module_plumerise1.F
References to this file elsewhere.
1 Module module_plumerise1
2 ! use module_zero_plumegen_coms
3 integer, parameter :: nveg_agreg = 4
4 ! integer, parameter :: tropical_forest = 1
5 ! integer, parameter :: boreal_forest = 2
6 ! integer, parameter :: savannah = 3
7
8 ! integer, parameter :: grassland = 4
9 real, dimension(nveg_agreg) :: firesize,mean_fct
10 ! character(len=20), parameter :: veg_name(nveg_agreg) = (/ &
11 ! 'Tropical-Forest', &
12 ! 'Boreal-Forest ', &
13 ! 'Savanna ', &
14 ! 'Grassland ' /)
15 ! character(len=20), parameter :: spc_suf(nveg_agreg) = (/ &
16 ! 'agtf' , & ! trop forest
17 ! 'agef' , & ! extratrop forest
18 ! 'agsv' , & ! savanna
19 ! 'aggr' /) ! grassland
20
21
22 CONTAINS
23 subroutine plumerise_driver (id,ktau,dtstep, &
24 ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8, &
25 ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso, &
26 ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald, &
27 ebu_ket,ebu_macr,ebu_ora1,ebu_ora2,mean_fct_agtf,mean_fct_agef,&
28 mean_fct_agsv,mean_fct_aggr,firesize_agtf,firesize_agef, &
29 firesize_agsv,firesize_aggr, &
30 config_flags, t_phy,moist, &
31 chem,rho_phy,vvel,u_phy,v_phy,p_phy, &
32 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt, &
33 e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_pm25,e_pm10,e_nh3, &
34 e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj,e_no2,e_ch3oh, &
35 e_c2h5oh,e_so4j,e_so4c,e_no3j,e_no3c,e_orgc,e_ecc, &
36 z_at_w,z, &
37 ids,ide, jds,jde, kds,kde, &
38 ims,ime, jms,jme, kms,kme, &
39 its,ite, jts,jte, kts,kte )
40
41 USE module_configure
42 USE module_model_constants
43 USE module_state_description
44 USE module_zero_plumegen_coms
45 USE module_chem_plumerise_scalar
46 ! integer, parameter :: nveg_agreg = 4
47 IMPLICIT NONE
48
49 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
50
51 INTEGER, INTENT(IN ) :: id,ktau, &
52 ids,ide, jds,jde, kds,kde, &
53 ims,ime, jms,jme, kms,kme, &
54 its,ite, jts,jte, kts,kte
55 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), &
56 INTENT(IN ) :: moist
57 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
58 INTENT(INOUT ) :: chem
59 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
60 INTENT(INOUT ) :: &
61 ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8, &
62 ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso, &
63 ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald, &
64 ebu_ket,ebu_macr,ebu_ora1,ebu_ora2
65 REAL, DIMENSION( ims:ime, jms:jme ), &
66 INTENT(IN ) :: &
67 mean_fct_agtf,mean_fct_agef,&
68 mean_fct_agsv,mean_fct_aggr,firesize_agtf,firesize_agef, &
69 firesize_agsv,firesize_aggr
70
71 REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ), &
72 INTENT(IN ) :: &
73 e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2, &
74 e_olt,e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_pm25, &
75 e_pm10,e_nh3,e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj,e_no2, &
76 e_ch3oh,e_c2h5oh,e_so4j,e_so4c,e_no3j,e_no3c,e_orgc,e_ecc
77 !
78 !
79 !
80 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
81 INTENT(IN ) :: &
82 t_phy, &
83 z,z_at_w,vvel,u_phy,v_phy,rho_phy,p_phy
84 REAL, INTENT(IN ) :: &
85 dtstep
86 !
87 ! Local variables...
88 !
89 INTEGER :: i, j, k, ksub
90
91
92 integer, parameter :: nspecies=25
93 real, dimension (nspecies) :: eburn_in
94 real, dimension (kte,nspecies) :: eburn_out
95 real, dimension (kte) :: u_in ,v_in ,w_in ,theta_in ,pi_in &
96 ,rho_phyin ,qv_in ,zmid &
97 ,z_lev
98 real :: sum
99 ! real,save,dimension(its:ite,jts:jte) :: ffirs
100 ! ffirs=0.
101
102 do j=jts,jte
103 do i=its,ite
104 do k=kts+1,kte
105 ebu_co(i,k,j)=0.
106 ebu_co2(i,k,j)=0.
107 ebu_eth(i,k,j)=0.
108 ebu_hc3(i,k,j)=0.
109 ebu_hc5(i,k,j)=0.
110 ebu_hc8(i,k,j)=0.
111 ebu_ete(i,k,j)=0.
112 ebu_olt(i,k,j)=0.
113 ebu_oli(i,k,j)=0.
114 ebu_pm25(i,k,j)=0.
115 ebu_pm10(i,k,j)=0.
116 ebu_dien(i,k,j)=0.
117 ebu_iso(i,k,j)=0.
118 ebu_api(i,k,j)=0.
119 ebu_lim(i,k,j)=0.
120 ebu_tol(i,k,j)=0.
121 ebu_xyl(i,k,j)=0.
122 ebu_csl(i,k,j)=0.
123 ebu_hcho(i,k,j)=0.
124 ebu_ald(i,k,j)=0.
125 ebu_ket(i,k,j)=0.
126 ebu_macr(i,k,j)=0.
127 ebu_ora1(i,k,j)=0.
128 ebu_ora2(i,k,j)=0.
129
130 enddo
131 enddo
132 enddo
133 do j=jts,jte
134 do i=its,ite
135 sum=mean_fct_agtf(i,j)+mean_fct_agef(i,j)+mean_fct_agsv(i,j) &
136 +mean_fct_aggr(i,j)
137 if(sum.lt.1.e-6)Cycle
138 ! ffirs=ffirs+1
139 eburn_out=0.
140 mean_fct(1)=mean_fct_agtf(i,j)
141 mean_fct(2)=mean_fct_agef(i,j)
142 mean_fct(3)=mean_fct_agsv(i,j)
143 mean_fct(4)=mean_fct_aggr(i,j)
144 firesize(1)=firesize_agtf(i,j)
145 firesize(2)=firesize_agef(i,j)
146 firesize(3)=firesize_agsv(i,j)
147 firesize(4)=firesize_aggr(i,j)
148 eburn_in(1)=ebu_no(i,kts,j)
149 eburn_in(2)=ebu_co(i,kts,j)
150 eburn_in(3)=ebu_co2(i,kts,j)
151 eburn_in(4)=ebu_eth(i,kts,j)
152 eburn_in(5)=ebu_hc3(i,kts,j)
153 eburn_in(6)=ebu_hc5(i,kts,j)
154 eburn_in(7)=ebu_hc8(i,kts,j)
155 eburn_in(8)=ebu_ete(i,kts,j)
156 eburn_in(9)=ebu_olt(i,kts,j)
157 eburn_in(10)=ebu_oli(i,kts,j)
158 eburn_in(11)=ebu_pm25(i,kts,j)
159 eburn_in(12)=ebu_pm10(i,kts,j)
160 eburn_in(13)=ebu_dien(i,kts,j)
161 eburn_in(14)=ebu_iso(i,kts,j)
162 eburn_in(15)=ebu_api(i,kts,j)
163 eburn_in(16)=ebu_lim(i,kts,j)
164 eburn_in(17)=ebu_tol(i,kts,j)
165 eburn_in(18)=ebu_xyl(i,kts,j)
166 eburn_in(19)=ebu_csl(i,kts,j)
167 eburn_in(20)=ebu_hcho(i,kts,j)
168 eburn_in(21)=ebu_ald(i,kts,j)
169 eburn_in(22)=ebu_ket(i,kts,j)
170 eburn_in(23)=ebu_macr(i,kts,j)
171 eburn_in(24)=ebu_ora1(i,kts,j)
172 eburn_in(25)=ebu_ora2(i,kts,j)
173 do k=kts,kte-1
174 u_in(k)=u_phy(i,k,j)
175 v_in(k)=v_phy(i,k,j)
176 w_in(k)=vvel(i,k,j)
177 qv_in(k)=moist(i,k,j,p_qv)
178 pi_in(k)=cp*(p_phy(i,k,j)/p1000mb)**rcp
179 zmid(k)=z(i,k,j)-z_at_w(i,kts,j)
180 z_lev(k)=z_at_w(i,k,j)-z_at_w(i,kts,j)
181 rho_phyin(k)=rho_phy(i,k,j)
182 theta_in(k)=t_phy(i,k,j)/pi_in(k)*cp
183 ! if(ffirs.le.5)then
184 ! write(0,*)k,u_in(k),w_in(k),qv_in(k),pi_in(k)
185 ! endif
186 enddo
187 pi_in(kte)=pi_in(kte-1)
188 u_in(kte)=u_in(kte-1)
189 v_in(kte)=v_in(kte-1)
190 w_in(kte)=w_in(kte-1)
191 qv_in(kte)=qv_in(kte-1)
192 zmid(kte)=z(i,kte,j)-z_at_w(i,kts,j)
193 z_lev(kte)=z_at_w(i,kte,j)-z_at_w(i,kts,j)
194 rho_phyin(kte)=rho_phyin(kte-1)
195 theta_in(kte)=theta_in(kte-1)
196 ! if(ffirs.le.5)then
197 ! do k=kts,kte
198 ! write(0,*)k,z_lev(k),zmid(k),rho_phyin(k),theta_in(k)
199 ! enddo
200 ! write(0,*)'eburn',eburn_in(1),mean_fct,firesize
201 ! endif
202
203 call plumerise(kte,1,1,1,1,1,1 &
204 ,nspecies,eburn_in,eburn_out &
205 ,u_in ,v_in ,w_in ,theta_in ,pi_in &
206 ,rho_phyin ,qv_in ,zmid &
207 ,z_lev )
208 ! if(ffirs.le.5)then
209 ! do k=kts,kte
210 ! write(0,*)'eburn_out ',k,i,j,eburn_out(k,1)
211 ! enddo
212 ! endif
213 do k=kts,kte-1
214 ebu_no(i,k,j)=eburn_out(k,1)
215 ebu_co(i,k,j)=eburn_out(k,2)
216 if(i.eq.56.and.j.eq.132)write(0,*)i,j,k,ebu_no(i,k,j),ebu_co(i,k,j)
217 ebu_co2(i,k,j)=eburn_out(k,3)
218 ebu_eth(i,k,j)=eburn_out(k,4)
219 ebu_hc3(i,k,j)=eburn_out(k,5)
220 ebu_hc5(i,k,j)=eburn_out(k,6)
221 ebu_hc8(i,k,j)=eburn_out(k,7)
222 ebu_ete(i,k,j)=eburn_out(k,8)
223 ebu_olt(i,k,j)=eburn_out(k,9)
224 ebu_oli(i,k,j)=eburn_out(k,10)
225 ebu_pm25(i,k,j)=eburn_out(k,11)
226 ebu_pm10(i,k,j)=eburn_out(k,12)
227 ebu_dien(i,k,j)=eburn_out(k,13)
228 ebu_iso(i,k,j)=eburn_out(k,14)
229 ebu_api(i,k,j)=eburn_out(k,15)
230 ebu_lim(i,k,j)=eburn_out(k,16)
231 ebu_tol(i,k,j)=eburn_out(k,17)
232 ebu_xyl(i,k,j)=eburn_out(k,18)
233 ebu_csl(i,k,j)=eburn_out(k,19)
234 ebu_hcho(i,k,j)=eburn_out(k,20)
235 ebu_ald(i,k,j)=eburn_out(k,21)
236 ebu_ket(i,k,j)=eburn_out(k,22)
237 ebu_macr(i,k,j)=eburn_out(k,23)
238 ebu_ora1(i,k,j)=eburn_out(k,24)
239 ebu_ora2(i,k,j)=eburn_out(k,25)
240 enddo
241
242 enddo
243 enddo
244 end subroutine plumerise_driver
245
246 END Module module_plumerise1