pkg/exch2/exch2_uv_xy_rx.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_xy_rx.template,v 1.3 2004/04/05 15:27:06 edhill Exp $
C $Name:  $

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