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.
p4zprod.F90 in branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90 @ 4148

Last change on this file since 4148 was 4148, checked in by cetlod, 11 years ago

merge in trunk changes between r3853 and r3940 and commit the changes, see ticket #1169
File size: 27.2 KB
Line 
1MODULE p4zprod
2   !!======================================================================
3   !!                         ***  MODULE p4zprod  ***
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   !!----------------------------------------------------------------------
10#if defined key_pisces
11   !!----------------------------------------------------------------------
12   !!   'key_pisces'                                       PISCES bio-model
13   !!----------------------------------------------------------------------
14   !!   p4z_prod       :   Compute the growth Rate of the two phytoplanktons groups
15   !!   p4z_prod_init  :   Initialization of the parameters for growth
16   !!   p4z_prod_alloc :   Allocate variables for growth
17   !!----------------------------------------------------------------------
18   USE oce_trc         !  shared variables between ocean and passive tracers
19   USE trc             !  passive tracers common variables
20   USE sms_pisces      !  PISCES Source Minus Sink variables
21   USE p4zopt          !  optical model
22   USE p4zlim          !  Co-limitations of differents nutrients
23   USE prtctl_trc      !  print control for debugging
24   USE iom             !  I/O manager
25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC   p4z_prod         ! called in p4zbio.F90
30   PUBLIC   p4z_prod_init    ! called in trcsms_pisces.F90
31   PUBLIC   p4z_prod_alloc
32
33   !! * Shared module variables
34   LOGICAL , PUBLIC ::  ln_newprod      !:
35   REAL(wp), PUBLIC ::  pislope         !:
36   REAL(wp), PUBLIC ::  pislope2        !:
37   REAL(wp), PUBLIC ::  excret          !:
38   REAL(wp), PUBLIC ::  excret2         !:
39   REAL(wp), PUBLIC ::  bresp           !:
40   REAL(wp), PUBLIC ::  chlcnm          !:
41   REAL(wp), PUBLIC ::  chlcdm          !:
42   REAL(wp), PUBLIC ::  chlcmin         !:
43   REAL(wp), PUBLIC ::  fecnm           !:
44   REAL(wp), PUBLIC ::  fecdm           !:
45   REAL(wp), PUBLIC ::  grosip          !:
46
47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax    !: optimal production = f(temperature)
48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotan   !: proxy of N quota in Nanophyto
49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotad   !: proxy of N quota in diatomee
50   
51   REAL(wp) :: r1_rday                !: 1 / rday
52   REAL(wp) :: texcret                !: 1 - excret
53   REAL(wp) :: texcret2               !: 1 - excret2       
54
55
56   !!* Substitution
57#  include "top_substitute.h90"
58   !!----------------------------------------------------------------------
59   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
60   !! $Id: p4zprod.F90 3160 2011-11-20 14:27:18Z cetlod $
61   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
62   !!----------------------------------------------------------------------
63CONTAINS
64
65   SUBROUTINE p4z_prod( kt , jnt )
66      !!---------------------------------------------------------------------
67      !!                     ***  ROUTINE p4z_prod  ***
68      !!
69      !! ** Purpose :   Compute the phytoplankton production depending on
70      !!              light, temperature and nutrient availability
71      !!
72      !! ** Method  : - ???
73      !!---------------------------------------------------------------------
74      !
75      INTEGER, INTENT(in) :: kt, jnt
76      !
77      INTEGER  ::   ji, jj, jk
78      REAL(wp) ::   zsilfac, znanotot, zdiattot, zconctemp, zconctemp2
79      REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap
80      REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zproreg, zproreg2
81      REAL(wp) ::   zmxltst, zmxlday, zmaxday
82      REAL(wp) ::   zpislopen  , zpislope2n
83      REAL(wp) ::   zrum, zcodel, zargu, zval
84      REAL(wp) ::   zrfact2
85      CHARACTER (len=25) :: charout
86      REAL(wp), POINTER, DIMENSION(:,:  ) :: zmixnano, zmixdiat, zstrn
87      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt   
88      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd
89      !!---------------------------------------------------------------------
90      !
91      IF( nn_timing == 1 )  CALL timing_start('p4z_prod')
92      !
93      !  Allocate temporary workspace
94      CALL wrk_alloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  )
95      CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            ) 
96      CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd )
97      !
98      zprorca (:,:,:) = 0._wp
99      zprorcad(:,:,:) = 0._wp
100      zprofed (:,:,:) = 0._wp
101      zprofen (:,:,:) = 0._wp
102      zprochln(:,:,:) = 0._wp
103      zprochld(:,:,:) = 0._wp
104      zpronew (:,:,:) = 0._wp
105      zpronewd(:,:,:) = 0._wp
106      zprdia  (:,:,:) = 0._wp
107      zprbio  (:,:,:) = 0._wp
108      zprdch  (:,:,:) = 0._wp
109      zprnch  (:,:,:) = 0._wp
110      zysopt  (:,:,:) = 0._wp
111
112      ! Computation of the optimal production
113      prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:) 
114      IF( lk_degrad )  prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:) 
115
116      ! compute the day length depending on latitude and the day
117      zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp )
118      zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  )
119
120      ! day length in hours
121      zstrn(:,:) = 0.
122      DO jj = 1, jpj
123         DO ji = 1, jpi
124            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
125            zargu = MAX( -1., MIN(  1., zargu ) )
126            zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
127         END DO
128      END DO
129
130      IF( ln_newprod ) THEN
131         ! Impact of the day duration on phytoplankton growth
132         DO jk = 1, jpkm1
133            DO jj = 1 ,jpj
134               DO ji = 1, jpi
135                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
136                     zval = MAX( 1., zstrn(ji,jj) )
137                     zval = 1.5 * zval / ( 12. + zval )
138                     zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval
139                     zprdia(ji,jj,jk) = zprbio(ji,jj,jk)
140                  ENDIF
141               END DO
142            END DO
143         END DO
144      ENDIF
145
146      ! Maximum light intensity
147      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
148      zstrn(:,:) = 24. / zstrn(:,:)
149
150      IF( ln_newprod ) THEN
151!CDIR NOVERRCHK
152         DO jk = 1, jpkm1
153!CDIR NOVERRCHK
154            DO jj = 1, jpj
155!CDIR NOVERRCHK
156               DO ji = 1, jpi
157                  ! Computation of the P-I slope for nanos and diatoms
158                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
159                      ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
160                      zadap       = ztn / ( 2.+ ztn )
161                      zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
162                      zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp
163                      znanotot    = enano(ji,jj,jk) * zstrn(ji,jj)
164                      zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj)
165                      !
166                      zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap  * EXP( -znanotot ) )  &
167                         &                   * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn)
168                      !
169                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn )   &
170                         &                   * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn)
171
172                      ! Computation of production function for Carbon
173                      !  ---------------------------------------------
174                      zpislopen  = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn)
175                      zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn)
176                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot )  )
177                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot )  )
178
179                      !  Computation of production function for Chlorophyll
180                      !--------------------------------------------------
181                      zmaxday  = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn )
182                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) )
183                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) )
184                  ENDIF
185               END DO
186            END DO
187         END DO
188      ELSE
189!CDIR NOVERRCHK
190         DO jk = 1, jpkm1
191!CDIR NOVERRCHK
192            DO jj = 1, jpj
193!CDIR NOVERRCHK
194               DO ji = 1, jpi
195
196                  ! Computation of the P-I slope for nanos and diatoms
197                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
198                      ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
199                      zadap       = ztn / ( 2.+ ztn )
200                      zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
201                      zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp
202                      !
203                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * EXP( -0.21 * enano(ji,jj,jk) ) )
204                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp)  / ( trn(ji,jj,jk,jpdia) + rtrn )
205
206                      zpislopen =  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)                &
207                        &          / ( trn(ji,jj,jk,jpphy) * 12.                  + rtrn )   &
208                        &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
209
210                      zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)                &
211                        &          / ( trn(ji,jj,jk,jpdia) * 12.                  + rtrn )   &
212                        &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
213
214                      ! Computation of production function for Carbon
215                      !  ---------------------------------------------
216                      zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) )
217                      zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) )
218
219                      !  Computation of production function for Chlorophyll
220                      !--------------------------------------------------
221                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) * zstrn(ji,jj) ) )
222                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) )
223                  ENDIF
224               END DO
225            END DO
226         END DO
227      ENDIF
228
229      !  Computation of a proxy of the N/C ratio
230      !  ---------------------------------------
231!CDIR NOVERRCHK
232      DO jk = 1, jpkm1
233!CDIR NOVERRCHK
234         DO jj = 1, jpj
235!CDIR NOVERRCHK
236            DO ji = 1, jpi
237                zval = ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn )
238                quotan(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval )
239                zval = ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn )
240                quotad(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval )
241            END DO
242         END DO
243      END DO
244
245
246      DO jk = 1, jpkm1
247         DO jj = 1, jpj
248            DO ji = 1, jpi
249
250                IF( etot(ji,jj,jk) > 1.E-3 ) THEN
251                   !    Si/C of diatoms
252                   !    ------------------------
253                   !    Si/C increases with iron stress and silicate availability
254                   !    Si/C is arbitrariliy increased for very high Si concentrations
255                   !    to mimic the very high ratios observed in the Southern Ocean (silpot2)
256                  zlim  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 )
257                  zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
258                  zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0
259                  zsiborn = trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil)
260                  IF (gphit(ji,jj) < -30 ) THEN
261                    zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
262                  ELSE
263                    zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 )
264                  ENDIF
265                  zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2
266              ENDIF
267            END DO
268         END DO
269      END DO
270
271      !  Computation of the limitation term due to a mixed layer deeper than the euphotic depth
272      DO jj = 1, jpj
273         DO ji = 1, jpi
274            zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) )
275            zmxlday = zmxltst * zmxltst * r1_rday
276            zmixnano(ji,jj) = 1. - zmxlday / ( 3. + zmxlday )
277            zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday )
278         END DO
279      END DO
280 
281      !  Mixed-layer effect on production                                                                               
282      DO jk = 1, jpkm1
283         DO jj = 1, jpj
284            DO ji = 1, jpi
285               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
286                  zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj)
287                  zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj)
288               ENDIF
289            END DO
290         END DO
291      END DO
292
293      ! Computation of the various production terms
294!CDIR NOVERRCHK
295      DO jk = 1, jpkm1
296!CDIR NOVERRCHK
297         DO jj = 1, jpj
298!CDIR NOVERRCHK
299            DO ji = 1, jpi
300               IF( etot(ji,jj,jk) > 1.E-3 ) THEN
301                  !  production terms for nanophyto.
302                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2
303                  zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
304                  !
305                  zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn )
306                  zratio = zratio / fecnm 
307                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
308                  zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk)  &
309                  &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    &
310                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  &
311                  &             * zmax * trn(ji,jj,jk,jpphy) * rfact2
312                  !  production terms for diatomees
313                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2
314                  zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
315                  !
316                  zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
317                  zratio = zratio / fecdm 
318                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
319                  zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk)  &
320                  &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    &
321                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  &
322                  &             * zmax * trn(ji,jj,jk,jpdia) * rfact2
323               ENDIF
324            END DO
325         END DO
326      END DO
327
328      IF( ln_newprod ) THEN
329!CDIR NOVERRCHK
330         DO jk = 1, jpkm1
331!CDIR NOVERRCHK
332            DO jj = 1, jpj
333!CDIR NOVERRCHK
334               DO ji = 1, jpi
335                  IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
336                     zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj)
337                     zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj)
338                  ENDIF
339                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
340                     !  production terms for nanophyto. ( chlorophyll )
341                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
342                     zprod    = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk)
343                     zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk)
344                     zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 12. * zprod / &
345                                        & (  zpislopead(ji,jj,jk) * znanotot +rtrn)
346                     !  production terms for diatomees ( chlorophyll )
347                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
348                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk)
349                     zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk)
350                     zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / &
351                                        & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn )
352                  ENDIF
353               END DO
354            END DO
355         END DO
356      ELSE
357!CDIR NOVERRCHK
358         DO jk = 1, jpkm1
359!CDIR NOVERRCHK
360            DO jj = 1, jpj
361!CDIR NOVERRCHK
362               DO ji = 1, jpi
363                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
364                     !  production terms for nanophyto. ( chlorophyll )
365                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
366                     zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk)
367                     zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk)
368                     zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 144. * zprod            &
369                     &                    / ( zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn )
370                     !  production terms for diatomees ( chlorophyll )
371                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
372                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk)
373                     zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk)
374                     zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 144. * zprod             &
375                     &                    / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn )
376                  ENDIF
377               END DO
378            END DO
379         END DO
380      ENDIF
381
382      !   Update the arrays TRA which contain the biological sources and sinks
383      DO jk = 1, jpkm1
384         DO jj = 1, jpj
385           DO ji =1 ,jpi
386              zproreg  = zprorca(ji,jj,jk) - zpronew(ji,jj,jk)
387              zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk)
388              tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk)
389              tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(ji,jj,jk) - zpronewd(ji,jj,jk)
390              tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2
391              tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorca(ji,jj,jk) * texcret
392              tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln(ji,jj,jk) * texcret
393              tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcret
394              tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcret2
395              tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld(ji,jj,jk) * texcret2
396              tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2
397              tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2
398              tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk)
399              tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) &
400                 &                + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) )
401              tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk)
402              tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
403              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk)
404              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) &
405                 &                                      - rno3 * ( zproreg + zproreg2 )
406          END DO
407        END DO
408     END DO
409
410     ! Total primary production per year
411     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
412
413     IF( ln_diatrc ) THEN
414         !
415         zrfact2 = 1.e3 * rfact2r  ! conversion from mol/L/timestep into mol/m3/s
416         IF( lk_iomput ) THEN
417           IF( jnt == nrdttrc ) THEN
418              CALL iom_put( "PPPHY"  , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by nanophyto
419              CALL iom_put( "PPPHY2" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by diatom
420              CALL iom_put( "PPNEWN" , zpronew (:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by nanophyto
421              CALL iom_put( "PPNEWD" , zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by diatom
422              CALL iom_put( "PBSi"   , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production
423              CALL iom_put( "PFeD"   , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by diatom
424              CALL iom_put( "PFeN"   , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by nanophyto
425              CALL iom_put( "Mumax"  , prmax(:,:,:) * tmask(:,:,:) )  ! Maximum growth rate
426              CALL iom_put( "MuN"    , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) )  ! Realized growth rate for nanophyto
427              CALL iom_put( "MuD"    , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) )  ! Realized growth rate for diatoms
428              CALL iom_put( "LNlight", zprbio (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) )  ! light limitation term
429              CALL iom_put( "LDlight", zprdia (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) )  ! light limitation term
430           ENDIF
431         ELSE
432              trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zrfact2 * tmask(:,:,:)
433              trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:)
434              trc3d(:,:,:,jp_pcs0_3d + 6)  = zpronew (:,:,:) * zrfact2 * tmask(:,:,:)
435              trc3d(:,:,:,jp_pcs0_3d + 7)  = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:)
436              trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:)
437              trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zrfact2 * tmask(:,:,:)
438#  if ! defined key_kriest
439              trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:)
440#  endif
441         ENDIF
442         !
443      ENDIF
444
445      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
446         WRITE(charout, FMT="('prod')")
447         CALL prt_ctl_trc_info(charout)
448         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
449      ENDIF
450      !
451      CALL wrk_dealloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  )
452      CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            ) 
453      CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd )
454      !
455      IF( nn_timing == 1 )  CALL timing_stop('p4z_prod')
456      !
457   END SUBROUTINE p4z_prod
458
459
460   SUBROUTINE p4z_prod_init
461      !!----------------------------------------------------------------------
462      !!                  ***  ROUTINE p4z_prod_init  ***
463      !!
464      !! ** Purpose :   Initialization of phytoplankton production parameters
465      !!
466      !! ** Method  :   Read the nampisprod namelist and check the parameters
467      !!      called at the first timestep (nittrc000)
468      !!
469      !! ** input   :   Namelist nampisprod
470      !!----------------------------------------------------------------------
471      !
472      NAMELIST/nampisprod/ pislope, pislope2, ln_newprod, bresp, excret, excret2,  &
473         &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip
474      INTEGER :: ios                 ! Local integer output status for namelist read
475      !!----------------------------------------------------------------------
476
477      REWIND( numnatp_ref )              ! Namelist nampisprod in reference namelist : Pisces phytoplankton production
478      READ  ( numnatp_ref, nampisprod, IOSTAT = ios, ERR = 901)
479901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisprod in reference namelist', lwp )
480
481      REWIND( numnatp_cfg )              ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production
482      READ  ( numnatp_cfg, nampisprod, IOSTAT = ios, ERR = 902 )
483902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisprod in configuration namelist', lwp )
484      WRITE ( numonp, nampisprod )
485
486      IF(lwp) THEN                         ! control print
487         WRITE(numout,*) ' '
488         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod'
489         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
490         WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod   =', ln_newprod
491         WRITE(numout,*) '    mean Si/C ratio                           grosip       =', grosip
492         WRITE(numout,*) '    P-I slope                                 pislope      =', pislope
493         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excret       =', excret
494         WRITE(numout,*) '    excretion ratio of diatoms                excret2      =', excret2
495         IF( ln_newprod )  THEN
496            WRITE(numout,*) '    basal respiration in phytoplankton        bresp        =', bresp
497            WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin
498         ENDIF
499         WRITE(numout,*) '    P-I slope  for diatoms                    pislope2     =', pislope2
500         WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm       =', chlcnm
501         WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm       =', chlcdm
502         WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm        =', fecnm
503         WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm        =', fecdm
504      ENDIF
505      !
506      r1_rday   = 1._wp / rday 
507      texcret   = 1._wp - excret
508      texcret2  = 1._wp - excret2
509      tpp       = 0._wp
510      !
511   END SUBROUTINE p4z_prod_init
512
513
514   INTEGER FUNCTION p4z_prod_alloc()
515      !!----------------------------------------------------------------------
516      !!                     ***  ROUTINE p4z_prod_alloc  ***
517      !!----------------------------------------------------------------------
518      ALLOCATE( prmax(jpi,jpj,jpk), quotan(jpi,jpj,jpk), quotad(jpi,jpj,jpk), STAT = p4z_prod_alloc )
519      !
520      IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.')
521      !
522   END FUNCTION p4z_prod_alloc
523
524#else
525   !!======================================================================
526   !!  Dummy module :                                   No PISCES bio-model
527   !!======================================================================
528CONTAINS
529   SUBROUTINE p4z_prod                    ! Empty routine
530   END SUBROUTINE p4z_prod
531#endif 
532
533   !!======================================================================
534END MODULE  p4zprod
Note: See TracBrowser for help on using the repository browser.