p2zsed.F90 8.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196
  1. MODULE 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. IMPLICIT NONE
  25. PRIVATE
  26. PUBLIC p2z_sed ! called in ???
  27. PUBLIC p2z_sed_init ! called in ???
  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. !!* Substitution
  33. # include "top_substitute.h90"
  34. !!----------------------------------------------------------------------
  35. !! NEMO/TOP 3.3 , NEMO Consortium (2010)
  36. !! $Id: p2zsed.F90 2355 2015-05-20 07:11:50Z ufla $
  37. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  38. !!----------------------------------------------------------------------
  39. CONTAINS
  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, ztrbio
  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. ! Allocate temporary workspace
  75. CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra )
  76. IF( l_trdtrc ) THEN
  77. CALL wrk_alloc( jpi, jpj, jpk, ztrbio )
  78. ztrbio(:,:,:) = tra(:,:,:,jpdet)
  79. ENDIF
  80. ! sedimentation of detritus : upstream scheme
  81. ! --------------------------------------------
  82. ! for detritus sedimentation only - jpdet
  83. zwork(:,:,1 ) = 0.e0 ! surface value set to zero
  84. zwork(:,:,jpk) = 0.e0 ! bottom value set to zero
  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. ! tracer flux divergence at t-point added to the general trend
  90. DO jk = 1, jpkm1
  91. DO jj = 1, jpj
  92. DO ji = 1, jpi
  93. ztra(ji,jj,jk) = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
  94. tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra(ji,jj,jk)
  95. END DO
  96. END DO
  97. END DO
  98. IF( lk_iomput ) THEN
  99. IF( iom_use( "TDETSED" ) ) THEN
  100. CALL wrk_alloc( jpi, jpj, zw2d )
  101. zw2d(:,:) = ztra(:,:,1) * fse3t(:,:,1) * 86400.
  102. DO jk = 2, jpkm1
  103. zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.
  104. END DO
  105. CALL iom_put( "TDETSED", zw2d )
  106. CALL wrk_dealloc( jpi, jpj, zw2d )
  107. ENDIF
  108. ELSE
  109. IF( ln_diatrc ) THEN
  110. CALL wrk_alloc( jpi, jpj, zw2d )
  111. zw2d(:,:) = ztra(:,:,1) * fse3t(:,:,1) * 86400.
  112. DO jk = 2, jpkm1
  113. zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * fse3t(:,:,jk) * 86400.
  114. END DO
  115. trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:)
  116. CALL wrk_dealloc( jpi, jpj, zw2d )
  117. ENDIF
  118. ENDIF
  119. !
  120. IF( ln_diabio .AND. .NOT. lk_iomput ) trbio(:,:,:,jp_pcs0_trd + 7) = ztra(:,:,:)
  121. CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra )
  122. !
  123. IF( l_trdtrc ) THEN
  124. ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:)
  125. jl = jp_pcs0_trd + 7
  126. CALL trd_trc( ztrbio, jl, kt ) ! handle the trend
  127. CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )
  128. ENDIF
  129. IF(ln_ctl) THEN ! print mean trends (used for debugging)
  130. WRITE(charout, FMT="('sed')")
  131. CALL prt_ctl_trc_info(charout)
  132. CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
  133. ENDIF
  134. !
  135. IF( nn_timing == 1 ) CALL timing_stop('p2z_sed')
  136. !
  137. END SUBROUTINE p2z_sed
  138. SUBROUTINE p2z_sed_init
  139. !!----------------------------------------------------------------------
  140. !! *** ROUTINE p2z_sed_init ***
  141. !!
  142. !! ** Purpose : Parameters from aphotic layers to sediment
  143. !!
  144. !! ** Method : Read the namlobsed namelist and check the parameters
  145. !!
  146. !!----------------------------------------------------------------------
  147. NAMELIST/namlobsed/ sedlam, sedlostpoc, vsed, xhr
  148. INTEGER :: ios ! Local integer output status for namelist read
  149. REWIND( numnatp_ref ) ! Namelist namlobsed in reference namelist : Lobster sediments
  150. READ ( numnatp_ref, namlobsed, IOSTAT = ios, ERR = 901)
  151. 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlosed in reference namelist', lwp )
  152. REWIND( numnatp_cfg ) ! Namelist namlobsed in configuration namelist : Lobster sediments
  153. READ ( numnatp_cfg, namlobsed, IOSTAT = ios, ERR = 902 )
  154. 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobsed in configuration namelist', lwp )
  155. IF(lwm) WRITE ( numonp, namlobsed )
  156. IF(lwp) THEN
  157. WRITE(numout,*) ' Namelist namlobsed'
  158. WRITE(numout,*) ' time coeff of POC in sediments sedlam =', sedlam
  159. WRITE(numout,*) ' Sediment geol loss for POC sedlostpoc=', sedlostpoc
  160. WRITE(numout,*) ' detritus sedimentation speed vsed =', 86400 * vsed , ' d'
  161. WRITE(numout,*) ' coeff for martin''s remineralistion xhr =', xhr
  162. WRITE(numout,*) ' '
  163. ENDIF
  164. !
  165. END SUBROUTINE p2z_sed_init
  166. #else
  167. !!======================================================================
  168. !! Dummy module : No PISCES bio-model
  169. !!======================================================================
  170. CONTAINS
  171. SUBROUTINE p2z_sed( kt ) ! Empty routine
  172. INTEGER, INTENT( in ) :: kt
  173. WRITE(*,*) 'p2z_sed: You should not have seen this print! error?', kt
  174. END SUBROUTINE p2z_sed
  175. #endif
  176. !!======================================================================
  177. END MODULE p2zsed