Changeset 13333 for NEMO/trunk
- Timestamp:
- 2020-07-22T16:05:31+02:00 (4 years ago)
- Location:
- NEMO/trunk/src
- Files:
-
- 3 edited
-
OCE/TRA/traqsr.F90 (modified) (2 diffs)
-
TOP/PISCES/P4Z/p4zopt.F90 (modified) (18 diffs)
-
TOP/oce_trc.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/TRA/traqsr.F90
r13295 r13333 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 … … 417 417 IF( .NOT.lk_top ) CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' ) 418 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' 424 ! 419 425 END SELECT 420 426 ! -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zopt.F90
r13295 r13333 37 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw ! PAR fraction of shortwave 38 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr ! wavelength (Red-Green-Blue) 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 39 44 40 !! * Substitutions … … 94 90 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 95 91 ! 96 ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t(ji,jj,jk,Kmm)97 ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t(ji,jj,jk,Kmm)98 ekr(ji,jj,jk) = xkrgb(3,irgb) * e3t(ji,jj,jk,Kmm)92 ekb(ji,jj,jk) = rkrgb(1,irgb) * e3t(ji,jj,jk,Kmm) 93 ekg(ji,jj,jk) = rkrgb(2,irgb) * e3t(ji,jj,jk,Kmm) 94 ekr(ji,jj,jk) = rkrgb(3,irgb) * e3t(ji,jj,jk,Kmm) 99 95 END_3D 100 96 ! !* Photosynthetically Available Radiation (PAR) … … 106 102 CALL p4z_opt_par( kt, Kmm, 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, Kmm, 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, Kmm, 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(:,:,2,Kmm) 161 157 162 DO_3D( 1, 1, 1, 1, 2, nksr p)158 DO_3D( 1, 1, 1, 1, 2, nksr ) 163 159 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 164 160 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer … … 178 174 zetmp2 (:,:) = 0.e0 179 175 180 DO_3D( 1, 1, 1, 1, 1, nksr p)176 DO_3D( 1, 1, 1, 1, 1, nksr ) 181 177 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 182 178 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation … … 189 185 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 190 186 ! 191 DO_3D( 1, 1, 1, 1, 1, nksr p)187 DO_3D( 1, 1, 1, 1, 1, nksr ) 192 188 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 193 189 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 201 197 zetmp4 (:,:) = 0.e0 202 198 ! 203 DO_3D( 1, 1, 1, 1, 1, nksr p)199 DO_3D( 1, 1, 1, 1, 1, nksr ) 204 200 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 205 201 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production … … 211 207 ediatm(:,:,:) = ediat(:,:,:) 212 208 ! 213 DO_3D( 1, 1, 1, 1, 1, nksr p)209 DO_3D( 1, 1, 1, 1, 1, nksr ) 214 210 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 215 211 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 221 217 IF( ln_p5z ) THEN 222 218 ALLOCATE( zetmp5(jpi,jpj) ) ; zetmp5 (:,:) = 0.e0 223 DO_3D( 1, 1, 1, 1, 1, nksr p)219 DO_3D( 1, 1, 1, 1, 1, nksr ) 224 220 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 225 221 zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production … … 229 225 epicom(:,:,:) = epico(:,:,:) 230 226 ! 231 DO_3D( 1, 1, 1, 1, 1, nksr p)227 DO_3D( 1, 1, 1, 1, 1, nksr ) 232 228 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 233 229 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 283 279 pe3(:,:,1) = zqsr(:,:) 284 280 ! 285 DO jk = 2, nksr p+ 1281 DO jk = 2, nksr + 1 286 282 DO jj = 1, jpj 287 283 DO ji = 1, jpi … … 302 298 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 303 299 ! 304 DO_3D( 1, 1, 1, 1, 2, nksr p)300 DO_3D( 1, 1, 1, 1, 2, nksr ) 305 301 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 306 302 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) … … 400 396 ntimes_par = iom_getszuld( numpar ) ! get number of record in file 401 397 ENDIF 402 !403 CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients404 nksrp = trc_oce_ext_lev( r_si2, 0.33e2_wp ) ! max level of light extinction (Blue Chl=0.01)405 !406 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m'407 398 ! 408 399 ekr (:,:,:) = 0._wp -
NEMO/trunk/src/TOP/oce_trc.F90
r13286 r13333 85 85 USE traqsr , ONLY : rn_abs => rn_abs !: fraction absorbed in the very near surface 86 86 USE traqsr , ONLY : rn_si0 => rn_si0 !: very near surface depth of extinction 87 USE traqsr , ONLY : nksr => nksr !: levels below which the light cannot penetrate (depth larger than 391 m) 88 USE traqsr , ONLY : rkrgb => rkrgb !: tabulated attenuation coefficients for RGB absorption 87 89 USE traqsr , ONLY : ln_qsr_bio => ln_qsr_bio !: flag to use or not the biological fluxes for light 88 90 USE sbcrnf , ONLY : rnfmsk => rnfmsk !: mixed adv scheme in runoffs vicinity (hori.)
Note: See TracChangeset
for help on using the changeset viewer.
