Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

coarsemission.F @ 5445

Last change on this file since 5445 was 2630, checked in by fhourdin, 8 years ago
Importation du modèle d'aérosols de Boucher, Escribano et al.
File size: 12.9 KB

Line
1	c This subroutine calculates the emissions of SEA SALT and DUST, part of
2	C which goes to tracer 2 and other part to tracer 3.
3	SUBROUTINE coarsemission(pctsrf,pdtphys,
4	. t_seri,pmflxr,pmflxs,prfl,psfl,
5	. xlat,xlon,debutphy,
6	. zu10m,zv10m,wstar,ale_bl,ale_wake,
7	. scale_param_ssacc,scale_param_sscoa,
8	. scale_param_dustacc,scale_param_dustcoa,
9	. scale_param_dustsco,
10	. nbreg_dust,
11	. iregion_dust,dust_ec,
12	. param_wstarBLperregion,param_wstarWAKEperregion,
13	. nbreg_wstardust,
14	. iregion_wstardust,
15	. lmt_sea_salt,qmin,qmax,
16	. flux_sparam_ddfine,flux_sparam_ddcoa,
17	. flux_sparam_ddsco,
18	. flux_sparam_ssfine,flux_sparam_sscoa,
19	. id_prec,id_fine,id_coss,id_codu,id_scdu,
20	. ok_chimeredust,
21	. source_tr,flux_tr)
22	! . wth,cly,zprecipinsoil,lmt_sea_salt,
23
24	! CALL dustemission( debutphy, xlat, xlon, pctsrf,
25	! . zu10m zv10m,wstar,ale_bl,ale_wake)
26	!
27
28	USE dimphy
29	USE indice_sol_mod
30	USE infotrac
31	USE dustemission_mod, ONLY : dustemission
32	! USE phytracr_spl_mod, ONLY : nbreg_dust, nbreg_ind, nbreg_bb
33	IMPLICIT NONE
34
35	#include "dimensions.h"
36	#include "chem.h"
37	#include "chem_spla.h"
38	#include "YOMCST.h"
39	#include "paramet.h"
40
41	c============================== INPUT ==================================
42	INTEGER nbjour
43	LOGICAL ok_chimeredust
44	REAL pdtphys ! pas d'integration pour la physique (seconde)
45	REAL t_seri(klon,klev) ! temperature
46	REAL pctsrf(klon,nbsrf)
47	REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection
48	! REAL pmflxr(klon,klev), pmflxs(klon,klev) !--convection
49	REAL prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale
50	! REAL prfl(klon,klev), psfl(klon,klev) !--large-scale
51	LOGICAL debutphy, lafinphy
52	REAL, intent(in) :: xlat(klon) ! latitudes pour chaque point
53	REAL, intent(in) :: xlon(klon) ! longitudes pour chaque point
54	REAL,DIMENSION(klon),INTENT(IN) :: zu10m
55	REAL,DIMENSION(klon),INTENT(IN) :: zv10m
56	REAL,DIMENSION(klon),INTENT(IN) :: wstar,Ale_bl,ale_wake
57
58	c
59	c------------------------- Scaling Parameters --------------------------
60	c
61	INTEGER iregion_dust(klon) !Defines dust regions
62	REAL scale_param_ssacc !Scaling parameter for Fine Sea Salt
63	REAL scale_param_sscoa !Scaling parameter for Coarse Sea Salt
64	REAL scale_param_dustacc(nbreg_dust) !Scaling parameter for Fine Dust
65	REAL scale_param_dustcoa(nbreg_dust) !Scaling parameter for Coarse Dust
66	REAL scale_param_dustsco(nbreg_dust) !Scaling parameter for SCoarse Dust
67	!JE20141124<<
68	INTEGER iregion_wstardust(klon) !Defines dust regions in terms of wstar
69	REAL param_wstarBLperregion(nbreg_wstardust) !
70	REAL param_wstarWAKEperregion(nbreg_wstardust) !
71	REAL param_wstarBL(klon) !parameter for surface wind correction..
72	REAL param_wstarWAKE(klon) !parameter for surface wind correction..
73	INTEGER nbreg_wstardust
74	!JE20141124>>
75	INTEGER nbreg_dust
76	INTEGER, INTENT(IN) :: id_prec,id_fine,id_coss,id_codu,id_scdu
77	c============================== OUTPUT =================================
78	REAL source_tr(klon,nbtr)
79	REAL flux_tr(klon,nbtr)
80	REAL flux_sparam_ddfine(klon), flux_sparam_ddcoa(klon)
81	REAL flux_sparam_ddsco(klon)
82	REAL flux_sparam_ssfine(klon), flux_sparam_sscoa(klon)
83	c=========================== LOCAL VARIABLES ===========================
84	INTEGER i, j
85	REAL pct_ocean(klon)
86	! REAL zprecipinsoil(klon)
87	! REAL cly(klon), wth(klon)
88	REAL clyfac, avgdryrate, drying
89
90	c---------------------------- SEA SALT emissions ------------------------
91	REAL lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um
92	c
93	c--------vent 10 m CEPMMT
94	c
95	REAL dust_ec(klon)
96
97	real tmp_var2(klon,nbtr) ! auxiliary variable to replace source
98	REAL qmin, qmax
99	!----------------------DUST Sahara ---------------
100	REAL, DIMENSION(klon) :: dustsourceacc,dustsourcecoa,dustsourcesco
101	INTEGER, DIMENSION(klon) :: maskd
102	C********************* DUST EMMISSIONS *****************************
103	c
104
105	! avgdryrate=300./365.*pdtphys/86400.
106	c
107	! DO i=1, klon
108	c
109	! IF (cly(i).LT.9990..AND.wth(i).LT.9990.) THEN
110	! zprecipinsoil(i)=zprecipinsoil(i) +
111	! . (pmflxr(i,1)+pmflxs(i,1)+prfl(i,1)+psfl(i,1))*pdtphys
112	c
113	! clyfac=MIN(16., cly(i)*0.4+8.) ![mm] max amount of water hold in top soil
114	! drying=avgdryrateexp(0.03905491
115	! . exp(0.17446*(t_seri(i,1)-273.15))) ! [mm]
116	! zprecipinsoil(i)=min(max(0.,zprecipinsoil(i)-drying),clyfac) ! [mm]
117	c
118	! ENDIF
119	c
120	! ENDDO
121	c
122	c ==================== CALCULATING DUST EMISSIONS ======================
123	c
124	! IF (lminmax) THEN
125	DO j=1,nbtr
126	DO i=1,klon
127	tmp_var2(i,j)=source_tr(i,j)
128	ENDDO
129	ENDDO
130	CALL minmaxsource(tmp_var2,qmin,qmax,'src: before DD emiss')
131	! print *,'Source = ',SUM(source_tr),MINVAL(source_tr),
132	! . MAXVAL(source_tr)
133	! ENDIF
134
135	c
136	IF (.NOT. ok_chimeredust) THEN
137	DO i=1, klon
138	!! IF (cly(i).GE.9990..OR.wth(i).GE.9990..OR.
139	!! . t_seri(i,1).LE.273.15.OR.zprecipinsoil(i).GT.1.e-8) THEN
140	!! dust_ec(i)=0.0
141	!! ENDIF
142	!c Corresponds to dust_emission.EQ.3
143	!!!!!!!****************AQUIIIIIIIIIIIIIIIIIIIIIIIIIIII
144	!! Original line (4 tracers)
145	!JE<< old 4 tracer(nhl scheme) source_tr(i,id_fine)=scale_param_dustacc(iregion_dust(i))*
146	! . dust_ec(i)1.e30.093 ! g/m2/s
147	! source_tr(i,id_codu)=scale_param_dustcoa(iregion_dust(i))*
148	! . dust_ec(i)1.e30.905 ! g/m2/s bin 0.5-10um
149	!! Original line (4 tracers)
150	! flux_tr(i,id_fine)=scale_param_dustacc(iregion_dust(i))*
151	! . dust_ec(i)1.e30.093*1.e3 !mg/m2/s
152	! flux_tr(i,id_codu)=scale_param_dustcoa(iregion_dust(i))*
153	! . dust_ec(i)1.e30.905*1.e3 !mg/m2/s bin 0.5-10um
154	! flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) *
155	! . dust_ec(i)1.e30.093*1.e3
156	! flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) *
157	! . dust_ec(i)1.e30.905*1.e3
158	IF(id_fine>0) source_tr(i,id_fine)=
159	. scale_param_dustacc(iregion_dust(i))*
160	. dust_ec(i)1.e30.093 ! g/m2/s
161	IF(id_codu>0) source_tr(i,id_codu)=
162	. scale_param_dustcoa(iregion_dust(i))*
163	. dust_ec(i)1.e30.905 ! g/m2/s bin 0.5-10um
164	IF(id_scdu>0) source_tr(i,id_scdu)=0. ! no supercoarse
165	! Original line (4 tracers)
166	IF(id_fine>0) flux_tr(i,id_fine)=
167	. scale_param_dustacc(iregion_dust(i))*
168	. dust_ec(i)1.e30.093*1.e3 !mg/m2/s
169	IF(id_codu>0) flux_tr(i,id_codu)=
170	. scale_param_dustcoa(iregion_dust(i))*
171	. dust_ec(i)1.e30.905*1.e3 !mg/m2/s bin 0.5-10um
172	IF(id_scdu>0) flux_tr(i,id_scdu)=0.
173
174	flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) *
175	. dust_ec(i)1.e30.093*1.e3
176	flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) *
177	. dust_ec(i)1.e30.905*1.e3
178	flux_sparam_ddsco(i)=0.
179	ENDDO
180	ENDIF
181	!***************NEW CHIMERE DUST EMISSION Sahara***
182	! je 20140522
183	IF(ok_chimeredust) THEN
184	print *,'MIX- NEW SAHARA DUST SOURCE SCHEME...'
185
186	DO i=1,klon
187	param_wstarBL(i) =param_wstarBLperregion(iregion_wstardust(i))
188	param_wstarWAKE(i)=param_wstarWAKEperregion(iregion_wstardust(i))
189	ENDDO
190
191
192	CALL dustemission( debutphy, xlat, xlon, pctsrf,
193	. zu10m,zv10m,wstar,ale_bl,ale_wake,
194	. param_wstarBL, param_wstarWAKE,
195	. dustsourceacc,dustsourcecoa,
196	. dustsourcesco,maskd)
197
198	DO i=1,klon
199	if (maskd(i).gt.0) then
200	IF(id_fine>0) source_tr(i,id_fine)=
201	. scale_param_dustacc(iregion_dust(i))*
202	. dustsourceacc(i)*1.e3 ! g/m2/s bin 0.03-0.5
203	IF(id_codu>0) source_tr(i,id_codu)=
204	. scale_param_dustcoa(iregion_dust(i))*
205	. dustsourcecoa(i)*1.e3 ! g/m2/s bin 0.5-3um
206	IF(id_scdu>0) source_tr(i,id_scdu)=
207	. scale_param_dustsco(iregion_dust(i))*
208	. dustsourcesco(i)*1.e3 ! g/m2/s bin 3-15um
209	! Original line (4 tracers)
210	IF(id_fine>0) flux_tr(i,id_fine)=
211	. scale_param_dustacc(iregion_dust(i))*
212	. dustsourceacc(i)1.e31.e3 !mg/m2/s
213	IF(id_codu>0) flux_tr(i,id_codu)=
214	. scale_param_dustcoa(iregion_dust(i))*
215	. dustsourcecoa(i)1.e31.e3 !mg/m2/s bin 0.5-3um
216	IF(id_scdu>0) flux_tr(i,id_scdu)=
217	. scale_param_dustsco(iregion_dust(i))*
218	. dustsourcesco(i)1.e31.e3 !mg/m2/s bin 3-15um
219	flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) *
220	. dustsourceacc(i)1.e31.e3
221	flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) *
222	. dustsourcecoa(i)1.e31.e3
223	flux_sparam_ddsco(i)=scale_param_dustsco(iregion_dust(i)) *
224	. dustsourcesco(i)1.e31.e3
225	else
226	IF(id_fine>0) source_tr(i,id_fine)=
227	. scale_param_dustacc(iregion_dust(i))*
228	. dust_ec(i)1.e30.114 ! g/m2/s
229	IF(id_codu>0) source_tr(i,id_codu)=
230	. scale_param_dustcoa(iregion_dust(i))*
231	. dust_ec(i)1.e30.108 ! g/m2/s bin 0.5-3um
232	IF(id_scdu>0) source_tr(i,id_scdu)=
233	. scale_param_dustsco(iregion_dust(i))*
234	. dust_ec(i)1.e30.778 ! g/m2/s bin 3-15um
235	! Original line (4 tracers)
236	IF(id_fine>0) flux_tr(i,id_fine)=
237	. scale_param_dustacc(iregion_dust(i))*
238	. dust_ec(i)1.e30.114*1.e3 !mg/m2/s
239	IF(id_codu>0) flux_tr(i,id_codu)=
240	. scale_param_dustcoa(iregion_dust(i))*
241	. dust_ec(i)1.e30.108*1.e3 !mg/m2/s bin 0.5-3um
242	IF(id_scdu>0) flux_tr(i,id_scdu)=
243	. scale_param_dustsco(iregion_dust(i))*
244	. dust_ec(i)1.e30.778*1.e3 !mg/m2/s bin 0.5-3um
245
246	flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) *
247	. dust_ec(i)1.e30.114*1.e3
248	flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) *
249	. dust_ec(i)1.e30.108*1.e3
250	flux_sparam_ddsco(i)=scale_param_dustsco(iregion_dust(i)) *
251	. dust_ec(i)1.e30.778*1.e3
252
253	endif
254	ENDDO
255
256
257
258
259
260	ENDIF
261	!*****************************************************
262	C***************** SEA SALT EMMISSIONS *****************************
263	DO i=1,klon
264	pct_ocean(i)=pctsrf(i,is_oce)
265	ENDDO
266	c
267	! IF (lminmax) THEN
268	DO j=1,nbtr
269	DO i=1,klon
270	tmp_var2(i,j)=source_tr(i,j)
271	ENDDO
272	ENDDO
273	CALL minmaxsource(tmp_var2,qmin,qmax,'src: before SS emiss')
274	IF(id_coss>0) then
275	print *,'Source = ',SUM(source_tr(:,id_coss)),
276	. MINVAL(source_tr(:,id_coss)), MAXVAL(source_tr(:,id_coss))
277	ENDIF
278	!
279	DO i=1,klon
280	! Original line (4 tracers)
281	IF(id_fine>0) source_tr(i,id_fine)=
282	. source_tr(i,id_fine)+scale_param_ssacc*
283	. lmt_sea_salt(i,1)*1.e4 !g/m2/s
284
285	! Original line (4 tracers)
286	IF(id_fine>0) flux_tr(i,id_fine)=
287	. flux_tr(i,id_fine)+scale_param_ssacc
288	. lmt_sea_salt(i,1)1.e4*1.e3 !mg/m2/s
289	!
290	IF(id_coss>0) source_tr(i,id_coss)=
291	. scale_param_sscoalmt_sea_salt(i,2)1.e4 !g/m2/s
292	IF(id_coss>0) flux_tr(i,id_coss)=
293	. scale_param_sscoalmt_sea_salt(i,2)1.e4*1.e3 !mg/m2/s
294	c
295	flux_sparam_ssfine(i)=scale_param_ssacc *
296	. lmt_sea_salt(i,1)1.e41.e3
297	flux_sparam_sscoa(i)=scale_param_sscoa *
298	. lmt_sea_salt(i,2)1.e41.e3
299	ENDDO
300	! IF (lminmax) THEN
301	DO j=1,nbtr
302	DO i=1,klon
303	tmp_var2(i,j)=source_tr(i,j)
304	ENDDO
305	ENDDO
306	CALL minmaxsource(tmp_var2,qmin,qmax,'src: after SS emiss')
307	IF(id_coss>0) then
308	print *,'Source = ',SUM(source_tr(:,id_coss)),
309	. MINVAL(source_tr(:,id_coss)), MAXVAL(source_tr(:,id_coss))
310	ENDIF
311	c
312
313	END

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

Download in other formats:

Original Format