- Timestamp:
- 2016-11-01T14:23:51+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r7068 r7162 37 37 INTEGER :: ntimes_par ! number of time steps in a file 38 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw !: PAR fraction of shortwave 39 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat !: PAR for phyto, nano and diat 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy !: PAR over 24h in case of diurnal cycle 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy !: averaged PAR in the mixed layer 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr !: wavelength (Red-Green-Blue) 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr !: wavelength (Red-Green-Blue) 44 40 45 41 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) 46 42 47 REAL(wp), DIMENSION(3,61) , PUBLIC:: xkrgb !: tabulated attenuation coefficients for RGB absorption43 REAL(wp), DIMENSION(3,61) :: xkrgb !: tabulated attenuation coefficients for RGB absorption 48 44 49 45 !!---------------------------------------------------------------------- … … 71 67 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 72 68 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 69 REAL(wp), POINTER, DIMENSION(:,: ) :: zetmp5 73 70 REAL(wp), POINTER, DIMENSION(:,: ) :: zqsr100, zqsr_corr 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3, zchl3d 75 72 !!--------------------------------------------------------------------- 76 73 ! … … 78 75 ! 79 76 ! Allocate temporary workspace 80 CALL wrk_alloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 81 CALL wrk_alloc( jpi, jpj, zqsr100, zqsr_corr ) 82 CALL wrk_alloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3 ) 77 CALL wrk_alloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 78 CALL wrk_alloc( jpi, jpj, zqsr100, zqsr_corr ) 79 IF( ln_p5z ) CALL wrk_alloc( jpi, jpj, zetmp5 ) 80 CALL wrk_alloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3, zchl3d ) 83 81 84 82 IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) … … 89 87 ze2(:,:,:) = 0._wp 90 88 ze3(:,:,:) = 0._wp 89 ! 91 90 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 92 DO jk = 1, jpkm1 ! -------------------------------------------------------- 91 ! -------------------------------------------------------- 92 zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 93 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 94 ! 95 DO jk = 1, jpkm1 93 96 DO jj = 1, jpj 94 97 DO ji = 1, jpi 95 zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e698 zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 96 99 zchl = MIN( 10. , MAX( 0.05, zchl ) ) 97 100 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) … … 116 119 ediat (:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 117 120 END DO 121 IF( ln_p5z ) THEN 122 DO jk = 1, nksrp 123 epico (:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 124 END DO 125 ENDIF 118 126 ! 119 127 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) … … 136 144 ediat(:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 137 145 END DO 146 IF( ln_p5z ) THEN 147 DO jk = 1, nksrp 148 epico(:,:,jk) = 2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 149 END DO 150 ENDIF 138 151 etot_ndcy(:,:,:) = etot(:,:,:) 139 152 ENDIF … … 151 164 ENDIF 152 165 ! !* Euphotic depth and level 153 neln(:,:) = 1 ! ------------------------ 154 heup(:,:) = 300. 166 neln (:,:) = 1 ! ------------------------ 167 heup (:,:) = gdepw_n(:,:,2) 168 heup_01(:,:) = gdepw_n(:,:,2) 155 169 156 170 DO jk = 2, nksrp … … 162 176 heup(ji,jj) = gdepw_n(ji,jj,jk+1) ! Euphotic layer depth 163 177 ENDIF 178 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 ) THEN 179 heup_01(ji,jj) = gdepw_n(ji,jj,jk+1) ! Euphotic layer depth (light level definition) 180 ENDIF 164 181 END DO 165 182 END DO 166 183 END DO 167 184 ! 168 heup(:,:) = MIN( 300., heup(:,:) ) 185 heup (:,:) = MIN( 300., heup (:,:) ) 186 heup_01(:,:) = MIN( 300., heup_01(:,:) ) 169 187 ! !* mean light over the mixed layer 170 188 zdepmoy(:,:) = 0.e0 ! ------------------------------- … … 205 223 END DO 206 224 ! 225 IF( ln_p5z ) THEN 226 zetmp5 (:,:) = 0.e0 227 DO jk = 1, nksrp 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 231 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 232 zetmp5(ji,jj) = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 233 epico(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 234 ENDIF 235 END DO 236 END DO 237 END DO 238 ENDIF 207 239 IF( lk_iomput ) THEN 208 240 IF( knt == nrdttrc ) THEN … … 213 245 ENDIF 214 246 ! 215 CALL wrk_dealloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 216 CALL wrk_dealloc( jpi, jpj, zqsr100, zqsr_corr ) 217 CALL wrk_dealloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3 ) 247 CALL wrk_dealloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 248 CALL wrk_dealloc( jpi, jpj, zqsr100, zqsr_corr ) 249 IF( ln_p5z ) CALL wrk_dealloc( jpi, jpj, zetmp5 ) 250 CALL wrk_dealloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3, zchl3d ) 218 251 ! 219 252 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt') … … 398 431 enano (:,:,:) = 0._wp 399 432 ediat (:,:,:) = 0._wp 433 IF( ln_p5z ) epico (:,:,:) = 0._wp 400 434 IF( ln_qsr_bio ) etot3 (:,:,:) = 0._wp 401 435 ! … … 409 443 !! *** ROUTINE p4z_opt_alloc *** 410 444 !!---------------------------------------------------------------------- 411 ALLOCATE( ekb(jpi,jpj,jpk) , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk), &412 & enano(jpi,jpj,jpk) , ediat(jpi,jpj,jpk),&413 & etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc)414 445 ! 446 ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), & 447 ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc ) 448 ! 415 449 IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 416 450 !
Note: See TracChangeset
for help on using the changeset viewer.
