Warning, /eesupp/src/exch_rx_recv_get_y.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
92f012330e Alis*0001 #include "CPP_EEOPTIONS.h"
4947bd1c5a Jean*0002 #undef EXCH_USE_SPINNING
92f012330e Alis*0003
4c563c2ee9 Chri*0004 CBOP
0005 C !ROUTINE: EXCH_RX_RECV_GET_Y
0006
0007 C !INTERFACE:
92f012330e Alis*0008 SUBROUTINE EXCH_RX_RECV_GET_Y( array,
0009 I myOLw, myOLe, myOLs, myOLn, myNz,
0010 I exchWidthX, exchWidthY,
0011 I theSimulationMode, theCornerMode, myThid )
0012 IMPLICIT NONE
0013
4c563c2ee9 Chri*0014 C !DESCRIPTION:
0015 C *==========================================================*
4947bd1c5a Jean*0016 C | SUBROUTINE RECV_GET_Y
0017 C | o "Send" or "put" Y edges for RX array.
4c563c2ee9 Chri*0018 C *==========================================================*
4947bd1c5a Jean*0019 C | Routine that invokes actual message passing send or
0020 C | direct "put" of data to update X faces of an XY[R] array.
4c563c2ee9 Chri*0021 C *==========================================================*
0022
0023 C !USES:
92f012330e Alis*0024 C == Global variables ==
0025 #include "SIZE.h"
0026 #include "EEPARAMS.h"
0027 #include "EESUPPORT.h"
0028 #include "EXCH.h"
0029
4c563c2ee9 Chri*0030 C !INPUT/OUTPUT PARAMETERS:
92f012330e Alis*0031 C == Routine arguments ==
4c563c2ee9 Chri*0032 C array :: Array with edges to exchange.
0033 C myOLw :: West, East, North and South overlap region sizes.
92f012330e Alis*0034 C myOLe
0035 C myOLn
0036 C myOLs
4c563c2ee9 Chri*0037 C exchWidthX :: Width of data region exchanged.
92f012330e Alis*0038 C exchWidthY
4c563c2ee9 Chri*0039 C theSimulationMode :: Forward or reverse mode exchange ( provides
0040 C support for adjoint integration of code. )
0041 C theCornerMode :: Flag indicating whether corner updates are
0042 C needed.
0043 C myThid :: Thread number of this instance of S/R EXCH...
0044 C eBl :: Edge buffer level
92f012330e Alis*0045 INTEGER myOLw
0046 INTEGER myOLe
0047 INTEGER myOLs
0048 INTEGER myOLn
0049 INTEGER myNz
0050 _RX array(1-myOLw:sNx+myOLe,
0051 & 1-myOLs:sNy+myOLn,
0052 & myNZ, nSx, nSy)
0053 INTEGER exchWidthX
0054 INTEGER exchWidthY
0055 INTEGER theSimulationMode
0056 INTEGER theCornerMode
0057 INTEGER myThid
0058
4c563c2ee9 Chri*0059 C !LOCAL VARIABLES:
92f012330e Alis*0060 C == Local variables ==
4947bd1c5a Jean*0061 C i, j, k, iMin, iMax, iB :: Loop counters and extents
92f012330e Alis*0062 C bi, bj
4c563c2ee9 Chri*0063 C biS, bjS :: South tile indices
0064 C biN, bjN :: North tile indices
0065 C eBl :: Current exchange buffer level
0066 C theProc, theTag, theType, :: Variables used in message building
92f012330e Alis*0067 C theSize
4c563c2ee9 Chri*0068 C southCommMode :: Working variables holding type
0069 C northCommMode of communication a particular
0070 C tile face uses.
0071 C spinCount :: Exchange statistics counter
0072 C mpiStatus :: MPI error code
4947bd1c5a Jean*0073 INTEGER i, j, k, iMin, iMax, jMin, jMax, iB, iB0
92f012330e Alis*0074 INTEGER bi, bj, biS, bjS, biN, bjN
0075 INTEGER eBl
0076 INTEGER southCommMode
0077 INTEGER northCommMode
4947bd1c5a Jean*0078 #ifdef EXCH_USE_SPINNING
92f012330e Alis*0079 INTEGER spinCount
4947bd1c5a Jean*0080 #endif
92f012330e Alis*0081 #ifdef ALLOW_USE_MPI
19765ceae9 Jean*0082 INTEGER theProc, theTag, theType, theSize
92f012330e Alis*0083 INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
19765ceae9 Jean*0084 # ifdef ALLOW_AUTODIFF_OPENAD_AMPI
0085 INTEGER pReqI
0086 # endif
0087 #endif /* ALLOW_USE_MPI */
4c563c2ee9 Chri*0088 CEOP
92f012330e Alis*0089
4947bd1c5a Jean*0090 C-- Under a "put" scenario we
92f012330e Alis*0091 C-- i. set completetion signal for buffer we put into.
4947bd1c5a Jean*0092 C-- ii. wait for completetion signal indicating data has been put in
92f012330e Alis*0093 C-- our buffer.
0094 C-- Under a messaging mode we "receive" the message.
0095 C-- Under a "get" scenario we
0096 C-- i. Check that the data is ready.
0097 C-- ii. Read the data.
0098 C-- iii. Set data read flag + memory sync.
0099
0100 #ifdef ALLOW_USE_MPI
4947bd1c5a Jean*0101 IF ( usingMPI ) THEN
19765ceae9 Jean*0102
4947bd1c5a Jean*0103 C-- Receive buffer data: Only Master Thread do proc communication
0104 _BEGIN_MASTER(myThid)
0105
0106 DO bj=1,nSy
0107 DO bi=1,nSx
0108 eBl = exchangeBufLevel(1,bi,bj)
0109 southCommMode = _tileCommModeS(bi,bj)
0110 northCommMode = _tileCommModeN(bi,bj)
0111 biN = _tileBiN(bi,bj)
0112 bjN = _tileBjN(bi,bj)
0113 biS = _tileBiS(bi,bj)
0114 bjS = _tileBjS(bi,bj)
0115 theType = _MPI_TYPE_RX
0116 theSize = sNx*exchWidthY*myNz
0117 IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
0118 theSize = (sNx+2*exchWidthX)*exchWidthY*myNz
0119 ENDIF
0120
0121 IF ( southCommMode .EQ. COMM_MSG ) THEN
92f012330e Alis*0122 theProc = tilePidS(bi,bj)
0123 theTag = _tileTagRecvS(bi,bj)
0eef504f9b Jean*0124 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
4947bd1c5a Jean*0125 CALL MPI_Recv( southRecvBuf_RX(1,eBl,bi,bj), theSize,
0126 & theType, theProc, theTag, MPI_COMM_MODEL,
92f012330e Alis*0127 & mpiStatus, mpiRc )
4947bd1c5a Jean*0128 # else
83996e0652 Jean*0129 pReqI=exchNReqsY(1,bi,bj)+1
4947bd1c5a Jean*0130 CALL ampi_recv_RX(
0131 & southRecvBuf_RX(1,eBl,bi,bj) ,
0132 & theSize ,
0133 & theType ,
0134 & theProc ,
0135 & theTag ,
0136 & MPI_COMM_MODEL ,
0137 & exchReqIdY(pReqI,1,bi,bj),
0138 & exchNReqsY(1,bi,bj),
0139 & mpiStatus ,
0140 & mpiRc )
0eef504f9b Jean*0141 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
4947bd1c5a Jean*0142 southRecvAck(eBl,bi,bj) = 1
92f012330e Alis*0143 ENDIF
4947bd1c5a Jean*0144
92f012330e Alis*0145 IF ( northCommMode .EQ. COMM_MSG ) THEN
0146 theProc = tilePidN(bi,bj)
0147 theTag = _tileTagRecvN(bi,bj)
0eef504f9b Jean*0148 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
4947bd1c5a Jean*0149 CALL MPI_Recv( northRecvBuf_RX(1,eBl,bi,bj), theSize,
0150 & theType, theProc, theTag, MPI_COMM_MODEL,
92f012330e Alis*0151 & mpiStatus, mpiRc )
033dc5d283 Jean*0152 # else
4d40368441 Jean*0153 pReqI=exchNReqsY(1,bi,bj)+1
4947bd1c5a Jean*0154 CALL ampi_recv_RX(
0155 & northRecvBuf_RX(1,eBl,bi,bj) ,
0156 & theSize ,
0157 & theType ,
0158 & theProc ,
0159 & theTag ,
0160 & MPI_COMM_MODEL ,
0161 & exchReqIdY(pReqI,1,bi,bj),
0162 & exchNReqsY(1,bi,bj),
0163 & mpiStatus ,
0164 & mpiRc )
0eef504f9b Jean*0165 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
4947bd1c5a Jean*0166 northRecvAck(eBl,bi,bj) = 1
92f012330e Alis*0167 ENDIF
0168 ENDDO
0169 ENDDO
0170
4947bd1c5a Jean*0171 C-- Processes wait for buffers I am going to read to be ready.
0172 IF ( .NOT.exchUsesBarrier ) THEN
0173 DO bj=1,nSy
0174 DO bi=1,nSx
0175 IF ( exchNReqsY(1,bi,bj) .GT. 0 ) THEN
0176 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
0177 CALL MPI_Waitall( exchNReqsY(1,bi,bj), exchReqIdY(1,1,bi,bj),
0178 & mpiStatus, mpiRC )
0179 # else
0180 CALL ampi_waitall(
0181 & exchNReqsY(1,bi,bj),
0182 & exchReqIdY(1,1,bi,bj),
0183 & mpiStatus,
0184 & mpiRC )
0185 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
0186 ENDIF
0187 C Clear outstanding requests counter
0188 exchNReqsY(1,bi,bj) = 0
0189 ENDDO
0190 ENDDO
0191 ENDIF
0192
0193 _END_MASTER(myThid)
0194 C-- need to sync threads after master has received data ;
0195 C (done after mpi waitall in case waitall is really needed)
0196 _BARRIER
0197
0198 ENDIF
0199 #endif /* ALLOW_USE_MPI */
0200
0201 C-- Threads wait for buffers I am going to read to be ready.
0202 C note: added BARRIER in exch_send_put S/R and here above (message mode)
0203 C so that we no longer needs this (undef EXCH_USE_SPINNING)
0204 #ifdef EXCH_USE_SPINNING
92f012330e Alis*0205 IF ( exchUsesBarrier ) THEN
0206 C o On some machines ( T90 ) use system barrier rather than spinning.
0207 CALL BARRIER( myThid )
0208 ELSE
0209 C o Spin waiting for completetion flag. This avoids a global-lock
0210 C i.e. we only lock waiting for data that we need.
0211 DO bj=myByLo(myThid),myByHi(myThid)
0212 DO bi=myBxLo(myThid),myBxHi(myThid)
4947bd1c5a Jean*0213
0214 spinCount = 0
0215 eBl = exchangeBufLevel(1,bi,bj)
92f012330e Alis*0216 southCommMode = _tileCommModeS(bi,bj)
0217 northCommMode = _tileCommModeN(bi,bj)
0eef504f9b Jean*0218 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
92f012330e Alis*0219 10 CONTINUE
e78c04eec8 Jean*0220 CALL FOOL_THE_COMPILER( spinCount )
92f012330e Alis*0221 spinCount = spinCount+1
0222 C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
0223 C STOP ' S/R EXCH_RECV_GET_Y: spinCount .GT. _EXCH_SPIN_LIMIT'
0224 C ENDIF
061bed00a3 Jean*0225 IF ( southRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
0226 IF ( northRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
033dc5d283 Jean*0227 # else
4947bd1c5a Jean*0228 DO WHILE ((southRecvAck(eBl,bi,bj) .EQ. 0
0229 & .OR.
0230 & northRecvAck(eBl,bi,bj) .EQ. 0 ))
033dc5d283 Jean*0231 CALL FOOL_THE_COMPILER( spinCount )
0232 spinCount = spinCount+1
4947bd1c5a Jean*0233 ENDDO
0eef504f9b Jean*0234 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
92f012330e Alis*0235 C Clear requests
061bed00a3 Jean*0236 southRecvAck(eBl,bi,bj) = 0
0237 northRecvAck(eBl,bi,bj) = 0
92f012330e Alis*0238 C Update statistics
0239 IF ( exchCollectStatistics ) THEN
0240 exchRecvYExchCount(1,bi,bj) = exchRecvYExchCount(1,bi,bj)+1
4947bd1c5a Jean*0241 exchRecvYSpinCount(1,bi,bj) =
92f012330e Alis*0242 & exchRecvYSpinCount(1,bi,bj)+spinCount
4947bd1c5a Jean*0243 exchRecvYSpinMax(1,bi,bj) =
92f012330e Alis*0244 & MAX(exchRecvYSpinMax(1,bi,bj),spinCount)
4947bd1c5a Jean*0245 exchRecvYSpinMin(1,bi,bj) =
92f012330e Alis*0246 & MIN(exchRecvYSpinMin(1,bi,bj),spinCount)
0247 ENDIF
0248
0249 ENDDO
0250 ENDDO
0251 ENDIF
4947bd1c5a Jean*0252 #endif /* EXCH_USE_SPINNING */
0253
0254 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
92f012330e Alis*0255
0256 C-- Read from the buffers
0257 DO bj=myByLo(myThid),myByHi(myThid)
0258 DO bi=myBxLo(myThid),myBxHi(myThid)
0259
4947bd1c5a Jean*0260 eBl = exchangeBufLevel(1,bi,bj)
0261 biN = _tileBiN(bi,bj)
0262 bjN = _tileBjN(bi,bj)
0263 biS = _tileBiS(bi,bj)
0264 bjS = _tileBjS(bi,bj)
92f012330e Alis*0265 southCommMode = _tileCommModeS(bi,bj)
0266 northCommMode = _tileCommModeN(bi,bj)
0267 IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
0268 iMin = 1-exchWidthX
0269 iMax = sNx+exchWidthX
0270 ELSE
0271 iMin = 1
0272 iMax = sNx
0273 ENDIF
0274 IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
0275 jMin = sNy+1
0276 jMax = sNy+exchWidthY
0277 iB0 = 0
4947bd1c5a Jean*0278 IF ( northCommMode .EQ. COMM_PUT
0279 & .OR. northCommMode .EQ. COMM_MSG ) THEN
92f012330e Alis*0280 iB = 0
4947bd1c5a Jean*0281 DO k=1,myNz
0282 DO j=jMin,jMax
0283 DO i=iMin,iMax
92f012330e Alis*0284 iB = iB + 1
4947bd1c5a Jean*0285 array(i,j,k,bi,bj) = northRecvBuf_RX(iB,eBl,bi,bj)
92f012330e Alis*0286 ENDDO
0287 ENDDO
0288 ENDDO
0289 ELSEIF ( northCommMode .EQ. COMM_GET ) THEN
4947bd1c5a Jean*0290 DO k=1,myNz
92f012330e Alis*0291 iB = iB0
4947bd1c5a Jean*0292 DO j=jMin,jMax
92f012330e Alis*0293 iB = iB+1
4947bd1c5a Jean*0294 DO i=iMin,iMax
0295 array(i,j,k,bi,bj) = array(i,iB,k,biN,bjN)
92f012330e Alis*0296 ENDDO
0297 ENDDO
0298 ENDDO
0299 ENDIF
0300 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
0301 jMin = sNy-exchWidthY+1
0302 jMax = sNy
0303 iB0 = 1-exchWidthY-1
4947bd1c5a Jean*0304 IF ( northCommMode .EQ. COMM_PUT
0305 & .OR. northCommMode .EQ. COMM_MSG ) THEN
92f012330e Alis*0306 iB = 0
4947bd1c5a Jean*0307 DO k=1,myNz
0308 DO j=jMin,jMax
0309 DO i=iMin,iMax
92f012330e Alis*0310 iB = iB + 1
4947bd1c5a Jean*0311 array(i,j,k,bi,bj) =
0312 & array(i,j,k,bi,bj) + northRecvBuf_RX(iB,eBl,bi,bj)
92f012330e Alis*0313 ENDDO
0314 ENDDO
0315 ENDDO
0316 ELSEIF ( northCommMode .EQ. COMM_GET ) THEN
4947bd1c5a Jean*0317 DO k=1,myNz
92f012330e Alis*0318 iB = iB0
4947bd1c5a Jean*0319 DO j=jMin,jMax
92f012330e Alis*0320 iB = iB+1
4947bd1c5a Jean*0321 DO i=iMin,iMax
0322 array(i,j,k,bi,bj) =
0323 & array(i,j,k,bi,bj) + array(i,iB,k,biN,bjN)
0324 array(i,iB,k,biN,bjN) = 0.0
92f012330e Alis*0325 ENDDO
0326 ENDDO
0327 ENDDO
0328 ENDIF
0329 ENDIF
0330
0331 IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
0332 jMin = 1-exchWidthY
0333 jMax = 0
0334 iB0 = sNy-exchWidthY
4947bd1c5a Jean*0335 IF ( southCommMode .EQ. COMM_PUT
0336 & .OR. southCommMode .EQ. COMM_MSG ) THEN
92f012330e Alis*0337 iB = 0
4947bd1c5a Jean*0338 DO k=1,myNz
0339 DO j=jMin,jMax
0340 DO i=iMin,iMax
92f012330e Alis*0341 iB = iB + 1
4947bd1c5a Jean*0342 array(i,j,k,bi,bj) = southRecvBuf_RX(iB,eBl,bi,bj)
92f012330e Alis*0343 ENDDO
0344 ENDDO
0345 ENDDO
0346 ELSEIF ( southCommMode .EQ. COMM_GET ) THEN
4947bd1c5a Jean*0347 DO k=1,myNz
92f012330e Alis*0348 iB = iB0
4947bd1c5a Jean*0349 DO j=jMin,jMax
92f012330e Alis*0350 iB = iB+1
4947bd1c5a Jean*0351 DO i=iMin,iMax
0352 array(i,j,k,bi,bj) = array(i,iB,k,biS,bjS)
92f012330e Alis*0353 ENDDO
0354 ENDDO
0355 ENDDO
0356 ENDIF
0357 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
0358 jMin = 1
0359 jMax = 1+exchWidthY-1
0360 iB0 = sNy
4947bd1c5a Jean*0361 IF ( southCommMode .EQ. COMM_PUT
0362 & .OR. southCommMode .EQ. COMM_MSG ) THEN
92f012330e Alis*0363 iB = 0
4947bd1c5a Jean*0364 DO k=1,myNz
0365 DO j=jMin,jMax
0366 DO i=iMin,iMax
92f012330e Alis*0367 iB = iB + 1
4947bd1c5a Jean*0368 array(i,j,k,bi,bj) =
0369 & array(i,j,k,bi,bj) + southRecvBuf_RX(iB,eBl,bi,bj)
92f012330e Alis*0370 ENDDO
0371 ENDDO
0372 ENDDO
0373 ELSEIF ( southCommMode .EQ. COMM_GET ) THEN
4947bd1c5a Jean*0374 DO k=1,myNz
92f012330e Alis*0375 iB = iB0
4947bd1c5a Jean*0376 DO j=jMin,jMax
92f012330e Alis*0377 iB = iB+1
4947bd1c5a Jean*0378 DO i=iMin,iMax
0379 array(i,j,k,bi,bj) =
0380 & array(i,j,k,bi,bj) + array(i,iB,k,biS,bjS)
0381 array(i,iB,k,biS,bjS) = 0.0
92f012330e Alis*0382 ENDDO
0383 ENDDO
0384 ENDDO
0385 ENDIF
0386 ENDIF
4947bd1c5a Jean*0387
92f012330e Alis*0388 ENDDO
0389 ENDDO
0390
0391 RETURN
0392 END
