/[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.3 - (show annotations) (download)
Mon Aug 20 19:22:32 2007 UTC (16 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59g, checkpoint59f, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i
Changes since 1.2: +3 -1 lines
copy back NW corner values (forgot this corner)

1 C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_bgrid_3d_rx.template,v 1.2 2007/08/17 18:17:45 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_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 uPhi(1,sNy+1,k,bi,bj) = uPhiNW(k,bi,bj)
326 vPhi(1,sNy+1,k,bi,bj) = vPhiNW(k,bi,bj)
327 DO i=2,OLx
328 uPhi(1,sNy+i,k,bi,bj) = vPhi(2-i,sNy+1,k,bi,bj)
329 vPhi(1,sNy+i,k,bi,bj) = uPhi(2-i,sNy+1,k,bi,bj)*negOne
330 ENDDO
331 ENDDO
332 ELSE
333 DO k=1,myNz
334 DO i=2,OLx
335 uPhi(2-i,sNy+1,k,bi,bj) = vPhi(1,sNy+i,k,bi,bj)*negOne
336 vPhi(2-i,sNy+1,k,bi,bj) = uPhi(1,sNy+i,k,bi,bj)
337 ENDDO
338 ENDDO
339 ENDIF
340 ENDIF
341
342 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
343
344 #ifdef W2_FILL_NULL_REGIONS
345 C-- Now zero out the null areas that should not be used in the numerics
346
347 IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
348 & exch2_isSedge(myTile) .EQ. 1 ) THEN
349 C Zero SW corner points
350 DO k=1,myNz
351 DO j=1-OLy,0
352 DO i=1-OLx,0
353 uPhi(i,j,k,bi,bj)=e2FillValue_RX
354 vPhi(i,j,k,bi,bj)=e2FillValue_RX
355 ENDDO
356 ENDDO
357 ENDDO
358 ENDIF
359
360 IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
361 & exch2_isNedge(myTile) .EQ. 1 ) THEN
362 C Zero NW corner points
363 DO k=1,myNz
364 DO j=sNy+2,sNy+OLy
365 DO i=1-OLx,0
366 uPhi(i,j,k,bi,bj)=e2FillValue_RX
367 vPhi(i,j,k,bi,bj)=e2FillValue_RX
368 ENDDO
369 ENDDO
370 ENDDO
371 ENDIF
372
373 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
374 & exch2_isSedge(myTile) .EQ. 1 ) THEN
375 C Zero SE corner points
376 DO k=1,myNz
377 DO j=1-OLy,0
378 DO i=sNx+2,sNx+OLx
379 uPhi(i,j,k,bi,bj)=e2FillValue_RX
380 vPhi(i,j,k,bi,bj)=e2FillValue_RX
381 ENDDO
382 ENDDO
383 ENDDO
384 ENDIF
385
386 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
387 & exch2_isNedge(myTile) .EQ. 1 ) THEN
388 C Zero NE corner points
389 DO k=1,myNz
390 DO j=sNy+2,sNy+OLy
391 DO i=sNx+2,sNx+OLx
392 uPhi(i,j,k,bi,bj)=e2FillValue_RX
393 vPhi(i,j,k,bi,bj)=e2FillValue_RX
394 ENDDO
395 ENDDO
396 ENDDO
397 ENDIF
398
399 #endif /* W2_FILL_NULL_REGIONS */
400
401 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
402
403 C-- end of Loops on tile indices (bi,bj).
404 ENDDO
405 ENDDO
406
407 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
408
409 ELSE
410 C--- not using CubedSphereExchange:
411
412 #ifndef AUTODIFF_EXCH2
413 CALL EXCH_RX( uPhi,
414 I OLw, OLe, OLs, OLn, myNz,
415 I exchWidthX, exchWidthY,
416 I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
417 CALL EXCH_RX( vPhi,
418 I OLw, OLe, OLs, OLn, myNz,
419 I exchWidthX, exchWidthY,
420 I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
421 #endif
422
423 C--- using or not using CubedSphereExchange: end
424 ENDIF
425
426 RETURN
427 END
428
429 CEH3 ;;; Local Variables: ***
430 CEH3 ;;; mode:fortran ***
431 CEH3 ;;; End: ***

  ViewVC Help
Powered by ViewVC 1.1.22