- Timestamp:
- 2017-12-26T17:32:56+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r9125 r9169 4 4 !! TOP - PISCES : Compute the light availability in the water column 5 5 !!====================================================================== 6 !! History : 7 !! 8 !! 9 !! 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.2 ! 2009-04 (C. Ethe, G. Madec) optimisation 9 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Improve light availability of nano & diat 10 10 !!---------------------------------------------------------------------- 11 11 !! p4z_opt : light availability in the water column … … 15 15 USE sms_pisces ! Source Minus Sink of PISCES 16 16 USE iom ! I/O manager 17 USE fldread 18 USE prtctl_trc 17 USE fldread ! time interpolation 18 USE prtctl_trc ! print control for debugging 19 19 20 20 IMPLICIT NONE … … 27 27 !! * Shared module variables 28 28 29 LOGICAL :: ln_varpar !:boolean for variable PAR fraction30 REAL(wp) :: parlux !:Fraction of shortwave as PAR31 REAL(wp) :: xparsw !:parlux/332 REAL(wp) :: xsi0r !:1. /rn_si029 LOGICAL :: ln_varpar ! boolean for variable PAR fraction 30 REAL(wp) :: parlux ! Fraction of shortwave as PAR 31 REAL(wp) :: xparsw ! parlux/3 32 REAL(wp) :: xsi0r ! 1. /rn_si0 33 33 34 34 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_par ! structure of input par 35 35 INTEGER , PARAMETER :: nbtimes = 366 !: maximum number of times record in a file 36 36 INTEGER :: ntimes_par ! number of time steps in a file 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw !:PAR fraction of shortwave38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr !:wavelength (Red-Green-Blue)37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: par_varsw ! PAR fraction of shortwave 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr ! wavelength (Red-Green-Blue) 39 39 40 40 INTEGER :: nksrp ! levels below which the light cannot penetrate ( depth larger than 391 m) 41 41 42 REAL(wp), DIMENSION(3,61) :: xkrgb ! :tabulated attenuation coefficients for RGB absorption42 REAL(wp), DIMENSION(3,61) :: xkrgb ! tabulated attenuation coefficients for RGB absorption 43 43 44 44 !!---------------------------------------------------------------------- … … 70 70 !!--------------------------------------------------------------------- 71 71 ! 72 IF( ln_timing ) CALL timing_start('p4z_opt') 73 ! 74 ! Allocate temporary workspace 75 IF( ln_p5z ) ALLOCATE( zetmp5(jpi,jpj) ) 76 77 IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) 72 IF( ln_timing ) CALL timing_start('p4z_opt') 73 IF( ln_p5z ) ALLOCATE( zetmp5(jpi,jpj) ) 74 75 IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) 78 76 79 77 ! Initialisation of variables used to compute PAR … … 84 82 ! 85 83 ! !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 86 87 zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch)88 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:)+ trb(:,:,:,jppch)84 ! ! -------------------------------------------------------- 85 zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 86 IF( ln_p5z ) zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 89 87 ! 90 88 DO jk = 1, jpkm1 … … 105 103 IF( l_trcdm2dc ) THEN ! diurnal cycle 106 104 ! 107 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. -fr_i(:,:) + rtrn )105 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1.-fr_i(:,:) + rtrn ) 108 106 ! 109 107 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) … … 120 118 ENDIF 121 119 ! 122 zqsr_corr(:,:) = qsr(:,:) / ( 1. -fr_i(:,:) + rtrn )120 zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 123 121 ! 124 122 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 ) … … 130 128 ELSE 131 129 ! 132 zqsr_corr(:,:) = qsr(:,:) / ( 1. -fr_i(:,:) + rtrn )130 zqsr_corr(:,:) = qsr(:,:) / ( 1.-fr_i(:,:) + rtrn ) 133 131 ! 134 132 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) … … 240 238 ENDIF 241 239 ! 242 IF( ln_p5z ) DEALLOCATE( zetmp5 ) 243 ! 244 IF( ln_timing ) CALL timing_stop('p4z_opt') 240 IF( ln_p5z ) DEALLOCATE( zetmp5 ) 241 IF( ln_timing ) CALL timing_stop('p4z_opt') 245 242 ! 246 243 END SUBROUTINE p4z_opt … … 255 252 !! 256 253 !!---------------------------------------------------------------------- 257 !! * arguments 258 INTEGER, INTENT(in) :: kt ! ocean time-step 259 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: pqsr ! shortwave 260 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 261 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 262 REAL(wp), DIMENSION(jpi,jpj) , INTENT(out) , OPTIONAL :: pqsr100 263 !! * local variables 254 INTEGER , INTENT(in) :: kt ! ocean time-step 255 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pqsr ! shortwave 256 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 257 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 ! 258 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out), OPTIONAL :: pqsr100 ! 259 ! 264 260 INTEGER :: ji, jj, jk ! dummy loop indices 265 REAL(wp), DIMENSION(jpi,jpj) :: zqsr !shortwave261 REAL(wp), DIMENSION(jpi,jpj) :: zqsr ! shortwave 266 262 !!---------------------------------------------------------------------- 267 263 … … 272 268 273 269 ! Light at the euphotic depth 274 IF( PRESENT( pqsr100 ) ) pqsr100(:,:) = 0.01 * 3. * zqsr(:,:)270 IF( PRESENT( pqsr100 ) ) pqsr100(:,:) = 0.01 * 3. * zqsr(:,:) 275 271 276 272 IF( PRESENT( pe0 ) ) THEN ! W-level … … 285 281 DO ji = 1, jpi 286 282 pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t_n(ji,jj,jk-1) * xsi0r ) 287 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ))288 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ))289 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ))283 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb (ji,jj,jk-1 ) ) 284 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg (ji,jj,jk-1 ) ) 285 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr (ji,jj,jk-1 ) ) 290 286 END DO 291 287 ! … … 327 323 !! 328 324 !!---------------------------------------------------------------------- 329 INTEGER , INTENT(in) :: kt! ocean time step325 INTEGER, INTENT(in) :: kt ! ocean time step 330 326 ! 331 327 INTEGER :: ji,jj … … 357 353 !! ** Input : external ascii and netcdf files 358 354 !!---------------------------------------------------------------------- 359 INTEGER :: numpar 360 INTEGER :: ierr 361 INTEGER :: ios ! Local integer output status for namelist read 362 REAL(wp), DIMENSION(nbtimes) :: zsteps ! times records 355 INTEGER :: numpar, ierr, ios ! Local integer 356 REAL(wp), DIMENSION(nbtimes) :: zsteps ! times records 363 357 ! 364 358 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files … … 367 361 NAMELIST/nampisopt/cn_dir, sn_par, ln_varpar, parlux 368 362 !!---------------------------------------------------------------------- 369 363 IF(lwp) THEN 364 WRITE(numout,*) 365 WRITE(numout,*) 'p4z_opt_init : ' 366 WRITE(numout,*) '~~~~~~~~~~~~ ' 367 ENDIF 370 368 REWIND( numnatp_ref ) ! Namelist nampisopt in reference namelist : Pisces attenuation coef. and PAR 371 369 READ ( numnatp_ref, nampisopt, IOSTAT = ios, ERR = 901) 372 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in reference namelist', lwp ) 373 370 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisopt in reference namelist', lwp ) 374 371 REWIND( numnatp_cfg ) ! Namelist nampisopt in configuration namelist : Pisces attenuation coef. and PAR 375 372 READ ( numnatp_cfg, nampisopt, IOSTAT = ios, ERR = 902 ) 376 902 IF( ios /= 0 )CALL ctl_nam ( ios , 'nampisopt in configuration namelist', lwp )373 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisopt in configuration namelist', lwp ) 377 374 IF(lwm) WRITE ( numonp, nampisopt ) 378 375 379 376 IF(lwp) THEN 380 WRITE(numout,*) ' ' 381 WRITE(numout,*) ' namelist : nampisopt ' 382 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' 383 WRITE(numout,*) ' PAR as a variable fraction of SW ln_varpar = ', ln_varpar 384 WRITE(numout,*) ' Default value for the PAR fraction parlux = ', parlux 377 WRITE(numout,*) ' Namelist : nampisopt ' 378 WRITE(numout,*) ' PAR as a variable fraction of SW ln_varpar = ', ln_varpar 379 WRITE(numout,*) ' Default value for the PAR fraction parlux = ', parlux 385 380 ENDIF 386 381 ! … … 391 386 ! ---------------------------------------- 392 387 IF( ln_varpar ) THEN 393 IF(lwp) WRITE(numout,*) ' initialize variable par fraction '394 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'388 IF(lwp) WRITE(numout,*) 389 IF(lwp) WRITE(numout,*) ' ==>>> initialize variable par fraction (ln_varpar=T)' 395 390 ! 396 391 ALLOCATE( par_varsw(jpi,jpj) )
Note: See TracChangeset
for help on using the changeset viewer.
