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

source: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90 @ 4641

Last change on this file since 4641 was 4624, checked in by acc, 10 years ago

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