Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

chemistry.f90 @ 7474

Last change on this file since 7474 was 4977, checked in by simon.bowring, 7 years ago
Currently running (13/02/2018) version includes all necessarily changes to include DOC in MICT code... further parametrisation necessary to equate soil pools with those of normal forcesoil restarts
Property svn:keywords set to `Date Revision HeadURL`
File size: 99.2 KB

Line
1	! ================================================================================================================================
2	! MODULE : chemistry
3	!
4	! CONTACT : orchidee-help _at_ listes.ipsl.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), DIMENSION(kjpindex) :: So !! Maximum radiation at the Earth surface (W.m^{-2})
627	REAL(r_std), DIMENSION(kjpindex) :: Rfrac !! Parameter in the regression of diffuse
628	!! share on transmission
629	REAL(r_std), DIMENSION(kjpindex) :: Kfrac !! Parameter in the regression of diffuse
630	!! share on transmission
631	REAL(r_std), DIMENSION(kjpindex) :: swdf !! Sw diffuse radiation (W.m^{-2})
632	REAL(r_std), DIMENSION(kjpindex) :: swdr !! Sw direct radiation (W.m^{-2})
633	REAL(r_std), DIMENSION(kjpindex,nvm) :: PARscat !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
634	REAL(r_std), DIMENSION(kjpindex,nvm) :: Clsun_iso !! Isoprene dependance to light for sun leaves
635	REAL(r_std), DIMENSION(kjpindex,nvm) :: Clsh_iso !! Isoprene dependance to light for shaded leaves
636	!! for multilayer canopy model for iso flux
637	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: PARscattab !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
638	REAL(r_std), DIMENSION(nlai+1) :: laitab !! LAI per layer (m^2.m^{-2})
639	REAL(r_std), DIMENSION(kjpindex,nlai) :: laisuntabdep !! LAI of sun leaves in each layer (m^2.m^{-2})
640	REAL(r_std), DIMENSION(kjpindex,nlai) :: laishtabdep !! LAI of shaded leaves in each layer
641	!! (m^2.m^{-2})
642	REAL(r_std) :: Clsun_iso_tab !! Isoprene dependance to light
643	!! for sun leaves and per layer
644	REAL(r_std) :: Clsh_iso_tab !! Isoprene dependance to light
645	!! for shaded leaves and per layer
646	!for multilayer canopy model Spitter et al. 1986
647	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: PARnotscat !! Not-Scattered PAR
648	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: PARabsdir !! Absorbed light of the PAR direct flux
649	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: PARabsdiff !! Absorbed light of the PAR diffuse flux
650	REAL(r_std), PARAMETER :: sigma = 0.20 !! scattering coefficient of single leaves and for visible radiation
651	REAL(r_std), PARAMETER :: cluster = 0.85 !! clustering coefficient for leaves, the same that is setting for default in MEGAN V2.10
652	REAL(r_std) :: rho !! reflection index of a green, closed vegetation
653	REAL(r_std) :: kbl !! extinction coefficient of black leaves
654	REAL(r_std) :: kdf !! extinction coefficient of diffuse flux
655	!!Leaf age
656	REAL(r_std), DIMENSION(kjpindex,nvm) :: Eff_age_iso !! Isoprene emission dependance to Leaf Age
657	REAL(r_std), DIMENSION(kjpindex,nvm) :: Eff_age_meth !! Methanol emission dependance to Leaf Age
658	REAL(r_std), DIMENSION(kjpindex,nvm) :: Eff_age_VOC !! Other VOC emission dependance to Leaf Age
659	!!BBG and Fertilizers for NOx soil emission
660	REAL(r_std), DIMENSION(kjpindex) :: veget_max_nowoody !! sum of veget_max for non-woody PFT
661	REAL(r_std), DIMENSION(kjpindex,nvm) :: N_qt_WRICE_pft !! N fertiliser on RICE
662	!! (kgN per year per grid cell)
663	REAL(r_std), DIMENSION(kjpindex,nvm) :: N_qt_OTHER_pft !! N fertiliser on other veg
664	!! (kgN per year per grid cell)
665	!! CO2 inhibition effect on isoprene
666	REAL(r_std),DIMENSION (kjpindex,nvm) :: fco2_wshort !! Wilkinson short term function for CO2 impact on BVOC (isoprene)
667	REAL(r_std),DIMENSION (kjpindex) :: fco2_wlong !! Wilkinson long term function for CO2 impact on BVOC (isoprene)
668	REAL(r_std) :: fco2_ctrl
669	REAL(r_std),DIMENSION (kjpindex,nvm) :: fco2 !! Function for CO2 impact on BVOC (isoprene)
670	REAL(r_std), DIMENSION(kjpindex) :: Ismax_short
671	REAL(r_std), DIMENSION(kjpindex) :: h_short
672	REAL(r_std), DIMENSION(kjpindex) :: Cstar_short
673	REAL(r_std) :: Ismax_long
674	REAL(r_std) :: h_long
675	REAL(r_std) :: Cstar_long
676
677	!! 0.5 Parameters values
678
679	REAL(r_std), PARAMETER :: CT1 = 95000.0 !! Empirical coeffcient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
680	REAL(r_std), PARAMETER :: CT2 = 230000.0 !! Empirical coefficient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
681	REAL(r_std), PARAMETER :: TS = 303.0 !! Leaf temperature at standard condition
682	!! (see Guenther .et. al, 1995, eq(10)) (K)
683	REAL(r_std), PARAMETER :: TM = 314.0 !! Leaf temperature (see Guenther .et. al, 1995, eq(10)) (K)
684
685	REAL(r_std), PARAMETER :: alpha_ = 0.0027 !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
686	REAL(r_std), PARAMETER :: CL1 = 1.066 !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
687	REAL(r_std), PARAMETER :: beta = 0.09 !! Empirical coeffcient (see Guenther .et. al, 1995, eq(11)) (K^{-1})
688	REAL(r_std), PARAMETER :: lai_threshold = 11. !! Lai threshold for the calculation of scattered radiation
689	!! based on Guenther .et. al (1995) (m^2.m^{-2})
690
691
692	! Biogenic emissions
693	REAL(r_std),DIMENSION(kjpindex) :: PAR !! Photosynthetic active radiation, half of swdown
694	!! @tex ($\mu mol photons. m^{-2} s^{-1}$) @endtex
695	REAL(r_std),DIMENSION(kjpindex,nvm) :: PARsun !! PAR received by sun leaves
696	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
697	REAL(r_std),DIMENSION(kjpindex,nvm) :: PARsh !! PAR received by shaded leaves
698	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
699	REAL(r_std),DIMENSION(kjpindex,nvm) :: laisun !! Leaf area index of Sun leaves (m^2.m^{-2})
700	REAL(r_std),DIMENSION(kjpindex,nvm) :: laish !! Leaf area index of Shaded leaves (m^2.m^{-2})
701
702	CHARACTER(LEN=14) :: tleafsun_name !! To store variables names for I/O
703	CHARACTER(LEN=13) :: tleafsh_name !! To store variables names for I/O
704	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: Tleafsun_temp !! temporary sunlit leaf temperature matrix for writing
705	REAL(r_std), DIMENSION(kjpindex,nlai+1) :: Tleafsh_temp !! temporary shade leaf temperature matrix for writing
706	REAL(r_std),DIMENSION(kjpindex) :: Fdf !! Fraction of the radiation which is diffused (0-1, unitless)
707	REAL(r_std),DIMENSION(kjpindex,nlai+1) :: PARsuntab !! PAR received by sun leaves over LAI layers
708	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
709	REAL(r_std),DIMENSION(kjpindex,nlai+1) :: PARshtab !! PAR received by shaded leaves over LAI layers
710	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
711	REAL(r_std),DIMENSION(kjpindex) :: PARdf !! Diffuse photosynthetic active radiation
712	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
713	REAL(r_std),DIMENSION(kjpindex) :: PARdr !! Direct photosynthetic active radiation
714	!! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
715	REAL(r_std),DIMENSION(kjpindex) :: Trans !! Atmospheric Transmissivity (unitless)
716
717	!_ ================================================================================================================================
718	fco2 = 0.
719	fco2_wshort = 0.
720	fco2_wlong = 0.
721	Fdf(:) = 0.
722	PAR(:) = 0.
723	PARsun(:,:) = 0.
724	PARsh(:,:) = 0.
725	laisun(:,:) = 0.
726	laish(:,:) = 0.
727	CRF(:,:) = 0.
728	Trans(:) = 0.
729	PARdf(:) = 0.
730	PARdr(:) = 0.
731	PARsuntab(:,:) = 0.
732	PARshtab(:,:) = 0.
733
734
735	!! 1. Canopy radiative transfer model
736
737	!! Canopy radiative transfer model: takes into account light extinction through canopy
738	!! First need to calculate diffuse and direct radiation
739	!! Based on Andrew Friend radiative model (Global Ecology & Biogeography, 2001)
740	!! And Spitters et al. (Agricultural and Forest Meteorology, 1986)
741
742	IF ( ok_radcanopy ) THEN
743
744	DO ji = 1, kjpindex
745	IF (coszang(ji) .GT. zero) THEN
746	!! 1.1 Extra-terrestrial solar irradiance at a plan parallel to Earh's surface
747	So(ji) = Sct( un + 0.033COS(360.pi/180.julian_diff/365.))*coszang(ji)
748	!! 1.2 Atmospheric transmissivity
749	Trans(ji) = swdown(ji)/So(ji)
750	!! 1.3 Empirical calculation of fraction diffuse from transmission based on Spitters et al. (1986)
751	Rfrac(ji) = 0.847 - 1.61coszang(ji) + 1.04(coszang(ji)**2.)
752	Kfrac(ji) = (1.47 - Rfrac(ji))/1.66
753	IF (Trans(ji) .LE. 0.22) THEN
754	Fdf(ji) = un
755	ELSE IF (Trans(ji) .LE. 0.35) THEN
756	Fdf(ji) = un - 6.4((Trans(ji) - 0.22)*2.)
757	ELSE IF (Trans(ji) .LE. Kfrac(ji)) THEN
758	Fdf(ji) = 1.47 - 1.66*Trans(ji)
759	ELSE
760	Fdf(ji) = Rfrac(ji)
761	END IF
762	!! 1.4 Direct and diffuse sw radiation in W.m^{-2}
763	swdf(ji) = swdown(ji)*Fdf(ji)
764	swdr(ji) = swdown(ji)*(un-Fdf(ji))
765	ELSE
766	swdf(ji) = zero
767	swdr(ji) = zero
768	END IF
769
770	!! 1.5 PAR diffuse and direct in umol/m^2/s
771	PARdf(ji) = swdf(ji) * W_to_mol * RG_to_PAR
772	PARdr(ji) = swdr(ji) * W_to_mol * RG_to_PAR
773	END DO
774
775	!! 1.6 Calculation of lai, parscat, parsh and parsun, laisun and laish !!?? define the terms
776	!! Based on Guenther et al. (JGR, 1995) and Norman (1982)
777	! One-layer canopy model or multi-layer canopy model
778	IF (ok_multilayer) THEN
779
780
781	! Calculation PER LAYER
782	DO jl = nlai+1, 1, -1
783	laitab(jl) = laimax(EXP(lai_level_depth(jl-1) - un)/(EXP(lai_level_depth*nlai) - un))
784
785	!introduction of the Spitter way to calculate radiation over the levels !!!!!!!
786	DO ji = 1, kjpindex
787	kdf = cluster0.8SQRT((1 - sigma))
788	IF (ABS(ACOS(coszang(ji))) .LT. pi/2. .AND. coszang(ji) .NE. zero) THEN
789	! Coefficients calculation:
790	kbl = cluster*0.5/ABS(coszang(ji))
791	rho = ((1-SQRT((1 - sigma)))/(1+SQRT((1 - sigma))))(2/(1+1.6ABS(coszang(ji))))
792
793	PARnotscat(ji,jl) = (1 - sigma)PARdr(ji)kblEXP(-SQRT((1 - sigma))kbl*laitab(jl))
794	PARabsdir(ji,jl) = (1 - rho)SQRT((1 - sigma))PARdr(ji)kblEXP(-SQRT((1 - sigma))kbllaitab(jl))
795	PARabsdiff(ji,jl) = (1 - rho)PARdf(ji)kdfEXP(-kdflaitab(jl))
796	PARshtab(ji,jl) = (PARabsdiff(ji,jl) + (PARabsdir(ji,jl) - PARnotscat(ji,jl)))/(1 - sigma)
797	PARsuntab(ji,jl) = PARshtab(ji,jl) + (1-sigma)kblPARdr(ji)/(1 - sigma)
798
799	!correction using the equation (4) in Bodin et al 2012 and (7) or (8) in Spitter et al 1986
800	!using the extinction coefficient kbl = 0.5/coszang and not only 0.5
801	IF (jl .NE. nlai+1) THEN
802	laisuntabdep(ji,jl) =(laitab(jl+1)-laitab(jl))EXP(-kbllaitab(jl))
803	laishtabdep(ji,jl) =(laitab(jl+1)-laitab(jl))(1.-EXP(-kbllaitab(jl)))
804	ENDIF
805
806	ELSE
807
808	PARshtab(ji,jl) = PARdf(ji)kdfEXP(-kdf*laitab(jl))
809	PARsuntab(ji,jl) = 0.
810
811	IF (jl .NE. nlai+1) THEN
812	laisuntabdep(ji,jl) = 0.
813	laishtabdep(ji,jl) = laitab(jl+1)-laitab(jl)
814
815	ENDIF
816	END IF
817	END DO
818	END DO
819
820
821
822	! introduction of the Spitter way to calculate radiation over the levels !!!!!!!
823	ELSE
824	! Calculation FOR one layer
825	DO jv = 1, nvm
826	DO ji = 1, kjpindex
827	IF (lai(ji,jv) .LE. lai_threshold) THEN
828	PARscat(ji,jv) = 0.07PARdr(ji)(1.1 - 0.1lai(ji,jv))exp(-coszang(ji))
829	ELSE
830	PARscat(ji,jv) = zero
831	END IF
832
833	IF (coszang(ji) .NE. zero ) THEN
834	PARsh(ji,jv) = PARdf(ji)exp(-0.5((lai(ji,jv))**0.7)) + PARscat(ji,jv)
835	PARsun(ji,jv) = PARdr(ji)COS(60.pi/180.)/coszang(ji) + PARsh(ji,jv)
836	ELSE
837	PARsh(ji,jv) = PARdf(ji)exp(-0.5(lai(ji,jv)**0.7)) + PARscat(ji,jv)
838	PARsun(ji,jv) = zero
839	END IF
840	IF (ABS(ACOS(coszang(ji))) .LT. pi/2. .AND. coszang(ji) .NE. zero) THEN
841	! calculation as in Lathiere (2005) = with correction removing lai in Guenther (1995)
842	laisun(ji,jv) = (un - exp(-0.5lai(ji,jv)/(coszang(ji))))coszang(ji)/COS(60.*pi/180.)
843	laish(ji,jv) = lai(ji,jv) - laisun(ji,jv)
844	ELSE
845	laisun(ji,jv) = zero
846	laish(ji,jv) = lai(ji,jv)
847	END IF
848	END DO
849	END DO
850	ENDIF
851	END IF
852
853
854	!! 2. Calculation of non-PFT dependant parameters used for VOC emissions
855	DO ji = 1, kjpindex ! (loop over # pixels)
856	!! 2.1 Calculation of Tleaf (based on Lathiere, 2005)
857
858
859	tleaf(ji) = temp_air(ji)
860
861	!! 2.2 Isoprene emission dependency - with no PARsun/PARshaded partitioning - Guenther et al. (1995) and Lathiere (2005)
862	!> @codeinc $$?? ecrire les equation en latex ?
863	exp_1(ji) = exp( (CT1 * ( tleaf(ji) - TS )) / (RRTStleaf(ji)) )
864	exp_2(ji) = exp( (CT2 ( tleaf(ji) - TM )) / (RRTS*tleaf(ji)) )
865	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
866	Ct_iso(ji) = exp_1(ji)/(un + exp_2(ji)) ! temperature dependance
867	Cl_iso(ji) = alpha_CL1PAR(ji)/sqrt(un + (alpha_*2) (PAR(ji)**2) ) ! light dependance
868	!> @endcodeinc
869
870	!! 2.3 Monoterpene and oxy VOB emission dependency to Temperature
871	!! light independant fraction
872	!> @codeinc
873	!Ct_mono(ji) = exp(beta*(tleaf(ji) - TS)) ! Old method
874	Ct_mono(ji) = exp(beta_mono*(tleaf(ji) - TS))
875	Ct_sesq(ji) = exp(beta_sesq*(tleaf(ji) - TS))
876	Ct_meth(ji) = exp(beta_meth*(tleaf(ji) - TS))
877	Ct_acet(ji) = exp(beta_acet*(tleaf(ji) - TS))
878	Ct_oxyVOC(ji) = exp(beta_oxyVOC*(tleaf(ji) - TS))
879	!> @endcodeinc
880	!! 2.4 MBO biogenic emissions dependency, only from PFT7 and PFT4 for location of vegetation emitter
881	! but in fact MBO fluxes only in America (ponderosa and lodgepole pines only found in these areas)
882	!> @codeinc
883	Xvar(ji) = ((un/312.3) - (un/tleaf(ji)))/RR
884	!> @endcodeinc
885	!! 2.4.1 temperature dependency
886	!> @codeinc
887	Ct_MBO(ji) = (1.52209000.0exp(67000.0Xvar(ji)))/(209000.0 - 67000.0(un - exp(209000.0*Xvar(ji))))
888	!> @endcodeinc
889	!! 2.4.2 light dependency
890	Cl_MBO(ji) = (0.00111.44PAR(ji))/(sqrt(un + (0.0011*2)(PAR(ji)**2)))
891	!! 2.5 NO biogenic emissions given in ngN/m^2/s, emission factor in ngN/m^2/s too
892	!! calculation of temperature used for NO soil emissions
893	t_no(ji) = ptnlev1(ji) - ZeroCelsius !!temp must be in celsius to calculate no emissions
894	!! 2.6 calculation of non-woody veget_max fraction
895	IF (ok_cropsfertil_NOx) THEN
896	veget_max_nowoody(ji) = zero
897	DO jv = 1,nvm
898	IF ( (jv /= ibare_sechiba) .AND. .NOT.(is_tree(jv)) ) THEN
899	veget_max_nowoody(ji) = veget_max_nowoody(ji) + veget_max(ji,jv)
900	ENDIF
901	ENDDO
902	END IF
903	END DO ! (loop over # pixels)
904
905	!! 2bis. Calculation of CO2 function for inhibition effect on isoprene
906	! 2 approaches can be used: either Possell et al. (2005) or Wilkinson et al. (2006)
907
908	!! 19/04/2010 and then implemented in version revised by Nicolas Vuichard, 08042014
909	!! Impact of atmospheric CO2 on isoprene emissions
910	!! Can be activated or not
911	!! If considered, can use either Possell 2005 or Wilkinson 2009 parameterisation
912	!! This is used to rescale the emission factor, considered to be measured at 350 ppm of CO2
913	!! to the CO2 conditions of the run
914
915	IF ( ok_co2bvoc_poss ) THEN
916	WRITE(numout,*) 'CO2 impact on isoprene: Possell calculation'
917
918	!! Possell function needs to be normalized (experiments at 400 ppm and EF before 1995)
919	!! Normalized at 350 ppm
920	fco2_ctrl = (-0.0123+(441.4795/350.)+(-1282.65/(350.**2)))
921
922	!! 2 tests: using the canopy (atmospheric) CO2 'ccanopy'
923	!! or the intercellular CO2 over nlai 'cim'
924	!! with cim = ccanopy*0.667
925	!! in the end I go for ccanopy for the Possell function since too much differences
926	!! when using cim and also the function has been derived based on atmospheric CO2
927	DO ji = 1, kjpindex
928
929	fco2(ji,:) = (-0.0123+(441.4795/ccanopy(ji))+(-1282.65/(ccanopy(ji)*ccanopy(ji))))/fco2_ctrl
930
931	END DO
932	ELSE IF ( ok_co2bvoc_wilk ) THEN
933	WRITE(numout,*) 'CO2 impact on isoprene: Wilkinson calculation'
934
935	!! In the Wilkinson function, 2 impacts are considered:
936	!! -short-term impact for CO2 variation during a single day (seconds/minutes)
937	!! -long-term impact for CO2 variation during leaf-growth (weeks/month)
938
939
940	!! Long-term parameters
941	!! Constant
942	Ismax_long = 1.344
943	h_long = 1.4614
944	Cstar_long = 585.
945	!! Short-term parameters
946	!! They have to be calculated based on atmospheric CO2
947	!! 10/05/2010
948	!! For atmospheric CO2 lower than 400 ppm or higher than 1200 ppm
949	!! (min and max CO2 level tested for short-term effect in Wilkinson et al. 2009)
950	!! we use the parameters calculated at 400/1200 ppm. For intermediate CO2 concentration,
951	!! parameters are calculated.
952	!! Linear interpolation
953
954	DO ji = 1, kjpindex
955
956	IF (ccanopy(ji) .LE. 400.) THEN
957
958	Ismax_short(ji) = 1.072
959	h_short(ji) = 1.7
960	Cstar_short(ji) = 1218.
961
962	ELSE IF (ccanopy(ji) .EQ. 600.) THEN
963
964	Ismax_short(ji) = 1.036
965	h_short(ji) = 2.0125
966	Cstar_short(ji) = 1150.
967
968	ELSE IF (ccanopy(ji) .EQ. 800.) THEN
969
970	Ismax_short(ji) = 1.046
971	h_short(ji) = 1.5380
972	Cstar_short(ji) = 2025.
973
974	ELSE IF (ccanopy(ji) .GE. 1200.) THEN
975
976	Ismax_short(ji) = 1.014
977	h_short(ji) = 2.8610
978	Cstar_short(ji) = 1525.
979
980
981	ELSE IF ((ccanopy(ji) .GT. 400.) .AND. (ccanopy(ji) .LT. 600.)) THEN
982
983	Ismax_short(ji) = 1.036 + (ccanopy(ji)-600.)*(1.036-1.072)/(600.-400.)
984	h_short(ji) = 2.0125 + (ccanopy(ji)-600.)*(2.0125-1.7)/(600.-400.)
985	Cstar_short(ji) = 1150. + (ccanopy(ji)-600.)*(1150.-1218.)/(600.-400.)
986
987	ELSE IF ((ccanopy(ji) .GT. 600.) .AND. (ccanopy(ji) .LT. 800.)) THEN
988
989	Ismax_short(ji) = 1.046 + (ccanopy(ji)-800.)*(1.046-1.036)/(800.-600.)
990	h_short(ji) = 1.5380 + (ccanopy(ji)-800.)*(1.5380-2.0125)/(800.-600.)
991	Cstar_short(ji) = 2025. + (ccanopy(ji)-800.)*(2025.-1150.)/(800.-600.)
992
993	ELSE IF ((ccanopy(ji) .GT. 800.) .AND. (ccanopy(ji) .LT. 1200.)) THEN
994
995	Ismax_short(ji) = 1.014 + (ccanopy(ji)-1200.)*(1.014-1.046)/(1200.-800.)
996	h_short(ji) = 2.8610 + (ccanopy(ji)-1200.)*(2.8610-1.5380)/(1200.-800.)
997	Cstar_short(ji) = 1525. + (ccanopy(ji)-1200.)*(1525.-2025.)/(1200.-800.)
998
999
1000	END IF
1001
1002	END DO
1003
1004	WRITE(numout,) 'Wilkinson BVOC-CO2 function: parameters*'
1005	WRITE(numout,*) 'Ismax_long: ', Ismax_long
1006	WRITE(numout,*) 'h_long: ', h_long
1007	WRITE(numout,*) 'Cstar_long: ', Cstar_long
1008	WRITE(numout,*) 'Ismax_short: ', MAXVAL(Ismax_short(:)) , MINVAL(Ismax_short(:))
1009	WRITE(numout,*) 'h_short: ', MAXVAL(h_short(:)) , MINVAL(h_short(:))
1010	WRITE(numout,*) 'Cstar_short: ', MAXVAL(Cstar_short(:)) , MINVAL(Cstar_short(:))
1011	WRITE(numout,) '*****'
1012
1013	DO ji = 1, kjpindex
1014	fco2_wlong(ji) = (Ismax_long-((Ismax_long((0.667ccanopy(ji))**h_long))/&
1015	& ((Cstar_long*h_long)+(0.667ccanopy(ji))**h_long)))/1.06566
1016	DO jv = 1, nvm
1017	fco2_wshort(ji,jv) = (Ismax_short(ji)-((Ismax_short(ji)((cim(ji,jv))*h_short(ji)))/&
1018	& ((Cstar_short(ji)h_short(ji))+(cim(ji,jv))h_short(ji))))/1.010803
1019	END DO
1020	END DO
1021
1022	DO ji = 1, kjpindex
1023	DO jv = 1, nvm
1024	fco2(ji,jv) = fco2_wshort(ji,jv)*fco2_wlong(ji)
1025	END DO
1026	END DO
1027
1028	ELSE
1029	WRITE(numout,*) 'CO2 impact on isoprene not considered'
1030	fco2(:,:) = 1.
1031	END IF
1032
1033
1034	!! 3. Calculation of PFT dependant parameters and
1035	! Calculation of VOC emissions flux
1036
1037	Eff_age_iso(:,:) = zero
1038	Eff_age_meth(:,:) = zero
1039
1040
1041	DO jv = 1, nvm ! loop over the PDFs
1042	DO ji = 1, kjpindex ! loop over the grid cell
1043	! 6-Calculation of Leaf Age Function (Lathiere 2005)
1044	IF ( ok_leafage ) THEN
1045	DO jf = 1, nleafages
1046	!> @codeinc
1047	Eff_age_iso(ji,jv) = Eff_age_iso(ji,jv) + frac_age(ji,jv,jf)*iso_activity(jf)
1048	Eff_age_meth(ji,jv) = Eff_age_meth(ji,jv) + frac_age(ji,jv,jf)*methanol_activity(jf)
1049	!> @endcodeinc
1050	END DO
1051	!> @codeinc
1052	Eff_age_VOC(ji,jv) = un
1053	!> @endcodeinc
1054	ELSE
1055	Eff_age_iso(ji,jv) = un
1056	Eff_age_meth(ji,jv) = un
1057	Eff_age_VOC(ji,jv) = un
1058	END IF
1059	!! 5. Calculation of foliar density
1060	IF ( sla(jv) .eq. zero ) THEN
1061	fol_dens(ji,jv) = zero
1062	ELSE
1063	! 2 factor for conversion from gC to gDM
1064	fol_dens(ji,jv) = 2 * lai(ji,jv)/sla(jv)
1065	ENDIF
1066	!! 6. Calculation of VOC emissions from vegetation
1067	IF ( ok_radcanopy ) THEN
1068	! if multi-layer canopy model
1069	IF (ok_multilayer) THEN
1070
1071	laisun(ji,jv) = zero
1072	laish(ji,jv) = zero
1073	GAMMA_iso_m = zero
1074	flx_iso(ji,jv) = zero
1075	flx_mono(ji,jv) = zero
1076	flx_apinen(ji,jv) = zero
1077	flx_bpinen(ji,jv) = zero
1078	flx_limonen(ji,jv) = zero
1079	flx_myrcen(ji,jv) = zero
1080	flx_sabinen(ji,jv) = zero
1081	flx_camphen(ji,jv) = zero
1082	flx_3caren(ji,jv) = zero
1083	flx_tbocimen(ji,jv) = zero
1084	flx_othermono(ji,jv) = zero
1085	flx_sesquiter(ji,jv) = zero
1086	flx_methanol(ji,jv) = zero
1087	flx_acetone(ji,jv) = zero
1088	flx_acetal(ji,jv) = zero
1089	flx_formal(ji,jv) = zero
1090	flx_acetic(ji,jv) = zero
1091	flx_formic(ji,jv) = zero
1092	! loop over the NLAI canopy layers
1093	DO jl = 1, nlai
1094	IF ((laitab(jl) .LE. lai(ji,jv)).AND.(lai(ji,jv).NE.zero)) THEN
1095	!sunlit vegetation
1096	Clsun_iso_tab = alpha_CL1PARsuntab(ji,jl)/sqrt(un + (alpha_*2) (PARsuntab(ji,jl)**2) )
1097	! shaded vegetation
1098	Clsh_iso_tab = alpha_CL1PARshtab(ji,jl)/sqrt(un + (alpha_*2) (PARshtab(ji,jl)**2) )
1099	flx_iso(ji,jv) = flx_iso(ji,jv) + (laisuntabdep(ji,jl)*Clsun_iso_tab+ &
1100	& laishtabdep(ji,jl)Clsh_iso_tab) &
1101	& fol_dens(ji,jv)/lai(ji,jv)Ct_iso(ji)em_factor_isoprene(jv)* &
1102	& Eff_age_iso(ji,jv)fco2(ji,jv)1e-9/one_hour
1103
1104	GAMMA_iso_m = GAMMA_iso_m + (laisuntabdep(ji,jl)*Clsun_iso_tab+ &
1105	& laishtabdep(ji,jl)Clsh_iso_tab) &
1106	& fol_dens(ji,jv)/lai(ji,jv)Ct_iso(ji)1e-9/one_hour
1107
1108	laisun(ji,jv) = laisun(ji,jv) + laisuntabdep(ji,jl)
1109	laish(ji,jv) = laish(ji,jv) + laishtabdep(ji,jl)
1110	END IF
1111	END DO
1112
1113	!! 6.1 Calculation of monoterpene biogenic emissions
1114	flx_mono(ji,jv) = ((1-LDF_mono)Ct_mono(ji)1e-9/one_hourfol_dens(ji,jv) + LDF_monoGAMMA_iso_m)* &
1115	& em_factor_monoterpene(jv)*Eff_age_VOC(ji,jv)
1116	!! 6.12 Calculation of sesquiterpenes biogenic emission
1117	flx_sesquiter(ji,jv) = ((1-LDF_sesq)Ct_sesq(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_sesqGAMMA_iso_m)* &
1118	& em_factor_sesquiterp(jv)*Eff_age_VOC(ji,jv)
1119	!! 6.13 Calculation of methanol biogenic emissions
1120	flx_methanol(ji,jv) = ((1-LDF_meth)Ct_meth(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_methGAMMA_iso_m)* &
1121	& em_factor_methanol(jv)*Eff_age_meth(ji,jv)
1122	!! 6.14 Calculation of acetone biogenic emissions
1123	flx_acetone(ji,jv) = ((1-LDF_acet)Ct_acet(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_acetGAMMA_iso_m)* &
1124	& em_factor_acetone(jv)*Eff_age_VOC(ji,jv)
1125	!! 6.14 Calculation of acetaldehyde biogenic emissions
1126	flx_acetal(ji,jv) = ((1-LDF_meth)Ct_meth(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_methGAMMA_iso_m)* &
1127	& em_factor_acetal(jv)*Eff_age_VOC(ji,jv)
1128	!! 6.16 Calculation of formaldehyde biogenic emissions
1129	flx_formal(ji,jv) = ((1-LDF_meth)Ct_meth(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_methGAMMA_iso_m)* &
1130	& em_factor_formal(jv)*Eff_age_VOC(ji,jv)
1131	!! 6.17 Calculation of acetic acid biogenic emissions
1132	flx_acetic(ji,jv) = ((1-LDF_meth)Ct_meth(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_methGAMMA_iso_m)* &
1133	& em_factor_acetic(jv)*Eff_age_VOC(ji,jv)
1134	!! 6.18 Calculation of formic acid biogenic emissions
1135	flx_formic(ji,jv) = ((1-LDF_meth)Ct_meth(ji)1e-9/one_hourfol_dens(ji,jv) +LDF_methGAMMA_iso_m)* &
1136	& em_factor_formic(jv)*Eff_age_VOC(ji,jv)
1137
1138
1139	!! 6.3 Calculation of alfa pinene biogenic emission
1140	flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv)
1141	!! 6.4 Calculation of beta pinene biogenic emission
1142	flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv)
1143	!! 6.5 Calculation of limonene biogenic emission
1144	flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv)
1145	!! 6.6 Calculation of myrcene biogenic emission !!
1146	flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv)
1147	!! 6.7 Calculation of sabinene biogenic emission
1148	flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv)
1149	!! 6.8 Calculation of camphene biogenic emission
1150	flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv)
1151	!! 6.9 Calculation of 3-carene biogenic emission
1152	flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv)
1153	!! 6.10 Calculation of t-beta-ocimene biogenic emission
1154	flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv)
1155	!! 6.11 Calculation of other monoterpenes biogenic emission
1156	flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv)
1157
1158	! if mono-layer canopy model
1159	ELSE
1160	!sunlit vegetation
1161	Clsun_iso(ji,jv) = alpha_CL1PARsun(ji,jv)/sqrt(un + (alpha_*2) (PARsun(ji,jv)**2) )
1162	! shaded vegetation
1163	Clsh_iso(ji,jv) = alpha_CL1PARsh(ji,jv)/sqrt(un + (alpha_*2) (PARsh(ji,jv)**2) )
1164	IF (lai(ji,jv) .NE. zero) THEN
1165	!! 6.1 Calculation of isoprene biogenic emissions
1166	GAMMA_iso = (laisun(ji,jv)Clsun_iso(ji,jv) + laish(ji,jv)Clsh_iso(ji,jv))/lai(ji,jv)*Ct_iso(ji)
1167	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
1168	!! 6.2 Calculation of monoterpene biogenic emissions
1169	flx_mono(ji,jv) = ((1-LDF_mono)Ct_mono(ji)+LDF_monoGAMMA_iso)fol_dens(ji,jv) &
1170	& em_factor_monoterpene(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1171	!! 6.3 Calculation of alfa pinene biogenic emission
1172	flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv)
1173	!! 6.4 Calculation of beta pinene biogenic emission
1174	flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv)
1175	!! 6.5 Calculation of limonene biogenic emission
1176	flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv)
1177	!! 6.6 Calculation of myrcene biogenic emission
1178	flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv)
1179	!! 6.7 Calculation of sabinene biogenic emission
1180	flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv)
1181	!! 6.8 Calculation of camphene biogenic emission
1182	flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv)
1183	!! 6.9 Calculation of 3-carene biogenic emission
1184	flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv)
1185	!! 6.10 Calculation of t-beta-ocimene biogenic emission
1186	flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv)
1187	!! 6.11 Calculation of other monoterpenes biogenic emission
1188	flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv)
1189	!! 6.12 Calculation of sesquiterpenes biogenic emission
1190	flx_sesquiter(ji,jv) = ((1-LDF_sesq)Ct_sesq(ji)+LDF_sesqGAMMA_iso)fol_dens(ji,jv) &
1191	& em_factor_sesquiterp(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1192	!! 6.13 Calculation of methanol biogenic emissions
1193	flx_methanol(ji,jv) = ((1-LDF_meth)Ct_meth(ji)+LDF_methGAMMA_iso)fol_dens(ji,jv) &
1194	& em_factor_methanol(jv)Eff_age_meth(ji,jv)1e-9/one_hour
1195	!! 6.14 Calculation of acetone biogenic emissions
1196	flx_acetone(ji,jv) = ((1-LDF_acet)Ct_acet(ji)+LDF_acetGAMMA_iso)fol_dens(ji,jv) &
1197	& em_factor_acetone(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1198	!! 6.15 Calculation of acetaldehyde biogenic emissions
1199	flx_acetal(ji,jv) = ((1-LDF_meth)Ct_meth(ji)+LDF_methGAMMA_iso)fol_dens(ji,jv) &
1200	& em_factor_acetal(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1201	!! 6.16 Calculation of formaldehyde biogenic emissions
1202	flx_formal(ji,jv) = ((1-LDF_meth)Ct_meth(ji)+LDF_methGAMMA_iso)fol_dens(ji,jv) &
1203	& em_factor_formal(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1204	!! 6.17 Calculation of acetic acid biogenic emissions
1205	flx_acetic(ji,jv) = ((1-LDF_meth)Ct_meth(ji)+LDF_methGAMMA_iso)fol_dens(ji,jv) &
1206	& em_factor_acetic(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1207	!! 6.18 Calculation of formic acid biogenic emissions
1208	flx_formic(ji,jv) = ((1-LDF_meth)Ct_meth(ji)+LDF_methGAMMA_iso)fol_dens(ji,jv) &
1209	& em_factor_formic(jv)Eff_age_VOC(ji,jv)1e-9/one_hour
1210
1211	ELSE
1212	!
1213	flx_iso(ji,jv) = zero
1214	flx_mono(ji,jv) = zero
1215	flx_apinen(ji,jv) = zero
1216	flx_bpinen(ji,jv) = zero
1217	flx_limonen(ji,jv) = zero
1218	flx_myrcen(ji,jv) = zero
1219	flx_sabinen(ji,jv) = zero
1220	flx_camphen(ji,jv) = zero
1221	flx_3caren(ji,jv) = zero
1222	flx_tbocimen(ji,jv) = zero
1223	flx_othermono(ji,jv) = zero
1224	flx_sesquiter(ji,jv) = zero
1225	flx_methanol(ji,jv) = zero
1226	flx_acetone(ji,jv) = zero
1227	flx_acetal(ji,jv) = zero
1228	flx_formal(ji,jv) = zero
1229	flx_acetic(ji,jv) = zero
1230	flx_formic(ji,jv) = zero
1231	END IF
1232	END IF
1233	! if no light extinction due to vegetation
1234	ELSE
1235	!! Isoprene emissions - general equation
1236	flx_iso(ji,jv) = fol_dens(ji,jv)Ct_iso(ji)Cl_iso(ji)Eff_age_iso(ji,jv)fco2(ji,jv)* &
1237	em_factor_isoprene(jv)*1e-9/one_hour
1238	!! 6.2 Calculation of monoterpene biogenic emissions
1239	Ylt_mono(ji) = ((1-LDF_mono)Ct_mono(ji)+LDF_monoCt_iso(ji)*Cl_iso(ji))
1240	flx_mono(ji,jv) = fol_dens(ji,jv)em_factor_monoterpene(jv)Ylt_mono(ji)Eff_age_VOC(ji,jv)&
1241	1e-9/one_hour
1242	!! 6.3 Calculation of alfa pinene biogenic emission
1243	flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv)
1244	!! 6.4 Calculation of beta pinene biogenic emission
1245	flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv)
1246	!! 6.5 Calculation of limonene biogenic emission
1247	flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv)
1248	!! 6.6 Calculation of myrcene biogenic emission
1249	flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv)
1250	!! 6.7 Calculation of sabinene biogenic emission
1251	flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv)
1252	!! 6.8 Calculation of camphene biogenic emission
1253	flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv)
1254	!! 6.9 Calculation of 3-carene biogenic emission
1255	flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv)
1256	!! 6.10 Calculation of t-beta-ocimene biogenic emission
1257	flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv)
1258	!! 6.11 Calculation of other monoterpenes biogenic emission
1259	flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv)
1260	!! 6.12 Calculation of sesquiterpenes biogenic emission
1261	Ylt_sesq(ji) = ((1-LDF_sesq)Ct_sesq(ji)+LDF_sesqCt_iso(ji)*Cl_iso(ji))
1262	flx_sesquiter(ji,jv) = fol_dens(ji,jv)em_factor_sesquiterp(jv)Ylt_sesq(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1263	!! 6.16 Calculation of methanol biogenic emissions
1264	Ylt_meth(ji) = ((1-LDF_meth)Ct_meth(ji)+LDF_methCt_iso(ji)*Cl_iso(ji))
1265	flx_methanol(ji,jv) = fol_dens(ji,jv)em_factor_methanol(jv)Ylt_meth(ji)Eff_age_meth(ji,jv)1e-9/one_hour
1266	!! 6.17 Calculation of acetone biogenic emissions
1267	Ylt_acet(ji) = ((1-LDF_acet)Ct_acet(ji)+LDF_acetCt_iso(ji)*Cl_iso(ji))
1268	flx_acetone(ji,jv) = fol_dens(ji,jv)em_factor_acetone(jv)Ylt_acet(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1269	!! 6.18 Calculation of acetaldehyde biogenic emissions
1270	flx_acetal(ji,jv) = fol_dens(ji,jv)em_factor_acetal(jv)Ylt_meth(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1271	!! 6.19 Calculation of formaldehyde biogenic emissions
1272	flx_formal(ji,jv) = fol_dens(ji,jv)em_factor_formal(jv)Ylt_meth(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1273	!! 6.20 Calculation of acetic acid biogenic emissions
1274	flx_acetic(ji,jv) = fol_dens(ji,jv)em_factor_acetic(jv)Ylt_meth(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1275	!! 6.21 Calculation of formic acid biogenic emissions
1276	flx_formic(ji,jv) = fol_dens(ji,jv)em_factor_formic(jv)Ylt_meth(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1277
1278	END IF
1279
1280	!! 6.22 Calculation of ORVOC biogenic emissions
1281	!! Other Reactive Volatile Organic Compounds
1282	!> @codeinc
1283	flx_ORVOC(ji,jv) = fol_dens(ji,jv)em_factor_ORVOC(jv)Ct_mono(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1284	!> @endcodeinc
1285	!! 6.4 Calculation of OVOC biogenic emissions
1286	!! Other Volatile Organic Compounds
1287	flx_OVOC(ji,jv) = fol_dens(ji,jv)em_factor_OVOC(jv)Ct_mono(ji)Eff_age_VOC(ji,jv)1e-9/one_hour
1288	!! 6.5 Calculation of MBO biogenic emissions
1289	!! 2-Methyl-3-Buten-2-ol
1290	IF(lalo(ji,1) .GE. 20. .AND. lalo(ji,2) .LE. -100) THEN
1291	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
1292	ELSE
1293	flx_MBO(ji,jv) = zero
1294	END IF
1295	END DO
1296
1297	END DO
1298
1299
1300	!! 7. Calculation of NOx emissions from soils
1301	! Based on Yienger & Levy (1995) and Lathiere (2005, chapter 3)
1302	DO ji = 1, kjpindex
1303	!! 7.1 Precipitation-related pulse function
1304	IF (ok_pulse_NOx) THEN
1305	! if we are during a period where pulses are not allowed
1306	IF (ok_siesta(ji)) THEN
1307	! if this period is not over
1308	IF (FLOOR(siestaday(ji)) .LE. siestalim(ji)) THEN
1309	siestaday(ji) = siestaday(ji) + (dt_sechiba/one_day)
1310	! if this period is over
1311	ELSE
1312	ok_siesta(ji) = .FALSE.
1313	siestaday(ji) = zero
1314	END IF
1315	END IF
1316	! if we are during a period where pulses are allowed
1317	IF ((.NOT. ok_siesta(ji)) .AND. (.NOT. allow_pulse(ji))) THEN
1318	IF (humrel(ji,1) .LT. 0.15) THEN
1319	! if precip exceeds 1 mm/day over one time step => a pulse occurs
1320	IF(precip_rain(ji)/nbre_precip .GE. un/(one_day/dt_sechiba)) THEN
1321	! if precip is up to 5 mm/day => pulse length is 3 days
1322	IF (precip_rain(ji)/nbre_precip .LT. 5./(one_day/dt_sechiba)) THEN
1323	pulselim(ji) = 3.
1324	! if precip is up to 15 mm/day => pulse length is 7 days
1325	ELSE IF (precip_rain(ji)/nbre_precip .LT. 15./(one_day/dt_sechiba)) THEN
1326	pulselim(ji) = 7.
1327	! if precip is upper than 15 mm/day => pulse length is 14 days
1328	ELSE IF (precip_rain(ji)/nbre_precip .GE. 15./(one_day/dt_sechiba)) THEN
1329	pulselim(ji) = 14.
1330	END IF
1331	allow_pulse(ji)=.TRUE.
1332	pulseday(ji) = un
1333	END IF
1334	END IF
1335	END IF
1336	! if we were during a pulse period
1337	IF (allow_pulse(ji)) THEN
1338	! if we are still during the pulse period
1339	! 16/06/2010 We assume a (pulselim-1) days for the pulse length (NVui+Jlath)
1340	IF(FLOOR(pulseday(ji)) .LT. pulselim(ji)) THEN
1341	! calculation of the pulse function
1342	IF (pulselim(ji).EQ.3) THEN
1343	pulse(ji) = 11.19exp(-0.805pulseday(ji))
1344	ELSE IF (pulselim(ji).EQ.7) THEN
1345	pulse(ji) = 14.68exp(-0.384pulseday(ji))
1346	ELSE IF (pulselim(ji).EQ.14) THEN
1347	pulse(ji) = 18.46exp(-0.208pulseday(ji))
1348	END IF
1349	pulseday(ji) = pulseday(ji) + (dt_sechiba/one_day)
1350	! if the pulse period is over
1351	ELSE
1352	! pulse function is set to 1
1353	pulse(ji) = un
1354	allow_pulse(ji) = .FALSE.
1355	siestaday(ji) = un
1356	siestalim(ji) = pulselim(ji)
1357	ok_siesta(ji) = .TRUE.
1358	END IF
1359	END IF
1360	! no precipitation-related pulse function
1361	ELSE
1362	pulse(ji) = un
1363	END IF
1364	END DO
1365
1366	!! 7.2 Calculation of NO basal emissions including pulse effect
1367	DO jv = 1, nvm
1368	DO ji = 1, kjpindex
1369	!Tropical forests
1370	IF ( is_tropical(jv) .AND. is_evergreen(jv) ) THEN
1371	! Wet soils
1372	IF (humrel(ji,1) .GT. 0.3) THEN
1373	flx_no_soil(ji,jv) = 2.6*pulse(ji)
1374	! Dry soils
1375	ELSE
1376	flx_no_soil(ji,jv) = 8.6*pulse(ji)
1377	END IF
1378	!Else If agricultural lands OR Wet soils
1379	ELSE IF ( ( .NOT.(natural(jv)) ) .OR. ( humrel(ji,1) .GT. 0.3 ) ) THEN
1380	! Calculation of NO emissions depending of Temperature
1381	IF (t_no(ji) .LT. zero) THEN
1382	flx_no_soil(ji,jv) = zero
1383	ELSE IF (t_no(ji) .LE. 10.) THEN
1384	flx_no_soil(ji,jv) = 0.28em_factor_no_wet(jv)t_no(ji)*pulse(ji)
1385	ELSE IF (t_no(ji) .LE. 30.) THEN
1386	flx_no_soil(ji,jv) = em_factor_no_wet(jv)exp(0.103t_no(ji))*pulse(ji)
1387	ELSE
1388	flx_no_soil(ji,jv) = 21.97em_factor_no_wet(jv)pulse(ji)
1389	END IF
1390	!Else if Temp negative
1391	ELSE IF (t_no(ji) .LT. zero) THEN
1392	flx_no_soil(ji,jv) = zero
1393	!Else if Temp <= 30
1394	ELSE IF (t_no(ji) .LE. 30.) THEN
1395	flx_no_soil(ji,jv) = (em_factor_no_dry(jv)t_no(ji))/30.pulse(ji)
1396	ELSE
1397	flx_no_soil(ji,jv) = em_factor_no_dry(jv)*pulse(ji)
1398	END IF
1399
1400	!! 7.3 IF ACTIVATED (ok_bbgfertil_NOx = TRUE) calculation of NOx soil emission increase due to biomass burning
1401	! Calculation of Biomass-Burning-induced NOx emissions (Lathiere, 2005)
1402	! => NOx emissions 3-fold increase
1403	IF (ok_bbgfertil_NOx) THEN
1404	IF ( natural(jv) ) THEN
1405	! North Tropical zone from May to June
1406	IF ((lalo(ji,1) .LE. 30. .AND. lalo(ji,1) .GE. zero).AND. &
1407	(julian_diff .GE. 121. .AND. julian_diff .LE. 181).AND.(flx_co2_bbg_year(ji) .GT. 0.1)) THEN
1408	flx_no_soil(ji,jv) = flx_no_soil(ji,jv)*3.
1409	! South Tropical zone from November to December
1410	ELSE IF ((lalo(ji,1) .GE. -30. .AND. lalo(ji,1) .LT. zero).AND.(julian_diff .GE. 305.).AND. &
1411	(flx_co2_bbg_year(ji) .GT. 0.1)) THEN
1412	flx_no_soil(ji,jv) = flx_no_soil(ji,jv)*3.
1413	END IF
1414	END IF
1415	END IF
1416
1417	!! 7.4 IF ACTIVATED (ok_cropsfertil_NOx = TRUE) calculation of NOx soil emission increase due to fertilizer use
1418	! Calculation of N-fertiliser-induced NOx emissions
1419	flx_fertil_no(ji,jv) = zero
1420	IF (ok_cropsfertil_NOx) THEN
1421	IF (veget_max_nowoody(ji) .NE. zero) THEN
1422	! Non-agricultural lands
1423	IF ( (jv == ibare_sechiba) .OR. is_tree(jv) ) THEN
1424	N_qt_WRICE_pft(ji,jv) = zero
1425	N_qt_OTHER_pft(ji,jv) = zero
1426	! Grasslands or Croplands
1427	ELSE
1428	N_qt_WRICE_pft(ji,jv) = N_qt_WRICE_year(ji)*veget_max(ji,jv)/veget_max_nowoody(ji)
1429	N_qt_OTHER_pft(ji,jv) = N_qt_OTHER_year(ji)*veget_max(ji,jv)/veget_max_nowoody(ji)
1430	END IF
1431	ELSE
1432	N_qt_WRICE_pft(ji,jv) = zero
1433	N_qt_OTHER_pft(ji,jv) = zero
1434	END IF
1435
1436	! North temperate regions from May to August
1437	! OR South Temperate regions from November to February
1438	IF (((lalo(ji,1) .GT. 30.) .AND. (julian_diff .GE. 121. .AND. julian_diff .LE. 243.).AND. &
1439	(veget_max(ji,jv) .NE. zero)) .OR. &
1440	((lalo(ji,1) .LT. -30.) .AND. (julian_diff .GE. 305. .OR. julian_diff .LE. 59.) .AND.&
1441	(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.

Context Navigation

source: branches/publications/ORCHIDEE_gmd_2018_MICT-LEAK/src_sechiba/chemistry.f90 @ 7474

Download in other formats: