- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/TOP/PISCES/P4Z/p4zopt.F90
r13237 r13899 16 16 USE iom ! I/O manager 17 17 USE fldread ! time interpolation 18 USE prtctl _trc! print control for debugging18 USE prtctl ! print control for debugging 19 19 20 20 IMPLICIT NONE … … 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 … … 89 85 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + tr(:,:,:,jppch,Kbb) 90 86 ! 91 DO_3D _11_11(1, jpkm1 )87 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 92 88 zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 93 89 zchl = MIN( 10. , MAX( 0.05, zchl ) ) 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 _11_11( 2, nksrp)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 _11_11( 1, nksrp)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 _11_11( 1, nksrp)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 _11_11( 1, nksrp)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 _11_11( 1, nksrp)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 _11_11( 1, nksrp)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 _11_11( 1, nksrp)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 _11_11( 2, nksrp)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
Note: See TracChangeset
for help on using the changeset viewer.