/[MITgcm]/MITgcm/eesupp/src/exch_uv_rx_cube.template
ViewVC logotype

Diff of /MITgcm/eesupp/src/exch_uv_rx_cube.template

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

revision 1.1 by adcroft, Wed Mar 28 19:48:51 2001 UTC revision 1.2 by adcroft, Tue May 29 14:01:36 2001 UTC
# Line 0  Line 1 
1    C $Header$
2    C $Name$
3    
4    #include "CPP_EEOPTIONS.h"
5    
6          SUBROUTINE EXCH_UV_RX_CUBE(
7         U            Uarray,Varray, withSigns,
8         I            myOLw, myOLe, myOLn, myOLs, myNz,
9         I            exchWidthX, exchWidthY,
10         I            simulationMode, cornerMode, myThid )
11    C     /==========================================================\
12    C     | SUBROUTINE EXCH_UV_RX_CUBE                               |
13    C     | o Control edge exchanges for RX array.                   |
14    C     |==========================================================|
15    C     |                                                          |
16    C     | Controlling routine for exchange of XY edges of an array |
17    C     | distributed in X and Y. The routine interfaces to        |
18    C     | communication routines that can use messages passing     |
19    C     | exchanges, put type exchanges or get type exchanges.     |
20    C     |  This allows anything from MPI to raw memory channel to  |
21    C     | memmap segments to be used as a inter-process and/or     |
22    C     | inter-thread communiation and synchronisation            |
23    C     | mechanism.                                               |
24    C     | Notes --                                                 |
25    C     | 1. Some low-level mechanisms such as raw memory-channel  |
26    C     | or SGI/CRAY shmem put do not have direct Fortran bindings|
27    C     | and are invoked through C stub routines.                 |
28    C     | 2. Although this routine is fairly general but it does   |
29    C     | require nSx and nSy are the same for all innvocations.   |
30    C     | There are many common data structures ( myByLo,          |
31    C     | westCommunicationMode, mpiIdW etc... ) tied in with      |
32    C     | (nSx,nSy). To support arbitray nSx and nSy would require |
33    C     | general forms of these.                                  |
34    C     |                                                          |
35    C     \==========================================================/
36          IMPLICIT NONE
37    
38    C     == Global data ==
39    #include "SIZE.h"
40    #include "EEPARAMS.h"
41    #include "EESUPPORT.h"
42    #include "EXCH.h"
43    
44    C     == Routine arguments ==
45    C     Uarray - (u-type) Array with edges to exchange.
46    C     Varray - (v-type) Array with edges to exchange.
47    C     withSigns - Uarray,Varray are vector components.
48    C     myOLw - West, East, North and South overlap region sizes.
49    C     myOLe
50    C     myOLn
51    C     myOLs
52    C     exchWidthX - Width of data region exchanged in X.
53    C     exchWidthY - Width of data region exchanged in Y.
54    C                  Note --
55    C                  1. In theory one could have a send width and
56    C                  a receive width for each face of each tile. The only
57    C                  restriction woul be that the send width of one
58    C                  face should equal the receive width of the sent to
59    C                  tile face. Dont know if this would be useful. I
60    C                  have left it out for now as it requires additional
61    C                  bookeeping.
62    C     simulationMode - Forward or reverse mode exchange ( provides
63    C                      support for adjoint integration of code. )
64    C     cornerMode     - Flag indicating whether corner updates are
65    C                      needed.
66    C     myThid         - Thread number of this instance of S/R EXCH...
67          LOGICAL withSigns
68          INTEGER myOLw
69          INTEGER myOLe
70          INTEGER myOLs
71          INTEGER myOLn
72          INTEGER myNz
73          INTEGER exchWidthX
74          INTEGER exchWidthY
75          INTEGER simulationMode
76          INTEGER cornerMode
77          INTEGER myThid
78          _RX Uarray(1-myOLw:sNx+myOLe,
79         &           1-myOLs:sNy+myOLn,
80         &           myNZ, nSx, nSy)
81          _RX Varray(1-myOLw:sNx+myOLe,
82         &           1-myOLs:sNy+myOLn,
83         &           myNZ, nSx, nSy)
84    
85    C     == Local variables ==
86    C     theSimulationMode - Holds working copy of simulation mode
87    C     theCornerMode     - Holds working copy of corner mode
88          INTEGER theSimulationMode
89          INTEGER theCornerMode
90          INTEGER I,J,K,repeat
91          INTEGER bl,bt,bn,bs,be,bw
92          _RL negOne,Utmp,Vtmp
93    
94    C     == Statement function ==
95    C     tilemod - Permutes indices to return neighboring tile index on
96    C               six face cube.
97          INTEGER tilemod
98          tilemod(I)=1+mod(I-1+6,6)
99    
100          theSimulationMode = simulationMode
101          theCornerMode     = cornerMode
102    
103          negOne = 1.
104          IF (withSigns) negOne = -1.
105    
106    C     For now tile<->tile exchanges are sequentialised through
107    C     thread 1. This is a temporary feature for preliminary testing until
108    C     general tile decomposistion is in place (CNH April 11, 2001)
109          CALL BAR2( myThid )
110          IF ( myThid .EQ. 1 ) THEN
111    
112           DO repeat=1,2
113    
114           DO bl = 1, 5, 2
115    
116            bt = bl
117            bn=tilemod(bt+2)
118            bs=tilemod(bt-1)
119            be=tilemod(bt+1)
120            bw=tilemod(bt-2)
121    
122            DO K = 1,myNz
123    
124    C        Tile Odd:Odd+2 [get] [North<-West]
125             DO J = 1,sNy+1
126              DO I = 1,exchWidthX
127               Uarray(J,sNy+I,K,bt,1) = negOne*Varray(I,sNy+2-J,K,bn,1)
128              ENDDO
129             ENDDO
130             DO J = 1,sNy
131              DO I = 1,exchWidthX
132               Varray(J,sNy+I,K,bt,1) = Uarray(I,sNy+1-J,K,bn,1)
133              ENDDO
134             ENDDO
135    C        Tile Odd:Odd-1 [get] [South<-North]
136             DO J = 1,sNy+1
137              DO I = 1,exchWidthX
138               Uarray(J,1-I,K,bt,1) = Uarray(J,sNy+1-I,K,bs,1)
139              ENDDO
140             ENDDO
141             DO J = 1,sNy
142              DO I = 1,exchWidthX
143               Varray(J,1-I,K,bt,1) = Varray(J,sNy+1-I,K,bs,1)
144              ENDDO
145             ENDDO
146    C        Tile Odd:Odd+1 [get] [East<-West]
147             DO J = 1,sNy
148              DO I = 1,exchWidthX
149               Uarray(sNx+I,J,K,bt,1) = Uarray(I,J,K,be,1)
150              ENDDO
151             ENDDO
152             DO J = 1,sNy+1
153              DO I = 1,exchWidthX
154               Varray(sNx+I,J,K,bt,1) = Varray(I,J,K,be,1)
155              ENDDO
156             ENDDO
157    C        Tile Odd:Odd-2 [get] [West<-North]
158             DO J = 1,sNy
159              DO I = 1,exchWidthX
160               Uarray(1-I,J,K,bt,1) = Varray(sNx+1-J,sNy+1-I,K,bw,1)
161              ENDDO
162             ENDDO
163             DO J = 1,sNy+1
164              DO I = 1,exchWidthX
165               Varray(1-I,J,K,bt,1) = negOne*Uarray(sNx+2-J,sNy+1-I,K,bw,1)
166              ENDDO
167             ENDDO
168    
169            ENDDO
170    
171            bt = bl+1
172            bn=tilemod(bt+1)
173            bs=tilemod(bt-2)
174            be=tilemod(bt+2)
175            bw=tilemod(bt-1)
176    
177            DO K = 1,myNz
178    
179    C        Tile Even:Even+1 [get] [North<-South]
180             DO J = 1,sNy+1
181              DO I = 1,exchWidthX
182               Uarray(J,sNy+I,K,bt,1) = Uarray(J,I,K,bn,1)
183              ENDDO
184             ENDDO
185             DO J = 1,sNy
186              DO I = 1,exchWidthX
187               Varray(J,sNy+I,K,bt,1) = Varray(J,I,K,bn,1)
188              ENDDO
189             ENDDO
190    C        Tile Even:Even-2 [get] [South<-East]
191             DO J = 1,sNy+1
192              DO I = 1,exchWidthX
193               Uarray(J,1-I,K,bt,1) = negOne*Varray(sNx+1-I,sNy+2-J,K,bs,1)
194              ENDDO
195             ENDDO
196             DO J = 1,sNy
197              DO I = 1,exchWidthX
198               Varray(J,1-I,K,bt,1) = Uarray(sNx+1-I,sNy+1-J,K,bs,1)
199              ENDDO
200             ENDDO
201    C        Tile Even:Even+2 [get] [East<-South]
202             DO J = 1,sNy
203              DO I = 1,exchWidthX
204               Uarray(sNx+I,J,K,bt,1) = Varray(sNx+1-J,I,K,be,1)
205              ENDDO
206             ENDDO
207             DO J = 1,sNy+1
208              DO I = 1,exchWidthX
209               Varray(sNx+I,J,K,bt,1) = negOne*Uarray(sNx+2-J,I,K,be,1)
210              ENDDO
211             ENDDO
212    C        Tile Even:Even-1 [get] [West<-East]
213             DO J = 1,sNy
214              DO I = 1,exchWidthX
215               Uarray(1-I,J,K,bt,1) = Uarray(sNx+1-I,J,K,bw,1)
216              ENDDO
217             ENDDO
218             DO J = 1,sNy+1
219              DO I = 1,exchWidthX
220               Varray(1-I,J,K,bt,1) = Varray(sNx+1-I,J,K,bw,1)
221              ENDDO
222             ENDDO
223    
224            ENDDO
225    
226           ENDDO
227    
228    C      Fix degeneracy at corners
229           IF (.FALSE.) THEN
230    c      IF (withSigns) THEN
231            DO bt = 1, 6
232             DO K = 1,myNz
233    C         Top left
234              Utmp=0.5*(Uarray(1,sNy,K,bt,1)+Uarray(0,sNy,K,bt,1))
235              Vtmp=0.5*(Varray(0,sNy+1,K,bt,1)+Varray(0,sNy,K,bt,1))
236              Varray(0,sNx+1,K,bt,1)=(Vtmp-Utmp)*0.70710678
237              Utmp=0.5*(Uarray(1,sNy+1,K,bt,1)+Uarray(2,sNy+1,K,bt,1))
238              Vtmp=0.5*(Varray(1,sNy+1,K,bt,1)+Varray(1,sNy+2,K,bt,1))
239              Uarray(1,sNy+1,K,bt,1)=(Utmp-Vtmp)*0.70710678
240    C         Bottom right
241              Utmp=0.5*(Uarray(sNx+1,1,K,bt,1)+Uarray(sNx+2,1,K,bt,1))
242              Vtmp=0.5*(Varray(sNx+1,1,K,bt,1)+Varray(sNx+1,2,K,bt,1))
243              Varray(sNx+1,1,K,bt,1)=(Vtmp-Utmp)*0.70710678
244              Utmp=0.5*(Uarray(sNx+1,0,K,bt,1)+Uarray(sNx,0,K,bt,1))
245              Vtmp=0.5*(Varray(sNx,1,K,bt,1)+Varray(sNx,0,K,bt,1))
246              Uarray(sNx+1,0,K,bt,1)=(Utmp-Vtmp)*0.70710678
247    C         Bottom left
248              Utmp=0.5*(Uarray(1,1,K,bt,1)+Uarray(0,1,K,bt,1))
249              Vtmp=0.5*(Varray(0,1,K,bt,1)+Varray(0,2,K,bt,1))
250              Varray(0,1,K,bt,1)=(Vtmp+Utmp)*0.70710678
251              Utmp=0.5*(Uarray(1,0,K,bt,1)+Uarray(2,0,K,bt,1))
252              Vtmp=0.5*(Varray(1,1,K,bt,1)+Varray(1,0,K,bt,1))
253              Uarray(1,0,K,bt,1)=(Utmp+Vtmp)*0.70710678
254    C         Top right
255              Utmp=0.5*(Uarray(sNx+1,sNy,K,bt,1)+Uarray(sNx+2,sNy,K,bt,1))
256              Vtmp=0.5*(Varray(sNx+1,sNy+1,K,bt,1)+Varray(sNx+1,sNy,K,bt,1))
257              Varray(sNx+1,sNy+1,K,bt,1)=(Vtmp+Utmp)*0.70710678
258              Utmp=0.5*(Uarray(sNx+1,sNy+1,K,bt,1)+Uarray(sNx,sNy+1,K,bt,1))
259              Vtmp=0.5*(Varray(sNx,sNy+1,K,bt,1)+Varray(sNx,sNy+2,K,bt,1))
260              Uarray(sNx+1,sNy+1,K,bt,1)=(Utmp+Vtmp)*0.70710678
261             ENDDO
262            ENDDO
263           ENDIF
264    
265           ENDDO
266    
267          ENDIF
268          CALL BAR2(myThid)
269    
270          RETURN
271          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22