Warning, /eesupp/src/exch_rx_recv_get_x.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_X
0006
0007 C !INTERFACE:
92f012330e Alis*0008 SUBROUTINE EXCH_RX_RECV_GET_X( 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_RX_GET_X
0017 C | o "Send" or "put" X 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
92f012330e Alis*0040 C support for adjoint integration of code. )
4c563c2ee9 Chri*0041 C theCornerMode :: Flag indicating whether corner updates are
92f012330e Alis*0042 C needed.
4c563c2ee9 Chri*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 biW, bjW :: West tile indices
0064 C biE, bjE :: East 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 westCommMode :: Working variables holding type
0069 C eastCommMode of communication a particular
0070 C tile face uses.
4947bd1c5a Jean*0071 INTEGER i, j, k, iMin, iMax, iB, iB0
92f012330e Alis*0072 INTEGER bi, bj, biW, bjW, biE, bjE
0073 INTEGER eBl
0074 INTEGER westCommMode
0075 INTEGER eastCommMode
4947bd1c5a Jean*0076 #ifdef EXCH_USE_SPINNING
92f012330e Alis*0077 INTEGER spinCount
4947bd1c5a Jean*0078 #endif
92f012330e Alis*0079 #ifdef ALLOW_USE_MPI
19765ceae9 Jean*0080 INTEGER theProc, theTag, theType, theSize
92f012330e Alis*0081 INTEGER mpiStatus(MPI_STATUS_SIZE,4), mpiRc
19765ceae9 Jean*0082 # ifdef ALLOW_AUTODIFF_OPENAD_AMPI
0083 INTEGER pReqI
0084 # endif
0085 #endif /* ALLOW_USE_MPI */
4c563c2ee9 Chri*0086 CEOP
92f012330e Alis*0087
4947bd1c5a Jean*0088 C-- Under a "put" scenario we
92f012330e Alis*0089 C-- i. set completetion signal for buffer we put into.
4947bd1c5a Jean*0090 C-- ii. wait for completetion signal indicating data has been put in
92f012330e Alis*0091 C-- our buffer.
0092 C-- Under a messaging mode we "receive" the message.
0093 C-- Under a "get" scenario we
0094 C-- i. Check that the data is ready.
0095 C-- ii. Read the data.
0096 C-- iii. Set data read flag + memory sync.
0097
0098 #ifdef ALLOW_USE_MPI
4947bd1c5a Jean*0099 IF ( usingMPI ) THEN
19765ceae9 Jean*0100
4947bd1c5a Jean*0101 C-- Receive buffer data: Only Master Thread do proc communication
0102 _BEGIN_MASTER(myThid)
0103
0104 DO bj=1,nSy
0105 DO bi=1,nSx
0106 eBl = exchangeBufLevel(1,bi,bj)
0107 westCommMode = _tileCommModeW(bi,bj)
0108 eastCommMode = _tileCommModeE(bi,bj)
0109 biE = _tileBiE(bi,bj)
0110 bjE = _tileBjE(bi,bj)
0111 biW = _tileBiW(bi,bj)
0112 bjW = _tileBjW(bi,bj)
0113 theType = _MPI_TYPE_RX
0114 theSize = sNy*exchWidthX*myNz
0115
0116 IF ( westCommMode .EQ. COMM_MSG ) THEN
92f012330e Alis*0117 theProc = tilePidW(bi,bj)
0118 theTag = _tileTagRecvW(bi,bj)
0eef504f9b Jean*0119 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
4947bd1c5a Jean*0120 CALL MPI_Recv( westRecvBuf_RX(1,eBl,bi,bj), theSize,
0121 & theType, theProc, theTag, MPI_COMM_MODEL,
92f012330e Alis*0122 & mpiStatus, mpiRc )
033dc5d283 Jean*0123 # else
4d40368441 Jean*0124 pReqI=exchNReqsX(1,bi,bj)+1
4947bd1c5a Jean*0125 CALL ampi_recv_RX(
0126 & westRecvBuf_RX(1,eBl,bi,bj) ,
0127 & theSize ,
0128 & theType ,
0129 & theProc ,
0130 & theTag ,
0131 & MPI_COMM_MODEL ,
0132 & exchReqIdX(pReqI,1,bi,bj),
0133 & exchNReqsX(1,bi,bj),
0134 & mpiStatus ,
0135 & mpiRc )
0eef504f9b Jean*0136 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
4947bd1c5a Jean*0137 westRecvAck(eBl,bi,bj) = 1
92f012330e Alis*0138 ENDIF
4947bd1c5a Jean*0139
92f012330e Alis*0140 IF ( eastCommMode .EQ. COMM_MSG ) THEN
0141 theProc = tilePidE(bi,bj)
0142 theTag = _tileTagRecvE(bi,bj)
0eef504f9b Jean*0143 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
4947bd1c5a Jean*0144 CALL MPI_Recv( eastRecvBuf_RX(1,eBl,bi,bj), theSize,
0145 & theType, theProc, theTag, MPI_COMM_MODEL,
92f012330e Alis*0146 & mpiStatus, mpiRc )
033dc5d283 Jean*0147 # else
4d40368441 Jean*0148 pReqI=exchNReqsX(1,bi,bj)+1
4947bd1c5a Jean*0149 CALL ampi_recv_RX(
0150 & eastRecvBuf_RX(1,eBl,bi,bj) ,
0151 & theSize ,
0152 & theType ,
0153 & theProc ,
0154 & theTag ,
0155 & MPI_COMM_MODEL ,
0156 & exchReqIdX(pReqI,1,bi,bj),
0157 & exchNReqsX(1,bi,bj),
0158 & mpiStatus ,
0159 & mpiRc )
0eef504f9b Jean*0160 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
4947bd1c5a Jean*0161 eastRecvAck(eBl,bi,bj) = 1
92f012330e Alis*0162 ENDIF
0163 ENDDO
0164 ENDDO
0165
4947bd1c5a Jean*0166 C-- Processes wait for buffers I am going to read to be ready.
0167 IF ( .NOT.exchUsesBarrier ) THEN
0168 DO bj=1,nSy
0169 DO bi=1,nSx
0170 IF ( exchNReqsX(1,bi,bj) .GT. 0 ) THEN
0171 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
0172 CALL MPI_Waitall( exchNReqsX(1,bi,bj), exchReqIdX(1,1,bi,bj),
0173 & mpiStatus, mpiRC )
0174 # else
0175 CALL ampi_waitall(
0176 & exchNReqsX(1,bi,bj),
0177 & exchReqIdX(1,1,bi,bj),
0178 & mpiStatus,
0179 & mpiRC )
0180 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
0181 ENDIF
0182 C Clear outstanding requests counter
0183 exchNReqsX(1,bi,bj) = 0
0184 ENDDO
0185 ENDDO
0186 ENDIF
0187
0188 _END_MASTER(myThid)
0189 C-- need to sync threads after master has received data ;
0190 C (done after mpi waitall in case waitall is really needed)
0191 _BARRIER
0192
0193 ENDIF
0194 #endif /* ALLOW_USE_MPI */
19765ceae9 Jean*0195
4947bd1c5a Jean*0196 C-- Threads wait for buffers I am going to read to be ready.
0197 C note: added BARRIER in exch_send_put S/R and here above (message mode)
0198 C so that we no longer needs this (undef EXCH_USE_SPINNING)
0199 #ifdef EXCH_USE_SPINNING
92f012330e Alis*0200 IF ( exchUsesBarrier ) THEN
0201 C o On some machines ( T90 ) use system barrier rather than spinning.
0202 CALL BARRIER( myThid )
0203 ELSE
0204 C o Spin waiting for completetion flag. This avoids a global-lock
0205 C i.e. we only lock waiting for data that we need.
0206 DO bj=myByLo(myThid),myByHi(myThid)
0207 DO bi=myBxLo(myThid),myBxHi(myThid)
4947bd1c5a Jean*0208
92f012330e Alis*0209 spinCount = 0
4947bd1c5a Jean*0210 eBl = exchangeBufLevel(1,bi,bj)
92f012330e Alis*0211 westCommMode = _tileCommModeW(bi,bj)
0212 eastCommMode = _tileCommModeE(bi,bj)
0eef504f9b Jean*0213 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
92f012330e Alis*0214 10 CONTINUE
e78c04eec8 Jean*0215 CALL FOOL_THE_COMPILER( spinCount )
92f012330e Alis*0216 spinCount = spinCount+1
0217 C IF ( myThid .EQ. 1 .AND. spinCount .GT. _EXCH_SPIN_LIMIT ) THEN
0218 C WRITE(*,*) ' eBl = ', ebl
0219 C STOP ' S/R EXCH_RECV_GET_X: spinCount .GT. _EXCH_SPIN_LIMIT'
0220 C ENDIF
061bed00a3 Jean*0221 IF ( westRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
0222 IF ( eastRecvAck(eBl,bi,bj) .EQ. 0 ) GOTO 10
4947bd1c5a Jean*0223 # else
0224 DO WHILE ((westRecvAck(eBl,bi,bj) .EQ. 0
0225 & .OR.
0226 & eastRecvAck(eBl,bi,bj) .EQ. 0 ))
033dc5d283 Jean*0227 CALL FOOL_THE_COMPILER( spinCount )
0228 spinCount = spinCount+1
4947bd1c5a Jean*0229 ENDDO
0eef504f9b Jean*0230 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
92f012330e Alis*0231 C Clear outstanding requests
061bed00a3 Jean*0232 westRecvAck(eBl,bi,bj) = 0
0233 eastRecvAck(eBl,bi,bj) = 0
92f012330e Alis*0234 C Update statistics
0235 IF ( exchCollectStatistics ) THEN
0236 exchRecvXExchCount(1,bi,bj) = exchRecvXExchCount(1,bi,bj)+1
4947bd1c5a Jean*0237 exchRecvXSpinCount(1,bi,bj) =
92f012330e Alis*0238 & exchRecvXSpinCount(1,bi,bj)+spinCount
4947bd1c5a Jean*0239 exchRecvXSpinMax(1,bi,bj) =
92f012330e Alis*0240 & MAX(exchRecvXSpinMax(1,bi,bj),spinCount)
4947bd1c5a Jean*0241 exchRecvXSpinMin(1,bi,bj) =
92f012330e Alis*0242 & MIN(exchRecvXSpinMin(1,bi,bj),spinCount)
0243 ENDIF
4947bd1c5a Jean*0244
92f012330e Alis*0245 ENDDO
0246 ENDDO
0247 ENDIF
4947bd1c5a Jean*0248 #endif /* EXCH_USE_SPINNING */
0249
0250 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
92f012330e Alis*0251
0252 C-- Read from the buffers
0253 DO bj=myByLo(myThid),myByHi(myThid)
0254 DO bi=myBxLo(myThid),myBxHi(myThid)
0255
4947bd1c5a Jean*0256 eBl = exchangeBufLevel(1,bi,bj)
0257 biE = _tileBiE(bi,bj)
0258 bjE = _tileBjE(bi,bj)
0259 biW = _tileBiW(bi,bj)
0260 bjW = _tileBjW(bi,bj)
92f012330e Alis*0261 westCommMode = _tileCommModeW(bi,bj)
0262 eastCommMode = _tileCommModeE(bi,bj)
4947bd1c5a Jean*0263
92f012330e Alis*0264 IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
0265 iMin = sNx+1
0266 iMax = sNx+exchWidthX
0267 iB0 = 0
0268 IF ( eastCommMode .EQ. COMM_PUT
0269 & .OR. eastCommMode .EQ. COMM_MSG ) THEN
0270 iB = 0
4947bd1c5a Jean*0271 DO k=1,myNz
0272 DO j=1,sNy
0273 DO i=iMin,iMax
92f012330e Alis*0274 iB = iB + 1
4947bd1c5a Jean*0275 array(i,j,k,bi,bj) = eastRecvBuf_RX(iB,eBl,bi,bj)
92f012330e Alis*0276 ENDDO
0277 ENDDO
0278 ENDDO
0279 ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
4947bd1c5a Jean*0280 DO k=1,myNz
0281 DO j=1,sNy
92f012330e Alis*0282 iB = iB0
4947bd1c5a Jean*0283 DO i=iMin,iMax
92f012330e Alis*0284 iB = iB+1
4947bd1c5a Jean*0285 array(i,j,k,bi,bj) = array(iB,j,k,biE,bjE)
92f012330e Alis*0286 ENDDO
0287 ENDDO
0288 ENDDO
0289 ENDIF
0290 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
0291 iMin = sNx-exchWidthX+1
0292 iMax = sNx
0293 iB0 = 1-exchWidthX-1
4947bd1c5a Jean*0294 IF ( eastCommMode .EQ. COMM_PUT
92f012330e Alis*0295 & .OR. eastCommMode .EQ. COMM_MSG ) THEN
0296 iB = 0
4947bd1c5a Jean*0297 DO k=1,myNz
0298 DO j=1,sNy
0299 DO i=iMin,iMax
92f012330e Alis*0300 iB = iB + 1
4947bd1c5a Jean*0301 array(i,j,k,bi,bj) =
0302 & array(i,j,k,bi,bj) + eastRecvBuf_RX(iB,eBl,bi,bj)
92f012330e Alis*0303 ENDDO
0304 ENDDO
0305 ENDDO
0306 ELSEIF ( eastCommMode .EQ. COMM_GET ) THEN
4947bd1c5a Jean*0307 DO k=1,myNz
0308 DO j=1,sNy
92f012330e Alis*0309 iB = iB0
4947bd1c5a Jean*0310 DO i=iMin,iMax
92f012330e Alis*0311 iB = iB+1
4947bd1c5a Jean*0312 array(i,j,k,bi,bj) =
0313 & array(i,j,k,bi,bj) + array(iB,j,k,biE,bjE)
0314 array(iB,j,k,biE,bjE) = 0.0
92f012330e Alis*0315 ENDDO
0316 ENDDO
0317 ENDDO
0318 ENDIF
0319 ENDIF
4947bd1c5a Jean*0320
92f012330e Alis*0321 IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
0322 iMin = 1-exchWidthX
0323 iMax = 0
0324 iB0 = sNx-exchWidthX
0325 IF ( westCommMode .EQ. COMM_PUT
0326 & .OR. westCommMode .EQ. COMM_MSG ) THEN
0327 iB = 0
4947bd1c5a Jean*0328 DO k=1,myNz
0329 DO j=1,sNy
0330 DO i=iMin,iMax
92f012330e Alis*0331 iB = iB + 1
4947bd1c5a Jean*0332 array(i,j,k,bi,bj) = westRecvBuf_RX(iB,eBl,bi,bj)
92f012330e Alis*0333 ENDDO
0334 ENDDO
0335 ENDDO
0336 ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
4947bd1c5a Jean*0337 DO k=1,myNz
0338 DO j=1,sNy
92f012330e Alis*0339 iB = iB0
4947bd1c5a Jean*0340 DO i=iMin,iMax
92f012330e Alis*0341 iB = iB+1
4947bd1c5a Jean*0342 array(i,j,k,bi,bj) = array(iB,j,k,biW,bjW)
92f012330e Alis*0343 ENDDO
0344 ENDDO
0345 ENDDO
0346 ENDIF
0347 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
0348 iMin = 1
0349 iMax = 1+exchWidthX-1
0350 iB0 = sNx
4947bd1c5a Jean*0351 IF ( westCommMode .EQ. COMM_PUT
0352 & .OR. westCommMode .EQ. COMM_MSG ) THEN
92f012330e Alis*0353 iB = 0
4947bd1c5a Jean*0354 DO k=1,myNz
0355 DO j=1,sNy
0356 DO i=iMin,iMax
92f012330e Alis*0357 iB = iB + 1
4947bd1c5a Jean*0358 array(i,j,k,bi,bj) =
0359 & array(i,j,k,bi,bj) + westRecvBuf_RX(iB,eBl,bi,bj)
92f012330e Alis*0360 ENDDO
0361 ENDDO
0362 ENDDO
0363 ELSEIF ( westCommMode .EQ. COMM_GET ) THEN
4947bd1c5a Jean*0364 DO k=1,myNz
0365 DO j=1,sNy
92f012330e Alis*0366 iB = iB0
4947bd1c5a Jean*0367 DO i=iMin,iMax
92f012330e Alis*0368 iB = iB+1
4947bd1c5a Jean*0369 array(i,j,k,bi,bj) =
0370 & array(i,j,k,bi,bj) + array(iB,j,k,biW,bjW)
0371 array(iB,j,k,biW,bjW) = 0.0
92f012330e Alis*0372 ENDDO
0373 ENDDO
0374 ENDDO
0375 ENDIF
0376 ENDIF
0377
0378 ENDDO
0379 ENDDO
0380
0381 RETURN
0382 END
