123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196 |
- MODULE p2zsed
- !!======================================================================
- !! *** MODULE p2zsed ***
- !! TOP : PISCES Compute loss of organic matter in the sediments
- !!======================================================================
- !! History : - ! 1995-06 (M. Levy) original code
- !! - ! 2000-12 (E. Kestenare) clean up
- !! 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 + simplifications
- !!----------------------------------------------------------------------
- #if defined key_pisces_reduced
- !!----------------------------------------------------------------------
- !! 'key_pisces_reduced' LOBSTER bio-model
- !!----------------------------------------------------------------------
- !! p2z_sed : Compute loss of organic matter in the sediments
- !!----------------------------------------------------------------------
- USE oce_trc !
- USE trc
- USE sms_pisces
- USE lbclnk
- USE trd_oce
- USE trdtrc
- USE iom
- USE prtctl_trc ! Print control for debbuging
- IMPLICIT NONE
- PRIVATE
- PUBLIC p2z_sed ! called in ???
- PUBLIC p2z_sed_init ! called in ???
- REAL(wp), PUBLIC :: sedlam !: time coefficient of POC remineralization in sediments
- REAL(wp), PUBLIC :: sedlostpoc ! mass of POC lost in sediments
- REAL(wp), PUBLIC :: vsed ! detritus sedimentation speed [m/s]
- REAL(wp), PUBLIC :: xhr ! coeff for martin''s remineralisation profile
- !!* Substitution
- # include "top_substitute.h90"
- !!----------------------------------------------------------------------
- !! NEMO/TOP 3.3 , NEMO Consortium (2010)
- !! $Id: p2zsed.F90 2355 2015-05-20 07:11:50Z ufla $
- !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
- !!----------------------------------------------------------------------
- CONTAINS
- SUBROUTINE p2z_sed( kt )
- !!---------------------------------------------------------------------
- !! *** ROUTINE p2z_sed ***
- !!
- !! ** Purpose : compute the now trend due to the vertical sedimentation of
- !! detritus and add it to the general trend of detritus equations
- !!
- !! ** Method : this ROUTINE compute not exactly the advection but the
- !! transport term, i.e. dz(wt) and dz(ws)., dz(wtr)
- !! using an upstream scheme
- !! the now vertical advection of tracers is given by:
- !! dz(trn wn) = 1/bt dk+1( e1t e2t vsed (trn) )
- !! add this trend now to the general trend of tracer (ta,sa,tra):
- !! tra = tra + dz(trn wn)
- !!
- !! IF 'key_diabio' is defined, the now vertical advection
- !! trend of passive tracers is saved for futher diagnostics.
- !!---------------------------------------------------------------------
- !!
- INTEGER, INTENT( in ) :: kt ! ocean time-step index
- !!
- INTEGER :: ji, jj, jk, jl, ierr
- CHARACTER (len=25) :: charout
- REAL(wp), POINTER, DIMENSION(:,: ) :: zw2d
- REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra, ztrbio
- !!---------------------------------------------------------------------
- !
- IF( nn_timing == 1 ) CALL timing_start('p2z_sed')
- !
- IF( kt == nittrc000 ) THEN
- IF(lwp) WRITE(numout,*)
- IF(lwp) WRITE(numout,*) ' p2z_sed: LOBSTER sedimentation'
- IF(lwp) WRITE(numout,*) ' ~~~~~~~'
- ENDIF
- ! Allocate temporary workspace
- CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra )
- IF( l_trdtrc ) THEN
- CALL wrk_alloc( jpi, jpj, jpk, ztrbio )
- ztrbio(:,:,:) = tra(:,:,:,jpdet)
- ENDIF
- ! sedimentation of detritus : upstream scheme
- ! --------------------------------------------
- ! for detritus sedimentation only - jpdet
- zwork(:,:,1 ) = 0.e0 ! surface value set to zero
- zwork(:,:,jpk) = 0.e0 ! bottom value set to zero
- ! tracer flux at w-point: we use -vsed (downward flux) with simplification : no e1*e2
- DO jk = 2, jpkm1
- zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet)
- END DO
- ! tracer flux divergence at t-point added to the general trend
- DO jk = 1, jpkm1
- DO jj = 1, jpj
- DO ji = 1, jpi
- ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
- tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk)
- END DO
- END DO
- END DO
- IF( lk_iomput ) THEN
- IF( iom_use( "TDETSED" ) ) THEN
- CALL wrk_alloc( jpi, jpj, zw2d )
- zw2d(:,:) = ztra(:,:,1) * fse3t(:,:,1) * 86400.
- DO jk = 2, jpkm1
- zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.
- END DO
- CALL iom_put( "TDETSED", zw2d )
- CALL wrk_dealloc( jpi, jpj, zw2d )
- ENDIF
- ELSE
- IF( ln_diatrc ) THEN
- CALL wrk_alloc( jpi, jpj, zw2d )
- zw2d(:,:) = ztra(:,:,1) * fse3t(:,:,1) * 86400.
- DO jk = 2, jpkm1
- zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.
- END DO
- trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:)
- CALL wrk_dealloc( jpi, jpj, zw2d )
- ENDIF
- ENDIF
- !
- IF( ln_diabio .AND. .NOT. lk_iomput ) trbio(:,:,:,jp_pcs0_trd + 7) = ztra(:,:,:)
- CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra )
- !
- IF( l_trdtrc ) THEN
- ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:)
- jl = jp_pcs0_trd + 7
- CALL trd_trc( ztrbio, jl, kt ) ! handle the trend
- CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )
- ENDIF
- IF(ln_ctl) THEN ! print mean trends (used for debugging)
- WRITE(charout, FMT="('sed')")
- CALL prt_ctl_trc_info(charout)
- CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
- ENDIF
- !
- IF( nn_timing == 1 ) CALL timing_stop('p2z_sed')
- !
- END SUBROUTINE p2z_sed
- SUBROUTINE p2z_sed_init
- !!----------------------------------------------------------------------
- !! *** ROUTINE p2z_sed_init ***
- !!
- !! ** Purpose : Parameters from aphotic layers to sediment
- !!
- !! ** Method : Read the namlobsed namelist and check the parameters
- !!
- !!----------------------------------------------------------------------
- NAMELIST/namlobsed/ sedlam, sedlostpoc, vsed, xhr
- INTEGER :: ios ! Local integer output status for namelist read
- REWIND( numnatp_ref ) ! Namelist namlobsed in reference namelist : Lobster sediments
- READ ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901)
- 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp )
- REWIND( numnatp_cfg ) ! Namelist namlobsed in configuration namelist : Lobster sediments
- READ ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 )
- 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp )
- IF(lwm) WRITE ( numonp, namlobsed )
- IF(lwp) THEN
- WRITE(numout,*) ' Namelist namlobsed'
- WRITE(numout,*) ' time coeff of POC in sediments sedlam =', sedlam
- WRITE(numout,*) ' Sediment geol loss for POC sedlostpoc=', sedlostpoc
- WRITE(numout,*) ' detritus sedimentation speed vsed =', 86400 * vsed , ' d'
- WRITE(numout,*) ' coeff for martin''s remineralistion xhr =', xhr
- WRITE(numout,*) ' '
- ENDIF
- !
- END SUBROUTINE p2z_sed_init
- #else
- !!======================================================================
- !! Dummy module : No PISCES bio-model
- !!======================================================================
- CONTAINS
- SUBROUTINE p2z_sed( kt ) ! Empty routine
- INTEGER, INTENT( in ) :: kt
- WRITE(*,*) 'p2z_sed: You should not have seen this print! error?', kt
- END SUBROUTINE p2z_sed
- #endif
- !!======================================================================
- END MODULE p2zsed
|