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.
p5zprod.F90 in NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/TOP/PISCES/P4Z/p5zprod.F90 @ 11671

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

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.

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