Warning, /pkg/exch2/exch2_rx1_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"
0002
0003 CBOP
0004 C !ROUTINE: EXCH_RX_CUBE
0005
0006 C !INTERFACE:
889df6b76e Jean*0007 SUBROUTINE EXCH2_RX1_CUBE(
54d78f5995 Jean*0008 U array,
8bc539472e Jean*0009 I signOption, fieldCode,
3371b2be58 Jean*0010 I myOLw, myOLe, myOLs, myOLn, myNz,
046fd16d1c Andr*0011 I exchWidthX, exchWidthY,
8bc539472e Jean*0012 I cornerMode, myThid )
046fd16d1c Andr*0013
0014 C !DESCRIPTION:
54d78f5995 Jean*0015 C Scalar field (1 component) Exchange:
0016 C Fill-in tile-edge overlap-region of a 1 component scalar field
0017 C with corresponding near-edge interior data point
046fd16d1c Andr*0018
0019 C !USES:
54d78f5995 Jean*0020 IMPLICIT NONE
0021
046fd16d1c Andr*0022 C == Global data ==
0023 #include "SIZE.h"
0024 #include "EEPARAMS.h"
0025 #include "EESUPPORT.h"
90219e5912 Jean*0026 #include "W2_EXCH2_SIZE.h"
046fd16d1c Andr*0027 #include "W2_EXCH2_TOPOLOGY.h"
90219e5912 Jean*0028 #include "W2_EXCH2_BUFFER.h"
046fd16d1c Andr*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 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 :: my Thread Id. number
0041
3371b2be58 Jean*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
046fd16d1c Andr*0047 CHARACTER*2 fieldCode
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
046fd16d1c Andr*0067 C Variables for working through W2 topology
54d78f5995 Jean*0068 INTEGER e2_msgHandles( 2, W2_maxNeighbours, nSx, nSy )
046fd16d1c Andr*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
046fd16d1c Andr*0074
0075 #ifdef ALLOW_USE_MPI
54d78f5995 Jean*0076 INTEGER iBufr, nri, nrj
0077 C MPI stuff (should be in a routine call)
046fd16d1c Andr*0078 INTEGER mpiStatus(MPI_STATUS_SIZE)
0079 INTEGER mpiRc
0080 INTEGER wHandle
026642cc3c Jean*0081 #endif
046fd16d1c Andr*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
046fd16d1c Andr*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-- Post sends into buffer (buffer level 1):
0099 DO bj=myByLo(myThid), myByHi(myThid)
0100 DO bi=myBxLo(myThid), myBxHi(myThid)
8adbfea2f8 Jean*0101 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0102 nN=exch2_nNeighbours(thisTile)
0103 DO N=1,nN
0104 farTile=exch2_neighbourId(N,thisTile)
0105 oN = exch2_opposingSend(N,thisTile)
0106 CALL EXCH2_GET_SCAL_BOUNDS(
0107 I fieldCode, exchWidthX, updateCorners,
0108 I farTile, oN,
0109 O tIlo, tiHi, tjLo, tjHi,
0110 O tiStride, tjStride,
0111 I myThid )
0112 tKLo=1
0113 tKHi=myNz
0114 tKStride=1
0115 C- Put my points in buffer for neighbour N to fill points
0116 C (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
0117 C in its copy of "array".
0118 CALL EXCH2_PUT_RX1(
0119 I tIlo, tIhi, tiStride,
0120 I tJlo, tJhi, tjStride,
0121 I tKlo, tKhi, tkStride,
0122 I thisTile, N,
0123 I e2BufrRecSize,
8adbfea2f8 Jean*0124 O iBuf1Filled(N,bi,bj),
0125 O e2Bufr1_RX(1,N,bi,bj,1),
54d78f5995 Jean*0126 I array(1-myOLw,1-myOLs,1,bi,bj),
0127 I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
0128 O e2_msgHandles(1,N,bi,bj),
8adbfea2f8 Jean*0129 I W2_myCommFlag(N,bi,bj), myThid )
54d78f5995 Jean*0130 ENDDO
046fd16d1c Andr*0131 ENDDO
0132 ENDDO
0133
e79836c793 Jean*0134 C Wait until all threads finish filling buffer
0135 CALL BAR2( myThid )
0136
54d78f5995 Jean*0137 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1bc75ace8b Jean*0138
889df6b76e Jean*0139 #ifdef ALLOW_USE_MPI
21a61ba58f Jean*0140 IF ( usingMPI ) THEN
0141
889df6b76e Jean*0142 _BEGIN_MASTER( myThid )
54d78f5995 Jean*0143
0144 C-- Send my data (in buffer, level 1) to target Process
0145 DO bj=1,nSy
0146 DO bi=1,nSx
8adbfea2f8 Jean*0147 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0148 nN=exch2_nNeighbours(thisTile)
0149 DO N=1,nN
0150 C- Skip the call if this is an internal exchange
8adbfea2f8 Jean*0151 IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
54d78f5995 Jean*0152 CALL EXCH2_SEND_RX1(
0153 I thisTile, N,
0154 I e2BufrRecSize,
8adbfea2f8 Jean*0155 I iBuf1Filled(N,bi,bj),
0156 I e2Bufr1_RX(1,N,bi,bj,1),
54d78f5995 Jean*0157 O e2_msgHandles(1,N,bi,bj),
8adbfea2f8 Jean*0158 I W2_myCommFlag(N,bi,bj), myThid )
54d78f5995 Jean*0159 ENDIF
0160 ENDDO
046fd16d1c Andr*0161 ENDDO
0162 ENDDO
0163
54d78f5995 Jean*0164 C-- Receive data (in buffer, level 2) from source Process
0165 DO bj=1,nSy
0166 DO bi=1,nSx
8adbfea2f8 Jean*0167 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0168 nN=exch2_nNeighbours(thisTile)
0169 DO N=1,nN
0170 C- Skip the call if this is an internal exchange
8adbfea2f8 Jean*0171 IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
54d78f5995 Jean*0172 CALL EXCH2_GET_SCAL_BOUNDS(
0173 I fieldCode, exchWidthX, updateCorners,
0174 I thisTile, N,
0175 O tIlo, tiHi, tjLo, tjHi,
0176 O tiStride, tjStride,
0177 I myThid )
0178 nri = 1 + (tIhi-tIlo)/tiStride
0179 nrj = 1 + (tJhi-tJlo)/tjStride
0180 iBufr = nri*nrj*myNz
0181 C Receive from neighbour N to fill buffer and later on the array
0182 CALL EXCH2_RECV_RX1(
0183 I thisTile, N,
0184 I e2BufrRecSize,
0185 I iBufr,
8adbfea2f8 Jean*0186 O e2Bufr1_RX(1,N,bi,bj,2),
0187 I W2_myCommFlag(N,bi,bj), myThid )
54d78f5995 Jean*0188 ENDIF
0189 ENDDO
046fd16d1c Andr*0190 ENDDO
0191 ENDDO
54d78f5995 Jean*0192
0193 C-- Clear message handles/locks
0194 DO bj=1,nSy
0195 DO bi=1,nSx
8adbfea2f8 Jean*0196 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0197 nN=exch2_nNeighbours(thisTile)
0198 DO N=1,nN
0199 C Note: In a between process tile-tile data transport using
0200 C MPI the sender needs to clear an Isend wait handle here.
0201 C In a within process tile-tile data transport using true
0202 C shared address space/or direct transfer through commonly
0203 C addressable memory blocks the receiver needs to assert
0204 C that he has consumed the buffer the sender filled here.
0205 farTile=exch2_neighbourId(N,thisTile)
8adbfea2f8 Jean*0206 IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
54d78f5995 Jean*0207 wHandle = e2_msgHandles(1,N,bi,bj)
0208 CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
8adbfea2f8 Jean*0209 ELSEIF ( W2_myCommFlag(N,bi,bj) .EQ. 'P' ) THEN
54d78f5995 Jean*0210 ELSE
0211 ENDIF
0212 ENDDO
0213 ENDDO
0214 ENDDO
0215
889df6b76e Jean*0216 _END_MASTER( myThid )
e79836c793 Jean*0217 C Everyone waits until master-thread finishes receiving
0218 CALL BAR2( myThid )
0219
21a61ba58f Jean*0220 ENDIF
889df6b76e Jean*0221 #endif /* ALLOW_USE_MPI */
046fd16d1c Andr*0222
54d78f5995 Jean*0223 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0224
0225 C-- Extract from buffer (either from level 1 if local exch,
0226 C or level 2 if coming from an other Proc)
0227 DO bj=myByLo(myThid), myByHi(myThid)
0228 DO bi=myBxLo(myThid), myBxHi(myThid)
8adbfea2f8 Jean*0229 thisTile=W2_myTileList(bi,bj)
54d78f5995 Jean*0230 nN=exch2_nNeighbours(thisTile)
0231 DO N=1,nN
0232 CALL EXCH2_GET_SCAL_BOUNDS(
0233 I fieldCode, exchWidthX, updateCorners,
0234 I thisTile, N,
0235 O tIlo, tiHi, tjLo, tjHi,
0236 O tiStride, tjStride,
0237 I myThid )
0238 tKLo=1
0239 tKHi=myNz
0240 tKStride=1
0241
0242 C From buffer, get my points
0243 C (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride) in "array":
0244 C Note: when transferring data within a process:
0245 C o e2Bufr entry to read is entry associated with opposing send record
0246 C o e2_msgHandle entry to read is entry associated with opposing send record.
0247 CALL EXCH2_GET_RX1(
0248 I tIlo, tIhi, tiStride,
0249 I tJlo, tJhi, tjStride,
0250 I tKlo, tKhi, tkStride,
0251 I thisTile, N, bi, bj,
0252 I e2BufrRecSize, W2_maxNeighbours, nSx, nSy,
0253 I e2Bufr1_RX,
0254 U array(1-myOLw,1-myOLs,1,bi,bj),
0255 I i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
0256 U e2_msgHandles,
8adbfea2f8 Jean*0257 I W2_myCommFlag(N,bi,bj), myThid )
54d78f5995 Jean*0258 ENDDO
0259 ENDDO
0260 ENDDO
0261
046fd16d1c Andr*0262 RETURN
0263 END
0264
2ad152b417 Ed H*0265 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
0266
0267 CEH3 ;;; Local Variables: ***
0268 CEH3 ;;; mode:fortran ***
0269 CEH3 ;;; End: ***
