Warning, /pkg/exch2/exch2_rx1_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
0004 C !ROUTINE: EXCH_RX_CUBE_AD
0005
0006 C !INTERFACE:
54d78f5995 Jean*0007 SUBROUTINE EXCH2_RX1_CUBE_AD(
8bc539472e Jean*0008 U array,
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 Scalar field (1 component) AD-Exchange:
0016 C Tile-edge overlap-region of a 1 component scalar 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 array :: Array with edges to exchange.
8bc539472e Jean*0032 C signOption :: Flag controlling whether field sign depends on orientation
0033 C :: (signOption not yet implemented but needed for SM exch)
54d78f5995 Jean*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 regi 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...
3371b2be58 Jean*0041
0042 INTEGER myOLw, myOLe, myOLs, myOLn, myNz
54d78f5995 Jean*0043 _RX array(1-myOLw:sNx+myOLe,
0044 & 1-myOLs:sNy+myOLn,
0045 & myNZ, nSx, nSy)
8bc539472e Jean*0046 LOGICAL signOption
54d78f5995 Jean*0047 CHARACTER*2 fieldCode
40f5e5bc62 Patr*0048 INTEGER exchWidthX
0049 INTEGER exchWidthY
0050 INTEGER cornerMode
0051 INTEGER myThid
0052
0053 C !LOCAL VARIABLES:
54d78f5995 Jean*0054 C e2_msgHandles :: Synchronization and coordination data structure used to
0055 C :: coordinate access to e2Bufr1_RX or to regulate message
0056 C :: buffering. In PUT communication sender will increment
0057 C :: handle entry once data is ready in buffer. Receiver will
0058 C :: decrement handle once data is consumed from buffer.
d6ea3164dc Jean*0059 C :: For MPI MSG communication MPI_Wait uses handle to check
54d78f5995 Jean*0060 C :: Isend has cleared. This is done in routine after receives.
0061 C note: a) current implementation does not use e2_msgHandles for communication
0062 C between threads: all-threads barriers are used (see CNH note below).
0063 C For a 2-threads synchro communication (future version),
0064 C e2_msgHandles should be shared (in common block, moved to BUFFER.h)
0065 C b) 1rst dim=2 so that it could be used also by exch2_rx2_cube.
0066 INTEGER bi, bj
40f5e5bc62 Patr*0067 C Variables for working through W2 topology
54d78f5995 Jean*0068 INTEGER e2_msgHandles( 2, W2_maxNeighbours, nSx, nSy )
40f5e5bc62 Patr*0069 INTEGER thisTile, farTile, N, nN, oN
0070 INTEGER tIlo, tIhi, tJlo, tJhi, tKlo, tKhi
0071 INTEGER tIStride, tJStride, tKStride
0072 INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
54d78f5995 Jean*0073 LOGICAL updateCorners
40f5e5bc62 Patr*0074
0075 #ifdef ALLOW_USE_MPI
54d78f5995 Jean*0076 INTEGER iBufr, nri, nrj
0077 C MPI stuff (should be in a routine call)
40f5e5bc62 Patr*0078 INTEGER mpiStatus(MPI_STATUS_SIZE)
0079 INTEGER mpiRc
0080 INTEGER wHandle
0081 #endif
0082 CEOP
0083
54d78f5995 Jean*0084 updateCorners = cornerMode .EQ. EXCH_UPDATE_CORNERS
0085 C- Tile size of array to exchange:
0086 i1Lo = 1-myOLw
0087 i1Hi = sNx+myOLe
0088 j1Lo = 1-myOLs
0089 j1Hi = sNy+myOLn
0090 k1Lo = 1
0091 k1Hi = myNz
40f5e5bc62 Patr*0092
54d78f5995 Jean*0093 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0094
e79836c793 Jean*0095 C Prevent anyone to access shared buffer while an other thread modifies it
0096 CALL BAR2( myThid )
0097
54d78f5995 Jean*0098 C-- Extract from buffer (either from level 1 if local exch,
0099 C or level 2 if coming from an other Proc)
0100 C AD: = fill buffer from my-tile-edge overlap-region, level 1 or 2 depending
0101 C AD: on local (to this Proc) or remote Proc tile destination
0102 DO bj=myByLo(myThid), myByHi(myThid)
0103 DO bi=myBxLo(myThid), myBxHi(myThid)
8adbfea2f8 Jean*0104 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0105 nN=exch2_nNeighbours(thisTile)
0106 DO N=1,nN
0107 CALL EXCH2_GET_SCAL_BOUNDS(
0108 I fieldCode, exchWidthX, updateCorners,
0109 I thisTile, N,
0110 O tIlo, tiHi, tjLo, tjHi,
0111 O tiStride, tjStride,
0112 I myThid )
0113 tKLo=1
0114 tKHi=myNz
0115 tKStride=1
0116
0117 C From buffer, get my points
0118 C (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride) in "array":
0119 C Note: when transferring data within a process:
0120 C o e2Bufr entry to read is entry associated with opposing send record
0121 C o e2_msgHandle entry to read is entry associated with opposing send record.
0122 CALL EXCH2_AD_GET_RX1(
0123 I tIlo, tIhi, tiStride,
0124 I tJlo, tJhi, tjStride,
0125 I tKlo, tKhi, tkStride,
0126 I thisTile, N, bi, bj,
0127 I e2BufrRecSize, W2_maxNeighbours, nSx, nSy,
8adbfea2f8 Jean*0128 O iBuf1Filled(N,bi,bj),
54d78f5995 Jean*0129 O e2Bufr1_RX,
0130 U array(1-myOLw,1-myOLs,1,bi,bj),
0131 I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
0132 U e2_msgHandles,
8adbfea2f8 Jean*0133 I W2_myCommFlag(N,bi,bj), myThid )
54d78f5995 Jean*0134 ENDDO
40f5e5bc62 Patr*0135 ENDDO
0136 ENDDO
0137
e79836c793 Jean*0138 C Wait until all threads finish filling buffer
0139 CALL BAR2( myThid )
0140
54d78f5995 Jean*0141 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0142
0143 #ifdef ALLOW_USE_MPI
21a61ba58f Jean*0144 IF ( usingMPI ) THEN
54d78f5995 Jean*0145 C AD: all MPI part is acting on buffer and is identical to forward code,
0146 C AD: except a) the buffer level: send from lev.2, receive into lev.1
d6ea3164dc Jean*0147 C AD: b) the length of transferred buffer (<- match the ad_put/ad_get)
54d78f5995 Jean*0148
0149 _BEGIN_MASTER( myThid )
40f5e5bc62 Patr*0150
54d78f5995 Jean*0151 C-- Send my data (in buffer, level 2) to target Process
0152 DO bj=1,nSy
0153 DO bi=1,nSx
8adbfea2f8 Jean*0154 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0155 nN=exch2_nNeighbours(thisTile)
0156 DO N=1,nN
0157 C- Skip the call if this is an internal exchange
8adbfea2f8 Jean*0158 IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
54d78f5995 Jean*0159 CALL EXCH2_SEND_RX1(
0160 I thisTile, N,
0161 I e2BufrRecSize,
8adbfea2f8 Jean*0162 I iBuf1Filled(N,bi,bj),
0163 I e2Bufr1_RX(1,N,bi,bj,2),
54d78f5995 Jean*0164 O e2_msgHandles(1,N,bi,bj),
8adbfea2f8 Jean*0165 I W2_myCommFlag(N,bi,bj), myThid )
54d78f5995 Jean*0166 ENDIF
0167 ENDDO
40f5e5bc62 Patr*0168 ENDDO
0169 ENDDO
0170
54d78f5995 Jean*0171 C-- Receive data (in buffer, level 1) from source Process
0172 DO bj=1,nSy
0173 DO bi=1,nSx
8adbfea2f8 Jean*0174 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0175 nN=exch2_nNeighbours(thisTile)
0176 DO N=1,nN
0177 C- Skip the call if this is an internal exchange
8adbfea2f8 Jean*0178 IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
54d78f5995 Jean*0179 farTile=exch2_neighbourId(N,thisTile)
0180 oN = exch2_opposingSend(N,thisTile)
0181 CALL EXCH2_GET_SCAL_BOUNDS(
0182 I fieldCode, exchWidthX, updateCorners,
0183 I farTile, oN,
0184 O tIlo, tiHi, tjLo, tjHi,
0185 O tiStride, tjStride,
0186 I myThid )
0187 nri = 1 + (tIhi-tIlo)/tiStride
0188 nrj = 1 + (tJhi-tJlo)/tjStride
0189 iBufr = nri*nrj*myNz
0190 C Receive from neighbour N to fill buffer and later on the array
0191 CALL EXCH2_RECV_RX1(
0192 I thisTile, N,
0193 I e2BufrRecSize,
0194 I iBufr,
8adbfea2f8 Jean*0195 O e2Bufr1_RX(1,N,bi,bj,1),
0196 I W2_myCommFlag(N,bi,bj), myThid )
54d78f5995 Jean*0197 ENDIF
0198 ENDDO
0199 ENDDO
0200 ENDDO
0201
0202 C-- Clear message handles/locks
0203 DO bj=1,nSy
0204 DO bi=1,nSx
8adbfea2f8 Jean*0205 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0206 nN=exch2_nNeighbours(thisTile)
0207 DO N=1,nN
0208 C Note: In a between process tile-tile data transport using
0209 C MPI the sender needs to clear an Isend wait handle here.
0210 C In a within process tile-tile data transport using true
0211 C shared address space/or direct transfer through commonly
0212 C addressable memory blocks the receiver needs to assert
0213 C that he has consumed the buffer the sender filled here.
0214 c farTile=exch2_neighbourId(N,thisTile)
8adbfea2f8 Jean*0215 IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
54d78f5995 Jean*0216 wHandle = e2_msgHandles(1,N,bi,bj)
0217 CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
8adbfea2f8 Jean*0218 ELSEIF ( W2_myCommFlag(N,bi,bj) .EQ. 'P' ) THEN
54d78f5995 Jean*0219 ELSE
0220 ENDIF
0221 ENDDO
0222 ENDDO
0223 ENDDO
0224
0225 _END_MASTER( myThid )
e79836c793 Jean*0226 C Everyone waits until master-thread finishes receiving
0227 CALL BAR2( myThid )
0228
21a61ba58f Jean*0229 ENDIF
54d78f5995 Jean*0230 #endif /* ALLOW_USE_MPI */
0231
0232 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0233
0234 C-- Post sends into buffer (buffer level 1):
0235 C- AD: = get exch-data from buffer (level 1), formerly in source tile
0236 C AD: overlap region, and add to my tile near-Edge interior
0237 DO bj=myByLo(myThid), myByHi(myThid)
0238 DO bi=myBxLo(myThid), myBxHi(myThid)
8adbfea2f8 Jean*0239 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0240 nN=exch2_nNeighbours(thisTile)
0241 DO N=1,nN
0242 farTile=exch2_neighbourId(N,thisTile)
0243 oN = exch2_opposingSend(N,thisTile)
0244 CALL EXCH2_GET_SCAL_BOUNDS(
0245 I fieldCode, exchWidthX, updateCorners,
0246 I farTile, oN,
0247 O tIlo, tiHi, tjLo, tjHi,
0248 O tiStride, tjStride,
0249 I myThid )
0250 tKLo=1
0251 tKHi=myNz
0252 tKStride=1
0253 C- Put my points in buffer for neighbour N to fill points
0254 C (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
0255 C in its copy of "array".
0256 CALL EXCH2_AD_PUT_RX1(
0257 I tIlo, tIhi, tiStride,
0258 I tJlo, tJhi, tjStride,
0259 I tKlo, tKhi, tkStride,
0260 I thisTile, N,
0261 I e2BufrRecSize,
8adbfea2f8 Jean*0262 I e2Bufr1_RX(1,N,bi,bj,1),
54d78f5995 Jean*0263 U array(1-myOLw,1-myOLs,1,bi,bj),
0264 I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
0265 O e2_msgHandles(1,N,bi,bj),
8adbfea2f8 Jean*0266 I W2_myCommFlag(N,bi,bj), myThid )
54d78f5995 Jean*0267 ENDDO
40f5e5bc62 Patr*0268 ENDDO
0269 ENDDO
0270
0271 RETURN
0272 END
0273
0274 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0275
0276 CEH3 ;;; Local Variables: ***
0277 CEH3 ;;; mode:fortran ***
0278 CEH3 ;;; End: ***
