MODULE p4zopt !!====================================================================== !! *** MODULE p4zopt *** !! TOP : PISCES Compute the light availability in the water column !!====================================================================== !! History : 1.0 ! 2004 (O. Aumont) Original code !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 !!---------------------------------------------------------------------- #if defined key_pisces !!---------------------------------------------------------------------- !! 'key_pisces' PISCES bio-model !!---------------------------------------------------------------------- !! p4z_opt : Compute the light availability in the water column !!---------------------------------------------------------------------- USE trc USE oce_trc ! USE trp_trc USE sms IMPLICIT NONE PRIVATE PUBLIC p4z_opt ! called in p4zprg.F90 !! * Shared module variables REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: etot, enano, ediat, & !: PAR for phyto, nano and diat emoy !: averaged PAR in the mixed layer REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: heup !: Depth of the euphotic zone !! * Module variables REAL(wp), DIMENSION(3,61) :: & !: xkrgb !: ??? !!* Substitution # include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) !! $Header:$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE p4z_opt(kt, jnt) !!--------------------------------------------------------------------- !! *** ROUTINE p4z_opt *** !! !! ** Purpose : Compute the light availability in the water column !! depending on the depth and the chlorophyll concentration !! !! ** Method : - ??? !!--------------------------------------------------------------------- INTEGER, INTENT(in) :: kt, jnt ! ocean time step INTEGER :: ji, jj, jk INTEGER :: irgb REAL(wp) :: zchl, zparlux REAL(wp) :: zrlight , zblight , zglight REAL(wp), DIMENSION(jpi,jpj) :: zdepmoy, zetmp REAL(wp), DIMENSION(jpi,jpj,jpk) :: zekg, zekr, zekb REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze1 , ze2 , ze3 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3lum, ze4lum REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze5lum, ze6lum !!--------------------------------------------------------------------- IF( ( kt * jnt ) == nittrc000 ) CALL p4z_opt_init ! Initialization (first time-step only) ! Initialisation of variables used to compute PAR ! ----------------------------------------------- ze1 (:,:,:) = 0.e0 ze2 (:,:,:) = 0.e0 ze3 (:,:,:) = 0.e0 etot(:,:,:) = 0.e0 zparlux = 0.43 / 3. ! IF activated, computation of the qsr for the dynamics ! ----------------------------------------------------- IF( ln_qsr_sms ) THEN ze3lum(:,:,:) = 0.e0 ze4lum(:,:,:) = 0.e0 ze5lum(:,:,:) = 0.e0 ze6lum(:,:,:) = 0.e0 ENDIF DO jk = 1, jpkm1 DO jj = 1, jpj DO ji = 1, jpi ! Separation in three light bands: red, green, blue ! ------------------------------------------------- zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 zchl = MAX( 0.03, zchl ) zchl = MIN( 10. , zchl ) irgb = INT( 41 + 20.* LOG10( zchl ) + rtrn ) zekb(ji,jj,jk) = xkrgb(1,irgb) zekg(ji,jj,jk) = xkrgb(2,irgb) zekr(ji,jj,jk) = xkrgb(3,irgb) END DO END DO END DO !CDIR NOVERRCHK DO jj = 1,jpj !CDIR NOVERRCHK DO ji = 1,jpi ! Separation in three light bands: red, green, blue ! ------------------------------------------------- zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1) zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1) zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1) ze1(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zblight) ze2(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zglight) ze3(ji,jj,1) = zparlux * qsr(ji,jj) * EXP(-zrlight) END DO END DO !CDIR NOVERRCHK DO jk = 2, jpkm1 !CDIR NOVERRCHK DO jj = 1, jpj !CDIR NOVERRCHK DO ji = 1, jpi ! Separation in three light bands: red, green, blue ! ------------------------------------------------- zblight = 0.5 * ( zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1) & & + zekb(ji,jj,jk ) * fse3t(ji,jj,jk ) ) zglight = 0.5 * ( zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1) & & + zekg(ji,jj,jk ) * fse3t(ji,jj,jk ) ) zrlight = 0.5 * ( zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1) & & + zekr(ji,jj,jk ) * fse3t(ji,jj,jk ) ) ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP(-zblight) ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP(-zglight) ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP(-zrlight) END DO END DO END DO etot(:,:,:) = ze1(:,:,:) + ze2(:,:,:) + ze3(:,:,:) enano(:,:,:) = 2.1 * ze1(:,:,:) + 0.42 * ze2(:,:,:) + 0.4 * ze3(:,:,:) ediat(:,:,:) = 1.6 * ze1(:,:,:) + 0.69 * ze2(:,:,:) + 0.7 * ze3(:,:,:) IF( ln_qsr_sms ) THEN ! In the following, the vertical attenuation of qsr for the dynamics is computed ! ------------------------------------------------------------------------------ !CDIR NOVERRCHK DO jj = 1, jpj !CDIR NOVERRCHK DO ji = 1, jpi ! Separation in three light bands: red, green, blue ! ------------------------------------------------- zblight = 0.5 * zekb(ji,jj,1) * fse3t(ji,jj,1) zglight = 0.5 * zekg(ji,jj,1) * fse3t(ji,jj,1) zrlight = 0.5 * zekr(ji,jj,1) * fse3t(ji,jj,1) ze3lum(ji,jj,1) = zparlux * qsr(ji,jj) ze4lum(ji,jj,1) = zparlux * qsr(ji,jj) ze5lum(ji,jj,1) = zparlux * qsr(ji,jj) ze6lum(ji,jj,1) = (1.-3. * zparlux) * qsr(ji,jj) END DO END DO !CDIR NOVERRCHK DO jk = 2, jpkm1 !CDIR NOVERRCHK DO jj = 1, jpj !CDIR NOVERRCHK DO ji = 1, jpi ! Separation in three light bands: red, green, blue ! ------------------------------------------------- zblight = zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1) zglight = zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1) zrlight = zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1) ze3lum(ji,jj,jk) = ze3lum(ji,jj,jk-1) * EXP( -zblight ) ze4lum(ji,jj,jk) = ze4lum(ji,jj,jk-1) * EXP( -zglight ) ze5lum(ji,jj,jk) = ze5lum(ji,jj,jk-1) * EXP( -zrlight ) ze6lum(ji,jj,jk) = ze6lum(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) / xsi1 ) END DO END DO END DO etot3(:,:,:) = ze3lum(:,:,:) + ze4lum(:,:,:) + ze5lum(:,:,:) + ze6lum(:,:,:) ENDIF ! Computation of the euphotic depth ! --------------------------------- heup(:,:) = 300.e0 DO jk = 2, jpkm1 DO jj = 1, jpj DO ji = 1, jpi IF( etot(ji,jj,jk) >= 0.0043 * qsr(ji,jj) ) heup(ji,jj) = fsdepw(ji,jj,jk+1) END DO END DO END DO heup(:,:) = MIN( 300., heup(:,:) ) ! Computation of the mean light over the mixed layer depth ! -------------------------------------------------------- zdepmoy(:,:) = 0.e0 zetmp (:,:) = 0.e0 emoy (:,:,:) = 0.e0 DO jk = 1, jpkm1 DO jj = 1, jpj DO ji = 1, jpi IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN zetmp (ji,jj) = zetmp (ji,jj) + etot(ji,jj,jk) * fse3t(ji,jj,jk) zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) ENDIF END DO END DO END DO emoy(:,:,:) = etot(:,:,:) DO jk = 1, jpkm1 DO jj = 1, jpj DO ji = 1, jpi IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) ENDIF END DO END DO END DO # if defined key_trc_diaadd trc2d(:,:,11) = heup(:,:) # endif ! END SUBROUTINE p4z_opt SUBROUTINE p4z_opt_init !!---------------------------------------------------------------------- !! *** ROUTINE p4z_opt_init *** !! !! ** Purpose : Initialization of of the optical scheme !! !! ** Method : read the look up table for the optical coefficients !! !! ** input : xKRGB61 !! !!---------------------------------------------------------------------- INTEGER :: ichl, iband INTEGER :: numlight REAL(wp) :: ztoto ! FROM THE NEW BIOOPTIC MODEL PROPOSED JM ANDRE, WE READ HERE ! A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT CALL ctlopn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL', & & 1, numout, .TRUE., 1 ) DO ichl = 1,61 READ(numlight,*) ztoto, ( xkrgb(iband,ichl), iband = 1,3 ) END DO CLOSE(numlight) IF(lwp) THEN ! control print WRITE(numout,*) ' ' WRITE(numout,*) ' Initialization of the optical look-up table done' WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' ENDIF END SUBROUTINE p4z_opt_init #else !!====================================================================== !! Dummy module : No PISCES bio-model !!====================================================================== CONTAINS SUBROUTINE p4z_opt ! Empty routine END SUBROUTINE p4z_opt #endif !!====================================================================== END MODULE p4zopt