pkg/exch2/exch2_uv_agrid_3d_rx.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_agrid_xyz_rx.template,v 1.5 2004/11/19 02:36:17 jmc Exp $
C $Name:  $

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

CBOP
C     !ROUTINE: EXCH2_UV_AGRID_3D_RX

C     !INTERFACE:
      SUBROUTINE EXCH2_UV_AGRID_3D_RX(
     U                                 Uphi, Vphi,
     I                                 withSigns, myNz, myThid )

C     !DESCRIPTION:
C*=====================================================================*
C  Purpose: SUBROUTINE EXCH2_UV_AGRID_3D_RX
C      handle exchanges for a 3D vector field on an A-grid.
C
C  Input: 
C    Uphi(lon,lat,levs,bi,bj) :: first component of vector
C    Vphi(lon,lat,levs,bi,bj) :: second component of vector
C    withSigns (logical)      :: true to use sign of components
C    myNz                     :: 3rd dimension of input arrays Uphi,Vphi
C    myThid                   :: my Thread Id number
C
C  Output: Uphi and Vphi are updated (halo regions filled)
C
C  Calls: exch_RX (exch2_RX1_cube) - for each component
C
C*=====================================================================*

C     !USES:
      IMPLICIT NONE

#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_PARAMS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Argument list variables ==
      INTEGER myNz
      _RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
      _RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
      LOGICAL withSigns
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     i,j,k,bi,bj   :: loop indices.
C     OL[wens]      :: Overlap extents in west, east, north, south.
C     exchWidth[XY] :: - Extent of regions that will be exchanged.
C     dummy[12]     :: - copies of the vector components with haloes filled.

      INTEGER i,j,k,bi,bj
      INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
      _RX dummy1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RX dummy2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RX negOne
      INTEGER mytile, myface
CEOP

      OLw        = OLx
      OLe        = OLx
      OLn        = OLy
      OLs        = OLy
      exchWidthX = OLx
      exchWidthY = OLy
      negOne = 1.
      IF (withSigns) negOne = -1.

      IF ( useCubedSphereExchange ) THEN
C---  using CubedSphereExchange:

C First CALL the exchanges for the two components

       CALL EXCH2_RX1_CUBE( Uphi, 'T ',
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
       CALL EXCH2_RX1_CUBE( Uphi, 'T ',
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )

       CALL EXCH2_RX1_CUBE( Vphi, 'T ',
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
       CALL EXCH2_RX1_CUBE( Vphi, 'T ',
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )

C- note: can substitute the low-level S/R calls above with:
c      CALL EXCH2_3D_RX( Uphi, myNz, myThid )
c      CALL EXCH2_3D_RX( Vphi, myNz, myThid )

C Then if we are on the cube we may need to switch u and v components
C and/or the signs depending on which cube face we are located.

C--    Loops on tile and level indices:
       DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)
         DO k = 1,myNz

C First we need to copy the component info into dummy arrays
          DO j = 1-OLy,sNy+OLy
           DO i = 1-OLx,sNx+OLx
             dummy1(i,j) = Uphi(i,j,k,bi,bj)
             dummy2(i,j) = Vphi(i,j,k,bi,bj)
           ENDDO
          ENDDO

C Now choose what to do at each edge of the halo based on which face
C    (we assume that bj is always=1)
          mytile = W2_myTileList(bi)
          myface = exch2_myFace(mytile)

C odd faces share disposition of all sections of the halo
          IF ( MOD(myface,2).EQ.1 ) THEN
C east (nothing to change)
c          IF (exch2_isEedge(mytile).EQ.1) THEN
c            DO j = 1-OLy,sNy+OLy
c             DO i = 1,exchWidthX
c              Uphi(sNx+i,j,k,bi,bj) = dummy1(sNx+i,j)
c              Vphi(sNx+i,j,k,bi,bj) = dummy2(sNx+i,j)
c             ENDDO
c            ENDDO
c          ENDIF
C west
           IF (exch2_isWedge(mytile).EQ.1) THEN
             DO j = 1-OLy,sNy+OLy
              DO i = 1,exchWidthX
               Uphi(1-i,j,k,bi,bj) = dummy2(1-i,j)
               Vphi(1-i,j,k,bi,bj) = dummy1(1-i,j)*negOne
              ENDDO
             ENDDO
           ENDIF
C north
           IF (exch2_isNedge(mytile).EQ.1) THEN
             DO j = 1,exchWidthY
              DO i = 1-OLx,sNx+OLx
               Uphi(i,sNy+j,k,bi,bj) = dummy2(i,sNy+j)*negOne
               Vphi(i,sNy+j,k,bi,bj) = dummy1(i,sNy+j)
              ENDDO
             ENDDO
           ENDIF
C south (nothing to change)
c          IF (exch2_isSedge(mytile).EQ.1) THEN
c            DO j = 1,exchWidthY
c             DO i = 1-OLx,sNx+OLx
c              Uphi(i,1-j,k,bi,bj) = dummy1(i,1-j)
c              Vphi(i,1-j,k,bi,bj) = dummy2(i,1-j)
c             ENDDO
c            ENDDO
c          ENDIF

          ELSE
C now the even faces (share disposition of all sections of the halo)

C east
           IF (exch2_isEedge(mytile).EQ.1) THEN
             DO j = 1-OLy,sNy+OLy
              DO i = 1,exchWidthX
               Uphi(sNx+i,j,k,bi,bj) = dummy2(sNx+i,j)
               Vphi(sNx+i,j,k,bi,bj) = dummy1(sNx+i,j)*negOne
              ENDDO
             ENDDO
           ENDIF
C west (nothing to change)
c          IF (exch2_isWedge(mytile).EQ.1) THEN
c            DO j = 1-OLy,sNy+OLy
c             DO i = 1,exchWidthX
c              Uphi(1-i,j,k,bi,bj) = dummy1(1-i,j)
c              Vphi(1-i,j,k,bi,bj) = dummy2(1-i,j)
c             ENDDO
c            ENDDO
c          ENDIF
C north (nothing to change)
c          IF (exch2_isNedge(mytile).EQ.1) THEN
c            DO j = 1,exchWidthY
c             DO i = 1-OLx,sNx+OLx
c              Uphi(i,sNy+j,k,bi,bj) = dummy1(i,sNy+j)
c              Vphi(i,sNy+j,k,bi,bj) = dummy2(i,sNy+j)
c             ENDDO
c            ENDDO
c          ENDIF
C south
           IF (exch2_isSedge(mytile).EQ.1) THEN
             DO j = 1,exchWidthY
              DO i = 1-OLx,sNx+OLx
               Uphi(i,1-j,k,bi,bj) = dummy2(i,1-j)*negOne
               Vphi(i,1-j,k,bi,bj) = dummy1(i,1-j)
              ENDDO
             ENDDO
           ENDIF

C end odd / even faces
          ENDIF

C--    end of Loops on tile and level indices (k,bi,bj).
         ENDDO
        ENDDO
       ENDDO

      ELSE
C---  not using CubedSphereExchange:

       CALL EXCH_RX( Uphi,
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
       CALL EXCH_RX( Vphi,
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )

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.1	C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_agrid_xyz_rx.template,v 1.5 2004/11/19 02:36:17 jmc Exp $
2			C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5			#include "W2_OPTIONS.h"
6
7			CBOP
8			C !ROUTINE: EXCH2_UV_AGRID_3D_RX
9
10			C !INTERFACE:
11			SUBROUTINE EXCH2_UV_AGRID_3D_RX(
12			U Uphi, Vphi,
13			I withSigns, myNz, myThid )
14
15			C !DESCRIPTION:
16			C=====================================================================
17			C Purpose: SUBROUTINE EXCH2_UV_AGRID_3D_RX
18			C handle exchanges for a 3D vector field on an A-grid.
19			C
20			C Input:
21			C Uphi(lon,lat,levs,bi,bj) :: first component of vector
22			C Vphi(lon,lat,levs,bi,bj) :: second component of vector
23			C withSigns (logical) :: true to use sign of components
24			C myNz :: 3rd dimension of input arrays Uphi,Vphi
25			C myThid :: my Thread Id number
26			C
27			C Output: Uphi and Vphi are updated (halo regions filled)
28			C
29			C Calls: exch_RX (exch2_RX1_cube) - for each component
30			C
31			C=====================================================================
32
33			C !USES:
34			IMPLICIT NONE
35
36			#include "SIZE.h"
37			#include "EEPARAMS.h"
38			#include "EESUPPORT.h"
39			#include "W2_EXCH2_TOPOLOGY.h"
40			#include "W2_EXCH2_PARAMS.h"
41
42			C !INPUT/OUTPUT PARAMETERS:
43			C == Argument list variables ==
44			INTEGER myNz
45			_RX Uphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
46			_RX Vphi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNz,nSx,nSy)
47			LOGICAL withSigns
48			INTEGER myThid
49
50			C !LOCAL VARIABLES:
51			C == Local variables ==
52			C i,j,k,bi,bj :: loop indices.
53			C OL[wens] :: Overlap extents in west, east, north, south.
54			C exchWidth[XY] :: - Extent of regions that will be exchanged.
55			C dummy[12] :: - copies of the vector components with haloes filled.
56
57			INTEGER i,j,k,bi,bj
58			INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
59			_RX dummy1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
60			_RX dummy2(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61			_RX negOne
62			INTEGER mytile, myface
63			CEOP
64
65			OLw = OLx
66			OLe = OLx
67			OLn = OLy
68			OLs = OLy
69			exchWidthX = OLx
70			exchWidthY = OLy
71			negOne = 1.
72			IF (withSigns) negOne = -1.
73
74			IF ( useCubedSphereExchange ) THEN
75			C--- using CubedSphereExchange:
76
77			C First CALL the exchanges for the two components
78
79			CALL EXCH2_RX1_CUBE( Uphi, 'T ',
80			I OLw, OLe, OLs, OLn, myNz,
81			I exchWidthX, exchWidthY,
82			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
83			CALL EXCH2_RX1_CUBE( Uphi, 'T ',
84			I OLw, OLe, OLs, OLn, myNz,
85			I exchWidthX, exchWidthY,
86			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
87
88			CALL EXCH2_RX1_CUBE( Vphi, 'T ',
89			I OLw, OLe, OLs, OLn, myNz,
90			I exchWidthX, exchWidthY,
91			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
92			CALL EXCH2_RX1_CUBE( Vphi, 'T ',
93			I OLw, OLe, OLs, OLn, myNz,
94			I exchWidthX, exchWidthY,
95			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
96
97			C- note: can substitute the low-level S/R calls above with:
98			c CALL EXCH2_3D_RX( Uphi, myNz, myThid )
99			c CALL EXCH2_3D_RX( Vphi, myNz, myThid )
100
101			C Then if we are on the cube we may need to switch u and v components
102			C and/or the signs depending on which cube face we are located.
103
104			C-- Loops on tile and level indices:
105			DO bj = myByLo(myThid), myByHi(myThid)
106			DO bi = myBxLo(myThid), myBxHi(myThid)
107			DO k = 1,myNz
108
109			C First we need to copy the component info into dummy arrays
110			DO j = 1-OLy,sNy+OLy
111			DO i = 1-OLx,sNx+OLx
112			dummy1(i,j) = Uphi(i,j,k,bi,bj)
113			dummy2(i,j) = Vphi(i,j,k,bi,bj)
114			ENDDO
115			ENDDO
116
117			C Now choose what to do at each edge of the halo based on which face
118			C (we assume that bj is always=1)
119			mytile = W2_myTileList(bi)
120			myface = exch2_myFace(mytile)
121
122			C odd faces share disposition of all sections of the halo
123			IF ( MOD(myface,2).EQ.1 ) THEN
124			C east (nothing to change)
125			c IF (exch2_isEedge(mytile).EQ.1) THEN
126			c DO j = 1-OLy,sNy+OLy
127			c DO i = 1,exchWidthX
128			c Uphi(sNx+i,j,k,bi,bj) = dummy1(sNx+i,j)
129			c Vphi(sNx+i,j,k,bi,bj) = dummy2(sNx+i,j)
130			c ENDDO
131			c ENDDO
132			c ENDIF
133			C west
134			IF (exch2_isWedge(mytile).EQ.1) THEN
135			DO j = 1-OLy,sNy+OLy
136			DO i = 1,exchWidthX
137			Uphi(1-i,j,k,bi,bj) = dummy2(1-i,j)
138			Vphi(1-i,j,k,bi,bj) = dummy1(1-i,j)*negOne
139			ENDDO
140			ENDDO
141			ENDIF
142			C north
143			IF (exch2_isNedge(mytile).EQ.1) THEN
144			DO j = 1,exchWidthY
145			DO i = 1-OLx,sNx+OLx
146			Uphi(i,sNy+j,k,bi,bj) = dummy2(i,sNy+j)*negOne
147			Vphi(i,sNy+j,k,bi,bj) = dummy1(i,sNy+j)
148			ENDDO
149			ENDDO
150			ENDIF
151			C south (nothing to change)
152			c IF (exch2_isSedge(mytile).EQ.1) THEN
153			c DO j = 1,exchWidthY
154			c DO i = 1-OLx,sNx+OLx
155			c Uphi(i,1-j,k,bi,bj) = dummy1(i,1-j)
156			c Vphi(i,1-j,k,bi,bj) = dummy2(i,1-j)
157			c ENDDO
158			c ENDDO
159			c ENDIF
160
161			ELSE
162			C now the even faces (share disposition of all sections of the halo)
163
164			C east
165			IF (exch2_isEedge(mytile).EQ.1) THEN
166			DO j = 1-OLy,sNy+OLy
167			DO i = 1,exchWidthX
168			Uphi(sNx+i,j,k,bi,bj) = dummy2(sNx+i,j)
169			Vphi(sNx+i,j,k,bi,bj) = dummy1(sNx+i,j)*negOne
170			ENDDO
171			ENDDO
172			ENDIF
173			C west (nothing to change)
174			c IF (exch2_isWedge(mytile).EQ.1) THEN
175			c DO j = 1-OLy,sNy+OLy
176			c DO i = 1,exchWidthX
177			c Uphi(1-i,j,k,bi,bj) = dummy1(1-i,j)
178			c Vphi(1-i,j,k,bi,bj) = dummy2(1-i,j)
179			c ENDDO
180			c ENDDO
181			c ENDIF
182			C north (nothing to change)
183			c IF (exch2_isNedge(mytile).EQ.1) THEN
184			c DO j = 1,exchWidthY
185			c DO i = 1-OLx,sNx+OLx
186			c Uphi(i,sNy+j,k,bi,bj) = dummy1(i,sNy+j)
187			c Vphi(i,sNy+j,k,bi,bj) = dummy2(i,sNy+j)
188			c ENDDO
189			c ENDDO
190			c ENDIF
191			C south
192			IF (exch2_isSedge(mytile).EQ.1) THEN
193			DO j = 1,exchWidthY
194			DO i = 1-OLx,sNx+OLx
195			Uphi(i,1-j,k,bi,bj) = dummy2(i,1-j)*negOne
196			Vphi(i,1-j,k,bi,bj) = dummy1(i,1-j)
197			ENDDO
198			ENDDO
199			ENDIF
200
201			C end odd / even faces
202			ENDIF
203
204			C-- end of Loops on tile and level indices (k,bi,bj).
205			ENDDO
206			ENDDO
207			ENDDO
208
209			ELSE
210			C--- not using CubedSphereExchange:
211
212			CALL EXCH_RX( Uphi,
213			I OLw, OLe, OLs, OLn, myNz,
214			I exchWidthX, exchWidthY,
215			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
216			CALL EXCH_RX( Vphi,
217			I OLw, OLe, OLs, OLn, myNz,
218			I exchWidthX, exchWidthY,
219			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
220
221			C--- using or not using CubedSphereExchange: end
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: ***