Changeset 7646 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
- Timestamp:
- 2017-02-06T10:25:03+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r6962 r7646 9 9 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Improve light availability of nano & diat 10 10 !!---------------------------------------------------------------------- 11 #if defined key_pisces12 !!----------------------------------------------------------------------13 !! 'key_pisces' PISCES bio-model14 !!----------------------------------------------------------------------15 11 !! p4z_opt : light availability in the water column 16 12 !!---------------------------------------------------------------------- … … 41 37 INTEGER :: ntimes_par ! number of time steps in a file 42 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw !: PAR fraction of shortwave 43 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat !: PAR for phyto, nano and diat 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy !: PAR over 24h in case of diurnal cycle 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy !: averaged PAR in the mixed layer 47 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) 48 40 49 41 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) 50 42 51 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 52 44 53 45 !!---------------------------------------------------------------------- … … 75 67 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 76 68 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 69 REAL(wp), POINTER, DIMENSION(:,: ) :: zetmp5 77 70 REAL(wp), POINTER, DIMENSION(:,: ) :: zqsr100, zqsr_corr 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3, zchl3d 79 72 !!--------------------------------------------------------------------- 80 73 ! … … 82 75 ! 83 76 ! Allocate temporary workspace 84 CALL wrk_alloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 85 CALL wrk_alloc( jpi, jpj, zqsr100, zqsr_corr ) 86 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 ) 87 81 88 82 IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) … … 93 87 ze2(:,:,:) = 0._wp 94 88 ze3(:,:,:) = 0._wp 89 ! 95 90 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 96 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 97 96 DO jj = 1, jpj 98 97 DO ji = 1, jpi 99 zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e698 zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 100 99 zchl = MIN( 10. , MAX( 0.05, zchl ) ) 101 100 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) … … 120 119 ediat (:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 121 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 122 126 ! 123 127 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) … … 140 144 ediat(:,:,jk) = 1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 141 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 142 151 etot_ndcy(:,:,:) = etot(:,:,:) 143 152 ENDIF … … 155 164 ENDIF 156 165 ! !* Euphotic depth and level 157 neln(:,:) = 1 ! ------------------------ 158 heup(:,:) = 300. 166 neln (:,:) = 1 ! ------------------------ 167 heup (:,:) = gdepw_n(:,:,2) 168 heup_01(:,:) = gdepw_n(:,:,2) 159 169 160 170 DO jk = 2, nksrp … … 166 176 heup(ji,jj) = gdepw_n(ji,jj,jk+1) ! Euphotic layer depth 167 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 168 181 END DO 169 182 END DO 170 183 END DO 171 184 ! 172 heup(:,:) = MIN( 300., heup(:,:) ) 185 heup (:,:) = MIN( 300., heup (:,:) ) 186 heup_01(:,:) = MIN( 300., heup_01(:,:) ) 173 187 ! !* mean light over the mixed layer 174 188 zdepmoy(:,:) = 0.e0 ! ------------------------------- … … 209 223 END DO 210 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 211 239 IF( lk_iomput ) THEN 212 240 IF( knt == nrdttrc ) THEN … … 215 243 IF( iom_use( "PAR" ) ) CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 216 244 ENDIF 217 ELSE 218 IF( ln_diatrc ) THEN ! save output diagnostics 219 trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1) 220 trc3d(:,:,:,jp_pcs0_3d + 3) = etot(:,:,:) * tmask(:,:,:) 221 ENDIF 222 ENDIF 223 ! 224 CALL wrk_dealloc( jpi, jpj, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 225 CALL wrk_dealloc( jpi, jpj, zqsr100, zqsr_corr ) 226 CALL wrk_dealloc( jpi, jpj, jpk, zpar , ze0, ze1, ze2, ze3 ) 245 ENDIF 246 ! 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 ) 227 251 ! 228 252 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt') … … 407 431 enano (:,:,:) = 0._wp 408 432 ediat (:,:,:) = 0._wp 433 IF( ln_p5z ) epico (:,:,:) = 0._wp 409 434 IF( ln_qsr_bio ) etot3 (:,:,:) = 0._wp 410 435 ! … … 418 443 !! *** ROUTINE p4z_opt_alloc *** 419 444 !!---------------------------------------------------------------------- 420 ALLOCATE( ekb(jpi,jpj,jpk) , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk), &421 & enano(jpi,jpj,jpk) , ediat(jpi,jpj,jpk),&422 & etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc)423 445 ! 446 ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), & 447 ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc ) 448 ! 424 449 IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 425 450 ! 426 451 END FUNCTION p4z_opt_alloc 427 428 #else429 !!----------------------------------------------------------------------430 !! Dummy module : No PISCES bio-model431 !!----------------------------------------------------------------------432 CONTAINS433 SUBROUTINE p4z_opt ! Empty routine434 END SUBROUTINE p4z_opt435 #endif436 452 437 453 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
