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

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

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


Revision 1.7 - (hide annotations) (download)
Tue Sep 4 00:47:14 2012 UTC (11 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63s, checkpoint64, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, HEAD
Changes since 1.6: +4 -4 lines
remove W2_EXCH2_PARAMS.h (no longer needed)

1 jmc 1.7 C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_cgrid_3d_rx.template,v 1.6 2012/03/26 19:43:10 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "CPP_EEOPTIONS.h"
5     #include "W2_OPTIONS.h"
6    
7     CBOP
8     C !ROUTINE: EXCH2_UV_CGRID_3D_RX
9    
10     C !INTERFACE:
11     SUBROUTINE EXCH2_UV_CGRID_3D_RX(
12     U uPhi, vPhi,
13     I withSigns, myNz, myThid )
14    
15     C !DESCRIPTION:
16     C*=====================================================================*
17     C Purpose: SUBROUTINE EXCH2_UV_CGRID_3D_RX
18     C handle exchanges for a 3D vector field on a C-grid.
19     C
20     C Input:
21     C uPhi(lon,lat,levs,bi,bj) :: first component of vector
22     C vPhi(lon,lat,levs,bi,bj) :: second component of vector
23     C withSigns (logical) :: true to use sign of components
24     C myNz :: 3rd dimension of input arrays uPhi,vPhi
25     C myThid :: my Thread Id number
26     C
27     C Output: uPhi and vPhi are updated (halo regions filled)
28     C
29     C Calls: exch_RX (exch2_RX1_cube) - for each component
30     C
31     C*=====================================================================*
32    
33     C !USES:
34     IMPLICIT NONE
35    
36     #include "SIZE.h"
37     #include "EEPARAMS.h"
38 jmc 1.3 #include "W2_EXCH2_SIZE.h"
39 jmc 1.1 #include "W2_EXCH2_TOPOLOGY.h"
40 jmc 1.7 c#ifdef W2_FILL_NULL_REGIONS
41     c#include "W2_EXCH2_PARAMS.h"
42     c#endif
43 jmc 1.1
44     C !INPUT/OUTPUT PARAMETERS:
45     C == Argument list variables ==
46     INTEGER myNz
47     _RX uPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
48     _RX vPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
49     LOGICAL withSigns
50     INTEGER myThid
51    
52     C !LOCAL VARIABLES:
53     C == Local variables ==
54     C i,j,k,bi,bj :: loop indices.
55     C OL[wens] :: Overlap extents in west, east, north, south.
56     C exchWidth[XY] :: Extent of regions that will be exchanged.
57     C uLoc,vLoc :: local copy of the vector components with haloes filled.
58    
59     INTEGER i,j,k,bi,bj
60     INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
61     _RX uLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
62     _RX vLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
63     _RX negOne
64     INTEGER myTile, myFace
65     CEOP
66    
67     OLw = OLx
68     OLe = OLx
69     OLn = OLy
70     OLs = OLy
71     exchWidthX = OLx
72     exchWidthY = OLy
73     negOne = 1.
74     IF (withSigns) negOne = -1.
75    
76     C-- First call the exchanges for the two components
77    
78 jmc 1.5 CALL EXCH2_RX1_CUBE( uPhi, .FALSE., 'T ',
79 jmc 1.1 I OLw, OLe, OLs, OLn, myNz,
80     I exchWidthX, exchWidthY,
81 jmc 1.6 I EXCH_IGNORE_CORNERS, myThid )
82 jmc 1.5 CALL EXCH2_RX1_CUBE( uPhi, .FALSE., 'T ',
83 jmc 1.1 I OLw, OLe, OLs, OLn, myNz,
84     I exchWidthX, exchWidthY,
85 jmc 1.5 I EXCH_UPDATE_CORNERS, myThid )
86 jmc 1.1
87 jmc 1.5 CALL EXCH2_RX1_CUBE( vPhi, .FALSE., 'T ',
88 jmc 1.1 I OLw, OLe, OLs, OLn, myNz,
89     I exchWidthX, exchWidthY,
90 jmc 1.6 I EXCH_IGNORE_CORNERS, myThid )
91 jmc 1.5 CALL EXCH2_RX1_CUBE( vPhi, .FALSE., 'T ',
92 jmc 1.1 I OLw, OLe, OLs, OLn, myNz,
93     I exchWidthX, exchWidthY,
94 jmc 1.5 I EXCH_UPDATE_CORNERS, myThid )
95 jmc 1.1
96     C- note: can substitute the low-level S/R calls above with:
97     c CALL EXCH2_3D_RX( uPhi, myNz, myThid )
98     c CALL EXCH2_3D_RX( vPhi, myNz, myThid )
99    
100 jmc 1.4 IF ( useCubedSphereExchange ) THEN
101    
102 jmc 1.1 C-- Then, depending on which tile we are, we may need
103     C 1) to switch u and v components and also to switch the signs
104     C 2) to shift the index along the face edge.
105     C 3) ensure that near-corner halo regions is filled in the correct order
106     C (i.e. with velocity component already available after 1 exch)
107     C- note: because of index shift, the order really matter:
108     C odd faces, do North 1rst and then West;
109     C even faces, do East 1rst and then South.
110    
111     C-- Loops on tile indices:
112     DO bj = myByLo(myThid), myByHi(myThid)
113     DO bi = myBxLo(myThid), myBxHi(myThid)
114    
115 jmc 1.5 C- Choose what to do at each edge of the halo based on which face we are
116 jmc 1.4 myTile = W2_myTileList(bi,bj)
117 jmc 1.1 myFace = exch2_myFace(myTile)
118    
119     C-- Loops on level index:
120     DO k = 1,myNz
121    
122     C- First we copy the 2 components info into local dummy arrays uLoc,vLoc
123     DO j = 1-OLy,sNy+OLy
124     DO i = 1-OLx,sNx+OLx
125     uLoc(i,j) = uPhi(i,j,k,bi,bj)
126     vLoc(i,j) = vPhi(i,j,k,bi,bj)
127     ENDDO
128     ENDDO
129    
130     C- odd faces share disposition of all sections of the halo
131     IF ( MOD(myFace,2).EQ.1 ) THEN
132     C- North:
133     IF (exch2_isNedge(myTile).EQ.1) THEN
134     C switch u <- v , reverse the sign & shift i+1 <- i
135     DO j = 1,exchWidthY
136     DO i = 1-OLx,sNx+OLx-1
137     uPhi(i+1,sNy+j,k,bi,bj) = vLoc(i,sNy+j)*negOne
138     ENDDO
139     ENDDO
140     C switch v <- u , keep the sign
141     DO j = 1,exchWidthY
142     DO i = 1-OLx,sNx+OLx
143     vPhi(i,sNy+j,k,bi,bj) = uLoc(i,sNy+j)
144     ENDDO
145     ENDDO
146     ENDIF
147     C- South (nothing to change)
148     c IF (exch2_isSedge(myTile).EQ.1) THEN
149     c DO j = 1,exchWidthY
150     c DO i = 1-OLx,sNx+OLx
151     c uPhi(i,1-j,k,bi,bj) = uLoc(i,1-j)
152     c vPhi(i,1-j,k,bi,bj) = vLoc(i,1-j)
153     c ENDDO
154     c ENDDO
155     c ENDIF
156     C- East (nothing to change)
157     c IF (exch2_isEedge(myTile).EQ.1) THEN
158     c DO j = 1-OLy,sNy+OLy
159     c DO i = 1,exchWidthX
160     c uPhi(sNx+i,j,k,bi,bj) = uLoc(sNx+i,j)
161     c vPhi(sNx+i,j,k,bi,bj) = vLoc(sNx+i,j)
162     c ENDDO
163     c ENDDO
164     c ENDIF
165     C- West:
166     IF (exch2_isWedge(myTile).EQ.1) THEN
167     C switch u <- v , keep the sign
168     DO j = 1-OLy,sNy+OLy
169     DO i = 1,exchWidthX
170     uPhi(1-i,j,k,bi,bj) = vLoc(1-i,j)
171     ENDDO
172     ENDDO
173     C switch v <- u , reverse the sign & shift j+1 <- j
174     DO j = 1-OLy,sNy+OLy-1
175     DO i = 1,exchWidthX
176     vPhi(1-i,j+1,k,bi,bj) = uLoc(1-i,j)*negOne
177     ENDDO
178     ENDDO
179     ENDIF
180    
181     ELSE
182     C- Now the even faces (share disposition of all sections of the halo)
183    
184     C- East:
185     IF (exch2_isEedge(myTile).EQ.1) THEN
186     C switch u <- v , keep the sign
187     DO j = 1-OLy,sNy+OLy
188     DO i = 1,exchWidthX
189     uPhi(sNx+i,j,k,bi,bj) = vLoc(sNx+i,j)
190     ENDDO
191     ENDDO
192     C switch v <- u , reverse the sign & shift j+1 <- j
193     DO j = 1-OLy,sNy+OLy-1
194     DO i = 1,exchWidthX
195     vPhi(sNx+i,j+1,k,bi,bj) = uLoc(sNx+i,j)*negOne
196     ENDDO
197     ENDDO
198     ENDIF
199     C- West (nothing to change)
200     c IF (exch2_isWedge(myTile).EQ.1) THEN
201     c DO j = 1-OLy,sNy+OLy
202     c DO i = 1,exchWidthX
203     c uPhi(1-i,j,k,bi,bj) = uLoc(1-i,j)
204     c vPhi(1-i,j,k,bi,bj) = vLoc(1-i,j)
205     c ENDDO
206     c ENDDO
207     c ENDIF
208     C- North (nothing to change)
209     c IF (exch2_isNedge(myTile).EQ.1) THEN
210     c DO j = 1,exchWidthY
211     c DO i = 1-OLx,sNx+OLx
212     c uPhi(i,sNy+j,k,bi,bj) = uLoc(i,sNy+j)
213     c vPhi(i,sNy+j,k,bi,bj) = vLoc(i,sNy+j)
214     c ENDDO
215     c ENDDO
216     c ENDIF
217     C- South:
218     IF (exch2_isSedge(myTile).EQ.1) THEN
219     C switch u <- v , reverse the sign & shift i+1 <- i
220     DO j = 1,exchWidthY
221     DO i = 1-OLx,sNx+OLx-1
222     uPhi(i+1,1-j,k,bi,bj) = vLoc(i,1-j)*negOne
223     ENDDO
224     ENDDO
225     C switch v <- u , keep the sign
226     DO j = 1,exchWidthY
227     DO i = 1-OLx,sNx+OLx
228     vPhi(i,1-j,k,bi,bj) = uLoc(i,1-j)
229     ENDDO
230     ENDDO
231     ENDIF
232    
233     C- end odd / even faces
234     ENDIF
235    
236     C-- end of Loops on level index k.
237     ENDDO
238    
239     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
240     C-- Now fix edges near cube-corner
241    
242     IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
243     & exch2_isSedge(myTile) .EQ. 1 ) THEN
244     IF ( MOD(myFace,2).EQ.1 ) THEN
245     DO k=1,myNz
246     DO i=1,OLx
247     vPhi(1-i,1,k,bi,bj) = uPhi(1,1-i,k,bi,bj)*negOne
248     ENDDO
249     ENDDO
250     ELSE
251     DO k=1,myNz
252     DO i=1,OLx
253     uPhi(1,1-i,k,bi,bj) = vPhi(1-i,1,k,bi,bj)*negOne
254     ENDDO
255     ENDDO
256     ENDIF
257     ENDIF
258    
259     IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
260     & exch2_isSedge(myTile) .EQ. 1 ) THEN
261     IF ( MOD(myFace,2).EQ.1 ) THEN
262     DO k=1,myNz
263     DO i=1,OLx
264     uPhi(sNx+1,1-i,k,bi,bj) = vPhi(sNx+i,1,k,bi,bj)
265     ENDDO
266     ENDDO
267     ELSE
268     DO k=1,myNz
269     DO i=1,OLx
270     vPhi(sNx+i,1,k,bi,bj) = uPhi(sNx+1,1-i,k,bi,bj)
271     ENDDO
272     ENDDO
273     ENDIF
274     ENDIF
275    
276     IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
277     & exch2_isNedge(myTile) .EQ. 1 ) THEN
278     IF ( MOD(myFace,2).EQ.1 ) THEN
279     DO k=1,myNz
280     DO i=1,OLx
281     vPhi(sNx+i,sNy+1,k,bi,bj)=uPhi(sNx+1,sNy+i,k,bi,bj)*negOne
282     ENDDO
283     ENDDO
284     ELSE
285     DO k=1,myNz
286     DO i=1,OLx
287     uPhi(sNx+1,sNy+i,k,bi,bj)=vPhi(sNx+i,sNy+1,k,bi,bj)*negOne
288     ENDDO
289     ENDDO
290     ENDIF
291     ENDIF
292    
293     IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
294     & exch2_isNedge(myTile) .EQ. 1 ) THEN
295     IF ( MOD(myFace,2).EQ.1 ) THEN
296     DO k=1,myNz
297     DO i=1,OLx
298     uPhi(1,sNy+i,k,bi,bj) = vPhi(1-i,sNy+1,k,bi,bj)
299     ENDDO
300     ENDDO
301     ELSE
302     DO k=1,myNz
303     DO i=1,OLx
304     vPhi(1-i,sNy+1,k,bi,bj) = uPhi(1,sNy+i,k,bi,bj)
305     ENDDO
306     ENDDO
307     ENDIF
308     ENDIF
309    
310     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
311    
312     C-- Now zero out the null areas that should not be used in the numerics
313     C Also add one valid u,v value next to the corner, that allows
314     C to compute vorticity on a wider stencil (e.g., vort3(0,1) & (1,0))
315    
316     IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
317     & exch2_isSedge(myTile) .EQ. 1 ) THEN
318     C Zero SW corner points
319     DO k=1,myNz
320     #ifdef W2_FILL_NULL_REGIONS
321     DO j=1-OLy,0
322     DO i=1-OLx,0
323     uPhi(i,j,k,bi,bj)=e2FillValue_RX
324     ENDDO
325     ENDDO
326     DO j=1-OLy,0
327     DO i=1-OLx,0
328     vPhi(i,j,k,bi,bj)=e2FillValue_RX
329     ENDDO
330     ENDDO
331     #endif
332     uPhi(0,0,k,bi,bj)=vPhi(1,0,k,bi,bj)
333     vPhi(0,0,k,bi,bj)=uPhi(0,1,k,bi,bj)
334     ENDDO
335     ENDIF
336    
337     IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
338     & exch2_isNedge(myTile) .EQ. 1 ) THEN
339     C Zero NW corner points
340     DO k=1,myNz
341     #ifdef W2_FILL_NULL_REGIONS
342     DO j=sNy+1,sNy+OLy
343     DO i=1-OLx,0
344     uPhi(i,j,k,bi,bj)=e2FillValue_RX
345     ENDDO
346     ENDDO
347     DO j=sNy+2,sNy+OLy
348     DO i=1-OLx,0
349     vPhi(i,j,k,bi,bj)=e2FillValue_RX
350     ENDDO
351     ENDDO
352     #endif
353     uPhi(0,sNy+1,k,bi,bj)= vPhi(1,sNy+2,k,bi,bj)*negOne
354     vPhi(0,sNy+2,k,bi,bj)= uPhi(0,sNy,k,bi,bj)*negOne
355     ENDDO
356     ENDIF
357    
358     IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
359     & exch2_isSedge(myTile) .EQ. 1 ) THEN
360     C Zero SE corner points
361     DO k=1,myNz
362     #ifdef W2_FILL_NULL_REGIONS
363     DO j=1-OLy,0
364     DO i=sNx+2,sNx+OLx
365     uPhi(i,j,k,bi,bj)=e2FillValue_RX
366     ENDDO
367     ENDDO
368     DO j=1-OLy,0
369     DO i=sNx+1,sNx+OLx
370     vPhi(i,j,k,bi,bj)=e2FillValue_RX
371     ENDDO
372     ENDDO
373     #endif
374     uPhi(sNx+2,0,k,bi,bj)= vPhi(sNx,0,k,bi,bj)*negOne
375     vPhi(sNx+1,0,k,bi,bj)= uPhi(sNx+2,1,k,bi,bj)*negOne
376     ENDDO
377     ENDIF
378    
379     IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
380     & exch2_isNedge(myTile) .EQ. 1 ) THEN
381     C Zero NE corner points
382     DO k=1,myNz
383     #ifdef W2_FILL_NULL_REGIONS
384     DO j=sNy+1,sNy+OLy
385     DO i=sNx+2,sNx+OLx
386     uPhi(i,j,k,bi,bj)=e2FillValue_RX
387     ENDDO
388     ENDDO
389     DO j=sNy+2,sNy+OLy
390     DO i=sNx+1,sNx+OLx
391     vPhi(i,j,k,bi,bj)=e2FillValue_RX
392     ENDDO
393     ENDDO
394     #endif
395     uPhi(sNx+2,sNy+1,k,bi,bj)=vPhi(sNx,sNy+2,k,bi,bj)
396     vPhi(sNx+1,sNy+2,k,bi,bj)=uPhi(sNx+2,sNy,k,bi,bj)
397     ENDDO
398     ENDIF
399     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
400    
401     C-- end of Loops on tile indices (bi,bj).
402     ENDDO
403     ENDDO
404    
405     C--- using or not using CubedSphereExchange: end
406     ENDIF
407    
408     RETURN
409     END
410    
411     CEH3 ;;; Local Variables: ***
412     CEH3 ;;; mode:fortran ***
413     CEH3 ;;; End: ***

  ViewVC Help
Powered by ViewVC 1.1.22