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