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