module_add_emiss_burn.F
References to this file elsewhere.
1 Module module_add_emiss_burn
2 CONTAINS
3 subroutine add_emis_burn(id,dtstep,ktau,dz8w,config_flags,rho_phy,chem, &
4 julday,gmt,xlat,xlong,t_phy,p_phy, &
5 ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8, &
6 ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso, &
7 ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald, &
8 ebu_ket,ebu_macr,ebu_ora1,ebu_ora2, &
9 ids,ide, jds,jde, kds,kde, &
10 ims,ime, jms,jme, kms,kme, &
11 its,ite, jts,jte, kts,kte )
12 USE module_configure
13 USE module_state_description
14 IMPLICIT NONE
15
16
17 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
18
19 INTEGER, INTENT(IN ) :: id,julday, &
20 ids,ide, jds,jde, kds,kde, &
21 ims,ime, jms,jme, kms,kme, &
22 its,ite, jts,jte, kts,kte
23 INTEGER, INTENT(IN ) :: &
24 ktau
25 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
26 INTENT(INOUT ) :: chem
27 !
28 !
29 !
30 REAL, DIMENSION( ims:ime , jms:jme ) , &
31 INTENT(IN ) :: &
32 xlat,xlong
33 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
34 INTENT(IN ) :: &
35 t_phy, &
36 p_phy, &
37 dz8w, &
38 rho_phy
39 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
40 INTENT(IN ) :: &
41 ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8, &
42 ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso, &
43 ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald, &
44 ebu_ket,ebu_macr,ebu_ora1,ebu_ora2
45
46 REAL, INTENT(IN ) :: &
47 dtstep,gmt
48 integer ::imonth1,idate1,iyear1,itime1
49 integer :: i,j,k
50 real :: time,conv_rho
51 integer :: iweek,idays
52 real :: tign,timeq,r_q,r_antro
53 real, dimension(7) :: week_CYCLE
54 ! dia da semana: DOM SEG TER QUA QUI SEX SAB
55 ! iweek= 1 2 3 4 5 6 7
56 !- dados cetesb/campinas/2005
57 data (week_CYCLE(iweek),iweek=1,7) /0.67, 1.1, 1.1, 1.1, 1.1, 1.1, 0.83/ !total = 7
58 real, parameter :: bx_bburn = 18.041288 * 3600., & !- peak at 18 UTC
59 cx = 2.184936 * 3600., &
60 rinti = 2.1813936e-8 , &
61 ax = 2000.6038 , &
62 bx_antro = 15.041288 * 3600. !- peak em 15 UTC
63 !itime1 : initial time of simulation (hour*100)
64 ! time : time elapsed in seconds
65 ! r_q : gaussian function in 1/sec
66
67 !-------------biomass burning diurnal cycle --------------------
68 !number of days of simulation
69 idays = int(( float(itime1)/100. + time/3600.)/24.+.00001)
70 tign = real(idays)*24.*3600.
71 ! Modulacao da queimada media durante o ciclo diurno(unidade: 1/s)
72 ! com a int( r_q dt) (0 - 24h)= 1.
73 timeq= ( time + float(itime1)*0.01*3600. - tign )
74 timeq=gmt*3600.+float(ktau)*dtstep
75 timeq=mod(timeq,86400.)
76 r_q = rinti*( ax * exp( -(timeq-bx_bburn)**2/(2.*cx**2) ) + 100. - &
77 5.6712963e-4*( timeq ))
78
79
80 !------------- anthropogenic diurnal cycle (industrial,residencial, ...)
81 ! weekly cycle
82 ! week day
83 iweek= int(((float(julday)/7. - &
84 int(julday/7))*7.)) + 1
85 if(iweek.gt.7) iweek = iweek-7
86 !- weekly + diurnal cycle
87 r_q=r_q*86400.
88
89 do j=jts,jte
90 do i=its,ite
91 do k=kts+1,kte
92 conv_rho=r_q*4.828e-4/rho_phy(i,k,j)*dtstep/60.
93 if(i.eq.56.and.j.eq.132)write(0,*)k,ebu_co(i,k,j),conv_rho,r_q,dtstep
94 chem(i,k,j,p_csl) = chem(i,k,j,p_csl) &
95 +ebu_csl(i,k,j)*conv_rho
96 chem(i,k,j,p_iso) = chem(i,k,j,p_iso) &
97 +ebu_iso(i,k,j)*conv_rho
98 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
99 +ebu_no(i,k,j)*conv_rho
100 chem(i,k,j,p_ald) = chem(i,k,j,p_ald) &
101 +ebu_ald(i,k,j)*conv_rho
102 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
103 +ebu_hcho(i,k,j)*conv_rho
104 chem(i,k,j,p_ora2) = chem(i,k,j,p_ora2) &
105 +ebu_ora2(i,k,j)*conv_rho
106 chem(i,k,j,p_hc3) = chem(i,k,j,p_hc3) &
107 +ebu_hc3(i,k,j)*conv_rho
108 chem(i,k,j,p_hc5) = chem(i,k,j,p_hc5) &
109 +ebu_hc5(i,k,j)*conv_rho
110 chem(i,k,j,p_hc8) = chem(i,k,j,p_hc8) &
111 +ebu_hc8(i,k,j)*conv_rho
112 chem(i,k,j,p_eth) = chem(i,k,j,p_eth) &
113 +ebu_eth(i,k,j)*conv_rho
114 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
115 +ebu_co(i,k,j)*conv_rho
116 chem(i,k,j,p_olt) = chem(i,k,j,p_olt) &
117 +ebu_olt(i,k,j)*conv_rho
118 chem(i,k,j,p_oli) = chem(i,k,j,p_oli) &
119 +ebu_oli(i,k,j)*conv_rho
120 chem(i,k,j,p_tol) = chem(i,k,j,p_tol) &
121 +ebu_tol(i,k,j)*conv_rho
122 chem(i,k,j,p_xyl) = chem(i,k,j,p_xyl) &
123 +ebu_xyl(i,k,j)*conv_rho
124 chem(i,k,j,p_ket) = chem(i,k,j,p_ket) &
125 +ebu_ket(i,k,j)*conv_rho
126 chem(i,k,j,p_pm_25) = chem(i,k,j,p_pm_25) &
127 +r_q*ebu_pm25(i,k,j)/rho_phy(i,k,j)*dtstep
128 chem(i,k,j,p_pm_10) = chem(i,k,j,p_pm_10) &
129 +r_q*ebu_pm10(i,k,j)/rho_phy(i,k,j)*dtstep
130 enddo
131 k=kts
132 conv_rho=r_q*4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
133 chem(i,k,j,p_csl) = chem(i,k,j,p_csl) &
134 +ebu_csl(i,k,j)*conv_rho
135 chem(i,k,j,p_iso) = chem(i,k,j,p_iso) &
136 +ebu_iso(i,k,j)*conv_rho
137 chem(i,k,j,p_no) = chem(i,k,j,p_no) &
138 +ebu_no(i,k,j)*conv_rho
139 chem(i,k,j,p_ald) = chem(i,k,j,p_ald) &
140 +ebu_ald(i,k,j)*conv_rho
141 chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) &
142 +ebu_hcho(i,k,j)*conv_rho
143 chem(i,k,j,p_ora2) = chem(i,k,j,p_ora2) &
144 +ebu_ora2(i,k,j)*conv_rho
145 chem(i,k,j,p_hc3) = chem(i,k,j,p_hc3) &
146 +ebu_hc3(i,k,j)*conv_rho
147 chem(i,k,j,p_hc5) = chem(i,k,j,p_hc5) &
148 +ebu_hc5(i,k,j)*conv_rho
149 chem(i,k,j,p_hc8) = chem(i,k,j,p_hc8) &
150 +ebu_hc8(i,k,j)*conv_rho
151 chem(i,k,j,p_eth) = chem(i,k,j,p_eth) &
152 +ebu_eth(i,k,j)*conv_rho
153 chem(i,k,j,p_co) = chem(i,k,j,p_co) &
154 +ebu_co(i,k,j)*conv_rho
155 chem(i,k,j,p_olt) = chem(i,k,j,p_olt) &
156 +ebu_olt(i,k,j)*conv_rho
157 chem(i,k,j,p_oli) = chem(i,k,j,p_oli) &
158 +ebu_oli(i,k,j)*conv_rho
159 chem(i,k,j,p_tol) = chem(i,k,j,p_tol) &
160 +ebu_tol(i,k,j)*conv_rho
161 chem(i,k,j,p_xyl) = chem(i,k,j,p_xyl) &
162 +ebu_xyl(i,k,j)*conv_rho
163 chem(i,k,j,p_ket) = chem(i,k,j,p_ket) &
164 +ebu_ket(i,k,j)*conv_rho
165 chem(i,k,j,p_pm_25) = chem(i,k,j,p_pm_25) &
166 +r_q*ebu_pm25(i,k,j)/rho_phy(i,k,j)/dz8w(i,k,j)*dtstep
167 chem(i,k,j,p_pm_10) = chem(i,k,j,p_pm_10) &
168 +r_q*ebu_pm10(i,k,j)/rho_phy(i,k,j)/dz8w(i,k,j)*dtstep
169 enddo
170 enddo
171
172
173 END subroutine add_emis_burn
174
175 END Module module_add_emiss_burn