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_r11943_MERGE_2019/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zprod.F90 @ 12340

Last change on this file since 12340 was 12340, checked in by acc, 4 years ago

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

which may need to be considered.
  • 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"   , ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * 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.