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	C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_xy_rx.template,v 1.5 2005/02/09 23:43:17 jmc Exp $
2	C $Name: $
3
4	#include "CPP_EEOPTIONS.h"
5	#include "W2_OPTIONS.h"
6
7	CBOP
8
9	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	C \| SUBROUTINE EXCH_UV_XY_RX
19	C \| o Handle exchanges for _RX, two-dimensional arrays.
20	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	C \| These components are rotated and interchanged on the
25	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	INTEGER bi, bj, myTile, i, j
55	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
72	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	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
85	DO bj=myByLo(myThid),myByHi(myThid)
86	DO bi=myBxLo(myThid),myBxHi(myThid)
87	myTile = W2_myTileList(bi)
88
89	IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
90	& exch2_isSedge(myTile) .EQ. 1 ) THEN
91	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	ENDIF
96	IF ( withSigns ) THEN
97	IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
98	& exch2_isNedge(myTile) .EQ. 1 ) THEN
99	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	ENDIF
104	ELSE
105	IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
106	& exch2_isNedge(myTile) .EQ. 1 ) THEN
107	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	ENDIF
112	ENDIF
113
114	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	C to compute vorticity on a wider stencil (e.g., vort3(0,1) & (1,0))
117
118	IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
119	& exch2_isSedge(myTile) .EQ. 1 ) THEN
120	C Zero SW corner points
121	#ifdef W2_FILL_NULL_REGIONS
122	DO J=1-OLx,0
123	DO I=1-OLx,0
124	uPhi(I,J,bi,bj)=e2FillValue_RX
125	ENDDO
126	ENDDO
127	DO J=1-OLx,0
128	DO I=1-OLx,0
129	vPhi(I,J,bi,bj)=e2FillValue_RX
130	ENDDO
131	ENDDO
132	#endif
133	uPhi(0,0,bi,bj)=vPhi(1,0,bi,bj)
134	vPhi(0,0,bi,bj)=uPhi(0,1,bi,bj)
135	ENDIF
136
137	IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
138	& exch2_isNedge(myTile) .EQ. 1 ) THEN
139	C Zero NW corner points
140	#ifdef W2_FILL_NULL_REGIONS
141	DO J=sNy+1,sNy+OLy
142	DO I=1-OLx,0
143	uPhi(I,J,bi,bj)=e2FillValue_RX
144	ENDDO
145	ENDDO
146	DO J=sNy+2,sNy+OLy
147	DO I=1-OLx,0
148	vPhi(I,J,bi,bj)=e2FillValue_RX
149	ENDDO
150	ENDDO
151	#endif
152	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	ENDIF
160
161	IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
162	& exch2_isSedge(myTile) .EQ. 1 ) THEN
163	C Zero SE corner points
164	#ifdef W2_FILL_NULL_REGIONS
165	DO J=1-OLx,0
166	DO I=sNx+2,sNx+OLx
167	uPhi(I,J,bi,bj)=e2FillValue_RX
168	ENDDO
169	ENDDO
170	DO J=1-OLx,0
171	DO I=sNx+1,sNx+OLx
172	vPhi(I,J,bi,bj)=e2FillValue_RX
173	ENDDO
174	ENDDO
175	#endif
176	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	ENDIF
184
185	IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
186	& exch2_isNedge(myTile) .EQ. 1 ) THEN
187	C Zero NE corner points
188	#ifdef W2_FILL_NULL_REGIONS
189	DO J=sNy+1,sNy+OLy
190	DO I=sNx+2,sNx+OLx
191	uPhi(I,J,bi,bj)=e2FillValue_RX
192	ENDDO
193	ENDDO
194	DO J=sNy+2,sNy+OLy
195	DO I=sNx+1,sNx+OLx
196	vPhi(I,J,bi,bj)=e2FillValue_RX
197	ENDDO
198	ENDDO
199	#endif
200	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	ENDIF
203
204	C- end bi,bj loops.
205	ENDDO
206	ENDDO
207
208	ELSE
209
210	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
222	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: ***