diff --git a/CHANGELOG.md b/CHANGELOG.md index 17892dda0..483820b42 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,19 @@ 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] - TBD +### Changed +- Renamed `Emiss_Carbon_Gases` to `CO2_Production` in `carbon_gases_mod.F90` +- Updated start date and restart file for CO2 and tagCO simulations for consistency with carbon simulations + +### Fixed +- Added a fix to skip the call to KPP when only CO2 is defined in the carbon simulation +- Added fix to turn on ship emissions for CO2 in the carbon simulation +- Updated `HEMCO_Config.rc` for carbon simulation to read data based on carbon species used +- Fixed entries for CO2 emissions in `ExtData.rc.carbon` +- Fixed metals simulation name in config file template comments +- Fixed bug in `download_data.py` which caused script to fail if log filename contained uppercase characters. + ## [14.5.0] - 2024-11-07 ### Added - Added vectors `State_Chm%KPP_AbsTol` and `State_Chm%KPP_RelTol` diff --git a/GeosCore/carbon_gases_mod.F90 b/GeosCore/carbon_gases_mod.F90 index db655e1ba..4a91aeb40 100644 --- a/GeosCore/carbon_gases_mod.F90 +++ b/GeosCore/carbon_gases_mod.F90 @@ -27,7 +27,7 @@ MODULE Carbon_Gases_Mod ! ! !PUBLIC MEMBER FUNCTIONS: ! - PUBLIC :: Emiss_Carbon_Gases + PUBLIC :: CO2_Production PUBLIC :: Chem_Carbon_Gases PUBLIC :: Init_Carbon_Gases PUBLIC :: Cleanup_Carbon_Gases @@ -67,16 +67,16 @@ MODULE Carbon_Gases_Mod !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: emiss_carbon_gases +! !IROUTINE: co2_production ! -! !DESCRIPTION: Places emissions of CH4, CO, CO2, OCS [kg] into the -! chemical species array. +! !DESCRIPTION: Places CO2 production from CO oxidation into the chemical +! species array. !\\ !\\ ! !INTERFACE: ! - SUBROUTINE Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & - State_Grid, State_Met, RC ) + SUBROUTINE CO2_Production( Input_Opt, State_Chm, State_Diag, & + State_Grid, State_Met, RC ) ! ! !USES: ! @@ -112,11 +112,14 @@ SUBROUTINE Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & ! ! !LOCAL VARIABLES: ! + ! SAVEd scalars + LOGICAL, SAVE :: FIRST = .TRUE. + ! Scalars LOGICAL :: prtDebug INTEGER :: I, J INTEGER :: L, N - REAL(fp) :: dtSrce, E_CO2 + REAL(fp) :: dtSrce, P_CO2 ! Strings CHARACTER(LEN=255) :: thisLoc @@ -142,7 +145,7 @@ SUBROUTINE Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & REAL(fp), PARAMETER :: xnumol_C = AVO / 12.0e-3_fp !======================================================================== - ! Emiss_Carbon_Gases begins here! + ! CO2_Production begins here! !======================================================================== ! Initialize @@ -151,7 +154,7 @@ SUBROUTINE Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & Spc => NULL() errMsg = '' thisLoc = & - ' -> at Emiss_Carbon_Gases (in module GeosCore/carbon_gases_mod.F90)' + ' -> at CO2_production (in module GeosCore/carbon_gases_mod.F90)' ! Exit with error if we can't find the HEMCO state object IF ( .NOT. ASSOCIATED( HcoState ) ) THEN @@ -166,7 +169,15 @@ SUBROUTINE Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & !======================================================================== ! CO2 production from CO oxidation !======================================================================== - IF ( Input_Opt%LCHEMCO2 .and. id_CO2_adv > 0 ) THEN + + ! If CO2 is an advected species but CO is not, use CO2_COPROD field + ! from HEMCO. Otherwise compute CO2 production via KPP. + IF ( id_CO2_adv > 0 .and. id_CO_adv <= 0 ) THEN + + IF ( Input_Opt%amIRoot .and. FIRST ) THEN + WRITE( 6, 100 ) +100 FORMAT( 'Carbon_Gases: Applying production of CO2 from CO from file') + ENDIF ! Point to chemical species array [kg/kg dry air] Spc => State_Chm%Species @@ -183,14 +194,14 @@ SUBROUTINE Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & ! Loop over all grid boxes !$OMP PARALLEL DO & !$OMP DEFAULT( SHARED )& - !$OMP PRIVATE( I, J, L, E_CO2, N )& + !$OMP PRIVATE( I, J, L, P_CO2, N )& !$OMP COLLAPSE( 3 ) DO L = 1, State_Grid%NZ DO J = 1, State_Grid%NY DO I = 1, State_Grid%NX ! Production is in [kg C/m3], convert to [molec/cm2/s] - E_CO2 = PCO2_fr_CO(I,J,L) & ! kg/m3 + P_CO2 = PCO2_fr_CO(I,J,L) & ! kg/m3 / CM3perM3 & ! => kg/cm3 * xnumol_C & ! => molec/cm3 / dtSrce & ! => molec/cm3/s @@ -202,7 +213,7 @@ SUBROUTINE Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & ! Save production of CO2 from CO oxidation [kg/m2/s] !------------------------------------------------------------------ IF ( State_Diag%Archive_ProdCO2fromCO ) THEN - State_Diag%ProdCO2fromCO(I,J,L) = E_CO2 & ! molec/cm2/s + State_Diag%ProdCO2fromCO(I,J,L) = P_CO2 & ! molec/cm2/s / xnumol_CO2 & ! => kg/cm2/s * CM2perM2 ! => kg/m2/s @@ -210,13 +221,13 @@ SUBROUTINE Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & ! Convert emissions from [molec/cm2/s] to [kg/kg dry air] ! (ewl, 9/11/15) - E_CO2 = E_CO2 * DTSRCE * CM2perM2 / & + P_CO2 = P_CO2 * DTSRCE * CM2perM2 / & ( XNUMOL_CO2 * State_Met%DELP(I,J,L) & * G0_100 * ( 1.0e+0_fp & - State_Met%SPHU(I,J,L) * 1.0e-3_fp ) ) ! Total CO2 [kg/kg dry air] - Spc(id_CO2)%Conc(I,J,L) = Spc(id_CO2)%Conc(I,J,L) + E_CO2 + Spc(id_CO2)%Conc(I,J,L) = Spc(id_CO2)%Conc(I,J,L) + P_CO2 ENDDO ENDDO @@ -231,7 +242,7 @@ SUBROUTINE Emiss_Carbon_Gases( Input_Opt, State_Chm, State_Diag, & Spc => NULL() Ptr2D => NULL() - END SUBROUTINE Emiss_Carbon_Gases + END SUBROUTINE CO2_Production !EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! @@ -283,25 +294,6 @@ SUBROUTINE Chem_Carbon_Gases( Input_Opt, State_Met, State_Chm, & ! INTEGER, INTENT(OUT) :: RC ! Success or failure? ! -! !REMARKS: -! CH4 SOURCES -! ============================================================================ -! (1 ) Oxidation of methane, isoprene and monoterpenes (SRCO_fromHCs). -! (2 ) Direct emissions of CO from fossil fuel combustion, biomass -! burning and wood (for fuel) burning (SR SETEMIS). -! (3 ) Emissions. -! . -! CH4 SINKS: -! ============================================================================ -! (1 ) Removal of CO by OH (SR OHparam & CO_decay). -! (2 ) CO uptake by soils (neglected). -! (3 ) Transport of CO to stratosphere from troposphere -! (in dynamical subroutines). -! (4 ) Removal by OH (Clarissa's OH--climatol_OH.f and CO_decay.f) -! (5 ) Transport of CH4 between troposphere and stratosphere, and -! destruction in strat (CH4_strat.f). -! (6 ) Removel by Cl -! ! !REVISION HISTORY: !EOP !------------------------------------------------------------------------------ @@ -310,7 +302,7 @@ SUBROUTINE Chem_Carbon_Gases( Input_Opt, State_Met, State_Chm, & ! !LOCAL VARIABLES: ! ! SAVEd scalars - LOGICAL :: first = .TRUE. + LOGICAL, SAVE :: first = .TRUE. ! Scalars LOGICAL :: failed @@ -368,11 +360,14 @@ SUBROUTINE Chem_Carbon_Gases( Input_Opt, State_Met, State_Chm, & ENDIF ! Determine which OH oxidant field we are using - CALL InquireGlobalOHversion( Input_Opt, RC ) - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error encountered in "InquireGlobalOHversion"!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN + ! OH is only needed when CH4 or CO are included in the carbon species + IF ( id_CH4_adv > 0 .or. id_CO_adv > 0 ) THEN + CALL InquireGlobalOHversion( Input_Opt, RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error encountered in "InquireGlobalOHversion"!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF ENDIF ! Reset first-time flag @@ -420,10 +415,15 @@ SUBROUTINE Chem_Carbon_Gases( Input_Opt, State_Met, State_Chm, & ! Compute OH diurnal cycle scaling factor ! (this scales OH by the position of the sun, and zeroes it at night) !======================================================================== - CALL Calc_Diurnal( & - State_Grid = State_Grid, & - State_Met = State_Met, & - OHdiurnalFac = OHdiurnalFac ) + ! OH is only needed when CH4 or CO are included in the carbon species + IF ( id_CH4_adv > 0 .or. id_CO_adv > 0 ) THEN + + CALL Calc_Diurnal( & + State_Grid = State_Grid, & + State_Met = State_Met, & + OHdiurnalFac = OHdiurnalFac ) + + ENDIF !======================================================================== ! %%%%% HISTORY (aka netCDF diagnostics) %%%%% @@ -452,201 +452,201 @@ SUBROUTINE Chem_Carbon_Gases( Input_Opt, State_Met, State_Chm, & ENDDO ENDDO !$OMP END PARALLEL DO - ENDIF - - !======================================================================== - ! Main chemistry loop -- call KPP to integrate the mechanism forward - !======================================================================== - - ! KPP forward-Euler integrator settings - ICNTRL = 0 - ICNTRL(1) = 1 ! Verbose error output - ICNTRL(2) = 0 ! Stop model on negative values - ICNTRL(15) = -1 ! Do not call Update_SUN, Update_RCONST w/in integrator - ! Set a flag to denote if the chemistry failed - failed = .FALSE. - - ! Loop over grid boxes - !$OMP PARALLEL DO & - !$OMP DEFAULT( SHARED )& - !$OMP PRIVATE( I, J, L, N )& - !$OMP COLLAPSE( 3 )& - !$OMP SCHEDULE( DYNAMIC, 24 ) - DO L = 1, State_Grid%NZ - DO J = 1, State_Grid%NY - DO I = 1, State_Grid%NX - - ! Initialize PRIVATE and THREADPRIVATE loop variables - C = 0.0_dp ! Species conc. [molec/cm3] - CFACTOR = 1.0_dp ! Not used, set = 1 - k_Strat = 0.0_dp ! Rate in stratosphere [1/s] - k_Trop = 0.0_dp ! Rate in troposphere [1/s] - NUMDEN = State_Met%AIRNUMDEN(I,J,L)! Air density [molec/cm3] - TROP = 0.0_dp ! Toggle for reaction - TEMP = State_Met%T(I,J,L) ! Temperature [K] - INV_TEMP = 1.0_dp / TEMP ! 1/T term for equations - TEMP_OVER_K300 = TEMP / 300.0_dp ! T/300 term for equations - K300_OVER_TEMP = 300.0_dp / TEMP ! 300/T term for equations - SUNCOS = State_Met%SUNCOSmid(I,J) ! Cos(SZA) ) [1] - - !===================================================================== - ! Convert CO, CO2, CH4 to molec/cm3 for the KPP solver - !===================================================================== + ENDIF - ! Convert units - CALL carbon_ConvertKgtoMolecCm3( & - I = I, & - J = J, & - L = L, & - id_CH4 = id_CH4, & - id_CO = id_CO, & - id_CO2 = id_CO2, & - xnumol_CH4 = xnumol_CH4, & - xnumol_CO = xnumol_CO, & - xnumol_CO2 = xnumol_CO2, & - State_Met = State_Met, & - State_Chm = State_Chm ) - - !=================================================================== - ! Update reaction rates - !=================================================================== - - ! Compute the rate constants that will be used - CALL carbon_ComputeRateConstants( & - I = I, & - J = J, & - L = L, & - dtChem = dtChem, & - ConcClMnd = Global_Cl(I,J,L), & - ConcOHmnd = Global_OH(I,J,L), & - LCH4_by_OH = LCH4_by_OH(I,J,L), & - LCO_in_Strat = LCO_in_Strat(I,J,L), & - OHdiurnalFac = OHdiurnalFac(I,J), & - PCO_in_Strat = PCO_in_Strat(I,J,L), & - PCO_fr_CH4_use = Input_Opt%LPCO_CH4, & - PCO_fr_CH4 = PCO_fr_CH4(I,J,L), & - PCO_fr_NMVOC_use = Input_Opt%LPCO_NMVOC, & - PCO_fr_NMVOC = PCO_fr_NMVOC(I,J,L), & - State_Met = State_Met, & - State_Chm = State_Chm ) - - ! Update the array of rate constants for the KPP solver - CALL Update_RCONST() + ! Do not call KPP if neither CH4 or CO are advected species + IF ( id_CH4_adv > 0 .or. id_CO_adv > 0 ) THEN !===================================================================== - ! Call the KPP integrator + ! Main chemistry loop -- call KPP to integrate the mechanism forward !===================================================================== - ! Integrate the mechanism forward in time - CALL Integrate( & - TIN = 0.0_dp, & - TOUT = dtChem, & - ICNTRL_U = ICNTRL, & - IERR_U = IERR ) + ! KPP forward-Euler integrator settings + ICNTRL = 0 + ICNTRL(1) = 1 ! Verbose error output + ICNTRL(2) = 0 ! Stop model on negative values + ICNTRL(15) = -1 ! Do not call Update_SUN, Update_RCONST w/in integrator - ! Trap potential errors - IF ( IERR /= 1 ) failed = .TRUE. + ! Set a flag to denote if the chemistry failed + failed = .FALSE. - !===================================================================== - ! HISTORY: Archive KPP solver diagnostics - !===================================================================== - IF ( State_Diag%Archive_KppDiags ) THEN + ! Loop over grid boxes + !$OMP PARALLEL DO & + !$OMP DEFAULT( SHARED )& + !$OMP PRIVATE( I, J, L, N )& + !$OMP COLLAPSE( 3 )& + !$OMP SCHEDULE( DYNAMIC, 24 ) + DO L = 1, State_Grid%NZ + DO J = 1, State_Grid%NY + DO I = 1, State_Grid%NX - ! # of integrator calls - IF ( State_Diag%Archive_KppIntCounts ) THEN - State_Diag%KppIntCounts(I,J,L) = ISTATUS(1) - ENDIF + ! Initialize PRIVATE and THREADPRIVATE loop variables + C = 0.0_dp ! Species conc. [molec/cm3] + CFACTOR = 1.0_dp ! Not used, set = 1 + k_Strat = 0.0_dp ! Rate in stratosphere[1/s] + k_Trop = 0.0_dp ! Rate in troposphere [1/s] + NUMDEN = State_Met%AIRNUMDEN(I,J,L)! Air density [molec/cm3] + TROP = 0.0_dp ! Toggle for reaction + TEMP = State_Met%T(I,J,L) ! Temperature [K] + INV_TEMP = 1.0_dp / TEMP ! 1/T term for equations + TEMP_OVER_K300 = TEMP / 300.0_dp ! T/300 term for equations + K300_OVER_TEMP = 300.0_dp / TEMP ! 300/T term for equations + SUNCOS = State_Met%SUNCOSmid(I,J) ! Cos(SZA) ) [1] + + ! Convert species to molec/cm3 for the KPP solver + CALL carbon_ConvertKgtoMolecCm3( & + I = I, & + J = J, & + L = L, & + id_CH4 = id_CH4, & + id_CO = id_CO, & + id_CO2 = id_CO2, & + xnumol_CH4 = xnumol_CH4, & + xnumol_CO = xnumol_CO, & + xnumol_CO2 = xnumol_CO2, & + State_Met = State_Met, & + State_Chm = State_Chm ) + + !================================================================ + ! Update reaction rates + !================================================================ + + ! Compute the rate constants that will be used + CALL carbon_ComputeRateConstants( & + I = I, & + J = J, & + L = L, & + dtChem = dtChem, & + ConcClMnd = Global_Cl(I,J,L), & + ConcOHmnd = Global_OH(I,J,L), & + LCH4_by_OH = LCH4_by_OH(I,J,L), & + LCO_in_Strat = LCO_in_Strat(I,J,L), & + OHdiurnalFac = OHdiurnalFac(I,J), & + PCO_in_Strat = PCO_in_Strat(I,J,L), & + PCO_fr_CH4_use = Input_Opt%LPCO_CH4, & + PCO_fr_CH4 = PCO_fr_CH4(I,J,L), & + PCO_fr_NMVOC_use = Input_Opt%LPCO_NMVOC, & + PCO_fr_NMVOC = PCO_fr_NMVOC(I,J,L), & + State_Met = State_Met, & + State_Chm = State_Chm ) + + ! Update the array of rate constants for the KPP solver + CALL Update_RCONST() + + !================================================================== + ! Call the KPP integrator + !===================================================================== + + ! Integrate the mechanism forward in time + CALL Integrate( & + TIN = 0.0_dp, & + TOUT = dtChem, & + ICNTRL_U = ICNTRL, & + IERR_U = IERR ) + + ! Trap potential errors + IF ( IERR /= 1 ) failed = .TRUE. + + !================================================================== + ! HISTORY: Archive KPP solver diagnostics + !================================================================== + IF ( State_Diag%Archive_KppDiags ) THEN + + ! # of integrator calls + IF ( State_Diag%Archive_KppIntCounts ) THEN + State_Diag%KppIntCounts(I,J,L) = ISTATUS(1) + ENDIF - ! # of times Jacobian was constructed - IF ( State_Diag%Archive_KppJacCounts ) THEN - State_Diag%KppJacCounts(I,J,L) = ISTATUS(2) - ENDIF + ! # of times Jacobian was constructed + IF ( State_Diag%Archive_KppJacCounts ) THEN + State_Diag%KppJacCounts(I,J,L) = ISTATUS(2) + ENDIF - ! # of internal timesteps - IF ( State_Diag%Archive_KppTotSteps ) THEN - State_Diag%KppTotSteps(I,J,L) = ISTATUS(3) - ENDIF + ! # of internal timesteps + IF ( State_Diag%Archive_KppTotSteps ) THEN + State_Diag%KppTotSteps(I,J,L) = ISTATUS(3) + ENDIF - ! # of accepted internal timesteps - IF ( State_Diag%Archive_KppTotSteps ) THEN - State_Diag%KppAccSteps(I,J,L) = ISTATUS(4) - ENDIF + ! # of accepted internal timesteps + IF ( State_Diag%Archive_KppTotSteps ) THEN + State_Diag%KppAccSteps(I,J,L) = ISTATUS(4) + ENDIF - ! # of rejected internal timesteps - IF ( State_Diag%Archive_KppTotSteps ) THEN - State_Diag%KppRejSteps(I,J,L) = ISTATUS(5) - ENDIF + ! # of rejected internal timesteps + IF ( State_Diag%Archive_KppTotSteps ) THEN + State_Diag%KppRejSteps(I,J,L) = ISTATUS(5) + ENDIF - ! # of LU-decompositions - IF ( State_Diag%Archive_KppLuDecomps ) THEN - State_Diag%KppLuDecomps(I,J,L) = ISTATUS(6) - ENDIF + ! # of LU-decompositions + IF ( State_Diag%Archive_KppLuDecomps ) THEN + State_Diag%KppLuDecomps(I,J,L) = ISTATUS(6) + ENDIF - ! # of forward and backwards substitutions - IF ( State_Diag%Archive_KppSubsts ) THEN - State_Diag%KppSubsts(I,J,L) = ISTATUS(7) - ENDIF + ! # of forward and backwards substitutions + IF ( State_Diag%Archive_KppSubsts ) THEN + State_Diag%KppSubsts(I,J,L) = ISTATUS(7) + ENDIF - ! # of singular-matrix decompositions - IF ( State_Diag%Archive_KppSmDecomps ) THEN - State_Diag%KppSmDecomps(I,J,L) = ISTATUS(8) + ! # of singular-matrix decompositions + IF ( State_Diag%Archive_KppSmDecomps ) THEN + State_Diag%KppSmDecomps(I,J,L) = ISTATUS(8) + ENDIF ENDIF - ENDIF - ! Convert CO, CO2, CH4 to molec/cm3 for the KPP solver - CALL carbon_ConvertMolecCm3ToKg( & - I = I, & - J = J, & - L = L, & - id_CH4 = id_CH4, & - id_CO = id_CO, & - id_CO2 = id_CO2, & - xnumol_CO = xnumol_CO, & - xnumol_CH4 = xnumol_CH4, & - xnumol_CO2 = xnumol_CO2, & - State_Chm = State_Chm, & - State_Met = State_Met ) - - !===================================================================== - ! HISTORY (aka netCDF diagnostics) - ! - ! Production and loss of CO - ! - ! NOTE: Call functions in KPP/carbon/carbon_Funcs.F90 so - ! that we avoid bringing in KPP species indices into this module. - ! This avoids compile-time dependency errors. - !===================================================================== + ! Convert species back to kg + CALL carbon_ConvertMolecCm3ToKg( & + I = I, & + J = J, & + L = L, & + id_CH4 = id_CH4, & + id_CO = id_CO, & + id_CO2 = id_CO2, & + xnumol_CO = xnumol_CO, & + xnumol_CH4 = xnumol_CH4, & + xnumol_CO2 = xnumol_CO2, & + State_Chm = State_Chm, & + State_Met = State_Met ) + + !================================================================== + ! HISTORY (aka netCDF diagnostics) + ! + ! Production and loss of CO + ! + ! NOTE: Call functions in KPP/carbon/carbon_Funcs.F90 so + ! that we avoid bringing in KPP species indices into this module. + ! This avoids compile-time dependency errors. + !===================================================================== - ! Production of CO2 from CO oxidation [molec/cm3/s] - IF ( Input_Opt%LCHEMCO2 ) THEN + ! Production of CO2 from CO oxidation [molec/cm3/s] IF ( State_Diag%Archive_ProdCO2fromCO ) THEN State_Diag%ProdCO2fromCO(I,J,L) = & - carbon_Get_CO2fromOH_Flux( dtChem ) + carbon_Get_CO2fromOH_Flux( dtChem ) + ENDIF + + ! Production of CO from CH4 + IF ( State_Diag%Archive_ProdCOfromCH4 ) THEN + State_Diag%ProdCOfromCH4(I,J,L) = & + carbon_Get_COfromCH4_Flux( dtChem ) ENDIF - ENDIF - ! Production of CO from CH4 - IF ( State_Diag%Archive_ProdCOfromCH4 ) THEN - State_Diag%ProdCOfromCH4(I,J,L) = & - carbon_Get_COfromCH4_Flux( dtChem ) - ENDIF + ! Units: [kg/s] Production of CO from NMVOCs + IF ( State_Diag%Archive_ProdCOfromNMVOC ) THEN + State_Diag%ProdCOfromNMVOC(I,J,L) = & + carbon_Get_COfromNMVOC_Flux( dtChem ) + ENDIF - ! Units: [kg/s] Production of CO from NMVOCs - IF ( State_Diag%Archive_ProdCOfromNMVOC ) THEN - State_Diag%ProdCOfromNMVOC(I,J,L) = & - carbon_Get_COfromNMVOC_Flux( dtChem ) - ENDIF + ENDDO + ENDDO + ENDDO + !$OMP END PARALLEL DO - ENDDO - ENDDO - ENDDO - !$OMP END PARALLEL DO + IF ( failed ) THEN + errMsg = 'KPP integration failed!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF - IF ( failed ) THEN - errMsg = 'KPP integration failed!' - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN ENDIF ! Free pointers for safety's sake @@ -744,119 +744,145 @@ SUBROUTINE ReadChemInputFields( Input_Opt, State_Grid, State_Met, & thisLoc = & ' -> at ReadInputChemFields (in module GeosCore/carbon_gases_mod.F90)' - !------------------------------------------------------------------------ - ! Loss frequencies of CH4 - ! Input via HEMCO ("CH4_LOSS" container) as [1/s] - !------------------------------------------------------------------------ - DgnName = 'CH4_LOSS' - CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & - LCH4_by_OH, RC, found=found ) - IF ( RC /= GC_SUCCESS .or. .not. found ) THEN - errMsg = 'Cannot get pointer to HEMCO field ' // TRIM( DgnName ) - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - - !------------------------------------------------------------------------ - ! Cl concentration: - ! Input via HEMCO ("SpeciesConc" collection) as [mol/mol dry] - ! Convert to [molec/cm3] below - !------------------------------------------------------------------------ - DgnName = 'GLOBAL_Cl' - CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & - Global_Cl, RC, found=found ) - IF ( RC /= GC_SUCCESS .or. .not. found ) THEN - errMsg = 'Cannot get pointer to HEMCO field ' // TRIM( DgnName ) - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF - - ! Convert orignal units [mol/mol dry air] to [molec/cm3] - Global_Cl = ( Global_Cl * State_Met%AirDen ) * toMolecCm3 + ! Initialize fields to zero + Global_OH = 0.0_fp + Global_Cl = 0.0_fp + LCH4_by_OH = 0.0_fp + LCO_in_Strat = 0.0_fp + PCO_in_Strat = 0.0_fp + PCO_fr_CH4 = 0.0_fp + PCO_fr_NMVOC = 0.0_fp + + ! Fields only needed if CH4 is an advected species + IF ( id_CH4_adv > 0 ) THEN + + !------------------------------------------------------------------------ + ! Loss frequencies of CH4 + ! Input via HEMCO ("CH4_LOSS" container) as [1/s] + !------------------------------------------------------------------------ + DgnName = 'CH4_LOSS' + CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & + LCH4_by_OH, RC, found=found ) + IF ( RC /= GC_SUCCESS .or. .not. found ) THEN + errMsg = 'Cannot get pointer to HEMCO field ' // TRIM( DgnName ) + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF - !------------------------------------------------------------------------ - ! OH concentration: from GEOS-Chem v5 or GEOS-Chem 10yr benchmark - !------------------------------------------------------------------------ - IF ( useGlobOHv5 .or. useGlobOHbmk10yr ) THEN + !------------------------------------------------------------------------ + ! Cl concentration: + ! Input via HEMCO ("SpeciesConc" collection) as [mol/mol dry] + ! Convert to [molec/cm3] below + !------------------------------------------------------------------------ - ! NOTE: Container name is GLOBAL_OH for both data sets! - DgnName = 'GLOBAL_OH' - CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & - Global_OH, RC, found=found ) + DgnName = 'GLOBAL_Cl' + CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & + Global_Cl, RC, found=found ) IF ( RC /= GC_SUCCESS .or. .not. found ) THEN errMsg = 'Cannot get pointer to HEMCO field ' // TRIM( DgnName ) CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF - ENDIF - ! If we are using OH from recent a 10-year benchmark ("SpeciesConc") - ! then convert OH [mol/mol dry air] to [molec/cm3]. - IF ( useGlobOHbmk10yr ) THEN - Global_OH = ( Global_OH * State_Met%AirDen ) * toMolecCm3 - ENDIF + ! Convert orignal units [mol/mol dry air] to [molec/cm3] + Global_Cl = ( Global_Cl * State_Met%AirDen ) * toMolecCm3 - ! If we are using Global_OH from GEOS-Chem v5 (e.g. for the IMI or - ! methane simulations) then convert OH from [kg/m3] to [molec/cm3]. - IF ( useGlobOHv5 ) THEN - Global_OH = Global_OH * xnumol_OH / CM3perM3 ENDIF - !------------------------------------------------------------------------ - ! P(CO) from GMI: - ! Input via HEMCO ("GMI_PROD_CO" field) as [v/v/s] - ! Units will be converted in carbon_ComputeRateConstants - !------------------------------------------------------------------------ - DgnName = 'GMI_PROD_CO' - CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & - PCO_in_Strat, RC, found=found ) - IF ( RC /= GC_SUCCESS .or. .not. found ) THEN - errMsg = 'Cannot get pointer to ' // TRIM( DgnName ) - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN - ENDIF + ! Fields only needed if CH4 or CO are advected species + IF ( id_CH4_adv > 0 .or. id_CO_adv > 0 ) THEN + + !------------------------------------------------------------------------ + ! OH concentration: from GEOS-Chem v5 or GEOS-Chem 10yr benchmark + !------------------------------------------------------------------------ + + IF ( useGlobOHv5 .or. useGlobOHbmk10yr ) THEN + + ! NOTE: Container name is GLOBAL_OH for both data sets! + DgnName = 'GLOBAL_OH' + CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & + Global_OH, RC, found=found ) + IF ( RC /= GC_SUCCESS .or. .not. found ) THEN + errMsg = 'Cannot get pointer to HEMCO field ' // TRIM( DgnName ) + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + ENDIF + + ! If we are using OH from recent a 10-year benchmark ("SpeciesConc") + ! then convert OH [mol/mol dry air] to [molec/cm3]. + IF ( useGlobOHbmk10yr ) THEN + Global_OH = ( Global_OH * State_Met%AirDen ) * toMolecCm3 + ENDIF + + ! If we are using Global_OH from GEOS-Chem v5 (e.g. for the IMI or + ! methane simulations) then convert OH from [kg/m3] to [molec/cm3]. + IF ( useGlobOHv5 ) THEN + Global_OH = Global_OH * xnumol_OH / CM3perM3 + ENDIF - !------------------------------------------------------------------------ - ! L(CO) from GMI - ! Input via HEMCO ("GMI_LOSS_CO" field) as [1/s] - !------------------------------------------------------------------------ - DgnName = 'GMI_LOSS_CO' - CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & - LCO_in_Strat, RC, found=found ) - IF ( RC /= GC_SUCCESS .or. .not. found ) THEN - errMsg = 'Cannot get pointer to HEMCO field ' // TRIM( DgnName ) - CALL GC_Error( errMsg, RC, thisLoc ) - RETURN ENDIF - !------------------------------------------------------------------------ - ! P(CO) from CH4 - ! Input via HEMCO ("ProdCOfromCH4 field") as [molec/cm3/s] - !------------------------------------------------------------------------ - IF ( Input_Opt%LPCO_CH4 ) THEN - DgnName = 'PCO_CH4' - CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & - PCO_fr_CH4, RC, found=found ) + ! Fields only needed if CO is an advected species + IF ( id_CO_adv > 0 ) THEN + + !--------------------------------------------------------------------- + ! P(CO) from GMI: + ! Input via HEMCO ("GMI_PROD_CO" field) as [v/v/s] + ! Units will be converted in carbon_ComputeRateConstants + !--------------------------------------------------------------------- + DgnName = 'GMI_PROD_CO' + CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & + PCO_in_Strat, RC, found=found ) IF ( RC /= GC_SUCCESS .or. .not. found ) THEN - errMsg = 'Cannot get pointer to HEMCO field ' // TRIM( DgnName ) + errMsg = 'Cannot get pointer to ' // TRIM( DgnName ) CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF - ENDIF - !------------------------------------------------------------------------ - ! P(CO) from NMVOC - ! Input via HEMCO ("ProdCOfromNMVOC" field) as [molec/cm3/s] - !------------------------------------------------------------------------ - IF ( Input_Opt%LPCO_NMVOC ) THEN - DgnName = 'PCO_NMVOC' + !--------------------------------------------------------------------- + ! L(CO) from GMI + ! Input via HEMCO ("GMI_LOSS_CO" field) as [1/s] + !--------------------------------------------------------------------- + DgnName = 'GMI_LOSS_CO' CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & - PCO_fr_NMVOC, RC, found=found ) + LCO_in_Strat, RC, found=found ) IF ( RC /= GC_SUCCESS .or. .not. found ) THEN errMsg = 'Cannot get pointer to HEMCO field ' // TRIM( DgnName ) CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF + + !--------------------------------------------------------------------- + ! P(CO) from CH4 + ! Input via HEMCO ("ProdCOfromCH4 field") as [molec/cm3/s] + !--------------------------------------------------------------------- + IF ( Input_Opt%LPCO_CH4 ) THEN + DgnName = 'PCO_CH4' + CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & + PCO_fr_CH4, RC, found=found ) + IF ( RC /= GC_SUCCESS .or. .not. found ) THEN + errMsg = 'Cannot get pointer to HEMCO field ' // TRIM( DgnName ) + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + ENDIF + + !--------------------------------------------------------------------- + ! P(CO) from NMVOC + ! Input via HEMCO ("ProdCOfromNMVOC" field) as [molec/cm3/s] + !--------------------------------------------------------------------- + IF ( Input_Opt%LPCO_NMVOC ) THEN + DgnName = 'PCO_NMVOC' + CALL HCO_GC_EvalFld( Input_Opt, State_Grid, DgnName, & + PCO_fr_NMVOC, RC, found=found ) + IF ( RC /= GC_SUCCESS .or. .not. found ) THEN + errMsg = 'Cannot get pointer to HEMCO field ' // TRIM( DgnName ) + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + ENDIF + ENDIF END SUBROUTINE ReadChemInputFields diff --git a/GeosCore/emissions_mod.F90 b/GeosCore/emissions_mod.F90 index 989020652..37e27efb7 100644 --- a/GeosCore/emissions_mod.F90 +++ b/GeosCore/emissions_mod.F90 @@ -124,7 +124,7 @@ SUBROUTINE Emissions_Run( Input_Opt, State_Chm, State_Diag, State_Grid, & ! !USES: ! USE CARBON_MOD, ONLY : EmissCarbon - USE Carbon_Gases_Mod, ONLY : Emiss_Carbon_Gases + USE Carbon_Gases_Mod, ONLY : CO2_Production USE CO2_MOD, ONLY : EmissCO2 USE ErrCode_Mod USE HCO_Interface_GC_Mod, ONLY : HCOI_GC_Run @@ -264,8 +264,8 @@ SUBROUTINE Emissions_Run( Input_Opt, State_Chm, State_Diag, State_Grid, & ! ! 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 ) + CALL CO2_Production( Input_Opt, State_Chm, State_Diag, & + State_Grid, State_Met, RC ) ! Trap potential errors IF ( RC /= GC_SUCCESS ) THEN diff --git a/GeosCore/input_mod.F90 b/GeosCore/input_mod.F90 index 451ccc431..cfc041eec 100644 --- a/GeosCore/input_mod.F90 +++ b/GeosCore/input_mod.F90 @@ -2015,7 +2015,7 @@ SUBROUTINE Config_CO( Config, Input_Opt, RC ) ! Initialize RC = GC_SUCCESS errMsg = '' - thisLoc = ' -> at Config_CO2 (in module GeosCore/input_mod.F90)' + thisLoc = ' -> at Config_CO (in module GeosCore/input_mod.F90)' !------------------------------------------------------------------------ ! Use P(CO) from CH4 (archived from a fullchem simulation)? @@ -2046,7 +2046,7 @@ SUBROUTINE Config_CO( Config, Input_Opt, RC ) !======================================================================== ! Print to screen !======================================================================== - IF ( Input_Opt%ITS_A_TAGCO_SIM .and. Input_Opt%amIRoot ) THEN + IF ( Input_Opt%amIRoot ) THEN WRITE(6,90 ) 'TAGGED CO SIMULATION SETTINGS' WRITE(6,95 ) '(overwrites any other settings related to CO)' WRITE(6,95 ) '---------------------------------------------' @@ -2154,7 +2154,7 @@ SUBROUTINE Config_CO2( Config, Input_Opt, RC ) !================================================================= ! Print to screen !================================================================= - IF ( Input_Opt%ITS_A_CO2_SIM .and. Input_Opt%amIRoot ) THEN + IF ( Input_Opt%amIRoot ) THEN WRITE( 6,90 ) 'CO2 SIMULATION SETTINGS' WRITE( 6,95 ) '(overwrites any other settings related to CO2)' WRITE( 6,95 ) '----------------------------------------------' diff --git a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CO2 b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CO2 index 82d84883e..c00c9a6b3 100644 --- a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CO2 +++ b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.CO2 @@ -30,6 +30,7 @@ ROOT: ${RUNDIR_DATA_ROOT}/HEMCO GCAPSCENARIO: ${RUNDIR_GCAP2_SCENARIO} GCAPVERTRES: ${RUNDIR_GCAP2_VERTRES} Logfile: * +DiagnFile: HEMCO_Diagn.rc DiagnPrefix: ./OutputDir/HEMCO_diagnostics DiagnFreq: Monthly Wildcard: * @@ -652,7 +653,7 @@ ${RUNDIR_CO2_COPROD} # main/national fossil fuel emission field if using avaition emissions. #============================================================================== (((FOSSIL_CDIAC.or.FOSSIL_ODIAC.or.CO2CORR -80 AVIATION_SURF_CORR $ROOT/CO2/v2015-04/FOSSIL/Aviation_SurfCorr_SclFac.1x1.nc CO2 2004/1/1/0 C xy 1 1 +80 AVIATION_SURF_CORR $ROOT/CO2/v2022-11/FOSSIL/Aviation_SurfCorr_SclFac.1x1.nc CO2 2004/1/1/0 C xy 1 1 )))FOSSIL_CDIAC.or.FOSSIL_ODIAC.or.CO2CORR #============================================================================== 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 be046787d..e643c0581 100644 --- a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon +++ b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon @@ -114,6 +114,7 @@ Mask fractions: false --> GMD_SFC_CH4 : true # 1979-2020 --> CMIP6_SFC_CH4 : false # 1750-1978 # ..... Ship emissions ............... + --> SHIP : true --> CEDSv2_SHIP : true # 1750-2017 --> CEDS_GBDMAPS_SHIP : false # 1970-2017 --> CEDS_GBDMAPS_SHIP_byFuelType: false # 1970-2017 @@ -1261,6 +1262,9 @@ Mask fractions: false #------------------------------------------------------------------------------ # --- Global OH fields --- #------------------------------------------------------------------------------ + +(((USE_CH4_DATA.or.USE_CO_DATA + # --- OH from GEOS-Chem v5-07 [kg/m3], needed for CH4/IMI --- (((GLOBAL_OH_GCv5 @@ -1281,10 +1285,14 @@ ${RUNDIR_GLOBAL_OH} ))).not.GLOBAL_OH_GCv5 )))GLOBAL_OH_GC14 +)))USE_CH4_DATA.or.USE_CO_DATA + #------------------------------------------------------------------------------ # --- Quantities needed for CH4 chemistry --- #------------------------------------------------------------------------------ +(((USE_CH4_DATA + # --- Global CH4 loss frequencies [1/s] ----------- (((CH4_LOSS_FREQ ${RUNDIR_CH4_LOSS} @@ -1295,9 +1303,12 @@ ${RUNDIR_CH4_LOSS} ${RUNDIR_GLOBAL_Cl} )))GLOBAL_CL +)))USE_CH4_DATA + #------------------------------------------------------------------------------ # --- Quantities needed for CO chemistry --- #------------------------------------------------------------------------------ +(((USE_CO_DATA # -- P(CO) from CH4 and NMVOC from the last 10-yr benchmark [molec/cm3/s] --- (((PROD_CO_CH4 @@ -1309,33 +1320,25 @@ ${RUNDIR_PCO_NMVOC} # --- GMI chemistry: prod/loss rates (for strato-/mesosphere) --- # --- Units: prod [v/v/s]; loss [1/s] --- -(((USE_CO_DATA (((GMI_PROD_LOSS * GMI_LOSS_CO $ROOT/GMI/v2022-11/gmi.clim.CO.geos5.2x25.nc loss 2005/1-12/1/0 C xyz s-1 CO - 1 1 * GMI_PROD_CO $ROOT/GMI/v2022-11/gmi.clim.CO.geos5.2x25.nc prod 2005/1-12/1/0 C xyz v/v/s CO - 1 1 )))GMI_PROD_LOSS -)))USE_CO_DATA -# If CO is not an advected species, then just read as a chemistry input -(((.not.USE_CO_DATA -(((GMI_PROD_LOSS -* GMI_LOSS_CO $ROOT/GMI/v2022-11/gmi.clim.CO.geos5.2x25.nc loss 2005/1-12/1/0 C xyz s-1 * - 1 1 -* GMI_PROD_CO $ROOT/GMI/v2022-11/gmi.clim.CO.geos5.2x25.nc prod 2005/1-12/1/0 C xyz v/v/s * - 1 1 -)))GMI_PROD_LOSS -))).not.USE_CO_DATA +)))USE_CO_DATA #------------------------------------------------------------------------------ # --- Quantities needed for CO2 chemistry --- #------------------------------------------------------------------------------ +(((USE_CO2_DATA # --- CHEMICAL PRODUCTION FROM CO OXIDATION ------ # --- Recommended for use in forward modelling --- # --- Optional for inversion/assimilation -------- - -(((USE_CO2_DATA (((CO2_COPROD ${RUNDIR_CO2_COPROD} )))CO2_COPROD + )))USE_CO2_DATA )))CHEMISTRY_INPUT diff --git a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.metals b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.metals index 07017f86b..f072a9dc9 100644 --- a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.metals +++ b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.metals @@ -13,7 +13,7 @@ #\\ #\\ # !REMARKS: -# This file has been customized for the Transport Tracers simulation. +# This file has been customized for the trace metals simulation. # See The HEMCO User's Guide for file details: # http://wiki.geos-chem.org/The_HEMCO_User%27s_Guide # diff --git a/run/GCClassic/HISTORY.rc.templates/HISTORY.rc.metals b/run/GCClassic/HISTORY.rc.templates/HISTORY.rc.metals index 69607f193..3975e3255 100644 --- a/run/GCClassic/HISTORY.rc.templates/HISTORY.rc.metals +++ b/run/GCClassic/HISTORY.rc.templates/HISTORY.rc.metals @@ -1,5 +1,5 @@ ############################################################################### -### HISTORY.rc file for GEOS-Chem Transport Tracers simulations ### +### HISTORY.rc file for GEOS-Chem trace metals simulations ### ### Contact: GEOS-Chem Support Team (geos-chem-support@g.harvard.edu) ### ############################################################################### diff --git a/run/GCClassic/createRunDir.sh b/run/GCClassic/createRunDir.sh index 39d34e84b..97d515a8f 100755 --- a/run/GCClassic/createRunDir.sh +++ b/run/GCClassic/createRunDir.sh @@ -927,6 +927,8 @@ cd ${rundir} # start year/month/day matches default initial restart file. if [[ "x${sim_name}" == "xHg" || "x${sim_name}" == "xCH4" || + "x${sim_name}" == "xCO2" || + "x${sim_name}" == "xtagCO" || "x${sim_name}" == "xcarbon" || "x${sim_name}" == "xTransportTracers" ]]; then startdate='20190101' diff --git a/run/GCHP/ExtData.rc.templates/ExtData.rc.carbon b/run/GCHP/ExtData.rc.templates/ExtData.rc.carbon index 4954e37b4..1c03505b6 100644 --- a/run/GCHP/ExtData.rc.templates/ExtData.rc.carbon +++ b/run/GCHP/ExtData.rc.templates/ExtData.rc.carbon @@ -263,7 +263,7 @@ CH4_SOILABSORB kg/m2/s 2009 Y F%y4-%m2-01T00:00:00 none none CH4uptake ./HcoD # --- AEIC 2019 aircraft (AEIC) --- AEIC19_MONMEAN_CO kg/m2/s Y Y F2019-%m2-01T00:00:00 none none CO ./HcoDir/AEIC2019/v2022-03/2019_monmean/AEIC_monmean_2019%m2.0.5x0.625.36L.nc # -##AEIC19_DAILY_CO kg/m2/s 2019 Y F%y4-%m2-%d2T00:00:00 none none CO ./HcoDir/AEIC2019/v2022-03/2019/%m2/AEIC_2019%m2%d2.0.5x0.625.36L.nc +##AEIC19_DAILY_CO kg/m2/s Y Y F%y4-%m2-%d2T00:00:00 none none CO ./HcoDir/AEIC2019/v2022-03/2019/%m2/AEIC_2019%m2%d2.0.5x0.625.36L.nc # --- CEDSv2 emissions --- CEDS_CO_AGR kg/m2/s N Y F%y4-%m2-01T00:00:00 none none CO_agr ./HcoDir/CEDS/v2021-06/%y4/CO-em-anthro_CMIP_CEDS_%y4.nc @@ -284,10 +284,10 @@ CEDS_CO_SHP kg/m2/s N Y F%y4-%m2-01T00:00:00 none none CO_shp ./HcoDir/CEDS/v2 FOSSILCO2_ODIAC kg/m2/s N Y F%y4-%m2-01T00:00:00 none none CO2 ./HcoDir/CO2/v2022-11/FOSSIL/ODIAC_CO2.monthly.generic.1x1.nc # --- CO2 Ocean Exchange --- -OCEANCO2_TAKA_MONTHLY kg/m2/s 2000 Y F%y4-%m2-01T00:00:00 none none CO2 ./HcoDir/CO2/v2022-11/OCEAN/Taka2009_CO2_Monthly.nc +OCEANCO2_SCALED_MONTHLY kg/m2/s N Y F%y4-%m2-01T00:00:00 none none CO2 ./HcoDir/CO2/v2022-11/OCEAN/Scaled_Ocean_CO2_monthly.nc # --- Balanced biosphere exchange --- -SIB_BBIO_CO2 kg/m2/s N Y F%y4-%m2-%d2T%h2-01-01 none none CO2 ./HcoDir/CO2/v2022-11/BIO/SiB3_3hr_NEP.nc +SIB_BBIO_CO2 kg/m2/s N Y F1985-%m2-%d2T%h2-01-01 none none CO2 ./HcoDir/CO2/v2022-11/BIO/SiB3_3hr_NEP.nc # --- Net Terrestrial Exchange --- CO2_NET_TERRESTRIAL kg/m2/s N Y - none none CO2 ./HcoDir/CO2/v2022-11/BIO/Net_terrestrial_exch_5.29Pg.generic.1x1.nc @@ -296,20 +296,20 @@ CO2_NET_TERRESTRIAL kg/m2/s N Y - none none CO2 ./HcoDir/CO2/v2022-11/BIO/Net_te CEDS_CO2_SHP kg/m2/s N Y F%y4-%m2-01T00:00:00 none none CO2_shp ./HcoDir/CEDS/v2021-06/%y4/CO2-em-anthro_CMIP_CEDS_%y4.nc # --- CO2: AEIC 2019 aircraft emissions --- -AEIC19_MONMEAN_CO2 kg/m2/s 2019 Y F%y4-%m2-%d2T00:00:00 none none FUELBURN ./HcoDir/AEIC2019/v2022-03/2019_monmean/AEIC_monmean_2019%m2.0.5x0.625.36L.nc +AEIC19_MONMEAN_CO2 kg/m2/s Y Y F2019-%m2-01T00:00:00 none none FUELBURN ./HcoDir/AEIC2019/v2022-03/2019_monmean/AEIC_monmean_2019%m2.0.5x0.625.36L.nc # --- CO2: Surface correction for CO oxidation --- -FOSSILCO2_MONTHLY kg/m/s N Y F%y4-%m2-01T01:00:00 none none CO2 ./HcoDir/CO2/v2022-11/FOSSIL/ODIAC_CO2.monthly.generic.1x1.nc -CO2_LIVESTOCK kg/m/s 2004 Y F%y4-%m2-01T01:00:00 none none CH4_004 ./HcoDir/CO2/v2022-11/CHEM/CH4_source.geos.2x25.nc -CO2_WASTE kg/m/s 2004 Y F%y4-%m2-01T01:00:00 none none CH4_005 ./HcoDir/CO2/v2022-11/CHEM/CH4_source.geos.2x25.nc -CO2_RICE kg/m/s 2004 Y F%y4-%m2-01T01:00:00 none none CH4_007 ./HcoDir/CO2/v2022-11/CHEM/CH4_source.geos.2x25.nc -CO2_WETLANDS kg/m/s 2004 Y F%y4-%m2-01T01:00:00 none none CH4_010 ./HcoDir/CO2/v2022-11/CHEM/CH4_source.geos.2x25.nc -CO2_NATURAL kg/m/s 2004 Y F%y4-%m2-01T01:00:00 none none CH4_012 ./HcoDir/CO2/v2022-11/CHEM/CH4_source.geos.2x25.nc -CO2_ISOPRENE kg/m/s 2004 Y F%y4-%m2-01T01:00:00 none none ISOP ./HcoDir/CO2/v2022-11/CHEM/Isoprene-2004.geos.2x25.nc -CO2_MONOTERP kg/m/s 2004 Y F%y4-%m2-01T01:00:00 none none MONOT ./HcoDir/CO2/v2022-11/CHEM/Monoterpene-2004.geos.2x25.nc +FOSSILCO2_MONTHLY kg/m/s N Y F%y4-%m2-01T01:00:00 none none CO2 ./HcoDir/CO2/v2022-11/FOSSIL/ODIAC_CO2.monthly.generic.1x1.nc +CO2_LIVESTOCK kg/m/s Y Y F2004-%m2-01T01:00:00 none none CH4_004 ./HcoDir/CO2/v2022-11/CHEM/CH4_source.geos.2x25.nc +CO2_WASTE kg/m/s Y Y F2004-%m2-01T01:00:00 none none CH4_005 ./HcoDir/CO2/v2022-11/CHEM/CH4_source.geos.2x25.nc +CO2_RICE kg/m/s Y Y F2004-%m2-01T01:00:00 none none CH4_007 ./HcoDir/CO2/v2022-11/CHEM/CH4_source.geos.2x25.nc +CO2_WETLANDS kg/m/s Y Y F2004-%m2-01T01:00:00 none none CH4_010 ./HcoDir/CO2/v2022-11/CHEM/CH4_source.geos.2x25.nc +CO2_NATURAL kg/m/s Y Y F2004-%m2-01T01:00:00 none none CH4_012 ./HcoDir/CO2/v2022-11/CHEM/CH4_source.geos.2x25.nc +CO2_ISOPRENE kg/m/s Y Y F2004-%m2-01T01:00:00 none none ISOP ./HcoDir/CO2/v2022-11/CHEM/Isoprene-2004.geos.2x25.nc +CO2_MONOTERP kg/m/s Y Y F2004-%m2-01T01:00:00 none none MONOT ./HcoDir/CO2/v2022-11/CHEM/Monoterpene-2004.geos.2x25.nc # --- CO2 production from CO --- -CO2_COPROD kgC/m3/s N Y F%y2-%m2-01T00:00:00 none none LCO ./HcoDir/CO2/v2024-01/CHEM/CO2_prod_rates.GEOS5.2x25.72L.nc +CO2_COPROD kgC/m3/s N Y F%y4-%m2-01T00:00:00 none none LCO ./HcoDir/CO2/v2024-01/CHEM/CO2_prod_rates.GEOS5.2x25.72L.nc #============================================================================== # --- OCS emission fluxes --- @@ -409,12 +409,11 @@ SHIP_LEVS 1 N Y - none none cmv_c3 ./HcoDir/VerticalScaleFactors/v2021-0 #============================================================================== # --- National fossil fuel CO2 scale factors (Nassar et al, 2013) --- -CO2_DIURNAL 1 N Y F2016-01-01T%h2:00:00 none none diurnal_scale_factors ./HcoDir/CO2/v2015-04/FOSSIL/TIMES_diurnal_scale_factors.nc -CO2_WEEKLY 1 2006 Y F%y4-%m2-%d2T00:00:00 none none weekly_scale_factors ./HcoDir/CO2/v2015-04/FOSSIL/TIMES_weekly_scale_factors.nc +CO2_DIURNAL 1 N Y F2006-01-01T%h2:00:00 none none diurnal_scale_factors ./HcoDir/CO2/v2015-04/FOSSIL/TIMES_diurnal_scale_factors.nc +CO2_WEEKLY 1 D Y F2006-01-01T00:00:00 none none weekly_scale_factors ./HcoDir/CO2/v2015-04/FOSSIL/TIMES_weekly_scale_factors.nc # --- Domestic aviation surface correction factor --- -AVIATION_SURF_CORR 1 2004 Y F%y2-01-01T00:00:00 none none CO2 ./HcoDir/CO2/v2022-11/FOSSIL/Aviation_SurfCorr_SclFac.1x1.nc -OCEANCO2_SCALED_MONTHLY kg/m2/s N Y F%y2-%m2-01T00:00:00 none none CO2 ./HcoDir/CO2/v2022-11/OCEAN/Scaled_Ocean_CO2_monthly.nc +AVIATION_SURF_CORR 1 Y Y F2004-01-01T00:00:00 none none CO2 ./HcoDir/CO2/v2022-11/FOSSIL/Aviation_SurfCorr_SclFac.1x1.nc ############################################################################### ### 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 b324c2c52..ee31e6ee9 100644 --- a/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon +++ b/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.carbon @@ -114,6 +114,7 @@ Mask fractions: false --> GMD_SFC_CH4 : true # 1979-2020 --> CMIP6_SFC_CH4 : false # 1750-1978 # ..... Ship emissions ............... + --> SHIP : true --> CEDSv2_SHIP : true # 1750-2017 --> CEDS_GBDMAPS_SHIP : false # 1970-2017 --> CEDS_GBDMAPS_SHIP_byFuelType: false # 1970-2017 @@ -1261,6 +1262,9 @@ Mask fractions: false #------------------------------------------------------------------------------ # --- Global OH fields --- #------------------------------------------------------------------------------ + +(((USE_CH4_DATA.or.USE_CO_DATA + # --- OH from GEOS-Chem v5-07 [kg/m3], needed for CH4/IMI --- (((GLOBAL_OH_GCv5 @@ -1281,10 +1285,14 @@ ${RUNDIR_GLOBAL_OH} ))).not.GLOBAL_OH_GCv5 )))GLOBAL_OH_GC14 +)))USE_CH4_DATA.or.USE_CO_DATA + #------------------------------------------------------------------------------ # --- Quantities needed for CH4 chemistry --- #------------------------------------------------------------------------------ +(((USE_CH4_DATA + # --- Global CH4 loss frequencies [1/s] ----------- (((CH4_LOSS_FREQ ${RUNDIR_CH4_LOSS} @@ -1295,9 +1303,12 @@ ${RUNDIR_CH4_LOSS} ${RUNDIR_GLOBAL_Cl} )))GLOBAL_CL +)))USE_CH4_DATA + #------------------------------------------------------------------------------ # --- Quantities needed for CO chemistry --- #------------------------------------------------------------------------------ +(((USE_CO_DATA # -- P(CO) from CH4 and NMVOC from the last 10-yr benchmark [molec/cm3/s] --- (((PROD_CO_CH4 @@ -1309,33 +1320,25 @@ ${RUNDIR_PCO_NMVOC} # --- GMI chemistry: prod/loss rates (for strato-/mesosphere) --- # --- Units: prod [v/v/s]; loss [1/s] --- -(((USE_CO_DATA (((GMI_PROD_LOSS * GMI_LOSS_CO $ROOT/GMI/v2022-11/gmi.clim.CO.geos5.2x25.nc loss 2005/1-12/1/0 C xyz s-1 CO - 1 1 * GMI_PROD_CO $ROOT/GMI/v2022-11/gmi.clim.CO.geos5.2x25.nc prod 2005/1-12/1/0 C xyz v/v/s CO - 1 1 )))GMI_PROD_LOSS -)))USE_CO_DATA -# If CO is not an advected species, then just read as a chemistry input -(((.not.USE_CO_DATA -(((GMI_PROD_LOSS -* GMI_LOSS_CO $ROOT/GMI/v2022-11/gmi.clim.CO.geos5.2x25.nc loss 2005/1-12/1/0 C xyz s-1 * - 1 1 -* GMI_PROD_CO $ROOT/GMI/v2022-11/gmi.clim.CO.geos5.2x25.nc prod 2005/1-12/1/0 C xyz v/v/s * - 1 1 -)))GMI_PROD_LOSS -))).not.USE_CO_DATA +)))USE_CO_DATA #------------------------------------------------------------------------------ # --- Quantities needed for CO2 chemistry --- #------------------------------------------------------------------------------ +(((USE_CO2_DATA # --- CHEMICAL PRODUCTION FROM CO OXIDATION ------ # --- Recommended for use in forward modelling --- # --- Optional for inversion/assimilation -------- - -(((USE_CO2_DATA (((CO2_COPROD ${RUNDIR_CO2_COPROD} )))CO2_COPROD + )))USE_CO2_DATA )))CHEMISTRY_INPUT diff --git a/run/shared/download_data.py b/run/shared/download_data.py index 3bc8fd35d..5f10b8d55 100755 --- a/run/shared/download_data.py +++ b/run/shared/download_data.py @@ -726,14 +726,16 @@ def parse_args(): # Parse command-line arguments (argument 0 is the program name) for i in range(1, len(sys.argv)): - arg = sys.argv[i].lower() - arg = arg.lstrip('-') + arg = sys.argv[i] if not dryrun_found: dryrun_log = arg dryrun_found = True continue + # Normalize arguments other than dryrun_log + arg = arg.lower().lstrip('-') + if not portal_found: for mir in portal_list: portal = mir.lower() diff --git a/run/shared/download_data.yml b/run/shared/download_data.yml index 6215aa77f..646e87924 100644 --- a/run/shared/download_data.yml +++ b/run/shared/download_data.yml @@ -61,11 +61,11 @@ restarts: remote: v2023-01/GEOSChem.Restart.carbon.20190101_0000z.nc4 local: GEOSChem.Restart.20190101_0000z.nc4 ch4: - remote: v2020-02/GEOSChem.Restart.CH4.20190101_0000z.nc4 + remote: v2023-01/GEOSChem.Restart.carbon.20190101_0000z.nc4 local: GEOSChem.Restart.20190101_0000z.nc4 co2: - remote: v2020-02/GEOSChem.Restart.CO2.20190701_0000z.nc4 - local: GEOSChem.Restart.20190701_0000z.nc4 + remote: v2023-01/GEOSChem.Restart.carbon.20190101_0000z.nc4 + local: GEOSChem.Restart.20190101_0000z.nc4 fullchem: remote: GC_14.5.0/GEOSChem.Restart.fullchem.20190701_0000z.nc4 local: GEOSChem.Restart.20190701_0000z.nc4 diff --git a/run/shared/singleCarbonSpecies.sh b/run/shared/singleCarbonSpecies.sh index 0e46e3637..a727dc2e8 100755 --- a/run/shared/singleCarbonSpecies.sh +++ b/run/shared/singleCarbonSpecies.sh @@ -314,17 +314,17 @@ function updateExtData() { sed -i "/AEIC19_DAILY_CO /d" "${file}" # trailing space required sed -i "/AEIC19_MONMEAN_CO /d" "${file}" # trailing space required sed -i "/APEI_CO/d" "${file}" - sed -i "/^CEDS_CO/d" "${file}" - sed -i "/CMIP6_CO/d" "${file}" + sed -i "/^CEDS_CO_/d" "${file}" + sed -i "/CMIP6_CO_/d" "${file}" sed -i "/\#DICE_/d" "${file}" - sed -i "/EDGAR_CO/d" "${file}" + sed -i "/EDGAR_CO_/d" "${file}" sed -i "/EPA16_CO_/d" "${file}" sed -i "/HTAP_CO_/d" "${file}" - sed -i "/RCP3PD_CO/d" "${file}" - sed -i "/RCP45_CO/d" "${file}" - sed -i "/RCP60_CO/d" "${file}" - sed -i "/RCP85_CO/d" "${file}" - sed -i "/NEI99_DOW_CO/d" "${file}" + sed -i "/RCP3PD_CO /d" "${file}" + sed -i "/RCP45_CO /d" "${file}" + sed -i "/RCP60_CO /d" "${file}" + sed -i "/RCP85_CO /d" "${file}" + sed -i "/NEI99_DOW_CO /d" "${file}" sed -i "/LIQFUEL_/d" "${file}" fi