/[MITgcm]/MITgcm/pkg/exch2/exch2_rx2_cube_ad.template
ViewVC logotype

Diff of /MITgcm/pkg/exch2/exch2_rx2_cube_ad.template

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.6 by jmc, Sat May 30 21:26:31 2009 UTC revision 1.12 by jmc, Mon Mar 26 19:13:15 2012 UTC
# Line 11  C     !INTERFACE: Line 11  C     !INTERFACE:
11        SUBROUTINE EXCH2_RX2_CUBE_AD(        SUBROUTINE EXCH2_RX2_CUBE_AD(
12       U            array1, array2,       U            array1, array2,
13       I            signOption, fieldCode,       I            signOption, fieldCode,
14       I            myOLw, myOLe, myOLn, myOLs, myNz,       I            myOLw, myOLe, myOLs, myOLn, myNz,
15       I            exchWidthX, exchWidthY,       I            exchWidthX, exchWidthY,
16       I            simulationMode, cornerMode, myThid )       I            cornerMode, myThid )
17    
18  C     !DESCRIPTION:  C     !DESCRIPTION:
19  C     Two components vector field AD-Exchange:  C     Two components vector field AD-Exchange:
# Line 37  C     array2      :: 2nd  component arra Line 37  C     array2      :: 2nd  component arra
37  C     signOption  :: Flag controlling whether vector is signed.  C     signOption  :: Flag controlling whether vector is signed.
38  C     fieldCode   :: field code (position on staggered grid)  C     fieldCode   :: field code (position on staggered grid)
39  C     myOLw,myOLe :: West and East overlap region sizes.  C     myOLw,myOLe :: West and East overlap region sizes.
40  C     myOLn,myOLs :: North and South overlap region sizes.  C     myOLs,myOLn :: South and North overlap region sizes.
41  C     exchWidthX  :: Width of data region exchanged in X.  C     exchWidthX  :: Width of data region exchanged in X.
42  C     exchWidthY  :: Width of data region exchanged in Y.  C     exchWidthY  :: Width of data region exchanged in Y.
43  C     cornerMode  :: halo-corner-region treatment: update/ignore corner region  C     cornerMode  :: halo-corner-region treatment: update/ignore corner region
44  C     myThid      :: Thread number of this instance of S/R EXCH...  C     myThid      :: Thread number of this instance of S/R EXCH...
45    
46        INTEGER myOLw, myOLe, myOLn, myOLs, myNz        INTEGER myOLw, myOLe, myOLs, myOLn, myNz
47        _RX array1(1-myOLw:sNx+myOLe,        _RX array1(1-myOLw:sNx+myOLe,
48       &           1-myOLs:sNy+myOLn,       &           1-myOLs:sNy+myOLn,
49       &           myNz, nSx, nSy)       &           myNz, nSx, nSy)
# Line 54  C     myThid      :: Thread number of th Line 54  C     myThid      :: Thread number of th
54        CHARACTER*2 fieldCode        CHARACTER*2 fieldCode
55        INTEGER exchWidthX        INTEGER exchWidthX
56        INTEGER exchWidthY        INTEGER exchWidthY
       INTEGER simulationMode  
57        INTEGER cornerMode        INTEGER cornerMode
58        INTEGER myThid        INTEGER myThid
59    
# Line 64  C                   :: coordinate access Line 63  C                   :: coordinate access
63  C                   :: buffering. In PUT communication sender will increment  C                   :: buffering. In PUT communication sender will increment
64  C                   :: handle entry once data is ready in buffer. Receiver will  C                   :: handle entry once data is ready in buffer. Receiver will
65  C                   :: decrement handle once data is consumed from buffer.  C                   :: decrement handle once data is consumed from buffer.
66  C                   :: For MPI MSG communication MPI_Wait uses hanlde to check  C                   :: For MPI MSG communication MPI_Wait uses handle to check
67  C                   :: Isend has cleared. This is done in routine after receives.  C                   :: Isend has cleared. This is done in routine after receives.
68  C     note: a) current implementation does not use e2_msgHandles for communication  C     note: a) current implementation does not use e2_msgHandles for communication
69  C              between threads: all-threads barriers are used (see CNH note below).  C              between threads: all-threads barriers are used (see CNH note below).
# Line 80  C     Variables for working through W2 t Line 79  C     Variables for working through W2 t
79        INTEGER tKlo, tKhi, tKStride        INTEGER tKlo, tKhi, tKStride
80        INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi        INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
81        INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi        INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
82          LOGICAL updateCorners
83    
84  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
85        INTEGER iBufr1, iBufr2, nri, nrj        INTEGER iBufr1, iBufr2, nri, nrj
# Line 90  C     MPI stuff (should be in a routine Line 90  C     MPI stuff (should be in a routine
90  #endif  #endif
91  CEOP  CEOP
92    
93          updateCorners = cornerMode .EQ. EXCH_UPDATE_CORNERS
94  C-    Tile size of arrays to exchange:  C-    Tile size of arrays to exchange:
95        i1Lo  = 1-myOLw        i1Lo  = 1-myOLw
96        i1Hi  = sNx+myOLe        i1Hi  = sNx+myOLe
# Line 104  C-    Tile size of arrays to exchange: Line 105  C-    Tile size of arrays to exchange:
105        k2Lo  = 1        k2Lo  = 1
106        k2Hi  = myNz        k2Hi  = myNz
107    
 C     For now tile <-> tile exchanges are sequentialised through  
 C     thread 1. This is a temporary feature for preliminary testing until  
 C     general tile decomposition is in place (CNH April 11, 2001)  
       CALL BAR2( myThid )  
   
108  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
109    
110    C     Prevent anyone to access shared buffer while an other thread modifies it
111          CALL BAR2( myThid )
112    
113  C--   Extract from buffer (either from level 1 if local exch,  C--   Extract from buffer (either from level 1 if local exch,
114  C                     or level 2 if coming from an other Proc)  C                     or level 2 if coming from an other Proc)
115  C  AD: = fill buffer from my-tile-edge overlap-region, level 1 or 2 depending  C  AD: = fill buffer from my-tile-edge overlap-region, level 1 or 2 depending
116  C  AD:   on local (to this Proc) or remote Proc tile destination  C  AD:   on local (to this Proc) or remote Proc tile destination
117        DO bj=myByLo(myThid), myByHi(myThid)        DO bj=myByLo(myThid), myByHi(myThid)
118         DO bi=myBxLo(myThid), myBxHi(myThid)         DO bi=myBxLo(myThid), myBxHi(myThid)
119          thisTile=W2_myTileList(bi)          thisTile=W2_myTileList(bi,bj)
120          nN=exch2_nNeighbours(thisTile)          nN=exch2_nNeighbours(thisTile)
121          DO N=1,nN          DO N=1,nN
122            CALL EXCH2_GET_UV_BOUNDS(            CALL EXCH2_GET_UV_BOUNDS(
123       I               fieldCode, exchWidthX,       I               fieldCode, exchWidthX, updateCorners,
124       I               thisTile, N,       I               thisTile, N,
125       O               tIlo1, tIhi1, tJlo1, tJhi1,       O               tIlo1, tIhi1, tJlo1, tJhi1,
126       O               tIlo2, tIhi2, tJlo2, tJhi2,       O               tIlo2, tIhi2, tJlo2, tJhi2,
# Line 143  C      o e2_msgHandle entry to read is e Line 142  C      o e2_msgHandle entry to read is e
142       I               tKlo, tKhi, tkStride,       I               tKlo, tKhi, tkStride,
143       I               thisTile, N, bi, bj,       I               thisTile, N, bi, bj,
144       I               e2BufrRecSize, W2_maxNeighbours, nSx, nSy,       I               e2BufrRecSize, W2_maxNeighbours, nSx, nSy,
145       O               iBuf1Filled(N,bi), iBuf2Filled(N,bi),       O               iBuf1Filled(N,bi,bj), iBuf2Filled(N,bi,bj),
146       O               e2Bufr1_RX, e2Bufr2_RX,       O               e2Bufr1_RX, e2Bufr2_RX,
147       U               array1(1-myOLw,1-myOLs,1,bi,bj),       U               array1(1-myOLw,1-myOLs,1,bi,bj),
148       U               array2(1-myOLw,1-myOLs,1,bi,bj),       U               array2(1-myOLw,1-myOLs,1,bi,bj),
149       I               i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,       I               i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
150       I               i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,       I               i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
151       U               e2_msgHandles,       U               e2_msgHandles,
152       I               W2_myCommFlag(N,bi), myThid )       I               W2_myCommFlag(N,bi,bj), myThid )
153          ENDDO          ENDDO
154         ENDDO         ENDDO
155        ENDDO        ENDDO
156    
157    C     Wait until all threads finish filling buffer
158          CALL BAR2( myThid )
159    
160  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
161    
162  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
163  C  AD: all MPI part is acting on buffer and is identical to forward code,  C  AD: all MPI part is acting on buffer and is identical to forward code,
164  C  AD: except a) the buffer level: send from lev.2, receive into lev.1  C  AD: except a) the buffer level: send from lev.2, receive into lev.1
165  C  AD:        b) the length of transfered buffer (<- match the ad_put/ad_get)  C  AD:        b) the length of transferred buffer (<- match the ad_put/ad_get)
166    
 C     wait until all threads finish filling buffer  
       CALL BAR2( myThid )  
167        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
168    
169  C--   Send my data (in buffer, level 1) to target Process  C--   Send my data (in buffer, level 1) to target Process
170        DO bj=1,nSy        DO bj=1,nSy
171         DO bi=1,nSx         DO bi=1,nSx
172          thisTile=W2_myTileList(bi)          thisTile=W2_myTileList(bi,bj)
173          nN=exch2_nNeighbours(thisTile)          nN=exch2_nNeighbours(thisTile)
174          DO N=1,nN          DO N=1,nN
175  C-    Skip the call if this is an internal exchange  C-    Skip the call if this is an internal exchange
176           IF ( W2_myCommFlag(N,bi) .EQ. 'M' ) THEN           IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
177            CALL EXCH2_SEND_RX2(            CALL EXCH2_SEND_RX2(
178       I               thisTile, N,       I               thisTile, N,
179       I               e2BufrRecSize,       I               e2BufrRecSize,
180       I               iBuf1Filled(N,bi),    iBuf2Filled(N,bi),       I               iBuf1Filled(N,bi,bj),    iBuf2Filled(N,bi,bj),
181       I               e2Bufr1_RX(1,N,bi,2), e2Bufr2_RX(1,N,bi,2),       I               e2Bufr1_RX(1,N,bi,bj,2), e2Bufr2_RX(1,N,bi,bj,2),
182       O               e2_msgHandles(1,N,bi,bj),       O               e2_msgHandles(1,N,bi,bj),
183       I               W2_myCommFlag(N,bi), myThid )       I               W2_myCommFlag(N,bi,bj), myThid )
184           ENDIF           ENDIF
185          ENDDO          ENDDO
186         ENDDO         ENDDO
# Line 189  C-    Skip the call if this is an intern Line 189  C-    Skip the call if this is an intern
189  C--   Receive data (in buffer, level 1) from source Process  C--   Receive data (in buffer, level 1) from source Process
190        DO bj=1,nSy        DO bj=1,nSy
191         DO bi=1,nSx         DO bi=1,nSx
192          thisTile=W2_myTileList(bi)          thisTile=W2_myTileList(bi,bj)
193          nN=exch2_nNeighbours(thisTile)          nN=exch2_nNeighbours(thisTile)
194          DO N=1,nN          DO N=1,nN
195  C-    Skip the call if this is an internal exchange  C-    Skip the call if this is an internal exchange
196           IF ( W2_myCommFlag(N,bi) .EQ. 'M' ) THEN           IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
197            farTile=exch2_neighbourId(N,thisTile)            farTile=exch2_neighbourId(N,thisTile)
198            oN = exch2_opposingSend(N,thisTile)            oN = exch2_opposingSend(N,thisTile)
199            CALL EXCH2_GET_UV_BOUNDS(            CALL EXCH2_GET_UV_BOUNDS(
200       I               fieldCode, exchWidthX,       I               fieldCode, exchWidthX, updateCorners,
201       I               farTile, oN,       I               farTile, oN,
202       O               tIlo1, tIhi1, tJlo1, tJhi1,       O               tIlo1, tIhi1, tJlo1, tJhi1,
203       O               tIlo2, tIhi2, tJlo2, tJhi2,       O               tIlo2, tIhi2, tJlo2, tJhi2,
# Line 215  C       Receive from neighbour N to fill Line 215  C       Receive from neighbour N to fill
215       I               thisTile, N,       I               thisTile, N,
216       I               e2BufrRecSize,       I               e2BufrRecSize,
217       I               iBufr1, iBufr2,       I               iBufr1, iBufr2,
218       I               e2Bufr1_RX(1,N,bi,1), e2Bufr2_RX(1,N,bi,1),       I               e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
219       I               W2_myCommFlag(N,bi), myThid )       I               W2_myCommFlag(N,bi,bj), myThid )
220           ENDIF           ENDIF
221          ENDDO          ENDDO
222         ENDDO         ENDDO
# Line 225  C       Receive from neighbour N to fill Line 225  C       Receive from neighbour N to fill
225  C--   Clear message handles/locks  C--   Clear message handles/locks
226        DO bj=1,nSy        DO bj=1,nSy
227         DO bi=1,nSx         DO bi=1,nSx
228          thisTile=W2_myTileList(bi)          thisTile=W2_myTileList(bi,bj)
229          nN=exch2_nNeighbours(thisTile)          nN=exch2_nNeighbours(thisTile)
230          DO N=1,nN          DO N=1,nN
231  C     Note: In a between process tile-tile data transport using  C     Note: In a between process tile-tile data transport using
# Line 235  C           shared address space/or dire Line 235  C           shared address space/or dire
235  C           addressable memory blocks the receiver needs to assert  C           addressable memory blocks the receiver needs to assert
236  C           that he has consumed the buffer the sender filled here.  C           that he has consumed the buffer the sender filled here.
237           farTile=exch2_neighbourId(N,thisTile)           farTile=exch2_neighbourId(N,thisTile)
238           IF     ( W2_myCommFlag(N,bi) .EQ. 'M' ) THEN           IF     ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
239            wHandle = e2_msgHandles(1,N,bi,bj)            wHandle = e2_msgHandles(1,N,bi,bj)
240            CALL MPI_Wait( wHandle, mpiStatus, mpiRc )            CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
241            wHandle = e2_msgHandles(2,N,bi,bj)            wHandle = e2_msgHandles(2,N,bi,bj)
242            CALL MPI_Wait( wHandle, mpiStatus, mpiRc )            CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
243           ELSEIF ( W2_myCommFlag(N,bi) .EQ. 'P' ) THEN           ELSEIF ( W2_myCommFlag(N,bi,bj) .EQ. 'P' ) THEN
244           ELSE           ELSE
245           ENDIF           ENDIF
246          ENDDO          ENDDO
# Line 248  C           that he has consumed the buf Line 248  C           that he has consumed the buf
248        ENDDO        ENDDO
249    
250        _END_MASTER( myThid )        _END_MASTER( myThid )
251    C     Everyone waits until master-thread finishes receiving
252          CALL BAR2( myThid )
253    
254  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
255    
256  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
 C     Wait until all threads finish receiving or filling buffer  
       CALL BAR2( myThid )  
257    
258  C--   Post sends into buffer (buffer level 1):  C--   Post sends into buffer (buffer level 1):
259        DO bj=myByLo(myThid), myByHi(myThid)        DO bj=myByLo(myThid), myByHi(myThid)
260         DO bi=myBxLo(myThid), myBxHi(myThid)         DO bi=myBxLo(myThid), myBxHi(myThid)
261          thisTile=W2_myTileList(bi)          thisTile=W2_myTileList(bi,bj)
262          nN=exch2_nNeighbours(thisTile)          nN=exch2_nNeighbours(thisTile)
263          DO N=1,nN          DO N=1,nN
264            farTile=exch2_neighbourId(N,thisTile)            farTile=exch2_neighbourId(N,thisTile)
265            oN = exch2_opposingSend(N,thisTile)            oN = exch2_opposingSend(N,thisTile)
266            CALL EXCH2_GET_UV_BOUNDS(            CALL EXCH2_GET_UV_BOUNDS(
267       I               fieldCode, exchWidthX,       I               fieldCode, exchWidthX, updateCorners,
268       I               farTile, oN,       I               farTile, oN,
269       O               tIlo1, tIhi1, tJlo1, tJhi1,       O               tIlo1, tIhi1, tJlo1, tJhi1,
270       O               tIlo2, tIhi2, tJlo2, tJhi2,       O               tIlo2, tIhi2, tJlo2, tJhi2,
# Line 283  C     in its copy of "array1" & "array2" Line 284  C     in its copy of "array1" & "array2"
284       I               oIs1, oJs1, oIs2, oJs2,       I               oIs1, oJs1, oIs2, oJs2,
285       I               thisTile, N,       I               thisTile, N,
286       I               e2BufrRecSize,       I               e2BufrRecSize,
287       O               e2Bufr1_RX(1,N,bi,1), e2Bufr2_RX(1,N,bi,1),       O               e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
288       I               array1(1-myOLw,1-myOLs,1,bi,bj),       I               array1(1-myOLw,1-myOLs,1,bi,bj),
289       I               array2(1-myOLw,1-myOLs,1,bi,bj),       I               array2(1-myOLw,1-myOLs,1,bi,bj),
290       I               i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,       I               i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
291       I               i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,       I               i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
292       O               e2_msgHandles(1,N,bi,bj),       O               e2_msgHandles(1,N,bi,bj),
293       I               W2_myCommFlag(N,bi), signOption, myThid )       I               W2_myCommFlag(N,bi,bj), signOption, myThid )
294          ENDDO          ENDDO
295         ENDDO         ENDDO
296        ENDDO        ENDDO
297    
       CALL BAR2(myThid)  
   
298        RETURN        RETURN
299        END        END
300    
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22