pkg/exch2/exch2_xyz_rx.template

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_xyz_rx.template,v 1.3 2005/07/24 01:35:06 jmc 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
#ifdef W2_FILL_NULL_REGIONS
      INTEGER bi, bj, myTile, i, j, k
#endif

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.4	C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_xyz_rx.template,v 1.3 2005/07/24 01:35:06 jmc 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	jmc	1.4	#ifdef W2_FILL_NULL_REGIONS
47	afe	1.1	INTEGER bi, bj, myTile, i, j, k
48	jmc	1.4	#endif
49	afe	1.1
50			CEOP
51
52			OLw = OLx
53			OLe = OLx
54			OLn = OLy
55			OLs = OLy
56			exchWidthX = OLx
57			exchWidthY = OLy
58			myNz = Nr
59			C NOTE The exchange routine we use here does not
60			C require the preceeding and following barriers.
61			C However, the slow, simple exchange interface
62			C that is calling it here is meant to ensure
63			C that threads are synchronised before exchanges
64			C begine.
65	jmc	1.3
66	afe	1.1	IF (useCubedSphereExchange) THEN
67	jmc	1.3
68	afe	1.1	CALL EXCH2_RX1_CUBE( phi, 'T ',
69			I OLw, OLe, OLs, OLn, myNz,
70			I exchWidthX, exchWidthY,
71			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
72
73	jmc	1.3	#ifdef W2_FILL_NULL_REGIONS
74	afe	1.1	DO bj=myByLo(myThid),myByHi(myThid)
75			DO bi=myBxLo(myThid),myBxHi(myThid)
76			myTile = W2_myTileList(bi)
77			C South-east corner
78			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
79			& exch2_isSedge(myTile) .EQ. 1 ) THEN
80			DO j=1-OLy,0
81			DO i=sNx+1,sNx+OLx
82	jmc	1.3	DO k=1,Nr
83			phi(i,j,k,bi,bj)=e2FillValue_RX
84	afe	1.1	ENDDO
85			ENDDO
86			ENDDO
87			ENDIF
88			C North-east corner
89			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
90			& exch2_isNedge(myTile) .EQ. 1 ) THEN
91			DO j=sNy+1,sNy+OLy
92			DO i=sNx+1,sNx+OLx
93	jmc	1.3	DO k=1,Nr
94			phi(i,j,k,bi,bj)=e2FillValue_RX
95	afe	1.1	ENDDO
96			ENDDO
97			ENDDO
98			ENDIF
99			C South-west corner
100			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
101			& exch2_isSedge(myTile) .EQ. 1 ) THEN
102			DO j=1-OLy,0
103			DO i=1-OLx,0
104	jmc	1.3	DO k=1,Nr
105			phi(i,j,k,bi,bj)=e2FillValue_RX
106	afe	1.1	ENDDO
107			ENDDO
108			ENDDO
109			ENDIF
110			C North-west corner
111			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
112			& exch2_isNedge(myTile) .EQ. 1 ) THEN
113			DO j=sNy+1,sNy+OLy
114			DO i=1-OLx,0
115	jmc	1.3	DO k=1,Nr
116			phi(i,j,k,bi,bj)=e2FillValue_RX
117	afe	1.1	ENDDO
118			ENDDO
119			ENDDO
120			ENDIF
121			ENDDO
122			ENDDO
123	jmc	1.3	#endif /* W2_FILL_NULL_REGIONS */
124
125	afe	1.1	CALL EXCH2_RX1_CUBE( phi, 'T ',
126			I OLw, OLe, OLs, OLn, myNz,
127			I exchWidthX, exchWidthY,
128			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
129
130	jmc	1.3	#ifdef W2_FILL_NULL_REGIONS
131	afe	1.1	DO bj=myByLo(myThid),myByHi(myThid)
132			DO bi=myBxLo(myThid),myBxHi(myThid)
133			myTile = W2_myTileList(bi)
134			C South-east corner
135			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
136			& exch2_isSedge(myTile) .EQ. 1 ) THEN
137			DO j=1-OLy,0
138			DO i=sNx+1,sNx+OLx
139	jmc	1.3	DO k=1,Nr
140			phi(i,j,k,bi,bj)=e2FillValue_RX
141	afe	1.1	ENDDO
142			ENDDO
143			ENDDO
144			ENDIF
145			C North-east corner
146			IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
147			& exch2_isNedge(myTile) .EQ. 1 ) THEN
148			DO j=sNy+1,sNy+OLy
149			DO i=sNx+1,sNx+OLx
150	jmc	1.3	DO k=1,Nr
151			phi(i,j,k,bi,bj)=e2FillValue_RX
152	afe	1.1	ENDDO
153			ENDDO
154			ENDDO
155			ENDIF
156			C South-west corner
157			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
158			& exch2_isSedge(myTile) .EQ. 1 ) THEN
159			DO j=1-OLy,0
160			DO i=1-OLx,0
161	jmc	1.3	DO k=1,Nr
162			phi(i,j,k,bi,bj)=e2FillValue_RX
163	afe	1.1	ENDDO
164			ENDDO
165			ENDDO
166			ENDIF
167			C North-west corner
168			IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
169			& exch2_isNedge(myTile) .EQ. 1 ) THEN
170			DO j=sNy+1,sNy+OLy
171			DO i=1-OLx,0
172	jmc	1.3	DO k=1,Nr
173			phi(i,j,k,bi,bj)=e2FillValue_RX
174	afe	1.1	ENDDO
175			ENDDO
176			ENDDO
177			ENDIF
178			ENDDO
179			ENDDO
180	jmc	1.3	#endif /* W2_FILL_NULL_REGIONS */
181
182	afe	1.1	ELSE
183	jmc	1.3
184	afe	1.1	CALL EXCH_RX( phi,
185			I OLw, OLe, OLs, OLn, myNz,
186			I exchWidthX, exchWidthY,
187			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
188	jmc	1.3
189	afe	1.1	ENDIF
190
191			RETURN
192			END
193	edhill	1.2
194			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
195
196			CEH3 ;;; Local Variables: ***
197			CEH3 ;;; mode:fortran ***
198			CEH3 ;;; End: ***