Context Navigation

p4zprod.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 9 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.

File size: 31.2 KB

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

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

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

Context Navigation

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90 @ 5870

Download in other formats: