Changeset 13331
- Timestamp:
- 2020-07-22T16:00:04+02:00 (5 years ago)
- Location:
- NEMO/releases/r4.0/r4.0-HEAD/src
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/releases/r4.0/r4.0-HEAD/src/OCE/TRA/traqsr.F90
r11536 r13331 63 63 REAL(wp) :: xsi1r ! inverse of rn_si1 64 64 ! 65 REAL(wp) , DIMENSION(3,61):: rkrgb ! tabulated attenuation coefficients for RGB absorption65 REAL(wp) , PUBLIC, DIMENSION(3,61) :: rkrgb ! tabulated attenuation coefficients for RGB absorption 66 66 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read) 67 67 … … 416 416 IF(lwp) WRITE(numout,*) ' ==>>> bio-model light penetration' 417 417 IF( .NOT.lk_top ) CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' ) 418 ! 419 CALL trc_oce_rgb( rkrgb ) ! tabulated attenuation coef. 420 ! 421 nksr = trc_oce_ext_lev( r_si2, 33._wp ) ! level of light extinction 422 ! 423 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m' 418 424 ! 419 425 END SELECT -
NEMO/releases/r4.0/r4.0-HEAD/src/TOP/PISCES/P4Z/p4zopt.F90
r12276 r13331 38 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr ! wavelength (Red-Green-Blue) 39 39 40 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m)41 42 REAL(wp), DIMENSION(3,61) :: xkrgb ! tabulated attenuation coefficients for RGB absorption43 44 40 !!---------------------------------------------------------------------- 45 41 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 92 88 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 93 89 ! 94 ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t_n(ji,jj,jk)95 ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t_n(ji,jj,jk)96 ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t_n(ji,jj,jk)90 ekb(ji,jj,jk) = rkrgb(1,irgb) * e3t_n(ji,jj,jk) 91 ekg(ji,jj,jk) = rkrgb(2,irgb) * e3t_n(ji,jj,jk) 92 ekr(ji,jj,jk) = rkrgb(3,irgb) * e3t_n(ji,jj,jk) 97 93 END DO 98 94 END DO … … 106 102 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 107 103 ! 108 DO jk = 1, nksr p104 DO jk = 1, nksr 109 105 etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 110 106 enano (:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) … … 112 108 END DO 113 109 IF( ln_p5z ) THEN 114 DO jk = 1, nksr p110 DO jk = 1, nksr 115 111 epico (:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 116 112 END DO … … 121 117 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) 122 118 ! 123 DO jk = 1, nksr p119 DO jk = 1, nksr 124 120 etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 125 121 END DO … … 131 127 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 132 128 ! 133 DO jk = 1, nksr p129 DO jk = 1, nksr 134 130 etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 135 131 enano(:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) … … 137 133 END DO 138 134 IF( ln_p5z ) THEN 139 DO jk = 1, nksr p135 DO jk = 1, nksr 140 136 epico(:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 141 137 END DO … … 150 146 ! 151 147 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) 152 DO jk = 2, nksr p+ 1148 DO jk = 2, nksr + 1 153 149 etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 154 150 END DO … … 160 156 heup_01(:,:) = gdepw_n(:,:,2) 161 157 162 DO jk = 2, nksr p158 DO jk = 2, nksr 163 159 DO jj = 1, jpj 164 160 DO ji = 1, jpi … … 182 178 zetmp2 (:,:) = 0.e0 183 179 184 DO jk = 1, nksr p180 DO jk = 1, nksr 185 181 DO jj = 1, jpj 186 182 DO ji = 1, jpi … … 197 193 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 198 194 ! 199 DO jk = 1, nksr p195 DO jk = 1, nksr 200 196 DO jj = 1, jpj 201 197 DO ji = 1, jpi … … 213 209 zetmp4 (:,:) = 0.e0 214 210 ! 215 DO jk = 1, nksr p211 DO jk = 1, nksr 216 212 DO jj = 1, jpj 217 213 DO ji = 1, jpi … … 227 223 ediatm(:,:,:) = ediat(:,:,:) 228 224 ! 229 DO jk = 1, nksr p225 DO jk = 1, nksr 230 226 DO jj = 1, jpj 231 227 DO ji = 1, jpi … … 241 237 IF( ln_p5z ) THEN 242 238 ALLOCATE( zetmp5(jpi,jpj) ) ; zetmp5 (:,:) = 0.e0 243 DO jk = 1, nksr p239 DO jk = 1, nksr 244 240 DO jj = 1, jpj 245 241 DO ji = 1, jpi … … 253 249 epicom(:,:,:) = epico(:,:,:) 254 250 ! 255 DO jk = 1, nksr p251 DO jk = 1, nksr 256 252 DO jj = 1, jpj 257 253 DO ji = 1, jpi … … 310 306 pe3(:,:,1) = zqsr(:,:) 311 307 ! 312 DO jk = 2, nksr p+ 1308 DO jk = 2, nksr + 1 313 309 DO jj = 1, jpj 314 310 DO ji = 1, jpi … … 329 325 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 330 326 ! 331 DO jk = 2, nksr p327 DO jk = 2, nksr 332 328 DO jj = 1, jpj 333 329 DO ji = 1, jpi … … 435 431 ntimes_par = iom_getszuld( numpar ) ! get number of record in file 436 432 ENDIF 437 !438 CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients439 nksrp = trc_oce_ext_lev( r_si2, 0.33e2 ) ! max level of light extinction (Blue Chl=0.01)440 !441 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m'442 433 ! 443 434 ekr (:,:,:) = 0._wp -
NEMO/releases/r4.0/r4.0-HEAD/src/TOP/oce_trc.F90
r10351 r13331 65 65 USE traqsr , ONLY : rn_abs => rn_abs !: fraction absorbed in the very near surface 66 66 USE traqsr , ONLY : rn_si0 => rn_si0 !: very near surface depth of extinction 67 USE traqsr , ONLY : nksr => nksr !: levels below which the light cannot penetrate (depth larger than 391 m) 68 USE traqsr , ONLY : rkrgb => rkrgb !: tabulated attenuation coefficients for RGB absorption 67 69 USE traqsr , ONLY : ln_qsr_bio => ln_qsr_bio !: flag to use or not the biological fluxes for light 68 70 USE sbcrnf , ONLY : rnfmsk => rnfmsk !: mixed adv scheme in runoffs vicinity (hori.)
Note: See TracChangeset
for help on using the changeset viewer.