File indexing completed on 2024-07-04 05:10:17 UTC
view on githubraw file Latest commit e37161e0 on 2024-07-03 22:04:10 UTC
c0d1c06c15 Matt*0001 #include "BLING_OPTIONS.h"
a284455135 Matt*0002 #ifdef ALLOW_AUTODIFF
0003 # include "AUTODIFF_OPTIONS.h"
0004 #endif
c0d1c06c15 Matt*0005
0006
4dea327916 aver*0007
0008
0009
a284455135 Matt*0010 SUBROUTINE BLING_LIGHT(
e0f9a7ba0b Matt*0011 I mld,
0012 U irr_inst, irr_eff,
0013 I bi, bj, imin, imax, jmin, jmax,
0014 I myTime, myIter, myThid)
0015
4dea327916 aver*0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027
0028
0029
0030
0031
0032
0033
0034
0035
e0f9a7ba0b Matt*0036 IMPLICIT NONE
0037
c0d1c06c15 Matt*0038
0039 #include "SIZE.h"
e0f9a7ba0b Matt*0040 #include "DYNVARS.h"
c0d1c06c15 Matt*0041 #include "EEPARAMS.h"
0042 #include "PARAMS.h"
0043 #include "GRID.h"
0044 #include "BLING_VARS.h"
e0f9a7ba0b Matt*0045 #ifdef USE_QSW
0046 #include "FFIELDS.h"
0047 #endif
a284455135 Matt*0048 #ifdef ALLOW_AUTODIFF_TAMC
c0d1c06c15 Matt*0049 # include "tamc.h"
0050 #endif
0051
4dea327916 aver*0052
c0d1c06c15 Matt*0053
0054
0055
0056
0057
0058
0059 INTEGER bi, bj, imin, imax, jmin, jmax
0060 INTEGER myThid
0061 INTEGER myIter
0062 _RL myTime
0063 _RL mld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
4dea327916 aver*0064
0065
e37161e05a Jean*0066
0067
c0d1c06c15 Matt*0068 _RL irr_inst (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
0069 _RL irr_eff (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
0070
4dea327916 aver*0071
e37161e05a Jean*0072 INTEGER i,j,k
0073 LOGICAL QSW_underice
0074 #ifdef ALLOW_CAL
0075 INTEGER mydate(4)
0076 #endif
0077 _RL localTime
0078 _RL utcTime, diffutc
0079 _RL sat_atten
0080 _RL sat_atten_sum(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0081 _RL chl_sat_sum (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
c0d1c06c15 Matt*0082 _RL atten
0083 _RL irr_surf (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
e0f9a7ba0b Matt*0084 #ifdef ML_MEAN_LIGHT
c0d1c06c15 Matt*0085 _RL irr_mix (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
4dea327916 aver*0086 _RL SumMLIrr (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0087 _RL tmp_ML (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
c0d1c06c15 Matt*0088 #endif
0089 #ifndef USE_QSW
9f5240b52a Jean*0090 _RL solar, albedo
0091 _RL dayfrac, yday, delta
0092 _RL lat, sun1, dayhrs
0093 _RL cosz, frac, fluxi
c0d1c06c15 Matt*0094 _RL sfac (1-OLy:sNy+OLy)
0095 #endif
00fa2d4ddd mmaz*0096 #ifdef PHYTO_SELF_SHADING
0097 _RL k0_rd, chi_rd, e_rd
0098 _RL k0_bg, chi_bg, e_bg
a284455135 Matt*0099 _RL kChl_rd (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
0100 _RL kChl_bg (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
00fa2d4ddd mmaz*0101 _RL atten_rd
0102 _RL atten_bg
a284455135 Matt*0103 _RL irr_rd (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
0104 _RL irr_bg (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
4dea327916 aver*0105 #endif /* PHYTO_SELF_SHADING */
4e4ad91a39 Jean*0106 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0107
4dea327916 aver*0108
0109 INTEGER tkey, kkey
00fa2d4ddd mmaz*0110 #endif
c0d1c06c15 Matt*0111
0112
4dea327916 aver*0113
0114
0115
0116 QSW_underice = .FALSE.
0117 #ifdef USE_QSW
0118 IF ( useSEAICE ) QSW_underice = .TRUE.
0119 IF ( useThSIce ) QSW_underice = .TRUE.
0120 #endif
a284455135 Matt*0121
e37161e05a Jean*0122 DO j=1-OLy,sNy+OLy
0123 DO i=1-OLx,sNx+OLx
0124 chl_sat_sum(i,j) = 0. _d 0
0125 sat_atten_sum(i,j) = 0. _d 0
0126 #ifdef ML_MEAN_LIGHT
0127 SumMLIrr(i,j) = 0. _d 0
0128 tmp_ML(i,j) = 0. _d 0
0129 #endif
0130 ENDDO
0131 ENDDO
4dea327916 aver*0132 DO k=1,Nr
e37161e05a Jean*0133 DO j=1-OLy,sNy+OLy
0134 DO i=1-OLx,sNx+OLx
4dea327916 aver*0135 irr_eff(i,j,k) = 0. _d 0
a284455135 Matt*0136 #ifdef PHYTO_SELF_SHADING
4dea327916 aver*0137 irr_rd(i,j,k) = 0. _d 0
0138 irr_bg(i,j,k) = 0. _d 0
a284455135 Matt*0139 #endif
c0d1c06c15 Matt*0140 ENDDO
0141 ENDDO
4dea327916 aver*0142 ENDDO
e37161e05a Jean*0143
4dea327916 aver*0144 #ifdef PHYTO_SELF_SHADING
0145
0146
0147 k0_rd = 0.225 _d 0
0148 k0_bg = 0.0232 _d 0
0149 chi_rd = 0.037 _d 0
0150 chi_bg = 0.074 _d 0
0151 e_rd = 0.629 _d 0
0152 e_bg = 0.674 _d 0
0153 #endif
c0d1c06c15 Matt*0154
0155
0156
0157
e0f9a7ba0b Matt*0158 #ifndef USE_QSW
c0d1c06c15 Matt*0159
0160
0161
0162
0163 solar = 1360. _d 0
0164 albedo = 0.6 _d 0
0165
0166
0167 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
0168 STOP 'ABNORMAL END: S/R INSOL: 2-D output not implemented'
0169 ENDIF
0170
0171
4dea327916 aver*0172
0173 dayfrac=mod(myTime,360. _d 0*86400. _d 0)
0174 & /(360. _d 0*86400. _d 0)
0175
0176 yday = 2. _d 0*PI*dayfrac
0177
0178 delta = (0.006918 _d 0
0179 & -(0.399912 _d 0*cos(yday))
0180 & +(0.070257 _d 0*sin(yday))
0181 & -(0.006758 _d 0*cos(2. _d 0*yday))
0182 & +(0.000907 _d 0*sin(2. _d 0*yday))
0183 & -(0.002697 _d 0*cos(3. _d 0*yday))
0184 & +(0.001480 _d 0*sin(3. _d 0*yday)) )
0185 DO j=1-OLy,sNy+OLy
c0d1c06c15 Matt*0186
4dea327916 aver*0187 lat=YC(1,j,1,bj)*deg2rad
c0d1c06c15 Matt*0188
0189
4dea327916 aver*0190 IF ( usingCartesianGrid .OR. usingCylindricalGrid )
0191 & lat = asin( fCori(1,j,1,bj)/(2. _d 0*omega) )
0192 sun1 = -sin(delta)/cos(delta) * sin(lat)/cos(lat)
0193 IF (sun1.LE.-0.999 _d 0) sun1=-0.999 _d 0
0194 IF (sun1.GE. 0.999 _d 0) sun1= 0.999 _d 0
0195 dayhrs = abs(acos(sun1))
0196
0197 cosz = ( sin(delta)*sin(lat)
0198 & +(cos(delta)*cos(lat)*sin(dayhrs)/dayhrs) )
0199 IF (cosz.LE.5. _d -3) cosz= 5. _d -3
0200
0201 frac = dayhrs/PI
c0d1c06c15 Matt*0202
4dea327916 aver*0203 fluxi = solar*(1. _d 0-albedo)*cosz*frac*parfrac
c0d1c06c15 Matt*0204
0205
4dea327916 aver*0206 sfac(j) = MAX(1. _d -5,fluxi)
0207 ENDDO
9f5240b52a Jean*0208 #endif /* ndef USE_QSW */
c0d1c06c15 Matt*0209
82e538d851 aver*0210
0211 utcTime = MOD( myTime/3600. _d 0, 24. _d 0 )
0212 #ifdef ALLOW_CAL
0213
0214 IF ( useCAL ) THEN
4dea327916 aver*0215 CALL CAL_GETDATE( myIter, myTime, mydate, myThid )
0216 i = mydate(2)/10000
0217 j = mydate(2)/100
0218 j = MOD(j,100)
0219 k = MOD(mydate(2),100)
0220 utcTime = i + j/60. _d 0 + k/3600. _d 0
82e538d851 aver*0221 ENDIF
0222 #endif
0223
c0d1c06c15 Matt*0224
0225
0226
e37161e05a Jean*0227 DO j=jmin,jmax
0228 DO i=imin,imax
0229
0230 #ifdef USE_QSW
0231 irr_surf(i,j) = MAX( epsln,
0232 & -parfrac*Qsw(i,j,bi,bj)*maskC(i,j,1,bi,bj))
0233 #else
0234 irr_surf(i,j) = sfac(j)
0235 #endif
0236
0237 IF ( .NOT. QSW_underice ) THEN
0238 irr_surf(i,j) = irr_surf(i,j)*(1. _d 0 - FIce(i,j,bi,bj))
0239 ENDIF
0240 ENDDO
0241 ENDDO
0242
4dea327916 aver*0243 #ifdef ALLOW_AUTODIFF_TAMC
0244 tkey = bi + (bj - 1)*nSx + (ikey_dynamics - 1)*nSx*nSy
0245 #endif /* ALLOW_AUTODIFF_TAMC */
0246
0247 DO k=1,Nr
0248
0249 #ifdef ALLOW_AUTODIFF_TAMC
0250 kkey = k + (tkey-1)*Nr
0251 # ifdef ML_MEAN_LIGHT
0252
0253 # endif /* ML_MEAN_LIGHT */
0254 #endif
0255
0256
0257 IF ( k.EQ.1) THEN
0258
0259 DO j=jmin,jmax
0260 DO i=imin,imax
0261
0262 IF ( maskC(i,j,k,bi,bj).EQ.oneRS ) THEN
e0f9a7ba0b Matt*0263
00fa2d4ddd mmaz*0264 #ifdef PHYTO_SELF_SHADING
0265
6ffd1aa797 Jean*0266
00fa2d4ddd mmaz*0267
6ffd1aa797 Jean*0268
00fa2d4ddd mmaz*0269
0270
0271
4dea327916 aver*0272 #ifdef ALLOW_AUTODIFF
0273 IF ( chl(i,j,1,bi,bj) .GT. 0. _d 0 ) THEN
0274 #endif
0275 kChl_rd(i,j,1) = k0_rd + chi_rd*(chl(i,j,1,bi,bj)**e_rd)
0276 kChl_bg(i,j,1) = k0_bg + chi_bg*(chl(i,j,1,bi,bj)**e_bg)
0277 #ifdef ALLOW_AUTODIFF
0278 ELSE
0279 kChl_rd(i,j,1) = k0_rd
0280 kChl_bg(i,j,1) = k0_bg
0281 ENDIF
0282 #endif
00fa2d4ddd mmaz*0283
4dea327916 aver*0284 atten_rd = kChl_rd(i,j,1)*drF(1)/2. _d 0*hFacC(i,j,1,bi,bj)
0285 atten_bg = kChl_bg(i,j,1)*drF(1)/2. _d 0*hFacC(i,j,1,bi,bj)
00fa2d4ddd mmaz*0286
4dea327916 aver*0287 irr_rd(i,j,1) = irr_surf(i,j) * exp(-atten_rd) * 0.5 _d 0
0288 irr_bg(i,j,1) = irr_surf(i,j) * exp(-atten_bg) * 0.5 _d 0
0289 irr_inst(i,j,1) = irr_rd(i,j,1) + irr_bg(i,j,1)
e37161e05a Jean*0290 #else /* PHYTO_SELF_SHADING */
4dea327916 aver*0291
0292
0293 atten = k0*drF(1)/2. _d 0*hFacC(i,j,1,bi,bj)
0294 irr_inst(i,j,1) = irr_surf(i,j)*exp(-atten)
0295
e37161e05a Jean*0296 #endif /* PHYTO_SELF_SHADING */
4dea327916 aver*0297
0298 ENDIF
0299 ENDDO
0300 ENDDO
e37161e05a Jean*0301
4dea327916 aver*0302
0303 ELSE
0304
0305 #ifdef ALLOW_AUTODIFF_TAMC
0306 # ifdef PHYTO_SELF_SHADING
0307
0308
0309 # endif
0310 #endif
0311
0312 DO j=jmin,jmax
0313 DO i=imin,imax
0314
0315 IF ( maskC(i,j,k,bi,bj).EQ.oneRS ) THEN
00fa2d4ddd mmaz*0316
4dea327916 aver*0317 #ifdef PHYTO_SELF_SHADING
00fa2d4ddd mmaz*0318
4dea327916 aver*0319 #ifdef ALLOW_AUTODIFF
0320 IF ( chl(i,j,k,bi,bj) .GT. 0. _d 0 ) THEN
0321 #endif
0322 kChl_rd(i,j,k) = k0_rd + chi_rd*(chl(i,j,k,bi,bj)**e_rd)
0323 kChl_bg(i,j,k) = k0_bg + chi_bg*(chl(i,j,k,bi,bj)**e_bg)
0324 #ifdef ALLOW_AUTODIFF
0325 ELSE
0326 kChl_rd(i,j,k) = k0_rd
0327 kChl_bg(i,j,k) = k0_bg
0328 ENDIF
0329 #endif
00fa2d4ddd mmaz*0330
4dea327916 aver*0331 atten_rd = kChl_rd(i,j,k)*drF(k)/2. _d 0*hFacC(i,j,k,bi,bj)
0332 & + kChl_rd(i,j,k-1)*drF(k-1)/2. _d 0*hFacC(i,j,k-1,bi,bj)
0333 atten_bg = kChl_bg(i,j,k)*drF(k)/2. _d 0*hFacC(i,j,k,bi,bj)
0334 & + kChl_bg(i,j,k-1)*drF(k-1)/2. _d 0*hFacC(i,j,k-1,bi,bj)
00fa2d4ddd mmaz*0335
4dea327916 aver*0336 irr_rd(i,j,k) = irr_rd(i,j,k-1)*exp(-atten_rd)
0337 irr_bg(i,j,k) = irr_bg(i,j,k-1)*exp(-atten_bg)
0338 irr_inst(i,j,k) = irr_rd(i,j,k) + irr_bg(i,j,k)
00fa2d4ddd mmaz*0339
e37161e05a Jean*0340 #else /* PHYTO_SELF_SHADING */
e0f9a7ba0b Matt*0341
c0d1c06c15 Matt*0342
4dea327916 aver*0343 atten = k0*drF(k)/2. _d 0*hFacC(i,j,k,bi,bj)
c0d1c06c15 Matt*0344 & + k0*drF(k-1)/2. _d 0*hFacC(i,j,k-1,bi,bj)
e37161e05a Jean*0345 irr_inst(i,j,k) = irr_inst(i,j,k-1)*exp(-atten)
4dea327916 aver*0346
e37161e05a Jean*0347 #endif /* PHYTO_SELF_SHADING */
4dea327916 aver*0348
0349 ENDIF
0350 ENDDO
0351 ENDDO
c0d1c06c15 Matt*0352
e37161e05a Jean*0353 ENDIF /* if k=1 then, else */
e0f9a7ba0b Matt*0354
82e538d851 aver*0355
4dea327916 aver*0356 DO j=jmin,jmax
0357 DO i=imin,imax
0358 IF ( maskC(i,j,k,bi,bj).EQ.oneRS ) THEN
0359
e37161e05a Jean*0360 IF ( irr_surf(i,j).GT.zeroRL ) THEN
82e538d851 aver*0361
4dea327916 aver*0362 #ifdef PHYTO_SELF_SHADING
e37161e05a Jean*0363 sat_atten = exp(-2. _d 0 * k0_bg * (-rC(k)))
82e538d851 aver*0364 #else
e37161e05a Jean*0365 sat_atten = exp(-2. _d 0 * k0 * (-rC(k)))
82e538d851 aver*0366 #endif
4dea327916 aver*0367 chl_sat_sum(i,j) = chl_sat_sum(i,j)
82e538d851 aver*0368 & + chl(i,j,k,bi,bj)*sat_atten
4dea327916 aver*0369 sat_atten_sum(i,j) = sat_atten_sum(i,j) + sat_atten
0370 ENDIF
82e538d851 aver*0371
c0d1c06c15 Matt*0372 #ifdef ML_MEAN_LIGHT
0373
e37161e05a Jean*0374 IF ( (-rF(k+1).LE. mld(i,j)) .AND.
0375 & (-rF(k+1).LT.MLmix_max) ) THEN
4dea327916 aver*0376 SumMLIrr(i,j) = SumMLIrr(i,j)+drF(k)*irr_inst(i,j,k)
0377 tmp_ML(i,j) = tmp_ML(i,j) + drF(k)
0378 irr_mix(i,j) = SumMLIrr(i,j)/tmp_ML(i,j)
0379 ENDIF
c0d1c06c15 Matt*0380 #endif
0381
e37161e05a Jean*0382 ENDIF
0383 ENDDO
0384 ENDDO
0385
0386
0387 ENDDO
0388
0389
82e538d851 aver*0390
e37161e05a Jean*0391 DO j=jmin,jmax
0392 DO i=imin,imax
0393 IF ( usingSphericalPolarGrid .OR. usingCurvilinearGrid ) THEN
0394
0395 diffutc = XC(i,j,bi,bj)/15. _d 0
0396 ELSE
0397
0398 diffutc = 0. _d 0
0399 ENDIF
0400 localTime = utcTime + diffutc + 24. _d 0
0401 localTime = MOD( localTime, 24. _d 0 )
0402 IF ( localTime.GT.chlsat_locTimWindow(1) .AND.
0403 & localTime.LT.chlsat_locTimWindow(2) ) THEN
0404 chl_sat(i,j,bi,bj) = chl_sat_sum(i,j)
0405 & / (sat_atten_sum(i,j) + epsln)
0406 ENDIF
0407 ENDDO
0408 ENDDO
c0d1c06c15 Matt*0409
e37161e05a Jean*0410 DO k=1,Nr
0411 DO j=jmin,jmax
0412 DO i=imin,imax
0413 IF ( maskC(i,j,k,bi,bj).EQ.oneRS ) THEN
e0f9a7ba0b Matt*0414
e37161e05a Jean*0415 irr_eff(i,j,k) = irr_inst(i,j,k)
c0d1c06c15 Matt*0416 #ifdef ML_MEAN_LIGHT
e0f9a7ba0b Matt*0417
e37161e05a Jean*0418 IF ( (-rF(k+1).LE. mld(i,j)) .AND.
0419 & (-rF(k+1).LT.MLmix_max) ) THEN
c0d1c06c15 Matt*0420 irr_eff(i,j,k) = irr_mix(i,j)
0421 ENDIF
e0f9a7ba0b Matt*0422 #endif
c0d1c06c15 Matt*0423
0424 ENDIF
0425 ENDDO
0426 ENDDO
0427 ENDDO
e0f9a7ba0b Matt*0428
82e538d851 aver*0429 #ifdef ALLOW_DIAGNOSTICS
0430 IF ( useDiagnostics ) THEN
4dea327916 aver*0431 CALL DIAGNOSTICS_FILL(chl_sat,'BLGCHLSA',0,1,1,bi,bj,myThid)
82e538d851 aver*0432 ENDIF
0433 #endif /* ALLOW_DIAGNOSTICS */
0434
c0d1c06c15 Matt*0435 RETURN
0436 END