high_res_cube/code-mods/exch2_xy_rl.F

C $Header: /usr/local/gcmpack/MITgcm_contrib/high_res_cube/code-mods/exch2_xy_rl.F,v 1.1.1.1 2003/11/11 18:08:07 cnh Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

CBOP

C     !ROUTINE: EXCH_XY_RL

C     !INTERFACE:
      SUBROUTINE EXCH2_XY_RL( 
     U                       phi, 
     I                       myThid )
      IMPLICIT NONE
C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE EXCH_XY_RL                                     
C     | o Handle exchanges for _RL two-dimensional scalar arrays.
C     *==========================================================*
C     | Invoke appropriate exchange for a scalar array for either
C     | global grid, or cube sphere grid.                         
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.
      _RL phi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,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
CEOP
  

      OLw        = OLx
      OLe        = OLx
      OLn        = OLy
      OLs        = OLy
      exchWidthX = OLx
      exchWidthY = OLy
      myNz       = 1
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_RL1_CUBE( phi, 'T ',
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
       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
            phi(i,j,bi,bj)=0.
           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
            phi(i,j,bi,bj)=0.
           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
            phi(i,j,bi,bj)=0.
           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
            phi(i,j,bi,bj)=0.
           ENDDO
          ENDDO
         ENDIF
        ENDDO
       ENDDO
       CALL EXCH2_RL1_CUBE( phi, 'T ',
     I            OLw, OLe, OLs, OLn, myNz,
     I            exchWidthX, exchWidthY,
     I            FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
       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
            phi(i,j,bi,bj)=0.
           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
            phi(i,j,bi,bj)=0.
           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
            phi(i,j,bi,bj)=0.
           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
            phi(i,j,bi,bj)=0.
           ENDDO
          ENDDO
         ENDIF
        ENDDO
       ENDDO

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

      RETURN
      END
1	dimitri	1.2	C $Header: /usr/local/gcmpack/MITgcm_contrib/high_res_cube/code-mods/exch2_xy_rl.F,v 1.1.1.1 2003/11/11 18:08:07 cnh Exp $
2	cnh	1.1	C $Name: $
3
4			#include "CPP_EEOPTIONS.h"
5
6			CBOP
7
8			C !ROUTINE: EXCH_XY_RL
9
10			C !INTERFACE:
11			SUBROUTINE EXCH2_XY_RL(
12			U phi,
13			I myThid )
14			IMPLICIT NONE
15			C !DESCRIPTION:
16			C ==========================================================
17			C \| SUBROUTINE EXCH_XY_RL
18			C \| o Handle exchanges for _RL two-dimensional scalar arrays.
19			C ==========================================================
20			C \| Invoke appropriate exchange for a scalar array for either
21			C \| global grid, or cube sphere grid.
22			C ==========================================================
23
24			C !USES:
25			C === Global data ===
26			#include "SIZE.h"
27			#include "EEPARAMS.h"
28			#include "EESUPPORT.h"
29			#include "W2_EXCH2_TOPOLOGY.h"
30			#include "W2_EXCH2_PARAMS.h"
31
32			C !INPUT/OUTPUT PARAMETERS:
33			C === Routine arguments ===
34			C phi :: Array with overlap regions are to be exchanged
35			C myThid :: My thread id.
36			_RL phi(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
37			INTEGER myThid
38
39			C !LOCAL VARIABLES:
40			C == Local variables ==
41			C OL[wens] :: Overlap extents in west, east, north, south.
42			C exchWidth[XY] :: Extent of regions that will be exchanged.
43			INTEGER OLw, OLe, OLn, OLs, exchWidthX, exchWidthY, myNz
44	dimitri	1.2	INTEGER bi, bj, myTile, i, j
45	cnh	1.1	CEOP
46
47
48			OLw = OLx
49			OLe = OLx
50			OLn = OLy
51			OLs = OLy
52			exchWidthX = OLx
53			exchWidthY = OLy
54			myNz = 1
55			C NOTE The exchange routine we use here does not
56			C require the preceeding and following barriers.
57			C However, the slow, simple exchange interface
58			C that is calling it here is meant to ensure
59			C that threads are synchronised before exchanges
60			C begine.
61			IF (useCubedSphereExchange) THEN
62			CALL EXCH2_RL1_CUBE( phi, 'T ',
63			I OLw, OLe, OLs, OLn, myNz,
64			I exchWidthX, exchWidthY,
65			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
66			DO bj=myByLo(myThid),myByHi(myThid)
67			DO bi=myBxLo(myThid),myBxHi(myThid)
68			myTile = W2_myTileList(bi)
69			C South-east corner
70	dimitri	1.2	IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
71			& exch2_isSedge(myTile) .EQ. 1 ) THEN
72			DO j=1-OLy,0
73			DO i=sNx+1,sNx+OLx
74			phi(i,j,bi,bj)=0.
75			ENDDO
76			ENDDO
77	cnh	1.1	ENDIF
78			C North-east corner
79	dimitri	1.2	IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
80			& exch2_isNedge(myTile) .EQ. 1 ) THEN
81			DO j=sNy+1,sNy+OLy
82			DO i=sNx+1,sNx+OLx
83			phi(i,j,bi,bj)=0.
84			ENDDO
85			ENDDO
86	cnh	1.1	ENDIF
87			C South-west corner
88	dimitri	1.2	IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
89			& exch2_isSedge(myTile) .EQ. 1 ) THEN
90			DO j=1-OLy,0
91			DO i=1-OLx,0
92			phi(i,j,bi,bj)=0.
93			ENDDO
94			ENDDO
95	cnh	1.1	ENDIF
96			C North-west corner
97	dimitri	1.2	IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
98			& exch2_isNedge(myTile) .EQ. 1 ) THEN
99			DO j=sNy+1,sNy+OLy
100			DO i=1-OLx,0
101			phi(i,j,bi,bj)=0.
102			ENDDO
103			ENDDO
104	cnh	1.1	ENDIF
105			ENDDO
106			ENDDO
107			CALL EXCH2_RL1_CUBE( phi, 'T ',
108			I OLw, OLe, OLs, OLn, myNz,
109			I exchWidthX, exchWidthY,
110			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
111			DO bj=myByLo(myThid),myByHi(myThid)
112			DO bi=myBxLo(myThid),myBxHi(myThid)
113			myTile = W2_myTileList(bi)
114			C South-east corner
115	dimitri	1.2	IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
116			& exch2_isSedge(myTile) .EQ. 1 ) THEN
117			DO j=1-OLy,0
118			DO i=sNx+1,sNx+OLx
119			phi(i,j,bi,bj)=0.
120			ENDDO
121			ENDDO
122	cnh	1.1	ENDIF
123			C North-east corner
124	dimitri	1.2	IF ( exch2_isEedge(myTile) .EQ. 1 .AND.
125			& exch2_isNedge(myTile) .EQ. 1 ) THEN
126			DO j=sNy+1,sNy+OLy
127			DO i=sNx+1,sNx+OLx
128			phi(i,j,bi,bj)=0.
129			ENDDO
130			ENDDO
131	cnh	1.1	ENDIF
132			C South-west corner
133	dimitri	1.2	IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
134			& exch2_isSedge(myTile) .EQ. 1 ) THEN
135			DO j=1-OLy,0
136			DO i=1-OLx,0
137			phi(i,j,bi,bj)=0.
138			ENDDO
139			ENDDO
140	cnh	1.1	ENDIF
141			C North-west corner
142	dimitri	1.2	IF ( exch2_isWedge(myTile) .EQ. 1 .AND.
143			& exch2_isNedge(myTile) .EQ. 1 ) THEN
144			DO j=sNy+1,sNy+OLy
145			DO i=1-OLx,0
146			phi(i,j,bi,bj)=0.
147			ENDDO
148			ENDDO
149	cnh	1.1	ENDIF
150			ENDDO
151			ENDDO
152
153			ELSE
154			CALL EXCH_RL( phi,
155			I OLw, OLe, OLs, OLn, myNz,
156			I exchWidthX, exchWidthY,
157			I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
158			ENDIF
159
160			RETURN
161			END