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 @ 1457

Last change on this file since 1457 was 1457, checked in by cetlod, 15 years ago

distribution of iom_put in TOP routines, see ticket:437

  • Property svn:keywords set to Id
File size: 6.0 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   USE iom
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#if defined key_trc_diaadd && defined key_iomput
64      REAL(wp), DIMENSION(jpi,jpj) ::  zw2d
65#endif
66      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio
67      CHARACTER (len=25) :: charout
68      !!---------------------------------------------------------------------
69
70      IF( kt == nit000 ) THEN
71         IF(lwp) WRITE(numout,*)
72         IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation'
73         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
74      ENDIF
75
76      ! sedimentation of detritus  : upstream scheme
77      ! --------------------------------------------
78
79      ! for detritus sedimentation only - jpdet
80      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
81      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
82
83#if defined key_trc_diaadd && defined key_iomput
84      zw2d(:,:) = 0.
85# endif
86
87      IF( l_trdtrc )THEN
88         ALLOCATE( ztrbio(jpi,jpj,jpk) )
89         ztrbio(:,:,:) = tra(:,:,:,jpdet)
90      ENDIF
91
92      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
93      DO jk = 2, jpkm1
94         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet)
95      END DO
96
97      ! tracer flux divergence at t-point added to the general trend
98      DO jk = 1, jpkm1
99         DO jj = 1, jpj
100            DO ji = 1,jpi
101               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
102               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra
103#if defined key_trc_diabio
104               trbio(ji,jj,jk,jp_lob0_trd + 7) = ztra
105#endif
106#if defined key_trc_diaadd
107# if ! defined key_iomput
108               trc2d(ji,jj,jp_lob0_2d + 7) = trc2d(ji,jj,jp_lob0_2d + 7) + ztra * fse3t(ji,jj,jk) * 86400.
109# else
110               zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400.
111# endif
112#endif
113            END DO
114         END DO
115      END DO
116
117#if defined key_trc_diabio
118      jl = jp_lob0_trd + 7
119      CALL lbc_lnk (trbio(:,:,1,jl), 'T', 1. )    ! Lateral boundary conditions on trcbio
120#endif
121#if defined key_trc_diaadd
122# if ! defined key_iomput
123      jl = jp_lob0_2d + 7
124      CALL lbc_lnk( trc2d(:,:,jl), 'T', 1. )      ! Lateral boundary conditions on trc2d
125# else
126      CALL lbc_lnk( zw2d(:,:), 'T', 1. )      ! Lateral boundary conditions on zw2d
127      CALL iom_put( "TDETSED", zw2d )
128# endif
129#endif
130      !
131
132      IF( l_trdtrc ) THEN
133         ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:)
134         jl = jp_lob0_trd + 7
135         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend
136      ENDIF
137
138      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
139         WRITE(charout, FMT="('sed')")
140         CALL prt_ctl_trc_info(charout)
141         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
142      ENDIF
143
144   END SUBROUTINE trc_sed
145
146#else
147   !!======================================================================
148   !!  Dummy module :                                   No PISCES bio-model
149   !!======================================================================
150CONTAINS
151   SUBROUTINE trc_sed( kt )                   ! Empty routine
152      INTEGER, INTENT( in ) ::   kt
153      WRITE(*,*) 'trc_sed: You should not have seen this print! error?', kt
154   END SUBROUTINE trc_sed
155#endif 
156
157   !!======================================================================
158END MODULE  trcsed
Note: See TracBrowser for help on using the repository browser.