pkg/exch2/exch2_uv_xy_rx.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_xy_rx.template,v 1.12 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: EXCH_UV_XY_RX

C     !INTERFACE:
      SUBROUTINE EXCH2_UV_XY_RX(
     U                       Uphi, Vphi, withSigns,
     I                       myThid )
      IMPLICIT NONE
C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE EXCH_UV_XY_RX
C     | o Handle exchanges for _RX, two-dimensional arrays.
C     *==========================================================*
C     | Exchange routine is called with two arrays that are
C     | components of a vector. These components are rotated and
C     | interchanged on the rotated grid during cube exchanges.
C     *==========================================================*

C     !USES:
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     Uphi      :: Arrays with overlap regions are to be exchanged
C     Vphi         Note - The interface to EXCH_ assumes that
C                  the standard Fortran 77 sequence association rules
C                  apply.
C     myThid    :: My thread id.
C     withSigns :: Flag controlling whether vector is signed.
      _RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      _RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,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, myNz
      INTEGER bi, bj, myTile
#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
      myNz       = 1

       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
       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
C         Uphi(sNx+1,    0,bi,bj)= vPhi(sNx+1,    1,bi,bj)
          DO j=1-olx,0
           Uphi(sNx+1,    j,bi,bj)= vPhi(sNx+(1-j),    1,bi,bj)
          ENDDO
         ENDIF
         IF ( withSigns ) THEN
          IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &         exch2_isNedge(myTile) .EQ. 1 ) THEN
C          Uphi(sNx+1,sNy+1,bi,bj)=-vPhi(sNx+1,sNy+1,bi,bj)
           DO j=1,olx
            Uphi(sNx+1,sNy+j,bi,bj)=-vPhi(sNx+j,sNy+1,bi,bj)
           ENDDO
          ENDIF
         ELSE
          IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &         exch2_isNedge(myTile) .EQ. 1 ) THEN
C          Uphi(sNx+1,sNy+1,bi,bj)= vPhi(sNx+1,sNy+1,bi,bj)
           DO j=1,olx
            Uphi(sNx+1,sNy+j,bi,bj)= vPhi(sNx+j,sNy+1,bi,bj)
           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
#ifdef W2_FILL_NULL_REGIONS
          DO j=1-OLx,0
           DO i=1-OLx,0
            uPhi(i,j,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
          DO j=1-OLx,0
           DO i=1-OLx,0
            vPhi(i,j,bi,bj)=e2FillValue_RX
           ENDDO
          ENDDO
#endif
            uPhi(0,0,bi,bj)=vPhi(1,0,bi,bj)
            vPhi(0,0,bi,bj)=uPhi(0,1,bi,bj)
         ENDIF

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

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

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

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