File indexing completed on 2023-11-05 05:09:59 UTC
view on githubraw file Latest commit 65754df4 on 2023-11-04 17:55:24 UTC
1eadaea85b Jean*0001 #include "PACKAGES_CONFIG.h"
05b6d6742b Patr*0002 #include "CPP_OPTIONS.h"
517dbdc414 Jean*0003 #ifdef ALLOW_AUTODIFF
0004 # include "AUTODIFF_OPTIONS.h"
0005 #endif
aecc8b0f47 Mart*0006 #ifdef ALLOW_CTRL
0007 # include "CTRL_OPTIONS.h"
0008 #endif
05b6d6742b Patr*0009
169b2214c5 Jean*0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
05b6d6742b Patr*0021
0022
0023
0024 SUBROUTINE UPDATE_MASKS_ETC( myThid )
0025
0026
ab5a98a4ed Jean*0027
0028
0029
05b6d6742b Patr*0030
65e083f882 Jean*0031
0032
0033
0034
0035
05b6d6742b Patr*0036
0037
0038
0039
0040
0041
0042 IMPLICIT NONE
0043
0044 #include "SIZE.h"
0045 #include "EEPARAMS.h"
0046 #include "PARAMS.h"
0047 #include "GRID.h"
0048 #include "SURFACE.h"
0049
517dbdc414 Jean*0050 #ifdef ALLOW_AUTODIFF
65754df434 Mart*0051 # include "OPTIMCYCLE.h"
65e083f882 Jean*0052 #endif
05b6d6742b Patr*0053
0054
0055
0056
0057 INTEGER myThid
0058
0059 #ifdef ALLOW_DEPTH_CONTROL
169b2214c5 Jean*0060
0061 _RS SMOOTHMIN_RS
0062 EXTERNAL SMOOTHMIN_RS
0063
05b6d6742b Patr*0064
0065
ab5a98a4ed Jean*0066
05b6d6742b Patr*0067
ab5a98a4ed Jean*0068
05b6d6742b Patr*0069 INTEGER bi, bj
ab5a98a4ed Jean*0070 INTEGER I, J, K
0071 _RS tmpfld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
05b6d6742b Patr*0072 CHARACTER*(MAX_LEN_MBUF) suff
0073
0074 INTEGER Im1, Jm1
aecc8b0f47 Mart*0075 _RL hFacCtmp
0076
05b6d6742b Patr*0077 _RL hFacMnSz
0078
0079
0080
0081
0082
0083 DO bj=myByLo(myThid), myByHi(myThid)
0084 DO bi=myBxLo(myThid), myBxHi(myThid)
0085 DO K=1, Nr
0086 hFacMnSz=max( hFacMin, min(hFacMinDr*recip_drF(k),1. _d 0) )
169b2214c5 Jean*0087 DO J=1-OLy,sNy+OLy
0088 DO I=1-OLx,sNx+OLx
05b6d6742b Patr*0089
11c3150c71 Mart*0090 hFacCtmp = ( rF(K) - xx_r_low(I,J,bi,bj) )*recip_drF(K)
169b2214c5 Jean*0091
0092
05b6d6742b Patr*0093
0094
0095
0096
0097
169b2214c5 Jean*0098
05b6d6742b Patr*0099
169b2214c5 Jean*0100 IF ( hFacCtmp .LE. 0. _d 0 ) THEN
0101
05b6d6742b Patr*0102 hFacC(I,J,K,bi,bj) = 0. _d 0
169b2214c5 Jean*0103 ELSEIF ( hFacCtmp .GT. 1. _d 0 ) THEN
05b6d6742b Patr*0104 hFacC(I,J,K,bi,bj) = 1. _d 0
0105 ELSE
0106 hFacC(I,J,K,bi,bj) = hFacCtmp + hFacMnSz*(
0107 & EXP(-hFacCtmp/hFacMnSz)-EXP(-1./hFacMnSz) )
0108 ENDIF
0109
0110
0111
0112
0113
0114
0115
0116
0117
0118
0119
0120
0121
0122
0123
0124 ENDDO
0125 ENDDO
0126 ENDDO
0127
0128 ENDDO
0129 ENDDO
169b2214c5 Jean*0130
12c8b75709 Jean*0131
169b2214c5 Jean*0132
05b6d6742b Patr*0133
0134 DO bj=myByLo(myThid), myByHi(myThid)
0135 DO bi=myBxLo(myThid), myBxHi(myThid)
169b2214c5 Jean*0136 DO J=1-OLy,sNy+OLy
0137 DO I=1-OLx,sNx+OLx
bbebcf4c4e Mart*0138 R_low(i,j,bi,bj) = rF(1)
0139 ENDDO
0140 ENDDO
0141 DO K=Nr,1,-1
169b2214c5 Jean*0142 DO J=1-OLy,sNy+OLy
0143 DO I=1-OLx,sNx+OLx
05b6d6742b Patr*0144 R_low(I,J,bi,bj) = R_low(I,J,bi,bj)
bbebcf4c4e Mart*0145 & - drF(K)*hFacC(I,J,K,bi,bj)
05b6d6742b Patr*0146 ENDDO
0147 ENDDO
0148 ENDDO
0149
0150 ENDDO
0151 ENDDO
0152
0153
0154
0155
169b2214c5 Jean*0156
0157
05b6d6742b Patr*0158
0159
0160
0161
0162
0163
0164
0165
0166
0167
0168
522c728681 Jean*0169 IF ( plotLevel.GE.debLevC ) THEN
65e083f882 Jean*0170 _BARRIER
0171 CALL PLOT_FIELD_XYRS( R_low,
0172 & 'Model R_low (update_masks_etc)', 1, myThid )
0173
0174
05b6d6742b Patr*0175
65e083f882 Jean*0176
0177
0178 ENDIF
05b6d6742b Patr*0179
0180
0181 DO bj = myByLo(myThid), myByHi(myThid)
0182 DO bi = myBxLo(myThid), myBxHi(myThid)
169b2214c5 Jean*0183 DO j=1-OLy,sNy+OLy
0184 DO i=1-OLx,sNx+OLx
05b6d6742b Patr*0185
0186 tmpfld(i,j,bi,bj) = Ro_surf(i,j,bi,bj) - R_low(i,j,bi,bj)
0187
0188 IF ( tmpfld(i,j,bi,bj) .LE. 0. ) THEN
0189 recip_Rcol(i,j,bi,bj) = 0.
0190 ELSE
ab5a98a4ed Jean*0191 recip_Rcol(i,j,bi,bj) = 1. _d 0 / tmpfld(i,j,bi,bj)
05b6d6742b Patr*0192 ENDIF
0193 ENDDO
0194 ENDDO
0195 ENDDO
0196 ENDDO
12c8b75709 Jean*0197
05b6d6742b Patr*0198
0199
0200
0201
0202
0203
0204
65e083f882 Jean*0205
05b6d6742b Patr*0206
0207 DO bj=myByLo(myThid), myByHi(myThid)
0208 DO bi=myBxLo(myThid), myBxHi(myThid)
0209 DO K=1, Nr
169b2214c5 Jean*0210 DO J=1-OLy,sNy+OLy
0211 DO I=1-OLx,sNx+OLx
05b6d6742b Patr*0212 Im1=MAX(I-1,1-OLx)
0213 Jm1=MAX(J-1,1-OLy)
0214 IF (DYG(I,J,bi,bj).EQ.0.) THEN
0215
0216
0217
0218 hFacW(I,J,K,bi,bj)=0.
0219 ELSE
0220 hFacW(I,J,K,bi,bj)=maskW(I,J,K,bi,bj)*
0221 #ifdef USE_SMOOTH_MIN
169b2214c5 Jean*0222 & SMOOTHMIN_RS(hFacC(I,J,K,bi,bj),hFacC(Im1,J,K,bi,bj))
05b6d6742b Patr*0223 #else
0224 & MIN(hFacC(I,J,K,bi,bj),hFacC(Im1,J,K,bi,bj))
0225 #endif /* USE_SMOOTH_MIN */
0226 ENDIF
0227 IF (DXG(I,J,bi,bj).EQ.0.) THEN
0228 hFacS(I,J,K,bi,bj)=0.
0229 ELSE
0230 hFacS(I,J,K,bi,bj)=maskS(I,J,K,bi,bj)*
0231 #ifdef USE_SMOOTH_MIN
169b2214c5 Jean*0232 & SMOOTHMIN_RS(hFacC(I,J,K,bi,bj),hFacC(I,Jm1,K,bi,bj))
ab5a98a4ed Jean*0233 #else
05b6d6742b Patr*0234 & MIN(hFacC(I,J,K,bi,bj),hFacC(I,Jm1,K,bi,bj))
0235 #endif /* USE_SMOOTH_MIN */
ab5a98a4ed Jean*0236 ENDIF
05b6d6742b Patr*0237 ENDDO
0238 ENDDO
0239 ENDDO
0240 ENDDO
0241 ENDDO
11c3150c71 Mart*0242 #if ( defined ALLOW_AUTODIFF && defined ALLOW_AUTODIFF_MONITOR )
169b2214c5 Jean*0243
0244
0245
0246
05b6d6742b Patr*0247
0248
0249 #endif
0250 CALL EXCH_UV_XYZ_RS(hFacW,hFacS,.FALSE.,myThid)
11c3150c71 Mart*0251 #if ( defined ALLOW_AUTODIFF && defined ALLOW_AUTODIFF_MONITOR )
169b2214c5 Jean*0252
0253
0254
0255
05b6d6742b Patr*0256
0257
0258 #endif
0259
0260
0261 WRITE(suff,'(I10.10)') optimcycle
0262 CALL WRITE_FLD_XY_RS( 'Depth.',suff,tmpfld,optimcycle,myThid)
0263 CALL WRITE_FLD_XYZ_RS( 'hFacC.',suff,hFacC,optimcycle,myThid)
0264 CALL WRITE_FLD_XYZ_RS( 'hFacW.',suff,hFacW,optimcycle,myThid)
0265 CALL WRITE_FLD_XYZ_RS( 'hFacS.',suff,hFacS,optimcycle,myThid)
0266
522c728681 Jean*0267 IF ( plotLevel.GE.debLevC ) THEN
65e083f882 Jean*0268 _BARRIER
05b6d6742b Patr*0269
65e083f882 Jean*0270 CALL PLOT_FIELD_XYZRS( hFacC,'hFacC (update_masks_etc)',
0271 & Nr, 1, myThid )
0272 CALL PLOT_FIELD_XYZRS( hFacW,'hFacW (update_masks_etc)',
0273 & Nr, 1, myThid )
0274 CALL PLOT_FIELD_XYZRS( hFacS,'hFacS (update_masks_etc)',
0275 & Nr, 1, myThid )
0276 ENDIF
05b6d6742b Patr*0277
0278
0279
0280
65e083f882 Jean*0281
05b6d6742b Patr*0282
ff02675122 Jean*0283
05b6d6742b Patr*0284
0285 DO bj = myByLo(myThid), myByHi(myThid)
0286 DO bi = myBxLo(myThid), myBxHi(myThid)
0287 DO K=1,Nr
169b2214c5 Jean*0288 DO J=1-OLy,sNy+OLy
0289 DO I=1-OLx,sNx+OLx
05b6d6742b Patr*0290 IF (hFacC(I,J,K,bi,bj) .NE. 0. ) THEN
0291
ab5a98a4ed Jean*0292 recip_hFacC(I,J,K,bi,bj) = 1. _d 0 / hFacC(I,J,K,bi,bj)
05b6d6742b Patr*0293
0294 ELSE
0295 recip_hFacC(I,J,K,bi,bj) = 0.
0296
0297 ENDIF
0298 IF (hFacW(I,J,K,bi,bj) .NE. 0. ) THEN
0299
ab5a98a4ed Jean*0300 recip_hFacW(I,J,K,bi,bj) = 1. _d 0 / hFacw(I,J,K,bi,bj)
05b6d6742b Patr*0301
0302 ELSE
0303 recip_hFacW(I,J,K,bi,bj) = 0.
0304
0305 ENDIF
0306 IF (hFacS(I,J,K,bi,bj) .NE. 0. ) THEN
0307
ab5a98a4ed Jean*0308 recip_hFacS(I,J,K,bi,bj) = 1. _d 0 / hFacS(I,J,K,bi,bj)
05b6d6742b Patr*0309
0310 ELSE
0311 recip_hFacS(I,J,K,bi,bj) = 0.
0312
0313 ENDIF
0314 ENDDO
0315 ENDDO
0316 ENDDO
0317
0318
0319
12c8b75709 Jean*0320
0321
0322
0323
0324
0325
05b6d6742b Patr*0326
0327
0328
169b2214c5 Jean*0329 #ifdef NONLIN_FRSURF
0330
0331
0332
0333 DO k=1,Nr
0334 DO j=1-OLy,sNy+OLy
0335 DO i=1-OLx,sNx+OLx
0336 h0FacC(i,j,k,bi,bj) = _hFacC(i,j,k,bi,bj)
0337 h0FacW(i,j,k,bi,bj) = _hFacW(i,j,k,bi,bj)
0338 h0FacS(i,j,k,bi,bj) = _hFacS(i,j,k,bi,bj)
05b6d6742b Patr*0339 ENDDO
0340 ENDDO
0341 ENDDO
169b2214c5 Jean*0342 #endif /* NONLIN_FRSURF */
05b6d6742b Patr*0343
0344 ENDDO
0345 ENDDO
ab5a98a4ed Jean*0346
05b6d6742b Patr*0347 #endif /* ALLOW_DEPTH_CONTROL */
0348 RETURN
0349 END
0350
0351 #ifdef USE_SMOOTH_MIN
169b2214c5 Jean*0352
0353
0354 _RS FUNCTION SMOOTHMIN_RS( a, b )
05b6d6742b Patr*0355
169b2214c5 Jean*0356 IMPLICIT NONE
05b6d6742b Patr*0357
0358 _RS a, b
0359
169b2214c5 Jean*0360 _RS SMOOTHABS_RS
0361 EXTERNAL SMOOTHABS_RS
05b6d6742b Patr*0362
0363
169b2214c5 Jean*0364 SMOOTHMIN_RS = .5*( a+b - SMOOTHABS_RS(a-b) )
05b6d6742b Patr*0365
0366
169b2214c5 Jean*0367 RETURN
0368 END
05b6d6742b Patr*0369
169b2214c5 Jean*0370 _RL FUNCTION SMOOTHMIN_RL( a, b )
05b6d6742b Patr*0371
169b2214c5 Jean*0372 IMPLICIT NONE
05b6d6742b Patr*0373
0374 _RL a, b
0375
169b2214c5 Jean*0376 _RL SMOOTHABS_RL
0377 EXTERNAL SMOOTHABS_RL
05b6d6742b Patr*0378
0379
169b2214c5 Jean*0380 SMOOTHMIN_RL = .5*( a+b - SMOOTHABS_RL(a-b) )
05b6d6742b Patr*0381
0382
169b2214c5 Jean*0383 RETURN
0384 END
05b6d6742b Patr*0385
169b2214c5 Jean*0386 _RS FUNCTION SMOOTHABS_RS( x )
ab5a98a4ed Jean*0387
169b2214c5 Jean*0388 IMPLICIT NONE
05b6d6742b Patr*0389
0390 #include "SIZE.h"
0391 #include "EEPARAMS.h"
0392 #include "PARAMS.h"
0393
0394 _RS x
0395
0396 _RS sf, rsf
0397
169b2214c5 Jean*0398 IF ( smoothAbsFuncRange .LT. 0.0 ) THEN
05b6d6742b Patr*0399
169b2214c5 Jean*0400 SMOOTHABS_RS = 0.
0401 ELSE
0402 IF ( smoothAbsFuncRange .NE. 0.0 ) THEN
05b6d6742b Patr*0403 sf = 10.0/smoothAbsFuncRange
0404 rsf = 1./sf
169b2214c5 Jean*0405 ELSE
05b6d6742b Patr*0406
0407 sf = 0.
0408 rsf = 0.
169b2214c5 Jean*0409 ENDIF
05b6d6742b Patr*0410
169b2214c5 Jean*0411 IF ( x .GT. smoothAbsFuncRange ) THEN
0412 SMOOTHABS_RS = x
0413 ELSEIF ( x .LT. -smoothAbsFuncRange ) THEN
0414 SMOOTHABS_RS = -x
0415 ELSE
0416 SMOOTHABS_RS = log(.5*(exp(x*sf)+exp(-x*sf)))*rsf
0417 ENDIF
0418 ENDIF
05b6d6742b Patr*0419
169b2214c5 Jean*0420 RETURN
0421 END
05b6d6742b Patr*0422
169b2214c5 Jean*0423 _RL FUNCTION SMOOTHABS_RL( x )
ab5a98a4ed Jean*0424
169b2214c5 Jean*0425 IMPLICIT NONE
05b6d6742b Patr*0426
0427 #include "SIZE.h"
0428 #include "EEPARAMS.h"
0429 #include "PARAMS.h"
0430
0431 _RL x
0432
0433 _RL sf, rsf
0434
169b2214c5 Jean*0435 IF ( smoothAbsFuncRange .LT. 0.0 ) THEN
05b6d6742b Patr*0436
169b2214c5 Jean*0437 SMOOTHABS_RL = 0.
0438 ELSE
0439 IF ( smoothAbsFuncRange .NE. 0.0 ) THEN
05b6d6742b Patr*0440 sf = 10.0D0/smoothAbsFuncRange
0441 rsf = 1.D0/sf
169b2214c5 Jean*0442 ELSE
05b6d6742b Patr*0443
0444 sf = 0.D0
0445 rsf = 0.D0
169b2214c5 Jean*0446 ENDIF
ab5a98a4ed Jean*0447
169b2214c5 Jean*0448 IF ( x .GE. smoothAbsFuncRange ) THEN
0449 SMOOTHABS_RL = x
0450 ELSEIF ( x .LE. -smoothAbsFuncRange ) THEN
0451 SMOOTHABS_RL = -x
0452 ELSE
0453 SMOOTHABS_RL = log(.5*(exp(x*sf)+exp(-x*sf)))*rsf
0454 ENDIF
0455 ENDIF
0456
0457 RETURN
0458 END
05b6d6742b Patr*0459 #endif /* USE_SMOOTH_MIN */
0460
0461
0462
0463
0464
0465
0466
0467
0468
169b2214c5 Jean*0469
05b6d6742b Patr*0470
0471
ab5a98a4ed Jean*0472
169b2214c5 Jean*0473
05b6d6742b Patr*0474
169b2214c5 Jean*0475
05b6d6742b Patr*0476
169b2214c5 Jean*0477
0478
05b6d6742b Patr*0479
169b2214c5 Jean*0480
05b6d6742b Patr*0481
0482
ab5a98a4ed Jean*0483
169b2214c5 Jean*0484
0485
05b6d6742b Patr*0486
0487 #ifdef ALLOW_DEPTH_CONTROL
0488
65e083f882 Jean*0489
0490
05b6d6742b Patr*0491
0492
0493
0494
0495
0496 #endif /* ALLOW_DEPTH_CONTROL */