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.
p4zmort.F90 in branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90 @ 3446

Last change on this file since 3446 was 3446, checked in by cetlod, 12 years ago

branch:2012/dev_r3438_LOCEAN15_PISLOB : 2nd step new PISCES updates from Olivier, see ticket #972

File size: 12.1 KB
Line 
1MODULE p4zmort
2   !!======================================================================
3   !!                         ***  MODULE p4zmort  ***
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
10   !!----------------------------------------------------------------------
11   !!   'key_pisces'                                       PISCES bio-model
12   !!----------------------------------------------------------------------
13   !!   p4z_mort       :   Compute the mortality terms for phytoplankton
14   !!   p4z_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 p4zsink         !  vertical flux of particulate matter due to sinking
20   USE prtctl_trc      !  print control for debugging
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   p4z_mort   
26   PUBLIC   p4z_mort_init   
27
28   !! * Shared module variables
29   REAL(wp), PUBLIC :: wchl   = 0.001_wp  !:
30   REAL(wp), PUBLIC :: wchld  = 0.02_wp   !:
31   REAL(wp), PUBLIC :: wchldm = 0.05_wp   !:
32   REAL(wp), PUBLIC :: mprat  = 0.01_wp   !:
33   REAL(wp), PUBLIC :: mprat2 = 0.01_wp   !:
34   REAL(wp), PUBLIC :: mpratm = 0.01_wp   !:
35
36
37   !!* Substitution
38#  include "top_substitute.h90"
39   !!----------------------------------------------------------------------
40   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
41   !! $Id: p4zmort.F90 3160 2011-11-20 14:27:18Z cetlod $
42   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
43   !!----------------------------------------------------------------------
44
45CONTAINS
46
47   SUBROUTINE p4z_mort( kt )
48      !!---------------------------------------------------------------------
49      !!                     ***  ROUTINE p4z_mort  ***
50      !!
51      !! ** Purpose :   Calls the different subroutine to initialize and compute
52      !!                the different phytoplankton mortality terms
53      !!
54      !! ** Method  : - ???
55      !!---------------------------------------------------------------------
56      INTEGER, INTENT(in) ::   kt ! ocean time step
57      !!---------------------------------------------------------------------
58
59      CALL p4z_nano            ! nanophytoplankton
60
61      CALL p4z_diat            ! diatoms
62
63   END SUBROUTINE p4z_mort
64
65
66   SUBROUTINE p4z_nano
67      !!---------------------------------------------------------------------
68      !!                     ***  ROUTINE p4z_nano  ***
69      !!
70      !! ** Purpose :   Compute the mortality terms for nanophytoplankton
71      !!
72      !! ** Method  : - ???
73      !!---------------------------------------------------------------------
74      INTEGER  :: ji, jj, jk
75      REAL(wp) :: zcompaph
76      REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal
77      REAL(wp) :: ztortp , zrespp , zmortp , zstep
78      CHARACTER (len=25) :: charout
79      !!---------------------------------------------------------------------
80      !
81      IF( nn_timing == 1 )  CALL timing_start('p4z_nano')
82      !
83      prodcal(:,:,:) = 0.  !: calcite production variable set to zero
84      DO jk = 1, jpkm1
85         DO jj = 1, jpj
86            DO ji = 1, jpi
87               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
88               zstep    = xstep
89# if defined key_degrad
90               zstep    = zstep * facvol(ji,jj,jk)
91# endif
92               !     Squared mortality of Phyto similar to a sedimentation term during
93               !     blooms (Doney et al. 1996)
94               zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * trn(ji,jj,jk,jpphy) 
95
96               !     Phytoplankton mortality. This mortality loss is slightly
97               !     increased when nutrients are limiting phytoplankton growth
98               !     as observed for instance in case of iron limitation.
99               ztortp = mprat * xstep * trn(ji,jj,jk,jpphy) / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph
100
101               zmortp = zrespp + ztortp
102
103               !   Update the arrays TRA which contains the biological sources and sinks
104
105               zfactfe = trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn)
106               zfactch = trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)
107               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp
108               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch
109               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe
110               zprcaca = xfracal(ji,jj,jk) * zmortp
111               !
112               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
113               !
114               zfracal = 0.5 * xfracal(ji,jj,jk)
115               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca
116               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
117               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
118#if defined key_kriest
119               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp
120               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp * xkr_dnano + zrespp * xkr_ddiat
121               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe
122#else
123               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp
124               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp
125               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe
126               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe
127#endif
128            END DO
129         END DO
130      END DO
131      !
132       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
133         WRITE(charout, FMT="('nano')")
134         CALL prt_ctl_trc_info(charout)
135         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
136       ENDIF
137      !
138      IF( nn_timing == 1 )  CALL timing_stop('p4z_nano')
139      !
140   END SUBROUTINE p4z_nano
141
142   SUBROUTINE p4z_diat
143      !!---------------------------------------------------------------------
144      !!                     ***  ROUTINE p4z_diat  ***
145      !!
146      !! ** Purpose :   Compute the mortality terms for diatoms
147      !!
148      !! ** Method  : - ???
149      !!---------------------------------------------------------------------
150      INTEGER  ::  ji, jj, jk
151      REAL(wp) ::  zfactfe,zfactsi,zfactch, zcompadi
152      REAL(wp) ::  zrespp2, ztortp2, zmortp2, zstep
153      REAL(wp) ::  zlim2, zlim1
154      CHARACTER (len=25) :: charout
155      !!---------------------------------------------------------------------
156      !
157      IF( nn_timing == 1 )  CALL timing_start('p4z_diat')
158      !
159
160      !    Aggregation term for diatoms is increased in case of nutrient
161      !    stress as observed in reality. The stressed cells become more
162      !    sticky and coagulate to sink quickly out of the euphotic zone
163      !     ------------------------------------------------------------
164
165      DO jk = 1, jpkm1
166         DO jj = 1, jpj
167            DO ji = 1, jpi
168
169               zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-8), 0. )
170
171               !    Aggregation term for diatoms is increased in case of nutrient
172               !    stress as observed in reality. The stressed cells become more
173               !    sticky and coagulate to sink quickly out of the euphotic zone
174               !     ------------------------------------------------------------
175               zstep   = xstep
176# if defined key_degrad
177               zstep = zstep * facvol(ji,jj,jk)
178# endif
179               !  Phytoplankton respiration
180               !     ------------------------
181               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk)
182               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 
183               zrespp2 = 1.e6 * zstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia)
184              ! zlim1   = 1.0 - xlimdia(ji,jj,jk)
185              ! zrespp2 = 1.e6 * zstep * (  wchl + wchld * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia)
186
187               !     Phytoplankton mortality.
188               !     ------------------------
189               ztortp2 = mprat2 * zstep * trn(ji,jj,jk,jpdia)  / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 
190
191               zmortp2 = zrespp2 + ztortp2
192
193               !   Update the arrays tra which contains the biological sources and sinks
194               !   ---------------------------------------------------------------------
195               zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )
196               zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
197               zfactsi = trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
198               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 
199               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch
200               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe
201               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi
202               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi
203#if defined key_kriest
204               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp2 
205               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp2 * xkr_ddiat + zrespp2 * xkr_daggr
206               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp2 * zfactfe
207#else
208               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2
209               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2
210               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe
211               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe
212#endif
213            END DO
214         END DO
215      END DO
216      !
217      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
218         WRITE(charout, FMT="('diat')")
219         CALL prt_ctl_trc_info(charout)
220         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
221      ENDIF
222      !
223      IF( nn_timing == 1 )  CALL timing_stop('p4z_diat')
224      !
225   END SUBROUTINE p4z_diat
226
227   SUBROUTINE p4z_mort_init
228
229      !!----------------------------------------------------------------------
230      !!                  ***  ROUTINE p4z_mort_init  ***
231      !!
232      !! ** Purpose :   Initialization of phytoplankton parameters
233      !!
234      !! ** Method  :   Read the nampismort namelist and check the parameters
235      !!      called at the first timestep
236      !!
237      !! ** input   :   Namelist nampismort
238      !!
239      !!----------------------------------------------------------------------
240
241      NAMELIST/nampismort/ wchl, wchld, wchldm, mprat, mprat2, mpratm
242
243      REWIND( numnatp )                     ! read numnatp
244      READ  ( numnatp, nampismort )
245
246      IF(lwp) THEN                         ! control print
247         WRITE(numout,*) ' '
248         WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, nampismort'
249         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
250         WRITE(numout,*) '    quadratic mortality of phytoplankton      wchl      =', wchl
251         WRITE(numout,*) '    maximum quadratic mortality of diatoms    wchld     =', wchld
252         WRITE(numout,*) '    maximum quadratic mortality of diatoms    wchld     =', wchldm
253         WRITE(numout,*) '    phytoplankton mortality rate              mprat     =', mprat
254         WRITE(numout,*) '    Diatoms mortality rate                    mprat2    =', mprat2
255         WRITE(numout,*) '    Phytoplankton minimum mortality rate      mpratm    =', mpratm
256      ENDIF
257
258   END SUBROUTINE p4z_mort_init
259
260#else
261   !!======================================================================
262   !!  Dummy module :                                   No PISCES bio-model
263   !!======================================================================
264CONTAINS
265   SUBROUTINE p4z_mort                    ! Empty routine
266   END SUBROUTINE p4z_mort
267#endif 
268
269   !!======================================================================
270END MODULE  p4zmort
Note: See TracBrowser for help on using the repository browser.