source: NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/P4Z/p4zprod.F90 @ 10314

Last change on this file since 10314 was 10314, checked in by smasson, 23 months ago

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2: add generic glob_min/max/sum and locmin/max, complete timing and report (including bdy and icb), see #2133

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