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

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90 @ 2287

Last change on this file since 2287 was 2287, checked in by smasson, 14 years ago

update licence of all NEMO files...

  • Property svn:keywords set to Id
File size: 6.0 KB
RevLine 
[934]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         !
[1119]17   USE trc
[1071]18   USE sms_lobster
[934]19   USE lbclnk
[2104]20   USE trdmod_oce
[2038]21   USE trdmod_trc
[1457]22   USE iom
[934]23   USE prtctl_trc      ! Print control for debbuging
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   trc_sed    ! called in ???
29
30   !!* Substitution
[1953]31#  include "top_substitute.h90"
[934]32   !!----------------------------------------------------------------------
[2287]33   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
[1146]34   !! $Id$
[2287]35   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[934]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      !!       
[2038]55      !!              IF 'key_diabio' is defined, the now vertical advection
[934]56      !!              trend of passive tracers is saved for futher diagnostics.
57      !!---------------------------------------------------------------------
58      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
59      !!
[1176]60      INTEGER  ::   ji, jj, jk, jl
[934]61      REAL(wp) ::   ztra
62      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwork
[2038]63#if defined key_diatrc && defined key_iomput
[1457]64      REAL(wp), DIMENSION(jpi,jpj) ::  zw2d
65#endif
[1176]66      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio
[934]67      CHARACTER (len=25) :: charout
68      !!---------------------------------------------------------------------
69
[2104]70      IF( kt == nit000 ) THEN
[934]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
[2038]79      ! for detritus sedimentation only - jp_lob_det
[934]80      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
81      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
82
[2038]83#if defined key_diatrc && defined key_iomput
[1457]84      zw2d(:,:) = 0.
85# endif
86
[1176]87      IF( l_trdtrc )THEN
88         ALLOCATE( ztrbio(jpi,jpj,jpk) )
[2038]89         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det)
[1176]90      ENDIF
91
[934]92      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
[1457]93      DO jk = 2, jpkm1
[2038]94         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jp_lob_det)
[934]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)
[2038]102               tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + ztra
103#if defined key_diabio
[1255]104               trbio(ji,jj,jk,jp_lob0_trd + 7) = ztra
[1457]105#endif
[2038]106#if defined key_diatrc
[1457]107# if ! defined key_iomput
[1255]108               trc2d(ji,jj,jp_lob0_2d + 7) = trc2d(ji,jj,jp_lob0_2d + 7) + ztra * fse3t(ji,jj,jk) * 86400.
[1457]109# else
110               zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400.
[934]111# endif
[1457]112#endif
[934]113            END DO
114         END DO
115      END DO
116
[2038]117#if defined key_diabio
[1255]118      jl = jp_lob0_trd + 7
119      CALL lbc_lnk (trbio(:,:,1,jl), 'T', 1. )    ! Lateral boundary conditions on trcbio
[934]120#endif
[2038]121#if defined key_diatrc
[1457]122# if ! defined key_iomput
[1255]123      jl = jp_lob0_2d + 7
124      CALL lbc_lnk( trc2d(:,:,jl), 'T', 1. )      ! Lateral boundary conditions on trc2d
[1457]125# else
126      CALL lbc_lnk( zw2d(:,:), 'T', 1. )      ! Lateral boundary conditions on zw2d
127      CALL iom_put( "TDETSED", zw2d )
128# endif
[934]129#endif
130      !
131
[1176]132      IF( l_trdtrc ) THEN
[2038]133         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) - ztrbio(:,:,:)
[1255]134         jl = jp_lob0_trd + 7
[1176]135         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend
136      ENDIF
137
[1953]138      IF( l_trdtrc ) DEALLOCATE( ztrbio )
139
[934]140      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
141         WRITE(charout, FMT="('sed')")
142         CALL prt_ctl_trc_info(charout)
143         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
144      ENDIF
145
146   END SUBROUTINE trc_sed
147
148#else
149   !!======================================================================
150   !!  Dummy module :                                   No PISCES bio-model
151   !!======================================================================
152CONTAINS
153   SUBROUTINE trc_sed( kt )                   ! Empty routine
154      INTEGER, INTENT( in ) ::   kt
155      WRITE(*,*) 'trc_sed: You should not have seen this print! error?', kt
156   END SUBROUTINE trc_sed
157#endif 
158
159   !!======================================================================
160END MODULE  trcsed
Note: See TracBrowser for help on using the repository browser.