source: branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcexp.F @ 772

CCC $Header$ 
      SUBROUTINE trcexp(kt)
#if defined key_top && defined key_lobster
CCC---------------------------------------------------------------------
CCC
CCC                       ROUTINE trcexp
CCC                     ******************
CCC
CC
CC     PURPOSE.
CC     --------
CC          *TRCEXP* MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT
CC                   TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN
CC
CC     METHOD.
CC     -------
CC          IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO
CC     NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE
CC     KINETICS FOLLOW MICHAELIS-MENTON FORMULATION. 
CC     THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER
CC     COLUMN BELOW THE SURFACE LAYER.
CC
CC     EXTERNALS.
CC     ----------
CC          NONE.
CC
CC     REFERENCE.
CC     ----------
CC
CC   MODIFICATIONS:
CC   --------------
CC      original      : 1999    O. Aumont
CC      modifications : 1999    C. Le Quere
CC      additions   : 01-05 (O. Aumont, E. Kestenare):
CC                           add sediment computations
CC                  :  05-06  (AS. Kremeur) new temporal integration for sedpoc
CC ---------------------------------------------------------------------
c ------
CC parameters and commons
CC ======================
CDIR$ NOLIST
      USE oce_trc
      USE trp_trc
      USE sms
      USE lbclnk
      USE trc
      USE trctrp_lec

      IMPLICIT NONE
CDIR$ LIST
CC----------------------------------------------------------------------
CC local declarations
CC ==================
C
      INTEGER kt
      INTEGER ji, jj, jk, zkbot(jpi,jpj)
      REAL zwork(jpi,jpj), zgeolpoc, zfact
CC----------------------------------------------------------------------
CC statement functions
CC ===================
CDIR$ NOLIST
#include "domzgr_substitute.h90"
CDIR$ LIST
C
C VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC
C POC IN THE WATER COLUMN
C (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT
C LAYERS IS DETERMINED BY DMIN3 DEFINED IN common.passivetrc.*.h
C ----------------------------------------------------------------------
C
C
      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)
          ENDDO
        ENDDO
      ENDDO
C
C     Find the last level of the water column
C     Compute fluxes due to sinking particles (slow)
C   
      zkbot = jpk
      zwork = 0.
C
C
      DO jk = 1,jpkm1
        DO jj = 2,jpjm1
          DO ji = 2,jpim1
   
             IF ( tmask(ji,jj,jk) .eq. 1 .and.
     .            tmask(ji,jj,jk+1). eq. 0 ) THEN
                  zkbot(ji,jj) = jk
                  zwork(ji,jj) = vsed * trn(ji,jj,jk,jpdet)
              ENDIF
    
             ENDDO
         ENDDO
      ENDDO
C
C     Initialization
      zgeolpoc = 0.

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

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

             sedpoca(ji,jj) = zwork(ji,jj)*rdt +
     .                       dminl(ji,jj)*fbod(ji,jj)*rdt -
     .                       sedlam*sedpocn(ji,jj)*rdt -
     .                       sedlostpoc*sedpocn(ji,jj)*rdt
C
             ENDDO
         ENDDO
C
        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)
           ENDDO
         ENDDO

         CALL lbc_lnk( sedpocn, 'T', 1. )
 
C Oa & Ek: diagnostics depending on jpdia2d
C          left as example
#     if defined key_trc_diaadd
           do jj=1,jpj
             do ji=1,jpi
              trc2d(ji,jj,19)=sedpocn(ji,jj)
             end do
           end do
#     endif

c      ! 1. Leap-frog scheme (only in explicit case, otherwise the 
c      ! -------------------  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

      
c      ! 2. Time filter and swap of arrays
c      ! ---------------------------------
      IF ( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN         
          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.
                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.
               END DO
             END DO
         ENDIF
         
      ELSE
c         !  case of smolar scheme or muscl
         DO jj = 1, jpj
            DO ji = 1, jpi
               sedpocb(ji,jj) = sedpoca(ji,jj)
               sedpocn(ji,jj) = sedpoca(ji,jj)
               sedpoca(ji,jj) = 0.
            END DO
         END DO
         
      ENDIF

#endif
      RETURN
      END