module CNFireEmissionsMod !----------------------------------------------------------------------- ! !DESCRIPTION: ! Gathers carbon emissions from fire sources to be sent to CAM-Chem via ! the coupler .... ! Created by F. Vitt, and revised by F. Li ! !USES: use shr_kind_mod, only : r8 => shr_kind_r8 use abortutils, only : endrun use PatchType, only : patch use decompMod, only : bounds_type use shr_fire_emis_mod, only : shr_fire_emis_comps_n, shr_fire_emis_comp_t, shr_fire_emis_linkedlist use shr_fire_emis_mod, only : shr_fire_emis_mechcomps_n, shr_fire_emis_mechcomps ! implicit none private ! ! !PUBLIC MEMBER FUNCTIONS: public :: CNFireEmisUpdate ! ! !PRIVATE TYPES: type, private :: emis_t real(r8), pointer :: emis(:) end type emis_t ! ! !PUBLIC TYPES: type, public :: fireemis_type real(r8), pointer, public :: fireflx_patch(:,:) ! carbon flux from fire sources (kg/m2/sec) real(r8), pointer, public :: ztop_patch(:) ! height of the smoke plume (meters) type(emis_t), pointer, private :: comp(:) ! fire emissions component (corresponds to emis factors table input file) type(emis_t), pointer, private :: mech(:) ! cam-chem mechism species emissions type(emis_t), private :: totfire ! sum of all species emissions contains procedure, public :: Init procedure, private :: InitAllocate procedure, private :: InitHistory end type fireemis_type !------------------------------------------------------------------------ contains !----------------------------------------------------------------------- subroutine Init(this, bounds) use shr_fire_emis_mod, only : shr_fire_emis_factors_file use FireEmisFactorsMod, only : fire_emis_factors_init, fire_emis_factors_get use clm_varpar, only : numpft implicit none ! args class(fireemis_type) :: this type(bounds_type), intent(in) :: bounds ! local vars integer :: nmech, nemis real(r8) :: factors(numpft) real(r8) :: molec_wght type(shr_fire_emis_comp_t), pointer :: emis_cmp if ( shr_fire_emis_mechcomps_n < 1) return call fire_emis_factors_init( shr_fire_emis_factors_file ) emis_cmp => shr_fire_emis_linkedlist do while(associated(emis_cmp)) allocate(emis_cmp%emis_factors(numpft)) call fire_emis_factors_get( trim(emis_cmp%name), factors, molec_wght ) emis_cmp%emis_factors = factors*1.e-3_r8 ! convert g/kg dry fuel to kg/kg emis_cmp%molec_weight = molec_wght emis_cmp => emis_cmp%next_emiscomp enddo call this%InitAllocate(bounds) call this%InitHistory(bounds) end subroutine Init !----------------------------------------------------------------------- subroutine InitAllocate(this, bounds) ! ! Allocate memory for module datatypes use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use clm_varcon , only : spval ! !ARGUMENTS: class(fireemis_type) :: this type(bounds_type), intent(in) :: bounds ! ! !LOCAL VARIABLES: integer :: beg, end, i !--------------------------------------------------------------------- beg = bounds%begp end = bounds%endp allocate(this%totfire%emis(beg:end)) this%totfire%emis(beg:end) = nan if (shr_fire_emis_mechcomps_n>0) then allocate(this%ztop_patch(beg:end)) this%ztop_patch(beg:end) = spval allocate(this%fireflx_patch(beg:end,shr_fire_emis_mechcomps_n)) this%fireflx_patch(beg:end,:) = spval allocate(this%mech(shr_fire_emis_mechcomps_n)) do i = 1, shr_fire_emis_mechcomps_n allocate(this%mech(i)%emis(beg:end)) this%mech(i)%emis(beg:end) = nan enddo endif if (shr_fire_emis_comps_n>0) then allocate(this%comp(shr_fire_emis_comps_n)) do i = 1, shr_fire_emis_comps_n allocate(this%comp(i)%emis(beg:end)) this%comp(i)%emis(beg:end) = nan enddo endif end subroutine InitAllocate !----------------------------------------------------------------------- subroutine InitHistory(this, bounds) use clm_varcon , only : spval use histFileMod , only : hist_addfld1d ! !ARGUMENTS: class(fireemis_type) :: this type(bounds_type), intent(in) :: bounds ! !LOCAL VARIABLES integer :: begp, endp integer :: imech, icomp type(shr_fire_emis_comp_t), pointer :: emis_cmp if (shr_fire_emis_mechcomps_n>0) then emis_cmp => shr_fire_emis_linkedlist ! loop over fire components emis_cmp_loop: do while(associated(emis_cmp)) icomp = emis_cmp%index call hist_addfld1d (fname='FireComp_'//trim(emis_cmp%name), units='kg/m2/sec', & avgflag='A', long_name='fire emissions flux of '//trim(emis_cmp%name), & ptr_patch=this%comp(icomp)%emis, default='inactive') emis_cmp => emis_cmp%next_emiscomp enddo emis_cmp_loop ! loop over atm chem mechanism species do imech = 1,shr_fire_emis_mechcomps_n call hist_addfld1d (fname='FireMech_'//trim(shr_fire_emis_mechcomps(imech)%name), units='kg/m2/sec', & avgflag='A', long_name='fire emissions flux of '//trim(shr_fire_emis_mechcomps(imech)%name), & ptr_patch=this%mech(imech)%emis, default='inactive') enddo call hist_addfld1d (fname='FireEmis_TOT', units='gC/m2/sec', & avgflag='A', long_name='Total fire emissions flux ', & ptr_patch=this%totfire%emis, default='inactive') call hist_addfld1d (fname='FireEmis_ZTOP', units='m', & avgflag='A', long_name='Top of vertical fire emissions distribution ', & ptr_patch=this%ztop_patch, default='inactive') endif end subroutine InitHistory !----------------------------------------------------------------------- subroutine CNFireEmisUpdate(bounds, num_soilp, filter_soilp, cnveg_cf_inst, cnveg_cs_inst, fireemis_inst ) use CNVegcarbonfluxType, only : cnveg_carbonflux_type use CNVegCarbonStateType, only : cnveg_carbonstate_type use clm_varpar, only : ndecomp_pools, nlevdecomp use clm_varcon, only : dzsoi_decomp !ARGUMENTS: type(bounds_type), intent(in) :: bounds integer, intent(in) :: num_soilp ! number of soil pfts in filter integer, intent(in) :: filter_soilp(:) ! filter for soil pfts type(cnveg_carbonflux_type), intent(in) :: cnveg_cf_inst type(cnveg_carbonstate_type),intent(in) :: cnveg_cs_inst type(fireemis_type), intent(inout) :: fireemis_inst !LOCAL VARIABLES: real(r8) :: fire_flux real(r8) :: fire_flux_lf real(r8) :: fire_flux_lf1 type(shr_fire_emis_comp_t), pointer :: emis_cmp real(r8) :: emis_flux(shr_fire_emis_comps_n) integer :: fp,p,g,c ! indices real(r8) :: epsilon ! emission factor [ug m-2 h-1] integer :: i, ii, icomp, imech, n_emis_comps, l, j if ( shr_fire_emis_mechcomps_n < 1) return associate( & fire_emis => fireemis_inst%fireflx_patch, & totfire => fireemis_inst%totfire, & mech => fireemis_inst%mech, & comp => fireemis_inst%comp, & ztop => fireemis_inst%ztop_patch & ) ! initialize to zero ... fire_emis(bounds%begp:bounds%endp,:) = 0._r8 totfire%emis(bounds%begp:bounds%endp) = 0._r8 ztop(bounds%begp:bounds%endp) = 0._r8 do i = 1, shr_fire_emis_mechcomps_n mech(i)%emis(bounds%begp:bounds%endp) = 0._r8 enddo do i = 1, shr_fire_emis_comps_n comp(i)%emis(bounds%begp:bounds%endp) = 0._r8 enddo ! Begin loop over points !_______________________________________________________________________________ do fp = 1,num_soilp p = filter_soilp(fp) g = patch%gridcell(p) c = patch%column(p) ! initialize EF epsilon=0._r8 emis_flux(:) = 0._r8 ! calculate fire emissions for non-bare ground PFTs if (patch%itype(p) > 0)then if(cnveg_cs_inst%totvegc_col(c) > 0._r8)then fire_flux_lf1=0._r8 do l = 1, ndecomp_pools do j = 1, nlevdecomp fire_flux_lf1 = fire_flux_lf1 + & cnveg_cf_inst%m_decomp_cpools_to_fire_vr_col(c,j,l)*dzsoi_decomp(j) enddo end do fire_flux_lf = fire_flux_lf1*cnveg_cs_inst%totvegc_patch(p)/cnveg_cs_inst%totvegc_col(c) else fire_flux_lf=0._r8 end if fire_flux = fire_flux_lf & + cnveg_cf_inst%m_leafc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from leafc + cnveg_cf_inst%m_leafc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from leafc_storage + cnveg_cf_inst%m_leafc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from leafc_xfer + cnveg_cf_inst%m_livestemc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livestemc + cnveg_cf_inst%m_livestemc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livestemc_storage + cnveg_cf_inst%m_livestemc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livestemc_xfer + cnveg_cf_inst%m_deadstemc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadstemc_xfer + cnveg_cf_inst%m_deadstemc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadstemc_storage + cnveg_cf_inst%m_deadstemc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadstemc_xfer + cnveg_cf_inst%m_frootc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from frootc + cnveg_cf_inst%m_frootc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from frootc_storage + cnveg_cf_inst%m_frootc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from frootc_xfer + cnveg_cf_inst%m_livecrootc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livecrootc + cnveg_cf_inst%m_livecrootc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livecrootc_storage + cnveg_cf_inst%m_livecrootc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from livecrootc_xfer + cnveg_cf_inst%m_deadcrootc_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadcrootc + cnveg_cf_inst%m_deadcrootc_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadcrootc_storage + cnveg_cf_inst%m_deadcrootc_xfer_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from deadcrootc_xfer + cnveg_cf_inst%m_gresp_storage_to_fire_patch (p) & ! (gC/m2/s) fire C emissions from gresp_storage + cnveg_cf_inst%m_gresp_xfer_to_fire_patch (p) ! (gC/m2/s) fire C emissions from gresp_xfer ! for diagnostics totfire%emis(p) = fire_flux ! gC/m2/sec ! loop over fire components emis_cmp => shr_fire_emis_linkedlist emis_cmp_loop: do while(associated(emis_cmp)) icomp = emis_cmp%index epsilon = emis_cmp%emis_factors(patch%itype(p)) comp(icomp)%emis(p) = epsilon * fire_flux* 1.e-3_r8/0.5_r8 ! (to convert gC/m2/sec to kg species/m2/sec) emis_flux(icomp) = emis_cmp%coeff*comp(icomp)%emis(p) emis_cmp => emis_cmp%next_emiscomp enddo emis_cmp_loop ! sum up the emissions compontent fluxes for the fluxes of chem mechanism compounds do imech = 1,shr_fire_emis_mechcomps_n n_emis_comps = shr_fire_emis_mechcomps(imech)%n_emis_comps do icomp = 1,n_emis_comps ! loop over number of emission components that make up the nth mechanism compoud ii = shr_fire_emis_mechcomps(imech)%emis_comps(icomp)%ptr%index fire_emis(p,imech) = fire_emis(p,imech) + emis_flux(ii) mech(imech)%emis(p) = fire_emis(p,imech) enddo enddo ztop(p) = vert_dist_top( patch%itype(p) ) end if ! ivt(1:15 only) enddo ! fp end associate end subroutine CNFireEmisUpdate ! Private methods !----------------------------------------------------------------------- !ztop compiled from Val Martin et al ACP 2010, Tosca et al. JGR 2011 and Jian et al., ACP 2013 !st ztop updated based on Val Martin pers. communication Jan2015 !----------------------------------------------------------------------- ! not_vegetated 500 m !PFT1: needleleaf_evergreen_temperate_tree 4000 m !2: needleleaf_evergreen_boreal_tree 4000 m !3: needleleaf_deciduous_boreal_tree 3000 m !4: broadleaf_evergreen_tropical_tree 2500 m !5: broadleaf_evergreen_temperate_tree 3000 m !6: broadleaf_deciduous_tropical_tree 2500 m !7: broadleaf_deciduous_temperate_tree 3000 m !8: broadleaf_deciduous_boreal_tree 3000 m !9: broadleaf_evergreen_shrub 2000 m !10: broadleaf_deciduous_temperate_shrub 2000 m !11: broadleaf_deciduous_boreal_shrub 2000 m !12: c3_arctic_grass 1000 m !13: c3_non-arctic_grass 1000 m !14: c4_grass 1000 m !15: c3_crop 1000 m !(and all new crops: 1000m) function vert_dist_top( veg_type ) result(ztop) use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use pftconMod , only : noveg, ndllf_evr_tmp_tree, ndllf_evr_brl_tree use pftconMod , only : ndllf_dcd_brl_tree, nbrdlf_evr_tmp_tree use pftconMod , only : nbrdlf_dcd_tmp_tree, nbrdlf_dcd_brl_tree use pftconMod , only : nbrdlf_evr_trp_tree, nbrdlf_dcd_trp_tree use pftconMod , only : nbrdlf_evr_shrub, nbrdlf_dcd_brl_shrub use pftconMod , only : nc3_arctic_grass, nc3_nonarctic_grass use pftconMod , only : nc3crop, nc3irrig use pftconMod , only : npcropmin, npcropmax implicit none integer, intent(in) :: veg_type real(r8) :: ztop ! Bare soil, won't be used if ( veg_type == noveg ) then ztop = nan ! temperate and boreal evergreen needleleaf trees else if ( veg_type == ndllf_evr_tmp_tree .or. veg_type == ndllf_evr_brl_tree ) then ztop = 4.e3_r8 ! m ! temperate and boreal trees else if ( veg_type == ndllf_dcd_brl_tree .or. veg_type == nbrdlf_evr_tmp_tree .or. & veg_type == nbrdlf_dcd_tmp_tree .or. veg_type == nbrdlf_dcd_brl_tree ) then ztop = 3.e3_r8 ! m ! tropical broadleaf trees (evergreen and decidious) else if ( veg_type == nbrdlf_evr_trp_tree .or. veg_type == nbrdlf_dcd_trp_tree ) then ztop = 2.5e3_r8 ! m ! shrubs else if ( veg_type >= nbrdlf_evr_shrub .and. veg_type <= nbrdlf_dcd_brl_shrub ) then ztop = 2.e3_r8 ! m ! grasses else if ( veg_type >= nc3_arctic_grass .and. veg_type <= nc3_nonarctic_grass ) then ztop = 1.e3_r8 ! m ! generic unmanaged crops else if ( veg_type == nc3crop .or. veg_type <= nc3irrig ) then ztop = 1.e3_r8 ! m ! Prognostic crops else if ( veg_type >= npcropmin .and. veg_type <= npcropmax ) then ztop = 1.e3_r8 ! m else call endrun('ERROR:: undefined veg_type' ) end if end function vert_dist_top end module CNFireEmissionsMod