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.
p5zmort.F90 in NEMO/trunk/src/TOP/PISCES/P4Z – NEMO

source: NEMO/trunk/src/TOP/PISCES/P4Z/p5zmort.F90

Last change on this file was 15459, checked in by cetlod, 2 years ago

Various bug fixes and more comments in PISCES routines ; sette test OK in debug mode, nn_hls=1/2, with tiling ; run.stat unchanged ; of course tracer.stat different

  • Property svn:keywords set to Id
File size: 15.7 KB
RevLine 
[7162]1MODULE p5zmort
2   !!======================================================================
3   !!                         ***  MODULE p5zmort  ***
[15459]4   !! TOP :   PISCES-QUOTA Compute the mortality terms for phytoplankton
[7162]5   !!======================================================================
6   !! History :   1.0  !  2002     (O. Aumont)  Original code
7   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
8   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
9   !!----------------------------------------------------------------------
10   !!   p5z_mort       :   Compute the mortality terms for phytoplankton
11   !!   p5z_mort_init  :   Initialize the mortality params for phytoplankton
12   !!----------------------------------------------------------------------
13   USE oce_trc         !  shared variables between ocean and passive tracers
14   USE trc             !  passive tracers common variables
15   USE sms_pisces      !  PISCES Source Minus Sink variables
[15459]16   USE p4zlim          !  Phytoplankton limitation terms (p4z)
17   USE p5zlim          !  Phytoplankton limitation terms (p5z)
[13286]18   USE prtctl          !  print control for debugging
[7162]19
20   IMPLICIT NONE
21   PRIVATE
22
[15459]23   PUBLIC   p5z_mort           ! Called from p4zbio.F90
24   PUBLIC   p5z_mort_init      ! Called from trcini_pisces.F90
[7162]25
26   !! * Shared module variables
[15459]27   REAL(wp), PUBLIC :: wchln   !! Quadratic mortality rate of nanophytoplankton
28   REAL(wp), PUBLIC :: wchlp   !: Quadratic mortality rate of picophytoplankton
29   REAL(wp), PUBLIC :: wchld   !: Quadratic mortality rate of diatoms
30   REAL(wp), PUBLIC :: mpratn  !: Linear mortality rate of nanophytoplankton
31   REAL(wp), PUBLIC :: mpratp  !: Linear mortality rate of picophytoplankton
32   REAL(wp), PUBLIC :: mpratd  !: Linear mortality rate of diatoms
[7162]33
[12377]34   !! * Substitutions
35#  include "do_loop_substitute.h90"
[7162]36   !!----------------------------------------------------------------------
[10067]37   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[10068]38   !! $Id$
39   !! Software governed by the CeCILL license (see ./LICENSE)
[7162]40   !!----------------------------------------------------------------------
41
42CONTAINS
43
[12377]44   SUBROUTINE p5z_mort( kt, Kbb, Krhs )
[7162]45      !!---------------------------------------------------------------------
46      !!                     ***  ROUTINE p5z_mort  ***
47      !!
[15459]48      !! ** Purpose :   Calls the different subroutine to compute
[7162]49      !!                the different phytoplankton mortality terms
50      !!
51      !! ** Method  : - ???
52      !!---------------------------------------------------------------------
53      INTEGER, INTENT(in) ::   kt ! ocean time step
[12377]54      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
[7162]55      !!---------------------------------------------------------------------
56
[15459]57      CALL p5z_mort_nano( Kbb, Krhs )            ! nanophytoplankton
58      CALL p5z_mort_pico( Kbb, Krhs )            ! picophytoplankton
59      CALL p5z_mort_diat( Kbb, Krhs )            ! diatoms
[7162]60
61   END SUBROUTINE p5z_mort
62
63
[15459]64   SUBROUTINE p5z_mort_nano( Kbb, Krhs )
[7162]65      !!---------------------------------------------------------------------
[15459]66      !!                     ***  ROUTINE p5z_mort_nano  ***
[7162]67      !!
68      !! ** Purpose :   Compute the mortality terms for nanophytoplankton
69      !!
[15459]70      !! ** Method  : - Both quadratic and simili linear mortality terms
[7162]71      !!---------------------------------------------------------------------
[12377]72      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
[7162]73      INTEGER  :: ji, jj, jk
[15459]74      REAL(wp) :: zcompaph, zlim1, zlim2
[7162]75      REAL(wp) :: zfactfe, zfactch, zfactn, zfactp, zprcaca
76      REAL(wp) :: ztortp , zrespp , zmortp
77      CHARACTER (len=25) :: charout
78      !!---------------------------------------------------------------------
79      !
[15459]80      IF( ln_timing )   CALL timing_start('p5z_mort_nano')
[7162]81      !
82      prodcal(:,:,:) = 0.  !: calcite production variable set to zero
[15090]83      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
[12377]84         zcompaph = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - 1e-9 ), 0.e0 )
[7162]85
[15459]86         ! Quadratic mortality of nano due to aggregation during
87         ! blooms (Doney et al. 1996)
88         ! -----------------------------------------------------
89         zlim2   = xlimphy(ji,jj,jk) * xlimphy(ji,jj,jk)
90         zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) * tr(ji,jj,jk,jpphy,Kbb)
91         zrespp = wchln * 1.e6 * xstep * zlim1 * xdiss(ji,jj,jk) * zcompaph
92
93         ! Phytoplankton linear mortality
94         ! A michaelis-menten like term is introduced to avoid
95         ! extinction of nanophyto in highly limited areas
96         ! ----------------------------------------------------
97         ztortp = mpratn * xstep * zcompaph * tr(ji,jj,jk,jpphy,Kbb) / ( xkmort + tr(ji,jj,jk,jpphy,Kbb) )
[12377]98         zmortp = zrespp + ztortp
[7162]99
[12377]100         !   Update the arrays TRA which contains the biological sources and sinks
101         zfactn  = tr(ji,jj,jk,jpnph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
102         zfactp  = tr(ji,jj,jk,jppph,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
103         zfactfe = tr(ji,jj,jk,jpnfe,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
104         zfactch = tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
105         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zmortp
106         tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) - zmortp * zfactn
107         tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) - zmortp * zfactp
108         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zmortp * zfactch
109         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zmortp * zfactfe
[15459]110
111                       ! Production PIC particles due to mortality
[12377]112         zprcaca = xfracal(ji,jj,jk) * zmortp
113         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
114         !
115         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca
116         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca
117         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca
118         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp
119         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn
120         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp
121         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp
122         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe
123      END_3D
[7162]124      !
[12377]125       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
[7162]126         WRITE(charout, FMT="('nano')")
[13286]127         CALL prt_ctl_info( charout, cdcomp = 'top' )
128         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
[7162]129       ENDIF
130      !
[15459]131      IF( ln_timing )   CALL timing_stop('p5z_mort_nano')
[7162]132      !
[15459]133   END SUBROUTINE p5z_mort_nano
[7162]134
[9124]135
[15459]136   SUBROUTINE p5z_mort_pico( Kbb, Krhs )
[7162]137      !!---------------------------------------------------------------------
[15459]138      !!                     ***  ROUTINE p5z_mort_pico  ***
[7162]139      !!
140      !! ** Purpose :   Compute the mortality terms for picophytoplankton
141      !!
[15459]142      !! ** Method  : - Both quadratic and semilininear terms are used
[7162]143      !!---------------------------------------------------------------------
[12377]144      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
[7162]145      INTEGER  :: ji, jj, jk
[15459]146      REAL(wp) :: zcompaph, zlim1, zlim2
[7162]147      REAL(wp) :: zfactfe, zfactch, zfactn, zfactp
148      REAL(wp) :: ztortp , zrespp , zmortp 
149      CHARACTER (len=25) :: charout
150      !!---------------------------------------------------------------------
151      !
[15459]152      IF( ln_timing )   CALL timing_start('p5z_mort_pico')
[7162]153      !
[15090]154      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
[12377]155         zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 )
[7162]156
[15459]157         ! Quadratic mortality of pico due to aggregation during
158         ! blooms (Doney et al. 1996)
159         ! -----------------------------------------------------
160         zlim2   = xlimpic(ji,jj,jk) * xlimpic(ji,jj,jk)
161         zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) * tr(ji,jj,jk,jppic,Kbb)
162         zrespp = wchlp * 1.e6 * xstep * zlim1 * xdiss(ji,jj,jk) * zcompaph
163
164         ! Phytoplankton linear mortality
165         ! A michaelis-menten like term is introduced to avoid
166         ! extinction of picophyto in highly limited areas
167         ! ----------------------------------------------------
168         ztortp = mpratp * xstep  * zcompaph * tr(ji,jj,jk,jppic,Kbb) /  ( xkmort + tr(ji,jj,jk,jppic,Kbb) )
[12377]169         zmortp = zrespp + ztortp
[7162]170
[12377]171         !   Update the arrays TRA which contains the biological sources and sinks
172         zfactn = tr(ji,jj,jk,jpnpi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
173         zfactp = tr(ji,jj,jk,jpppi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
174         zfactfe = tr(ji,jj,jk,jppfe,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
175         zfactch = tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
176         tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zmortp
177         tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zmortp * zfactn
178         tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zmortp * zfactp
179         tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zmortp * zfactch
180         tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zmortp * zfactfe
181         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp
182         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn
183         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp
184         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe
185         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp
186      END_3D
[7162]187      !
[12377]188       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
[7162]189         WRITE(charout, FMT="('pico')")
[13286]190         CALL prt_ctl_info( charout, cdcomp = 'top' )
191         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
[7162]192       ENDIF
193      !
[15459]194      IF( ln_timing )   CALL timing_stop('p5z_mort_pico')
[7162]195      !
[15459]196   END SUBROUTINE p5z_mort_pico
[7162]197
198
[15459]199   SUBROUTINE p5z_mort_diat( Kbb, Krhs )
[7162]200      !!---------------------------------------------------------------------
[15459]201      !!                     ***  ROUTINE p5z_mort_diat  ***
[7162]202      !!
203      !! ** Purpose :   Compute the mortality terms for diatoms
204      !!
205      !! ** Method  : - ???
206      !!---------------------------------------------------------------------
[12377]207      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
[7162]208      INTEGER  ::  ji, jj, jk
209      REAL(wp) ::  zfactfe,zfactsi,zfactch, zfactn, zfactp, zcompadi
210      REAL(wp) ::  zrespp2, ztortp2, zmortp2
211      REAL(wp) ::  zlim2, zlim1
212      CHARACTER (len=25) :: charout
213      !!---------------------------------------------------------------------
214      !
[15459]215      IF( ln_timing )   CALL timing_start('p5z_mort_diat')
[7162]216      !
217
[15090]218      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
[7162]219
[12377]220         zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. )
[7162]221
[12377]222         !   Aggregation term for diatoms is increased in case of nutrient
223         !   stress as observed in reality. The stressed cells become more
224         !   sticky and coagulate to sink quickly out of the euphotic zone
225         !   -------------------------------------------------------------
226         !  Phytoplankton squared mortality
227         !  -------------------------------
228         zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
229         zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
[15459]230         zrespp2 = 1.e6 * xstep * wchld * zlim1 * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb)
[7162]231
[15459]232         ! Phytoplankton linear mortality
233         ! A michaelis-menten like term is introduced to avoid
234         ! extinction of diatoms in highly limited areas
235         !  ---------------------------------------------------
236         ztortp2 = mpratd * xstep  * zcompadi * tr(ji,jj,jk,jpdia,Kbb) /  ( xkmort + tr(ji,jj,jk,jpdia,Kbb) )
[12377]237         zmortp2 = zrespp2 + ztortp2
[7162]238
[12377]239         !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks
240         !   ---------------------------------------------------------------------
241         zfactn  = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
242         zfactp  = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
243         zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
244         zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
245         zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
246         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 
247         tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zmortp2 * zfactn
248         tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zmortp2 * zfactp
249         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch
250         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe
251         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi
252         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi
253         tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 
254         tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zrespp2 * zfactn
255         tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zrespp2 * zfactp
256         tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zrespp2 * zfactfe
257         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortp2
258         tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + ztortp2 * zfactn
259         tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + ztortp2 * zfactp
260         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ztortp2 * zfactfe
261         prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + ztortp2
262         prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk) + zrespp2
[15459]263
[12377]264      END_3D
[7162]265      !
[12377]266      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
[7162]267         WRITE(charout, FMT="('diat')")
[13286]268         CALL prt_ctl_info( charout, cdcomp = 'top' )
269         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
[7162]270      ENDIF
271      !
[15459]272      IF( ln_timing )   CALL timing_stop('p5z_mort_diat')
[7162]273      !
[15459]274   END SUBROUTINE p5z_mort_diat
[7162]275
[9124]276
[7162]277   SUBROUTINE p5z_mort_init
278      !!----------------------------------------------------------------------
279      !!                  ***  ROUTINE p5z_mort_init  ***
280      !!
[15459]281      !! ** Purpose :   Initialization of phytoplankton mortality parameters
[7162]282      !!
[15459]283      !! ** Method  :   Read the namp5zmort namelist and check the parameters
[7162]284      !!      called at the first timestep
285      !!
[15459]286      !! ** input   :   Namelist namp5zmort
[7162]287      !!
288      !!----------------------------------------------------------------------
[15459]289      INTEGER :: ios   ! Local integer output status for namelist read
[9124]290      !!
[15459]291      NAMELIST/namp5zmort/ wchln, wchlp, wchld, mpratn, mpratp, mpratd
[9124]292      !!----------------------------------------------------------------------
[7162]293
294      READ  ( numnatp_ref, namp5zmort, IOSTAT = ios, ERR = 901)
[11536]295901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zmort in reference namelist' )
[7162]296
297      READ  ( numnatp_cfg, namp5zmort, IOSTAT = ios, ERR = 902 )
[11536]298902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zmort in configuration namelist' )
[7162]299      IF(lwm) WRITE ( numonp, namp5zmort )
300
301      IF(lwp) THEN                         ! control print
302         WRITE(numout,*) ' '
303         WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, namp5zmort'
304         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
305         WRITE(numout,*) '    quadratic mortality of phytoplankton      wchln     =', wchln
306         WRITE(numout,*) '    quadratic mortality of picophyto.         wchlp     =', wchlp
307         WRITE(numout,*) '    quadratic mortality of diatoms            wchld     =', wchld
308         WRITE(numout,*) '    nanophyto. mortality rate                 mpratn    =', mpratn
309         WRITE(numout,*) '    picophyto. mortality rate                 mpratp    =', mpratp
310         WRITE(numout,*) '    Diatoms mortality rate                    mpratd    =', mpratd
311      ENDIF
312
313   END SUBROUTINE p5z_mort_init
314
315   !!======================================================================
[9788]316END MODULE p5zmort
Note: See TracBrowser for help on using the repository browser.