chem/module_plumerise1.F

   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,ebu_in,mean_fct_agtf,mean_fct_agef,mean_fct_agsv,mean_fct_aggr,              &
  25            firesize_agtf,firesize_agef,firesize_agsv,firesize_aggr,              &
  26            config_flags, t_phy,moist,                                     &
  27            rho_phy,vvel,u_phy,v_phy,p_phy,                              &
  28            emis_ant,z_at_w,z,scale_fire_emiss,                                      &
  29            ids,ide, jds,jde, kds,kde,                                        &
  30            ims,ime, jms,jme, kms,kme,                                        &
  31            its,ite, jts,jte, kts,kte                                         )
  32
  33   USE module_configure
  34   USE module_model_constants
  35   USE module_state_description
  36   USE module_zero_plumegen_coms
  37   USE module_chem_plumerise_scalar
  38   IMPLICIT NONE
  39 ! integer, parameter :: nveg_agreg      = 4
  40 ! integer, parameter :: nveg_agreg      = 4
  41 ! integer, parameter :: tropical_forest = 1
  42 ! integer, parameter :: boreal_forest   = 2
  43 ! integer, parameter :: savannah        = 3
  44
  45    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  46
  47    INTEGER,      INTENT(IN   ) :: id,ktau,                      &
  48                                   ids,ide, jds,jde, kds,kde,               &
  49                                   ims,ime, jms,jme, kms,kme,               &
  50                                   its,ite, jts,jte, kts,kte
  51    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ),                &
  52          INTENT(IN ) ::                                   moist
  53    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_ebu ),                 &
  54          INTENT(INOUT ) ::                                   ebu
  55    REAL, DIMENSION( ims:ime, 1, jms:jme, num_ebu_in ),                 &
  56          INTENT(INOUT ) ::                                   ebu_in
  57    REAL, DIMENSION( ims:ime, jms:jme ),                 &
  58          INTENT(IN ) ::                                                &
  59            mean_fct_agtf,mean_fct_agef,&
  60            mean_fct_agsv,mean_fct_aggr,firesize_agtf,firesize_agef,       &
  61            firesize_agsv,firesize_aggr
  62
  63    REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme,num_emis_ant ),            &
  64          INTENT(IN ) ::                                                    &
  65                      emis_ant
  66 !
  67 !
  68 !
  69    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,               &
  70           INTENT(IN   ) ::                                                 &
  71                                                       t_phy,               &
  72                  z,z_at_w,vvel,u_phy,v_phy,rho_phy,p_phy
  73       REAL,      INTENT(IN   ) ::                                          &
  74                              dtstep
  75
  76    LOGICAL,      INTENT(IN   ) :: scale_fire_emiss
  77
  78 !
  79 ! Local variables...
  80 !
  81       INTEGER :: nv, i, j, k, ksub, nspecies
  82
  83
  84 !     integer, parameter :: nspecies=num_ebu
  85       real, dimension (num_ebu) :: eburn_in
  86       real, dimension (kte,num_ebu) :: eburn_out
  87       real, dimension (kte) :: u_in ,v_in ,w_in ,theta_in ,pi_in  &
  88                               ,rho_phyin ,qv_in ,zmid    &
  89                               ,z_lev
  90 ! real, dimension(nveg_agreg) :: firesize,mean_fct
  91       real :: sum, ffirs, ratio
  92 !     real,save,dimension(its:ite,jts:jte) :: ffirs
  93       ffirs=0.
  94       nspecies=num_ebu
  95 !     write(0,*)'plumerise'
  96
  97       if( scale_fire_emiss ) then
  98         select case( config_flags%chem_opt )
  99           case( MOZART_KPP,MOZCART_KPP,T1_MOZCART_KPP,MOZART_MOSAIC_4BIN_KPP,MOZART_MOSAIC_4BIN_AQ_KPP )
 100           case default
 101             call wrf_error_fatal("Fire emission scaling only supported for MOZART chem options")
 102         end select
 103       endif
 104
 105        if ( config_flags%biomass_burn_opt == BIOMASSB ) then
 106          do j=jts,jte
 107             do i=its,ite
 108                ebu(i,kts,j,p_ebu_no)=ebu_in(i,1,j,p_ebu_in_no)
 109                ebu(i,kts,j,p_ebu_no2)=ebu_in(i,1,j,p_ebu_in_no2)
 110                ebu(i,kts,j,p_ebu_co)=ebu_in(i,1,j,p_ebu_in_co)
 111                ebu(i,kts,j,p_ebu_co2)=ebu_in(i,1,j,p_ebu_in_co2)
 112               ebu(i,kts,j,p_ebu_nh3) = ebu_in(i,1,j,p_ebu_in_nh3)
 113                ebu(i,kts,j,p_ebu_ch4) = ebu_in(i,1,j,p_ebu_in_ch4)
 114                ebu(i,kts,j,p_ebu_eth)=ebu_in(i,1,j,p_ebu_in_eth)
 115                ebu(i,kts,j,p_ebu_hc3)=ebu_in(i,1,j,p_ebu_in_hc3)
 116                ebu(i,kts,j,p_ebu_hc5)=ebu_in(i,1,j,p_ebu_in_hc5)
 117                ebu(i,kts,j,p_ebu_hc8)=ebu_in(i,1,j,p_ebu_in_hc8)
 118                ebu(i,kts,j,p_ebu_ete)=ebu_in(i,1,j,p_ebu_in_ete)
 119                ebu(i,kts,j,p_ebu_olt)=ebu_in(i,1,j,p_ebu_in_olt)
 120                ebu(i,kts,j,p_ebu_oli)=ebu_in(i,1,j,p_ebu_in_oli)
 121                ebu(i,kts,j,p_ebu_pm25)=ebu_in(i,1,j,p_ebu_in_pm25)
 122                ebu(i,kts,j,p_ebu_pm10)=ebu_in(i,1,j,p_ebu_in_pm10)
 123                ebu(i,kts,j,p_ebu_dien)=ebu_in(i,1,j,p_ebu_in_dien)
 124                ebu(i,kts,j,p_ebu_iso)=ebu_in(i,1,j,p_ebu_in_iso)
 125                ebu(i,kts,j,p_ebu_api)=ebu_in(i,1,j,p_ebu_in_api)
 126                ebu(i,kts,j,p_ebu_lim)=ebu_in(i,1,j,p_ebu_in_lim)
 127                ebu(i,kts,j,p_ebu_tol)=ebu_in(i,1,j,p_ebu_in_tol)
 128                ebu(i,kts,j,p_ebu_xyl)=ebu_in(i,1,j,p_ebu_in_xyl)
 129                ebu(i,kts,j,p_ebu_csl)=ebu_in(i,1,j,p_ebu_in_csl)
 130                ebu(i,kts,j,p_ebu_hcho)=ebu_in(i,1,j,p_ebu_in_hcho)
 131                ebu(i,kts,j,p_ebu_ald)=ebu_in(i,1,j,p_ebu_in_ald)
 132                ebu(i,kts,j,p_ebu_ket)=ebu_in(i,1,j,p_ebu_in_ket)
 133                ebu(i,kts,j,p_ebu_macr)=ebu_in(i,1,j,p_ebu_in_macr)
 134                ebu(i,kts,j,p_ebu_ora1)=ebu_in(i,1,j,p_ebu_in_ora1)
 135                ebu(i,kts,j,p_ebu_ora2)=ebu_in(i,1,j,p_ebu_in_ora2)
 136 !              ebu(i,kts,j,p_ebu_sulf)=ebu_in(i,1,j,p_ebu_in_sulf)
 137                ebu(i,kts,j,p_ebu_bc)=ebu_in(i,1,j,p_ebu_in_bc)
 138                ebu(i,kts,j,p_ebu_oc)=ebu_in(i,1,j,p_ebu_in_oc)
 139                ebu(i,kts,j,p_ebu_so2)=ebu_in(i,1,j,p_ebu_in_so2)
 140                ebu(i,kts,j,p_ebu_dms)=ebu_in(i,1,j,p_ebu_in_dms)
 141             enddo
 142          enddo
 143        elseif ( config_flags%biomass_burn_opt == BIOMASSB_MOZC .or. &
 144                 config_flags%biomass_burn_opt == BIOMASSB_T1_MOZCART .or. &
 145                 config_flags%biomass_burn_opt == BIOMASSB_MOZ ) then
 146          do j=jts,jte
 147             do i=its,ite
 148                ebu(i,kts,j,p_ebu_no) = ebu_in(i,1,j,p_ebu_in_no)
 149                ebu(i,kts,j,p_ebu_co) = ebu_in(i,1,j,p_ebu_in_co)
 150                ebu(i,kts,j,p_ebu_bigalk) = ebu_in(i,1,j,p_ebu_in_bigalk)
 151                ebu(i,kts,j,p_ebu_bigene) = ebu_in(i,1,j,p_ebu_in_bigene)
 152                ebu(i,kts,j,p_ebu_c2h4) = ebu_in(i,1,j,p_ebu_in_c2h4)
 153                ebu(i,kts,j,p_ebu_c2h5oh) = ebu_in(i,1,j,p_ebu_in_c2h5oh)
 154                ebu(i,kts,j,p_ebu_c2h6) = ebu_in(i,1,j,p_ebu_in_c2h6)
 155                ebu(i,kts,j,p_ebu_c3h6) = ebu_in(i,1,j,p_ebu_in_c3h6)
 156                ebu(i,kts,j,p_ebu_c3h8) = ebu_in(i,1,j,p_ebu_in_c3h8)
 157                ebu(i,kts,j,p_ebu_ch2o) = ebu_in(i,1,j,p_ebu_in_ch2o)
 158                ebu(i,kts,j,p_ebu_ch3cho) = ebu_in(i,1,j,p_ebu_in_ch3cho)
 159                ebu(i,kts,j,p_ebu_ch3coch3) = ebu_in(i,1,j,p_ebu_in_ch3coch3)
 160                ebu(i,kts,j,p_ebu_ch3oh) = ebu_in(i,1,j,p_ebu_in_ch3oh)
 161                ebu(i,kts,j,p_ebu_mek) = ebu_in(i,1,j,p_ebu_in_mek)
 162                ebu(i,kts,j,p_ebu_so2) = ebu_in(i,1,j,p_ebu_in_so2)
 163                ebu(i,kts,j,p_ebu_toluene) = ebu_in(i,1,j,p_ebu_in_toluene)
 164                ebu(i,kts,j,p_ebu_nh3) = ebu_in(i,1,j,p_ebu_in_nh3)
 165                ebu(i,kts,j,p_ebu_no2) = ebu_in(i,1,j,p_ebu_in_no2)
 166                ebu(i,kts,j,p_ebu_open) = ebu_in(i,1,j,p_ebu_in_open)
 167                ebu(i,kts,j,p_ebu_mgly) = ebu_in(i,1,j,p_ebu_in_mgly)
 168                ebu(i,kts,j,p_ebu_ch3cooh) = ebu_in(i,1,j,p_ebu_in_ch3cooh)
 169                ebu(i,kts,j,p_ebu_cres) = ebu_in(i,1,j,p_ebu_in_cres)
 170                ebu(i,kts,j,p_ebu_glyald) = ebu_in(i,1,j,p_ebu_in_glyald)
 171                ebu(i,kts,j,p_ebu_gly) = ebu_in(i,1,j,p_ebu_in_gly)
 172                ebu(i,kts,j,p_ebu_acetol) = ebu_in(i,1,j,p_ebu_in_acetol)
 173                ebu(i,kts,j,p_ebu_isop) = ebu_in(i,1,j,p_ebu_in_isop)
 174                ebu(i,kts,j,p_ebu_macr) = ebu_in(i,1,j,p_ebu_in_macr)
 175                ebu(i,kts,j,p_ebu_mvk) = ebu_in(i,1,j,p_ebu_in_mvk)
 176                ebu(i,kts,j,p_ebu_dms) = ebu_in(i,1,j,p_ebu_in_dms)
 177                if( p_ebu_c10h16 >= param_first_scalar ) then
 178                  ebu(its:ite,kts,j,p_ebu_c10h16) = ebu_in(its:ite,1,j,p_ebu_in_c10h16)
 179                endif
 180             enddo
 181          enddo
 182          if( config_flags%biomass_burn_opt == BIOMASSB_MOZC .or. &
 183              config_flags%biomass_burn_opt == BIOMASSB_T1_MOZCART ) then
 184            do j=jts,jte
 185              ebu(its:ite,kts,j,p_ebu_pm10) = ebu_in(its:ite,1,j,p_ebu_in_pm10)
 186              ebu(its:ite,kts,j,p_ebu_pm25) = ebu_in(its:ite,1,j,p_ebu_in_pm25)
 187              ebu(its:ite,kts,j,p_ebu_oc) = ebu_in(its:ite,1,j,p_ebu_in_oc)
 188              ebu(its:ite,kts,j,p_ebu_bc) = ebu_in(its:ite,1,j,p_ebu_in_bc)
 189            enddo
 190            if( config_flags%biomass_burn_opt == BIOMASSB_T1_MOZCART ) then
 191              do j=jts,jte
 192                ebu(its:ite,kts,j,p_ebu_apin)  = ebu_in(its:ite,1,j,p_ebu_in_apin)
 193                ebu(its:ite,kts,j,p_ebu_benzene)  = ebu_in(its:ite,1,j,p_ebu_in_benzene)
 194                ebu(its:ite,kts,j,p_ebu_ch3cn) = ebu_in(its:ite,1,j,p_ebu_in_ch3cn)
 195                ebu(its:ite,kts,j,p_ebu_hcn)   = ebu_in(its:ite,1,j,p_ebu_in_hcn)
 196                ebu(its:ite,kts,j,p_ebu_hcooh) = ebu_in(its:ite,1,j,p_ebu_in_hcooh)
 197                ebu(its:ite,kts,j,p_ebu_c2h2)  = ebu_in(its:ite,1,j,p_ebu_in_c2h2)
 198                ebu(its:ite,kts,j,p_ebu_xylenes) = ebu_in(its:ite,1,j,p_ebu_in_xylenes)
 199              enddo
 200            endif
 201          endif
 202        elseif ( config_flags%biomass_burn_opt == BIOMASSB_GHG ) then
 203          do j=jts,jte
 204             do i=its,ite
 205                ebu(i,kts,j,p_ebu_co)  = ebu_in(i,1,j,p_ebu_in_co)
 206                ebu(i,kts,j,p_ebu_co2) = ebu_in(i,1,j,p_ebu_in_co2)
 207                ebu(i,kts,j,p_ebu_ch4) = ebu_in(i,1,j,p_ebu_in_ch4)
 208             enddo
 209           enddo
 210        endif
 211 !
 212        do nv=1,num_ebu
 213           do j=jts,jte
 214             do k=kts+1,kte
 215                do i=its,ite
 216                  ebu(i,k,j,nv)=0.
 217                enddo
 218             enddo
 219           enddo
 220        enddo
 221
 222        do j=jts,jte
 223           do i=its,ite
 224             sum=mean_fct_agtf(i,j)+mean_fct_agef(i,j)+mean_fct_agsv(i,j)    &
 225                     +mean_fct_aggr(i,j)
 226             if(sum.lt.1.e-6)Cycle
 227 !           write(0,*)'before',i,j,ebu_co(i,1,j),sum
 228 !           ffirs=ffirs+1
 229             sum=firesize_agtf(i,j)+firesize_agef(i,j)+firesize_agsv(i,j)    &
 230                     +firesize_aggr(i,j)
 231             if(sum.lt.1.e-6)Cycle
 232             eburn_out=0.
 233             mean_fct(1)=mean_fct_agtf(i,j)
 234             mean_fct(2)=mean_fct_agef(i,j)
 235             mean_fct(3)=mean_fct_agsv(i,j)
 236             mean_fct(4)=mean_fct_aggr(i,j)
 237             firesize(1)=firesize_agtf(i,j)
 238             firesize(2)=firesize_agef(i,j)
 239             firesize(3)=firesize_agsv(i,j)
 240             firesize(4)=firesize_aggr(i,j)
 241             do nv=1,num_ebu
 242             eburn_in(nv)=ebu(i,kts,j,nv)
 243             enddo
 244             if( maxval( eburn_in(:) ) == 0. ) cycle
 245             do k=kts,kte
 246               u_in(k)=u_phy(i,k,j)
 247               v_in(k)=v_phy(i,k,j)
 248               w_in(k)=vvel(i,k,j)
 249               qv_in(k)=moist(i,k,j,p_qv)
 250               pi_in(k)=cp*(p_phy(i,k,j)/p1000mb)**rcp
 251               zmid(k)=z(i,k,j)-z_at_w(i,kts,j)
 252               z_lev(k)=z_at_w(i,k,j)-z_at_w(i,kts,j)
 253               rho_phyin(k)=rho_phy(i,k,j)
 254               theta_in(k)=t_phy(i,k,j)/pi_in(k)*cp
 255 !             if(ffirs.le.5)then
 256 !               write(0,*)k,u_in(k),w_in(k),qv_in(k),pi_in(k)
 257 !             endif
 258             enddo
 259 !!$              pi_in(kte)=pi_in(kte-1)  !wig: These are no longer needed after changing definition
 260 !!$              u_in(kte)=u_in(kte-1)    !     of kte in chem_driver (12-Oct-2007)
 261 !!$              v_in(kte)=v_in(kte-1)
 262 !!$              w_in(kte)=w_in(kte-1)
 263 !!$              qv_in(kte)=qv_in(kte-1)
 264 !!$              zmid(kte)=z(i,kte,j)-z_at_w(i,kts,j)
 265 !!$              z_lev(kte)=z_at_w(i,kte,j)-z_at_w(i,kts,j)
 266 !!$              rho_phyin(kte)=rho_phyin(kte-1)
 267 !!$              theta_in(kte)=theta_in(kte-1)
 268 !             if(ffirs.le.5)then
 269 !           do k=kts,kte
 270 !               write(0,*)k,z_lev(k),zmid(k),rho_phyin(k),theta_in(k)
 271 !           enddo
 272 !               write(0,*)'eburn',eburn_in(1),mean_fct,firesize
 273 !             endif
 274
 275             call plumerise(kte,1,1,1,1,1,1,firesize,mean_fct  &
 276                     ,nspecies,eburn_in,eburn_out &
 277                     ,u_in ,v_in ,w_in ,theta_in ,pi_in  &
 278                     ,rho_phyin ,qv_in ,zmid    &
 279                     ,z_lev                               )
 280
 281 !             if(ffirs.le.5)then
 282 !           do k=kts,kte
 283 !               write(0,*)'eburn_out ',k,i,j,eburn_out(k,1)
 284 !           enddo
 285 !             endif
 286
 287             do nv=1,num_ebu
 288               do k=kts+1,kte
 289                 ebu(i,k,j,nv)=eburn_out(k,nv)*(z_at_w(i,k+1,j)-z_at_w(i,k,j))
 290               enddo
 291             enddo
 292
 293 has_total_emissions : &
 294             if( scale_fire_emiss ) then
 295 is_mozcart : &
 296               if( (config_flags%chem_opt == MOZCART_KPP .and. &
 297                    config_flags%biomass_burn_opt == BIOMASSB_MOZC) .or. &
 298                   (config_flags%chem_opt == T1_MOZCART_KPP .and. &
 299                    config_flags%biomass_burn_opt == BIOMASSB_T1_MOZCART) .or. &
 300                   (config_flags%chem_opt == MOZART_KPP .and. &
 301                    config_flags%biomass_burn_opt == BIOMASSB_MOZ) .or. &
 302                   (config_flags%chem_opt == MOZART_MOSAIC_4BIN_KPP .and. &
 303                    config_flags%biomass_burn_opt == BIOMASSB_MOZC) .or. &
 304                    (config_flags%chem_opt == MOZART_MOSAIC_4BIN_AQ_KPP .and. &
 305                    config_flags%biomass_burn_opt == BIOMASSB_MOZC) ) then
 306 !-------------------------------------------------------------------
 307 ! we input total emissions instead of smoldering emissions:
 308 ! ratio of smolderling to total
 309 !-------------------------------------------------------------------
 310                 sum = 0.
 311                 do k = kts,kte
 312                   sum = sum + ebu(i,k,j,p_ebu_co)
 313                 end do
 314                 if( sum > 0. ) then
 315                   ratio = ebu(i,kts,j,p_ebu_co)/sum
 316                 else
 317                   ratio = 0.
 318                 endif
 319
 320                 do k = kts,kte
 321                   ebu(i,k,j,p_ebu_no) = ebu(i,k,j,p_ebu_no)*ratio
 322                   ebu(i,k,j,p_ebu_co) = ebu(i,k,j,p_ebu_co)*ratio
 323                   ebu(i,k,j,p_ebu_bigalk) = ebu(i,k,j,p_ebu_bigalk)*ratio
 324                   ebu(i,k,j,p_ebu_bigene) = ebu(i,k,j,p_ebu_bigene)*ratio
 325                   ebu(i,k,j,p_ebu_c2h4)   = ebu(i,k,j,p_ebu_c2h4)*ratio
 326                   ebu(i,k,j,p_ebu_c2h5oh) = ebu(i,k,j,p_ebu_c2h5oh)*ratio
 327                   ebu(i,k,j,p_ebu_c2h6) = ebu(i,k,j,p_ebu_c2h6)*ratio
 328                   ebu(i,k,j,p_ebu_c3h6) = ebu(i,k,j,p_ebu_c3h6)*ratio
 329                   ebu(i,k,j,p_ebu_c3h8) = ebu(i,k,j,p_ebu_c3h8)*ratio
 330                   ebu(i,k,j,p_ebu_ch2o) = ebu(i,k,j,p_ebu_ch2o)*ratio
 331                   ebu(i,k,j,p_ebu_ch3cho) = ebu(i,k,j,p_ebu_ch3cho)*ratio
 332                   ebu(i,k,j,p_ebu_ch3coch3) = ebu(i,k,j,p_ebu_ch3coch3)*ratio
 333                   ebu(i,k,j,p_ebu_ch3oh)    = ebu(i,k,j,p_ebu_ch3oh)*ratio
 334                   ebu(i,k,j,p_ebu_mek) = ebu(i,k,j,p_ebu_mek)*ratio
 335                   ebu(i,k,j,p_ebu_so2) = ebu(i,k,j,p_ebu_so2)*ratio
 336                   ebu(i,k,j,p_ebu_toluene) = ebu(i,k,j,p_ebu_toluene)*ratio
 337                   ebu(i,k,j,p_ebu_nh3) = ebu(i,k,j,p_ebu_nh3)*ratio
 338                   ebu(i,k,j,p_ebu_no2)  = ebu(i,k,j,p_ebu_no2)*ratio
 339                   ebu(i,k,j,p_ebu_open) = ebu(i,k,j,p_ebu_open)*ratio
 340                   ebu(i,k,j,p_ebu_c10h16) = ebu(i,k,j,p_ebu_c10h16)*ratio
 341                   ebu(i,k,j,p_ebu_mgly) = ebu(i,k,j,p_ebu_mgly)*ratio
 342                   ebu(i,k,j,p_ebu_ch3cooh) = ebu(i,k,j,p_ebu_ch3cooh)*ratio
 343                   ebu(i,k,j,p_ebu_cres) = ebu(i,k,j,p_ebu_cres)*ratio
 344                   ebu(i,k,j,p_ebu_glyald) = ebu(i,k,j,p_ebu_glyald)*ratio
 345                   ebu(i,k,j,p_ebu_gly) = ebu(i,k,j,p_ebu_gly)*ratio
 346                   ebu(i,k,j,p_ebu_acetol) = ebu(i,k,j,p_ebu_acetol)*ratio
 347                   ebu(i,k,j,p_ebu_isop) = ebu(i,k,j,p_ebu_isop)*ratio
 348                   ebu(i,k,j,p_ebu_macr) = ebu(i,k,j,p_ebu_macr)*ratio
 349                   ebu(i,k,j,p_ebu_mvk)  = ebu(i,k,j,p_ebu_mvk)*ratio
 350                   ebu(i,k,j,p_ebu_dms) = ebu_in(i,k,j,p_ebu_in_dms)*ratio
 351                 end do
 352
 353                 select case( config_flags%biomass_burn_opt )
 354                   case( BIOMASSB_T1_MOZCART )
 355                     ebu(i,kts:kte,j,p_ebu_apin) = ebu(i,kts:kte,j,p_ebu_apin)*ratio
 356                     ebu(i,kts:kte,j,p_ebu_benzene) = ebu(i,kts:kte,j,p_ebu_benzene)*ratio
 357                     ebu(i,kts:kte,j,p_ebu_ch3cn) = ebu(i,kts:kte,j,p_ebu_ch3cn)*ratio
 358                     ebu(i,kts:kte,j,p_ebu_hcn) = ebu(i,kts:kte,j,p_ebu_hcn)*ratio
 359                     ebu(i,kts:kte,j,p_ebu_hcooh) = ebu(i,kts:kte,j,p_ebu_hcooh)*ratio
 360                     ebu(i,kts:kte,j,p_ebu_c2h2) = ebu(i,kts:kte,j,p_ebu_c2h2)*ratio
 361                     ebu(i,kts:kte,j,p_ebu_xylenes) = ebu(i,kts:kte,j,p_ebu_xylenes)*ratio
 362                   case( BIOMASSB_MOZ,BIOMASSB_MOZC )
 363                     ebu(i,kts:kte,j,p_ebu_c10h16) = ebu(i,kts:kte,j,p_ebu_c10h16)*ratio
 364                 end select
 365                 if( config_flags%biomass_burn_opt == BIOMASSB_MOZC .or. &
 366                     config_flags%biomass_burn_opt == BIOMASSB_T1_MOZCART ) then
 367                   ebu(i,kts:kte,j,p_ebu_pm10) = ebu(i,kts:kte,j,p_ebu_pm10)*ratio
 368                   ebu(i,kts:kte,j,p_ebu_pm25) = ebu(i,kts:kte,j,p_ebu_pm25)*ratio
 369                   ebu(i,kts:kte,j,p_ebu_oc) = ebu(i,kts:kte,j,p_ebu_oc)*ratio
 370                   ebu(i,kts:kte,j,p_ebu_bc) = ebu(i,kts:kte,j,p_ebu_bc)*ratio
 371                 endif
 372
 373 !psp add for other treatments
 374                elseif (config_flags%biomass_burn_opt == BIOMASSB) then
 375
 376 !-------------------------------------------------------------------
 377 ! we input total emissions instead of smoldering emissions:
 378 ! ratio of smolderling to total
 379 !-------------------------------------------------------------------
 380                  sum = 0.
 381                  do k = kts,kte
 382                    sum = sum + ebu(i,k,j,p_ebu_co)
 383                  end do
 384                  if( sum > 0. ) then
 385                    ratio = ebu(i,kts,j,p_ebu_co)/sum
 386                  else
 387                    ratio = 0.
 388                  endif
 389
 390                  do k = kts,kte
 391                    ebu(i,k,j,p_ebu_no)  = ebu(i,k,j,p_ebu_no)*ratio
 392                    ebu(i,k,j,p_ebu_no2)  = ebu(i,k,j,p_ebu_no2)*ratio
 393                    ebu(i,k,j,p_ebu_co)  = ebu(i,k,j,p_ebu_co)*ratio
 394                    ebu(i,k,j,p_ebu_co2)  = ebu(i,k,j,p_ebu_co2)*ratio
 395                    ebu(i,k,j,p_ebu_eth)  = ebu(i,k,j,p_ebu_eth)*ratio
 396                    ebu(i,k,j,p_ebu_hc3)  = ebu(i,k,j,p_ebu_hc3)*ratio
 397                    ebu(i,k,j,p_ebu_hc5)  = ebu(i,k,j,p_ebu_hc5)*ratio
 398                    ebu(i,k,j,p_ebu_hc8)  = ebu(i,k,j,p_ebu_hc8)*ratio
 399                    ebu(i,k,j,p_ebu_ete)  = ebu(i,k,j,p_ebu_ete)*ratio
 400                    ebu(i,k,j,p_ebu_olt)  = ebu(i,k,j,p_ebu_olt)*ratio
 401                    ebu(i,k,j,p_ebu_oli)  = ebu(i,k,j,p_ebu_oli)*ratio
 402                    ebu(i,k,j,p_ebu_pm25)  = ebu(i,k,j,p_ebu_pm25)*ratio
 403                    ebu(i,k,j,p_ebu_pm10)  = ebu(i,k,j,p_ebu_pm10)*ratio
 404                    ebu(i,k,j,p_ebu_dien)  = ebu(i,k,j,p_ebu_dien)*ratio
 405                    ebu(i,k,j,p_ebu_iso)  = ebu(i,k,j,p_ebu_iso)*ratio
 406                    ebu(i,k,j,p_ebu_api)  = ebu(i,k,j,p_ebu_api)*ratio
 407                    ebu(i,k,j,p_ebu_lim)  = ebu(i,k,j,p_ebu_lim)*ratio
 408                    ebu(i,k,j,p_ebu_tol)  = ebu(i,k,j,p_ebu_tol)*ratio
 409                    ebu(i,k,j,p_ebu_csl)  = ebu(i,k,j,p_ebu_csl)*ratio
 410                    ebu(i,k,j,p_ebu_hcho)  = ebu(i,k,j,p_ebu_hcho)*ratio
 411                    ebu(i,k,j,p_ebu_ald)  = ebu(i,k,j,p_ebu_ald)*ratio
 412                    ebu(i,k,j,p_ebu_ket)  = ebu(i,k,j,p_ebu_ket)*ratio
 413                    ebu(i,k,j,p_ebu_macr)  = ebu(i,k,j,p_ebu_macr)*ratio
 414                    ebu(i,k,j,p_ebu_ora1)  = ebu(i,k,j,p_ebu_ora1)*ratio
 415                    ebu(i,k,j,p_ebu_ora2)  = ebu(i,k,j,p_ebu_ora2)*ratio
 416                    ebu(i,k,j,p_ebu_so2)  = ebu(i,k,j,p_ebu_so2)*ratio
 417                    ebu(i,k,j,p_ebu_nh3)  = ebu(i,k,j,p_ebu_nh3)*ratio
 418                    ebu(i,k,j,p_ebu_oc)  = ebu(i,k,j,p_ebu_oc)*ratio
 419                    ebu(i,k,j,p_ebu_bc)  = ebu(i,k,j,p_ebu_bc)*ratio
 420                    ebu(i,k,j,p_ebu_sulf)  = ebu(i,k,j,p_ebu_sulf)*ratio
 421                    ebu(i,k,j,p_ebu_dms)  = ebu(i,k,j,p_ebu_dms)*ratio
 422                  end do
 423               end if is_mozcart
 424             end if has_total_emissions
 425
 426           enddo
 427           enddo
 428 end subroutine plumerise_driver
 429
 430 END Module module_plumerise1