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 NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P2Z – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P2Z/p2zsed.F90 @ 10975

Last change on this file since 10975 was 10975, checked in by acc, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Finish converting all TOP routines and knock-on effects of these conversions. Fully SETTE tested (SETTE tests 1-6 and 9). This completes the first stage conversion of TRA and TOP but need to revisit and pass ts and tr arrays through the argument lists where appropriate.

  • Property svn:keywords set to Id
File size: 6.8 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 trd_oce         !
14   USE trdtrc          !
15   USE trc             !
16   USE sms_pisces      !
17   !
18   USE lbclnk          !
19   USE iom             !
20   USE prtctl_trc      ! Print control for debbuging
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   p2z_sed         ! called in ???
26   PUBLIC   p2z_sed_init    ! called in ???
27
28   REAL(wp), PUBLIC ::   sedlam      !: time coefficient of POC remineralization in sediments
29   REAL(wp), PUBLIC ::   sedlostpoc  !: mass of POC lost in sediments
30   REAL(wp), PUBLIC ::   vsed        !: detritus sedimentation speed [m/s]
31   REAL(wp), PUBLIC ::   xhr         !: coeff for martin''s remineralisation profile
32
33   !!----------------------------------------------------------------------
34   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
35   !! $Id$
36   !! Software governed by the CeCILL license (see ./LICENSE)
37   !!----------------------------------------------------------------------
38CONTAINS
39
40   SUBROUTINE p2z_sed( kt, Kmm, Krhs )
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(tr(:,:,:,:,Kmm) ww) = 1/bt dk+1( e1t e2t vsed (tr(:,:,:,:,Kmm)) )
52      !!              add this trend now to the general trend of tracer (ta,sa,tr(:,:,:,:,Krhs)):
53      !!                             tr(:,:,:,:,Krhs) = tr(:,:,:,:,Krhs) + dz(tr(:,:,:,:,Kmm) ww)
54      !!       
55      !!              IF 'key_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      INTEGER, INTENT( in ) ::   Kmm, Krhs  ! time level indices
60      !
61      INTEGER  ::   ji, jj, jk, jl, ierr
62      CHARACTER (len=25) :: charout
63      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d
64      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork, ztra
65      !!---------------------------------------------------------------------
66      !
67      IF( ln_timing )   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      ! sedimentation of detritus  : upstream scheme
76      ! --------------------------------------------
77
78      ! for detritus sedimentation only - jpdet
79      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
80      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
81
82      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
83      DO jk = 2, jpkm1
84         zwork(:,:,jk) = -vsed * tr(:,:,jk-1,jpdet,Kmm)
85      END DO
86
87      ! tracer flux divergence at t-point added to the general trend
88      DO jk = 1, jpkm1
89         DO jj = 1, jpj
90            DO ji = 1, jpi
91               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm)
92               tr(ji,jj,jk,jpdet,Krhs) = tr(ji,jj,jk,jpdet,Krhs) + ztra(ji,jj,jk) 
93            END DO
94         END DO
95      END DO
96
97      IF( lk_iomput )  THEN
98         IF( iom_use( "TDETSED" ) ) THEN
99            ALLOCATE( zw2d(jpi,jpj) )
100            zw2d(:,:) =  ztra(:,:,1) * e3t(:,:,1,Kmm) * 86400._wp
101            DO jk = 2, jpkm1
102               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t(:,:,jk,Kmm) * 86400._wp
103            END DO
104            CALL iom_put( "TDETSED", zw2d )
105            DEALLOCATE( zw2d )
106         ENDIF
107      ENDIF
108      !
109
110      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
111         WRITE(charout, FMT="('sed')")
112         CALL prt_ctl_trc_info(charout)
113         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
114      ENDIF
115      !
116      IF( ln_timing )   CALL timing_stop('p2z_sed')
117      !
118   END SUBROUTINE p2z_sed
119
120
121   SUBROUTINE p2z_sed_init
122      !!----------------------------------------------------------------------
123      !!                  ***  ROUTINE p2z_sed_init  ***
124      !!
125      !! ** Purpose :   Parameters from aphotic layers to sediment
126      !!
127      !! ** Method  :   Read the namlobsed namelist and check the parameters
128      !!
129      !!----------------------------------------------------------------------
130      INTEGER ::   ios   ! Local integer
131      !!
132      NAMELIST/namlobsed/ sedlam, sedlostpoc, vsed, xhr
133      !!----------------------------------------------------------------------
134      !
135      REWIND( numnatp_ref )              ! Namelist namlobsed in reference namelist : Lobster sediments
136      READ  ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901)
137901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp )
138      REWIND( numnatp_cfg )              ! Namelist namlobsed in configuration namelist : Lobster sediments
139      READ  ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 )
140902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp )
141      IF(lwm) WRITE ( numonp, namlobsed )
142      !
143      IF(lwp) THEN
144          WRITE(numout,*) '   Namelist namlobsed'
145          WRITE(numout,*) '      time coeff of POC in sediments                sedlam    =', sedlam
146          WRITE(numout,*) '      Sediment geol loss for POC                    sedlostpoc=', sedlostpoc
147          WRITE(numout,*) '      detritus sedimentation speed                  vsed      =', 86400 * vsed  , ' d'
148          WRITE(numout,*) '      coeff for martin''s remineralistion           xhr       =', xhr
149          WRITE(numout,*) ' '
150      ENDIF
151      !
152   END SUBROUTINE p2z_sed_init
153
154   !!======================================================================
155END MODULE p2zsed
Note: See TracBrowser for help on using the repository browser.