pkg/exch2/exch2_xyz_rx.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_xyz_rx.template,v 1.2 2004/04/05 15:27:06 edhill Exp $
C $Name:  $

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

CBOP

C     !ROUTINE: EXCH_XYZ_RX

C     !INTERFACE:
      SUBROUTINE EXCH2_XYZ_RX(
     U                       phi,
     I                       myThid )
      IMPLICIT NONE

C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE EXCH_XYZ_RX
C     | o Handle exchanges for _RX, three-dim scalar arrays.
C     *==========================================================*
C     | Invoke appropriate exchange routine depending on type
C     | of grid (cube or globally indexed) to be operated on.
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     phi    :: Array with overlap regions are to be exchanged
C     myThid :: My thread id.
      _RX phi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)
      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, k

CEOP

      OLw        = OLx
      OLe        = OLx
      OLn        = OLy
      OLs        = OLy
      exchWidthX = OLx
      exchWidthY = OLy
      myNz       = Nr
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_RX1_CUBE( phi, 'T ',
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )

#ifdef W2_FILL_NULL_REGIONS
       DO bj=myByLo(myThid),myByHi(myThid)
        DO bi=myBxLo(myThid),myBxHi(myThid)
         myTile = W2_myTileList(bi)
C        South-east corner
         IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &        exch2_isSedge(myTile) .EQ. 1 ) THEN
          DO j=1-OLy,0
           DO i=sNx+1,sNx+OLx
            DO k=1,Nr
             phi(i,j,k,bi,bj)=e2FillValue_RX
            ENDDO
           ENDDO
          ENDDO
         ENDIF
C        North-east corner
         IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &        exch2_isNedge(myTile) .EQ. 1 ) THEN
          DO j=sNy+1,sNy+OLy
           DO i=sNx+1,sNx+OLx
            DO k=1,Nr
             phi(i,j,k,bi,bj)=e2FillValue_RX
            ENDDO
           ENDDO
          ENDDO
         ENDIF
C        South-west corner
         IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
     &        exch2_isSedge(myTile) .EQ. 1 ) THEN
          DO j=1-OLy,0
           DO i=1-OLx,0
            DO k=1,Nr
             phi(i,j,k,bi,bj)=e2FillValue_RX
            ENDDO
           ENDDO
          ENDDO
         ENDIF
C        North-west corner
         IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
     &        exch2_isNedge(myTile) .EQ. 1 ) THEN
          DO j=sNy+1,sNy+OLy
           DO i=1-OLx,0
            DO k=1,Nr
             phi(i,j,k,bi,bj)=e2FillValue_RX
            ENDDO
           ENDDO
          ENDDO
         ENDIF
        ENDDO
       ENDDO
#endif /* W2_FILL_NULL_REGIONS */

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

#ifdef W2_FILL_NULL_REGIONS
       DO bj=myByLo(myThid),myByHi(myThid)
        DO bi=myBxLo(myThid),myBxHi(myThid)
         myTile = W2_myTileList(bi)
C        South-east corner
         IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &        exch2_isSedge(myTile) .EQ. 1 ) THEN
          DO j=1-OLy,0
           DO i=sNx+1,sNx+OLx
            DO k=1,Nr
             phi(i,j,k,bi,bj)=e2FillValue_RX
            ENDDO
           ENDDO
          ENDDO
         ENDIF
C        North-east corner
         IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
     &        exch2_isNedge(myTile) .EQ. 1 ) THEN
          DO j=sNy+1,sNy+OLy
           DO i=sNx+1,sNx+OLx
            DO k=1,Nr
             phi(i,j,k,bi,bj)=e2FillValue_RX
            ENDDO
           ENDDO
          ENDDO
         ENDIF
C        South-west corner
         IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
     &        exch2_isSedge(myTile) .EQ. 1 ) THEN
          DO j=1-OLy,0
           DO i=1-OLx,0
            DO k=1,Nr
             phi(i,j,k,bi,bj)=e2FillValue_RX
            ENDDO
           ENDDO
          ENDDO
         ENDIF
C        North-west corner
         IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
     &        exch2_isNedge(myTile) .EQ. 1 ) THEN
          DO j=sNy+1,sNy+OLy
           DO i=1-OLx,0
            DO k=1,Nr
             phi(i,j,k,bi,bj)=e2FillValue_RX
            ENDDO
           ENDDO
          ENDDO
         ENDIF
        ENDDO
       ENDDO
#endif /* W2_FILL_NULL_REGIONS */

      ELSE

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

      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_xyz_rx.template,v 1.2 2004/04/05 15:27:06 edhill Exp $
2	afe	1.1	C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5	jmc	1.3	#include "W2_OPTIONS.h"
6
7	afe	1.1	CBOP
8
9			C !ROUTINE: EXCH_XYZ_RX
10
11			C !INTERFACE:
12	jmc	1.3	SUBROUTINE EXCH2_XYZ_RX(
13			U phi,
14	afe	1.1	I myThid )
15			IMPLICIT NONE
16
17			C !DESCRIPTION:
18			C ==========================================================
19	jmc	1.3	C \| SUBROUTINE EXCH_XYZ_RX
20			C \| o Handle exchanges for _RX, three-dim scalar arrays.
21	afe	1.1	C ==========================================================
22			C \| Invoke appropriate exchange routine depending on type
23			C \| of grid (cube or globally indexed) to be operated on.
24			C ==========================================================
25
26			C !USES:
27			C === Global data ===
28			#include "SIZE.h"
29			#include "EEPARAMS.h"
30			#include "EESUPPORT.h"
31			#include "W2_EXCH2_TOPOLOGY.h"
32			#include "W2_EXCH2_PARAMS.h"
33
34			C !INPUT/OUTPUT PARAMETERS:
35			C === Routine arguments ===
36			C phi :: Array with overlap regions are to be exchanged
37			C myThid :: My thread id.
38			_RX phi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,1:Nr,nSx,nSy)
39			INTEGER myThid
40
41			C !LOCAL VARIABLES:
42			C == Local variables ==
43			C OL[wens] :: Overlap extents in west, east, north, south.
44			C exchWidth[XY] :: Extent of regions that will be exchanged.
45			INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY, myNz
46			INTEGER bi, bj, myTile, i, j, k
47
48			CEOP
49
50			OLw = OLx
51			OLe = OLx
52			OLn = OLy
53			OLs = OLy
54			exchWidthX = OLx
55			exchWidthY = OLy
56			myNz = Nr
57			C NOTE The exchange routine we use here does not
58			C require the preceeding and following barriers.
59			C However, the slow, simple exchange interface
60			C that is calling it here is meant to ensure
61			C that threads are synchronised before exchanges
62			C begine.
63	jmc	1.3
64	afe	1.1	IF (useCubedSphereExchange) THEN
65	jmc	1.3
66	afe	1.1	CALL EXCH2_RX1_CUBE( phi, 'T ',
67			I OLw, OLe, OLs, OLn, myNz,
68			I exchWidthX, exchWidthY,
69			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
70
71	jmc	1.3	#ifdef W2_FILL_NULL_REGIONS
72	afe	1.1	DO bj=myByLo(myThid),myByHi(myThid)
73			DO bi=myBxLo(myThid),myBxHi(myThid)
74			myTile = W2_myTileList(bi)
75			C South-east corner
76			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
77			& exch2_isSedge(myTile) .EQ. 1 ) THEN
78			DO j=1-OLy,0
79			DO i=sNx+1,sNx+OLx
80	jmc	1.3	DO k=1,Nr
81			phi(i,j,k,bi,bj)=e2FillValue_RX
82	afe	1.1	ENDDO
83			ENDDO
84			ENDDO
85			ENDIF
86			C North-east corner
87			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
88			& exch2_isNedge(myTile) .EQ. 1 ) THEN
89			DO j=sNy+1,sNy+OLy
90			DO i=sNx+1,sNx+OLx
91	jmc	1.3	DO k=1,Nr
92			phi(i,j,k,bi,bj)=e2FillValue_RX
93	afe	1.1	ENDDO
94			ENDDO
95			ENDDO
96			ENDIF
97			C South-west corner
98			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
99			& exch2_isSedge(myTile) .EQ. 1 ) THEN
100			DO j=1-OLy,0
101			DO i=1-OLx,0
102	jmc	1.3	DO k=1,Nr
103			phi(i,j,k,bi,bj)=e2FillValue_RX
104	afe	1.1	ENDDO
105			ENDDO
106			ENDDO
107			ENDIF
108			C North-west corner
109			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
110			& exch2_isNedge(myTile) .EQ. 1 ) THEN
111			DO j=sNy+1,sNy+OLy
112			DO i=1-OLx,0
113	jmc	1.3	DO k=1,Nr
114			phi(i,j,k,bi,bj)=e2FillValue_RX
115	afe	1.1	ENDDO
116			ENDDO
117			ENDDO
118			ENDIF
119			ENDDO
120			ENDDO
121	jmc	1.3	#endif /* W2_FILL_NULL_REGIONS */
122
123	afe	1.1	CALL EXCH2_RX1_CUBE( phi, 'T ',
124			I OLw, OLe, OLs, OLn, myNz,
125			I exchWidthX, exchWidthY,
126			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
127
128	jmc	1.3	#ifdef W2_FILL_NULL_REGIONS
129	afe	1.1	DO bj=myByLo(myThid),myByHi(myThid)
130			DO bi=myBxLo(myThid),myBxHi(myThid)
131			myTile = W2_myTileList(bi)
132			C South-east corner
133			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
134			& exch2_isSedge(myTile) .EQ. 1 ) THEN
135			DO j=1-OLy,0
136			DO i=sNx+1,sNx+OLx
137	jmc	1.3	DO k=1,Nr
138			phi(i,j,k,bi,bj)=e2FillValue_RX
139	afe	1.1	ENDDO
140			ENDDO
141			ENDDO
142			ENDIF
143			C North-east corner
144			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
145			& exch2_isNedge(myTile) .EQ. 1 ) THEN
146			DO j=sNy+1,sNy+OLy
147			DO i=sNx+1,sNx+OLx
148	jmc	1.3	DO k=1,Nr
149			phi(i,j,k,bi,bj)=e2FillValue_RX
150	afe	1.1	ENDDO
151			ENDDO
152			ENDDO
153			ENDIF
154			C South-west corner
155			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
156			& exch2_isSedge(myTile) .EQ. 1 ) THEN
157			DO j=1-OLy,0
158			DO i=1-OLx,0
159	jmc	1.3	DO k=1,Nr
160			phi(i,j,k,bi,bj)=e2FillValue_RX
161	afe	1.1	ENDDO
162			ENDDO
163			ENDDO
164			ENDIF
165			C North-west corner
166			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
167			& exch2_isNedge(myTile) .EQ. 1 ) THEN
168			DO j=sNy+1,sNy+OLy
169			DO i=1-OLx,0
170	jmc	1.3	DO k=1,Nr
171			phi(i,j,k,bi,bj)=e2FillValue_RX
172	afe	1.1	ENDDO
173			ENDDO
174			ENDDO
175			ENDIF
176			ENDDO
177			ENDDO
178	jmc	1.3	#endif /* W2_FILL_NULL_REGIONS */
179
180	afe	1.1	ELSE
181	jmc	1.3
182	afe	1.1	CALL EXCH_RX( phi,
183			I OLw, OLe, OLs, OLn, myNz,
184			I exchWidthX, exchWidthY,
185			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
186	jmc	1.3
187	afe	1.1	ENDIF
188
189			RETURN
190			END
191	edhill	1.2
192			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
193
194			CEH3 ;;; Local Variables: ***
195			CEH3 ;;; mode:fortran ***
196			CEH3 ;;; End: ***