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/NEMO/TOP_SRC/LOBSTER – NEMO

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

Last change on this file since 1146 was 1146, checked in by rblod, 16 years ago

Add svn Id (first try), see ticket #210

  • Property svn:keywords set to Id
File size: 7.2 KB
Line 
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         !
18   USE sms_lobster
19   USE lbclnk
20   USE trc
21   USE trctrp_lec
22   USE prtctl_trc      ! Print control for debbuging
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   trc_exp    ! called in p4zprg.F90
28
29   !!* Substitution
30#  include "domzgr_substitute.h90"
31   !!----------------------------------------------------------------------
32   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
33   !! $Id$
34   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
35   !!----------------------------------------------------------------------
36
37CONTAINS
38
39   SUBROUTINE trc_exp( kt )
40      !!---------------------------------------------------------------------
41      !!                     ***  ROUTINE trc_exp  ***
42      !!
43      !! ** Purpose :   MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT
44      !!              TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN
45      !!
46      !! ** Method  : - IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO
47      !!              NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE
48      !!              KINETICS FOLLOW MICHAELIS-MENTON FORMULATION.
49      !!              THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER
50      !!              COLUMN BELOW THE SURFACE LAYER.
51      !!---------------------------------------------------------------------
52      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
53      !!
54      INTEGER  ::   ji, jj, jk
55      REAL(wp) ::   zgeolpoc, zfact
56      INTEGER , DIMENSION(jpi,jpj) ::   ikbot
57      REAL(wp), DIMENSION(jpi,jpj) ::   zwork
58
59      CHARACTER (len=25) :: charout
60      !!---------------------------------------------------------------------
61
62      IF( kt == nit000 ) THEN
63         IF(lwp) WRITE(numout,*)
64         IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export'
65         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
66      ENDIF
67
68! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC
69! POC IN THE WATER COLUMN
70! (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT
71! LAYERS IS DETERMINED BY DMIN3 DEFINED IN common.passivetrc.*.h
72! ----------------------------------------------------------------------
73
74      DO jk = 1, jpkm1
75         DO jj = 2, jpjm1
76            DO ji = 2, jpim1
77               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3)   &
78     &                             + (1./fse3t(ji,jj,jk)) * dmin3(ji,jj,jk) * fbod(ji,jj)
79            END DO
80         END DO
81      END DO
82
83!     Find the last level of the water column
84!     Compute fluxes due to sinking particles (slow)
85   
86      ikbot(:,:) = jpk
87      zwork(:,:) = 0.e0
88
89!!gm ikbot already exist in opa...
90      DO jk = 1, jpkm1
91         DO jj = 2, jpjm1
92            DO ji = 2, jpim1
93               IF( tmask(ji,jj,jk) == 1 .AND.  tmask(ji,jj,jk+1) == 0 ) THEN
94                  ikbot(ji,jj) = jk
95                  zwork(ji,jj) = vsed * trn(ji,jj,jk,jpdet)
96               ENDIF
97            END DO
98         END DO
99      END DO
100
101      zgeolpoc = 0.e0         !     Initialization
102
103      ! Release of nutrients from the "simple" sediment
104      DO jj = 2, jpjm1
105         DO ji = 2, jpim1
106            tra(ji,jj,ikbot(ji,jj),jpno3) = tra(ji,jj,ikbot(ji,jj),jpno3)   &
107               &                          + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikbot(ji,jj))
108
109            !     Deposition of organic matter in the sediment
110            zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1t(ji,jj) * e2t(ji,jj)
111
112!!gm factorisationof rdt just bellow...
113            sedpoca(ji,jj) = zwork(ji,jj) * rdt + dminl(ji,jj) * fbod(ji,jj) * rdt   &
114               &           - sedlam * sedpocn(ji,jj) * rdt - sedlostpoc * sedpocn(ji,jj) * rdt
115
116         END DO
117      END DO
118
119      DO jj = 2,jpjm1
120         DO ji = 2,jpim1
121            tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1)
122         END DO
123      END DO
124
125      CALL lbc_lnk( sedpocn, 'T', 1. )
126 
127      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example
128# if defined key_trc_diaadd
129      trc2d(:,:,19) = sedpocn(:,:)
130# endif
131
132      ! Leap-frog scheme (only in explicit case, otherwise the
133      ! ----------------  time stepping is already done in trczdf)
134      IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN
135         zfact = 2. * rdttra(jk) * FLOAT( ndttrc ) 
136         IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(ndttrc) 
137         sedpoca(:,:) =  sedpocb(:,:) + zfact * sedpoca(:,:) 
138      ENDIF
139
140     
141      ! Time filter and swap of arrays
142      ! ------------------------------
143      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN         ! centred or tvd scheme
144         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
145            DO jj = 1, jpj
146               DO ji = 1, jpi
147                  sedpocb(ji,jj) = sedpocn(ji,jj)
148                  sedpocn(ji,jj) = sedpoca(ji,jj)
149                  sedpoca(ji,jj) = 0.e0
150               END DO
151            END DO
152         ELSE
153            DO jj = 1, jpj
154               DO ji = 1, jpi
155                  sedpocb(ji,jj) = atfp  * ( sedpocb(ji,jj) + sedpoca(ji,jj) )    &
156                     &           + atfp1 *   sedpocn(ji,jj)
157                  sedpocn(ji,jj) = sedpoca(ji,jj)
158                  sedpoca(ji,jj) = 0.e0
159               END DO
160            END DO
161         ENDIF
162      ELSE                                                   !  case of smolar scheme or muscl
163         sedpocb(:,:) = sedpoca(:,:)
164         sedpocn(:,:) = sedpoca(:,:)
165         sedpoca(:,:) = 0.e0
166      ENDIF
167      !
168
169      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
170         WRITE(charout, FMT="('exp')")
171         CALL prt_ctl_trc_info(charout)
172         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
173      ENDIF
174
175   END SUBROUTINE trc_exp
176
177#else
178   !!======================================================================
179   !!  Dummy module :                                   No PISCES bio-model
180   !!======================================================================
181CONTAINS
182   SUBROUTINE trc_exp( kt )                   ! Empty routine
183      INTEGER, INTENT( in ) ::   kt
184      WRITE(*,*) 'trc_exp: You should not have seen this print! error?', kt
185   END SUBROUTINE trc_exp
186#endif 
187
188   !!======================================================================
189END MODULE  trcexp
Note: See TracBrowser for help on using the repository browser.