** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Sat, 10 May 2024 05:11:25 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/pkg/exch2/exch2_get_uv_bounds.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:39:43 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
dc3295f797 Jean*0001 #include "CPP_EEOPTIONS.h"
                0002 
10972e8712 Jean*0003 CBOP
                0004 C     !ROUTINE: EXCH2_GET_UV_BOUNDS
                0005 
                0006 C     !INTERFACE:
                0007       SUBROUTINE EXCH2_GET_UV_BOUNDS(
b475142410 Jean*0008      I                 fCode, eWdth, updateCorners,
11942f961e Jean*0009      I                 tgTile, tgNb,
                0010      O                 tIlo1, tIhi1, tJlo1, tJhi1,
                0011      O                 tIlo2, tIhi2, tJlo2, tJhi2,
                0012      O                 tiStride, tjStride,
                0013      O                 e2_oi1, e2_oj1, e2_oi2, e2_oj2,
                0014      I                 myThid )
10972e8712 Jean*0015 
                0016 C     !DESCRIPTION:
11942f961e Jean*0017 C     Return the index range & step of the part of the array (overlap-region)
                0018 C     which is going to be updated by the exchange with 1 neighbour.
                0019 C     2 components vector field (UV) version.
                0020 
10972e8712 Jean*0021 
                0022 C     !USES:
                0023       IMPLICIT NONE
                0024 C     == Global data ==
11942f961e Jean*0025 #include "SIZE.h"
                0026 #include "W2_EXCH2_SIZE.h"
                0027 #include "W2_EXCH2_TOPOLOGY.h"
10972e8712 Jean*0028 
                0029 C     !INPUT/OUTPUT PARAMETERS:
11942f961e Jean*0030 C     fCode         :: field code (position on staggered grid)
                0031 C     eWdth         :: width of data region to exchange
                0032 C     updateCorners :: flag, do update corner halo region if true
                0033 C     tgTile        :: target tile
                0034 C     tgNb          :: target Neighbour entry
                0035 C     tIlo1, tIhi1  :: index range in I that will be filled in 1rst comp. array
                0036 C     tJlo1, tJhi1  :: index range in J that will be filled in 1rst comp. array
                0037 C     tIlo2, tIhi2  :: index range in I that will be filled in 2nd  comp. array
                0038 C     tJlo2, tJhi2  :: index range in J that will be filled in 2nd  comp. array
                0039 C     tiStride      :: index step  in I that will be filled in target arrays
                0040 C     tjStride      :: index step  in J that will be filled in target arrays
                0041 C     e2_oi1        :: index offset in target to source-1 index relation
                0042 C     e2_oj1        :: index offset in target to source-1 index relation
                0043 C     e2_oi2        :: index offset in target to source-2 index relation
                0044 C     e2_oj2        :: index offset in target to source-2 index relation
                0045 C     myThid        :: my Thread Id. number
10972e8712 Jean*0046 
                0047       CHARACTER*2 fCode
                0048       INTEGER     eWdth
b475142410 Jean*0049       LOGICAL     updateCorners
11942f961e Jean*0050       INTEGER     tgTile, tgNb
10972e8712 Jean*0051       INTEGER     tIlo1, tIhi1, tJlo1, tJhi1
                0052       INTEGER     tIlo2, tIhi2, tJlo2, tJhi2
                0053       INTEGER     tiStride, tjStride
                0054       INTEGER     e2_oi1, e2_oj1
                0055       INTEGER     e2_oi2, e2_oj2
                0056       INTEGER     myThid
                0057 C
                0058 C     !LOCAL VARIABLES:
11942f961e Jean*0059 C     soTile        :: source tile
                0060 C     soNb          :: source Neighbour entry
                0061       INTEGER  soTile
                0062       INTEGER  soNb
                0063       INTEGER  tIlo,  tIhi,  tJlo,  tJhi
                0064       INTEGER  i, e2_pij(4)
10972e8712 Jean*0065 
                0066 C---  exch2 target to source index relation:
                0067 C     is = pij(1)*it + pij(2)*jt + oi
                0068 C     js = pij(3)*it + pij(4)*jt + oj
                0069 
11942f961e Jean*0070 C---  Initialise index range from Topology values:
                0071       tIlo = exch2_iLo(tgNb,tgTile)
                0072       tIhi = exch2_iHi(tgNb,tgTile)
                0073       tJlo = exch2_jLo(tgNb,tgTile)
                0074       tJhi = exch2_jHi(tgNb,tgTile)
                0075       soNb = exch2_opposingSend(tgNb,tgTile)
                0076       soTile = exch2_neighbourId(tgNb,tgTile)
                0077       e2_oi1 = exch2_oi(soNb,soTile)
                0078       e2_oj1 = exch2_oj(soNb,soTile)
                0079       DO i=1,4
                0080         e2_pij(i) = exch2_pij(i,soNb,soTile)
                0081       ENDDO
10972e8712 Jean*0082 
                0083 C---  Expand index range according to exchange-Width "eWdth"
                0084       IF ( tIlo.EQ.tIhi .AND. tIlo.EQ.0 ) THEN
11942f961e Jean*0085 C      Filling a west edge overlap
10972e8712 Jean*0086        tIlo1 = 1-eWdth
                0087        tIhi1 = 0
11942f961e Jean*0088        tiStride = 1
10972e8712 Jean*0089        IF ( tJlo.LE.tJhi ) THEN
                0090         tjStride=1
                0091        ELSE
                0092         tjStride=-1
                0093        ENDIF
b475142410 Jean*0094        IF ( updateCorners ) THEN
11942f961e Jean*0095         tJlo1 = tJlo-tjStride*(eWdth-1)
                0096         tJhi1 = tJhi+tjStride*(eWdth-1)
b475142410 Jean*0097        ELSE
                0098         tJlo1 = tJlo+tjStride
                0099         tJhi1 = tJhi-tjStride
                0100        ENDIF
10972e8712 Jean*0101       ENDIF
                0102       IF ( tIlo.EQ.tIhi .AND. tIlo.GT.1 ) THEN
11942f961e Jean*0103 C      Filling an east edge overlap
                0104        tIlo1 = tIlo
10972e8712 Jean*0105        tIhi1 = tIhi+eWdth-1
11942f961e Jean*0106        tiStride = 1
10972e8712 Jean*0107        IF ( tJlo.LE.tJhi ) THEN
11942f961e Jean*0108         tjStride = 1
10972e8712 Jean*0109        ELSE
11942f961e Jean*0110         tjStride =-1
10972e8712 Jean*0111        ENDIF
b475142410 Jean*0112        IF ( updateCorners ) THEN
11942f961e Jean*0113         tJlo1 = tJlo-tjStride*(eWdth-1)
                0114         tJhi1 = tJhi+tjStride*(eWdth-1)
b475142410 Jean*0115        ELSE
                0116         tJlo1 = tJlo+tjStride
                0117         tJhi1 = tJhi-tjStride
                0118        ENDIF
10972e8712 Jean*0119       ENDIF
                0120       IF ( tJlo.EQ.tJhi .AND. tJlo.EQ.0 ) THEN
11942f961e Jean*0121 C      Filling a south edge overlap
10972e8712 Jean*0122        tJlo1 = 1-eWdth
                0123        tJhi1 = 0
11942f961e Jean*0124        tjStride = 1
10972e8712 Jean*0125        IF ( tIlo .LE. tIhi ) THEN
11942f961e Jean*0126         tiStride = 1
10972e8712 Jean*0127        ELSE
11942f961e Jean*0128         tiStride =-1
10972e8712 Jean*0129        ENDIF
b475142410 Jean*0130        IF ( updateCorners ) THEN
11942f961e Jean*0131         tIlo1 = tIlo-tiStride*(eWdth-1)
                0132         tIhi1 = tIhi+tiStride*(eWdth-1)
b475142410 Jean*0133        ELSE
                0134         tIlo1 = tIlo+tiStride
                0135         tIhi1 = tIhi-tiStride
                0136        ENDIF
10972e8712 Jean*0137       ENDIF
                0138       IF ( tJlo.EQ.tJhi .AND. tJlo.GT.1 ) THEN
11942f961e Jean*0139 C      Filling a north edge overlap
                0140        tJlo1 = tJlo
10972e8712 Jean*0141        tJhi1 = tJhi+eWdth-1
11942f961e Jean*0142        tjStride = 1
10972e8712 Jean*0143        IF ( tIlo.LE.tIhi ) THEN
11942f961e Jean*0144         tiStride = 1
10972e8712 Jean*0145        ELSE
11942f961e Jean*0146         tiStride =-1
10972e8712 Jean*0147        ENDIF
b475142410 Jean*0148        IF ( updateCorners ) THEN
11942f961e Jean*0149         tIlo1 = tIlo-tiStride*(eWdth-1)
                0150         tIhi1 = tIhi+tiStride*(eWdth-1)
b475142410 Jean*0151        ELSE
                0152         tIlo1 = tIlo+tiStride
                0153         tIhi1 = tIhi-tiStride
                0154        ENDIF
10972e8712 Jean*0155       ENDIF
                0156 
                0157 C---  copy to 2nd set of indices
                0158       tIlo2 = tIlo1
                0159       tIhi2 = tIhi1
                0160       tJlo2 = tJlo1
                0161       tJhi2 = tJhi1
                0162       e2_oi2 = e2_oi1
                0163       e2_oj2 = e2_oj1
                0164 
                0165       IF ( fCode.EQ.'Cg' ) THEN
                0166 C---  UV C-Grid specific code: start here
                0167 
                0168 C---  half grid-cell location with inverse index relation
                0169 C     => increase the offset by 1 (relative to tracer cell-centered offset)
                0170 C     if pij(1) is -1 then +i in source aligns with -i in target
                0171 C     if pij(3) is -1 then +j in source aligns with -i in target
                0172         IF ( e2_pij(1) .EQ. -1 ) THEN
                0173          e2_oi1 = e2_oi1 + 1
                0174         ENDIF
                0175         IF ( e2_pij(3) .EQ. -1 ) THEN
                0176          e2_oj1 = e2_oj1 + 1
                0177         ENDIF
                0178 C     if pij(2) is -1 then +i in source aligns with -j in target
                0179 C     if pij(4) is -1 then +j in source aligns with -j in target
                0180         IF ( e2_pij(2) .EQ. -1 ) THEN
                0181          e2_oi2 = e2_oi2 + 1
                0182         ENDIF
                0183         IF ( e2_pij(4) .EQ. -1 ) THEN
                0184          e2_oj2 = e2_oj2 + 1
                0185         ENDIF
b475142410 Jean*0186 
                0187 C---  adjust index lower and upper bounds (fct of updateCorners):
                0188        IF ( updateCorners ) THEN
                0189 
10972e8712 Jean*0190 C--   as a consequence, need also to increase the index lower bound
                0191 C     (avoid "out-of bounds" problems ; formerly itlreduce,jtlreduce)
                0192         IF ( e2_pij(1).EQ.-1 .OR. e2_pij(3).EQ.-1 ) tIlo1 = tIlo1+1
                0193         IF ( e2_pij(2).EQ.-1 .OR. e2_pij(4).EQ.-1 ) tJlo2 = tJlo2+1
                0194 
                0195 C---  Avoid updating (some) tile-corner halo region if across faces
                0196 c       IF ( tIlo.EQ.tIhi .AND. tIlo.EQ.0 ) THEN
11942f961e Jean*0197 c         IF ( exch2_isSedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0198 C-      West edge is touching the face S edge
                0199 c           tJlo1 = tJlo+1
                0200 c           tJlo2 = tJlo+1
                0201 c         ENDIF
11942f961e Jean*0202 c         IF ( exch2_isNedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0203 C-      West edge is touching the face N edge
                0204 c           tJhi1 = tJhi-1
                0205 c           tJhi2 = tJhi
                0206 c         ENDIF
                0207 c       ENDIF
                0208         IF ( tIlo.EQ.tIhi .AND. tIlo.GT.1 ) THEN
11942f961e Jean*0209           IF ( exch2_isSedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0210 C-      East edge is touching the face S edge
                0211             tJlo1 = tJlo+1
                0212             tJlo2 = tJlo+1
                0213           ENDIF
11942f961e Jean*0214           IF ( exch2_isNedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0215 C-      East edge is touching the face N edge
                0216             tJhi1 = tJhi-1
                0217             tJhi2 = tJhi
                0218           ENDIF
                0219         ENDIF
                0220 c       IF ( tJlo.EQ.tJhi .AND. tJlo.EQ.0 ) THEN
11942f961e Jean*0221 c         IF ( exch2_isWedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0222 C-      South edge is touching the face W edge
                0223 c           tIlo1 = tIlo+1
                0224 c           tIlo2 = tIlo+1
                0225 c         ENDIF
11942f961e Jean*0226 c         IF ( exch2_isEedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0227 C-      South Edge is touching the face E edge
                0228 c           tIhi1 = tIhi
                0229 c           tIhi2 = tIhi-1
                0230 c         ENDIF
                0231 c       ENDIF
                0232         IF ( tJlo.EQ.tJhi .AND. tJlo.GT.1 ) THEN
11942f961e Jean*0233           IF ( exch2_isWedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0234 C-      North edge is touching the face W edge
                0235             tIlo1 = tIlo+1
                0236             tIlo2 = tIlo+1
                0237           ENDIF
11942f961e Jean*0238           IF ( exch2_isEedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0239 C-      North Edge is touching the face E edge
                0240             tIhi1 = tIhi
                0241             tIhi2 = tIhi-1
                0242           ENDIF
                0243         ENDIF
                0244 
b475142410 Jean*0245        ELSE
                0246 C---  adjust index lower and upper bounds (updateCorners = F case):
                0247         IF ( e2_pij(1).EQ.-1 .OR. e2_pij(3).EQ.-1 ) THEN
                0248           tIlo1 = tIlo1+1
                0249           tIhi1 = tIhi1+1
                0250         ENDIF
                0251         IF ( e2_pij(2).EQ.-1 .OR. e2_pij(4).EQ.-1 ) THEN
                0252           tJlo2 = tJlo2+1
                0253           tJhi2 = tJhi2+1
                0254         ENDIF
                0255        ENDIF
                0256 
10972e8712 Jean*0257 C---  UV C-Grid specific code: end
                0258 
                0259       ELSEIF ( fCode.NE.'Ag' ) THEN
                0260         STOP 'ABNORMAL END: S/R EXCH2_GET_UV_BOUNDS (wrong fCode)'
                0261       ENDIF
                0262 
                0263       RETURN
                0264       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!