eesupp/src/fill_cs_corner_tr_rl.F

C $Header: /u/gcmpack/MITgcm/eesupp/src/fill_cs_corner_tr_rl.F,v 1.2 2005/11/05 01:07:30 jmc Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_EEOPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: FILL_CS_CORNER_TR_RL

C     !INTERFACE:
      SUBROUTINE FILL_CS_CORNER_TR_RL(
     I     fill4dirX, withSigns,
     U     trFld,
     I     bi,bj, myThid)

C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE FILL_CS_CORNER_TR_RL
C     | o Fill the corner-halo region of CS-grid,
C     |   for a tracer variable (center of grid cell)
C     *==========================================================*
C     | o the corner halo region is filled with valid values
C     |   in order to compute (later on) gradient in X or Y
C     |   direction, on a wide stencil.
C     *==========================================================*

C     !USES:
      IMPLICIT NONE

C     == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#ifdef ALLOW_EXCH2
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_PARAMS.h"
#endif /* ALLOW_EXCH2 */

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C
C     fill4dirX :: True = prepare for X direction calculations
C                  otherwise, prepare for Y direction
C     withSigns :: True = account for sign of X & Y directions
C     trFld     :: tracer field array with empty corners to fill
C     bi,bj     :: tile indices
C     myThid    :: thread number
      LOGICAL fill4dirX
      LOGICAL withSigns
      _RL trFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      INTEGER bi,bj
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C      i,j           :: loop indices
C      myTile        :: tile number
      INTEGER i,j
      LOGICAL southWestCorner
      LOGICAL southEastCorner
      LOGICAL northWestCorner
      LOGICAL northEastCorner
      _RL     negOne
#ifdef ALLOW_EXCH2
      INTEGER myTile
#endif
CEOP

      negOne = 1.
      IF (withSigns) negOne = -1.

      IF (useCubedSphereExchange) THEN

#ifdef ALLOW_EXCH2
       myTile = W2_myTileList(bi)
       southWestCorner = exch2_isWedge(myTile).EQ.1
     &             .AND. exch2_isSedge(myTile).EQ.1
       southEastCorner = exch2_isEedge(myTile).EQ.1
     &             .AND. exch2_isSedge(myTile).EQ.1
       northEastCorner = exch2_isEedge(myTile).EQ.1
     &             .AND. exch2_isNedge(myTile).EQ.1
       northWestCorner = exch2_isWedge(myTile).EQ.1
     &             .AND. exch2_isNedge(myTile).EQ.1
#else
       southWestCorner = .TRUE.
       southEastCorner = .TRUE.
       northWestCorner = .TRUE.
       northEastCorner = .TRUE.
#endif

       IF ( fill4dirX ) THEN
C--    Internal exchange for calculations in X

C-     For cube face corners we need to duplicate the
C-     i-1 and i+1 values into the null space as follows:
C
C
C      o NW corner: copy T(    0,sNy  ) into T(    0,sNy+1) e.g.
C                      |
C         x T(0,sNy+1) |
C        /\            |
C      --||------------|-----------
C        ||            |
C         x T(0,sNy)   |   x T(1,sNy)
C                      |
C
C      o SW corner: copy T(0,1) into T(0,0) e.g.
C                      |
C         x T(0,1)     |  x T(1,1)
C        ||            |
C      --||------------|-----------
C        \/            |
C         x T(0,0)     |
C                      |
C
C      o NE corner: copy T(sNx+1,sNy  ) into T(sNx+1,sNy+1) e.g.
C                      |
C                      |   x T(sNx+1,sNy+1)
C                      |  /\
C      ----------------|--||-------
C                      |  ||
C         x T(sNx,sNy) |   x T(sNx+1,sNy  )
C                      |
C      o SE corner: copy T(sNx+1,1    ) into T(sNx+1,0    ) e.g.
C                      |
C         x T(sNx,1)   |   x T(sNx+1,    1)
C                      |  ||
C      ----------------|--||-------
C                      |  \/
C                      |   x T(sNx+1,    0)
         IF ( southWestCorner ) THEN
          DO j=1,OLy
           DO i=1,OLx
            trFld( 1-i , 1-j ) = negOne*trFld( 1-j , i  )
           ENDDO
          ENDDO
         ENDIF
         IF ( southEastCorner ) THEN
          DO j=1,OLy
           DO i=1,OLx
            trFld(sNx+i, 1-j ) = negOne*trFld(sNx+j, i  )
           ENDDO
          ENDDO
         ENDIF
         IF ( northWestCorner ) THEN
          DO j=1,OLy
           DO i=1,OLx
            trFld( 1-i ,sNy+j) = negOne*trFld( 1-j , sNy+1-i )
           ENDDO
          ENDDO
         ENDIF
         IF ( northEastCorner ) THEN
          DO j=1,OLy
           DO i=1,OLx
            trFld(sNx+i,sNy+j) = negOne*trFld(sNx+j, sNy+1-i )
           ENDDO
          ENDDO
         ENDIF

C--   End of X direction ; start Y direction case.

       ELSE
C--    Internal exchange for calculations in Y

C-     For cube face corners we need to duplicate the
C-     j-1 and j+1 values into the null space as follows:
C
C      o SW corner: copy T(0,1) into T(0,0) e.g.
C                      |
C                      |  x T(1,1)
C                      |
C      ----------------|-----------
C                      |
C         x T(0,0)<====== x T(1,0)
C                      |
C
C      o NW corner: copy T(    0,sNy  ) into T(    0,sNy+1) e.g.
C                      |
C         x T(0,sNy+1)<=== x T(1,sNy+1)
C                      |
C      ----------------|-----------
C                      |
C                      |   x T(1,sNy)
C                      |
C
C      o NE corner: copy T(sNx+1,sNy  ) into T(sNx+1,sNy+1) e.g.
C                      |
C      x T(sNx,sNy+1)=====>x T(sNx+1,sNy+1)
C                      |
C      ----------------|-----------
C                      |
C      x T(sNx,sNy)    |
C                      |
C      o SE corner: copy T(sNx+1,1    ) into T(sNx+1,0    ) e.g.
C                      |
C         x T(sNx,1)   |
C                      |
C      ----------------|-----------
C                      |
C         x T(sNx,0) =====>x T(sNx+1,    0)
         IF ( southWestCorner ) THEN
          DO j=1,Oly
           DO i=1,Olx
            trFld( 1-i , 1-j ) = negOne*trFld(   j   , 1-i )
           ENDDO
          ENDDO
         ENDIF
         IF ( southEastCorner ) THEN
          DO j=1,Oly
           DO i=1,Olx
            trFld(sNx+i, 1-j ) = negOne*trFld(sNx+1-j, 1-i )
           ENDDO
          ENDDO
         ENDIF
         IF ( northWestCorner ) THEN
          DO j=1,Oly
           DO i=1,Olx
            trFld( 1-i ,sNy+j) = negOne*trFld(   j   ,sNy+i)
           ENDDO
          ENDDO
         ENDIF
         IF ( northEastCorner ) THEN
          DO j=1,Oly
           DO i=1,Olx
            trFld(sNx+i,sNy+j) = negOne*trFld(sNx+1-j,sNy+i)
           ENDDO
          ENDDO
         ENDIF

C-     End of Y direction case.
       ENDIF

C--   End useCubedSphereExchange
      ENDIF

      RETURN
      END
1	jmc	1.3	C $Header: /u/gcmpack/MITgcm/eesupp/src/fill_cs_corner_tr_rl.F,v 1.2 2005/11/05 01:07:30 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "PACKAGES_CONFIG.h"
5			#include "CPP_EEOPTIONS.h"
6
7			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
8			CBOP
9			C !ROUTINE: FILL_CS_CORNER_TR_RL
10
11			C !INTERFACE:
12			SUBROUTINE FILL_CS_CORNER_TR_RL(
13	jmc	1.3	I fill4dirX, withSigns,
14	jmc	1.1	U trFld,
15			I bi,bj, myThid)
16
17			C !DESCRIPTION:
18			C ==========================================================
19			C \| SUBROUTINE FILL_CS_CORNER_TR_RL
20	jmc	1.3	C \| o Fill the corner-halo region of CS-grid,
21	jmc	1.1	C \| for a tracer variable (center of grid cell)
22			C ==========================================================
23			C \| o the corner halo region is filled with valid values
24			C \| in order to compute (later on) gradient in X or Y
25			C \| direction, on a wide stencil.
26			C ==========================================================
27
28			C !USES:
29	jmc	1.3	IMPLICIT NONE
30
31	jmc	1.1	C == Global variables ==
32			#include "SIZE.h"
33			#include "EEPARAMS.h"
34			#ifdef ALLOW_EXCH2
35			#include "W2_EXCH2_TOPOLOGY.h"
36			#include "W2_EXCH2_PARAMS.h"
37			#endif /* ALLOW_EXCH2 */
38
39			C !INPUT/OUTPUT PARAMETERS:
40			C == Routine arguments ==
41	jmc	1.3	C
42	jmc	1.1	C fill4dirX :: True = prepare for X direction calculations
43			C otherwise, prepare for Y direction
44	jmc	1.3	C withSigns :: True = account for sign of X & Y directions
45	jmc	1.1	C trFld :: tracer field array with empty corners to fill
46			C bi,bj :: tile indices
47			C myThid :: thread number
48			LOGICAL fill4dirX
49	jmc	1.3	LOGICAL withSigns
50	jmc	1.1	_RL trFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
51			INTEGER bi,bj
52			INTEGER myThid
53
54			C !LOCAL VARIABLES:
55			C == Local variables ==
56			C i,j :: loop indices
57			C myTile :: tile number
58			INTEGER i,j
59			LOGICAL southWestCorner
60			LOGICAL southEastCorner
61			LOGICAL northWestCorner
62			LOGICAL northEastCorner
63	jmc	1.3	_RL negOne
64	jmc	1.2	#ifdef ALLOW_EXCH2
65			INTEGER myTile
66			#endif
67	jmc	1.1	CEOP
68
69	jmc	1.3	negOne = 1.
70			IF (withSigns) negOne = -1.
71
72	jmc	1.1	IF (useCubedSphereExchange) THEN
73
74			#ifdef ALLOW_EXCH2
75			myTile = W2_myTileList(bi)
76			southWestCorner = exch2_isWedge(myTile).EQ.1
77			& .AND. exch2_isSedge(myTile).EQ.1
78			southEastCorner = exch2_isEedge(myTile).EQ.1
79			& .AND. exch2_isSedge(myTile).EQ.1
80			northEastCorner = exch2_isEedge(myTile).EQ.1
81			& .AND. exch2_isNedge(myTile).EQ.1
82			northWestCorner = exch2_isWedge(myTile).EQ.1
83			& .AND. exch2_isNedge(myTile).EQ.1
84			#else
85			southWestCorner = .TRUE.
86			southEastCorner = .TRUE.
87			northWestCorner = .TRUE.
88			northEastCorner = .TRUE.
89			#endif
90
91			IF ( fill4dirX ) THEN
92			C-- Internal exchange for calculations in X
93
94			C- For cube face corners we need to duplicate the
95			C- i-1 and i+1 values into the null space as follows:
96			C
97			C
98			C o NW corner: copy T( 0,sNy ) into T( 0,sNy+1) e.g.
99			C \|
100			C x T(0,sNy+1) \|
101			C /\ \|
102			C --\|\|------------\|-----------
103			C \|\| \|
104			C x T(0,sNy) \| x T(1,sNy)
105			C \|
106			C
107			C o SW corner: copy T(0,1) into T(0,0) e.g.
108			C \|
109			C x T(0,1) \| x T(1,1)
110			C \|\| \|
111			C --\|\|------------\|-----------
112			C \/ \|
113			C x T(0,0) \|
114			C \|
115			C
116			C o NE corner: copy T(sNx+1,sNy ) into T(sNx+1,sNy+1) e.g.
117			C \|
118			C \| x T(sNx+1,sNy+1)
119			C \| /\
120			C ----------------\|--\|\|-------
121			C \| \|\|
122			C x T(sNx,sNy) \| x T(sNx+1,sNy )
123			C \|
124			C o SE corner: copy T(sNx+1,1 ) into T(sNx+1,0 ) e.g.
125			C \|
126	jmc	1.3	C x T(sNx,1) \| x T(sNx+1, 1)
127	jmc	1.1	C \| \|\|
128			C ----------------\|--\|\|-------
129			C \| \/
130			C \| x T(sNx+1, 0)
131			IF ( southWestCorner ) THEN
132			DO j=1,OLy
133			DO i=1,OLx
134	jmc	1.3	trFld( 1-i , 1-j ) = negOne*trFld( 1-j , i )
135	jmc	1.1	ENDDO
136			ENDDO
137			ENDIF
138			IF ( southEastCorner ) THEN
139			DO j=1,OLy
140			DO i=1,OLx
141	jmc	1.3	trFld(sNx+i, 1-j ) = negOne*trFld(sNx+j, i )
142	jmc	1.1	ENDDO
143			ENDDO
144			ENDIF
145			IF ( northWestCorner ) THEN
146			DO j=1,OLy
147			DO i=1,OLx
148	jmc	1.3	trFld( 1-i ,sNy+j) = negOne*trFld( 1-j , sNy+1-i )
149	jmc	1.1	ENDDO
150			ENDDO
151			ENDIF
152			IF ( northEastCorner ) THEN
153			DO j=1,OLy
154			DO i=1,OLx
155	jmc	1.3	trFld(sNx+i,sNy+j) = negOne*trFld(sNx+j, sNy+1-i )
156	jmc	1.1	ENDDO
157			ENDDO
158			ENDIF
159
160			C-- End of X direction ; start Y direction case.
161
162			ELSE
163			C-- Internal exchange for calculations in Y
164
165			C- For cube face corners we need to duplicate the
166			C- j-1 and j+1 values into the null space as follows:
167			C
168			C o SW corner: copy T(0,1) into T(0,0) e.g.
169			C \|
170			C \| x T(1,1)
171			C \|
172			C ----------------\|-----------
173			C \|
174			C x T(0,0)<====== x T(1,0)
175			C \|
176			C
177			C o NW corner: copy T( 0,sNy ) into T( 0,sNy+1) e.g.
178			C \|
179			C x T(0,sNy+1)<=== x T(1,sNy+1)
180			C \|
181			C ----------------\|-----------
182			C \|
183			C \| x T(1,sNy)
184			C \|
185			C
186			C o NE corner: copy T(sNx+1,sNy ) into T(sNx+1,sNy+1) e.g.
187			C \|
188			C x T(sNx,sNy+1)=====>x T(sNx+1,sNy+1)
189	jmc	1.3	C \|
190	jmc	1.1	C ----------------\|-----------
191	jmc	1.3	C \|
192			C x T(sNx,sNy) \|
193	jmc	1.1	C \|
194			C o SE corner: copy T(sNx+1,1 ) into T(sNx+1,0 ) e.g.
195			C \|
196	jmc	1.3	C x T(sNx,1) \|
197			C \|
198	jmc	1.1	C ----------------\|-----------
199	jmc	1.3	C \|
200	jmc	1.1	C x T(sNx,0) =====>x T(sNx+1, 0)
201			IF ( southWestCorner ) THEN
202			DO j=1,Oly
203			DO i=1,Olx
204	jmc	1.3	trFld( 1-i , 1-j ) = negOne*trFld( j , 1-i )
205	jmc	1.1	ENDDO
206			ENDDO
207			ENDIF
208			IF ( southEastCorner ) THEN
209			DO j=1,Oly
210			DO i=1,Olx
211	jmc	1.3	trFld(sNx+i, 1-j ) = negOne*trFld(sNx+1-j, 1-i )
212	jmc	1.1	ENDDO
213			ENDDO
214			ENDIF
215			IF ( northWestCorner ) THEN
216			DO j=1,Oly
217			DO i=1,Olx
218	jmc	1.3	trFld( 1-i ,sNy+j) = negOne*trFld( j ,sNy+i)
219	jmc	1.1	ENDDO
220			ENDDO
221			ENDIF
222			IF ( northEastCorner ) THEN
223			DO j=1,Oly
224			DO i=1,Olx
225	jmc	1.3	trFld(sNx+i,sNy+j) = negOne*trFld(sNx+1-j,sNy+i)
226	jmc	1.1	ENDDO
227			ENDDO
228			ENDIF
229
230			C- End of Y direction case.
231			ENDIF
232
233			C-- End useCubedSphereExchange
234			ENDIF
235
236			RETURN
237			END