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

source: branches/UKMO/r5936_hadgem3_cplseq/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90 @ 7131

Last change on this file since 7131 was 7131, checked in by jcastill, 7 years ago

Remove svn keywords

File size: 8.2 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 trd_oce
21   USE trdtrc
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   !! * Substitutions
37#  include "domzgr_substitute.h90"
38   !!----------------------------------------------------------------------
39   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
40   !! $Id$
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( lk_iomput )  THEN
111         IF( iom_use( "TDETSED" ) ) THEN
112            CALL wrk_alloc( jpi, jpj, zw2d )
113            zw2d(:,:) =  ztra(:,:,1) * fse3t(:,:,1) * 86400.
114            DO jk = 2, jpkm1
115               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.
116            END DO
117            CALL iom_put( "TDETSED", zw2d )
118            CALL wrk_dealloc( jpi, jpj, zw2d )
119         ENDIF
120      ELSE
121         IF( ln_diatrc ) THEN
122            CALL wrk_alloc( jpi, jpj, zw2d )
123            zw2d(:,:) =  ztra(:,:,1) * fse3t(:,:,1) * 86400.
124            DO jk = 2, jpkm1
125               zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.
126            END DO
127            trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:)
128            CALL wrk_dealloc( jpi, jpj, zw2d )
129         ENDIF
130      ENDIF
131      !
132      IF( ln_diabio .AND. .NOT. lk_iomput )  trbio(:,:,:,jp_pcs0_trd + 7) = ztra(:,:,:)
133      CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra )
134      !
135      IF( l_trdtrc ) THEN
136         ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:)
137         jl = jp_pcs0_trd + 7
138         CALL trd_trc( ztrbio, jl, kt )   ! handle the trend
139         CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )
140      ENDIF
141
142      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
143         WRITE(charout, FMT="('sed')")
144         CALL prt_ctl_trc_info(charout)
145         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
146      ENDIF
147      !
148      IF( nn_timing == 1 )  CALL timing_stop('p2z_sed')
149      !
150   END SUBROUTINE p2z_sed
151
152   SUBROUTINE p2z_sed_init
153      !!----------------------------------------------------------------------
154      !!                  ***  ROUTINE p2z_sed_init  ***
155      !!
156      !! ** Purpose :   Parameters from aphotic layers to sediment
157      !!
158      !! ** Method  :   Read the namlobsed namelist and check the parameters
159      !!
160      !!----------------------------------------------------------------------
161      NAMELIST/namlobsed/ sedlam, sedlostpoc, vsed, xhr
162      INTEGER :: ios                 ! Local integer output status for namelist read
163
164      REWIND( numnatp_ref )              ! Namelist namlobsed in reference namelist : Lobster sediments
165      READ  ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901)
166901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp )
167
168      REWIND( numnatp_cfg )              ! Namelist namlobsed in configuration namelist : Lobster sediments
169      READ  ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 )
170902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp )
171      IF(lwm) WRITE ( numonp, namlobsed )
172
173      IF(lwp) THEN
174          WRITE(numout,*) ' Namelist namlobsed'
175          WRITE(numout,*) '    time coeff of POC in sediments                       sedlam    =', sedlam
176          WRITE(numout,*) '    Sediment geol loss for POC                           sedlostpoc=', sedlostpoc
177          WRITE(numout,*) '    detritus sedimentation speed                         vsed      =', 86400 * vsed  , ' d'
178          WRITE(numout,*) '    coeff for martin''s remineralistion                  xhr       =', xhr
179          WRITE(numout,*) ' '
180      ENDIF
181      !
182   END SUBROUTINE p2z_sed_init
183
184#else
185   !!======================================================================
186   !!  Dummy module :                                   No PISCES bio-model
187   !!======================================================================
188CONTAINS
189   SUBROUTINE p2z_sed( kt )                   ! Empty routine
190      INTEGER, INTENT( in ) ::   kt
191      WRITE(*,*) 'p2z_sed: You should not have seen this print! error?', kt
192   END SUBROUTINE p2z_sed
193#endif 
194
195   !!======================================================================
196END MODULE  p2zsed
Note: See TracBrowser for help on using the repository browser.