Warning, /eesupp/src/scatter_2d_rx.template is written in an unsupported language. File is not indexed.
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
2c3e6deece Jean*0001 #include "PACKAGES_CONFIG.h"
0002 #include "CPP_EEOPTIONS.h"
0003
0004 CBOP
0005 C !ROUTINE: SCATTER_2D_RX
0006 C !INTERFACE:
0007 SUBROUTINE SCATTER_2D_RX(
0008 I gloBuff,
0009 O myField,
0010 I xSize, ySize,
17eb230979 Jean*0011 I useExch2GlobLayOut,
2c3e6deece Jean*0012 I zeroBuff,
0013 I myThid )
0014 C !DESCRIPTION:
0015 C Scatter elements of a global 2-D array from mpi process 0 to all processes.
1707a3cb3a Jean*0016 C Note: done by Master-Thread ; might need barrier calls before and after
0017 C this S/R call.
2c3e6deece Jean*0018
0019 C !USES:
0020 IMPLICIT NONE
0021 #include "SIZE.h"
0022 #include "EEPARAMS.h"
0023 #include "EESUPPORT.h"
0024 #ifdef ALLOW_EXCH2
1cc6effca6 Jean*0025 #include "W2_EXCH2_SIZE.h"
2c3e6deece Jean*0026 #include "W2_EXCH2_TOPOLOGY.h"
0027 #endif /* ALLOW_EXCH2 */
0028
0029 C !INPUT/OUTPUT PARAMETERS:
0030 C gloBuff ( _RX ) :: full-domain 2D IO-buffer array (Input)
0031 C myField ( _RX ) :: tiled, local (i.e. my Proc. tiles) 2D array (Output)
0032 C xSize (integer):: global buffer 1rst dim (x)
0033 C ySize (integer):: global buffer 2nd dim (y)
17eb230979 Jean*0034 C useExch2GlobLayOut:: =T: Use Exch2 global-map layout (only with EXCH2)
2c3e6deece Jean*0035 C zeroBuff (logical):: =T: reset the buffer to zero after copy
0036 C myThid (integer):: my Thread Id number
0037
0038 INTEGER xSize, ySize
0039 _RX gloBuff(xSize,ySize)
0040 _RX myField(1:sNx,1:sNy,nSx,nSy)
17eb230979 Jean*0041 LOGICAL useExch2GlobLayOut
2c3e6deece Jean*0042 LOGICAL zeroBuff
0043 INTEGER myThid
0044 CEOP
0045
0046 C !LOCAL VARIABLES:
0047 INTEGER i,j, bi,bj
0048 INTEGER iG, jG
0049 INTEGER iBase, jBase
0050 #ifdef ALLOW_EXCH2
0051 INTEGER iGjLoc, jGjLoc
0052 INTEGER tN
0053 #endif /* ALLOW_EXCH2 */
0054 #ifdef ALLOW_USE_MPI
1071dbe8ca Jean*0055 INTEGER np, pId
2c3e6deece Jean*0056 _RX temp(1:sNx,1:sNy,nSx,nSy)
0057 INTEGER istatus(MPI_STATUS_SIZE), ierr
0058 INTEGER lbuff, isource, itag
0059 #endif /* ALLOW_USE_MPI */
0060
0061 _BEGIN_MASTER( myThid )
0062
0063 #ifdef ALLOW_USE_MPI
1071dbe8ca Jean*0064 IF ( usingMPI ) THEN
2c3e6deece Jean*0065
1071dbe8ca Jean*0066 lbuff = sNx*nSx*sNy*nSy
0067 isource = 0
0068 itag = 0
2c3e6deece Jean*0069
1071dbe8ca Jean*0070 IF( mpiMyId .EQ. 0 ) THEN
2c3e6deece Jean*0071
0072 C-- Process 0 sends local arrays to all other processes
1071dbe8ca Jean*0073 DO np = 2, nPx*nPy
2c3e6deece Jean*0074
0075 C-- Process 0 extract the local arrays from the global buffer.
0076
0077 #ifdef ALLOW_EXCH2
17eb230979 Jean*0078 IF ( useExch2GlobLayOut ) THEN
2c3e6deece Jean*0079
6e33c64afb Jean*0080 DO bj=1,nSy
2c3e6deece Jean*0081 DO bi=1,nSx
6e33c64afb Jean*0082 tN = W2_procTileList(bi,bj,np)
2c3e6deece Jean*0083 IF ( exch2_mydNx(tN) .GT. xSize ) THEN
0084 C- face x-size larger than glob-size : fold it
0085 iGjLoc = 0
0086 jGjLoc = exch2_mydNx(tN) / xSize
0087 ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
0088 C- tile y-size larger than glob-size : make a long line
0089 iGjLoc = exch2_mydNx(tN)
0090 jGjLoc = 0
0091 ELSE
0092 C- default (face fit into global-IO-array)
0093 iGjLoc = 0
0094 jGjLoc = 1
0095 ENDIF
0096
0097 DO j=1,sNy
0098 #ifdef TARGET_NEC_SX
0099 !cdir novector
0100 #endif
0101 iG=exch2_txGlobalo(tN)+iGjLoc*(j-1)-1
0102 jG=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
0103 DO i=1,sNx
0104 temp(i,j,bi,bj) = gloBuff(iG+i,jG)
0105 ENDDO
0106 ENDDO
0107
0108 ENDDO
6e33c64afb Jean*0109 ENDDO
2c3e6deece Jean*0110
0111 ELSE
0112 #else /* ALLOW_EXCH2 */
0113 IF (.TRUE.) THEN
0114 #endif /* ALLOW_EXCH2 */
0115
df6a8765ed Jean*0116 iBase = mpi_myXGlobalLo(np)-1
0117 jBase = mpi_myYGlobalLo(np)-1
2c3e6deece Jean*0118
0119 DO bj=1,nSy
0120 DO bi=1,nSx
0121 DO j=1,sNy
0122 #ifdef TARGET_NEC_SX
0123 !cdir novector
0124 #endif
0125 iG = iBase+(bi-1)*sNx
0126 jG = jBase+(bj-1)*sNy+j
0127 DO i=1,sNx
0128 temp(i,j,bi,bj) = gloBuff(iG+i,jG)
0129 ENDDO
0130 ENDDO
0131 ENDDO
0132 ENDDO
0133
17eb230979 Jean*0134 C end if-else useExch2GlobLayOut
2c3e6deece Jean*0135 ENDIF
0136
0137 C-- Process 0 sends local arrays to all other processes
1071dbe8ca Jean*0138 pId = np - 1
2c3e6deece Jean*0139 CALL MPI_SEND (temp, lbuff, _MPI_TYPE_RX,
1071dbe8ca Jean*0140 & pId, itag, MPI_COMM_MODEL, ierr)
2c3e6deece Jean*0141
df6a8765ed Jean*0142 C- end loop on np
0143 ENDDO
0144
1071dbe8ca Jean*0145 ELSE
2c3e6deece Jean*0146
0147 C-- All proceses except 0 receive local array from process 0
0148 CALL MPI_RECV (myField, lbuff, _MPI_TYPE_RX,
0149 & isource, itag, MPI_COMM_MODEL, istatus, ierr)
0150
1071dbe8ca Jean*0151 ENDIF
2c3e6deece Jean*0152
1071dbe8ca Jean*0153 ENDIF
2c3e6deece Jean*0154 #endif /* ALLOW_USE_MPI */
0155
0156 IF( myProcId .EQ. 0 ) THEN
0157 C-- Process 0 fills-in its local data
0158
0159 #ifdef ALLOW_EXCH2
17eb230979 Jean*0160 IF ( useExch2GlobLayOut ) THEN
2c3e6deece Jean*0161
6e33c64afb Jean*0162 DO bj=1,nSy
2c3e6deece Jean*0163 DO bi=1,nSx
6e33c64afb Jean*0164 tN = W2_myTileList(bi,bj)
2c3e6deece Jean*0165 IF ( exch2_mydNx(tN) .GT. xSize ) THEN
0166 C- face x-size larger than glob-size : fold it
0167 iGjLoc = 0
0168 jGjLoc = exch2_mydNx(tN) / xSize
0169 ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
0170 C- tile y-size larger than glob-size : make a long line
0171 iGjLoc = exch2_mydNx(tN)
0172 jGjLoc = 0
0173 ELSE
0174 C- default (face fit into global-IO-array)
0175 iGjLoc = 0
0176 jGjLoc = 1
0177 ENDIF
0178
0179 DO j=1,sNy
0180 #ifdef TARGET_NEC_SX
0181 !cdir novector
0182 #endif
0183 iG=exch2_txGlobalo(tN)+iGjLoc*(j-1)-1
0184 jG=exch2_tyGlobalo(tN)+jGjLoc*(j-1)
0185 DO i=1,sNx
0186 myField(i,j,bi,bj) = gloBuff(iG+i,jG)
0187 ENDDO
0188 ENDDO
0189
0190 ENDDO
6e33c64afb Jean*0191 ENDDO
2c3e6deece Jean*0192
0193 C-- After the copy from the buffer, reset to zero.
0194 C An alternative to zeroBuff when writing to file,
0195 C which could be faster if we do less read than write.
0196 IF ( zeroBuff ) THEN
0197 DO j=1,ySize
0198 DO i=1,xSize
0199 gloBuff(i,j) = 0.
0200 ENDDO
0201 ENDDO
0202 ENDIF
0203
0204 ELSE
0205 #else /* ALLOW_EXCH2 */
0206 IF (.TRUE.) THEN
0207 #endif /* ALLOW_EXCH2 */
0208
df6a8765ed Jean*0209 iBase = myXGlobalLo-1
0210 jBase = myYGlobalLo-1
2c3e6deece Jean*0211
0212 DO bj=1,nSy
0213 DO bi=1,nSx
0214 DO j=1,sNy
0215 #ifdef TARGET_NEC_SX
0216 !cdir novector
0217 #endif
0218 iG = iBase+(bi-1)*sNx
0219 jG = jBase+(bj-1)*sNy+j
0220 DO i=1,sNx
0221 myField(i,j,bi,bj) = gloBuff(iG+i,jG)
0222 ENDDO
0223 ENDDO
0224 ENDDO
0225 ENDDO
0226
17eb230979 Jean*0227 C end if-else useExch2GlobLayOut
2c3e6deece Jean*0228 ENDIF
0229
0230 C- end if myProcId = 0
0231 ENDIF
0232
0233 _END_MASTER( myThid )
0234
0235 RETURN
0236 END
0237 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
