eesupp/src/fill_cs_corner_tr_rl.F

C $Header: /u/gcmpack/MITgcm/eesupp/src/fill_cs_corner_tr_rl.F,v 1.4 2008/10/22 00:23:40 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     fill4dir, 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_SIZE.h"
#include "W2_EXCH2_TOPOLOGY.h"
#endif /* ALLOW_EXCH2 */

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C
C     fill4dir  :: = 0 fill corner with zeros
C                  = 1 copy to prepare for X direction calculations
C                  = 2 copy to prepare for Y direction calculations
C                  = 3 fill corner with averaged value
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
      INTEGER fill4dir
      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 ( fill4dir .EQ. 0 ) THEN
C--    Just fill corner with zero (e.g., used for 6 tracer points average)

         IF ( southWestCorner ) THEN
          DO j=1,OLy
           DO i=1,OLx
            trFld( 1-i , 1-j ) = 0. _d 0
           ENDDO
          ENDDO
         ENDIF
         IF ( southEastCorner ) THEN
          DO j=1,OLy
           DO i=1,OLx
            trFld(sNx+i, 1-j ) = 0. _d 0
           ENDDO
          ENDDO
         ENDIF
         IF ( northWestCorner ) THEN
          DO j=1,OLy
           DO i=1,OLx
            trFld( 1-i ,sNy+j) = 0. _d 0
           ENDDO
          ENDDO
         ENDIF
         IF ( northEastCorner ) THEN
          DO j=1,OLy
           DO i=1,OLx
            trFld(sNx+i,sNy+j) = 0. _d 0
           ENDDO
          ENDDO
         ENDIF

       ELSEIF ( fill4dir .EQ. 1 ) 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.

       ELSEIF ( fill4dir .EQ. 2 ) THEN
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.
       ELSE
         STOP 'FILL_CS_CORNER_TR_RL: fill4dir has illegal value'
       ENDIF

C--   End useCubedSphereExchange
      ENDIF

      RETURN
      END
1	jmc	1.5	C $Header: /u/gcmpack/MITgcm/eesupp/src/fill_cs_corner_tr_rl.F,v 1.4 2008/10/22 00:23:40 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.4	I fill4dir, 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	jmc	1.4	C \| direction on a wide stencil.
26	jmc	1.1	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	jmc	1.5	#include "W2_EXCH2_SIZE.h"
36	jmc	1.1	#include "W2_EXCH2_TOPOLOGY.h"
37			#endif /* ALLOW_EXCH2 */
38
39			C !INPUT/OUTPUT PARAMETERS:
40			C == Routine arguments ==
41	jmc	1.3	C
42	jmc	1.4	C fill4dir :: = 0 fill corner with zeros
43			C = 1 copy to prepare for X direction calculations
44			C = 2 copy to prepare for Y direction calculations
45			C = 3 fill corner with averaged value
46	jmc	1.3	C withSigns :: True = account for sign of X & Y directions
47	jmc	1.1	C trFld :: tracer field array with empty corners to fill
48			C bi,bj :: tile indices
49			C myThid :: thread number
50	jmc	1.4	INTEGER fill4dir
51	jmc	1.3	LOGICAL withSigns
52	jmc	1.1	_RL trFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
53			INTEGER bi,bj
54			INTEGER myThid
55
56			C !LOCAL VARIABLES:
57			C == Local variables ==
58			C i,j :: loop indices
59			C myTile :: tile number
60			INTEGER i,j
61			LOGICAL southWestCorner
62			LOGICAL southEastCorner
63			LOGICAL northWestCorner
64			LOGICAL northEastCorner
65	jmc	1.3	_RL negOne
66	jmc	1.2	#ifdef ALLOW_EXCH2
67			INTEGER myTile
68			#endif
69	jmc	1.1	CEOP
70
71	jmc	1.3	negOne = 1.
72			IF (withSigns) negOne = -1.
73
74	jmc	1.1	IF (useCubedSphereExchange) THEN
75
76			#ifdef ALLOW_EXCH2
77			myTile = W2_myTileList(bi)
78			southWestCorner = exch2_isWedge(myTile).EQ.1
79			& .AND. exch2_isSedge(myTile).EQ.1
80			southEastCorner = exch2_isEedge(myTile).EQ.1
81			& .AND. exch2_isSedge(myTile).EQ.1
82			northEastCorner = exch2_isEedge(myTile).EQ.1
83			& .AND. exch2_isNedge(myTile).EQ.1
84			northWestCorner = exch2_isWedge(myTile).EQ.1
85			& .AND. exch2_isNedge(myTile).EQ.1
86			#else
87			southWestCorner = .TRUE.
88			southEastCorner = .TRUE.
89			northWestCorner = .TRUE.
90			northEastCorner = .TRUE.
91			#endif
92
93	jmc	1.4	IF ( fill4dir .EQ. 0 ) THEN
94			C-- Just fill corner with zero (e.g., used for 6 tracer points average)
95
96			IF ( southWestCorner ) THEN
97			DO j=1,OLy
98			DO i=1,OLx
99			trFld( 1-i , 1-j ) = 0. _d 0
100			ENDDO
101			ENDDO
102			ENDIF
103			IF ( southEastCorner ) THEN
104			DO j=1,OLy
105			DO i=1,OLx
106			trFld(sNx+i, 1-j ) = 0. _d 0
107			ENDDO
108			ENDDO
109			ENDIF
110			IF ( northWestCorner ) THEN
111			DO j=1,OLy
112			DO i=1,OLx
113			trFld( 1-i ,sNy+j) = 0. _d 0
114			ENDDO
115			ENDDO
116			ENDIF
117			IF ( northEastCorner ) THEN
118			DO j=1,OLy
119			DO i=1,OLx
120			trFld(sNx+i,sNy+j) = 0. _d 0
121			ENDDO
122			ENDDO
123			ENDIF
124
125			ELSEIF ( fill4dir .EQ. 1 ) THEN
126	jmc	1.1	C-- Internal exchange for calculations in X
127
128			C- For cube face corners we need to duplicate the
129			C- i-1 and i+1 values into the null space as follows:
130			C
131			C
132			C o NW corner: copy T( 0,sNy ) into T( 0,sNy+1) e.g.
133			C \|
134			C x T(0,sNy+1) \|
135			C /\ \|
136			C --\|\|------------\|-----------
137			C \|\| \|
138			C x T(0,sNy) \| x T(1,sNy)
139			C \|
140			C
141			C o SW corner: copy T(0,1) into T(0,0) e.g.
142			C \|
143			C x T(0,1) \| x T(1,1)
144			C \|\| \|
145			C --\|\|------------\|-----------
146			C \/ \|
147			C x T(0,0) \|
148			C \|
149			C
150			C o NE corner: copy T(sNx+1,sNy ) into T(sNx+1,sNy+1) e.g.
151			C \|
152			C \| x T(sNx+1,sNy+1)
153			C \| /\
154			C ----------------\|--\|\|-------
155			C \| \|\|
156			C x T(sNx,sNy) \| x T(sNx+1,sNy )
157			C \|
158			C o SE corner: copy T(sNx+1,1 ) into T(sNx+1,0 ) e.g.
159			C \|
160	jmc	1.3	C x T(sNx,1) \| x T(sNx+1, 1)
161	jmc	1.1	C \| \|\|
162			C ----------------\|--\|\|-------
163			C \| \/
164			C \| x T(sNx+1, 0)
165			IF ( southWestCorner ) THEN
166			DO j=1,OLy
167			DO i=1,OLx
168	jmc	1.3	trFld( 1-i , 1-j ) = negOne*trFld( 1-j , i )
169	jmc	1.1	ENDDO
170			ENDDO
171			ENDIF
172			IF ( southEastCorner ) THEN
173			DO j=1,OLy
174			DO i=1,OLx
175	jmc	1.3	trFld(sNx+i, 1-j ) = negOne*trFld(sNx+j, i )
176	jmc	1.1	ENDDO
177			ENDDO
178			ENDIF
179			IF ( northWestCorner ) THEN
180			DO j=1,OLy
181			DO i=1,OLx
182	jmc	1.3	trFld( 1-i ,sNy+j) = negOne*trFld( 1-j , sNy+1-i )
183	jmc	1.1	ENDDO
184			ENDDO
185			ENDIF
186			IF ( northEastCorner ) THEN
187			DO j=1,OLy
188			DO i=1,OLx
189	jmc	1.3	trFld(sNx+i,sNy+j) = negOne*trFld(sNx+j, sNy+1-i )
190	jmc	1.1	ENDDO
191			ENDDO
192			ENDIF
193
194			C-- End of X direction ; start Y direction case.
195
196	jmc	1.4	ELSEIF ( fill4dir .EQ. 2 ) THEN
197	jmc	1.1	C-- Internal exchange for calculations in Y
198
199			C- For cube face corners we need to duplicate the
200			C- j-1 and j+1 values into the null space as follows:
201			C
202			C o SW corner: copy T(0,1) into T(0,0) e.g.
203			C \|
204			C \| x T(1,1)
205			C \|
206			C ----------------\|-----------
207			C \|
208			C x T(0,0)<====== x T(1,0)
209			C \|
210			C
211			C o NW corner: copy T( 0,sNy ) into T( 0,sNy+1) e.g.
212			C \|
213			C x T(0,sNy+1)<=== x T(1,sNy+1)
214			C \|
215			C ----------------\|-----------
216			C \|
217			C \| x T(1,sNy)
218			C \|
219			C
220			C o NE corner: copy T(sNx+1,sNy ) into T(sNx+1,sNy+1) e.g.
221			C \|
222			C x T(sNx,sNy+1)=====>x T(sNx+1,sNy+1)
223	jmc	1.3	C \|
224	jmc	1.1	C ----------------\|-----------
225	jmc	1.3	C \|
226			C x T(sNx,sNy) \|
227	jmc	1.1	C \|
228			C o SE corner: copy T(sNx+1,1 ) into T(sNx+1,0 ) e.g.
229			C \|
230	jmc	1.3	C x T(sNx,1) \|
231			C \|
232	jmc	1.1	C ----------------\|-----------
233	jmc	1.3	C \|
234	jmc	1.1	C x T(sNx,0) =====>x T(sNx+1, 0)
235			IF ( southWestCorner ) THEN
236			DO j=1,Oly
237			DO i=1,Olx
238	jmc	1.3	trFld( 1-i , 1-j ) = negOne*trFld( j , 1-i )
239	jmc	1.1	ENDDO
240			ENDDO
241			ENDIF
242			IF ( southEastCorner ) THEN
243			DO j=1,Oly
244			DO i=1,Olx
245	jmc	1.3	trFld(sNx+i, 1-j ) = negOne*trFld(sNx+1-j, 1-i )
246	jmc	1.1	ENDDO
247			ENDDO
248			ENDIF
249			IF ( northWestCorner ) THEN
250			DO j=1,Oly
251			DO i=1,Olx
252	jmc	1.3	trFld( 1-i ,sNy+j) = negOne*trFld( j ,sNy+i)
253	jmc	1.1	ENDDO
254			ENDDO
255			ENDIF
256			IF ( northEastCorner ) THEN
257			DO j=1,Oly
258			DO i=1,Olx
259	jmc	1.3	trFld(sNx+i,sNy+j) = negOne*trFld(sNx+1-j,sNy+i)
260	jmc	1.1	ENDDO
261			ENDDO
262			ENDIF
263
264			C- End of Y direction case.
265	jmc	1.4	ELSE
266			STOP 'FILL_CS_CORNER_TR_RL: fill4dir has illegal value'
267	jmc	1.1	ENDIF
268
269			C-- End useCubedSphereExchange
270			ENDIF
271
272			RETURN
273			END