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

Annotation of /MITgcm/pkg/exch2/exch2_z_3d_rx.template

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

Revision 1.6 - (hide annotations) (download)
Thu May 6 23:28:46 2010 UTC (14 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint63, checkpoint62g, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x
Changes since 1.5: +5 -5 lines 
- S/R EXCH2_RX1,2_CUBE: remove argument "simulationMode" ;
- add argument "signOption" to EXCH2_RX1_CUBE (will be needed for SM exch)
1 jmc 1.6 C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_z_3d_rx.template,v 1.5 2010/04/23 20:21:07 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: EXCH_Z_3D_RX
9    
10     C !INTERFACE:
11     SUBROUTINE EXCH2_Z_3D_RX(
12     U phi,
13     I myNz, myThid )
14     IMPLICIT NONE
15     C !DESCRIPTION:
16     C *==========================================================*
17     C | SUBROUTINE EXCH_Z_3D_RX
18     C | o Handle exchanges for _RX three-dim zeta-point array.
19     C *==========================================================*
20    
21     C !USES:
22     C === Global data ===
23     #include "SIZE.h"
24     #include "EEPARAMS.h"
25 jmc 1.3 #include "W2_EXCH2_SIZE.h"
26 jmc 1.1 #include "W2_EXCH2_TOPOLOGY.h"
27 jmc 1.3 #ifdef W2_FILL_NULL_REGIONS
28 jmc 1.1 #include "W2_EXCH2_PARAMS.h"
29 jmc 1.3 #endif
30 jmc 1.1
31     C !INPUT/OUTPUT PARAMETERS:
32     C === Routine arguments ===
33     C phi :: Array with overlap regions are to be exchanged
34     C myNz :: 3rd dimension of input array phi
35     C myThid :: My Thread Id. number
36     INTEGER myNz
37     _RX phi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
38     INTEGER myThid
39    
40     C !LOCAL VARIABLES:
41     C == Local variables ==
42     C OL[wens] :: Overlap extents in west, east, north, south.
43     C exchWidth[XY] :: Extent of regions that will be exchanged.
44     C mFace :: face number
45     C local_maxDim :: upper limit of 3rd dimension value
46     C phiNW,phiSE :: temporary array to hold corner value (CS grid)
47 jmc 1.5 C msgBuf :: Informational/error message buffer
48 jmc 1.1 INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
49     INTEGER bi, bj, myTile, i, j, k
50     INTEGER mFace
51     INTEGER local_maxDim
52     PARAMETER( local_maxDim = 8*Nr )
53     _RX phiNW(local_maxDim,nSx,nSy)
54     _RX phiSE(local_maxDim,nSx,nSy)
55     CHARACTER*(MAX_LEN_MBUF) msgBuf
56     CEOP
57    
58    
59     OLw = OLx
60     OLe = OLx
61     OLn = OLy
62     OLs = OLy
63     exchWidthX = OLx
64     exchWidthY = OLy
65    
66     IF (useCubedSphereExchange) THEN
67     IF ( myNz.GT.local_maxDim ) THEN
68     WRITE(msgBuf,'(2A,2(I4,A))') 'EXCH_Z_3D_RX :',
69     & ' 3rd dimension=', myNz,
70     & ' exceeds local_maxDim (=', local_maxDim, ' )'
71     CALL PRINT_ERROR( msgBuf , myThid )
72     WRITE(msgBuf,'(2A)') 'EXCH_Z_3D_RX :',
73     & ' Increase "local_maxDim" and recompile'
74     CALL PRINT_ERROR( msgBuf , myThid )
75     STOP 'ABNORMAL END: S/R EXCH_Z_3D_RX'
76     ENDIF
77    
78     C- save 2 corners value (in case we find 1 "missing corner")
79     DO bj=myByLo(myThid),myByHi(myThid)
80     DO bi=myBxLo(myThid),myBxHi(myThid)
81     DO k=1,myNz
82     phiNW(k,bi,bj) = phi(1,sNy+1,k,bi,bj)
83     phiSE(k,bi,bj) = phi(sNx+1,1,k,bi,bj)
84     ENDDO
85     ENDDO
86     ENDDO
87 jmc 1.4 ENDIF
88 jmc 1.1
89 jmc 1.6 CALL EXCH2_RX1_CUBE( phi, .FALSE., 'T ',
90 jmc 1.1 I OLw, OLe, OLs, OLn, myNz,
91     I exchWidthX, exchWidthY,
92 jmc 1.6 I EXCH_UPDATE_CORNERS, myThid )
93     CALL EXCH2_RX1_CUBE( phi, .FALSE., 'T ',
94 jmc 1.1 I OLw, OLe, OLs, OLn, myNz,
95     I exchWidthX, exchWidthY,
96 jmc 1.6 I EXCH_UPDATE_CORNERS, myThid )
97 jmc 1.1
98 jmc 1.4 IF (useCubedSphereExchange) THEN
99    
100 jmc 1.1 DO bj=myByLo(myThid),myByHi(myThid)
101     DO bi=myBxLo(myThid),myBxHi(myThid)
102 jmc 1.4 myTile = W2_myTileList(bi,bj)
103 jmc 1.1 mFace = exch2_myFace(myTile)
104    
105     C--- Face 2,4,6:
106     IF ( MOD(mFace,2).EQ.0 ) THEN
107    
108     C-- East edge : shift j <- j-1
109     IF ( exch2_isEedge(myTile) .EQ. 1 ) THEN
110     DO k=1,myNz
111     DO j=sNy+OLy,2-Oly,-1
112     DO i=sNx+1,sNx+OLx
113     phi(i,j,k,bi,bj)=phi(i,j-1,k,bi,bj)
114     ENDDO
115     ENDDO
116     ENDDO
117     C- North-East corner
118     IF ( exch2_isNedge(myTile) .EQ. 1 ) THEN
119     DO k=1,myNz
120     DO j=sNy+2,sNy+OLy
121     i=sNx-sNy+j
122     phi(sNx+1,j,k,bi,bj)=phi(i,sNy+1,k,bi,bj)
123     ENDDO
124     #ifdef W2_FILL_NULL_REGIONS
125     DO j=sNy+2,sNy+OLy
126     DO i=sNx+2,sNx+OLx
127     phi(i,j,k,bi,bj)=e2FillValue_RX
128     ENDDO
129     ENDDO
130     #endif
131     ENDDO
132     ENDIF
133     ENDIF
134     C-- South edge : shift i <- i-1
135     IF ( exch2_isSedge(myTile) .EQ. 1 ) THEN
136     DO k=1,myNz
137     DO j=1-OLy,0
138     DO i=sNx+OLx,2-Olx,-1
139     phi(i,j,k,bi,bj)=phi(i-1,j,k,bi,bj)
140     ENDDO
141     ENDDO
142     ENDDO
143     C- South-East corner
144     IF ( exch2_isEedge(myTile) .EQ. 1 ) THEN
145     DO k=1,myNz
146     phi(sNx+1,1,k,bi,bj)=phiSE(k,bi,bj)
147     DO i=sNx+2,sNx+OLx
148     j=sNx+2-i
149     phi(i,1,k,bi,bj)=phi(sNx+1,j,k,bi,bj)
150     ENDDO
151     #ifdef W2_FILL_NULL_REGIONS
152     DO j=1-OLy,0
153     DO i=sNx+2,sNx+OLx
154     phi(i,j,k,bi,bj)=e2FillValue_RX
155     ENDDO
156     ENDDO
157     #endif
158     ENDDO
159     ENDIF
160     C- South-West corner
161     IF ( exch2_isWedge(myTile) .EQ. 1 ) THEN
162     DO k=1,myNz
163     DO j=1-OLy,0
164     phi(1,j,k,bi,bj)=phi(j,1,k,bi,bj)
165     #ifdef W2_FILL_NULL_REGIONS
166     DO i=1-OLx,0
167     phi(i,j,k,bi,bj)=e2FillValue_RX
168     ENDDO
169     #endif
170     ENDDO
171     ENDDO
172     ENDIF
173     ENDIF
174     C-- North-west corner
175     IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
176     & exch2_isNedge(myTile) .EQ. 1 ) THEN
177     DO k=1,myNz
178     DO i=2-OLx,0
179     j=sNy+2-i
180     phi(i,sNy+1,k,bi,bj)=phi(1,j,k,bi,bj)
181     ENDDO
182     #ifdef W2_FILL_NULL_REGIONS
183     DO j=sNy+2,sNy+OLy
184     DO i=1-OLx,0
185     phi(i,j,k,bi,bj)=e2FillValue_RX
186     ENDDO
187     ENDDO
188     phi(1-Olx,sNy+1,k,bi,bj)=e2FillValue_RX
189     #endif
190     ENDDO
191     ENDIF
192    
193     ELSE
194     C--- Face 1,3,5:
195    
196     C-- North edge : shift i <- i-1
197     IF ( exch2_isNedge(myTile) .EQ. 1 ) THEN
198     DO k=1,myNz
199     DO j=sNy+1,sNy+Oly
200     DO i=sNx+OLx,2-Olx,-1
201     phi(i,j,k,bi,bj)=phi(i-1,j,k,bi,bj)
202     ENDDO
203     ENDDO
204     ENDDO
205     C- North-East corner
206     IF ( exch2_isEedge(myTile) .EQ. 1 ) THEN
207     DO k=1,myNz
208     DO i=sNx+2,sNx+OLx
209     j=sNy-sNx+i
210     phi(i,sNy+1,k,bi,bj)=phi(sNx+1,j,k,bi,bj)
211     ENDDO
212     #ifdef W2_FILL_NULL_REGIONS
213     DO j=sNy+2,sNy+OLy
214     DO i=sNx+2,sNx+OLx
215     phi(i,j,k,bi,bj)=e2FillValue_RX
216     ENDDO
217     ENDDO
218     #endif
219     ENDDO
220     ENDIF
221     ENDIF
222     C-- West edge : shift j <- j-1
223     IF ( exch2_isWedge(myTile) .EQ. 1 ) THEN
224     DO k=1,myNz
225     DO j=sNy+OLy,2-Oly,-1
226     DO i=1-Olx,0
227     phi(i,j,k,bi,bj)=phi(i,j-1,k,bi,bj)
228     ENDDO
229     ENDDO
230     ENDDO
231     C- North-west corner
232     IF ( exch2_isNedge(myTile) .EQ. 1 ) THEN
233     DO k=1,myNz
234     phi(1,sNy+1,k,bi,bj)=phiNW(k,bi,bj)
235     DO j=sNy+2,sNy+OLy
236     i=sNy+2-j
237     phi(1,j,k,bi,bj)=phi(i,sNy+1,k,bi,bj)
238     ENDDO
239     #ifdef W2_FILL_NULL_REGIONS
240     DO j=sNy+2,sNy+OLy
241     DO i=1-OLx,0
242     phi(i,j,k,bi,bj)=e2FillValue_RX
243     ENDDO
244     ENDDO
245     #endif
246     ENDDO
247     ENDIF
248     C- South-West corner
249     IF ( exch2_isSedge(myTile) .EQ. 1 ) THEN
250     DO k=1,myNz
251     DO i=1-OLx,0
252     phi(i,1,k,bi,bj)=phi(1,i,k,bi,bj)
253     ENDDO
254     #ifdef W2_FILL_NULL_REGIONS
255     DO j=1-OLy,0
256     DO i=1-OLx,0
257     phi(i,j,k,bi,bj)=e2FillValue_RX
258     ENDDO
259     ENDDO
260     #endif
261     ENDDO
262     ENDIF
263     ENDIF
264     C- South-East corner
265     IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
266     & exch2_isSedge(myTile) .EQ. 1 ) THEN
267     DO k=1,myNz
268     DO j=2-OLy,0
269     i=sNx+2-j
270     phi(sNx+1,j,k,bi,bj)=phi(i,1,k,bi,bj)
271     ENDDO
272     #ifdef W2_FILL_NULL_REGIONS
273     DO j=1-OLy,0
274     DO i=sNx+2,sNx+OLx
275     phi(i,j,k,bi,bj)=e2FillValue_RX
276     ENDDO
277     ENDDO
278     phi(sNx+1,1-Oly,k,bi,bj)=e2FillValue_RX
279     #endif
280     ENDDO
281     ENDIF
282    
283     C--- end odd / even face number
284     ENDIF
285    
286     ENDDO
287     ENDDO
288    
289 jmc 1.4 C--- using or not using CubedSphereExchange: end
290 jmc 1.1 ENDIF
291    
292     RETURN
293     END
294    
295     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
296    
297     CEH3 ;;; Local Variables: ***
298     CEH3 ;;; mode:fortran ***
299     CEH3 ;;; End: ***
  ViewVC Help
Powered by ViewVC 1.1.22