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/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p5zmort.F90 @ 13176

Last change on this file since 13176 was 13176, checked in by smasson, 4 years ago

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