/[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.1 by heimbach, Fri Jul 27 22:15:23 2007 UTC revision 1.10 by jmc, Thu May 6 23:28:44 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            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
       INTEGER simulationMode  
57        INTEGER cornerMode        INTEGER cornerMode
58        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)  
59    
60  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
61  C     theSimulationMode :: Holds working copy of simulation mode  C     e2_msgHandles :: Synchronization and coordination data structure used to
62  C     theCornerMode     :: Holds working copy of corner mode  C                   :: coordinate access to e2Bufr1_RX or to regulate message
63  C     I,J,K,bl,bt,bn,bs :: Loop and index counters  C                   :: buffering. In PUT communication sender will increment
64  C     be,bw  C                   :: handle entry once data is ready in buffer. Receiver will
65        INTEGER theSimulationMode  C                   :: decrement handle once data is consumed from buffer.
66        INTEGER theCornerMode  C                   :: For MPI MSG communication MPI_Wait uses handle to check
67  c     INTEGER I,J,K  C                   :: Isend has cleared. This is done in routine after receives.
68  c     INTEGER bl,bt,bn,bs,be,bw  C     note: a) current implementation does not use e2_msgHandles for communication
69        INTEGER I  C              between threads: all-threads barriers are used (see CNH note below).
70    C              For a 2-threads synchro communication (future version),
71    C              e2_msgHandles should be shared (in common block, moved to BUFFER.h)
72          INTEGER bi, bj
73  C     Variables for working through W2 topology  C     Variables for working through W2 topology
74        INTEGER e2_msgHandles(2,MAX_NEIGHBOURS, nSx)        INTEGER e2_msgHandles( 2, W2_maxNeighbours, nSx, nSy )
75        INTEGER thisTile, farTile, N, nN, oN        INTEGER thisTile, farTile, N, nN, oN
76        INTEGER tIlo, tIhi, tJlo, tJhi, tKlo, tKhi        INTEGER tIlo1, tIhi1, tJlo1, tJhi1, oIs1, oJs1
77        INTEGER tIStride, tJStride, tKStride        INTEGER tIlo2, tIhi2, tJlo2, tJhi2, oIs2, oJs2
78          INTEGER tIStride, tJStride
79          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
 C     == Statement function ==  
 C     tilemod - Permutes indices to return neighboring tile index on  
 C               six face cube.  
 c     INTEGER tilemod  
82    
 C     MPI stuff (should be in a routine call)  
83  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
84          INTEGER iBufr1, iBufr2, nri, nrj
85    C     MPI stuff (should be in a routine call)
86        INTEGER mpiStatus(MPI_STATUS_SIZE)        INTEGER mpiStatus(MPI_STATUS_SIZE)
87        INTEGER mpiRc        INTEGER mpiRc
88        INTEGER wHandle        INTEGER wHandle
89  #endif  #endif
90  CEOP  CEOP
91    
92        theSimulationMode = simulationMode  C-    Tile size of arrays to exchange:
93        theCornerMode     = cornerMode        i1Lo  = 1-myOLw
94          i1Hi  = sNx+myOLe
95          j1Lo  = 1-myOLs
96          j1Hi  = sNy+myOLn
97          k1Lo  = 1
98          k1Hi  = myNz
99          i2Lo  = 1-myOLw
100          i2Hi  = sNx+myOLe
101          j2Lo  = 1-myOLs
102          j2Hi  = sNy+myOLn
103          k2Lo  = 1
104          k2Hi  = myNz
105    
106    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
107    
108  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)  
109        CALL BAR2( myThid )        CALL BAR2( myThid )
110    
111  C     Receive messages or extract buffer copies  C--   Extract from buffer (either from level 1 if local exch,
112        DO I=myBxLo(myThid), myBxHi(myThid)  C                     or level 2 if coming from an other Proc)
113         thisTile=W2_myTileList(I)  C  AD: = fill buffer from my-tile-edge overlap-region, level 1 or 2 depending
114         nN=exch2_nNeighbours(thisTile)  C  AD:   on local (to this Proc) or remote Proc tile destination
115  CRG communication depends on order!!!        DO bj=myByLo(myThid), myByHi(myThid)
116  CRG       DO N=1,nN         DO bi=myBxLo(myThid), myBxHi(myThid)
117         DO N=nN,1,-1          thisTile=W2_myTileList(bi,bj)
118          farTile=exch2_neighbourId(N,thisTile)          nN=exch2_nNeighbours(thisTile)
119          oN=exch2_opposingSend_Record(N,thisTile)          DO N=1,nN
120          tIlo =exch2_itlo_c(oN,farTile)            CALL EXCH2_GET_UV_BOUNDS(
121          tIhi =exch2_ithi_c(oN,farTile)       I               fieldCode, exchWidthX,
122          tJlo =exch2_jtlo_c(oN,farTile)       I               thisTile, N,
123          tJhi =exch2_jthi_c(oN,farTile)       O               tIlo1, tIhi1, tJlo1, tJhi1,
124          CALL EXCH2_GET_RECV_BOUNDS(       O               tIlo2, tIhi2, tJlo2, tJhi2,
125       I       fieldCode, exchWidthX,       O               tiStride, tjStride,
126       O       tiStride, tjStride,       O               oIs1, oJs1, oIs2, oJs2,
127       U       tIlo, tiHi, tjLo, tjHi )       I               myThid )
128          tKLo=1            tKLo=1
129          tKHi=myNz            tKHi=myNz
130          tKStride=1            tKStride=1
131          i1Lo  = 1-myOLw  
132          i1Hi  = sNx+myOLe  C     From buffer, get my points
133          j1Lo  = 1-myOLs  C     (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride) in "array1,2":
134          j1Hi  = sNy+myOLs  C     Note: when transferring data within a process:
135          k1Lo  = 1  C      o e2Bufr entry to read is entry associated with opposing send record
136          k1Hi  = myNz  C      o e2_msgHandle entry to read is entry associated with opposing send record.
137          i2Lo  = 1-myOLw            CALL EXCH2_AD_GET_RX2(
138          i2Hi  = sNx+myOLe       I               tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
139          j2Lo  = 1-myOLs       I               tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
140          j2Hi  = sNy+myOLs       I               tKlo, tKhi, tkStride,
141          k2Lo  = 1       I               thisTile, N, bi, bj,
142          k2Hi  = myNz       I               e2BufrRecSize, W2_maxNeighbours, nSx, nSy,
143  C       Receive from neighbour N to fill my points       O               iBuf1Filled(N,bi,bj), iBuf2Filled(N,bi,bj),
144  C       (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)       O               e2Bufr1_RX, e2Bufr2_RX,
145  C       in "array".       U               array1(1-myOLw,1-myOLs,1,bi,bj),
146  C       Note: when transferring data within a process:       U               array2(1-myOLw,1-myOLs,1,bi,bj),
147  C             o e2Bufr entry to read is entry associated with opposing send record       I               i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
148  C             o e2_msgHandle entry to read is entry associated with opposing send       I               i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
149  C               record.       U               e2_msgHandles,
150          CALL EXCH2_RECV_RX2_AD(       I               W2_myCommFlag(N,bi,bj), myThid )
151       I       tIlo, tIhi, tiStride,          ENDDO
      I       tJlo, tJhi, tjStride,  
      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 )  
152         ENDDO         ENDDO
153        ENDDO        ENDDO
154    
155  C     without MPI: wait until all threads finish filling buffer  C     Wait until all threads finish filling buffer
156        CALL BAR2( myThid )        CALL BAR2( myThid )
157    
158  C     Post sends as messages or buffer copies  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
159        DO I=myBxLo(myThid), myBxHi(myThid)  
160         thisTile=W2_myTileList(I)  #ifdef ALLOW_USE_MPI
161         nN=exch2_nNeighbours(thisTile)  C  AD: all MPI part is acting on buffer and is identical to forward code,
162         DO N=1,nN  C  AD: except a) the buffer level: send from lev.2, receive into lev.1
163          farTile=exch2_neighbourId(N,thisTile)  C  AD:        b) the length of transferred buffer (<- match the ad_put/ad_get)
164          tIlo =exch2_itlo_c(N,thisTile)  
165          tIhi =exch2_ithi_c(N,thisTile)        _BEGIN_MASTER( myThid )
166          tJlo =exch2_jtlo_c(N,thisTile)  
167          tJhi =exch2_jthi_c(N,thisTile)  C--   Send my data (in buffer, level 1) to target Process
168          CALL EXCH2_GET_SEND_BOUNDS(        DO bj=1,nSy
169       I       fieldCode, exchWidthX,         DO bi=1,nSx
170       O       tiStride, tjStride,          thisTile=W2_myTileList(bi,bj)
171       U       tIlo, tiHi, tjLo, tjHi )          nN=exch2_nNeighbours(thisTile)
172          tKLo=1          DO N=1,nN
173          tKHi=myNz  C-    Skip the call if this is an internal exchange
174          tKStride=1           IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
175          i1Lo  = 1-myOLw            CALL EXCH2_SEND_RX2(
176          i1Hi  = sNx+myOLe       I               thisTile, N,
177          j1Lo  = 1-myOLs       I               e2BufrRecSize,
178          j1Hi  = sNy+myOLs       I               iBuf1Filled(N,bi,bj),    iBuf2Filled(N,bi,bj),
179          k1Lo  = 1       I               e2Bufr1_RX(1,N,bi,bj,2), e2Bufr2_RX(1,N,bi,bj,2),
180          k1Hi  = myNz       O               e2_msgHandles(1,N,bi,bj),
181          i2Lo  = 1-myOLw       I               W2_myCommFlag(N,bi,bj), myThid )
182          i2Hi  = sNx+myOLe           ENDIF
183          j2Lo  = 1-myOLs          ENDDO
         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 )  
184         ENDDO         ENDDO
185        ENDDO        ENDDO
186    
187  C     Clear message handles/locks  C--   Receive data (in buffer, level 1) from source Process
188        DO I=1,nSx        DO bj=1,nSy
189         thisTile=W2_myTileList(I)         DO bi=1,nSx
190         nN=exch2_nNeighbours(thisTile)          thisTile=W2_myTileList(bi,bj)
191         DO N=1,nN          nN=exch2_nNeighbours(thisTile)
192  C       Note: In a between process tile-tile data transport using          DO N=1,nN
193  C             MPI the sender needs to clear an Isend wait handle here.  C-    Skip the call if this is an internal exchange
194  C             In a within process tile-tile data transport using true           IF ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
195  C             shared address space/or direct transfer through commonly            farTile=exch2_neighbourId(N,thisTile)
196  C             addressable memory blocks the receiver needs to assert            oN = exch2_opposingSend(N,thisTile)
197  C             that is has consumed the buffer the sender filled here.            CALL EXCH2_GET_UV_BOUNDS(
198          farTile=exch2_neighbourId(N,thisTile)       I               fieldCode, exchWidthX,
199          IF     ( W2_myCommFlag(N,I) .EQ. 'M' ) THEN       I               farTile, oN,
200  #ifdef ALLOW_USE_MPI       O               tIlo1, tIhi1, tJlo1, tJhi1,
201           wHandle = e2_msgHandles(1,N,I)       O               tIlo2, tIhi2, tJlo2, tJhi2,
202           CALL MPI_Wait( wHandle, mpiStatus, mpiRc )       O               tiStride, tjStride,
203           wHandle = e2_msgHandles(2,N,I)       O               oIs1, oJs1, oIs2, oJs2,
204           CALL MPI_Wait( wHandle, mpiStatus, mpiRc )       I               myThid )
205  #endif            nri = 1 + (tIhi1-tIlo1)/tiStride
206          ELSEIF ( W2_myCommFlag(N,I) .EQ. 'P' ) THEN            nrj = 1 + (tJhi1-tJlo1)/tjStride
207          ELSE            iBufr1 = nri*nrj*myNz
208          ENDIF            nri = 1 + (tIhi2-tIlo2)/tiStride
209              nrj = 1 + (tJhi2-tJlo2)/tjStride
210              iBufr2 = nri*nrj*myNz
211    C       Receive from neighbour N to fill buffer and later on the array
212              CALL EXCH2_RECV_RX2(
213         I               thisTile, N,
214         I               e2BufrRecSize,
215         I               iBufr1, iBufr2,
216         I               e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
217         I               W2_myCommFlag(N,bi,bj), myThid )
218             ENDIF
219            ENDDO
220           ENDDO
221          ENDDO
222    
223    C--   Clear message handles/locks
224          DO bj=1,nSy
225           DO bi=1,nSx
226            thisTile=W2_myTileList(bi,bj)
227            nN=exch2_nNeighbours(thisTile)
228            DO N=1,nN
229    C     Note: In a between process tile-tile data transport using
230    C           MPI the sender needs to clear an Isend wait handle here.
231    C           In a within process tile-tile data transport using true
232    C           shared address space/or direct transfer through commonly
233    C           addressable memory blocks the receiver needs to assert
234    C           that he has consumed the buffer the sender filled here.
235             farTile=exch2_neighbourId(N,thisTile)
236             IF     ( W2_myCommFlag(N,bi,bj) .EQ. 'M' ) THEN
237              wHandle = e2_msgHandles(1,N,bi,bj)
238              CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
239              wHandle = e2_msgHandles(2,N,bi,bj)
240              CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
241             ELSEIF ( W2_myCommFlag(N,bi,bj) .EQ. 'P' ) THEN
242             ELSE
243             ENDIF
244            ENDDO
245           ENDDO
246          ENDDO
247    
248          _END_MASTER( myThid )
249    C     Everyone waits until master-thread finishes receiving
250          CALL BAR2( myThid )
251    
252    #endif /* ALLOW_USE_MPI */
253    
254    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
255    
256    C--   Post sends into buffer (buffer level 1):
257          DO bj=myByLo(myThid), myByHi(myThid)
258           DO bi=myBxLo(myThid), myBxHi(myThid)
259            thisTile=W2_myTileList(bi,bj)
260            nN=exch2_nNeighbours(thisTile)
261            DO N=1,nN
262              farTile=exch2_neighbourId(N,thisTile)
263              oN = exch2_opposingSend(N,thisTile)
264              CALL EXCH2_GET_UV_BOUNDS(
265         I               fieldCode, exchWidthX,
266         I               farTile, oN,
267         O               tIlo1, tIhi1, tJlo1, tJhi1,
268         O               tIlo2, tIhi2, tJlo2, tJhi2,
269         O               tiStride, tjStride,
270         O               oIs1, oJs1, oIs2, oJs2,
271         I               myThid )
272              tKLo=1
273              tKHi=myNz
274              tKStride=1
275    C-    Put my points in buffer for neighbour N to fill points
276    C     (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
277    C     in its copy of "array1" & "array2".
278              CALL EXCH2_AD_PUT_RX2(
279         I               tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
280         I               tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
281         I               tKlo, tKhi, tkStride,
282         I               oIs1, oJs1, oIs2, oJs2,
283         I               thisTile, N,
284         I               e2BufrRecSize,
285         O               e2Bufr1_RX(1,N,bi,bj,1), e2Bufr2_RX(1,N,bi,bj,1),
286         I               array1(1-myOLw,1-myOLs,1,bi,bj),
287         I               array2(1-myOLw,1-myOLs,1,bi,bj),
288         I               i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
289         I               i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
290         O               e2_msgHandles(1,N,bi,bj),
291         I               W2_myCommFlag(N,bi,bj), signOption, myThid )
292            ENDDO
293         ENDDO         ENDDO
294        ENDDO        ENDDO
295    
       CALL BAR2(myThid)  
     
296        RETURN        RETURN
297        END        END
298    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22