/[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.6 by jmc, Sat May 30 21:26:31 2009 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 hanlde 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     For now tile<->tile exchanges are sequentialised through  C     For now tile <-> tile exchanges are sequentialised through
108  C     thread 1. This is a temporary feature for preliminary testing until  C     thread 1. This is a temporary feature for preliminary testing until
109  C     general tile decomposistion is in place (CNH April 11, 2001)  C     general tile decomposition is in place (CNH April 11, 2001)
110        CALL BAR2( myThid )        CALL BAR2( myThid )
111    
112  C     Receive messages or extract buffer copies  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
113        DO I=myBxLo(myThid), myBxHi(myThid)  
114         thisTile=W2_myTileList(I)  C--   Extract from buffer (either from level 1 if local exch,
115         nN=exch2_nNeighbours(thisTile)  C                     or level 2 if coming from an other Proc)
116  CRG communication depends on order!!!  C  AD: = fill buffer from my-tile-edge overlap-region, level 1 or 2 depending
117  CRG       DO N=1,nN  C  AD:   on local (to this Proc) or remote Proc tile destination
118         DO N=nN,1,-1        DO bj=myByLo(myThid), myByHi(myThid)
119          farTile=exch2_neighbourId(N,thisTile)         DO bi=myBxLo(myThid), myBxHi(myThid)
120          oN=exch2_opposingSend_Record(N,thisTile)          thisTile=W2_myTileList(bi)
121          tIlo =exch2_itlo_c(oN,farTile)          nN=exch2_nNeighbours(thisTile)
122          tIhi =exch2_ithi_c(oN,farTile)          DO N=1,nN
123          tJlo =exch2_jtlo_c(oN,farTile)            CALL EXCH2_GET_UV_BOUNDS(
124          tJhi =exch2_jthi_c(oN,farTile)       I               fieldCode, exchWidthX,
125          CALL EXCH2_GET_RECV_BOUNDS(       I               thisTile, N,
126       I       fieldCode, exchWidthX,       O               tIlo1, tIhi1, tJlo1, tJhi1,
127       O       tiStride, tjStride,       O               tIlo2, tIhi2, tJlo2, tJhi2,
128       U       tIlo, tiHi, tjLo, tjHi )       O               tiStride, tjStride,
129          tKLo=1       O               oIs1, oJs1, oIs2, oJs2,
130          tKHi=myNz       I               myThid )
131          tKStride=1            tKLo=1
132          i1Lo  = 1-myOLw            tKHi=myNz
133          i1Hi  = sNx+myOLe            tKStride=1
134          j1Lo  = 1-myOLs  
135          j1Hi  = sNy+myOLs  C     From buffer, get my points
136          k1Lo  = 1  C     (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride) in "array1,2":
137          k1Hi  = myNz  C     Note: when transferring data within a process:
138          i2Lo  = 1-myOLw  C      o e2Bufr entry to read is entry associated with opposing send record
139          i2Hi  = sNx+myOLe  C      o e2_msgHandle entry to read is entry associated with opposing send record.
140          j2Lo  = 1-myOLs            CALL EXCH2_AD_GET_RX2(
141          j2Hi  = sNy+myOLs       I               tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
142          k2Lo  = 1       I               tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
143          k2Hi  = myNz       I               tKlo, tKhi, tkStride,
144  C       Receive from neighbour N to fill my points       I               thisTile, N, bi, bj,
145  C       (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)       I               e2BufrRecSize, W2_maxNeighbours, nSx, nSy,
146  C       in "array".       O               iBuf1Filled(N,bi), iBuf2Filled(N,bi),
147  C       Note: when transferring data within a process:       O               e2Bufr1_RX, e2Bufr2_RX,
148  C             o e2Bufr entry to read is entry associated with opposing send record       U               array1(1-myOLw,1-myOLs,1,bi,bj),
149  C             o e2_msgHandle entry to read is entry associated with opposing send       U               array2(1-myOLw,1-myOLs,1,bi,bj),
150  C               record.       I               i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
151          CALL EXCH2_RECV_RX2_AD(       I               i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
152       I       tIlo, tIhi, tiStride,       U               e2_msgHandles,
153       I       tJlo, tJhi, tjStride,       I               W2_myCommFlag(N,bi), myThid )
154       I       tKlo, tKhi, tkStride,          ENDDO
      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 )  
155         ENDDO         ENDDO
156        ENDDO        ENDDO
157    
158  C     without MPI: wait until all threads finish filling buffer  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
159    
160    #ifdef ALLOW_USE_MPI
161    C  AD: all MPI part is acting on buffer and is identical to forward code,
162    C  AD: except a) the buffer level: send from lev.2, receive into lev.1
163    C  AD:        b) the length of transfered buffer (<- match the ad_put/ad_get)
164    
165    C     wait until all threads finish filling buffer
166        CALL BAR2( myThid )        CALL BAR2( myThid )
167          _BEGIN_MASTER( myThid )
168    
169  C     Post sends as messages or buffer copies  C--   Send my data (in buffer, level 1) to target Process
170        DO I=myBxLo(myThid), myBxHi(myThid)        DO bj=1,nSy
171         thisTile=W2_myTileList(I)         DO bi=1,nSx
172         nN=exch2_nNeighbours(thisTile)          thisTile=W2_myTileList(bi)
173         DO N=1,nN          nN=exch2_nNeighbours(thisTile)
174          farTile=exch2_neighbourId(N,thisTile)          DO N=1,nN
175          tIlo =exch2_itlo_c(N,thisTile)  C-    Skip the call if this is an internal exchange
176          tIhi =exch2_ithi_c(N,thisTile)           IF ( W2_myCommFlag(N,bi) .EQ. 'M' ) THEN
177          tJlo =exch2_jtlo_c(N,thisTile)            CALL EXCH2_SEND_RX2(
178          tJhi =exch2_jthi_c(N,thisTile)       I               thisTile, N,
179          CALL EXCH2_GET_SEND_BOUNDS(       I               e2BufrRecSize,
180       I       fieldCode, exchWidthX,       I               iBuf1Filled(N,bi),    iBuf2Filled(N,bi),
181       O       tiStride, tjStride,       I               e2Bufr1_RX(1,N,bi,2), e2Bufr2_RX(1,N,bi,2),
182       U       tIlo, tiHi, tjLo, tjHi )       O               e2_msgHandles(1,N,bi,bj),
183          tKLo=1       I               W2_myCommFlag(N,bi), myThid )
184          tKHi=myNz           ENDIF
185          tKStride=1          ENDDO
         i1Lo  = 1-myOLw  
         i1Hi  = sNx+myOLe  
         j1Lo  = 1-myOLs  
         j1Hi  = sNy+myOLs  
         k1Lo  = 1  
         k1Hi  = myNz  
         i2Lo  = 1-myOLw  
         i2Hi  = sNx+myOLe  
         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 )  
186         ENDDO         ENDDO
187        ENDDO        ENDDO
188    
189  C     Clear message handles/locks  C--   Receive data (in buffer, level 1) from source Process
190        DO I=1,nSx        DO bj=1,nSy
191         thisTile=W2_myTileList(I)         DO bi=1,nSx
192         nN=exch2_nNeighbours(thisTile)          thisTile=W2_myTileList(bi)
193         DO N=1,nN          nN=exch2_nNeighbours(thisTile)
194  C       Note: In a between process tile-tile data transport using          DO N=1,nN
195  C             MPI the sender needs to clear an Isend wait handle here.  C-    Skip the call if this is an internal exchange
196  C             In a within process tile-tile data transport using true           IF ( W2_myCommFlag(N,bi) .EQ. 'M' ) THEN
197  C             shared address space/or direct transfer through commonly            farTile=exch2_neighbourId(N,thisTile)
198  C             addressable memory blocks the receiver needs to assert            oN = exch2_opposingSend(N,thisTile)
199  C             that is has consumed the buffer the sender filled here.            CALL EXCH2_GET_UV_BOUNDS(
200          farTile=exch2_neighbourId(N,thisTile)       I               fieldCode, exchWidthX,
201          IF     ( W2_myCommFlag(N,I) .EQ. 'M' ) THEN       I               farTile, oN,
202  #ifdef ALLOW_USE_MPI       O               tIlo1, tIhi1, tJlo1, tJhi1,
203           wHandle = e2_msgHandles(1,N,I)       O               tIlo2, tIhi2, tJlo2, tJhi2,
204           CALL MPI_Wait( wHandle, mpiStatus, mpiRc )       O               tiStride, tjStride,
205           wHandle = e2_msgHandles(2,N,I)       O               oIs1, oJs1, oIs2, oJs2,
206           CALL MPI_Wait( wHandle, mpiStatus, mpiRc )       I               myThid )
207  #endif            nri = 1 + (tIhi1-tIlo1)/tiStride
208          ELSEIF ( W2_myCommFlag(N,I) .EQ. 'P' ) THEN            nrj = 1 + (tJhi1-tJlo1)/tjStride
209          ELSE            iBufr1 = nri*nrj*myNz
210          ENDIF            nri = 1 + (tIhi2-tIlo2)/tiStride
211              nrj = 1 + (tJhi2-tJlo2)/tjStride
212              iBufr2 = nri*nrj*myNz
213    C       Receive from neighbour N to fill buffer and later on the array
214              CALL EXCH2_RECV_RX2(
215         I               thisTile, N,
216         I               e2BufrRecSize,
217         I               iBufr1, iBufr2,
218         I               e2Bufr1_RX(1,N,bi,1), e2Bufr2_RX(1,N,bi,1),
219         I               W2_myCommFlag(N,bi), myThid )
220             ENDIF
221            ENDDO
222           ENDDO
223          ENDDO
224    
225    C--   Clear message handles/locks
226          DO bj=1,nSy
227           DO bi=1,nSx
228            thisTile=W2_myTileList(bi)
229            nN=exch2_nNeighbours(thisTile)
230            DO N=1,nN
231    C     Note: In a between process tile-tile data transport using
232    C           MPI the sender needs to clear an Isend wait handle here.
233    C           In a within process tile-tile data transport using true
234    C           shared address space/or direct transfer through commonly
235    C           addressable memory blocks the receiver needs to assert
236    C           that he has consumed the buffer the sender filled here.
237             farTile=exch2_neighbourId(N,thisTile)
238             IF     ( W2_myCommFlag(N,bi) .EQ. 'M' ) THEN
239              wHandle = e2_msgHandles(1,N,bi,bj)
240              CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
241              wHandle = e2_msgHandles(2,N,bi,bj)
242              CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
243             ELSEIF ( W2_myCommFlag(N,bi) .EQ. 'P' ) THEN
244             ELSE
245             ENDIF
246            ENDDO
247           ENDDO
248          ENDDO
249    
250          _END_MASTER( myThid )
251    #endif /* ALLOW_USE_MPI */
252    
253    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
254    C     Wait until all threads finish receiving or filling buffer
255          CALL BAR2( myThid )
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)
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,1), e2Bufr2_RX(1,N,bi,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), signOption, myThid )
293            ENDDO
294         ENDDO         ENDDO
295        ENDDO        ENDDO
296    
297        CALL BAR2(myThid)        CALL BAR2(myThid)
298      
299        RETURN        RETURN
300        END        END
301    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6

  ViewVC Help
Powered by ViewVC 1.1.22