/[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.2 by jmc, Tue Jul 29 20:25:23 2008 UTC revision 1.9 by jmc, Fri Apr 23 20:21:07 2010 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    #undef LOCAL_DBUG
 #undef  Dbg  
6    
7  CBOP  CBOP
8  C     !ROUTINE: EXCH_RX2_CUBE  C     !ROUTINE: EXCH_RX2_CUBE_AD
9    
10  C     !INTERFACE:  C     !INTERFACE:
11        SUBROUTINE EXCH2_RX2_CUBE_AD(        SUBROUTINE EXCH2_RX2_CUBE_AD(
12       U            array1, array2, signOption, fieldCode,       U            array1, array2,
13         I            signOption, fieldCode,
14       I            myOLw, myOLe, myOLn, myOLs, myNz,       I            myOLw, myOLe, myOLn, myOLs, myNz,
15       I            exchWidthX, exchWidthY,       I            exchWidthX, exchWidthY,
16       I            simulationMode, cornerMode, myThid )       I            simulationMode, cornerMode, myThid )
       IMPLICIT NONE  
17    
18  C     !DESCRIPTION:  C     !DESCRIPTION:
19    C     Two components vector field AD-Exchange:
20    C     Tile-edge overlap-region of a 2 component vector field is added to
21    C     corresponding near-edge interior data point and then zero out.
22    
23  C     !USES:  C     !USES:
24          IMPLICIT NONE
25    
26  C     == Global data ==  C     == Global data ==
27  #include "SIZE.h"  #include "SIZE.h"
28  #include "EEPARAMS.h"  #include "EEPARAMS.h"
29  #include "EESUPPORT.h"  #include "EESUPPORT.h"
30  #include "EXCH.h"  #include "W2_EXCH2_SIZE.h"
31  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
32  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_BUFFER.h"
33    
34  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
35  C     array :: Array with edges to exchange.  C     array1      :: 1rst component array with edges to exchange.
36  C     myOLw :: West, East, North and South overlap region sizes.  C     array2      :: 2nd  component array with edges to exchange.
37  C     myOLe  C     signOption  :: Flag controlling whether vector is signed.
38  C     myOLn  C     fieldCode   :: field code (position on staggered grid)
39  C     myOLs  C     myOLw,myOLe :: West and East overlap region sizes.
40  C     exchWidthX :: Width of data region exchanged in X.  C     myOLn,myOLs :: North and South overlap region sizes.
41  C     exchWidthY :: Width of data region exchanged in Y.  C     exchWidthX  :: Width of data region exchanged in X.
42  C     myThid         :: Thread number of this instance of S/R EXCH...  C     exchWidthY  :: Width of data region exchanged in Y.
43        LOGICAL     signOption  C     cornerMode  :: halo-corner-region treatment: update/ignore corner region
44    C     myThid      :: Thread number of this instance of S/R EXCH...
45    
46          INTEGER myOLw, myOLe, myOLn, myOLs, myNz
47          _RX array1(1-myOLw:sNx+myOLe,
48         &           1-myOLs:sNy+myOLn,
49         &           myNz, nSx, nSy)
50          _RX array2(1-myOLw:sNx+myOLe,
51         &           1-myOLs:sNy+myOLn,
52         &           myNz, nSx, nSy)
53          LOGICAL signOption
54        CHARACTER*2 fieldCode        CHARACTER*2 fieldCode
       INTEGER myOLw  
       INTEGER myOLe  
       INTEGER myOLs  
       INTEGER myOLn  
       INTEGER myNz  
55        INTEGER exchWidthX        INTEGER exchWidthX
56        INTEGER exchWidthY        INTEGER exchWidthY
57        INTEGER simulationMode        INTEGER simulationMode
58        INTEGER cornerMode        INTEGER cornerMode
59        INTEGER myThid        INTEGER myThid
       _RX array1(1-myOLw:sNx+myOLe,  
      &           1-myOLs:sNy+myOLn,  
      &           myNZ, nSx, nSy)  
       _RX array2(1-myOLw:sNx+myOLe,  
      &           1-myOLs:sNy+myOLn,  
      &           myNZ, nSx, nSy)  
60    
61  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
62  C     theSimulationMode :: Holds working copy of simulation mode  C     e2_msgHandles :: Synchronization and coordination data structure used to
63  C     theCornerMode     :: Holds working copy of corner mode  C                   :: coordinate access to e2Bufr1_RX or to regulate message
64  C     I,J,K,bl,bt,bn,bs :: Loop and index counters  C                   :: buffering. In PUT communication sender will increment
65  C     be,bw  C                   :: handle entry once data is ready in buffer. Receiver will
66        INTEGER theSimulationMode  C                   :: decrement handle once data is consumed from buffer.
67        INTEGER theCornerMode  C                   :: For MPI MSG communication MPI_Wait uses handle to check
68  c     INTEGER I,J,K  C                   :: Isend has cleared. This is done in routine after receives.
69  c     INTEGER bl,bt,bn,bs,be,bw  C     note: a) current implementation does not use e2_msgHandles for communication
70        INTEGER I  C              between threads: all-threads barriers are used (see CNH note below).
71    C              For a 2-threads synchro communication (future version),
72    C              e2_msgHandles should be shared (in common block, moved to BUFFER.h)
73          INTEGER bi, bj
74  C     Variables for working through W2 topology  C     Variables for working through W2 topology
75        INTEGER e2_msgHandles(2,MAX_NEIGHBOURS, nSx)        INTEGER e2_msgHandles( 2, W2_maxNeighbours, nSx, nSy )
76        INTEGER thisTile, farTile, N, nN, oN        INTEGER thisTile, farTile, N, nN, oN
77        INTEGER tIlo, tIhi, tJlo, tJhi, tKlo, tKhi        INTEGER tIlo1, tIhi1, tJlo1, tJhi1, oIs1, oJs1
78        INTEGER tIStride, tJStride, tKStride        INTEGER tIlo2, tIhi2, tJlo2, tJhi2, oIs2, oJs2
79          INTEGER tIStride, tJStride
80          INTEGER tKlo, tKhi, tKStride
81        INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi        INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
82        INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi        INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
 C     == Statement function ==  
 C     tilemod - Permutes indices to return neighboring tile index on  
 C               six face cube.  
 c     INTEGER tilemod  
83    
 C     MPI stuff (should be in a routine call)  
84  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
85          INTEGER iBufr1, iBufr2, nri, nrj
86    C     MPI stuff (should be in a routine call)
87        INTEGER mpiStatus(MPI_STATUS_SIZE)        INTEGER mpiStatus(MPI_STATUS_SIZE)
88        INTEGER mpiRc        INTEGER mpiRc
89        INTEGER wHandle        INTEGER wHandle
90  #endif  #endif
91  CEOP  CEOP
92    
93        theSimulationMode = simulationMode  C-    Tile size of arrays to exchange:
94        theCornerMode     = cornerMode        i1Lo  = 1-myOLw
95          i1Hi  = sNx+myOLe
96          j1Lo  = 1-myOLs
97          j1Hi  = sNy+myOLn
98          k1Lo  = 1
99          k1Hi  = myNz
100          i2Lo  = 1-myOLw
101          i2Hi  = sNx+myOLe
102          j2Lo  = 1-myOLs
103          j2Hi  = sNy+myOLn
104          k2Lo  = 1
105          k2Hi  = myNz
106    
107    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
108    
109  C     For now tile<->tile exchanges are sequentialised through  C     Prevent anyone to access shared buffer while an other thread modifies it
 C     thread 1. This is a temporary feature for preliminary testing until  
 C     general tile decomposistion is in place (CNH April 11, 2001)  
110        CALL BAR2( myThid )        CALL BAR2( myThid )
111    
112  C     Receive messages or extract buffer copies  C--   Extract from buffer (either from level 1 if local exch,
113        DO I=myBxLo(myThid), myBxHi(myThid)  C                     or level 2 if coming from an other Proc)
114         thisTile=W2_myTileList(I)  C  AD: = fill buffer from my-tile-edge overlap-region, level 1 or 2 depending
115         nN=exch2_nNeighbours(thisTile)  C  AD:   on local (to this Proc) or remote Proc tile destination
116  CRG communication depends on order!!!        DO bj=myByLo(myThid), myByHi(myThid)
117  CRG       DO N=1,nN         DO bi=myBxLo(myThid), myBxHi(myThid)
118         DO N=nN,1,-1          thisTile=W2_myTileList(bi,bj)
119          farTile=exch2_neighbourId(N,thisTile)          nN=exch2_nNeighbours(thisTile)
120          tIlo =exch2_iLo(N,thisTile)          DO N=1,nN
121          tIhi =exch2_iHi(N,thisTile)            CALL EXCH2_GET_UV_BOUNDS(
122          tJlo =exch2_jLo(N,thisTile)       I               fieldCode, exchWidthX,
123          tJhi =exch2_jHi(N,thisTile)       I               thisTile, N,
124          CALL EXCH2_GET_RECV_BOUNDS(       O               tIlo1, tIhi1, tJlo1, tJhi1,
125       I       fieldCode, exchWidthX,       O               tIlo2, tIhi2, tJlo2, tJhi2,
126       O       tiStride, tjStride,       O               tiStride, tjStride,
127       U       tIlo, tiHi, tjLo, tjHi )       O               oIs1, oJs1, oIs2, oJs2,
128          tKLo=1       I               myThid )
129          tKHi=myNz            tKLo=1
130          tKStride=1            tKHi=myNz
131          i1Lo  = 1-myOLw            tKStride=1
132          i1Hi  = sNx+myOLe  
133          j1Lo  = 1-myOLs  C     From buffer, get my points
134          j1Hi  = sNy+myOLs  C     (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride) in "array1,2":
135          k1Lo  = 1  C     Note: when transferring data within a process:
136          k1Hi  = myNz  C      o e2Bufr entry to read is entry associated with opposing send record
137          i2Lo  = 1-myOLw  C      o e2_msgHandle entry to read is entry associated with opposing send record.
138          i2Hi  = sNx+myOLe            CALL EXCH2_AD_GET_RX2(
139          j2Lo  = 1-myOLs       I               tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
140          j2Hi  = sNy+myOLs       I               tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
141          k2Lo  = 1       I               tKlo, tKhi, tkStride,
142          k2Hi  = myNz       I               thisTile, N, bi, bj,
143  C       Receive from neighbour N to fill my points       I               e2BufrRecSize, W2_maxNeighbours, nSx, nSy,
144  C       (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)       O               iBuf1Filled(N,bi,bj), iBuf2Filled(N,bi,bj),
145  C       in "array".       O               e2Bufr1_RX, e2Bufr2_RX,
146  C       Note: when transferring data within a process:       U               array1(1-myOLw,1-myOLs,1,bi,bj),
147  C             o e2Bufr entry to read is entry associated with opposing send record       U               array2(1-myOLw,1-myOLs,1,bi,bj),
148  C             o e2_msgHandle entry to read is entry associated with opposing send       I               i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
149  C               record.       I               i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
150          CALL EXCH2_RECV_RX2_AD(       U               e2_msgHandles,
151       I       tIlo, tIhi, tiStride,       I               W2_myCommFlag(N,bi,bj), myThid )
152       I       tJlo, tJhi, tjStride,          ENDDO
      I       tKlo, tKhi, tkStride,  
      I       thisTile, I, N,  
      I       e2Bufr1_RX, e2Bufr2_RX, e2BufrRecSize,  
      I       MAX_NEIGHBOURS, nSx,  
      I       array1(1-myOLw,1-myOLs,1,I,1),  
      I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,  
      I       array2(1-myOLw,1-myOLs,1,I,1),  
      I       i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,  
      O       e2_msgHandles(1,N,I),  
      O       e2_msgHandles(2,N,I),  
      I       W2_myTileList,  
      I       W2_myCommFlag(N,I),  
      I       myThid )  
153         ENDDO         ENDDO
154        ENDDO        ENDDO
155    
156  C     without MPI: wait until all threads finish filling buffer  C     Wait until all threads finish filling buffer
157        CALL BAR2( myThid )        CALL BAR2( myThid )
158    
159  C     Post sends as messages or buffer copies  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
160        DO I=myBxLo(myThid), myBxHi(myThid)  
161         thisTile=W2_myTileList(I)  #ifdef ALLOW_USE_MPI
162         nN=exch2_nNeighbours(thisTile)  C  AD: all MPI part is acting on buffer and is identical to forward code,
163         DO N=1,nN  C  AD: except a) the buffer level: send from lev.2, receive into lev.1
164          farTile=exch2_neighbourId(N,thisTile)  C  AD:        b) the length of transferred buffer (<- match the ad_put/ad_get)
165          oN=exch2_opposingSend(N,thisTile)  
166          tIlo =exch2_iLo(oN,farTile)        _BEGIN_MASTER( myThid )
167          tIhi =exch2_iHi(oN,farTile)  
168          tJlo =exch2_jLo(oN,farTile)  C--   Send my data (in buffer, level 1) to target Process
169          tJhi =exch2_jHi(oN,farTile)        DO bj=1,nSy
170          CALL EXCH2_GET_SEND_BOUNDS(         DO bi=1,nSx
171       I       fieldCode, exchWidthX,          thisTile=W2_myTileList(bi,bj)
172       O       tiStride, tjStride,          nN=exch2_nNeighbours(thisTile)
173       U       tIlo, tiHi, tjLo, tjHi )          DO N=1,nN
174          tKLo=1  C-    Skip the call if this is an internal exchange
175          tKHi=myNz           IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
176          tKStride=1            CALL EXCH2_SEND_RX2(
177          i1Lo  = 1-myOLw       I               thisTile, N,
178          i1Hi  = sNx+myOLe       I               e2BufrRecSize,
179          j1Lo  = 1-myOLs       I               iBuf1Filled(N,bi,bj),    iBuf2Filled(N,bi,bj),
180          j1Hi  = sNy+myOLs       I               e2Bufr1_RX(1,N,bi,bj,2), e2Bufr2_RX(1,N,bi,bj,2),
181          k1Lo  = 1       O               e2_msgHandles(1,N,bi,bj),
182          k1Hi  = myNz       I               W2_myCommFlag(N,bi,bj), myThid )
183          i2Lo  = 1-myOLw           ENDIF
184          i2Hi  = sNx+myOLe          ENDDO
         j2Lo  = 1-myOLs  
         j2Hi  = sNy+myOLs  
         k2Lo  = 1  
         k2Hi  = myNz  
 C       Send to neighbour N to fill neighbor points  
 C       (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)  
 C       in its copy of "array".  
         CALL EXCH2_SEND_RX2_AD(  
      I       tIlo, tIhi, tiStride,  
      I       tJlo, tJhi, tjStride,  
      I       tKlo, tKhi, tkStride,  
      I       thisTile, N,  
      I       e2Bufr1_RX(1,N,I,1), e2BufrRecSize,  
      I       e2Bufr2_RX(1,N,I,1),  
      I       array1(1-myOLw,1-myOLs,1,I,1),  
      I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,  
      I       array2(1-myOLw,1-myOLs,1,I,1),  
      I       i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,  
      O       e2_msgHandles(1,N,I),  
      O       e2_msgHandles(2,N,I),  
      I       W2_myCommFlag(N,I), signOption,  
      I       myThid )  
185         ENDDO         ENDDO
186        ENDDO        ENDDO
187    
188  C     Clear message handles/locks  C--   Receive data (in buffer, level 1) from source Process
189        DO I=1,nSx        DO bj=1,nSy
190         thisTile=W2_myTileList(I)         DO bi=1,nSx
191         nN=exch2_nNeighbours(thisTile)          thisTile=W2_myTileList(bi,bj)
192         DO N=1,nN          nN=exch2_nNeighbours(thisTile)
193  C       Note: In a between process tile-tile data transport using          DO N=1,nN
194  C             MPI the sender needs to clear an Isend wait handle here.  C-    Skip the call if this is an internal exchange
195  C             In a within process tile-tile data transport using true           IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
196  C             shared address space/or direct transfer through commonly            farTile=exch2_neighbourId(N,thisTile)
197  C             addressable memory blocks the receiver needs to assert            oN = exch2_opposingSend(N,thisTile)
198  C             that is has consumed the buffer the sender filled here.            CALL EXCH2_GET_UV_BOUNDS(
199          farTile=exch2_neighbourId(N,thisTile)       I               fieldCode, exchWidthX,
200          IF     ( W2_myCommFlag(N,I) .EQ. 'M' ) THEN       I               farTile, oN,
201  #ifdef ALLOW_USE_MPI       O               tIlo1, tIhi1, tJlo1, tJhi1,
202           wHandle = e2_msgHandles(1,N,I)       O               tIlo2, tIhi2, tJlo2, tJhi2,
203           CALL MPI_Wait( wHandle, mpiStatus, mpiRc )       O               tiStride, tjStride,
204           wHandle = e2_msgHandles(2,N,I)       O               oIs1, oJs1, oIs2, oJs2,
205           CALL MPI_Wait( wHandle, mpiStatus, mpiRc )       I               myThid )
206  #endif            nri = 1 + (tIhi1-tIlo1)/tiStride
207          ELSEIF ( W2_myCommFlag(N,I) .EQ. 'P' ) THEN            nrj = 1 + (tJhi1-tJlo1)/tjStride
208          ELSE            iBufr1 = nri*nrj*myNz
209          ENDIF            nri = 1 + (tIhi2-tIlo2)/tiStride
210              nrj = 1 + (tJhi2-tJlo2)/tjStride
211              iBufr2 = nri*nrj*myNz
212    C       Receive from neighbour N to fill buffer and later on the array
213              CALL EXCH2_RECV_RX2(
214         I               thisTile, N,
215         I               e2BufrRecSize,
216         I               iBufr1, iBufr2,
217         I               e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
218         I               W2_myCommFlag(N,bi,bj), myThid )
219             ENDIF
220            ENDDO
221           ENDDO
222          ENDDO
223    
224    C--   Clear message handles/locks
225          DO bj=1,nSy
226           DO bi=1,nSx
227            thisTile=W2_myTileList(bi,bj)
228            nN=exch2_nNeighbours(thisTile)
229            DO N=1,nN
230    C     Note: In a between process tile-tile data transport using
231    C           MPI the sender needs to clear an Isend wait handle here.
232    C           In a within process tile-tile data transport using true
233    C           shared address space/or direct transfer through commonly
234    C           addressable memory blocks the receiver needs to assert
235    C           that he has consumed the buffer the sender filled here.
236             farTile=exch2_neighbourId(N,thisTile)
237             IF     ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
238              wHandle = e2_msgHandles(1,N,bi,bj)
239              CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
240              wHandle = e2_msgHandles(2,N,bi,bj)
241              CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
242             ELSEIF ( W2_myCommFlag(N,bi,bj) .EQ. 'P' ) THEN
243             ELSE
244             ENDIF
245            ENDDO
246           ENDDO
247          ENDDO
248    
249          _END_MASTER( myThid )
250    C     Everyone waits until master-thread finishes receiving
251          CALL BAR2( myThid )
252    
253    #endif /* ALLOW_USE_MPI */
254    
255    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
256    
257    C--   Post sends into buffer (buffer level 1):
258          DO bj=myByLo(myThid), myByHi(myThid)
259           DO bi=myBxLo(myThid), myBxHi(myThid)
260            thisTile=W2_myTileList(bi,bj)
261            nN=exch2_nNeighbours(thisTile)
262            DO N=1,nN
263              farTile=exch2_neighbourId(N,thisTile)
264              oN = exch2_opposingSend(N,thisTile)
265              CALL EXCH2_GET_UV_BOUNDS(
266         I               fieldCode, exchWidthX,
267         I               farTile, oN,
268         O               tIlo1, tIhi1, tJlo1, tJhi1,
269         O               tIlo2, tIhi2, tJlo2, tJhi2,
270         O               tiStride, tjStride,
271         O               oIs1, oJs1, oIs2, oJs2,
272         I               myThid )
273              tKLo=1
274              tKHi=myNz
275              tKStride=1
276    C-    Put my points in buffer for neighbour N to fill points
277    C     (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
278    C     in its copy of "array1" & "array2".
279              CALL EXCH2_AD_PUT_RX2(
280         I               tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
281         I               tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
282         I               tKlo, tKhi, tkStride,
283         I               oIs1, oJs1, oIs2, oJs2,
284         I               thisTile, N,
285         I               e2BufrRecSize,
286         O               e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
287         I               array1(1-myOLw,1-myOLs,1,bi,bj),
288         I               array2(1-myOLw,1-myOLs,1,bi,bj),
289         I               i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
290         I               i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
291         O               e2_msgHandles(1,N,bi,bj),
292         I               W2_myCommFlag(N,bi,bj), signOption, myThid )
293            ENDDO
294         ENDDO         ENDDO
295        ENDDO        ENDDO
296    
       CALL BAR2(myThid)  
     
297        RETURN        RETURN
298        END        END
299    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22