source: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/P4Z/p5zprod.F90

Last change on this file was 12377, checked in by acc, 10 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 31.7 KB
Line 
1MODULE p5zprod
2   !!======================================================================
3   !!                         ***  MODULE p5zprod  ***
4   !! TOP :  Growth Rate of the two phytoplanktons groups
5   !!======================================================================
6   !! History :   1.0  !  2004     (O. Aumont) Original code
7   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
8   !!             3.4  !  2011-05  (O. Aumont, C. Ethe) New parameterization of light limitation
9   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
10   !!----------------------------------------------------------------------
11   !!   p5z_prod       :   Compute the growth Rate of the two phytoplanktons groups
12   !!   p5z_prod_init  :   Initialization of the parameters for growth
13   !!   p5z_prod_alloc :   Allocate variables for growth
14   !!----------------------------------------------------------------------
15   USE oce_trc         !  shared variables between ocean and passive tracers
16   USE trc             !  passive tracers common variables
17   USE sms_pisces      !  PISCES Source Minus Sink variables
18   USE p4zlim
19   USE p5zlim          !  Co-limitations of differents nutrients
20   USE prtctl_trc      !  print control for debugging
21   USE iom             !  I/O manager
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   p5z_prod         ! called in p5zbio.F90
27   PUBLIC   p5z_prod_init    ! called in trcsms_pisces.F90
28   PUBLIC   p5z_prod_alloc
29
30   !! * Shared module variables
31   REAL(wp), PUBLIC ::  pislopen        !:
32   REAL(wp), PUBLIC ::  pislopep        !:
33   REAL(wp), PUBLIC ::  pisloped        !:
34   REAL(wp), PUBLIC ::  xadap           !:
35   REAL(wp), PUBLIC ::  excretn         !:
36   REAL(wp), PUBLIC ::  excretp         !:
37   REAL(wp), PUBLIC ::  excretd         !:
38   REAL(wp), PUBLIC ::  bresp           !:
39   REAL(wp), PUBLIC ::  thetanpm        !:
40   REAL(wp), PUBLIC ::  thetannm        !:
41   REAL(wp), PUBLIC ::  thetandm        !:
42   REAL(wp), PUBLIC ::  chlcmin         !:
43   REAL(wp), PUBLIC ::  grosip          !:
44
45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   zdaylen
46   
47   REAL(wp) :: r1_rday                !: 1 / rday
48   REAL(wp) :: texcretn               !: 1 - excret
49   REAL(wp) :: texcretp               !: 1 - excretp
50   REAL(wp) :: texcretd               !: 1 - excret2       
51
52   !! * Substitutions
53#  include "do_loop_substitute.h90"
54   !!----------------------------------------------------------------------
55   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
56   !! $Id$
57   !! Software governed by the CeCILL license (see ./LICENSE)
58   !!----------------------------------------------------------------------
59CONTAINS
60
61   SUBROUTINE p5z_prod( kt , knt, Kbb, Kmm, Krhs )
62      !!---------------------------------------------------------------------
63      !!                     ***  ROUTINE p5z_prod  ***
64      !!
65      !! ** Purpose :   Compute the phytoplankton production depending on
66      !!              light, temperature and nutrient availability
67      !!
68      !! ** Method  : - ???
69      !!---------------------------------------------------------------------
70      !
71      INTEGER, INTENT(in) :: kt, knt
72      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs      ! time level indices
73      !
74      INTEGER  ::   ji, jj, jk
75      REAL(wp) ::   zsilfac, znanotot, zpicotot, zdiattot, zconctemp, zconctemp2
76      REAL(wp) ::   zration, zratiop, zratiof, zmax, zmax2, zsilim, ztn, zadap
77      REAL(wp) ::   zpronmax, zpropmax, zprofmax, zrat
78      REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zprontot, zproptot, zprodtot
79      REAL(wp) ::   zprnutmax, zdocprod, zprochln, zprochld, zprochlp
80      REAL(wp) ::   zpislopen, zpislopep, zpisloped, thetannm_n, thetandm_n, thetanpm_n
81      REAL(wp) ::   zrum, zcodel, zargu, zval, zfeup
82      REAL(wp) ::   zfact, zrfact2
83      CHARACTER (len=25) :: charout
84      REAL(wp), DIMENSION(jpi,jpj    ) :: zmixnano, zmixpico, zmixdiat, zstrn
85      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopeadn, zpislopeadp, zpislopeadd
86      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprnut, zprmaxp, zprmaxn, zprmaxd
87      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprbio, zprpic, zprdia, zysopt
88      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprchln, zprchlp, zprchld
89      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorcan, zprorcap, zprorcad 
90      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprofed, zprofep, zprofen
91      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronewn, zpronewp, zpronewd
92      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zproregn, zproregp, zproregd
93      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpropo4n, zpropo4p, zpropo4d
94      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprodopn, zprodopp, zprodopd
95      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespn, zrespp, zrespd
96      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcroissn, zcroissp, zcroissd
97      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl
98      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpligprod1, zpligprod2
99      !!---------------------------------------------------------------------
100      !
101      IF( ln_timing )   CALL timing_start('p5z_prod')
102      !
103      zprorcan(:,:,:) = 0._wp ; zprorcap(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp
104      zcroissn(:,:,:) = 0._wp ; zcroissp(:,:,:) = 0._wp ; zcroissd(:,:,:) = 0._wp
105      zprofed (:,:,:) = 0._wp ; zprofep (:,:,:) = 0._wp ; zprofen (:,:,:) = 0._wp
106      zpronewn(:,:,:) = 0._wp ; zpronewp(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp
107      zproregn(:,:,:) = 0._wp ; zproregp(:,:,:) = 0._wp ; zproregd(:,:,:) = 0._wp 
108      zpropo4n(:,:,:) = 0._wp ; zpropo4p(:,:,:) = 0._wp ; zpropo4d(:,:,:) = 0._wp
109      zprdia  (:,:,:) = 0._wp ; zprpic  (:,:,:) = 0._wp ; zprbio  (:,:,:) = 0._wp
110      zprodopn(:,:,:) = 0._wp ; zprodopp(:,:,:) = 0._wp ; zprodopd(:,:,:) = 0._wp
111      zysopt  (:,:,:) = 0._wp 
112      zrespn  (:,:,:) = 0._wp ; zrespp  (:,:,:) = 0._wp ; zrespd  (:,:,:) = 0._wp 
113
114      ! Computation of the optimal production
115      zprnut (:,:,:) = 0.65_wp * r1_rday * tgfunc(:,:,:)
116      zprmaxn(:,:,:) = ( 0.65_wp * (1. + zpsino3 * qnpmax ) ) * r1_rday * tgfunc(:,:,:)
117      zprmaxp(:,:,:) = 0.5 / 0.65 * zprmaxn(:,:,:) 
118      zprmaxd(:,:,:) = zprmaxn(:,:,:) 
119
120      ! compute the day length depending on latitude and the day
121      zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp )
122      zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  )
123
124      ! day length in hours
125      zstrn(:,:) = 0.
126      DO_2D_11_11
127         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
128         zargu = MAX( -1., MIN(  1., zargu ) )
129         zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
130      END_2D
131
132         ! Impact of the day duration on phytoplankton growth
133      DO_3D_11_11( 1, jpkm1 )
134         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
135            zval = MAX( 1., zstrn(ji,jj) )
136            IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
137               zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
138            ENDIF
139            zmxl_chl(ji,jj,jk) = zval / 24.
140            zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval )
141         ENDIF
142      END_3D
143
144      zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:)
145      zprdia(:,:,:) = zprmaxd(:,:,:) * zmxl_fac(:,:,:)
146      zprpic(:,:,:) = zprmaxp(:,:,:) * zmxl_fac(:,:,:)
147
148
149      ! Maximum light intensity
150      zdaylen(:,:) = MAX(1., zstrn(:,:)) / 24.
151      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
152
153      DO_3D_11_11( 1, jpkm1 )
154         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
155            ! Computation of the P-I slope for nanos and diatoms
156            ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. )
157            zadap       = xadap * ztn / ( 2.+ ztn )
158            !
159            zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb)    &
160            &                       /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn)
161            zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) )   &
162            &                       * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn)
163            zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb)    &
164               &                    /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn)
165            !
166            zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
167            zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn )
168            zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
169
170            ! Computation of production function for Carbon
171            !  ---------------------------------------------
172            zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  )
173            zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) )  )
174            zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  )
175
176            ! Computation of production function for Chlorophyll
177            !  -------------------------------------------------
178            zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
179            zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
180            zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
181            zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) )  )
182            zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) )  )
183            zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) )  )
184         ENDIF
185      END_3D
186
187      DO_3D_11_11( 1, jpkm1 )
188
189          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
190            !    Si/C of diatoms
191            !    ------------------------
192            !    Si/C increases with iron stress and silicate availability
193            !    Si/C is arbitrariliy increased for very high Si concentrations
194            !    to mimic the very high ratios observed in the Southern Ocean (silpot2)
195            zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 )
196            zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
197            zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0
198            zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb)
199            IF (gphit(ji,jj) < -30 ) THEN
200              zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
201            ELSE
202              zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 )
203            ENDIF
204            zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2
205        ENDIF
206      END_3D
207
208      !  Sea-ice effect on production                                                                               
209      DO_3D_11_11( 1, jpkm1 )
210         zprbio(ji,jj,jk)  = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
211         zprpic(ji,jj,jk)  = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
212         zprdia(ji,jj,jk)  = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
213         zprnut(ji,jj,jk)  = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
214      END_3D
215
216      ! Computation of the various production terms of nanophytoplankton
217      DO_3D_11_11( 1, jpkm1 )
218         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
219            !  production terms for nanophyto.
220            zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2
221            !
222            zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
223            zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
224            zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
225            zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * rfact2
226            ! Uptake of nitrogen
227            zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) ) 
228            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
229            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) )   &
230            &          / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) )
231            zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk)
232            zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk)
233            ! Uptake of phosphorus
234            zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) )
235            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
236            zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk)
237            zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk)
238            zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk)
239            ! Uptake of iron
240            zrat = MIN( 1., zratiof / qfnmax )
241            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
242            zprofmax = zprnutmax * qfnmax * zmax
243            zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk)    &
244            &          / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn  &
245            &          + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) )
246         ENDIF
247      END_3D
248
249      ! Computation of the various production terms of picophytoplankton
250      DO_3D_11_11( 1, jpkm1 )
251         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
252            !  production terms for picophyto.
253            zprorcap(ji,jj,jk) = zprpic(ji,jj,jk)  * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2
254            !
255            zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn )
256            zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn )
257            zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn )
258            zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * rfact2
259            ! Uptake of nitrogen
260            zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) )
261            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
262            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) )   &
263            &          / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) )
264            zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk) 
265            zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk)
266            ! Uptake of phosphorus
267            zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) )
268            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
269            zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk)
270            zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk)
271            zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk)
272            ! Uptake of iron
273            zrat = MIN( 1., zratiof / qfpmax )
274            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
275            zprofmax = zprnutmax * qfpmax * zmax
276            zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk)   &
277            &          / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn   &
278            &          + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) )
279         ENDIF
280      END_3D
281
282      ! Computation of the various production terms of diatoms
283      DO_3D_11_11( 1, jpkm1 )
284         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
285            !  production terms for diatomees
286            zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2
287            ! Computation of the respiration term according to pahlow
288            ! & oschlies (2013)
289            !
290            zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
291            zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
292            zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
293            zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * rfact2
294            ! Uptake of nitrogen
295            zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) )
296            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
297            zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) )   &
298            &          / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) )
299            zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk)
300            zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk)
301            ! Uptake of phosphorus
302            zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) )
303            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05)) 
304            zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk)
305            zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk)
306            zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk)
307            ! Uptake of iron
308            zrat = MIN( 1., zratiof / qfdmax )
309            zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
310            zprofmax = zprnutmax * qfdmax * zmax
311            zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk)     &
312            &          / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn   &
313            &          + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) )
314         ENDIF
315      END_3D
316
317      DO_3D_11_11( 1, jpkm1 )
318         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
319               !  production terms for nanophyto. ( chlorophyll )
320            znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
321            zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk)
322            thetannm_n   = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   &
323            &               * (1. - 1.14 / 43.4 * 20.))
324            zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn )
325            zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) )
326               !  production terms for picophyto. ( chlorophyll )
327            zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
328            zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk)
329            thetanpm_n   = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   &
330            &               * (1. - 1.14 / 43.4 * 20.))
331            zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn )
332            zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) )
333            !  production terms for diatomees ( chlorophyll )
334            zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
335            zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk)
336            thetandm_n   = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm)))   &
337            &               * (1. - 1.14 / 43.4 * 20.))
338            zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn )
339            zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) )
340            !   Update the arrays TRA which contain the Chla sources and sinks
341            tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn
342            tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd
343            tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp
344         ENDIF
345      END_3D
346
347      !   Update the arrays TRA which contain the biological sources and sinks
348      DO_3D_11_11( 1, jpkm1 )
349        zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)
350        zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)
351        zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)
352        zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  &
353        &          + excretp * zprorcap(ji,jj,jk)
354        tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk)  &
355        &                     - zpropo4p(ji,jj,jk)
356        tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)  &
357        &                     - zpronewp(ji,jj,jk)
358        tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk)  &
359        &                     - zproregp(ji,jj,jk)
360        tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn    &
361           &                  - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk)   &
362           &                  - zrespn(ji,jj,jk) 
363        zcroissn(ji,jj,jk) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn)
364        tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn
365        tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn   &
366        &                     + zprodopn(ji,jj,jk) * texcretn
367        tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn
368        tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + zprorcap(ji,jj,jk) * texcretp     &
369           &                  - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk)   &
370           &                  - zrespp(ji,jj,jk) 
371        zcroissp(ji,jj,jk) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn)
372        tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp
373        tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp   &
374        &                     + zprodopp(ji,jj,jk) * texcretp
375        tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp
376        tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd   &
377           &                  - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk)   &
378           &                  - zrespd(ji,jj,jk) 
379        zcroissd(ji,jj,jk) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn)
380        tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd
381        tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd   &
382        &                     + zprodopd(ji,jj,jk) * texcretd
383        tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd
384        tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd
385        tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)  &
386        &                     + excretp * zprorcap(ji,jj,jk)
387        tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot   &
388        &                     + excretp * zproptot
389        tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk)   &
390        &    - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk)     &
391        &    - texcretp * zprodopp(ji,jj,jk)
392        tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)   &
393           &                + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk)           &
394           &                + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) )   &
395           &                - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) )
396        zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
397        tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup
398        tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
399        tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  &
400        &                     + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk)   &
401        &                     + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk)   &
402        &                     + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk)  &
403        &                     + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk) 
404        tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk)  &
405        &                     + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk)     &
406        &                     + zproregp(ji,jj,jk) ) 
407      END_3D
408     !
409     IF( ln_ligand ) THEN
410         zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp             
411         DO_3D_11_11( 1, jpkm1 )
412           zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk)
413           zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
414           tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet
415           zpligprod1(ji,jj,jk) = zdocprod * ldocp
416           zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet
417         END_3D
418     ENDIF
419
420
421     ! Total primary production per year
422
423    ! Total primary production per year
424    IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  &
425      & tpp = glob_sum( 'p5zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) + zprorcap(:,:,:) ) * cvol(:,:,:) )
426
427    IF( lk_iomput .AND.  knt == nrdttrc ) THEN
428       zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
429       !
430       CALL iom_put( "PPPHYP"  , zprorcap(:,:,:) * zfact * tmask(:,:,:)   ) ! primary production by picophyto
431       CALL iom_put( "PPPHYN"  , zprorcan(:,:,:) * zfact * tmask(:,:,:) )  ! primary production by nanophyto
432       CALL iom_put( "PPPHYD"  , zprorcad(:,:,:) * zfact * tmask(:,:,:)   ) ! primary production by diatomes
433       CALL iom_put( "PPNEWN"  , zpronewp(:,:,:) * zfact * tmask(:,:,:)    ) ! new primary production by picophyto
434       CALL iom_put( "PPNEWN"  , zpronewn(:,:,:) * zfact * tmask(:,:,:)    ) ! new primary production by nanophyto
435       CALL iom_put( "PPNEWD"  , zpronewd(:,:,:) * zfact * tmask(:,:,:)   ) ! new primary production by diatomes
436       CALL iom_put( "PBSi"    , zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:)  ) ! biogenic silica production
437       CALL iom_put( "PFeP"    , zprofep(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by picophyto
438       CALL iom_put( "PFeN"    , zprofen(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by nanophyto
439       CALL iom_put( "PFeD"    , zprofed(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by  diatomes
440       IF( ln_ligand ) THEN
441         CALL iom_put( "LPRODP"  , zpligprod1(:,:,:) * 1e9 * zfact * tmask(:,:,:) )
442         CALL iom_put( "LDETP"   , zpligprod2(:,:,:) * 1e9 * zfact * tmask(:,:,:) )
443       ENDIF
444       CALL iom_put( "Mumax"   , zprmaxn(:,:,:) * tmask(:,:,:)  ) ! Maximum growth rate
445       CALL iom_put( "MuP"     , zprpic(:,:,:) * xlimpic(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for picophyto
446       CALL iom_put( "MuN"     , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto
447       CALL iom_put( "MuD"     , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms
448       CALL iom_put( "LPlight" , zprpic(:,:,:) / (zprmaxp(:,:,:) + rtrn) * tmask(:,:,:)  )  ! light limitation term
449       CALL iom_put( "LNlight" , zprbio(:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:)  )  ! light limitation term
450       CALL iom_put( "LDlight" , zprdia(:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:)   )
451       CALL iom_put( "MunetP"  , zcroissp(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for picophyto
452       CALL iom_put( "MunetN"  , zcroissn(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto
453       CALL iom_put( "MunetD"  , zcroissd(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms
454       CALL iom_put( "TPP"     , ( zprorcap(:,:,:) + zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  )  ! total primary production
455       CALL iom_put( "TPNEW"   , ( zpronewp(:,:,:) + zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ) ! total new production
456       CALL iom_put( "TPBFE"   , ( zprofep (:,:,:) + zprofen (:,:,:) + zprofed (:,:,:) ) * zfact * tmask(:,:,:)  )  ! total biogenic iron production
457       CALL iom_put( "tintpp"  , tpp * zfact )  !  global total integrated primary production molC/s
458     ENDIF
459
460      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
461         WRITE(charout, FMT="('prod')")
462         CALL prt_ctl_trc_info(charout)
463         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
464      ENDIF
465      !
466      IF( ln_timing )   CALL timing_stop('p5z_prod')
467      !
468   END SUBROUTINE p5z_prod
469
470
471   SUBROUTINE p5z_prod_init
472      !!----------------------------------------------------------------------
473      !!                  ***  ROUTINE p5z_prod_init  ***
474      !!
475      !! ** Purpose :   Initialization of phytoplankton production parameters
476      !!
477      !! ** Method  :   Read the nampisprod namelist and check the parameters
478      !!      called at the first timestep (nittrc000)
479      !!
480      !! ** input   :   Namelist nampisprod
481      !!----------------------------------------------------------------------
482      INTEGER :: ios                 ! Local integer output status for namelist read
483      !!
484      NAMELIST/namp5zprod/ pislopen, pislopep, pisloped, excretn, excretp, excretd,     &
485         &                 thetannm, thetanpm, thetandm, chlcmin, grosip, bresp, xadap
486      !!----------------------------------------------------------------------
487
488      READ  ( numnatp_ref, namp5zprod, IOSTAT = ios, ERR = 901)
489901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zprod in reference namelist' )
490
491      READ  ( numnatp_cfg, namp5zprod, IOSTAT = ios, ERR = 902 )
492902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namp5zprod in configuration namelist' )
493      IF(lwm) WRITE ( numonp, namp5zprod )
494
495      IF(lwp) THEN                         ! control print
496         WRITE(numout,*) ' '
497         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp5zprod'
498         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
499         WRITE(numout,*) '    mean Si/C ratio                           grosip       =', grosip
500         WRITE(numout,*) '    P-I slope                                 pislopen     =', pislopen
501         WRITE(numout,*) '    P-I slope  for diatoms                    pisloped     =', pisloped
502         WRITE(numout,*) '    P-I slope  for picophytoplankton          pislopep     =', pislopep
503         WRITE(numout,*) '    Acclimation factor to low light           xadap        =', xadap
504         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excretn      =', excretn
505         WRITE(numout,*) '    excretion ratio of picophytoplankton      excretp      =', excretp
506         WRITE(numout,*) '    excretion ratio of diatoms                excretd      =', excretd
507         WRITE(numout,*) '    basal respiration in phytoplankton        bresp        =', bresp
508         WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin
509         WRITE(numout,*) '    Minimum Chl/N in nanophytoplankton        thetannm     =', thetannm
510         WRITE(numout,*) '    Minimum Chl/N in picophytoplankton        thetanpm     =', thetanpm
511         WRITE(numout,*) '    Minimum Chl/N in diatoms                  thetandm     =', thetandm
512      ENDIF
513      !
514      r1_rday   = 1._wp / rday 
515      texcretn  = 1._wp - excretn
516      texcretp  = 1._wp - excretp
517      texcretd  = 1._wp - excretd
518      tpp       = 0._wp
519      !
520   END SUBROUTINE p5z_prod_init
521
522
523   INTEGER FUNCTION p5z_prod_alloc()
524      !!----------------------------------------------------------------------
525      !!                     ***  ROUTINE p5z_prod_alloc  ***
526      !!----------------------------------------------------------------------
527      ALLOCATE( zdaylen(jpi,jpj), STAT = p5z_prod_alloc )
528      !
529      IF( p5z_prod_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p5z_prod_alloc : failed to allocate arrays.' )
530      !
531   END FUNCTION p5z_prod_alloc
532   !!======================================================================
533END MODULE p5zprod
Note: See TracBrowser for help on using the repository browser.