From 075f80187968789aecd540cc0399be5b3d61139a Mon Sep 17 00:00:00 2001 From: Melissa Sulprizio Date: Wed, 29 Nov 2023 16:39:57 -0500 Subject: [PATCH 1/5] Improve error message for when species not found in species_database.yml Signed-off-by: Melissa Sulprizio --- Headers/species_database_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Headers/species_database_mod.F90 b/Headers/species_database_mod.F90 index cf504212a..abc0c08c6 100644 --- a/Headers/species_database_mod.F90 +++ b/Headers/species_database_mod.F90 @@ -839,7 +839,8 @@ SUBROUTINE Init_Species_Database( Input_Opt, SpcData, SpcCount, RC ) ThisSpc%Is_Gas = .TRUE. ELSE errMsg = "Is_Gas and Is_Aerosol are both FALSE for species " // & - TRIM( spc ) // "!" + TRIM( spc ) // "!This species may not be included " // & + "in species_database.yml. Please check that file." CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF From 01f2a97cafbd278cbadd4c7b1bc24b7cbc39fb1c Mon Sep 17 00:00:00 2001 From: Melissa Sulprizio Date: Wed, 3 Jan 2024 13:27:23 -0500 Subject: [PATCH 2/5] Remove CH4 emissions scaling from code and apply in HEMCO_Config.rc instead To facilitate CH4 simulations with multiple tracers representing the different state vector elements within an analytical inversion, we now remove the emissions perturbation applied within global_ch4_mod.F90 (and carbon_mod.F90). Instead, emissions are perturbed directly in HEMCO_Config.rc via scale factors applied to the state vector element IDs read from a netCDF file. The perturbations are meant to be used on total CH4 emissions (i.e. using output from a HEMCO standalone simulation) to avoid having to apply the scale factor(s) for every emissions inventory and sector throughout HEMCO_Config.rc. For example: #============================================================================== # ---Total CH4 emissions (all sectors) from prior simulation --- #============================================================================== (((UseTotalPriorEmis 0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 0 CH4_Emis_Prior_0001 - - - - - - CH4_0001 2001 1 500 )))UseTotalPriorEmis #============================================================================== # --- Scale factors for analytical inversions --- #============================================================================== (((AnalyticalInversion # Add perturbations to individual state vector element (N) following the format # Start scale factor ID at 2000 to avoid conflicts with other SFs/masks #200N SCALE_ELEM000N ./Perturbations.txt - - - xy count 1 2001 SCALE_ELEM_0001 ./Perturbations.txt - - - xy count 1 )))AnalyticalInversion The Emis_PosteriorSF and OH_PosteriorSF options have also been updated here so they are also applied directly within HEMCO_Config.rc instead of within global_ch4_mod.F90/carbon_mod.F90. Emis_PosteriorSF applies the field EMIS_SF to the total CH4 emissions field and OH_PosteriorSF applies OH_SF to the GLOBAL_OH field. Signed-off-by: Melissa Sulprizio --- CHANGELOG.md | 7 + GeosCore/carbon_gases_mod.F90 | 135 ---- GeosCore/emissions_mod.F90 | 26 +- GeosCore/global_ch4_mod.F90 | 574 +----------------- GeosCore/hco_interface_gc_mod.F90 | 93 +-- GeosCore/input_mod.F90 | 74 --- Headers/state_chm_mod.F90 | 32 - .../HEMCO_Config.rc.CH4 | 93 ++- .../HEMCO_Config.rc.carbon | 97 +-- .../HEMCO_Config.rc.tagCH4 | 96 +-- .../geoschem_config.yml.CH4 | 5 - .../geoschem_config.yml.carbon | 5 - .../geoschem_config.yml.tagCH4 | 5 - .../HEMCO_Config.rc.carbon | 97 +-- 14 files changed, 282 insertions(+), 1057 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0e53787b5..30570f48e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,13 @@ This file documents all notable changes to the GEOS-Chem repository starting in The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [Unreleased] +### Changed +- Removed emissions handling from `global_ch4_mod.F90` and `carbon_mod.F90` and instead apply scale factors to emissions directly in `HEMCO_Config.rc` + +### Removed +- Removed State_Chm%CH4_EMIS + ## [14.2.3] - 2023-12-01 ### Added - GEOS-Chem Classic rundir script `run/GCClassic/setupForRestarts.sh` diff --git a/GeosCore/carbon_gases_mod.F90 b/GeosCore/carbon_gases_mod.F90 index fdf4f4f45..a10bfdbc4 100644 --- a/GeosCore/carbon_gases_mod.F90 +++ b/GeosCore/carbon_gases_mod.F90 @@ -32,10 +32,6 @@ MODULE Carbon_Gases_Mod PUBLIC :: Init_Carbon_Gases PUBLIC :: Cleanup_Carbon_Gases ! -! !PUBLIC DATA MEMBERS: -! - REAL(fp), ALLOCATABLE, PUBLIC :: CH4_EMIS_J(:,:,:) ! [kg/m2/s] -! ! !REVISION HISTORY: ! 04 Apr 2022 - M.S. Long - Initial version, based on work by B. Bukosa ! See https://github.com/geoschem/geos-chem for complete history @@ -116,13 +112,6 @@ SUBROUTINE Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & ! !OUTPUT PARAMETERS: ! INTEGER, INTENT(OUT) :: RC ! Success or failure? -! -! !REMARKS: -! WARNING: Soil absorption has to be the 15th field in CH4_EMIS -! Also: the ND58 diagnostics have now been removed. We still need to -! read the HEMCO manual diagnostics into CH4_EMIS for the analytical -! inversion. Therefore, we will keep EmissCh4 for the time-being -! but only remove the bpch diagnostic. !EOP !------------------------------------------------------------------------------ !BOC @@ -180,102 +169,6 @@ SUBROUTINE Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & ! Emission timestep dtSrce = HcoState%TS_EMIS - !======================================================================== - ! CH4 emissions - ! - ! --> All emission calculations are now done through HEMCO - ! HEMCO stores emissions of all species internally in the HEMCO - ! state object. Here, we pass these emissions into module array - ! CH4_EMIS in units kg/m2/s. These values are then either added to - ! the species array (full mixing scheme) or used later on in - ! vdiff_mod.F90 if the non-local PBL mixing scheme is used. - ! - ! The CH4_EMIS array is mostly used for backwards compatibility - ! (especially the diagnostics). It is also used to ensure that - ! in a multi-species simulation, species 1 (total CH4) is properly - ! defined. - ! (ckeller, 9/12/2013) - !======================================================================== - IF ( id_CH4 > 0 ) THEN - - ! Initialize - CH4_EMIS_J = 0.0_fp - CH4scale = 1.0_hp - CH4diag(1) = 'CH4' - CH4diag(2) = 'CH4_OIL' - CH4diag(3) = 'CH4_GAS' - CH4diag(4) = 'CH4_COAL' - CH4diag(5) = 'CH4_LIVESTOCK' - CH4diag(6) = 'CH4_LANDFILLS' - CH4diag(7) = 'CH4_WASTEWATER' - CH4diag(8) = 'CH4_RICE' - CH4diag(9) = 'CH4_ANTHROTHER' - CH4diag(10) = 'CH4_BIOMASS' - CH4diag(11) = 'CH4_WETLAND' - CH4diag(12) = 'CH4_SEEPS' - CH4diag(13) = 'CH4_LAKES' - CH4diag(14) = 'CH4_TERMITES' - CH4diag(15) = 'CH4_SOILABSORB' ! CH4 soilabsorb values are negative! - CH4diag(16) = 'CH4_RESERVOIRS' - CH4scale(15) = -1.0_hp ! Need to convert to positive - - ! Loop over manual CH4 diagnostics - DO N = 2, N_CH4_DIAGS - - ! Get a pointer to the emissions - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, CH4diag(N), & - .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors - IF ( RC /= HCO_SUCCESS ) THEN - errMsg = 'Cannot get pointer to HEMCO field ' // TRIM(CH4diag(N)) - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - IF ( .not. ASSOCIATED( Ptr2D ) ) THEN - errMsg = 'Cannot get pointer to HEMCO field ' // TRIM(CH4diag(N)) - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - - ! Store emissions in CH4_EMIS_J [kg/m2/s] - ! CH4scale is either -1 (for soil absorption) or 1 (everything else) - CH4_EMIS_J(:,:,N) = Ptr2D * CH4scale(N) - - ! Free pointer for next iteration - Ptr2D => NULL() - ENDDO - - !--------------------------------------------------------------------- - ! Total emission: sum of all emissions - (2*soil absorption) - ! We have to substract soil absorption twice because it is added - ! to other emissions in the SUM function. (ccc, 7/23/09) - !--------------------------------------------------------------------- - CH4_EMIS_J(:,:,1) = SUM( CH4_EMIS_J, 3 ) & - - ( 2.0_fp * CH4_EMIS_J(:,:,15) ) - - IF ( Input_Opt%Verbose ) THEN - WRITE(*,*) 'CH4_EMIS (kg/m2/s):' - WRITE(*,*) 'Total : ', SUM( CH4_EMIS_J(:,:,1 ) ) - WRITE(*,*) 'Oil : ', SUM( CH4_EMIS_J(:,:,2 ) ) - WRITE(*,*) 'Gas : ', SUM( CH4_EMIS_J(:,:,3 ) ) - WRITE(*,*) 'Coal : ', SUM( CH4_EMIS_J(:,:,4 ) ) - WRITE(*,*) 'Livestock : ', SUM( CH4_EMIS_J(:,:,5 ) ) - WRITE(*,*) 'Landfills : ', SUM( CH4_EMIS_J(:,:,6 ) ) - WRITE(*,*) 'Wastewater : ', SUM( CH4_EMIS_J(:,:,7 ) ) - WRITE(*,*) 'Rice : ', SUM( CH4_EMIS_J(:,:,8 ) ) - WRITE(*,*) 'Other anth : ', SUM( CH4_EMIS_J(:,:,9 ) ) - WRITE(*,*) 'Biomass burn : ', SUM( CH4_EMIS_J(:,:,10) ) - WRITE(*,*) 'Wetlands : ', SUM( CH4_EMIS_J(:,:,11) ) - WRITE(*,*) 'Seeps : ', SUM( CH4_EMIS_J(:,:,12) ) - WRITE(*,*) 'Lakes : ', SUM( CH4_EMIS_J(:,:,13) ) - WRITE(*,*) 'Termites : ', SUM( CH4_EMIS_J(:,:,14) ) - WRITE(*,*) 'Soil absorb : ', SUM( CH4_EMIS_J(:,:,15) ) - WRITE(*,*) 'Reservoirs : ', SUM( CH4_EMIS_J(:,:,16) ) - ENDIF - - ENDIF - !======================================================================== ! CO2 production from CO oxidation !======================================================================== @@ -1398,27 +1291,6 @@ SUBROUTINE Init_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & IF ( RC /= GC_SUCCESS ) RETURN sumOfCosSza = 0.0_fp - !======================================================================== - ! Initialize variables for CH4 chemistry - !======================================================================== - IF ( id_CH4 > 0 ) THEN - ALLOCATE( CH4_EMIS_J( State_Grid%NX, State_Grid%NY, N_CH4_DIAGS ), & - STAT=RC ) - CALL GC_CheckVar( 'carbon_gases_mod.F90:CH4_EMIS', 0, RC ) - IF ( RC /= GC_SUCCESS ) RETURN - CH4_EMIS_J = 0.0_fp - ENDIF - - !======================================================================== - ! Initialize variables for CO2 chemistry - !======================================================================== - ! none yet - - !======================================================================== - ! Initialize variables for OCS chemistry - !======================================================================== - ! none yet - END SUBROUTINE Init_Carbon_Gases !EOC !------------------------------------------------------------------------------ @@ -1454,13 +1326,6 @@ SUBROUTINE Cleanup_Carbon_Gases( RC ) ! Initialize RC = GC_SUCCESS - ! Deallocate - IF ( ALLOCATED( CH4_EMIS_J ) ) THEN - DEALLOCATE( CH4_EMIS_J, STAT=RC ) - CALL GC_CheckVar( 'carbon_gases_mod.F90:CH4_EMIS', 2, RC ) - RETURN - ENDIF - IF ( ALLOCATED( sumOfCosSza ) ) THEN DEALLOCATE( sumOfCosSza, STAT=RC ) CALL GC_CheckVar( 'carbon_gases_mod.F90:sumOfCosSza', 2, RC ) diff --git a/GeosCore/emissions_mod.F90 b/GeosCore/emissions_mod.F90 index ce592fbda..c8d2b5a30 100644 --- a/GeosCore/emissions_mod.F90 +++ b/GeosCore/emissions_mod.F90 @@ -127,7 +127,6 @@ SUBROUTINE Emissions_Run( Input_Opt, State_Chm, State_Diag, & USE Carbon_Gases_Mod, ONLY : Emiss_Carbon_Gases USE CO2_MOD, ONLY : EmissCO2 USE ErrCode_Mod - USE GLOBAL_CH4_MOD, ONLY : EmissCH4 USE HCO_Interface_GC_Mod, ONLY : HCOI_GC_Run USE Input_Opt_Mod, ONLY : OptInput USE Mercury_Mod, ONLY : EmissMercury @@ -247,28 +246,6 @@ SUBROUTINE Emissions_Run( Input_Opt, State_Chm, State_Diag, & ENDIF ENDIF - ! For CH4 simulation - ! - ! This will get the individual CH4 emission terms (gas, coal, wetlands, - ! ...) and write them into the individual emissions arrays defined in - ! global_ch4_mod (CH4_EMIS). Emissions are all done in mixing_mod, the - ! call to EMISSCH4 is for backwards consistency. This is especially - ! needed to do the analytical inversions. - ! - ! To enable CH4 emissions in a full-chemistry simulation, add entries - ! in HEMCO_Config.rc as is done for other species. - ! (mps, 2/12/21) - IF ( Input_Opt%ITS_A_CH4_SIM .or. Input_Opt%ITS_A_TAGCH4_SIM ) THEN - CALL EmissCh4( Input_Opt, State_Chm, State_Grid, State_Met, RC ) - - ! Trap potential errors - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Error encountered in "EmissCH4"!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - ENDIF - ! For transport tracer simulation IF ( Input_Opt%ITS_A_TRACER_SIM ) THEN CALL Tracer_Source_Phase( Input_Opt, State_Chm, State_Grid, & @@ -284,8 +261,7 @@ SUBROUTINE Emissions_Run( Input_Opt, State_Chm, State_Diag, & ! Carbon simulation (e.g. CO2-CO-CH4-OCS via KPP) ! - ! This will get the individual CH4 emission terms in the same way - ! as done for the CH4 simulation above. + ! Computes CO2 production from CO oxidation IF ( Input_Opt%ITS_A_CARBON_SIM ) THEN CALL Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & State_Grid, State_Met, RC ) diff --git a/GeosCore/global_ch4_mod.F90 b/GeosCore/global_ch4_mod.F90 index 5a42288fb..e6612e636 100644 --- a/GeosCore/global_ch4_mod.F90 +++ b/GeosCore/global_ch4_mod.F90 @@ -23,7 +23,6 @@ MODULE GLOBAL_CH4_MOD ! ! !PUBLIC MEMBER FUNCTIONS: ! - PUBLIC :: EMISSCH4 PUBLIC :: CHEMCH4 PUBLIC :: INIT_GLOBAL_CH4 ! @@ -61,519 +60,6 @@ MODULE GLOBAL_CH4_MOD !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: emissch4 -! -! !DESCRIPTION: Subroutine EMISSCH4 places emissions of CH4 [kg] into the -! chemical species array. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE EMISSCH4( Input_Opt, State_Chm, State_Grid, State_Met, RC ) -! -! !USES: -! - USE HCO_Utilities_GC_Mod, ONLY : HCO_GC_EvalFld - USE HCO_Utilities_GC_Mod, ONLY : HCO_GC_GetDiagn - USE ErrCode_Mod - USE Input_Opt_Mod, ONLY : OptInput - USE State_Chm_Mod, ONLY : ChmState - USE State_Met_Mod, ONLY : MetState - USE State_Grid_Mod, ONLY : GrdState -! -! !INPUT PARAMETERS: -! - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object - TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object - TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object - TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT(OUT) :: RC ! Success or failure? -! -! !REMARKS: -! WARNING: Soil absorption has to be the 15th field in CH4_EMIS -! Also: the ND58 diagnostics have now been removed. We still need to -! read the HEMCO manual diagnostics into CH4_EMIS for the analytical -! inversion. Therefore, we will keep EmissCh4 for the time-being -! but only remove the bpch diagnostic. -! -! !REVISION HISTORY: -! (1 ) Created by Bryan Duncan (1/99). Adapted for CH4 chemistry by -! James Wang (7/00). Inserted into module "global_ch4_mod.f" -! by Bob Yantosca. (bmy, 1/16/01) -! See https://github.com/geoschem/geos-chem for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - ! Scalars - INTEGER :: I, J, N - - ! Strings - CHARACTER(LEN= 63) :: DgnName - CHARACTER(LEN=255) :: ErrMsg - CHARACTER(LEN=255) :: ThisLoc - - ! Logicals - LOGICAL, SAVE :: FIRST = .TRUE. - - ! Arrays of state vector elements for applying emissions perturbations - REAL(fp) :: STATE_VECTOR(State_Grid%NX,State_Grid%NY) - - ! Array of scale factors for emissions (from HEMCO) - REAL(fp) :: EMIS_SF(State_Grid%NX,State_Grid%NY) - - ! Pointers - REAL(f4), POINTER :: Ptr2D(:,:) - - !================================================================= - ! EMISSCH4 begins here! - !================================================================= - - ! Nullify pointers - Ptr2D => NULL() - - ! Assume success - RC = GC_SUCCESS - ErrMsg = '' - ThisLoc = ' -> at EMISSCH4 (in GeosCore/global_ch4_mod.F90)' - - IF ( Input_Opt%Verbose ) THEN - print*,'BEGIN SUBROUTINE: EMISSCH4' - ENDIF - - ! ================================================================= - ! Get fields for CH4 analytical inversions if needed - ! ================================================================= - IF ( Input_Opt%DoAnalyticalInv ) THEN - - ! Evaluate the state vector field from HEMCO - CALL HCO_GC_EvalFld( Input_Opt, State_Grid, 'CH4_STATE_VECTOR', & - STATE_VECTOR, RC) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'CH4_STATE_VECTOR not found in HEMCO data list!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - ENDIF - - IF ( Input_Opt%UseEmisSF ) THEN - - ! Evaluate CH4 emissions scale factors from HEMCO - CALL HCO_GC_EvalFld( Input_Opt, State_Grid, 'EMIS_SF', EMIS_SF, RC) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'EMIS_SF not found in HEMCO data list!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - ENDIF - - ! ================================================================= - ! --> All emission calculations are now done through HEMCO - ! HEMCO stores emissions of all species internally in the HEMCO - ! state object. Here, we pass these emissions into module array - ! CH4_EMIS in units kg/m2/s. These values are then either added to - ! the species array (full mixing scheme) or used later on in - ! vdiff_mod.F90 if the non-local PBL mixing scheme is used. - ! - ! The CH4_EMIS array is mostly used for backwards compatibility - ! (especially the diagnostics). It is also used to ensure that - ! in a multi-species simulation, species 1 (total CH4) is properly - ! defined. - ! - ! (ckeller, 9/12/2013) - ! ================================================================= - State_Chm%CH4_EMIS(:,:,:) = 0e+0_fp - - !------------------- - ! Oil - !------------------- - DgnName = 'CH4_OIL' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,2) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Gas - !------------------- - DgnName = 'CH4_GAS' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,3) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Coal - !------------------- - DgnName = 'CH4_COAL' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,4) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Livestock - !------------------- - DgnName = 'CH4_LIVESTOCK' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,5) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Landfills - !------------------- - DgnName = 'CH4_LANDFILLS' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,6) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Wastewater - !------------------- - DgnName = 'CH4_WASTEWATER' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,7) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Rice - !------------------- - DgnName = 'CH4_RICE' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,8) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Other anthropogenic - !------------------- - DgnName = 'CH4_ANTHROTHER' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc = ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,9) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Biomass burning - !------------------- - DgnName = 'CH4_BIOMASS' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,10) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Wetland - !------------------- - DgnName = 'CH4_WETLAND' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,11) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Global seeps - !------------------- - DgnName = 'CH4_SEEPS' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,12) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Lakes - !------------------- - DgnName = 'CH4_LAKES' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,13) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Termites - !------------------- - DgnName = 'CH4_TERMITES' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,14) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - !------------------- - ! Soil absorption (those are negative!) - !------------------- - DgnName = 'CH4_SOILABSORB' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,15) = Ptr2D(:,:) * -1.0_fp - ENDIF - Ptr2D => NULL() - - !------------------- - ! Reservoirs - !------------------- - DgnName = 'CH4_RESERVOIRS' - CALL HCO_GC_GetDiagn( Input_Opt, State_Grid, DgnName, .FALSE., RC, Ptr2D=Ptr2D ) - - ! Trap potential errors and assign HEMCO pointer to array - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'Cannot get pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ELSEIF ( .NOT. ASSOCIATED(Ptr2D) ) THEN - ErrMsg = 'Unassociated pointer to HEMCO field ' // TRIM(DgnName) - CALL GC_Warning( ErrMsg, RC, ThisLoc=ThisLoc ) - ELSE - State_Chm%CH4_EMIS(:,:,16) = Ptr2D(:,:) - ENDIF - Ptr2D => NULL() - - ! ================================================================= - ! Total emission: sum of all emissions - (2*soil absorption) - ! We have to substract soil absorption twice because it is added - ! to other emissions in the SUM function. (ccc, 7/23/09) - ! ================================================================= - State_Chm%CH4_EMIS(:,:,1) = SUM(State_Chm%CH4_EMIS, 3) - (2 * State_Chm%CH4_EMIS(:,:,15)) - - IF ( Input_Opt%Verbose ) THEN - WRITE(*,*) 'CH4_EMIS (kg/m2/s):' - WRITE(*,*) 'Total : ', SUM(State_Chm%CH4_EMIS(:,:,1)) - WRITE(*,*) 'Oil : ', SUM(State_Chm%CH4_EMIS(:,:,2)) - WRITE(*,*) 'Gas : ', SUM(State_Chm%CH4_EMIS(:,:,3)) - WRITE(*,*) 'Coal : ', SUM(State_Chm%CH4_EMIS(:,:,4)) - WRITE(*,*) 'Livestock : ', SUM(State_Chm%CH4_EMIS(:,:,5)) - WRITE(*,*) 'Landfills : ', SUM(State_Chm%CH4_EMIS(:,:,6)) - WRITE(*,*) 'Wastewater : ', SUM(State_Chm%CH4_EMIS(:,:,7)) - WRITE(*,*) 'Rice : ', SUM(State_Chm%CH4_EMIS(:,:,8)) - WRITE(*,*) 'Other anth : ', SUM(State_Chm%CH4_EMIS(:,:,9)) - WRITE(*,*) 'Biomass burn : ', SUM(State_Chm%CH4_EMIS(:,:,10)) - WRITE(*,*) 'Wetlands : ', SUM(State_Chm%CH4_EMIS(:,:,11)) - WRITE(*,*) 'Seeps : ', SUM(State_Chm%CH4_EMIS(:,:,12)) - WRITE(*,*) 'Lakes : ', SUM(State_Chm%CH4_EMIS(:,:,13)) - WRITE(*,*) 'Termites : ', SUM(State_Chm%CH4_EMIS(:,:,14)) - WRITE(*,*) 'Soil absorb : ', SUM(State_Chm%CH4_EMIS(:,:,15)) - WRITE(*,*) 'Reservoirs : ', SUM(State_Chm%CH4_EMIS(:,:,16)) - ENDIF - - ! ================================================================= - ! Do scaling for analytical inversion - ! ================================================================= - IF ( Input_Opt%DoAnalyticalInv .or. & - Input_Opt%UseEmisSF .or. & - Input_Opt%UseOHSF ) THEN - - ! Don't optimize for soil absorption so remove from the total - ! emissions array - State_Chm%CH4_EMIS(:,:,1) = State_Chm%CH4_EMIS(:,:,1) + State_Chm%CH4_EMIS(:,:,15) - - !$OMP PARALLEL DO & - !$OMP DEFAULT( SHARED ) & - !$OMP PRIVATE( I, J) - DO J = 1, State_Grid%NY - DO I = 1, State_Grid%NX - - !------------------------------------------------------------ - ! Apply emission scale factors from a previous inversion - !------------------------------------------------------------ - IF ( Input_Opt%UseEmisSF ) THEN - ! Scale total emissions - State_Chm%CH4_EMIS(I,J,1) = State_Chm%CH4_EMIS(I,J,1) * EMIS_SF(I,J) - ENDIF - - !------------------------------------------------------------ - ! Perturb emissions for analytical inversion - !------------------------------------------------------------ - IF ( Input_Opt%DoAnalyticalInv ) THEN - - ! Only apply emission perturbation to current state vector - ! element number - IF ( Input_Opt%StateVectorElement .GT. 0 ) THEN - - ! Convert STATE_VECTOR value to nearest integer for comparison - IF ( NINT(STATE_VECTOR(I,J)) == & - Input_Opt%StateVectorElement) THEN - State_Chm%CH4_EMIS(I,J,1) = State_Chm%CH4_EMIS(I,J,1) & - * Input_Opt%EmisPerturbFactor - - IF ( Input_Opt%Verbose ) THEN - Print*, 'Analytical Inversion: ', & - 'Scaled state vector element ', & - Input_Opt%StateVectorElement, ' by ', & - Input_Opt%EmisPerturbFactor - ENDIF - ENDIF - ENDIF - ENDIF - - ENDDO - ENDDO - !$OMP END PARALLEL DO - - ! Now that we've done the emission factor scaling, add soil absorption - ! back to the total emissions array - State_Chm%CH4_EMIS(:,:,1) = State_Chm%CH4_EMIS(:,:,1) - State_Chm%CH4_EMIS(:,:, 15) - - ENDIF - - IF ( Input_Opt%Verbose ) THEN - print*,'END SUBROUTINE: EMISSCH4' - ENDIF - - END SUBROUTINE EMISSCH4 -!EOC -!------------------------------------------------------------------------------ -! GEOS-Chem Global Chemical Transport Model ! -!------------------------------------------------------------------------------ -!BOP -! ! !IROUTINE: chemch4 ! ! !DESCRIPTION: Subroutine CHEMCH4 computes the chemical loss of CH4 @@ -848,8 +334,8 @@ SUBROUTINE CH4_DECAY( Input_Opt, State_Chm, State_Diag, & ! Pointers TYPE(SpcConc), POINTER :: Spc(:) - ! Array of scale factors for OH (from HEMCO) - REAL(fp) :: OH_SF(State_Grid%NX,State_Grid%NY) +! ! Array of scale factors for OH (from HEMCO) +! REAL(fp) :: OH_SF(State_Grid%NX,State_Grid%NY) !================================================================= ! CH4_DECAY begins here! @@ -864,20 +350,20 @@ SUBROUTINE CH4_DECAY( Input_Opt, State_Chm, State_Diag, & ! Point to the chemical species array Spc => State_Chm%Species - ! ================================================================= - ! Get fields for CH4 analytical inversions if needed - ! ================================================================= - IF ( Input_Opt%UseOHSF ) THEN - - ! Evaluate OH scale factors from HEMCO - CALL HCO_GC_EvalFld( Input_Opt, State_Grid, 'OH_SF', OH_SF, RC) - IF ( RC /= GC_SUCCESS ) THEN - ErrMsg = 'OH_SF not found in HEMCO data list!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - - ENDIF +! ! ================================================================= +! ! Get fields for CH4 analytical inversions if needed +! ! ================================================================= +! IF ( Input_Opt%UseOHSF ) THEN +! +! ! Evaluate OH scale factors from HEMCO +! CALL HCO_GC_EvalFld( Input_Opt, State_Grid, 'OH_SF', OH_SF, RC) +! IF ( RC /= GC_SUCCESS ) THEN +! ErrMsg = 'OH_SF not found in HEMCO data list!' +! CALL GC_Error( ErrMsg, RC, ThisLoc ) +! RETURN +! ENDIF +! +! ENDIF !================================================================= ! %%%%% HISTORY (aka netCDF diagnostics) %%%%% @@ -937,14 +423,14 @@ SUBROUTINE CH4_DECAY( Input_Opt, State_Chm, State_Diag, & ! BOH from HEMCO in units of kg/m3, convert to molec/cm3 C_OH = State_Chm%BOH(I,J,L) * XNUMOL_OH / CM3PERM3 - ! Apply OH scale factors from a previous inversion - IF ( Input_Opt%UseOHSF ) THEN - C_OH = C_OH * OH_SF(I,J) - IF ( Input_Opt%Verbose ) THEN - !This will print over every grid box; comment out for now - !Print*, 'Applying scale factor to OH: ', OH_SF(I,J) - ENDIF - ENDIF +! ! Apply OH scale factors from a previous inversion +! IF ( Input_Opt%UseOHSF ) THEN +! C_OH = C_OH * OH_SF(I,J) +! IF ( Input_Opt%Verbose ) THEN +! !This will print over every grid box; comment out for now +! !Print*, 'Applying scale factor to OH: ', OH_SF(I,J) +! ENDIF +! ENDIF ! Cl in [molec/cm3] ! BCl from HEMCO in units of mol/mol, convert to molec/cm3 @@ -1213,16 +699,6 @@ SUBROUTINE CH4_Metrics( Input_Opt, State_Chm, State_Diag, & Ktrop = 1.64e-12_f8 * EXP( -1520.0_f8 / State_Met%T(I,J,L) ) LossOHbyMCF = LossOHbyMCF + ( Ktrop * OHconc_MCM3 * airMass_m ) - !--------------------------------------------------------------- - ! HISTORY (aka netCDF diagnostics) - ! - ! Keep track of CH4 emisisons [kg/s] for computing - ! the various lifetime metrics in post-processing - !--------------------------------------------------------------- - IF ( L == 1 .and. State_Diag%Archive_CH4emission ) THEN - State_Diag%CH4emission(I,J) = State_Chm%CH4_EMIS(I,J,id_CH4) & - * State_Grid%Area_M2(I,J) - ENDIF ENDIF ENDDO @@ -1447,7 +923,7 @@ END SUBROUTINE CH4_STRAT ! !IROUTINE: ch4_distrib ! ! !DESCRIPTION: Subroutine CH4\_DISTRIB allocates the chemistry sink to -! different emission species. (ccc, 10/2/09) +! different CH4 species. (ccc, 10/2/09) !\\ !\\ ! !INTERFACE: diff --git a/GeosCore/hco_interface_gc_mod.F90 b/GeosCore/hco_interface_gc_mod.F90 index ef6a63feb..b3ad50f84 100644 --- a/GeosCore/hco_interface_gc_mod.F90 +++ b/GeosCore/hco_interface_gc_mod.F90 @@ -4163,85 +4163,6 @@ SUBROUTINE CheckSettings( HcoConfig, Input_Opt, State_Met, State_Chm, RC ) ENDIF - !----------------------------------------------------------------------- - ! Input data for CH4 simulations only - ! - ! If we have turned on CH4 options in geoschem_config.yml, then we - ! also need to toggle switches so that HEMCO reads the appropriate data. - !----------------------------------------------------------------------- - IF ( Input_Opt%ITS_A_CH4_SIM .or. Input_Opt%ITS_A_TAGCH4_SIM) THEN - - IF ( Input_Opt%DoAnalyticalInv ) THEN - CALL GetExtOpt( HcoConfig, -999, 'AnalyticalInv', & - OptValBool=LTMP, FOUND=FOUND, RC=HMRC ) - - IF ( HMRC /= HCO_SUCCESS ) THEN - RC = HMRC - ErrMsg = 'Error encountered in "GetExtOpt( AnalyticalInv )"!' - CALL GC_Error( ErrMsg, RC, ThisLoc, Instr ) - RETURN - ENDIF - IF ( .not. FOUND ) THEN - ErrMsg = 'AnalyticalInv not found in HEMCO_Config.rc file!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - IF ( .not. LTMP ) THEN - ErrMsg = 'AnalyticalInv is set to false in HEMCO_Config.rc ' // & - 'but should be set to true for this simulation.' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - ENDIF - - IF ( Input_Opt%UseEmisSF ) THEN - CALL GetExtOpt( HcoConfig, -999, 'Emis_ScaleFactor', & - OptValBool=LTMP, FOUND=FOUND, RC=HMRC ) - - IF ( HMRC /= HCO_SUCCESS ) THEN - RC = HMRC - ErrMsg = 'Error encountered in "GetExtOpt( Emis_ScaleFactor )"!' - CALL GC_Error( ErrMsg, RC, ThisLoc, Instr ) - RETURN - ENDIF - IF ( .not. FOUND ) THEN - ErrMsg = 'Emis_ScaleFactor not found in HEMCO_Config.rc file!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - IF ( .not. LTMP ) THEN - ErrMsg = 'Emis_ScaleFactor is set to false in HEMCO_Config.rc '// & - 'but should be set to true for this simulation.' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - ENDIF - - IF ( Input_Opt%UseOHSF ) THEN - CALL GetExtOpt( HcoConfig, -999, 'OH_ScaleFactor', & - OptValBool=LTMP, FOUND=FOUND, RC=HMRC ) - - IF ( HMRC /= HCO_SUCCESS ) THEN - RC = HMRC - ErrMsg = 'Error encountered in "GetExtOpt( OH_ScaleFactor )"!' - CALL GC_Error( ErrMsg, RC, ThisLoc, Instr ) - RETURN - ENDIF - IF ( .not. FOUND ) THEN - ErrMsg = 'OH_ScaleFactor not found in HEMCO_Config.rc file!' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - IF ( .not. LTMP ) THEN - ErrMsg = 'OH_ScaleFactor is set to false in HEMCO_Config.rc ' // & - 'but should be set to true for this simulation.' - CALL GC_Error( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - ENDIF - - ENDIF - !----------------------------------------------------------------------- ! RRTMG input data ! @@ -4781,19 +4702,7 @@ SUBROUTINE Compute_Sflx_for_Vdiff( Input_Opt, State_Chm, State_Diag, & ! Add total emissions in the PBL to the EFLX array ! which tracks emission fluxes. Units are [kg/m2/s]. !------------------------------------------------------------------ - IF ( Input_Opt%ITS_A_CH4_SIM ) THEN - - eflx(I,J,NA) = State_Chm%CH4_EMIS(I,J,1) - - ELSE IF ( Input_Opt%ITS_A_TAGCH4_SIM ) THEN - - ! CH4 emissions become stored in state_chm_mod.F90. - ! We use CH4_EMIS here instead of the HEMCO internal emissions - ! only to make sure that total CH4 emissions are properly defined - ! in a multi-tracer CH4 simulation. - eflx(I,J,NA) = State_Chm%CH4_EMIS(I,J,NA) - - ELSE IF ( EmisSpec ) THEN ! Are there emissions for these species? + IF ( EmisSpec ) THEN ! Are there emissions for these species? ! Compute emissions for all other simulation tmpFlx = 0.0_fp diff --git a/GeosCore/input_mod.F90 b/GeosCore/input_mod.F90 index 67613a24f..a02456f27 100644 --- a/GeosCore/input_mod.F90 +++ b/GeosCore/input_mod.F90 @@ -4888,46 +4888,6 @@ SUBROUTINE Config_CH4( Config, Input_Opt, RC ) ENDIF Input_Opt%TCCON_CH4_OBS = v_bool - !------------------------------------------------------------------------ - ! Do an analytical inversion? - !------------------------------------------------------------------------ - key = "CH4_simulation_options%analytical_inversion%activate" - v_bool = MISSING_BOOL - CALL QFYAML_Add_Get( Config, TRIM( key ), v_bool, "", RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error parsing ' // TRIM( key ) // '!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Input_Opt%DoAnalyticalInv = v_bool - - !------------------------------------------------------------------------ - ! Current state vector element number - !------------------------------------------------------------------------ - key = & - "CH4_simulation_options%analytical_inversion%state_vector_element_number" - v_int = MISSING_INT - CALL QFYAML_Add_Get( Config, TRIM( key ), v_int, "", RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error parsing ' // TRIM( key ) // '!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Input_Opt%StateVectorElement = v_int - - !------------------------------------------------------------------------ - ! Emission perturbation factor - !------------------------------------------------------------------------ - key = "CH4_simulation_options%analytical_inversion%emission_perturbation_factor" - v_str = MISSING_STR - CALL QFYAML_Add_Get( Config, TRIM( key ), v_str, "", RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error parsing ' // TRIM( key ) // '!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Input_Opt%EmisPerturbFactor = Cast_and_RoundOff( v_str, places=4 ) - !------------------------------------------------------------------------ ! Perturb CH4 boundary conditions? !------------------------------------------------------------------------ @@ -4957,33 +4917,6 @@ SUBROUTINE Config_CH4( Config, Input_Opt, RC ) Input_Opt%CH4BoundaryConditionIncreaseEast = Cast_and_RoundOff( a_str(3), places=4 ) Input_Opt%CH4BoundaryConditionIncreaseWest = Cast_and_RoundOff( a_str(4), places=4 ) - !------------------------------------------------------------------------ - ! Use emission scale factors from a previous inversion? - !------------------------------------------------------------------------ - key = & - "CH4_simulation_options%analytical_inversion%use_emission_scale_factor" - v_bool = MISSING_BOOL - CALL QFYAML_Add_Get( Config, TRIM( key ), v_bool, "", RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error parsing ' // TRIM( key ) // '!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Input_Opt%UseEmisSF = v_bool - - !------------------------------------------------------------------------ - ! Use OH scale factors from a previous inversion? - !------------------------------------------------------------------------ - key = "CH4_simulation_options%analytical_inversion%use_OH_scale_factors" - v_bool = MISSING_BOOL - CALL QFYAML_Add_Get( Config, TRIM( key ), v_bool, "", RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error parsing ' // TRIM( key ) // '!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - Input_Opt%UseOHSF = v_bool - !======================================================================== ! Print to screen !======================================================================== @@ -4993,24 +4926,17 @@ SUBROUTINE Config_CH4( Config, Input_Opt, RC ) WRITE(6,100) 'Use AIRS obs operator? : ', Input_Opt%AIRS_CH4_OBS WRITE(6,100) 'Use GOSAT obs operator? : ', Input_Opt%GOSAT_CH4_OBS WRITE(6,100) 'Use TCCON obs operator? : ', Input_Opt%TCCON_CH4_OBS - WRITE(6,100) 'Do analytical inversion? : ', Input_Opt%DoAnalyticalInv - WRITE(6,120) 'Current state vector elem: ', Input_Opt%StateVectorElement - WRITE(6,110) 'Emiss perturbation factor: ', Input_Opt%EmisPerturbFactor WRITE(6,100) 'Perturb CH4 BCs? : ', Input_Opt%DoPerturbCH4BoundaryConditions WRITE(6,130) 'CH4 BC ppb increase NSEW : ', Input_Opt%CH4BoundaryConditionIncreaseNorth,& Input_Opt%CH4BoundaryConditionIncreaseSouth,& Input_Opt%CH4BoundaryConditionIncreaseEast,& Input_Opt%CH4BoundaryConditionIncreaseWest - WRITE(6,100) 'Use emis scale factors? : ', Input_Opt%UseEmisSF - WRITE(6,100) 'Use OH scale factors? : ', Input_Opt%UseOHSF ENDIF ! FORMAT statements 90 FORMAT( /, A ) 95 FORMAT( A ) 100 FORMAT( A, L5 ) -110 FORMAT( A, f6.2 ) -120 FORMAT( A, I5 ) 130 FORMAT( A, F10.4, 1X, F10.4, 1X, F10.4, 1X, F10.4) END SUBROUTINE Config_CH4 diff --git a/Headers/state_chm_mod.F90 b/Headers/state_chm_mod.F90 index df1a117a9..6a8029e7e 100644 --- a/Headers/state_chm_mod.F90 +++ b/Headers/state_chm_mod.F90 @@ -329,8 +329,6 @@ MODULE State_Chm_Mod !----------------------------------------------------------------------- REAL(fp), POINTER :: BOH (:,:,: ) ! OH values [molec/cm3] REAL(fp), POINTER :: BCl (:,:,: ) ! Cl values [v/v] - REAL(fp), POINTER :: CH4_EMIS (:,:,: ) ! CH4 emissions [kg/m2/s]. - ! third dim is cat, total 15 LOGICAL :: IsCH4BCPerturbed ! Is CH4 BC perturbed? #ifdef APM @@ -537,7 +535,6 @@ SUBROUTINE Zero_State_Chm( State_Chm, RC ) State_Chm%TOMS2 => NULL() State_Chm%BOH => NULL() State_Chm%BCl => NULL() - State_Chm%CH4_EMIS => NULL() State_Chm%SFC_CH4 => NULL() State_Chm%UCX_REGRID => NULL() @@ -2243,23 +2240,6 @@ SUBROUTINE Init_State_Chm( Input_Opt, State_Chm, State_Grid, RC ) ! Initialize State_Chm quantities pertinent to CH4 simulations !======================================================================= IF ( Input_Opt%ITS_A_CH4_SIM .or. Input_Opt%ITS_A_TAGCH4_SIM ) THEN - ! CH4_EMIS - chmId = 'CH4_EMIS' - CALL Init_and_Register( & - Input_Opt = Input_Opt, & - State_Chm = State_Chm, & - State_Grid = State_Grid, & - chmId = chmId, & - Ptr2Data = State_Chm%CH4_EMIS, & - nSlots = 16, & - RC = RC ) - - IF ( RC /= GC_SUCCESS ) THEN - errMsg = TRIM( errMsg_ir ) // TRIM( chmId ) - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - ! Global OH and Cl from HEMCO input chmId = 'BOH' CALL Init_and_Register( & @@ -3598,13 +3578,6 @@ SUBROUTINE Cleanup_State_Chm( State_Chm, RC ) State_Chm%BCl => NULL() ENDIF - IF ( ASSOCIATED( State_Chm%CH4_EMIS ) ) THEN - DEALLOCATE( State_Chm%CH4_EMIS, STAT=RC ) - CALL GC_CheckVar( 'State_Chm%CH4_EMIS', 2, RC ) - IF ( RC /= GC_SUCCESS ) RETURN - State_Chm%CH4_EMIS => NULL() - ENDIF - #ifdef LUO_WETDEP IF ( ASSOCIATED( State_Chm%QQ3D ) ) THEN DEALLOCATE( State_Chm%QQ3D, STAT=RC ) @@ -4716,11 +4689,6 @@ SUBROUTINE Get_Metadata_State_Chm( am_I_Root, metadataID, Found, & IF ( isUnits ) Units = '' IF ( isRank ) Rank = 4 - CASE( 'CH4_EMIS' ) - IF ( isDesc ) Desc = 'CH4 emissions by sector, CH4 specialty simulation only' - IF ( isUnits ) Units = 'kg/m2/s' - IF ( isRank ) Rank = 3 - CASE( 'BOH' ) IF ( isDesc ) Desc = 'OH values, CH4 specialty simulation only' IF ( isUnits ) Units = 'molec/cm3' diff --git a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CH4 b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CH4 index 428f5fec5..d9150b511 100644 --- a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CH4 +++ b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CH4 @@ -89,9 +89,11 @@ VerboseOnCores: root # Accepted values: root all --> GLOBAL_CL : true # 2010-2019 --> OLSON_LANDMAP : true # 1985 --> YUAN_MODIS_LAI : true # 2000-2020 - --> AnalyticalInv : false - --> Emis_ScaleFactor : false - --> OH_ScaleFactor : false +# ----- OPTIONS FOR ANALYTICAL INVERSIONS ------------------------------------ + --> AnalyticalInversion : false + --> UseTotalPriorEmis : false # Skips global/regional inventories + --> Emis_PosteriorSF : false # Apply posterior scale factors to total emis? + --> OH_PosteriorSF : false # Apply posterior scale factor to global OH? # ----------------------------------------------------------------------------- 111 GFED : on CH4 --> GFED4 : true @@ -118,6 +120,22 @@ VerboseOnCores: root # Accepted values: root all (((EMISSIONS +#============================================================================== +# ---Total CH4 emissions (all sectors) from prior simulation --- +#============================================================================== +(((UseTotalPriorEmis + +(((Emis_PosteriorSF +0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 +)))Emis_PosteriorSF + +(((.not.Emis_PosteriorSF +0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 +))).not.Emis_PosteriorSF + +)))UseTotalPriorEmis + +(((.not.UseTotalPriorEmis #============================================================================== # --- Gridded GHGI v2 (Maasakkers et al., submitted to ES&T, 2023) --- # @@ -550,6 +568,8 @@ VerboseOnCores: root # Accepted values: root all 0 RCP85_CH4 $ROOT/RCP/v2020-07/RCP_85/RCPs_anthro_CH4_2005-2100_43533.nc ACCMIP 2005-2100/1/1/0 ID xy kg/m2/s CH4 - 1 1 )))RCP_85 +))).not.UseTotalPriorEmis + )))EMISSIONS ############################################################################### @@ -659,7 +679,15 @@ ${RUNDIR_CH4_LOSS} # --- Global OH from GEOS-Chem v5-07 [kg/m3] --- (((GLOBAL_OH + +(((OH_PosteriorSF +* GLOBAL_OH $ROOT/OH/v2014-09/v5-07-08/OH_3Dglobal.geos5.47L.4x5.nc OH 1985/1-12/1/0 C xyz kg/m3 * 2/4 1 1 +)))OH_PosteriorSF + +(((.not.OH_PosteriorSF * GLOBAL_OH $ROOT/OH/v2014-09/v5-07-08/OH_3Dglobal.geos5.47L.4x5.nc OH 1985/1-12/1/0 C xyz kg/m3 * 2 1 1 +))).not.OH_PosteriorSF + )))GLOBAL_OH # --- Global Cl [mol/mol dry air] --- @@ -839,36 +867,10 @@ ${RUNDIR_GLOBAL_Cl} #============================================================================== # --- Files needed for analytical inversion --- -# -# These fields are are only used if analytical_inversion?' is activated in -# geoschem_config.yml. These fields are obtained from HEMCO and applied in -# GEOS-Chem/GeosCore/global_ch4_mod.F90. -# -# Entries below provided for examples only. Add your own here! #============================================================================== -(((AnalyticalInv - -# State vector file +(((AnalyticalInversion * CH4_STATE_VECTOR StateVector.nc StateVector 2009/1/1/0 C xy 1 * - 1 1 - -)))AnalyticalInv - -#============================================================================== -# --- Scale factors for posterior run --- -# -# Enable emission scale factors by setting the use_emission_scale_factor or -# use_OH_scale_factor options to true in geoschem_config.yml. These fields are -# obtained from HEMCO and applied in GEOS-Chem/GeosCore/global_ch4_mod.F90. -# -# Entries below are provided for examples only. Add your own here! -#============================================================================== -(((Emis_ScaleFactor -* EMIS_SF gridded_posterior.nc ScaleFactor 2000/1/1/0 C xy 1 * - 1 1 -)))Emis_ScaleFactor - -(((OH_ScaleFactor -* OH_SF Post_SF_OH.nc SF_OH 2010-2017/1/1/0 E xy 1 * - 1 1 -)))OH_ScaleFactor +)))AnalyticalInversion ### END SECTION BASE EMISSIONS ### @@ -893,8 +895,35 @@ ${RUNDIR_GLOBAL_Cl} #============================================================================== 2 OH_pert_factor 1.0 - - - xy 1 1 -(((EMISSIONS +#============================================================================== +# --- Scale factors for posterior run --- +# +# Enable emission scale factors by setting the use_emission_scale_factor or +# use_OH_scale_factor options to true in geoschem_config.yml. These fields are +# obtained from HEMCO and applied in GEOS-Chem/GeosCore/global_ch4_mod.F90. +# +# Entries below are provided for examples only. Add your own here! +#============================================================================== +(((Emis_PosteriorSF +3 EMIS_SF gridded_posterior.nc ScaleFactor 2000/1/1/0 C xy 1 1 +)))Emis_PosteriorSF + +(((OH_PosteriorSF +4 OH_SF Post_SF_OH.nc SF_OH 2010-2017/1/1/0 C xy 1 1 +)))OH_PosteriorSF + +#============================================================================== +# --- Scale factors for analytical inversions --- +#============================================================================== +(((AnalyticalInversion + +# Add perturbations to individual state vector element (N) following this format +# Start scale factor ID at 2000 to avoid conflicts with other SFs/masks +#200N SCALE_ELEM_000N ./Perturbations.txt - - - xy count 1 +)))AnalyticalInversion + +(((EMISSIONS #============================================================================== # --- Seasonal scaling factors ---- #============================================================================== diff --git a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon index d30c299fb..cc4cc333c 100644 --- a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon +++ b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon @@ -86,10 +86,6 @@ Mask fractions: false # ..... Non-Emissions Data ........... --> CH4_LOSS_FREQ : true # 1985 --> GLOBAL_CL : true # 2010-2019 -# ..... Options for the IMI .......... - --> AnalyticalInv : false - --> Emis_ScaleFactor : false - --> OH_ScaleFactor : false # ----- CO and CO2-only INVENTORIES AND DATA ---------------------------------- # ..... Global inventories ........... --> AEIC2019_DAILY : false # 2019 (daily data) @@ -138,6 +134,11 @@ Mask fractions: false --> YUAN_MODIS_LAI : true # 2000-2020 --> GLOBAL_OH_GC14 : false # 2010-2019 --> GLOBAL_OH_GCv5 : true # 1985 (recommended for CH4) +# ----- Options for analytical inversions ------------------------------------- + --> AnalyticalInversion : false + --> UseTotalPriorEmis : false # Skips global/regional inventories + --> Emis_PosteriorSF : false # Apply posterior scale factors to total emis? + --> OH_PosteriorSF : false # Apply posterior scale factor to global OH? # ----------------------------------------------------------------------------- 111 GFED : on CH4/CO/CO2 --> GFED4 : true @@ -160,6 +161,23 @@ Mask fractions: false #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (((USE_CH4_DATA +#============================================================================== +# ---Total CH4 emissions (all sectors) from prior simulation --- +#============================================================================== +(((UseTotalPriorEmis + +(((Emis_PosteriorSF +0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 +)))Emis_PosteriorSF + +(((.not.Emis_PosteriorSF +0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 +))).not.Emis_PosteriorSF + +)))UseTotalPriorEmis + +(((.not.UseTotalPriorEmis + #============================================================================== # --- CH4: Gridded GHGI v2 (Maasakkers et al., submitted to ES&T, 2023) --- # @@ -577,6 +595,8 @@ Mask fractions: false 0 RCP85_CH4 $ROOT/RCP/v2020-07/RCP_85/RCPs_anthro_CH4_2005-2100_43533.nc ACCMIP 2005-2100/1/1/0 ID xy kg/m2/s CH4 - 1 1 )))RCP_85 +))).not.UseTotalPriorEmis + )))USE_CH4_DATA #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1259,36 +1279,10 @@ Mask fractions: false #------------------------------------------------------------------------------ # --- Files needed for analytical inversion --- -# -# These fields are are only used if analytical_inversion?' is activated in -# geoschem_config.yml. These fields are obtained from HEMCO and applied in -# GEOS-Chem/GeosCore/global_ch4_mod.F90. -# -# Entries below provided for examples only. Add your own here! -#------------------------------------------------------------------------------ -(((AnalyticalInv - -# State vector file -* CH4_STATE_VECTOR StateVector.nc StateVector 2009/1/1/0 C xy 1 * - 1 1 - -)))AnalyticalInv - -#------------------------------------------------------------------------------ -# --- Scale factors for posterior run --- -# -# Enable emission scale factors by setting the use_emission_scale_factor or -# use_OH_scale_factor options to true in geoschem_config.yml. These fields are -# obtained from HEMCO and applied in GEOS-Chem/GeosCore/global_ch4_mod.F90. -# -# Entries below are provided for examples only. Add your own here! #------------------------------------------------------------------------------ -(((Emis_ScaleFactor -* EMIS_SF gridded_posterior.nc ScaleFactor 2000/1/1/0 C xy 1 * - 1 1 -)))Emis_ScaleFactor - -(((OH_ScaleFactor -* OH_SF Post_SF_OH.nc SF_OH 2010-2017/1/1/0 E xy 1 * - 1 1 -)))OH_ScaleFactor +(((AnalyticalInversion +* CH4_STATE_VECTOR StateVector.nc StateVector 2009/1/1/0 C xy 1 * - 1 1 +)))AnalyticalInversion )))USE_CH4_DATA @@ -1302,7 +1296,15 @@ Mask fractions: false #------------------------------------------------------------------------------ # --- OH from GEOS-Chem v5-07 [kg/m3], needed for CH4/IMI --- (((GLOBAL_OH_GCv5 + +(((OH_PosteriorSF +* GLOBAL_OH $ROOT/OH/v2022-11/v5-07-08/OH_3Dglobal.geos5.47L.4x5.nc OH 1985/1-12/1/0 C xyz kg/m3 * 2/4 1 1 +)))OH_PosteriorSF + +(((.not.OH_PosteriorSF * GLOBAL_OH $ROOT/OH/v2022-11/v5-07-08/OH_3Dglobal.geos5.47L.4x5.nc OH 1985/1-12/1/0 C xyz kg/m3 * 2 1 1 +))).not.OH_PosteriorSF + )))GLOBAL_OH_GCv5 # --- OH from the last 10-yr benchmark [mol/mol dry air] --- @@ -1390,8 +1392,35 @@ ${RUNDIR_CO2_COPROD} #============================================================================== 2 OH_pert_factor 1.0 - - - xy 1 1 -(((EMISSIONS +#============================================================================== +# --- Scale factors for posterior run --- +# +# Enable emission scale factors by setting the use_emission_scale_factor or +# use_OH_scale_factor options to true in geoschem_config.yml. These fields are +# obtained from HEMCO and applied in GEOS-Chem/GeosCore/global_ch4_mod.F90. +# +# Entries below are provided for examples only. Add your own here! +#============================================================================== +(((Emis_PosteriorSF +3 EMIS_SF gridded_posterior.nc ScaleFactor 2000/1/1/0 C xy 1 1 +)))Emis_PosteriorSF + +(((OH_PosteriorSF +4 OH_SF Post_SF_OH.nc SF_OH 2010-2017/1/1/0 C xy 1 1 +)))OH_PosteriorSF + +#============================================================================== +# --- Scale factors for analytical inversions --- +#============================================================================== +(((AnalyticalInversion + +# Add perturbations to individual state vector element (N) following this format +# Start scale factor ID at 2000 to avoid conflicts with other SFs/masks +#200N SCALE_ELEM_000N ./Perturbations.txt - - - xy count 1 +)))AnalyticalInversion + +(((EMISSIONS #============================================================================== # --- Seasonal scaling factors ---- #============================================================================== diff --git a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.tagCH4 b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.tagCH4 index de0a3dc06..effca16ac 100644 --- a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.tagCH4 +++ b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.tagCH4 @@ -96,9 +96,11 @@ VerboseOnCores: root # Accepted values: root all --> GLOBAL_CL : true # 2010-2019 --> OLSON_LANDMAP : true # 1985 --> YUAN_MODIS_LAI : true # 2000-2020 - --> AnalyticalInv : false - --> Emis_ScaleFactor : false - --> OH_ScaleFactor : false +# ----- OPTIONS FOR ANALYTICAL INVERSIONS ------------------------------------ + --> AnalyticalInversion : false + --> UseTotalPriorEmis : false # Skips global/regional inventories + --> Emis_PosteriorSF : false # Apply posterior scale factors to total emis? + --> OH_PosteriorSF : false # Apply posterior scale factor to global OH? # ----------------------------------------------------------------------------- 111 GFED : on CH4/CH4_BBN --> GFED4 : true @@ -125,6 +127,22 @@ VerboseOnCores: root # Accepted values: root all (((EMISSIONS +#============================================================================== +# ---Total CH4 emissions (all sectors) from prior simulation --- +#============================================================================== +(((UseTotalPriorEmis + +(((Emis_PosteriorSF +0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 +)))Emis_PosteriorSF + +(((.not.Emis_PosteriorSF +0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 +))).not.Emis_PosteriorSF + +)))UseTotalPriorEmis + +(((.not.UseTotalPriorEmis #============================================================================== # --- Gridded GHGI v2 (Maasakkers et al., submitted to ES&T, 2023) --- # @@ -761,6 +779,8 @@ VerboseOnCores: root # Accepted values: root all 0 RCP85_CH4 $ROOT/RCP/v2020-07/RCP_85/RCPs_anthro_CH4_2005-2100_43533.nc ACCMIP 2005-2100/1/1/0 ID xy kg/m2/s CH4 - 1 1 )))RCP_85 +))).not.UseTotalPriorEmis + )))EMISSIONS ############################################################################### @@ -870,7 +890,15 @@ ${RUNDIR_CH4_LOSS} # --- Global OH from GEOS-Chem v5-07 [kg/m3] --- (((GLOBAL_OH + +(((OH_PosteriorSF +* GLOBAL_OH $ROOT/OH/v2014-09/v5-07-08/OH_3Dglobal.geos5.47L.4x5.nc OH 1985/1-12/1/0 C xyz kg/m3 * 2/4 1 1 +)))OH_PosteriorSF + +(((.not.OH_PosteriorSF * GLOBAL_OH $ROOT/OH/v2014-09/v5-07-08/OH_3Dglobal.geos5.47L.4x5.nc OH 1985/1-12/1/0 C xyz kg/m3 * 2 1 1 +))).not.OH_PosteriorSF + )))GLOBAL_OH # --- Global Cl [mol/mol dry air] --- @@ -1050,36 +1078,10 @@ ${RUNDIR_GLOBAL_Cl} #============================================================================== # --- Files needed for analytical inversion --- -# -# These fields are are only used if analytical_inversion?' is activated in -# geoschem_config.yml. These fields are obtained from HEMCO and applied in -# GEOS-Chem/GeosCore/global_ch4_mod.F90. -# -# Entries below provided for examples only. Add your own here! #============================================================================== -(((AnalyticalInv - -# State vector file +(((AnalyticalInversion * CH4_STATE_VECTOR StateVector.nc StateVector 2009/1/1/0 C xy 1 * - 1 1 - -)))AnalyticalInv - -#============================================================================== -# --- Scale factors for posterior run --- -# -# Enable emission scale factors by setting the use_emission_scale_factor or -# use_OH_scale_factor options to true in geoschem_config.yml. These fields are -# obtained from HEMCO and applied in GEOS-Chem/GeosCore/global_ch4_mod.F90. -# -# Entries below are provided for examples only. Add your own here! -#============================================================================== -(((Emis_ScaleFactor -* EMIS_SF gridded_posterior.nc ScaleFactor 2000/1/1/0 C xy 1 * - 1 1 -)))Emis_ScaleFactor - -(((OH_ScaleFactor -* OH_SF Post_SF_OH.nc SF_OH 2010-2017/1/1/0 E xy 1 * - 1 1 -)))OH_ScaleFactor +)))AnalyticalInversion ### END SECTION BASE EMISSIONS ### @@ -1104,8 +1106,35 @@ ${RUNDIR_GLOBAL_Cl} #============================================================================== 2 OH_pert_factor 1.0 - - - xy 1 1 -(((EMISSIONS +#============================================================================== +# --- Scale factors for posterior run --- +# +# Enable emission scale factors by setting the use_emission_scale_factor or +# use_OH_scale_factor options to true in geoschem_config.yml. These fields are +# obtained from HEMCO and applied in GEOS-Chem/GeosCore/global_ch4_mod.F90. +# +# Entries below are provided for examples only. Add your own here! +#============================================================================== +(((Emis_PosteriorSF +3 EMIS_SF gridded_posterior.nc ScaleFactor 2000/1/1/0 C xy 1 1 +)))Emis_PosteriorSF + +(((OH_PosteriorSF +4 OH_SF Post_SF_OH.nc SF_OH 2010-2017/1/1/0 C xy 1 1 +)))OH_PosteriorSF +#============================================================================== +# --- Scale factors for analytical inversions --- +#============================================================================== +(((AnalyticalInversion + +# Add perturbations to individual state vector element (N) following this format +# Start scale factor ID at 2000 to avoid conflicts with other SFs/masks +#200N SCALE_ELEM_000N ./Perturbations.txt - - - xy count 1 + +)))AnalyticalInversion + +(((EMISSIONS #============================================================================== # --- Seasonal scaling factors ---- #============================================================================== @@ -1122,9 +1151,6 @@ ${RUNDIR_GLOBAL_Cl} 59 GHGI_OTH_BUR_SF $ROOT/CH4/v2023-07/Gridded_GHGI_v2/Gridded_GHGI_Methane_v2_Monthly_Scale_Factors_$YYYY.nc monthly_scale_factor_3F_Field_Burning 2012-2018/1-12/1/0 C xy 1 1 )))GHGI_v2.or.GHGI_v2_Express_Ext -#============================================================================== -# --- Seasonal scaling factors ---- -#============================================================================== (((Scarpelli_Mexico.or.Scarpelli_Canada 10 MANURE_SF $ROOT/CH4/v2017-10/Seasonal_SF/EMICH4_Manure_ScalingFactors.WithClimatology.nc sf_ch4 2008-2016/1-12/1/0 C xy 1 1 11 RICE_SF $ROOT/CH4/v2017-10/Seasonal_SF/EMICH4_Rice_ScalingFactors.SetMissing.nc sf_ch4 2012/1-12/1/0 C xy 1 1 diff --git a/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.CH4 b/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.CH4 index 1c04432fa..731590b20 100644 --- a/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.CH4 +++ b/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.CH4 @@ -75,13 +75,8 @@ CH4_simulation_options: TCCON: false analytical_inversion: - activate: false - state_vector_element_number: 0 - emission_perturbation_factor: 1.0 perturb_CH4_boundary_conditions: false CH4_boundary_condition_ppb_increase_NSEW: [0.0, 0.0, 0.0, 0.0] - use_emission_scale_factor: false - use_OH_scale_factors: false #============================================================================ # Settings for diagnostics (other than HISTORY and HEMCO) diff --git a/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.carbon b/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.carbon index 36f5499cd..3eb7e5dad 100644 --- a/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.carbon +++ b/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.carbon @@ -78,13 +78,8 @@ CH4_simulation_options: TCCON: false analytical_inversion: - activate: false - state_vector_element_number: 0 - emission_perturbation_factor: 1.0 perturb_CH4_boundary_conditions: false CH4_boundary_condition_ppb_increase_NSEW: [0.0, 0.0, 0.0, 0.0] - use_emission_scale_factor: false - use_OH_scale_factors: false #============================================================================ # Options for CO diff --git a/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.tagCH4 b/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.tagCH4 index 68a3623eb..2c872a89a 100644 --- a/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.tagCH4 +++ b/run/GCClassic/geoschem_config.yml.templates/geoschem_config.yml.tagCH4 @@ -90,13 +90,8 @@ CH4_simulation_options: TCCON: false analytical_inversion: - activate: false - state_vector_element_number: 0 - emission_perturbation_factor: 1.0 perturb_CH4_boundary_conditions: false CH4_boundary_condition_ppb_increase_NSEW: [0.0, 0.0, 0.0, 0.0] - use_emission_scale_factor: false - use_OH_scale_factors: false #============================================================================ # Settings for diagnostics (other than HISTORY and HEMCO) diff --git a/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon b/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon index 9dc36cfbd..6b869d107 100644 --- a/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon +++ b/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon @@ -86,10 +86,6 @@ Mask fractions: false # ..... Non-Emissions Data ........... --> CH4_LOSS_FREQ : true # 1985 --> GLOBAL_CL : true # 2010-2019 -# ..... Options for the IMI .......... - --> AnalyticalInv : false - --> Emis_ScaleFactor : false - --> OH_ScaleFactor : false # ----- CO and CO2-only INVENTORIES AND DATA ---------------------------------- # ..... Global inventories ........... --> AEIC2019_DAILY : false # 2019 (daily data) @@ -138,6 +134,11 @@ Mask fractions: false --> YUAN_MODIS_LAI : true # 2000-2020 --> GLOBAL_OH_GC14 : false # 2010-2019 --> GLOBAL_OH_GCv5 : true # 1985 (recommended for CH4) +# ----- Options for analytical inversions ------------------------------------- + --> AnalyticalInversion : false + --> UseTotalPriorEmis : false # Skips global/regional inventories + --> Emis_PosteriorSF : false # Apply posterior scale factors to total emis? + --> OH_PosteriorSF : false # Apply posterior scale factor to global OH? # ----------------------------------------------------------------------------- 111 GFED : on CH4/CO/CO2 --> GFED4 : true @@ -160,6 +161,23 @@ Mask fractions: false #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (((USE_CH4_DATA +#============================================================================== +# ---Total CH4 emissions (all sectors) from prior simulation --- +#============================================================================== +(((UseTotalPriorEmis + +(((Emis_PosteriorSF +0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 +)))Emis_PosteriorSF + +(((.not.Emis_PosteriorSF +0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 +))).not.Emis_PosteriorSF + +)))UseTotalPriorEmis + +(((.not.UseTotalPriorEmis + #============================================================================== # --- CH4: Gridded GHGI v2 (Maasakkers et al., submitted to ES&T, 2023) --- # @@ -577,6 +595,8 @@ Mask fractions: false 0 RCP85_CH4 $ROOT/RCP/v2020-07/RCP_85/RCPs_anthro_CH4_2005-2100_43533.nc ACCMIP 2005-2100/1/1/0 ID xy kg/m2/s CH4 - 1 1 )))RCP_85 +))).not.UseTotalPriorEmis + )))USE_CH4_DATA #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1259,36 +1279,10 @@ Mask fractions: false #------------------------------------------------------------------------------ # --- Files needed for analytical inversion --- -# -# These fields are are only used if analytical_inversion?' is activated in -# geoschem_config.yml. These fields are obtained from HEMCO and applied in -# GEOS-Chem/GeosCore/global_ch4_mod.F90. -# -# Entries below provided for examples only. Add your own here! -#------------------------------------------------------------------------------ -(((AnalyticalInv - -# State vector file -* CH4_STATE_VECTOR StateVector.nc StateVector 2009/1/1/0 C xy 1 * - 1 1 - -)))AnalyticalInv - -#------------------------------------------------------------------------------ -# --- Scale factors for posterior run --- -# -# Enable emission scale factors by setting the use_emission_scale_factor or -# use_OH_scale_factor options to true in geoschem_config.yml. These fields are -# obtained from HEMCO and applied in GEOS-Chem/GeosCore/global_ch4_mod.F90. -# -# Entries below are provided for examples only. Add your own here! #------------------------------------------------------------------------------ -(((Emis_ScaleFactor -* EMIS_SF gridded_posterior.nc ScaleFactor 2000/1/1/0 C xy 1 * - 1 1 -)))Emis_ScaleFactor - -(((OH_ScaleFactor -* OH_SF Post_SF_OH.nc SF_OH 2010-2017/1/1/0 E xy 1 * - 1 1 -)))OH_ScaleFactor +(((AnalyticalInversion +* CH4_STATE_VECTOR StateVector.nc StateVector 2009/1/1/0 C xy 1 * - 1 1 +)))AnalyticalInversion )))USE_CH4_DATA @@ -1302,7 +1296,15 @@ Mask fractions: false #------------------------------------------------------------------------------ # --- OH from GEOS-Chem v5-07 [kg/m3], needed for CH4/IMI --- (((GLOBAL_OH_GCv5 + +(((OH_PosteriorSF +* GLOBAL_OH $ROOT/OH/v2022-11/v5-07-08/OH_3Dglobal.geos5.47L.4x5.nc OH 1985/1-12/1/0 C xyz kg/m3 * 2/4 1 1 +)))OH_PosteriorSF + +(((.not.OH_PosteriorSF * GLOBAL_OH $ROOT/OH/v2022-11/v5-07-08/OH_3Dglobal.geos5.47L.4x5.nc OH 1985/1-12/1/0 C xyz kg/m3 * 2 1 1 +))).not.OH_PosteriorSF + )))GLOBAL_OH_GCv5 # --- OH from the last 10-yr benchmark [mol/mol dry air] --- @@ -1390,8 +1392,35 @@ ${RUNDIR_CO2_COPROD} #============================================================================== 2 OH_pert_factor 1.0 - - - xy 1 1 -(((EMISSIONS +#============================================================================== +# --- Scale factors for posterior run --- +# +# Enable emission scale factors by setting the use_emission_scale_factor or +# use_OH_scale_factor options to true in geoschem_config.yml. These fields are +# obtained from HEMCO and applied in GEOS-Chem/GeosCore/global_ch4_mod.F90. +# +# Entries below are provided for examples only. Add your own here! +#============================================================================== +(((Emis_PosteriorSF +3 EMIS_SF gridded_posterior.nc ScaleFactor 2000/1/1/0 C xy 1 1 +)))Emis_PosteriorSF + +(((OH_PosteriorSF +4 OH_SF Post_SF_OH.nc SF_OH 2010-2017/1/1/0 C xy 1 1 +)))OH_PosteriorSF + +#============================================================================== +# --- Scale factors for analytical inversions --- +#============================================================================== +(((AnalyticalInversion + +# Add perturbations to individual state vector element (N) following this format +# Start scale factor ID at 2000 to avoid conflicts with other SFs/masks +#200N SCALE_ELEM_000N ./Perturbations.txt - - - xy count 1 +)))AnalyticalInversion + +(((EMISSIONS #============================================================================== # --- Seasonal scaling factors ---- #============================================================================== From 6bb9561d3a98fef762163f8a69cdcf9d9b0a9657 Mon Sep 17 00:00:00 2001 From: Melissa Sulprizio Date: Wed, 3 Jan 2024 13:52:25 -0500 Subject: [PATCH 3/5] Loop over advected species in global_ch4_mod.F90 to allow for multiple CH4 tracers Subroutines CH4_DECAY and CH4_STRAT have been modified to loop over the number of advected species in the CH4 simulation. This allows for multiple CH4 tracers (as used in the analytical inversion framework to represent individual state vector elements). Signed-off-by: Melissa Sulprizio --- CHANGELOG.md | 1 + GeosCore/global_ch4_mod.F90 | 245 +++++++++++++++++------------------- 2 files changed, 118 insertions(+), 128 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 30570f48e..adc99039f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), ## [Unreleased] ### Changed - Removed emissions handling from `global_ch4_mod.F90` and `carbon_mod.F90` and instead apply scale factors to emissions directly in `HEMCO_Config.rc` +- Loop over advected species CH4 chemistry routines to allow for multiple CH4 tracers within analytical inversion framework ### Removed - Removed State_Chm%CH4_EMIS diff --git a/GeosCore/global_ch4_mod.F90 b/GeosCore/global_ch4_mod.F90 index e6612e636..c7725347f 100644 --- a/GeosCore/global_ch4_mod.F90 +++ b/GeosCore/global_ch4_mod.F90 @@ -248,8 +248,7 @@ SUBROUTINE CHEMCH4( Input_Opt, State_Chm, State_Diag, & State_Grid, State_Met, RC ) !================================================================= - ! Distribute the chemistry sink from total CH4 to other CH4 - ! species. (ccc, 2/10/09) + ! Distribute the chemistry sink from total CH4 to tagged species !================================================================= IF ( Input_Opt%ITS_A_TAGCH4_SIM ) THEN CALL CH4_DISTRIB( Input_Opt, State_Chm, State_Grid, PREVCH4 ) @@ -325,7 +324,7 @@ SUBROUTINE CH4_DECAY( Input_Opt, State_Chm, State_Diag, & ! !LOCAL VARIABLES: ! ! Scalars - INTEGER :: I, J, L + INTEGER :: I, J, L, N, NA REAL(fp) :: DT, GCH4, Spc2GCH4 REAL(fp) :: KRATE, C_OH REAL(fp) :: KRATE_Cl, C_Cl @@ -334,9 +333,6 @@ SUBROUTINE CH4_DECAY( Input_Opt, State_Chm, State_Diag, & ! Pointers TYPE(SpcConc), POINTER :: Spc(:) -! ! Array of scale factors for OH (from HEMCO) -! REAL(fp) :: OH_SF(State_Grid%NX,State_Grid%NY) - !================================================================= ! CH4_DECAY begins here! !================================================================= @@ -350,21 +346,6 @@ SUBROUTINE CH4_DECAY( Input_Opt, State_Chm, State_Diag, & ! Point to the chemical species array Spc => State_Chm%Species -! ! ================================================================= -! ! Get fields for CH4 analytical inversions if needed -! ! ================================================================= -! IF ( Input_Opt%UseOHSF ) THEN -! -! ! Evaluate OH scale factors from HEMCO -! CALL HCO_GC_EvalFld( Input_Opt, State_Grid, 'OH_SF', OH_SF, RC) -! IF ( RC /= GC_SUCCESS ) THEN -! ErrMsg = 'OH_SF not found in HEMCO data list!' -! CALL GC_Error( ErrMsg, RC, ThisLoc ) -! RETURN -! ENDIF -! -! ENDIF - !================================================================= ! %%%%% HISTORY (aka netCDF diagnostics) %%%%% ! @@ -395,85 +376,86 @@ SUBROUTINE CH4_DECAY( Input_Opt, State_Chm, State_Diag, & ! ! This is from Kirschke et al., Nat. Geosci., 2013. !================================================================= + DO NA = 1, State_Chm%nAdvect - !$OMP PARALLEL DO & - !$OMP DEFAULT( SHARED ) & - !$OMP PRIVATE( L, J, I, KRATE, Spc2GCH4, GCH4, C_OH ) & - !$OMP PRIVATE( C_Cl, KRATE_Cl ) & - !$OMP REDUCTION( +:TROPOCH4 ) - DO L = 1, State_Grid%NZ - DO J = 1, State_Grid%NY - DO I = 1, State_Grid%NX + ! Advected species ID + N = State_Chm%Map_Advect(NA) - ! Only consider tropospheric boxes - IF ( State_Met%InTroposphere(I,J,L) ) THEN - - ! Calculate rate coefficients - KRATE = 2.45e-12_fp * EXP( -1775e+0_fp / State_Met%T(I,J,L)) - KRATE_Cl = 9.60e-12_fp * EXP( -1360e+0_fp / State_Met%T(I,J,L)) - - ! Conversion from [kg/box] --> [molec/cm3] - ! [kg CH4/box] * [box/cm3] * XNUMOL_CH4 [molec CH4/kg CH4] - Spc2GCH4 = 1e+0_fp / State_Met%AIRVOL(I,J,L) / 1e+6_fp * XNUMOL_CH4 - - ! CH4 in [molec/cm3] - GCH4 = Spc(1)%Conc(I,J,L) * Spc2GCH4 - - ! OH in [molec/cm3] - ! BOH from HEMCO in units of kg/m3, convert to molec/cm3 - C_OH = State_Chm%BOH(I,J,L) * XNUMOL_OH / CM3PERM3 - -! ! Apply OH scale factors from a previous inversion -! IF ( Input_Opt%UseOHSF ) THEN -! C_OH = C_OH * OH_SF(I,J) -! IF ( Input_Opt%Verbose ) THEN -! !This will print over every grid box; comment out for now -! !Print*, 'Applying scale factor to OH: ', OH_SF(I,J) -! ENDIF -! ENDIF - - ! Cl in [molec/cm3] - ! BCl from HEMCO in units of mol/mol, convert to molec/cm3 - C_Cl = State_Chm%BCl(I,J,L) * State_Met%AIRNUMDEN(I,J,L) - - TROPOCH4 = TROPOCH4 + GCH4 * KRATE * C_OH * DT / Spc2GCH4 & - + GCH4 * KRATE_Cl * C_Cl * DT / Spc2GCH4 - - !----------------------------------------------------------- - ! %%%%% HISTORY (aka netCDF diagnostics) %%%%% - ! - ! Archive Loss of CH4 (kg/s) reactions with OH and Cl - !----------------------------------------------------------- - - ! Loss CH4 by reaction with Cl [kg/s] - IF ( State_Diag%Archive_LossCH4byClinTrop ) THEN - State_Diag%LossCH4byClinTrop(I,J,L) = & - ( GCH4 * KRATE_Cl * C_Cl ) / Spc2GCH4 - ENDIF + ! Only do chemistry for the total CH4 tracer in tagCH4 simulations + IF ( Input_Opt%ITS_A_TAGCH4_SIM .and. NA > 1 ) CYCLE - IF ( State_Diag%Archive_LossCH4byOHinTrop ) THEN - State_Diag%LossCH4byOHinTrop(I,J,L) = & - ( GCH4 * KRATE * C_OH ) / Spc2GCH4 - ENDIF + !$OMP PARALLEL DO & + !$OMP DEFAULT( SHARED ) & + !$OMP PRIVATE( I, J, L, KRATE, Spc2GCH4, GCH4, C_OH ) & + !$OMP PRIVATE( C_Cl, KRATE_Cl ) & + !$OMP REDUCTION( +:TROPOCH4 ) + DO L = 1, State_Grid%NZ + DO J = 1, State_Grid%NY + DO I = 1, State_Grid%NX - ! Calculate new CH4 value: [CH4]=[CH4](1-k[OH]*delt) - GCH4 = GCH4 * & - ( 1.0_fp - ( KRATE * C_OH * DT ) - ( KRATE_Cl * C_Cl * DT ) ) + ! Only consider tropospheric boxes + IF ( State_Met%InTroposphere(I,J,L) ) THEN - ! Convert back from [molec/cm3] --> [kg/box] - Spc(1)%Conc(I,J,L) = GCH4 / Spc2GCH4 + ! Calculate rate coefficients + KRATE = 2.45e-12_fp * EXP( -1775e+0_fp / State_Met%T(I,J,L)) + KRATE_Cl = 9.60e-12_fp * EXP( -1360e+0_fp / State_Met%T(I,J,L)) + + ! Conversion from [kg/box] --> [molec/cm3] + ! [kg CH4/box] * [box/cm3] * XNUMOL_CH4 [molec CH4/kg CH4] + Spc2GCH4 = 1e+0_fp / State_Met%AIRVOL(I,J,L) / 1e+6_fp * XNUMOL_CH4 + + ! CH4 in [molec/cm3] + GCH4 = Spc(N)%Conc(I,J,L) * Spc2GCH4 + + ! OH in [molec/cm3] + ! BOH from HEMCO in units of kg/m3, convert to molec/cm3 + C_OH = State_Chm%BOH(I,J,L) * XNUMOL_OH / CM3PERM3 + + ! Cl in [molec/cm3] + ! BCl from HEMCO in units of mol/mol, convert to molec/cm3 + C_Cl = State_Chm%BCl(I,J,L) * State_Met%AIRNUMDEN(I,J,L) + + TROPOCH4 = TROPOCH4 + GCH4 * KRATE * C_OH * DT / Spc2GCH4 & + + GCH4 * KRATE_Cl * C_Cl * DT / Spc2GCH4 + + !----------------------------------------------------------- + ! %%%%% HISTORY (aka netCDF diagnostics) %%%%% + ! + ! Archive Loss of CH4 (kg/s) reactions with OH and Cl + !----------------------------------------------------------- + IF ( NA == 1 ) THEN + ! Loss CH4 by reaction with Cl [kg/s] + IF ( State_Diag%Archive_LossCH4byClinTrop ) THEN + State_Diag%LossCH4byClinTrop(I,J,L) = & + ( GCH4 * KRATE_Cl * C_Cl ) / Spc2GCH4 + ENDIF + + IF ( State_Diag%Archive_LossCH4byOHinTrop ) THEN + State_Diag%LossCH4byOHinTrop(I,J,L) = & + ( GCH4 * KRATE * C_OH ) / Spc2GCH4 + ENDIF + ENDIF + + ! Calculate new CH4 value: [CH4]=[CH4](1-k[OH]*delt) + GCH4 = GCH4 * & + ( 1.0_fp - ( KRATE * C_OH * DT ) - ( KRATE_Cl * C_Cl * DT ) ) + + ! Convert back from [molec/cm3] --> [kg/box] + Spc(N)%Conc(I,J,L) = GCH4 / Spc2GCH4 + ENDIF + ENDDO + ENDDO + ENDDO + !$OMP END PARALLEL DO + + IF ( Input_Opt%Verbose ) THEN + print*,'% --- CHEMCH4: CH4_DECAY: TROP DECAY (Tg): ',TROPOCH4/1e9 + print*,'Trop decay should be over 1Tg per day globally' + print*,' ~ 500Tg/365d ~ 1.37/d' ENDIF - ENDDO - ENDDO - ENDDO - !$OMP END PARALLEL DO - IF ( Input_Opt%Verbose ) THEN - print*,'% --- CHEMCH4: CH4_DECAY: TROP DECAY (Tg): ',TROPOCH4/1e9 - print*,'Trop decay should be over 1Tg per day globally' - print*,' ~ 500Tg/365d ~ 1.37/d' - ENDIF + ENDDO ! Free pointers Spc => NULL() @@ -818,7 +800,7 @@ SUBROUTINE CH4_STRAT( Input_Opt, State_Chm, State_Diag, & ! !LOCAL VARIABLES: ! ! Scalars - INTEGER :: I, J, L + INTEGER :: I, J, L, N, NA REAL(fp) :: DT, GCH4, Spc2GCH4, LRATE ! Strings @@ -869,46 +851,56 @@ SUBROUTINE CH4_STRAT( Input_Opt, State_Chm, State_Diag, & !================================================================= ! Loop over stratospheric boxes only !================================================================= - !$OMP PARALLEL DO & - !$OMP DEFAULT( SHARED ) & - !$OMP PRIVATE( I, J, L, Spc2GCH4, GCH4, LRATE ) - DO L = 1, State_Grid%NZ - DO J = 1, State_Grid%NY - DO I = 1, State_Grid%NX + DO NA = 1, State_Chm%nAdvect - ! Only proceed if we are outside of the chemistry grid - IF ( .not. State_Met%InTroposphere(I,J,L) ) THEN + ! Advected species ID + N = State_Chm%Map_Advect(NA) - ! Conversion factor [kg/box] --> [molec/cm3] - ! [kg/box] / [AIRVOL * 1e6 cm3] * [XNUMOL_CH4 molec/mole] - Spc2GCH4 = 1e+0_fp / State_Met%AIRVOL(I,J,L) / 1e+6_fp * XNUMOL_CH4 + ! Only do chemistry for the total CH4 tracer in tagCH4 simulations + IF ( Input_Opt%ITS_A_TAGCH4_SIM .and. NA > 1 ) CYCLE + + !$OMP PARALLEL DO & + !$OMP DEFAULT( SHARED ) & + !$OMP PRIVATE( I, J, L, Spc2GCH4, GCH4, LRATE ) + DO L = 1, State_Grid%NZ + DO J = 1, State_Grid%NY + DO I = 1, State_Grid%NX - ! CH4 in [molec/cm3] - GCH4 = Spc(1)%Conc(I,J,L) * Spc2GCH4 + ! Only proceed if we are outside of the chemistry grid + IF ( .not. State_Met%InTroposphere(I,J,L) ) THEN - ! Loss rate [molec/cm3/s] - LRATE = GCH4 * CH4LOSS( I,J,L ) + ! Conversion factor [kg/box] --> [molec/cm3] + ! [kg/box] / [AIRVOL * 1e6 cm3] * [XNUMOL_CH4 molec/mole] + Spc2GCH4 = 1e+0_fp / State_Met%AIRVOL(I,J,L) / 1e+6_fp * XNUMOL_CH4 - ! Update Methane concentration in this grid box [molec/cm3] - GCH4 = GCH4 - ( LRATE * DT ) + ! CH4 in [molec/cm3] + GCH4 = Spc(N)%Conc(I,J,L) * Spc2GCH4 - ! Convert back from [molec CH4/cm3] --> [kg/box] - Spc(1)%Conc(I,J,L) = GCH4 / Spc2GCH4 + ! Loss rate [molec/cm3/s] + LRATE = GCH4 * CH4LOSS( I,J,L ) + + ! Update Methane concentration in this grid box [molec/cm3] + GCH4 = GCH4 - ( LRATE * DT ) + + ! Convert back from [molec CH4/cm3] --> [kg/box] + Spc(N)%Conc(I,J,L) = GCH4 / Spc2GCH4 + + !------------------------------------------------------------ + ! %%%%%% HISTORY (aka netCDF diagnostics) %%%%% + ! + ! Loss of CH4 by OH above tropopause [kg/s] + !------------------------------------------------------------ + IF ( State_Diag%Archive_LossCH4inStrat ) THEN + State_Diag%LossCH4inStrat(I,J,L) = LRATE / Spc2GCH4 + ENDIF - !------------------------------------------------------------ - ! %%%%%% HISTORY (aka netCDF diagnostics) %%%%% - ! - ! Loss of CH4 by OH above tropopause [kg/s] - !------------------------------------------------------------ - IF ( State_Diag%Archive_LossCH4inStrat ) THEN - State_Diag%LossCH4inStrat(I,J,L) = LRATE / Spc2GCH4 ENDIF + ENDDO + ENDDO + ENDDO + !$OMP END PARALLEL DO - ENDIF - ENDDO ENDDO - ENDDO - !$OMP END PARALLEL DO ! Free pointer Spc => NULL() @@ -961,7 +953,7 @@ SUBROUTINE CH4_DISTRIB( Input_Opt, State_Chm, State_Grid, PREVCH4 ) ! !LOCAL VARIABLES: ! ! Scalars - INTEGER :: I, J, L, N, NA, nAdvect + INTEGER :: I, J, L, N, NA ! Pointers TYPE(SpcConc), POINTER :: Spc(:) @@ -973,11 +965,8 @@ SUBROUTINE CH4_DISTRIB( Input_Opt, State_Chm, State_Grid, PREVCH4 ) ! Point to chemical species array [kg] Spc => State_Chm%Species - ! fix nAdvect (Xueying Yu, 12/10/2017) - nAdvect = State_Chm%nAdvect - ! Loop over the number of advected species - DO NA = 2, nAdvect + DO NA = 2, State_Chm%nAdvect ! Advected species ID N = State_Chm%Map_Advect(NA) From 46fec0188836f9ecdbb8f5e0876ac6893b65a77e Mon Sep 17 00:00:00 2001 From: Melissa Sulprizio Date: Sun, 7 Jan 2024 19:39:51 -0500 Subject: [PATCH 4/5] Add fix to look for prior emissions in proper directory The file path to CH4_Emis_Prior is specific to the IMI. If users want to use this option in a different framework then they can modify the path manually. Signed-off-by: Melissa Sulprizio --- run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CH4 | 4 ++-- .../HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon | 4 ++-- .../HEMCO_Config.rc.templates/HEMCO_Config.rc.tagCH4 | 4 ++-- run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CH4 b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CH4 index d9150b511..74d6de020 100644 --- a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CH4 +++ b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CH4 @@ -126,11 +126,11 @@ VerboseOnCores: root # Accepted values: root all (((UseTotalPriorEmis (((Emis_PosteriorSF -0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 +0 CH4_Emis_Prior ../../prior_run/OutputDir/HEMCO_sa_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 )))Emis_PosteriorSF (((.not.Emis_PosteriorSF -0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 +0 CH4_Emis_Prior ../../prior_run/OutputDir/HEMCO_sa_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 ))).not.Emis_PosteriorSF )))UseTotalPriorEmis diff --git a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon index cc4cc333c..e6ef39731 100644 --- a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon +++ b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon @@ -167,11 +167,11 @@ Mask fractions: false (((UseTotalPriorEmis (((Emis_PosteriorSF -0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 +0 CH4_Emis_Prior ../../prior_run/OutputDir/HEMCO_sa_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 )))Emis_PosteriorSF (((.not.Emis_PosteriorSF -0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 +0 CH4_Emis_Prior ../../prior_run/OutputDir/HEMCO_sa_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 ))).not.Emis_PosteriorSF )))UseTotalPriorEmis diff --git a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.tagCH4 b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.tagCH4 index effca16ac..d72b36a9f 100644 --- a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.tagCH4 +++ b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.tagCH4 @@ -133,11 +133,11 @@ VerboseOnCores: root # Accepted values: root all (((UseTotalPriorEmis (((Emis_PosteriorSF -0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 +0 CH4_Emis_Prior ../../prior_run/OutputDir/HEMCO_sa_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 )))Emis_PosteriorSF (((.not.Emis_PosteriorSF -0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 +0 CH4_Emis_Prior ../../prior_run/OutputDir/HEMCO_sa_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 ))).not.Emis_PosteriorSF )))UseTotalPriorEmis diff --git a/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon b/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon index 6b869d107..314b4cc8b 100644 --- a/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon +++ b/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon @@ -167,11 +167,11 @@ Mask fractions: false (((UseTotalPriorEmis (((Emis_PosteriorSF -0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 +0 CH4_Emis_Prior ../../prior_run/OutputDir/HEMCO_sa_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 3 1 500 )))Emis_PosteriorSF (((.not.Emis_PosteriorSF -0 CH4_Emis_Prior ../prior_run/OutputDir/HEMCO_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 +0 CH4_Emis_Prior ../../prior_run/OutputDir/HEMCO_sa_diagnostics.$YYYY$MM$DD0000.nc EmisCH4_Total $YYYY/$MM/$DD/0 C xy kg/m2/s CH4 - 1 500 ))).not.Emis_PosteriorSF )))UseTotalPriorEmis From 75a886bb47b7500522570c09df352f44c2d46c37 Mon Sep 17 00:00:00 2001 From: Melissa Sulprizio Date: Wed, 27 Mar 2024 13:44:38 -0400 Subject: [PATCH 5/5] Fix typo in CHANGELOG.md for CH4 updates Signed-off-by: Melissa Sulprizio --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8b3cc0661..dd6ccf251 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -32,7 +32,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Copy utility scripts that allow you to resubmit failed to integration and parallel test root directories - Update GCHP operational example environment files for Harvard Cannon - Do not run GCClassic integration test compile jobs in the background -- Removed emissions handling from `global_ch4_mod.F90` and `carbon_mod.F90` and instead apply scale factors to emissions directly in `HEMCO_Config.rc` +- Removed emissions handling from `global_ch4_mod.F90` and `carbon_gases_mod.F90` and instead apply scale factors to emissions directly in `HEMCO_Config.rc` - Loop over advected species CH4 chemistry routines to allow for multiple CH4 tracers within analytical inversion framework ### Fixed