eesupp/src/global_sum.F

b043311a0b Jean*0001 #include "CPP_EEOPTIONS.h"
                0002
924557e60a Chri*0003 C--   File global_sum.F: Routines that perform global sum on an array
                0004 C                        of thread values.
5237154b93 Jean*0005 C--    Contents
                0006 C--    o GLOBAL_SUM_R4
                0007 C--    o GLOBAL_SUM_R8
                0008 C--    o GLOBAL_SUM_INT
03c23d8c97 Jean*0009
b043311a0b Jean*0010 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
4c563c2ee9 Chri*0011 CBOP
                0012 C     !ROUTINE: GLOBAL_SUM_R4
                0013
                0014 C     !INTERFACE:
03c23d8c97 Jean*0015       SUBROUTINE GLOBAL_SUM_R4(
78c96bee2f Alis*0016      U                       sumPhi,
924557e60a Chri*0017      I                       myThid )
03c23d8c97 Jean*0018
4c563c2ee9 Chri*0019 C     !DESCRIPTION:
                0020 C     *==========================================================*
03c23d8c97 Jean*0021 C     | SUBROUTINE GLOBAL\_SUM\_R4
                0022 C     | o Handle sum for real*4 data.
4c563c2ee9 Chri*0023 C     *==========================================================*
03c23d8c97 Jean*0024 C     | Perform sum an array of one value per thread and then
                0025 C     | sum result of all the processes.
                0026 C     | Notes:
                0027 C     | Within a process only one thread does the sum.
                0028 C     | The same thread also does the inter-process sum for
                0029 C     | example with MPI and then writes the result into a shared
                0030 C     | location. All threads wait until the sum is avaiailable.
4c563c2ee9 Chri*0031 C     *==========================================================*
924557e60a Chri*0032
4c563c2ee9 Chri*0033 C     !USES:
03c23d8c97 Jean*0034       IMPLICIT NONE
                0035
924557e60a Chri*0036 C     == Global data ==
                0037 #include "SIZE.h"
                0038 #include "EEPARAMS.h"
                0039 #include "EESUPPORT.h"
aea29c8517 Alis*0040 #include "GLOBAL_SUM.h"
924557e60a Chri*0041
4c563c2ee9 Chri*0042 C     !INPUT/OUTPUT PARAMETERS:
924557e60a Chri*0043 C     == Routine arguments ==
b043311a0b Jean*0044 C     sumPhi :: Result of sum.
                0045 C     myThid :: My thread id.
924557e60a Chri*0046       Real*4 sumPhi
                0047       INTEGER myThid
                0048
4c563c2ee9 Chri*0049 C     !LOCAL VARIABLES:
924557e60a Chri*0050 C     == Local variables ==
b043311a0b Jean*0051 C     I      :: Loop counters
                0052 C     mpiRC  :: MPI return code
5237154b93 Jean*0053       INTEGER i
924557e60a Chri*0054       Real*4  tmp
ca1d7a672f Jean*0055 #ifdef ALLOW_USE_MPI
924557e60a Chri*0056       INTEGER mpiRC
                0057 #endif /* ALLOW_USE_MPI */
4c563c2ee9 Chri*0058 CEOP
924557e60a Chri*0059
78c96bee2f Alis*0060 C--   write local sum into array
b043311a0b Jean*0061       phiGSR4(1,myThid) = sumPhi
78c96bee2f Alis*0062
46dc4f419b Chri*0063 C--   Can not start until everyone is ready
aea29c8517 Alis*0064       CALL BAR2( myThid )
924557e60a Chri*0065
                0066 C--   Sum within the process first
                0067       _BEGIN_MASTER( myThid )
                0068        tmp = 0.
5237154b93 Jean*0069        DO i=1,nThreads
                0070         tmp = tmp + phiGSR4(1,i)
924557e60a Chri*0071        ENDDO
                0072        sumPhi = tmp
ca1d7a672f Jean*0073 #ifdef ALLOW_USE_MPI
924557e60a Chri*0074        IF ( usingMPI ) THEN
                0075         CALL MPI_Allreduce(tmp,sumPhi,1,MPI_REAL,MPI_SUM,
ed584e7d0c Jean*0076      &                   MPI_COMM_MODEL,mpiRC)
924557e60a Chri*0077        ENDIF
ca1d7a672f Jean*0078 #endif /* ALLOW_USE_MPI */
78c96bee2f Alis*0079 C--     Write solution to place where all threads can see it
b043311a0b Jean*0080        phiGSR4(1,0) = sumPhi
78c96bee2f Alis*0081
924557e60a Chri*0082       _END_MASTER( myThid )
                0083 C--
aea29c8517 Alis*0084       CALL BAR2( myThid )
78c96bee2f Alis*0085
                0086 C--   set result for every process
40c782d0d0 Jean*0087       sumPhi = phiGSR4(1,0)
78c96bee2f Alis*0088
924557e60a Chri*0089       RETURN
                0090       END
03c23d8c97 Jean*0091
b043311a0b Jean*0092 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
4c563c2ee9 Chri*0093 CBOP
                0094 C     !ROUTINE: GLOBAL_SUM_R8
                0095
                0096 C     !INTERFACE:
03c23d8c97 Jean*0097       SUBROUTINE GLOBAL_SUM_R8(
78c96bee2f Alis*0098      U                       sumPhi,
924557e60a Chri*0099      I                       myThid )
b043311a0b Jean*0100
4c563c2ee9 Chri*0101 C     !DESCRIPTION:
                0102 C     *==========================================================*
03c23d8c97 Jean*0103 C     | SUBROUTINE GLOBAL\_SUM\_R8
                0104 C     | o Handle sum for real*8 data.
4c563c2ee9 Chri*0105 C     *==========================================================*
03c23d8c97 Jean*0106 C     | Perform sum an array of one value per thread and then
                0107 C     | sum result of all the processes.
                0108 C     | Notes:
                0109 C     | Within a process only one thread does the sum.
                0110 C     | The same thread also does the inter-process sum for
                0111 C     | example with MPI and then writes the result into a shared
                0112 C     | location. All threads wait until the sum is avaiailable.
4c563c2ee9 Chri*0113 C     *==========================================================*
924557e60a Chri*0114
4c563c2ee9 Chri*0115 C     !USES:
b043311a0b Jean*0116       IMPLICIT NONE
                0117
924557e60a Chri*0118 C     === Global data ===
                0119 #include "SIZE.h"
                0120 #include "EEPARAMS.h"
                0121 #include "EESUPPORT.h"
aea29c8517 Alis*0122 #include "GLOBAL_SUM.h"
924557e60a Chri*0123
4c563c2ee9 Chri*0124 C     !INPUT/OUTPUT PARAMETERS:
924557e60a Chri*0125 C     === Routine arguments ===
b043311a0b Jean*0126 C     sumPhi :: Result of sum.
                0127 C     myThid :: My thread id.
924557e60a Chri*0128       Real*8 sumPhi
                0129       INTEGER myThid
                0130
4c563c2ee9 Chri*0131 C     !LOCAL VARIABLES:
924557e60a Chri*0132 C     === Local variables ===
b043311a0b Jean*0133 C     I      :: Loop counters
                0134 C     mpiRC  :: MPI return code
5237154b93 Jean*0135       INTEGER i
924557e60a Chri*0136       Real*8  tmp
ca1d7a672f Jean*0137 #ifdef ALLOW_USE_MPI
924557e60a Chri*0138       INTEGER mpiRC
                0139 #endif   /* ALLOW_USE_MPI */
4c563c2ee9 Chri*0140 CEOP
924557e60a Chri*0141
78c96bee2f Alis*0142 C--   write local sum into array
b043311a0b Jean*0143       phiGSR8(1,myThid) = sumPhi
78c96bee2f Alis*0144
46dc4f419b Chri*0145 C--   Can not start until everyone is ready
b043311a0b Jean*0146 C     CALL FOOL_THE_COMPILER( phiGSR8 )
aea29c8517 Alis*0147 C     CALL MS
                0148       CALL BAR2( myThid )
                0149 C     _BARRIER
                0150 C     _BARRIER
b043311a0b Jean*0151 C     CALL FOOL_THE_COMPILER( phiGSR8 )
924557e60a Chri*0152
                0153 C--   Sum within the process first
                0154       _BEGIN_MASTER( myThid )
                0155        tmp = 0. _d 0
5237154b93 Jean*0156        DO i=1,nThreads
                0157         tmp = tmp + phiGSR8(1,i)
924557e60a Chri*0158        ENDDO
                0159        sumPhi = tmp
ca1d7a672f Jean*0160 #ifdef ALLOW_USE_MPI
924557e60a Chri*0161        IF ( usingMPI ) THEN
                0162         CALL MPI_Allreduce(tmp,sumPhi,1,MPI_DOUBLE_PRECISION,MPI_SUM,
ed584e7d0c Jean*0163      &                   MPI_COMM_MODEL,mpiRC)
924557e60a Chri*0164        ENDIF
ca1d7a672f Jean*0165 #endif /* ALLOW_USE_MPI */
924557e60a Chri*0166 C--     Write solution to place where all threads can see it
b043311a0b Jean*0167        phiGSR8(1,0) = sumPhi
924557e60a Chri*0168       _END_MASTER( myThid )
                0169
46dc4f419b Chri*0170 C--   Do not leave until we are sure that the sum is done
b043311a0b Jean*0171 C     CALL FOOL_THE_COMPILER( phiGSR8 )
aea29c8517 Alis*0172 C     CALL MS
                0173 C     _BARRIER
                0174 C     _BARRIER
                0175       CALL BAR2( myThid )
b043311a0b Jean*0176 C     CALL FOOL_THE_COMPILER( phiGSR8 )
78c96bee2f Alis*0177
                0178 C--   set result for every process
b043311a0b Jean*0179       sumPhi = phiGSR8(1,0)
78c96bee2f Alis*0180
924557e60a Chri*0181       RETURN
                0182       END
4c563c2ee9 Chri*0183
b043311a0b Jean*0184 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
4c563c2ee9 Chri*0185 CBOP
                0186 C     !ROUTINE: GLOBAL_SUM_INT
                0187 C     !INTERFACE:
03c23d8c97 Jean*0188       SUBROUTINE GLOBAL_SUM_INT(
3877be74e8 Patr*0189      U                       sumPhi,
                0190      I                       myThid )
b043311a0b Jean*0191
4c563c2ee9 Chri*0192 C     !DESCRIPTION:
                0193 C     *==========================================================*
03c23d8c97 Jean*0194 C     | SUBROUTINE GLOBAL\_SUM\_INT
                0195 C     | o Handle sum for integer data.
4c563c2ee9 Chri*0196 C     *==========================================================*
03c23d8c97 Jean*0197 C     | Perform sum an array of one value per thread and then
                0198 C     | sum result of all the processes.
                0199 C     | Notes:
                0200 C     | Within a process only one thread does the sum.
                0201 C     | The same thread also does the inter-process sum for
                0202 C     | example with MPI and then writes the result into a shared
                0203 C     | location. All threads wait until the sum is avaiailable.
4c563c2ee9 Chri*0204 C     *==========================================================*
3877be74e8 Patr*0205
4c563c2ee9 Chri*0206 C     !USES:
b043311a0b Jean*0207       IMPLICIT NONE
                0208
3877be74e8 Patr*0209 C     === Global data ===
                0210 #include "SIZE.h"
                0211 #include "EEPARAMS.h"
                0212 #include "EESUPPORT.h"
aea29c8517 Alis*0213 #include "GLOBAL_SUM.h"
3877be74e8 Patr*0214
4c563c2ee9 Chri*0215 C     !INPUT/OUTPUT PARAMETERS:
3877be74e8 Patr*0216 C     === Routine arguments ===
b043311a0b Jean*0217 C     sumPhi :: Result of sum.
                0218 C     myThid :: My thread id.
3877be74e8 Patr*0219       INTEGER sumPhi
                0220       INTEGER myThid
                0221
4c563c2ee9 Chri*0222 C     !LOCAL VARIABLES:
3877be74e8 Patr*0223 C     === Local variables ===
b043311a0b Jean*0224 C     I      :: Loop counters
                0225 C     mpiRC  :: MPI return code
5237154b93 Jean*0226       INTEGER i
3877be74e8 Patr*0227       INTEGER  tmp
ca1d7a672f Jean*0228 #ifdef ALLOW_USE_MPI
3877be74e8 Patr*0229       INTEGER mpiRC
                0230 #endif   /* ALLOW_USE_MPI */
4c563c2ee9 Chri*0231 CEOP
3877be74e8 Patr*0232
                0233 C--   write local sum into array
aea29c8517 Alis*0234       phiGSI(1,myThid) = sumPhi
3877be74e8 Patr*0235
                0236 C--   Can not start until everyone is ready
                0237       _BARRIER
                0238
                0239 C--   Sum within the process first
                0240       _BEGIN_MASTER( myThid )
03c23d8c97 Jean*0241        tmp = 0
5237154b93 Jean*0242        DO i=1,nThreads
                0243         tmp = tmp + phiGSI(1,i)
3877be74e8 Patr*0244        ENDDO
                0245        sumPhi = tmp
ca1d7a672f Jean*0246 #ifdef ALLOW_USE_MPI
3877be74e8 Patr*0247        IF ( usingMPI ) THEN
                0248         CALL MPI_Allreduce(tmp,sumPhi,1,MPI_INTEGER,MPI_SUM,
ed584e7d0c Jean*0249      &                   MPI_COMM_MODEL,mpiRC)
3877be74e8 Patr*0250        ENDIF
ca1d7a672f Jean*0251 #endif /* ALLOW_USE_MPI */
3877be74e8 Patr*0252 C--     Write solution to place where all threads can see it
b043311a0b Jean*0253        phiGSI(1,0) = sumPhi
3877be74e8 Patr*0254       _END_MASTER( myThid )
                0255
                0256 C--   Do not leave until we are sure that the sum is done
                0257       _BARRIER
                0258
                0259 C--   set result for every process
b043311a0b Jean*0260       sumPhi = phiGSI(1,0)
3877be74e8 Patr*0261
                0262       RETURN
                0263       END