source: branches/2016/dev_v3.20_2016_gravity_drainage/SOURCES/source_3.20/bio.com @ 24

Last change on this file since 24 was 20, checked in by vancop, 8 years ago

Ludivine source files

File size: 16.5 KB
Line 
1!
2!               COMMONS FOR SEA ICE BIOGEOCHEMISTRY
3!               ===================================
4!
5!
6! z_i_bio       : vertical coordinate of the middle of bio-layers
7! deltaz_i_bio  : thickness of the bio-layers
8! c_i_bio       : concentration of tracers in the brines
9! cbu_i_bio     : bulk concentration of tracers in the ice
10! cbub_i_bio    : concentration of tracers in bubbles for bulk ice
11! f_bub         : Gas flux to the atmosphere due to gas bubbles
12! t_i_bio       : temperature in the ice, interpolated on the bio grid
13! s_i_bio       : salinity in the ice, interpolated on the bio grid
14! e_i_bio       : relative brine volume, interpolated on the bio grid
15! c_w_bio       : concentration of tracer in seawater
16
17      REAL(8), DIMENSION(nlay_bio) ::
18     &   z_i_bio,
19     &   deltaz_i_bio,
20     &   t_i_bio,
21     &   s_i_bio,
22     &   e_i_bio,
23     &   diff_br_bio
24
25      REAL(8), DIMENSION(0:nlay_bio) ::
26     &   zb_i_bio
27
28      REAL(8), DIMENSION(ntra_bio_max) ::
29     &   cbu_i_nml,
30     &   c_w_bio,
31     &   ct_i_bio,
32     &   ch_bo_bio,
33     &   ch_si_bio,
34     &   c_s_bio,
35     &   f_su_tra,
36     &   f_bo_tra,
37     &   f_bogr,
38     &   f_sigr,
39     &   fcb,
40     &   fcbp,
41     &   fcsi,
42     &   fcbm,
43     &   fcsu,
44     &   fcb_max,
45     &   fgas,
46     &   gas_trvel,
47     &   f_bub,
48     &   dmol_gas,
49     &   mixr_gas
50
51      INTEGER, DIMENSION(ntra_bio_max) ::
52     &   nn_init      !: switch for init ( 0=from code, 1=conc. conserved, 2=stock conserved, 3=read profile )
53
54      INTEGER ::
55     &   jn_dsi,      !: tracer number for dsi
56     &   jn_din,      !:  ...
57     &   jn_dip,      !:  ...
58     &   jn_aoc,      !:  ...
59     &   jn_eoc,      !:  ...
60     &   jn_dic,      !:  ...
61     &   jn_alk,      !:  ...
62     &   jn_ika,      !:  ...
63     &   jn_oxy,      !:  ...
64     &   jn_arg,      !:  ...
65     &   jn_pco,      !:  ...
66     &   jn_car,      !:  ...
67     &   jn_co2,      !:  ...
68     &   jn_cal,      !:  ...
69     &   jn_aon,      !:  ...
70     &   jn_eon,      !:  ...
71     &   jn_aop,      !:  ...           
72     &   jn_eop
73
74      REAL(8), DIMENSION(ntra_bio_max,nlay_bio) ::
75     &   c_i_bio,
76     &   cbu_i_bio,
77     &   cbub_i_bio,
78     &   c_gtot_i,
79     &   pc_sat,
80     &   diag_divf_bio,
81     &   csat_gas,
82     &   sol_gas
83
84      REAL(8), DIMENSION(ntra_bio_max,0:nlay_bio) ::
85     &   fdiff
86
87      COMMON /bioarrays/
88     &   z_i_bio,
89     &   zb_i_bio,
90     &   deltaz_i_bio,
91     &   t_i_bio,
92     &   s_i_bio,
93     &   e_i_bio,
94     &   diff_br_bio,
95     &   ct_i_bio,
96     &   cbu_i_nml,
97     &   c_w_bio,
98     &   ch_bo_bio,
99     &   ch_si_bio,
100     &   c_s_bio,
101     &   f_su_tra,
102     &   f_bo_tra,
103     &   f_bogr,
104     &   f_sigr,
105     &   fcb,
106     &   fcbp,
107     &   fcsi,
108     &   fcbm,
109     &   fcsu,
110     &   fcb_max,
111     &   fgas,
112     &   f_bub,
113     &   dmol_gas,
114     &   mixr_gas,
115     &   gas_trvel,
116     &   c_i_bio,
117     &   cbu_i_bio,
118     &   cbub_i_bio,
119     &   c_gtot_i,
120     &   pc_sat,
121     &   diag_divf_bio,
122     &   fdiff,
123     &   csat_gas,
124     &   sol_gas,
125     &   FDSI_AD,
126     &   FDIN_AD,
127     &   FDIP_AD
128
129
130      COMMON /bioini/
131     &   nn_init                  !: type of initialization for bgc tracers
132
133      COMMON/biotrindex/
134     &   jn_dsi,      !: tracer number for dsi
135     &   jn_din,      !:  ...
136     &   jn_dip,      !:  ...
137     &   jn_aoc,      !:  ...
138     &   jn_eoc,      !:  ...
139     &   jn_dic,      !:  ...
140     &   jn_alk,      !:  ...
141     &   jn_ika,      !:  ...
142     &   jn_oxy,      !:  ...
143     &   jn_arg,      !:  ...
144     &   jn_pco,      !:  ...
145     &   jn_car,      !:  ...
146     &   jn_co2,      !:  ...
147     &   jn_cal,      !:  ...
148     &   jn_aon,      !:  ...
149     &   jn_eon,      !:  ...
150     &   jn_aop,      !:
151     &   jn_eop
152
153      COMMON /biophyparams/
154     &   nn_bio_opt       ,       !: type of biological formulation
155     &   astar_alg        ,       !: specific absorption coeff (m-1 / (mg chla m-3))
156     &   fdet_alg         ,       !: fraction of detrital absorption compared to algal absorption
157     &   nn_phs           ,       !: type of photosynthesis
158     &   nn_lys           ,       !: type of lysis
159     &   nn_rem           ,       !: type of remineralization
160     &   pp_presc         ,       !: prescribed primary production
161     &   h_skel           ,       !: thickness of the biological layer ('SL' & 'BAL' only)
162     &   e_thr_bal        ,       !: thickness of the biological layer ('SL' & 'BAL' only)
163     &   h_bio            ,       !: thickness of the biological layer ('SL' & 'BAL' only)
164     &   brines_ar                !: brines aspect ratio (for gas exchange)
165
166      REAL(8), DIMENSION(ntra_bio_max) ::
167     &   mt_i_bio_init, mt_i_bio_final,
168     &   mt_w_bio_init, mt_w_bio_final,
169     &   mt_i_bio
170     
171      REAL(8), DIMENSION(ntra_bio_max) ::
172     &   mt_i_gas_init, mt_i_gas_final,
173     &   mt_i_gas
174
175      REAL(8), DIMENSION(ntra_bio_max) ::
176     &   mt_i_carb_init, mt_i_carb_final,
177     &   mt_i_carb
178
179      REAL(8), DIMENSION(ntra_bio_max,nlay_bio) ::
180     &   m_i_bio_init, m_i_bio_final
181
182
183      COMMON/bioconserv/
184     &   mt_i_bio_init, mt_i_bio_final,
185     &   mt_w_bio_init, mt_w_bio_final,     
186     &   mt_i_bio,
187     &   mt_i_gas_init, mt_i_gas_final,
188     &   mt_i_gas,
189     &   mt_i_carb_init, mt_i_carb_final,
190     &   mt_i_carb,
191     &   m_i_bio_init, m_i_bio_final
192
193      LOGICAL ::
194     &   flag_diff(ntra_bio_max)     , !: flag which describes diffusability of a tracer
195     &   flag_active(ntra_bio_max)   , !: describe whether a tracer is assumed active or not
196     &   flag_adsorb(ntra_bio_max)   , !: adsorbed or not ?
197     &   ln_trbo                 , !: activate tracer basal entrapment
198     &   ln_trsi                 , !: activate tracer surface entrapment
199     &   ln_trdiff               , !: activate tracer diffusion
200     &   ln_trremp               , !: activate tracer remapping
201     &   ln_lim_dsi              , !: activate DSi limitation
202     &   ln_lim_no3              , !: activate NO3 limitation
203     &   ln_lim_po4              , !: activate PO4 limitation
204     &   ln_lim_lig              , !: activate light limitation
205     &   ln_lim_tem              , !: activate temperature inhibition
206     &   ln_lim_sal              , !: activate brine salinity inhibition
207     &   ln_lys                  , !: activate lysis
208     &   ln_rem                  , !: activate remineralization
209     &   ln_syn                  , !: activate diatom synthesis
210     &   ln_bubform              , !: activate gas buble formation
211     &   ln_bubrise              , !: activate gas buble ascent
212     &   ln_gasflux              , !: activate gas flux to atm
213     &   ln_carbon               , !: activate carbon cycle
214     &   ln_ikaite               , !: activate CaCO3
215     &   ln_decoupNC             , !: activate N cycle disconnected from C cycle   
216     &   ln_decoupPC
217
218      INTEGER(4) ::
219     &   nn_bio_opt              , !: type of biological model (0=NP, 1=NPD Redfield)
220     &   nn_diff(ntra_bio_max)   , !: switch for diffusion (0=no diffus, 1=diffus, 2=reset brine cc to zero)
221     &   nn_remp(ntra_bio_max)   , !: switch for remapping (0=no remap , 1=diffus. remap, 2=squeeze remap.)
222     &   nn_phs                  , !: switch for photosynthesis (1=Ek, 2=chl-C, 3=chl-C+T/S, 4=variable chl-C)
223     &   nn_lys                  , !: type of loss term (1=prescribed, 2=T-dependent)
224     &   nn_rem                  , !: type of remineralization (1=prescribed, 2=T-dependent)
225     &   nn_lim_sal              , !: switch for the type of brine salinity inhibition
226     &   ntra_bio                , !: maximum number of tracers
227     &   layer_00                , !: index of the first layer
228     &   nn_carbonate              !: type of carbonate constants (1=Roy, 2=mehrbach)
229
230      REAL(8) ::
231     &   bub_form_rate           ,
232     &   bub_diss_rate           ,
233     &   h_bl_gas                ,
234     &   e_thr_bubrise           ,
235     &   e_thr_gasflux           ,
236     &   sursat_gas              ,
237     &   caco3_time               
238
239      COMMON /bioswi/
240     &   flag_diff               ,
241     &   flag_active             ,
242     &   flag_adsorb             ,
243     &   ln_trbo                 ,
244     &   ln_trsi                 ,
245     &   ln_trdiff               ,
246     &   ln_trremp               ,
247     &   ln_lim_dsi              ,
248     &   ln_lim_no3              ,
249     &   ln_lim_po4              ,
250     &   ln_lim_lig              ,
251     &   ln_lim_tem              ,
252     &   ln_lim_sal              ,
253     &   ln_lys                  ,
254     &   ln_rem                  ,
255     &   ln_syn                  ,
256     &   nn_diff                 ,
257     &   nn_remp                 ,
258     &   nn_lim_sal              ,
259     &   ntra_bio                ,
260     &   layer_00                ,
261     &   nn_carbonate            ,
262     &   i_gasflux               ,
263     &   ln_bubform              ,
264     &   ln_bubrise              ,
265     &   ln_gasflux              ,
266     &   ln_carbon               ,
267     &   ln_ikaite               ,
268     &   bub_form_rate           ,
269     &   bub_diss_rate           ,
270     &   h_bl_gas                ,
271     &   e_thr_bubrise           ,
272     &   e_thr_gasflux           ,
273     &   sursat_gas              ,
274     &   caco3_time              ,
275     &   ln_decoupNC             ,
276     &   ln_decoupPC
277
278      !-----------------------
279      ! Brine characteristics
280      !-----------------------
281      REAL(8), DIMENSION(nlay_bio) ::  ! Brine characteristics
282     &   tc_bio                  ,  ! Celsius temperature on the bio-grid
283     &   sbr_bio                 ,  ! brine salinity on the bio-grid
284     &   rhobr_bio                  ! brine density on the bio-grid
285
286      COMMON/biobrine/
287     &   tc_bio                  ,
288     &   sbr_bio                 ,
289     &   rhobr_bio                 
290
291      !---------------------
292      ! Carbonate chemistry
293      !---------------------
294      REAL(8), DIMENSION(nlay_bio) ::  ! Carbonate chemistry diagnostics
295     &   CO2aq                   , ! aqueous CO2, bulk concentration
296     &   CO32m                   , ! carbonate (CO32-), bulk concentration
297     &   hCO3m                   , ! bicarbonate (HCO3-), bulk concentration
298     &   pH                      , ! pH, brine
299     &   pCO2                      ! pCO2, brine
300
301      COMMON/biocarbchem/       
302     &   CO2aq                   , ! aqueous CO2, bulk concentration
303     &   CO32m                   , ! carbonate (CO32-), bulk concentration
304     &   hCO3m                   , ! bicarbonate (HCO3-), bulk concentration
305     &   pH                      , ! pH, brine
306     &   pCO2                      ! pCO2, brine
307
308      CHARACTER(len=64) ::
309     &   biotr_i_nam(ntra_bio_max)  , !:
310     &   biotr_i_typ(ntra_bio_max)    !:
311
312      CHARACTER(len=64) ::         
313     &   biotr_i_uni(ntra_bio_max)
314
315      CHARACTER(len=2) ::         
316     &   c_grid
317
318      CHARACTER(len=3) ::
319     &   c_read_name(ntra_bio_max),
320     &   c_nc_name(ntra_bio_max)
321         
322      COMMON /biochar/
323     &   biotr_i_nam,
324     &   biotr_i_typ,
325     &   biotr_i_uni,
326     &   c_grid,
327     &   c_read_name,
328     &   c_nc_name   
329
330      COMMON /biomass/
331     &   chla_i_bio(nlay_bio)     !: chlorophyll a concentration
332
333      REAL(8) ::
334     &   ika_rate(nlay_bio)      , !: CaCO3 precipitation / dissolution rate (mmol/m3/s)
335     &   ika_omega(nlay_bio)     , !: CACO3 saturation state (-)
336     &   syn_bio(nlay_bio)       , !: synthesis
337     &   lys_bio(nlay_bio)       , !: lysis
338     &   exu_bio(nlay_bio)       , !: exudation
339     &   rsp_bio(nlay_bio)       , !: respiration
340     &   rem_bio(nlay_bio)       , !: remineralization
341     &   lim_lig(nlay_bio)       , !: light limitation
342     &   lim_dsi(nlay_bio)       , !: DSi limitation
343     &   lim_no3(nlay_bio)       , !: NO3 limitation
344     &   lim_po4(nlay_bio)       , !: PO4 limitation
345     &   lim_tem(nlay_bio)       , !: temperature limitation
346     &   lim_sal(nlay_bio)       , !: salt limitation
347     &   chlC_bio(nlay_bio)      , !: interactive chl-a / C ratio
348     &   syn_N(nlay_bio)         , !:
349     &   lys_N(nlay_bio)         , !:
350     &   rsp_N(nlay_bio)         , !:
351     &   rem_N(nlay_bio)         , !:
352     &   syn_P(nlay_bio)         , !:
353     &   lys_P(nlay_bio)         , !:
354     &   rsp_P(nlay_bio)         , !:
355     &   rem_P(nlay_bio)         , !:
356     &   N_C_alg(nlay_bio)       , !: N/C ratio in algae (if ln_decoupNC = TRUE)
357     &   N_C_det(nlay_bio)       , !: N/C ratio in detritic matter (if ln_decoupNC = TRUE)
358     &   lim_din_stock(nlay_bio) , !: limitation en stock DIN
359     &   lim_dip_stock(nlay_bio) , !:
360     &   lim_dsi_stock(nlay_bio) , !:
361     &   P_C_alg(nlay_bio)       , !: P/C ratio in algae (if ln_decoupPC = TRUE)
362     &   P_C_det(nlay_bio)       , !: P/C ratio in algae (if ln_decoupPC = TRUE)
363     &   N_P_alg(nlay_bio)       , !: N/P ratio in algae (if ln_decoupPC = TRUE)
364     &   N_P_det(nlay_bio)         !: N/P ratio in algae (if ln_decoupPC = TRUE)
365
366      COMMON /biosources/
367     &   ika_rate                , !:
368     &   ika_omega               , !:
369     &   syn_bio                 , !:
370     &   lys_bio                 , !:
371     &   exu_bio                 , !:
372     &   rsp_bio                 , !:
373     &   rem_bio                 , !:
374     &   lim_lig                 , !:
375     &   lim_dsi                 , !:
376     &   lim_no3                 , !:
377     &   lim_po4                 , !:
378     &   lim_tem                 , !:
379     &   lim_sal                 , !:
380     &   chlC_bio                , !:
381     &   syn_N                   , !:
382     &   lys_N                   , !:
383     &   rsp_N                   , !:
384     &   rem_N                   , !:
385     &   syn_P                   , !:
386     &   lys_P                   , !:
387     &   rsp_P                   , !:
388     &   rem_P                   , !:
389     &   N_C_alg                 , !:
390     &   N_C_det                 , !:
391     &   lim_din_stock           , !:
392     &   lim_dip_stock           , !:
393     &   lim_dsi_stock           , !:
394     &   P_C_alg                 , !:
395     &   P_C_det                 , !:
396     &   N_P_alg                 , !:
397     &   N_P_det                   !:
398
399
400      COMMON /biorad/             
401     &   par_bio(nlay_bio)         !: Photosynthetically available radiation
402                                   !: (flux micromol quanta m-2 s-1)
403      !---------------------------------------
404      ! Constants and parameters of the model
405      !---------------------------------------
406      REAL(8) ::
407     &   mumax_bio               , !: maximum specific growth (s-1)
408     &   klys_bio                , !: autolysis rate (s-1)
409     &   ek_bio                  , !: light adaptation micrmol quanta m-2 s-1
410     &   alpha_bio               , !: photosynthetic efficiency (gC/gchla/s-1/(muE/m2/s))
411     &   khs_si_bio              , !: half sat for Si uptake (mmol m-3)
412     &   khs_n_bio               , !: half sat for N uptake (mmol m-3)
413     &   khs_p_bio               , !: half sat for P uptake (mmol m-3)
414     &   frem_bio                , !: fraction of Si loss that is remineralized (-)
415     &   krem_bio                , !: carbon remineralization time constant (s-1)
416     &   krsp_bio                , !: carbon respiration time constant
417     &   rg_bio                  , !: temperature coefficient for diatom synthesis (deg C-1)
418     &   rg_bac                  , !: temperature coefficient for bacterial processes (deg C-1)
419     &   lim_sal_wid             , !: width of the limitation function (case 4)
420     &   lim_sal_smax            , !: salinity at which limitation function is 1 (case 4)
421     &   chla_c                  , !: Chlorophyll-to-carbon ratio
422     &   Estar                   , !: PAR level of minimum Chl/C
423     &   si_c                    , !: Si cell quota in diatoms
424     &   no3_c                   , !: N cell quota in diatoms
425     &   po4_c                   , !: N cell quota in diatoms
426     &   oxy_c                   , !: Oxygen cell quota in diatoms
427     &   c_molar                 , !: carbon molar mass
428     &   ksyn_N                  , !: intensity of N flux compared with C flux
429     &   klys_N                  , !: same
430     &   krsp_N                  , !: same
431     &   krem_N                  , !: same
432     &   ksyn_P                  , !: intensity of N flux compared with C flux
433     &   klys_P                  , !: same
434     &   krsp_P                  , !: same
435     &   krem_P                    !: same
436
437      COMMON /bioparams/
438     &   mumax_bio, klys_bio, ek_bio, alpha_bio,
439     &   khs_si_bio, khs_n_bio, khs_p_bio, frem_bio,
440     &   krem_bio, krsp_bio,
441     &   rg_bio, rg_bac, chla_c, Estar, si_c, no3_c, po4_c, oxy_c,
442     &   lim_sal_wid, lim_sal_smax, c_molar, ksyn_N, klys_N,
443     &   krsp_N, krem_N, ksyn_P, klys_P, krsp_P,
444     &   krem_P
445 
446
Note: See TracBrowser for help on using the repository browser.