Context Navigation

source: branches/publications/ORCHIDEE-ICE_SurfaceMassBalance/src_sechiba/chemistry.f90 @ 8398

Last change on this file since 8398 was 4287, checked in by josefine.ghattas, 7 years ago
Enhencement on clear functions. Added call to clear functions from all offline drivers. See ticket #232
Property svn:keywords set to `Date Revision HeadURL`
File size: 99.2 KB

Line
1	! ================================================================================================================================
2	! MODULE : chemistry
3	!
4	! CONTACT : orchidee-help _at_ ipsl.jussieu.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF
10	!!
11	!!\n DESCRIPTION:
12	!!
13	!! RECENT CHANGE(S): The content of this module were previously part of the diffuco module.
14	!! ok_inca changed name into ok_bvoc and DIFFUCO_OK_INCA changed into CHEMISTRY_BVOC
15	!! LEAFAGE_OK_INCA changed name into CHEMISTRY_LEAFAGE
16	!!
17	!! $HeadURL$
18	!! $Date$
19	!! $Revision$
20	!! \n
21	!_ ================================================================================================================================
22
23	MODULE chemistry
24
25	USE ioipsl
26	USE xios_orchidee
27	USE constantes
28	USE qsat_moisture
29	USE sechiba_io_p
30	USE ioipsl
31	USE pft_parameters
32	USE grid
33	USE ioipsl_para
34	USE xios_orchidee
35
36	IMPLICIT NONE
37
38	PRIVATE
39	PUBLIC :: chemistry_initialize, chemistry_bvoc, chemistry_flux_interface, chemistry_clear
40
41
42	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_iso !! Isoprene emissions from vegetation (kgC.m^{-2}.s^{-1})
43	!$OMP THREADPRIVATE(flx_iso)
44	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_mono !! Monoterpene emissions from vegetation (kgC.m^{-2}.s^{-1})
45	!$OMP THREADPRIVATE(flx_mono)
46	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_ORVOC !! Other Volatile Organic Compound emissions from vegetation (kgC.m^{-2}.s^{-1})
47	!$OMP THREADPRIVATE(flx_ORVOC)
48	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_MBO !! 2-methyl-3-buten-2-ol emissions from vegetation (mainly pines in America) (kgC.m^{-2}.s^{-1})
49	!$OMP THREADPRIVATE(flx_MBO)
50	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_methanol !! Methanol emissions from vegetation (kgC.m^{-2}.s^{-1})
51	!$OMP THREADPRIVATE(flx_methanol)
52	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_acetone !! Acetone emissions from vegetation (kgC.m^{-2}.s^{-1})
53	!$OMP THREADPRIVATE(flx_acetone)
54	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_acetal !! Acetaldehyde emissions from vegetation (kgC.m^{-2}.s^{-1})
55	!$OMP THREADPRIVATE(flx_acetal)
56	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_formal !! Formaldehyde emissions from vegetation (kgC.m^{-2}.s^{-1})
57	!$OMP THREADPRIVATE(flx_formal)
58	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_acetic !! Acetic acid emissions from vegetation (kgC.m^{-2}.s^{-1})
59	!$OMP THREADPRIVATE(flx_acetic)
60	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_formic !! Formic acid emissions from vegetation (kgC.m^{-2}.s^{-1})
61	!$OMP THREADPRIVATE(flx_formic)
62	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_apinen !! Alpha pinene emissions from vegetation (kgC.m^{-2}.s^{-1})
63	!$OMP THREADPRIVATE(flx_apinen)
64	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_bpinen !! Beta pinene emissions from vegetation (kgC.m^{-2}.s^{-1})
65	!$OMP THREADPRIVATE(flx_bpinen)
66	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_limonen !! Limonene emissions from vegetation (kgC.m^{-2}.s^{-1})
67	!$OMP THREADPRIVATE(flx_limonen)
68	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_myrcen !! Myrcene emissions from vegetation (kgC.m^{-2}.s^{-1})
69	!$OMP THREADPRIVATE(flx_myrcen)
70	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_sabinen !! Sabinene emissions from vegetation (kgC.m^{-2}.s^{-1})
71	!$OMP THREADPRIVATE(flx_sabinen)
72	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_camphen !! Camphene emissions from vegetation (kgC.m^{-2}.s^{-1})
73	!$OMP THREADPRIVATE(flx_camphen)
74	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_3caren !! 3-Carene emissions from vegetation (kgC.m^{-2}.s^{-1})
75	!$OMP THREADPRIVATE(flx_3caren)
76	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_tbocimen !! T-beta Ocimene emissions from vegetation (kgC.m^{-2}.s^{-1})
77	!$OMP THREADPRIVATE(flx_tbocimen)
78	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_othermono !! Emissions of other monoterpenes from vegetation (kgC.m^{-2}.s^{-1})
79	!$OMP THREADPRIVATE(flx_othermono)
80	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_sesquiter !! Sesquiterpene emissions from vegetation (kgC.m^{-2}.s^{-1})
81	!$OMP THREADPRIVATE(flx_sesquiter)
82	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_fertil_no !! Biogenic nitrogen oxide soil emission due to N-fertilisation (ngN.m^{-2}.s^{-1})
83	!$OMP THREADPRIVATE(flx_fertil_no)
84	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_no_soil !! Nitrogen Oxide emissions from soil, before deposition on canopy
85	!! (ngN.m^{-2}.s^{-1})
86	!$OMP THREADPRIVATE(flx_no_soil)
87	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_no !! Net nitrogen Oxide emissions from soil, after deposition on canopy
88	!$OMP THREADPRIVATE(flx_no)
89	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: CRF !! Canopy reduction factor for net NO flux calculation (kjpindex,nvm)
90	!$OMP THREADPRIVATE(CRF)
91
92	! variables used inside diffuco_inca module
93	LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: ok_siesta !! Flag for controlling post-pulse period (true/false)
94	!$OMP THREADPRIVATE(ok_siesta)
95	LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: allow_pulse !! Flag for controlling pulse period (true/false)
96	!$OMP THREADPRIVATE(allow_pulse)
97	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulse !! Pulse fonction
98	!$OMP THREADPRIVATE(pulse)
99	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulseday !! Counter for pulse period
100	!$OMP THREADPRIVATE(pulseday)
101	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: siestaday !! Counter for post-pulse period
102	!$OMP THREADPRIVATE(siestaday)
103	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulselim !! Pulse period length
104	!$OMP THREADPRIVATE(pulselim)
105	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: siestalim !! Post-pulse period length
106	!$OMP THREADPRIVATE(siestalim)
107	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: area2 !! Grid cell area (m^2)
108	!$OMP THREADPRIVATE(area2)
109	REAL(r_std), SAVE :: nbre_precip
110	!$OMP THREADPRIVATE(nbre_precip)
111	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: flx_co2_bbg_year !! CO2 emissions from biomass burning
112	!! Read in an input file (kgC.m^{-2}.year^{-1})
113	!$OMP THREADPRIVATE(flx_co2_bbg_year)
114	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: N_qt_WRICE_year !! N fertilizers applied on wetland rice
115	!! Read in an input file (kgN.yr^{-1})
116	!$OMP THREADPRIVATE(N_qt_WRICE_year)
117	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: N_qt_OTHER_year !! N fertilizers applied on other crops and grasses
118	!! Read in an input file (kgN.yr^{-1})
119	!$OMP THREADPRIVATE(N_qt_OTHER_year)
120	LOGICAL, SAVE :: l_first_chemistry_inca=.TRUE. !! Initialisation for chemistry_flux_interface
121	!$OMP THREADPRIVATE(l_first_chemistry_inca)
122
123
124
125	CONTAINS
126
127	!! ================================================================================================================================
128	!! SUBROUTINE : chemistry_initialize
129	!!
130	!>\BRIEF This subroutine initializes the chemistry module
131	!!
132	!! DESCRIPTION : Some of the variables and flags used chemistry_bvoc are allocated and initialised here.
133	!!
134	!! RECENT CHANGE(S): Changed name from diffuco_inca_init to chemistry_initialize
135	!!
136	!! MAIN OUTPUT VARIABLE(S): None
137	!!
138	!! REFERENCE(S) : None
139	!!
140	!! FLOWCHART : None
141	!_ ================================================================================================================================
142	SUBROUTINE chemistry_initialize(kjpindex, lalo, neighbours, resolution)
143
144	USE interpweight
145
146	IMPLICIT NONE
147
148	!! 0. Variables and parameter declaration
149
150	!! 0.1 Input variables
151
152	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size (unitless)
153	REAL(r_std), DIMENSION(kjpindex,2), INTENT (in) :: lalo !! Geographical coordinates
154	INTEGER(i_std), DIMENSION(kjpindex,8), INTENT (in) :: neighbours !! Vector of neighbours for each
155	!! grid point (1=N, 2=E, 3=S, 4=W)
156	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: resolution !! The size in km of each grid-box in X and Y
157
158	!! 0.2 Output variables
159	REAL(r_std), DIMENSION(kjpindex) :: achem_wrice !! Availability of data for the interpolation
160	REAL(r_std), DIMENSION(kjpindex) :: achem_other !! Availability of data for the interpolation
161	REAL(r_std), DIMENSION(kjpindex) :: achem_co2 !! Availability of data for the interpolation
162
163	!! 0.3 Modified variables
164
165	!! 0.4 Local variables
166	LOGICAL :: allow_weathergen
167	CHARACTER(LEN=80) :: filename, fieldname
168	INTEGER(i_std) :: iml, jml, lml, tml, force_id
169	INTEGER(i_std) :: ier
170	REAL(r_std) :: vmin, vmax !! min/max values to use for the
171	!! renormalization
172	CHARACTER(LEN=250) :: maskvname !! Variable to read the mask from
173	!! the file
174	CHARACTER(LEN=80) :: lonname, latname !! lon, lat names in input file
175	REAL(r_std), DIMENSION(:), ALLOCATABLE :: variabletypevals !! Values for all the types of the variable
176	!! (variabletypevals(1) = -un, not used)
177	CHARACTER(LEN=50) :: fractype !! method of calculation of fraction
178	!! 'XYKindTime': Input values are kinds
179	!! of something with a temporal
180	!! evolution on the dx*dy matrix'
181	LOGICAL :: nonegative !! whether negative values should be removed
182	CHARACTER(LEN=50) :: maskingtype !! Type of masking
183	!! 'nomask': no-mask is applied
184	!! 'mbelow': take values below maskvals(1)
185	!! 'mabove': take values above maskvals(1)
186	!! 'msumrange': take values within 2 ranges;
187	!! maskvals(2) <= SUM(vals(k)) <= maskvals(1)
188	!! maskvals(1) < SUM(vals(k)) <= maskvals(3)
189	!! (normalized by maskvals(3))
190	!! 'var': mask values are taken from a
191	!! variable inside the file (>0)
192	REAL(r_std), DIMENSION(3) :: maskvals !! values to use to mask (according to
193	!! `maskingtype')
194	CHARACTER(LEN=250) :: namemaskvar !! name of the variable to use to mask
195	REAL(r_std) :: chem_norefinf !! No value
196	REAL(r_std) :: chem_default !! Default value
197
198	!_ ================================================================================================================================
199
200	ALLOCATE (pulse(kjpindex),stat=ier)
201	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable pulse','','')
202	pulse(:) = un
203
204	! If we acount for NOx pulse emissions
205	IF (ok_pulse_NOx) THEN
206
207	ALLOCATE (ok_siesta(kjpindex),stat=ier)
208	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable ok_siesta','','')
209	ok_siesta(:) = .FALSE.
210
211	ALLOCATE (allow_pulse(kjpindex),stat=ier)
212	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable allow_pulse','','')
213	allow_pulse(:) = .FALSE.
214
215	ALLOCATE (pulseday(kjpindex),stat=ier)
216	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable pulseday','','')
217	pulseday(:) = zero
218
219	ALLOCATE (siestaday(kjpindex),stat=ier)
220	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable siestaday','','')
221	siestaday(:) = zero
222
223	ALLOCATE (pulselim(kjpindex),stat=ier)
224	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable pulselim','','')
225	pulselim(:) = zero
226
227	ALLOCATE (siestalim(kjpindex),stat=ier)
228	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable siestalim','','')
229	siestalim(:) = zero
230
231	END IF ! (ok_pulse_NOx)
232
233	! If we acount for NOx emissions by N-fertilizers
234	IF (ok_cropsfertil_NOx) THEN
235
236	ALLOCATE (area2(kjpindex),stat=ier)
237	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable area2','','')
238	area2(:) = resolution(:,1)*resolution(:,2)
239
240	ALLOCATE (N_qt_WRICE_year(kjpindex),stat=ier) !! N fertilizers on wetland rice, read in file
241	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable N_qt_WRICE_year','','')
242	N_qt_WRICE_year(:) = zero
243
244	ALLOCATE (N_qt_OTHER_year(kjpindex),stat=ier) !! N fertilizers on other crops and grasses, read in file
245	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable N_qt_OTHER_year','','')
246	N_qt_OTHER_year(:) = zero
247
248	WRITE (numout,) ' ********************** Interpolating N fertilizers files for NOx emissions... '
249
250	!Config Key = N_FERTIL_FILE
251	!Config Desc = File name
252	!Config If = CHEMISTRY_BVOC and NOx_FERTILIZERS_USE
253	!Config Def = orchidee_fertilizer_1995.nc
254	!Config Help =
255	!Config Units = -
256	filename = 'orchidee_fertilizer_1995.nc'
257	CALL getin_p('N_FERTIL_FILE',filename)
258
259	!! Variables for interpweight
260	vmin = 0.
261	vmax = 0.
262	! Type of calculation of cell fractions
263	fractype = 'default'
264	! Name of the longitude and latitude in the input file
265	lonname = 'lon'
266	latname = 'lat'
267	! Default value when no value is get from input file
268	chem_default = 0.
269	! Reference value when no value is get from input file
270	chem_norefinf = 0.
271	! Should negative values be set to zero from input file?
272	nonegative = .TRUE.
273	! Type of mask to apply to the input data (see header for more details)
274	maskingtype = 'nomask'
275	! Values to use for the masking
276	maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
277	! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
278	namemaskvar = ''
279
280	fieldname= 'N_qt_WRICE_year'
281	CALL interpweight_2Dcont(kjpindex, 0, 0, lalo, resolution, neighbours, &
282	contfrac, filename, fieldname, lonname, latname, vmin, vmax, nonegative, maskingtype, &
283	maskvals, namemaskvar, -1, fractype, chem_default, chem_norefinf, &
284	N_qt_WRICE_year, achem_wrice)
285
286	fieldname= 'N_qt_OTHER_year'
287	CALL interpweight_2Dcont(kjpindex, 0, 0, lalo, resolution, neighbours, &
288	contfrac, filename, fieldname, lonname, latname, vmin, vmax, nonegative, maskingtype, &
289	maskvals, namemaskvar, -1, fractype, chem_default, chem_norefinf, &
290	N_qt_OTHER_year, achem_other)
291
292	END IF
293
294	ALLOCATE (flx_iso(kjpindex,nvm), stat=ier)
295	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_iso','','')
296	flx_iso(:,:) = 0.
297
298	ALLOCATE (flx_mono(kjpindex,nvm), stat=ier)
299	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_mono','','')
300	flx_mono(:,:) = 0.
301
302	ALLOCATE (flx_ORVOC(kjpindex,nvm), stat=ier)
303	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_ORVOC ','','')
304	flx_ORVOC(:,:) = 0.
305
306	ALLOCATE (flx_MBO(kjpindex,nvm), stat=ier)
307	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_MBO','','')
308	flx_MBO(:,:) = 0.
309
310	ALLOCATE (flx_methanol(kjpindex,nvm), stat=ier)
311	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_methanol','','')
312	flx_methanol(:,:) = 0.
313
314	ALLOCATE (flx_acetone(kjpindex,nvm), stat=ier)
315	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_acetone','','')
316	flx_acetone(:,:) = 0.
317
318	ALLOCATE (flx_acetal(kjpindex,nvm), stat=ier)
319	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_acetal','','')
320	flx_acetal(:,:) = 0.
321
322	ALLOCATE (flx_formal(kjpindex,nvm), stat=ier)
323	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_formal','','')
324	flx_formal(:,:) = 0.
325
326	ALLOCATE (flx_acetic(kjpindex,nvm), stat=ier)
327	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_acetic','','')
328	flx_acetic(:,:) = 0.
329
330	ALLOCATE (flx_formic(kjpindex,nvm), stat=ier)
331	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_formic','','')
332	flx_formic(:,:) = 0.
333
334	ALLOCATE (flx_no_soil(kjpindex,nvm), stat=ier)
335	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_no_soil','','')
336	flx_no_soil(:,:) = 0.
337
338	ALLOCATE (flx_no(kjpindex,nvm), stat=ier)
339	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_no','','')
340	flx_no(:,:) = 0.
341
342	ALLOCATE (flx_fertil_no(kjpindex,nvm), stat=ier)
343	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_fertil_no','','')
344	flx_fertil_no(:,:) = 0.
345
346	ALLOCATE (flx_apinen(kjpindex,nvm), stat=ier)
347	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_apinen','','')
348	flx_apinen(:,:) = 0.
349
350	ALLOCATE (flx_bpinen (kjpindex,nvm), stat=ier)
351	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_bpinen','','')
352	flx_bpinen(:,:) = 0.
353
354	ALLOCATE (flx_limonen (kjpindex,nvm), stat=ier)
355	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_limonen','','')
356	flx_limonen(:,:) = 0.
357
358	ALLOCATE (flx_myrcen(kjpindex,nvm), stat=ier)
359	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_myrcen','','')
360	flx_myrcen(:,:) = 0.
361
362	ALLOCATE (flx_sabinen(kjpindex,nvm), stat=ier)
363	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_sabinen','','')
364	flx_sabinen(:,:) = 0.
365
366	ALLOCATE (flx_camphen(kjpindex,nvm), stat=ier)
367	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_camphen','','')
368	flx_camphen(:,:) = 0.
369
370	ALLOCATE (flx_3caren(kjpindex,nvm), stat=ier)
371	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_3caren','','')
372	flx_3caren(:,:) = 0.
373
374	ALLOCATE (flx_tbocimen(kjpindex,nvm), stat=ier)
375	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_tbocimen','','')
376	flx_tbocimen(:,:) = 0.
377
378	ALLOCATE (flx_othermono(kjpindex,nvm), stat=ier)
379	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_othermono','','')
380	flx_othermono(:,:) = 0.
381
382	ALLOCATE (flx_sesquiter(kjpindex,nvm), stat=ier)
383	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_sesquiter','','')
384	flx_sesquiter(:,:) = 0.
385
386	ALLOCATE(CRF(kjpindex,nvm), stat=ier)
387	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable CRF ','','')
388	CRF(:,:) = 0.
389
390
391	! If we acount for NOx emissions due to Biomass Burning
392	IF (ok_bbgfertil_NOx) THEN
393
394	ALLOCATE (flx_co2_bbg_year(kjpindex),stat=ier) !! CO2 emissions from bbg, read in file
395	IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable flx_co2_bbg_year','','')
396	flx_co2_bbg_year(:) = zero
397
398	WRITE (numout,) ' ********************** Interpolating CO2 bbg files for NOx emissions... '
399	!Config Key = N_FERTIL_FILE
400	!Config Desc = File name
401	!Config If = CHEMISTRY_BVOC and NOx_FERTILIZERS_USE
402	!Config Def = orchidee_fertilizer_1995.nc
403	!Config Help = ...
404	!Config Units = -
405	filename = 'orchidee_bbg_clim.nc'
406	CALL getin_p('CO2_BBG_FILE',filename)
407
408	!! Variables for interpweight
409	vmin = 0.
410	vmax = 0.
411	! Type of calculation of cell fractions
412	fractype = 'default'
413	! Name of the longitude and latitude in the input file
414	lonname = 'lon'
415	latname = 'lat'
416	! Default value when no value is get from input file
417	chem_default = 0.
418	! Reference value when no value is get from input file
419	chem_norefinf = 0.
420	! Should negative values be set to zero from input file?
421	nonegative = .TRUE.
422	! Type of mask to apply to the input data (see header for more details)
423	maskingtype = 'nomask'
424	! Values to use for the masking
425	maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
426	! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
427	namemaskvar = ''
428
429	fieldname = 'flx_co2_bbg_year'
430	CALL interpweight_2Dcont(kjpindex, 0, 0, lalo, resolution, neighbours, &
431	contfrac, filename, fieldname, lonname, latname, vmin, vmax, nonegative, maskingtype, &
432	maskvals, namemaskvar, -1, fractype, chem_default, chem_norefinf, &
433	flx_co2_bbg_year, achem_co2)
434	END IF
435
436	IF ( OFF_LINE_MODE ) THEN
437
438	!-
439	!- What are the alowed options for the temporal interpolation
440	!-
441	! ALLOW_WEATHERGEN : Allow weather generator to create data
442	! This parameter is already read in the driver
443	allow_weathergen = .FALSE.
444	CALL getin_p('ALLOW_WEATHERGEN',allow_weathergen)
445
446	! FORCING_FILE : Name of file containing the forcing data
447	! This parameter is already read in the driver
448	filename='forcing_file.nc'
449	CALL getin_p('FORCING_FILE',filename)
450	CALL flininfo(filename,iml, jml, lml, tml, force_id)
451	WRITE(numout,*) 'Number of data per year in forcing file :', tml
452	CALL flinclo(force_id)
453	WRITE(numout,*) 'Forcing file closed in chemistry_initialize'
454
455
456	IF ( allow_weathergen ) THEN
457	WRITE(numout,) '*chemistry_initialize: Using weather generator, careful to precip division for NOx '
458	nbre_precip = un
459	WRITE(numout,*) 'Division pour les precip, NOx:', nbre_precip
460	ELSE
461	WRITE(numout,*) 'DT_SECHIBA :', dt_sechiba
462	nbre_precip = (one_day/dt_sechiba)/(tml/one_year)
463	WRITE(numout,*) 'Division pour les precip, NOx:', nbre_precip
464	END IF
465
466	ELSE ! (in coupled mode)
467
468	nbre_precip = un
469
470	END IF ! (OFF_LINE_MODE)
471
472	! Write diagnostics
473	IF (ok_cropsfertil_NOx) THEN
474	CALL xios_orchidee_send_field("achem_wrice",achem_wrice)
475	CALL xios_orchidee_send_field("achem_other",achem_other)
476	END IF
477	IF (ok_bbgfertil_NOx) THEN
478	CALL xios_orchidee_send_field("achem_co2",achem_co2)
479	END IF
480
481
482	END SUBROUTINE chemistry_initialize
483
484
485	!! ================================================================================================================================
486	!! SUBROUTINE : chemistry_bvoc
487	!!
488	!>\BRIEF This subroutine computes biogenic emissions of reactive compounds, that is of
489	!! VOCs (volatile organic compounds) from vegetation and NOx (nitrogen oxides) from soils.
490	!! Calculation are mostly based on the works by Guenther et al. (1995) and Yienger and Levy (1995).\n
491	!!
492	!! DESCRIPTION : Biogenic VOC emissions from vegetation are based on the parameterisations developped by
493	!! Guenther et al. (1995). Biogenic VOCs considered here are: isoprene, monoterpenes, OVOC and ORVOC
494	!! as bulked emissions, methanol, acetone, acetaldehyde, formaldehyde, acetic acid, formic acid
495	!! as single emissions.\n
496	!! For every biogenic VOCs an emission factor (EF), depending on the PFT considered, is used.\n
497	!! Isoprene emissions depend on temperature and radiation. A partition between sunlit and shaded
498	!! leaves is taken into account and either one (if ok_multilayer = FALSE) or several layers
499	!! (if ok_multilayer = TRUE) in the canopy can be used.\n
500	!! When radiation extinction is considered, the canopy radiative transfer model takes into
501	!! account light extinction through canopy, calculating first need diffuse and direct radiation
502	!! based on Andrew Friend 2001 radiative model and Spitters et al. 1986. The calculation of lai,
503	!! parscat, parsh and parsun, laisun and laishabsed based on Guenther et al.(JGR, 1995) and Norman (1982).\n
504	!! Emissions for other BVOCs (monoterpenes, OVOC, ORVOC and other single compounds such as
505	!! methanol, acetone...) depend only on temperature.\n
506	!! The impact of leaf age, using an emission activity prescribed for each of the 4 leaf age
507	!! classes can also be considered for isoprene and methanol emissions when ok_leafage = TRUE.\n
508	!! NOx emissions from soils are based on Yienger and Levy (1995) and depend on soil moisture
509	!! and temperature and PFT. The pulse effect, related to significant rain occuring after severe
510	!! drought can also be considered (ok_pulse_NOx = TRUE), as well as the increase in emissions related to
511	!! biomass buring (ok_bbgfertil_NOx = TRUE) or use of fertilizers (ok_cropsfertil_NOx = TRUE).
512	!! A net NO flux is eventually calculated taking into account loss by deposition on the surface, using
513	!! a Canopy Reduction Factor (CRF) based on stomatal and leaf area.\n
514	!! This subroutine is called by diffuco_main only if biogenic emissions are activated
515	!! for sechiba (flag CHEMISTRY_BVOC=TRUE).\n
516	!!
517	!! RECENT CHANGE(S): Changed name from diffuco_inca to chemistry_bvoc
518	!!
519	!! MAIN OUTPUT VARIABLE(S): :: PAR, :: PARsun, :: PARsh, :: laisun, :: laish,
520	!! :: flx_iso, :: flx_mono, :: flx_ORVOC, :: flx_MBO,
521	!! :: flx_methanol, :: flx_acetone, :: flx_acetal, :: flx_formal,
522	!! :: flx_acetic, :: flx_formic, :: flx_no_soil, :: flx_no,
523	!! :: CRF, :: flx_fertil_no, :: Trans, :: Fdf,
524	!! :: PARdf, :: PARdr, :: PARsuntab, :: PARshtab
525	!!
526	!! REFERENCE(S) :
527	!! - Andrew Friend (2001), Modelling canopy CO2 fluxes: are 'big-leaf' simplifications justified?
528	!! Global Ecology and Biogeography, 10, 6, 603-619, doi: 10.1046/j.1466-822x.2001.00268.x
529	!! - Spitters, C.J.T, Toussaint, H.A.J.M, Groudriaan, J. (1986), Separating the diffuse and direct
530	!! component of global radiation and its implications for modeling canopy photosynthesis, Agricultural
531	!! and Forest Meteorology, 38, 1-3, 217-229, doi:10.1016/0168-1923(86)90060-2
532	!! - Norman JM (1982) Simulation of microclimates. In: Hatfield JL, Thomason IJ (eds)
533	!! Biometeorology in integrated pest management. Academic, New York, pp 65â99
534	!! - Guenther, A., Hewitt, C. N., Erickson, D., Fall, R., Geron, C., Graedel, T., Harley, P.,
535	!! Klinger, L., Lerdau, M., McKay, W. A., Pierce, T., Scholes, B., Steinbrecher, R., Tallamraju,
536	!! R., Taylor, J. et Zimmerman, P. (1995), A global model of natural volatile organic compound
537	!! emissions, J. Geophys. Res., 100, 8873-8892.
538	!! - MacDonald, R. et Fall, R. (1993), Detection of substantial emissions of methanol from
539	!! plants to the atmosphere, Atmos. Environ., 27A, 1709-1713.
540	!! - Guenther, A., Geron, C., Pierce, T., Lamb, B., Harley, P. et Fall, R. (2000), Natural emissions
541	!! of non-methane volatile organic compounds, carbon monoxide, and oxides of nitrogen from
542	!! North America, Atmos. Environ., 34, 2205-2230.
543	!! - Yienger, J. J. et Levy II, H. (1995), Empirical model of global soil-biogenic NOx emissions,
544	!! J. Geophys. Res., 100, 11,447-11,464.
545	!! - Lathiere, J., D.A. Hauglustaine, A. Friend, N. De Noblet-Ducoudre, N. Viovy, and
546	!! G. Folberth (2006), Impact of climate variability and land use changes on global biogenic volatile
547	!! organic compound emissions, Atmospheric Chemistry and Physics, 6, 2129-2146.
548	!! - Lathiere, J., D.A. Hauglustaine, N. De Noblet-Ducoudre, G. Krinner et G.A. Folberth (2005),
549	!! Past and future changes in biogenic volatile organic compound emissions simulated with a global
550	!! dynamic vegetation model, Geophysical Research Letters, 32, doi: 10.1029/2005GL024164.
551	!! - Lathiere, J. (2005), Evolution des emissions de composes organiques et azotes par la biosphere
552	!! continentale dans le modele LMDz-INCA-ORCHIDEE, These de doctorat, Universite Paris VI.
553	!!
554	!! FLOWCHART : None
555	!_ ================================================================================================================================
556
557	SUBROUTINE chemistry_bvoc (kjpindex, swdown, coszang, temp_air, &
558	temp_sol, ptnlev1, precip_rain, humrel, veget_max, lai, &
559	frac_age, lalo, ccanopy, cim, wind, snow, &
560	veget, hist_id, hist2_id,kjit, index, &
561	indexlai, indexveg)
562
563	!! 0. Variables and parameter declaration
564
565	!! 0.1 Input variables
566
567	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size - terrestrial pixels only (unitless)
568	INTEGER(i_std), INTENT(in) :: kjit !! Time step number (-)
569	INTEGER(i_std),INTENT (in) :: hist_id !! History file identifier (-)
570	INTEGER(i_std),INTENT (in) :: hist2_id !! History file 2 identifier (-)
571	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map (-)
572	INTEGER(i_std),DIMENSION (kjpindex*(nlai+1)), INTENT (in) :: indexlai !! Indeces of the points on the 3D map
573	INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in) :: indexveg !! Indeces of the points on the 3D map (-)
574	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: swdown !! Down-welling surface short-wave flux
575	!! (W.m^{-2})
576	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: coszang !! Cosine of the solar zenith angle (unitless)
577	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: temp_air !! Air temperature (K)
578	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: temp_sol !! Skin temperature (K)
579	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: ptnlev1 !! 1st level of soil temperature (K)
580	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: precip_rain !! Rain precipitation !!?? init
581	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: humrel !! Soil moisture stress (0-1, unitless)
582	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: veget_max !! Max. vegetation fraction (0-1, unitless)
583	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow !! Snow mass (kg)
584	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget !! Fraction of vegetation type (-)
585	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: lai !! Leaf area index (m^2.m^{-2})
586	REAL(r_std), DIMENSION(kjpindex,nvm,nleafages), INTENT(in) :: frac_age !! Age efficacity from STOMATE for iso
587	REAL(r_std), DIMENSION(kjpindex,2), INTENT(in) :: lalo !! Geographical coordinates for pixels (degrees)
588	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: ccanopy !! CO2 concentration inside the canopy
589	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: cim !! Intercellular CO2 over nlai
590	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: wind !! Wind module (m s^{-1})
591
592	!! 0.2 Output variables
593
594	!! 0.3 Modified variables
595
596	!! 0.4 Local variables
597
598	INTEGER(i_std) :: ji, jv, jf, jl !! Indices (unitless)
599	REAL(r_std), DIMENSION(kjpindex,nvm) :: fol_dens !! foliar density (gDM.m^{-2})
600	REAL(r_std), DIMENSION(kjpindex) :: tleaf !! Foliar temperature (K)
601	REAL(r_std), DIMENSION(kjpindex) :: t_no !! Temperature used for soil NO emissions (C)
602	REAL(r_std), DIMENSION(kjpindex) :: exp_1 !! First exponential used in the calculation of
603	!! isoprene dependancy to Temperature
604	REAL(r_std), DIMENSION(kjpindex) :: exp_2 !! Second exponential used in the calculation of
605	!! Isoprene dependancy to Temperature
606	REAL(r_std), DIMENSION(kjpindex) :: Ct_iso !! Isoprene dependancy to Temperature
607	REAL(r_std), DIMENSION(kjpindex) :: Cl_iso !! Isoprene dependancy to Light
608	REAL(r_std), DIMENSION(kjpindex) :: Ct_mono !! Monoterpene dependancy to Temperature
609	REAL(r_std), DIMENSION(kjpindex) :: Ct_sesq !! Sesquiterpenes dependancy to Temperature
610	REAL(r_std), DIMENSION(kjpindex) :: Ct_meth !! Methanol dependancy to Temperature
611	REAL(r_std), DIMENSION(kjpindex) :: Ct_acet !! Acetone dependancy to Temperature
612	REAL(r_std), DIMENSION(kjpindex) :: Ct_oxyVOC !! Other oxygenated BVOC dependancy to Temperature
613	REAL(r_std) :: GAMMA_iso !! Temperature and light dependancy for isoprene and fo each PFT
614	REAL(r_std) :: GAMMA_iso_m !! Temperature and light dependancy for isoprene and fo each PFT for multilayer
615	REAL(r_std), DIMENSION(kjpindex) :: Ylt_mono !! Total Temperature and light dependancy for monoterpenes
616	REAL(r_std), DIMENSION(kjpindex) :: Ylt_sesq !! Total Temperature and light dependancy for sesquiterpens
617	REAL(r_std), DIMENSION(kjpindex) :: Ylt_meth !! Total Temperature and light dependancy for methanol
618	REAL(r_std), DIMENSION(kjpindex) :: Ylt_acet !! Total Temperature and light dependancy for acetone
619	REAL(r_std), DIMENSION(kjpindex) :: Ct_MBO !! MBO dependance to Temperature
620	REAL(r_std), DIMENSION(kjpindex) :: Cl_MBO !! MBO dependance to Light
621	REAL(r_std), DIMENSION(kjpindex) :: Xvar !! Parameter used in the calculation
622	!! of MBO dependance to Temperature
623	REAL(r_std), DIMENSION(kjpindex,nvm) :: flx_OVOC !! Biogenic OVOC emission -
624	!! Other Volatil Organic Components (kgC.m^{-2}.s^{-1})
625	!!Canopy radiative transfer model
626	REAL(r_std) :: day !! Day of The Year
627	REAL(r_std), DIMENSION(kjpindex) :: So !! Maximum radiation at the Earth surface (W.m^{-2})
628	REAL(r_std), DIMENSION(kjpindex) :: Rfrac !! Parameter in the regression of diffuse
629	!! share on transmission
630	REAL(r_std), DIMENSION(kjpindex) :: Kfrac !! Parameter in the regression of diffuse
631	!! share on transmission
632	REAL(r_std), DIMENSION(kjpindex) :: swdf !! Sw diffuse radiation (W.m^{-2})
633	REAL(r_std), DIMENSION(kjpindex) :: swdr !! Sw direct radiation (W.m^{-2})
634	REAL(r_std), DIMENSION(kjpindex,nvm) :: PARscat !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
635	REAL(r_std), DIMENSION(kjpindex,nvm) :: Clsun_iso !! Isoprene dependance to light for sun leaves
636	REAL(r_std), DIMENSION(kjpindex,nvm) :: Clsh_iso !! Isoprene dependance to light for shaded leaves
637	!! for multilayer canopy model for iso flux
638	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: PARscattab !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
639	REAL(r_std), DIMENSION(nlai+1) :: laitab !! LAI per layer (m^2.m^{-2})
640	REAL(r_std), DIMENSION(kjpindex,nlai) :: laisuntabdep !! LAI of sun leaves in each layer (m^2.m^{-2})
641	REAL(r_std), DIMENSION(kjpindex,nlai) :: laishtabdep !! LAI of shaded leaves in each layer
642	!! (m^2.m^{-2})
643	REAL(r_std) :: Clsun_iso_tab !! Isoprene dependance to light
644	!! for sun leaves and per layer
645	REAL(r_std) :: Clsh_iso_tab !! Isoprene dependance to light
646	!! for shaded leaves and per layer
647	!for multilayer canopy model Spitter et al. 1986
648	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: PARnotscat !! Not-Scattered PAR
649	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: PARabsdir !! Absorbed light of the PAR direct flux
650	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: PARabsdiff !! Absorbed light of the PAR diffuse flux
651	REAL(r_std), PARAMETER :: sigma = 0.20 !! scattering coefficient of single leaves and for visible radiation
652	REAL(r_std), PARAMETER :: cluster = 0.85 !! clustering coefficient for leaves, the same that is setting for default in MEGAN V2.10
653	REAL(r_std) :: rho !! reflection index of a green, closed vegetation
654	REAL(r_std) :: kbl !! extinction coefficient of black leaves
655	REAL(r_std) :: kdf !! extinction coefficient of diffuse flux
656	!!Leaf age
657	REAL(r_std), DIMENSION(kjpindex,nvm) :: Eff_age_iso !! Isoprene emission dependance to Leaf Age
658	REAL(r_std), DIMENSION(kjpindex,nvm) :: Eff_age_meth !! Methanol emission dependance to Leaf Age
659	REAL(r_std), DIMENSION(kjpindex,nvm) :: Eff_age_VOC !! Other VOC emission dependance to Leaf Age
660	!!BBG and Fertilizers for NOx soil emission
661	REAL(r_std), DIMENSION(kjpindex) :: veget_max_nowoody !! sum of veget_max for non-woody PFT
662	REAL(r_std), DIMENSION(kjpindex,nvm) :: N_qt_WRICE_pft !! N fertiliser on RICE
663	!! (kgN per year per grid cell)
664	REAL(r_std), DIMENSION(kjpindex,nvm) :: N_qt_OTHER_pft !! N fertiliser on other veg
665	!! (kgN per year per grid cell)
666	!! CO2 inhibition effect on isoprene
667	REAL(r_std),DIMENSION (kjpindex,nvm) :: fco2_wshort !! Wilkinson short term function for CO2 impact on BVOC (isoprene)
668	REAL(r_std),DIMENSION (kjpindex) :: fco2_wlong !! Wilkinson long term function for CO2 impact on BVOC (isoprene)
669	REAL(r_std) :: fco2_ctrl
670	REAL(r_std),DIMENSION (kjpindex,nvm) :: fco2 !! Function for CO2 impact on BVOC (isoprene)
671	REAL(r_std), DIMENSION(kjpindex) :: Ismax_short
672	REAL(r_std), DIMENSION(kjpindex) :: h_short
673	REAL(r_std), DIMENSION(kjpindex) :: Cstar_short
674	REAL(r_std) :: Ismax_long
675	REAL(r_std) :: h_long
676	REAL(r_std) :: Cstar_long
677
678	!! 0.5 Parameters values
679
680	REAL(r_std), PARAMETER :: CT1 = 95000.0 !! Empirical coeffcient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
681	REAL(r_std), PARAMETER :: CT2 = 230000.0 !! Empirical coefficient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
682	REAL(r_std), PARAMETER :: TS = 303.0 !! Leaf temperature at standard condition
683	!! (see Guenther .et. al, 1995, eq(10)) (K)
684	REAL(r_std), PARAMETER :: TM = 314.0 !! Leaf temperature (see Guenther .et. al, 1995, eq(10)) (K)
685
686	REAL(r_std), PARAMETER :: alpha_ = 0.0027 !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
687	REAL(r_std), PARAMETER :: CL1 = 1.066 !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
688	REAL(r_std), PARAMETER :: beta = 0.09 !! Empirical coeffcient (see Guenther .et. al, 1995, eq(11)) (K^{-1})
689	REAL(r_std), PARAMETER :: lai_threshold = 11. !! Lai threshold for the calculation of scattered radiation
690	!! based on Guenther .et. al (1995) (m^2.m^{-2})
691
692
693	! Biogenic emissions
694	REAL(r_std),DIMENSION(kjpindex) :: PAR !! Photosynthetic active radiation, half of swdown
695	!! @tex ($\mu mol photons. m^{-2} s^{-1}$) @endtex
696	REAL(r_std),DIMENSION(kjpindex,nvm) :: PARsun !! PAR received by sun leaves
697	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
698	REAL(r_std),DIMENSION(kjpindex,nvm) :: PARsh !! PAR received by shaded leaves
699	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
700	REAL(r_std),DIMENSION(kjpindex,nvm) :: laisun !! Leaf area index of Sun leaves (m^2.m^{-2})
701	REAL(r_std),DIMENSION(kjpindex,nvm) :: laish !! Leaf area index of Shaded leaves (m^2.m^{-2})
702
703	CHARACTER(LEN=14) :: tleafsun_name !! To store variables names for I/O
704	CHARACTER(LEN=13) :: tleafsh_name !! To store variables names for I/O
705	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: Tleafsun_temp !! temporary sunlit leaf temperature matrix for writing
706	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: Tleafsh_temp !! temporary shade leaf temperature matrix for writing
707	REAL(r_std),DIMENSION(kjpindex) :: Fdf !! Fraction of the radiation which is diffused (0-1, unitless)
708	REAL(r_std),DIMENSION(kjpindex,nlai+1) :: PARsuntab !! PAR received by sun leaves over LAI layers
709	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
710	REAL(r_std),DIMENSION(kjpindex,nlai+1) :: PARshtab !! PAR received by shaded leaves over LAI layers
711	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
712	REAL(r_std),DIMENSION(kjpindex) :: PARdf !! Diffuse photosynthetic active radiation
713	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
714	REAL(r_std),DIMENSION(kjpindex) :: PARdr !! Direct photosynthetic active radiation
715	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
716	REAL(r_std),DIMENSION(kjpindex) :: Trans !! Atmospheric Transmissivity (unitless)
717
718	!_ ================================================================================================================================
719	fco2 = 0.
720	fco2_wshort = 0.
721	fco2_wlong = 0.
722	Fdf(:) = 0.
723	PAR(:) = 0.
724	PARsun(:,:) = 0.
725	PARsh(:,:) = 0.
726	laisun(:,:) = 0.
727	laish(:,:) = 0.
728	CRF(:,:) = 0.
729	Trans(:) = 0.
730	PARdf(:) = 0.
731	PARdr(:) = 0.
732	PARsuntab(:,:) = 0.
733	PARshtab(:,:) = 0.
734
735
736	!! 1. Canopy radiative transfer model
737
738	!! Canopy radiative transfer model: takes into account light extinction through canopy
739	!! First need to calculate diffuse and direct radiation
740	!! Based on Andrew Friend radiative model (Global Ecology & Biogeography, 2001)
741	!! And Spitters et al. (Agricultural and Forest Meteorology, 1986)
742
743	IF ( ok_radcanopy ) THEN
744
745	DO ji = 1, kjpindex
746	IF (coszang(ji) .GT. zero) THEN
747	day = julian_diff
748	!! 1.1 Extra-terrestrial solar irradiance at a plan parallel to Earh's surface
749	So(ji) = Sct( un + 0.033COS(360.pi/180.day/365.))*coszang(ji)
750	!! 1.2 Atmospheric transmissivity
751	Trans(ji) = swdown(ji)/So(ji)
752	!! 1.3 Empirical calculation of fraction diffuse from transmission based on Spitters et al. (1986)
753	Rfrac(ji) = 0.847 - 1.61coszang(ji) + 1.04(coszang(ji)**2.)
754	Kfrac(ji) = (1.47 - Rfrac(ji))/1.66
755	IF (Trans(ji) .LE. 0.22) THEN
756	Fdf(ji) = un
757	ELSE IF (Trans(ji) .LE. 0.35) THEN
758	Fdf(ji) = un - 6.4((Trans(ji) - 0.22)*2.)
759	ELSE IF (Trans(ji) .LE. Kfrac(ji)) THEN
760	Fdf(ji) = 1.47 - 1.66*Trans(ji)
761	ELSE
762	Fdf(ji) = Rfrac(ji)
763	END IF
764	!! 1.4 Direct and diffuse sw radiation in W.m^{-2}
765	swdf(ji) = swdown(ji)*Fdf(ji)
766	swdr(ji) = swdown(ji)*(un-Fdf(ji))
767	ELSE
768	swdf(ji) = zero
769	swdr(ji) = zero
770	END IF
771
772	!! 1.5 PAR diffuse and direct in umol/m^2/s
773	PARdf(ji) = swdf(ji) * W_to_mol * RG_to_PAR
774	PARdr(ji) = swdr(ji) * W_to_mol * RG_to_PAR
775	END DO
776
777	!! 1.6 Calculation of lai, parscat, parsh and parsun, laisun and laish !!?? define the terms
778	!! Based on Guenther et al. (JGR, 1995) and Norman (1982)
779	! One-layer canopy model or multi-layer canopy model
780	IF (ok_multilayer) THEN
781
782
783	! Calculation PER LAYER
784	DO jl = nlai+1, 1, -1
785	laitab(jl) = laimax(EXP(lai_level_depth(jl-1) - un)/(EXP(lai_level_depth*nlai) - un))
786
787	!introduction of the Spitter way to calculate radiation over the levels !!!!!!!
788	DO ji = 1, kjpindex
789	kdf = cluster0.8SQRT((1 - sigma))
790	IF (ABS(ACOS(coszang(ji))) .LT. pi/2. .AND. coszang(ji) .NE. zero) THEN
791	! Coefficients calculation:
792	kbl = cluster*0.5/ABS(coszang(ji))
793	rho = ((1-SQRT((1 - sigma)))/(1+SQRT((1 - sigma))))(2/(1+1.6ABS(coszang(ji))))
794
795	PARnotscat(ji,jl) = (1 - sigma)PARdr(ji)kblEXP(-SQRT((1 - sigma))kbl*laitab(jl))
796	PARabsdir(ji,jl) = (1 - rho)SQRT((1 - sigma))PARdr(ji)kblEXP(-SQRT((1 - sigma))kbllaitab(jl))
797	PARabsdiff(ji,jl) = (1 - rho)PARdf(ji)kdfEXP(-kdflaitab(jl))
798	PARshtab(ji,jl) = (PARabsdiff(ji,jl) + (PARabsdir(ji,jl) - PARnotscat(ji,jl)))/(1 - sigma)
799	PARsuntab(ji,jl) = PARshtab(ji,jl) + (1-sigma)kblPARdr(ji)/(1 - sigma)
800
801	!correction using the equation (4) in Bodin et al 2012 and (7) or (8) in Spitter et al 1986
802	!using the extinction coefficient kbl = 0.5/coszang and not only 0.5
803	IF (jl .NE. nlai+1) THEN
804	laisuntabdep(ji,jl) =(laitab(jl+1)-laitab(jl))EXP(-kbllaitab(jl))
805	laishtabdep(ji,jl) =(laitab(jl+1)-laitab(jl))(1.-EXP(-kbllaitab(jl)))
806	ENDIF
807
808	ELSE
809
810	PARshtab(ji,jl) = PARdf(ji)kdfEXP(-kdf*laitab(jl))
811	PARsuntab(ji,jl) = 0.
812
813	IF (jl .NE. nlai+1) THEN
814	laisuntabdep(ji,jl) = 0.
815	laishtabdep(ji,jl) = laitab(jl+1)-laitab(jl)
816
817	ENDIF
818	END IF
819	END DO
820	END DO
821
822
823
824	! introduction of the Spitter way to calculate radiation over the levels !!!!!!!
825	ELSE
826	! Calculation FOR one layer
827	DO jv = 1, nvm
828	DO ji = 1, kjpindex
829	IF (lai(ji,jv) .LE. lai_threshold) THEN
830	PARscat(ji,jv) = 0.07PARdr(ji)(1.1 - 0.1lai(ji,jv))exp(-coszang(ji))
831	ELSE
832	PARscat(ji,jv) = zero
833	END IF
834
835	IF (coszang(ji) .NE. zero ) THEN
836	PARsh(ji,jv) = PARdf(ji)exp(-0.5((lai(ji,jv))**0.7)) + PARscat(ji,jv)
837	PARsun(ji,jv) = PARdr(ji)COS(60.pi/180.)/coszang(ji) + PARsh(ji,jv)
838	ELSE
839	PARsh(ji,jv) = PARdf(ji)exp(-0.5(lai(ji,jv)**0.7)) + PARscat(ji,jv)
840	PARsun(ji,jv) = zero
841	END IF
842	IF (ABS(ACOS(coszang(ji))) .LT. pi/2. .AND. coszang(ji) .NE. zero) THEN
843	! calculation as in Lathiere (2005) = with correction removing lai in Guenther (1995)
844	laisun(ji,jv) = (un - exp(-0.5lai(ji,jv)/(coszang(ji))))coszang(ji)/COS(60.*pi/180.)
845	laish(ji,jv) = lai(ji,jv) - laisun(ji,jv)
846	ELSE
847	laisun(ji,jv) = zero
848	laish(ji,jv) = lai(ji,jv)
849	END IF
850	END DO
851	END DO
852	ENDIF
853	END IF
854
855
856	!! 2. Calculation of non-PFT dependant parameters used for VOC emissions
857	DO ji = 1, kjpindex ! (loop over # pixels)
858	!! 2.1 Calculation of Tleaf (based on Lathiere, 2005)
859
860
861	tleaf(ji) = temp_air(ji)
862
863	!! 2.2 Isoprene emission dependency - with no PARsun/PARshaded partitioning - Guenther et al. (1995) and Lathiere (2005)
864	!> @codeinc $$?? ecrire les equation en latex ?
865	exp_1(ji) = exp( (CT1 * ( tleaf(ji) - TS )) / (RRTStleaf(ji)) )
866	exp_2(ji) = exp( (CT2 ( tleaf(ji) - TM )) / (RRTS*tleaf(ji)) )
867	PAR(ji) = swdown(ji) * W_to_mol * RG_to_PAR ! from W/m^2 to umol photons/m^2/s and half of sw for PAR
868	Ct_iso(ji) = exp_1(ji)/(un + exp_2(ji)) ! temperature dependance
869	Cl_iso(ji) = alpha_CL1PAR(ji)/sqrt(un + (alpha_*2) (PAR(ji)**2) ) ! light dependance
870	!> @endcodeinc
871
872	!! 2.3 Monoterpene and oxy VOB emission dependency to Temperature
873	!! light independant fraction
874	!> @codeinc
875	!Ct_mono(ji) = exp(beta*(tleaf(ji) - TS)) ! Old method
876	Ct_mono(ji) = exp(beta_mono*(tleaf(ji) - TS))
877	Ct_sesq(ji) = exp(beta_sesq*(tleaf(ji) - TS))
878	Ct_meth(ji) = exp(beta_meth*(tleaf(ji) - TS))
879	Ct_acet(ji) = exp(beta_acet*(tleaf(ji) - TS))
880	Ct_oxyVOC(ji) = exp(beta_oxyVOC*(tleaf(ji) - TS))
881	!> @endcodeinc
882	!! 2.4 MBO biogenic emissions dependency, only from PFT7 and PFT4 for location of vegetation emitter
883	! but in fact MBO fluxes only in America (ponderosa and lodgepole pines only found in these areas)
884	!> @codeinc
885	Xvar(ji) = ((un/312.3) - (un/tleaf(ji)))/RR
886	!> @endcodeinc
887	!! 2.4.1 temperature dependency
888	!> @codeinc
889	Ct_MBO(ji) = (1.52209000.0exp(67000.0Xvar(ji)))/(209000.0 - 67000.0(un - exp(209000.0*Xvar(ji))))
890	!> @endcodeinc
891	!! 2.4.2 light dependency
892	Cl_MBO(ji) = (0.00111.44PAR(ji))/(sqrt(un + (0.0011*2)(PAR(ji)**2)))
893	!! 2.5 NO biogenic emissions given in ngN/m^2/s, emission factor in ngN/m^2/s too
894	!! calculation of temperature used for NO soil emissions
895	t_no(ji) = ptnlev1(ji) - ZeroCelsius !!temp must be in celsius to calculate no emissions
896	!! 2.6 calculation of non-woody veget_max fraction
897	IF (ok_cropsfertil_NOx) THEN
898	veget_max_nowoody(ji) = zero
899	DO jv = 1,nvm
900	IF ( (jv /= ibare_sechiba) .AND. .NOT.(is_tree(jv)) ) THEN
901	veget_max_nowoody(ji) = veget_max_nowoody(ji) + veget_max(ji,jv)
902	ENDIF
903	ENDDO
904	END IF
905	END DO ! (loop over # pixels)
906
907	!! 2bis. Calculation of CO2 function for inhibition effect on isoprene
908	! 2 approaches can be used: either Possell et al. (2005) or Wilkinson et al. (2006)
909
910	!! 19/04/2010 and then implemented in version revised by Nicolas Vuichard, 08042014
911	!! Impact of atmospheric CO2 on isoprene emissions
912	!! Can be activated or not
913	!! If considered, can use either Possell 2005 or Wilkinson 2009 parameterisation
914	!! This is used to rescale the emission factor, considered to be measured at 350 ppm of CO2
915	!! to the CO2 conditions of the run
916
917	IF ( ok_co2bvoc_poss ) THEN
918	WRITE(numout,*) 'CO2 impact on isoprene: Possell calculation'
919
920	!! Possell function needs to be normalized (experiments at 400 ppm and EF before 1995)
921	!! Normalized at 350 ppm
922	fco2_ctrl = (-0.0123+(441.4795/350.)+(-1282.65/(350.**2)))
923
924	!! 2 tests: using the canopy (atmospheric) CO2 'ccanopy'
925	!! or the intercellular CO2 over nlai 'cim'
926	!! with cim = ccanopy*0.667
927	!! in the end I go for ccanopy for the Possell function since too much differences
928	!! when using cim and also the function has been derived based on atmospheric CO2
929	DO ji = 1, kjpindex
930
931	fco2(ji,:) = (-0.0123+(441.4795/ccanopy(ji))+(-1282.65/(ccanopy(ji)*ccanopy(ji))))/fco2_ctrl
932
933	END DO
934	ELSE IF ( ok_co2bvoc_wilk ) THEN
935	WRITE(numout,*) 'CO2 impact on isoprene: Wilkinson calculation'
936
937	!! In the Wilkinson function, 2 impacts are considered:
938	!! -short-term impact for CO2 variation during a single day (seconds/minutes)
939	!! -long-term impact for CO2 variation during leaf-growth (weeks/month)
940
941
942	!! Long-term parameters
943	!! Constant
944	Ismax_long = 1.344
945	h_long = 1.4614
946	Cstar_long = 585.
947	!! Short-term parameters
948	!! They have to be calculated based on atmospheric CO2
949	!! 10/05/2010
950	!! For atmospheric CO2 lower than 400 ppm or higher than 1200 ppm
951	!! (min and max CO2 level tested for short-term effect in Wilkinson et al. 2009)
952	!! we use the parameters calculated at 400/1200 ppm. For intermediate CO2 concentration,
953	!! parameters are calculated.
954	!! Linear interpolation
955
956	DO ji = 1, kjpindex
957
958	IF (ccanopy(ji) .LE. 400.) THEN
959
960	Ismax_short(ji) = 1.072
961	h_short(ji) = 1.7
962	Cstar_short(ji) = 1218.
963
964	ELSE IF (ccanopy(ji) .EQ. 600.) THEN
965
966	Ismax_short(ji) = 1.036
967	h_short(ji) = 2.0125
968	Cstar_short(ji) = 1150.
969
970	ELSE IF (ccanopy(ji) .EQ. 800.) THEN
971
972	Ismax_short(ji) = 1.046
973	h_short(ji) = 1.5380
974	Cstar_short(ji) = 2025.
975
976	ELSE IF (ccanopy(ji) .GE. 1200.) THEN
977
978	Ismax_short(ji) = 1.014
979	h_short(ji) = 2.8610
980	Cstar_short(ji) = 1525.
981
982
983	ELSE IF ((ccanopy(ji) .GT. 400.) .AND. (ccanopy(ji) .LT. 600.)) THEN
984
985	Ismax_short(ji) = 1.036 + (ccanopy(ji)-600.)*(1.036-1.072)/(600.-400.)
986	h_short(ji) = 2.0125 + (ccanopy(ji)-600.)*(2.0125-1.7)/(600.-400.)
987	Cstar_short(ji) = 1150. + (ccanopy(ji)-600.)*(1150.-1218.)/(600.-400.)
988
989	ELSE IF ((ccanopy(ji) .GT. 600.) .AND. (ccanopy(ji) .LT. 800.)) THEN
990
991	Ismax_short(ji) = 1.046 + (ccanopy(ji)-800.)*(1.046-1.036)/(800.-600.)
992	h_short(ji) = 1.5380 + (ccanopy(ji)-800.)*(1.5380-2.0125)/(800.-600.)
993	Cstar_short(ji) = 2025. + (ccanopy(ji)-800.)*(2025.-1150.)/(800.-600.)
994
995	ELSE IF ((ccanopy(ji) .GT. 800.) .AND. (ccanopy(ji) .LT. 1200.)) THEN
996
997	Ismax_short(ji) = 1.014 + (ccanopy(ji)-1200.)*(1.014-1.046)/(1200.-800.)
998	h_short(ji) = 2.8610 + (ccanopy(ji)-1200.)*(2.8610-1.5380)/(1200.-800.)
999	Cstar_short(ji) = 1525. + (ccanopy(ji)-1200.)*(1525.-2025.)/(1200.-800.)
1000
1001
1002	END IF
1003
1004	END DO
1005
1006	WRITE(numout,) 'Wilkinson BVOC-CO2 function: parameters*'
1007	WRITE(numout,*) 'Ismax_long: ', Ismax_long
1008	WRITE(numout,*) 'h_long: ', h_long
1009	WRITE(numout,*) 'Cstar_long: ', Cstar_long
1010	WRITE(numout,*) 'Ismax_short: ', MAXVAL(Ismax_short(:)) , MINVAL(Ismax_short(:))
1011	WRITE(numout,*) 'h_short: ', MAXVAL(h_short(:)) , MINVAL(h_short(:))
1012	WRITE(numout,*) 'Cstar_short: ', MAXVAL(Cstar_short(:)) , MINVAL(Cstar_short(:))
1013	WRITE(numout,) '*****'
1014
1015	DO ji = 1, kjpindex
1016	fco2_wlong(ji) = (Ismax_long-((Ismax_long((0.667ccanopy(ji))**h_long))/&
1017	& ((Cstar_long*h_long)+(0.667ccanopy(ji))**h_long)))/1.06566
1018	DO jv = 1, nvm
1019	fco2_wshort(ji,jv) = (Ismax_short(ji)-((Ismax_short(ji)((cim(ji,jv))*h_short(ji)))/&
1020	& ((Cstar_short(ji)h_short(ji))+(cim(ji,jv))h_short(ji))))/1.010803
1021	END DO
1022	END DO
1023
1024	DO ji = 1, kjpindex
1025	DO jv = 1, nvm
1026	fco2(ji,jv) = fco2_wshort(ji,jv)*fco2_wlong(ji)
1027	END DO
1028	END DO
1029
1030	ELSE
1031	WRITE(numout,*) 'CO2 impact on isoprene not considered'
1032	fco2(:,:) = 1.
1033	END IF
1034
1035
1036	!! 3. Calculation of PFT dependant parameters and
1037	! Calculation of VOC emissions flux
1038
1039	Eff_age_iso(:,:) = zero
1040	Eff_age_meth(:,:) = zero
1041
1042
1043	DO jv = 1, nvm ! loop over the PDFs
1044	DO ji = 1, kjpindex ! loop over the grid cell
1045	! 6-Calculation of Leaf Age Function (Lathiere 2005)
1046	IF ( ok_leafage ) THEN
1047	DO jf = 1, nleafages
1048	!> @codeinc
1049	Eff_age_iso(ji,jv) = Eff_age_iso(ji,jv) + frac_age(ji,jv,jf)*iso_activity(jf)
1050	Eff_age_meth(ji,jv) = Eff_age_meth(ji,jv) + frac_age(ji,jv,jf)*methanol_activity(jf)
1051	!> @endcodeinc
1052	END DO
1053	!> @codeinc
1054	Eff_age_VOC(ji,jv) = un
1055	!> @endcodeinc
1056	ELSE
1057	Eff_age_iso(ji,jv) = un
1058	Eff_age_meth(ji,jv) = un
1059	Eff_age_VOC(ji,jv) = un
1060	END IF
1061	!! 5. Calculation of foliar density
1062	IF ( sla(jv) .eq. zero ) THEN
1063	fol_dens(ji,jv) = zero
1064	ELSE
1065	! 2 factor for conversion from gC to gDM
1066	fol_dens(ji,jv) = 2 * lai(ji,jv)/sla(jv)
1067	ENDIF
1068	!! 6. Calculation of VOC emissions from vegetation
1069	IF ( ok_radcanopy ) THEN
1070	! if multi-layer canopy model
1071	IF (ok_multilayer) THEN
1072
1073	laisun(ji,jv) = zero
1074	laish(ji,jv) = zero
1075	GAMMA_iso_m = zero
1076	flx_iso(ji,jv) = zero
1077	flx_mono(ji,jv) = zero
1078	flx_apinen(ji,jv) = zero
1079	flx_bpinen(ji,jv) = zero
1080	flx_limonen(ji,jv) = zero
1081	flx_myrcen(ji,jv) = zero
1082	flx_sabinen(ji,jv) = zero
1083	flx_camphen(ji,jv) = zero
1084	flx_3caren(ji,jv) = zero
1085	flx_tbocimen(ji,jv) = zero
1086	flx_othermono(ji,jv) = zero
1087	flx_sesquiter(ji,jv) = zero
1088	flx_methanol(ji,jv) = zero
1089	flx_acetone(ji,jv) = zero
1090	flx_acetal(ji,jv) = zero
1091	flx_formal(ji,jv) = zero
1092	flx_acetic(ji,jv) = zero
1093	flx_formic(ji,jv) = zero
1094	! loop over the NLAI canopy layers
1095	DO jl = 1, nlai
1096	IF ((laitab(jl) .LE. lai(ji,jv)).AND.(lai(ji,jv).NE.zero)) THEN
1097	!sunlit vegetation
1098	Clsun_iso_tab = alpha_CL1PARsuntab(ji,jl)/sqrt(un + (alpha_*2) (PARsuntab(ji,jl)**2) )
1099	! shaded vegetation
1100	Clsh_iso_tab = alpha_CL1PARshtab(ji,jl)/sqrt(un + (alpha_*2) (PARshtab(ji,jl)**2) )
1101	flx_iso(ji,jv) = flx_iso(ji,jv) + (laisuntabdep(ji,jl)*Clsun_iso_tab+ &
1102	& laishtabdep(ji,jl)Clsh_iso_tab) &
1103	& fol_dens(ji,jv)/lai(ji,jv)Ct_iso(ji)em_factor_isoprene(jv)* &
1104	& Eff_age_iso(ji,jv)fco2(ji,jv)1e-9/one_hour
1105
1106	GAMMA_iso_m = GAMMA_iso_m + (laisuntabdep(ji,jl)*Clsun_iso_tab+ &
1107	& laishtabdep(ji,jl)Clsh_iso_tab) &
1108	& fol_dens(ji,jv)/lai(ji,jv)Ct_iso(ji)1e-9/one_hour
1109
1110	laisun(ji,jv) = laisun(ji,jv) + laisuntabdep(ji,jl)
1111	laish(ji,jv) = laish(ji,jv) + laishtabdep(ji,jl)
1112	END IF
1113	END DO
1114
1115	!! 6.1 Calculation of monoterpene biogenic emissions
1116	flx_mono(ji,jv) = ((1-LDF_mono)Ct_mono(ji)1e-9/one_hourfol_dens(ji,jv) + LDF_monoGAMMA_iso_m)* &
1117	& em_factor_monoterpene(jv)*Eff_age_VOC(ji,jv)
1118	!! 6.12 Calculation of sesquiterpenes biogenic emission
1119	flx_sesquiter(ji,jv) = ((1-LDF_sesq)Ct_sesq(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_sesqGAMMA_iso_m)* &
1120	& em_factor_sesquiterp(jv)*Eff_age_VOC(ji,jv)
1121	!! 6.13 Calculation of methanol biogenic emissions
1122	flx_methanol(ji,jv) = ((1-LDF_meth)Ct_meth(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_methGAMMA_iso_m)* &
1123	& em_factor_methanol(jv)*Eff_age_meth(ji,jv)
1124	!! 6.14 Calculation of acetone biogenic emissions
1125	flx_acetone(ji,jv) = ((1-LDF_acet)Ct_acet(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_acetGAMMA_iso_m)* &
1126	& em_factor_acetone(jv)*Eff_age_VOC(ji,jv)
1127	!! 6.14 Calculation of acetaldehyde biogenic emissions
1128	flx_acetal(ji,jv) = ((1-LDF_meth)Ct_meth(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_methGAMMA_iso_m)* &
1129	& em_factor_acetal(jv)*Eff_age_VOC(ji,jv)
1130	!! 6.16 Calculation of formaldehyde biogenic emissions
1131	flx_formal(ji,jv) = ((1-LDF_meth)Ct_meth(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_methGAMMA_iso_m)* &
1132	& em_factor_formal(jv)*Eff_age_VOC(ji,jv)
1133	!! 6.17 Calculation of acetic acid biogenic emissions
1134	flx_acetic(ji,jv) = ((1-LDF_meth)Ct_meth(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_methGAMMA_iso_m)* &
1135	& em_factor_acetic(jv)*Eff_age_VOC(ji,jv)
1136	!! 6.18 Calculation of formic acid biogenic emissions
1137	flx_formic(ji,jv) = ((1-LDF_meth)Ct_meth(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_methGAMMA_iso_m)* &
1138	& em_factor_formic(jv)*Eff_age_VOC(ji,jv)
1139
1140
1141	!! 6.3 Calculation of alfa pinene biogenic emission
1142	flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv)
1143	!! 6.4 Calculation of beta pinene biogenic emission
1144	flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv)
1145	!! 6.5 Calculation of limonene biogenic emission
1146	flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv)
1147	!! 6.6 Calculation of myrcene biogenic emission !!
1148	flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv)
1149	!! 6.7 Calculation of sabinene biogenic emission
1150	flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv)
1151	!! 6.8 Calculation of camphene biogenic emission
1152	flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv)
1153	!! 6.9 Calculation of 3-carene biogenic emission
1154	flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv)
1155	!! 6.10 Calculation of t-beta-ocimene biogenic emission
1156	flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv)
1157	!! 6.11 Calculation of other monoterpenes biogenic emission
1158	flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv)
1159
1160	! if mono-layer canopy model
1161	ELSE
1162	!sunlit vegetation
1163	Clsun_iso(ji,jv) = alpha_CL1PARsun(ji,jv)/sqrt(un + (alpha_*2) (PARsun(ji,jv)**2) )
1164	! shaded vegetation
1165	Clsh_iso(ji,jv) = alpha_CL1PARsh(ji,jv)/sqrt(un + (alpha_*2) (PARsh(ji,jv)**2) )
1166	IF (lai(ji,jv) .NE. zero) THEN
1167	!! 6.1 Calculation of isoprene biogenic emissions
1168	GAMMA_iso = (laisun(ji,jv)Clsun_iso(ji,jv) + laish(ji,jv)Clsh_iso(ji,jv))/lai(ji,jv)*Ct_iso(ji)
1169	flx_iso(ji,jv) = GAMMA_isofol_dens(ji,jv)em_factor_isoprene(jv)Eff_age_iso(ji,jv)fco2(ji,jv)*1e-9/one_hour
1170	!! 6.2 Calculation of monoterpene biogenic emissions
1171	flx_mono(ji,jv) = ((1-LDF_mono)Ct_mono(ji)+LDF_monoGAMMA_iso)fol_dens(ji,jv) &
1172	& em_factor_monoterpene(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1173	!! 6.3 Calculation of alfa pinene biogenic emission
1174	flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv)
1175	!! 6.4 Calculation of beta pinene biogenic emission
1176	flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv)
1177	!! 6.5 Calculation of limonene biogenic emission
1178	flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv)
1179	!! 6.6 Calculation of myrcene biogenic emission
1180	flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv)
1181	!! 6.7 Calculation of sabinene biogenic emission
1182	flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv)
1183	!! 6.8 Calculation of camphene biogenic emission
1184	flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv)
1185	!! 6.9 Calculation of 3-carene biogenic emission
1186	flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv)
1187	!! 6.10 Calculation of t-beta-ocimene biogenic emission
1188	flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv)
1189	!! 6.11 Calculation of other monoterpenes biogenic emission
1190	flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv)
1191	!! 6.12 Calculation of sesquiterpenes biogenic emission
1192	flx_sesquiter(ji,jv) = ((1-LDF_sesq)Ct_sesq(ji)+LDF_sesqGAMMA_iso)fol_dens(ji,jv) &
1193	& em_factor_sesquiterp(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1194	!! 6.13 Calculation of methanol biogenic emissions
1195	flx_methanol(ji,jv) = ((1-LDF_meth)Ct_meth(ji)+LDF_methGAMMA_iso)fol_dens(ji,jv) &
1196	& em_factor_methanol(jv)Eff_age_meth(ji,jv)1e-9/one_hour
1197	!! 6.14 Calculation of acetone biogenic emissions
1198	flx_acetone(ji,jv) = ((1-LDF_acet)Ct_acet(ji)+LDF_acetGAMMA_iso)fol_dens(ji,jv) &
1199	& em_factor_acetone(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1200	!! 6.15 Calculation of acetaldehyde biogenic emissions
1201	flx_acetal(ji,jv) = ((1-LDF_meth)Ct_meth(ji)+LDF_methGAMMA_iso)fol_dens(ji,jv) &
1202	& em_factor_acetal(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1203	!! 6.16 Calculation of formaldehyde biogenic emissions
1204	flx_formal(ji,jv) = ((1-LDF_meth)Ct_meth(ji)+LDF_methGAMMA_iso)fol_dens(ji,jv) &
1205	& em_factor_formal(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1206	!! 6.17 Calculation of acetic acid biogenic emissions
1207	flx_acetic(ji,jv) = ((1-LDF_meth)Ct_meth(ji)+LDF_methGAMMA_iso)fol_dens(ji,jv) &
1208	& em_factor_acetic(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1209	!! 6.18 Calculation of formic acid biogenic emissions
1210	flx_formic(ji,jv) = ((1-LDF_meth)Ct_meth(ji)+LDF_methGAMMA_iso)fol_dens(ji,jv) &
1211	& em_factor_formic(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1212
1213	ELSE
1214	!
1215	flx_iso(ji,jv) = zero
1216	flx_mono(ji,jv) = zero
1217	flx_apinen(ji,jv) = zero
1218	flx_bpinen(ji,jv) = zero
1219	flx_limonen(ji,jv) = zero
1220	flx_myrcen(ji,jv) = zero
1221	flx_sabinen(ji,jv) = zero
1222	flx_camphen(ji,jv) = zero
1223	flx_3caren(ji,jv) = zero
1224	flx_tbocimen(ji,jv) = zero
1225	flx_othermono(ji,jv) = zero
1226	flx_sesquiter(ji,jv) = zero
1227	flx_methanol(ji,jv) = zero
1228	flx_acetone(ji,jv) = zero
1229	flx_acetal(ji,jv) = zero
1230	flx_formal(ji,jv) = zero
1231	flx_acetic(ji,jv) = zero
1232	flx_formic(ji,jv) = zero
1233	END IF
1234	END IF
1235	! if no light extinction due to vegetation
1236	ELSE
1237	!! Isoprene emissions - general equation
1238	flx_iso(ji,jv) = fol_dens(ji,jv)Ct_iso(ji)Cl_iso(ji)Eff_age_iso(ji,jv)fco2(ji,jv)* &
1239	em_factor_isoprene(jv)*1e-9/one_hour
1240	!! 6.2 Calculation of monoterpene biogenic emissions
1241	Ylt_mono(ji) = ((1-LDF_mono)Ct_mono(ji)+LDF_monoCt_iso(ji)*Cl_iso(ji))
1242	flx_mono(ji,jv) = fol_dens(ji,jv)em_factor_monoterpene(jv)Ylt_mono(ji)Eff_age_VOC(ji,jv)&
1243	1e-9/one_hour
1244	!! 6.3 Calculation of alfa pinene biogenic emission
1245	flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv)
1246	!! 6.4 Calculation of beta pinene biogenic emission
1247	flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv)
1248	!! 6.5 Calculation of limonene biogenic emission
1249	flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv)
1250	!! 6.6 Calculation of myrcene biogenic emission
1251	flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv)
1252	!! 6.7 Calculation of sabinene biogenic emission
1253	flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv)
1254	!! 6.8 Calculation of camphene biogenic emission
1255	flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv)
1256	!! 6.9 Calculation of 3-carene biogenic emission
1257	flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv)
1258	!! 6.10 Calculation of t-beta-ocimene biogenic emission
1259	flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv)
1260	!! 6.11 Calculation of other monoterpenes biogenic emission
1261	flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv)
1262	!! 6.12 Calculation of sesquiterpenes biogenic emission
1263	Ylt_sesq(ji) = ((1-LDF_sesq)Ct_sesq(ji)+LDF_sesqCt_iso(ji)*Cl_iso(ji))
1264	flx_sesquiter(ji,jv) = fol_dens(ji,jv)em_factor_sesquiterp(jv)Ylt_sesq(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1265	!! 6.16 Calculation of methanol biogenic emissions
1266	Ylt_meth(ji) = ((1-LDF_meth)Ct_meth(ji)+LDF_methCt_iso(ji)*Cl_iso(ji))
1267	flx_methanol(ji,jv) = fol_dens(ji,jv)em_factor_methanol(jv)Ylt_meth(ji)Eff_age_meth(ji,jv)1e-9/one_hour
1268	!! 6.17 Calculation of acetone biogenic emissions
1269	Ylt_acet(ji) = ((1-LDF_acet)Ct_acet(ji)+LDF_acetCt_iso(ji)*Cl_iso(ji))
1270	flx_acetone(ji,jv) = fol_dens(ji,jv)em_factor_acetone(jv)Ylt_acet(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1271	!! 6.18 Calculation of acetaldehyde biogenic emissions
1272	flx_acetal(ji,jv) = fol_dens(ji,jv)em_factor_acetal(jv)Ylt_meth(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1273	!! 6.19 Calculation of formaldehyde biogenic emissions
1274	flx_formal(ji,jv) = fol_dens(ji,jv)em_factor_formal(jv)Ylt_meth(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1275	!! 6.20 Calculation of acetic acid biogenic emissions
1276	flx_acetic(ji,jv) = fol_dens(ji,jv)em_factor_acetic(jv)Ylt_meth(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1277	!! 6.21 Calculation of formic acid biogenic emissions
1278	flx_formic(ji,jv) = fol_dens(ji,jv)em_factor_formic(jv)Ylt_meth(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1279
1280	END IF
1281
1282	!! 6.22 Calculation of ORVOC biogenic emissions
1283	!! Other Reactive Volatile Organic Compounds
1284	!> @codeinc
1285	flx_ORVOC(ji,jv) = fol_dens(ji,jv)em_factor_ORVOC(jv)Ct_mono(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1286	!> @endcodeinc
1287	!! 6.4 Calculation of OVOC biogenic emissions
1288	!! Other Volatile Organic Compounds
1289	flx_OVOC(ji,jv) = fol_dens(ji,jv)em_factor_OVOC(jv)Ct_mono(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1290	!! 6.5 Calculation of MBO biogenic emissions
1291	!! 2-Methyl-3-Buten-2-ol
1292	IF(lalo(ji,1) .GE. 20. .AND. lalo(ji,2) .LE. -100) THEN
1293	flx_MBO(ji,jv) = fol_dens(ji,jv)em_factor_MBO(jv)Ct_MBO(ji)Cl_MBO(ji)Eff_age_VOC(ji,jv)*1e-9/one_hour
1294	ELSE
1295	flx_MBO(ji,jv) = zero
1296	END IF
1297	END DO
1298
1299	END DO
1300
1301
1302	!! 7. Calculation of NOx emissions from soils
1303	! Based on Yienger & Levy (1995) and Lathiere (2005, chapter 3)
1304	DO ji = 1, kjpindex
1305	!! 7.1 Precipitation-related pulse function
1306	IF (ok_pulse_NOx) THEN
1307	! if we are during a period where pulses are not allowed
1308	IF (ok_siesta(ji)) THEN
1309	! if this period is not over
1310	IF (FLOOR(siestaday(ji)) .LE. siestalim(ji)) THEN
1311	siestaday(ji) = siestaday(ji) + (dt_sechiba/one_day)
1312	! if this period is over
1313	ELSE
1314	ok_siesta(ji) = .FALSE.
1315	siestaday(ji) = zero
1316	END IF
1317	END IF
1318	! if we are during a period where pulses are allowed
1319	IF ((.NOT. ok_siesta(ji)) .AND. (.NOT. allow_pulse(ji))) THEN
1320	IF (humrel(ji,1) .LT. 0.15) THEN
1321	! if precip exceeds 1 mm/day over one time step => a pulse occurs
1322	IF(precip_rain(ji)/nbre_precip .GE. un/(one_day/dt_sechiba)) THEN
1323	! if precip is up to 5 mm/day => pulse length is 3 days
1324	IF (precip_rain(ji)/nbre_precip .LT. 5./(one_day/dt_sechiba)) THEN
1325	pulselim(ji) = 3.
1326	! if precip is up to 15 mm/day => pulse length is 7 days
1327	ELSE IF (precip_rain(ji)/nbre_precip .LT. 15./(one_day/dt_sechiba)) THEN
1328	pulselim(ji) = 7.
1329	! if precip is upper than 15 mm/day => pulse length is 14 days
1330	ELSE IF (precip_rain(ji)/nbre_precip .GE. 15./(one_day/dt_sechiba)) THEN
1331	pulselim(ji) = 14.
1332	END IF
1333	allow_pulse(ji)=.TRUE.
1334	pulseday(ji) = un
1335	END IF
1336	END IF
1337	END IF
1338	! if we were during a pulse period
1339	IF (allow_pulse(ji)) THEN
1340	! if we are still during the pulse period
1341	! 16/06/2010 We assume a (pulselim-1) days for the pulse length (NVui+Jlath)
1342	IF(FLOOR(pulseday(ji)) .LT. pulselim(ji)) THEN
1343	! calculation of the pulse function
1344	IF (pulselim(ji).EQ.3) THEN
1345	pulse(ji) = 11.19exp(-0.805pulseday(ji))
1346	ELSE IF (pulselim(ji).EQ.7) THEN
1347	pulse(ji) = 14.68exp(-0.384pulseday(ji))
1348	ELSE IF (pulselim(ji).EQ.14) THEN
1349	pulse(ji) = 18.46exp(-0.208pulseday(ji))
1350	END IF
1351	pulseday(ji) = pulseday(ji) + (dt_sechiba/one_day)
1352	! if the pulse period is over
1353	ELSE
1354	! pulse function is set to 1
1355	pulse(ji) = un
1356	allow_pulse(ji) = .FALSE.
1357	siestaday(ji) = un
1358	siestalim(ji) = pulselim(ji)
1359	ok_siesta(ji) = .TRUE.
1360	END IF
1361	END IF
1362	! no precipitation-related pulse function
1363	ELSE
1364	pulse(ji) = un
1365	END IF
1366	END DO
1367
1368	!! 7.2 Calculation of NO basal emissions including pulse effect
1369	DO jv = 1, nvm
1370	DO ji = 1, kjpindex
1371	!Tropical forests
1372	IF ( is_tropical(jv) .AND. is_evergreen(jv) ) THEN
1373	! Wet soils
1374	IF (humrel(ji,1) .GT. 0.3) THEN
1375	flx_no_soil(ji,jv) = 2.6*pulse(ji)
1376	! Dry soils
1377	ELSE
1378	flx_no_soil(ji,jv) = 8.6*pulse(ji)
1379	END IF
1380	!Else If agricultural lands OR Wet soils
1381	ELSE IF ( ( .NOT.(natural(jv)) ) .OR. ( humrel(ji,1) .GT. 0.3 ) ) THEN
1382	! Calculation of NO emissions depending of Temperature
1383	IF (t_no(ji) .LT. zero) THEN
1384	flx_no_soil(ji,jv) = zero
1385	ELSE IF (t_no(ji) .LE. 10.) THEN
1386	flx_no_soil(ji,jv) = 0.28em_factor_no_wet(jv)t_no(ji)*pulse(ji)
1387	ELSE IF (t_no(ji) .LE. 30.) THEN
1388	flx_no_soil(ji,jv) = em_factor_no_wet(jv)exp(0.103t_no(ji))*pulse(ji)
1389	ELSE
1390	flx_no_soil(ji,jv) = 21.97em_factor_no_wet(jv)pulse(ji)
1391	END IF
1392	!Else if Temp negative
1393	ELSE IF (t_no(ji) .LT. zero) THEN
1394	flx_no_soil(ji,jv) = zero
1395	!Else if Temp <= 30
1396	ELSE IF (t_no(ji) .LE. 30.) THEN
1397	flx_no_soil(ji,jv) = (em_factor_no_dry(jv)t_no(ji))/30.pulse(ji)
1398	ELSE
1399	flx_no_soil(ji,jv) = em_factor_no_dry(jv)*pulse(ji)
1400	END IF
1401
1402	!! 7.3 IF ACTIVATED (ok_bbgfertil_NOx = TRUE) calculation of NOx soil emission increase due to biomass burning
1403	! Calculation of Biomass-Burning-induced NOx emissions (Lathiere, 2005)
1404	! => NOx emissions 3-fold increase
1405	IF (ok_bbgfertil_NOx) THEN
1406	IF ( natural(jv) ) THEN
1407	! North Tropical zone from May to June
1408	IF ((lalo(ji,1) .LE. 30. .AND. lalo(ji,1) .GE. zero).AND. &
1409	(day .GE. 121. .AND. day .LE. 181).AND.(flx_co2_bbg_year(ji) .GT. 0.1)) THEN
1410	flx_no_soil(ji,jv) = flx_no_soil(ji,jv)*3.
1411	! South Tropical zone from November to December
1412	ELSE IF ((lalo(ji,1) .GE. -30. .AND. lalo(ji,1) .LT. zero).AND.(day .GE. 305.).AND. &
1413	(flx_co2_bbg_year(ji) .GT. 0.1)) THEN
1414	flx_no_soil(ji,jv) = flx_no_soil(ji,jv)*3.
1415	END IF
1416	END IF
1417	END IF
1418
1419	!! 7.4 IF ACTIVATED (ok_cropsfertil_NOx = TRUE) calculation of NOx soil emission increase due to fertilizer use
1420	! Calculation of N-fertiliser-induced NOx emissions
1421	flx_fertil_no(ji,jv) = zero
1422	IF (ok_cropsfertil_NOx) THEN
1423	IF (veget_max_nowoody(ji) .NE. zero) THEN
1424	! Non-agricultural lands
1425	IF ( (jv == ibare_sechiba) .OR. is_tree(jv) ) THEN
1426	N_qt_WRICE_pft(ji,jv) = zero
1427	N_qt_OTHER_pft(ji,jv) = zero
1428	! Grasslands or Croplands
1429	ELSE
1430	N_qt_WRICE_pft(ji,jv) = N_qt_WRICE_year(ji)*veget_max(ji,jv)/veget_max_nowoody(ji)
1431	N_qt_OTHER_pft(ji,jv) = N_qt_OTHER_year(ji)*veget_max(ji,jv)/veget_max_nowoody(ji)
1432	END IF
1433	ELSE
1434	N_qt_WRICE_pft(ji,jv) = zero
1435	N_qt_OTHER_pft(ji,jv) = zero
1436	END IF
1437
1438	! North temperate regions from May to August
1439	! OR South Temperate regions from November to February
1440	IF (((lalo(ji,1) .GT. 30.) .AND. (day .GE. 121. .AND. day .LE. 243.).AND.(veget_max(ji,jv) .NE. zero)) .OR. &
1441	& ((lalo(ji,1) .LT. -30.) .AND. (day .GE. 305. .OR. day .LE. 59.) .AND.(veget_max(ji,jv) .NE. zero))) THEN
1442	! 1e12 for conversion from kg to Ng
1443	! 1/(365/122460604) for conversion from year to seconds corrected for 4 months of emissions
1444	flx_fertil_no(ji,jv) = (N_qt_WRICE_pft(ji,jv)(1/30.)+N_qt_OTHER_pft(ji,jv))(2.5/100.) &
1445	& 1e12/(3652460604/12)/(area2(ji)veget_max(ji,jv))
1446	! OR Tropical regions all the year
1447	ELSE IF ((lalo(ji,1) .GE. -30.).AND.(lalo(ji,1) .LE. 30.).AND.(veget_max(ji,jv) .NE. zero)) THEN
1448	flx_fertil_no(ji,jv) = (N_qt_WRICE_pft(ji,jv)(1/30.)+N_qt_OTHER_pft(ji,jv))(2.5/100.) &
1449	& 1e12/(365246060)/(area2(ji)*veget_max(ji,jv))
1450	END IF
1451	flx_no_soil(ji,jv) = flx_no_soil(ji,jv) + flx_fertil_no(ji,jv)
1452	END IF
1453
1454	!! 7.5 Calculation of net NO flux above soil accounting for surface deposition,
1455	!! based on the Canopy Reduction Factor (CRF), calculated using Leaf Area and Stomatal Area
1456	!kc=cuticle absorptivity = 0.24m^2/m^2
1457	!ks=stomatal absorptivity = 8.75m^2/m^2
1458	!Larch=Larcher SAI/LAI ratio given in Larcher 1991
1459	!> @codeinc
1460	CRF(ji,jv) = (exp(-8.75Larch(jv)lai(ji,jv)) + exp(-0.24*lai(ji,jv)))/2.
1461	flx_no(ji,jv) = flx_no_soil(ji,jv)*CRF(ji,jv)
1462	!> @endcodeinc
1463	END DO
1464	END DO
1465
1466
1467	! Write output with XIOS
1468	CALL xios_orchidee_send_field("PAR",PAR)
1469	CALL xios_orchidee_send_field("flx_fertil_no",flx_fertil_no)
1470	CALL xios_orchidee_send_field("flx_iso",flx_iso)
1471	CALL xios_orchidee_send_field("flx_mono",flx_mono)
1472	CALL xios_orchidee_send_field("flx_ORVOC",flx_ORVOC)
1473	CALL xios_orchidee_send_field("flx_MBO",flx_MBO)
1474	CALL xios_orchidee_send_field("flx_methanol",flx_methanol)
1475	CALL xios_orchidee_send_field("flx_acetone",flx_acetone)
1476	CALL xios_orchidee_send_field("flx_acetal",flx_acetal)
1477	CALL xios_orchidee_send_field("flx_formal",flx_formal)
1478	CALL xios_orchidee_send_field("flx_acetic",flx_acetic)
1479	CALL xios_orchidee_send_field("flx_formic",flx_formic)
1480	CALL xios_orchidee_send_field("flx_no_soil",flx_no_soil)
1481	CALL xios_orchidee_send_field("flx_no",flx_no)
1482	CALL xios_orchidee_send_field('flx_apinen' , flx_apinen)
1483	CALL xios_orchidee_send_field('flx_bpinen' , flx_bpinen)
1484	CALL xios_orchidee_send_field('flx_limonen' ,flx_limonen)
1485	CALL xios_orchidee_send_field('flx_myrcen' , flx_myrcen)
1486	CALL xios_orchidee_send_field('flx_sabinen' ,flx_sabinen)
1487	CALL xios_orchidee_send_field('flx_camphen' ,flx_camphen)
1488	CALL xios_orchidee_send_field('flx_3caren' , flx_3caren)
1489	CALL xios_orchidee_send_field('flx_tbocimen' ,flx_tbocimen)
1490	CALL xios_orchidee_send_field('flx_othermono',flx_othermono)
1491	CALL xios_orchidee_send_field('flx_sesquiter',flx_sesquiter)
1492	CALL xios_orchidee_send_field("CRF",CRF)
1493	CALL xios_orchidee_send_field('fco2', fco2)
1494
1495	IF ( ok_radcanopy ) THEN
1496	CALL xios_orchidee_send_field("PARdf",PARdf)
1497	CALL xios_orchidee_send_field("PARdr",PARdr)
1498
1499	IF (ok_multilayer) THEN
1500	CALL xios_orchidee_send_field("PARsuntab",PARsuntab)
1501	CALL xios_orchidee_send_field("PARshtab",PARshtab)
1502	ELSE
1503	CALL xios_orchidee_send_field("PARsun",PARsun)
1504	CALL xios_orchidee_send_field("PARsh",PARsh)
1505	CALL xios_orchidee_send_field("laisun",laisun)
1506	CALL xios_orchidee_send_field("laish",laish)
1507	ENDIF
1508	ENDIF
1509
1510	IF ( ok_bbgfertil_Nox ) THEN
1511	CALL xios_orchidee_send_field("flx_co2_bbg_year",flx_co2_bbg_year)
1512	END IF
1513
1514	IF ( ok_cropsfertil_Nox ) THEN
1515	CALL xios_orchidee_send_field("N_qt_WRICE_year",N_qt_WRICE_year)
1516	CALL xios_orchidee_send_field("N_qt_OTHER_year",N_qt_OTHER_year)
1517	END IF
1518
1519
1520	! Write output with IOIPSL
1521	IF ( .NOT. almaoutput ) THEN
1522
1523	CALL histwrite_p(hist_id, 'PAR', kjit, PAR, kjpindex, index)
1524	IF ( ok_radcanopy ) THEN
1525	CALL histwrite_p(hist_id, 'laisun', kjit, laisun, kjpindex*nvm, indexveg)
1526	CALL histwrite_p(hist_id, 'laish', kjit, laish, kjpindex*nvm, indexveg)
1527	CALL histwrite_p(hist_id, 'Fdf', kjit, Fdf, kjpindex, index)
1528	IF (ok_multilayer) THEN
1529	CALL histwrite_p(hist_id, 'PARsuntab', kjit, PARsuntab, kjpindex*(nlai+1), indexlai)
1530	CALL histwrite_p(hist_id, 'PARshtab', kjit, PARshtab, kjpindex*(nlai+1), indexlai)
1531	ELSE
1532	CALL histwrite_p(hist_id, 'PARsun', kjit, PARsun, kjpindex*nvm, indexveg)
1533	CALL histwrite_p(hist_id, 'PARsh', kjit, PARsh, kjpindex*nvm, indexveg)
1534	END IF
1535	CALL histwrite_p(hist_id, 'coszang', kjit, coszang, kjpindex, index)
1536	CALL histwrite_p(hist_id, 'PARdf', kjit, PARdf, kjpindex, index)
1537	CALL histwrite_p(hist_id, 'PARdr', kjit, PARdr, kjpindex, index)
1538	CALL histwrite_p(hist_id, 'Trans', kjit, Trans, kjpindex, index)
1539	END IF
1540	CALL histwrite_p(hist_id, 'flx_fertil_no', kjit, flx_fertil_no, kjpindex*nvm, indexveg)
1541	CALL histwrite_p(hist_id, 'CRF', kjit, CRF, kjpindex*nvm, indexveg)
1542	CALL histwrite_p(hist_id, 'fco2', kjit, fco2, kjpindex*nvm, indexveg)
1543
1544	IF ( ok_bbgfertil_Nox ) THEN
1545	CALL histwrite_p(hist_id, 'flx_co2_bbg_year', 1, flx_co2_bbg_year, kjpindex, index)
1546	ENDIF
1547	IF ( ok_cropsfertil_Nox ) THEN
1548	CALL histwrite_p(hist_id, 'N_qt_WRICE_year', 1, N_qt_WRICE_year, kjpindex, index)
1549	CALL histwrite_p(hist_id, 'N_qt_OTHER_year', 1, N_qt_OTHER_year, kjpindex, index)
1550	ENDIF
1551	CALL histwrite_p(hist_id, 'flx_iso', kjit, flx_iso, kjpindex*nvm, indexveg)
1552	CALL histwrite_p(hist_id, 'flx_mono', kjit, flx_mono, kjpindex*nvm, indexveg)
1553	CALL histwrite_p(hist_id, 'flx_apinen', kjit, flx_apinen, kjpindex*nvm, indexveg)
1554	CALL histwrite_p(hist_id, 'flx_bpinen', kjit, flx_bpinen, kjpindex*nvm, indexveg)
1555	CALL histwrite_p(hist_id, 'flx_limonen', kjit, flx_limonen, kjpindex*nvm, indexveg)
1556	CALL histwrite_p(hist_id, 'flx_myrcen', kjit, flx_myrcen, kjpindex*nvm, indexveg)
1557	CALL histwrite_p(hist_id, 'flx_sabinen', kjit, flx_sabinen, kjpindex*nvm, indexveg)
1558	CALL histwrite_p(hist_id, 'flx_camphen', kjit, flx_camphen, kjpindex*nvm, indexveg)
1559	CALL histwrite_p(hist_id, 'flx_3caren', kjit, flx_3caren, kjpindex*nvm, indexveg)
1560	CALL histwrite_p(hist_id, 'flx_tbocimen', kjit, flx_tbocimen, kjpindex*nvm, indexveg)
1561	CALL histwrite_p(hist_id, 'flx_othermono', kjit, flx_othermono, kjpindex*nvm, indexveg)
1562	CALL histwrite_p(hist_id, 'flx_sesquiter', kjit, flx_sesquiter, kjpindex*nvm, indexveg)
1563	CALL histwrite_p(hist_id, 'flx_ORVOC', kjit, flx_ORVOC, kjpindex*nvm, indexveg)
1564	CALL histwrite_p(hist_id, 'flx_MBO', kjit, flx_MBO, kjpindex*nvm, indexveg)
1565	CALL histwrite_p(hist_id, 'flx_methanol', kjit, flx_methanol, kjpindex*nvm, indexveg)
1566	CALL histwrite_p(hist_id, 'flx_acetone', kjit, flx_acetone, kjpindex*nvm, indexveg)
1567	CALL histwrite_p(hist_id, 'flx_acetal', kjit, flx_acetal, kjpindex*nvm, indexveg)
1568	CALL histwrite_p(hist_id, 'flx_formal', kjit, flx_formal, kjpindex*nvm, indexveg)
1569	CALL histwrite_p(hist_id, 'flx_acetic', kjit, flx_acetic, kjpindex*nvm, indexveg)
1570	CALL histwrite_p(hist_id, 'flx_formic', kjit, flx_formic, kjpindex*nvm, indexveg)
1571	CALL histwrite_p(hist_id, 'flx_no_soil', kjit, flx_no_soil, kjpindex*nvm, indexveg)
1572	CALL histwrite_p(hist_id, 'flx_no', kjit, flx_no, kjpindex*nvm, indexveg)
1573
1574	IF ( hist2_id > 0 ) THEN
1575	CALL histwrite_p(hist2_id, 'PAR', kjit, PAR, kjpindex, index)
1576	IF ( ok_radcanopy ) THEN
1577	CALL histwrite_p(hist2_id, 'PARsun', kjit, PARsun, kjpindex*nvm, indexveg)
1578	CALL histwrite_p(hist2_id, 'PARsh', kjit, PARsh, kjpindex*nvm, indexveg)
1579	CALL histwrite_p(hist2_id, 'laisun', kjit, laisun, kjpindex*nvm, indexveg)
1580	CALL histwrite_p(hist2_id, 'laish', kjit, laish, kjpindex*nvm, indexveg)
1581	ENDIF
1582	CALL histwrite_p(hist2_id, 'flx_fertil_no', kjit, flx_fertil_no, kjpindex*nvm, indexveg)
1583	CALL histwrite_p(hist2_id, 'CRF', kjit, CRF, kjpindex*nvm, indexveg)
1584	IF ( ok_bbgfertil_Nox ) THEN
1585	CALL histwrite_p(hist2_id, 'flx_co2_bbg_year', 1, flx_co2_bbg_year, kjpindex, index)
1586	ENDIF
1587	IF ( ok_cropsfertil_Nox ) THEN
1588	CALL histwrite_p(hist2_id, 'N_qt_WRICE_year', 1, N_qt_WRICE_year, kjpindex, index)
1589	CALL histwrite_p(hist2_id, 'N_qt_OTHER_year', 1, N_qt_OTHER_year, kjpindex, index)
1590	ENDIF
1591	CALL histwrite_p(hist2_id, 'flx_iso', kjit, flx_iso, kjpindex*nvm, indexveg)
1592	CALL histwrite_p(hist2_id, 'flx_mono', kjit, flx_mono, kjpindex*nvm, indexveg)
1593	CALL histwrite_p(hist2_id, 'flx_apinen', kjit, flx_apinen, kjpindex*nvm, indexveg)
1594	CALL histwrite_p(hist2_id, 'flx_bpinen', kjit, flx_bpinen, kjpindex*nvm, indexveg)
1595	CALL histwrite_p(hist2_id, 'flx_limonen', kjit, flx_limonen, kjpindex*nvm, indexveg)
1596	CALL histwrite_p(hist2_id, 'flx_myrcen', kjit, flx_myrcen, kjpindex*nvm, indexveg)
1597	CALL histwrite_p(hist2_id, 'flx_sabinen', kjit, flx_sabinen, kjpindex*nvm, indexveg)
1598	CALL histwrite_p(hist2_id, 'flx_camphen', kjit, flx_camphen, kjpindex*nvm, indexveg)
1599	CALL histwrite_p(hist2_id, 'flx_3caren', kjit, flx_3caren, kjpindex*nvm, indexveg)
1600	CALL histwrite_p(hist2_id, 'flx_tbocimen', kjit, flx_tbocimen, kjpindex*nvm, indexveg)
1601	CALL histwrite_p(hist2_id, 'flx_othermono', kjit, flx_othermono, kjpindex*nvm, indexveg)
1602	CALL histwrite_p(hist2_id, 'flx_sesquiter', kjit, flx_sesquiter, kjpindex*nvm, indexveg)
1603	CALL histwrite_p(hist2_id, 'flx_ORVOC', kjit, flx_ORVOC, kjpindex*nvm, indexveg)
1604	CALL histwrite_p(hist2_id, 'flx_MBO', kjit, flx_MBO, kjpindex*nvm, indexveg)
1605	CALL histwrite_p(hist2_id, 'flx_methanol', kjit, flx_methanol, kjpindex*nvm, indexveg)
1606	CALL histwrite_p(hist2_id, 'flx_acetone', kjit, flx_acetone, kjpindex*nvm, indexveg)
1607	CALL histwrite_p(hist2_id, 'flx_acetal', kjit, flx_acetal, kjpindex*nvm, indexveg)
1608	CALL histwrite_p(hist2_id, 'flx_formal', kjit, flx_formal, kjpindex*nvm, indexveg)
1609	CALL histwrite_p(hist2_id, 'flx_acetic', kjit, flx_acetic, kjpindex*nvm, indexveg)
1610	CALL histwrite_p(hist2_id, 'flx_formic', kjit, flx_formic, kjpindex*nvm, indexveg)
1611	CALL histwrite_p(hist2_id, 'flx_no_soil', kjit, flx_no_soil, kjpindex*nvm, indexveg)
1612	CALL histwrite_p(hist2_id, 'flx_no', kjit, flx_no, kjpindex*nvm, indexveg)
1613	ENDIF
1614	ENDIF
1615
1616	IF (printlev>=3) WRITE(numout,*) 'OK chemistry_bvoc'
1617
1618	END SUBROUTINE chemistry_bvoc
1619
1620	!! ================================================================================================================================
1621	!! SUBROUTINE : chemistry_flux_interface
1622	!!
1623	!>\BRIEF This subroutine will give to the interface between inca model and orchidee model in sechiba all the flux ask by inca
1624	!!
1625	!! DESCRIPTION : This subroutine allow the transfer of fluxes between surface and atmospheric chemistry. It is called from sechiba
1626	!!
1627	!! RECENT CHANGE(S): None
1628	!!
1629	!! MAIN OUTPUT VARIABLE(S): ::
1630	!!
1631	!! REFERENCE(S) : None
1632	!!
1633	!! FLOWCHART : None
1634	!_ ================================================================================================================================
1635
1636	SUBROUTINE chemistry_flux_interface( field_out_names, fields_out, field_in_names, fields_in)
1637
1638	!
1639	! Optional arguments
1640	!
1641	! Names and fields for emission variables : to be transport by Orchidee to Inca
1642	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names
1643	REAL(r_std),DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: fields_out
1644	!
1645	! Names and fields for deposit variables : to be transport from chemistry model by INCA to ORCHIDEE.
1646	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names
1647	REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN) :: fields_in
1648	!
1649	! Number of fields to give (nb_fields_out) or get from (nb_fields_in) INCA :
1650	INTEGER(i_std), SAVE :: nb_fields_out, nb_fields_in
1651	!$OMP THREADPRIVATE(nb_fields_out, nb_fields_in)
1652
1653	! Id of fields to give (nb_fields_out) or get from (nb_fields_in) INCA :
1654	INTEGER(i_std) :: i_fields_out, i_fields_in
1655
1656	IF (l_first_chemistry_inca) THEN
1657
1658	! il faut verifier que ok_bvoc (chemistry_ok_bvoc) est bien active sinon on arrete tout
1659	if (.not.ok_bvoc) then
1660	CALL ipslerr_p (3,'chemistry_inca', &
1661	& 'you need to activate chemistry_ok_bvoc in orchidee.def',&
1662	& 'This model won''t be able to continue.', &
1663	& '')
1664	endif
1665
1666	! Prepare fieds out/in for interface with INCA.
1667	IF (PRESENT(field_out_names)) THEN
1668	nb_fields_out=SIZE(field_out_names)
1669	ELSE
1670	nb_fields_out=0
1671	ENDIF
1672
1673	IF (PRESENT(field_in_names)) THEN
1674	nb_fields_in=SIZE(field_in_names)
1675	ELSE
1676	nb_fields_in=0
1677	ENDIF
1678	l_first_chemistry_inca = .FALSE.
1679
1680	ENDIF
1681
1682
1683
1684	IF (ok_bvoc) THEN
1685	! Fields for deposit variables : to be transport from chemistry model by INCA to ORCHIDEE.
1686	DO i_fields_in=1,nb_fields_in
1687	SELECT CASE(TRIM(field_in_names(i_fields_in)))
1688	CASE DEFAULT
1689	CALL ipslerr_p (3,'chemistry_inca', &
1690	& 'You ask in INCA an unknown field '//TRIM(field_in_names(i_fields_in))//&
1691	& ' to give to ORCHIDEE for this specific version.',&
1692	& 'This model won''t be able to continue.', &
1693	& '(check your tracer parameters in INCA)')
1694	END SELECT
1695	ENDDO
1696
1697	! Fields for Biogenic emissions : to be transport by Orchidee to Inca
1698	DO i_fields_out=1,nb_fields_out
1699	SELECT CASE(TRIM(field_out_names(i_fields_out)))
1700	CASE("flx_iso")
1701	fields_out(:,:,i_fields_out)=flx_iso(:,:)
1702	CASE("flx_mono")
1703	fields_out(:,:,i_fields_out)=flx_mono(:,:)
1704	CASE("flx_ORVOC")
1705	fields_out(:,:,i_fields_out)=flx_ORVOC(:,:)
1706	CASE("flx_MBO")
1707	fields_out(:,:,i_fields_out)=flx_MBO(:,:)
1708	CASE("flx_methanol")
1709	fields_out(:,:,i_fields_out)=flx_methanol(:,:)
1710	CASE("flx_acetone")
1711	fields_out(:,:,i_fields_out)=flx_acetone(:,:)
1712	CASE("flx_acetal")
1713	fields_out(:,:,i_fields_out)=flx_acetal(:,:)
1714	CASE("flx_formal")
1715	fields_out(:,:,i_fields_out)=flx_formal(:,:)
1716	CASE("flx_acetic")
1717	fields_out(:,:,i_fields_out)=flx_acetic(:,:)
1718	CASE("flx_formic")
1719	fields_out(:,:,i_fields_out)=flx_formic(:,:)
1720	CASE("flx_no_soil")
1721	fields_out(:,:,i_fields_out)=flx_no_soil(:,:)
1722	CASE("flx_nox")
1723	fields_out(:,:,i_fields_out)=flx_no(:,:)
1724	CASE("flx_fertil_no")
1725	fields_out(:,:,i_fields_out)=flx_fertil_no(:,:)
1726	CASE("flx_apinen")
1727	fields_out(:,:,i_fields_out)=flx_apinen(:,:)
1728	CASE("flx_bpinen")
1729	fields_out(:,:,i_fields_out)=flx_bpinen(:,:)
1730	CASE("flx_limonen")
1731	fields_out(:,:,i_fields_out)=flx_limonen(:,:)
1732	CASE("flx_myrcen")
1733	fields_out(:,:,i_fields_out)=flx_myrcen(:,:)
1734	CASE("flx_sabinen")
1735	fields_out(:,:,i_fields_out)=flx_sabinen(:,:)
1736	CASE("flx_camphen")
1737	fields_out(:,:,i_fields_out)=flx_camphen(:,:)
1738	CASE("flx_3caren")
1739	fields_out(:,:,i_fields_out)=flx_3caren(:,:)
1740	CASE("flx_tbocimen")
1741	fields_out(:,:,i_fields_out)=flx_tbocimen(:,:)
1742	CASE("flx_othermono")
1743	fields_out(:,:,i_fields_out)=flx_othermono(:,:)
1744	CASE("flx_sesquiter")
1745	fields_out(:,:,i_fields_out)=flx_sesquiter(:,:)
1746
1747	CASE DEFAULT
1748	CALL ipslerr_p (3,'chemistry_inca', &
1749	& 'You ask from INCA an unknown field '//TRIM(field_out_names(i_fields_out))//&
1750	& ' to ORCHIDEE for this specific version.',&
1751	& 'This model won''t be able to continue.', &
1752	& '(check your tracer parameters in INCA)')
1753	END SELECT
1754	ENDDO
1755
1756	ENDIF
1757	END SUBROUTINE chemistry_flux_interface
1758
1759	!! ================================================================================================================================
1760	!! SUBROUTINE : chemistry_clear
1761	!!
1762	!>\BRIEF Clear chemistry module
1763	!!
1764	!! DESCRIPTION : Deallocate memory and reset initialization variables to there original values
1765	!!
1766	!_ ================================================================================================================================
1767	SUBROUTINE chemistry_clear
1768
1769	!! 1. Initialize as for first run
1770	l_first_chemistry_inca = .TRUE.
1771
1772	!! 2. Deallocate dynamic variables
1773	IF (ALLOCATED(pulse)) DEALLOCATE (pulse)
1774	IF (ALLOCATED (ok_siesta)) DEALLOCATE (ok_siesta)
1775	IF (ALLOCATED (allow_pulse)) DEALLOCATE (allow_pulse)
1776	IF (ALLOCATED (pulseday)) DEALLOCATE (pulseday)
1777	IF (ALLOCATED (siestaday)) DEALLOCATE (siestaday)
1778	IF (ALLOCATED (pulselim)) DEALLOCATE (pulselim)
1779	IF (ALLOCATED (siestalim)) DEALLOCATE (siestalim)
1780	IF (ALLOCATED (area2)) DEALLOCATE (area2)
1781	IF (ALLOCATED (N_qt_WRICE_year)) DEALLOCATE (N_qt_WRICE_year)
1782	IF (ALLOCATED (N_qt_OTHER_year)) DEALLOCATE (N_qt_OTHER_year)
1783	IF (ALLOCATED (flx_iso)) DEALLOCATE (flx_iso)
1784	IF (ALLOCATED (flx_mono)) DEALLOCATE (flx_mono)
1785	IF (ALLOCATED (flx_ORVOC)) DEALLOCATE (flx_ORVOC)
1786	IF (ALLOCATED (flx_MBO)) DEALLOCATE (flx_MBO)
1787	IF (ALLOCATED (flx_methanol)) DEALLOCATE (flx_methanol)
1788	IF (ALLOCATED (flx_acetone)) DEALLOCATE (flx_acetone)
1789	IF (ALLOCATED (flx_acetal)) DEALLOCATE (flx_acetal)
1790	IF (ALLOCATED (flx_formal)) DEALLOCATE (flx_formal)
1791	IF (ALLOCATED (flx_acetic)) DEALLOCATE (flx_acetic)
1792	IF (ALLOCATED (flx_formic)) DEALLOCATE (flx_formic)
1793	IF (ALLOCATED (flx_no_soil)) DEALLOCATE (flx_no_soil)
1794	IF (ALLOCATED (flx_no)) DEALLOCATE (flx_no)
1795	IF (ALLOCATED (flx_fertil_no)) DEALLOCATE (flx_fertil_no)
1796	IF (ALLOCATED (flx_apinen)) DEALLOCATE (flx_apinen)
1797	IF (ALLOCATED (flx_bpinen)) DEALLOCATE (flx_bpinen)
1798	IF (ALLOCATED (flx_limonen)) DEALLOCATE (flx_limonen)
1799	IF (ALLOCATED (flx_myrcen)) DEALLOCATE (flx_myrcen)
1800	IF (ALLOCATED (flx_sabinen)) DEALLOCATE (flx_sabinen)
1801	IF (ALLOCATED (flx_camphen)) DEALLOCATE (flx_camphen)
1802	IF (ALLOCATED (flx_3caren)) DEALLOCATE (flx_3caren)
1803	IF (ALLOCATED (flx_tbocimen)) DEALLOCATE (flx_tbocimen)
1804	IF (ALLOCATED (flx_othermono)) DEALLOCATE (flx_othermono)
1805	IF (ALLOCATED (flx_sesquiter)) DEALLOCATE (flx_sesquiter)
1806	IF (ALLOCATED (CRF)) DEALLOCATE (CRF)
1807	IF (ALLOCATED (flx_co2_bbg_year)) DEALLOCATE (flx_co2_bbg_year)
1808
1809	END SUBROUTINE chemistry_clear
1810
1811	END MODULE chemistry

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

Download in other formats: