pkg/exch2/exch2_uv_3d_rx.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_3d_rx.template,v 1.6 2009/05/12 19:44:58 jmc Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"
#include "W2_OPTIONS.h"
#undef DO_CORNER_COPY_V2U

CBOP
C     !ROUTINE: EXCH2_UV_3D_RX

C     !INTERFACE:
      SUBROUTINE EXCH2_UV_3D_RX(
     U                           Uphi, Vphi,
     I                           withSigns, myNz, myThid )

C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE EXCH2_UV_3D_RX
C     | o Handle exchanges for _RX, 3-dimensional vector arrays.
C     *==========================================================*
C     | Vector arrays need to be rotated and interchaged for
C     | exchange operations on some grids. This driver routine
C     | branches to support this.
C     *==========================================================*

C     !USES:
      IMPLICIT NONE
C     === Global data ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "W2_EXCH2_SIZE.h"
#include "W2_EXCH2_TOPOLOGY.h"
#ifdef W2_FILL_NULL_REGIONS
#include "W2_EXCH2_PARAMS.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
C     === Routine arguments ===
C     phi    :: Array with overlap regions are to be exchanged
C               Note - The interface to EXCH_RX assumes that
C               the standard Fortran 77 sequence association rules
C               apply.
C     myNz   :: 3rd dimension of array to exchange
C     myThid :: My thread id.
      INTEGER myNz
      _RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
      _RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
      LOGICAL withSigns
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     OL[wens]       :: Overlap extents in west, east, north, south.
C     exchWidth[XY]  :: Extent of regions that will be exchanged.
      INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
      INTEGER bi, bj, myTile, k
#ifdef W2_FILL_NULL_REGIONS
      INTEGER i, j
#else
# ifdef DO_CORNER_COPY_V2U
      INTEGER j
# endif
#endif
CEOP

      OLw        = OLx
      OLe        = OLx
      OLn        = OLy
      OLs        = OLy
      exchWidthX = OLx
      exchWidthY = OLy

       CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'Cg',
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
       CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'Cg',
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )

      IF (useCubedSphereExchange) THEN
C---  using CubedSphereExchange:
      DO bj=myByLo(myThid),myByHi(myThid)
       DO bi=myBxLo(myThid),myBxHi(myThid)
        myTile = W2_myTileList(bi,bj)

#ifdef DO_CORNER_COPY_V2U
        IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &       exch2_isSedge(myTile) .EQ. 1 ) THEN
         DO k=1,myNz
C         Uphi(sNx+1,    0,k,bi,bj)= vPhi(sNx+1,    1,k,bi,bj)
          DO j=1-olx,0
           Uphi(sNx+1,    j,k,bi,bj)= vPhi(sNx+(1-j),    1,k,bi,bj)
          ENDDO
         ENDDO
        ENDIF
        IF ( withSigns ) THEN
         IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &        exch2_isNedge(myTile) .EQ. 1 ) THEN
          DO k=1,myNz
C          Uphi(sNx+1,sNy+1,k,bi,bj)=-vPhi(sNx+1,sNy+1,k,bi,bj)
           DO j=1,olx
            Uphi(sNx+1,sNy+j,k,bi,bj)=-vPhi(sNx+j,sNy+1,k,bi,bj)
           ENDDO
          ENDDO
         ENDIF
        ELSE
         IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &        exch2_isNedge(myTile) .EQ. 1 ) THEN
          DO k=1,myNz
C          Uphi(sNx+1,sNy+1,k,bi,bj)= vPhi(sNx+1,sNy+1,k,bi,bj)
           DO j=1,olx
            Uphi(sNx+1,sNy+j,k,bi,bj)= vPhi(sNx+j,sNy+1,k,bi,bj)
           ENDDO
          ENDDO
         ENDIF
        ENDIF
#endif /* DO_CORNER_COPY_V2U */

C--     Now zero out the null areas that should not be used in the numerics
C       Also add one valid u,v value next to the corner, that allows
C        to compute vorticity on a wider stencil (e.g., vort3(0,1) & (1,0))

        IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
     &       exch2_isSedge(myTile) .EQ. 1 ) THEN
C        Zero SW corner points
         DO k=1,myNz
#ifdef W2_FILL_NULL_REGIONS
          DO j=1-OLx,0
           DO i=1-OLx,0
            uPhi(i,j,k,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
          DO j=1-OLx,0
           DO i=1-OLx,0
            vPhi(i,j,k,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
#endif
            uPhi(0,0,k,bi,bj)=vPhi(1,0,k,bi,bj)
            vPhi(0,0,k,bi,bj)=uPhi(0,1,k,bi,bj)
         ENDDO
        ENDIF

        IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
     &       exch2_isNedge(myTile) .EQ. 1 ) THEN
C        Zero NW corner points
         DO k=1,myNz
#ifdef W2_FILL_NULL_REGIONS
          DO j=sNy+1,sNy+OLy
           DO i=1-OLx,0
            uPhi(i,j,k,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
          DO j=sNy+2,sNy+OLy
           DO i=1-OLx,0
            vPhi(i,j,k,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
#endif
          IF ( withSigns ) THEN
            uPhi(0,sNy+1,k,bi,bj)=-vPhi(1,sNy+2,k,bi,bj)
            vPhi(0,sNy+2,k,bi,bj)=-uPhi(0,sNy,k,bi,bj)
          ELSE
            uPhi(0,sNy+1,k,bi,bj)= vPhi(1,sNy+2,k,bi,bj)
            vPhi(0,sNy+2,k,bi,bj)= uPhi(0,sNy,k,bi,bj)
          ENDIF
         ENDDO
        ENDIF

        IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &       exch2_isSedge(myTile) .EQ. 1 ) THEN
C        Zero SE corner points
         DO k=1,myNz
#ifdef W2_FILL_NULL_REGIONS
          DO j=1-OLx,0
           DO i=sNx+2,sNx+OLx
            uPhi(i,j,k,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
          DO j=1-OLx,0
           DO i=sNx+1,sNx+OLx
            vPhi(i,j,k,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
#endif
          IF ( withSigns ) THEN
            uPhi(sNx+2,0,k,bi,bj)=-vPhi(sNx,0,k,bi,bj)
            vPhi(sNx+1,0,k,bi,bj)=-uPhi(sNx+2,1,k,bi,bj)
          ELSE
            uPhi(sNx+2,0,k,bi,bj)= vPhi(sNx,0,k,bi,bj)
            vPhi(sNx+1,0,k,bi,bj)= uPhi(sNx+2,1,k,bi,bj)
          ENDIF
         ENDDO
        ENDIF

        IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &       exch2_isNedge(myTile) .EQ. 1 ) THEN
C        Zero NE corner points
         DO k=1,myNz
#ifdef W2_FILL_NULL_REGIONS
          DO j=sNy+1,sNy+OLy
           DO i=sNx+2,sNx+OLx
            uPhi(i,j,k,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
          DO j=sNy+2,sNy+OLy
           DO i=sNx+1,sNx+OLx
            vPhi(i,j,k,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
#endif
            uPhi(sNx+2,sNy+1,k,bi,bj)=vPhi(sNx,sNy+2,k,bi,bj)
            vPhi(sNx+1,sNy+2,k,bi,bj)=uPhi(sNx+2,sNy,k,bi,bj)
         ENDDO
        ENDIF

       ENDDO
      ENDDO
C---  using or not using CubedSphereExchange: end
      ENDIF

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CEH3 ;;; Local Variables: ***
CEH3 ;;; mode:fortran ***
CEH3 ;;; End: ***
1	jmc	1.7	C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_3d_rx.template,v 1.6 2009/05/12 19:44:58 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5			#include "W2_OPTIONS.h"
6	jmc	1.4	#undef DO_CORNER_COPY_V2U
7	jmc	1.1
8			CBOP
9			C !ROUTINE: EXCH2_UV_3D_RX
10
11			C !INTERFACE:
12			SUBROUTINE EXCH2_UV_3D_RX(
13			U Uphi, Vphi,
14			I withSigns, myNz, myThid )
15
16			C !DESCRIPTION:
17			C ==========================================================
18			C \| SUBROUTINE EXCH2_UV_3D_RX
19			C \| o Handle exchanges for _RX, 3-dimensional vector arrays.
20			C ==========================================================
21			C \| Vector arrays need to be rotated and interchaged for
22			C \| exchange operations on some grids. This driver routine
23			C \| branches to support this.
24			C ==========================================================
25
26			C !USES:
27			IMPLICIT NONE
28			C === Global data ===
29			#include "SIZE.h"
30			#include "EEPARAMS.h"
31	jmc	1.6	#include "W2_EXCH2_SIZE.h"
32	jmc	1.1	#include "W2_EXCH2_TOPOLOGY.h"
33	jmc	1.6	#ifdef W2_FILL_NULL_REGIONS
34	jmc	1.1	#include "W2_EXCH2_PARAMS.h"
35	jmc	1.6	#endif
36	jmc	1.1
37			C !INPUT/OUTPUT PARAMETERS:
38			C === Routine arguments ===
39			C phi :: Array with overlap regions are to be exchanged
40			C Note - The interface to EXCH_RX assumes that
41			C the standard Fortran 77 sequence association rules
42			C apply.
43			C myNz :: 3rd dimension of array to exchange
44			C myThid :: My thread id.
45			INTEGER myNz
46			_RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
47			_RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
48			LOGICAL withSigns
49			INTEGER myThid
50
51			C !LOCAL VARIABLES:
52			C == Local variables ==
53			C OL[wens] :: Overlap extents in west, east, north, south.
54			C exchWidth[XY] :: Extent of regions that will be exchanged.
55			INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
56	jmc	1.7	INTEGER bi, bj, myTile, k
57	jmc	1.1	#ifdef W2_FILL_NULL_REGIONS
58	jmc	1.7	INTEGER i, j
59			#else
60			# ifdef DO_CORNER_COPY_V2U
61			INTEGER j
62			# endif
63	jmc	1.1	#endif
64			CEOP
65
66			OLw = OLx
67			OLe = OLx
68			OLn = OLy
69			OLs = OLy
70			exchWidthX = OLx
71			exchWidthY = OLy
72
73	jmc	1.3	CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'Cg',
74	jmc	1.1	I OLw, OLe, OLs, OLn, myNz,
75			I exchWidthX, exchWidthY,
76			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
77	jmc	1.3	CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'Cg',
78	jmc	1.1	I OLw, OLe, OLs, OLn, myNz,
79			I exchWidthX, exchWidthY,
80			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
81
82	jmc	1.7	IF (useCubedSphereExchange) THEN
83			C--- using CubedSphereExchange:
84	jmc	1.1	DO bj=myByLo(myThid),myByHi(myThid)
85			DO bi=myBxLo(myThid),myBxHi(myThid)
86	jmc	1.7	myTile = W2_myTileList(bi,bj)
87	jmc	1.1
88	jmc	1.3	#ifdef DO_CORNER_COPY_V2U
89	jmc	1.1	IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
90			& exch2_isSedge(myTile) .EQ. 1 ) THEN
91			DO k=1,myNz
92	jmc	1.7	C Uphi(sNx+1, 0,k,bi,bj)= vPhi(sNx+1, 1,k,bi,bj)
93	jmc	1.1	DO j=1-olx,0
94	jmc	1.7	Uphi(sNx+1, j,k,bi,bj)= vPhi(sNx+(1-j), 1,k,bi,bj)
95	jmc	1.1	ENDDO
96			ENDDO
97			ENDIF
98			IF ( withSigns ) THEN
99			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
100			& exch2_isNedge(myTile) .EQ. 1 ) THEN
101			DO k=1,myNz
102	jmc	1.7	C Uphi(sNx+1,sNy+1,k,bi,bj)=-vPhi(sNx+1,sNy+1,k,bi,bj)
103	jmc	1.1	DO j=1,olx
104	jmc	1.7	Uphi(sNx+1,sNy+j,k,bi,bj)=-vPhi(sNx+j,sNy+1,k,bi,bj)
105	jmc	1.1	ENDDO
106			ENDDO
107			ENDIF
108			ELSE
109			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
110			& exch2_isNedge(myTile) .EQ. 1 ) THEN
111			DO k=1,myNz
112	jmc	1.7	C Uphi(sNx+1,sNy+1,k,bi,bj)= vPhi(sNx+1,sNy+1,k,bi,bj)
113	jmc	1.1	DO j=1,olx
114	jmc	1.7	Uphi(sNx+1,sNy+j,k,bi,bj)= vPhi(sNx+j,sNy+1,k,bi,bj)
115	jmc	1.1	ENDDO
116			ENDDO
117			ENDIF
118			ENDIF
119	jmc	1.4	#endif /* DO_CORNER_COPY_V2U */
120	jmc	1.1
121			C-- Now zero out the null areas that should not be used in the numerics
122			C Also add one valid u,v value next to the corner, that allows
123			C to compute vorticity on a wider stencil (e.g., vort3(0,1) & (1,0))
124
125			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
126			& exch2_isSedge(myTile) .EQ. 1 ) THEN
127			C Zero SW corner points
128	jmc	1.7	DO k=1,myNz
129	jmc	1.1	#ifdef W2_FILL_NULL_REGIONS
130	jmc	1.7	DO j=1-OLx,0
131			DO i=1-OLx,0
132			uPhi(i,j,k,bi,bj)=e2FillValue_RX
133	jmc	1.1	ENDDO
134			ENDDO
135	jmc	1.7	DO j=1-OLx,0
136			DO i=1-OLx,0
137			vPhi(i,j,k,bi,bj)=e2FillValue_RX
138	jmc	1.1	ENDDO
139			ENDDO
140			#endif
141	jmc	1.7	uPhi(0,0,k,bi,bj)=vPhi(1,0,k,bi,bj)
142			vPhi(0,0,k,bi,bj)=uPhi(0,1,k,bi,bj)
143	jmc	1.1	ENDDO
144			ENDIF
145
146			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
147			& exch2_isNedge(myTile) .EQ. 1 ) THEN
148			C Zero NW corner points
149	jmc	1.7	DO k=1,myNz
150	jmc	1.1	#ifdef W2_FILL_NULL_REGIONS
151	jmc	1.7	DO j=sNy+1,sNy+OLy
152			DO i=1-OLx,0
153			uPhi(i,j,k,bi,bj)=e2FillValue_RX
154	jmc	1.1	ENDDO
155			ENDDO
156	jmc	1.7	DO j=sNy+2,sNy+OLy
157			DO i=1-OLx,0
158			vPhi(i,j,k,bi,bj)=e2FillValue_RX
159	jmc	1.1	ENDDO
160			ENDDO
161			#endif
162			IF ( withSigns ) THEN
163	jmc	1.7	uPhi(0,sNy+1,k,bi,bj)=-vPhi(1,sNy+2,k,bi,bj)
164			vPhi(0,sNy+2,k,bi,bj)=-uPhi(0,sNy,k,bi,bj)
165	jmc	1.1	ELSE
166	jmc	1.7	uPhi(0,sNy+1,k,bi,bj)= vPhi(1,sNy+2,k,bi,bj)
167			vPhi(0,sNy+2,k,bi,bj)= uPhi(0,sNy,k,bi,bj)
168	jmc	1.1	ENDIF
169			ENDDO
170			ENDIF
171
172			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
173			& exch2_isSedge(myTile) .EQ. 1 ) THEN
174			C Zero SE corner points
175	jmc	1.7	DO k=1,myNz
176	jmc	1.1	#ifdef W2_FILL_NULL_REGIONS
177	jmc	1.7	DO j=1-OLx,0
178			DO i=sNx+2,sNx+OLx
179			uPhi(i,j,k,bi,bj)=e2FillValue_RX
180	jmc	1.1	ENDDO
181			ENDDO
182	jmc	1.7	DO j=1-OLx,0
183			DO i=sNx+1,sNx+OLx
184			vPhi(i,j,k,bi,bj)=e2FillValue_RX
185	jmc	1.1	ENDDO
186			ENDDO
187			#endif
188			IF ( withSigns ) THEN
189	jmc	1.7	uPhi(sNx+2,0,k,bi,bj)=-vPhi(sNx,0,k,bi,bj)
190			vPhi(sNx+1,0,k,bi,bj)=-uPhi(sNx+2,1,k,bi,bj)
191	jmc	1.1	ELSE
192	jmc	1.7	uPhi(sNx+2,0,k,bi,bj)= vPhi(sNx,0,k,bi,bj)
193			vPhi(sNx+1,0,k,bi,bj)= uPhi(sNx+2,1,k,bi,bj)
194	jmc	1.1	ENDIF
195			ENDDO
196			ENDIF
197
198			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
199			& exch2_isNedge(myTile) .EQ. 1 ) THEN
200			C Zero NE corner points
201	jmc	1.7	DO k=1,myNz
202	jmc	1.1	#ifdef W2_FILL_NULL_REGIONS
203	jmc	1.7	DO j=sNy+1,sNy+OLy
204			DO i=sNx+2,sNx+OLx
205			uPhi(i,j,k,bi,bj)=e2FillValue_RX
206	jmc	1.1	ENDDO
207			ENDDO
208	jmc	1.7	DO j=sNy+2,sNy+OLy
209			DO i=sNx+1,sNx+OLx
210			vPhi(i,j,k,bi,bj)=e2FillValue_RX
211	jmc	1.1	ENDDO
212			ENDDO
213			#endif
214	jmc	1.7	uPhi(sNx+2,sNy+1,k,bi,bj)=vPhi(sNx,sNy+2,k,bi,bj)
215			vPhi(sNx+1,sNy+2,k,bi,bj)=uPhi(sNx+2,sNy,k,bi,bj)
216	jmc	1.1	ENDDO
217			ENDIF
218	jmc	1.7
219	jmc	1.1	ENDDO
220			ENDDO
221	jmc	1.7	C--- using or not using CubedSphereExchange: end
222	jmc	1.1	ENDIF
223
224			RETURN
225			END
226
227			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
228
229			CEH3 ;;; Local Variables: ***
230			CEH3 ;;; mode:fortran ***
231			CEH3 ;;; End: ***