- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/TOP/PISCES/P4Z/p4zopt.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/TOP/PISCES/P4Z/p4zopt.F90
r12377 r13540 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 45 41 # include "do_loop_substitute.h90" 42 # include "domzgr_substitute.h90" 46 43 !!---------------------------------------------------------------------- 47 44 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 88 85 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + tr(:,:,:,jppch,Kbb) 89 86 ! 90 DO_3D _11_11(1, jpkm1 )87 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 91 88 zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 92 89 zchl = MIN( 10. , MAX( 0.05, zchl ) ) 93 90 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 94 91 ! 95 ekb(ji,jj,jk) = xkrgb(1,irgb) * e3t(ji,jj,jk,Kmm)96 ekg(ji,jj,jk) = xkrgb(2,irgb) * e3t(ji,jj,jk,Kmm)97 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) 98 95 END_3D 99 96 ! !* Photosynthetically Available Radiation (PAR) … … 105 102 CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 106 103 ! 107 DO jk = 1, nksr p104 DO jk = 1, nksr 108 105 etot_ndcy(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 109 106 enano (:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) … … 111 108 END DO 112 109 IF( ln_p5z ) THEN 113 DO jk = 1, nksr p110 DO jk = 1, nksr 114 111 epico (:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 115 112 END DO … … 120 117 CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3 ) 121 118 ! 122 DO jk = 1, nksr p119 DO jk = 1, nksr 123 120 etot(:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 124 121 END DO … … 130 127 CALL p4z_opt_par( kt, Kmm, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 131 128 ! 132 DO jk = 1, nksr p129 DO jk = 1, nksr 133 130 etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 134 131 enano(:,:,jk) = 1.85 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.46 * ze3(:,:,jk) … … 136 133 END DO 137 134 IF( ln_p5z ) THEN 138 DO jk = 1, nksr p135 DO jk = 1, nksr 139 136 epico(:,:,jk) = 1.94 * ze1(:,:,jk) + 0.66 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 140 137 END DO … … 149 146 ! 150 147 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) 151 DO jk = 2, nksr p+ 1148 DO jk = 2, nksr + 1 152 149 etot3(:,:,jk) = ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 153 150 END DO … … 159 156 heup_01(:,:) = gdepw(:,:,2,Kmm) 160 157 161 DO_3D _11_11( 2, nksrp)158 DO_3D( 1, 1, 1, 1, 2, nksr ) 162 159 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 163 160 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer … … 177 174 zetmp2 (:,:) = 0.e0 178 175 179 DO_3D _11_11( 1, nksrp)176 DO_3D( 1, 1, 1, 1, 1, nksr ) 180 177 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 181 178 zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! remineralisation … … 188 185 zpar(:,:,:) = etot_ndcy(:,:,:) ! diagnostic : PAR with no diurnal cycle 189 186 ! 190 DO_3D _11_11( 1, nksrp)187 DO_3D( 1, 1, 1, 1, 1, nksr ) 191 188 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 192 189 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 200 197 zetmp4 (:,:) = 0.e0 201 198 ! 202 DO_3D _11_11( 1, nksrp)199 DO_3D( 1, 1, 1, 1, 1, nksr ) 203 200 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 204 201 zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano (ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production … … 210 207 ediatm(:,:,:) = ediat(:,:,:) 211 208 ! 212 DO_3D _11_11( 1, nksrp)209 DO_3D( 1, 1, 1, 1, 1, nksr ) 213 210 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 214 211 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 220 217 IF( ln_p5z ) THEN 221 218 ALLOCATE( zetmp5(jpi,jpj) ) ; zetmp5 (:,:) = 0.e0 222 DO_3D _11_11( 1, nksrp)219 DO_3D( 1, 1, 1, 1, 1, nksr ) 223 220 IF( gdepw(ji,jj,jk+1,Kmm) <= MIN(hmld(ji,jj), heup_01(ji,jj)) ) THEN 224 221 zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t(ji,jj,jk,Kmm) ! production … … 228 225 epicom(:,:,:) = epico(:,:,:) 229 226 ! 230 DO_3D _11_11( 1, nksrp)227 DO_3D( 1, 1, 1, 1, 1, nksr ) 231 228 IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN 232 229 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) … … 282 279 pe3(:,:,1) = zqsr(:,:) 283 280 ! 284 DO jk = 2, nksr p+ 1281 DO jk = 2, nksr + 1 285 282 DO jj = 1, jpj 286 283 DO ji = 1, jpi … … 301 298 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 302 299 ! 303 DO_3D _11_11( 2, nksrp)300 DO_3D( 1, 1, 1, 1, 2, nksr ) 304 301 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 305 302 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) … … 399 396 ntimes_par = iom_getszuld( numpar ) ! get number of record in file 400 397 ENDIF 401 !402 CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients403 nksrp = trc_oce_ext_lev( r_si2, 0.33e2 ) ! max level of light extinction (Blue Chl=0.01)404 !405 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m'406 398 ! 407 399 ekr (:,:,:) = 0._wp
Note: See TracChangeset
for help on using the changeset viewer.
