File indexing completed on 2024-03-02 06:10:37 UTC
view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 UTC
fc8c6425d2 Jean*0001 #include "GRDCHK_OPTIONS.h"
a7eff9e819 Jean*0002 #ifdef ALLOW_CTRL
0003 # include "CTRL_OPTIONS.h"
0004 #endif
2091ce7ee7 Patr*0005
b6a9ed93ee Jean*0006
0007
0008
2091ce7ee7 Patr*0009
b6a9ed93ee Jean*0010
0011 SUBROUTINE GRDCHK_LOC(
0012 I icomp,
0013 I ichknum,
0014 O icvrec,
0015 O itile,
0016 O jtile,
0017 O layer,
0018 O obcspos,
0019 O itilepos,
0020 O jtilepos,
0021 O icglom1,
0022 O itest,
0023 O ierr,
0024 I myThid )
2091ce7ee7 Patr*0025
b6a9ed93ee Jean*0026
0027
0028
0029
0030
0031
0032
0033
0034
2091ce7ee7 Patr*0035
b6a9ed93ee Jean*0036
0037 IMPLICIT NONE
0038
2091ce7ee7 Patr*0039 #include "EEPARAMS.h"
0040 #include "SIZE.h"
0041 #include "GRID.h"
5cf4364659 Mart*0042 #include "CTRL_SIZE.h"
4d72283393 Mart*0043 #include "CTRL.h"
444da61630 Mart*0044 #ifdef ALLOW_OBCS_CONTROL
0045
0046 # include "CTRL_OBCS.h"
0047 #endif
0048 #include "GRDCHK.h"
0f4da31a07 Patr*0049 #ifdef ALLOW_OBCS
fc8c6425d2 Jean*0050 # include "OBCS_GRID.h"
0f4da31a07 Patr*0051 #endif
e6556bc77a Mart*0052 #ifdef ALLOW_SHELFICE
0053 # include "SHELFICE.h"
0054 #endif /* ALLOW_SHELFICE */
2091ce7ee7 Patr*0055
b6a9ed93ee Jean*0056
0057 INTEGER icomp
0058 INTEGER ichknum
0059 INTEGER icvrec
0060 INTEGER jtile
0061 INTEGER itile
0062 INTEGER layer
0063 INTEGER obcspos
0064 INTEGER itilepos
0065 INTEGER jtilepos
0066 INTEGER itest
0067 INTEGER ierr
0068 INTEGER myThid
2091ce7ee7 Patr*0069
edd57506ae Patr*0070 #ifdef ALLOW_GRDCHK
5cf4364659 Mart*0071
0072 INTEGER ILNBLNK
0073 EXTERNAL ILNBLNK
0074
b6a9ed93ee Jean*0075
0076 INTEGER bi,bj
0077 INTEGER i,j,k
0078 INTEGER itmp,jtmp
0079 INTEGER iobcs
0080
0081 INTEGER iwrk, jwrk, kwrk
0082
0083 INTEGER irec, irecwrk
0084 INTEGER icglo, icglom1
0085 INTEGER icomptest
0086 INTEGER icomploc
0087 INTEGER nobcsmax
0088
2091ce7ee7 Patr*0089
b6a9ed93ee Jean*0090 _BEGIN_MASTER( myThid )
2091ce7ee7 Patr*0091
b6a9ed93ee Jean*0092
e4b263335d Patr*0093 ierr = -5
0094 icglom1 = 0
0095 icomploc= 0
2091ce7ee7 Patr*0096
c732bd258e Patr*0097
0098 print *, 'ph-test icomp, ncvarcomp, ichknum ',
0099 & icomp, ncvarcomp, ichknum
0100
b6a9ed93ee Jean*0101 IF ( icomp .GT. 0 ) THEN
0102 IF ( icomp .LE. ncvarcomp ) THEN
0103
0104 IF ( ichknum .EQ. 1 ) THEN
0105 itest = 0
0106 icomptest = 0
0107 irecwrk = 1
0108
0109
0110 kwrk = 1
0111
0112 jwrk = 1
0113 iwrk = 1
0114 icglo = 0
0115 ELSE
0116 itest = itestmem (ichknum-1)
0117 icomptest = icompmem (ichknum-1)
0118 irecwrk = irecmem (ichknum-1)
0119
0120
0121 kwrk = klocmem (ichknum-1)
0122
0123 icglo = icglomem (ichknum-1)
0124 jwrk = jlocmem (ichknum-1)
0125 iwrk = ilocmem (ichknum-1)
0126 iwrk = iwrk + 1
0127 ENDIF
2091ce7ee7 Patr*0128
b6a9ed93ee Jean*0129
0130 IF ( ncvargrd(grdchkvarindex) .EQ. 'm' ) THEN
444da61630 Mart*0131 #ifdef ALLOW_OBCS_CONTROL
0132 nobcsmax = nobcs
0133 #else
0134 print *, 'S/R grdchk_loc: Ooops!'
0135 #endif
b6a9ed93ee Jean*0136 ELSE
0137 nobcsmax = 1
0138 ENDIF
7109a141b2 Patr*0139
e4b263335d Patr*0140
ef53b829d7 Jean*0141
e4b263335d Patr*0142
0143
b6a9ed93ee Jean*0144
0145 DO irec = irecwrk, ncvarrecs(grdchkvarindex)
0146
31a64ac75a Patr*0147 iobcs = MOD((irec-1),nobcsmax) + 1
b6a9ed93ee Jean*0148
0149
0150 bj = jLocTile
0151 bi = iLocTile
0152
0153 DO k = kwrk, ncvarnrmax(grdchkvarindex)
e4b263335d Patr*0154 icglo = icglo + nwettile(bi,bj,k,iobcs)
0155 icglom1 = icglo - nwettile(bi,bj,k,iobcs)
0156
c732bd258e Patr*0157 print *, 'ph-grd _loc: bi, bj, icomptest, ichknum ',
0158 & bi, bj, icomptest, ichknum
ef53b829d7 Jean*0159
e4b263335d Patr*0160
0161
b6a9ed93ee Jean*0162 IF ( (ierr .NE. 0) .AND.
0163 & (icomp .GT. icglom1 .AND. icomp .LE. icglo) ) THEN
e4b263335d Patr*0164
b6a9ed93ee Jean*0165
0166
ef53b829d7 Jean*0167
b6a9ed93ee Jean*0168
0169
e4b263335d Patr*0170
0171
b6a9ed93ee Jean*0172 IF ( icomptest .EQ. 0 ) THEN
e4b263335d Patr*0173 icomptest = icglom1
b6a9ed93ee Jean*0174 ENDIF
e4b263335d Patr*0175 icomploc = icomp
31a64ac75a Patr*0176 icvrec = irec
2091ce7ee7 Patr*0177 itile = bi
0178 jtile = bj
e4b263335d Patr*0179
0180
0181
b6a9ed93ee Jean*0182 DO j = jwrk, ncvarymax(grdchkvarindex)
0183 DO i = iwrk, ncvarxmax(grdchkvarindex)
0184 IF (ierr .NE. 0) THEN
0185 IF ( ncvargrd(grdchkvarindex) .EQ. 'c' ) THEN
0186 IF ( maskC(i,j,k,bi,bj) .GT. 0.) THEN
2091ce7ee7 Patr*0187 icomptest = icomptest + 1
0f4da31a07 Patr*0188 itmp = i
0189 jtmp = j
b6a9ed93ee Jean*0190 ENDIF
0191 ELSEIF ( ncvargrd(grdchkvarindex) .EQ. 's' ) THEN
0192 IF ( _maskS(i,j,k,bi,bj) .GT. 0.) THEN
2091ce7ee7 Patr*0193 icomptest = icomptest + 1
0f4da31a07 Patr*0194 itmp = i
0195 jtmp = j
b6a9ed93ee Jean*0196 ENDIF
0197 ELSEIF ( ncvargrd(grdchkvarindex) .EQ. 'w' ) THEN
0198 IF ( _maskW(i,j,k,bi,bj) .GT. 0.) THEN
2091ce7ee7 Patr*0199 icomptest = icomptest + 1
0f4da31a07 Patr*0200 itmp = i
0201 jtmp = j
b6a9ed93ee Jean*0202 ENDIF
0203 #ifdef ALLOW_SHELFICE
0204 ELSEIF ( ncvargrd(grdchkvarindex) .EQ. 'i' ) THEN
0205 IF ( maskSHI(i,j,k,bi,bj) .GT. 0.) THEN
e6556bc77a Mart*0206 icomptest = icomptest + 1
0207 itmp = i
0208 jtmp = j
b6a9ed93ee Jean*0209 ENDIF
6b47d550f4 Mart*0210 #endif /* ALLOW_SHELFICE */
5cf4364659 Mart*0211 #ifdef ALLOW_OBCS_CONTROL
b6a9ed93ee Jean*0212 ELSEIF ( ncvargrd(grdchkvarindex) .EQ. 'm' ) THEN
5cf4364659 Mart*0213 IF ( ncvarfname(grdchkvarindex)
0214 & .EQ.xx_obcsn_file ) THEN
7109a141b2 Patr*0215 #ifdef ALLOW_OBCSN_CONTROL
b6a9ed93ee Jean*0216 IF ( grdchk_maskxz(i,k,bi,bj,iobcs) .GT. 0.
0217 & .AND. j.EQ. OB_Jn(i,bi,bj) ) THEN
7109a141b2 Patr*0218 icomptest = icomptest + 1
0f4da31a07 Patr*0219 itmp = i
b6a9ed93ee Jean*0220 jtmp = OB_Jn(i,bi,bj)
0221 ENDIF
7109a141b2 Patr*0222 #endif
5cf4364659 Mart*0223 ELSEIF ( ncvarfname(grdchkvarindex)
0224 & .EQ.xx_obcss_file ) THEN
7109a141b2 Patr*0225 #ifdef ALLOW_OBCSS_CONTROL
b6a9ed93ee Jean*0226 IF ( grdchk_maskxz(i,k,bi,bj,iobcs) .GT. 0.
0227 & .AND. j.EQ. OB_Js(i,bi,bj) ) THEN
7109a141b2 Patr*0228 icomptest = icomptest + 1
0f4da31a07 Patr*0229 itmp = i
b6a9ed93ee Jean*0230 jtmp = OB_Js(i,bi,bj)
0231 ENDIF
7109a141b2 Patr*0232 #endif
5cf4364659 Mart*0233 ELSEIF ( ncvarfname(grdchkvarindex)
0234 & .EQ.xx_obcse_file ) THEN
0235 #ifdef ALLOW_OBCSE_CONTROL
b6a9ed93ee Jean*0236 IF ( grdchk_maskyz(j,k,bi,bj,iobcs) .GT. 0.
5cf4364659 Mart*0237 & .AND. i.EQ. OB_Ie(j,bi,bj) ) THEN
7109a141b2 Patr*0238 icomptest = icomptest + 1
5cf4364659 Mart*0239 itmp = OB_Ie(j,bi,bj)
0f4da31a07 Patr*0240 jtmp = j
b6a9ed93ee Jean*0241 ENDIF
7109a141b2 Patr*0242 #endif
5cf4364659 Mart*0243 ELSEIF ( ncvarfname(grdchkvarindex)
0244 & .EQ.xx_obcsw_file ) THEN
0245 #ifdef ALLOW_OBCSW_CONTROL
b6a9ed93ee Jean*0246 IF ( grdchk_maskyz(j,k,bi,bj,iobcs) .GT. 0.
5cf4364659 Mart*0247 & .AND. i.EQ. OB_Iw(j,bi,bj) ) THEN
7109a141b2 Patr*0248 icomptest = icomptest + 1
5cf4364659 Mart*0249 itmp = OB_Iw(j,bi,bj)
0f4da31a07 Patr*0250 jtmp = j
b6a9ed93ee Jean*0251 ENDIF
7109a141b2 Patr*0252 #endif
b6a9ed93ee Jean*0253 ENDIF
5cf4364659 Mart*0254 #endif /* ALLOW_OBCS_CONTROL */
b6a9ed93ee Jean*0255 ENDIF
e4b263335d Patr*0256
0257
ef53b829d7 Jean*0258
e4b263335d Patr*0259
b6a9ed93ee Jean*0260 IF ( icomploc .EQ. icomptest ) THEN
0f4da31a07 Patr*0261 itilepos = itmp
0262 jtilepos = jtmp
2091ce7ee7 Patr*0263 layer = k
7109a141b2 Patr*0264 obcspos = iobcs
2091ce7ee7 Patr*0265 ierr = 0
c732bd258e Patr*0266
0f4da31a07 Patr*0267
0268 print *, 'ph-grd -->hit<-- ', itmp,jtmp,k,iobcs
0269 goto 1234
0270
b6a9ed93ee Jean*0271 ENDIF
0272 ENDIF
0273 ENDDO
2091ce7ee7 Patr*0274 iwrk = 1
b6a9ed93ee Jean*0275 ENDDO
2091ce7ee7 Patr*0276 jwrk = 1
b6a9ed93ee Jean*0277 ELSEIF (ierr .NE. 0) THEN
0278 IF (icomptest .EQ. icomp-1) THEN
0f4da31a07 Patr*0279 icomptest = icomptest
b6a9ed93ee Jean*0280 ELSE
0f4da31a07 Patr*0281 icomptest = icomptest + nwettile(bi,bj,k,iobcs)
b6a9ed93ee Jean*0282 ENDIF
e4b263335d Patr*0283
0284
0285
0286
b6a9ed93ee Jean*0287 iwrk = 1
0288 jwrk = 1
0289 ENDIF
0290
0291
0292 ENDDO
0293 kwrk = 1
0294
232d1fe37e Jean*0295
b6a9ed93ee Jean*0296
0297
0298
0299
0300
0301
0302
0303
0304 ENDDO
0305
0306 ELSE
0307
0308 IF ( icomp .GT. maxncvarcomps ) THEN
0309
0310 ierr = -4
0311 icvrec = -1
0312 jtile = -1
0313 itile = -1
0314 layer = -1
0315 obcspos = -1
0316 jtilepos = -1
0317 itilepos = -1
0318 ELSE
0319
0320 ierr = -3
0321 icvrec = -1
0322 jtile = -1
0323 itile = -1
0324 layer = -1
0325 obcspos = -1
0326 jtilepos = -1
0327 itilepos = -1
0328 ENDIF
0329
0330 ENDIF
0331 ELSE
0332
0333 IF ( icomp .LT. 0 ) THEN
0334
2091ce7ee7 Patr*0335 ierr = -2
0336 icvrec = -1
0337 jtile = -1
0338 itile = -1
0339 layer = -1
7109a141b2 Patr*0340 obcspos = -1
2091ce7ee7 Patr*0341 jtilepos = -1
0342 itilepos = -1
b6a9ed93ee Jean*0343 ELSE
0344
2091ce7ee7 Patr*0345 ierr = -1
0346 icvrec = -1
0347 jtile = -1
0348 itile = -1
0349 layer = -1
7109a141b2 Patr*0350 obcspos = -1
2091ce7ee7 Patr*0351 jtilepos = -1
0352 itilepos = -1
b6a9ed93ee Jean*0353 ENDIF
0354
0355 ENDIF
2091ce7ee7 Patr*0356
b6a9ed93ee Jean*0357 1234 CONTINUE
0f4da31a07 Patr*0358
b6a9ed93ee Jean*0359 _END_MASTER( myThid )
2091ce7ee7 Patr*0360
0361 _BARRIER
0362
edd57506ae Patr*0363 #endif /* ALLOW_GRDCHK */
2091ce7ee7 Patr*0364
b6a9ed93ee Jean*0365 RETURN
0366 END