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

Contents of /MITgcm/pkg/exch2/exch2_uv_3d_rx.template

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.1 - (show annotations) (download)
Wed Aug 23 15:13:03 2006 UTC (17 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint58r_post, checkpoint58x_post, checkpoint58t_post, checkpoint58q_post, checkpoint59e, checkpoint59d, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59, checkpoint58o_post, checkpoint58y_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post 
exch2 interface S/R:
 - change _XYZ_ interface to _3D_ subroutine (with 3rd dim in argument list)
 - not often used EXCH S/R (exch_z, exch_uv_agrid): keep only the _3D_ version.
1 C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_xyz_rx.template,v 1.7 2005/11/04 01:31:05 jmc Exp $
2 C $Name: $
3
4 #include "CPP_EEOPTIONS.h"
5 #include "W2_OPTIONS.h"
6
7 CBOP
8 C !ROUTINE: EXCH2_UV_3D_RX
9
10 C !INTERFACE:
11 SUBROUTINE EXCH2_UV_3D_RX(
12 U Uphi, Vphi,
13 I withSigns, myNz, myThid )
14
15 C !DESCRIPTION:
16 C *==========================================================*
17 C | SUBROUTINE EXCH2_UV_3D_RX
18 C | o Handle exchanges for _RX, 3-dimensional vector arrays.
19 C *==========================================================*
20 C | Vector arrays need to be rotated and interchaged for
21 C | exchange operations on some grids. This driver routine
22 C | branches to support this.
23 C *==========================================================*
24
25 C !USES:
26 IMPLICIT NONE
27 C === Global data ===
28 #include "SIZE.h"
29 #include "EEPARAMS.h"
30 #include "EESUPPORT.h"
31 #include "W2_EXCH2_TOPOLOGY.h"
32 #include "W2_EXCH2_PARAMS.h"
33
34 C !INPUT/OUTPUT PARAMETERS:
35 C === Routine arguments ===
36 C phi :: Array with overlap regions are to be exchanged
37 C Note - The interface to EXCH_RX assumes that
38 C the standard Fortran 77 sequence association rules
39 C apply.
40 C myNz :: 3rd dimension of array to exchange
41 C myThid :: My thread id.
42 INTEGER myNz
43 _RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
44 _RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
45 LOGICAL withSigns
46 INTEGER myThid
47
48 C !LOCAL VARIABLES:
49 C == Local variables ==
50 C OL[wens] :: Overlap extents in west, east, north, south.
51 C exchWidth[XY] :: Extent of regions that will be exchanged.
52 INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
53 INTEGER bi, bj, myTile, k, j
54 #ifdef W2_FILL_NULL_REGIONS
55 INTEGER i
56 #endif
57 CEOP
58
59 OLw = OLx
60 OLe = OLx
61 OLn = OLy
62 OLs = OLy
63 exchWidthX = OLx
64 exchWidthY = OLy
65 C ** NOTE ** The exchange routine we use here does not
66 C require the preceeding and following barriers.
67 C However, the slow, simple exchange interface
68 C that is calling it here is meant to ensure
69 C that threads are synchronised before exchanges
70 C begine.
71
72 IF (useCubedSphereExchange) THEN
73
74 CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'UV',
75 I OLw, OLe, OLs, OLn, myNz,
76 I exchWidthX, exchWidthY,
77 I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
78 CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'UV',
79 I OLw, OLe, OLs, OLn, myNz,
80 I exchWidthX, exchWidthY,
81 I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
82 CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'UV',
83 I OLw, OLe, OLs, OLn, myNz,
84 I exchWidthX, exchWidthY,
85 I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
86
87 DO bj=myByLo(myThid),myByHi(myThid)
88 DO bi=myBxLo(myThid),myBxHi(myThid)
89 myTile = W2_myTileList(bi)
90
91 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
92 & exch2_isSedge(myTile) .EQ. 1 ) THEN
93 DO k=1,myNz
94 C Uphi(snx+1, 0,k,bi,bj)= vPhi(snx+1, 1,k,bi,bj)
95 DO j=1-olx,0
96 Uphi(snx+1, j,k,bi,bj)= vPhi(snx+(1-j), 1,k,bi,bj)
97 ENDDO
98 ENDDO
99 ENDIF
100 IF ( withSigns ) THEN
101 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
102 & exch2_isNedge(myTile) .EQ. 1 ) THEN
103 DO k=1,myNz
104 C Uphi(snx+1,sny+1,k,bi,bj)=-vPhi(snx+1,sny+1,k,bi,bj)
105 DO j=1,olx
106 Uphi(snx+1,sny+j,k,bi,bj)=-vPhi(snx+j,sny+1,k,bi,bj)
107 ENDDO
108 ENDDO
109 ENDIF
110 ELSE
111 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
112 & exch2_isNedge(myTile) .EQ. 1 ) THEN
113 DO k=1,myNz
114 C Uphi(snx+1,sny+1,k,bi,bj)= vPhi(snx+1,sny+1,k,bi,bj)
115 DO j=1,olx
116 Uphi(snx+1,sny+j,k,bi,bj)= vPhi(snx+j,sny+1,k,bi,bj)
117 ENDDO
118 ENDDO
119 ENDIF
120 ENDIF
121
122 C-- Now zero out the null areas that should not be used in the numerics
123 C Also add one valid u,v value next to the corner, that allows
124 C to compute vorticity on a wider stencil (e.g., vort3(0,1) & (1,0))
125
126 IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
127 & exch2_isSedge(myTile) .EQ. 1 ) THEN
128 C Zero SW corner points
129 DO K=1,myNz
130 #ifdef W2_FILL_NULL_REGIONS
131 DO J=1-OLx,0
132 DO I=1-OLx,0
133 uPhi(I,J,K,bi,bj)=e2FillValue_RX
134 ENDDO
135 ENDDO
136 DO J=1-OLx,0
137 DO I=1-OLx,0
138 vPhi(I,J,K,bi,bj)=e2FillValue_RX
139 ENDDO
140 ENDDO
141 #endif
142 uPhi(0,0,K,bi,bj)=vPhi(1,0,K,bi,bj)
143 vPhi(0,0,K,bi,bj)=uPhi(0,1,K,bi,bj)
144 ENDDO
145 ENDIF
146
147 IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
148 & exch2_isNedge(myTile) .EQ. 1 ) THEN
149 C Zero NW corner points
150 DO K=1,myNz
151 #ifdef W2_FILL_NULL_REGIONS
152 DO J=sNy+1,sNy+OLy
153 DO I=1-OLx,0
154 uPhi(I,J,K,bi,bj)=e2FillValue_RX
155 ENDDO
156 ENDDO
157 DO J=sNy+2,sNy+OLy
158 DO I=1-OLx,0
159 vPhi(I,J,K,bi,bj)=e2FillValue_RX
160 ENDDO
161 ENDDO
162 #endif
163 IF ( withSigns ) THEN
164 uPhi(0,sNy+1,K,bi,bj)=-vPhi(1,sNy+2,K,bi,bj)
165 vPhi(0,sNy+2,K,bi,bj)=-uPhi(0,sNy,K,bi,bj)
166 ELSE
167 uPhi(0,sNy+1,K,bi,bj)= vPhi(1,sNy+2,K,bi,bj)
168 vPhi(0,sNy+2,K,bi,bj)= uPhi(0,sNy,K,bi,bj)
169 ENDIF
170 ENDDO
171 ENDIF
172
173 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
174 & exch2_isSedge(myTile) .EQ. 1 ) THEN
175 C Zero SE corner points
176 DO K=1,myNz
177 #ifdef W2_FILL_NULL_REGIONS
178 DO J=1-OLx,0
179 DO I=sNx+2,sNx+OLx
180 uPhi(I,J,K,bi,bj)=e2FillValue_RX
181 ENDDO
182 ENDDO
183 DO J=1-OLx,0
184 DO I=sNx+1,sNx+OLx
185 vPhi(I,J,K,bi,bj)=e2FillValue_RX
186 ENDDO
187 ENDDO
188 #endif
189 IF ( withSigns ) THEN
190 uPhi(sNx+2,0,K,bi,bj)=-vPhi(sNx,0,K,bi,bj)
191 vPhi(sNx+1,0,K,bi,bj)=-uPhi(sNx+2,1,K,bi,bj)
192 ELSE
193 uPhi(sNx+2,0,K,bi,bj)= vPhi(sNx,0,K,bi,bj)
194 vPhi(sNx+1,0,K,bi,bj)= uPhi(sNx+2,1,K,bi,bj)
195 ENDIF
196 ENDDO
197 ENDIF
198
199 IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
200 & exch2_isNedge(myTile) .EQ. 1 ) THEN
201 C Zero NE corner points
202 DO K=1,myNz
203 #ifdef W2_FILL_NULL_REGIONS
204 DO J=sNy+1,sNy+OLy
205 DO I=sNx+2,sNx+OLx
206 uPhi(I,J,K,bi,bj)=e2FillValue_RX
207 ENDDO
208 ENDDO
209 DO J=sNy+2,sNy+OLy
210 DO I=sNx+1,sNx+OLx
211 vPhi(I,J,K,bi,bj)=e2FillValue_RX
212 ENDDO
213 ENDDO
214 #endif
215 uPhi(sNx+2,sNy+1,K,bi,bj)=vPhi(sNx,sNy+2,K,bi,bj)
216 vPhi(sNx+1,sNy+2,K,bi,bj)=uPhi(sNx+2,sNy,K,bi,bj)
217 ENDDO
218 ENDIF
219 ENDDO
220 ENDDO
221
222 ELSE
223
224 c CALL EXCH_RX( Uphi,
225 c I OLw, OLe, OLs, OLn, myNz,
226 c I exchWidthX, exchWidthY,
227 c I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
228 c CALL EXCH_RX( Vphi,
229 c I OLw, OLe, OLs, OLn, myNz,
230 c I exchWidthX, exchWidthY,
231 c I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
232 c_jmc: for JAM compatibility, replace the 2 CALLs above by the 2 CPP_MACROs:
233 _EXCH_XYZ_RX( Uphi, myThid )
234 _EXCH_XYZ_RX( Vphi, myThid )
235
236 ENDIF
237
238 RETURN
239 END
240
241 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
242
243 CEH3 ;;; Local Variables: ***
244 CEH3 ;;; mode:fortran ***
245 CEH3 ;;; End: ***
  ViewVC Help
Powered by ViewVC 1.1.22