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/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p5zmort.F90 @ 11822

Last change on this file since 11822 was 11822, checked in by acc, 4 years ago

Branch 2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps. Sette tested updates to branch to align with trunk changes between 10721 and 11740. Sette tests are passing but results differ from branch before these changes (except for GYRE_PISCES and VORTEX) and branch results already differed from trunk because of algorithmic fixes. Will need more checks to confirm correctness.

  • Property svn:keywords set to Id
File size: 15.2 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_trc      !  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   !!----------------------------------------------------------------------
36   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
37   !! $Id$
38   !! Software governed by the CeCILL license (see ./LICENSE)
39   !!----------------------------------------------------------------------
40
41CONTAINS
42
43   SUBROUTINE p5z_mort( kt, Kbb, Krhs )
44      !!---------------------------------------------------------------------
45      !!                     ***  ROUTINE p5z_mort  ***
46      !!
47      !! ** Purpose :   Calls the different subroutine to initialize and compute
48      !!                the different phytoplankton mortality terms
49      !!
50      !! ** Method  : - ???
51      !!---------------------------------------------------------------------
52      INTEGER, INTENT(in) ::   kt ! ocean time step
53      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
54      !!---------------------------------------------------------------------
55
56      CALL p5z_nano( Kbb, Krhs )            ! nanophytoplankton
57      CALL p5z_pico( Kbb, Krhs )            ! picophytoplankton
58      CALL p5z_diat( Kbb, Krhs )            ! diatoms
59
60   END SUBROUTINE p5z_mort
61
62
63   SUBROUTINE p5z_nano( Kbb, Krhs )
64      !!---------------------------------------------------------------------
65      !!                     ***  ROUTINE p5z_nano  ***
66      !!
67      !! ** Purpose :   Compute the mortality terms for nanophytoplankton
68      !!
69      !! ** Method  : - ???
70      !!---------------------------------------------------------------------
71      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
72      INTEGER  :: ji, jj, jk
73      REAL(wp) :: zcompaph
74      REAL(wp) :: zfactfe, zfactch, zfactn, zfactp, zprcaca
75      REAL(wp) :: ztortp , zrespp , zmortp
76      CHARACTER (len=25) :: charout
77      !!---------------------------------------------------------------------
78      !
79      IF( ln_timing )   CALL timing_start('p5z_nano')
80      !
81      prodcal(:,:,:) = 0.  !: calcite production variable set to zero
82      DO jk = 1, jpkm1
83         DO jj = 1, jpj
84            DO ji = 1, jpi
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 DO
120         END DO
121      END DO
122      !
123       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
124         WRITE(charout, FMT="('nano')")
125         CALL prt_ctl_trc_info(charout)
126         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
127       ENDIF
128      !
129      IF( ln_timing )   CALL timing_stop('p5z_nano')
130      !
131   END SUBROUTINE p5z_nano
132
133
134   SUBROUTINE p5z_pico( Kbb, Krhs )
135      !!---------------------------------------------------------------------
136      !!                     ***  ROUTINE p5z_pico  ***
137      !!
138      !! ** Purpose :   Compute the mortality terms for picophytoplankton
139      !!
140      !! ** Method  : - ???
141      !!---------------------------------------------------------------------
142      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
143      INTEGER  :: ji, jj, jk
144      REAL(wp) :: zcompaph
145      REAL(wp) :: zfactfe, zfactch, zfactn, zfactp
146      REAL(wp) :: ztortp , zrespp , zmortp 
147      CHARACTER (len=25) :: charout
148      !!---------------------------------------------------------------------
149      !
150      IF( ln_timing )   CALL timing_start('p5z_pico')
151      !
152      DO jk = 1, jpkm1
153         DO jj = 1, jpj
154            DO ji = 1, jpi
155               zcompaph = MAX( ( tr(ji,jj,jk,jppic,Kbb) - 1e-9 ), 0.e0 )
156               !  Squared mortality of Phyto similar to a sedimentation term during
157               !  blooms (Doney et al. 1996)
158               !  -----------------------------------------------------------------
159               zrespp = wchlp * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * tr(ji,jj,jk,jppic,Kbb)
160
161               !     Phytoplankton mortality
162               ztortp = mpratp * xstep  * zcompaph
163               zmortp = zrespp + ztortp
164
165               !   Update the arrays TRA which contains the biological sources and sinks
166
167               zfactn = tr(ji,jj,jk,jpnpi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
168               zfactp = tr(ji,jj,jk,jpppi,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
169               zfactfe = tr(ji,jj,jk,jppfe,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
170               zfactch = tr(ji,jj,jk,jppch,Kbb)/(tr(ji,jj,jk,jppic,Kbb)+rtrn)
171               tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) - zmortp
172               tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) - zmortp * zfactn
173               tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) - zmortp * zfactp
174               tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) - zmortp * zfactch
175               tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) - zmortp * zfactfe
176               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortp
177               tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + zmortp * zfactn
178               tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + zmortp * zfactp
179               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zmortp * zfactfe
180               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp
181            END DO
182         END DO
183      END DO
184      !
185       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
186         WRITE(charout, FMT="('pico')")
187         CALL prt_ctl_trc_info(charout)
188         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
189       ENDIF
190      !
191      IF( ln_timing )   CALL timing_stop('p5z_pico')
192      !
193   END SUBROUTINE p5z_pico
194
195
196   SUBROUTINE p5z_diat( Kbb, Krhs )
197      !!---------------------------------------------------------------------
198      !!                     ***  ROUTINE p5z_diat  ***
199      !!
200      !! ** Purpose :   Compute the mortality terms for diatoms
201      !!
202      !! ** Method  : - ???
203      !!---------------------------------------------------------------------
204      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
205      INTEGER  ::  ji, jj, jk
206      REAL(wp) ::  zfactfe,zfactsi,zfactch, zfactn, zfactp, zcompadi
207      REAL(wp) ::  zrespp2, ztortp2, zmortp2
208      REAL(wp) ::  zlim2, zlim1
209      CHARACTER (len=25) :: charout
210      !!---------------------------------------------------------------------
211      !
212      IF( ln_timing )   CALL timing_start('p5z_diat')
213      !
214
215      DO jk = 1, jpkm1
216         DO jj = 1, jpj
217            DO ji = 1, jpi
218
219               zcompadi = MAX( ( tr(ji,jj,jk,jpdia,Kbb) - 1E-9), 0. )
220
221               !   Aggregation term for diatoms is increased in case of nutrient
222               !   stress as observed in reality. The stressed cells become more
223               !   sticky and coagulate to sink quickly out of the euphotic zone
224               !   -------------------------------------------------------------
225               !  Phytoplankton squared mortality
226               !  -------------------------------
227               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
228               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
229               zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * tr(ji,jj,jk,jpdia,Kbb)
230
231               !  Phytoplankton linear mortality
232               !  ------------------------------
233               ztortp2 = mpratd * xstep  * zcompadi
234               zmortp2 = zrespp2 + ztortp2
235
236               !   Update the arrays tr(:,:,:,:,Krhs) which contains the biological sources and sinks
237               !   ---------------------------------------------------------------------
238               zfactn  = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
239               zfactp  = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
240               zfactch = tr(ji,jj,jk,jpdch,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
241               zfactfe = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
242               zfactsi = tr(ji,jj,jk,jpdsi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
243               tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zmortp2 
244               tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) - zmortp2 * zfactn
245               tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) - zmortp2 * zfactp
246               tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zmortp2 * zfactch
247               tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zmortp2 * zfactfe
248               tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zmortp2 * zfactsi
249               tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zmortp2 * zfactsi
250               tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zrespp2 
251               tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zrespp2 * zfactn
252               tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zrespp2 * zfactp
253               tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zrespp2 * zfactfe
254               tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + ztortp2
255               tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + ztortp2 * zfactn
256               tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + ztortp2 * zfactp
257               tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ztortp2 * zfactfe
258               prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + ztortp2
259               prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk) + zrespp2
260            END DO
261         END DO
262      END DO
263      !
264      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
265         WRITE(charout, FMT="('diat')")
266         CALL prt_ctl_trc_info(charout)
267         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
268      ENDIF
269      !
270      IF( ln_timing )   CALL timing_stop('p5z_diat')
271      !
272   END SUBROUTINE p5z_diat
273
274
275   SUBROUTINE p5z_mort_init
276      !!----------------------------------------------------------------------
277      !!                  ***  ROUTINE p5z_mort_init  ***
278      !!
279      !! ** Purpose :   Initialization of phytoplankton parameters
280      !!
281      !! ** Method  :   Read the nampismort namelist and check the parameters
282      !!      called at the first timestep
283      !!
284      !! ** input   :   Namelist nampismort
285      !!
286      !!----------------------------------------------------------------------
287      INTEGER :: ios                 ! Local integer output status for namelist read
288      !!
289      NAMELIST/namp5zmort/ wchln, wchlp, wchld, wchldm, mpratn, mpratp, mpratd
290      !!----------------------------------------------------------------------
291
292      REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton
293      READ  ( numnatp_ref, namp5zmort, IOSTAT = ios, ERR = 901)
294901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zmort in reference namelist' )
295
296      REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton
297      READ  ( numnatp_cfg, namp5zmort, IOSTAT = ios, ERR = 902 )
298902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zmort in configuration namelist' )
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,*) '    Additional quadratic mortality of diatoms wchldm    =', wchldm
309         WRITE(numout,*) '    nanophyto. mortality rate                 mpratn    =', mpratn
310         WRITE(numout,*) '    picophyto. mortality rate                 mpratp    =', mpratp
311         WRITE(numout,*) '    Diatoms mortality rate                    mpratd    =', mpratd
312      ENDIF
313
314   END SUBROUTINE p5z_mort_init
315
316   !!======================================================================
317END MODULE p5zmort
Note: See TracBrowser for help on using the repository browser.