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 branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

Context Navigation

source: branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90 @ 7617

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

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

Download in other formats: