Warning, /pkg/exch2/exch2_rx2_cube.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
046fd16d1c Andr*0001 #include "CPP_EEOPTIONS.h"
10972e8712 Jean*0002 #undef LOCAL_DBUG
046fd16d1c Andr*0003
0004 CBOP
0005 C !ROUTINE: EXCH_RX2_CUBE
0006
0007 C !INTERFACE:
9b79698769 Jean*0008 SUBROUTINE EXCH2_RX2_CUBE(
54d78f5995 Jean*0009 U array1, array2,
0010 I signOption, fieldCode,
3371b2be58 Jean*0011 I myOLw, myOLe, myOLs, myOLn, myNz,
046fd16d1c Andr*0012 I exchWidthX, exchWidthY,
8bc539472e Jean*0013 I cornerMode, myThid )
046fd16d1c Andr*0014
0015 C !DESCRIPTION:
54d78f5995 Jean*0016 C Two components vector field Exchange:
0017 C Fill-in tile-edge overlap-region of a 2 component vector field
0018 C with corresponding near-edge interior data point
046fd16d1c Andr*0019
0020 C !USES:
54d78f5995 Jean*0021 IMPLICIT NONE
0022
046fd16d1c Andr*0023 C == Global data ==
0024 #include "SIZE.h"
0025 #include "EEPARAMS.h"
0026 #include "EESUPPORT.h"
90219e5912 Jean*0027 #include "W2_EXCH2_SIZE.h"
046fd16d1c Andr*0028 #include "W2_EXCH2_TOPOLOGY.h"
90219e5912 Jean*0029 #include "W2_EXCH2_BUFFER.h"
046fd16d1c Andr*0030
0031 C !INPUT/OUTPUT PARAMETERS:
54d78f5995 Jean*0032 C array1 :: 1rst component array with edges to exchange.
0033 C array2 :: 2nd component array with edges to exchange.
0034 C signOption :: Flag controlling whether vector is signed.
0035 C fieldCode :: field code (position on staggered grid)
0036 C myOLw,myOLe :: West and East overlap region sizes.
3371b2be58 Jean*0037 C myOLs,myOLn :: South and North overlap region sizes.
54d78f5995 Jean*0038 C exchWidthX :: Width of data region exchanged in X.
0039 C exchWidthY :: Width of data region exchanged in Y.
0040 C cornerMode :: halo-corner-region treatment: update/ignore corner region
0041 C myThid :: Thread number of this instance of S/R EXCH...
0042
3371b2be58 Jean*0043 INTEGER myOLw, myOLe, myOLs, myOLn, myNz
046fd16d1c Andr*0044 _RX array1(1-myOLw:sNx+myOLe,
9b79698769 Jean*0045 & 1-myOLs:sNy+myOLn,
10972e8712 Jean*0046 & myNz, nSx, nSy)
046fd16d1c Andr*0047 _RX array2(1-myOLw:sNx+myOLe,
9b79698769 Jean*0048 & 1-myOLs:sNy+myOLn,
10972e8712 Jean*0049 & myNz, nSx, nSy)
54d78f5995 Jean*0050 LOGICAL signOption
0051 CHARACTER*2 fieldCode
0052 INTEGER exchWidthX
0053 INTEGER exchWidthY
0054 INTEGER cornerMode
0055 INTEGER myThid
046fd16d1c Andr*0056
0057 C !LOCAL VARIABLES:
54d78f5995 Jean*0058 C e2_msgHandles :: Synchronization and coordination data structure used to
0059 C :: coordinate access to e2Bufr1_RX or to regulate message
0060 C :: buffering. In PUT communication sender will increment
0061 C :: handle entry once data is ready in buffer. Receiver will
0062 C :: decrement handle once data is consumed from buffer.
d6ea3164dc Jean*0063 C :: For MPI MSG communication MPI_Wait uses handle to check
54d78f5995 Jean*0064 C :: Isend has cleared. This is done in routine after receives.
0065 C note: a) current implementation does not use e2_msgHandles for communication
0066 C between threads: all-threads barriers are used (see CNH note below).
0067 C For a 2-threads synchro communication (future version),
0068 C e2_msgHandles should be shared (in common block, moved to BUFFER.h)
0069 INTEGER bi, bj
046fd16d1c Andr*0070 C Variables for working through W2 topology
54d78f5995 Jean*0071 INTEGER e2_msgHandles( 2, W2_maxNeighbours, nSx, nSy )
046fd16d1c Andr*0072 INTEGER thisTile, farTile, N, nN, oN
10972e8712 Jean*0073 INTEGER tIlo1, tIhi1, tJlo1, tJhi1, oIs1, oJs1
0074 INTEGER tIlo2, tIhi2, tJlo2, tJhi2, oIs2, oJs2
0075 INTEGER tIStride, tJStride
0076 INTEGER tKlo, tKhi, tKStride
046fd16d1c Andr*0077 INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
0078 INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
b475142410 Jean*0079 LOGICAL updateCorners
046fd16d1c Andr*0080
0081 #ifdef ALLOW_USE_MPI
54d78f5995 Jean*0082 INTEGER iBufr1, iBufr2, nri, nrj
0083 C MPI stuff (should be in a routine call)
046fd16d1c Andr*0084 INTEGER mpiStatus(MPI_STATUS_SIZE)
0085 INTEGER mpiRc
0086 INTEGER wHandle
026642cc3c Jean*0087 #endif
046fd16d1c Andr*0088 CEOP
0089
b475142410 Jean*0090 updateCorners = cornerMode .EQ. EXCH_UPDATE_CORNERS
54d78f5995 Jean*0091 C- Tile size of arrays to exchange:
0092 i1Lo = 1-myOLw
0093 i1Hi = sNx+myOLe
0094 j1Lo = 1-myOLs
0095 j1Hi = sNy+myOLn
0096 k1Lo = 1
0097 k1Hi = myNz
0098 i2Lo = 1-myOLw
0099 i2Hi = sNx+myOLe
0100 j2Lo = 1-myOLs
0101 j2Hi = sNy+myOLn
0102 k2Lo = 1
0103 k2Hi = myNz
046fd16d1c Andr*0104
54d78f5995 Jean*0105 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0106
e79836c793 Jean*0107 C Prevent anyone to access shared buffer while an other thread modifies it
0108 CALL BAR2( myThid )
0109
54d78f5995 Jean*0110 C-- Post sends into buffer (buffer level 1):
0111 DO bj=myByLo(myThid), myByHi(myThid)
0112 DO bi=myBxLo(myThid), myBxHi(myThid)
8adbfea2f8 Jean*0113 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0114 nN=exch2_nNeighbours(thisTile)
0115 DO N=1,nN
0116 farTile=exch2_neighbourId(N,thisTile)
0117 oN = exch2_opposingSend(N,thisTile)
10972e8712 Jean*0118 #ifdef LOCAL_DBUG
8adbfea2f8 Jean*0119 WRITE(errorMessageUnit,'(A,3I3,A,4I4,A,2I5)')
0120 & 'send_0 bi,N=', bi,bj, N, ' , tI,J_lo,hi=',
54d78f5995 Jean*0121 & exch2_iLo(oN,farTile), exch2_iHi(oN,farTile),
0122 & exch2_jLo(oN,farTile), exch2_jHi(oN,farTile),
0123 & ' , oIs,oJs=', exch2_oi(N,thisTile), exch2_oj(N,thisTile)
10972e8712 Jean*0124 #endif
54d78f5995 Jean*0125 CALL EXCH2_GET_UV_BOUNDS(
b475142410 Jean*0126 I fieldCode, exchWidthX, updateCorners,
54d78f5995 Jean*0127 I farTile, oN,
0128 O tIlo1, tIhi1, tJlo1, tJhi1,
0129 O tIlo2, tIhi2, tJlo2, tJhi2,
0130 O tiStride, tjStride,
0131 O oIs1, oJs1, oIs2, oJs2,
0132 I myThid )
10972e8712 Jean*0133 #ifdef LOCAL_DBUG
8adbfea2f8 Jean*0134 WRITE(errorMessageUnit,'(A,3I3,A,4I4,A,2I5)')
0135 & 'send_1 bi,N=', bi,bj, N, ' , tI,J_lo,hi=',
54d78f5995 Jean*0136 & tIlo1, tIhi1, tJlo1, tJhi1, ' , oIs,oJs=', oIs1, oJs1
8adbfea2f8 Jean*0137 WRITE(errorMessageUnit,'(A,3I3,A,4I4,A,2I5)')
0138 & 'send_2 bi,N=', bi,bj, N, ' , tI,J_lo,hi=',
54d78f5995 Jean*0139 & tIlo2, tIhi2, tJlo2, tJhi2, ' , oIs,oJs=', oIs2, oJs2
10972e8712 Jean*0140 #endif
54d78f5995 Jean*0141 tKLo=1
0142 tKHi=myNz
0143 tKStride=1
0144 C- Put my points in buffer for neighbour N to fill points
0145 C (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
0146 C in its copy of "array1" & "array2".
0147 CALL EXCH2_PUT_RX2(
0148 I tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
0149 I tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
0150 I tKlo, tKhi, tkStride,
0151 I oIs1, oJs1, oIs2, oJs2,
0152 I thisTile, N,
0153 I e2BufrRecSize,
8adbfea2f8 Jean*0154 O iBuf1Filled(N,bi,bj), iBuf2Filled(N,bi,bj),
0155 O e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
54d78f5995 Jean*0156 I array1(1-myOLw,1-myOLs,1,bi,bj),
0157 I array2(1-myOLw,1-myOLs,1,bi,bj),
0158 I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
0159 I i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
0160 O e2_msgHandles(1,N,bi,bj),
8adbfea2f8 Jean*0161 I W2_myCommFlag(N,bi,bj), signOption, myThid )
54d78f5995 Jean*0162 ENDDO
046fd16d1c Andr*0163 ENDDO
0164 ENDDO
54d78f5995 Jean*0165
e79836c793 Jean*0166 C Wait until all threads finish filling buffer
0167 CALL BAR2( myThid )
0168
54d78f5995 Jean*0169 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0170
889df6b76e Jean*0171 #ifdef ALLOW_USE_MPI
21a61ba58f Jean*0172 IF ( usingMPI ) THEN
0173
54d78f5995 Jean*0174 _BEGIN_MASTER( myThid )
0175
0176 C-- Send my data (in buffer, level 1) to target Process
0177 DO bj=1,nSy
0178 DO bi=1,nSx
8adbfea2f8 Jean*0179 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0180 nN=exch2_nNeighbours(thisTile)
0181 DO N=1,nN
0182 C- Skip the call if this is an internal exchange
8adbfea2f8 Jean*0183 IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
54d78f5995 Jean*0184 CALL EXCH2_SEND_RX2(
0185 I thisTile, N,
0186 I e2BufrRecSize,
8adbfea2f8 Jean*0187 I iBuf1Filled(N,bi,bj), iBuf2Filled(N,bi,bj),
0188 I e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
54d78f5995 Jean*0189 O e2_msgHandles(1,N,bi,bj),
8adbfea2f8 Jean*0190 I W2_myCommFlag(N,bi,bj), myThid )
54d78f5995 Jean*0191 ENDIF
0192 ENDDO
0193 ENDDO
0194 ENDDO
0195
0196 C-- Receive data (in buffer, level 2) from source Process
0197 DO bj=1,nSy
0198 DO bi=1,nSx
8adbfea2f8 Jean*0199 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0200 nN=exch2_nNeighbours(thisTile)
0201 DO N=1,nN
0202 C- Skip the call if this is an internal exchange
8adbfea2f8 Jean*0203 IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
54d78f5995 Jean*0204 CALL EXCH2_GET_UV_BOUNDS(
b475142410 Jean*0205 I fieldCode, exchWidthX, updateCorners,
54d78f5995 Jean*0206 I thisTile, N,
0207 O tIlo1, tIhi1, tJlo1, tJhi1,
0208 O tIlo2, tIhi2, tJlo2, tJhi2,
0209 O tiStride, tjStride,
0210 O oIs1, oJs1, oIs2, oJs2,
0211 I myThid )
0212 nri = 1 + (tIhi1-tIlo1)/tiStride
0213 nrj = 1 + (tJhi1-tJlo1)/tjStride
0214 iBufr1 = nri*nrj*myNz
0215 nri = 1 + (tIhi2-tIlo2)/tiStride
0216 nrj = 1 + (tJhi2-tJlo2)/tjStride
0217 iBufr2 = nri*nrj*myNz
0218 C Receive from neighbour N to fill buffer and later on the array
0219 CALL EXCH2_RECV_RX2(
0220 I thisTile, N,
0221 I e2BufrRecSize,
0222 I iBufr1, iBufr2,
8adbfea2f8 Jean*0223 I e2Bufr1_RX(1,N,bi,bj,2), e2Bufr2_RX(1,N,bi,bj,2),
0224 I W2_myCommFlag(N,bi,bj), myThid )
54d78f5995 Jean*0225 ENDIF
0226 ENDDO
0227 ENDDO
0228 ENDDO
0229
0230 C-- Clear message handles/locks
0231 DO bj=1,nSy
0232 DO bi=1,nSx
8adbfea2f8 Jean*0233 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0234 nN=exch2_nNeighbours(thisTile)
0235 DO N=1,nN
0236 C Note: In a between process tile-tile data transport using
0237 C MPI the sender needs to clear an Isend wait handle here.
0238 C In a within process tile-tile data transport using true
0239 C shared address space/or direct transfer through commonly
0240 C addressable memory blocks the receiver needs to assert
0241 C that he has consumed the buffer the sender filled here.
0242 farTile=exch2_neighbourId(N,thisTile)
8adbfea2f8 Jean*0243 IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
54d78f5995 Jean*0244 wHandle = e2_msgHandles(1,N,bi,bj)
0245 CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
0246 wHandle = e2_msgHandles(2,N,bi,bj)
0247 CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
8adbfea2f8 Jean*0248 ELSEIF ( W2_myCommFlag(N,bi,bj) .EQ. 'P' ) THEN
54d78f5995 Jean*0249 ELSE
0250 ENDIF
0251 ENDDO
0252 ENDDO
0253 ENDDO
0254
889df6b76e Jean*0255 _END_MASTER( myThid )
e79836c793 Jean*0256 C Everyone waits until master-thread finishes receiving
0257 CALL BAR2( myThid )
0258
21a61ba58f Jean*0259 ENDIF
54d78f5995 Jean*0260 #endif /* ALLOW_USE_MPI */
046fd16d1c Andr*0261
54d78f5995 Jean*0262 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1bc75ace8b Jean*0263
54d78f5995 Jean*0264 C-- Extract from buffer (either from level 1 if local exch,
0265 C or level 2 if coming from an other Proc)
0266 DO bj=myByLo(myThid), myByHi(myThid)
0267 DO bi=myBxLo(myThid), myBxHi(myThid)
8adbfea2f8 Jean*0268 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0269 nN=exch2_nNeighbours(thisTile)
0270 DO N=1,nN
10972e8712 Jean*0271 #ifdef LOCAL_DBUG
8adbfea2f8 Jean*0272 WRITE(errorMessageUnit,'(A,3I3,A,4I4,A,2I5)')
0273 & 'recv_0 bi,N=', bi,bj, N, ' , tI,J_lo,hi=',
54d78f5995 Jean*0274 & exch2_iLo(N,thisTile), exch2_iHi(N,thisTile),
0275 & exch2_jLo(N,thisTile), exch2_jHi(N,thisTile)
10972e8712 Jean*0276 #endif
54d78f5995 Jean*0277 CALL EXCH2_GET_UV_BOUNDS(
b475142410 Jean*0278 I fieldCode, exchWidthX, updateCorners,
54d78f5995 Jean*0279 I thisTile, N,
0280 O tIlo1, tIhi1, tJlo1, tJhi1,
0281 O tIlo2, tIhi2, tJlo2, tJhi2,
0282 O tiStride, tjStride,
0283 O oIs1, oJs1, oIs2, oJs2,
0284 I myThid )
10972e8712 Jean*0285 #ifdef LOCAL_DBUG
8adbfea2f8 Jean*0286 WRITE(errorMessageUnit,'(A,3I3,A,4I4,A,2I5)')
0287 & 'recv_1 bi,N=', bi,bj, N, ' , tI,J_lo,hi=',
54d78f5995 Jean*0288 & tIlo1, tIhi1, tJlo1, tJhi1
8adbfea2f8 Jean*0289 WRITE(errorMessageUnit,'(A,3I3,A,4I4,A,2I5)')
0290 & 'recv_2 bi,N=', bi,bj, N, ' , tI,J_lo,hi=',
54d78f5995 Jean*0291 & tIlo2, tIhi2, tJlo2, tJhi2
889df6b76e Jean*0292 #endif
54d78f5995 Jean*0293 tKLo=1
0294 tKHi=myNz
0295 tKStride=1
046fd16d1c Andr*0296
54d78f5995 Jean*0297 C From buffer, get my points
0298 C (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride) in "array1,2":
0299 C Note: when transferring data within a process:
0300 C o e2Bufr entry to read is entry associated with opposing send record
0301 C o e2_msgHandle entry to read is entry associated with opposing send record.
0302 CALL EXCH2_GET_RX2(
0303 I tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
0304 I tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
0305 I tKlo, tKhi, tkStride,
0306 I thisTile, N, bi, bj,
0307 I e2BufrRecSize, W2_maxNeighbours, nSx, nSy,
0308 I e2Bufr1_RX, e2Bufr2_RX,
0309 U array1(1-myOLw,1-myOLs,1,bi,bj),
0310 U array2(1-myOLw,1-myOLs,1,bi,bj),
0311 I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
0312 I i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
0313 U e2_msgHandles,
8adbfea2f8 Jean*0314 I W2_myCommFlag(N,bi,bj), myThid )
54d78f5995 Jean*0315 ENDDO
046fd16d1c Andr*0316 ENDDO
0317 ENDDO
0318
0319 RETURN
0320 END
0321
2ad152b417 Ed H*0322 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0323
0324 CEH3 ;;; Local Variables: ***
0325 CEH3 ;;; mode:fortran ***
0326 CEH3 ;;; End: ***
