/[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.3 by jmc, Fri Aug 1 00:45:16 2008 UTC
# Line 9  CBOP Line 9  CBOP
9  C     !ROUTINE: EXCH_RX2_CUBE  C     !ROUTINE: EXCH_RX2_CUBE
10    
11  C     !INTERFACE:  C     !INTERFACE:
12        SUBROUTINE EXCH2_RX2_CUBE_AD(        SUBROUTINE EXCH2_RX2_CUBE_AD(
13       U            array1, array2, signOption, fieldCode,       U            array1, array2, signOption, fieldCode,
14       I            myOLw, myOLe, myOLn, myOLs, myNz,       I            myOLw, myOLe, myOLn, myOLs, myNz,
15       I            exchWidthX, exchWidthY,       I            exchWidthX, exchWidthY,
# Line 35  C     myOLn Line 35  C     myOLn
35  C     myOLs  C     myOLs
36  C     exchWidthX :: Width of data region exchanged in X.  C     exchWidthX :: Width of data region exchanged in X.
37  C     exchWidthY :: Width of data region exchanged in Y.  C     exchWidthY :: Width of data region exchanged in Y.
38  C     myThid         :: Thread number of this instance of S/R EXCH...  C     myThid     :: Thread number of this instance of S/R EXCH...
39        LOGICAL     signOption        LOGICAL     signOption
40        CHARACTER*2 fieldCode        CHARACTER*2 fieldCode
41        INTEGER myOLw        INTEGER myOLw
# Line 49  C     myThid         :: Thread number of Line 49  C     myThid         :: Thread number of
49        INTEGER cornerMode        INTEGER cornerMode
50        INTEGER myThid        INTEGER myThid
51        _RX array1(1-myOLw:sNx+myOLe,        _RX array1(1-myOLw:sNx+myOLe,
52       &           1-myOLs:sNy+myOLn,       &           1-myOLs:sNy+myOLn,
53       &           myNZ, nSx, nSy)       &           myNZ, nSx, nSy)
54        _RX array2(1-myOLw:sNx+myOLe,        _RX array2(1-myOLw:sNx+myOLe,
55       &           1-myOLs:sNy+myOLn,       &           1-myOLs:sNy+myOLn,
56       &           myNZ, nSx, nSy)       &           myNZ, nSx, nSy)
57    
58  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
59  C     theSimulationMode :: Holds working copy of simulation mode  C     theSimulationMode :: Holds working copy of simulation mode
60  C     theCornerMode     :: Holds working copy of corner mode  C     theCornerMode     :: Holds working copy of corner mode
61  C     I,J,K,bl,bt,bn,bs :: Loop and index counters  C     I,J,K             :: Loop and index counters
 C     be,bw  
62        INTEGER theSimulationMode        INTEGER theSimulationMode
63        INTEGER theCornerMode        INTEGER theCornerMode
64  c     INTEGER I,J,K  c     INTEGER I,J,K
65  c     INTEGER bl,bt,bn,bs,be,bw  c     INTEGER bl,bt,bn,bs,be,bw
66        INTEGER I        INTEGER bi
67  C     Variables for working through W2 topology  C     Variables for working through W2 topology
68        INTEGER e2_msgHandles(2,MAX_NEIGHBOURS, nSx)        INTEGER e2_msgHandles(2,MAX_NEIGHBOURS, nSx)
69        INTEGER thisTile, farTile, N, nN, oN        INTEGER thisTile, farTile, N, nN, oN
70        INTEGER tIlo, tIhi, tJlo, tJhi, tKlo, tKhi        INTEGER tIlo1, tIhi1, tJlo1, tJhi1, oIs1, oJs1
71        INTEGER tIStride, tJStride, tKStride        INTEGER tIlo2, tIhi2, tJlo2, tJhi2, oIs2, oJs2
72          INTEGER tIStride, tJStride
73          INTEGER tKlo, tKhi, tKStride
74        INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi        INTEGER i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi
75        INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi        INTEGER i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi
76  C     == Statement function ==  C     == Statement function ==
# Line 94  C     general tile decomposistion is in Line 95  C     general tile decomposistion is in
95        CALL BAR2( myThid )        CALL BAR2( myThid )
96    
97  C     Receive messages or extract buffer copies  C     Receive messages or extract buffer copies
98        DO I=myBxLo(myThid), myBxHi(myThid)        DO bi=myBxLo(myThid), myBxHi(myThid)
99         thisTile=W2_myTileList(I)         thisTile=W2_myTileList(bi)
100         nN=exch2_nNeighbours(thisTile)         nN=exch2_nNeighbours(thisTile)
101  CRG communication depends on order!!!  CRG communication depends on order!!!
102  CRG       DO N=1,nN  CRG    DO N=1,nN
103         DO N=nN,1,-1  c      DO N=nN,1,-1
104    C- this is no longer the case after 2008-07-31 (changes in index range)
105           DO N=1,nN
106          farTile=exch2_neighbourId(N,thisTile)          farTile=exch2_neighbourId(N,thisTile)
107          tIlo =exch2_iLo(N,thisTile)          oN=exch2_opposingSend(N,thisTile)
108          tIhi =exch2_iHi(N,thisTile)          tIlo1 = exch2_iLo(N,thisTile)
109          tJlo =exch2_jLo(N,thisTile)          tIhi1 = exch2_iHi(N,thisTile)
110          tJhi =exch2_jHi(N,thisTile)          tJlo1 = exch2_jLo(N,thisTile)
111          CALL EXCH2_GET_RECV_BOUNDS(          tJhi1 = exch2_jHi(N,thisTile)
112       I       fieldCode, exchWidthX,          oIs1  = exch2_oi(oN,farTile)
113       O       tiStride, tjStride,          oJs1  = exch2_oj(oN,farTile)
114       U       tIlo, tiHi, tjLo, tjHi )          CALL EXCH2_GET_UV_BOUNDS(
115         I             fieldCode, exchWidthX,
116         I             exch2_isWedge(thisTile), exch2_isEedge(thisTile),
117         I             exch2_isSedge(thisTile), exch2_isNedge(thisTile),
118         U             tIlo1, tIhi1, tJlo1, tJhi1,
119         O             tIlo2, tIhi2, tJlo2, tJhi2,
120         O             tiStride, tjStride,
121         I             exch2_pij(1,oN,farTile),
122         U             oIs1, oJs1,
123         O             oIs2, oJs2,
124         I             myThid )
125          tKLo=1          tKLo=1
126          tKHi=myNz          tKHi=myNz
127          tKStride=1          tKStride=1
# Line 124  CRG       DO N=1,nN Line 137  CRG       DO N=1,nN
137          j2Hi  = sNy+myOLs          j2Hi  = sNy+myOLs
138          k2Lo  = 1          k2Lo  = 1
139          k2Hi  = myNz          k2Hi  = myNz
140  C       Receive from neighbour N to fill my points  C       Receive from neighbour N to fill my points
141  C       (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)  C       (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
142  C       in "array".  C       in "array".
143  C       Note: when transferring data within a process:  C       Note: when transferring data within a process:
144  C             o e2Bufr entry to read is entry associated with opposing send record  C             o e2Bufr entry to read is entry associated with opposing send record
145  C             o e2_msgHandle entry to read is entry associated with opposing send  C             o e2_msgHandle entry to read is entry associated with opposing send
146  C               record.  C               record.
147          CALL EXCH2_RECV_RX2_AD(          CALL EXCH2_RECV_RX2_AD(
148       I       tIlo, tIhi, tiStride,       I       tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
149       I       tJlo, tJhi, tjStride,       I       tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
150       I       tKlo, tKhi, tkStride,       I       tKlo, tKhi, tkStride,
151       I       thisTile, I, N,       I       thisTile, bi, N,
152       I       e2Bufr1_RX, e2Bufr2_RX, e2BufrRecSize,       I       e2Bufr1_RX, e2Bufr2_RX, e2BufrRecSize,
153       I       MAX_NEIGHBOURS, nSx,       I       MAX_NEIGHBOURS, nSx,
154       I       array1(1-myOLw,1-myOLs,1,I,1),       I       array1(1-myOLw,1-myOLs,1,bi,1),
155       I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,       I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
156       I       array2(1-myOLw,1-myOLs,1,I,1),       I       array2(1-myOLw,1-myOLs,1,bi,1),
157       I       i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,       I       i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
158       O       e2_msgHandles(1,N,I),       O       e2_msgHandles(1,N,bi),
159       O       e2_msgHandles(2,N,I),       O       e2_msgHandles(2,N,bi),
160       I       W2_myTileList,       I       W2_myTileList,
161       I       W2_myCommFlag(N,I),       I       W2_myCommFlag(N,bi),
162       I       myThid )       I       myThid )
163         ENDDO         ENDDO
164        ENDDO        ENDDO
# Line 154  C     without MPI: wait until all thread Line 167  C     without MPI: wait until all thread
167        CALL BAR2( myThid )        CALL BAR2( myThid )
168    
169  C     Post sends as messages or buffer copies  C     Post sends as messages or buffer copies
170        DO I=myBxLo(myThid), myBxHi(myThid)        DO bi=myBxLo(myThid), myBxHi(myThid)
171         thisTile=W2_myTileList(I)         thisTile=W2_myTileList(bi)
172         nN=exch2_nNeighbours(thisTile)         nN=exch2_nNeighbours(thisTile)
173         DO N=1,nN         DO N=1,nN
174          farTile=exch2_neighbourId(N,thisTile)          farTile=exch2_neighbourId(N,thisTile)
175          oN=exch2_opposingSend(N,thisTile)          oN=exch2_opposingSend(N,thisTile)
176          tIlo =exch2_iLo(oN,farTile)          tIlo1 = exch2_iLo(oN,farTile)
177          tIhi =exch2_iHi(oN,farTile)          tIhi1 = exch2_iHi(oN,farTile)
178          tJlo =exch2_jLo(oN,farTile)          tJlo1 = exch2_jLo(oN,farTile)
179          tJhi =exch2_jHi(oN,farTile)          tJhi1 = exch2_jHi(oN,farTile)
180          CALL EXCH2_GET_SEND_BOUNDS(          oIs1  = exch2_oi(N,thisTile)
181       I       fieldCode, exchWidthX,          oJs1  = exch2_oj(N,thisTile)
182       O       tiStride, tjStride,          CALL EXCH2_GET_UV_BOUNDS(
183       U       tIlo, tiHi, tjLo, tjHi )       I             fieldCode, exchWidthX,
184         I             exch2_isWedge(farTile), exch2_isEedge(farTile),
185         I             exch2_isSedge(farTile), exch2_isNedge(farTile),
186         U             tIlo1, tIhi1, tJlo1, tJhi1,
187         O             tIlo2, tIhi2, tJlo2, tJhi2,
188         O             tiStride, tjStride,
189         I             exch2_pij(1,N,thisTile),
190         U             oIs1, oJs1,
191         O             oIs2, oJs2,
192         I             myThid )
193          tKLo=1          tKLo=1
194          tKHi=myNz          tKHi=myNz
195          tKStride=1          tKStride=1
# Line 183  C     Post sends as messages or buffer c Line 205  C     Post sends as messages or buffer c
205          j2Hi  = sNy+myOLs          j2Hi  = sNy+myOLs
206          k2Lo  = 1          k2Lo  = 1
207          k2Hi  = myNz          k2Hi  = myNz
208  C       Send to neighbour N to fill neighbor points  C       Send to neighbour N to fill neighbor points
209  C       (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)  C       (tIlo:tIhi:tiStride,tJlo:tJhi,tJStride,tKlo:tKhi,tKStride)
210  C       in its copy of "array".  C       in its copy of "array".
211          CALL EXCH2_SEND_RX2_AD(          CALL EXCH2_SEND_RX2_AD(
212       I       tIlo, tIhi, tiStride,       I       tIlo1, tIhi1, tIlo2, tIhi2, tiStride,
213       I       tJlo, tJhi, tjStride,       I       tJlo1, tJhi1, tJlo2, tJhi2, tjStride,
214       I       tKlo, tKhi, tkStride,       I       tKlo, tKhi, tkStride,
215       I       thisTile, N,       I       thisTile, N, oIs1, oJs1, oIs2, oJs2,
216       I       e2Bufr1_RX(1,N,I,1), e2BufrRecSize,       O       e2Bufr1_RX(1,N,bi,1),
217       I       e2Bufr2_RX(1,N,I,1),       O       e2Bufr2_RX(1,N,bi,1),
218       I       array1(1-myOLw,1-myOLs,1,I,1),       I       e2BufrRecSize,
219         I       array1(1-myOLw,1-myOLs,1,bi,1),
220       I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,       I       i1Lo, i1Hi, j1Lo, j1Hi, k1Lo, k1Hi,
221       I       array2(1-myOLw,1-myOLs,1,I,1),       I       array2(1-myOLw,1-myOLs,1,bi,1),
222       I       i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,       I       i2Lo, i2Hi, j2Lo, j2Hi, k2Lo, k2Hi,
223       O       e2_msgHandles(1,N,I),       O       e2_msgHandles(1,N,bi),
224       O       e2_msgHandles(2,N,I),       O       e2_msgHandles(2,N,bi),
225       I       W2_myCommFlag(N,I), signOption,       I       W2_myCommFlag(N,bi), signOption,
226       I       myThid )       I       myThid )
227         ENDDO         ENDDO
228        ENDDO        ENDDO
229    
230  C     Clear message handles/locks  C     Clear message handles/locks
231        DO I=1,nSx        DO bi=1,nSx
232         thisTile=W2_myTileList(I)         thisTile=W2_myTileList(bi)
233         nN=exch2_nNeighbours(thisTile)         nN=exch2_nNeighbours(thisTile)
234         DO N=1,nN         DO N=1,nN
235  C       Note: In a between process tile-tile data transport using  C       Note: In a between process tile-tile data transport using
236  C             MPI the sender needs to clear an Isend wait handle here.  C             MPI the sender needs to clear an Isend wait handle here.
237  C             In a within process tile-tile data transport using true  C             In a within process tile-tile data transport using true
238  C             shared address space/or direct transfer through commonly  C             shared address space/or direct transfer through commonly
239  C             addressable memory blocks the receiver needs to assert  C             addressable memory blocks the receiver needs to assert
240  C             that is has consumed the buffer the sender filled here.  C             that is has consumed the buffer the sender filled here.
241          farTile=exch2_neighbourId(N,thisTile)          farTile=exch2_neighbourId(N,thisTile)
242          IF     ( W2_myCommFlag(N,I) .EQ. 'M' ) THEN          IF     ( W2_myCommFlag(N,bi) .EQ. 'M' ) THEN
243  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
244           wHandle = e2_msgHandles(1,N,I)           wHandle = e2_msgHandles(1,N,bi)
245           CALL MPI_Wait( wHandle, mpiStatus, mpiRc )           CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
246           wHandle = e2_msgHandles(2,N,I)           wHandle = e2_msgHandles(2,N,bi)
247           CALL MPI_Wait( wHandle, mpiStatus, mpiRc )           CALL MPI_Wait( wHandle, mpiStatus, mpiRc )
248  #endif  #endif
249          ELSEIF ( W2_myCommFlag(N,I) .EQ. 'P' ) THEN          ELSEIF ( W2_myCommFlag(N,bi) .EQ. 'P' ) THEN
250          ELSE          ELSE
251          ENDIF          ENDIF
252         ENDDO         ENDDO
253        ENDDO        ENDDO
254    
255        CALL BAR2(myThid)        CALL BAR2(myThid)
256      
257        RETURN        RETURN
258        END        END
259    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22