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

source: branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90 @ 3313

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

Merge of 3.4beta into the trunk

  • 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 trdmod_oce
21   USE trdmod_trc
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 "top_substitute.h90"
32   !!----------------------------------------------------------------------
33   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
34   !! $Id$
35   !! Software governed by the CeCILL licence (NEMOGCM/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_diabio' is defined, the now vertical advection
56      !!              trend of passive tracers is saved for futher diagnostics.
57      !!---------------------------------------------------------------------
58      !!
59      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
60      !!
61      INTEGER  ::   ji, jj, jk, jl, ierr
62      CHARACTER (len=25) :: charout
63      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d
64      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra, ztrbio
65      !!---------------------------------------------------------------------
66      !
67      IF( nn_timing == 1 )  CALL timing_start('trc_sed')
68      !
69      IF( kt == nittrc000 ) THEN
70         IF(lwp) WRITE(numout,*)
71         IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation'
72         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
73      ENDIF
74
75      ! Allocate temporary workspace
76      CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra )
77
78      IF( ln_diatrc )  THEN
79         CALL wrk_alloc( jpi, jpj, zw2d )
80      ENDIF
81
82      IF( l_trdtrc ) THEN
83         CALL wrk_alloc( jpi, jpj, jpk, ztrbio )
84         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det)
85      ENDIF
86
87      ! sedimentation of detritus  : upstream scheme
88      ! --------------------------------------------
89
90      ! for detritus sedimentation only - jp_lob_det
91      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
92      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
93
94      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
95      DO jk = 2, jpkm1
96         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jp_lob_det)
97      END DO
98
99      ! tracer flux divergence at t-point added to the general trend
100      DO jk = 1, jpkm1
101         DO jj = 1, jpj
102            DO ji = 1, jpi
103               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
104               tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + ztra(ji,jj,jk) 
105            END DO
106         END DO
107      END DO
108
109      IF( ln_diatrc ) THEN
110         DO jk = 1, jpkm1
111            DO jj = 1, jpj
112               DO ji = 1, jpi
113                  zw2d(ji,jj) = zw2d(ji,jj) + ztra(ji,jj,jk) * fse3t(ji,jj,jk) * 86400.
114               END DO
115            END DO
116         END DO
117         IF( lk_iomput )  THEN
118           CALL iom_put( "TDETSED", zw2d )
119         ELSE
120           trc2d(:,:,jp_lob0_2d + 7) = zw2d(:,:)
121         ENDIF
122         CALL wrk_dealloc( jpi, jpj, zw2d )
123      ENDIF
124      !
125      IF( ln_diabio )  trbio(:,:,:,jp_lob0_trd + 7) = ztra(:,:,:)
126      CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra )
127      !
128      IF( l_trdtrc ) THEN
129         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) - ztrbio(:,:,:)
130         jl = jp_lob0_trd + 7
131         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend
132         CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )
133      ENDIF
134
135      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
136         WRITE(charout, FMT="('sed')")
137         CALL prt_ctl_trc_info(charout)
138         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
139      ENDIF
140      !
141      IF( nn_timing == 1 )  CALL timing_stop('trc_sed')
142      !
143   END SUBROUTINE trc_sed
144
145#else
146   !!======================================================================
147   !!  Dummy module :                                   No PISCES bio-model
148   !!======================================================================
149CONTAINS
150   SUBROUTINE trc_sed( kt )                   ! Empty routine
151      INTEGER, INTENT( in ) ::   kt
152      WRITE(*,*) 'trc_sed: You should not have seen this print! error?', kt
153   END SUBROUTINE trc_sed
154#endif 
155
156   !!======================================================================
157END MODULE  trcsed
Note: See TracBrowser for help on using the repository browser.