wrfv2_fire/chem/module_cbmz_addemiss.F

   1 !**********************************************************************************
   2 ! This computer software was prepared by Battelle Memorial Institute, hereinafter
   3 ! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of
   4 ! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY,
   5 ! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE.
   6 !
   7 ! CBMZ module: see module_cbmz.F for information and terms of use
   8 !**********************************************************************************
   9
  10 MODULE module_cbmz_addemiss
  11 !WRF:MODEL_LAYER:CHEMICS
  12
  13
  14
  15    integer, parameter :: cbmz_addemiss_masscheck = -1
  16                        ! only do emissions masscheck calcs when this is positive
  17
  18
  19
  20 CONTAINS
  21
  22
  23
  24 !----------------------------------------------------------------------
  25    subroutine cbmz_addemiss_anthro( id, dtstep, dz8w, config_flags,       &
  26                rho_phy, chem,                                             &
  27                e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt, &
  28                e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3,         &
  29                e_no2,e_ch3oh,e_c2h5oh,                                    &
  30                ids,ide, jds,jde, kds,kde,                                 &
  31                ims,ime, jms,jme, kms,kme,                                 &
  32                its,ite, jts,jte, kts,kte                                  )
  33 !
  34 ! adds emissions for cbmz trace gas species
  35 ! (i.e., emissions tendencies over time dtstep are applied
  36 ! to the trace gas concentrations)
  37 !
  38
  39   USE module_configure
  40   USE module_state_description
  41   USE module_data_radm2
  42
  43   IMPLICIT NONE
  44
  45    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  46
  47    INTEGER,      INTENT(IN   ) :: id,                                      &
  48                                   ids,ide, jds,jde, kds,kde,               &
  49                                   ims,ime, jms,jme, kms,kme,               &
  50                                   its,ite, jts,jte, kts,kte
  51
  52    REAL, INTENT(IN   ) ::    dtstep
  53
  54 ! trace species mixing ratios (gases=ppm)
  55    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
  56          INTENT(INOUT ) ::   chem
  57 !
  58 ! emissions arrays (v.1: ppm m/min; v.2: mole km^-2 hr^-1)
  59 !
  60 !   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                          &
  61    REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ),            &
  62          INTENT(IN ) ::                                                    &
  63           e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt,       &
  64           e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3,               &
  65           e_no2,e_ch3oh,e_c2h5oh
  66
  67 ! layer thickness (m)
  68    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,               &
  69           INTENT(IN   ) ::   dz8w, rho_phy
  70
  71 ! local variables
  72    integer :: i,j,k
  73    real, parameter :: efact1 = 1.0/60.0
  74    real :: conv
  75    double precision :: chem_sum(num_chem)
  76
  77
  78 ! do mass check initial calc
  79       if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck(            &
  80                id, config_flags, 1, 'cbmz_addemiss',                       &
  81                dtstep, efact1, dz8w, chem, chem_sum,                       &
  82                ids,ide, jds,jde, kds,kde,                                  &
  83                ims,ime, jms,jme, kms,kme,                                  &
  84                its,ite, jts,jte, kts,kte,                                  &
  85                21,                                                         &
  86                e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt,  &
  87                e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3,          &
  88                e_no2,e_ch3oh,e_c2h5oh                                      )
  89
  90
  91 !
  92 ! add emissions
  93 !
  94       do 100 j=jts,jte
  95       do 100 i=its,ite
  96
  97       DO k=kts,min(config_flags%kemit,kte-1)
  98 !v1 units:        conv = dtstep/(dz8w(i,k,j)*60.)
  99 !v2 units:
 100         conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
 101
 102 #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
 103        if( (i <= CHEM_DBG_I .and. i >= CHEM_DBG_I) .and. &
 104            (j <= CHEM_DBG_J .and. j >= CHEM_DBG_J) .and. &
 105            (k <= CHEM_DBG_K .and. k >= CHEM_DBG_K)  ) then
 106           print*
 107           print*,"Converted emissions for CBMZ:"
 108           print*,"e_csl=",e_csl(i,k,j)*conv
 109           print*,"e_so2=",e_so2(i,k,j)*conv
 110           print*,"e_no=",e_no(i,k,j)*conv
 111           print*,"e_ald=",e_ald(i,k,j)*conv
 112           print*,"e_hcho=",e_hcho(i,k,j)*conv
 113           print*,"e_ora2=",e_ora2(i,k,j)*conv
 114           print*,"e_nh3=",e_nh3(i,k,j)*conv
 115           print*,"e_hc3=",e_hc3(i,k,j)*conv
 116           print*,"e_hc5=",e_hc5(i,k,j)*conv
 117           print*,"e_hc8=",e_hc8(i,k,j)*conv
 118           print*,"e_eth=",e_eth(i,k,j)*conv
 119           print*,"e_co=",e_co(i,k,j)*conv
 120           print*,"e_ol2=",e_ol2(i,k,j)*conv
 121           print*,"e_olt=",e_olt(i,k,j)*conv
 122           print*,"e_oli=",e_oli(i,k,j)*conv
 123           print*,"e_tol=",e_tol(i,k,j)*conv
 124           print*,"e_xyl=",e_xyl(i,k,j)*conv
 125           print*,"e_ket=",e_ket(i,k,j)*conv
 126        end if
 127 #endif
 128
 129         chem(i,k,j,p_csl)  =  chem(i,k,j,p_csl)                        &
 130                          +e_csl(i,k,j)*conv
 131         chem(i,k,j,p_so2)  = chem(i,k,j,p_so2)                         &
 132                          +e_so2(i,k,j)*conv
 133         chem(i,k,j,p_no)   = chem(i,k,j,p_no)                          &
 134                          +e_no(i,k,j)*conv
 135         chem(i,k,j,p_ald)  = chem(i,k,j,p_ald)                         &
 136                          +e_ald(i,k,j)*conv
 137         chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho)                        &
 138                          +e_hcho(i,k,j)*conv
 139         chem(i,k,j,p_ora2)  = chem(i,k,j,p_ora2)                       &
 140                          +e_ora2(i,k,j)*conv
 141         chem(i,k,j,p_nh3)  = chem(i,k,j,p_nh3)                         &
 142                          +e_nh3(i,k,j)*conv
 143         chem(i,k,j,p_hc3)  = chem(i,k,j,p_hc3)                         &
 144                          +e_hc3(i,k,j)*conv
 145         chem(i,k,j,p_hc5)  = chem(i,k,j,p_hc5)                         &
 146                          +e_hc5(i,k,j)*conv
 147         chem(i,k,j,p_hc8)  = chem(i,k,j,p_hc8)                         &
 148                          +e_hc8(i,k,j)*conv
 149         chem(i,k,j,p_eth)  = chem(i,k,j,p_eth)                         &
 150                          +e_eth(i,k,j)*conv
 151         chem(i,k,j,p_co)  = chem(i,k,j,p_co)                           &
 152                          +e_co(i,k,j)*conv
 153         chem(i,k,j,p_ol2)  = chem(i,k,j,p_ol2)                         &
 154                          +e_ol2(i,k,j)*conv
 155         chem(i,k,j,p_olt)  = chem(i,k,j,p_olt)                         &
 156                          +e_olt(i,k,j)*conv
 157         chem(i,k,j,p_oli)  = chem(i,k,j,p_oli)                         &
 158                          +e_oli(i,k,j)*conv
 159         chem(i,k,j,p_tol)  = chem(i,k,j,p_tol)                         &
 160                          +e_tol(i,k,j)*conv
 161         chem(i,k,j,p_xyl)  = chem(i,k,j,p_xyl)                         &
 162                          +e_xyl(i,k,j)*conv
 163         chem(i,k,j,p_ket)  =  chem(i,k,j,p_ket)                        &
 164                          +e_ket(i,k,j)*conv
 165
 166 ! when emissions input file is "radm2sorg" variety, calc par emissions as a
 167 !   combination of the anthropogenic emissions for radm2 primary voc species
 168         if ( (config_flags%emiss_inpt_opt == EMISS_INPT_DEFAULT) .or.   &
 169              (config_flags%emiss_inpt_opt == EMISS_INPT_PNNL_RS) ) then
 170             chem(i,k,j,p_par) = chem(i,k,j,p_par)             &
 171                 + conv*                                       &
 172                   ( 0.4*e_ald(i,k,j) + 2.9*e_hc3(i,k,j)       &
 173                   + 4.8*e_hc5(i,k,j) + 7.9*e_hc8(i,k,j)       &
 174                   + 0.9*e_ket(i,k,j) + 2.8*e_oli(i,k,j)       &
 175                   + 1.8*e_olt(i,k,j) + 1.0*e_ora2(i,k,j) )
 176
 177 ! when emissions input file is "cbmzmosaic" variety,
 178 !   the par emissions are read into e_hc5
 179 !   and there are emissions for other species
 180         else
 181             chem(i,k,j,p_par) = chem(i,k,j,p_par)             &
 182                 + conv*e_hc5(i,k,j)
 183
 184             chem(i,k,j,p_no2) = chem(i,k,j,p_no2)             &
 185                 + conv*e_no2(i,k,j)
 186             chem(i,k,j,p_ch3oh)  = chem(i,k,j,p_ch3oh)        &
 187                 + conv*e_ch3oh(i,k,j)
 188             chem(i,k,j,p_c2h5oh) = chem(i,k,j,p_c2h5oh)       &
 189                 + conv*e_c2h5oh(i,k,j)
 190         end if
 191
 192       END DO
 193  100  continue
 194
 195
 196 ! do mass check final calc
 197       if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck(            &
 198                id, config_flags, 2, 'cbmz_addemiss',                       &
 199                dtstep, efact1, dz8w, chem, chem_sum,                       &
 200                ids,ide, jds,jde, kds,kde,                                  &
 201                ims,ime, jms,jme, kms,kme,                                  &
 202                its,ite, jts,jte, kts,kte,                                  &
 203                21,                                                         &
 204                e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt,  &
 205                e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3,          &
 206                e_no2,e_ch3oh,e_c2h5oh                                      )
 207
 208
 209    END subroutine cbmz_addemiss_anthro
 210
 211
 212
 213 !----------------------------------------------------------------------
 214   subroutine cbmz_addemiss_bio( id, dtstep, dz8w, config_flags,       &
 215         rho_phy, chem, e_bio, ne_area, e_iso,                         &
 216         numgas,                                                       &
 217         ids,ide, jds,jde, kds,kde,                                    &
 218         ims,ime, jms,jme, kms,kme,                                    &
 219         its,ite, jts,jte, kts,kte                                     )
 220
 221   USE module_configure
 222   USE module_state_description
 223   USE module_data_radm2
 224   USE module_aerosols_sorgam
 225
 226   IMPLICIT NONE
 227
 228 ! subr arguments
 229    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 230
 231    INTEGER,      INTENT(IN   ) :: id, ne_area,                             &
 232                                   numgas,                                  &
 233                                   ids,ide, jds,jde, kds,kde,               &
 234                                   ims,ime, jms,jme, kms,kme,               &
 235                                   its,ite, jts,jte, kts,kte
 236
 237    REAL,      INTENT(IN   ) ::    dtstep
 238
 239    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
 240          INTENT(INOUT ) ::        chem
 241
 242    REAL, DIMENSION( ims:ime, jms:jme,ne_area ),                            &
 243          INTENT(IN ) ::           e_bio
 244
 245 !   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                          &
 246    REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ),            &
 247          INTENT(IN ) ::           e_iso
 248
 249    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,               &
 250           INTENT(IN   ) ::        dz8w, rho_phy
 251
 252
 253 ! local variables
 254    integer i,j,k,n
 255    real, parameter :: efact1 = 1.0/60.0
 256    double precision :: chem_sum(num_chem)
 257
 258
 259 !
 260 ! apply gunther online biogenic gas emissions when bio_emiss_opt == GUNTHER1
 261 !
 262    if (config_flags%bio_emiss_opt == GUNTHER1) then
 263
 264       if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck(            &
 265                id, config_flags, 1, 'cbmz_addemiss_bioaa',                 &
 266                dtstep, efact1, dz8w, chem, chem_sum,                       &
 267                ids,ide, jds,jde, kds,kde,                                  &
 268                ims,ime, jms,jme, kms,kme,                                  &
 269                its,ite, jts,jte, kts,kte,                                  &
 270                kms, 13,                                                    &
 271                e_bio(ims,jms,p_ald-1),  e_bio(ims,jms,p_hc3-1),            &
 272                e_bio(ims,jms,p_hc5-1),  e_bio(ims,jms,p_hc8-1),            &
 273                e_bio(ims,jms,p_hcho-1), e_bio(ims,jms,p_iso-1),            &
 274                e_bio(ims,jms,p_ket-1),  e_bio(ims,jms,p_no-1),             &
 275                e_bio(ims,jms,p_oli-1),  e_bio(ims,jms,p_olt-1),            &
 276                e_bio(ims,jms,p_ora1-1), e_bio(ims,jms,p_ora2-1),           &
 277                e_bio(ims,jms,p_xyl-1),                                     &
 278                e_bio(ims,jms,p_xyl-1),  e_bio(ims,jms,p_xyl-1),            &
 279                e_bio(ims,jms,p_xyl-1),  e_bio(ims,jms,p_xyl-1),            &
 280                e_bio(ims,jms,p_xyl-1),  e_bio(ims,jms,p_xyl-1),            &
 281                e_bio(ims,jms,p_xyl-1),  e_bio(ims,jms,p_xyl-1)             )
 282
 283       DO n = 1, ne_area-2 !Assumes CBMZ and RADM2 species locations match up to p_iso
 284       do 100 j=jts,jte
 285       do 100 i=its,ite
 286         chem(i,kts,j,n+1) = chem(i,kts,j,n+1)    &
 287                           + e_bio(i,j,n)/(dz8w(i,kts,j)*60.)*dtstep
 288  100  continue
 289       enddo
 290
 291 ! calc par emissions as a combination of the biogenic emissions
 292 ! for radm2 primary voc species
 293       do j = jts, jte
 294       do i = its, ite
 295          chem(i,kts,j,p_par)  =  chem(i,kts,j,p_par)               &
 296              + (dtstep/(dz8w(i,kts,j)*60.))*                       &
 297                ( 0.4*e_bio(i,j,p_ald-1) + 2.9*e_bio(i,j,p_hc3-1)   &
 298                + 4.8*e_bio(i,j,p_hc5-1) + 7.9*e_bio(i,j,p_hc8-1)   &
 299                + 0.9*e_bio(i,j,p_ket-1) + 2.8*e_bio(i,j,p_oli-1)   &
 300                + 1.8*e_bio(i,j,p_olt-1) + 1.0*e_bio(i,j,p_ora2-1) )
 301       end do
 302       end do
 303
 304       if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck(            &
 305                id, config_flags, 2, 'cbmz_addemiss_bioaa',                 &
 306                dtstep, efact1, dz8w, chem, chem_sum,                       &
 307                ids,ide, jds,jde, kds,kde,                                  &
 308                ims,ime, jms,jme, kms,kme,                                  &
 309                its,ite, jts,jte, kts,kte,                                  &
 310                kms, 13,                                                    &
 311                e_bio(ims,jms,p_ald-1),  e_bio(ims,jms,p_hc3-1),            &
 312                e_bio(ims,jms,p_hc5-1),  e_bio(ims,jms,p_hc8-1),            &
 313                e_bio(ims,jms,p_hcho-1), e_bio(ims,jms,p_iso-1),            &
 314                e_bio(ims,jms,p_ket-1),  e_bio(ims,jms,p_no-1),             &
 315                e_bio(ims,jms,p_oli-1),  e_bio(ims,jms,p_olt-1),            &
 316                e_bio(ims,jms,p_ora1-1), e_bio(ims,jms,p_ora2-1),           &
 317                e_bio(ims,jms,p_xyl-1),                                     &
 318                e_bio(ims,jms,p_xyl-1),  e_bio(ims,jms,p_xyl-1),            &
 319                e_bio(ims,jms,p_xyl-1),  e_bio(ims,jms,p_xyl-1),            &
 320                e_bio(ims,jms,p_xyl-1),  e_bio(ims,jms,p_xyl-1),            &
 321                e_bio(ims,jms,p_xyl-1),  e_bio(ims,jms,p_xyl-1)             )
 322
 323    end if
 324
 325
 326 !
 327 ! apply offline isoprene emissions when bio_emiss_opt /= GUNTHER1
 328 !
 329    if (config_flags%bio_emiss_opt /= GUNTHER1) then
 330
 331       if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck(            &
 332                id, config_flags, 1, 'cbmz_addemiss_biobb',                 &
 333                dtstep, efact1, dz8w, chem, chem_sum,                       &
 334                ids,ide, jds,jde, kds,kde,                                  &
 335                ims,ime, jms,jme, kms,kme,                                  &
 336                its,ite, jts,jte, kts,kte,                                  &
 337                1,                                                          &
 338                e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,                  &
 339                e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,                  &
 340                e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso                   )
 341
 342       do j = jts, jte
 343       do k = kts, min(config_flags%kemit,kte-1)
 344       do i = its, ite
 345          chem(i,k,j,p_iso) = chem(i,k,j,p_iso) + e_iso(i,k,j)              &
 346               *4.828e-4/rho_phy(i,k,j)*(dtstep/(dz8w(i,k,j)*60.))
 347       end do
 348       end do
 349       end do
 350
 351       if (cbmz_addemiss_masscheck > 0) call addemiss_masscheck(            &
 352                id, config_flags, 2, 'cbmz_addemiss_biobb',                 &
 353                dtstep, efact1, dz8w, chem, chem_sum,                       &
 354                ids,ide, jds,jde, kds,kde,                                  &
 355                ims,ime, jms,jme, kms,kme,                                  &
 356                its,ite, jts,jte, kts,kte,                                  &
 357                1,                                                          &
 358                e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,                  &
 359                e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,                  &
 360                e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso                   )
 361
 362    end if
 363
 364
 365    END subroutine cbmz_addemiss_bio
 366
 367
 368 END MODULE module_cbmz_addemiss
 369
 370
 371