New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
trcexp.F90 in trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER – NEMO

source: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90 @ 3692

Last change on this file since 3692 was 3294, checked in by rblod, 12 years ago

Merge of 3.4beta into the trunk

  • Property svn:keywords set to Id
File size: 7.0 KB
RevLine 
[934]1MODULE trcexp
2   !!======================================================================
3   !!                         ***  MODULE p4sed  ***
4   !! TOP :   PISCES Compute loss of organic matter in the sediments
5   !!======================================================================
6   !! History :    -   !  1999    (O. Aumont, C. Le Quere)  original code
7   !!              -   !  2001-05 (O. Aumont, E. Kestenare) add sediment computations
8   !!             1.0  !  2005-06 (A.-S. Kremeur) new temporal integration for sedpoc
9   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90
10   !!----------------------------------------------------------------------
11#if defined key_lobster
12   !!----------------------------------------------------------------------
13   !!   'key_lobster'                                     LOBSTER bio-model
14   !!----------------------------------------------------------------------
15   !!   trc_exp        :  Compute loss of organic matter in the sediments
16   !!----------------------------------------------------------------------
17   USE oce_trc         !
[1071]18   USE sms_lobster
[934]19   USE lbclnk
20   USE trc
[2528]21   USE trcnam_trp
[934]22   USE prtctl_trc      ! Print control for debbuging
[2528]23   USE trdmod_oce
24   USE trdmod_trc
[1457]25   USE iom
[934]26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   trc_exp    ! called in p4zprg.F90
31
32   !!* Substitution
[1457]33#  include "top_substitute.h90"
[934]34   !!----------------------------------------------------------------------
[2528]35   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
[1146]36   !! $Id$
[2528]37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[934]38   !!----------------------------------------------------------------------
39
40CONTAINS
41
42   SUBROUTINE trc_exp( kt )
43      !!---------------------------------------------------------------------
44      !!                     ***  ROUTINE trc_exp  ***
45      !!
46      !! ** Purpose :   MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT
47      !!              TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN
48      !!
49      !! ** Method  : - IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO
50      !!              NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE
51      !!              KINETICS FOLLOW MICHAELIS-MENTON FORMULATION.
52      !!              THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER
53      !!              COLUMN BELOW THE SURFACE LAYER.
54      !!---------------------------------------------------------------------
[3294]55      !!
[934]56      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
57      !!
[3294]58      INTEGER  ::   ji, jj, jk, jl, ikt, ierr
[2528]59      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd
[3294]60      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrbio
[934]61      CHARACTER (len=25) :: charout
62      !!---------------------------------------------------------------------
[3294]63      !
64      IF( nn_timing == 1 )  CALL timing_start('trc_exp')
65      !
66      IF( kt == nittrc000 ) THEN
[934]67         IF(lwp) WRITE(numout,*)
68         IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export'
69         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
70      ENDIF
71
[3294]72      IF( l_trdtrc )  THEN
73         ALLOCATE( ztrbio(jpi,jpj,jpk) , STAT = ierr )   ! temporary save of trends
74         IF( ierr > 0 ) THEN
75            CALL ctl_stop( 'trc_exp: unable to allocate ztrbio array' )   ;   RETURN
76         ENDIF
77         ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3)
78      ENDIF
79
[1176]80      ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC
81      ! POC IN THE WATER COLUMN
82      ! (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT
83      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_lobster.F90
84      ! ----------------------------------------------------------------------
[934]85      DO jk = 1, jpkm1
86         DO jj = 2, jpjm1
[1457]87            DO ji = fs_2, fs_jpim1
88               ze3t = 1. / fse3t(ji,jj,jk)
[2528]89               tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + ze3t * dmin3(ji,jj,jk) * fbod(ji,jj)
[934]90            END DO
91         END DO
92      END DO
93
[1457]94      ! Find the last level of the water column
95      ! Compute fluxes due to sinking particles (slow)
[934]96   
97
98      zgeolpoc = 0.e0         !     Initialization
99      ! Release of nutrients from the "simple" sediment
100      DO jj = 2, jpjm1
[1457]101         DO ji = fs_2, fs_jpim1
[2528]102            ikt = mbkt(ji,jj) 
103            tra(ji,jj,ikt,jp_lob_no3) = tra(ji,jj,ikt,jp_lob_no3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikt) 
[1457]104            ! Deposition of organic matter in the sediment
[2528]105            zwork = vsed * trn(ji,jj,ikt,jp_lob_det)
[1457]106            sedpoca(ji,jj) = ( zwork + dminl(ji,jj) * fbod(ji,jj)   &
107               &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt
[2715]108            zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj)
[934]109         END DO
110      END DO
111
[1457]112      DO jj = 2, jpjm1
113         DO ji = fs_2, fs_jpim1
[2528]114            tra(ji,jj,1,jp_lob_no3) = tra(ji,jj,1,jp_lob_no3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1)
[934]115         END DO
116      END DO
117
118      CALL lbc_lnk( sedpocn, 'T', 1. )
119 
120      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example
[3294]121      IF( ln_diatrc ) THEN
122         IF( lk_iomput ) THEN   ;   CALL iom_put( "SEDPOC" , sedpocn )
123         ELSE                   ;   trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:)
124         ENDIF
125      ENDIF
[934]126
127     
128      ! Time filter and swap of arrays
129      ! ------------------------------
[3294]130      IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step
[2528]131        !                                             ! (only swap)
132        sedpocn(:,:) = sedpoca(:,:)
133        !                                             
134      ELSE
135        !
136        DO jj = 1, jpj
137           DO ji = 1, jpi
138              zsedpocd = sedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers
139              sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn
140              sedpocn(ji,jj) = sedpoca(ji,jj)                                       ! sedpocn <-- sedpoca
141           END DO
142        END DO
143        !
[934]144      ENDIF
[2528]145      sedpoca(:,:) = 0.e0
[934]146      !
[1176]147      IF( l_trdtrc ) THEN
[2528]148         ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) - ztrbio(:,:,:)
[1255]149         jl = jp_lob0_trd + 16
[1176]150         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend
[3294]151         DEALLOCATE( ztrbio ) 
[1176]152      ENDIF
[934]153
154      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
155         WRITE(charout, FMT="('exp')")
156         CALL prt_ctl_trc_info(charout)
157         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
158      ENDIF
[3294]159      !
160      IF( nn_timing == 1 )  CALL timing_stop('trc_exp')
161      !
[934]162   END SUBROUTINE trc_exp
163
164#else
165   !!======================================================================
166   !!  Dummy module :                                   No PISCES bio-model
167   !!======================================================================
168CONTAINS
169   SUBROUTINE trc_exp( kt )                   ! Empty routine
170      INTEGER, INTENT( in ) ::   kt
171      WRITE(*,*) 'trc_exp: You should not have seen this print! error?', kt
172   END SUBROUTINE trc_exp
173#endif 
174
175   !!======================================================================
176END MODULE  trcexp
Note: See TracBrowser for help on using the repository browser.