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.
trcsed.F90 in trunk/NEMO/TOP_SRC/LOBSTER – NEMO

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

Last change on this file since 1194 was 1194, checked in by cetlod, 16 years ago

Correction of LOBSTER modules to ensure reproductibility for GYRE_LOBSTER, see ticket:253

  • Property svn:keywords set to Id
File size: 5.4 KB
Line 
1MODULE trcsed
2   !!======================================================================
3   !!                         ***  MODULE p4sed  ***
4   !! TOP :   PISCES Compute loss of organic matter in the sediments
5   !!======================================================================
6   !! History :    -   !  1995-06 (M. Levy)  original code
7   !!              -   !  2000-12 (E. Kestenare)  clean up
8   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 + simplifications
9   !!----------------------------------------------------------------------
10#if defined key_lobster
11   !!----------------------------------------------------------------------
12   !!   'key_lobster'                                     LOBSTER bio-model
13   !!----------------------------------------------------------------------
14   !!   trc_sed        :  Compute loss of organic matter in the sediments
15   !!----------------------------------------------------------------------
16   USE oce_trc         !
17   USE trc
18   USE sms_lobster
19   USE lbclnk
20   USE trdmld_trc
21   USE trdmld_trc_oce
22
23   USE prtctl_trc      ! Print control for debbuging
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   trc_sed    ! called in ???
29
30   !!* Substitution
31#  include "domzgr_substitute.h90"
32   !!----------------------------------------------------------------------
33   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
34   !! $Id$
35   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
36   !!----------------------------------------------------------------------
37
38CONTAINS
39
40   SUBROUTINE trc_sed( kt )
41      !!---------------------------------------------------------------------
42      !!                     ***  ROUTINE trc_sed  ***
43      !!
44      !! ** Purpose :   compute the now trend due to the vertical sedimentation of
45      !!              detritus and add it to the general trend of detritus equations
46      !!
47      !! ** Method  :   this ROUTINE compute not exactly the advection but the
48      !!              transport term, i.e.  dz(wt) and dz(ws)., dz(wtr)
49      !!              using an upstream scheme
50      !!              the now vertical advection of tracers is given by:
51      !!                      dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) )
52      !!              add this trend now to the general trend of tracer (ta,sa,tra):
53      !!                             tra = tra + dz(trn wn)
54      !!       
55      !!              IF 'key_trc_diabio' is defined, the now vertical advection
56      !!              trend of passive tracers is saved for futher diagnostics.
57      !!---------------------------------------------------------------------
58      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
59      !!
60      INTEGER  ::   ji, jj, jk, jl
61      REAL(wp) ::   ztra
62      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwork
63      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio
64      CHARACTER (len=25) :: charout
65      !!---------------------------------------------------------------------
66
67      IF( kt == nit000 ) THEN
68         IF(lwp) WRITE(numout,*)
69         IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation'
70         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
71      ENDIF
72
73      ! sedimentation of detritus  : upstream scheme
74      ! --------------------------------------------
75
76      ! for detritus sedimentation only - jpdet
77
78      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
79      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
80
81      IF( l_trdtrc )THEN
82         ALLOCATE( ztrbio(jpi,jpj,jpk) )
83         ztrbio(:,:,:) = tra(:,:,:,jpdet)
84      ENDIF
85
86      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
87
88      DO jk = 2, jpk
89         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet)
90      END DO
91
92      ! tracer flux divergence at t-point added to the general trend
93
94      DO jk = 1, jpkm1
95         DO jj = 1, jpj
96            DO ji = 1,jpi
97               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
98               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra
99# if defined key_trc_diabio
100               trbio(ji,jj,jk,8) = ztra
101# endif
102# if defined key_trc_diaadd
103               trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400.
104# endif
105            END DO
106         END DO
107      END DO
108
109#if defined key_trc_diabio
110      CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. )    ! Lateral boundary conditions on trcbio
111#endif
112#if defined key_trc_diaadd
113      CALL lbc_lnk( trc2d(:,:,8), 'T', 1. )      ! Lateral boundary conditions on trc2d
114#endif
115      !
116
117      IF( l_trdtrc ) THEN
118         ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:)
119         jl = 8
120         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend
121      ENDIF
122
123      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
124         WRITE(charout, FMT="('sed')")
125         CALL prt_ctl_trc_info(charout)
126         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
127      ENDIF
128
129   END SUBROUTINE trc_sed
130
131#else
132   !!======================================================================
133   !!  Dummy module :                                   No PISCES bio-model
134   !!======================================================================
135CONTAINS
136   SUBROUTINE trc_sed( kt )                   ! Empty routine
137      INTEGER, INTENT( in ) ::   kt
138      WRITE(*,*) 'trc_sed: You should not have seen this print! error?', kt
139   END SUBROUTINE trc_sed
140#endif 
141
142   !!======================================================================
143END MODULE  trcsed
Note: See TracBrowser for help on using the repository browser.