Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mksflx_p2p.F90 @ 6610

Last change on this file since 6610 was 6610, checked in by acosce, 10 months ago
INCA used for ICOLMDZORINCA_CO2_Transport_GMD_2023
File size: 32.2 KB

Line
1	!$Id: mksflx.F90 163 2010-02-22 15:41:45Z acosce $
2	!! =========================================================================
3	!! INCA - INteraction with Chemistry and Aerosols
4	!!
5	!! Copyright Laboratoire des Sciences du Climat et de l'Environnement (LSCE)
6	!! Unite mixte CEA-CNRS-UVSQ
7	!!
8	!! Contributors to this INCA subroutine:
9	!!
10	!! Didier Hauglustaine, LSCE, hauglustaine@cea.fr
11	!! Michael Schulz, LSCE, Michael.Schulz@cea.fr
12	!! Christiane Textor, LSCE
13	!!
14	!! Anne Cozic, LSCE, anne.cozic@cea.fr
15	!! Yann Meurdesoif, LSCE, yann.meurdesoif@cea.fr
16	!!
17	!! This software is a computer program whose purpose is to simulate the
18	!! atmospheric gas phase and aerosol composition. The model is designed to be
19	!! used within a transport model or a general circulation model. This version
20	!! of INCA was designed to be coupled to the LMDz GCM. LMDz-INCA accounts
21	!! for emissions, transport (resolved and sub-grid scale), photochemical
22	!! transformations, and scavenging (dry deposition and washout) of chemical
23	!! species and aerosols interactively in the GCM. Several versions of the INCA
24	!! model are currently used depending on the envisaged applications with the
25	!! chemistry-climate model.
26	!!
27	!! This software is governed by the CeCILL license under French law and
28	!! abiding by the rules of distribution of free software. You can use,
29	!! modify and/ or redistribute the software under the terms of the CeCILL
30	!! license as circulated by CEA, CNRS and INRIA at the following URL
31	!! "http://www.cecill.info".
32	!!
33	!! As a counterpart to the access to the source code and rights to copy,
34	!! modify and redistribute granted by the license, users are provided only
35	!! with a limited warranty and the software's author, the holder of the
36	!! economic rights, and the successive licensors have only limited
37	!! liability.
38	!!
39	!! In this respect, the user's attention is drawn to the risks associated
40	!! with loading, using, modifying and/or developing or reproducing the
41	!! software by the user in light of its specific status of free software,
42	!! that may mean that it is complicated to manipulate, and that also
43	!! therefore means that it is reserved for developers and experienced
44	!! professionals having in-depth computer knowledge. Users are therefore
45	!! encouraged to load and test the software's suitability as regards their
46	!! requirements in conditions enabling the security of their systems and/or
47	!! data to be ensured and, more generally, to use and operate it in the
48	!! same conditions as regards security.
49	!!
50	!! The fact that you are presently reading this means that you have had
51	!! knowledge of the CeCILL license and that you accept its terms.
52	!! =========================================================================
53
54	#include <inca_define.h>
55
56	SUBROUTINE MKSFLX_P2P(calday, oro, lat, lon, area, &
57	loc_angle, polar_night, polar_day, sunon, sunoff, &
58	u, v, paprs, pmid, cdragh, cdragm, temp, sh, &
59	ftsol, ts, pctsrf )
60
61	!--------------------------------------------------------
62	! ... Form the surface fluxes for this time slice
63	! Didier Hauglustaine, IPSL, 2000, 2018
64	!--------------------------------------------------------
65
66	USE RADON_SRF_FLX
67	USE SRF_FLUX_INT
68	USE SPECIES_NAMES
69	USE SFLX
70	USE CONST_MOD, ONLY : pi
71	USE SURF_CHEM_MOD
72	USE CONST_LMDZ
73	USE INCA_DIM
74	USE MOD_INCA_PARA
75	USE CHEM_CONS, ONLY : dayspy
76	USE TIME_MOD_INCA, ONLY : one_year,month_len,month,day
77	USE AEROSOL_METEO, ONLY : zheight
78	USE PARAM_CHEM
79	#ifdef AER
80	USE AEROSOL_MOD, ONLY : srcsigmaln,rop,asmode
81	#endif
82	#ifdef GES
83	USE CARBONATOR
84	#endif
85
86
87	IMPLICIT NONE
88
89	!--------------------------------------------------------
90	! ... Dummy arguments
91	!--------------------------------------------------------
92	REAL, INTENT(in) :: oro(PLON)
93	REAL, INTENT(in) :: area(PLON)
94	REAL, INTENT(in) :: lat(PLON)
95	REAL, INTENT(in) :: lon(PLON)
96	REAL, INTENT(in) :: calday !time of year in days
97	! variables used in nightingale
98	REAL, INTENT(in) :: u(PLON,PLEV),v(PLON,PLEV)
99	REAL, INTENT(in) :: paprs(PLON,PLEV+1)
100	REAL, INTENT(in) :: pmid(PLON,PLEV)
101	REAL, INTENT(in) :: cdragh(PLON), cdragm(PLON)
102	REAL, INTENT(in) :: temp(PLON,PLEV)
103	REAL, INTENT(in) :: sh(PLON,PLEV)
104	REAL, INTENT(in) :: ftsol(PLON,nbsrf)
105	REAL, INTENT(in) :: ts(PLON)
106	REAL, INTENT(in) :: pctsrf(PLON,nbsrf)
107
108	!--------------------------------------------------------
109	! ... Dummy arguments needed to calculate diurnal
110	! variation of isoprene and monoterpenes
111	! added by Gerd Folberth, LSCE, 2001.
112	!--------------------------------------------------------
113	REAL, INTENT(in) :: loc_angle(PLON) ! "local" time angle
114	LOGICAL, INTENT(in) :: polar_day(PLON) ! continuous daylight flag
115	LOGICAL, INTENT(in) :: polar_night(PLON) ! continuous night flag
116	REAL, INTENT(in) :: sunon(PLON) ! sunrise angle in radians
117	REAL, INTENT(in) :: sunoff(PLON) ! sunset angle in radians
118
119	!--------------------------------------------------------
120	! ... Local variables
121	!--------------------------------------------------------
122	REAL :: econc_dms(PLON)
123	INTEGER :: i, m, last, next
124	REAL :: dels
125	REAL :: sflux1, sflux2
126	REAL :: sflux1_loc(PLON), sflux2_loc(PLON)
127	REAL :: sflux1_glo(nbp_glo), sflux2_glo(nbp_glo)
128	REAL :: total_flux
129	REAL, PARAMETER :: secpyr = dayspy * 8.64e4
130
131	LOGICAL, SAVE :: entered = .FALSE.
132	!$OMP THREADPRIVATE(entered)
133
134
135
136	#ifdef NMHC
137	!--------------------------------------------------------
138	! ... Local variables for calculating diurnal variations
139	! added by Gerd Folberth, LSCE, 2001.
140	!--------------------------------------------------------
141	REAL :: factor
142	REAL :: dayfrac ! fraction of day in light
143	REAL :: iso_off ! time isoprene flux turns off
144	REAL :: iso_on ! time isoprene flux turns on
145	#endif
146
147	#ifdef AER
148	! source mass median diameter [m]
149	REAL :: srcmmd_id_ASBCM = 0.14e-6
150	REAL :: srcmmd_id_ASPOMM = 0.34e-6
151	REAL :: fdistBC ! Number/Mass factor to compute number flux
152	REAL :: fdistPOM ! Number/Mass factor to compute number flux
153	REAL :: fdistSO4
154	REAL :: srcmmd_id_ASSO4M = 0.3e-6
155	#endif
156
157	INTEGER :: ll
158	REAL :: fracthh ! single value instead of array(4)
159	REAL :: zalt
160	REAL, PARAMETER :: emi_height = 2000.
161
162	LOGICAL, SAVE :: first = .TRUE.
163	!$OMP THREADPRIVATE(first)
164
165	IF (first) THEN
166
167	IF (CoupSurfAtm) THEN
168	! allocation des eflux_notfromveg et veg dans le cas du couplage avec orchidee
169	ALLOCATE(eflux_notfromveg(PLON,nb_flux))
170	ALLOCATE(eflux_veg(PLON,nb_flux))
171	eflux_notfromveg(:,:) = 0.
172	eflux_veg(:,:) = 0.
173	ENDIF
174
175	first = .FALSE.
176	ENDIF
177
178
179
180	!--------------------------------------------------------
181	! ... Setup the time interpolation
182	! Note: 365 day year inconsistent with LMDz (360 days) !!!
183	!--------------------------------------------------------
184
185	SELECT CASE(emi_interp_time)
186	CASE(0) !--no time interpolation at all
187	dels = 0.
188	last = month ! Added ThL: in this case, last = current month and next = next month
189	IF ( month == 12 ) THEN ! (considering months as 1st to 30th)
190	next = 1
191	ELSE
192	next = month + 1
193	ENDIF
194
195	CASE(1) !--default time interpolation
196	IF ( calday < days(1) ) THEN
197	next = 1
198	last = 12
199	dels = REAL(365. + calday - days(12)) &
200	/ REAL(365. + days(1) - days(12))
201	ELSE IF ( calday >= days(12) ) THEN
202	next = 1
203	last = 12
204	dels = REAL(calday - days(12)) &
205	/ REAL(365. + days(1) - days(12))
206	ELSE
207	DO m = 11,1,-1
208	IF ( calday >= days(m) ) THEN
209	EXIT
210	ENDIF
211	ENDDO
212	last = m
213	next = m + 1
214	dels = REAL(calday - days(m)) / REAL(days(m+1) - days(m))
215	ENDIF
216	dels = MAX( MIN( 1.,dels ),0. )
217
218
219	END SELECT
220
221	!--------------------------------------------------------
222	! ... Radon emission (called once)
223	! Note : radon global emission = 15 Kg/yr
224	!--------------------------------------------------------
225	! calcul eflux(rn222) at each time step because oro is modify at the end of the day
226	! IF( .NOT. entered ) THEN
227
228	total_flux = 15. / secpyr ! kg/s
229	baseflux = 0.
230	sflux1 = 0.
231	sflux2 = 0.
232	sflux1_loc(:)=0.
233	sflux2_loc(:)=0.
234
235	DO i = 1, PLON
236	IF( lat(i) < 70. .AND. lat(i) > -60. ) THEN
237	sflux1_loc(i) = 1.basefluxarea(i)*(1.-oro(i))
238	IF ( lat(i) >= 60. ) THEN
239	IF (lon(i) < -20. .AND. lon(i) > -70.) THEN
240	sflux2_loc(i) = 0.5basefluxoro(i)*area(i)
241	ELSE
242	sflux2_loc(i) = 0.5oro(i)area(i)
243	ENDIF
244	ELSE
245	sflux2_loc(i) = 1.0oro(i)area(i)
246	ENDIF
247	ENDIF
248	ENDDO
249
250	CALL gather(sflux1_loc,sflux1_glo)
251	CALL gather(sflux2_loc,sflux2_glo)
252
253	!$OMP MASTER
254	IF (is_mpi_root) THEN
255	DO i = 1, nbp_glo
256	sflux1=sflux1+sflux1_glo(i)
257	sflux2=sflux2+sflux2_glo(i)
258	ENDDO
259	landflux = (total_flux - sflux1) / sflux2
260	ENDIF
261	!$OMP END MASTER
262	CALL bcast(landflux)
263
264	DO i = 1,PLON
265	IF (lat(i) >= 70. .OR. lat(i) <= -60.) THEN
266	eflux(i,id_Rn222) = baseflux
267	ELSE
268	IF (lat(i) >= 60.) THEN
269	IF (lon(i) < -20. .AND. lon(i) > -70.) THEN
270	eflux(i,id_Rn222) = 0.5 * baseflux * oro(i) &
271	+ baseflux * (1.-oro(i))
272	ELSE
273	eflux(i,id_Rn222) = 0.5 * landflux * oro(i) &
274	+ baseflux * (1.-oro(i))
275	ENDIF
276	ELSE
277	eflux(i,id_Rn222) = 1.0 * landflux * oro(i) &
278	+ baseflux * (1.-oro(i))
279	ENDIF
280	ENDIF
281	ENDDO
282
283	! entered = .TRUE.
284	! ENDIF
285
286
287	!--------------------------------------------------------
288	! ... Set non-zero fluxes
289	!--------------------------------------------------------
290	#ifdef NMHC
291	flx_mcf = flx_mcf_ant + flx_mcf_nat
292	eflux(:,id_MCF) = flx_mcf(:,last) + dels * (flx_mcf(:,next) - flx_mcf(:,last))
293
294	flx_n2o = flx_n2o_ant + flx_n2o_nat
295	eflux(:,id_N2O) = flx_n2o(:,last) + dels * (flx_n2o(:,next) - flx_n2o(:,last))
296
297	flx_ch4 = flx_ch4_ant + flx_ch4_nat
298	eflux(:,id_CH4) = flx_ch4(:,last) + dels * (flx_ch4(:,next) - flx_ch4(:,last))
299
300	flx_co = flx_co_ant + flx_co_nat
301	eflux(:,id_CO) = flx_co(:,last) + dels * (flx_co(:,next) - flx_co(:,last))
302
303	flx_h2 = flx_h2_ant + flx_h2_nat
304	eflux(:,id_H2) = flx_h2(:,last) + dels * (flx_h2(:,next) - flx_h2(:,last))
305
306	flx_no = flx_no_ant + flx_no_nat
307	eflux(:,id_NO) = flx_no(:,last) + dels * (flx_no(:,next) - flx_no(:,last))
308
309	flx_c2h5oh = flx_c2h5oh_ant + flx_c2h5oh_nat
310	eflux(:,id_C2H5OH) = flx_c2h5oh(:,last) + dels * (flx_c2h5oh(:,next) - flx_c2h5oh(:,last))
311
312	flx_alkan = flx_alkan_ant + flx_alkan_nat
313	eflux(:,id_ALKAN) = flx_alkan(:,last)+ dels * (flx_alkan(:,next) - flx_alkan(:,last))
314
315	flx_arom = flx_arom_ant + flx_arom_nat
316	eflux(:,id_AROM) = flx_arom(:,last) + dels * (flx_arom(:,next) - flx_arom(:,last))
317
318	flx_mek = flx_mek_ant + flx_mek_nat
319	eflux(:,id_MEK) = flx_mek(:,last) + dels * (flx_mek(:,next) - flx_mek(:,last))
320
321	flx_mvk = flx_mvk_ant + flx_mvk_nat
322	eflux(:,id_MVK) = flx_mvk(:,last) + dels * (flx_mvk(:,next) - flx_mvk(:,last))
323
324	flx_c2h6 = flx_c2h6_ant + flx_c2h6_nat
325	eflux(:,id_C2H6) = flx_c2h6(:,last) + dels * (flx_c2h6(:,next) - flx_c2h6(:,last))
326
327	flx_c3h8 = flx_c3h8_ant + flx_c3h8_nat
328	eflux(:,id_C3H8) = flx_c3h8(:,last) + dels * (flx_c3h8(:,next) - flx_c3h8(:,last))
329
330	flx_c2h4 = flx_c2h4_ant + flx_c2h4_nat
331	eflux(:,id_C2H4) = flx_c2h4(:,last) + dels * (flx_c2h4(:,next) - flx_c2h4(:,last))
332
333	flx_c3h6 = flx_c3h6_ant + flx_c3h6_nat
334	eflux(:,id_C3H6) = flx_c3h6(:,last) + dels * (flx_c3h6(:,next) - flx_c3h6(:,last))
335
336	flx_c2h2 = flx_c2h2_ant + flx_c2h2_nat
337	eflux(:,id_C2H2) = flx_c2h2(:,last) + dels * (flx_c2h2(:,next) - flx_c2h2(:,last))
338
339	flx_alken = flx_alken_ant + flx_alken_nat
340	eflux(:,id_ALKEN) = flx_alken(:,last) + dels * (flx_alken(:,next) - flx_alken(:,last))
341
342
343	IF (id_Orch_iso .EQ. 0) THEN
344	flx_isop = flx_isop_ant + flx_isop_nat
345	eflux(:,id_ISOP) = flx_isop(:,last) + dels * (flx_isop(:,next) - flx_isop(:,last))
346	ELSE
347	! dans ce cas la eflux(iso) = flux_no_veg + flux_orchidee
348	! le flux orchidee sera ajoute apres l'ajustement diurne du flux ocean
349	flx_isop_no_veg = flx_isop_ant + flx_isop_nat
350	eflux_notfromveg(:,id_Orch_iso) = flx_isop_no_veg(:,last) + dels * (flx_isop_no_veg(:,next) - flx_isop_no_veg(:,last))
351	ENDIF
352
353	IF (id_Orch_apin .EQ. 0) THEN
354	flx_apin = flx_apin_ant + flx_apin_nat
355	eflux(:,id_APIN) = flx_apin(:,last) + dels * (flx_apin(:,next) - flx_apin(:,last))
356	ELSE
357	flx_apin_no_veg = flx_apin_ant + flx_apin_nat
358	eflux_notfromveg(:,id_Orch_apin) = flx_apin_no_veg(:,last) + dels * (flx_apin_no_veg(:,next) - flx_apin_no_veg(:,last))
359	ENDIF
360
361	IF (id_Orch_ch3oh .EQ. 0 ) THEN
362	flx_ch3oh = flx_ch3oh_ant + flx_ch3oh_nat
363	eflux(:,id_CH3OH) = flx_ch3oh(:,last)+ dels * (flx_ch3oh(:,next) - flx_ch3oh(:,last))
364	ELSE
365	flx_ch3oh_no_veg = flx_ch3oh_ant + flx_ch3oh_nat
366	eflux_notfromveg(:,id_Orch_ch3oh) = flx_ch3oh_no_veg(:,last)+ dels * (flx_ch3oh_no_veg(:,next) - flx_ch3oh_no_veg(:,last))
367	ENDIF
368
369	IF (id_Orch_formal .EQ. 0) THEN
370	flx_ch2o = flx_ch2o_ant + flx_ch2o_nat
371	eflux(:,id_CH2O) = flx_ch2o(:,last) + dels * (flx_ch2o(:,next) - flx_ch2o(:,last))
372	ELSE
373	flx_ch2o_no_veg = flx_ch2o_ant + flx_ch2o_nat
374	eflux_notfromveg(:,id_Orch_formal) = flx_ch2o_no_veg(:,last) + dels * (flx_ch2o_no_veg(:,next) - flx_ch2o_no_veg(:,last))
375	ENDIF
376
377	IF (id_Orch_acetal .EQ. 0) THEN
378	flx_ch3cho = flx_ch3cho_ant + flx_ch3cho_nat
379	eflux(:,id_CH3CHO) = flx_ch3cho(:,last) + dels * (flx_ch3cho(:,next) - flx_ch3cho(:,last))
380	ELSE
381	flx_ch3cho_no_veg = flx_ch3cho_ant + flx_ch3cho_nat
382	eflux_notfromveg(:,id_Orch_acetal) = flx_ch3cho_no_veg(:,last)+ dels * (flx_ch3cho_no_veg(:,next) - flx_ch3cho_no_veg(:,last))
383	ENDIF
384
385	IF (id_Orch_ch3coch3 .EQ. 0) THEN
386	flx_ch3coch3 = flx_ch3coch3_ant + flx_ch3coch3_nat
387	eflux(:,id_CH3COCH3)= flx_ch3coch3(:,last)+ dels * (flx_ch3coch3(:,next) - flx_ch3coch3(:,last))
388	ELSE
389	flx_ch3coch3_no_veg = flx_ch3coch3_ant + flx_ch3coch3_nat
390	eflux_notfromveg(:,id_Orch_ch3coch3) = flx_ch3coch3_no_veg(:,last)+ dels * (flx_ch3coch3_no_veg(:,next) - flx_ch3coch3_no_veg(:,last))
391	ENDIF
392
393	IF ((id_Orch_acetic .EQ. 0) .OR. (id_Orch_formic .EQ. 0)) THEN
394	flx_ch3cooh = flx_ch3cooh_ant + flx_ch3cooh_nat
395	eflux(:,id_CH3COOH) = flx_ch3cooh(:,last) + dels * (flx_ch3cooh(:,next) - flx_ch3cooh(:,last))
396	ELSE
397	flx_ch3cooh_no_veg = flx_ch3cooh_ant + flx_ch3cooh_nat
398	eflux_notfromveg(:,id_Orch_acetic) = flx_ch3cooh_no_veg(:,last)+ dels * (flx_ch3cooh_no_veg(:,next) - flx_ch3cooh_no_veg(:,last))
399	eflux_notfromveg(:,id_Orch_formic) = eflux_notfromveg(:,id_Orch_acetic)
400	ENDIF
401	#endif
402
403	#ifdef GES
404	flx_mcf = flx_mcf_ant + flx_mcf_nat
405	eflux(:,id_MCF) = flx_mcf(:,last) + dels * (flx_mcf(:,next) - flx_mcf(:,last))
406
407	flx_n2o = flx_n2o_ant + flx_n2o_nat
408	eflux(:,id_N2O) = flx_n2o(:,last) + dels * (flx_n2o(:,next) - flx_n2o(:,last))
409
410	flx_ch4 = flx_ch4_ant + flx_ch4_nat
411	eflux(:,id_CH4) = flx_ch4(:,last) + dels * (flx_ch4(:,next) - flx_ch4(:,last))
412
413	flx_co = flx_co_ant + flx_co_nat
414	eflux(:,id_CO) = flx_co(:,last) + dels * (flx_co(:,next) - flx_co(:,last))
415
416	! champ calcule dans carbonator - independant de sflx*.nc
417	eflux(:,id_CO2BIH) = eflux_CO2(:,id_co2bih_loc)/3600.
418	#endif
419
420
421
422	#ifndef DUSS
423	#ifdef AER
424
425	fdistBC= 1./pi6./rop(id_ASBCM)/srcmmd_id_ASBCM3 EXP(4.5srcsigmaln(asmode)*2)
426	fdistPOM=1./pi6./rop(id_ASPOMM)/srcmmd_id_ASPOMM3 EXP(4.5srcsigmaln(asmode)*2)
427	fdistSO4= 1./pi6./rop(id_ASSO4M) /srcmmd_id_ASSO4M3 EXP(4.5srcsigmaln(asmode)*2)
428
429	flx_so2 = flx_so2_ant + flx_so2_nat
430	eflux(:,id_SO2) = flx_so2(:,last) + dels * (flx_so2(:,next) - flx_so2(:,last))
431
432	flx_nh3 = flx_nh3_ant + flx_nh3_nat
433	eflux(:,id_NH3) = flx_nh3(:,last) + dels * (flx_nh3(:,next) - flx_nh3(:,last))
434
435	flx_h2s = flx_h2s_ant + flx_h2s_nat
436	eflux(:,id_H2S) = flx_h2s(:,last) + dels * (flx_h2s(:,next) - flx_h2s(:,last))
437
438
439	!****************source function
440	!--------unit of flxBCM are cgs: g cm**-2 s-1
441	! computation of flux
442	! Injection in Low Height
443	! 20% of the BC is hydrophilic upon emission and 80% is hydrophobic
444	! 50% of POM is hydrophilic as it is emitted and 50% is hydrophobic
445
446	flx_pom = flx_pom_ant + flx_pom_nat
447	flx_bc = flx_bc_ant + flx_bc_nat
448
449	eflux(:,id_AIBCM) = 0.8 * ( flx_bc(:,last) + dels * (flx_bc(:,next) - flx_bc(:,last)) )
450	eflux(:,id_AIPOMM) = 0.5 * ( flx_pom(:,last) + dels * (flx_pom(:,next)- flx_pom(:,last)))
451	eflux(:,id_ASBCM) = 0.2 ( flx_bc(:,last) + dels (flx_bc(:,next) - flx_bc(:,last)) )
452	eflux(:,id_ASPOMM) = 0.5 * ( flx_pom(:,last) + dels * (flx_pom(:,next)- flx_pom(:,last)))
453
454	! and for the number mixing ratio
455	eflux(:,id_AIN) = eflux(:,id_AIN) + eflux(:,id_AIBCM) * fdistBC
456	eflux(:,id_AIN) = eflux(:,id_AIN) + eflux(:,id_AIPOMM) * fdistPOM
457	eflux(:,id_ASN) = eflux(:,id_ASN) + eflux(:,id_ASBCM) * fdistBC
458	eflux(:,id_ASN) = eflux(:,id_ASN) + eflux(:,id_ASPOMM) * fdistPOM
459
460	flx_asso4m = flx_so4_ant + flx_so4_nat
461	eflux(:,id_ASSO4M) = flx_asso4m(:,last) + dels * (flx_asso4m(:,next) - flx_asso4m(:,last))
462	eflux(:,id_ASN) = eflux(:,id_ASN) + eflux(:,id_ASSO4M)*fdistSO4
463
464	!Emissions in altitude (biomass burning) are prepared here.
465	!For AERONLY they are injected in bcpomsource.F90 for aerosols, NO2, NH3, and SO2.
466	!For NMHC-AER they are injected in SETEXT_BBG for all tracers.
467
468	#ifdef AERONLY
469	flx_no = flx_no_ant + flx_no_nat
470	eflux(:,id_NO2) = 46./30. * (flx_no(:,last) + dels * (flx_no(:,next) - flx_no(:,last)))
471
472	! bc/pom/so2 emission at altitude from biomass burning aerosols
473	DO i = 1, PLON
474	zalt = 0.0
475	DO ll = 1, PLEV
476
477	fracthh = (MIN(zalt+zheight(i,ll),emi_height)-MIN(zalt,emi_height))/emi_height
478	zalt = zalt + zheight(i,ll)
479
480	eflux_alt(i,ll,id_AIBCM) = 0.8 * fracthh * (flx_bc_bbg(i,last) +dels*(flx_bc_bbg(i,next) -flx_bc_bbg(i,last)))
481	eflux_alt(i,ll,id_AIPOMM) = 0.5 * fracthh * (flx_pom_bbg(i,last)+dels*(flx_pom_bbg(i,next)-flx_pom_bbg(i,last)))
482	eflux_alt(i,ll,id_ASBCM) = 0.2 * fracthh * (flx_bc_bbg(i,last) +dels*(flx_bc_bbg(i,next) -flx_bc_bbg(i,last)))
483	eflux_alt(i,ll,id_ASPOMM) = 0.5 * fracthh * (flx_pom_bbg(i,last)+dels*(flx_pom_bbg(i,next)-flx_pom_bbg(i,last)))
484
485	eflux_alt(i,ll,id_AIN) = eflux_alt(i,ll,id_AIN)+ eflux_alt(i,ll,id_AIBCM) * fdistBC
486	eflux_alt(i,ll,id_AIN) = eflux_alt(i,ll,id_AIN)+ eflux_alt(i,ll,id_AIPOMM) * fdistPOM
487	eflux_alt(i,ll,id_ASN) = eflux_alt(i,ll,id_ASN)+ eflux_alt(i,ll,id_ASBCM) * fdistBC
488	eflux_alt(i,ll,id_ASN) = eflux_alt(i,ll,id_ASN)+ eflux_alt(i,ll,id_ASPOMM) * fdistPOM
489
490	! Modif ThL: only anthro SO2 is emitted from ground; BBSO2 was injected in altitude (same for nh3 and no2)
491	eflux_alt_so2(i,ll) = fracthh * (flx_so2_bbg(i,last) + dels*(flx_so2_bbg(i,next) - flx_so2_bbg(i,last)))
492	eflux_alt_nh3(i,ll) = fracthh * (flx_nh3_bbg(i,last) + dels*(flx_nh3_bbg(i,next) - flx_nh3_bbg(i,last)))
493	eflux_alt_no2(i,ll) = 46./30. * fracthh * (flx_no_bbg(i,last) + dels*(flx_no_bbg(i,next) - flx_no_bbg(i,last)))
494
495	ENDDO
496	ENDDO
497	#else
498
499	DO i = 1, PLON
500	zalt = 0.0
501	DO ll = 1, PLEV
502
503	fracthh = (MIN(zalt+zheight(i,ll),emi_height)-MIN(zalt,emi_height))/emi_height
504	zalt = zalt + zheight(i,ll)
505
506	aflux(i,ll,id_N2O) = fracthh * (flx_n2o_bbg(i,last) + dels*(flx_n2o_bbg(i,next) - flx_n2o_bbg(i,last)))
507	aflux(i,ll,id_CH4) = fracthh * (flx_ch4_bbg(i,last) + dels*(flx_ch4_bbg(i,next) - flx_ch4_bbg(i,last)))
508	aflux(i,ll,id_CO) = fracthh * (flx_co_bbg(i,last) + dels*(flx_co_bbg(i,next) - flx_co_bbg(i,last)))
509	aflux(i,ll,id_H2) = fracthh * (flx_h2_bbg(i,last) + dels*(flx_h2_bbg(i,next) - flx_h2_bbg(i,last)))
510	aflux(i,ll,id_NO) = fracthh * (flx_no_bbg(i,last) + dels*(flx_no_bbg(i,next) - flx_no_bbg(i,last)))
511	aflux(i,ll,id_MCF) = fracthh * (flx_mcf_bbg(i,last) + dels*(flx_mcf_bbg(i,next) - flx_mcf_bbg(i,last)))
512	aflux(i,ll,id_CH3OH) = fracthh * (flx_ch3oh_bbg(i,last) + dels*(flx_ch3oh_bbg(i,next) - flx_ch3oh_bbg(i,last)))
513	aflux(i,ll,id_C2H5OH) = fracthh * (flx_c2h5oh_bbg(i,last) + dels*(flx_c2h5oh_bbg(i,next) - flx_c2h5oh_bbg(i,last)))
514	aflux(i,ll,id_C2H6) = fracthh * (flx_c2h6_bbg(i,last) + dels*(flx_c2h6_bbg(i,next) - flx_c2h6_bbg(i,last)))
515	aflux(i,ll,id_C3H8) = fracthh * (flx_c3h8_bbg(i,last) + dels*(flx_c3h8_bbg(i,next) - flx_c3h8_bbg(i,last)))
516	aflux(i,ll,id_ALKAN) = fracthh * (flx_alkan_bbg(i,last) + dels*(flx_alkan_bbg(i,next) - flx_alkan_bbg(i,last)))
517	aflux(i,ll,id_C2H4) = fracthh * (flx_c2h4_bbg(i,last) + dels*(flx_c2h4_bbg(i,next) - flx_c2h4_bbg(i,last)))
518	aflux(i,ll,id_C3H6) = fracthh * (flx_c3h6_bbg(i,last) + dels*(flx_c3h6_bbg(i,next) - flx_c3h6_bbg(i,last)))
519	aflux(i,ll,id_C2H2) = fracthh * (flx_c2h2_bbg(i,last) + dels*(flx_c2h2_bbg(i,next) - flx_c2h2_bbg(i,last)))
520	aflux(i,ll,id_ALKEN) = fracthh * (flx_alken_bbg(i,last) + dels*(flx_alken_bbg(i,next) - flx_alken_bbg(i,last)))
521	aflux(i,ll,id_AROM) = fracthh * (flx_arom_bbg(i,last) + dels*(flx_arom_bbg(i,next) - flx_arom_bbg(i,last)))
522	aflux(i,ll,id_CH2O) = fracthh * (flx_ch2o_bbg(i,last) + dels*(flx_ch2o_bbg(i,next) - flx_ch2o_bbg(i,last)))
523	aflux(i,ll,id_CH3CHO) = fracthh * (flx_ch3cho_bbg(i,last) + dels*(flx_ch3cho_bbg(i,next) - flx_ch3cho_bbg(i,last)))
524	aflux(i,ll,id_CH3COCH3) = fracthh * (flx_ch3coch3_bbg(i,last) + dels*(flx_ch3coch3_bbg(i,next) - flx_ch3coch3_bbg(i,last)))
525	aflux(i,ll,id_MEK) = fracthh * (flx_mek_bbg(i,last) + dels*(flx_mek_bbg(i,next) - flx_mek_bbg(i,last)))
526	aflux(i,ll,id_MVK) = fracthh * (flx_mvk_bbg(i,last) + dels*(flx_mvk_bbg(i,next) - flx_mvk_bbg(i,last)))
527	aflux(i,ll,id_CH3COOH) = fracthh * (flx_ch3cooh_bbg(i,last) + dels*(flx_ch3cooh_bbg(i,next) - flx_ch3cooh_bbg(i,last)))
528	aflux(i,ll,id_ISOP) = fracthh * (flx_isop_bbg(i,last) + dels*(flx_isop_bbg(i,next) - flx_isop_bbg(i,last)))
529	aflux(i,ll,id_APIN) = fracthh * (flx_apin_bbg(i,last) + dels*(flx_apin_bbg(i,next) - flx_apin_bbg(i,last)))
530	aflux(i,ll,id_NH3) = fracthh * (flx_nh3_bbg(i,last) + dels*(flx_nh3_bbg(i,next) - flx_nh3_bbg(i,last)))
531	aflux(i,ll,id_H2S) = fracthh * (flx_h2s_bbg(i,last) + dels*(flx_h2s_bbg(i,next) - flx_h2s_bbg(i,last)))
532	aflux(i,ll,id_SO2) = fracthh * (flx_so2_bbg(i,last) + dels*(flx_so2_bbg(i,next) - flx_so2_bbg(i,last)))
533
534	aflux(i,ll,id_AIBCM) = 0.8 * fracthh * (flx_bc_bbg(i,last) +dels*(flx_bc_bbg(i,next) -flx_bc_bbg(i,last)))
535	aflux(i,ll,id_AIPOMM) = 0.5 * fracthh * (flx_pom_bbg(i,last)+dels*(flx_pom_bbg(i,next)-flx_pom_bbg(i,last)))
536	aflux(i,ll,id_ASBCM) = 0.2 * fracthh * (flx_bc_bbg(i,last) +dels*(flx_bc_bbg(i,next) -flx_bc_bbg(i,last)))
537	aflux(i,ll,id_ASPOMM) = 0.5 * fracthh * (flx_pom_bbg(i,last)+dels*(flx_pom_bbg(i,next)-flx_pom_bbg(i,last)))
538
539	aflux(i,ll,id_AIN) = aflux(i,ll,id_AIN) + aflux(i,ll,id_AIBCM) * fdistBC
540	aflux(i,ll,id_AIN) = aflux(i,ll,id_AIN) + aflux(i,ll,id_AIPOMM) * fdistPOM
541	aflux(i,ll,id_ASN) = aflux(i,ll,id_ASN) + aflux(i,ll,id_ASBCM) * fdistBC
542	aflux(i,ll,id_ASN) = aflux(i,ll,id_ASN) + aflux(i,ll,id_ASPOMM) * fdistPOM
543
544	aflux(i,ll,id_ASSO4M) = fracthh * (flx_so4_bbg(i,last) + dels*(flx_so4_bbg(i,next) - flx_so4_bbg(i,last)))
545	aflux(i,ll,id_ASN) = aflux(i,ll,id_ASN) + aflux(i,ll,id_ASSO4M)*fdistSO4
546
547	ENDDO
548	ENDDO
549	#endif
550
551
552	econc_dms(:) = conc_dms(:,last) + dels * (conc_dms(:,next) - conc_dms(:,last))
553
554	#endif
555	#endif
556
557
558	#ifndef AER
559	#ifdef NMHC
560
561
562	DO i = 1, PLON
563	zalt = 0.0
564	DO ll = 1, PLEV
565
566	fracthh = (MIN(zalt+zheight(i,ll),emi_height)-MIN(zalt,emi_height))/emi_height
567	zalt = zalt + zheight(i,ll)
568
569	aflux(i,ll,id_CH4) = fracthh * (flx_ch4_bbg(i,last) + dels*(flx_ch4_bbg(i,next) - flx_ch4_bbg(i,last)))
570	aflux(i,ll,id_CO) = fracthh * (flx_co_bbg(i,last) + dels*(flx_co_bbg(i,next) - flx_co_bbg(i,last)))
571	aflux(i,ll,id_NO) = fracthh * (flx_no_bbg(i,last) + dels*(flx_no_bbg(i,next) - flx_no_bbg(i,last)))
572
573	ENDDO
574	ENDDO
575
576
577
578	#endif
579	#endif
580
581	#ifdef NMHC
582	!--------------------------------------------------------
583	! ... calculate diurnal variation for biogenic NMHCs
584	! included in one loop to save calculation time
585	! Gerd Folberth, LSCE, for LMDZ/INCA, 2001.
586	!--------------------------------------------------------
587
588	!--------------------------------------------------------
589	! ... loop starts here
590	! Gerd Folberth, LSCE, for LMDZ/INCA, 2001.
591	!--------------------------------------------------------
592	DO i = 1, PLON
593
594	!--------------------------------------------------------
595	! ... Adjust isoprene for diurnal variation
596	! Modified by Gerd Folberth, LSCE, for LMDZ/INCA, 2001.
597	!--------------------------------------------------------
598	IF( polar_night(i) ) THEN
599	CYCLE
600	ELSE
601	IF( polar_day(i) ) THEN
602	iso_off = 0.8 * pi
603	iso_on = 1.2 * pi
604	ELSE
605	iso_off = 0.8 * sunoff(i)
606	iso_on = (2. * pi) - iso_off
607	ENDIF
608	IF ( (loc_angle(i) >= iso_off) .AND. (loc_angle(i) <= iso_on) ) THEN
609	IF (id_Orch_iso .EQ. 0 ) THEN
610	eflux(i,id_ISOP) = 0.
611	ELSE
612	eflux_notfromveg(i,id_Orch_iso) = 0.
613	ENDIF
614	ELSE
615	factor = loc_angle(i) - iso_on
616	IF (factor <= 0.) THEN
617	factor = factor + 2.*pi
618	ENDIF
619	factor = factor / (2.*iso_off + 1.e-6)
620	IF (id_Orch_iso .EQ. 0) THEN
621	eflux(i,id_ISOP) = eflux(i,id_ISOP) * 2. / iso_off &
622	* pi * (SIN(pifactor))*2
623	ELSE
624	eflux_notfromveg(i,id_Orch_iso) = eflux_notfromveg(i,id_Orch_iso) * 2. / iso_off &
625	* pi * (SIN(pifactor))*2
626	ENDIF
627	ENDIF
628	ENDIF
629
630	!--------------------------------------------------------
631	! ... Adjust alpha-pinene for diurnal variation
632	! Modified by Gerd Folberth, LSCE, for LMDZ/INCA, 2001.
633	!--------------------------------------------------------
634	IF ( .NOT. polar_night(i) .AND. .NOT. polar_day(i) ) THEN
635	dayfrac = sunoff(i) / pi
636	IF (id_Orch_apin .EQ. 0) THEN
637	eflux(i,id_APIN) = eflux(i,id_APIN) / (0.7 + 0.3*dayfrac)
638	ELSE
639	eflux_notfromveg(i,id_Orch_apin) = eflux_notfromveg(i,id_Orch_apin) / (0.7 + 0.3*dayfrac)
640	ENDIF
641	IF ( (loc_angle(i) >= sunoff(i)) .AND. (loc_angle(i) <= sunon(i)) ) THEN
642	IF (id_Orch_apin .EQ. 0) THEN
643	eflux(i,id_APIN) = eflux(i,id_APIN) * 0.7
644	ELSE
645	eflux_notfromveg(i,id_Orch_apin) = eflux_notfromveg(i,id_Orch_apin) * 0.7
646	ENDIF
647	ENDIF
648	ENDIF
649
650	!--------------------------------------------------------
651	! ... loop ends here
652	! Gerd Folberth, LSCE, for LMDZ/INCA, 2001.
653	!--------------------------------------------------------
654	ENDDO
655
656
657	!! finalisation des calculs de flux a partir des donnees de orchidee
658	!! Isoprene
659	IF (id_Orch_iso .NE. 0) THEN
660	! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s
661	eflux_veg(:,id_Orch_iso) = tot_emiflx_fromOrch(:,id_Orch_iso)* pctsrf(:,is_ter) * 68./60.
662	! calcul du flux
663	eflux(:,id_ISOP) = eflux_veg(:,id_Orch_iso) + eflux_notfromveg(:,id_Orch_iso)
664	ENDIF
665
666	IF (id_Orch_apin .NE. 0) THEN
667	! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s
668	eflux_veg(:,id_Orch_apin) = tot_emiflx_fromOrch(:,id_Orch_apin) * pctsrf(:,is_ter) * 136./120.
669	! calcul du flux
670	eflux(:,id_APIN) = eflux_veg(:,id_Orch_apin) + eflux_notfromveg(:,id_Orch_apin)
671	ENDIF
672
673	!! Methanol
674	if (id_Orch_ch3oh .NE. 0) THEN
675	! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s
676	eflux_veg(:,id_Orch_ch3oh) = tot_emiflx_fromOrch(:,id_Orch_ch3oh) * pctsrf(:,is_ter) * 32/12
677	! calcul du flux
678	eflux(:,id_CH3OH) = eflux_veg(:,id_Orch_ch3oh) + eflux_notfromveg(:,id_Orch_ch3oh)
679	ENDIF
680
681	!! Acetone
682	IF (id_Orch_ch3coch3 .NE. 0) THEN
683	! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s
684	eflux_veg(:,id_Orch_ch3coch3) = tot_emiflx_fromOrch(:,id_Orch_ch3coch3) * pctsrf(:,is_ter) * 58/36
685	! calcul du flux
686	eflux(:,id_CH3COCH3) = eflux_veg(:,id_Orch_ch3coch3) + eflux_notfromveg(:,id_Orch_ch3coch3)
687	ENDIF
688
689	!! Aldehydes
690	if (id_Orch_formal .ne. 0)then
691	! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s
692	eflux_veg(:,id_Orch_formal) = tot_emiflx_fromOrch(:,id_Orch_formal) * pctsrf(:,is_ter) * 30/12
693	! calcul du flux
694	eflux(:,id_CH2O) = eflux_veg(:,id_Orch_formal) + eflux_notfromveg(:,id_Orch_formal)
695	endif
696
697	IF (id_Orch_acetal .NE. 0)THEN
698	! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s
699	eflux_veg(:, id_Orch_acetal) = tot_emiflx_fromOrch(:,id_Orch_acetal) * pctsrf(:,is_ter) * 44/24
700	! calcul du flux
701	eflux(:,id_CH3CHO) = eflux_veg(:,id_Orch_acetal) + eflux_notfromveg(:,id_Orch_acetal)
702	ENDIF
703
704	!! Acides carboxyliques
705	IF ((id_Orch_acetic .NE. 0).AND.(id_Orch_formic .NE. 0)) THEN
706	! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s
707	! =acide acetique+acide formique (HCOOH, converti en C acide acetique) d'ORCHIDEE
708	eflux_veg(:,id_Orch_acetic) = (tot_emiflx_fromOrch(:,id_Orch_acetic)+tot_emiflx_fromOrch(:,id_Orch_formic)) * pctsrf(:,is_ter) * 60/24
709	! calcul du flux
710	eflux(:,id_CH3COOH) = eflux_veg(:,id_Orch_acetic) + eflux_notfromveg(:,id_Orch_acetic)
711	ENDIF
712
713
714	#endif
715
716
717	#ifndef DUSS
718	#ifdef AER
719
720	CALL nightingale(u, v, paprs, pmid, &
721	cdragh, cdragm, temp, sh, ftsol, ts, &
722	pctsrf,econc_dms,eflux(:,id_DMS))
723	#endif
724	#endif
725
726
727	END SUBROUTINE MKSFLX_P2P
728

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

Context Navigation

source: CONFIG/publications/ICOLMDZORINCA_CO2_Transport_GMD_2023/INCA/src/INCA_SRC/mksflx_p2p.F90 @ 6610

Download in other formats: