source: trunk/NEMO/TOP_SRC/SMS/p4zopt.F @ 262

CDIR$ LIST
      SUBROUTINE p4zopt
#if defined key_passivetrc && defined key_trc_pisces
CCC---------------------------------------------------------------------
CCC
CCC                       ROUTINE p4zopt
CCC                     *****************
CCC
CCC  PURPOSE :
CCC  ---------
CCC         Compute the light availability in the water column
CCC         depending on the depth and the chlorophyll concentration
CCC
CC   METHOD :
CC   -------
CC      
CC
CC   INPUT :
CC   -----
CC      argument
CC              None
CC      common
CC              all the common defined in opa
CC
CC
CC   OUTPUT :                   : no
CC   ------
CC
CC   WORKSPACE :
CC   ---------
CC
CC   EXTERNAL :
CC   --------
CC
CC   MODIFICATIONS:
CC   --------------
CC      original  : O. Aumont (2002)
CC----------------------------------------------------------------------
CC parameters and commons
CC ======================
      USE oce_trc
      USE trp_trc
      USE sms
#include "domzgr_substitute.h90"
CC----------------------------------------------------------------------
CC local declarations
CC ==================
      INTEGER ji, jj, jk, mrgb
      REAL xchl,ekg,ekr,ekb,xlim1,xlim2,xlim3,xlim4
      REAL parlux,e1(jpi,jpj,jpk),e2(jpi,jpj,jpk),e3(jpi,jpj,jpk)
      REAL zdepmoy(jpi,jpj)
      REAL e3lum(jpi,jpj,jpk),e4lum(jpi,jpj,jpk)
      REAL e5lum(jpi,jpj,jpk),etmp(jpi,jpj)
      REAL e6lum(jpi,jpj,jpk)

C     Initialisation of variables used to compute PAR
C     -----------------------------------------------
C
        e1     = 0.
        e2     = 0.
        e3     = 0.
        e3lum  = 0.
        e4lum  = 0.
        e5lum  = 0.
        e6lum  = 0.
        etot   = 0.
        etot3  = 0.
        parlux = 0.43/3.
C
        DO jj = 1,jpj
          DO ji = 1,jpi
C
C  Computation of a variable par fraction
C
        e1(ji,jj,1)=parlux*qsr(ji,jj)
        e2(ji,jj,1)=parlux*qsr(ji,jj)
        e3(ji,jj,1)=parlux*qsr(ji,jj)
        e3lum(ji,jj,1)=parlux*qsr(ji,jj)
        e4lum(ji,jj,1)=parlux*qsr(ji,jj)
        e5lum(ji,jj,1)=parlux*qsr(ji,jj)
        e6lum(ji,jj,1)=1.-3.*parlux*qsr(ji,jj)
C
          END DO
        END DO

C
C  Tuning of the iron concentration to a minimum
C  level that is set to the detection limit
C  -------------------------------------
C
        trn(:,:,:,jpfer)=max(trn(:,:,:,jpfer),1.E-11)
C
        DO jk = 1,jpkm1
          DO jj = 1,jpj
            DO ji = 1,jpi
C
C     Separation in two light bands: red and green
C     --------------------------------------------
C    
        xchl=(trn(ji,jj,jk,jpnch)+trn(ji,jj,jk,jpdch)+rtrn)*1.E6
        xchl=max(0.01,xchl)
        xchl=min(10.,xchl)

        mrgb = int(41+20.*log10(xchl)+rtrn)

        ekb=xkrgb(1,mrgb)
        ekg=xkrgb(2,mrgb)
        ekr=xkrgb(3,mrgb)

        e1(ji,jj,jk+1) = e1(ji,jj,jk)*exp(-ekb*fse3t(ji,jj,jk)/2.)
        e2(ji,jj,jk+1) = e2(ji,jj,jk)*exp(-ekg*fse3t(ji,jj,jk)/2.)
        e3(ji,jj,jk+1) = e3(ji,jj,jk)*exp(-ekr*fse3t(ji,jj,jk)/2.)


        etot(ji,jj,jk) = e1(ji,jj,jk+1)+e2(ji,jj,jk+1)+e3(ji,jj,jk+1)
C    
C     Computation of irradiance below level T
C     ---------------------------------------
C    
        e1(ji,jj,jk+1) = e1(ji,jj,jk+1)*exp(-ekb*fse3t(ji,jj,jk)/2.)
        e2(ji,jj,jk+1) = e2(ji,jj,jk+1)*exp(-ekg*fse3t(ji,jj,jk)/2.)
        e3(ji,jj,jk+1) = e3(ji,jj,jk+1)*exp(-ekr*fse3t(ji,jj,jk)/2.)

        e3lum(ji,jj,jk+1) = e3lum(ji,jj,jk)*exp(-ekb*fse3t(ji,jj,jk))
        e4lum(ji,jj,jk+1) = e4lum(ji,jj,jk)*exp(-ekg*fse3t(ji,jj,jk))
        e5lum(ji,jj,jk+1) = e5lum(ji,jj,jk)*exp(-ekr*fse3t(ji,jj,jk))
        e6lum(ji,jj,jk+1) = e6lum(ji,jj,jk)*exp(-fse3t(ji,jj,jk)/xsi1)
C
            END DO
          END DO
        END DO

C
C  modif pour le couplage avec la physique
C
        etot3=e3lum+e4lum+e5lum+e6lum
C
        DO jk = 1,jpkm1
          DO jj = 1,jpj
            DO ji = 1,jpi
C    
C      Michaelis-Menten Limitation term for nutrients
C      Small flagellates
C      -----------------------------------------------
C
        xnanono3(ji,jj,jk)=trn(ji,jj,jk,jpno3)*concnnh4
     &      /(conc0*concnnh4+concnnh4*trn(ji,jj,jk,jpno3)+
     &        conc0*trn(ji,jj,jk,jpnh4))
        xnanonh4(ji,jj,jk)=trn(ji,jj,jk,jpnh4)*conc0
     &      /(conc0*concnnh4+concnnh4*trn(ji,jj,jk,jpno3)+
     &        conc0*trn(ji,jj,jk,jpnh4))
        xlim1=xnanono3(ji,jj,jk)+xnanonh4(ji,jj,jk)
        xlim2=trn(ji,jj,jk,jppo4)/(trn(ji,jj,jk,jppo4)+conc0)
        xlim3=trn(ji,jj,jk,jpfer)/(trn(ji,jj,jk,jpfer)+conc2)
        xlimphy(ji,jj,jk)=min(xlim1,xlim2,xlim3)
        xlim4=trn(ji,jj,jk,jpdoc)/(trn(ji,jj,jk,jpdoc)+xkdoc2)
        xlimbac(ji,jj,jk)=min(xlim1,xlim2,xlim3,xlim4)
C
            END DO
          END DO
        END DO
C
        DO jk = 1,jpkm1
          DO jj = 1,jpj
            DO ji = 1,jpi
C     Diatoms
C     -------
        xdiatno3(ji,jj,jk)=trn(ji,jj,jk,jpno3)*concdnh4
     &      /(conc1*concdnh4+concdnh4*trn(ji,jj,jk,jpno3)+
     &        conc1*trn(ji,jj,jk,jpnh4))
        xdiatnh4(ji,jj,jk)=trn(ji,jj,jk,jpnh4)*conc1
     &      /(conc1*concdnh4+concdnh4*trn(ji,jj,jk,jpno3)+
     &        conc1*trn(ji,jj,jk,jpnh4))

        xlim1=xdiatno3(ji,jj,jk)+xdiatnh4(ji,jj,jk)
        xlim2=trn(ji,jj,jk,jppo4)/(trn(ji,jj,jk,jppo4)+conc1)
        xlim3=trn(ji,jj,jk,jpsil)/(trn(ji,jj,jk,jpsil)+xksi(ji,jj))
        xlim4=trn(ji,jj,jk,jpfer)/(trn(ji,jj,jk,jpfer)+conc3)
        xlimdia(ji,jj,jk)=min(xlim1,xlim2,xlim3,xlim4)
C
            END DO
          END DO
        END DO
C    
C     Initialisation of the euphotic depth
C     ------------------------------------
C    
        zmeu(:,:)=fsdept(:,:,jkopt+1)
C    
C     Computation of the euphotic depth
C     ---------------------------------
C    
        DO jk = 2,jkopt
          DO jj = 1,jpj
            DO ji = 1,jpi
        IF (etot(ji,jj,jk).GE.0.0043*qsr(ji,jj)) THEN
           zmeu(ji,jj) = fsdepw(ji,jj,jk+1)
        ENDIF
            END DO
          END DO
        END DO
C
C    Computation of the mean light over the mixed layer depth
C    --------------------------------------------------------
C
        zdepmoy  = 0
        etmp  = 0.
        emoy  = 0.

        DO jk = 1,jpkm1
          DO jj = 1,jpj
            DO ji = 1,jpi
          etmp(ji,jj) = etmp(ji,jj)+etot(ji,jj,jk)
     $            *fse3t(ji,jj,jk)*
     $            (0.5+sign(0.5,(hmld(ji,jj)
     $            -fsdept(ji,jj,jk))))
          zdepmoy(ji,jj)=zdepmoy(ji,jj)+
     $        fse3t(ji,jj,jk)*
     $        (0.5+sign(0.5,(hmld(ji,jj)
     $        -fsdept(ji,jj,jk))))
            END DO
          END DO
        END DO

        emoy=etot

        DO jk=1,jpkm1
          DO jj = 1,jpj
            DO ji = 1,jpi
        IF (fsdept(ji,jj,jk).LE.hmld(ji,jj)) THEN
          emoy(ji,jj,jk) = etmp(ji,jj)/(zdepmoy(ji,jj)+rtrn)
        ENDIF
            END DO
          END DO
        END DO

#   if defined key_trc_diaadd
        trc2d(:,:,11) = zmeu(:,:)
#    endif
C
#endif
      RETURN
      END