wrfv2_fire/chem/emissions_driver.F

   1 !WRF:MODEL_LAYER:CHEMICS
   2 !
   3     subroutine emissions_driver(id,ktau,dtstep,DX,                         &
   4          config_flags, stepbioe,gmt,julday,alt,t_phy,moist,p8w,t8w,        &
   5          e_bio,p_phy,chem,rho_phy,dz8w,ne_area,                            &
   6          e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt,  &
   7          e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_pm25,e_pm10,e_nh3,  &
   8          e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj,e_no2,e_ch3oh,          &
   9          e_c2h5oh,e_so4j,e_so4c,e_no3j,e_no3c,e_orgc,e_ecc,                &
  10          u10,v10,ivgtyp,gsw,vegfra,rmol,ust,znt,                           &
  11          xland,xlat,xlong,z_at_w,                                          &
  12          sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl,                &
  13          sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald,                &
  14          sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr,                &
  15          noag_grow,noag_nongrow,nononag,slai,                              &
  16          ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl,                     &
  17          ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald,                     &
  18          ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no,             &
  19          numgas,                                                           &
  20          ids,ide, jds,jde, kds,kde,                                        &
  21          ims,ime, jms,jme, kms,kme,                                        &
  22          its,ite, jts,jte, kts,kte                                         )
  23 !----------------------------------------------------------------------
  24   USE module_configure
  25   USE module_state_description
  26   USE module_data_radm2
  27   USE module_emissions_anthropogenics
  28   USE module_bioemi_simple
  29   USE module_bioemi_beis311
  30   USE module_cbmz_addemiss
  31   USE module_mosaic_addemiss
  32   IMPLICIT NONE
  33
  34    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  35
  36    INTEGER,      INTENT(IN   ) :: id,julday, ne_area,                      &
  37                                   numgas,                                  &
  38                                   ids,ide, jds,jde, kds,kde,               &
  39                                   ims,ime, jms,jme, kms,kme,               &
  40                                   its,ite, jts,jte, kts,kte
  41    INTEGER,      INTENT(IN   ) ::                                          &
  42                                   ktau,stepbioe
  43    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ),                &
  44          INTENT(IN ) ::                                   moist
  45    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
  46          INTENT(INOUT ) ::                                   chem
  47    REAL, DIMENSION( ims:ime, jms:jme, ne_area ),                           &
  48          INTENT(INOUT ) ::                               e_bio
  49 !   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                           &
  50    REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ),            &
  51          INTENT(IN ) ::                                                    &
  52           e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,       &
  53           e_olt,e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_pm25,        &
  54           e_pm10,e_nh3,e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj,e_no2,    &
  55           e_ch3oh,e_c2h5oh,e_so4j,e_so4c,e_no3j,e_no3c,e_orgc,e_ecc
  56 !
  57 !
  58 !
  59    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,               &
  60           INTENT(IN   ) ::                                                 &
  61                                                         alt,               &
  62                                                       t_phy,               &
  63                                                       p_phy,               &
  64                                                       dz8w,                &
  65                                               t8w,p8w,z_at_w ,             &
  66                                                     rho_phy
  67    INTEGER,DIMENSION( ims:ime , jms:jme )                  ,               &
  68           INTENT(IN   ) ::                                                 &
  69                                                      ivgtyp
  70    REAL,  DIMENSION( ims:ime , jms:jme )                   ,               &
  71           INTENT(IN   ) ::                                                 &
  72                                                      u10,                  &
  73                                                      v10,                  &
  74                                                      gsw,                  &
  75                                                   vegfra,                  &
  76                                                      rmol,                 &
  77                                                      ust,                  &
  78                                                      xland,                &
  79                                                      xlat,                 &
  80                                                      xlong,                &
  81                                                      znt
  82    REAL,  DIMENSION( ims:ime , jms:jme )                   ,               &
  83           INTENT(INOUT   ) ::                                                 &
  84                sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl,      &
  85                sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald,      &
  86                sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr,      &
  87                noag_grow,noag_nongrow,nononag,slai,                    &
  88                ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl,           &
  89                ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald,           &
  90                ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no
  91
  92       REAL,      INTENT(IN   ) ::                                          &
  93                              dtstep,dx,gmt
  94 !
  95 ! Local variables...
  96 !
  97       INTEGER :: i, j, k, ksub
  98       REAL :: conv
  99       CHARACTER (LEN=80) :: message
 100
 101 ! ..
 102 ! ..
 103 ! .. Intrinsic Functions ..
 104       INTRINSIC max, min
 105 ! ..
 106     ksub=1
 107 #if ( NMM_CORE == 1 )
 108     ksub=0
 109 #endif
 110     bioem_select: SELECT CASE(config_flags%bio_emiss_opt)
 111      CASE (GUNTHER1)
 112      CALL wrf_debug(15,'biogenic emissions: calling Gunther1')
 113        if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0)then
 114          call bio_emissions(id,ktau,dtstep,DX,config_flags,                &
 115                gmt,julday,t_phy,moist,p8w,t8w,                             &
 116                e_bio,p_phy,chem,rho_phy,dz8w,ne_area,                      &
 117                ivgtyp,gsw,vegfra,rmol,ust,znt,xlat,xlong,z_at_w,           &
 118                numgas-1,                                                   &
 119                ids,ide, jds,jde, kds,kde,                                  &
 120                ims,ime, jms,jme, kms,kme,                                  &
 121                its,ite, jts,jte, kts,kte                                   )
 122        endif
 123      CASE (BEIS311)
 124        if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0)then
 125          if(config_flags%chem_opt > RACMSORG .AND. config_flags%chem_opt < 100  ) then !<100: kpp mechs, e.g. RACMSORG_KPP
 126              CALL wrf_error_fatal( &
 127               "emissions_driver: beis3.1.1 biogenic emis. not currently implemented for CBMZ")
 128          endif
 129          CALL wrf_debug(15,'biogenic emissions: calling beis3.1.1')
 130          call bio_emissions_beis311(id,config_flags,ktau,dtstep,       &
 131                julday,gmt,xlat,xlong,t_phy,p_phy,gsw,                  &
 132                sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl,      &
 133                sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald,      &
 134                sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr,      &
 135                noag_grow,noag_nongrow,nononag,slai,                    &
 136                ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl,           &
 137                ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald,           &
 138                ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no,   &
 139                ids,ide, jds,jde, kds,kde,                              &
 140                ims,ime, jms,jme, kms,kme,                              &
 141                its,ite, jts,jte, kts,kte                               )
 142        endif
 143
 144      CASE DEFAULT
 145        if(ktau.eq.1.or.mod(ktau,stepbioe).eq.0) &
 146             e_bio(its:ite,jts:jte,1:ne_area) = 0.
 147 !wig: May need to zero out all ebio_xxx arrays too if they are incorporated
 148 !     into CBMZ/MOSAIC.
 149
 150     END SELECT bioem_select
 151
 152     gas_addemiss_select: SELECT CASE(config_flags%chem_opt)
 153     CASE (RADM2, RADM2_KPP, RADM2SORG, RACM, RACMSORG,RACM_KPP,RACMSORG_KPP, RACM_MIM_KPP,RADM2SORG_KPP)
 154        IF(config_flags%kemit .GT. kte-ksub) THEN
 155          message = ' EMISSIONS_DRIVER: KEMIT > KME '
 156          k=config_flags%kemit
 157          write(0,*)kme,kte-ksub,k
 158          CALL WRF_ERROR_FATAL (message)
 159        ENDIF
 160        call wrf_debug(15,'emissions_driver calling add_anthropogenics')
 161        call add_anthropogenics(id,dtstep,dz8w,config_flags,rho_phy,chem,&
 162             e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,        &
 163             e_ol2,e_olt,e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,    &
 164             e_pm25,e_pm10,e_nh3,                                        &
 165             ids,ide, jds,jde, kds,kde,                                  &
 166             ims,ime, jms,jme, kms,kme,                                  &
 167             its,ite, jts,jte, kts,kte                                   )
 168        call wrf_debug(15,'emissions_driver calling add_biogenics')
 169        call add_biogenics(id,dtstep,dz8w,config_flags, rho_phy,chem,    &
 170             e_bio,ne_area,                                              &
 171             ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl,               &
 172             ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald,               &
 173             ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no,       &
 174             ids,ide, jds,jde, kds,kde,                                  &
 175             ims,ime, jms,jme, kms,kme,                                  &
 176             its,ite, jts,jte, kts,kte                                   )
 177
 178     CASE (CBMZ, CBMZ_BB, CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
 179        IF(config_flags%kemit .GT. kte-ksub) THEN
 180          message = ' EMISSIONS_DRIVER: KEMIT > KME '
 181          CALL WRF_ERROR_FATAL (message)
 182        ENDIF
 183        call wrf_debug(15,'emissions_driver calling cbmz_addemiss_anthro')
 184        call cbmz_addemiss_anthro( id, dtstep, dz8w, config_flags,        &
 185             rho_phy, chem,                                               &
 186             e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt,   &
 187             e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_nh3,           &
 188             e_no2,e_ch3oh,e_c2h5oh,                                      &
 189             ids,ide, jds,jde, kds,kde,                                   &
 190             ims,ime, jms,jme, kms,kme,                                   &
 191             its,ite, jts,jte, kts,kte                                    )
 192        call wrf_debug(15,'emissions_driver calling cbmz_addemiss_bio')
 193        call cbmz_addemiss_bio( id, dtstep, dz8w, config_flags,           &
 194             rho_phy, chem, e_bio, ne_area, e_iso,                        &
 195             numgas,                                                      &
 196             ids,ide, jds,jde, kds,kde,                                   &
 197             ims,ime, jms,jme, kms,kme,                                   &
 198             its,ite, jts,jte, kts,kte                                    )
 199
 200     CASE (CHEM_TRACER)
 201        do j=jts,jte
 202           do i=its,ite
 203              do k=kts,min(config_flags%kemit,kte-ksub)
 204                 conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
 205                 chem(i,k,j,p_so2)  = chem(i,k,j,p_so2)                   &
 206                      +e_so2(i,k,j)*conv
 207                 chem(i,k,j,p_co)  = chem(i,k,j,p_co)                     &
 208                      +e_co(i,k,j)*conv
 209                 chem(i,k,j,p_no)  = chem(i,k,j,p_no)                     &
 210                      +e_co(i,k,j)*conv
 211                 chem(i,k,j,p_ald)  = chem(i,k,j,p_ald)                   &
 212                      +e_co(i,k,j)*conv
 213                 chem(i,k,j,p_hcho)  = chem(i,k,j,p_hcho)                 &
 214                      +e_co(i,k,j)*conv
 215                 chem(i,k,j,p_ora2)  = chem(i,k,j,p_ora2)                 &
 216                      +e_co(i,k,j)*conv
 217              end do
 218           end do
 219        end do
 220
 221     CASE DEFAULT
 222        call wrf_debug(15,'emissions_driver NOT CALLING gas add_... routines')
 223
 224     END SELECT gas_addemiss_select
 225
 226     aer_addemiss_select: SELECT CASE(config_flags%chem_opt)
 227
 228     CASE (CBMZ_MOSAIC_4BIN, CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ)
 229        call wrf_debug(15,'emissions_driver calling mosaic_addemiss')
 230        call mosaic_addemiss( id, dtstep, u10, v10, alt, dz8w, xland,     &
 231             config_flags, chem,                                          &
 232             e_pm10,e_pm25,e_pm25i,e_pm25j,e_eci,e_ecj,e_orgi,e_orgj,     &
 233             e_so4j,e_so4c,e_no3j,e_no3c,e_orgc,e_ecc,                    &
 234             ids,ide, jds,jde, kds,kde,                                   &
 235             ims,ime, jms,jme, kms,kme,                                   &
 236             its,ite, jts,jte, kts,kte                                    )
 237
 238     CASE DEFAULT
 239        call wrf_debug(15,'emissions_driver NOT CALLING aer add_... routines')
 240
 241     END SELECT aer_addemiss_select
 242
 243     END subroutine emissions_driver