Warning, /eesupp/src/exch_rx_send_put_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"
0002
4c563c2ee9 Chri*0003 CBOP
0004 C !ROUTINE: EXCH_RX_SEND_PUT_Y
0005
0006 C !INTERFACE:
92f012330e Alis*0007 SUBROUTINE EXCH_RX_SEND_PUT_Y( array,
0008 I myOLw, myOLe, myOLs, myOLn, myNz,
0009 I exchWidthX, exchWidthY,
0010 I thesimulationMode, thecornerMode, myThid )
0011 IMPLICIT NONE
4c563c2ee9 Chri*0012 C !DESCRIPTION:
0013 C *==========================================================*
4947bd1c5a Jean*0014 C | SUBROUTINE SEND_PUT_Y
0015 C | o "Send" or "put" Y edges for RX array.
4c563c2ee9 Chri*0016 C *==========================================================*
4947bd1c5a Jean*0017 C | Routine that invokes actual message passing send or
0018 C | direct "put" of data to update Y faces of an XY[R] array.
4c563c2ee9 Chri*0019 C *==========================================================*
92f012330e Alis*0020
4c563c2ee9 Chri*0021 C !USES:
92f012330e Alis*0022 C == Global variables ==
0023 #include "SIZE.h"
0024 #include "EEPARAMS.h"
0025 #include "EESUPPORT.h"
0026 #include "EXCH.h"
4c563c2ee9 Chri*0027
0028 C !INPUT/OUTPUT PARAMETERS:
92f012330e Alis*0029 C == Routine arguments ==
4c563c2ee9 Chri*0030 C array :: Array with edges to exchange.
0031 C myOLw :: West, East, North and South overlap region sizes.
92f012330e Alis*0032 C myOLe
0033 C myOLn
0034 C myOLs
4c563c2ee9 Chri*0035 C exchWidthX :: Width of data region exchanged.
92f012330e Alis*0036 C exchWidthY
4947bd1c5a Jean*0037 C theSimulationMode :: Forward or reverse mode exchange ( provides
4c563c2ee9 Chri*0038 C support for adjoint integration of code. )
4947bd1c5a Jean*0039 C Note - the reverse mode for an assignment
0040 C is an accumulation. This means that
4c563c2ee9 Chri*0041 C put implementations that do leary things
4947bd1c5a Jean*0042 C like writing to overlap regions in a
4c563c2ee9 Chri*0043 C remote process need to be even more
0044 C careful. You need to be pretty careful
0045 C in forward mode too!
4947bd1c5a Jean*0046 C theCornerMode :: Flag indicating whether corner updates are
4c563c2ee9 Chri*0047 C needed.
0048 C myThid :: Thread number of this instance of S/R EXCH...
0049 C eBl :: Edge buffer level
92f012330e Alis*0050 INTEGER myOLw
0051 INTEGER myOLe
0052 INTEGER myOLs
0053 INTEGER myOLn
0054 INTEGER myNz
0055 _RX array(1-myOLw:sNx+myOLe,
4947bd1c5a Jean*0056 & 1-myOLs:sNy+myOLn,
92f012330e Alis*0057 & myNZ, nSx, nSy)
0058 INTEGER exchWidthX
0059 INTEGER exchWidthY
0060 INTEGER theSimulationMode
0061 INTEGER theCornerMode
0062 INTEGER myThid
0063
4c563c2ee9 Chri*0064 C !LOCAL VARIABLES:
92f012330e Alis*0065 C == Local variables ==
4947bd1c5a Jean*0066 C i, j, k, jMin, jMax, iB - Loop counters and extents
0067 C bi, bj
92f012330e Alis*0068 C biS, bjS - South tile indices
0069 C biN, bjN - North tile indices
0070 C eBl - Current exchange buffer level
0071 C theProc, theTag, theType, - Variables used in message building
0072 C theSize
0073 C southCommMode - Working variables holding type
0074 C northCommMode of communication a particular
0075 C tile face uses.
4947bd1c5a Jean*0076 INTEGER i, j, k, jMin, jMax, iMin, iMax, iB
92f012330e Alis*0077 INTEGER bi, bj, biS, bjS, biN, bjN
0078 INTEGER eBl
0079 INTEGER northCommMode
0080 INTEGER southCommMode
0081 #ifdef ALLOW_USE_MPI
0082 INTEGER theProc, theTag, theType, theSize, mpiRc
0eef504f9b Jean*0083 # ifdef ALLOW_AUTODIFF_OPENAD_AMPI
033dc5d283 Jean*0084 INTEGER mpiStatus(MPI_STATUS_SIZE)
83996e0652 Jean*0085 INTEGER pReqI
033dc5d283 Jean*0086 # endif
92f012330e Alis*0087 #endif
0088
0089 C-- Write data to exchange buffer
4947bd1c5a Jean*0090 C Various actions are possible depending on the communication mode
92f012330e Alis*0091 C as follows:
0092 C Mode Action
0093 C -------- ---------------------------
0094 C COMM_NONE Do nothing
0095 C
0096 C COMM_MSG Message passing communication ( e.g. MPI )
0097 C Fill south send buffer from this tile.
0098 C Send data with tag identifying tile and direction.
0099 C Fill north send buffer from this tile.
0100 C Send data with tag identifying tile and direction.
0101 C
0102 C COMM_PUT "Put" communication ( UMP_, shmemput, etc... )
0103 C Fill south receive buffer of south-neighbor tile
0104 C Fill north receive buffer of north-neighbor tile
0105 C Sync. memory
0106 C Write data-ready Ack for north edge of south-neighbor
0107 C tile
0108 C Write data-ready Ack for south edge of north-neighbor
0109 C tile
0110 C Sync. memory
4c563c2ee9 Chri*0111 CEOP
0112
0eef504f9b Jean*0113 #ifdef ALLOW_AUTODIFF_OPENAD_AMPI
033dc5d283 Jean*0114 # ifdef ALLOW_USE_MPI
4947bd1c5a Jean*0115 IF ( usingMPI ) THEN
0116 _BEGIN_MASTER(myThid)
0117 DO bj=1,nSy
0118 DO bi=1,nSx
0119 CALL ampi_awaitall (
0120 & exchNReqsY(1,bi,bj) ,
0121 & exchReqIdY(1,1,bi,bj) ,
0122 & mpiStatus ,
0123 & mpiRC )
0124 ENDDO
0125 ENDDO
0126 _END_MASTER(myThid)
0127 ENDIF
033dc5d283 Jean*0128 # endif
0129 #endif
0130
4947bd1c5a Jean*0131 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0132
0133 C Prevent anyone to access shared buffer while an other thread modifies it
0134 _BARRIER
0135
0136 C Fill shared buffers from array values
92f012330e Alis*0137 DO bj=myByLo(myThid),myByHi(myThid)
0138 DO bi=myBxLo(myThid),myBxHi(myThid)
0139
4947bd1c5a Jean*0140 eBl = exchangeBufLevel(1,bi,bj)
0141 southCommMode = _tileCommModeS(bi,bj)
0142 northCommMode = _tileCommModeN(bi,bj)
0143 biS = _tileBiS(bi,bj)
0144 bjS = _tileBjS(bi,bj)
0145 biN = _tileBiN(bi,bj)
0146 bjN = _tileBjN(bi,bj)
92f012330e Alis*0147 iMin = 1
0148 iMax = sNx
0149 IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
0150 iMin = 1-exchWidthX
0151 iMax = sNx+exchWidthX
0152 ENDIF
0153
4947bd1c5a Jean*0154 C >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
92f012330e Alis*0155
4947bd1c5a Jean*0156 IF ( _theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
92f012330e Alis*0157
0158 C o Send or Put south edge
0159 jMin = 1
0160 jMax = 1+exchWidthY-1
4947bd1c5a Jean*0161 IF ( southCommMode .EQ. COMM_MSG ) THEN
0162 iB = 0
0163 DO k=1,myNz
0164 DO j=jMin,jMax
0165 DO i=iMin,iMax
0166 iB = iB + 1
0167 southSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
0168 ENDDO
92f012330e Alis*0169 ENDDO
0170 ENDDO
4947bd1c5a Jean*0171 ELSEIF ( southCommMode .EQ. COMM_PUT ) THEN
0172 iB = 0
0173 DO k=1,myNz
0174 DO j=jMin,jMax
0175 DO i=iMin,iMax
0176 iB = iB + 1
0177 northRecvBuf_RX(iB,eBl,biS,bjS) = array(i,j,k,bi,bj)
0178 ENDDO
92f012330e Alis*0179 ENDDO
0180 ENDDO
4947bd1c5a Jean*0181 ELSEIF ( southCommMode .NE. COMM_NONE
0182 & .AND. southCommMode .NE. COMM_GET ) THEN
0183 STOP ' S/R EXCH: Invalid commS mode.'
0184 ENDIF
92f012330e Alis*0185
0186 C o Send or Put north edge
0187 jMin = sNy-exchWidthY+1
0188 jMax = sNy
4947bd1c5a Jean*0189 IF ( northCommMode .EQ. COMM_MSG ) THEN
0190 iB = 0
0191 DO k=1,myNz
0192 DO j=jMin,jMax
0193 DO i=iMin,iMax
0194 iB = iB + 1
0195 northSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
0196 ENDDO
92f012330e Alis*0197 ENDDO
0198 ENDDO
0199 ELSEIF ( northCommMode .EQ. COMM_PUT ) THEN
0200 iB = 0
4947bd1c5a Jean*0201 DO k=1,myNz
0202 DO j=jMin,jMax
0203 DO i=iMin,iMax
92f012330e Alis*0204 iB = iB + 1
4947bd1c5a Jean*0205 southRecvBuf_RX(iB,eBl,biN,bjN) = array(i,j,k,bi,bj)
92f012330e Alis*0206 ENDDO
0207 ENDDO
0208 ENDDO
0209 ELSEIF ( northCommMode .NE. COMM_NONE
0210 & .AND. northCommMode .NE. COMM_GET ) THEN
0211 STOP ' S/R EXCH: Invalid commN mode.'
0212 ENDIF
0213
4947bd1c5a Jean*0214 C >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
92f012330e Alis*0215
0216 ELSEIF ( _theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
4947bd1c5a Jean*0217
0218 C o Send or Put south edge
92f012330e Alis*0219 jMin = 1-exchWidthY
0220 jMax = 0
4947bd1c5a Jean*0221 IF ( southCommMode .EQ. COMM_MSG ) THEN
0222 iB = 0
0223 DO k=1,myNz
0224 DO j=jMin,jMax
0225 DO i=iMin,iMax
0226 iB = iB + 1
0227 southSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
0228 array(i,j,k,bi,bj) = 0.0
0229 ENDDO
92f012330e Alis*0230 ENDDO
0231 ENDDO
4947bd1c5a Jean*0232 ELSEIF ( southCommMode .EQ. COMM_PUT ) THEN
0233 iB = 0
0234 DO k=1,myNz
0235 DO j=jMin,jMax
0236 DO i=iMin,iMax
0237 iB = iB + 1
0238 northRecvBuf_RX(iB,eBl,biS,bjS) = array(i,j,k,bi,bj)
0239 array(i,j,k,bi,bj) = 0.0
0240 ENDDO
92f012330e Alis*0241 ENDDO
0242 ENDDO
4947bd1c5a Jean*0243 ELSEIF ( southCommMode .NE. COMM_NONE
0244 & .AND. southCommMode .NE. COMM_GET ) THEN
0245 STOP ' S/R EXCH: Invalid commS mode.'
0246 ENDIF
92f012330e Alis*0247
0248 C o Send or Put north edge
0249 jMin = sNy+1
0250 jMax = sNy+exchWidthY
4947bd1c5a Jean*0251 IF ( northCommMode .EQ. COMM_MSG ) THEN
0252 iB = 0
0253 DO k=1,myNz
0254 DO j=jMin,jMax
0255 DO i=iMin,iMax
0256 iB = iB + 1
0257 northSendBuf_RX(iB,eBl,bi,bj) = array(i,j,k,bi,bj)
0258 array(i,j,k,bi,bj) = 0.0
0259 ENDDO
92f012330e Alis*0260 ENDDO
0261 ENDDO
4947bd1c5a Jean*0262 ELSEIF ( northCommMode .EQ. COMM_PUT ) THEN
0263 iB = 0
0264 DO k=1,myNz
0265 DO j=jMin,jMax
0266 DO i=iMin,iMax
0267 iB = iB + 1
0268 southRecvBuf_RX(iB,eBl,biN,bjN) = array(i,j,k,bi,bj)
0269 array(i,j,k,bi,bj) = 0.0
0270 ENDDO
92f012330e Alis*0271 ENDDO
0272 ENDDO
4947bd1c5a Jean*0273 ELSEIF ( northCommMode .NE. COMM_NONE
0274 & .AND. northCommMode .NE. COMM_GET ) THEN
0275 STOP ' S/R EXCH: Invalid commN mode.'
0276 ENDIF
0277
92f012330e Alis*0278 ENDIF
4947bd1c5a Jean*0279
92f012330e Alis*0280 ENDDO
0281 ENDDO
0282
4947bd1c5a Jean*0283 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
92f012330e Alis*0284 C-- Signal completetion ( making sure system-wide memory state is
0285 C-- consistent ).
0286
0287 C ** NOTE ** We are relying on being able to produce strong-ordered
0288 C memory semantics here. In other words we assume that there is a
0289 C mechanism which can ensure that by the time the Ack is seen the
0290 C overlap region data that will be exchanged is up to date.
0291 IF ( exchNeedsMemSync ) CALL MEMSYNC
0292
0293 DO bj=myByLo(myThid),myByHi(myThid)
0294 DO bi=myBxLo(myThid),myBxHi(myThid)
4947bd1c5a Jean*0295 eBl = exchangeBufLevel(1,bi,bj)
92f012330e Alis*0296 biS = _tileBiS(bi,bj)
0297 bjS = _tileBjS(bi,bj)
0298 biN = _tileBiN(bi,bj)
0299 bjN = _tileBjN(bi,bj)
0300 southCommMode = _tileCommModeS(bi,bj)
0301 northCommMode = _tileCommModeN(bi,bj)
01f26df47c Jean*0302 IF ( southCommMode.EQ.COMM_PUT ) northRecvAck(eBl,biS,bjS) = 1
0303 IF ( northCommMode.EQ.COMM_PUT ) southRecvAck(eBl,biN,bjN) = 1
0304 IF ( southCommMode.EQ.COMM_GET ) northRecvAck(eBl,biS,bjS) = 1
0305 IF ( northCommMode.EQ.COMM_GET ) southRecvAck(eBl,biN,bjN) = 1
92f012330e Alis*0306 ENDDO
0307 ENDDO
0308
0309 C-- Make sure "ack" setting is seen system-wide.
0310 C Here strong-ordering is not an issue but we want to make
0311 C sure that processes that might spin on the above Ack settings
0312 C will see the setting.
0313 C ** NOTE ** On some machines we wont spin on the Ack setting
0314 C ( particularly the T90 ), instead we will use s system barrier.
4947bd1c5a Jean*0315 C On the T90 the system barrier is very fast and switches out the
92f012330e Alis*0316 C thread while it waits. On most machines the system barrier
0317 C is much too slow and if we own the machine and have one thread
0318 C per process preemption is not a problem.
0319 IF ( exchNeedsMemSync ) CALL MEMSYNC
0320
4947bd1c5a Jean*0321 C Wait until all threads finish filling buffer
8e7b8dcb06 Chri*0322 _BARRIER
05c61d4346 Chri*0323
4947bd1c5a Jean*0324 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0325
0326 #ifdef ALLOW_USE_MPI
0327 IF ( usingMPI ) THEN
0328 C-- Send buffer data: Only Master Thread do proc communication
0329 _BEGIN_MASTER(myThid)
0330
0331 DO bj=1,nSy
0332 DO bi=1,nSx
0333
0334 eBl = exchangeBufLevel(1,bi,bj)
0335 southCommMode = _tileCommModeS(bi,bj)
0336 northCommMode = _tileCommModeN(bi,bj)
0337 biS = _tileBiS(bi,bj)
0338 bjS = _tileBjS(bi,bj)
0339 biN = _tileBiN(bi,bj)
0340 bjN = _tileBjN(bi,bj)
0341 theType = _MPI_TYPE_RX
0342 theSize = sNx*exchWidthY*myNz
0343 IF ( theCornerMode .EQ. EXCH_UPDATE_CORNERS ) THEN
0344 theSize = (sNx+2*exchWidthX)*exchWidthY*myNz
0345 ENDIF
0346
0347 IF ( southCommMode .EQ. COMM_MSG ) THEN
0348 C Send buffer data (copied from south edge)
0349 theProc = tilePidS(bi,bj)
0350 theTag = _tileTagSendS(bi,bj)
0351 # ifndef ALLOW_AUTODIFF_OPENAD_AMPI
0352 exchNreqsY(1,bi,bj) = exchNreqsY(1,bi,bj)+1
0353 CALL MPI_Isend( southSendBuf_RX(1,eBl,bi,bj), theSize,
0354 & theType, theProc, theTag, MPI_COMM_MODEL,
0355 & exchReqIdY(exchNreqsY(1,bi,bj),1,bi,bj),
0356 & mpiRc )
0357 # else
0358 pReqI=exchNReqsY(1,bi,bj)+1
0359 CALL ampi_isend_RX(
0360 & southSendBuf_RX(1,eBl,bi,bj),
0361 & theSize,
0362 & theType,
0363 & theProc,
0364 & theTag,
0365 & MPI_COMM_MODEL,
0366 & exchReqIdY(pReqI,1,bi,bj),
0367 & exchNReqsY(1,bi,bj),
0368 & mpiStatus,
0369 & mpiRc )
0370 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
0371 c northRecvAck(eBl,biS,bjS) = 1
0372 ENDIF
0373
0374 IF ( northCommMode .EQ. COMM_MSG ) THEN
0375 C Send buffer data (copied from north edge)
0376 theProc = tilePidN(bi,bj)
0377 theTag = _tileTagSendN(bi,bj)
0378 #ifndef ALLOW_AUTODIFF_OPENAD_AMPI
0379 exchNreqsY(1,bi,bj) = exchNreqsY(1,bi,bj)+1
0380 CALL MPI_Isend( northSendBuf_RX(1,eBl,bi,bj), theSize,
0381 & theType, theProc, theTag, MPI_COMM_MODEL,
0382 & exchReqIdY(exchNreqsY(1,bi,bj),1,bi,bj),
0383 & mpiRc )
0384 # else
0385 pReqI=exchNReqsY(1,bi,bj)+1
0386 CALL ampi_isend_RX(
0387 & northSendBuf_RX(1,eBl,bi,bj) ,
0388 & theSize ,
0389 & theType ,
0390 & theProc ,
0391 & theTag ,
0392 & MPI_COMM_MODEL ,
0393 & exchReqIdY(pReqI,1,bi,bj) ,
0394 & exchNReqsY(1,bi,bj) ,
0395 & mpiStatus ,
0396 & mpiRc )
0397 # endif /* ALLOW_AUTODIFF_OPENAD_AMPI */
0398 c southRecvAck(eBl,biN,bjN) = 1
0399 ENDIF
0400
0401 ENDDO
0402 ENDDO
0403
0404 _END_MASTER(myThid)
0405
0406 ENDIF
0407 #endif /* ALLOW_USE_MPI */
0408
0409 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0410
0411 RETURN
92f012330e Alis*0412 END
