LCOV - code coverage report
Current view: | top level - chemistry/mozart - hco_cc_emissions.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 14 | 0.0 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 0 | 3 | 0.0 %

              Line data    Source code
           1             : !------------------------------------------------------------------------------
           2             : !                    Harmonized Emissions Component (HEMCO)                   !
           3             : !------------------------------------------------------------------------------
           4             : !BOP
           5             : !
           6             : ! !MODULE: hco_cc_emissions
           7             : !
           8             : ! !DESCRIPTION: Module hco\_cc\_emissions provides emissions to CAM-chem in CESM.
           9             : !               This module replaces mo\_extfrc and mo\_srf\_emissions in CAM-chem
          10             : !               when HEMCO is enabled, otherwise they are not called if HEMCO-CESM is not
          11             : !               enabled at runtime.
          12             : !
          13             : !               These subroutines emulate the behavior of extfrc\_set (3-D emissions)
          14             : !               and set\_srf\_emissions in CAM-chem for API compatibility.
          15             : !\\
          16             : !\\
          17             : ! !INTERFACE:
          18             : !
          19             : module hco_cc_emissions
          20             : !
          21             : ! !USES:
          22             : !
          23             :     ! CESM types
          24             :     use shr_kind_mod,     only: r8 => shr_kind_r8
          25             :
          26             :     ! Run control
          27             :     use spmd_utils,       only: masterproc
          28             :     use cam_abortutils,   only: endrun
          29             :     use cam_logfile,      only: iulog
          30             :
          31             :     ! Grid information
          32             :     use ppgrid,           only: pver, pverp
          33             :
          34             :     ! Chemistry mechanism properties
          35             :     use chem_mods,        only: gas_pcnst
          36             :     use mo_tracname,      only: solsym
          37             :
          38             :     ! Physics buffer operations
          39             :     use physics_buffer,   only: physics_buffer_desc
          40             :     use physics_buffer,   only: pbuf_get_field, pbuf_get_index
          41             :
          42             :     ! Compat with XFRC diagn
          43             :     use cam_history,         only: outfld
          44             :     use cam_history_support, only: max_fieldname_len
          45             :
          46             :     implicit none
          47             :     private
          48             : !
          49             : ! !PUBLIC MEMBER FUNCTIONS:
          50             : !
          51             :     public :: hco_extfrc_inti
          52             :     public :: hco_set_srf_emissions, hco_set_extfrc
          53             : !
          54             : ! !REMARKS:
          55             : !  None
          56             : !
          57             : ! !REVISION HISTORY:
          58             : !  08 Aug 2022 - H.P. Lin    - Initial version
          59             : !  04 Nov 2022 - H.P. Lin    - Now initialize extfrc fields in here
          60             : !EOP
          61             : !------------------------------------------------------------------------------
          62             : !BOC
          63             :     logical :: pcnst_is_extfrc(gas_pcnst)              ! Is external forcing? (3-D data)
          64             :     integer :: pcnst_extfrc_ndx(gas_pcnst)             ! External forcing index from get_extfrc_ndx
          65             :     integer :: hco_pbuf_idx(gas_pcnst)                 ! Physics buffer indices for HCO_* fields from HEMCO
          66             : contains
          67             : !EOC
          68             : !------------------------------------------------------------------------------
          69             : !                    Harmonized Emissions Component (HEMCO)                   !
          70             : !------------------------------------------------------------------------------
          71             : !BOP
          72             : !
          73             : ! !IROUTINE: hco_set_srf_emissions
          74             : !
          75             : ! !DESCRIPTION: Sets surface level emissions (note, TOA is level 1, so this is level pver)
          76             : !               for this latitude slice (chunk).
          77             : !\\
          78             : !\\
          79             : ! !INTERFACE:
          80             : !
          81           0 :     subroutine hco_set_srf_emissions( lchnk, ncol, sflx, pbuf )
          82             : !
          83             : ! !USES:
          84             : !
          85             :     implicit none
          86             : !
          87             : ! !INPUT PARAMETERS:
          88             : !
          89             :     integer,  intent(in)               :: ncol        ! columns in chunk
          90             :     integer,  intent(in)               :: lchnk       ! chunk index
          91             :     real(r8), intent(out)              :: sflx(:,:)   ! surface emissions ( kg/m^2/s )
          92             :     type(physics_buffer_desc), pointer :: pbuf(:)     ! pbuf in chunk
          93             : !
          94             : ! !REVISION HISTORY:
          95             : !  08 Aug 2022 - H.P. Lin    - Initial version
          96             : !  12 Jan 2023 - H.P. Lin    - Check if pbuf is 2-D or 3-D first
          97             : !  09 Feb 2023 - H.P. Lin    - For 3-D pbuf, no longer set cflx and use 3-D forcing only.
          98             : !EOP
          99             : !------------------------------------------------------------------------------
         100             : !BOC
         101             : !
         102             : ! !LOCAL VARIABLES:
         103             : !
         104             :     integer               :: n
         105             :
         106             :     real(r8), pointer     :: pbuf_ptr_3d(:,:)          ! ptr to pbuf data (/pcols,pver/)
         107           0 :     real(r8), pointer     :: pbuf_ptr_2d(:)            ! ptr to pbuf data (/pcols/)
         108             :     integer               :: tmpIdx                    ! pbuf field id
         109             :
         110             :     ! reset sflx here. (same as mo_srf_emissions.F90)
         111             :     ! sflx is defined in chem_emissions (chemistry.F90) but without default values, and is
         112             :     ! later added to cam_in%cflx. it must be initialized in this subroutine.
         113           0 :     sflx(:,:) = 0._r8
         114             :
         115             :     !--------------------------------------------------------
         116             :     ! ... set HEMCO emissions
         117             :     ! hplin 7/19/20
         118             :     !--------------------------------------------------------
         119             :
         120             :     ! for every species index retrieve the species name, compute the pbuf name,
         121             :     ! and write it into sflx(col, n)
         122             :     ! where n is spc_ndx
         123             :
         124             :     ! if the pbuf exists, set has_emis(1:gas_pcnst) to .true.
         125             :     ! this process is supposed to be set by srf_emissions_inti but it is just
         126             :     ! used below, so we shunt it here and decide later
         127             :
         128             :     ! ncol: # of columns in chunk
         129             :     ! lchnk: chunk number
         130             :
         131             :     ! sflx is given in (pcols, gas_pcnst) so it is a in-chunk slice of the
         132             :     ! srf flux specifier. maybe this loop needs to be done higher up so
         133             :     ! we loop over the pbuf to prevent inquiries. tbd hplin 7/19/20
         134             :
         135             :     do n = 1, gas_pcnst
         136             :         tmpIdx = hco_pbuf_idx(n)
         137             :         if(tmpIdx > 0) then
         138             :             if(pcnst_is_extfrc(n)) then ! 3-D data
         139             :                 ! if species is 3-D data, then all forcings set through 3-D. no longer process
         140             :                 ! their emissions here.
         141             :             else ! 2-D data
         142             :                 call pbuf_get_field(pbuf, tmpIdx, pbuf_ptr_2d)
         143             :
         144             :                 ! for each col retrieve data from pbuf_ptr(I, K)
         145             :                 sflx(1:ncol,n) = pbuf_ptr_2d(1:ncol)
         146             :
         147             :                 pbuf_ptr_2d => null()
         148             :             endif
         149             :         endif
         150             :     enddo
         151             :
         152           0 :     end subroutine hco_set_srf_emissions
         153             : !EOC
         154             : !------------------------------------------------------------------------------
         155             : !                    Harmonized Emissions Component (HEMCO)                   !
         156             : !------------------------------------------------------------------------------
         157             : !BOP
         158             : !
         159             : ! !IROUTINE: hco_set_extfrc
         160             : !
         161             : ! !DESCRIPTION: Set 3-D emissions apart from surface level.
         162             : !\\
         163             : !\\
         164             : ! !INTERFACE:
         165             : !
         166           0 :     subroutine hco_set_extfrc( lchnk, zint, frcing, ncol, pbuf )
         167             : !
         168             : ! !USES:
         169             : !
         170             :         use mo_chem_utls,   only: get_spc_ndx
         171             :
         172             :         ! Check list whether this species has external forcing from dataset - this is a CAM-chem flag
         173             :         ! and this is CAM-chem specific.
         174             :         use chem_mods,      only: frc_from_dataset, extfrc_lst
         175             :         use chem_mods,      only: extcnt, adv_mass
         176             :
         177             :         use mo_constants,   only: avogadro
         178             :         implicit none
         179             : !
         180             : ! !INPUT PARAMETERS:
         181             : !
         182             :         integer,  intent(in)               :: ncol                       ! columns in chunk
         183             :         integer,  intent(in)               :: lchnk                      ! chunk index
         184             :         real(r8), intent(in)               :: zint(ncol, pverp)          ! interface geopot above surface (km)
         185             :         real(r8), intent(inout)            :: frcing(ncol,pver,extcnt)   ! insitu forcings (molec/cm^3/s)
         186             :         type(physics_buffer_desc), pointer :: pbuf(:)                    ! pbuf in chunk
         187             : !
         188             : ! !REVISION HISTORY:
         189             : !  08 Aug 2022 - H.P. Lin    - Initial version based on original from 14 Nov 2020
         190             : !  09 Feb 2023 - H.P. Lin    - Use full 3-D emissions, including surface, if available
         191             : !EOP
         192             : !------------------------------------------------------------------------------
         193             : !BOC
         194             : !
         195             : ! !LOCAL VARIABLES:
         196             : !
         197             :     real(r8), parameter   :: cm2_to_m2 = 1.e4_r8
         198             :     real(r8), parameter   :: kg_to_g   = 1.e-3_r8
         199             :     real(r8), parameter   :: km_to_cm  = 1.e5_r8
         200             :
         201             :     ! Loop idxs
         202             :     integer               :: m, n, k
         203             :
         204             :     ! For compatibility with XFRC_ diagnostic in CAM-chem
         205           0 :     real(r8)              :: frcing_col(1:ncol), frcing_col_kg(1:ncol)
         206             :     character(len=max_fieldname_len) :: xfcname
         207             :     real(r8)              :: molec_to_kg
         208             :     integer               :: spc_ndx
         209             :
         210             :
         211           0 :     real(r8), pointer     :: pbuf_ik(:,:)              ! ptr to pbuf data (/pcols,pver/)
         212             :     integer               :: tmpIdx                    ! pbuf field id
         213             :     real(r8)              :: kg_to_molec
         214             :
         215             :     ! for every species index retrieve the species name, compute the pbuf name,
         216             :     ! and write it into frcing(col, lev, n)
         217             :     ! where n is FRC_IDX --
         218             :     !
         219             :
         220             :     !******************************************************************************************************
         221             :     ! WARNING: ONLY SPECIES THAT ARE EXTERNALLY FORCED AND SPECIFIED IN mo_sim_dat.F90
         222             :     ! CAN HAVE 3-D EMISSIONS, OTHERWISE THEY WILL BE IGNORED!!!
         223             :     !
         224             :     !  the n = frc_idx comes from get_extfrc_ndx( spc_name ).
         225             :     !  it is too computationally expensive to check all fields to see if they are 3-d emitted
         226             :     !
         227             :     !  so PLEASE verify that all your species are in mo_sim_dat.F90:: extfrc_lst before attempting
         228             :     !  to have 3-D emissions for them.
         229             :     !
         230             :     ! I will still loop through all species, get its symbol and attempt to inject extfrc emissions
         231             :     ! for it, but it may not be guaranteed to be done.
         232             :     !******************************************************************************************************
         233             :
         234             :     ! if the pbuf exists, set has_emis(1:gas_pcnst) to .true.
         235             :     ! this process is supposed to be set by srf_emissions_inti but it is just
         236             :     ! used below, so we shunt it here and decide later
         237             :
         238             :     ! ncol: # of columns in chunk
         239             :     ! lchnk: chunk number
         240             :
         241             :     ! Zero out frcing to be consistent with mo_extfrc
         242             :     frcing(:,:,:) = 0._r8
         243             :
         244             :     do n = 1, gas_pcnst
         245             :       ! check if extfrc available?
         246             :       if(pcnst_is_extfrc(n)) then
         247             :         ! add extfrc
         248             :         ! "external insitu forcing" (1/cm^3/s)
         249             :         m = pcnst_extfrc_ndx(n)
         250             :         tmpIdx = hco_pbuf_idx(n)
         251             :         if(tmpIdx > 0) then
         252             :           ! Note: units coming out of HEMCO are in kg/m2/s, so unit conversion must be done
         253             :           !
         254             :           ! using species factor...
         255             :           ! (kg_to_g is actually kg/g...)
         256             :           !
         257             :           !     1 / (kg/molec cm2/m2) = molec/kg m2/cm2
         258             :           !
         259             :           ! kg/m2/s * molec/kg m2/cm2 = molec/cm2/s
         260             :           ! now divide by z-interface height (in CM!) for each height to get the right answer!
         261             :           ! (hplin, 11/14/20)
         262             :           kg_to_molec = 1/(adv_mass(n) / avogadro * cm2_to_m2 * kg_to_g)
         263             :
         264             :           ! this is already in chunk, retrieve it.
         265             :           ! if the field does not exist, pbuf_get_field will return an error, so sanity check for pbuf_ik is not needed.
         266             :           call pbuf_get_field(pbuf, tmpIdx, pbuf_ik)
         267             :
         268             :           ! for each col retrieve data from pbuf_ik(I, K)
         269             :           ! this includes surface layer.
         270             :           do k = 1, pver
         271             :             frcing(:ncol,k,m) = frcing(:ncol,k,m) + pbuf_ik(1:ncol,k) * kg_to_molec / ((zint(:ncol,k)-zint(:ncol,k+1)) * km_to_cm)
         272             :           enddo
         273             :
         274             :           if ( frc_from_dataset(m) ) then
         275             :              xfcname = trim(extfrc_lst(m))//'_XFRC'
         276             :              call outfld( xfcname, frcing(:ncol,:,n), ncol, lchnk )
         277             :              spc_ndx = get_spc_ndx( extfrc_lst(m) )
         278             :              molec_to_kg = adv_mass( spc_ndx ) / avogadro * cm2_to_m2 * kg_to_g
         279             :
         280             :              frcing_col(:ncol) = 0._r8
         281             :              frcing_col_kg(:ncol) = 0._r8
         282             :              do k = 1, pver
         283             :                 frcing_col(:ncol) = frcing_col(:ncol) + frcing(:ncol,k,m)*(zint(:ncol,k)-zint(:ncol,k+1))*km_to_cm
         284             :                 frcing_col_kg(:ncol) = frcing_col_kg(:ncol) + frcing(:ncol,k,m)*(zint(:ncol,k)-zint(:ncol,k+1))*km_to_cm*molec_to_kg
         285             :              enddo
         286             :
         287             :              xfcname = trim(extfrc_lst(m))//'_CLXF'
         288             :              call outfld( xfcname, frcing_col(:ncol), ncol, lchnk )
         289             :              xfcname = trim(extfrc_lst(m))//'_CMXF'
         290             :              call outfld( xfcname, frcing_col_kg(:ncol), ncol, lchnk )
         291             :           endif
         292             :         endif
         293             :       endif
         294             :     enddo
         295             :
         296           0 :     end subroutine hco_set_extfrc
         297             : !EOC
         298             : !------------------------------------------------------------------------------
         299             : !                    Harmonized Emissions Component (HEMCO)                   !
         300             : !------------------------------------------------------------------------------
         301             : !BOP
         302             : !
         303             : ! !IROUTINE: hco_extfrc_inti
         304             : !
         305             : ! !DESCRIPTION: Initialize external forcing related diagnostic fields
         306             : !\\
         307             : !\\
         308             : ! !INTERFACE:
         309             : !
         310           0 :     subroutine hco_extfrc_inti( )
         311             : !
         312             : ! !USES:
         313             : !
         314             :         use chem_mods,    only: frc_from_dataset, extcnt, extfrc_lst
         315             :         use cam_history,  only: addfld, add_default, horiz_only
         316             :         use phys_control, only: phys_getopts
         317             :         use mo_chem_utls, only: get_extfrc_ndx
         318             :         implicit none
         319             : !
         320             : ! !REVISION HISTORY:
         321             : !  04 Nov 2022 - H.P. Lin    - Initial version based on extfrc_inti
         322             : !  10 Apr 2023 - H.P. Lin    - Now move pcnst_is_extfrc initialization here
         323             : !EOP
         324             : !------------------------------------------------------------------------------
         325             : !BOC
         326             : !
         327             : ! !LOCAL VARIABLES:
         328             : !
         329             :     logical  :: history_aerosol
         330             :     logical  :: history_chemistry
         331             :     logical  :: history_cesm_forcing
         332             :     character(len=16)  :: spc_name
         333             :     integer  :: n
         334             :
         335             :     character(len=255)    :: fldname_ns                ! field name HCO_NH3
         336             :     integer               :: RC                        ! return code (dummy)
         337             :
         338             :     ! for first run, cache results of 3-D or 2-D scan within pcnst_is_extfrc
         339             :     ! to avoid lengthy lookups in future timesteps. hplin 1/12/23
         340             :     do n = 1, gas_pcnst
         341             :         pcnst_extfrc_ndx(n) = get_extfrc_ndx(trim(solsym(n)))
         342             :         pcnst_is_extfrc(n) = (pcnst_extfrc_ndx(n) > 0)
         343             :
         344             :         ! construct information about HCO_* corresponding pbuf location
         345             :         fldname_ns = 'HCO_' // trim(solsym(n))
         346             :         hco_pbuf_idx(n) = pbuf_get_index(fldname_ns, RC)
         347             :     enddo
         348             :
         349           0 :     if(masterproc) then
         350           0 :         write(iulog,*) "hco_set_srf_emissions: first run pcnst_is_extfrc cache, extfrc_ndx:"
         351             :         do n = 1, gas_pcnst
         352           0 :            write(iulog,*) trim(solsym(n)), ' : ', pcnst_is_extfrc(n), pcnst_extfrc_ndx(n)
         353             :         end do
         354             :      endif
         355             :
         356             :     ! Replicate functionality in extfrc_inti to create _XFRC... diagnostics
         357             :     call phys_getopts( &
         358             :          history_aerosol_out = history_aerosol, &
         359             :          history_chemistry_out = history_chemistry, &
         360           0 :          history_cesm_forcing_out = history_cesm_forcing )
         361             :
         362             :     do n= 1,extcnt
         363             :        if (frc_from_dataset(n)) then
         364             :           spc_name = extfrc_lst(n)
         365             :           call addfld( trim(spc_name)//'_XFRC', (/ 'lev' /), 'A',  'molec/cm3/s', &
         366             :                'external forcing for '//trim(spc_name) )
         367             :           call addfld( trim(spc_name)//'_CLXF', horiz_only,  'A',  'molec/cm2/s', &
         368             :                'vertically intergrated external forcing for '//trim(spc_name) )
         369             :           call addfld( trim(spc_name)//'_CMXF', horiz_only,  'A',  'kg/m2/s', &
         370             :                'vertically intergrated external forcing for '//trim(spc_name) )
         371             :           if ( history_aerosol .or. history_chemistry ) then
         372             :              call add_default( trim(spc_name)//'_CLXF', 1, ' ' )
         373             :              call add_default( trim(spc_name)//'_CMXF', 1, ' ' )
         374             :           endif
         375             :           if ( history_cesm_forcing .and. spc_name == 'NO2' ) then
         376             :              call add_default( trim(spc_name)//'_CLXF', 1, ' ' )
         377             :              call add_default( trim(spc_name)//'_CMXF', 1, ' ' )
         378             :           endif
         379             :        endif
         380             :     enddo
         381             :
         382           0 :     end subroutine hco_extfrc_inti
         383             : !EOC
         384             : end module hco_cc_emissions

Generated by: LCOV version 1.14