/[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.1 - (hide annotations) (download)
Wed Jul 25 21:11:47 2007 UTC (17 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59e
new exch2 S/R that only use the cube-tracer (center-position) exchange:
for B-grid vector (not yet tested) and C-grid vector (tested).

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