Context Navigation

p5zprod.F90 @ 12587

Last change on this file since 12587 was 12377, checked in by acc, 4 years 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: 31.7 KB

Line
1	MODULE p5zprod
2	!!======================================================================
3	!! * MODULE p5zprod *
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	!! 3.6 ! 2015-05 (O. Aumont) PISCES quota
10	!!----------------------------------------------------------------------
11	!! p5z_prod : Compute the growth Rate of the two phytoplanktons groups
12	!! p5z_prod_init : Initialization of the parameters for growth
13	!! p5z_prod_alloc : Allocate variables for growth
14	!!----------------------------------------------------------------------
15	USE oce_trc ! shared variables between ocean and passive tracers
16	USE trc ! passive tracers common variables
17	USE sms_pisces ! PISCES Source Minus Sink variables
18	USE p4zlim
19	USE p5zlim ! Co-limitations of differents nutrients
20	USE prtctl_trc ! print control for debugging
21	USE iom ! I/O manager
22
23	IMPLICIT NONE
24	PRIVATE
25
26	PUBLIC p5z_prod ! called in p5zbio.F90
27	PUBLIC p5z_prod_init ! called in trcsms_pisces.F90
28	PUBLIC p5z_prod_alloc
29
30	!! * Shared module variables
31	REAL(wp), PUBLIC :: pislopen !:
32	REAL(wp), PUBLIC :: pislopep !:
33	REAL(wp), PUBLIC :: pisloped !:
34	REAL(wp), PUBLIC :: xadap !:
35	REAL(wp), PUBLIC :: excretn !:
36	REAL(wp), PUBLIC :: excretp !:
37	REAL(wp), PUBLIC :: excretd !:
38	REAL(wp), PUBLIC :: bresp !:
39	REAL(wp), PUBLIC :: thetanpm !:
40	REAL(wp), PUBLIC :: thetannm !:
41	REAL(wp), PUBLIC :: thetandm !:
42	REAL(wp), PUBLIC :: chlcmin !:
43	REAL(wp), PUBLIC :: grosip !:
44
45	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdaylen
46
47	REAL(wp) :: r1_rday !: 1 / rday
48	REAL(wp) :: texcretn !: 1 - excret
49	REAL(wp) :: texcretp !: 1 - excretp
50	REAL(wp) :: texcretd !: 1 - excret2
51
52	!! * Substitutions
53	# include "do_loop_substitute.h90"
54	!!----------------------------------------------------------------------
55	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
56	!! $Id$
57	!! Software governed by the CeCILL license (see ./LICENSE)
58	!!----------------------------------------------------------------------
59	CONTAINS
60
61	SUBROUTINE p5z_prod( kt , knt, Kbb, Kmm, Krhs )
62	!!---------------------------------------------------------------------
63	!! * ROUTINE p5z_prod *
64	!!
65	!! ** Purpose : Compute the phytoplankton production depending on
66	!! light, temperature and nutrient availability
67	!!
68	!! ** Method : - ???
69	!!---------------------------------------------------------------------
70	!
71	INTEGER, INTENT(in) :: kt, knt
72	INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level indices
73	!
74	INTEGER :: ji, jj, jk
75	REAL(wp) :: zsilfac, znanotot, zpicotot, zdiattot, zconctemp, zconctemp2
76	REAL(wp) :: zration, zratiop, zratiof, zmax, zmax2, zsilim, ztn, zadap
77	REAL(wp) :: zpronmax, zpropmax, zprofmax, zrat
78	REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, zprontot, zproptot, zprodtot
79	REAL(wp) :: zprnutmax, zdocprod, zprochln, zprochld, zprochlp
80	REAL(wp) :: zpislopen, zpislopep, zpisloped, thetannm_n, thetandm_n, thetanpm_n
81	REAL(wp) :: zrum, zcodel, zargu, zval, zfeup
82	REAL(wp) :: zfact, zrfact2
83	CHARACTER (len=25) :: charout
84	REAL(wp), DIMENSION(jpi,jpj ) :: zmixnano, zmixpico, zmixdiat, zstrn
85	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopeadn, zpislopeadp, zpislopeadd
86	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprnut, zprmaxp, zprmaxn, zprmaxd
87	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprbio, zprpic, zprdia, zysopt
88	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprchln, zprchlp, zprchld
89	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorcan, zprorcap, zprorcad
90	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprofed, zprofep, zprofen
91	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronewn, zpronewp, zpronewd
92	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zproregn, zproregp, zproregd
93	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpropo4n, zpropo4p, zpropo4d
94	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprodopn, zprodopp, zprodopd
95	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespn, zrespp, zrespd
96	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcroissn, zcroissp, zcroissd
97	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxl_fac, zmxl_chl
98	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpligprod1, zpligprod2
99	!!---------------------------------------------------------------------
100	!
101	IF( ln_timing ) CALL timing_start('p5z_prod')
102	!
103	zprorcan(:,:,:) = 0._wp ; zprorcap(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp
104	zcroissn(:,:,:) = 0._wp ; zcroissp(:,:,:) = 0._wp ; zcroissd(:,:,:) = 0._wp
105	zprofed (:,:,:) = 0._wp ; zprofep (:,:,:) = 0._wp ; zprofen (:,:,:) = 0._wp
106	zpronewn(:,:,:) = 0._wp ; zpronewp(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp
107	zproregn(:,:,:) = 0._wp ; zproregp(:,:,:) = 0._wp ; zproregd(:,:,:) = 0._wp
108	zpropo4n(:,:,:) = 0._wp ; zpropo4p(:,:,:) = 0._wp ; zpropo4d(:,:,:) = 0._wp
109	zprdia (:,:,:) = 0._wp ; zprpic (:,:,:) = 0._wp ; zprbio (:,:,:) = 0._wp
110	zprodopn(:,:,:) = 0._wp ; zprodopp(:,:,:) = 0._wp ; zprodopd(:,:,:) = 0._wp
111	zysopt (:,:,:) = 0._wp
112	zrespn (:,:,:) = 0._wp ; zrespp (:,:,:) = 0._wp ; zrespd (:,:,:) = 0._wp
113
114	! Computation of the optimal production
115	zprnut (:,:,:) = 0.65_wp * r1_rday * tgfunc(:,:,:)
116	zprmaxn(:,:,:) = ( 0.65_wp * (1. + zpsino3 * qnpmax ) ) * r1_rday * tgfunc(:,:,:)
117	zprmaxp(:,:,:) = 0.5 / 0.65 * zprmaxn(:,:,:)
118	zprmaxd(:,:,:) = zprmaxn(:,:,:)
119
120	! compute the day length depending on latitude and the day
121	zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp )
122	zcodel = ASIN( SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp ) )
123
124	! day length in hours
125	zstrn(:,:) = 0.
126	DO_2D_11_11
127	zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
128	zargu = MAX( -1., MIN( 1., zargu ) )
129	zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
130	END_2D
131
132	! Impact of the day duration on phytoplankton growth
133	DO_3D_11_11( 1, jpkm1 )
134	IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
135	zval = MAX( 1., zstrn(ji,jj) )
136	IF( gdepw(ji,jj,jk+1,Kmm) <= hmld(ji,jj) ) THEN
137	zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn ))
138	ENDIF
139	zmxl_chl(ji,jj,jk) = zval / 24.
140	zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval )
141	ENDIF
142	END_3D
143
144	zprbio(:,:,:) = zprmaxn(:,:,:) * zmxl_fac(:,:,:)
145	zprdia(:,:,:) = zprmaxd(:,:,:) * zmxl_fac(:,:,:)
146	zprpic(:,:,:) = zprmaxp(:,:,:) * zmxl_fac(:,:,:)
147
148
149	! Maximum light intensity
150	zdaylen(:,:) = MAX(1., zstrn(:,:)) / 24.
151	WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
152
153	DO_3D_11_11( 1, jpkm1 )
154	IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
155	! Computation of the P-I slope for nanos and diatoms
156	ztn = MAX( 0., ts(ji,jj,jk,jp_tem,Kmm) - 15. )
157	zadap = xadap * ztn / ( 2.+ ztn )
158	!
159	zpislopeadn(ji,jj,jk) = pislopen * tr(ji,jj,jk,jpnch,Kbb) &
160	& /( tr(ji,jj,jk,jpphy,Kbb) * 12. + rtrn)
161	zpislopeadp(ji,jj,jk) = pislopep * ( 1. + zadap * EXP( -0.25 * epico(ji,jj,jk) ) ) &
162	& * tr(ji,jj,jk,jppch,Kbb) /( tr(ji,jj,jk,jppic,Kbb) * 12. + rtrn)
163	zpislopeadd(ji,jj,jk) = pisloped * tr(ji,jj,jk,jpdch,Kbb) &
164	& /( tr(ji,jj,jk,jpdia,Kbb) * 12. + rtrn)
165	!
166	zpislopen = zpislopeadn(ji,jj,jk) / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
167	zpislopep = zpislopeadp(ji,jj,jk) / ( zprpic(ji,jj,jk) * rday * xlimpic(ji,jj,jk) + rtrn )
168	zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
169
170	! Computation of production function for Carbon
171	! ---------------------------------------------
172	zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) )
173	zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) ) )
174	zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) )
175
176	! Computation of production function for Chlorophyll
177	! -------------------------------------------------
178	zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
179	zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
180	zpislopep = zpislopep * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
181	zprchln(ji,jj,jk) = zprmaxn(ji,jj,jk) * ( 1.- EXP( -zpislopen * enanom(ji,jj,jk) ) )
182	zprchlp(ji,jj,jk) = zprmaxp(ji,jj,jk) * ( 1.- EXP( -zpislopep * epicom(ji,jj,jk) ) )
183	zprchld(ji,jj,jk) = zprmaxd(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediatm(ji,jj,jk) ) )
184	ENDIF
185	END_3D
186
187	DO_3D_11_11( 1, jpkm1 )
188
189	IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
190	! Si/C of diatoms
191	! ------------------------
192	! Si/C increases with iron stress and silicate availability
193	! Si/C is arbitrariliy increased for very high Si concentrations
194	! to mimic the very high ratios observed in the Southern Ocean (silpot2)
195	zlim = tr(ji,jj,jk,jpsil,Kbb) / ( tr(ji,jj,jk,jpsil,Kbb) + xksi1 )
196	zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) )
197	zsilfac = 3.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0
198	zsiborn = tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb) * tr(ji,jj,jk,jpsil,Kbb)
199	IF (gphit(ji,jj) < -30 ) THEN
200	zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 )
201	ELSE
202	zsilfac2 = 1. + zsiborn / ( zsiborn + xksi2**3 )
203	ENDIF
204	zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2
205	ENDIF
206	END_3D
207
208	! Sea-ice effect on production
209	DO_3D_11_11( 1, jpkm1 )
210	zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
211	zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
212	zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
213	zprnut(ji,jj,jk) = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) )
214	END_3D
215
216	! Computation of the various production terms of nanophytoplankton
217	DO_3D_11_11( 1, jpkm1 )
218	IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
219	! production terms for nanophyto.
220	zprorcan(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * tr(ji,jj,jk,jpphy,Kbb) * rfact2
221	!
222	zration = tr(ji,jj,jk,jpnph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
223	zratiop = tr(ji,jj,jk,jppph,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
224	zratiof = tr(ji,jj,jk,jpnfe,Kbb) / ( tr(ji,jj,jk,jpphy,Kbb) + rtrn )
225	zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpphy,Kbb) * rfact2
226	! Uptake of nitrogen
227	zrat = MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) )
228	zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
229	zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) ) &
230	& / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) )
231	zpronewn(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xnanono3(ji,jj,jk)
232	zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk)
233	! Uptake of phosphorus
234	zrat = MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) )
235	zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
236	zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk)
237	zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk)
238	zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk)
239	! Uptake of iron
240	zrat = MIN( 1., zratiof / qfnmax )
241	zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
242	zprofmax = zprnutmax * qfnmax * zmax
243	zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk) * ( 3. - 2.4 * xlimnfe(ji,jj,jk) &
244	& / ( xlimnfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn &
245	& + xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) ) * (1. - xnanofer(ji,jj,jk) ) )
246	ENDIF
247	END_3D
248
249	! Computation of the various production terms of picophytoplankton
250	DO_3D_11_11( 1, jpkm1 )
251	IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
252	! production terms for picophyto.
253	zprorcap(ji,jj,jk) = zprpic(ji,jj,jk) * xlimpic(ji,jj,jk) * tr(ji,jj,jk,jppic,Kbb) * rfact2
254	!
255	zration = tr(ji,jj,jk,jpnpi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn )
256	zratiop = tr(ji,jj,jk,jpppi,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn )
257	zratiof = tr(ji,jj,jk,jppfe,Kbb) / ( tr(ji,jj,jk,jppic,Kbb) + rtrn )
258	zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jppic,Kbb) * rfact2
259	! Uptake of nitrogen
260	zrat = MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) )
261	zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
262	zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) ) &
263	& / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) )
264	zpronewp(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xpicono3(ji,jj,jk)
265	zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk)
266	! Uptake of phosphorus
267	zrat = MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) )
268	zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
269	zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk)
270	zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk)
271	zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk)
272	! Uptake of iron
273	zrat = MIN( 1., zratiof / qfpmax )
274	zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
275	zprofmax = zprnutmax * qfpmax * zmax
276	zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk) * ( 3. - 2.4 * xlimpfe(ji,jj,jk) &
277	& / ( xlimpfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn &
278	& + xpicono3(ji,jj,jk) + xpiconh4(ji,jj,jk) ) * (1. - xpicofer(ji,jj,jk) ) )
279	ENDIF
280	END_3D
281
282	! Computation of the various production terms of diatoms
283	DO_3D_11_11( 1, jpkm1 )
284	IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
285	! production terms for diatomees
286	zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * tr(ji,jj,jk,jpdia,Kbb) * rfact2
287	! Computation of the respiration term according to pahlow
288	! & oschlies (2013)
289	!
290	zration = tr(ji,jj,jk,jpndi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
291	zratiop = tr(ji,jj,jk,jppdi,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
292	zratiof = tr(ji,jj,jk,jpdfe,Kbb) / ( tr(ji,jj,jk,jpdia,Kbb) + rtrn )
293	zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * tr(ji,jj,jk,jpdia,Kbb) * rfact2
294	! Uptake of nitrogen
295	zrat = MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) )
296	zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
297	zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) ) &
298	& / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) )
299	zpronewd(ji,jj,jk) = zpronmax * zdaylen(ji,jj) * xdiatno3(ji,jj,jk)
300	zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk)
301	! Uptake of phosphorus
302	zrat = MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) )
303	zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
304	zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk)
305	zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk)
306	zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk)
307	! Uptake of iron
308	zrat = MIN( 1., zratiof / qfdmax )
309	zmax = MAX(0., MIN(1., (1. - zrat)/ (1.05 - zrat) * 1.05))
310	zprofmax = zprnutmax * qfdmax * zmax
311	zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk) * ( 3. - 2.4 * xlimdfe(ji,jj,jk) &
312	& / ( xlimdfe(ji,jj,jk) + 0.2 ) ) * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn &
313	& + xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) ) * (1. - xdiatfer(ji,jj,jk) ) )
314	ENDIF
315	END_3D
316
317	DO_3D_11_11( 1, jpkm1 )
318	IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN
319	! production terms for nanophyto. ( chlorophyll )
320	znanotot = enanom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
321	zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk)
322	thetannm_n = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) &
323	& * (1. - 1.14 / 43.4 * 20.))
324	zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn )
325	zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) )
326	! production terms for picophyto. ( chlorophyll )
327	zpicotot = epicom(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
328	zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk)
329	thetanpm_n = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) &
330	& * (1. - 1.14 / 43.4 * 20.))
331	zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn )
332	zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) )
333	! production terms for diatomees ( chlorophyll )
334	zdiattot = ediatm(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn )
335	zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk)
336	thetandm_n = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *ts(ji,jj,jk,jp_tem,Kmm))) &
337	& * (1. - 1.14 / 43.4 * 20.))
338	zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn )
339	zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) )
340	! Update the arrays TRA which contain the Chla sources and sinks
341	tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) + zprochln * texcretn
342	tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) + zprochld * texcretd
343	tr(ji,jj,jk,jppch,Krhs) = tr(ji,jj,jk,jppch,Krhs) + zprochlp * texcretp
344	ENDIF
345	END_3D
346
347	! Update the arrays TRA which contain the biological sources and sinks
348	DO_3D_11_11( 1, jpkm1 )
349	zprontot = zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)
350	zproptot = zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)
351	zprodtot = zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)
352	zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) &
353	& + excretp * zprorcap(ji,jj,jk)
354	tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) - zpropo4n(ji,jj,jk) - zpropo4d(ji,jj,jk) &
355	& - zpropo4p(ji,jj,jk)
356	tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) &
357	& - zpronewp(ji,jj,jk)
358	tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) - zproregn(ji,jj,jk) - zproregd(ji,jj,jk) &
359	& - zproregp(ji,jj,jk)
360	tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) + zprorcan(ji,jj,jk) * texcretn &
361	& - zpsino3 * zpronewn(ji,jj,jk) - zpsinh4 * zproregn(ji,jj,jk) &
362	& - zrespn(ji,jj,jk)
363	zcroissn(ji,jj,jk) = tr(ji,jj,jk,jpphy,Krhs) / rfact2/ (tr(ji,jj,jk,jpphy,Kbb) + rtrn)
364	tr(ji,jj,jk,jpnph,Krhs) = tr(ji,jj,jk,jpnph,Krhs) + zprontot * texcretn
365	tr(ji,jj,jk,jppph,Krhs) = tr(ji,jj,jk,jppph,Krhs) + zpropo4n(ji,jj,jk) * texcretn &
366	& + zprodopn(ji,jj,jk) * texcretn
367	tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) + zprofen(ji,jj,jk) * texcretn
368	tr(ji,jj,jk,jppic,Krhs) = tr(ji,jj,jk,jppic,Krhs) + zprorcap(ji,jj,jk) * texcretp &
369	& - zpsino3 * zpronewp(ji,jj,jk) - zpsinh4 * zproregp(ji,jj,jk) &
370	& - zrespp(ji,jj,jk)
371	zcroissp(ji,jj,jk) = tr(ji,jj,jk,jppic,Krhs) / rfact2/ (tr(ji,jj,jk,jppic,Kbb) + rtrn)
372	tr(ji,jj,jk,jpnpi,Krhs) = tr(ji,jj,jk,jpnpi,Krhs) + zproptot * texcretp
373	tr(ji,jj,jk,jpppi,Krhs) = tr(ji,jj,jk,jpppi,Krhs) + zpropo4p(ji,jj,jk) * texcretp &
374	& + zprodopp(ji,jj,jk) * texcretp
375	tr(ji,jj,jk,jppfe,Krhs) = tr(ji,jj,jk,jppfe,Krhs) + zprofep(ji,jj,jk) * texcretp
376	tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) + zprorcad(ji,jj,jk) * texcretd &
377	& - zpsino3 * zpronewd(ji,jj,jk) - zpsinh4 * zproregd(ji,jj,jk) &
378	& - zrespd(ji,jj,jk)
379	zcroissd(ji,jj,jk) = tr(ji,jj,jk,jpdia,Krhs) / rfact2 / (tr(ji,jj,jk,jpdia,Kbb) + rtrn)
380	tr(ji,jj,jk,jpndi,Krhs) = tr(ji,jj,jk,jpndi,Krhs) + zprodtot * texcretd
381	tr(ji,jj,jk,jppdi,Krhs) = tr(ji,jj,jk,jppdi,Krhs) + zpropo4d(ji,jj,jk) * texcretd &
382	& + zprodopd(ji,jj,jk) * texcretd
383	tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) + zprofed(ji,jj,jk) * texcretd
384	tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd
385	tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) &
386	& + excretp * zprorcap(ji,jj,jk)
387	tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + excretd * zprodtot + excretn * zprontot &
388	& + excretp * zproptot
389	tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + excretd * zpropo4d(ji,jj,jk) + excretn * zpropo4n(ji,jj,jk) &
390	& - texcretn * zprodopn(ji,jj,jk) - texcretd * zprodopd(ji,jj,jk) + excretp * zpropo4p(ji,jj,jk) &
391	& - texcretp * zprodopp(ji,jj,jk)
392	tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) + o2ut * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) &
393	& + zproregp(ji,jj,jk) ) + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) &
394	& + zpronewd(ji,jj,jk) + zpronewp(ji,jj,jk) ) &
395	& - o2ut * ( zrespn(ji,jj,jk) + zrespp(ji,jj,jk) + zrespd(ji,jj,jk) )
396	zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
397	tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) - zfeup
398	tr(ji,jj,jk,jpsil,Krhs) = tr(ji,jj,jk,jpsil,Krhs) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
399	tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk) &
400	& + zpsino3 * zpronewn(ji,jj,jk) + zpsinh4 * zproregn(ji,jj,jk) &
401	& + zpsino3 * zpronewp(ji,jj,jk) + zpsinh4 * zproregp(ji,jj,jk) &
402	& + zpsino3 * zpronewd(ji,jj,jk) + zpsinh4 * zproregd(ji,jj,jk) &
403	& + zrespn(ji,jj,jk) + zrespd(ji,jj,jk) + zrespp(ji,jj,jk)
404	tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) &
405	& + zpronewp(ji,jj,jk) ) - rno3 * ( zproregn(ji,jj,jk) + zproregd(ji,jj,jk) &
406	& + zproregp(ji,jj,jk) )
407	END_3D
408	!
409	IF( ln_ligand ) THEN
410	zpligprod1(:,:,:) = 0._wp ; zpligprod2(:,:,:) = 0._wp
411	DO_3D_11_11( 1, jpkm1 )
412	zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) + excretp * zprorcap(ji,jj,jk)
413	zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk)
414	tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet
415	zpligprod1(ji,jj,jk) = zdocprod * ldocp
416	zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) * lthet
417	END_3D
418	ENDIF
419
420
421	! Total primary production per year
422
423	! Total primary production per year
424	IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) &
425	& tpp = glob_sum( 'p5zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) + zprorcap(:,:,:) ) * cvol(:,:,:) )
426
427	IF( lk_iomput .AND. knt == nrdttrc ) THEN
428	zfact = 1.e+3 * rfact2r ! conversion from mol/l/kt to mol/m3/s
429	!
430	CALL iom_put( "PPPHYP" , zprorcap(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by picophyto
431	CALL iom_put( "PPPHYN" , zprorcan(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by nanophyto
432	CALL iom_put( "PPPHYD" , zprorcad(:,:,:) * zfact * tmask(:,:,:) ) ! primary production by diatomes
433	CALL iom_put( "PPNEWN" , zpronewp(:,:,:) * zfact * tmask(:,:,:) ) ! new primary production by picophyto
434	CALL iom_put( "PPNEWN" , zpronewn(:,:,:) * zfact * tmask(:,:,:) ) ! new primary production by nanophyto
435	CALL iom_put( "PPNEWD" , zpronewd(:,:,:) * zfact * tmask(:,:,:) ) ! new primary production by diatomes
436	CALL iom_put( "PBSi" , zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production
437	CALL iom_put( "PFeP" , zprofep(:,:,:) * zfact * tmask(:,:,:) ) ! biogenic iron production by picophyto
438	CALL iom_put( "PFeN" , zprofen(:,:,:) * zfact * tmask(:,:,:) ) ! biogenic iron production by nanophyto
439	CALL iom_put( "PFeD" , zprofed(:,:,:) * zfact * tmask(:,:,:) ) ! biogenic iron production by diatomes
440	IF( ln_ligand ) THEN
441	CALL iom_put( "LPRODP" , zpligprod1(:,:,:) * 1e9 * zfact * tmask(:,:,:) )
442	CALL iom_put( "LDETP" , zpligprod2(:,:,:) * 1e9 * zfact * tmask(:,:,:) )
443	ENDIF
444	CALL iom_put( "Mumax" , zprmaxn(:,:,:) * tmask(:,:,:) ) ! Maximum growth rate
445	CALL iom_put( "MuP" , zprpic(:,:,:) * xlimpic(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for picophyto
446	CALL iom_put( "MuN" , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto
447	CALL iom_put( "MuD" , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms
448	CALL iom_put( "LPlight" , zprpic(:,:,:) / (zprmaxp(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term
449	CALL iom_put( "LNlight" , zprbio(:,:,:) / (zprmaxn(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term
450	CALL iom_put( "LDlight" , zprdia(:,:,:) / (zprmaxd(:,:,:) + rtrn) * tmask(:,:,:) )
451	CALL iom_put( "MunetP" , zcroissp(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for picophyto
452	CALL iom_put( "MunetN" , zcroissn(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto
453	CALL iom_put( "MunetD" , zcroissd(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms
454	CALL iom_put( "TPP" , ( zprorcap(:,:,:) + zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:) ) ! total primary production
455	CALL iom_put( "TPNEW" , ( zpronewp(:,:,:) + zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:) ) ! total new production
456	CALL iom_put( "TPBFE" , ( zprofep (:,:,:) + zprofen (:,:,:) + zprofed (:,:,:) ) * zfact * tmask(:,:,:) ) ! total biogenic iron production
457	CALL iom_put( "tintpp" , tpp * zfact ) ! global total integrated primary production molC/s
458	ENDIF
459
460	IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
461	WRITE(charout, FMT="('prod')")
462	CALL prt_ctl_trc_info(charout)
463	CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
464	ENDIF
465	!
466	IF( ln_timing ) CALL timing_stop('p5z_prod')
467	!
468	END SUBROUTINE p5z_prod
469
470
471	SUBROUTINE p5z_prod_init
472	!!----------------------------------------------------------------------
473	!! * ROUTINE p5z_prod_init *
474	!!
475	!! ** Purpose : Initialization of phytoplankton production parameters
476	!!
477	!! ** Method : Read the nampisprod namelist and check the parameters
478	!! called at the first timestep (nittrc000)
479	!!
480	!! ** input : Namelist nampisprod
481	!!----------------------------------------------------------------------
482	INTEGER :: ios ! Local integer output status for namelist read
483	!!
484	NAMELIST/namp5zprod/ pislopen, pislopep, pisloped, excretn, excretp, excretd, &
485	& thetannm, thetanpm, thetandm, chlcmin, grosip, bresp, xadap
486	!!----------------------------------------------------------------------
487
488	READ ( numnatp_ref, namp5zprod, IOSTAT = ios, ERR = 901)
489	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp5zprod in reference namelist' )
490
491	READ ( numnatp_cfg, namp5zprod, IOSTAT = ios, ERR = 902 )
492	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namp5zprod in configuration namelist' )
493	IF(lwm) WRITE ( numonp, namp5zprod )
494
495	IF(lwp) THEN ! control print
496	WRITE(numout,*) ' '
497	WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp5zprod'
498	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
499	WRITE(numout,*) ' mean Si/C ratio grosip =', grosip
500	WRITE(numout,*) ' P-I slope pislopen =', pislopen
501	WRITE(numout,*) ' P-I slope for diatoms pisloped =', pisloped
502	WRITE(numout,*) ' P-I slope for picophytoplankton pislopep =', pislopep
503	WRITE(numout,*) ' Acclimation factor to low light xadap =', xadap
504	WRITE(numout,*) ' excretion ratio of nanophytoplankton excretn =', excretn
505	WRITE(numout,*) ' excretion ratio of picophytoplankton excretp =', excretp
506	WRITE(numout,*) ' excretion ratio of diatoms excretd =', excretd
507	WRITE(numout,*) ' basal respiration in phytoplankton bresp =', bresp
508	WRITE(numout,*) ' Maximum Chl/C in phytoplankton chlcmin =', chlcmin
509	WRITE(numout,*) ' Minimum Chl/N in nanophytoplankton thetannm =', thetannm
510	WRITE(numout,*) ' Minimum Chl/N in picophytoplankton thetanpm =', thetanpm
511	WRITE(numout,*) ' Minimum Chl/N in diatoms thetandm =', thetandm
512	ENDIF
513	!
514	r1_rday = 1._wp / rday
515	texcretn = 1._wp - excretn
516	texcretp = 1._wp - excretp
517	texcretd = 1._wp - excretd
518	tpp = 0._wp
519	!
520	END SUBROUTINE p5z_prod_init
521
522
523	INTEGER FUNCTION p5z_prod_alloc()
524	!!----------------------------------------------------------------------
525	!! * ROUTINE p5z_prod_alloc *
526	!!----------------------------------------------------------------------
527	ALLOCATE( zdaylen(jpi,jpj), STAT = p5z_prod_alloc )
528	!
529	IF( p5z_prod_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p5z_prod_alloc : failed to allocate arrays.' )
530	!
531	END FUNCTION p5z_prod_alloc
532	!!======================================================================
533	END MODULE p5zprod

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

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

Download in other formats: