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 trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z – NEMO

source: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90 @ 4609

Last change on this file since 4609 was 4609, checked in by cetlod, 10 years ago

bugfix on PISCES/P2Z, see ticket #1298

File size: 7.9 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#if defined key_pisces_reduced
11   !!----------------------------------------------------------------------
12   !!   'key_pisces_reduced'                                     LOBSTER bio-model
13   !!----------------------------------------------------------------------
14   !!   p2z_sed        :  Compute loss of organic matter in the sediments
15   !!----------------------------------------------------------------------
16   USE oce_trc         !
17   USE trc
18   USE sms_pisces
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   p2z_sed         ! called in ???
29   PUBLIC   p2z_sed_init    ! called in ???
30
31   REAL(wp), PUBLIC ::   sedlam      !: time coefficient of POC remineralization in sediments
32   REAL(wp), PUBLIC ::   sedlostpoc  ! mass of POC lost in sediments
33   REAL(wp), PUBLIC ::   vsed        ! detritus sedimentation speed [m/s]
34   REAL(wp), PUBLIC ::   xhr         ! coeff for martin''s remineralisation profile
35
36   !!* Substitution
37#  include "top_substitute.h90"
38   !!----------------------------------------------------------------------
39   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
40   !! $Id: p2z_sed.F90 3294 2012-01-28 16:44:18Z rblod $
41   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
42   !!----------------------------------------------------------------------
43
44CONTAINS
45
46   SUBROUTINE p2z_sed( kt )
47      !!---------------------------------------------------------------------
48      !!                     ***  ROUTINE p2z_sed  ***
49      !!
50      !! ** Purpose :   compute the now trend due to the vertical sedimentation of
51      !!              detritus and add it to the general trend of detritus equations
52      !!
53      !! ** Method  :   this ROUTINE compute not exactly the advection but the
54      !!              transport term, i.e.  dz(wt) and dz(ws)., dz(wtr)
55      !!              using an upstream scheme
56      !!              the now vertical advection of tracers is given by:
57      !!                      dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) )
58      !!              add this trend now to the general trend of tracer (ta,sa,tra):
59      !!                             tra = tra + dz(trn wn)
60      !!       
61      !!              IF 'key_diabio' is defined, the now vertical advection
62      !!              trend of passive tracers is saved for futher diagnostics.
63      !!---------------------------------------------------------------------
64      !!
65      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
66      !!
67      INTEGER  ::   ji, jj, jk, jl, ierr
68      CHARACTER (len=25) :: charout
69      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d
70      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra, ztrbio
71      !!---------------------------------------------------------------------
72      !
73      IF( nn_timing == 1 )  CALL timing_start('p2z_sed')
74      !
75      IF( kt == nittrc000 ) THEN
76         IF(lwp) WRITE(numout,*)
77         IF(lwp) WRITE(numout,*) ' p2z_sed: LOBSTER sedimentation'
78         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
79      ENDIF
80
81      ! Allocate temporary workspace
82      CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra )
83      IF( l_trdtrc ) THEN
84         CALL wrk_alloc( jpi, jpj, jpk, ztrbio )
85         ztrbio(:,:,:) = tra(:,:,:,jpdet)
86      ENDIF
87
88      ! sedimentation of detritus  : upstream scheme
89      ! --------------------------------------------
90
91      ! for detritus sedimentation only - jpdet
92      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
93      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
94
95      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
96      DO jk = 2, jpkm1
97         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet)
98      END DO
99
100      ! tracer flux divergence at t-point added to the general trend
101      DO jk = 1, jpkm1
102         DO jj = 1, jpj
103            DO ji = 1, jpi
104               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
105               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk) 
106            END DO
107         END DO
108      END DO
109
110      IF( ln_diatrc ) THEN
111         CALL wrk_alloc( jpi, jpj, zw2d )
112         zw2d(:,:) =  ztra(:,:,1) * fse3t(:,:,1) * 86400.
113         DO jk = 2, jpkm1
114            zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.
115         END DO
116         IF( lk_iomput )  THEN
117           CALL iom_put( "TDETSED", zw2d )
118         ELSE
119           trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:)
120         ENDIF
121         CALL wrk_dealloc( jpi, jpj, zw2d )
122      ENDIF
123      !
124      IF( ln_diabio .AND. .NOT. lk_iomput )  trbio(:,:,:,jp_pcs0_trd + 7) = ztra(:,:,:)
125      CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra )
126      !
127      IF( l_trdtrc ) THEN
128         ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:)
129         jl = jp_pcs0_trd + 7
130         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend
131         CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )
132      ENDIF
133
134      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
135         WRITE(charout, FMT="('sed')")
136         CALL prt_ctl_trc_info(charout)
137         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
138      ENDIF
139      !
140      IF( nn_timing == 1 )  CALL timing_stop('p2z_sed')
141      !
142   END SUBROUTINE p2z_sed
143
144   SUBROUTINE p2z_sed_init
145      !!----------------------------------------------------------------------
146      !!                  ***  ROUTINE p2z_sed_init  ***
147      !!
148      !! ** Purpose :   Parameters from aphotic layers to sediment
149      !!
150      !! ** Method  :   Read the namlobsed namelist and check the parameters
151      !!
152      !!----------------------------------------------------------------------
153      NAMELIST/namlobsed/ sedlam, sedlostpoc, vsed, xhr
154      INTEGER :: ios                 ! Local integer output status for namelist read
155
156      REWIND( numnatp_ref )              ! Namelist namlobsed in reference namelist : Lobster sediments
157      READ  ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901)
158901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp )
159
160      REWIND( numnatp_cfg )              ! Namelist namlobsed in configuration namelist : Lobster sediments
161      READ  ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 )
162902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp )
163      WRITE ( numonp, namlobsed )
164
165      IF(lwp) THEN
166          WRITE(numout,*) ' Namelist namlobsed'
167          WRITE(numout,*) '    time coeff of POC in sediments                       sedlam    =', sedlam
168          WRITE(numout,*) '    Sediment geol loss for POC                           sedlostpoc=', sedlostpoc
169          WRITE(numout,*) '    detritus sedimentation speed                         vsed      =', 86400 * vsed  , ' d'
170          WRITE(numout,*) '    coeff for martin''s remineralistion                  xhr       =', xhr
171          WRITE(numout,*) ' '
172      ENDIF
173      !
174   END SUBROUTINE p2z_sed_init
175
176#else
177   !!======================================================================
178   !!  Dummy module :                                   No PISCES bio-model
179   !!======================================================================
180CONTAINS
181   SUBROUTINE p2z_sed( kt )                   ! Empty routine
182      INTEGER, INTENT( in ) ::   kt
183      WRITE(*,*) 'p2z_sed: You should not have seen this print! error?', kt
184   END SUBROUTINE p2z_sed
185#endif 
186
187   !!======================================================================
188END MODULE  p2zsed
Note: See TracBrowser for help on using the repository browser.