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

Annotation of /MITgcm/pkg/exch2/exch2_z_3d_rx.template

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

Revision 1.1 - (hide annotations) (download)
Wed Aug 23 15:13:04 2006 UTC (17 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint58r_post, checkpoint58x_post, checkpoint58t_post, checkpoint58q_post, checkpoint59e, checkpoint59d, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59, checkpoint58o_post, checkpoint58y_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post 
exch2 interface S/R:
 - change _XYZ_ interface to _3D_ subroutine (with 3rd dim in argument list)
 - not often used EXCH S/R (exch_z, exch_uv_agrid): keep only the _3D_ version.
1 jmc 1.1 C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_z_xy_rx.template,v 1.2 2005/07/24 01:35:06 jmc Exp $
2     C $Name: $
3    
4     #include "CPP_EEOPTIONS.h"
5     #include "W2_OPTIONS.h"
6    
7     CBOP
8     C !ROUTINE: EXCH_Z_3D_RX
9    
10     C !INTERFACE:
11     SUBROUTINE EXCH2_Z_3D_RX(
12     U phi,
13     I myNz, myThid )
14     IMPLICIT NONE
15     C !DESCRIPTION:
16     C *==========================================================*
17     C | SUBROUTINE EXCH_Z_3D_RX
18     C | o Handle exchanges for _RX three-dim zeta-point array.
19     C *==========================================================*
20     C | Invoke appropriate exchange for a zeta-point array
21     C | for either global grid, or cube sphere grid.
22     C *==========================================================*
23    
24     C !USES:
25     C === Global data ===
26     #include "SIZE.h"
27     #include "EEPARAMS.h"
28     #include "EESUPPORT.h"
29     #include "W2_EXCH2_TOPOLOGY.h"
30     #include "W2_EXCH2_PARAMS.h"
31    
32     C !INPUT/OUTPUT PARAMETERS:
33     C === Routine arguments ===
34     C phi :: Array with overlap regions are to be exchanged
35     C myNz :: 3rd dimension of input array phi
36     C myThid :: My Thread Id. number
37     INTEGER myNz
38     _RX phi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
39     INTEGER myThid
40    
41     C !LOCAL VARIABLES:
42     C == Local variables ==
43     C OL[wens] :: Overlap extents in west, east, north, south.
44     C exchWidth[XY] :: Extent of regions that will be exchanged.
45     C mFace :: face number
46     C local_maxDim :: upper limit of 3rd dimension value
47     C phiNW,phiSE :: temporary array to hold corner value (CS grid)
48     C msgBuf :: Informational/error meesage buffer
49     INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
50     INTEGER bi, bj, myTile, i, j, k
51     INTEGER mFace
52     INTEGER local_maxDim
53     PARAMETER( local_maxDim = 8*Nr )
54     _RX phiNW(local_maxDim,nSx,nSy)
55     _RX phiSE(local_maxDim,nSx,nSy)
56     CHARACTER*(MAX_LEN_MBUF) msgBuf
57     CEOP
58    
59    
60     OLw = OLx
61     OLe = OLx
62     OLn = OLy
63     OLs = OLy
64     exchWidthX = OLx
65     exchWidthY = OLy
66     C ** NOTE ** The exchange routine we use here does not
67     C require the preceeding and following barriers.
68     C However, the slow, simple exchange interface
69     C that is calling it here is meant to ensure
70     C that threads are synchronised before exchanges
71     C begine.
72    
73     IF (useCubedSphereExchange) THEN
74     IF ( myNz.GT.local_maxDim ) THEN
75     WRITE(msgBuf,'(2A,2(I4,A))') 'EXCH_Z_3D_RX :',
76     & ' 3rd dimension=', myNz,
77     & ' exceeds local_maxDim (=', local_maxDim, ' )'
78     CALL PRINT_ERROR( msgBuf , myThid )
79     WRITE(msgBuf,'(2A)') 'EXCH_Z_3D_RX :',
80     & ' Increase "local_maxDim" and recompile'
81     CALL PRINT_ERROR( msgBuf , myThid )
82     STOP 'ABNORMAL END: S/R EXCH_Z_3D_RX'
83     ENDIF
84    
85     C- save 2 corners value (in case we find 1 "missing corner")
86     DO bj=myByLo(myThid),myByHi(myThid)
87     DO bi=myBxLo(myThid),myBxHi(myThid)
88     DO k=1,myNz
89     phiNW(k,bi,bj) = phi(1,sNy+1,k,bi,bj)
90     phiSE(k,bi,bj) = phi(sNx+1,1,k,bi,bj)
91     ENDDO
92     ENDDO
93     ENDDO
94    
95     CALL EXCH2_RX1_CUBE( phi, 'T ',
96     I OLw, OLe, OLs, OLn, myNz,
97     I exchWidthX, exchWidthY,
98     I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
99     CALL EXCH2_RX1_CUBE( phi, 'T ',
100     I OLw, OLe, OLs, OLn, myNz,
101     I exchWidthX, exchWidthY,
102     I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
103    
104     DO bj=myByLo(myThid),myByHi(myThid)
105     DO bi=myBxLo(myThid),myBxHi(myThid)
106     myTile = W2_myTileList(bi)
107     mFace = exch2_myFace(myTile)
108    
109     C--- Face 2,4,6:
110     IF ( MOD(mFace,2).EQ.0 ) THEN
111    
112     C-- East edge : shift j <- j-1
113     IF ( exch2_isEedge(myTile) .EQ. 1 ) THEN
114     DO k=1,myNz
115     DO j=sNy+OLy,2-Oly,-1
116     DO i=sNx+1,sNx+OLx
117     phi(i,j,k,bi,bj)=phi(i,j-1,k,bi,bj)
118     ENDDO
119     ENDDO
120     ENDDO
121     C- North-East corner
122     IF ( exch2_isNedge(myTile) .EQ. 1 ) THEN
123     DO k=1,myNz
124     DO j=sNy+2,sNy+OLy
125     i=sNx-sNy+j
126     phi(sNx+1,j,k,bi,bj)=phi(i,sNy+1,k,bi,bj)
127     ENDDO
128     #ifdef W2_FILL_NULL_REGIONS
129     DO j=sNy+2,sNy+OLy
130     DO i=sNx+2,sNx+OLx
131     phi(i,j,k,bi,bj)=e2FillValue_RX
132     ENDDO
133     ENDDO
134     #endif
135     ENDDO
136     ENDIF
137     ENDIF
138     C-- South edge : shift i <- i-1
139     IF ( exch2_isSedge(myTile) .EQ. 1 ) THEN
140     DO k=1,myNz
141     DO j=1-OLy,0
142     DO i=sNx+OLx,2-Olx,-1
143     phi(i,j,k,bi,bj)=phi(i-1,j,k,bi,bj)
144     ENDDO
145     ENDDO
146     ENDDO
147     C- South-East corner
148     IF ( exch2_isEedge(myTile) .EQ. 1 ) THEN
149     DO k=1,myNz
150     phi(sNx+1,1,k,bi,bj)=phiSE(k,bi,bj)
151     DO i=sNx+2,sNx+OLx
152     j=sNx+2-i
153     phi(i,1,k,bi,bj)=phi(sNx+1,j,k,bi,bj)
154     ENDDO
155     #ifdef W2_FILL_NULL_REGIONS
156     DO j=1-OLy,0
157     DO i=sNx+2,sNx+OLx
158     phi(i,j,k,bi,bj)=e2FillValue_RX
159     ENDDO
160     ENDDO
161     #endif
162     ENDDO
163     ENDIF
164     C- South-West corner
165     IF ( exch2_isWedge(myTile) .EQ. 1 ) THEN
166     DO k=1,myNz
167     DO j=1-OLy,0
168     phi(1,j,k,bi,bj)=phi(j,1,k,bi,bj)
169     #ifdef W2_FILL_NULL_REGIONS
170     DO i=1-OLx,0
171     phi(i,j,k,bi,bj)=e2FillValue_RX
172     ENDDO
173     #endif
174     ENDDO
175     ENDDO
176     ENDIF
177     ENDIF
178     C-- North-west corner
179     IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
180     & exch2_isNedge(myTile) .EQ. 1 ) THEN
181     DO k=1,myNz
182     DO i=2-OLx,0
183     j=sNy+2-i
184     phi(i,sNy+1,k,bi,bj)=phi(1,j,k,bi,bj)
185     ENDDO
186     #ifdef W2_FILL_NULL_REGIONS
187     DO j=sNy+2,sNy+OLy
188     DO i=1-OLx,0
189     phi(i,j,k,bi,bj)=e2FillValue_RX
190     ENDDO
191     ENDDO
192     phi(1-Olx,sNy+1,k,bi,bj)=e2FillValue_RX
193     #endif
194     ENDDO
195     ENDIF
196    
197     ELSE
198     C--- Face 1,3,5:
199    
200     C-- North edge : shift i <- i-1
201     IF ( exch2_isNedge(myTile) .EQ. 1 ) THEN
202     DO k=1,myNz
203     DO j=sNy+1,sNy+Oly
204     DO i=sNx+OLx,2-Olx,-1
205     phi(i,j,k,bi,bj)=phi(i-1,j,k,bi,bj)
206     ENDDO
207     ENDDO
208     ENDDO
209     C- North-East corner
210     IF ( exch2_isEedge(myTile) .EQ. 1 ) THEN
211     DO k=1,myNz
212     DO i=sNx+2,sNx+OLx
213     j=sNy-sNx+i
214     phi(i,sNy+1,k,bi,bj)=phi(sNx+1,j,k,bi,bj)
215     ENDDO
216     #ifdef W2_FILL_NULL_REGIONS
217     DO j=sNy+2,sNy+OLy
218     DO i=sNx+2,sNx+OLx
219     phi(i,j,k,bi,bj)=e2FillValue_RX
220     ENDDO
221     ENDDO
222     #endif
223     ENDDO
224     ENDIF
225     ENDIF
226     C-- West edge : shift j <- j-1
227     IF ( exch2_isWedge(myTile) .EQ. 1 ) THEN
228     DO k=1,myNz
229     DO j=sNy+OLy,2-Oly,-1
230     DO i=1-Olx,0
231     phi(i,j,k,bi,bj)=phi(i,j-1,k,bi,bj)
232     ENDDO
233     ENDDO
234     ENDDO
235     C- North-west corner
236     IF ( exch2_isNedge(myTile) .EQ. 1 ) THEN
237     DO k=1,myNz
238     phi(1,sNy+1,k,bi,bj)=phiNW(k,bi,bj)
239     DO j=sNy+2,sNy+OLy
240     i=sNy+2-j
241     phi(1,j,k,bi,bj)=phi(i,sNy+1,k,bi,bj)
242     ENDDO
243     #ifdef W2_FILL_NULL_REGIONS
244     DO j=sNy+2,sNy+OLy
245     DO i=1-OLx,0
246     phi(i,j,k,bi,bj)=e2FillValue_RX
247     ENDDO
248     ENDDO
249     #endif
250     ENDDO
251     ENDIF
252     C- South-West corner
253     IF ( exch2_isSedge(myTile) .EQ. 1 ) THEN
254     DO k=1,myNz
255     DO i=1-OLx,0
256     phi(i,1,k,bi,bj)=phi(1,i,k,bi,bj)
257     ENDDO
258     #ifdef W2_FILL_NULL_REGIONS
259     DO j=1-OLy,0
260     DO i=1-OLx,0
261     phi(i,j,k,bi,bj)=e2FillValue_RX
262     ENDDO
263     ENDDO
264     #endif
265     ENDDO
266     ENDIF
267     ENDIF
268     C- South-East corner
269     IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
270     & exch2_isSedge(myTile) .EQ. 1 ) THEN
271     DO k=1,myNz
272     DO j=2-OLy,0
273     i=sNx+2-j
274     phi(sNx+1,j,k,bi,bj)=phi(i,1,k,bi,bj)
275     ENDDO
276     #ifdef W2_FILL_NULL_REGIONS
277     DO j=1-OLy,0
278     DO i=sNx+2,sNx+OLx
279     phi(i,j,k,bi,bj)=e2FillValue_RX
280     ENDDO
281     ENDDO
282     phi(sNx+1,1-Oly,k,bi,bj)=e2FillValue_RX
283     #endif
284     ENDDO
285     ENDIF
286    
287     C--- end odd / even face number
288     ENDIF
289    
290     ENDDO
291     ENDDO
292    
293     ELSE
294    
295     CALL EXCH_RX( phi,
296     I OLw, OLe, OLs, OLn, myNz,
297     I exchWidthX, exchWidthY,
298     I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
299    
300     ENDIF
301    
302     RETURN
303     END
304    
305     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
306    
307     CEH3 ;;; Local Variables: ***
308     CEH3 ;;; mode:fortran ***
309     CEH3 ;;; End: ***
  ViewVC Help
Powered by ViewVC 1.1.22