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

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

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

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