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

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

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

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

svn merge —ignore-ancestry \

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

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

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

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

  • Property svn:keywords set to Id
File size: 21.7 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 p4zlim          ! 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   REAL(wp), PUBLIC ::   pislopen     !:
29   REAL(wp), PUBLIC ::   pisloped     !:
30   REAL(wp), PUBLIC ::   xadap        !:
31   REAL(wp), PUBLIC ::   excretn      !:
32   REAL(wp), PUBLIC ::   excretd      !:
33   REAL(wp), PUBLIC ::   bresp        !:
34   REAL(wp), PUBLIC ::   chlcnm       !:
35   REAL(wp), PUBLIC ::   chlcdm       !:
36   REAL(wp), PUBLIC ::   chlcmin      !:
37   REAL(wp), PUBLIC ::   fecnm        !:
38   REAL(wp), PUBLIC ::   fecdm        !:
39   REAL(wp), PUBLIC ::   grosip       !:
40
41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotan   !: proxy of N quota in Nanophyto
42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotad   !: proxy of N quota in diatomee
43   
44   REAL(wp) ::   r1_rday    ! 1 / rday
45   REAL(wp) ::   texcretn   ! 1 - excretn
46   REAL(wp) ::   texcretd   ! 1 - excretd       
47
48   !! * Substitutions
49#  include "do_loop_substitute.h90"
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, Kbb, Kmm, Krhs )
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      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices
68      !
69      INTEGER  ::   ji, jj, jk
70      REAL(wp) ::   zsilfac, znanotot, zdiattot, zconctemp, zconctemp2
71      REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap, zlim, zsilfac2, zsiborn
72      REAL(wp) ::   zprod, zproreg, zproreg2, zprochln, zprochld
73      REAL(wp) ::   zmaxday, zdocprod, zpislopen, zpisloped
74      REAL(wp) ::   zmxltst, zmxlday
75      REAL(wp) ::   zrum, zcodel, zargu, zval, zfeup, chlcnm_n, chlcdm_n
76      REAL(wp) ::   zfact
77      CHARACTER (len=25) :: charout
78      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zw2d
79      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d
80      REAL(wp), DIMENSION(jpi,jpj    ) :: zstrn, zmixnano, zmixdiat
81      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprmaxn,zprmaxd
82      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopeadn, zpislopeadd, zysopt 
83      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprdia, zprbio, zprdch, zprnch   
84      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorcan, zprorcad, zprofed, zprofen
85      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronewn, zpronewd
86      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl
87      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpligprod1, zpligprod2
88      !!---------------------------------------------------------------------
89      !
90      IF( ln_timing )   CALL timing_start('p4z_prod')
91      !
92      !  Allocate temporary workspace
93      !
94      zprorcan  (:,:,:) = 0._wp ; zprorcad  (:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp
95      zprofen   (:,:,:) = 0._wp ; zysopt    (:,:,:) = 0._wp
96      zpronewn  (:,:,:) = 0._wp ; zpronewd  (:,:,:) = 0._wp ; zprdia  (:,:,:) = 0._wp
97      zprbio    (:,:,:) = 0._wp ; zprdch    (:,:,:) = 0._wp ; zprnch  (:,:,:) = 0._wp 
98      zmxl_fac  (:,:,:) = 0._wp ; zmxl_chl  (:,:,:) = 0._wp 
99      zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp 
100
101      ! Computation of the optimal production
102      zprmaxn(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:)
103      zprmaxd(:,:,:) = zprmaxn(:,:,:)
104
105      ! compute the day length depending on latitude and the day
106      zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp )
107      zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  )
108
109      ! day length in hours
110      zstrn(:,:) = 0.
111      DO_2D_11_11
112         zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
113         zargu = MAX( -1., MIN(  1., zargu ) )
114         zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
115      END_2D
116
117      ! Impact of the day duration and light intermittency on phytoplankton growth
118      DO_3D_11_11( 1, jpkm1 )
119         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
120            zval = MAX( 1., zstrn(ji,jj) )
121            IF( gdept(ji,jj,jk,Kmm) <= hmld(ji,jj) ) THEN
122               zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
123            ENDIF
124            zmxl_chl(ji,jj,jk) = zval / 24.
125            zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval )
126         ENDIF
127      END_3D
128
129      zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:)
130      zprdia(:,:,:) = zprmaxd(:,:,:) * zmxl_fac(:,:,:)
131
132      ! Maximum light intensity
133      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
134
135      ! Computation of the P-I slope for nanos and diatoms
136      DO_3D_11_11( 1, jpkm1 )
137         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
138            ztn         = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. )
139            zadap       = xadap * ztn / ( 2.+ ztn )
140            zconctemp   = MAX( 0.e0 , tr(ji,jj,jk,jpdia,Kbb) - xsizedia )
141            zconctemp2  = tr(ji,jj,jk,jpdia,Kbb) - zconctemp
142            !
143            zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  &
144            &                   * tr(ji,jj,jk,jpnch,Kbb) /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn)
145            !
146            zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )   &
147            &                   * tr(ji,jj,jk,jpdch,Kbb) /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn)
148         ENDIF
149      END_3D
150
151      DO_3D_11_11( 1, jpkm1 )
152         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
153             ! Computation of production function for Carbon
154             !  ---------------------------------------------
155             zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
156             &            * zmxl_fac(ji,jj,jk) * rday + rtrn)
157             zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) &
158             &            * zmxl_fac(ji,jj,jk) * rday + rtrn)
159             zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  )
160             zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  )
161             !  Computation of production function for Chlorophyll
162             !--------------------------------------------------
163             zpislopen = zpislopeadn(ji,jj,jk) / ( zprmaxn(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
164             zpisloped = zpislopeadd(ji,jj,jk) / ( zprmaxd(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn )
165             zprnch(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) )
166             zprdch(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) )
167         ENDIF
168      END_3D
169
170      !  Computation of a proxy of the N/C ratio
171      !  ---------------------------------------
172      DO_3D_11_11( 1, jpkm1 )
173          zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   &
174          &      * zprmaxn(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn )
175          quotan(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval )
176          zval = MIN( xdiatpo4(ji,jj,jk), ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) )   &
177          &      * zprmaxd(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn )
178          quotad(ji,jj,jk) = MIN( 1., 0.2 + 0.8 * zval )
179      END_3D
180
181
182      DO_3D_11_11( 1, jpkm1 )
183
184          IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
185             !    Si/C of diatoms
186             !    ------------------------
187             !    Si/C increases with iron stress and silicate availability
188             !    Si/C is arbitrariliy increased for very high Si concentrations
189             !    to mimic the very high ratios observed in the Southern Ocean (silpot2)
190            zlim  = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 )
191            zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
192            zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0
193            zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb)
194            IF (gphit(ji,jj) < -30 ) THEN
195              zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
196            ELSE
197              zsilfac2 = 1. +      zsiborn / ( zsiborn + xksi2**3 )
198            ENDIF
199            zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2
200        ENDIF
201      END_3D
202
203      !  Mixed-layer effect on production
204      !  Sea-ice effect on production
205
206      DO_3D_11_11( 1, jpkm1 )
207         zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
208         zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
209      END_3D
210
211      ! Computation of the various production terms
212      DO_3D_11_11( 1, jpkm1 )
213         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
214            !  production terms for nanophyto. (C)
215            zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2
216            zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
217            !
218            zratio = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) * fecnm + rtrn )
219            zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
220            zprofen(ji,jj,jk) = fecnm * zprmaxn(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  &
221            &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    &
222            &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  &
223            &             * zmax * tr(ji,jj,jk,jpphy,Kbb) * rfact2
224            !  production terms for diatoms (C)
225            zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2
226            zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
227            !
228            zratio = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) * fecdm + rtrn )
229            zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
230            zprofed(ji,jj,jk) = fecdm * zprmaxd(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) )  &
231            &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    &
232            &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  &
233            &             * zmax * tr(ji,jj,jk,jpdia,Kbb) * rfact2
234         ENDIF
235      END_3D
236
237      ! Computation of the chlorophyll production terms
238      DO_3D_11_11( 1, jpkm1 )
239         IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
240            !  production terms for nanophyto. ( chlorophyll )
241            znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
242            zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk)
243            zprochln = chlcmin * 12. * zprorcan (ji,jj,jk)
244            chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.))
245            zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / &
246                                  & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn)
247            !  production terms for diatoms ( chlorophyll )
248            zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
249            zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk)
250            zprochld = chlcmin * 12. * zprorcad(ji,jj,jk)
251            chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * ts(ji,jj,jk,jp_tem,Kmm))) * (1. - 1.14 / 43.4 * 20.))
252            zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / &
253                                  & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn )
254            !   Update the arrays TRA which contain the Chla sources and sinks
255            tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn
256            tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd
257         ENDIF
258      END_3D
259
260      !   Update the arrays TRA which contain the biological sources and sinks
261      DO_3D_11_11( 1, jpkm1 )
262        IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
263           zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk)
264           zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk)
265           zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
266           tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)
267           tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk)
268           tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproreg - zproreg2
269           tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn
270           tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn
271           tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd
272           tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd
273           tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd
274           tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zdocprod
275           tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproreg + zproreg2) &
276           &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) )
277           !
278           zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
279           tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup
280           tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
281           tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk)
282           tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) &
283           &                                         - rno3 * ( zproreg + zproreg2 )
284        ENDIF
285      END_3D
286     !
287     IF( ln_ligand ) THEN
288         zpligprod1(:,:,:) = 0._wp    ;    zpligprod2(:,:,:) = 0._wp
289         DO_3D_11_11( 1, jpkm1 )
290           IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
291              zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk)
292              zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk)
293              tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet
294              zpligprod1(ji,jj,jk) = zdocprod * ldocp
295              zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet
296           ENDIF
297         END_3D
298     ENDIF
299
300
301    ! Total primary production per year
302    IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  &
303         & tpp = glob_sum( 'p4zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
304
305    IF( lk_iomput .AND.  knt == nrdttrc ) THEN
306       zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
307       !
308       CALL iom_put( "PPPHYN"  , zprorcan(:,:,:) * zfact * tmask(:,:,:) )  ! primary production by nanophyto
309       CALL iom_put( "PPPHYD"  , zprorcad(:,:,:) * zfact * tmask(:,:,:)   ) ! primary production by diatomes
310       CALL iom_put( "PPNEWN"  , zpronewn(:,:,:) * zfact * tmask(:,:,:)    ) ! new primary production by nanophyto
311       CALL iom_put( "PPNEWD"  , zpronewd(:,:,:) * zfact * tmask(:,:,:)   ) ! new primary production by diatomes
312       CALL iom_put( "PBSi"    , zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:)  ) ! biogenic silica production
313       CALL iom_put( "PFeN"    , zprofen(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by nanophyto
314       CALL iom_put( "PFeD"    , zprofed(:,:,:) * zfact * tmask(:,:,:)  ) ! biogenic iron production by  diatomes
315       IF( ln_ligand ) THEN
316         CALL iom_put( "LPRODP"  , zpligprod1(:,:,:) * 1e9 * zfact * tmask(:,:,:) )
317         CALL iom_put( "LDETP"   , zpligprod2(:,:,:) * 1e9 * zfact * tmask(:,:,:) )
318       ENDIF
319       CALL iom_put( "Mumax"   , zprmaxn(:,:,:) * tmask(:,:,:)  ) ! Maximum growth rate
320       CALL iom_put( "MuN"     , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto
321       CALL iom_put( "MuD"     , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms
322       CALL iom_put( "LNlight" , zprbio (:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:)  )  ! light limitation term
323       CALL iom_put( "LDlight" , zprdia (:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:)   )
324       CALL iom_put( "TPP"     , ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  )  ! total primary production
325       CALL iom_put( "TPNEW"   , ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ) ! total new production
326       CALL iom_put( "TPBFE"   , ( zprofen(:,:,:) + zprofed(:,:,:) ) * zfact * tmask(:,:,:)  )  ! total biogenic iron production
327       CALL iom_put( "tintpp"  , tpp * zfact )  !  global total integrated primary production molC/s
328     ENDIF
329
330     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
331         WRITE(charout, FMT="('prod')")
332         CALL prt_ctl_trc_info(charout)
333         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
334     ENDIF
335      !
336      IF( ln_timing )  CALL timing_stop('p4z_prod')
337      !
338   END SUBROUTINE p4z_prod
339
340
341   SUBROUTINE p4z_prod_init
342      !!----------------------------------------------------------------------
343      !!                  ***  ROUTINE p4z_prod_init  ***
344      !!
345      !! ** Purpose :   Initialization of phytoplankton production parameters
346      !!
347      !! ** Method  :   Read the nampisprod namelist and check the parameters
348      !!      called at the first timestep (nittrc000)
349      !!
350      !! ** input   :   Namelist nampisprod
351      !!----------------------------------------------------------------------
352      INTEGER ::   ios   ! Local integer
353      !
354      NAMELIST/namp4zprod/ pislopen, pisloped, xadap, bresp, excretn, excretd,  &
355         &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip
356      !!----------------------------------------------------------------------
357      !
358      IF(lwp) THEN                         ! control print
359         WRITE(numout,*)
360         WRITE(numout,*) 'p4z_prod_init : phytoplankton growth'
361         WRITE(numout,*) '~~~~~~~~~~~~~'
362      ENDIF
363      !
364      READ  ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901)
365901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zprod in reference namelist' )
366      READ  ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 )
367902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zprod in configuration namelist' )
368      IF(lwm) WRITE( numonp, namp4zprod )
369
370      IF(lwp) THEN                         ! control print
371         WRITE(numout,*) '   Namelist : namp4zprod'
372         WRITE(numout,*) '      mean Si/C ratio                           grosip       =', grosip
373         WRITE(numout,*) '      P-I slope                                 pislopen     =', pislopen
374         WRITE(numout,*) '      Acclimation factor to low light           xadap        =', xadap
375         WRITE(numout,*) '      excretion ratio of nanophytoplankton      excretn      =', excretn
376         WRITE(numout,*) '      excretion ratio of diatoms                excretd      =', excretd
377         WRITE(numout,*) '      basal respiration in phytoplankton        bresp        =', bresp
378         WRITE(numout,*) '      Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin
379         WRITE(numout,*) '      P-I slope  for diatoms                    pisloped     =', pisloped
380         WRITE(numout,*) '      Minimum Chl/C in nanophytoplankton        chlcnm       =', chlcnm
381         WRITE(numout,*) '      Minimum Chl/C in diatoms                  chlcdm       =', chlcdm
382         WRITE(numout,*) '      Maximum Fe/C in nanophytoplankton         fecnm        =', fecnm
383         WRITE(numout,*) '      Minimum Fe/C in diatoms                   fecdm        =', fecdm
384      ENDIF
385      !
386      r1_rday   = 1._wp / rday 
387      texcretn  = 1._wp - excretn
388      texcretd  = 1._wp - excretd
389      tpp       = 0._wp
390      !
391   END SUBROUTINE p4z_prod_init
392
393
394   INTEGER FUNCTION p4z_prod_alloc()
395      !!----------------------------------------------------------------------
396      !!                     ***  ROUTINE p4z_prod_alloc  ***
397      !!----------------------------------------------------------------------
398      ALLOCATE( quotan(jpi,jpj,jpk), quotad(jpi,jpj,jpk), STAT = p4z_prod_alloc )
399      !
400      IF( p4z_prod_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_prod_alloc : failed to allocate arrays.' )
401      !
402   END FUNCTION p4z_prod_alloc
403
404   !!======================================================================
405END MODULE p4zprod
Note: See TracBrowser for help on using the repository browser.