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

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

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


Revision 1.8 - (hide annotations) (download)
Mon Mar 26 19:43:10 2012 UTC (13 years, 3 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o
Changes since 1.7: +3 -3 lines
Switch 1rst EXCH call to IGNORE_CORNERS (instead of UPDATE_CORNERS)
but keep the 2nd with UPDATE_CORNERS : this prevent overwiting
good data with bad ones comming from a not-yet-updated halo.

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

  ViewVC Help
Powered by ViewVC 1.1.22