pkg/exch2/exch2_uv_agrid_3d_rx.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_agrid_3d_rx.template,v 1.2 2006/11/18 01:09:00 heimbach 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     uLoc,vLoc     :: copies of the vector components with haloes filled.

      INTEGER i,j,k,bi,bj
      INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
      _RX uLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RX vLoc(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 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 indices:
       DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)

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--   Loops on level index:
         DO k = 1,myNz

C-    First we copy the component info into local dummy arrays
          DO j = 1-OLy,sNy+OLy
           DO i = 1-OLx,sNx+OLx
             uLoc(i,j) = uPhi(i,j,k,bi,bj)
             vLoc(i,j) = vPhi(i,j,k,bi,bj)
           ENDDO
          ENDDO

C-    odd faces share disposition of all sections of the halo
          IF ( MOD(myFace,2).EQ.1 ) THEN
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) = vLoc(i,sNy+j)*negOne
               vPhi(i,sNy+j,k,bi,bj) = uLoc(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) = uLoc(i,1-j)
c              vPhi(i,1-j,k,bi,bj) = vLoc(i,1-j)
c             ENDDO
c            ENDDO
c          ENDIF
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) = uLoc(sNx+i,j)
c              vPhi(sNx+i,j,k,bi,bj) = vLoc(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) = vLoc(1-i,j)
               vPhi(1-i,j,k,bi,bj) = uLoc(1-i,j)*negOne
              ENDDO
             ENDDO
           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) = vLoc(sNx+i,j)
               vPhi(sNx+i,j,k,bi,bj) = uLoc(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) = uLoc(1-i,j)
c              vPhi(1-i,j,k,bi,bj) = vLoc(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) = uLoc(i,sNy+j)
c              vPhi(i,sNy+j,k,bi,bj) = vLoc(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) = vLoc(i,1-j)*negOne
               vPhi(i,1-j,k,bi,bj) = uLoc(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:

#ifndef AUTODIFF_EXCH2
       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 )
#endif

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.3	C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_uv_agrid_3d_rx.template,v 1.2 2006/11/18 01:09:00 heimbach Exp $
2	jmc	1.1	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	jmc	1.3	U uPhi, vPhi,
13	jmc	1.1	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	jmc	1.3	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	jmc	1.1	C withSigns (logical) :: true to use sign of components
24	jmc	1.3	C myNz :: 3rd dimension of input arrays uPhi,vPhi
25	jmc	1.1	C myThid :: my Thread Id number
26			C
27	jmc	1.3	C Output: uPhi and vPhi are updated (halo regions filled)
28	jmc	1.1	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	jmc	1.3	_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	jmc	1.1	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	jmc	1.3	C exchWidth[XY] :: Extent of regions that will be exchanged.
55			C uLoc,vLoc :: copies of the vector components with haloes filled.
56	jmc	1.1
57			INTEGER i,j,k,bi,bj
58			INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY
59	jmc	1.3	_RX uLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
60			_RX vLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61	jmc	1.1	_RX negOne
62	jmc	1.3	INTEGER myTile, myFace
63	jmc	1.1	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	jmc	1.3	C-- First call the exchanges for the two components
78	jmc	1.1
79	jmc	1.3	CALL EXCH2_RX1_CUBE( uPhi, 'T ',
80	jmc	1.1	I OLw, OLe, OLs, OLn, myNz,
81			I exchWidthX, exchWidthY,
82			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
83	jmc	1.3	CALL EXCH2_RX1_CUBE( uPhi, 'T ',
84	jmc	1.1	I OLw, OLe, OLs, OLn, myNz,
85			I exchWidthX, exchWidthY,
86			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
87
88	jmc	1.3	CALL EXCH2_RX1_CUBE( vPhi, 'T ',
89	jmc	1.1	I OLw, OLe, OLs, OLn, myNz,
90			I exchWidthX, exchWidthY,
91			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
92	jmc	1.3	CALL EXCH2_RX1_CUBE( vPhi, 'T ',
93	jmc	1.1	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	jmc	1.3	c CALL EXCH2_3D_RX( uPhi, myNz, myThid )
99			c CALL EXCH2_3D_RX( vPhi, myNz, myThid )
100	jmc	1.1
101	jmc	1.3	C-- Then we may need to switch u and v components
102			C and/or the signs depending on which cube face we are located.
103	jmc	1.1
104	jmc	1.3	C-- Loops on tile indices:
105	jmc	1.1	DO bj = myByLo(myThid), myByHi(myThid)
106			DO bi = myBxLo(myThid), myBxHi(myThid)
107	jmc	1.3
108			C- Now choose what to do at each edge of the halo based on which face
109			C (we assume that bj is always=1)
110			myTile = W2_myTileList(bi)
111			myFace = exch2_myFace(myTile)
112
113			C-- Loops on level index:
114	jmc	1.1	DO k = 1,myNz
115
116	jmc	1.3	C- First we copy the component info into local dummy arrays
117	jmc	1.1	DO j = 1-OLy,sNy+OLy
118			DO i = 1-OLx,sNx+OLx
119	jmc	1.3	uLoc(i,j) = uPhi(i,j,k,bi,bj)
120			vLoc(i,j) = vPhi(i,j,k,bi,bj)
121	jmc	1.1	ENDDO
122			ENDDO
123
124	jmc	1.3	C- odd faces share disposition of all sections of the halo
125			IF ( MOD(myFace,2).EQ.1 ) THEN
126			C- North:
127			IF (exch2_isNedge(myTile).EQ.1) THEN
128			DO j = 1,exchWidthY
129			DO i = 1-OLx,sNx+OLx
130			uPhi(i,sNy+j,k,bi,bj) = vLoc(i,sNy+j)*negOne
131			vPhi(i,sNy+j,k,bi,bj) = uLoc(i,sNy+j)
132			ENDDO
133			ENDDO
134			ENDIF
135			C- South: (nothing to change)
136			c IF (exch2_isSedge(myTile).EQ.1) THEN
137			c DO j = 1,exchWidthY
138			c DO i = 1-OLx,sNx+OLx
139			c uPhi(i,1-j,k,bi,bj) = uLoc(i,1-j)
140			c vPhi(i,1-j,k,bi,bj) = vLoc(i,1-j)
141			c ENDDO
142			c ENDDO
143			c ENDIF
144			C- East: (nothing to change)
145			c IF (exch2_isEedge(myTile).EQ.1) THEN
146	jmc	1.1	c DO j = 1-OLy,sNy+OLy
147			c DO i = 1,exchWidthX
148	jmc	1.3	c uPhi(sNx+i,j,k,bi,bj) = uLoc(sNx+i,j)
149			c vPhi(sNx+i,j,k,bi,bj) = vLoc(sNx+i,j)
150	jmc	1.1	c ENDDO
151			c ENDDO
152			c ENDIF
153	jmc	1.3	C- West:
154			IF (exch2_isWedge(myTile).EQ.1) THEN
155	jmc	1.1	DO j = 1-OLy,sNy+OLy
156			DO i = 1,exchWidthX
157	jmc	1.3	uPhi(1-i,j,k,bi,bj) = vLoc(1-i,j)
158			vPhi(1-i,j,k,bi,bj) = uLoc(1-i,j)*negOne
159	jmc	1.1	ENDDO
160			ENDDO
161			ENDIF
162
163			ELSE
164	jmc	1.3	C- Now the even faces (share disposition of all sections of the halo)
165	jmc	1.1
166	jmc	1.3	C- East:
167			IF (exch2_isEedge(myTile).EQ.1) THEN
168	jmc	1.1	DO j = 1-OLy,sNy+OLy
169			DO i = 1,exchWidthX
170	jmc	1.3	uPhi(sNx+i,j,k,bi,bj) = vLoc(sNx+i,j)
171			vPhi(sNx+i,j,k,bi,bj) = uLoc(sNx+i,j)*negOne
172	jmc	1.1	ENDDO
173			ENDDO
174			ENDIF
175	jmc	1.3	C- West: (nothing to change)
176			c IF (exch2_isWedge(myTile).EQ.1) THEN
177	jmc	1.1	c DO j = 1-OLy,sNy+OLy
178			c DO i = 1,exchWidthX
179	jmc	1.3	c uPhi(1-i,j,k,bi,bj) = uLoc(1-i,j)
180			c vPhi(1-i,j,k,bi,bj) = vLoc(1-i,j)
181	jmc	1.1	c ENDDO
182			c ENDDO
183			c ENDIF
184	jmc	1.3	C- North: (nothing to change)
185			c IF (exch2_isNedge(myTile).EQ.1) THEN
186	jmc	1.1	c DO j = 1,exchWidthY
187			c DO i = 1-OLx,sNx+OLx
188	jmc	1.3	c uPhi(i,sNy+j,k,bi,bj) = uLoc(i,sNy+j)
189			c vPhi(i,sNy+j,k,bi,bj) = vLoc(i,sNy+j)
190	jmc	1.1	c ENDDO
191			c ENDDO
192			c ENDIF
193	jmc	1.3	C- South:
194			IF (exch2_isSedge(myTile).EQ.1) THEN
195	jmc	1.1	DO j = 1,exchWidthY
196			DO i = 1-OLx,sNx+OLx
197	jmc	1.3	uPhi(i,1-j,k,bi,bj) = vLoc(i,1-j)*negOne
198			vPhi(i,1-j,k,bi,bj) = uLoc(i,1-j)
199	jmc	1.1	ENDDO
200			ENDDO
201			ENDIF
202
203			C end odd / even faces
204			ENDIF
205
206			C-- end of Loops on tile and level indices (k,bi,bj).
207			ENDDO
208			ENDDO
209			ENDDO
210
211			ELSE
212			C--- not using CubedSphereExchange:
213
214	heimbach	1.2	#ifndef AUTODIFF_EXCH2
215	jmc	1.3	CALL EXCH_RX( uPhi,
216	jmc	1.1	I OLw, OLe, OLs, OLn, myNz,
217			I exchWidthX, exchWidthY,
218			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
219	jmc	1.3	CALL EXCH_RX( vPhi,
220	jmc	1.1	I OLw, OLe, OLs, OLn, myNz,
221			I exchWidthX, exchWidthY,
222			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
223	heimbach	1.2	#endif
224	jmc	1.1
225			C--- using or not using CubedSphereExchange: end
226			ENDIF
227
228			RETURN
229			END
230
231			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
232
233			CEH3 ;;; Local Variables: ***
234			CEH3 ;;; mode:fortran ***
235			CEH3 ;;; End: ***