Context Navigation

coarsemission.F @ 2404

Last change on this file since 2404 was 2196, checked in by jescribano, 10 years ago
Dust emission scheme changes: (1) Included possibility of use previous dust emission scheme (with 2 dust bins). (2) Parameter of Marticorena and Bergametti 1995 set to it's original value (2.61) for testing purposes with pdtphys=15min. (3) Cleaning ustar calculation.
File size: 13.0 KB

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

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

Download in other formats:

Original Format