Adjusting include paths for removal of redundant code
[WRF.git] / chem / mechanism_driver.F
blob9a68bfae28465644e018725699065f0356d9d4c3
1 !WRF:MODEL_LAYER:CHEMICS
3     subroutine mechanism_driver(id,curr_secs,ktau,dtstep,ktauc,dtstepc,&
4                config_flags,gmt,julday,t_phy,moist,p8w,t8w,gd_cldfr,   &
5                p_phy,chem,rho_phy,dz8w,dx,g,z,z_at_w,xlat,xlong,vdrog3,&
6                vcsulf_old,vcso2_old,vch2o2_old,ttday,tcosz,            &
7                ph_macr,ph_o31d,ph_o33p,ph_no2,                         &
8                ph_cl2,ph_hocl,ph_clno2,ph_fmcl,                        &
9                ph_no3o2,ph_no3o,ph_hno2,                               &
10                ph_hno3,ph_hno4,ph_h2o2,ph_ch2or,ph_ch2om,ph_ch3cho,    &
11                ph_ch3coch3,ph_ch3coc2h5,ph_hcocho,ph_ch3cocho,         &
12                ph_hcochest,ph_ch3o2h,ph_ch3coo2h,ph_ch3ono2,ph_hcochob,&
13                ph_n2o5,ph_o2,backg_oh,backg_h2o2,backg_no3,            &
14                addt,addx,addc,etep,oltp,olip,cslp,limp,hc5p,hc8p,tolp, &
15                xylp,apip,isop,hc3p,ethp,o3p,tco3,mo2,o1d,olnn,rpho,xo2,&
16                ketp,olnd,                                              &
17                ids,ide, jds,jde, kds,kde,                              &
18                ims,ime, jms,jme, kms,kme,                              &
19                its,ite, jts,jte, kts,kte                               )
20 !----------------------------------------------------------------------
21   USE module_configure
22   USE module_state_description
23   USE module_data_radm2
24   USE module_data_sorgam
25   USE module_radm
26   USE module_gocart_chem
27   USE module_aerosols_sorgam
28   USE module_cbmz, only:        cbmz_driver
29    IMPLICIT NONE
31    INTEGER,      INTENT(IN   ) :: id,julday,                           &
32                                   ids,ide, jds,jde, kds,kde,           &
33                                   ims,ime, jms,jme, kms,kme,           &
34                                   its,ite, jts,jte, kts,kte
35    INTEGER,      INTENT(IN   ) :: ktau,ktauc
36    REAL(KIND=8), INTENT(IN   ) :: curr_secs
37    REAL,         INTENT(IN   ) :: dtstep,dtstepc,gmt,dx,g
39 ! advected moisture variables
41    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ),            &
42          INTENT(IN ) ::                                   moist
44 ! advected chemical species
46    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),             &
47          INTENT(INOUT ) ::                                   chem
48    REAL, DIMENSION( ims:ime, jms:jme ),                       &
49          INTENT(IN ) ::                                             &
50           xlat,xlong,ttday,tcosz
53 ! arrays that hold the photolysis rates
55    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                       &
56          INTENT(INOUT ) ::                                             &
57            ph_macr,ph_o31d,ph_o33p,ph_no2,                             &
58            ph_cl2,ph_hocl,ph_clno2,ph_fmcl,                            &
59            ph_no3o2,ph_no3o,ph_hno2,                                   &
60            ph_hno3,ph_hno4,ph_h2o2,ph_ch2or,ph_ch2om,ph_ch3cho,        &
61            ph_ch3coch3,ph_ch3coc2h5,ph_hcocho,ph_ch3cocho,             &
62            ph_hcochest,ph_ch3o2h,ph_ch3coo2h,ph_ch3ono2,ph_hcochob,    &
63            ph_n2o5,ph_o2
65 ! RACM radicals
67    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                       &
68          INTENT(INOUT ) ::                                             &
69                addt,addx,addc,etep,oltp,olip,cslp,limp,hc5p,hc8p,tolp, &
70                xylp,apip,isop,hc3p,ethp,o3p,tco3,mo2,o1d,olnn,rpho,xo2,&
71                ketp,olnd
75 ! on input from meteorological model 
78    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,           &
79           INTENT(IN   ) ::                                             &
80                                                       t_phy,           &
81                                                       p_phy,           &
82                                                     dz8w,              &
83                         z    ,backg_oh,backg_h2o2,backg_no3,           &
84                                               t8w,p8w,z_at_w ,         &
85                                                     rho_phy
86    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,           &
87           OPTIONAL,                                                    &
88           INTENT(IN   ) ::  gd_cldfr
89 ! ..
90    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
92 ! for interaction of aerosls/chemistry (MADE/SORGAM only)
94       real ,      INTENT(INOUT   ) ::                                  &
95                       vdrog3(ims:ime,kms:kme-0,jms:jme,ldrog)
96       real ,      INTENT(INOUT   ) ::                                  &
97                       vcsulf_old(ims:ime,kms:kme,jms:jme),             &
98                       vcso2_old(ims:ime,kms:kme,jms:jme),              &
99                       vch2o2_old(ims:ime,kms:kme,jms:jme)
103 ! ..
104 ! .. Intrinsic Functions ..
105       INTRINSIC max, min
106 ! ..
108 ! select chemical mechanism
110    chem_select: SELECT CASE(config_flags%chem_opt)
111      CASE (GOCART_SIMPLE,GOCARTRACM_KPP,GOCARTRADM2)
112        CALL wrf_debug(15,'calling gocart chem from mechanism_driver')
113        call gocart_chem_driver(curr_secs,dtstepc,config_flags,        &
114          gmt,julday,t_phy,moist,                                      &
115          chem,rho_phy,dz8w,p8w,backg_oh,backg_h2o2,backg_no3,         &
116          gd_cldfr,dx,g,xlat,xlong,ttday,tcosz, &
117          ids,ide, jds,jde, kds,kde,                                        &
118          ims,ime, jms,jme, kms,kme,                                        &
119          its,ite, jts,jte, kts,kte                                         )
120        vcsulf_old(its:ite,kts:kte,jts:jte) = &
121             max(chem(its:ite,kts:kte,jts:jte,p_sulf),epsilc)
122        vcso2_old(its:ite,kts:kte,jts:jte) = &
123             max(chem(its:ite,kts:kte,jts:jte,p_so2),epsilc)
124        vch2o2_old(its:ite,kts:kte,jts:jte) = &
125             max(chem(its:ite,kts:kte,jts:jte,p_h2o2),epsilc)
128      CASE (RADM2, RADM2SORG, RADM2SORG_AQ, RADM2SORG_AQCHEM)
129        CALL wrf_debug(15,'calling radm2_driver from mechanism_driver')
130        if (config_flags%chem_opt /= RADM2) then
131           vcsulf_old(its:ite,kts:kte,jts:jte) = &
132              max(chem(its:ite,kts:kte,jts:jte,p_sulf),epsilc)
133        end if
134        call radm_driver(id,curr_secs,dtstepc,config_flags,             &
135                gmt,julday,t_phy,moist,p8w,t8w,                         &
136                p_phy,chem,rho_phy,dz8w,z,z_at_w,vdrog3,                &
137                ph_o31d,ph_o33p,ph_no2,ph_no3o2,ph_no3o,ph_hno2,        &
138                ph_hno3,ph_hno4,ph_h2o2,ph_ch2or,ph_ch2om,ph_ch3cho,    &
139                ph_ch3coch3,ph_ch3coc2h5,ph_hcocho,ph_ch3cocho,         &
140                ph_hcochest,ph_ch3o2h,ph_ch3coo2h,ph_ch3ono2,ph_hcochob,&
141                ids,ide, jds,jde, kds,kde,                              &
142                ims,ime, jms,jme, kms,kme,                              &
143                its,ite, jts,jte, kts,kte                               )
144      CASE(RACMSORG_KPP,RADM2SORG_KPP,RACMSORG_AQ,RACMSORG_AQCHEM_KPP,  &
145           RACM_ESRLSORG_AQCHEM_KPP,RACM_ESRLSORG_KPP,RACM_SOA_VBS_KPP, &
146           RACM_SOA_VBS_HET_KPP)
147          vcsulf_old(its:ite,kts:kte,jts:jte) = &
148           max(chem(its:ite,kts:kte,jts:jte,p_sulf),epsilc)
150      CASE (CBMZ, CBMZ_BB, CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN,      &
151                  CBMZ_MOSAIC_4BIN_AQ,     CBMZ_MOSAIC_8BIN_AQ,     &
152                  CBMZ_MOSAIC_DMS_4BIN,    CBMZ_MOSAIC_DMS_8BIN,    &
153                  CBMZ_MOSAIC_DMS_4BIN_AQ, CBMZ_MOSAIC_DMS_8BIN_AQ, &
154                  CBMZSORG, CBMZSORG_AQ, CBMZ_CAM_MAM3_NOAQ,        &
155                  CBMZ_CAM_MAM3_AQ,CBMZ_CAM_MAM7_NOAQ,              &
156                  CBMZ_CAM_MAM7_AQ)
158        CALL wrf_debug(15,'calling cbmz_driver from mechanism_driver')
159        vcsulf_old(its:ite,kts:kte,jts:jte) = &
160           max(chem(its:ite,kts:kte,jts:jte,p_sulf),epsilc)
161        call cbmz_driver(id,curr_secs,ktau,dtstep,ktauc,dtstepc,        &
162                config_flags,                                           &
163                gmt,julday,t_phy,moist,p8w,t8w,                         &
164                p_phy,chem,rho_phy,dz8w,z,z_at_w,vdrog3,                &
165                ph_o31d,ph_o33p,ph_no2,ph_no3o2,ph_no3o,ph_hno2,        &
166                ph_hno3,ph_hno4,ph_h2o2,ph_ch2or,ph_ch2om,              &
167                ph_ch3o2h,ph_n2o5,                                      &
168                ids,ide, jds,jde, kds,kde,                              &
169                ims,ime, jms,jme, kms,kme,                              &
170                its,ite, jts,jte, kts,kte                               )
172      CASE (CB05_SORG_AQ_KPP)
173        chem(its:ite,kts:kte,jts:jte,p_apin) = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.248
174        chem(its:ite,kts:kte,jts:jte,p_bpin) = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.294
175        chem(its:ite,kts:kte,jts:jte,p_lim)  = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.164
176        chem(its:ite,kts:kte,jts:jte,p_ter)  = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.006
177        chem(its:ite,kts:kte,jts:jte,p_oci)  = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.213
178        chem(its:ite,kts:kte,jts:jte,p_hum)  = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.074
179        chem(its:ite,kts:kte,jts:jte,p_ch4) = 1.7
180        chem(its:ite,kts:kte,jts:jte,p_h2) = 0.5
182        vcsulf_old(its:ite,kts:kte,jts:jte) = &
183           max(chem(its:ite,kts:kte,jts:jte,p_sulf),epsilc)
185      CASE (CB05_SORG_VBS_AQ_KPP)
186        chem(its:ite,kts:kte,jts:jte,p_apin) = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.248
187        chem(its:ite,kts:kte,jts:jte,p_bpin) = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.294
188        chem(its:ite,kts:kte,jts:jte,p_lim)  = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.164
189        chem(its:ite,kts:kte,jts:jte,p_ter)  = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.006
190        chem(its:ite,kts:kte,jts:jte,p_oci)  = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.213
191        chem(its:ite,kts:kte,jts:jte,p_hum)  = chem(its:ite,kts:kte,jts:jte,p_terp) * 0.074
192        chem(its:ite,kts:kte,jts:jte,p_ch4) = 1.7
193        chem(its:ite,kts:kte,jts:jte,p_h2) = 0.5
195        vcsulf_old(its:ite,kts:kte,jts:jte) = &
196           max(chem(its:ite,kts:kte,jts:jte,p_sulf),epsilc)
198      CASE DEFAULT
199                                                      
200    END SELECT chem_select                              
203     END subroutine mechanism_driver