chem/module_cbm4_addemiss.F

   1
   2
   3 MODULE module_cbm4_addemiss
   4
   5
   6    integer, parameter :: cbm4_addemiss_masscheck = -1
   7                        ! only do emissions masscheck calcs when this is positive
   8
   9
  10
  11 CONTAINS
  12
  13
  14
  15 !----------------------------------------------------------------------
  16    subroutine cbm4_addemiss_anthro( id, dtstep, dz8w, config_flags,       &
  17                rho_phy, chem,emis_ant,                                    &
  18                ids,ide, jds,jde, kds,kde,                                 &
  19                ims,ime, jms,jme, kms,kme,                                 &
  20                its,ite, jts,jte, kts,kte                                  )
  21 !
  22 ! adds emissions for cbm4 trace gas species
  23 ! (i.e., emissions tendencies over time dtstep are applied
  24 ! to the trace gas concentrations)
  25 !
  26
  27   USE module_configure
  28   USE module_state_description
  29   USE module_data_radm2
  30
  31   IMPLICIT NONE
  32
  33    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  34
  35    INTEGER,      INTENT(IN   ) :: id,                                      &
  36                                   ids,ide, jds,jde, kds,kde,               &
  37                                   ims,ime, jms,jme, kms,kme,               &
  38                                   its,ite, jts,jte, kts,kte
  39
  40    REAL, INTENT(IN   ) ::    dtstep
  41
  42 ! trace species mixing ratios (gases=ppm)
  43    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
  44          INTENT(INOUT ) ::   chem
  45 !
  46 ! emissions arrays (v.1: ppm m/min; v.2: mole km^-2 hr^-1)
  47 !
  48 !   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                          &
  49    REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme,num_emis_ant),&
  50          INTENT(IN ) ::                                                    &
  51                          emis_ant
  52 ! layer thickness (m)
  53    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,               &
  54           INTENT(IN   ) ::   dz8w, rho_phy
  55
  56 ! local variables
  57    integer :: i,j,k
  58    real, parameter :: efact1 = 1.0/60.0
  59    real :: conv
  60    double precision :: chem_sum(num_chem)
  61
  62
  63 !! do mass check initial calc
  64 !      if (cbm4_addemiss_masscheck > 0) call addemiss_masscheck(               &
  65 !               id, config_flags, 1, 'cbm4_addemiss',                          &
  66 !               dtstep, efact1, dz8w, chem, chem_sum,                          &
  67 !               ids,ide, jds,jde, kds,kde,                                     &
  68 !               ims,ime, jms,jme, kms,kme,                                     &
  69 !               its,ite, jts,jte, kts,kte,                                     &
  70 !               21,                                                            &
  71 !               emis_ant(ims,kms,jms,p_e_so2),emis_ant(ims,kms,jms,p_e_no),    &
  72 !               emis_ant(ims,kms,jms,p_e_co),emis_ant(ims,kms,jms,p_e_eth),    &
  73 !               emis_ant(ims,kms,jms,p_e_hc3),emis_ant(ims,kms,jms,p_e_hc5),   &
  74 !               emis_ant(ims,kms,jms,p_e_hc8),emis_ant(ims,kms,jms,p_e_xyl),   &
  75 !               emis_ant(ims,kms,jms,p_e_ol2),emis_ant(ims,kms,jms,p_e_olt),   &
  76 !               emis_ant(ims,kms,jms,p_e_oli),emis_ant(ims,kms,jms,p_e_tol),   &
  77 !               emis_ant(ims,kms,jms,p_e_csl),emis_ant(ims,kms,jms,p_e_hcho),  &
  78 !               emis_ant(ims,kms,jms,p_e_ald),emis_ant(ims,kms,jms,p_e_ket),   &
  79 !               emis_ant(ims,kms,jms,p_e_ora2),emis_ant(ims,kms,jms,p_e_nh3),  &
  80 !               emis_ant(ims,kms,jms,p_e_no2),emis_ant(ims,kms,jms,p_e_ch3oh), &
  81 !               emis_ant(ims,kms,jms,p_e_c2h5oh))
  82
  83
  84
  85 !
  86 ! add emissions
  87 !
  88       do 100 j=jts,jte
  89       do 100 i=its,ite
  90
  91       DO k=kts,min(config_flags%kemit,kte)
  92 !v1 units:        conv = dtstep/(dz8w(i,k,j)*60.)
  93 !v2 units:
  94         conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
  95
  96 !#if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
  97 !       if( (i <= CHEM_DBG_I .and. i >= CHEM_DBG_I) .and. &
  98 !           (j <= CHEM_DBG_J .and. j >= CHEM_DBG_J) .and. &
  99 !           (k <= CHEM_DBG_K .and. k >= CHEM_DBG_K)  ) then
 100 !          print*
 101 !          print*,"Converted emissions for CBM4:"
 102 !          print*,"e_csl=",emis_ant(i,k,j,p_e_csl)*conv
 103 !          print*,"e_so2=",emis_ant(i,k,j,p_e_so2)*conv
 104 !          print*,"e_no=",emis_ant(i,k,j,p_e_no)*conv
 105 !          print*,"e_ald=",emis_ant(i,k,j,p_e_ald)*conv
 106 !          print*,"e_hcho=",emis_ant(i,k,j,p_e_hcho)*conv
 107 !          print*,"e_ora2=",emis_ant(i,k,j,p_e_ora2)*conv
 108 !          print*,"e_nh3=",emis_ant(i,k,j,p_e_nh3)*conv
 109 !          print*,"e_hc3=",emis_ant(i,k,j,p_e_hc3)*conv
 110 !          print*,"e_hc5=",emis_ant(i,k,j,p_e_hc5)*conv
 111 !          print*,"e_hc8=",emis_ant(i,k,j,p_e_hc8)*conv
 112 !          print*,"e_eth=",emis_ant(i,k,j,p_e_eth)*conv
 113 !          print*,"e_co=",emis_ant(i,k,j,p_e_co)*conv
 114 !          print*,"e_ol2=",emis_ant(i,k,j,p_e_ol2)*conv
 115 !          print*,"e_olt=",emis_ant(i,k,j,p_e_olt)*conv
 116 !          print*,"e_oli=",emis_ant(i,k,j,p_e_oli)*conv
 117 !          print*,"e_tol=",emis_ant(i,k,j,p_e_tol)*conv
 118 !          print*,"e_xyl=",emis_ant(i,k,j,p_e_xyl)*conv
 119 !          print*,"e_ket=",emis_ant(i,k,j,p_e_ket)*conv
 120 !       end if
 121 !#endif
 122
 123         chem(i,k,j,p_cres)  =  chem(i,k,j,p_cres)                       &
 124                          +emis_ant(i,k,j,p_e_csl)  * conv
 125         chem(i,k,j,p_no)    = chem(i,k,j,p_no)                          &
 126                          +emis_ant(i,k,j,p_e_no)   * conv
 127         chem(i,k,j,p_ald2)  = chem(i,k,j,p_ald2)                        &
 128                          +emis_ant(i,k,j,p_e_ald)  * conv
 129         chem(i,k,j,p_hcho)  = chem(i,k,j,p_hcho)                        &
 130                          +emis_ant(i,k,j,p_e_hcho) * conv
 131         chem(i,k,j,p_eth)   = chem(i,k,j,p_eth)                         &
 132                          +emis_ant(i,k,j,p_e_ol2)  * conv
 133         chem(i,k,j,p_co)    = chem(i,k,j,p_co)                          &
 134                          +emis_ant(i,k,j,p_e_co)   * conv
 135         chem(i,k,j,p_tol)   = chem(i,k,j,p_tol)                         &
 136                          +emis_ant(i,k,j,p_e_tol)  * conv
 137         chem(i,k,j,p_xyl)   = chem(i,k,j,p_xyl)                         &
 138                          +emis_ant(i,k,j,p_e_xyl)  * conv
 139
 140 ! when emissions input file is "radm2sorg" variety, calc par emissions as a
 141 !   combination of the anthropogenic emissions for radm2 primary voc species
 142         if ( (config_flags%emiss_inpt_opt == EMISS_INPT_DEFAULT) .or.   &
 143              (config_flags%emiss_inpt_opt == EMISS_INPT_PNNL_RS) ) then
 144             chem(i,k,j,p_par) = chem(i,k,j,p_par)             &
 145                 + conv*                                       &
 146                   ( 0.4*emis_ant(i,k,j,p_e_ald) + 2.9*emis_ant(i,k,j,p_e_hc3)       &
 147                   + 4.8*emis_ant(i,k,j,p_e_hc5) + 7.9*emis_ant(i,k,j,p_e_hc8)       &
 148                   + 0.9*emis_ant(i,k,j,p_e_ket) + 2.8*emis_ant(i,k,j,p_e_oli)       &
 149                   + 1.8*emis_ant(i,k,j,p_e_olt) + 1.0*emis_ant(i,k,j,p_e_ora2) )
 150             chem(i,k,j,p_ole)  = chem(i,k,j,p_ole)                         &
 151              +(emis_ant(i,k,j,p_e_oli)+emis_ant(i,k,j,p_e_olt))*conv
 152
 153 ! when emissions input file is "cbm4mosaic" variety,
 154 !   the par emissions are read into e_hc5
 155 !   and there are emissions for other species
 156         elseif(config_flags%emiss_inpt_opt == EMISS_INPT_CB4) then
 157             chem(i,k,j,p_par)  = chem(i,k,j,p_par)             &
 158                 + conv*emis_ant(i,k,j,p_e_hc5)
 159             chem(i,k,j,p_no2)  = chem(i,k,j,p_no2)             &
 160                 + conv*emis_ant(i,k,j,p_e_no2)
 161             chem(i,k,j,p_ole)  = chem(i,k,j,p_ole)             &
 162                  +emis_ant(i,k,j,p_e_oli)*conv
 163         end if
 164
 165       END DO
 166  100  continue
 167
 168
 169 !! do mass check final calc
 170 !      if (cbm4_addemiss_masscheck > 0) call addemiss_masscheck(               &
 171 !               id, config_flags, 2, 'cbm4_addemiss',                          &
 172 !               dtstep, efact1, dz8w, chem, chem_sum,                          &
 173 !               ids,ide, jds,jde, kds,kde,                                     &
 174 !               ims,ime, jms,jme, kms,kme,                                     &
 175 !               its,ite, jts,jte, kts,kte,                                     &
 176 !               21,                                                            &
 177 !               emis_ant(ims,kms,jms,p_e_so2),emis_ant(ims,kms,jms,p_e_no),    &
 178 !               emis_ant(ims,kms,jms,p_e_co),emis_ant(ims,kms,jms,p_e_eth),    &
 179 !               emis_ant(ims,kms,jms,p_e_hc3),emis_ant(ims,kms,jms,p_e_hc5),   &
 180 !               emis_ant(ims,kms,jms,p_e_hc8),emis_ant(ims,kms,jms,p_e_xyl),   &
 181 !               emis_ant(ims,kms,jms,p_e_ol2),emis_ant(ims,kms,jms,p_e_olt),   &
 182 !               emis_ant(ims,kms,jms,p_e_oli),emis_ant(ims,kms,jms,p_e_tol),   &
 183 !               emis_ant(ims,kms,jms,p_e_csl),emis_ant(ims,kms,jms,p_e_hcho),  &
 184 !               emis_ant(ims,kms,jms,p_e_ald),emis_ant(ims,kms,jms,p_e_ket),   &
 185 !               emis_ant(ims,kms,jms,p_e_ora2),emis_ant(ims,kms,jms,p_e_nh3),  &
 186 !               emis_ant(ims,kms,jms,p_e_no2),emis_ant(ims,kms,jms,p_e_ch3oh), &
 187 !               emis_ant(ims,kms,jms,p_e_c2h5oh))
 188
 189
 190    END subroutine cbm4_addemiss_anthro
 191
 192
 193
 194 !----------------------------------------------------------------------
 195   subroutine cbm4_addemiss_bio( id, dtstep, dz8w, config_flags,       &
 196         rho_phy, chem, e_bio, ne_area, e_iso,                         &
 197         ids,ide, jds,jde, kds,kde,                                    &
 198         ims,ime, jms,jme, kms,kme,                                    &
 199         its,ite, jts,jte, kts,kte                                     )
 200
 201   USE module_configure
 202   USE module_state_description
 203   USE module_data_radm2
 204   USE module_aerosols_sorgam
 205
 206   IMPLICIT NONE
 207
 208 ! subr arguments
 209    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 210
 211    INTEGER,      INTENT(IN   ) :: id, ne_area,                             &
 212                                   ids,ide, jds,jde, kds,kde,               &
 213                                   ims,ime, jms,jme, kms,kme,               &
 214                                   its,ite, jts,jte, kts,kte
 215
 216    REAL,      INTENT(IN   ) ::    dtstep
 217
 218    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
 219          INTENT(INOUT ) ::        chem
 220
 221    REAL, DIMENSION( ims:ime, jms:jme,ne_area ),                            &
 222          INTENT(IN ) ::           e_bio
 223
 224    REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ),            &
 225          INTENT(IN ) ::           e_iso
 226
 227    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,               &
 228           INTENT(IN   ) ::        dz8w, rho_phy
 229
 230
 231 ! local variables
 232    integer i,j,k,n
 233    real, parameter :: efact1 = 1.0/60.0
 234    double precision :: chem_sum(num_chem)
 235
 236
 237 !
 238 ! apply gunther online biogenic gas emissions when bio_emiss_opt == GUNTHER1
 239 !
 240    if (config_flags%bio_emiss_opt == GUNTHER1) then
 241
 242 !      if (cbm4_addemiss_masscheck > 0) call addemiss_masscheck(         &
 243 !               id, config_flags, 1, 'cbm4_addemiss_bioaa',              &
 244 !               dtstep, efact1, dz8w, chem, chem_sum,                    &
 245 !               ids,ide, jds,jde, kds,kde,                               &
 246 !               ims,ime, jms,jme, kms,kme,                               &
 247 !               its,ite, jts,jte, kts,kte,                               &
 248 !               13,                                                      &
 249 !               e_bio(ims,jms,lald),  e_bio(ims,jms,lhc3),               &
 250 !               e_bio(ims,jms,lhc5),  e_bio(ims,jms,lhc8),               &
 251 !               e_bio(ims,jms,lhcho), e_bio(ims,jms,liso),               &
 252 !               e_bio(ims,jms,lket),  e_bio(ims,jms,lno),                &
 253 !               e_bio(ims,jms,loli),  e_bio(ims,jms,lolt),               &
 254 !               e_bio(ims,jms,lora1), e_bio(ims,jms,lora2),              &
 255 !               e_bio(ims,jms,lxyl),                                     &
 256 !               e_bio(ims,jms,lxyl),  e_bio(ims,jms,lxyl),               &
 257 !               e_bio(ims,jms,lxyl),  e_bio(ims,jms,lxyl),               &
 258 !               e_bio(ims,jms,lxyl),  e_bio(ims,jms,lxyl),               &
 259 !               e_bio(ims,jms,lxyl),  e_bio(ims,jms,lxyl)                )
 260
 261       do j=jts,jte
 262       do i=its,ite
 263         chem(i,kts,j,p_so2) = chem(i,kts,j,p_so2)    &
 264                           + e_bio(i,j,lso2)/(dz8w(i,kts,j)*60.)*dtstep
 265         chem(i,kts,j,p_sulf) = chem(i,kts,j,p_sulf)    &
 266                           + e_bio(i,j,lsulf)/(dz8w(i,kts,j)*60.)*dtstep
 267         chem(i,kts,j,p_no2) = chem(i,kts,j,p_no2)    &
 268                           + e_bio(i,j,lno2)/(dz8w(i,kts,j)*60.)*dtstep
 269         chem(i,kts,j,p_no) = chem(i,kts,j,p_no)    &
 270                           + e_bio(i,j,lno)/(dz8w(i,kts,j)*60.)*dtstep
 271         chem(i,kts,j,p_o3) = chem(i,kts,j,p_o3)    &
 272                           + e_bio(i,j,lo3)/(dz8w(i,kts,j)*60.)*dtstep
 273         chem(i,kts,j,p_hno3) = chem(i,kts,j,p_hno3)    &
 274                           + e_bio(i,j,lhno3)/(dz8w(i,kts,j)*60.)*dtstep
 275         chem(i,kts,j,p_h2o2) = chem(i,kts,j,p_h2o2)    &
 276                           + e_bio(i,j,lh2o2)/(dz8w(i,kts,j)*60.)*dtstep
 277         chem(i,kts,j,p_ald2) = chem(i,kts,j,p_ald2)    &
 278                           + e_bio(i,j,lald)/(dz8w(i,kts,j)*60.)*dtstep
 279         chem(i,kts,j,p_hcho) = chem(i,kts,j,p_hcho)    &
 280                           + e_bio(i,j,lhcho)/(dz8w(i,kts,j)*60.)*dtstep
 281         chem(i,kts,j,p_no2) = chem(i,kts,j,p_no2)    &
 282                           + e_bio(i,j,lno2)/(dz8w(i,kts,j)*60.)*dtstep
 283         chem(i,kts,j,p_pan) = chem(i,kts,j,p_pan)    &
 284                           + e_bio(i,j,lpan)/(dz8w(i,kts,j)*60.)*dtstep
 285         chem(i,kts,j,p_co) = chem(i,kts,j,p_co)    &
 286                           + e_bio(i,j,lco)/(dz8w(i,kts,j)*60.)*dtstep
 287         chem(i,kts,j,p_eth) = chem(i,kts,j,p_eth)    &
 288                           + e_bio(i,j,lol2)/(dz8w(i,kts,j)*60.)*dtstep
 289         chem(i,kts,j,p_ole) = chem(i,kts,j,p_ole)    &
 290                           + (e_bio(i,j,lolt)+ e_bio(i,j,loli))  &
 291                           /(dz8w(i,kts,j)*60.)*dtstep
 292         chem(i,kts,j,p_tol) = chem(i,kts,j,p_tol)    &
 293                           + e_bio(i,j,ltol)/(dz8w(i,kts,j)*60.)*dtstep
 294         chem(i,kts,j,p_xyl) = chem(i,kts,j,p_xyl)    &
 295                           + e_bio(i,j,lxyl)/(dz8w(i,kts,j)*60.)*dtstep
 296         chem(i,kts,j,p_onit) = chem(i,kts,j,p_onit)    &
 297                           + e_bio(i,j,lonit)/(dz8w(i,kts,j)*60.)*dtstep
 298         chem(i,kts,j,p_csl) = chem(i,kts,j,p_csl)    &
 299                           + e_bio(i,j,lcsl)/(dz8w(i,kts,j)*60.)*dtstep
 300         chem(i,kts,j,p_iso) = chem(i,kts,j,p_iso)    &
 301                           + e_bio(i,j,liso)/(dz8w(i,kts,j)*60.)*dtstep
 302       end do
 303       end do
 304
 305 ! calc par emissions as a combination of the biogenic emissions
 306 ! for radm2 primary voc species
 307       do j = jts, jte
 308       do i = its, ite
 309          chem(i,kts,j,p_par)  =  chem(i,kts,j,p_par)               &
 310              + (dtstep/(dz8w(i,kts,j)*60.))*                       &
 311                ( 0.4*e_bio(i,j,lald) + 2.9*e_bio(i,j,lhc3)         &
 312                + 4.8*e_bio(i,j,lhc5) + 7.9*e_bio(i,j,lhc8)         &
 313                + 0.9*e_bio(i,j,lket) + 2.8*e_bio(i,j,loli)         &
 314                + 1.8*e_bio(i,j,lolt) + 1.0*e_bio(i,j,lora2)        )
 315       end do
 316       end do
 317
 318 !      if (cbm4_addemiss_masscheck > 0) call addemiss_masscheck(         &
 319 !               id, config_flags, 2, 'cbm4_addemiss_bioaa',              &
 320 !               dtstep, efact1, dz8w, chem, chem_sum,                    &
 321 !               ids,ide, jds,jde, kds,kde,                               &
 322 !               ims,ime, jms,jme, kms,kme,                               &
 323 !               its,ite, jts,jte, kts,kte,                               &
 324 !               13,                                                      &
 325 !               e_bio(ims,jms,lald),  e_bio(ims,jms,lhc3),               &
 326 !               e_bio(ims,jms,lhc5),  e_bio(ims,jms,lhc8),               &
 327 !               e_bio(ims,jms,lhcho), e_bio(ims,jms,liso),               &
 328 !               e_bio(ims,jms,lket),  e_bio(ims,jms,lno),                &
 329 !               e_bio(ims,jms,loli),  e_bio(ims,jms,lolt),               &
 330 !               e_bio(ims,jms,lora1), e_bio(ims,jms,lora2),              &
 331 !               e_bio(ims,jms,lxyl),                                     &
 332 !               e_bio(ims,jms,lxyl),  e_bio(ims,jms,lxyl),               &
 333 !               e_bio(ims,jms,lxyl),  e_bio(ims,jms,lxyl),               &
 334 !               e_bio(ims,jms,lxyl),  e_bio(ims,jms,lxyl),               &
 335 !               e_bio(ims,jms,lxyl),  e_bio(ims,jms,lxyl)                )
 336 !
 337       end if
 338
 339
 340 !
 341 ! apply offline isoprene emissions when bio_emiss_opt /= GUNTHER1
 342 !
 343    if (config_flags%bio_emiss_opt /= GUNTHER1) then
 344
 345 !      if (cbm4_addemiss_masscheck > 0) call addemiss_masscheck(            &
 346 !               id, config_flags, 1, 'cbm4_addemiss_biobb',                 &
 347 !               dtstep, efact1, dz8w, chem, chem_sum,                       &
 348 !               ids,ide, jds,jde, kds,kde,                                  &
 349 !               ims,ime, jms,jme, kms,kme,                                  &
 350 !               its,ite, jts,jte, kts,kte,                                  &
 351 !               1,                                                          &
 352 !               e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,                  &
 353 !               e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,                  &
 354 !               e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso                   )
 355
 356       do j = jts, jte
 357       do k = kts, min(config_flags%kemit,kte)
 358       do i = its, ite
 359          chem(i,k,j,p_iso) = chem(i,k,j,p_iso) + e_iso(i,k,j)              &
 360               *4.828e-4/rho_phy(i,k,j)*(dtstep/(dz8w(i,k,j)*60.))
 361       end do
 362       end do
 363       end do
 364
 365 !      if (cbm4_addemiss_masscheck > 0) call addemiss_masscheck(            &
 366 !               id, config_flags, 2, 'cbm4_addemiss_biobb',                 &
 367 !               dtstep, efact1, dz8w, chem, chem_sum,                       &
 368 !               ids,ide, jds,jde, kds,kde,                                  &
 369 !               ims,ime, jms,jme, kms,kme,                                  &
 370 !               its,ite, jts,jte, kts,kte,                                  &
 371 !               1,                                                          &
 372 !               e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,                  &
 373 !               e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,                  &
 374 !               e_iso,e_iso,e_iso,e_iso,e_iso,e_iso,e_iso                   )
 375 !
 376    end if
 377
 378
 379    END subroutine cbm4_addemiss_bio
 380
 381
 382 END MODULE module_cbm4_addemiss
 383
 384
 385