Context Navigation

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

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

Line
1	SUBROUTINE ice_bio_ini(kideb,kiut,nlay_i)
2	!
3	!------------------------------------------------------------------------------!
4	!
5	! This routine initializes biogeochemical tracers
6	! (c) Martin Vancoppenolle, Oct 2014
7	!
8	! version: 3.04
9	!
10	!------------------------------------------------------------------------------!
11	!
12	INCLUDE 'type.com'
13	INCLUDE 'para.com'
14	INCLUDE 'const.com'
15	INCLUDE 'ice.com'
16	INCLUDE 'thermo.com'
17	INCLUDE 'bio.com'
18
19	INTEGER ::
20	& ji , ! : index for space
21	& jk , ! : index for ice layers
22	& jn , ! : index for tracers
23	& numtra = 700, ! : reference number for bio.param
24	& n_raw ! : number of values in the raw initial profile
25
26	REAL(4) zini(1) ! forcing field dummy array
27
28	REAL(8), DIMENSION(maxnlay) ::
29	& z_raw,
30	& zq_raw,
31	& zc_raw,
32	& zq1,
33	& zdh_bio
34
35	REAL(8), DIMENSION(maxnlay+2) ::
36	& zdh_raw
37
38	REAL(8), DIMENSION(0:maxnlay) ::
39	& zb_raw
40
41	CHARACTER(len=61) ::
42	& zblank
43
44	CHARACTER(len=10) ::
45	& filenc='init.nc'
46
47	CHARACTER(len=3) ::
48	& zchar
49
50	LOGICAL ::
51	& ln_initfile = .FALSE.
52
53	zblank =
54	& ' '
55	ji = 1
56
57	!------------------------------------------------------------------------------!
58
59	WRITE(numout,) ' * ice_bio_ini : '
60	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ '
61	WRITE(numout,*)
62
63	IF ( c_bio_model .EQ. 'KRILL' ) THEN
64	ntra_bio = 23
65	ENDIF
66	!
67	!-----------------------------------------------------------------------------!
68	! 1) Create grid and interpolate physical variables
69	!-----------------------------------------------------------------------------!
70	!
71
72	CALL ice_bio_grid(kideb,kiut,nlay_i,.TRUE.) ! Biological grid
73
74	CALL ice_bio_interp_phy2bio(kideb,kiut,nlay_i, .FALSE.) ! Physical fields
75	! on the bio grid
76
77	!
78	!-----------------------------------------------------------------------------!
79	! 2) Initialize tracer numbers and names
80	!-----------------------------------------------------------------------------!
81	!
82	WRITE(numout,*) ' Initialize tracers... '
83	WRITE(numout,*)
84
85	! Set default tracer values
86	layer_00 = 1
87	cbu_i_bio(:,:) = 0.
88	cbub_i_bio(:,:) = 0. ; c_gtot_i(:,:) = 0.
89	c_w_bio(:) = 0. ; mixr_gas(:) = 0.
90	dmol_gas(:) = 0.
91
92	flag_active(:) = .false. ! Activated ?
93	flag_adsorb(:) = .false. ! Adsorbed ?
94	flag_diff(:) = .false. ! Diffused ?
95	nn_remp(:) = 1 ! Squeezing remaping
96	biotr_i_nam(:) = 'xxx'//zblank ! Name of the tracer
97	biotr_i_typ(:) = 'xxx'//zblank ! Type = algal
98	biotr_i_uni(:) = 'xxx'//zblank ! Units
99	nn_init(:) = 1
100
101	! Compute layer limits
102	IF ( ( c_grid .EQ. 'SL' ) .OR. ( c_grid .EQ. 'BA' ) )
103	& layer_00 = nlay_bio
104
105	! Assign Tracer Numbers
106	jn_dsi = 1
107	jn_din = 2
108	jn_dip = 3
109	jn_aoc = 4
110	jn_eoc = 5
111	jn_co2 = 6 ! 20
112	jn_dic = 7 ! 12
113	jn_alk = 8 ! 13
114	jn_ika = 9 ! 14
115	jn_oxy = 10 ! 15
116	jn_nit = 11 ! 16
117	jn_arg = 12 ! 17
118	jn_cal = 13 ! 21
119	jn_aon = 14
120	jn_eon = 15
121	jn_aop = 16
122	jn_eop = 17
123
124	! Assign Tracer names
125	biotr_i_nam(jn_dsi) = 'dSi'//zblank
126	biotr_i_nam(jn_din) = 'dIN'//zblank
127	biotr_i_nam(jn_dip) = 'dIP'//zblank
128	biotr_i_nam(jn_aoc) = 'AoC'//zblank
129	biotr_i_nam(jn_eoc) = 'eoC'//zblank
130	biotr_i_nam(jn_co2) = 'CO2'//zblank
131	biotr_i_nam(jn_dic) = 'DIC'//zblank
132	biotr_i_nam(jn_alk) = 'Alk'//zblank
133	biotr_i_nam(jn_ika) = 'Ika'//zblank
134	biotr_i_nam(jn_cal) = 'Cal'//zblank
135	biotr_i_nam(jn_arg) = 'Arg'//zblank
136	biotr_i_nam(jn_oxy) = 'Oxy'//zblank
137	biotr_i_nam(jn_nit) = 'Nit'//zblank
138	biotr_i_nam(jn_aon) = 'AoN'//zblank
139	biotr_i_nam(jn_eon) = 'eoN'//zblank
140	biotr_i_nam(jn_aop) = 'AoP'//zblank
141	biotr_i_nam(jn_eop) = 'eoP'//zblank
142
143	!
144	!-----------------------------------------------------------------------------!
145	! 3) Read tracer parameters
146	!-----------------------------------------------------------------------------!
147	!
148
149	WRITE(numout,*) ' Tracer parameters ... '
150	WRITE(numout,*)
151
152	OPEN( unit = numtra , file='tracer.param', status='old' )
153
154	! initial values
155	READ(numtra,*)
156	READ(numtra,*)
157	READ(numtra,*)
158	READ(numtra,*)
159	READ(numtra,*)
160	READ(numtra,*)
161	READ(numtra,*)
162	READ(numtra,*)
163	READ(numtra,*)
164	READ(numtra,*)
165	READ(numtra,*)
166	READ(numtra,*)
167	READ(numtra,*)
168	READ(numtra,*)
169	READ(numtra,*)
170	READ(numtra,*)
171	READ(numtra,*)
172	READ(numtra,*)
173	READ(numtra,*)
174	READ(numtra,*)
175	READ(numtra,*)
176
177	DO jn_read = 1, 17
178
179	READ(numtra,*) c_read_name(jn_read), zchar, i_dummy1, zdummy2,
180	& zdummy3, zdummy4, zdummy5
181
182	DO jn = 1, ntra_bio
183	IF ( c_read_name(jn_read)//zblank .EQ. biotr_i_nam(jn) ) THEN
184	c_nc_name(jn) = zchar
185	nn_init(jn) = i_dummy1
186	cbu_i_nml(jn) = zdummy2
187	c_w_bio(jn) = zdummy3
188	mixr_gas(jn) = zdummy4
189	dmol_gas(jn) = zdummy5
190	ENDIF
191	END DO
192
193	ENDDO
194
195	CLOSE( numtra )
196
197	WRITE(numout,*)
198	DO jn = 1, ntra_bio
199	WRITE(numout,*) biotr_i_nam(jn), nn_init(jn) , cbu_i_nml(jn),
200	& c_w_bio(jn) , mixr_gas(jn), dmol_gas(jn)
201	END DO
202
203	!
204	!-----------------------------------------------------------------------------!
205	! 4) Parameterize tracer behaviour
206	!-----------------------------------------------------------------------------!
207	!
208	! flag_active determines a tracer is activated in the code
209	! flag_adsorb is just there for one specific test and should not be activated
210	! flag_diff tells whether a tracer should be diffused with brine or not
211	! nn_remp gives the type of remapping - 1 = linear remapping (very diffusive); 2 = "squeezing remapping"
212	! biotr_i_typ can be either - only gas is useful because flag_diff makes the difference between solutes and particles
213	! - 'sol' -> solute (like salt)
214	! - 'prc' -> particulate (e.g. organic matter)
215	! - 'gas' -> gas
216
217	!------------------------
218	! DSi : Dissolved silica
219	!------------------------
220	jn = jn_dsi
221	flag_active(jn) = .true.
222	flag_adsorb(jn) = .false.
223	flag_diff(jn) = .true.
224	nn_remp(jn) = 1
225	biotr_i_typ(jn) = 'sol'//zblank
226	biotr_i_uni(jn) = 'mmol_m3'//zblank
227
228	!------------------------------------
229	! DIN : dissolved inorganic nitrogen
230	!------------------------------------
231	jn = jn_din
232	flag_active(jn) = .true.
233	flag_adsorb(jn) = .false.
234	flag_diff(jn) = .true.
235	nn_remp(jn) = 1
236	biotr_i_typ(jn) = 'sol'//zblank
237	biotr_i_uni(jn) = 'mmol_m3'//zblank
238
239	!----------------------------
240	! DIP : Dissolved phosphorus
241	!----------------------------
242	jn = jn_dip
243	! Units = ( mmole PO4 m-3 ) or ( micrmol PO4 l-1 )
244	flag_active(jn) = .true.
245	flag_adsorb(jn) = .false.
246	flag_diff(jn) = .true.
247	nn_remp(jn) = 1
248	biotr_i_typ(jn) = 'sol'//zblank
249	biotr_i_uni(jn) = 'mmol_m3'//zblank
250
251	!--------------------------------------
252	! AoC : Ice algae organic carbon
253	!--------------------------------------
254	jn = jn_aoc
255	flag_active(jn) = .true.
256	flag_adsorb(jn) = .false.
257	flag_diff(jn) = .false.
258	nn_remp(jn) = 2
259	biotr_i_typ(jn) = 'prc'//zblank
260	biotr_i_uni(jn) = 'mmol_m3'//zblank
261
262	!--------------------------------------
263	! eoC : Detritus organic Carbon
264	!--------------------------------------
265	jn = jn_eoc
266	flag_active(jn) = .true.
267	flag_adsorb(jn) = .false.
268	flag_diff(jn) = .false.
269	nn_remp(jn) = 2
270	biotr_i_typ(jn) = 'prc'//zblank
271	biotr_i_uni(jn) = 'mmol_m3'//zblank
272
273	!--------------------------------------
274	! AoN : Ice algae organic N
275	!--------------------------------------
276	jn = jn_aon
277	flag_active(jn) = .true.
278	flag_adsorb(jn) = .false.
279	flag_diff(jn) = .false.
280	nn_remp(jn) = 2
281	biotr_i_typ(jn) = 'prc'//zblank
282	biotr_i_uni(jn) = 'mmol_m3'//zblank
283
284	!--------------------------------------
285	! eoN : Detritus organic N
286	!--------------------------------------
287	jn = jn_eon
288	flag_active(jn) = .true.
289	flag_adsorb(jn) = .false.
290	flag_diff(jn) = .false.
291	nn_remp(jn) = 2
292	biotr_i_typ(jn) = 'prc'//zblank
293	biotr_i_uni(jn) = 'mmol_m3'//zblank
294
295	!--------------------------------------
296	! AoP : Ice algae organic P
297	!--------------------------------------
298	jn = jn_aop
299	flag_active(jn) = .true.
300	flag_adsorb(jn) = .false.
301	flag_diff(jn) = .false.
302	nn_remp(jn) = 2
303	biotr_i_typ(jn) = 'prc'//zblank
304	biotr_i_uni(jn) = 'mmol_m3'//zblank
305
306	!--------------------------------------
307	! eoP : Detritus organic P
308	!--------------------------------------
309	jn = jn_eop
310	flag_active(jn) = .true.
311	flag_adsorb(jn) = .false.
312	flag_diff(jn) = .false.
313	nn_remp(jn) = 2
314	biotr_i_typ(jn) = 'prc'//zblank
315	biotr_i_uni(jn) = 'mmol_m3'//zblank
316
317	!--------------------------------------
318	! DIC : Dissolved Inorganic Carbon
319	!--------------------------------------
320	jn = jn_dic
321	flag_active(jn) = .true.
322	flag_adsorb(jn) = .false.
323	flag_diff(jn) = .true.
324	nn_remp(jn) = 1
325	biotr_i_typ(jn) = 'sol'//zblank
326	biotr_i_uni(jn) = 'mmol_m3'//zblank
327
328	!--------------------------------------
329	! Alk : Total Alkalinity
330	!--------------------------------------
331	jn = jn_alk
332	flag_active(jn) = .true.
333	flag_adsorb(jn) = .false.
334	flag_diff(jn) = .true.
335	nn_remp(jn) = 1
336	biotr_i_typ(jn) = 'sol'//zblank
337	biotr_i_uni(jn) = 'mmol_m3'//zblank
338
339	!--------------------------------------
340	! CO2 : aqueous CO2
341	!--------------------------------------
342	jn = jn_co2
343	flag_active(jn) = .true.
344	flag_adsorb(jn) = .false.
345	flag_diff(jn) = .true.
346	nn_remp(jn) = 1
347	biotr_i_typ(jn) = 'gas'//zblank
348	biotr_i_uni(jn) = 'mmol_m3'//zblank
349
350	!--------------------------------------
351	! Ika : Ikaite
352	!--------------------------------------
353	jn = jn_ika
354	flag_active(jn) = .true.
355	flag_adsorb(jn) = .false.
356	flag_diff(jn) = .false.
357	nn_remp(jn) = 1
358	biotr_i_typ(jn) = 'prc'//zblank
359	biotr_i_uni(jn) = 'mmol_m3'//zblank
360
361	!--------------------------------------
362	! Cal : Ca2+
363	!--------------------------------------
364	jn = jn_cal
365	flag_active(jn) = .true.
366	flag_adsorb(jn) = .false.
367	flag_diff(jn) = .true.
368	nn_remp(jn) = 1
369	biotr_i_typ(jn) = 'prc'//zblank
370	biotr_i_uni(jn) = 'mmol_m3'//zblank
371
372	!--------------------------------------
373	! Arg : ARgon
374	!--------------------------------------
375	jn = jn_arg
376	flag_active(jn) = .true.
377	flag_adsorb(jn) = .false.
378	flag_diff(jn) = .true.
379	nn_remp(jn) = 1
380	biotr_i_typ(jn) = 'gas'//zblank
381	biotr_i_uni(jn) = 'mmol_m3'//zblank
382
383	!--------------------------------------
384	! Oxy : Oxygen
385	!--------------------------------------
386	jn = jn_oxy
387	flag_active(jn) = .true.
388	flag_adsorb(jn) = .false.
389	flag_diff(jn) = .true.
390	nn_remp(jn) = 1
391	biotr_i_typ(jn) = 'gas'//zblank
392	biotr_i_uni(jn) = 'mmol_m3'//zblank
393
394	!--------------------------------------
395	! Nit : N2
396	!--------------------------------------
397	jn = jn_nit
398	flag_active(jn) = .false.
399	flag_adsorb(jn) = .false.
400	flag_diff(jn) = .false.
401	nn_remp(jn) = 1
402	biotr_i_typ(jn) = 'gas'//zblank
403	biotr_i_uni(jn) = 'mmol_m3'//zblank
404
405	!
406	!-----------------------------------------------------------------------------!
407	! 5) Prepare Netcdf Interpolation if required
408	!-----------------------------------------------------------------------------!
409	!
410	DO jn = 1, ntra_bio
411
412	IF ( flag_active (jn) .AND. ( nn_init(jn) == 3 ) )
413	& ln_initfile = .TRUE.
414
415	END DO
416
417	IF ( ln_initfile ) THEN
418
419	!--- Open file
420	!--------------
421	CALL CF_OPEN (filenc,id) ! open forcing file
422
423	CALL CF_READ1D ( filenc, 'nlay', 1, 1, zini ) ! number of layers
424	n_raw = zini(1)
425
426	DO layer = 1, n_raw ! raw grid
427	CALL CF_READ1D ( filenc, 'z_i', layer, 1, zini)
428	z_raw(layer) = zini(1)
429	END DO
430
431	zb_raw(:) = 0.0 ! layer interfaces
432	DO layer = 1, n_raw - 1
433	zb_raw(layer) = ( z_raw(layer) + z_raw(layer+1) ) / 2.
434	END DO
435	zb_raw(n_raw) = ht_i_b(ji)
436
437	zdh_raw(:) = 0. ! layer thicknesses
438	DO layer = 1, n_raw
439	zdh_raw(layer) = zb_raw(layer) - zb_raw(layer-1)
440	END DO
441
442	zdh_bio(:) = 0.
443	zdh_bio(1:nlay_bio) = deltaz_i_bio(:)
444
445	ENDIF
446
447	!--------------------------------------
448	! Assign ice concentrations to cbu_i
449	!--------------------------------------
450	DO jn = 1, ntra_bio
451
452	IF ( flag_active(jn) ) THEN
453
454	IF ( nn_init(jn) .EQ. 1 ) !--- Initialization conserves namelist concentration
455	& cbu_i_bio(jn,layer_00:nlay_bio) = cbu_i_nml(jn)
456
457	IF ( nn_init(jn) .EQ. 2 ) THEN !--- Initialization conserves namelist concentration times thickness
458	zstock = cbu_i_nml(jn) * ht_i_b(ji)
459	cbu_i_bio(jn,layer_00:nlay_bio) = zstock / h_bio
460	ENDIF
461
462	IF ( nn_init(jn) .EQ. 3 ) THEN !--- Profile read from nc file
463
464	DO layer = 1, n_raw
465	CALL CF_READ1D ( filenc, c_nc_name(jn), layer, 1, zini )
466	zc_raw(layer) = zini(1)
467	END DO
468
469	zq_raw(1:n_raw) = zc_raw(1:n_raw) * zdh_raw(1:n_raw)
470
471	CALL ice_phy_relay( n_raw , nlay_bio , 1 , 1 ,
472	& zdh_raw, zdh_bio, zq_raw , zq1 )
473
474	cbu_i_bio(jn,1:nlay_bio) = zq1(1:nlay_bio) /
475	& deltaz_i_bio(1:nlay_bio)
476
477	ENDIF
478
479	ENDIF
480
481	END DO
482
483	IF ( ln_initfile )
484	& CALL CF_CLOSE (filenc) ! close forcing file
485
486	!
487	!-----------------------------------------------------------------------------!
488	! 7) Chl-a (mg/m3)
489	!-----------------------------------------------------------------------------!
490	!
491	c_molar = 12. ! molar mass of carbon
492	DO layer = 1, nlay_bio
493	chla_i_bio(layer) = cbu_i_bio(4,layer) * chla_c * c_molar
494	END DO
495
496	!
497	!-----------------------------------------------------------------------------!
498	! 8) Zero un used tracers
499	!-----------------------------------------------------------------------------!
500	!
501	IF ( nn_bio_opt .EQ. 0 ) THEN
502	cbu_i_bio(jn_eoc,:) = 0.0
503	flag_active(jn_eoc) = .FALSE.
504	flag_adsorb(jn_eoc) = .FALSE.
505	flag_diff(jn_eoc) = .FALSE.
506	c_w_bio(jn_eoc) = 0.
507	mixr_gas(jn_eoc) = 0.
508	dmol_gas(jn_eoc) = 0.
509	ENDIF
510
511	!
512	!-----------------------------------------------------------------------------!
513	! 9) Control prints
514	!-----------------------------------------------------------------------------!
515	!
516	WRITE(numout,) ' Initial values * '
517	WRITE(numout,*)
518	DO jn = 1, ntra_bio
519	IF ( flag_active(jn) ) THEN
520	WRITE(numout,*) ' Tracer : ', biotr_i_nam(jn)
521	WRITE(numout,*) ' ~~~~~~~ '
522	WRITE(numout,*) ' Type : ', biotr_i_typ(jn)
523	WRITE(numout,*) ' cbu_i_bio : ', ( cbu_i_bio(jn,jk),
524	& jk = 1, nlay_bio )
525	WRITE(numout,*) ' c_w_bio : ', c_w_bio(jn)
526	WRITE(numout,*)
527	ENDIF
528	END DO ! jn
529
530	WRITE(numout,*) ' Chla '
531	WRITE(numout,*) ' ~~~~ '
532	WRITE(numout,*) ' chla_i_bio : ',
533	& ( chla_i_bio(layer), layer = 1, nlay_bio )
534
535	WRITE(numout,*)
536	WRITE(numout,*) ' End of ice_bio_ini '
537	WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
538
539	!
540	!-----------------------------------------------------------------------------!
541	!-- End of ice_bio_ini --
542	RETURN
543
544	END

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

Download in other formats: