/[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.2 - (hide annotations) (download)
Fri Aug 17 18:17:45 2007 UTC (16 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59g, checkpoint59f, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i
Changes since 1.1: +2 -2 lines
comment out #include "EESUPPORT.h" (not needed)

1 jmc 1.2 C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_cgrid_3d_rx.template,v 1.1 2007/07/25 21:11:48 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.2 c#include "EESUPPORT.h"
39 jmc 1.1 #include "W2_EXCH2_TOPOLOGY.h"
40     #include "W2_EXCH2_PARAMS.h"
41    
42     C !INPUT/OUTPUT PARAMETERS:
43     C == Argument list variables ==
44     INTEGER myNz
45     _RX uPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
46     _RX vPhi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
47     LOGICAL withSigns
48     INTEGER myThid
49    
50     C !LOCAL VARIABLES:
51     C == Local variables ==
52     C i,j,k,bi,bj :: loop indices.
53     C OL[wens] :: Overlap extents in west, east, north, south.
54     C exchWidth[XY] :: Extent of regions that will be exchanged.
55     C uLoc,vLoc :: local copy of the vector components with haloes filled.
56    
57     INTEGER i,j,k,bi,bj
58     INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
59     _RX uLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
60     _RX vLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61     _RX negOne
62     INTEGER myTile, myFace
63     CEOP
64    
65     OLw = OLx
66     OLe = OLx
67     OLn = OLy
68     OLs = OLy
69     exchWidthX = OLx
70     exchWidthY = OLy
71     negOne = 1.
72     IF (withSigns) negOne = -1.
73    
74     IF ( useCubedSphereExchange ) THEN
75     C--- using CubedSphereExchange:
76    
77     C-- First call the exchanges for the two components
78    
79     CALL EXCH2_RX1_CUBE( uPhi, 'T ',
80     I OLw, OLe, OLs, OLn, myNz,
81     I exchWidthX, exchWidthY,
82     I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
83     CALL EXCH2_RX1_CUBE( uPhi, 'T ',
84     I OLw, OLe, OLs, OLn, myNz,
85     I exchWidthX, exchWidthY,
86     I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
87    
88     CALL EXCH2_RX1_CUBE( vPhi, 'T ',
89     I OLw, OLe, OLs, OLn, myNz,
90     I exchWidthX, exchWidthY,
91     I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
92     CALL EXCH2_RX1_CUBE( vPhi, 'T ',
93     I OLw, OLe, OLs, OLn, myNz,
94     I exchWidthX, exchWidthY,
95     I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
96    
97     C- note: can substitute the low-level S/R calls above with:
98     c CALL EXCH2_3D_RX( uPhi, myNz, myThid )
99     c CALL EXCH2_3D_RX( vPhi, myNz, myThid )
100    
101     C-- Then, depending on which tile we are, we may need
102     C 1) to switch u and v components and also to switch the signs
103     C 2) to shift the index along the face edge.
104     C 3) ensure that near-corner halo regions is filled in the correct order
105     C (i.e. with velocity component already available after 1 exch)
106     C- note: because of index shift, the order really matter:
107     C odd faces, do North 1rst and then West;
108     C even faces, do East 1rst and then South.
109    
110     C-- Loops on tile indices:
111     DO bj = myByLo(myThid), myByHi(myThid)
112     DO bi = myBxLo(myThid), myBxHi(myThid)
113    
114     C- Now choose what to do at each edge of the halo based on which face
115     C (we assume that bj is always=1)
116     myTile = W2_myTileList(bi)
117     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---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
406    
407     ELSE
408     C--- not using CubedSphereExchange:
409    
410     #ifndef AUTODIFF_EXCH2
411     CALL EXCH_RX( uPhi,
412     I OLw, OLe, OLs, OLn, myNz,
413     I exchWidthX, exchWidthY,
414     I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
415     CALL EXCH_RX( vPhi,
416     I OLw, OLe, OLs, OLn, myNz,
417     I exchWidthX, exchWidthY,
418     I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
419     #endif
420    
421     C--- using or not using CubedSphereExchange: end
422     ENDIF
423    
424     RETURN
425     END
426    
427     CEH3 ;;; Local Variables: ***
428     CEH3 ;;; mode:fortran ***
429     CEH3 ;;; End: ***

  ViewVC Help
Powered by ViewVC 1.1.22