pkg/exch2/exch2_get_uv_bounds.F

C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_get_uv_bounds.F,v 1.1 2008/08/01 00:45:16 jmc Exp $
C $Name:  $

CBOP
C     !ROUTINE: EXCH2_GET_UV_BOUNDS

C     !INTERFACE:
      SUBROUTINE EXCH2_GET_UV_BOUNDS(
     I                 fCode, eWdth,
     I                 tgTile, tgNb,
     O                 tIlo1, tIhi1, tJlo1, tJhi1,
     O                 tIlo2, tIhi2, tJlo2, tJhi2,
     O                 tiStride, tjStride,
     O                 e2_oi1, e2_oj1, e2_oi2, e2_oj2,
     I                 myThid )

C     !DESCRIPTION:
C     Return the index range & step of the part of the array (overlap-region)
C     which is going to be updated by the exchange with 1 neighbour.
C     2 components vector field (UV) version.


C     !USES:
      IMPLICIT NONE
C     == Global data ==
#include "SIZE.h"
#include "W2_EXCH2_SIZE.h"
#include "W2_EXCH2_TOPOLOGY.h"

C     !INPUT/OUTPUT PARAMETERS:
C     fCode         :: field code (position on staggered grid)
C     eWdth         :: width of data region to exchange
C     updateCorners :: flag, do update corner halo region if true
C     tgTile        :: target tile
C     tgNb          :: target Neighbour entry
C     tIlo1, tIhi1  :: index range in I that will be filled in 1rst comp. array
C     tJlo1, tJhi1  :: index range in J that will be filled in 1rst comp. array
C     tIlo2, tIhi2  :: index range in I that will be filled in 2nd  comp. array
C     tJlo2, tJhi2  :: index range in J that will be filled in 2nd  comp. array
C     tiStride      :: index step  in I that will be filled in target arrays
C     tjStride      :: index step  in J that will be filled in target arrays
C     e2_oi1        :: index offset in target to source-1 index relation
C     e2_oj1        :: index offset in target to source-1 index relation
C     e2_oi2        :: index offset in target to source-2 index relation
C     e2_oj2        :: index offset in target to source-2 index relation
C     myThid        :: my Thread Id. number

      CHARACTER*2 fCode
      INTEGER     eWdth
c     LOGICAL     updateCorners
      INTEGER     tgTile, tgNb
      INTEGER     tIlo1, tIhi1, tJlo1, tJhi1
      INTEGER     tIlo2, tIhi2, tJlo2, tJhi2
      INTEGER     tiStride, tjStride
      INTEGER     e2_oi1, e2_oj1
      INTEGER     e2_oi2, e2_oj2
      INTEGER     myThid
C
C     !LOCAL VARIABLES:
C     soTile        :: source tile
C     soNb          :: source Neighbour entry
      INTEGER  soTile
      INTEGER  soNb
      INTEGER  tIlo,  tIhi,  tJlo,  tJhi
      INTEGER  i, e2_pij(4)

C---  exch2 target to source index relation:
C     is = pij(1)*it + pij(2)*jt + oi
C     js = pij(3)*it + pij(4)*jt + oj

C---  Initialise index range from Topology values:
      tIlo = exch2_iLo(tgNb,tgTile)
      tIhi = exch2_iHi(tgNb,tgTile)
      tJlo = exch2_jLo(tgNb,tgTile)
      tJhi = exch2_jHi(tgNb,tgTile)
      soNb = exch2_opposingSend(tgNb,tgTile)
      soTile = exch2_neighbourId(tgNb,tgTile)
      e2_oi1 = exch2_oi(soNb,soTile)
      e2_oj1 = exch2_oj(soNb,soTile)
      DO i=1,4
        e2_pij(i) = exch2_pij(i,soNb,soTile)
      ENDDO

C---  Expand index range according to exchange-Width "eWdth"
      IF ( tIlo.EQ.tIhi .AND. tIlo.EQ.0 ) THEN
C      Filling a west edge overlap
       tIlo1 = 1-eWdth
       tIhi1 = 0
       tiStride = 1
       IF ( tJlo.LE.tJhi ) THEN
        tjStride=1
       ELSE
        tjStride=-1
       ENDIF
        tJlo1 = tJlo-tjStride*(eWdth-1)
        tJhi1 = tJhi+tjStride*(eWdth-1)
      ENDIF
      IF ( tIlo.EQ.tIhi .AND. tIlo.GT.1 ) THEN
C      Filling an east edge overlap
       tIlo1 = tIlo
       tIhi1 = tIhi+eWdth-1
       tiStride = 1
       IF ( tJlo.LE.tJhi ) THEN
        tjStride = 1
       ELSE
        tjStride =-1
       ENDIF
        tJlo1 = tJlo-tjStride*(eWdth-1)
        tJhi1 = tJhi+tjStride*(eWdth-1)
      ENDIF
      IF ( tJlo.EQ.tJhi .AND. tJlo.EQ.0 ) THEN
C      Filling a south edge overlap
       tJlo1 = 1-eWdth
       tJhi1 = 0
       tjStride = 1
       IF ( tIlo .LE. tIhi ) THEN
        tiStride = 1
       ELSE
        tiStride =-1
       ENDIF
        tIlo1 = tIlo-tiStride*(eWdth-1)
        tIhi1 = tIhi+tiStride*(eWdth-1)
      ENDIF
      IF ( tJlo.EQ.tJhi .AND. tJlo.GT.1 ) THEN
C      Filling a north edge overlap
       tJlo1 = tJlo
       tJhi1 = tJhi+eWdth-1
       tjStride = 1
       IF ( tIlo.LE.tIhi ) THEN
        tiStride = 1
       ELSE
        tiStride =-1
       ENDIF
        tIlo1 = tIlo-tiStride*(eWdth-1)
        tIhi1 = tIhi+tiStride*(eWdth-1)
      ENDIF

C---  copy to 2nd set of indices
      tIlo2 = tIlo1
      tIhi2 = tIhi1
      tJlo2 = tJlo1
      tJhi2 = tJhi1
      e2_oi2 = e2_oi1
      e2_oj2 = e2_oj1

      IF ( fCode.EQ.'Cg' ) THEN
C---  UV C-Grid specific code: start here

C---  half grid-cell location with inverse index relation
C     => increase the offset by 1 (relative to tracer cell-centered offset)
C     if pij(1) is -1 then +i in source aligns with -i in target
C     if pij(3) is -1 then +j in source aligns with -i in target
        IF ( e2_pij(1) .EQ. -1 ) THEN
         e2_oi1 = e2_oi1 + 1
        ENDIF
        IF ( e2_pij(3) .EQ. -1 ) THEN
         e2_oj1 = e2_oj1 + 1
        ENDIF
C     if pij(2) is -1 then +i in source aligns with -j in target
C     if pij(4) is -1 then +j in source aligns with -j in target
        IF ( e2_pij(2) .EQ. -1 ) THEN
         e2_oi2 = e2_oi2 + 1
        ENDIF
        IF ( e2_pij(4) .EQ. -1 ) THEN
         e2_oj2 = e2_oj2 + 1
        ENDIF
C--   as a consequence, need also to increase the index lower bound
C     (avoid "out-of bounds" problems ; formerly itlreduce,jtlreduce)
        IF ( e2_pij(1).EQ.-1 .OR. e2_pij(3).EQ.-1 ) tIlo1 = tIlo1+1
        IF ( e2_pij(2).EQ.-1 .OR. e2_pij(4).EQ.-1 ) tJlo2 = tJlo2+1

C---  Avoid updating (some) tile-corner halo region if across faces
c       IF ( tIlo.EQ.tIhi .AND. tIlo.EQ.0 ) THEN
c         IF ( exch2_isSedge(tgTile).EQ.1 ) THEN
C-      West edge is touching the face S edge
c           tJlo1 = tJlo+1
c           tJlo2 = tJlo+1
c         ENDIF
c         IF ( exch2_isNedge(tgTile).EQ.1 ) THEN
C-      West edge is touching the face N edge
c           tJhi1 = tJhi-1
c           tJhi2 = tJhi
c         ENDIF
c       ENDIF
        IF ( tIlo.EQ.tIhi .AND. tIlo.GT.1 ) THEN
          IF ( exch2_isSedge(tgTile).EQ.1 ) THEN
C-      East edge is touching the face S edge
            tJlo1 = tJlo+1
            tJlo2 = tJlo+1
          ENDIF
          IF ( exch2_isNedge(tgTile).EQ.1 ) THEN
C-      East edge is touching the face N edge
            tJhi1 = tJhi-1
            tJhi2 = tJhi
          ENDIF
        ENDIF
c       IF ( tJlo.EQ.tJhi .AND. tJlo.EQ.0 ) THEN
c         IF ( exch2_isWedge(tgTile).EQ.1 ) THEN
C-      South edge is touching the face W edge
c           tIlo1 = tIlo+1
c           tIlo2 = tIlo+1
c         ENDIF
c         IF ( exch2_isEedge(tgTile).EQ.1 ) THEN
C-      South Edge is touching the face E edge
c           tIhi1 = tIhi
c           tIhi2 = tIhi-1
c         ENDIF
c       ENDIF
        IF ( tJlo.EQ.tJhi .AND. tJlo.GT.1 ) THEN
          IF ( exch2_isWedge(tgTile).EQ.1 ) THEN
C-      North edge is touching the face W edge
            tIlo1 = tIlo+1
            tIlo2 = tIlo+1
          ENDIF
          IF ( exch2_isEedge(tgTile).EQ.1 ) THEN
C-      North Edge is touching the face E edge
            tIhi1 = tIhi
            tIhi2 = tIhi-1
          ENDIF
        ENDIF

C---  UV C-Grid specific code: end

      ELSEIF ( fCode.NE.'Ag' ) THEN
        STOP 'ABNORMAL END: S/R EXCH2_GET_UV_BOUNDS (wrong fCode)'
      ENDIF

      RETURN
      END
1	jmc	1.2	C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_get_uv_bounds.F,v 1.1 2008/08/01 00:45:16 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			CBOP
5			C !ROUTINE: EXCH2_GET_UV_BOUNDS
6
7			C !INTERFACE:
8			SUBROUTINE EXCH2_GET_UV_BOUNDS(
9	jmc	1.2	I fCode, eWdth,
10			I tgTile, tgNb,
11			O tIlo1, tIhi1, tJlo1, tJhi1,
12			O tIlo2, tIhi2, tJlo2, tJhi2,
13			O tiStride, tjStride,
14			O e2_oi1, e2_oj1, e2_oi2, e2_oj2,
15			I myThid )
16	jmc	1.1
17			C !DESCRIPTION:
18	jmc	1.2	C Return the index range & step of the part of the array (overlap-region)
19			C which is going to be updated by the exchange with 1 neighbour.
20			C 2 components vector field (UV) version.
21
22	jmc	1.1
23			C !USES:
24			IMPLICIT NONE
25			C == Global data ==
26	jmc	1.2	#include "SIZE.h"
27			#include "W2_EXCH2_SIZE.h"
28			#include "W2_EXCH2_TOPOLOGY.h"
29	jmc	1.1
30			C !INPUT/OUTPUT PARAMETERS:
31	jmc	1.2	C fCode :: field code (position on staggered grid)
32			C eWdth :: width of data region to exchange
33			C updateCorners :: flag, do update corner halo region if true
34			C tgTile :: target tile
35			C tgNb :: target Neighbour entry
36			C tIlo1, tIhi1 :: index range in I that will be filled in 1rst comp. array
37			C tJlo1, tJhi1 :: index range in J that will be filled in 1rst comp. array
38			C tIlo2, tIhi2 :: index range in I that will be filled in 2nd comp. array
39			C tJlo2, tJhi2 :: index range in J that will be filled in 2nd comp. array
40			C tiStride :: index step in I that will be filled in target arrays
41			C tjStride :: index step in J that will be filled in target arrays
42			C e2_oi1 :: index offset in target to source-1 index relation
43			C e2_oj1 :: index offset in target to source-1 index relation
44			C e2_oi2 :: index offset in target to source-2 index relation
45			C e2_oj2 :: index offset in target to source-2 index relation
46			C myThid :: my Thread Id. number
47	jmc	1.1
48			CHARACTER*2 fCode
49			INTEGER eWdth
50	jmc	1.2	c LOGICAL updateCorners
51			INTEGER tgTile, tgNb
52	jmc	1.1	INTEGER tIlo1, tIhi1, tJlo1, tJhi1
53			INTEGER tIlo2, tIhi2, tJlo2, tJhi2
54			INTEGER tiStride, tjStride
55			INTEGER e2_oi1, e2_oj1
56			INTEGER e2_oi2, e2_oj2
57			INTEGER myThid
58			C
59			C !LOCAL VARIABLES:
60	jmc	1.2	C soTile :: source tile
61			C soNb :: source Neighbour entry
62			INTEGER soTile
63			INTEGER soNb
64			INTEGER tIlo, tIhi, tJlo, tJhi
65			INTEGER i, e2_pij(4)
66	jmc	1.1
67			C--- exch2 target to source index relation:
68			C is = pij(1)it + pij(2)jt + oi
69			C js = pij(3)it + pij(4)jt + oj
70
71	jmc	1.2	C--- Initialise index range from Topology values:
72			tIlo = exch2_iLo(tgNb,tgTile)
73			tIhi = exch2_iHi(tgNb,tgTile)
74			tJlo = exch2_jLo(tgNb,tgTile)
75			tJhi = exch2_jHi(tgNb,tgTile)
76			soNb = exch2_opposingSend(tgNb,tgTile)
77			soTile = exch2_neighbourId(tgNb,tgTile)
78			e2_oi1 = exch2_oi(soNb,soTile)
79			e2_oj1 = exch2_oj(soNb,soTile)
80			DO i=1,4
81			e2_pij(i) = exch2_pij(i,soNb,soTile)
82			ENDDO
83	jmc	1.1
84			C--- Expand index range according to exchange-Width "eWdth"
85			IF ( tIlo.EQ.tIhi .AND. tIlo.EQ.0 ) THEN
86	jmc	1.2	C Filling a west edge overlap
87	jmc	1.1	tIlo1 = 1-eWdth
88			tIhi1 = 0
89	jmc	1.2	tiStride = 1
90	jmc	1.1	IF ( tJlo.LE.tJhi ) THEN
91			tjStride=1
92			ELSE
93			tjStride=-1
94			ENDIF
95	jmc	1.2	tJlo1 = tJlo-tjStride*(eWdth-1)
96			tJhi1 = tJhi+tjStride*(eWdth-1)
97	jmc	1.1	ENDIF
98			IF ( tIlo.EQ.tIhi .AND. tIlo.GT.1 ) THEN
99	jmc	1.2	C Filling an east edge overlap
100			tIlo1 = tIlo
101	jmc	1.1	tIhi1 = tIhi+eWdth-1
102	jmc	1.2	tiStride = 1
103	jmc	1.1	IF ( tJlo.LE.tJhi ) THEN
104	jmc	1.2	tjStride = 1
105	jmc	1.1	ELSE
106	jmc	1.2	tjStride =-1
107	jmc	1.1	ENDIF
108	jmc	1.2	tJlo1 = tJlo-tjStride*(eWdth-1)
109			tJhi1 = tJhi+tjStride*(eWdth-1)
110	jmc	1.1	ENDIF
111			IF ( tJlo.EQ.tJhi .AND. tJlo.EQ.0 ) THEN
112	jmc	1.2	C Filling a south edge overlap
113	jmc	1.1	tJlo1 = 1-eWdth
114			tJhi1 = 0
115	jmc	1.2	tjStride = 1
116	jmc	1.1	IF ( tIlo .LE. tIhi ) THEN
117	jmc	1.2	tiStride = 1
118	jmc	1.1	ELSE
119	jmc	1.2	tiStride =-1
120	jmc	1.1	ENDIF
121	jmc	1.2	tIlo1 = tIlo-tiStride*(eWdth-1)
122			tIhi1 = tIhi+tiStride*(eWdth-1)
123	jmc	1.1	ENDIF
124			IF ( tJlo.EQ.tJhi .AND. tJlo.GT.1 ) THEN
125	jmc	1.2	C Filling a north edge overlap
126			tJlo1 = tJlo
127	jmc	1.1	tJhi1 = tJhi+eWdth-1
128	jmc	1.2	tjStride = 1
129	jmc	1.1	IF ( tIlo.LE.tIhi ) THEN
130	jmc	1.2	tiStride = 1
131	jmc	1.1	ELSE
132	jmc	1.2	tiStride =-1
133	jmc	1.1	ENDIF
134	jmc	1.2	tIlo1 = tIlo-tiStride*(eWdth-1)
135			tIhi1 = tIhi+tiStride*(eWdth-1)
136	jmc	1.1	ENDIF
137
138			C--- copy to 2nd set of indices
139			tIlo2 = tIlo1
140			tIhi2 = tIhi1
141			tJlo2 = tJlo1
142			tJhi2 = tJhi1
143			e2_oi2 = e2_oi1
144			e2_oj2 = e2_oj1
145
146			IF ( fCode.EQ.'Cg' ) THEN
147			C--- UV C-Grid specific code: start here
148
149			C--- half grid-cell location with inverse index relation
150			C => increase the offset by 1 (relative to tracer cell-centered offset)
151			C if pij(1) is -1 then +i in source aligns with -i in target
152			C if pij(3) is -1 then +j in source aligns with -i in target
153			IF ( e2_pij(1) .EQ. -1 ) THEN
154			e2_oi1 = e2_oi1 + 1
155			ENDIF
156			IF ( e2_pij(3) .EQ. -1 ) THEN
157			e2_oj1 = e2_oj1 + 1
158			ENDIF
159			C if pij(2) is -1 then +i in source aligns with -j in target
160			C if pij(4) is -1 then +j in source aligns with -j in target
161			IF ( e2_pij(2) .EQ. -1 ) THEN
162			e2_oi2 = e2_oi2 + 1
163			ENDIF
164			IF ( e2_pij(4) .EQ. -1 ) THEN
165			e2_oj2 = e2_oj2 + 1
166			ENDIF
167			C-- as a consequence, need also to increase the index lower bound
168			C (avoid "out-of bounds" problems ; formerly itlreduce,jtlreduce)
169			IF ( e2_pij(1).EQ.-1 .OR. e2_pij(3).EQ.-1 ) tIlo1 = tIlo1+1
170			IF ( e2_pij(2).EQ.-1 .OR. e2_pij(4).EQ.-1 ) tJlo2 = tJlo2+1
171
172			C--- Avoid updating (some) tile-corner halo region if across faces
173			c IF ( tIlo.EQ.tIhi .AND. tIlo.EQ.0 ) THEN
174	jmc	1.2	c IF ( exch2_isSedge(tgTile).EQ.1 ) THEN
175	jmc	1.1	C- West edge is touching the face S edge
176			c tJlo1 = tJlo+1
177			c tJlo2 = tJlo+1
178			c ENDIF
179	jmc	1.2	c IF ( exch2_isNedge(tgTile).EQ.1 ) THEN
180	jmc	1.1	C- West edge is touching the face N edge
181			c tJhi1 = tJhi-1
182			c tJhi2 = tJhi
183			c ENDIF
184			c ENDIF
185			IF ( tIlo.EQ.tIhi .AND. tIlo.GT.1 ) THEN
186	jmc	1.2	IF ( exch2_isSedge(tgTile).EQ.1 ) THEN
187	jmc	1.1	C- East edge is touching the face S edge
188			tJlo1 = tJlo+1
189			tJlo2 = tJlo+1
190			ENDIF
191	jmc	1.2	IF ( exch2_isNedge(tgTile).EQ.1 ) THEN
192	jmc	1.1	C- East edge is touching the face N edge
193			tJhi1 = tJhi-1
194			tJhi2 = tJhi
195			ENDIF
196			ENDIF
197			c IF ( tJlo.EQ.tJhi .AND. tJlo.EQ.0 ) THEN
198	jmc	1.2	c IF ( exch2_isWedge(tgTile).EQ.1 ) THEN
199	jmc	1.1	C- South edge is touching the face W edge
200			c tIlo1 = tIlo+1
201			c tIlo2 = tIlo+1
202			c ENDIF
203	jmc	1.2	c IF ( exch2_isEedge(tgTile).EQ.1 ) THEN
204	jmc	1.1	C- South Edge is touching the face E edge
205			c tIhi1 = tIhi
206			c tIhi2 = tIhi-1
207			c ENDIF
208			c ENDIF
209			IF ( tJlo.EQ.tJhi .AND. tJlo.GT.1 ) THEN
210	jmc	1.2	IF ( exch2_isWedge(tgTile).EQ.1 ) THEN
211	jmc	1.1	C- North edge is touching the face W edge
212			tIlo1 = tIlo+1
213			tIlo2 = tIlo+1
214			ENDIF
215	jmc	1.2	IF ( exch2_isEedge(tgTile).EQ.1 ) THEN
216	jmc	1.1	C- North Edge is touching the face E edge
217			tIhi1 = tIhi
218			tIhi2 = tIhi-1
219			ENDIF
220			ENDIF
221
222			C--- UV C-Grid specific code: end
223
224			ELSEIF ( fCode.NE.'Ag' ) THEN
225			STOP 'ABNORMAL END: S/R EXCH2_GET_UV_BOUNDS (wrong fCode)'
226			ENDIF
227
228			RETURN
229			END