File indexing completed on 2024-08-29 05:10:34 UTC
view on githubraw file Latest commit 5237154b on 2024-08-28 14:56:27 UTC
b043311a0b Jean*0001 #include "CPP_EEOPTIONS.h"
0002
52aaad098a Jean*0003
0004
5237154b93 Jean*0005
0006
0007
52aaad098a Jean*0008
b043311a0b Jean*0009
52aaad098a Jean*0010
0011
0012
0013
0014 SUBROUTINE GLOBAL_SUM_TILE_RL(
0015 I phiTile,
0016 O sumPhi,
0017 I myThid )
b043311a0b Jean*0018
52aaad098a Jean*0019
0020
0021
0022
0023
0024
0025
0026
0027
0028
b043311a0b Jean*0029 IMPLICIT NONE
0030
52aaad098a Jean*0031
0032 #include "SIZE.h"
0033 #include "EEPARAMS.h"
0034 #include "EESUPPORT.h"
0035 #include "GLOBAL_SUM.h"
0036
0037
0038
0039
0040
0041
0042 _RL phiTile(nSx,nSy)
0043 _RL sumPhi
0044 INTEGER myThid
0045
0046
0047
1071dbe8ca Jean*0048
0049
52aaad098a Jean*0050
0051
0052 INTEGER bi,bj
0053 #ifdef ALLOW_USE_MPI
0054 #ifdef GLOBAL_SUM_SEND_RECV
1071dbe8ca Jean*0055 INTEGER biG, bjG, np, pId
52aaad098a Jean*0056 INTEGER lbuff, idest, itag, ready_to_receive
0057 INTEGER istatus(MPI_STATUS_SIZE), ierr
0058 Real*8 localBuf (nSx,nSy)
0059 Real*8 globalBuf(nSx*nPx,nSy*nPy)
fe6019498a Jean*0060 #elif defined (GLOBAL_SUM_ORDER_TILES)
0061 INTEGER biG, bjG, lbuff
0062 Real*8 localBuf (nSx*nPx,nSy*nPy)
0063 Real*8 globalBuf(nSx*nPx,nSy*nPy)
52aaad098a Jean*0064 #endif
1071dbe8ca Jean*0065 INTEGER mpiRC
52aaad098a Jean*0066 #endif /* ALLOW_USE_MPI */
1071dbe8ca Jean*0067 Real*8 sumMyPr
52aaad098a Jean*0068 Real*8 sumAllP
0069
0070
f0eee60ee1 Jean*0071
0072
52aaad098a Jean*0073
0074
0075 DO bj = myByLo(myThid), myByHi(myThid)
0076 DO bi = myBxLo(myThid), myBxHi(myThid)
0077 shareBufGSR8(bi,bj) = phiTile(bi,bj)
0078 ENDDO
0079 ENDDO
0080
0081
0082 CALL BAR2( myThid )
0083 _BEGIN_MASTER( myThid )
0084
5237154b93 Jean*0085 #if (defined GLOBAL_SUM_SEND_RECV && defined ALLOW_USE_MPI )
1071dbe8ca Jean*0086 IF ( usingMPI ) THEN
52aaad098a Jean*0087
1071dbe8ca Jean*0088 lbuff = nSx*nSy
0089 idest = 0
0090 itag = 0
0091 ready_to_receive = 0
52aaad098a Jean*0092
1071dbe8ca Jean*0093 IF ( mpiMyId.NE.0 ) THEN
52aaad098a Jean*0094
0095
0096 #ifndef DISABLE_MPI_READY_TO_RECEIVE
0097 CALL MPI_RECV (ready_to_receive, 1, MPI_INTEGER,
0098 & idest, itag, MPI_COMM_MODEL, istatus, ierr)
0099 #endif
0100 CALL MPI_SEND (shareBufGSR8, lbuff, MPI_DOUBLE_PRECISION,
0101 & idest, itag, MPI_COMM_MODEL, ierr)
0102
0103
0104 CALL MPI_RECV (sumAllP, 1, MPI_DOUBLE_PRECISION,
0105 & idest, itag, MPI_COMM_MODEL, istatus, ierr)
0106
1071dbe8ca Jean*0107 ELSE
0108
52aaad098a Jean*0109
0110
1071dbe8ca Jean*0111 np = 1
0112 DO bj=1,nSy
52aaad098a Jean*0113 DO bi=1,nSx
1071dbe8ca Jean*0114 biG = (mpi_myXGlobalLo(np)-1)/sNx+bi
0115 bjG = (mpi_myYGlobalLo(np)-1)/sNy+bj
52aaad098a Jean*0116 globalBuf(biG,bjG) = shareBufGSR8(bi,bj)
0117 ENDDO
1071dbe8ca Jean*0118 ENDDO
52aaad098a Jean*0119
0120
1071dbe8ca Jean*0121 DO np = 2, nPx*nPy
0122 pId = np - 1
52aaad098a Jean*0123 #ifndef DISABLE_MPI_READY_TO_RECEIVE
0124 CALL MPI_SEND (ready_to_receive, 1, MPI_INTEGER,
1071dbe8ca Jean*0125 & pId, itag, MPI_COMM_MODEL, ierr)
52aaad098a Jean*0126 #endif
0127 CALL MPI_RECV (localBuf, lbuff, MPI_DOUBLE_PRECISION,
1071dbe8ca Jean*0128 & pId, itag, MPI_COMM_MODEL, istatus, ierr)
52aaad098a Jean*0129
0130
0131 DO bj=1,nSy
0132 DO bi=1,nSx
1071dbe8ca Jean*0133 biG = (mpi_myXGlobalLo(np)-1)/sNx+bi
0134 bjG = (mpi_myYGlobalLo(np)-1)/sNy+bj
0135 globalBuf(biG,bjG) = localBuf(bi,bj)
52aaad098a Jean*0136 ENDDO
0137 ENDDO
1071dbe8ca Jean*0138
0139 ENDDO
52aaad098a Jean*0140
0141
1071dbe8ca Jean*0142 sumAllP = 0.
0143 DO bjG = 1,nSy*nPy
0144 DO biG = 1,nSx*nPx
52aaad098a Jean*0145 sumAllP = sumAllP + globalBuf(biG,bjG)
1071dbe8ca Jean*0146 ENDDO
52aaad098a Jean*0147 ENDDO
0148
0149
1071dbe8ca Jean*0150 lbuff = 1
0151 DO np = 2, nPx*nPy
0152 pId = np - 1
52aaad098a Jean*0153 CALL MPI_SEND (sumAllP, 1, MPI_DOUBLE_PRECISION,
1071dbe8ca Jean*0154 & pId, itag, MPI_COMM_MODEL, ierr)
0155 ENDDO
52aaad098a Jean*0156
1071dbe8ca Jean*0157
0158 ENDIF
52aaad098a Jean*0159
1071dbe8ca Jean*0160 ELSE
5237154b93 Jean*0161 #elif (defined GLOBAL_SUM_ORDER_TILES && defined ALLOW_USE_MPI )
fe6019498a Jean*0162 IF ( usingMPI ) THEN
0163
0164
0165 DO bjG=1,nSy*nPy
0166 DO biG=1,nSx*nPx
0167 localBuf(biG,bjG) = 0.
0168 ENDDO
0169 ENDDO
0170
0171
0172 DO bj=1,nSy
0173 DO bi=1,nSx
0174 biG = (myXGlobalLo-1)/sNx+bi
0175 bjG = (myYGlobalLo-1)/sNy+bj
0176 localBuf(biG,bjG) = shareBufGSR8(bi,bj)
0177 ENDDO
0178 ENDDO
0179
0180
0181 lbuff = nSx*nPx*nSy*nPy
0182 CALL MPI_Allreduce( localBuf, globalBuf, lbuff,
0183 & MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_MODEL, mpiRC )
0184
0185
0186 sumAllP = 0.
0187 DO bjG = 1,nSy*nPy
0188 DO biG = 1,nSx*nPx
0189 sumAllP = sumAllP + globalBuf(biG,bjG)
0190 ENDDO
0191 ENDDO
0192
0193 ELSE
0194 #else /* not ((GLOBAL_SUM_SEND_RECV | GLOBAL_SUM_ORDER_TILES) & ALLOW_USE_MPI) */
1071dbe8ca Jean*0195 IF ( .TRUE. ) THEN
fe6019498a Jean*0196 #endif /* not ((GLOBAL_SUM_SEND_RECV | GLOBAL_SUM_ORDER_TILES) & ALLOW_USE_MPI) */
52aaad098a Jean*0197
0198
1071dbe8ca Jean*0199 sumMyPr = 0.
0200 DO bj = 1,nSy
0201 DO bi = 1,nSx
52aaad098a Jean*0202 sumMyPr = sumMyPr + shareBufGSR8(bi,bj)
1071dbe8ca Jean*0203 ENDDO
52aaad098a Jean*0204 ENDDO
0205
fe6019498a Jean*0206
1071dbe8ca Jean*0207 sumAllP = sumMyPr
52aaad098a Jean*0208
0209 #ifdef ALLOW_USE_MPI
1071dbe8ca Jean*0210 IF ( usingMPI ) THEN
0211 CALL MPI_Allreduce(sumMyPr,sumAllP,1,MPI_DOUBLE_PRECISION,
0212 & MPI_SUM,MPI_COMM_MODEL,mpiRC)
0213 ENDIF
52aaad098a Jean*0214 #endif /* ALLOW_USE_MPI */
0215
1071dbe8ca Jean*0216 ENDIF
52aaad098a Jean*0217
fe6019498a Jean*0218
1071dbe8ca Jean*0219
0220 phiGSR8(1,0) = sumAllP
52aaad098a Jean*0221
0222 _END_MASTER( myThid )
0223
0224 CALL BAR2( myThid )
0225
0226
b043311a0b Jean*0227
0228 sumPhi = phiGSR8(1,0)
52aaad098a Jean*0229
b043311a0b Jean*0230
f0eee60ee1 Jean*0231
0232
b043311a0b Jean*0233
0234
52aaad098a Jean*0235
0236 RETURN
0237 END