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