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

Contents 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 - (show annotations) (download)
Sun Jun 28 00:57:51 2009 UTC (14 years, 11 months 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 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 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 "W2_EXCH2_SIZE.h"
39 #include "W2_EXCH2_TOPOLOGY.h"
40 #ifdef W2_FILL_NULL_REGIONS
41 #include "W2_EXCH2_PARAMS.h"
42 #endif
43
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 C--- using or not using CubedSphereExchange: end
111 ENDIF
112
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 IF ( useCubedSphereExchange ) THEN
138
139 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 myTile = W2_myTileList(bi,bj)
155 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 uPhi(1,sNy+1,k,bi,bj) = uPhiNW(k,bi,bj)
332 vPhi(1,sNy+1,k,bi,bj) = vPhiNW(k,bi,bj)
333 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