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

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

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

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