/[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.4 - (hide annotations) (download)
Tue May 12 19:44:58 2009 UTC (15 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint61o, checkpoint61r, checkpoint61p, checkpoint61q
Changes since 1.3: +4 -1 lines
new header files "W2_EXCH2_SIZE.h" (taken out of W2_EXCH2_TOPOLOGY.h)
             and "W2_EXCH2_BUFFER.h" (taken out of W2_EXCH2_PARAMS.h)

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

  ViewVC Help
Powered by ViewVC 1.1.22