/[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.5 - (hide annotations) (download)
Sun Jun 28 00:57:51 2009 UTC (16 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62e, checkpoint62d, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61s, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.4: +6 -19 lines
-always call exch2_*_cube, not exch-1 anymore, if useCubedSphereExchange=F
-add bj in exch2 arrays and S/R.

1 jmc 1.5 C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_bgrid_3d_rx.template,v 1.4 2009/05/12 19:44:58 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     C msgBuf :: Informational/error meesage buffer
62    
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     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     CALL EXCH2_RX1_CUBE( uPhi, 'T ',
120     I OLw, OLe, OLs, OLn, myNz,
121     I exchWidthX, exchWidthY,
122     I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
123    
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     CALL EXCH2_RX1_CUBE( vPhi, 'T ',
129     I OLw, OLe, OLs, OLn, myNz,
130     I exchWidthX, exchWidthY,
131     I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
132    
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     C- Now choose what to do at each edge of the halo based on which face
153     C (we assume that bj is always=1)
154 jmc 1.5 myTile = W2_myTileList(bi,bj)
155 jmc 1.1 myFace = exch2_myFace(myTile)
156    
157     C-- Loops on level index:
158     DO k = 1,myNz
159    
160     C- First we copy the 2 components info into local dummy arrays uLoc,vLoc
161     DO j = 1-OLy,sNy+OLy
162     DO i = 1-OLx,sNx+OLx
163     uLoc(i,j) = uPhi(i,j,k,bi,bj)
164     vLoc(i,j) = vPhi(i,j,k,bi,bj)
165     ENDDO
166     ENDDO
167    
168     C- odd faces share disposition of all sections of the halo
169     IF ( MOD(myFace,2).EQ.1 ) THEN
170     C- North:
171     IF (exch2_isNedge(myTile).EQ.1) THEN
172     C switch u <- v , reverse the sign & shift i+1 <- i
173     C switch v <- u , keep the sign & shift i+1 <- i
174     DO j = 1,exchWidthY
175     DO i = 1-OLx,sNx+OLx-1
176     uPhi(i+1,sNy+j,k,bi,bj) = vLoc(i,sNy+j)*negOne
177     vPhi(i+1,sNy+j,k,bi,bj) = uLoc(i,sNy+j)
178     ENDDO
179     ENDDO
180     ENDIF
181     C- South (nothing to change)
182     c IF (exch2_isSedge(myTile).EQ.1) THEN
183     c DO j = 1,exchWidthY
184     c DO i = 1-OLx,sNx+OLx
185     c uPhi(i,1-j,k,bi,bj) = uLoc(i,1-j)
186     c vPhi(i,1-j,k,bi,bj) = vLoc(i,1-j)
187     c ENDDO
188     c ENDDO
189     c ENDIF
190     C- East (nothing to change)
191     c IF (exch2_isEedge(myTile).EQ.1) THEN
192     c DO j = 1-OLy,sNy+OLy
193     c DO i = 1,exchWidthX
194     c uPhi(sNx+i,j,k,bi,bj) = uLoc(sNx+i,j)
195     c vPhi(sNx+i,j,k,bi,bj) = vLoc(sNx+i,j)
196     c ENDDO
197     c ENDDO
198     c ENDIF
199     C- West:
200     IF (exch2_isWedge(myTile).EQ.1) THEN
201     C switch u <- v , keep the sign & shift j+1 <- j
202     C switch v <- u , reverse the sign & shift j+1 <- j
203     DO j = 1-OLy,sNy+OLy-1
204     DO i = 1,exchWidthX
205     uPhi(1-i,j+1,k,bi,bj) = vLoc(1-i,j)
206     vPhi(1-i,j+1,k,bi,bj) = uLoc(1-i,j)*negOne
207     ENDDO
208     ENDDO
209     ENDIF
210    
211     ELSE
212     C- Now the even faces (share disposition of all sections of the halo)
213    
214     C- East:
215     IF (exch2_isEedge(myTile).EQ.1) THEN
216     C switch u <- v , keep the sign & shift j+1 <- j
217     C switch v <- u , reverse the sign & shift j+1 <- j
218     DO j = 1-OLy,sNy+OLy-1
219     DO i = 1,exchWidthX
220     uPhi(sNx+i,j+1,k,bi,bj) = vLoc(sNx+i,j)
221     vPhi(sNx+i,j+1,k,bi,bj) = uLoc(sNx+i,j)*negOne
222     ENDDO
223     ENDDO
224     ENDIF
225     C- West (nothing to change)
226     c IF (exch2_isWedge(myTile).EQ.1) THEN
227     c DO j = 1-OLy,sNy+OLy
228     c DO i = 1,exchWidthX
229     c uPhi(1-i,j,k,bi,bj) = uLoc(1-i,j)
230     c vPhi(1-i,j,k,bi,bj) = vLoc(1-i,j)
231     c ENDDO
232     c ENDDO
233     c ENDIF
234     C- North (nothing to change)
235     c IF (exch2_isNedge(myTile).EQ.1) THEN
236     c DO j = 1,exchWidthY
237     c DO i = 1-OLx,sNx+OLx
238     c uPhi(i,sNy+j,k,bi,bj) = uLoc(i,sNy+j)
239     c vPhi(i,sNy+j,k,bi,bj) = vLoc(i,sNy+j)
240     c ENDDO
241     c ENDDO
242     c ENDIF
243     C- South:
244     IF (exch2_isSedge(myTile).EQ.1) THEN
245     C switch u <- v , reverse the sign & shift i+1 <- i
246     C switch v <- u , keep the sign & shift i+1 <- i
247     DO j = 1,exchWidthY
248     DO i = 1-OLx,sNx+OLx-1
249     uPhi(i+1,1-j,k,bi,bj) = vLoc(i,1-j)*negOne
250     vPhi(i+1,1-j,k,bi,bj) = uLoc(i,1-j)
251     ENDDO
252     ENDDO
253     ENDIF
254    
255     C- end odd / even faces
256     ENDIF
257    
258     C-- end of Loops on level index k.
259     ENDDO
260    
261     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
262     C-- Now fix edges near cube-corner
263    
264     C- South-West corner
265     IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
266     & exch2_isSedge(myTile) .EQ. 1 ) THEN
267     IF ( MOD(myFace,2).EQ.1 ) THEN
268     DO k=1,myNz
269     DO i=1,OLx
270     vPhi(1-i,1,k,bi,bj) = uPhi(1,1-i,k,bi,bj)*negOne
271     uPhi(1-i,1,k,bi,bj) = vPhi(1,1-i,k,bi,bj)
272     ENDDO
273     ENDDO
274     ELSE
275     DO k=1,myNz
276     DO i=1,OLx
277     uPhi(1,1-i,k,bi,bj) = vPhi(1-i,1,k,bi,bj)*negOne
278     vPhi(1,1-i,k,bi,bj) = uPhi(1-i,1,k,bi,bj)
279     ENDDO
280     ENDDO
281     ENDIF
282     ENDIF
283    
284     C- South-East corner
285     IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
286     & exch2_isSedge(myTile) .EQ. 1 ) THEN
287     IF ( MOD(myFace,2).EQ.1 ) THEN
288     DO k=1,myNz
289     DO i=2,OLx
290     uPhi(sNx+1,2-i,k,bi,bj) = vPhi(sNx+i,1,k,bi,bj)
291     vPhi(sNx+1,2-i,k,bi,bj) = uPhi(sNx+i,1,k,bi,bj)*negOne
292     ENDDO
293     ENDDO
294     ELSE
295     DO k=1,myNz
296     uPhi(sNx+1,1,k,bi,bj) = uPhiSE(k,bi,bj)
297     vPhi(sNx+1,1,k,bi,bj) = vPhiSE(k,bi,bj)
298     DO i=2,OLx
299     uPhi(sNx+i,1,k,bi,bj) = vPhi(sNx+1,2-i,k,bi,bj)*negOne
300     vPhi(sNx+i,1,k,bi,bj) = uPhi(sNx+1,2-i,k,bi,bj)
301     ENDDO
302     ENDDO
303     ENDIF
304     ENDIF
305    
306     C- North-East corner
307     IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
308     & exch2_isNedge(myTile) .EQ. 1 ) THEN
309     IF ( MOD(myFace,2).EQ.1 ) THEN
310     DO k=1,myNz
311     DO i=2,OLx
312     uPhi(sNx+i,sNy+1,k,bi,bj)=vPhi(sNx+1,sNy+i,k,bi,bj)
313     vPhi(sNx+i,sNy+1,k,bi,bj)=uPhi(sNx+1,sNy+i,k,bi,bj)*negOne
314     ENDDO
315     ENDDO
316     ELSE
317     DO k=1,myNz
318     DO i=2,OLx
319     uPhi(sNx+1,sNy+i,k,bi,bj)=vPhi(sNx+i,sNy+1,k,bi,bj)*negOne
320     vPhi(sNx+1,sNy+i,k,bi,bj)=uPhi(sNx+i,sNy+1,k,bi,bj)
321     ENDDO
322     ENDDO
323     ENDIF
324     ENDIF
325    
326     C- North-West corner
327     IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
328     & exch2_isNedge(myTile) .EQ. 1 ) THEN
329     IF ( MOD(myFace,2).EQ.1 ) THEN
330     DO k=1,myNz
331 jmc 1.3 uPhi(1,sNy+1,k,bi,bj) = uPhiNW(k,bi,bj)
332     vPhi(1,sNy+1,k,bi,bj) = vPhiNW(k,bi,bj)
333 jmc 1.1 DO i=2,OLx
334     uPhi(1,sNy+i,k,bi,bj) = vPhi(2-i,sNy+1,k,bi,bj)
335     vPhi(1,sNy+i,k,bi,bj) = uPhi(2-i,sNy+1,k,bi,bj)*negOne
336     ENDDO
337     ENDDO
338     ELSE
339     DO k=1,myNz
340     DO i=2,OLx
341     uPhi(2-i,sNy+1,k,bi,bj) = vPhi(1,sNy+i,k,bi,bj)*negOne
342     vPhi(2-i,sNy+1,k,bi,bj) = uPhi(1,sNy+i,k,bi,bj)
343     ENDDO
344     ENDDO
345     ENDIF
346     ENDIF
347    
348     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
349    
350     #ifdef W2_FILL_NULL_REGIONS
351     C-- Now zero out the null areas that should not be used in the numerics
352    
353     IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
354     & exch2_isSedge(myTile) .EQ. 1 ) THEN
355     C Zero SW corner points
356     DO k=1,myNz
357     DO j=1-OLy,0
358     DO i=1-OLx,0
359     uPhi(i,j,k,bi,bj)=e2FillValue_RX
360     vPhi(i,j,k,bi,bj)=e2FillValue_RX
361     ENDDO
362     ENDDO
363     ENDDO
364     ENDIF
365    
366     IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
367     & exch2_isNedge(myTile) .EQ. 1 ) THEN
368     C Zero NW corner points
369     DO k=1,myNz
370     DO j=sNy+2,sNy+OLy
371     DO i=1-OLx,0
372     uPhi(i,j,k,bi,bj)=e2FillValue_RX
373     vPhi(i,j,k,bi,bj)=e2FillValue_RX
374     ENDDO
375     ENDDO
376     ENDDO
377     ENDIF
378    
379     IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
380     & exch2_isSedge(myTile) .EQ. 1 ) THEN
381     C Zero SE corner points
382     DO k=1,myNz
383     DO j=1-OLy,0
384     DO i=sNx+2,sNx+OLx
385     uPhi(i,j,k,bi,bj)=e2FillValue_RX
386     vPhi(i,j,k,bi,bj)=e2FillValue_RX
387     ENDDO
388     ENDDO
389     ENDDO
390     ENDIF
391    
392     IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
393     & exch2_isNedge(myTile) .EQ. 1 ) THEN
394     C Zero NE corner points
395     DO k=1,myNz
396     DO j=sNy+2,sNy+OLy
397     DO i=sNx+2,sNx+OLx
398     uPhi(i,j,k,bi,bj)=e2FillValue_RX
399     vPhi(i,j,k,bi,bj)=e2FillValue_RX
400     ENDDO
401     ENDDO
402     ENDDO
403     ENDIF
404    
405     #endif /* W2_FILL_NULL_REGIONS */
406    
407     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
408    
409     C-- end of Loops on tile indices (bi,bj).
410     ENDDO
411     ENDDO
412    
413     C--- using or not using CubedSphereExchange: end
414     ENDIF
415    
416     RETURN
417     END
418    
419     CEH3 ;;; Local Variables: ***
420     CEH3 ;;; mode:fortran ***
421     CEH3 ;;; End: ***

  ViewVC Help
Powered by ViewVC 1.1.22