! ************************************************************************************** ! This computer software was developed by Dr. Yang Zhang and her research group * ! at North Carolina State University (NCSU) with support from the NSF Career Award * ! No. Atm-0348819, and the Memorandum of Understanding between the * ! U.S. Environmental Protection Agency (EPA) and the U.S. Department of * ! Commerce's National Oceanic and Atmospheric Administration (NOAA) * ! and under agreement number DW13921548, and the U.S. EPA/Office of * ! Air Quality Planning & Standards via RTI International contract #4-321-0210288. * ! * ! NEITHER ANY COSPONSORS, NCSU, NOR ANY PERSON ACTING ON BEHALF * ! OF ANY OF THEM MAKES ANY WARRANTY OR REPRESENTATION * ! WHATSOEVER, EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR * ! THE USE OF THIS SOFTWARE. THIS SOFTWARE OR PART OF IT MAY BE * ! COPYRIGHTED AND IS PERMITTED BY ORIGINAL CODE DEVELOPERS FOR * ! NONPROFIT USE AND SUBJECTED TO RESTRICTIONS * ! * ! Contact information: * ! Dr. Yang Zhang * ! Principal Investigator * ! Department of Marine, Earth, and Atmospheric Sciences * ! North Carolina State University * ! Campus Box 8208 * ! Room 5151, Jordan Hall, 2800 Faucette Drive * ! Raleigh, NC 27695-8208, USA * ! Tel: (919) 515-9688 (Office) * ! Fax: (919) 515-7802 * ! E-Mail: yang_zhang@ncsu.edu * !*************************************************************************************** MODULE module_cb05_addemiss !*************************************************************************************** ! FUNCTION: ADD EMISSIONS FOR CB05 GAS SPECIES * ! PRECONDITION REQUIRED: use for CB05 gas-phase mechanism * ! RETURN VALUES: * ! KEY SUBROUTINES AND FUNCTIONS CALLED: None * ! REVISION HISTORY: * ! This code was based on module_cbmz_addemiss.F, developed by PNNL, 2005 * ! Revised by J.P. HUANG AND Y. ZHANG, Air Quality Forecasting Laboratory, * ! North Carolina State University, Raleigh, NC 27695 * ! for incorporation of CB05 into WRF/Chem under several projects * ! led by Dr. Yang Zhang (contact: (919) 515-9688, yang_zhang@ncsu.edu) * ! March-Oct., 2006 * ! Revised by Y. ZHANG, NCSU, clean up, May 6, 2007 * ! Revised by Ying Pan and Yang Zhang, NCSU, Nov. 2007-Nov. 2008 * ! to couple MADRID with CB05 gas-phase mechanism * ! Revised by Yang Zhang, Xiao-Ming Hu, and Ying Pan, NCSU, Sept.-Nov., 2008 * ! Code cleanup for NOAA WRF/Chem repository checkin * ! Revised by Ying Pan and Yang Zhang, NCSU, Sep. 2009 * ! to transfer code to WRF/Chem v3.1.1 * ! Revised by Kai Wang, NCSU, Oct 2014 to transfer to WRF/Chem v3.6.1 * ! * ! REFERENCES: * ! * !*************************************************************************************** !WRF:MODEL_LAYER:CHEMICS ! CONTAINS ! ! currently this only adds in the emissions... ! this may be done differently for different chemical mechanisms ! in the future. aerosols are already added somewhere else.... ! subroutine cb05_addemiss_anthro( id, dtstep, dz8w, config_flags, & rho_phy, chem, emis_ant, & ids,ide, jds,jde, kds, kde, & ims,ime, jms,jme, kms, kme, & its,ite, jts,jte, kts, kte ) !---------------------------------------------------------------------- USE module_configure USE module_state_description USE module_data_radm2 IMPLICIT NONE ! .. Parameters .. TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags INTEGER, INTENT(IN ) :: id, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte REAL, INTENT(IN ) :: & dtstep ! trace species mixing ratios (gases=ppm) REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & INTENT(INOUT ) :: chem ! ! emissions arrays ! ! REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme,num_emis_ant),& INTENT(IN ) :: & emis_ant ! layer thickness (m) REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , & INTENT(IN ) :: dz8w, rho_phy ! local variables integer i,j,k real, parameter :: efact1 = 1.0/60.0 real :: conv double precision :: chem_sum(num_chem) !--- deposition and emissions stuff ! ! .. Intrinsic Functions .. call wrf_debug(15,'cb05_addemiss_anthro') ! ! add emissions ! do 100 j=jts,jte do 100 i=its,ite DO k=kts,min(config_flags%kemit,kte) !v1 units: conv = dtstep/(dz8w(i,k,j)*60.) !v2 units: conv = 4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.) #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K)) if( (i <= CHEM_DBG_I .and. i >= CHEM_DBG_I) .and. & (j <= CHEM_DBG_J .and. j >= CHEM_DBG_J) .and. & (k <= CHEM_DBG_K .and. k >= CHEM_DBG_K) ) then print* print*,"Converted emissions for CB05:" end if #endif chem(i,k,j,p_no2) = chem(i,k,j,p_no2) & + emis_ant(i,k,j,p_e_no2)*conv chem(i,k,j,p_xyl) = chem(i,k,j,p_xyl) & + emis_ant(i,k,j,p_e_xyl)*conv chem(i,k,j,p_tol) = chem(i,k,j,p_tol) & + emis_ant(i,k,j,p_e_tol)*conv chem(i,k,j,p_so2) = chem(i,k,j,p_so2) & + emis_ant(i,k,j,p_e_so2)*conv chem(i,k,j,p_no) = chem(i,k,j,p_no) & + emis_ant(i,k,j,p_e_no)*conv chem(i,k,j,p_nh3) = chem(i,k,j,p_nh3) & + emis_ant(i,k,j,p_e_nh3)*conv chem(i,k,j,p_hcl) = chem(i,k,j,p_hcl) & + emis_ant(i,k,j,p_e_hcl)*conv chem(i,k,j,p_co) = chem(i,k,j,p_co) & + emis_ant(i,k,j,p_e_co)*conv chem(i,k,j,p_aldx) = chem(i,k,j,p_aldx) & + emis_ant(i,k,j,p_e_aldx)*conv ! when biogenic emissions are off, terpene emissions are read from offline if (config_flags%bio_emiss_opt == 0) then chem(i,k,j,p_terp) = chem(i,k,j,p_terp) & + emis_ant(i,k,j,p_e_terp)*conv end if ! when emissions inventory is based on RADM2 speciation, which requires emiss_opt = 14 ! with emiss_inpt_opt = 102 if ( (config_flags%emiss_opt == 14) ) then chem(i,k,j,p_par) = chem(i,k,j,p_par) & + conv* & ( 2.9*emis_ant(i,k,j,p_e_hc3) & + 4.8*emis_ant(i,k,j,p_e_hc5) + 7.9*emis_ant(i,k,j,p_e_hc8) & + 0.9*emis_ant(i,k,j,p_e_ket) ) chem(i,k,j,p_aacd) = chem(i,k,j,p_aacd) & + emis_ant(i,k,j,p_e_ora2)*conv chem(i,k,j,p_ole) = chem(i,k,j,p_ole) & + emis_ant(i,k,j,p_e_olt)*conv chem(i,k,j,p_iole) = chem(i,k,j,p_iole) & + emis_ant(i,k,j,p_e_oli)*conv chem(i,k,j,p_eth) = chem(i,k,j,p_eth) & + emis_ant(i,k,j,p_e_ol2)*conv chem(i,k,j,p_form) = chem(i,k,j,p_form) & + emis_ant(i,k,j,p_e_hcho)*conv chem(i,k,j,p_etha) = chem(i,k,j,p_etha) & + emis_ant(i,k,j,p_e_eth)*conv chem(i,k,j,p_cres) = chem(i,k,j,p_cres) & + emis_ant(i,k,j,p_e_csl)*conv chem(i,k,j,p_meoh) = chem(i,k,j,p_meoh) & + emis_ant(i,k,j,p_e_ch3oh)*conv chem(i,k,j,p_etoh) = chem(i,k,j,p_etoh) & + emis_ant(i,k,j,p_e_c2h5oh)*conv chem(i,k,j,p_ald2) = chem(i,k,j,p_ald2) & + emis_ant(i,k,j,p_e_ald)*conv ! when biogenic emissions are off, isoprene emissions are read from offline if (config_flags%bio_emiss_opt == 0) then chem(i,k,j,p_isop) = chem(i,k,j,p_isop) & + emis_ant(i,k,j,p_e_iso)*conv end if ! when emissions inventory is based on CBM speciation, which requires emiss_opt = 15 ! with emiss_inpt_opt = 101 else chem(i,k,j,p_par) = chem(i,k,j,p_par) & + conv*emis_ant(i,k,j,p_e_par) chem(i,k,j,p_ole) = chem(i,k,j,p_ole) & + emis_ant(i,k,j,p_e_ole)*conv chem(i,k,j,p_iole) = chem(i,k,j,p_iole) & + emis_ant(i,k,j,p_e_iole)*conv chem(i,k,j,p_eth) = chem(i,k,j,p_eth) & + emis_ant(i,k,j,p_e_eth)*conv chem(i,k,j,p_form) = chem(i,k,j,p_form) & + emis_ant(i,k,j,p_e_form)*conv chem(i,k,j,p_etha) = chem(i,k,j,p_etha) & + emis_ant(i,k,j,p_e_etha)*conv chem(i,k,j,p_cres) = chem(i,k,j,p_cres) & + emis_ant(i,k,j,p_e_cres)*conv & + emis_ant(i,k,j,p_e_phen)*conv chem(i,k,j,p_meoh) = chem(i,k,j,p_meoh) & + emis_ant(i,k,j,p_e_meoh)*conv chem(i,k,j,p_etoh) = chem(i,k,j,p_etoh) & + emis_ant(i,k,j,p_e_etoh)*conv chem(i,k,j,p_ald2) = chem(i,k,j,p_ald2) & + emis_ant(i,k,j,p_e_ald2)*conv chem(i,k,j,p_meo2) = chem(i,k,j,p_meo2) & + emis_ant(i,k,j,p_e_meo2)*conv chem(i,k,j,p_sulf) = chem(i,k,j,p_sulf) & + emis_ant(i,k,j,p_e_psulf)*conv chem(i,k,j,p_mgly) = chem(i,k,j,p_mgly) & + emis_ant(i,k,j,p_e_mgly)*conv chem(i,k,j,p_facd) = chem(i,k,j,p_facd) & + emis_ant(i,k,j,p_e_hcooh)*conv chem(i,k,j,p_aacd) = chem(i,k,j,p_aacd) & + emis_ant(i,k,j,p_e_ccooh)*conv chem(i,k,j,p_ispd) = chem(i,k,j,p_ispd) & + emis_ant(i,k,j,p_e_iprod)*conv ! when biogenic emissions are off, isoprene emissions are read from offline if (config_flags%bio_emiss_opt == 0) then chem(i,k,j,p_isop) = chem(i,k,j,p_isop) & + emis_ant(i,k,j,p_e_isop)*conv end if end if END DO 100 continue END subroutine cb05_addemiss_anthro !---------------------------------------------------------------------- subroutine cb05_addemiss_bio( id, dtstep, dz8w, config_flags, & rho_phy, chem, e_bio, ne_area, e_iso, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) USE module_configure USE module_state_description USE module_data_radm2 USE module_aerosols_sorgam IMPLICIT NONE ! subr arguments TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags INTEGER, INTENT(IN ) :: id, ne_area, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte REAL, INTENT(IN ) :: dtstep REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & INTENT(INOUT ) :: chem REAL, DIMENSION( ims:ime, jms:jme,ne_area ), & INTENT(IN ) :: e_bio REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ), & INTENT(IN ) :: e_iso REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , & INTENT(IN ) :: dz8w, rho_phy ! local variables integer i,j,k,n real, parameter :: efact1 = 1.0/60.0 double precision :: chem_sum(num_chem) ! ! apply gunther online biogenic gas emissions when bio_emiss_opt == GUNTHER1 ! only incoporated isoprene and terpene at the current stage for CB05 ! if (config_flags%bio_emiss_opt == GUNTHER1) then do j=jts,jte do i=its,ite chem(i,kts,j,p_isop) = chem(i,kts,j,p_isop) & + e_bio(i,j,liso)/(dz8w(i,kts,j)*60.)*dtstep ! tpan is used to be the place holder of terpene in Gunther scheme chem(i,kts,j,p_terp) = chem(i,kts,j,p_terp) & + e_bio(i,j,ltpan)/(dz8w(i,kts,j)*60.)*dtstep end do end do end if END subroutine cb05_addemiss_bio ! END MODULE module_cb05_addemiss