/[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.4 - (show annotations) (download)
Tue May 12 19:44:58 2009 UTC (16 years, 2 months 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 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 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 c#include "EESUPPORT.h"
39 #include "W2_EXCH2_SIZE.h"
40 #include "W2_EXCH2_TOPOLOGY.h"
41 #ifdef W2_FILL_NULL_REGIONS
42 #include "W2_EXCH2_PARAMS.h"
43 #endif
44
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 uPhi(1,sNy+1,k,bi,bj) = uPhiNW(k,bi,bj)
329 vPhi(1,sNy+1,k,bi,bj) = vPhiNW(k,bi,bj)
330 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