source: trunk/NEMO/TOP_SRC/LOBSTER/trcexp.F90 @ 1194

MODULE trcexp
   !!======================================================================
   !!                         ***  MODULE p4sed  ***
   !! TOP :   PISCES Compute loss of organic matter in the sediments
   !!======================================================================
   !! History :    -   !  1999    (O. Aumont, C. Le Quere)  original code
   !!              -   !  2001-05 (O. Aumont, E. Kestenare) add sediment computations
   !!             1.0  !  2005-06 (A.-S. Kremeur) new temporal integration for sedpoc
   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90
   !!----------------------------------------------------------------------
#if defined key_lobster
   !!----------------------------------------------------------------------
   !!   'key_lobster'                                     LOBSTER bio-model
   !!----------------------------------------------------------------------
   !!   trc_exp        :  Compute loss of organic matter in the sediments
   !!----------------------------------------------------------------------
   USE oce_trc         !
   USE sms_lobster
   USE lbclnk
   USE trc
   USE trctrp_lec
   USE prtctl_trc      ! Print control for debbuging
   USE trdmld_trc
   USE trdmld_trc_oce

   IMPLICIT NONE
   PRIVATE

   PUBLIC   trc_exp    ! called in p4zprg.F90

   !!* Substitution
#  include "domzgr_substitute.h90"
   !!----------------------------------------------------------------------
   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
   !! $Id$ 
   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
   !!----------------------------------------------------------------------

CONTAINS

   SUBROUTINE trc_exp( kt )
      !!---------------------------------------------------------------------
      !!                     ***  ROUTINE trc_exp  ***
      !!
      !! ** Purpose :   MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT
      !!              TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN
      !!
      !! ** Method  : - IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO
      !!              NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE
      !!              KINETICS FOLLOW MICHAELIS-MENTON FORMULATION. 
      !!              THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER
      !!              COLUMN BELOW THE SURFACE LAYER.
      !!---------------------------------------------------------------------
      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
      !!
      INTEGER  ::   ji, jj, jk, jl
      REAL(wp) ::   zgeolpoc, zfact
      INTEGER , DIMENSION(jpi,jpj) ::   ikbot
      REAL(wp), DIMENSION(jpi,jpj) ::   zwork
      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio
      CHARACTER (len=25) :: charout
      !!---------------------------------------------------------------------

      IF( kt == nit000 ) THEN
         IF(lwp) WRITE(numout,*)
         IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export'
         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
      ENDIF

      ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC
      ! POC IN THE WATER COLUMN
      ! (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT
      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_lobster.F90
      ! ----------------------------------------------------------------------

      IF( l_trdtrc )THEN
         ALLOCATE( ztrbio(jpi,jpj,jpk) )
         ztrbio(:,:,:) = tra(:,:,:,jpno3)
      ENDIF

      DO jk = 1, jpkm1
         DO jj = 2, jpjm1
            DO ji = 2, jpim1
               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3)   &
     &                             + (1./fse3t(ji,jj,jk)) * dmin3(ji,jj,jk) * fbod(ji,jj)
            END DO
         END DO
      END DO

!     Find the last level of the water column
!     Compute fluxes due to sinking particles (slow)
   
      ikbot(:,:) = jpk
      zwork(:,:) = 0.e0

!!gm ikbot already exist in opa...
      DO jk = 1, jpkm1
         DO jj = 2, jpjm1
            DO ji = 2, jpim1
               IF( tmask(ji,jj,jk) == 1 .AND.  tmask(ji,jj,jk+1) == 0 ) THEN
                  ikbot(ji,jj) = jk
                  zwork(ji,jj) = vsed * trn(ji,jj,jk,jpdet)
               ENDIF
            END DO
         END DO
      END DO

      zgeolpoc = 0.e0         !     Initialization

      ! Release of nutrients from the "simple" sediment
      DO jj = 2, jpjm1
         DO ji = 2, jpim1
            tra(ji,jj,ikbot(ji,jj),jpno3) = tra(ji,jj,ikbot(ji,jj),jpno3)   &
               &                          + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikbot(ji,jj))

            !     Deposition of organic matter in the sediment
            zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1t(ji,jj) * e2t(ji,jj)

!!gm factorisationof rdt just bellow...
            sedpoca(ji,jj) = zwork(ji,jj) * rdt + dminl(ji,jj) * fbod(ji,jj) * rdt   &
               &           - sedlam * sedpocn(ji,jj) * rdt - sedlostpoc * sedpocn(ji,jj) * rdt

         END DO
      END DO

      DO jj = 2,jpjm1
         DO ji = 2,jpim1
            tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1)
         END DO
      END DO

      CALL lbc_lnk( sedpocn, 'T', 1. )
 
      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example
# if defined key_trc_diaadd
      trc2d(:,:,19) = sedpocn(:,:)
# endif

      ! Leap-frog scheme (only in explicit case, otherwise the 
      ! ----------------  time stepping is already done in trczdf)
      IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN
         zfact = 2. * rdttra(jk) * FLOAT( ndttrc ) 
         IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(ndttrc) 
         sedpoca(:,:) =  sedpocb(:,:) + zfact * sedpoca(:,:) 
      ENDIF

      
      ! Time filter and swap of arrays
      ! ------------------------------
      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN         ! centred or tvd scheme
         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
            DO jj = 1, jpj
               DO ji = 1, jpi
                  sedpocb(ji,jj) = sedpocn(ji,jj)
                  sedpocn(ji,jj) = sedpoca(ji,jj)
                  sedpoca(ji,jj) = 0.e0
               END DO
            END DO
         ELSE
            DO jj = 1, jpj
               DO ji = 1, jpi
                  sedpocb(ji,jj) = atfp  * ( sedpocb(ji,jj) + sedpoca(ji,jj) )    &
                     &           + atfp1 *   sedpocn(ji,jj)
                  sedpocn(ji,jj) = sedpoca(ji,jj)
                  sedpoca(ji,jj) = 0.e0
               END DO
            END DO
         ENDIF
      ELSE                                                   !  case of smolar scheme or muscl
         sedpocb(:,:) = sedpoca(:,:)
         sedpocn(:,:) = sedpoca(:,:)
         sedpoca(:,:) = 0.e0
      ENDIF
      !
      IF( l_trdtrc ) THEN
         ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:)
         jl = 17
         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend
      ENDIF

      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
         WRITE(charout, FMT="('exp')")
         CALL prt_ctl_trc_info(charout)
         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
      ENDIF

   END SUBROUTINE trc_exp

#else
   !!======================================================================
   !!  Dummy module :                                   No PISCES bio-model
   !!======================================================================
CONTAINS
   SUBROUTINE trc_exp( kt )                   ! Empty routine
      INTEGER, INTENT( in ) ::   kt
      WRITE(*,*) 'trc_exp: You should not have seen this print! error?', kt
   END SUBROUTINE trc_exp
#endif 

   !!======================================================================
END MODULE  trcexp