chem_driver.F
References to this file elsewhere.
1 !WRF:MODEL_LAYER:CHEMICS
2 !
3 #if ( NMM_CORE == 1 )
4 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
5 !NCEP_MESO:MEDIATION_LAYER:SOLVER
6 !
7 !-----------------------------------------------------------------------
8 #include "../dyn_nmm/nmm_loop_basemacros.h"
9 #include "../dyn_nmm/nmm_loop_macros.h"
10 !-----------------------------------------------------------------------
11 #endif
12 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
13 subroutine chem_driver ( grid , config_flags &
14
15 #if ( EM_CORE == 1 )
16 #include "em_dummy_new_args.inc"
17 #endif
18
19 #if ( NMM_CORE == 1 )
20 #include "nmm_dummy_new_args.inc"
21 #endif
22
23 )
24 !----------------------------------------------------------------------
25 USE module_domain
26 USE module_configure
27 #if ( EM_CORE == 1 )
28 USE module_driver_constants
29 USE module_machine
30 USE module_tiles
31 #endif
32 USE module_dm
33 USE module_model_constants
34 USE module_state_description
35 #if ( NMM_CORE == 1 )
36 USE MODULE_PHYSICS_CALLS
37 #endif
38 USE module_data_radm2
39 USE module_data_sorgam
40 USE module_radm
41 USE module_dep_simple
42 USE module_bioemi_simple
43 USE module_phot_mad
44 USE module_aerosols_sorgam
45 USE module_chem_utilities
46 USE module_ctrans_grell
47 USE module_dry_dep_driver
48 USE module_emissions_driver
49 USE module_wetscav_driver, only: wetscav_driver
50 USE module_input_chem_data, only: &
51 #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
52 chem_dbg, &
53 #endif
54 get_last_gas
55 IMPLICIT NONE
56
57 ! Input data.
58
59 TYPE(domain) , TARGET :: grid
60 !
61 ! Definitions of dummy arguments to solve
62 #if ( EM_CORE == 1 )
63 #include <em_dummy_new_decl.inc>
64 #define NO_I1_OLD
65 !#include <em_i1_decl_new.inc>
66 #endif
67 #if ( NMM_CORE == 1 )
68 #include <nmm_dummy_new_decl.inc>
69 #ifdef DM_PARALLEL
70 INCLUDE "mpif.h"
71 #endif
72 #endif
73
74 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
75
76 INTEGER :: ids,ide, jds,jde, kds,kde, &
77 ims,ime, jms,jme, kms,kme, &
78 ips,ipe, jps,jpe, kps,kpe, &
79 its,ite, jts,jte, kts,kte
80 ! ..
81 ! .. Local Scalars ..
82 INTEGER :: stepave,i,j,k,l,numgas,nv,n, nr,ktauc, ktau,k_start,k_end,idf,jdf,kdf
83
84 ! ................................................................
85 ! ..
86 !
87 ! necessary for aerosols (module dependent)
88 !
89 #if ( NMM_CORE == 1 )
90 real, dimension(grid%sm31:grid%em31,grid%sm33:grid%em33,grid%sm32:grid%em32) ::vcsulf_old
91 real, dimension(grid%sm31:grid%em31,grid%sm33:grid%em33,grid%sm32:grid%em32,ldrog) ::vdrog3
92 real, dimension(grid%sm31:grid%em31,grid%sm33:grid%em33,grid%sm32:grid%em32) ::n2o5_het
93 REAL,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33,grid%sm32:grid%em32) :: &
94 p_phy,u_phy,v_phy &
95 ,t_phy,dz8w,t8w,p8w &
96 ,rho,rri,z_at_w,vvel,zmid
97 REAL,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32) :: pbl_h
98 REAL,DIMENSION(grid%sm33:grid%em33-1) :: QL,TL
99 REAL,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32) :: REXNSFC,FACTRS &
100 ,TOT,TSFC
101 REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: moist_trans
102 REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: scalar_trans
103 #endif
104 #if ( EM_CORE == 1 )
105 real, dimension(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) ::vcsulf_old
106 real, dimension(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,ldrog) ::vdrog3
107 real, dimension(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) ::n2o5_het
108 REAL,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: &
109 p_phy,u_phy,v_phy &
110 ,t_phy,dz8w,t8w,p8w &
111 ,rho,rri,z_at_w,vvel,zmid
112 REAL,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: pbl_h
113 REAL,DIMENSION(grid%sm32:grid%em32-1) :: QL,TL
114 REAL,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: REXNSFC,FACTRS &
115 ,TOT,TSFC
116
117 #endif
118
119 REAL :: DAYI,DPL,FICE,FRAIN,HOUR,PLYR &
120 & ,QI,QR,QW,RADT,TIMES,WC,TDUM,WMSK,RWMSK
121
122
123 INTEGER :: ij
124 INTEGER :: im , num_3d_m , ic , num_3d_c, num_3d_s
125 INTEGER :: ijds, ijde
126 INTEGER :: ksubt
127
128 REAL :: chem_minval, dtstepc
129
130 INTEGER :: numgas_aqfrac ! last dimension of gas_aqfrac
131 REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: gas_aqfrac
132 ! fraction of gas that is in cloud water
133 LOGICAL :: haveaer
134 CHARACTER (LEN=256) :: current_date_char !shc
135 integer :: current_month !shc
136 ! ..
137 ! .. Intrinsic Functions ..
138 INTRINSIC max, min
139 !<DESCRIPTION>
140 !<pre>
141 ! chem_driver is the main driver for handling chemistry related tasks
142 ! for a particular timestep. chem_driver is a mediation-layer routine ->
143 ! DM and SM calls are made where needed for parallel processing.
144 !
145 ! The main sections of chem_driver are:
146 !
147 ! (1) Initialization of meteorology variables as needed for chemistry
148 !
149 ! (2) Calls to drivers for the various chemistry tasks:
150 ! emissions_driver
151 ! photolysis_driver
152 ! dry_dep_driver
153 ! grelldrvct (convective tracer transport)
154 ! mechanism_driver (gases)
155 ! cloud_chem_driver
156 ! aerosols_driver
157 ! wetscav_driver
158 ! sum_pm_driver
159 !
160 ! Handling of tile indices in chem_driver is as close as possible to
161 ! what is done in solve_em. For subroutines called from chem_driver,
162 ! the its:ite, jts:jte, and kts:kte variables represent the extent of
163 ! the domain that each processor should loop over. For example, a do
164 ! loop in the vertical for the chem array should go from kts to kte.
165 ! For the EM core, kte=kde-1. For the NMM core, kte=kde-2.
166 !
167 ! Note that the tile indices for the chemistry initialization differ
168 ! from the integration loop indices in that the initializataion routines
169 ! use kte=kde. Go figure, this is how the met. folks set things up.
170 !
171 !</pre>
172 !</DESCRIPTION>
173
174 ! ..
175
176 ! Number of levels to exclude from the chem calculations counting from
177 ! the model top.
178 ! ksubt=0
179
180 ! ..
181
182
183 stepave=1800./grid%dt
184 CALL get_ijk_from_grid ( grid , &
185 ids, ide, jds, jde, kds, kde, &
186 ims, ime, jms, jme, kms, kme, &
187 ips, ipe, jps, jpe, kps, kpe )
188 ktau = grid%itimestep
189 CALL domain_clock_get( grid, current_timestr=current_date_char ) !shc
190 read(current_date_char(6:7),FMT='(I2)') current_month !shc
191 !initialize
192 !
193 #if ( NMM_CORE == 1 )
194 !*** IN NMM SET CONTROLS FOR TILES TO PATCHES
195 !
196 !-----------------------------------------------------------------------
197 KTAU=GRID%NMM_NTSD
198 IDF=IDE-1
199 JDF=JDE-1
200 KDF=KDE-2 !wig: do not do chem at the top level to mimic what used to be done (also prevents a solver failure at kde-1 for MADE/SORGAM)
201 ITS=IPS
202 ITE=MIN(IPE,IDF)
203 JTS=JPS
204 JTE=MIN(JPE,JDF)
205 KTS=KPS
206 KTE=MIN(KPE,KDF)
207
208 #endif
209 if(ktau.le.1)then
210 grid%gd_cloud_a=0.
211 grid%gd_cloud2_a=0.
212 grid%gd_cloud_b=0.
213 grid%gd_cloud2_b=0.
214 grid%raincv_a=0.
215 grid%raincv_b=0.
216 endif
217
218
219
220 num_3d_m = num_moist
221 num_3d_c = num_chem
222 num_3d_s = num_scalar
223 numgas = get_last_gas(config_flags%chem_opt)
224 numgas_aqfrac = 0 !will be set upon allocation of gas_aqfrac
225
226
227 #if ( EM_CORE == 1 )
228
229 ! Compute these starting and stopping locations for each tile and number of tiles.
230 CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe )
231 k_start = kps
232 k_end = kpe
233
234 #endif
235 ijds = min(ids, jds)
236 ijde = max(ide, jde)
237 #if ( NMM_CORE ==1)
238 allocate(moist_trans(ims:ime,kms:kme,jms:jme,num_3d_m))
239 allocate(scalar_trans(ims:ime,kms:kme,jms:jme,num_3d_s))
240 DO l=1,num_3d_m
241 DO j=jts,jte
242 DO k=kts,kte
243 DO i=its,ite
244 moist_trans(i,k,j,l)=moist(i,j,k,l)
245 ENDDO
246 ENDDO
247 ENDDO
248 ENDDO
249 DO l=1,num_3d_s
250 DO j=jts,jte
251 DO k=kts,kte
252 DO i=its,ite
253 scalar_trans(i,k,j,l)=scalar(i,j,k,l)
254 ENDDO
255 ENDDO
256 ENDDO
257 ENDDO
258 #endif
259 chem_minval = epsilc !chem_minval can be case dependant and set below...
260 chem_select: SELECT CASE(config_flags%chem_opt)
261 CASE (RADM2)
262 CALL wrf_debug(15,'calling radm2 from chem_driver')
263 haveaer = .false.
264 CASE (RADM2_KPP)
265 CALL wrf_debug(15,'calling radm2_kpp from chem_driver')
266 haveaer = .false.
267 CASE (RADM2SORG)
268 CALL wrf_debug(15,'calling radm2sorg aerosols driver from chem_driver')
269 haveaer = .true.
270 CASE (RADM2SORG_KPP)
271 CALL wrf_debug(15,'calling radm2sorg aerosols driver from chem_driver')
272 haveaer = .false.
273 CASE (RADM2SORG_AQ)
274 CALL wrf_debug(15,'calling radm2sorg_aq aerosols driver from chem_driver')
275 haveaer = .true.
276 CASE (RACM)
277 CALL wrf_debug(15,'calling racm from chem_driver')
278 haveaer = .false.
279 CASE (RACM_KPP)
280 CALL wrf_debug(15,'calling racm_kpp from chem_driver')
281 CASE (RACMPM_KPP)
282 CALL wrf_debug(15,'calling racmpm_kpp from chem_driver')
283 haveaer = .false.
284 CASE (RACM_MIM_KPP)
285 CALL wrf_debug(15,'calling racm_mim_kpp from chem_driver')
286 haveaer = .false.
287 CASE (RACMSORG)
288 CALL wrf_debug(15,'calling racmsorg aerosols driver from chem_driver')
289 haveaer = .true.
290 CASE (RACMSORG_KPP)
291 CALL wrf_debug(15,'calling racmsorg_kpp aerosols driver from chem_driver')
292 haveaer = .false.
293 CASE (RACMSORG_AQ)
294 CALL wrf_debug(15,'calling racmsorg_aq aerosols driver from chem_driver')
295 haveaer = .true.
296 CASE (CBMZ)
297 CALL wrf_debug(15,'calling cbmz from chem_driver')
298 haveaer = .false.
299 CASE (CBMZ_BB)
300 CALL wrf_debug(15,'calling cbmz_bb from chem_driver')
301 haveaer = .false.
302 CASE (CBMZ_MOSAIC_4BIN)
303 CALL wrf_debug(15,'calling cbmz_mosaic_4bin aerosols driver from chem_driver')
304 haveaer = .true.
305 CASE (CBMZ_MOSAIC_8BIN)
306 CALL wrf_debug(15,'calling cbmz_mosaic_8bin aerosols driver from chem_driver')
307 haveaer = .true.
308 CASE (CBMZ_MOSAIC_4BIN_AQ)
309 CALL wrf_debug(15,'calling cbmz_mosaic_4bin_aq aerosols driver from chem_driver')
310 haveaer = .true.
311 CASE (CBMZ_MOSAIC_8BIN_AQ)
312 CALL wrf_debug(15,'calling cbmz_mosaic_8bin_aq aerosols driver from chem_driver')
313 haveaer = .true.
314 CASE (CHEM_TRACER)
315 CALL wrf_debug(15,'tracer mode: only doing emissions and dry dep in chem_driver')
316 CASE DEFAULT
317 CALL wrf_debug(15,'calling chem_opt=? from chem_driver')
318 END SELECT chem_select
319 !
320 !
321 !
322 #if ( NMM_CORE == 1 )
323 k_start = kts
324 k_end = min(kpe,kde-1)
325 ! this should be in seperate routine!!!!!!
326 GRID%SIGMA=1
327 grid%nmm_HYDRO=.FALSE.
328 its=max(its,MYIS1)
329 jts=max(jts,MYJS2)
330 ite=min(ite,MYIE1)
331 jte=min(jte,MYJE2)
332 DO J=jts,jte
333 DO I=its,ite
334 pbl_h(i,j)=grid%nmm_pblh(i,j)
335 !
336 ! PDSL=PD(I,J)*RES(I,J)
337 !-----------------------------------------------------------------------
338 !*** LONG AND SHORTWAVE FLUX AT GROUND SURFACE
339 !-----------------------------------------------------------------------
340 IF(grid%nmm_CZMEAN(I,J)>0.) THEN
341 FACTRS(I,J)=grid%nmm_CZEN(I,J)/grid%nmm_CZMEAN(I,J)
342 ELSE
343 FACTRS(I,J)=0.
344 ENDIF
345 grid%GSW(I,J)=(grid%nmm_RSWIN(I,J)-grid%nmm_RSWOUT(I,J))*grid%nmm_HBM2(I,J)*FACTRS(I,J)
346 P8W(I,KTE+1,J)=grid%nmm_PT
347 grid%XLAT(I,J)=grid%nmm_GLAT(I,J)/DEGRAD
348 grid%XLONG(I,J)=grid%nmm_GLON(I,J)/DEGRAD
349 grid%XLAND(I,J)=grid%nmm_SM(I,J)+1.
350 grid%PSFC(i,j)=grid%nmm_PD(I,J)+grid%nmm_PDTOP+grid%nmm_PT
351 grid%UST(I,J)=grid%nmm_USTAR(I,J)
352 REXNSFC(I,J)=(grid%PSFC(i,j)*1.E-5)**CAPA
353 TSFC(I,J)=grid%nmm_THS(I,J)*REXNSFC(I,J)
354 grid%TSK(I,J)=TSFC(I,J)
355
356 T8W(I,1,J)=TSFC(I,J)
357 P8W(I,KTS,J)=grid%nmm_ETA1(KTS)*grid%nmm_PDTOP+grid%nmm_ETA2(KTS)*grid%nmm_PDSL(i,j)+grid%nmm_PT
358 !
359 !-----------------------------------------------------------------------
360 !*** FILL THE SINGLE-COLUMN INPUT
361 !-----------------------------------------------------------------------
362 !
363 z_at_w(i,kts,j)=grid%nmm_fis(i,j)/g
364 DO K=KTS,KTE+1
365 vvel(i,k,j)=grid%nmm_w(i,j,k)
366 DPL=grid%nmm_DETA1(K)*grid%nmm_PDTOP+grid%nmm_DETA2(K)*grid%nmm_PDSL(i,j)
367 QL(K)=AMAX1(grid%nmm_Q(I,J,K),EPSQ)
368 PLYR=grid%nmm_AETA1(K)*grid%nmm_PDTOP+grid%nmm_AETA2(K)*grid%nmm_PDSL(i,j)+grid%nmm_PT
369 TL(K)=grid%nmm_T(I,J,K)
370 !
371 ! here rri is inverse density!
372 !
373 RHO(I,K,J)=PLYR/(R_D*TL(K)*(1.+P608*QL(K)))
374 RRI(I,K,J)=1./RHO(i,k,j)
375 T_PHY(I,K,J)=TL(K)
376 moist_trans(I,K,J,P_QV)=QL(K)/(1.-QL(K))
377 P8W(I,K+1,J)=grid%nmm_ETA1(K+1)*grid%nmm_PDTOP+grid%nmm_ETA2(K+1)*grid%nmm_PDSL(i,j)+grid%nmm_PT
378 P_PHY(I,K,J)=PLYR
379 DZ8W(I,K,J)=TL(K)*(P608*QL(K)+1.)*R_D &
380 & *(P8W(I,K,J)-P8W(I,K+1,J)) &
381 & /(P_PHY(I,K,J)*G)
382 if(K.gt.kts)then
383 Z_AT_W(i,k,j)=Z_AT_W(I,k-1,j)+DZ8W(I,K-1,J)
384 ZMID(I,K-1,J)=.5*(Z_AT_W(I,K-1,J)+Z_AT_W(I,K,J))
385 endif
386
387 ENDDO
388 !
389 DO K=KTS+1,KTE+1
390 T8W(I,K,J)=0.5*(TL(K-1)+TL(K))
391 ENDDO
392 T8W(I,KTE+2,J)=-1.E20
393 ZMID(I,KTE+1,J)=Z_AT_W(I,KTE+1,J)
394 !
395 ENDDO
396 ENDDO
397 !-----------------------------------------------------------------------
398 !-----------------------------------------------------------------------
399 !
400 !*** COMPUTE VELOCITY COMPONENTS AT MASS POINTS
401 !
402 !-----------------------------------------------------------------------
403 !$omp parallel do &
404 !$omp& private(i,j,k,rwmsk,wmsk)
405 DO J=MYJS1_P1,MYJE1_P1
406 !
407 DO K=KTS,KTE
408 DO I=MYIS_P1,MYIE_P1
409 WMSK=grid%nmm_VTM(I+grid%nmm_IHE(J),J,K)+grid%nmm_VTM(I+grid%nmm_IHW(J),J,K) &
410 & +grid%nmm_VTM(I,J+1,K)+grid%nmm_VTM(I,J-1,K)
411 IF(WMSK>0.)THEN
412 RWMSK=1./WMSK
413 U_PHY(I,K,J)=(grid%nmm_U(I+grid%nmm_IHE(J),J,K)*grid%nmm_VTM(I+grid%nmm_IHE(J),J,K) &
414 & +grid%nmm_U(I+grid%nmm_IHW(J),J,K)*grid%nmm_VTM(I+grid%nmm_IHW(J),J,K) &
415 & +grid%nmm_U(I,J+1,K)*grid%nmm_VTM(I,J+1,K) &
416 & +grid%nmm_U(I,J-1,K)*grid%nmm_VTM(I,J-1,K))*RWMSK
417 V_PHY(I,K,J)=(grid%nmm_V(I+grid%nmm_IHE(J),J,K)*grid%nmm_VTM(I+grid%nmm_IHE(J),J,K) &
418 & +grid%nmm_V(I+grid%nmm_IHW(J),J,K)*grid%nmm_VTM(I+grid%nmm_IHW(J),J,K) &
419 & +grid%nmm_V(I,J+1,K)*grid%nmm_VTM(I,J+1,K) &
420 & +grid%nmm_V(I,J-1,K)*grid%nmm_VTM(I,J-1,K))*RWMSK
421 ELSE
422 U_PHY(I,K,J)=0.
423 V_PHY(I,K,J)=0.
424 ENDIF
425 ENDDO
426 ENDDO
427 ENDDO
428 #endif
429
430 do nv=1,num_chem
431 do j=jps,jpe
432 do k=kps,kpe
433 do i=ips,ipe
434 chem(i,k,j,nv)=max(chem(i,k,j,nv),chem_minval)
435 enddo
436 enddo
437 enddo
438 enddo
439 select case (config_flags%chem_opt)
440 case (RADM2SORG, RADM2SORG_KPP,RACMSORG,RACMSORG_KPP)
441 do j=jps,jpe
442 do k=kps,kpe
443 do i=ips,ipe
444 if(chem(i,k,j,p_nu0).lt.1.e07) then
445 chem(i,k,j,p_nu0)=1.e7
446 endif
447 enddo
448 enddo
449 enddo
450 end select
451
452
453 vdrog3=0.
454 #if ( EM_CORE == 1 )
455 do j=jps,min(jde-1,jpe)
456 do k=kps,kpe
457 do i=ips,min(ide-1,ipe)
458 vvel(i,k,j)=grid%em_w_2(i,k,j)
459 zmid(i,k,j)=grid%em_z(i,k,j)
460 enddo
461 enddo
462 enddo
463 do j=jps,min(jde-1,jpe)
464 do k=kps,min(kde-1,kpe)
465 do i=ips,min(ide-1,ipe)
466 rri(i,k,j)=grid%em_alt(i,k,j)
467 enddo
468 enddo
469 enddo
470 do j=jps,min(jde-1,jpe)
471 do i=ips,min(ide-1,ipe)
472 pbl_h(i,j)=grid%pblh(i,j)
473 enddo
474 enddo
475
476 !------------------------------------------------------------------------
477 ! Main chemistry tile loop
478 !------------------------------------------------------------------------
479
480 !$OMP PARALLEL DO &
481 !$OMP PRIVATE ( ij, its, ite, jts, jte )
482 chem_tile_loop_1: DO ij = 1 , grid%num_tiles
483 !!$ its = max(grid%i_start(ij),ids+1) !beg: old way w/o domain edge ring
484 !!$ ite = min(grid%i_end(ij),ide-2)
485 !!$ jts = max(grid%j_start(ij),jds+1)
486 !!$ jte = min(grid%j_end(ij),jde-2) !end: old way
487 its = grid%i_start(ij) !beg, wig: new way to match physics subroutines
488 ite = min(grid%i_end(ij),ide-1)
489 jts = grid%j_start(ij)
490 jte = min(grid%j_end(ij),jde-1) !end, wig: new way
491
492 kts=k_start
493 kte=min(k_end,kde-1)
494
495 #endif
496 !
497 ! no time average available in first half hour
498 !
499 if( config_flags%chem_conv_tr>0)then
500 if(ktau.le.stepave)then
501 do j=jts,jte
502 do i=its,ite
503 grid%raincv_b(i,j)=grid%raincv(i,j)
504 enddo
505 enddo
506 endif
507 !
508 ! build time average, and stored in raincv_b to be used by convective transport routine
509 !
510 if(mod(ktau,stepave).ne.0)then
511 do j=jts,jte
512 do i=its,ite
513 grid%raincv_a(i,j)=grid%raincv_a(i,j)+grid%raincv(i,j)
514 enddo
515 enddo
516 else if(mod(ktau,stepave).eq.0)then
517 do j=jts,jte
518 do i=its,ite
519 grid%raincv_b(i,j)=grid%raincv_a(i,j)/float(stepave)
520 grid%raincv_a(i,j)=0.
521 enddo
522 enddo
523 endif
524 endif ! chem_conv_tr
525 !
526 ! do the same for convwective parameterization cloud water mix ratio,
527 ! currently only for cu_physics=3, used by both photolysis and atmospheric radiation
528 !
529 if(config_flags%cu_rad_feedback)then
530 if( config_flags%cu_physics == 3 )then
531 if(ktau.le.stepave)then
532 do j=jts,jte
533 do k=kts,kte
534 do i=its,ite
535 grid%gd_cloud_b(i,k,j)=grid%gd_cloud(i,k,j)
536 grid%gd_cloud2_b(i,k,j)=grid%gd_cloud2(i,k,j)
537 enddo
538 enddo
539 enddo
540 endif ! stepave
541 !
542 !
543 !
544 if(mod(ktau,stepave).ne.0)then
545 do j=jts,jte
546 do k=kts,kte
547 do i=its,ite
548 grid%gd_cloud_a(i,k,j)=grid%gd_cloud_a(i,k,j)+grid%gd_cloud(i,k,j)
549 grid%gd_cloud2_a(i,k,j)=grid%gd_cloud2_a(i,k,j)+grid%gd_cloud2(i,k,j)
550 enddo
551 enddo
552 enddo
553 else if(mod(ktau,stepave).eq.0)then
554 do j=jts,jte
555 do k=kts,kte
556 do i=its,ite
557 grid%gd_cloud_b(i,k,j)=grid%gd_cloud_a(i,k,j)/float(stepave)
558 grid%gd_cloud_a(i,k,j)=0.
559 grid%gd_cloud2_b(i,k,j)=grid%gd_cloud2_a(i,k,j)/float(stepave)
560 grid%gd_cloud2_a(i,k,j)=0.
561 enddo
562 enddo
563 enddo
564 endif !stepave
565 endif ! cu_physics
566 endif ! cu_rad_feedback
567 !
568 !
569 #if ( EM_CORE == 1 )
570 CALL wrf_debug ( 15 , ' call chem_prep' )
571 CALL chem_prep ( config_flags, &
572 grid%em_u_2, grid%em_v_2, grid%em_p, grid%em_pb, &
573 grid%em_alt,grid%em_ph_2, grid%em_phb, grid%em_t_2, &
574 moist, num_3d_m, rho, &
575 p_phy, u_phy, v_phy, &
576 p8w, t_phy, t8w, grid%em_z, z_at_w, &
577 dz8w, grid%em_fnm, grid%em_fnp, &
578 ids, ide, jds, jde, kds, kde, &
579 ims, ime, jms, jme, kms, kme, &
580 its,ite,jts,jte, &
581 k_start, k_end )
582 #endif
583
584 #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
585 if( (its <= CHEM_DBG_I .and. ite >= CHEM_DBG_I) .and. &
586 (jts <= CHEM_DBG_J .and. jte >= CHEM_DBG_J) .and. &
587 (k_start <= CHEM_DBG_K .and. k_end >= CHEM_DBG_K) ) then
588 call wrf_debug(15,"calling chem_dbg at top of chem_driver")
589 call chem_dbg(CHEM_DBG_I,CHEM_DBG_J,CHEM_DBG_K,grid%dt,ktau, &
590 dz8w,t_phy,p_phy,rho,chem, &
591 grid%e_so2,grid%e_no,grid%e_co,grid%e_eth,grid%e_hc3,grid%e_hc5, &
592 grid%e_hc8,grid%e_xyl,grid%e_ol2,grid%e_olt, &
593 grid%e_oli,grid%e_tol,grid%e_csl,grid%e_hcho,grid%e_ald,grid%e_ket, &
594 grid%e_ora2,grid%e_nh3,grid%e_pm10,grid%e_pm25,grid%e_pm25i, &
595 grid%e_pm25j,grid%e_eci,grid%e_ecj,grid%e_orgi,grid%e_orgj, &
596 grid%e_no2,grid%e_ch3oh,grid%e_c2h5oh,grid%e_iso, &
597 grid%e_so4j,grid%e_so4c,grid%e_no3j,grid%e_no3c,grid%e_orgc,grid%e_ecc,&
598 ids,ide, jds,jde, kds,kde, &
599 ims,ime, jms,jme, kms,kme, &
600 its,ite, jts,jte,kts,kte, &
601 config_flags%kemit )
602 end if
603 #endif
604
605 !--- emissions
606 if(config_flags%emiss_inpt_opt > 0)then
607 call wrf_debug(15,'calling emissions driver')
608 ! jdf add smois for dust emissions
609 call emissions_driver(grid%id,ktau,grid%dt,grid%DX,grid%stepfirepl, &
610 config_flags, grid%stepbioe, &
611 #if (NMM_CORE == 1)
612 grid%gmt,grid%julday,rri,t_phy,moist_trans,p8w,t8w,u_phy,v_phy,vvel, &
613 #endif
614 #if (EM_CORE == 1 )
615 grid%gmt,grid%julday,rri,t_phy,moist,p8w,t8w,u_phy,v_phy,vvel, &
616 #endif
617 grid%e_bio,p_phy,chem,rho,dz8w,grid%ne_area, &
618 grid%e_iso,grid%e_so2,grid%e_no,grid%e_co,grid%e_eth,grid%e_hc3, &
619 grid%e_hc5,grid%e_hc8,grid%e_xyl,grid%e_ol2,grid%e_olt, &
620 grid%e_oli,grid%e_tol,grid%e_csl,grid%e_hcho,grid%e_ald,grid%e_ket, &
621 grid%e_ora2,grid%e_pm25,grid%e_pm10,grid%e_nh3, &
622 grid%e_pm25i,grid%e_pm25j,grid%e_eci,grid%e_ecj,grid%e_orgi, &
623 grid%e_orgj,grid%e_no2,grid%e_ch3oh, &
624 grid%e_c2h5oh,grid%e_so4i,grid%e_so4j,grid%e_so4c, &
625 grid%e_no3i,grid%e_no3j,grid%e_no3c,grid%e_orgc,grid%e_ecc, &
626 grid%ebu_no,grid%ebu_co,grid%ebu_co2,grid%ebu_eth,grid%ebu_hc3,grid%ebu_hc5, &
627 grid%ebu_hc8,grid%ebu_ete,grid%ebu_olt,grid%ebu_oli,grid%ebu_pm25, &
628 grid%ebu_pm10,grid%ebu_dien,grid%ebu_iso,grid%ebu_api,grid%ebu_lim, &
629 grid%ebu_tol,grid%ebu_xyl,grid%ebu_csl,grid%ebu_hcho,grid%ebu_ald, &
630 grid%ebu_ket,grid%ebu_macr,grid%ebu_ora1,grid%ebu_ora2,grid%mean_fct_agtf, &
631 grid%mean_fct_agef,grid%mean_fct_agsv,grid%mean_fct_aggr,grid%firesize_agtf, &
632 grid%firesize_agef,grid%firesize_agsv,grid%firesize_aggr, &
633 grid%u10,grid%v10,grid%ivgtyp,grid%isltyp,grid%gsw,grid%vegfra,grid%rmol, &
634 grid%ust,grid%znt, &
635 grid%xland,grid%xlat,grid%xlong, &
636 z_at_w,zmid,grid%smois, &
637 grid%sebio_iso,grid%sebio_oli,grid%sebio_api,grid%sebio_lim, &
638 grid%sebio_xyl,grid%sebio_hc3,grid%sebio_ete,grid%sebio_olt, &
639 grid%sebio_ket,grid%sebio_ald,grid%sebio_hcho,grid%sebio_eth, &
640 grid%sebio_ora2,grid%sebio_co,grid%sebio_nr, &
641 grid%noag_grow,grid%noag_nongrow,grid%nononag,grid%slai, &
642 grid%ebio_iso,grid%ebio_oli,grid%ebio_api,grid%ebio_lim,grid%ebio_xyl, &
643 grid%ebio_hc3,grid%ebio_ete,grid%ebio_olt,grid%ebio_ket,grid%ebio_ald, &
644 grid%ebio_hcho,grid%ebio_eth,grid%ebio_ora2,grid%ebio_co,grid%ebio_nr, &
645 grid%ebio_no, &
646 !shc stuff for MEGAN v2.04
647 #if (NMM_CORE == 1)
648 grid%T2,grid%nmm_RSWIN, &
649 #endif
650 #if (EM_CORE == 1 )
651 grid%T2,grid%swdown, &
652 #endif
653 grid%nmegan,grid%EFmegan, &
654 grid%msebio_isop, &
655 grid%mlai, &
656 grid%pftp_bt, grid%pftp_nt, grid%pftp_sb, grid%pftp_hb, &
657 grid%mtsa, &
658 grid%mswdown, &
659 grid%mebio_isop,grid%mebio_apin,grid%mebio_bpin, grid%mebio_bcar, &
660 grid%mebio_acet,grid%mebio_mbo,grid%mebio_no, &
661 current_month, &
662 !shc end stuff for MEGAN v2.04
663 ids,ide, jds,jde, kds,kde, &
664 ims,ime, jms,jme, kms,kme, &
665 its,ite,jts,jte,kts,kte)
666
667 #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
668 if( (its <= CHEM_DBG_I .and. ite >= CHEM_DBG_I) .and. &
669 (jts <= CHEM_DBG_J .and. jte >= CHEM_DBG_J) .and. &
670 (k_start <= CHEM_DBG_K .and. k_end >= CHEM_DBG_K) ) then
671 call wrf_debug(15,'calling chem_dbg after emissions_driver')
672 call chem_dbg(CHEM_DBG_I,CHEM_DBG_J,CHEM_DBG_K,grid%dt,ktau, &
673 dz8w,t_phy,p_phy,rho,chem, &
674 grid%e_so2,grid%e_no,grid%e_co,grid%e_eth,grid%e_hc3,grid%e_hc5, &
675 grid%e_hc8,grid%e_xyl,grid%e_ol2,grid%e_olt, &
676 grid%e_oli,grid%e_tol,grid%e_csl,grid%e_hcho,grid%e_ald,grid%e_ket, &
677 grid%e_ora2,grid%e_nh3,grid%e_pm10,grid%e_pm25,grid%e_pm25i, &
678 grid%e_pm25j,grid%e_eci,grid%e_ecj,grid%e_orgi,grid%e_orgj, &
679 grid%e_no2,grid%e_ch3oh,grid%e_c2h5oh,grid%e_iso, &
680 grid%e_so4j,grid%e_so4c,grid%e_no3j,grid%e_no3c,grid%e_orgc,grid%e_ecc,&
681 ids,ide, jds,jde, kds,kde, &
682 ims,ime, jms,jme, kms,kme, &
683 its,ite, jts,jte, kts, kte, &
684 config_flags%kemit )
685 end if
686 #endif
687 endif
688
689 !
690 ! calculate photolysis rates
691 if((ktau.eq.1 .or. mod(ktau,grid%stepphot).eq.0) &
692 .and. config_flags%chem_opt /= CHEM_TRACER) then
693 call wrf_debug(15,'calling photolysis driver')
694 call photolysis_driver (grid%id,ktau,grid%dt,config_flags,haveaer, &
695 #if (NMM_CORE == 1)
696 grid%gmt,grid%julday,t_phy,moist_trans,grid%aerwrf,p8w,t8w,p_phy, &
697 #endif
698 #if (EM_CORE == 1)
699 grid%gmt,grid%julday,t_phy,moist,grid%aerwrf,p8w,t8w,p_phy, &
700 #endif
701 chem,rho,dz8w,grid%xlat,grid%xlong, &
702 z_at_w, &
703 grid%gd_cloud_b,grid%gd_cloud2_b, &
704 grid%ph_macr,grid%ph_o31d,grid%ph_o33p,grid%ph_no2,grid%ph_no3o2, &
705 grid%ph_no3o,grid%ph_hno2,grid%ph_hno3,grid%ph_hno4,grid%ph_h2o2, &
706 grid%ph_ch2or,grid%ph_ch2om,grid%ph_ch3cho,grid%ph_ch3coch3, &
707 grid%ph_ch3coc2h5,grid%ph_hcocho,grid%ph_ch3cocho, &
708 grid%ph_hcochest,grid%ph_ch3o2h,grid%ph_ch3coo2h,grid%ph_ch3ono2, &
709 grid%ph_hcochob,grid%ph_n2o5,grid%ph_o2, &
710 grid%tauaer1,grid%tauaer2,grid%tauaer3,grid%tauaer4, &
711 grid%gaer1,grid%gaer2,grid%gaer3,grid%gaer4, &
712 grid%waer1,grid%waer2,grid%waer3,grid%waer4, &
713 grid%pm2_5_dry,grid%pm2_5_water,grid%uvrad, &
714 ids,ide, jds,jde, kds,kde, &
715 ims,ime, jms,jme, kms,kme, &
716 its,ite,jts,jte,kts,kte)
717
718 #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
719 if( (its <= CHEM_DBG_I .and. ite >= CHEM_DBG_I) .and. &
720 (jts <= CHEM_DBG_J .and. jte >= CHEM_DBG_J) .and. &
721 (k_start <= CHEM_DBG_K .and. k_end >= CHEM_DBG_K) ) then
722 call wrf_debug(15,'calling chem_dbg after photolysis_driver')
723 call chem_dbg(CHEM_DBG_I,CHEM_DBG_J,CHEM_DBG_K,grid%dt,ktau, &
724 dz8w,t_phy,p_phy,rho,chem, &
725 grid%e_so2,grid%e_no,grid%e_co,grid%e_eth,grid%e_hc3,grid%e_hc5, &
726 grid%e_hc8,grid%e_xyl,grid%e_ol2,grid%e_olt, &
727 grid%e_oli,grid%e_tol,grid%e_csl,grid%e_hcho,grid%e_ald,grid%e_ket, &
728 grid%e_ora2,grid%e_nh3,grid%e_pm10,grid%e_pm25,grid%e_pm25i, &
729 grid%e_pm25j,grid%e_eci,grid%e_ecj,grid%e_orgi,grid%e_orgj, &
730 grid%e_no2,grid%e_ch3oh,grid%e_c2h5oh,grid%e_iso, &
731 grid%e_so4j,grid%e_so4c,grid%e_no3j,grid%e_no3c,grid%e_orgc,grid%e_ecc,&
732 ids,ide, jds,jde, kds,kde, &
733 ims,ime, jms,jme, kms,kme, &
734 its,ite, jts,jte, kts,kte, &
735 config_flags%kemit, &
736 grid%ph_macr,grid%ph_o31d,grid%ph_o33p,grid%ph_no2,grid%ph_no3o2, &
737 grid%ph_no3o,grid%ph_hno2,grid%ph_hno3,grid%ph_hno4,grid%ph_h2o2, &
738 grid%ph_ch2or,grid%ph_ch2om,grid%ph_ch3cho,grid%ph_ch3coch3, &
739 grid%ph_ch3coc2h5,grid%ph_hcocho,grid%ph_ch3cocho, &
740 grid%ph_hcochest,grid%ph_ch3o2h,grid%ph_ch3coo2h, &
741 grid%ph_ch3ono2,grid%ph_hcochob,grid%ph_n2o5,grid%ph_o2 &
742 )
743 end if
744 #endif
745 endif
746
747 !
748 ! do vertical mixing with dry deposition
749 ! 28-jun-2005 rce - added vertmix_onoff to turn vertical mixing on/off
750 !
751 if (config_flags%vertmix_onoff>0) then
752 if (ktau.gt.2) then
753 call wrf_debug(15,'calling dry_deposition_driver')
754 call dry_dep_driver(grid%id,ktau,grid%dt,config_flags, &
755 #if (NMM_CORE == 1)
756 grid%gmt,grid%julday,t_phy,moist_trans,scalar_trans,p8w,t8w,vvel, &
757 #endif
758 #if (EM_CORE == 1)
759 grid%gmt,grid%julday,t_phy,moist,scalar,p8w,t8w,vvel, &
760 #endif
761 rri,p_phy,chem,rho,dz8w,grid%exch_h, &
762 grid%cldfra, grid%cldfra_old, &
763 grid%ccn1, grid%ccn2, grid%ccn3, grid%ccn4, grid%ccn5, grid%ccn6, &
764 grid%qndropsource,grid%ivgtyp,grid%tsk,grid%gsw,grid%vegfra,pbl_h, &
765 grid%rmol,grid%ust,grid%znt,grid%xlat,grid%xlong, &
766 zmid,z_at_w, &
767 grid%h2oaj,grid%h2oai,grid%nu3,grid%ac3,grid%cor3,grid%asulf, &
768 grid%ahno3,grid%anh3,grid%cvaro1,grid%cvaro2,grid%cvalk1,grid%cvole1,&
769 grid%cvapi1,grid%cvapi2,grid%cvlim1,grid%cvlim2,grid%dep_vel_o3, &
770 grid%e_co,config_flags%kemit,numgas, &
771 ids,ide, jds,jde, kds,kde, &
772 ims,ime, jms,jme, kms,kme, &
773 its,ite,jts,jte,kts,kte)
774 ! k_start , min(k_end,kde-ksubt) )
775 end if
776
777 #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
778 if( (its <= CHEM_DBG_I .and. ite >= CHEM_DBG_I) .and. &
779 (jts <= CHEM_DBG_J .and. jte >= CHEM_DBG_J) .and. &
780 (k_start <= CHEM_DBG_K .and. k_end >= CHEM_DBG_K) ) then
781 call wrf_debug(15,'calling chem_dbg after dry_deposition_driver')
782 call chem_dbg(CHEM_DBG_I,CHEM_DBG_J,CHEM_DBG_K,grid%dt,ktau, &
783 dz8w,t_phy,p_phy,rho,chem, &
784 grid%e_so2,grid%e_no,grid%e_co,grid%e_eth,grid%e_hc3,grid%e_hc5, &
785 grid%e_hc8,grid%e_xyl,grid%e_ol2,grid%e_olt, &
786 grid%e_oli,grid%e_tol,grid%e_csl,grid%e_hcho,grid%e_ald,grid%e_ket, &
787 grid%e_ora2,grid%e_nh3,grid%e_pm10,grid%e_pm25,grid%e_pm25i, &
788 grid%e_pm25j,grid%e_eci,grid%e_ecj,grid%e_orgi,grid%e_orgj, &
789 grid%e_no2,grid%e_ch3oh,grid%e_c2h5oh,grid%e_iso, &
790 grid%e_so4j,grid%e_so4c,grid%e_no3j,grid%e_no3c,grid%e_orgc,grid%e_ecc,&
791 ids,ide, jds,jde, kds,kde, &
792 ims,ime, jms,jme, kms,kme, &
793 its,ite, jts,jte, kts, kte, &
794 config_flags%kemit, &
795 )
796 end if
797 #endif
798 end if
799
800
801
802 !
803 ! convective transport/wet deposition
804 !
805 !
806 !
807 if( config_flags%cu_physics>0 .and. config_flags%chem_conv_tr>0)then
808 call wrf_debug(15,'calling conv transport')
809 call grelldrvct(grid%DT,ktau,grid%DX,grid%id,config_flags, &
810 rho,grid%RAINCV_B,chem, &
811 #if (NMM_CORE == 1)
812 U_phy,V_phy,t_phy,moist_trans,dz8w, &
813 #endif
814 #if (EM_CORE == 1)
815 U_phy,V_phy,t_phy,moist,dz8w, &
816 #endif
817 p_phy,XLV,CP,G,r_v, &
818 z_at_w, &
819 grid%cu_co_ten, &
820 num_chem, &
821 ids,ide, jds,jde, kds,kde, &
822 ims,ime, jms,jme, kms,kme, &
823 its,ite,jts,jte,kts,k_end)
824 !~wig:temporarily change to k_end to avoid rewriting k indexing inside routine: its,ite,jts,jte,kts,kte)
825 ! k_start , min(k_end,kde-1) )
826 end if
827 !
828 !
829 !
830 !
831 n2o5_het=0.
832 ! Calculate rate of n2o5 hydrolysis
833 call wrf_debug(15,'calling calc_het_n2o5')
834
835
836
837 !
838 ! For the chemistry tracer mode, only emissions and vertical mixing are done.
839 ! So, finish any remaining tiles and then skip to the end of chem_driver.
840 !
841 ! kts=k_start
842 ! kte=k_end
843
844 if((ktau.eq.1.or.mod(ktau,grid%stepchem).eq.0) &
845 .and. config_flags%chem_opt /= CHEM_TRACER) then
846 dtstepc=grid%dt*float(grid%stepchem)
847 ktauc=max(ktau/grid%stepchem,1)
848 !wig, 23-Jul-2007: Alter logic to reduce dtstepc on the 2nd call
849 !to the gas and aer drivers since they are already called once at
850 !the 1st time step. The original logic introduced an erroneous
851 !extra one timestep increment to the calls since they are forced
852 !to make a call at katu==1. This only matters when the met
853 !timestep does not equal the chem timestep.
854 if(ktau.eq.1) then
855 dtstepc=grid%dt
856 else if( ktau==grid%stepchem .and. grid%stepchem>1 ) then
857 dtstepc=grid%dt*(grid%stepchem - 1)
858 end if
859 if(config_flags%gaschem_onoff>0)then
860 !
861 ! chemical mechanisms
862 !
863 call mechanism_driver(grid%id,ktau,grid%dt,ktauc,dtstepc,config_flags, &
864 #if (NMM_CORE == 1)
865 grid%gmt,grid%julday,t_phy,moist_trans,p8w,t8w, &
866 #endif
867 #if (EM_CORE == 1)
868 grid%gmt,grid%julday,t_phy,moist,p8w,t8w, &
869 #endif
870 p_phy,chem,rho,dz8w, &
871 zmid,z_at_w, &
872 vdrog3,vcsulf_old, &
873 grid%ph_macr,grid%ph_o31d,grid%ph_o33p,grid%ph_no2,grid%ph_no3o2, &
874 grid%ph_no3o,grid%ph_hno2,grid%ph_hno3,grid%ph_hno4,grid%ph_h2o2, &
875 grid%ph_ch2or,grid%ph_ch2om,grid%ph_ch3cho,grid%ph_ch3coch3, &
876 grid%ph_ch3coc2h5,grid%ph_hcocho,grid%ph_ch3cocho,grid%ph_hcochest, &
877 grid%ph_ch3o2h,grid%ph_ch3coo2h,grid%ph_ch3ono2,grid%ph_hcochob, &
878 grid%ph_n2o5,grid%ph_o2,grid%addt,grid%addx,grid%addc,grid%etep, &
879 grid%oltp,grid%olip,grid%cslp,grid%limp,grid%hc5p,grid%hc8p,grid%tolp, &
880 grid%xylp,grid%apip,grid%isop,grid%hc3p,grid%ethp,grid%o3p,grid%tco3, &
881 grid%mo2,grid%o1d,grid%olnn,grid%rpho,grid%xo2, &
882 grid%ketp,grid%olnd, &
883 ids,ide, jds,jde, kds,kde, &
884 ims,ime, jms,jme, kms,kme, &
885 its,ite,jts,jte,kts,kte )
886 !cms++
887 !
888
889 #ifdef WRF_KPP
890 CALL wrf_debug(15,'calling kpp_mechanism_driver')
891 CALL kpp_mechanism_driver (chem, &
892 grid%id,dtstepc,config_flags, &
893 p_phy,t_phy,rho,moist_trans, &
894 vdrog3, ldrog, &
895 !
896 #include <call_to_kpp_mech_drive.inc>
897 !
898 ids,ide, jds,jde, kds,kde, &
899 ims,ime, jms,jme, kms,kme, &
900 its,ite,jts,jte,kts,kte)
901 ! k_start , min(k_end,kde-ksubt) )
902
903
904 !cms--
905 !
906 #endif
907 #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
908 if( (its <= CHEM_DBG_I .and. ite >= CHEM_DBG_I) .and. &
909 (jts <= CHEM_DBG_J .and. jte >= CHEM_DBG_J) .and. &
910 (k_start <= CHEM_DBG_K .and. k_end >= CHEM_DBG_K) ) then
911 call wrf_debug(15,'calling chem_dbg after mechanism_driver')
912 call chem_dbg(CHEM_DBG_I,CHEM_DBG_J,CHEM_DBG_K,grid%dt,ktau, &
913 dz8w,t_phy,p_phy,rho,chem, &
914 grid%e_so2,grid%e_no,grid%e_co,grid%e_eth,grid%e_hc3,grid%e_hc5, &
915 grid%e_hc8,grid%e_xyl,grid%e_ol2,grid%e_olt, &
916 grid%e_oli,grid%e_tol,grid%e_csl,grid%e_hcho,grid%e_ald,grid%e_ket, &
917 grid%e_ora2,grid%e_nh3,grid%e_pm10,grid%e_pm25,grid%e_pm25i, &
918 grid%e_pm25j,grid%e_eci,grid%e_ecj,grid%e_orgi,grid%e_orgj, &
919 grid%e_no2,grid%e_ch3oh,grid%e_c2h5oh,grid%e_iso, &
920 grid%e_so4j,grid%e_so4c,grid%e_no3j,grid%e_no3c,grid%e_orgc,grid%e_ecc,&
921 ids,ide, jds,jde, kds,kde, &
922 ims,ime, jms,jme, kms,kme, &
923 its,ite, jts,jte, kts,kte, &
924 config_flags%kemit, &
925 grid%ph_macr,grid%ph_o31d,grid%ph_o33p,grid%ph_no2,grid%ph_no3o2, &
926 grid%ph_no3o,grid%ph_hno2,grid%ph_hno3,grid%ph_hno4,grid%ph_h2o2, &
927 grid%ph_ch2or,grid%ph_ch2om,grid%ph_ch3cho,grid%ph_ch3coch3, &
928 grid%ph_ch3coc2h5,grid%ph_hcocho,grid%ph_ch3cocho, &
929 grid%ph_hcochest,grid%ph_ch3o2h,grid%ph_ch3coo2h, &
930 grid%ph_ch3ono2,grid%ph_hcochob,grid%ph_n2o5,grid%ph_o2 &
931 end if
932 #endif
933 endif
934
935
936 ! allocate gas_aqfrac if either cldchem or wetscav is on
937 if ( (config_flags%cldchem_onoff > 0) .or. &
938 (config_flags%wetscav_onoff > 0) ) then
939 numgas_aqfrac = max( numgas, 1 )
940 #if (NMM_CORE==1)
941 allocate( gas_aqfrac( grid%sm31:grid%em31, grid%sm33:grid%em33, &
942 grid%sm32:grid%em32, numgas_aqfrac ) )
943 #endif
944 #if (EM_CORE==1)
945 allocate( gas_aqfrac( grid%sm31:grid%em31, grid%sm32:grid%em32, &
946 grid%sm33:grid%em33, numgas_aqfrac ) )
947 #endif
948 gas_aqfrac(its:ite,kts:kte,jts:jte,:) = 0.0
949 end if
950
951 !
952 ! now do cloud chemistry
953 !
954 if (config_flags%cldchem_onoff > 0) then
955
956 call cloudchem_driver( &
957 grid%id, ktau, ktauc, grid%dt, dtstepc, config_flags, &
958 t_phy, p_phy, rho, rri, &
959 #if (NMM_CORE == 1)
960 moist_trans, grid%cldfra, grid%ph_no2, &
961 #endif
962 #if (EM_CORE == 1)
963 moist, grid%cldfra, grid%ph_no2, &
964 #endif
965 chem, gas_aqfrac, numgas_aqfrac, &
966 ids,ide, jds,jde, kds,kde, &
967 ims,ime, jms,jme, kms,kme, &
968 its,ite, jts,jte, kts,kte )
969
970 endif
971
972
973 !
974 ! now do aerosols
975 !
976 if(config_flags%aerchem_onoff>0)then
977 call aerosols_driver (grid%id,ktau,grid%dt,ktauc,config_flags,dtstepc, &
978 #if (NMM_CORE==1)
979 rri,t_phy,moist_trans,grid%aerwrf,p8w,t8w, &
980 #endif
981 #if (EM_CORE == 1)
982 rri,t_phy,moist,grid%aerwrf,p8w,t8w, &
983 #endif
984 p_phy,chem,rho,dz8w, &
985 zmid,z_at_w, &
986 grid%h2oaj,grid%h2oai,grid%nu3,grid%ac3,grid%cor3,grid%asulf, &
987 grid%ahno3,grid%anh3,grid%cvaro1,grid%cvaro2,grid%cvalk1,grid%cvole1, &
988 grid%cvapi1,grid%cvapi2,grid%cvlim1,grid%cvlim2,vcsulf_old, &
989 grid%e_pm25i,grid%e_pm25j,grid%e_eci,grid%e_ecj,grid%e_orgi, &
990 grid%e_orgj,grid%e_pm10,grid%e_so4i,grid%e_so4j,grid%e_no3i,grid%e_no3j,&
991 vdrog3, &
992 ids,ide, jds,jde, kds,kde, &
993 ims,ime, jms,jme, kms,kme, &
994 its,ite,jts,jte,kts,kte)
995
996 #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
997 if( (its <= CHEM_DBG_I .and. ite >= CHEM_DBG_I) .and. &
998 (jts <= CHEM_DBG_J .and. jte >= CHEM_DBG_J) .and. &
999 (k_start <= CHEM_DBG_K .and. k_end >= CHEM_DBG_K) ) then
1000 call wrf_debug(15,'calling chem_dbg after aerosols_driver')
1001 call chem_dbg(CHEM_DBG_I,CHEM_DBG_J,CHEM_DBG_K,grid%dt,ktau, &
1002 dz8w,t_phy,p_phy,rho,chem, &
1003 grid%e_so2,grid%e_no,grid%e_co,grid%e_eth,grid%e_hc3,grid%e_hc5, &
1004 grid%e_hc8,grid%e_xyl,grid%e_ol2,grid%e_olt, &
1005 grid%e_oli,grid%e_tol,grid%e_csl,grid%e_hcho,grid%e_ald,grid%e_ket, &
1006 grid%e_ora2,grid%e_nh3,grid%e_pm10,grid%e_pm25,grid%e_pm25i, &
1007 grid%e_pm25j,grid%e_eci,grid%e_ecj,grid%e_orgi,grid%e_orgj, &
1008 grid%e_no2,grid%e_ch3oh,grid%e_c2h5oh,grid%e_iso, &
1009 grid%e_so4j,grid%e_so4c,grid%e_no3j,grid%e_no3c,grid%e_orgc,grid%e_ecc,&
1010 ids,ide, jds,jde, kds,kde, &
1011 ims,ime, jms,jme, kms,kme, &
1012 its,ite, jts,jte, kts, kte, &
1013 config_flags%kemit,
1014 grid%ph_macr,grid%ph_o31d,grid%ph_o33p,grid%ph_no2,grid%ph_no3o2, &
1015 grid%ph_no3o,grid%ph_hno2,grid%ph_hno3,grid%ph_hno4,grid%ph_h2o2, &
1016 grid%ph_ch2or,grid%ph_ch2om,grid%ph_ch3cho,grid%ph_ch3coch3, &
1017 grid%ph_ch3coc2h5,grid%ph_hcocho,grid%ph_ch3cocho, &
1018 grid%ph_hcochest,grid%ph_ch3o2h,grid%ph_ch3coo2h, &
1019 grid%ph_ch3ono2,grid%ph_hcochob,grid%ph_n2o5,grid%ph_o2 &
1020 )
1021 end if
1022 #endif
1023 endif
1024
1025
1026
1027 !
1028 ! now do wet removal
1029 !
1030 if (config_flags%wetscav_onoff > 0) then
1031 call wetscav_driver (grid%id,ktau,grid%dt,ktauc,config_flags,dtstepc, &
1032 #if (NMM_CORE == 1)
1033 rri,t_phy,moist_trans,p8w,t8w, &
1034 #endif
1035 #if (EM_CORE == 1)
1036 rri,t_phy,moist,p8w,t8w, &
1037 #endif
1038 p_phy,chem,rho,grid%cldfra, &
1039 grid%qlsink,grid%precr,grid%preci,grid%precs,grid%precg, &
1040 gas_aqfrac, numgas_aqfrac, &
1041 grid%h2oaj,grid%h2oai,grid%nu3,grid%ac3,grid%cor3, &
1042 grid%asulf,grid%ahno3,grid%anh3,grid%cvaro1,grid%cvaro2, &
1043 grid%cvalk1,grid%cvole1,grid%cvapi1,grid%cvapi2, &
1044 grid%cvlim1,grid%cvlim2, &
1045 ids,ide, jds,jde, kds,kde, &
1046 ims,ime, jms,jme, kms,kme, &
1047 its,ite, jts,jte, kts,kte)
1048 ! grid%i_start(ij), min(grid%i_end(ij),ide-1), &
1049 ! grid%j_start(ij), min(grid%j_end(ij),jde-1), &
1050 ! k_start , min(k_end,kde-ksubt) )
1051
1052 endif
1053
1054 if (numgas_aqfrac > 0) then
1055 deallocate( gas_aqfrac )
1056 numgas_aqfrac = 0
1057 end if
1058
1059 end if !Chemistry time step check
1060 !
1061 ! Sum up the aerosol mass for radiation and diagnostic purposes. Unlike
1062 ! aerosol_driver, which is called every dtchem, this must be done every
1063 ! time step because of emissions and deposition.
1064 !
1065 call sum_pm_driver ( config_flags, &
1066 rri, chem, grid%h2oaj, grid%h2oai, &
1067 grid%pm2_5_dry, grid%pm2_5_water, grid%pm2_5_dry_ec, grid%pm10, &
1068 ids,ide, jds,jde, kds,kde, &
1069 ims,ime, jms,jme, kms,kme, &
1070 its,ite, jts,jte, kts, kte )
1071
1072 ! Fill top level to prevent spurious interpolation results (no extrapolation)
1073 ! should this be done on halo too????
1074 do nv=1,num_chem
1075 do j=jts,jte
1076 do i=its,ite
1077 chem(i,k_end,j,nv)=chem(i,kte,j,nv)
1078 enddo
1079 enddo
1080 enddo
1081 call wrf_debug(15,'done tileloop in chem_driver')
1082 # if ( EM_CORE == 1 )
1083 END DO chem_tile_loop_1
1084 #endif
1085 #if (NMM_CORE==1)
1086 DO l=1,num_3d_m
1087 DO k=kts,kte
1088 DO j=jts,jte
1089 DO i=its,ite
1090 moist(i,j,k,l)=moist_trans(i,k,j,l)
1091 ENDDO
1092 ENDDO
1093 ENDDO
1094 ENDDO
1095 DO l=1,num_3d_s
1096 DO k=kts,kte
1097 DO j=jts,jte
1098 DO i=its,ite
1099 scalar(i,j,k,l)=scalar_trans(i,k,j,l)
1100 ENDDO
1101 ENDDO
1102 ENDDO
1103 ENDDO
1104 deallocate(moist_trans)
1105 deallocate(scalar_trans)
1106 #endif
1107 END subroutine chem_driver