pkg/exch2/exch2_uv_xy_rx.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_xy_rx.template,v 1.5 2005/02/09 23:43:17 jmc Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"
#include "W2_OPTIONS.h"

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     | Driver exchange routine which branches to cube sphere or
C     | global, simple cartesian index grid. Exchange routine is
C     | called with two arrays that are components of a vector.
C     | These components are rotated and interchanged on the
C     | rotated grid during cube exchanges.
C     *==========================================================*

C     !USES:
C     === Global data ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_PARAMS.h"

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, i, j
CEOP

      OLw        = OLx
      OLe        = OLx
      OLn        = OLy
      OLs        = OLy
      exchWidthX = OLx
      exchWidthY = OLy
      myNz       = 1
C     ** NOTE ** The exchange routine we use here does not
C                require the preceeding and following barriers.
C                However, the slow, simple exchange interface
C                that is calling it here is meant to ensure
C                that threads are synchronised before exchanges
C                begine.
      IF (useCubedSphereExchange) THEN

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

       DO bj=myByLo(myThid),myByHi(myThid)
        DO bi=myBxLo(myThid),myBxHi(myThid)
         myTile = W2_myTileList(bi)

         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

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

      ELSE

c      CALL EXCH_RX( Uphi,
c    I            OLw, OLe, OLs, OLn, myNz,
c    I            exchWidthX, exchWidthY,
c    I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
c      CALL EXCH_RX( Vphi,
c    I            OLw, OLe, OLs, OLn, myNz,
c    I            exchWidthX, exchWidthY,
c    I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
c_jmc: for JAM compatibility, replace the 2 CALLs above by the 2 CPP_MACROs:
       _EXCH_XY_RX( Uphi, myThid )
       _EXCH_XY_RX( Vphi, myThid )

      ENDIF

      RETURN
      END

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

CEH3 ;;; Local Variables: ***
CEH3 ;;; mode:fortran ***
CEH3 ;;; End: ***
1	jmc	1.6	C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_xy_rx.template,v 1.5 2005/02/09 23:43:17 jmc Exp $
2	afe	1.1	C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5	jmc	1.6	#include "W2_OPTIONS.h"
6	afe	1.1
7			CBOP
8	jmc	1.6
9	afe	1.1	C !ROUTINE: EXCH_UV_XY_RX
10
11			C !INTERFACE:
12			SUBROUTINE EXCH2_UV_XY_RX(
13			U Uphi, Vphi, withSigns,
14			I myThid )
15			IMPLICIT NONE
16			C !DESCRIPTION:
17			C ==========================================================
18	jmc	1.6	C \| SUBROUTINE EXCH_UV_XY_RX
19			C \| o Handle exchanges for _RX, two-dimensional arrays.
20	afe	1.1	C ==========================================================
21			C \| Driver exchange routine which branches to cube sphere or
22			C \| global, simple cartesian index grid. Exchange routine is
23			C \| called with two arrays that are components of a vector.
24	jmc	1.6	C \| These components are rotated and interchanged on the
25	afe	1.1	C \| rotated grid during cube exchanges.
26			C ==========================================================
27
28			C !USES:
29			C === Global data ===
30			#include "SIZE.h"
31			#include "EEPARAMS.h"
32			#include "EESUPPORT.h"
33			#include "W2_EXCH2_TOPOLOGY.h"
34			#include "W2_EXCH2_PARAMS.h"
35
36			C !INPUT/OUTPUT PARAMETERS:
37			C === Routine arguments ===
38			C Uphi :: Arrays with overlap regions are to be exchanged
39			C Vphi Note - The interface to EXCH_ assumes that
40			C the standard Fortran 77 sequence association rules
41			C apply.
42			C myThid :: My thread id.
43			C withSigns :: Flag controlling whether vector is signed.
44			_RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
45			_RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
46			LOGICAL withSigns
47			INTEGER myThid
48
49			C !LOCAL VARIABLES:
50			C == Local variables ==
51			C OL[wens] :: Overlap extents in west, east, north, south.
52			C exchWidth[XY] :: Extent of regions that will be exchanged.
53			INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY, myNz
54	cnh	1.2	INTEGER bi, bj, myTile, i, j
55	afe	1.1	CEOP
56
57			OLw = OLx
58			OLe = OLx
59			OLn = OLy
60			OLs = OLy
61			exchWidthX = OLx
62			exchWidthY = OLy
63			myNz = 1
64			C NOTE The exchange routine we use here does not
65			C require the preceeding and following barriers.
66			C However, the slow, simple exchange interface
67			C that is calling it here is meant to ensure
68			C that threads are synchronised before exchanges
69			C begine.
70			IF (useCubedSphereExchange) THEN
71	jmc	1.6
72	afe	1.1	CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'UV',
73			I OLw, OLe, OLs, OLn, myNz,
74			I exchWidthX, exchWidthY,
75			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
76			CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'UV',
77			I OLw, OLe, OLs, OLn, myNz,
78			I exchWidthX, exchWidthY,
79			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
80	jmc	1.5	CALL EXCH2_RX2_CUBE( Uphi, Vphi, withSigns, 'UV',
81			I OLw, OLe, OLs, OLn, myNz,
82			I exchWidthX, exchWidthY,
83			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
84	jmc	1.6
85	afe	1.1	DO bj=myByLo(myThid),myByHi(myThid)
86			DO bi=myBxLo(myThid),myBxHi(myThid)
87			myTile = W2_myTileList(bi)
88	jmc	1.6
89	afe	1.1	IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
90			& exch2_isSedge(myTile) .EQ. 1 ) THEN
91	cnh	1.2	C Uphi(snx+1, 0,bi,bj)= vPhi(snx+1, 1,bi,bj)
92			DO j=1-olx,0
93			Uphi(snx+1, j,bi,bj)= vPhi(snx+(1-j), 1,bi,bj)
94			ENDDO
95	afe	1.1	ENDIF
96			IF ( withSigns ) THEN
97			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
98			& exch2_isNedge(myTile) .EQ. 1 ) THEN
99	cnh	1.2	C Uphi(snx+1,sny+1,bi,bj)=-vPhi(snx+1,sny+1,bi,bj)
100			DO j=1,olx
101			Uphi(snx+1,sny+j,bi,bj)=-vPhi(snx+j,sny+1,bi,bj)
102			ENDDO
103	afe	1.1	ENDIF
104			ELSE
105			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
106			& exch2_isNedge(myTile) .EQ. 1 ) THEN
107	cnh	1.2	C Uphi(snx+1,sny+1,bi,bj)= vPhi(snx+1,sny+1,bi,bj)
108			DO j=1,olx
109			Uphi(snx+1,sny+j,bi,bj)= vPhi(snx+j,sny+1,bi,bj)
110			ENDDO
111	afe	1.1	ENDIF
112	cnh	1.2	ENDIF
113
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	cnh	1.2	DO J=1-OLx,0
123			DO I=1-OLx,0
124	jmc	1.6	uPhi(I,J,bi,bj)=e2FillValue_RX
125	cnh	1.2	ENDDO
126			ENDDO
127			DO J=1-OLx,0
128			DO I=1-OLx,0
129	jmc	1.6	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	cnh	1.2	DO J=sNy+1,sNy+OLy
142			DO I=1-OLx,0
143	jmc	1.6	uPhi(I,J,bi,bj)=e2FillValue_RX
144	cnh	1.2	ENDDO
145			ENDDO
146			DO J=sNy+2,sNy+OLy
147			DO I=1-OLx,0
148	jmc	1.6	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	cnh	1.2	DO J=1-OLx,0
166			DO I=sNx+2,sNx+OLx
167	jmc	1.6	uPhi(I,J,bi,bj)=e2FillValue_RX
168	cnh	1.2	ENDDO
169			ENDDO
170			DO J=1-OLx,0
171			DO I=sNx+1,sNx+OLx
172	jmc	1.6	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	cnh	1.2	DO J=sNy+1,sNy+OLy
190			DO I=sNx+2,sNx+OLx
191	jmc	1.6	uPhi(I,J,bi,bj)=e2FillValue_RX
192	cnh	1.2	ENDDO
193			ENDDO
194			DO J=sNy+2,sNy+OLy
195			DO I=sNx+1,sNx+OLx
196	jmc	1.6	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			ELSE
209	jmc	1.6
210	afe	1.1	c CALL EXCH_RX( Uphi,
211			c I OLw, OLe, OLs, OLn, myNz,
212			c I exchWidthX, exchWidthY,
213			c I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
214			c CALL EXCH_RX( Vphi,
215			c I OLw, OLe, OLs, OLn, myNz,
216			c I exchWidthX, exchWidthY,
217			c I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
218			c_jmc: for JAM compatibility, replace the 2 CALLs above by the 2 CPP_MACROs:
219			_EXCH_XY_RX( Uphi, myThid )
220			_EXCH_XY_RX( Vphi, myThid )
221	jmc	1.6
222	afe	1.1	ENDIF
223
224			RETURN
225			END
226	edhill	1.3
227			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
228
229			CEH3 ;;; Local Variables: ***
230			CEH3 ;;; mode:fortran ***
231			CEH3 ;;; End: ***