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
0004
0005
0006
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
11942f961e Jean*0017
0018
0019
0020
10972e8712 Jean*0021
0022
0023 IMPLICIT NONE
0024
11942f961e Jean*0025 #include "SIZE.h"
0026 #include "W2_EXCH2_SIZE.h"
0027 #include "W2_EXCH2_TOPOLOGY.h"
10972e8712 Jean*0028
0029
11942f961e Jean*0030
0031
0032
0033
0034
0035
0036
0037
0038
0039
0040
0041
0042
0043
0044
0045
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
0058
11942f961e Jean*0059
0060
0061 INTEGER soTile
0062 INTEGER soNb
0063 INTEGER tIlo, tIhi, tJlo, tJhi
0064 INTEGER i, e2_pij(4)
10972e8712 Jean*0065
0066
0067
0068
0069
11942f961e Jean*0070
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
0084 IF ( tIlo.EQ.tIhi .AND. tIlo.EQ.0 ) THEN
11942f961e Jean*0085
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
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
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
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
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
0167
0168
0169
0170
0171
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
0179
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
0188 IF ( updateCorners ) THEN
0189
10972e8712 Jean*0190
0191
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
0196
11942f961e Jean*0197
10972e8712 Jean*0198
0199
0200
0201
11942f961e Jean*0202
10972e8712 Jean*0203
0204
0205
0206
0207
0208 IF ( tIlo.EQ.tIhi .AND. tIlo.GT.1 ) THEN
11942f961e Jean*0209 IF ( exch2_isSedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0210
0211 tJlo1 = tJlo+1
0212 tJlo2 = tJlo+1
0213 ENDIF
11942f961e Jean*0214 IF ( exch2_isNedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0215
0216 tJhi1 = tJhi-1
0217 tJhi2 = tJhi
0218 ENDIF
0219 ENDIF
0220
11942f961e Jean*0221
10972e8712 Jean*0222
0223
0224
0225
11942f961e Jean*0226
10972e8712 Jean*0227
0228
0229
0230
0231
0232 IF ( tJlo.EQ.tJhi .AND. tJlo.GT.1 ) THEN
11942f961e Jean*0233 IF ( exch2_isWedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0234
0235 tIlo1 = tIlo+1
0236 tIlo2 = tIlo+1
0237 ENDIF
11942f961e Jean*0238 IF ( exch2_isEedge(tgTile).EQ.1 ) THEN
10972e8712 Jean*0239
0240 tIhi1 = tIhi
0241 tIhi2 = tIhi-1
0242 ENDIF
0243 ENDIF
0244
b475142410 Jean*0245 ELSE
0246
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
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