Changeset 14362
- Timestamp:
- 2021-01-31T18:35:29+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12985_TOP-04_IMMERSE_BGC_interface
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12985_TOP-04_IMMERSE_BGC_interface/cfgs/SHARED/namelist_top_ref
r12377 r14362 100 100 / 101 101 !----------------------------------------------------------------------- 102 &namtrc_opt ! light availability in the water column 103 !----------------------------------------------------------------------- 104 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 105 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 106 sn_par = 'par.orca' , 24 , 'fr_par' , .true. , .true. , 'yearly' , '' , '' , '' 107 cn_dir = './' ! root directory for the location of the dynamical files 108 ln_varpar = .true. ! Read PAR from file 109 parlux = 0.43 ! Fraction of shortwave as PAR 110 light_loc = 'center' ! Light location in the water cell ('top', 'center', 'integral') 111 / 112 !----------------------------------------------------------------------- 102 113 &namtrc_dmp ! passive tracer newtonian damping (ln_trcdmp=T) 103 114 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12985_TOP-04_IMMERSE_BGC_interface/src/TOP/trcopt.F90
r13107 r14362 2 2 !!====================================================================== 3 3 !! *** MODULE trcopt *** 4 !! TOP : Compute the light availability in the water column4 !! TOP : Compute the light in the water column for RGB wavelengths 5 5 !!====================================================================== 6 6 !! History : 1.0 ! 2020 (T. Lovato) Initial code … … 12 12 USE iom ! I/O manager 13 13 USE fldread ! time interpolation 14 USE prtctl_trc ! print control for debugging15 14 16 15 IMPLICIT NONE 17 16 PRIVATE 18 17 19 PUBLIC trc_opt ! called in trcsms.F90 module20 PUBLIC trc_opt_ini t ! called in trcsms.F90 module18 PUBLIC trc_opt ! called in spefici BGC model routines 19 PUBLIC trc_opt_ini ! called in trcini.F90 21 20 PUBLIC trc_opt_alloc 22 21 … … 25 24 LOGICAL :: ln_varpar ! boolean for variable PAR fraction 26 25 REAL(wp) :: parlux ! Fraction of shortwave as PAR 26 CHARACTER (len=25) :: light_loc 27 27 28 28 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_par ! structure of input par … … 30 30 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw ! PAR fraction of shortwave 31 31 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr ! wavelength (Red-Green-Blue) 32 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xeps ! weighted diffusion coefficient 32 33 33 34 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) … … 38 39 !! * Substitutions 39 40 # include "do_loop_substitute.h90" 41 # include "domzgr_substitute.h90" 40 42 !!---------------------------------------------------------------------- 41 43 !! NEMO/TOP 4.0 , NEMO Consortium (2020) … … 49 51 !! *** ROUTINE trc_opt *** 50 52 !! 51 !! ** Purpose : 53 !! ** Purpose : Compute the light availability in the water column 52 54 !! depending on depth and chlorophyll concentration 53 55 !! … … 57 59 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 58 60 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: zchl ! chlorophyll field 59 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(out),OPTIONAL :: ze1, ze2, ze3 ! chlorophyll field61 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(out),OPTIONAL :: ze1, ze2, ze3 ! PAR for individual wavelength 60 62 ! 61 63 INTEGER :: ji, jj, jk, irgb … … 74 76 ze3(:,:,:) = 0._wp 75 77 76 ! PAR conve sion factor78 ! PAR conversion factor 77 79 ! -------------------- 78 80 IF( knt == 1 .AND. ln_varpar ) CALL trc_opt_sbc( kt ) … … 84 86 ! Attenuation coef. function of Chlorophyll and wavelength (RGB) 85 87 ! -------------------------------------------------------------- 86 DO_3D _11_11(1, jpkm1 )88 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 87 89 ztmp = ( zchl(ji,jj,jk) + rtrn ) * 1.e6 88 90 ztmp = MIN( 10. , MAX( 0.05, ztmp ) ) … … 106 108 ! 107 109 DO jk = 2, nksrp + 1 108 DO jj = 1, jpj 109 DO ji = 1, jpi 110 DO_2D(1, 1, 1, 1) 110 111 ze0(ji,jj,jk) = ze0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * (1. / rn_si0) ) 111 112 ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) ) 112 113 ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) ) 113 114 ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ) ) 114 END DO 115 END DO 115 END_2D 116 116 END DO 117 117 ! … … 132 132 etot (:,:,jk) = ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 133 133 ENDDO 134 ! 135 ! Diurnal cycle 134 135 ! weighted broadband diffuse attenuation coefficient 136 WHERE(etot .ne. 0.) & 137 xeps = ( ze1 * ekr + ze2 * ekb + ze3 * ekg ) / e3t(:,:,:,Kmm) / etot 138 ! Compute PAR at cell center (T-level) or integrate over cell depth 139 IF ( TRIM(light_loc) == 'center' ) THEN 140 IF(lwp) WRITE(numout,*) 'trcopt : center' 141 etot = etot * EXP( -xeps * 0.5 * e3t(:,:,:,Kmm)) 142 ELSE IF ( TRIM(light_loc) == 'integral' ) THEN 143 IF(lwp) WRITE(numout,*) 'trcopt : integral' 144 WHERE(etot == 0.) & 145 etot = etot / xeps * (1. - EXP(-xeps*e3t(:,:,:,Kmm))) 146 ENDIF 147 148 ! 149 ! No Diurnal cycle PAR 136 150 IF( l_trcdm2dc ) THEN 137 151 zqsr_corr(:,:) = parsw(:,:) * qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn ) … … 144 158 etot_ndcy(:,:,:) = etot(:,:,:) 145 159 ENDIF 146 160 147 161 ! Light at the euphotic depth 148 162 ! --------------------------- 149 zqsr100 = 0.01 * 3. * parsw(:,:) * qsr(:,:)163 zqsr100 = 0.01 * 3. * zqsr_corr(:,:) 150 164 151 165 ! Euphotic depth and level … … 155 169 heup_01(:,:) = gdepw(:,:,2,Kmm) 156 170 ! 157 DO_3D _11_11(2, nksrp )171 DO_3D( 1, 1, 1, 1, 2, nksrp ) 158 172 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 159 173 ! Euphotic level (1st T-level strictly below Euphotic layer) … … 174 188 ! 175 189 IF( lk_iomput ) THEN 190 CALL iom_put( "xeps" , xeps(:,:,:) * tmask(:,:,:) ) 176 191 CALL iom_put( "Heup" , heup(:,: ) * tmask(:,:,1) ) 177 192 ENDIF … … 187 202 !! 188 203 !! ** purpose : compute PAR of each wavelength (Red-Green-Blue) 189 !! for a given shortwave radiation 204 !! for a given shortwave radiation at w-level 190 205 !! 191 206 !!---------------------------------------------------------------------- … … 195 210 ! 196 211 INTEGER :: ji, jj, jk ! dummy loop indices 197 REAL(wp) :: xsi0r ! inverse of rn_si0 (traqsr.F90)198 212 !!---------------------------------------------------------------------- 199 213 pe1(:,:,:) = 0. ; pe2(:,:,:) = 0. ; pe3(:,:,:) = 0. … … 203 217 pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 204 218 ! 205 DO_3D _11_11(2, nksrp )219 DO_3D( 1, 1, 1, 1, 2, nksrp ) 206 220 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 207 221 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) … … 246 260 247 261 248 SUBROUTINE trc_opt_ini t249 !!---------------------------------------------------------------------- 250 !! *** ROUTINE trc_opt_ini t***262 SUBROUTINE trc_opt_ini 263 !!---------------------------------------------------------------------- 264 !! *** ROUTINE trc_opt_ini *** 251 265 !! 252 266 !! ** Purpose : Initialization of tabulated attenuation coefficients … … 260 274 TYPE(FLD_N) :: sn_par ! informations about the fields to be read 261 275 ! 262 NAMELIST/namtrc_opt/cn_dir, sn_par, ln_varpar, parlux 276 NAMELIST/namtrc_opt/cn_dir, sn_par, ln_varpar, parlux, light_loc 263 277 !!---------------------------------------------------------------------- 264 278 IF(lwp) THEN 265 279 WRITE(numout,*) 266 WRITE(numout,*) ' p4z_opt_init :'267 WRITE(numout,*) '~~~~~~~~~~~~ 280 WRITE(numout,*) 'trc_opt_ini : Initialize light module' 281 WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 268 282 ENDIF 269 283 READ ( numnat_ref, namtrc_opt, IOSTAT = ios, ERR = 901) … … 276 290 WRITE(numout,*) ' Namelist : namtrc_opt ' 277 291 WRITE(numout,*) ' PAR as a variable fraction of SW ln_varpar = ', ln_varpar 278 WRITE(numout,*) ' Default value for the PAR fraction parlux = ', parlux 292 WRITE(numout,*) ' Fraction of shortwave as PAR parlux = ', parlux 293 WRITE(numout,*) ' Light location in the water cell light_loc = ', light_loc 279 294 ENDIF 280 295 ! … … 287 302 ALLOCATE( par_varsw(jpi,jpj) ) 288 303 ! 289 ALLOCATE( sf_par(1), STAT=ierr ) !* allocate and fill sf_ sst (forcing structure) with sn_sst290 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'trc_opt_ini t: unable to allocate sf_par structure' )291 ! 292 CALL fld_fill( sf_par, (/ sn_par /), cn_dir, 'trc_opt_ini t', 'Variable PAR fraction ', 'nampisopt' )304 ALLOCATE( sf_par(1), STAT=ierr ) !* allocate and fill sf_par (forcing structure) with sn_par 305 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'trc_opt_ini: unable to allocate sf_par structure' ) 306 ! 307 CALL fld_fill( sf_par, (/ sn_par /), cn_dir, 'trc_opt_ini', 'Initialize prescribed PAR forcing ', 'namtrc_opt' ) 293 308 ALLOCATE( sf_par(1)%fnow(jpi,jpj,1) ) 294 309 IF( sn_par%ln_tint ) ALLOCATE( sf_par(1)%fdta(jpi,jpj,1,2) ) … … 310 325 IF( ln_qsr_bio ) etot3 (:,:,:) = 0._wp 311 326 ! 312 END SUBROUTINE trc_opt_ini t327 END SUBROUTINE trc_opt_ini 313 328 314 329 315 330 INTEGER FUNCTION trc_opt_alloc() 316 331 !!---------------------------------------------------------------------- 317 !! *** ROUTINE p4z_opt_alloc ***332 !! *** ROUTINE trc_opt_alloc *** 318 333 !!---------------------------------------------------------------------- 319 334 ! 320 335 ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), & 321 ekg(jpi,jpj,jpk), STAT= trc_opt_alloc )336 ekg(jpi,jpj,jpk), xeps(jpi,jpj,jpk), STAT= trc_opt_alloc ) 322 337 ! 323 338 IF( trc_opt_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_opt_alloc : failed to allocate arrays.' )
Note: See TracChangeset
for help on using the changeset viewer.