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.
p2zsed.F90 in branches/UKMO/r8395_cpl_tauwav/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z – NEMO

source: branches/UKMO/r8395_cpl_tauwav/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90 @ 12286

Last change on this file since 12286 was 12286, checked in by jcastill, 4 years ago

Remove svn keywords

File size: 6.7 KB
Line 
1MODULE p2zsed
2   !!======================================================================
3   !!                         ***  MODULE p2zsed  ***
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   !!   p2z_sed        :  Compute loss of organic matter in the sediments
11   !!----------------------------------------------------------------------
12   USE oce_trc         !
13   USE trc
14   USE sms_pisces
15   USE lbclnk
16   USE trd_oce
17   USE trdtrc
18   USE iom
19   USE prtctl_trc      ! Print control for debbuging
20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC   p2z_sed         ! called in ???
25   PUBLIC   p2z_sed_init    ! called in ???
26
27   REAL(wp), PUBLIC ::   sedlam      !: time coefficient of POC remineralization in sediments
28   REAL(wp), PUBLIC ::   sedlostpoc  ! mass of POC lost in sediments
29   REAL(wp), PUBLIC ::   vsed        ! detritus sedimentation speed [m/s]
30   REAL(wp), PUBLIC ::   xhr         ! coeff for martin''s remineralisation profile
31
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 p2z_sed( kt )
41      !!---------------------------------------------------------------------
42      !!                     ***  ROUTINE p2z_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
65      !!---------------------------------------------------------------------
66      !
67      IF( nn_timing == 1 )  CALL timing_start('p2z_sed')
68      !
69      IF( kt == nittrc000 ) THEN
70         IF(lwp) WRITE(numout,*)
71         IF(lwp) WRITE(numout,*) ' p2z_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      ! sedimentation of detritus  : upstream scheme
79      ! --------------------------------------------
80
81      ! for detritus sedimentation only - jpdet
82      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
83      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
84
85      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
86      DO jk = 2, jpkm1
87         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet)
88      END DO
89
90      ! tracer flux divergence at t-point added to the general trend
91      DO jk = 1, jpkm1
92         DO jj = 1, jpj
93            DO ji = 1, jpi
94               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t_n(ji,jj,jk)
95               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk) 
96            END DO
97         END DO
98      END DO
99
100      IF( lk_iomput )  THEN
101         IF( iom_use( "TDETSED" ) ) THEN
102            CALL wrk_alloc( jpi, jpj, zw2d )
103            zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp
104            DO jk = 2, jpkm1
105               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp
106            END DO
107            CALL iom_put( "TDETSED", zw2d )
108            CALL wrk_dealloc( jpi, jpj, zw2d )
109         ENDIF
110      ENDIF
111      !
112      CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra )
113      !
114
115      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
116         WRITE(charout, FMT="('sed')")
117         CALL prt_ctl_trc_info(charout)
118         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
119      ENDIF
120      !
121      IF( nn_timing == 1 )  CALL timing_stop('p2z_sed')
122      !
123   END SUBROUTINE p2z_sed
124
125   SUBROUTINE p2z_sed_init
126      !!----------------------------------------------------------------------
127      !!                  ***  ROUTINE p2z_sed_init  ***
128      !!
129      !! ** Purpose :   Parameters from aphotic layers to sediment
130      !!
131      !! ** Method  :   Read the namlobsed namelist and check the parameters
132      !!
133      !!----------------------------------------------------------------------
134      NAMELIST/namlobsed/ sedlam, sedlostpoc, vsed, xhr
135      INTEGER :: ios                 ! Local integer output status for namelist read
136
137      REWIND( numnatp_ref )              ! Namelist namlobsed in reference namelist : Lobster sediments
138      READ  ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901)
139901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp )
140
141      REWIND( numnatp_cfg )              ! Namelist namlobsed in configuration namelist : Lobster sediments
142      READ  ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 )
143902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp )
144      IF(lwm) WRITE ( numonp, namlobsed )
145
146      IF(lwp) THEN
147          WRITE(numout,*) ' Namelist namlobsed'
148          WRITE(numout,*) '    time coeff of POC in sediments                       sedlam    =', sedlam
149          WRITE(numout,*) '    Sediment geol loss for POC                           sedlostpoc=', sedlostpoc
150          WRITE(numout,*) '    detritus sedimentation speed                         vsed      =', 86400 * vsed  , ' d'
151          WRITE(numout,*) '    coeff for martin''s remineralistion                  xhr       =', xhr
152          WRITE(numout,*) ' '
153      ENDIF
154      !
155   END SUBROUTINE p2z_sed_init
156
157   !!======================================================================
158END MODULE  p2zsed
Note: See TracBrowser for help on using the repository browser.