pkg/exch2/exch2_uv_xy_rx.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_xy_rx.template,v 1.2 2004/02/11 05:18:29 cnh 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
         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
         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
         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
         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
         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	edhill	1.3	C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_xy_rx.template,v 1.2 2004/02/11 05:18:29 cnh 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			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
107			& exch2_isSedge(myTile) .EQ. 1 ) THEN
108			C Zero SW corner points
109			DO J=1-OLx,0
110			DO I=1-OLx,0
111			uPhi(I,J,bi,bj)=0.
112			ENDDO
113			ENDDO
114			DO J=1-OLx,0
115			DO I=1-OLx,0
116			vPhi(I,J,bi,bj)=0.
117			ENDDO
118			ENDDO
119			ENDIF
120			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
121			& exch2_isNedge(myTile) .EQ. 1 ) THEN
122			C Zero NW corner points
123			DO J=sNy+1,sNy+OLy
124			DO I=1-OLx,0
125			uPhi(I,J,bi,bj)=0.
126			ENDDO
127			ENDDO
128			DO J=sNy+2,sNy+OLy
129			DO I=1-OLx,0
130			vPhi(I,J,bi,bj)=0.
131			ENDDO
132			ENDDO
133			ENDIF
134			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
135			& exch2_isSedge(myTile) .EQ. 1 ) THEN
136			C Zero SE corner points
137			DO J=1-OLx,0
138			DO I=sNx+2,sNx+OLx
139			uPhi(I,J,bi,bj)=0.
140			ENDDO
141			ENDDO
142			DO J=1-OLx,0
143			DO I=sNx+1,sNx+OLx
144			vPhi(I,J,bi,bj)=0.
145			ENDDO
146			ENDDO
147			ENDIF
148			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
149			& exch2_isNedge(myTile) .EQ. 1 ) THEN
150			C Zero NE corner points
151			DO J=sNy+1,sNy+OLy
152			DO I=sNx+2,sNx+OLx
153			uPhi(I,J,bi,bj)=0.
154			ENDDO
155			ENDDO
156			DO J=sNy+2,sNy+OLy
157			DO I=sNx+1,sNx+OLx
158			vPhi(I,J,bi,bj)=0.
159			ENDDO
160			ENDDO
161	afe	1.1	ENDIF
162			ENDDO
163			ENDDO
164
165			ELSE
166			c CALL EXCH_RX( Uphi,
167			c I OLw, OLe, OLs, OLn, myNz,
168			c I exchWidthX, exchWidthY,
169			c I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
170			c CALL EXCH_RX( Vphi,
171			c I OLw, OLe, OLs, OLn, myNz,
172			c I exchWidthX, exchWidthY,
173			c I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
174			c_jmc: for JAM compatibility, replace the 2 CALLs above by the 2 CPP_MACROs:
175			_EXCH_XY_RX( Uphi, myThid )
176			_EXCH_XY_RX( Vphi, myThid )
177			ENDIF
178
179			RETURN
180			END
181	edhill	1.3
182			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
183
184			CEH3 ;;; Local Variables: ***
185			CEH3 ;;; mode:fortran ***
186			CEH3 ;;; End: ***