Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

ice_bio_sms.f @ 20

Last change on this file since 20 was 20, checked in by vancop, 8 years ago
Ludivine source files
File size: 25.1 KB

Line
1	SUBROUTINE ice_bio_sms(nlay_i,kideb,kiut)
2	!
3	!-----------------------------------------------------------------------------!
4	! * ice_bio_sms *
5	! Biological sources minus sinks
6	! (c) Martin Vancoppenolle, LOCEAN, October 2012
7	!
8	! version : source_3.03
9	! status : in permanent revision :-)
10	!
11	!=============================================================================!
12	!
13	INCLUDE 'type.com'
14	INCLUDE 'para.com'
15	INCLUDE 'const.com'
16	INCLUDE 'ice.com'
17	INCLUDE 'thermo.com'
18	INCLUDE 'bio.com'
19
20	INTEGER, DIMENSION(3) ::
21	& zindex
22
23	REAL, DIMENSION(nlay_bio) ::
24	& zek,
25	& zlim_nut
26
27	LOGICAL ::
28	& ln_write_bio
29
30	ln_write_bio = .TRUE.
31	zeps = 1.0e-14
32	ji = 1
33
34	!
35	!=============================================================================!
36	!
37	!-----------------------------------------------------------------------------!
38	! 1) Control prints
39	!-----------------------------------------------------------------------------!
40	!
41	IF ( ln_write_bio ) THEN
42
43	WRITE(numout,*)
44	WRITE(numout,) ' * ice_bio_sms : '
45	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ '
46	WRITE(numout,*)
47
48	CALL ice_brine
49
50	WRITE(numout,*) ' Initial tracer values '
51	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~ '
52
53	DO jn = 1, ntra_bio
54	IF ( flag_active(jn) ) THEN
55	WRITE(numout,*) ' Tracer : ', biotr_i_nam(jn)
56	WRITE(numout,*) ' cbu_i_bio: ', ( cbu_i_bio(jn,layer),
57	& layer = 1, nlay_bio )
58	ENDIF ! flag_active
59	END DO ! jn
60
61	WRITE(numout,*)
62	WRITE(numout,*) ' Parameters '
63	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~ '
64	WRITE(numout,*) ' si_c : ', si_c
65	WRITE(numout,*) ' no3_c : ', no3_c
66	WRITE(numout,*) ' po4_c : ', po4_c
67	WRITE(numout,*) ' mumax_bio : ', mumax_bio
68	WRITE(numout,*) ' klys_bio : ', klys_bio
69	WRITE(numout,*) ' khs_si_bio: ', khs_si_bio
70	WRITE(numout,*) ' ek_bio : ', ek_bio
71	WRITE(numout,*) ' astar_alg : ', astar_alg
72	WRITE(numout,*) ' rg_bio : ', rg_bio
73	WRITE(numout,*) ' nn_lim_sal: ', nn_lim_sal
74	WRITE(numout,*) ' lim_sal_wid :', lim_sal_wid
75	WRITE(numout,*) ' lim_sal_smax:', lim_sal_smax
76	WRITE(numout,*)
77
78	ENDIF ! ln_write_bio
79	!
80	!-----------------------------------------------------------------------------!
81	! 2) Source Minus Sink terms
82	!-----------------------------------------------------------------------------!
83	!
84	consN = 0
85
86	DO layer = layer_00, nlay_bio
87
88	trucN = cbu_i_bio(jn_din,layer) + cbu_i_bio(jn_eon,layer)
89	& + cbu_i_bio(jn_aon,layer) + consN
90	consN = trucN
91
92	END DO
93
94	WRITE(numout,*) ' Conservation BIO N :', consN
95
96
97	! Reference of the upper layer
98	IF ( ( c_grid .EQ. 'SL' ) .OR. ( c_grid .EQ. 'BA' ) ) THEN
99
100	lim_dsi(:) = 0.; lim_no3(:) = 0.; lim_po4(:) = 0.
101	lim_lig(:) = 0.; lim_tem(:) = 0.; lim_sal(:) = 0.
102	lys_bio(:) = 0.; rem_bio(:) = 0.; syn_bio(:) = 0.
103	rsp_bio(:) = 0.; exu_bio(:) = 0.
104
105	lim_dsi(nlay_bio) = 1.; lim_no3(nlay_bio) = 1.
106	lim_po4(nlay_bio) = 1.
107	lim_lig(nlay_bio) = 1.; lim_tem(nlay_bio) = 1.
108	lim_sal(nlay_bio) = 1.
109
110	ELSE
111
112	lim_dsi(:) = 1.; lim_no3(:) = 1.; lim_po4(:) = 1.
113	lim_lig(:) = 1.; lim_tem(:) = 1.; lim_sal(:) = 1.
114	lys_bio(:) = 0.; rem_bio(:) = 0.; syn_bio(:) = 0.
115	rsp_bio(:) = 0.; exu_bio(:) = 0.
116
117	ENDIF
118
119	!------------------------------------------------------------------------
120	! 2.1 Limitation factors
121	!------------------------------------------------------------------------
122
123	! 2.1.1 Nutrients & temperature
124	!--------------------------------
125	DO layer = layer_00, nlay_bio
126
127	IF ( ln_lim_dsi ) ! DSi limitation
128	& lim_dsi(layer) = c_i_bio(1,layer)
129	& / ( khs_si_bio + c_i_bio(1,layer) )
130
131	IF ( ln_lim_no3 ) ! NO3 limitation
132	& lim_no3(layer) = c_i_bio(2,layer)
133	& / ( khs_n_bio + c_i_bio(2,layer) )
134
135	IF ( ln_lim_po4 ) ! PO4 limitation
136	& lim_po4(layer) = c_i_bio(3,layer)
137	& / ( khs_p_bio + c_i_bio(3,layer) )
138
139	IF ( ln_lim_dsi .OR. ln_lim_no3 .OR. ln_lim_po4 ) ! Nut limitation
140	! & zlim_nut(layer) = lim_dsi(layer) * lim_no3(layer)
141	! & * lim_po4(layer)
142	& zlim_nut(layer) = MIN ( lim_dsi(layer) , lim_no3(layer)
143	& , lim_po4(layer) )
144
145	IF ( ln_lim_tem ) ! Temperature factor
146	& lim_tem(layer) = EXP( rg_bio * tc_bio(layer) )
147
148	END DO ! layer
149
150	! 2.1.2 Brine salinity
151	!----------------------
152	IF ( ln_lim_sal ) THEN
153
154	SELECT CASE ( nn_lim_sal )
155
156	CASE (1) ! Arrigo and Sullivan (1992)
157
158	DO layer = layer_00, nlay_bio
159	zarg = 2.16 - 8.30e-5 * sbr_bio(layer)**2.11
160	& - 0.55 * LOG( sbr_bio(layer) )
161	lim_sal(layer) = EXP ( - zarg * zarg )
162	END DO
163
164	CASE (2) ! Simple Gaussian ( Martouf and Grozny, 2010 )
165
166	DO layer = layer_00, nlay_bio
167	zarg = ( sbr_bio(layer) - lim_sal_smax ) / lim_sal_wid
168	lim_sal(layer) = EXP( - zarg * zarg )
169	END DO
170
171	END SELECT
172
173	ENDIF ! ln_lim_sal
174
175	! 2.1.3 Light
176	!-------------
177	IF ( ln_lim_lig ) THEN
178
179	SELECT CASE ( nn_phs )
180
181	CASE (1) ! prescribed Ek
182
183	zek(:) = ek_bio
184	chlC_bio(:) = chla_c
185
186	CASE (2) ! Ek depends on chla/C
187
188	zek(:) = mumax_bio / ( alpha_bio * chla_c )
189	chlC_bio(:) = chla_c
190
191	CASE (3) ! full account for limitation factors
192
193	zek(:) = mumax_bio * lim_tem(:) * lim_sal(:)
194	& * zlim_nut(:) / ( alpha_bio * chla_c )
195	chlC_bio(:) = chla_c
196
197	CASE (4) ! varying chl-a carbon ratio
198
199	zthmin = 0.01 ! min
200	zthmax = 0.05 ! max
201
202	DO layer = layer_00, nlay_bio
203	chlC_bio (layer) = ( zthmax - ( zthmax - zthmin ) *
204	& MIN( par_bio(layer) / Estar, 1.0 ) ) * zlim_nut(layer)
205	END DO
206
207	zek(:) = mumax_bio * lim_tem(:) * lim_sal(:)
208	& * zlim_nut(:) / ( alpha_bio * chlC_bio(:) )
209
210	END SELECT
211
212	DO layer = layer_00, nlay_bio ! Jassby & Platt 76 formulation
213	lim_lig(layer) = TANH ( par_bio(layer) / zek(layer) )
214	END DO
215
216	WRITE(numout,*)
217	WRITE(numout,*) ' lim_lig : ', ( lim_lig(layer),
218	& layer = layer_00, nlay_bio )
219	WRITE(numout,*) ' zlim_nut: ', ( zlim_nut(layer),
220	& layer = layer_00, nlay_bio )
221	WRITE(numout,*) ' par_bio : ', ( par_bio(layer),
222	& layer = layer_00, nlay_bio )
223	WRITE(numout,*) ' zek : ', ( zek(layer) ,
224	& layer = layer_00, nlay_bio )
225	WRITE(numout,*) ' chlC_bio: ', ( chlC_bio(layer),
226	& layer = layer_00, nlay_bio )
227	WRITE(numout,*)
228
229	ENDIF ! ln_lim_lig
230
231	IF ( .NOT. ln_lim_lig ) chlC_bio(:) = chla_c
232
233	!------------------------------------------------------------------------
234	! 2.2 Loss & remineralization
235	!------------------------------------------------------------------------
236
237	! Exudation is zero
238	exu_bio(:) = 0.0
239
240	DO layer = layer_00, nlay_bio
241
242	! Respiration (NP, NPDr)
243	! IF ( ln_rsp ) ...
244	rsp_bio(layer) = krsp_bio * cbu_i_bio(jn_aoc,layer) *
245	& lim_tem(layer)
246
247	! Lysis (NP, NPDr)
248	IF ( ln_lys ) THEN
249
250	IF ( nn_lys .GE. 1 ) ! no T-dependence
251	& lys_bio(layer) = klys_bio * cbu_i_bio(jn_aoc,layer)
252
253	IF ( nn_lys .EQ. 2 ) ! T-dependence
254	& lys_bio(layer) = lys_bio(layer) * lim_tem(layer)
255
256	ENDIF
257
258	END DO
259
260	DO layer = layer_00, nlay_bio
261
262	IF ( ln_rem ) THEN
263
264	SELECT CASE ( nn_bio_opt )
265
266	CASE(0) ! NP
267
268	rem_bio(layer) = frem_bio *
269	& lys_bio(layer)
270
271	CASE(1) ! NPD
272
273	IF ( nn_rem .EQ. 1 ) ! no T-dependence
274	& rem_bio(layer) = krem_bio *
275	& cbu_i_bio(jn_eoc,layer)
276
277	IF ( nn_rem .EQ. 2 ) ! T-dependence
278	& rem_bio(layer) = krem_bio * cbu_i_bio(jn_eoc,layer)
279	& * EXP( rg_bac * tc_bio(layer) )
280
281	END SELECT
282
283	ENDIF
284
285	END DO
286
287	!------------------------------------------------------------------------
288	! 2.3 Diatom Synthesis
289	!------------------------------------------------------------------------
290	zeps = 0.000000001
291
292	DO layer = layer_00, nlay_bio
293
294	IF ( ln_syn ) THEN
295	! raw synthesis (in s-1)
296	z_syn = mumax_bio
297	& * lim_tem(layer) * lim_sal(layer) * lim_lig(layer)
298	& * zlim_nut(layer)
299
300	! preclude excessive growth if insufficient nutrient stock
301	zsyn1 = z_syn * cbu_i_bio(jn_aoc,layer) ! normal carbon production rate (mmolC/m3/s)
302	zsyn2 = zsyn1; zsyn3 = zsyn1; zsyn4 = zsyn1
303
304
305	IF ( ln_lim_dsi ) ! prevent exhaustion of Si
306	& zsyn2 = cbu_i_bio(jn_dsi,layer) / ddtb / si_c - zeps
307
308	IF (ln_decoupNC) THEN ! C aussi limité en stock par DIN
309	zC = MAX (cbu_i_bio(jn_aoc,layer) , zeps )
310	zN = MAX (cbu_i_bio(jn_aon,layer) , zeps )
311	N_C_alg(layer) = zN / zC
312	! N_C_alg(layer) = 0.14
313	zsyn3 = cbu_i_bio(jn_din,layer) / (ddtb*N_C_alg(layer))
314	& - zeps
315	ELSE
316	zsyn3 = cbu_i_bio(jn_din,layer) / (ddtb * no3_c) - zeps
317	ENDIF
318
319
320	IF (ln_decoupPC) THEN ! C aussi limité en stock par DIP
321	zC = MAX (cbu_i_bio(jn_aoc,layer) , zeps )
322	zP = MAX (cbu_i_bio(jn_aop,layer) , zeps )
323	P_C_alg(layer) = zP / zC
324	! P_C_alg(layer) = 0.0094
325	zsyn4 = cbu_i_bio(jn_dip,layer)/(ddtb * P_C_alg(layer))
326	& - zeps
327	ELSE
328	zsyn4 = cbu_i_bio(jn_dip,layer) / ddtb / po4_c - zeps
329	ENDIF
330
331
332	! nutrient stock-limited PP rate
333	syn_bio(layer) = MIN( zsyn1, zsyn2, zsyn3, zsyn4 )
334
335	ELSE ! ln_syn is .FALSE.
336	! PP is prescribed to zero everywhere
337	! except in the bottom layer
338	! where it equals pp_presc
339	! if sun is shining
340
341	IF ( ( layer .EQ. nlay_bio ) .AND. ( fsolgb(ji) .GT. 5.0 ) )
342	& syn_bio(layer) = pp_presc
343
344	ENDIF ! ln_syn
345
346
347	! -------------------------
348	! -- Limitations en stocks
349	! ------------------------
350
351	IF (ln_decoupNC) THEN
352	zzdin = syn_bio(layer) / (((1/N_C_alg(layer)) *
353	& (cbu_i_bio(jn_din,layer)/ddtb)) - zeps)
354
355	ELSE
356	zzdin = syn_bio(layer) / (((1/no3_c) *
357	& (cbu_i_bio(jn_din,layer)/ddtb)) - zeps)
358	ENDIF
359
360
361	IF (ln_decoupPC) THEN
362	zzpo4 = syn_bio(layer) / (((1/P_C_alg(layer)) *
363	& (cbu_i_bio(jn_dip,layer)/ddtb)) - zeps)
364
365	ELSE
366	zzpo4 = syn_bio(layer) / (((1/po4_c) *
367	& (cbu_i_bio(jn_dip,layer)/ddtb)) - zeps)
368	ENDIF
369
370
371
372	zzsi = syn_bio(layer) / (((1/si_c) *
373	& (cbu_i_bio(jn_dsi,layer)/ddtb)) - zeps)
374
375
376	IF ( zzdin .EQ. 1 ) THEN
377	lim_din_stock(layer) = 1 !DIN est limitant en stocks
378	ELSE
379	lim_din_stock(layer) = 0 !DIN PAS limitant en stocks
380	ENDIF
381
382	IF ( zzpo4 .EQ. 1 ) THEN
383	lim_dip_stock(layer) = 1
384	ELSE
385	lim_dip_stock(layer) = 0
386	ENDIF
387
388	IF ( zzsi .EQ. 1) THEN
389	lim_dsi_stock(layer) = 1
390	ELSE
391	lim_dsi_stock(layer) = 0
392	ENDIF
393
394
395	!------------------------------------------------------------------------
396	! N cycle
397	!------------------------------------------------------------------------
398
399
400	IF ( ln_decoupNC ) THEN
401
402	!--- Nitrogen carbon algal ratio
403	zC = MAX( cbu_i_bio(jn_aoc,layer) , zeps )
404	zN = MAX( cbu_i_bio(jn_aon,layer) , zeps )
405	N_C_alg(layer) = zN / zC
406	! zN_C = MIN( cbu_i_bio(jn_aon,layer) / zC , N_C_max )
407	! zN_C = MAX( N_C_min , zN_C )
408	! N_C_alg(layer) = zN_C ! => marche pas
409	! N_C_alg(layer) = 0.14
410
411	!--- Nitrogen carbon detritic ratio
412	zC = MAX( cbu_i_bio(jn_eoc,layer), zeps )
413	zNd = MAX( cbu_i_bio(jn_eon,layer), zeps )
414	N_C_det(layer) = zNd / zC
415	! N_C_det(layer) = 0.14
416
417	!--- Process rates
418	syn_N(layer) = N_C_alg(layer) * ksyn_N * syn_bio(layer)
419	rsp_N(layer) = N_C_alg(layer) * krsp_N * rsp_bio(layer)
420	lys_N(layer) = N_C_alg(layer) * klys_N * lys_bio(layer)
421	rem_N(layer) = N_C_det(layer) * krem_N * rem_bio(layer)
422
423
424	ENDIF ! ln_decoupNC
425
426	!------------------------------------------------------------------------
427	! P cycle
428	!------------------------------------------------------------------------
429
430
431	IF ( ln_decoupPC ) THEN
432
433	!--- P carbon algal ratio
434	zC = MAX( cbu_i_bio(jn_aoc,layer) , zeps )
435	zP = MAX( cbu_i_bio(jn_aop,layer) , zeps )
436	P_C_alg(layer) = zP / zC
437
438	!--- P carbon detritic ratio
439	zC = MAX( cbu_i_bio(jn_eoc,layer), zeps )
440	zPd = MAX( cbu_i_bio(jn_eop,layer), zeps )
441	P_C_det(layer) = zPd / zC
442
443	!--- Process rates
444	syn_P(layer) = P_C_alg(layer) * ksyn_P * syn_bio(layer)
445	rsp_P(layer) = P_C_alg(layer) * krsp_P * rsp_bio(layer)
446	lys_P(layer) = P_C_alg(layer) * klys_P * lys_bio(layer)
447	rem_P(layer) = P_C_det(layer) * krem_P * rem_bio(layer)
448
449	ENDIF ! ln_decoupPC
450
451
452	zPa = MAX( cbu_i_bio(jn_aop,layer) , zeps )
453	zNt = MAX( cbu_i_bio(jn_aon,layer) , zeps )
454	N_P_alg(layer) = zNt / zPa
455	zPe = MAX( cbu_i_bio(jn_eop,layer) , zeps )
456	zNtd = MAX( cbu_i_bio(jn_eon,layer) , zeps )
457	N_P_det(layer) = zNtd / zPe
458
459
460
461	!------------------------------------------------------------------------
462	! 2.4 Update reservoirs (including N cycle reservoirs)
463	!------------------------------------------------------------------------
464
465	! -------------------------------------------------------
466	! -- 1) Increments
467	! ------------------------------------------------------
468
469
470	! DSi uptake
471	zd_dsi1 = si_c * ( rem_bio(layer) +
472	& rsp_bio(layer) - syn_bio(layer) ) * ddtb
473	zd_dsi2 = - cbu_i_bio(jn_dsi,layer) ! Maximum DSi uptake
474	zd_dsi = MAX ( zd_dsi1, zd_dsi2 )
475
476	! update algae
477	zd_daf1 = ( syn_bio(layer) - lys_bio(layer) -
478	& rsp_bio(layer) - exu_bio(layer) ) * ddtb
479	zd_daf2 = - cbu_i_bio(jn_aoc,layer) ! Max algal carbon loss
480	zd_daf = MAX ( zd_daf1, zd_daf2 )
481
482	! update detritus
483	IF ( nn_bio_opt .GE. 1 ) THEN
484	zd_eoc1 = ( lys_bio(layer) + exu_bio(layer) -
485	& rem_bio(layer) ) * ddtb
486	zd_eoc2 = - cbu_i_bio(jn_eoc,layer) ! Max detrital carbon loss
487	zd_eoc = MAX( zd_eoc1, zd_eoc2 )
488	ENDIF ! nn_bio_opt
489
490
491	IF (ln_decoupNC) THEN
492
493	!--- Increments
494	zd_din1 = ( rsp_N(layer) - syn_N(layer) +
495	& rem_N(layer) ) * ddtb
496	zd_din2 = - cbu_i_bio(jn_din,layer) !PEU PAS EPUISER PLUS
497	!QUE CE QUIL Y A !!!!
498	zd_din = MAX ( zd_din1, zd_din2 ) ! interessant dans le cas
499	! ou zd_din1 est négatif
500	! zd_din1 peut pas être
501	! plus petit que zd_din2
502
503	zd_aon1 = ( syn_N(layer) - rsp_N(layer) - lys_N(layer) ) *
504	& ddtb
505	zd_aon2 = - cbu_i_bio(jn_aon,layer)
506	zd_aon = MAX ( zd_aon1, zd_aon2 )
507
508	zd_eon1 = ( lys_N(layer) - rem_N(layer) ) * ddtb
509	zd_eon2 = - cbu_i_bio(jn_eon,layer)
510	zd_eon = MAX ( zd_eon1, zd_eon2 )
511
512	!--- Correct rates to prevent leaks
513	IF ( zd_din .EQ. zd_din2 )
514	& syn_N(layer) = MIN( syn_N(layer), -zd_din2/ddtb)
515
516	IF ( zd_aon .EQ. zd_aon2 )
517	& lys_N(layer) = MIN( lys_N(layer), -zd_aon2/ddtb)
518
519	IF ( zd_eon .EQ. zd_eon2 )
520	& rem_N(layer) = MIN( rem_N(layer), -zd_eon2/ddtb)
521
522
523	ELSE
524	zd_din1 = no3_c * ( rem_bio(layer) +
525	& rsp_bio(layer) - syn_bio(layer) ) * ddtb
526	zd_din2 = - cbu_i_bio(jn_din,layer) ! Max NO3 uptake
527	zd_din = MAX ( zd_din1, zd_din2 )
528
529	ENDIF ! ln_decoupNC
530
531	!!!!!!!!!!!!!!!!!!
532
533	IF (ln_decoupPC) THEN
534
535	!--- Increments
536	zd_dip1 = ( rsp_P(layer) - syn_P(layer) +
537	& rem_P(layer) ) * ddtb
538	zd_dip2 = - cbu_i_bio(jn_dip,layer) !PEU PAS EPUISER PLUS
539	!QUE CE QUIL Y A !!!!
540	zd_dip = MAX ( zd_dip1, zd_dip2 ) ! interessant dans le
541	! ou zd_din1 est négatif
542	! zd_din1 peut pas être
543	! plus petit que zd_din2
544
545	zd_aop1 = ( syn_P(layer) - rsp_P(layer) - lys_P(layer) ) *
546	& ddtb
547	zd_aop2 = - cbu_i_bio(jn_aop,layer)
548	zd_aop = MAX ( zd_aop1, zd_aop2 )
549
550	zd_eop1 = ( lys_P(layer) - rem_P(layer) ) * ddtb
551	zd_eop2 = - cbu_i_bio(jn_eop,layer)
552	zd_eop = MAX ( zd_eop1, zd_eop2 )
553
554	!--- Correct rates to prevent leaks
555	IF ( zd_dip .EQ. zd_dip2 )
556	& syn_P(layer) = MIN( syn_P(layer), -zd_dip2/ddtb)
557
558	IF ( zd_aop .EQ. zd_aop2 )
559	& lys_P(layer) = MIN( lys_P(layer), -zd_aop2/ddtb)
560
561	IF ( zd_eop .EQ. zd_eop2 )
562	& rem_P(layer) = MIN( rem_P(layer), -zd_eop2/ddtb)
563
564
565	ELSE
566	zd_dip1 = po4_c * ( rem_bio(layer) +
567	& rsp_bio(layer) - syn_bio(layer) ) * ddtb
568	zd_dip2 = - cbu_i_bio(jn_dip,layer) ! Max DIP uptake
569	zd_dip = MAX ( zd_dip1, zd_dip2 )
570
571	ENDIF ! ln_decoupPC
572
573
574	! -------------------------------------------------------
575	! -- 2) Add Increments
576	! ------------------------------------------------------
577
578	IF (ln_decoupNC) THEN
579	cbu_i_bio(jn_din,layer) = cbu_i_bio(jn_din,layer) + zd_din
580	cbu_i_bio(jn_aon,layer) = cbu_i_bio(jn_aon,layer) + zd_aon
581	cbu_i_bio(jn_eon,layer) = cbu_i_bio(jn_eon,layer) + zd_eon
582	ELSE
583	cbu_i_bio(jn_din,layer) = cbu_i_bio(jn_din,layer) + zd_din
584	ENDIF
585
586	IF (ln_decoupPC) THEN
587	cbu_i_bio(jn_dip,layer) = cbu_i_bio(jn_dip,layer) + zd_dip
588	cbu_i_bio(jn_aop,layer) = cbu_i_bio(jn_aop,layer) + zd_aop
589	cbu_i_bio(jn_eop,layer) = cbu_i_bio(jn_eop,layer) + zd_eop
590	ELSE
591	cbu_i_bio(jn_dip,layer) = cbu_i_bio(jn_dip,layer) + zd_dip
592	ENDIF
593
594
595	cbu_i_bio(jn_dsi,layer) = cbu_i_bio(jn_dsi,layer) + zd_dsi
596	cbu_i_bio(jn_aoc,layer) = cbu_i_bio(jn_aoc,layer) + zd_daf
597
598	IF ( nn_bio_opt .GE. 1 )
599	& cbu_i_bio(jn_eoc,layer) = cbu_i_bio(jn_eoc,layer) + zd_eoc
600
601
602	IF ( ln_write_bio ) THEN
603
604	WRITE(numout,*) ' Terms for layer: ', layer
605	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ '
606	WRITE(numout,*) ' syn_bio : ', syn_bio(layer)
607	WRITE(numout,*) ' lys_bio : ', lys_bio(layer)
608	WRITE(numout,*) ' rem_bio : ', rem_bio(layer)
609	WRITE(numout,*) ' exu_bio : ', exu_bio(layer)
610	WRITE(numout,*) ' rsp_bio : ', rsp_bio(layer)
611	WRITE(numout,*) ' lim_dsi : ', lim_dsi(layer)
612	WRITE(numout,*) ' lim_no3 : ', lim_no3(layer)
613	WRITE(numout,*) ' lim_po4 : ', lim_po4(layer)
614	WRITE(numout,*) ' lim_lig : ', lim_lig(layer)
615	WRITE(numout,*) ' lim_tem : ', lim_tem(layer)
616	WRITE(numout,*) ' lim_sal : ', lim_sal(layer)
617	WRITE(numout,*) ' lim_din_stock : ', lim_din_stock(layer)
618	WRITE(numout,*) ' lim_dip_stock : ', lim_dip_stock(layer)
619	WRITE(numout,*) ' lim_dsi_stock : ', lim_dsi_stock(layer)
620	WRITE(numout,*)
621	WRITE(numout,*) ' tc_bio : ', tc_bio(layer)
622	WRITE(numout,*) ' sbr_bio : ', sbr_bio(layer)
623	WRITE(numout,*) ' par_bio : ', par_bio(layer)
624	WRITE(numout,*)
625	WRITE(numout,*) ' zd_dsi : ', zd_dsi
626	WRITE(numout,*) ' zd_po4 : ', zd_po4
627	WRITE(numout,*) ' zd_daf : ', zd_daf
628	WRITE(numout,*) ' zd_eoc : ', zd_eoc
629	WRITE(numout,*) ' zd_din : ', zd_din
630	WRITE(numout,*)
631	WRITE(numout,*) ' dSi : ', cbu_i_bio(jn_dsi,layer)
632	WRITE(numout,*) ' dIN : ', cbu_i_bio(jn_din,layer)
633	WRITE(numout,*) ' dIP : ', cbu_i_bio(jn_dip,layer)
634	WRITE(numout,*) ' AoC : ', cbu_i_bio(jn_aoc,layer)
635	WRITE(numout,*) ' eoC : ', cbu_i_bio(jn_eoc,layer)
636	WRITE(numout,*) ' krem_N : ', krem_N
637
638
639	IF (ln_decoupNC) THEN
640	WRITE(numout,*) ' syn_N : ', syn_N(layer)
641	WRITE(numout,*) ' rsp_N : ', rsp_N(layer)
642	WRITE(numout,*) ' lys_N : ', lys_N(layer)
643	WRITE(numout,*) ' rem_N : ', rem_N(layer)
644	WRITE(numout,*)
645	WRITE(numout,*) ' zd_aon : ', zd_aon
646	WRITE(numout,*) ' zd_eon : ', zd_eon
647	WRITE(numout,*)
648	WRITE(numout,*) ' AoN : ', cbu_i_bio(jn_aon,layer)
649	WRITE(numout,*) ' eoN : ', cbu_i_bio(jn_eon,layer)
650	WRITE(numout,*)
651	WRITE(numout,*) ' N_C_alg : ', N_C_alg(layer)
652	WRITE(numout,*) ' N_C_det : ', N_C_det(layer)
653	ENDIF ! ln_decoupNC
654
655	ENDIF ! ln_write_bio
656
657	END DO ! layer
658
659
660
661	!------------------------------------------------------------------------
662	! 2.5 Update DIC, Alk and Oxy
663	!------------------------------------------------------------------------
664
665	DO layer = layer_00, nlay_bio
666
667	zncp = - syn_bio(layer) + rsp_bio(layer) + rem_bio(layer)
668
669	IF ( ln_carbon .AND. flag_active(jn_dic)
670	& .AND. flag_active(jn_alk) ) THEN
671
672	zd_dic1 = - zncp * ddtb !! Bizarre
673	zd_dic2 = - cbu_i_bio(jn_dic,layer)
674	zd_dic = MAX( zd_dic1 , zd_dic2 )
675
676	zd_alk1 = no3_c * zncp * ddtb !! Bizarre
677	zd_alk2 = - cbu_i_bio(jn_alk,layer)
678	zd_alk = MAX( zd_alk1 , zd_alk2 )
679
680	cbu_i_bio(jn_dic,layer) = cbu_i_bio(jn_dic,layer) + zd_dic
681	cbu_i_bio(jn_alk,layer) = cbu_i_bio(jn_alk,layer) + zd_alk
682
683	IF ( ln_write_bio ) THEN
684	WRITE(numout,*) ' DIC : ', cbu_i_bio(jn_dic,layer)
685	WRITE(numout,*) ' Alk : ', cbu_i_bio(jn_alk,layer)
686	ENDIF
687
688	ENDIF
689
690	IF ( flag_active(jn_oxy) ) THEN
691
692	zd_oxy1 = oxy_c * zncp * ddtb
693	zd_oxy2 = - cbu_i_bio(jn_oxy,layer)
694	zd_oxy = MAX( zd_oxy1, zd_oxy2 )
695
696	cbu_i_bio(jn_oxy,layer) = cbu_i_bio(jn_oxy,layer) + zd_oxy
697
698	IF ( ln_write_bio ) THEN
699	WRITE(numout,*) ' Oxy : ', cbu_i_bio(jn_oxy,layer)
700	ENDIF
701
702	ENDIF
703
704	END DO
705
706	!
707	!------------------------------------------------------------------------------!
708	! X) End of the routine
709	!------------------------------------------------------------------------------!
710	!
711	WRITE(numout,*)
712	WRITE(numout,) ' After biological sources and sinks * '
713	WRITE(numout,*) ' model output '
714	DO jn = 1, ntra_bio
715	IF ( flag_active(jn) ) THEN
716	WRITE(numout,*) ' biotr_i_nam : ', biotr_i_nam(jn)
717	WRITE(numout,*) ' cbu_i_bio : ', ( cbu_i_bio(jn, jk), jk = 1,
718	& nlay_bio )
719	ENDIF
720	END DO
721	WRITE(numout,*)
722
723	WRITE(numout,*)
724	WRITE(numout,*) ' End of ice_bio_sms '
725	WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
726
727
728	!==============================================================================\|
729	! Fin de la routine ice_bio_sms
730	WRITE(numout,*)
731
732	END

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

Context Navigation

source: branches/2016/dev_v3.20_2016_gravity_drainage/SOURCES/source_3.20/ice_bio_sms.f @ 20

Download in other formats: