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/UKMO/r8395_coupling_sequence/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: NEMO/branches/UKMO/r8395_coupling_sequence/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p5zmort.F90 @ 10761

Last change on this file since 10761 was 10761, checked in by jcastill, 5 years ago

Remove svn keys

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