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 branches/CNRS/dev_r4826_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: branches/CNRS/dev_r4826_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmort.F90 @ 5288

Last change on this file since 5288 was 5288, checked in by aumont, 9 years ago

various bug fixes and updates of PISCES quota
  • Property svn:executable set to *
File size: 16.6 KB
Line 
1MODULE p5zmort
2   !!======================================================================
3   !!                         ***  MODULE p5zmort  ***
4   !! TOP :   PISCES Compute the mortality terms for phytoplankton
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#if defined key_pisces_quota
11   !!----------------------------------------------------------------------
12   !!   'key_pisces_quota'                                 PISCES bio-model
13   !!----------------------------------------------------------------------
14   !!   p5z_mort       :   Compute the mortality terms for phytoplankton
15   !!   p5z_mort_init  :   Initialize the mortality params for phytoplankton
16   !!----------------------------------------------------------------------
17   USE oce_trc         !  shared variables between ocean and passive tracers
18   USE trc             !  passive tracers common variables
19   USE sms_pisces      !  PISCES Source Minus Sink variables
20   USE p5zsink         !  vertical flux of particulate matter due to sinking
21   USE p5zprod         !  Primary productivity
22   USE prtctl_trc      !  print control for debugging
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   p5z_mort   
28   PUBLIC   p5z_mort_init   
29
30   !! * Shared module variables
31   REAL(wp), PUBLIC :: wchl    !:
32   REAL(wp), PUBLIC :: wchlp   !:
33   REAL(wp), PUBLIC :: wchld   !:
34   REAL(wp), PUBLIC :: wchldm  !:
35   REAL(wp), PUBLIC :: mprat   !:
36   REAL(wp), PUBLIC :: mpratp  !:
37   REAL(wp), PUBLIC :: mprat2  !:
38
39
40   !!* Substitution
41#  include "top_substitute.h90"
42   !!----------------------------------------------------------------------
43   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
44   !! $Id: p4zmort.F90 3160 2011-11-20 14:27:18Z cetlod $
45   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
46   !!----------------------------------------------------------------------
47
48CONTAINS
49
50   SUBROUTINE p5z_mort( kt )
51      !!---------------------------------------------------------------------
52      !!                     ***  ROUTINE p5z_mort  ***
53      !!
54      !! ** Purpose :   Calls the different subroutine to initialize and compute
55      !!                the different phytoplankton mortality terms
56      !!
57      !! ** Method  : - ???
58      !!---------------------------------------------------------------------
59      INTEGER, INTENT(in) ::   kt ! ocean time step
60      !!---------------------------------------------------------------------
61
62      CALL p5z_nano            ! nanophytoplankton
63      CALL p5z_pico            ! picophytoplankton
64      CALL p5z_diat            ! diatoms
65
66   END SUBROUTINE p5z_mort
67
68
69   SUBROUTINE p5z_nano
70      !!---------------------------------------------------------------------
71      !!                     ***  ROUTINE p5z_nano  ***
72      !!
73      !! ** Purpose :   Compute the mortality terms for nanophytoplankton
74      !!
75      !! ** Method  : - ???
76      !!---------------------------------------------------------------------
77      INTEGER  :: ji, jj, jk
78      REAL(wp) :: zcompaph
79      REAL(wp) :: zfactfe, zfactch, zfactn, zfactp, zprcaca
80      REAL(wp) :: ztortp , zrespp , zmortp , zstep
81      CHARACTER (len=25) :: charout
82      !!---------------------------------------------------------------------
83      !
84      IF( nn_timing == 1 )  CALL timing_start('p5z_nano')
85      !
86      prodcal(:,:,:) = 0.  !: calcite production variable set to zero
87      DO jk = 1, jpkm1
88         DO jj = 1, jpj
89            DO ji = 1, jpi
90               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
91               zstep    = xstep
92# if defined key_degrad
93               zstep    = zstep * facvol(ji,jj,jk)
94# endif
95               !   Squared mortality of Phyto similar to a sedimentation term during
96               !   blooms (Doney et al. 1996)
97               !   -----------------------------------------------------------------
98               zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * trn(ji,jj,jk,jpphy)
99
100               !   Phytoplankton linear mortality
101               !   ------------------------------
102               ztortp = mprat * xstep  * zcompaph
103               zmortp = zrespp + ztortp
104
105               !   Update the arrays TRA which contains the biological sources and sinks
106
107               zfactn  = trn(ji,jj,jk,jpnph)/(trn(ji,jj,jk,jpphy)+rtrn)
108               zfactp  = trn(ji,jj,jk,jppph)/(trn(ji,jj,jk,jpphy)+rtrn)
109               zfactfe = trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn)
110               zfactch = trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)
111               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp
112               tra(ji,jj,jk,jpnph) = tra(ji,jj,jk,jpnph) - zmortp * zfactn
113               tra(ji,jj,jk,jppph) = tra(ji,jj,jk,jppph) - zmortp * zfactp
114               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch
115               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe
116               zprcaca = xfracal(ji,jj,jk) * zmortp
117               !
118               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
119               !
120               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca
121               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
122               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
123#if defined key_kriest
124               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp
125               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn
126               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp
127               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp * xkr_dnano + zrespp * xkr_ddiat
128               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe
129#else
130               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp
131               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn
132               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp
133
134               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe
135#endif
136            END DO
137         END DO
138      END DO
139      !
140       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
141         WRITE(charout, FMT="('nano')")
142         CALL prt_ctl_trc_info(charout)
143         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
144       ENDIF
145      !
146      IF( nn_timing == 1 )  CALL timing_stop('p5z_nano')
147      !
148   END SUBROUTINE p5z_nano
149
150   SUBROUTINE p5z_pico
151      !!---------------------------------------------------------------------
152      !!                     ***  ROUTINE p5z_pico  ***
153      !!
154      !! ** Purpose :   Compute the mortality terms for picophytoplankton
155      !!
156      !! ** Method  : - ???
157      !!---------------------------------------------------------------------
158      INTEGER  :: ji, jj, jk
159      REAL(wp) :: zcompaph
160      REAL(wp) :: zfactfe, zfactch, zfactn, zfactp
161      REAL(wp) :: ztortp , zrespp , zmortp , zstep
162      CHARACTER (len=25) :: charout
163      !!---------------------------------------------------------------------
164      !
165      IF( nn_timing == 1 )  CALL timing_start('p5z_pico')
166      !
167      DO jk = 1, jpkm1
168         DO jj = 1, jpj
169            DO ji = 1, jpi
170               zcompaph = MAX( ( trn(ji,jj,jk,jppic) - 1e-8 ), 0.e0 )
171               zstep    = xstep
172# if defined key_degrad
173               zstep    = zstep * facvol(ji,jj,jk)
174# endif
175               !  Squared mortality of Phyto similar to a sedimentation term during
176               !  blooms (Doney et al. 1996)
177               !  -----------------------------------------------------------------
178               zrespp = wchlp * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * trn(ji,jj,jk,jppic)
179
180               !     Phytoplankton mortality
181               ztortp = mpratp * xstep  * zcompaph
182               zmortp = zrespp + ztortp
183
184               !   Update the arrays TRA which contains the biological sources and sinks
185
186               zfactn = trn(ji,jj,jk,jpnpi)/(trn(ji,jj,jk,jppic)+rtrn)
187               zfactp = trn(ji,jj,jk,jpppi)/(trn(ji,jj,jk,jppic)+rtrn)
188               zfactfe = trn(ji,jj,jk,jppfe)/(trn(ji,jj,jk,jppic)+rtrn)
189               zfactch = trn(ji,jj,jk,jppch)/(trn(ji,jj,jk,jppic)+rtrn)
190               tra(ji,jj,jk,jppic) = tra(ji,jj,jk,jppic) - zmortp
191               tra(ji,jj,jk,jpnpi) = tra(ji,jj,jk,jpnpi) - zmortp * zfactn
192               tra(ji,jj,jk,jpppi) = tra(ji,jj,jk,jpppi) - zmortp * zfactp
193               tra(ji,jj,jk,jppch) = tra(ji,jj,jk,jppch) - zmortp * zfactch
194               tra(ji,jj,jk,jppfe) = tra(ji,jj,jk,jppfe) - zmortp * zfactfe
195#if defined key_kriest
196               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp
197               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp * zfactn
198               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp * zfactp
199               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp * xkr_dnano + zrespp * xkr_ddiat
200               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe
201#else
202               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zmortp
203               tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zmortp * zfactn
204               tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zmortp * zfactp
205               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zmortp * zfactfe
206#endif
207            END DO
208         END DO
209      END DO
210      !
211       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
212         WRITE(charout, FMT="('pico')")
213         CALL prt_ctl_trc_info(charout)
214         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
215       ENDIF
216      !
217      IF( nn_timing == 1 )  CALL timing_stop('p5z_pico')
218      !
219   END SUBROUTINE p5z_pico
220
221
222   SUBROUTINE p5z_diat
223      !!---------------------------------------------------------------------
224      !!                     ***  ROUTINE p5z_diat  ***
225      !!
226      !! ** Purpose :   Compute the mortality terms for diatoms
227      !!
228      !! ** Method  : - ???
229      !!---------------------------------------------------------------------
230      INTEGER  ::  ji, jj, jk
231      REAL(wp) ::  zfactfe,zfactsi,zfactch, zfactn, zfactp, zcompadi
232      REAL(wp) ::  zrespp2, ztortp2, zmortp2, zstep
233      REAL(wp) ::  zlim2, zlim1
234      CHARACTER (len=25) :: charout
235      !!---------------------------------------------------------------------
236      !
237      IF( nn_timing == 1 )  CALL timing_start('p5z_diat')
238      !
239
240      DO jk = 1, jpkm1
241         DO jj = 1, jpj
242            DO ji = 1, jpi
243
244               zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1E-8), 0. )
245
246               !   Aggregation term for diatoms is increased in case of nutrient
247               !   stress as observed in reality. The stressed cells become more
248               !   sticky and coagulate to sink quickly out of the euphotic zone
249               !   -------------------------------------------------------------
250               zstep   = xstep
251# if defined key_degrad
252               zstep = zstep * facvol(ji,jj,jk)
253# endif
254               !  Phytoplankton squared mortality
255               !  -------------------------------
256               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
257               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
258               zrespp2 = 1.e6 * zstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia)
259
260               !  Phytoplankton linear mortality
261               !  ------------------------------
262               ztortp2 = mprat2 * xstep  * zcompadi
263               zmortp2 = zrespp2 + ztortp2
264
265               !   Update the arrays tra which contains the biological sources and sinks
266               !   ---------------------------------------------------------------------
267               zfactn  = trn(ji,jj,jk,jpndi) / ( trn(ji,jj,jk,jpdia) + rtrn )
268               zfactp  = trn(ji,jj,jk,jppdi) / ( trn(ji,jj,jk,jpdia) + rtrn )
269               zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )
270               zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
271               zfactsi = trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
272               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 
273               tra(ji,jj,jk,jpndi) = tra(ji,jj,jk,jpndi) - zmortp2 * zfactn
274               tra(ji,jj,jk,jppdi) = tra(ji,jj,jk,jppdi) - zmortp2 * zfactp
275               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch
276               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe
277               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi
278               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi
279#if defined key_kriest
280               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp2 
281               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zmortp2 * zfactn
282               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + zmortp2 * zfactp
283               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp2 * xkr_ddiat + zrespp2 * xkr_daggr
284               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp2 * zfactfe
285#else
286               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2
287               tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + (zrespp2 + 0.5 * ztortp2) * zfactn
288               tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + (zrespp2 + 0.5 * ztortp2) * zfactp
289               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + (zrespp2 + 0.5 * ztortp2) * zfactfe
290               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2
291               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + 0.5 * ztortp2 * zfactn
292               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 0.5 * ztortp2 * zfactp
293               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe
294#endif
295            END DO
296         END DO
297      END DO
298      !
299      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
300         WRITE(charout, FMT="('diat')")
301         CALL prt_ctl_trc_info(charout)
302         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
303      ENDIF
304      !
305      IF( nn_timing == 1 )  CALL timing_stop('p5z_diat')
306      !
307   END SUBROUTINE p5z_diat
308
309   SUBROUTINE p5z_mort_init
310
311      !!----------------------------------------------------------------------
312      !!                  ***  ROUTINE p5z_mort_init  ***
313      !!
314      !! ** Purpose :   Initialization of phytoplankton parameters
315      !!
316      !! ** Method  :   Read the nampismort namelist and check the parameters
317      !!      called at the first timestep
318      !!
319      !! ** input   :   Namelist nampismort
320      !!
321      !!----------------------------------------------------------------------
322
323      NAMELIST/nampismort/ wchl, wchlp, wchld, wchldm, mprat, mpratp, mprat2
324      INTEGER :: ios                 ! Local integer output status for namelist read
325
326      REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton
327      READ  ( numnatp_ref, nampismort, IOSTAT = ios, ERR = 901)
328901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismort in reference namelist', lwp )
329
330      REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton
331      READ  ( numnatp_cfg, nampismort, IOSTAT = ios, ERR = 902 )
332902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismort in configuration namelist', lwp )
333      IF(lwm) WRITE ( numonp, nampismort )
334
335      IF(lwp) THEN                         ! control print
336         WRITE(numout,*) ' '
337         WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, nampismort'
338         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
339         WRITE(numout,*) '    quadratic mortality of phytoplankton      wchl      =', wchl
340         WRITE(numout,*) '    quadratic mortality of picophyto.         wchlp     =', wchlp
341         WRITE(numout,*) '    quadratic mortality of diatoms            wchld     =', wchld
342         WRITE(numout,*) '    Additional quadratic mortality of diatoms wchldm    =', wchldm
343         WRITE(numout,*) '    nanophyto. mortality rate                 mprat     =', mprat
344         WRITE(numout,*) '    picophyto. mortality rate                 mpratp    =', mpratp
345         WRITE(numout,*) '    Diatoms mortality rate                    mprat2    =', mprat2
346      ENDIF
347
348   END SUBROUTINE p5z_mort_init
349
350#else
351   !!======================================================================
352   !!  Dummy module :                                   No PISCES bio-model
353   !!======================================================================
354CONTAINS
355   SUBROUTINE p5z_mort                    ! Empty routine
356   END SUBROUTINE p5z_mort
357#endif 
358
359   !!======================================================================
360END MODULE  p5zmort
Note: See TracBrowser for help on using the repository browser.