Context Navigation

chemistry.f90 @ 5143

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

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

Context Navigation

source: branches/publications/ORCHIDEE_gmd-2018-57/src_sechiba/chemistry.f90 @ 5143

Download in other formats: