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 @ 5266

Last change on this file since 5266 was 5266, checked in by cetlod, 9 years ago

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