From c2825738135b979699a7ce8cc54837bca4c693b5 Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Tue, 26 Mar 2024 11:53:28 -0400 Subject: [PATCH 01/37] Initial version of KPP Standalone Interface --- GeosCore/CMakeLists.txt | 1 + GeosCore/fullchem_mod.F90 | 49 +- GeosCore/kpp_standalone_interface.F90 | 689 ++++++++++++++++++++++++++ run/kpp_standalone_interface.yml | 78 +++ 4 files changed, 816 insertions(+), 1 deletion(-) create mode 100644 GeosCore/kpp_standalone_interface.F90 create mode 100644 run/kpp_standalone_interface.yml diff --git a/GeosCore/CMakeLists.txt b/GeosCore/CMakeLists.txt index f01fbbd42..226de8624 100755 --- a/GeosCore/CMakeLists.txt +++ b/GeosCore/CMakeLists.txt @@ -82,6 +82,7 @@ add_library(GeosCore vdiff_mod.F90 wetscav_mod.F90 YuIMN_Code.F90 + kpp_standalone_interface.F90 # Files only included for special cases $<$:flexgrid_read_mod.F90 get_met_mod.F90 set_boundary_conditions_mod.F90> diff --git a/GeosCore/fullchem_mod.F90 b/GeosCore/fullchem_mod.F90 index ecdda088d..cdf205c5f 100644 --- a/GeosCore/fullchem_mod.F90 +++ b/GeosCore/fullchem_mod.F90 @@ -140,6 +140,7 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & USE UCX_MOD, ONLY : SO4_PHOTFRAC USE UCX_MOD, ONLY : UCX_NOX USE UCX_MOD, ONLY : UCX_H2SO4PHOT + USE KPP_Standalone_Interface #ifdef TOMAS USE TOMAS_MOD, ONLY : H2SO4_RATE USE TOMAS_MOD, ONLY : PSO4AQ_RATE @@ -178,7 +179,7 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & INTEGER :: errorCount, previous_units REAL(fp) :: SO4_FRAC, T, TIN REAL(fp) :: TOUT, SR, LWC - + REAL(dp) :: KPPH_before_integrate ! Strings CHARACTER(LEN=255) :: errMsg, thisLoc @@ -200,6 +201,7 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & REAL(dp) :: RCNTRL (20) REAL(dp) :: RSTATE (20) REAL(dp) :: C_before_integrate(NSPEC) + REAL(dp) :: local_RCONST(NREACT) ! For tagged CO saving REAL(fp) :: LCH4, PCO_TOT, PCO_CH4, PCO_NMVOC @@ -438,6 +440,13 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & mapData => NULL() ENDIF + !======================================================================= + ! Should we print the full chemical state for any grid cell on this CPU? + ! for use with the KPP Standalone + ! (psturm, 03/22/24) + !======================================================================= + CALL Check_Domain( RC ) + !======================================================================== ! Set up integration convergence conditions and timesteps ! (cf. M. J. Evans) @@ -514,6 +523,7 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & !$OMP DEFAULT( SHARED )& !$OMP PRIVATE( I, J, L, N )& !$OMP PRIVATE( ICNTRL, C_before_integrate )& + !$OMP PRIVATE( KPPH_before_integrate, local_RCONST )& !$OMP PRIVATE( SO4_FRAC, IERR, RCNTRL, ISTATUS, RSTATE )& !$OMP PRIVATE( SpcID, KppID, F, P, Vloc )& !$OMP PRIVATE( Aout, Thread, RC, S, LCH4 )& @@ -569,6 +579,12 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! atmosphere if keepActive option is enabled. (hplin, 2/9/22) CALL fullchem_AR_SetKeepActive( option=.TRUE. ) + ! Check if the current grid cell in this loop should have its + ! full chemical state printed (concentrations, rates, constants) + ! for use with the KPP Standalone + ! (psturm, 03/22/24) + CALL Check_ActiveCell( I, J, L, State_Grid ) + ! Start measuring KPP-related routine timing for this grid box IF ( State_Diag%Archive_KppTime ) THEN call cpu_time(TimeStart) @@ -990,6 +1006,11 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! let us reset concentrations before calling "Integrate" a 2nd time. C_before_integrate = C + ! Do the same for the KPP initial timestep + ! Save local rate constants too + KPPH_before_integrate = State_Chm%KPPHvalue(I,J,L) + local_RCONST = RCONST + ! Call the Rosenbrock integrator ! (with optional auto-reduce functionality) CALL Integrate( TIN, TOUT, ICNTRL, & @@ -1260,6 +1281,16 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & State_Diag%KppTime(I,J,L) = TimeEnd - TimeStart ENDIF + ! Write chemical state to file for the kpp standalone interface + ! No external logic needed, this subroutine exits early if the + ! chemical state should not be printed (psturm, 03/23/24) +#ifdef MODEL_GEOS + CALL Write_Samples( I, J, L, C_before_integrate, & + local_RCONST, KPPH_before_integrate, & + State_Grid, State_Chm, State_Met, & + Input_Opt, ISTATUS(3), RC ) +#endif + !===================================================================== ! Check we have no negative values and copy the concentrations ! calculated from the C array back into State_Chm%Species%Conc @@ -2667,6 +2698,7 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) USE State_Chm_Mod, ONLY : ChmState USE State_Chm_Mod, ONLY : Ind_ USE State_Diag_Mod, ONLY : DgnState + USE KPP_Standalone_Interface, ONLY : Config_KPP_Standalone ! ! !INPUT PARAMETERS: ! @@ -2959,6 +2991,16 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) ENDIF ENDIF + !-------------------------------------------------------------------- + ! Initialize grid cells for input to KPP Standalone (Obin Sturm) + !-------------------------------------------------------------------- + CALL Config_KPP_Standalone( Input_Opt, RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "KPP_Standalone"!' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + END SUBROUTINE Init_FullChem !EOC !------------------------------------------------------------------------------ @@ -2978,6 +3020,7 @@ SUBROUTINE Cleanup_FullChem( RC ) ! !USES: ! USE ErrCode_Mod + USE KPP_Standalone_Interface, ONLY : Cleanup_KPP_Standalone ! ! !OUTPUT PARAMETERS: ! @@ -3027,6 +3070,10 @@ SUBROUTINE Cleanup_FullChem( RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF + ! Deallocate variables from kpp standalone module + ! psturm, 03/22/2024 + CALL Cleanup_KPP_Standalone( RC ) + END SUBROUTINE Cleanup_FullChem !EOC END MODULE FullChem_Mod diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 new file mode 100644 index 000000000..f33dfc0aa --- /dev/null +++ b/GeosCore/kpp_standalone_interface.F90 @@ -0,0 +1,689 @@ +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: kpp_standalone_interface.F90 +! +! !DESCRIPTION: Contains routines to print the full chemical state in fullchem, which can be used as input to the KPP Standalone. +!\\ +!\\ +! !INTERFACE: +! +MODULE KPP_Standalone_Interface +! +! !USES: +! + USE PRECISION_MOD ! For GEOS-Chem Precision (fp) + USE HCO_ERROR_MOD ! For real precisions (hp) + IMPLICIT NONE + PRIVATE +! +! !PUBLIC MEMBERS: +! + PUBLIC :: Check_Domain + PUBLIC :: Check_ActiveCell + PUBLIC :: Config_KPP_Standalone + PUBLIC :: Write_Samples + PUBLIC :: Cleanup_KPP_Standalone + + TYPE :: KPP_Standalone_Interface_Type + ! Scalars + INTEGER :: NLOC + LOGICAL :: Active_Cell + LOGICAL :: SkipIt + + ! Strings + CHARACTER(LEN=255) :: Active_Cell_Name + CHARACTER(LEN=255) :: Output_Directory + + ! Allocatable arrays + CHARACTER(LEN=255), DIMENSION(:), ALLOCATABLE :: LocationName + REAL(hp), DIMENSION(:), ALLOCATABLE :: LocationLons + REAL(hp), DIMENSION(:), ALLOCATABLE :: LocationLats + INTEGER, DIMENSION(:), ALLOCATABLE :: IDX + INTEGER, DIMENSION(:), ALLOCATABLE :: JDX + INTEGER, DIMENSION(:), ALLOCATABLE :: Levels + END TYPE KPP_Standalone_Interface_Type +! + +TYPE(KPP_Standalone_Interface_Type) :: KPP_Standalone_YAML +! !REVISION HISTORY: +CONTAINS +!EOP +!------------------------------------------------------------------------------ +!BOC +! +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: check_domain +! +! !DESCRIPTION: Subroutine Check_Domain is used to identify if a +! specified latitude and longitude falls within a grid cell on the +! current CPU. Multiple lat/lon pairs can be checked simultaneously. +! Obin Sturm (psturm@usc.edu) 2023/12/29 +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Check_Domain( RC ) + +! !USES: + USE HCO_GeoTools_Mod, ONLY: HCO_GetHorzIJIndex + USE HCO_State_GC_Mod, ONLY : HcoState + USE HCO_ERROR_MOD ! For real precisions (hp) +! !OUTPUT PARAMETERS + integer, intent(out) :: RC + + + ! Early exit if no locations + IF ( KPP_Standalone_YAML%SkipIt ) THEN + RETURN + END IF + + CALL HCO_GetHorzIJIndex( HcoState, & + KPP_Standalone_YAML%NLOC, & + KPP_Standalone_YAML%LocationLons, & + KPP_Standalone_YAML%LocationLats, & + KPP_Standalone_YAML%IDX, & + KPP_Standalone_YAML%JDX, & + RC) + END SUBROUTINE Check_Domain +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: check_activecell +! +! !DESCRIPTION: Subroutine Check_ActiveCell is used to identify if a grid cell +! is within a specified latitude and longitude to print the full chemical state +! (all concentrations, reaction rates, rate constants, and meteo metadata). +! Obin Sturm (psturm@usc.edu) 2024/03/11 +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Check_ActiveCell( I, J, L, State_Grid ) + +! !USES: + USE State_Grid_Mod, ONLY : GrdState +! !INPUT PARAMETERS: + INTEGER, INTENT(IN) :: I,J,L ! Grid Indices + TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object +! !LOCAL VARIABLES + INTEGER :: K + + KPP_Standalone_YAML%Active_Cell = .FALSE. + + ! Early exit if there was no YAML file or no active cells + IF ( KPP_Standalone_YAML%SkipIt ) THEN + RETURN + END IF + + IF ( ANY(L == KPP_Standalone_YAML%Levels) ) THEN + DO K = 1,KPP_Standalone_YAML%NLOC + IF ( KPP_Standalone_YAML%IDX(K) == I .AND. KPP_Standalone_YAML%JDX(K) == J ) THEN + KPP_Standalone_YAML%Active_Cell = .TRUE. + KPP_Standalone_YAML%Active_Cell_Name = KPP_Standalone_YAML%LocationName(K) + write(*,*) trim(KPP_Standalone_YAML%Active_Cell_Name), " LatLon: " , State_Grid%YMid(I,J), State_Grid%XMid(I,J) + ENDIF + ENDDO + ENDIF + END SUBROUTINE Check_ActiveCell +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Config_KPP_Standalone +! +! !DESCRIPTION: Subroutine Config_KPP_Standalone reads a set of gridcells to be sampled +! and the full chemical state printed. +! Obin Sturm (psturm@usc.edu) 2024/03/11 +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) + USE QfYaml_Mod + USE ErrCode_Mod + USE Input_Opt_Mod, ONLY : OptInput + USE RoundOff_Mod, ONLY : Cast_and_RoundOff + USE inquireMod, ONLY : findFreeLUN +! !INPUT PARAMETERS: +! + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure +! +! !LOCAL VARIABLES: +! + ! Scalars + INTEGER :: I, N + INTEGER :: IU_FILE ! Available unit for writing + INTEGER :: path_exists + LOGICAL :: file_exists + + ! Strings + CHARACTER(LEN=255) :: thisLoc + CHARACTER(LEN=512) :: errMsg + CHARACTER(LEN=QFYAML_NamLen) :: key + CHARACTER(LEN=QFYAML_StrLen) :: v_str + + ! Objects + TYPE(QFYAML_t) :: Config, ConfigAnchored + + ! Arrays + INTEGER :: a_int(QFYAML_MaxArr) + + ! String arrays + CHARACTER(LEN=QFYAML_NamLen) :: a_str(QFYAML_MaxArr) + + ! YAML configuration file name to be read + CHARACTER(LEN=30), PARAMETER :: configFile = './kpp_standalone_interface.yml' + + ! Inquire if YAML interface exists -- if not, skip initializing + KPP_Standalone_YAML%SkipIt = .FALSE. + INQUIRE( FILE=configFile, EXIST=file_exists ) + IF ( .NOT. file_exists ) THEN + KPP_Standalone_YAML%SkipIt = .TRUE. + IF ( Input_Opt%amIRoot ) & + write(*,*) "Config file ", configFile, " not found, skipping KPP Standalone interface" + RETURN + END IF + + ! Assume success + RC = GC_SUCCESS + errMsg = '' + thisLoc = ' -> at Config_KPP_Standalone (in module GeosCore/kpp_standalone_interface.F90)' + + !======================================================================== + ! Read the YAML file into the Config object + !======================================================================== + CALL QFYAML_Init( configFile, Config, ConfigAnchored, RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error reading configuration file: ' // TRIM( configFile ) + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + + !======================================================================== + ! Read the list of active cells + !======================================================================== + key = "active_cells" + a_str = MISSING_STR + CALL QFYAML_Add_Get( Config, key, a_str, "", RC, dynamic_size=.TRUE. ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error parsing ' // TRIM( key ) // '!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + + !======================================================================== + ! Get the number of active cells (if 0, return) and the list of names + !======================================================================== + KPP_Standalone_YAML%NLOC = Find_Number_of_Locations( a_str ) + IF ( KPP_Standalone_YAML%NLOC .eq. 0 ) THEN + ! Set SkipIt flag to short circuit other subroutines + KPP_Standalone_YAML%SkipIt = .TRUE. + IF ( Input_Opt%amIRoot ) & + write(*,*) "No active cells for box modeling in kpp_standalone_interface.yml" + RETURN + END IF + ALLOCATE( KPP_Standalone_YAML%LocationName( KPP_Standalone_YAML%NLOC ), STAT=RC ) + CALL GC_CheckVar( 'KPP_Standalone_YAML%LocationName', 0, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + DO I = 1,KPP_Standalone_YAML%NLOC + KPP_Standalone_YAML%LocationName(I) = TRIM( a_str(I) ) + END DO + + !======================================================================== + ! Read latitude and longitude of active cells + !======================================================================== + + ! Allocate number of locations for lats and lons + ALLOCATE( KPP_Standalone_YAML%LocationLons( KPP_Standalone_YAML%NLOC ), STAT=RC ) + CALL GC_CheckVar( 'KPP_Standalone_YAML%LocationLons', 0, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + + ALLOCATE( KPP_Standalone_YAML%LocationLats( KPP_Standalone_YAML%NLOC ), STAT=RC ) + CALL GC_CheckVar( 'KPP_Standalone_YAML%LocationLats', 0, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + + ! Read coordinates + DO I = 1,KPP_Standalone_YAML%NLOC + ! Read longitudes + key = "locations%"//TRIM( KPP_Standalone_YAML%LocationName(I) )//"%longitude" + 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 + KPP_Standalone_YAML%LocationLons( I ) = Cast_and_RoundOff( TRIM( v_str ), places=-1 ) + ! Read latitudes + key = "locations%"//TRIM( KPP_Standalone_YAML%LocationName(I) )//"%latitude" + 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 + KPP_Standalone_YAML%LocationLats( I ) = Cast_and_RoundOff( TRIM( v_str ), places=-1 ) + END DO + + ! Allocate IDX and JDX (masks for whether a location is on the CPU) + ALLOCATE( KPP_Standalone_YAML%IDX( KPP_Standalone_YAML%NLOC ), STAT=RC ) + CALL GC_CheckVar( 'KPP_Standalone_YAML%IDX', 0, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + + ALLOCATE( KPP_Standalone_YAML%JDX( KPP_Standalone_YAML%NLOC ), STAT=RC ) + CALL GC_CheckVar( 'KPP_Standalone_YAML%JDX', 0, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + + KPP_Standalone_YAML%IDX(:) = -1 + KPP_Standalone_YAML%JDX(:) = -1 + + !======================================================================== + ! Get the list of levels and number of levels + !======================================================================== + ! Note: could add capability for location specific levels + key = "settings%levels" + a_int = MISSING_INT + CALL QFYAML_Add_Get( Config, key, a_int, "", RC, dynamic_size=.TRUE. ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error parsing ' // TRIM( key ) // '!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + N = Find_Number_of_Levels( a_int ) + ! if no specified levels, print the surface + IF ( N .eq. 0 ) THEN + N = 1 + a_int(1) = 1 + END IF + ALLOCATE( KPP_Standalone_YAML%Levels( N ), STAT=RC ) + CALL GC_CheckVar( 'KPP_Standalone_YAML%Levels', 0, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + DO I = 1,N + KPP_Standalone_YAML%Levels(I) = a_int(I) + END DO + + !======================================================================== + ! Set the output directory + !======================================================================== + ! Get that value + key = "settings%output_directory" + 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 + ! Check to see if the directory exists + ! Do this in a portable way that works across compilers + ! The directory specifier in inquire might be specific to ifort + ! So instead try to open a test file within the output directory + IU_FILE = findFreeLUN() + open(IU_FILE,FILE=trim(v_str)//'/.test_directory_existence', & + action = "WRITE",iostat=path_exists,access='SEQUENTIAL') + IF ( path_exists /= 0 ) THEN + IF ( Input_Opt%amIRoot ) & + write(*,*) "KPP Standalone Interface warning: Specified output directory ", & + trim(v_str), " does not exist, writing to default output path" + KPP_Standalone_YAML%Output_Directory = "./" + ELSE + KPP_Standalone_YAML%Output_Directory = trim(v_str) + ! Delete the file that tested the directory existence + ! Think that just because we're here means that it still exists? + ! Not with multiple CPUs deleting in parallel! Time to inquire + !INQUIRE( UNIT=IU_FILE, EXIST=file_exists ) + close(IU_FILE) + END IF + + END SUBROUTINE Config_KPP_Standalone +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Write_Samples +! +! !DESCRIPTION: Subroutine Write_Samples writes the full chemical state +! (concentrations, reaction rates and rate constants, meteorological conditions). +! Obin Sturm (psturm@usc.edu) 2024/03/11 +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & + State_Grid, State_Chm, State_Met, Input_Opt, & + KPP_TotSteps, RC, FORCE_WRITE, CELL_NAME ) + USE ErrCode_Mod + USE State_Grid_Mod, ONLY : GrdState + USE State_Chm_Mod, ONLY : ChmState + USE State_Met_Mod, ONLY : MetState + USE Input_Opt_Mod, ONLY : OptInput + USE GcKpp_Function + USE GcKpp_Parameters, ONLY : NSPEC, NREACT, NVAR + USE TIME_MOD, ONLY : GET_TS_CHEM + USE TIME_MOD, ONLY : TIMESTAMP_STRING + USE TIME_MOD, ONLY : Get_Minute + USE TIME_MOD, ONLY : Get_Hour + USE TIME_MOD, ONLY : Get_Day + USE TIME_MOD, ONLY : Get_Month + USE TIME_MOD, ONLY : Get_Year + USE Pressure_Mod, ONLY : Get_Pcenter + USE inquireMod, ONLY : findFreeLUN +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: I ! Longitude index + INTEGER, INTENT(IN) :: J ! Latitude index + INTEGER, INTENT(IN) :: L ! GEOS-Chem vertical level + INTEGER, INTENT(IN) :: KPP_TotSteps ! Total KPP integrator steps + + TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object + TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object + TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object + REAL(dp), INTENT(IN) :: initC(NSPEC) ! Initial concentrations + REAL(dp), INTENT(IN) :: localRCONST(NREACT) ! Rate constants + REAL(dp) :: initHvalue ! Initial timestep + +! !OPTIONAL INPUT PARAMETER + LOGICAL, OPTIONAL :: FORCE_WRITE ! Write even if not in an active cell + CHARACTER(LEN=255), OPTIONAL :: CELL_NAME ! Customize the name of this file +! +! !AUXILLIARY LOCAL PARAMETERS (pass the aux bc Fortran doesn't have defaults for kwargs) + LOGICAL :: FORCE_WRITE_AUX ! Write even if not in an active cell + CHARACTER(LEN=255) :: CELL_NAME_AUX ! Customize the name of this file +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure +! +! !LOCAL VARIABLES: + ! Integers + INTEGER :: N ! Loop index + INTEGER :: IU_FILE ! Available unit for writing + INTEGER :: SpcID ! Mapping from State_Chm and KPP + ! Strings + CHARACTER(LEN=255) :: YYYYMMDD_hhmmz + CHARACTER(LEN=255) :: level_string + CHARACTER(LEN=512) :: errMsg + + ! Arrays + REAL(dp) :: Vloc(NVAR), Aout(NREACT) ! For KPP reaction rate diagnostics + + + ! Did a user want to write the chemical state even if not in an active cell? + IF ( PRESENT(FORCE_WRITE) ) THEN + FORCE_WRITE_AUX = FORCE_WRITE + ELSE + FORCE_WRITE_AUX = .FALSE. + END IF + + ! Quit early if there's no writing to be done + IF (KPP_Standalone_YAML%Active_Cell .eq. .FALSE. .AND. FORCE_WRITE_AUX .eq. .FALSE.) THEN + RETURN + END IF + + ! Did the call include an optional cell name? + IF ( PRESENT(CELL_NAME) ) THEN + CELL_NAME_AUX = CELL_NAME + ELSE + CELL_NAME_AUX = '' + END IF + + CALL Fun( V = initC(1:NVAR), & + F = initC(NVAR+1:NSPEC), & + RCT = localRCONST, & + Vdot = Vloc, & + Aout = Aout ) + + !======================================================================== + ! Write the file + !======================================================================== + ! Find a free file LUN + IU_FILE = findFreeLUN() + write(level_string,'(I0)') L + write(YYYYMMDD_hhmmz,'(I0.4,I0.2,I0.2,a,I0.2,I0.2)' ) & + Get_Year(), Get_Month(), Get_Day(),'_', Get_Hour(), Get_Minute() + open(IU_FILE,FILE=trim(KPP_Standalone_YAML%Output_Directory)//'/' & + //trim(CELL_NAME_AUX)//trim(KPP_Standalone_YAML%ACTIVE_CELL_NAME) & + //'_L'//trim(level_string)//'_' //trim(YYYYMMDD_hhmmz)//'.txt', & + action = "WRITE",iostat=RC,access='SEQUENTIAL') + IF ( RC /= 0 ) THEN + IF ( Input_Opt%amIRoot ) & + errMsg = 'Error writing chemical state to KPP Standalone file' + CALL GC_Error( errMsg, RC, '' ) + RETURN + END IF + ! Write header to file + write(IU_FILE, '(a)') '===========================================================================' + write(IU_FILE, '(a)') ' ' + write(IU_FILE, '(a)') ' KPP Standalone Atmospheric Chemical State ' + write(IU_FILE, '(a)') ' ' + write(IU_FILE, '(a)') 'File Description: ' + write(IU_FILE, '(a)') 'This file contains model output of the atmospheric chemical state ' + write(IU_FILE, '(a)') 'as simulated by the GEOS-Chem chemistry module in a 3D setting. ' + write(IU_FILE, '(a)') 'Each grid cell represents the chemical state of an individual location, ' + write(IU_FILE, '(a)') 'suitable for input into a separate KPP Standalone program which will ' + write(IU_FILE, '(a)') 'replicate the chemical evolution of that grid cell for mechanism analysis. ' + write(IU_FILE, '(a)') 'Note that the KPP Standalone will only use concentrations, rate constants, ' + write(IU_FILE, '(a)') 'and KPP-specific fields. All other fields are for reference. If wanting to ' + write(IU_FILE, '(a)') 'use this output for other analysis, a Python class to read these fields is ' + write(IU_FILE, '(a)') 'available by request, contact Obin Sturm (psturm@usc.edu). ' + write(IU_FILE, '(a)') ' ' + write(IU_FILE, '(a)') 'Generated by GEOS-Chem Model ' + write(IU_FILE, '(a)') ' (https://geos-chem.org/) ' + write(IU_FILE, '(a)') 'Using the KPP Standalone Interface ' + write(IU_FILE, '(a)') ' With contributions from: ' + write(IU_FILE, '(a)') ' Obin Sturm (psturm@usc.edu) ' + write(IU_FILE, '(a)') ' Christoph Keller ' + write(IU_FILE, '(a)') ' Michael Long ' + write(IU_FILE, '(a)') ' Sam Silva ' + write(IU_FILE, '(a)') ' ' + write(IU_FILE, '(a)') '===========================================================================' + ! Write the grid cell metadata + write(IU_FILE,'(a)' ) 'Meteorological and general grid cell metadata ' + write(IU_FILE,'(a,a)' ) 'Location: ', trim(CELL_NAME_AUX)//trim(KPP_Standalone_YAML%ACTIVE_CELL_NAME) + write(IU_FILE,'(a,a)' ) 'Timestamp: ', TIMESTAMP_STRING() + write(IU_FILE,'(a,F11.4)') 'Longitude (degrees): ', State_Grid%XMid(I,J) + write(IU_FILE,'(a,F11.4)') 'Latitude (degrees): ', State_Grid%YMid(I,J) + write(IU_FILE,'(a,i6)' ) 'GEOS-Chem Vertical Level: ', L + write(IU_FILE,'(a,F11.4)') 'Pressure (hPa): ', Get_Pcenter(I,J,L) + write(IU_FILE,'(a,F11.2)') 'Temperature (K): ', State_Met%T(I,J,L) + write(IU_FILE,'(a,e11.4)') 'Dry air density (molec/cm3): ', State_Met%AIRNUMDEN(I,J,L) + write(IU_FILE,'(a,e11.4)') 'Water vapor mixing ratio (vol H2O/vol dry air): ', State_Met%AVGW(I,J,L) + write(IU_FILE,'(a,e11.4)') 'Cloud fraction: ', State_Met%CLDF(I,J,L) + write(IU_FILE,'(a,e11.4)') 'Cosine of solar zenith angle: ', State_Met%SUNCOSmid(I,J) + write(IU_FILE,'(a)' ) 'KPP Integrator-specific parameters ' + write(IU_FILE,'(a,e11.4)') 'Initial KPP H val (seconds): ', initHvalue + write(IU_FILE,'(a,e11.4)') 'Final KPP H val (seconds): ', State_Chm%KPPHvalue(I,J,L) + write(IU_FILE,'(a,i6)' ) 'Number of internal timesteps: ', KPP_TotSteps + write(IU_File,'(a)' ) 'CSV data of full chemical state, including species concentrations,' + write(IU_File,'(a)' ) 'rate constants (R) and instantaneous reaction rates (A). ' + write(IU_File,'(a)' ) 'All concentration units are in molecules/cc.' + DO N=1,NSPEC + SpcID = State_Chm%Map_KppSpc(N) + IF ( SpcID <= 0 ) THEN + write(IU_FILE,'(A,I0,A,E25.16)') "C",N,",",initC(N) + CYCLE + ENDIF + write(IU_FILE,'(A,A,E25.16)') trim(State_Chm%SpcData(N)%Info%Name),',',initC(N) + ENDDO + DO N=1,NREACT + write(IU_FILE,'(A,I0,A,E25.16)') 'R',N,',', localRCONST(N) + ENDDO + DO N=1,NREACT + write(IU_FILE,'(A,I0,A,E25.16)') 'A',N,',', Aout(N) + ENDDO + close(IU_FILE) + + END SUBROUTINE Write_Samples +!EOC +! !INPUT PARAMETERS: +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: cleanup_kpp_standalone +! +! !DESCRIPTION: Deallocates module variables that may have been allocated at run time +! and unnecessary files required during the process +!\\ +!\\ +! !INTERFACE: + SUBROUTINE Cleanup_KPP_Standalone( RC ) +! +! !USES: +! + USE ErrCode_Mod + USE inquireMod, ONLY : findFreeLUN +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? +! +! !REVISION HISTORY: +! 11 Mar 2024 - Obin Sturm - Initial version +!EOP +!------------------------------------------------------------------------------ +!BOC + ! Assume success + RC = GC_SUCCESS + + IF ( ALLOCATED( KPP_Standalone_YAML%LocationName ) ) THEN + DEALLOCATE( KPP_Standalone_YAML%LocationName, STAT=RC ) + CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationName', 2, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + ENDIF + + IF ( ALLOCATED( KPP_Standalone_YAML%LocationLons ) ) THEN + DEALLOCATE( KPP_Standalone_YAML%LocationLons, STAT=RC ) + CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationLons', 2, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + ENDIF + + IF ( ALLOCATED( KPP_Standalone_YAML%LocationLats ) ) THEN + DEALLOCATE( KPP_Standalone_YAML%LocationLats, STAT=RC ) + CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationLats', 2, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + ENDIF + + IF ( ALLOCATED( KPP_Standalone_YAML%IDX ) ) THEN + DEALLOCATE( KPP_Standalone_YAML%IDX, STAT=RC ) + CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%IDX', 2, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + ENDIF + + IF ( ALLOCATED( KPP_Standalone_YAML%JDX ) ) THEN + DEALLOCATE( KPP_Standalone_YAML%JDX, STAT=RC ) + CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%JDX', 2, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + ENDIF + + IF ( ALLOCATED( KPP_Standalone_YAML%Levels ) ) THEN + DEALLOCATE( KPP_Standalone_YAML%Levels, STAT=RC ) + CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%Levels', 2, RC ) + IF ( RC /= GC_SUCCESS ) RETURN + ENDIF + + END SUBROUTINE Cleanup_KPP_Standalone +!EOC +! !INPUT PARAMETERS: +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Find_Number_of_Locations +! +! !DESCRIPTION: Searches a string array containing location names and returns +! the number of valid locations (i.e. char that do not match MISSING_STR). +! Assumes all the valid locations will be listed contiguously at the front +! of the array. Taken from Get_Number_of_Species from input_mod.F90 +!\\ +!\\ +! !INTERFACE: + FUNCTION Find_Number_of_Locations( a_str ) RESULT( n_valid ) +! +! !INPUT PARAMETERS: +! + CHARACTER(LEN=*), INTENT(IN) :: a_str(:) +! +! !RETURN VALUE: +! + INTEGER :: n_valid +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + INTEGER :: N + + ! Return the number of valid locations + n_valid = 0 + DO N = 1, SIZE( a_str ) + IF ( TRIM( a_str(N) ) == MISSING_STR ) EXIT + n_valid = n_valid + 1 + ENDDO + + END FUNCTION Find_Number_of_Locations +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Find_Number_of_Levels +! +! !DESCRIPTION: Searches an integer array containing location names and returns +! the number of valid levels (i.e. int that do not match MISSING_INT). +! Assumes all the valid levels will be listed contiguously at the front +! of the array. Taken from Get_Number_of_Species from input_mod.F90 +!\\ +!\\ +! !INTERFACE: + FUNCTION Find_Number_of_Levels( a_int ) RESULT( n_valid ) +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: a_int(:) +! +! !RETURN VALUE: +! + INTEGER :: n_valid +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + INTEGER :: N + + ! Return the number of valid locations + n_valid = 0 + DO N = 1, SIZE( a_int ) + IF ( a_int(N) == MISSING_INT ) EXIT + n_valid = n_valid + 1 + ENDDO + + END FUNCTION Find_Number_of_Levels +!EOC +END MODULE KPP_Standalone_Interface diff --git a/run/kpp_standalone_interface.yml b/run/kpp_standalone_interface.yml new file mode 100644 index 000000000..151fc4051 --- /dev/null +++ b/run/kpp_standalone_interface.yml @@ -0,0 +1,78 @@ +@@ -0,0 +1,81 @@ +active_cells: + - LosAngeles + - McMurdo + - Paris + - Beijing + - Kinshasa + - Kennaook + - Graciosa + - Utqiagvik + - Ozarks + - Amazon + - Congo + - Borneo + - IndianOcean + - AtlanticOcean + - PacificOcean + - ElDjouf +settings: + output_dir: "./" + levels: + - 1 + - 2 + - 10 + - 23 + - 35 + - 48 + - 56 + timestep: 15 # default to heartbeat / operator splitting timestep +locations: + LosAngeles: + longitude: -118.243 + latitude: 34.0522 + Paris: + longitude: 2.3522 + latitude: 48.8566 + Beijing: + longitude: 116.4074 + latitude: 39.9042 + Kinshasa: + longitude: 15.3105 + latitude: -4.3033 + Kennaook: + longitude: 144.6833 + latitude: -40.6833 + Graciosa: + longitude: -28.0069 + latitude: 39.0525 + McMurdo: + longitude: 166.6698 + latitude: -77.8455 + Utqiagvik: + longitude: -156.7886 + latitude: 71.2906 + Ozarks: + longitude: -91.259 + latitude: 37.502 + Amazon: + longitude: -62.2159 + latitude: -3.4653 + Congo: + longitude: 12.5484 + latitude: -5.9175 + Borneo: + longitude: 114.0 + latitude: 0.0 + IndianOcean: + longitude: 87.2 + latitude: 23.0 + AtlanticOcean: + longitude: -41.574755 + latitude: 34.707874 + PacificOcean: + longitude: -121.964508 + latitude: 0.0 + ElDjouf: + longitude: -6.6661 + latitude: 21.5008 From caad4e95e895fda94e21d5a5fd51d190fc06a3ee Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Tue, 26 Mar 2024 20:44:00 -0400 Subject: [PATCH 02/37] Initial version w revised header and cell name fix --- GeosCore/fullchem_mod.F90 | 10 ++++++++++ GeosCore/kpp_standalone_interface.F90 | 27 ++++++++++++++++----------- 2 files changed, 26 insertions(+), 11 deletions(-) diff --git a/GeosCore/fullchem_mod.F90 b/GeosCore/fullchem_mod.F90 index cdf205c5f..d96140a9f 100644 --- a/GeosCore/fullchem_mod.F90 +++ b/GeosCore/fullchem_mod.F90 @@ -1289,6 +1289,16 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & local_RCONST, KPPH_before_integrate, & State_Grid, State_Chm, State_Met, & Input_Opt, ISTATUS(3), RC ) + + ! test the force write option on the root node + ! example use case: printing chemical state under conditions + ! without knowing where those conditions will happen + ! IF ( Input_Opt%amIRoot .AND. L == 1 ) & + ! CALL Write_Samples( I, J, L, C_before_integrate, & + ! local_RCONST, KPPH_before_integrate, & + ! State_Grid, State_Chm, State_Met, & + ! Input_Opt, ISTATUS(3), RC, & + ! FORCE_WRITE = .TRUE., CELL_NAME = 'root') #endif !===================================================================== diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 index f33dfc0aa..e99c21493 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kpp_standalone_interface.F90 @@ -119,6 +119,7 @@ SUBROUTINE Check_ActiveCell( I, J, L, State_Grid ) INTEGER :: K KPP_Standalone_YAML%Active_Cell = .FALSE. + KPP_Standalone_YAML%Active_Cell_Name = '' ! Early exit if there was no YAML file or no active cells IF ( KPP_Standalone_YAML%SkipIt ) THEN @@ -404,7 +405,7 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & ! !OPTIONAL INPUT PARAMETER LOGICAL, OPTIONAL :: FORCE_WRITE ! Write even if not in an active cell - CHARACTER(LEN=255), OPTIONAL :: CELL_NAME ! Customize the name of this file + CHARACTER(LEN=*), OPTIONAL :: CELL_NAME ! Customize the name of this file ! ! !AUXILLIARY LOCAL PARAMETERS (pass the aux bc Fortran doesn't have defaults for kwargs) LOGICAL :: FORCE_WRITE_AUX ! Write even if not in an active cell @@ -472,10 +473,10 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & RETURN END IF ! Write header to file + write(IU_FILE, '(a)') '47 ' write(IU_FILE, '(a)') '===========================================================================' write(IU_FILE, '(a)') ' ' write(IU_FILE, '(a)') ' KPP Standalone Atmospheric Chemical State ' - write(IU_FILE, '(a)') ' ' write(IU_FILE, '(a)') 'File Description: ' write(IU_FILE, '(a)') 'This file contains model output of the atmospheric chemical state ' write(IU_FILE, '(a)') 'as simulated by the GEOS-Chem chemistry module in a 3D setting. ' @@ -483,21 +484,22 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & write(IU_FILE, '(a)') 'suitable for input into a separate KPP Standalone program which will ' write(IU_FILE, '(a)') 'replicate the chemical evolution of that grid cell for mechanism analysis. ' write(IU_FILE, '(a)') 'Note that the KPP Standalone will only use concentrations, rate constants, ' - write(IU_FILE, '(a)') 'and KPP-specific fields. All other fields are for reference. If wanting to ' - write(IU_FILE, '(a)') 'use this output for other analysis, a Python class to read these fields is ' - write(IU_FILE, '(a)') 'available by request, contact Obin Sturm (psturm@usc.edu). ' + write(IU_FILE, '(a)') 'and KPP-specific fields. All other fields are for reference. The first line' + write(IU_FILE, '(a)') 'contains the number of lines in this header. If wanting to use this output ' + write(IU_FILE, '(a)') 'for other analysis, a Python class to read these fields is available by ' + write(IU_FILE, '(a)') 'request, contact Obin Sturm (psturm@usc.edu). ' write(IU_FILE, '(a)') ' ' - write(IU_FILE, '(a)') 'Generated by GEOS-Chem Model ' + write(IU_FILE, '(a)') 'Generated by the GEOS-Chem Model ' write(IU_FILE, '(a)') ' (https://geos-chem.org/) ' write(IU_FILE, '(a)') 'Using the KPP Standalone Interface ' + write(IU_FILE, '(a)') 'github.com/GEOS-ESM/geos-chem/tree/feature/psturm/kpp_standalone_interface ' write(IU_FILE, '(a)') ' With contributions from: ' write(IU_FILE, '(a)') ' Obin Sturm (psturm@usc.edu) ' write(IU_FILE, '(a)') ' Christoph Keller ' write(IU_FILE, '(a)') ' Michael Long ' write(IU_FILE, '(a)') ' Sam Silva ' write(IU_FILE, '(a)') ' ' - write(IU_FILE, '(a)') '===========================================================================' - ! Write the grid cell metadata + ! Write the grid cell metadata as part of the header write(IU_FILE,'(a)' ) 'Meteorological and general grid cell metadata ' write(IU_FILE,'(a,a)' ) 'Location: ', trim(CELL_NAME_AUX)//trim(KPP_Standalone_YAML%ACTIVE_CELL_NAME) write(IU_FILE,'(a,a)' ) 'Timestamp: ', TIMESTAMP_STRING() @@ -514,9 +516,12 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & write(IU_FILE,'(a,e11.4)') 'Initial KPP H val (seconds): ', initHvalue write(IU_FILE,'(a,e11.4)') 'Final KPP H val (seconds): ', State_Chm%KPPHvalue(I,J,L) write(IU_FILE,'(a,i6)' ) 'Number of internal timesteps: ', KPP_TotSteps - write(IU_File,'(a)' ) 'CSV data of full chemical state, including species concentrations,' - write(IU_File,'(a)' ) 'rate constants (R) and instantaneous reaction rates (A). ' - write(IU_File,'(a)' ) 'All concentration units are in molecules/cc.' + write(IU_File,'(a)' ) 'CSV data of full chemical state, including species concentrations, ' + write(IU_File,'(a)' ) 'rate constants (R) and instantaneous reaction rates (A). ' + write(IU_File,'(a)' ) 'All concentration units are in molecules/cc and rates in molec/cc/s. ' + write(IU_FILE, '(a)') ' ' + write(IU_FILE, '(a)') '===========================================================================' + write(IU_FILE, '(a)') 'Name, Value ' DO N=1,NSPEC SpcID = State_Chm%Map_KppSpc(N) IF ( SpcID <= 0 ) THEN From 241a486b1b6a87889a3742426b9a026ba908759b Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Tue, 2 Apr 2024 17:16:32 -0400 Subject: [PATCH 03/37] commenting out verbose diagnostic printing --- GeosCore/kpp_standalone_interface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 index e99c21493..ee6a7cfe3 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kpp_standalone_interface.F90 @@ -131,7 +131,7 @@ SUBROUTINE Check_ActiveCell( I, J, L, State_Grid ) IF ( KPP_Standalone_YAML%IDX(K) == I .AND. KPP_Standalone_YAML%JDX(K) == J ) THEN KPP_Standalone_YAML%Active_Cell = .TRUE. KPP_Standalone_YAML%Active_Cell_Name = KPP_Standalone_YAML%LocationName(K) - write(*,*) trim(KPP_Standalone_YAML%Active_Cell_Name), " LatLon: " , State_Grid%YMid(I,J), State_Grid%XMid(I,J) + !write(*,*) trim(KPP_Standalone_YAML%Active_Cell_Name), " LatLon: " , State_Grid%YMid(I,J), State_Grid%XMid(I,J) ENDIF ENDDO ENDIF From 70264d6d44d438c0d71269b0191c0e61d9bb0a1d Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Mon, 8 Apr 2024 17:24:30 -0400 Subject: [PATCH 04/37] Add chemistry operator splitting timestep --- GeosCore/kpp_standalone_interface.F90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 index ee6a7cfe3..db73db91f 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kpp_standalone_interface.F90 @@ -420,6 +420,7 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & INTEGER :: N ! Loop index INTEGER :: IU_FILE ! Available unit for writing INTEGER :: SpcID ! Mapping from State_Chm and KPP + REAL(fp) :: DT ! Chemistry operator timestep ! Strings CHARACTER(LEN=255) :: YYYYMMDD_hhmmz CHARACTER(LEN=255) :: level_string @@ -454,6 +455,8 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & Vdot = Vloc, & Aout = Aout ) + DT = GET_TS_CHEM() + !======================================================================== ! Write the file !======================================================================== @@ -473,7 +476,7 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & RETURN END IF ! Write header to file - write(IU_FILE, '(a)') '47 ' + write(IU_FILE, '(a)') '48 ' write(IU_FILE, '(a)') '===========================================================================' write(IU_FILE, '(a)') ' ' write(IU_FILE, '(a)') ' KPP Standalone Atmospheric Chemical State ' @@ -513,8 +516,9 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & write(IU_FILE,'(a,e11.4)') 'Cloud fraction: ', State_Met%CLDF(I,J,L) write(IU_FILE,'(a,e11.4)') 'Cosine of solar zenith angle: ', State_Met%SUNCOSmid(I,J) write(IU_FILE,'(a)' ) 'KPP Integrator-specific parameters ' - write(IU_FILE,'(a,e11.4)') 'Initial KPP H val (seconds): ', initHvalue - write(IU_FILE,'(a,e11.4)') 'Final KPP H val (seconds): ', State_Chm%KPPHvalue(I,J,L) + write(IU_FILE,'(a,F11.4)') 'Initial KPP H val (seconds): ', initHvalue + write(IU_FILE,'(a,F11.4)') 'Final KPP H val (seconds): ', State_Chm%KPPHvalue(I,J,L) + write(IU_FILE,'(a,F11.4)') 'Chemistry operator timestep (seconds): ', DT write(IU_FILE,'(a,i6)' ) 'Number of internal timesteps: ', KPP_TotSteps write(IU_File,'(a)' ) 'CSV data of full chemical state, including species concentrations, ' write(IU_File,'(a)' ) 'rate constants (R) and instantaneous reaction rates (A). ' From 8b38a68fb38cfe6214a750f5c0b5831ffd4448c0 Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Sun, 21 Apr 2024 17:13:19 -0400 Subject: [PATCH 05/37] remove MODEL_GEOS ifdef --- GeosCore/fullchem_mod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/GeosCore/fullchem_mod.F90 b/GeosCore/fullchem_mod.F90 index d96140a9f..1a0d1d794 100644 --- a/GeosCore/fullchem_mod.F90 +++ b/GeosCore/fullchem_mod.F90 @@ -1284,7 +1284,6 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! Write chemical state to file for the kpp standalone interface ! No external logic needed, this subroutine exits early if the ! chemical state should not be printed (psturm, 03/23/24) -#ifdef MODEL_GEOS CALL Write_Samples( I, J, L, C_before_integrate, & local_RCONST, KPPH_before_integrate, & State_Grid, State_Chm, State_Met, & @@ -1299,7 +1298,6 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! State_Grid, State_Chm, State_Met, & ! Input_Opt, ISTATUS(3), RC, & ! FORCE_WRITE = .TRUE., CELL_NAME = 'root') -#endif !===================================================================== ! Check we have no negative values and copy the concentrations From 37e8647d5f85106a5485499315b5d35f287cac0a Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Mon, 22 Apr 2024 23:57:21 -0400 Subject: [PATCH 06/37] Add OutputDir as a backup default output directory --- GeosCore/kpp_standalone_interface.F90 | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 index db73db91f..e457ef077 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kpp_standalone_interface.F90 @@ -336,20 +336,28 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) ! Do this in a portable way that works across compilers ! The directory specifier in inquire might be specific to ifort ! So instead try to open a test file within the output directory + ! Check ./OutputDir (which exists for GEOS-Chem and GCHP) as backup IU_FILE = findFreeLUN() open(IU_FILE,FILE=trim(v_str)//'/.test_directory_existence', & action = "WRITE",iostat=path_exists,access='SEQUENTIAL') - IF ( path_exists /= 0 ) THEN - IF ( Input_Opt%amIRoot ) & - write(*,*) "KPP Standalone Interface warning: Specified output directory ", & - trim(v_str), " does not exist, writing to default output path" - KPP_Standalone_YAML%Output_Directory = "./" + ! If the specified folder doesn't exist, try OutputDir + IF ( path_exists /= 0 ) THEN + open(IU_FILE,FILE='./OutputDir/.test_directory_existence', & + action = "WRITE",iostat=path_exists,access='SEQUENTIAL') + KPP_Standalone_YAML%Output_Directory = "./OutputDir" + IF ( Input_Opt%amIRoot ) & + write(*,*) "KPP Standalone Interface warning: Specified output directory ", & + trim(v_str), " was not found, trying default output path './OutputDir' " + ! If OutputDir doesn't exist, write to the current directory + IF ( (path_exists /= 0) ) THEN + IF ( Input_Opt%amIRoot ) & + write(*,*) "KPP Standalone Interface warning: Specified output directory ", & + trim(v_str), " and default output directory './OutputDir' " // & + "were not found, writing output to the current directory './'" + KPP_Standalone_YAML%Output_Directory = "./" + ENDIF ELSE KPP_Standalone_YAML%Output_Directory = trim(v_str) - ! Delete the file that tested the directory existence - ! Think that just because we're here means that it still exists? - ! Not with multiple CPUs deleting in parallel! Time to inquire - !INQUIRE( UNIT=IU_FILE, EXIST=file_exists ) close(IU_FILE) END IF From f092b67367323695795e1556b62508a879c804d0 Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Tue, 23 Apr 2024 00:00:07 -0400 Subject: [PATCH 07/37] Fix early quit conditional so GNU fortran 10.2 stops tripping --- GeosCore/kpp_standalone_interface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 index e457ef077..273426af8 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kpp_standalone_interface.F90 @@ -446,7 +446,7 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & END IF ! Quit early if there's no writing to be done - IF (KPP_Standalone_YAML%Active_Cell .eq. .FALSE. .AND. FORCE_WRITE_AUX .eq. .FALSE.) THEN + IF ( (.not. KPP_Standalone_YAML%Active_Cell) .AND. (.not. FORCE_WRITE_AUX) ) THEN RETURN END IF From c0be3bb3d6e5f435c781c85b2cd728a5482220ef Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Tue, 23 Apr 2024 00:06:58 -0400 Subject: [PATCH 08/37] moved kpp_standalone_interface.yml to run/shared --- run/{ => shared}/kpp_standalone_interface.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) rename run/{ => shared}/kpp_standalone_interface.yml (97%) diff --git a/run/kpp_standalone_interface.yml b/run/shared/kpp_standalone_interface.yml similarity index 97% rename from run/kpp_standalone_interface.yml rename to run/shared/kpp_standalone_interface.yml index 151fc4051..adbc6bd0c 100644 --- a/run/kpp_standalone_interface.yml +++ b/run/shared/kpp_standalone_interface.yml @@ -1,4 +1,3 @@ -@@ -0,0 +1,81 @@ active_cells: - LosAngeles - McMurdo @@ -17,7 +16,7 @@ active_cells: - PacificOcean - ElDjouf settings: - output_dir: "./" + output_dir: "./OutputDir/" levels: - 1 - 2 From 165e50229dcd2502dab5786dfbf5f3c0edc0f90e Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Tue, 23 Apr 2024 00:15:50 -0400 Subject: [PATCH 09/37] comment in the YAML file that output_dir must exist --- run/shared/kpp_standalone_interface.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/run/shared/kpp_standalone_interface.yml b/run/shared/kpp_standalone_interface.yml index adbc6bd0c..fe1ab83d8 100644 --- a/run/shared/kpp_standalone_interface.yml +++ b/run/shared/kpp_standalone_interface.yml @@ -16,7 +16,7 @@ active_cells: - PacificOcean - ElDjouf settings: - output_dir: "./OutputDir/" + output_dir: "./OutputDir/" # this directory should already exist levels: - 1 - 2 From bbeb084102fc2cdf88f1ab2b42fa8b02f9fde600 Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Fri, 26 Apr 2024 01:38:09 -0400 Subject: [PATCH 10/37] fix KPP species name mapping --- GeosCore/kpp_standalone_interface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 index 273426af8..a0cc025fd 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kpp_standalone_interface.F90 @@ -540,7 +540,7 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & write(IU_FILE,'(A,I0,A,E25.16)') "C",N,",",initC(N) CYCLE ENDIF - write(IU_FILE,'(A,A,E25.16)') trim(State_Chm%SpcData(N)%Info%Name),',',initC(N) + write(IU_FILE,'(A,A,E25.16)') trim(State_Chm%SpcData(SpcID)%Info%Name),',',initC(N) ENDDO DO N=1,NREACT write(IU_FILE,'(A,I0,A,E25.16)') 'R',N,',', localRCONST(N) From 072ba23b5b5800c05cf28d367bae0e6323732994 Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Wed, 1 May 2024 18:50:29 -0400 Subject: [PATCH 11/37] write Hexit last step instead of future step --- GeosCore/fullchem_mod.F90 | 4 ++++ GeosCore/kpp_standalone_interface.F90 | 9 +++++---- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/GeosCore/fullchem_mod.F90 b/GeosCore/fullchem_mod.F90 index 1a0d1d794..f369e5192 100644 --- a/GeosCore/fullchem_mod.F90 +++ b/GeosCore/fullchem_mod.F90 @@ -237,6 +237,8 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! (assuming Rosenbrock solver). Define this locally in order to break ! a compile-time dependency. -- Bob Yantosca (05 May 2022) INTEGER, PARAMETER :: Nhnew = 3 + ! Add Nhexit, the last timestep length -- Obin Sturm (30 April 2024) + INTEGER, PARAMETER :: Nhexit = 2 ! Suppress printing out KPP error messages after this many errors occur INTEGER, PARAMETER :: INTEGRATE_FAIL_TOGGLE = 20 @@ -1286,6 +1288,7 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! chemical state should not be printed (psturm, 03/23/24) CALL Write_Samples( I, J, L, C_before_integrate, & local_RCONST, KPPH_before_integrate, & + RSTATE(Nhexit), & State_Grid, State_Chm, State_Met, & Input_Opt, ISTATUS(3), RC ) @@ -1295,6 +1298,7 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! IF ( Input_Opt%amIRoot .AND. L == 1 ) & ! CALL Write_Samples( I, J, L, C_before_integrate, & ! local_RCONST, KPPH_before_integrate, & + ! RSTATE(Nhexit), & ! State_Grid, State_Chm, State_Met, & ! Input_Opt, ISTATUS(3), RC, & ! FORCE_WRITE = .TRUE., CELL_NAME = 'root') diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 index a0cc025fd..1ccef2980 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kpp_standalone_interface.F90 @@ -377,8 +377,8 @@ END SUBROUTINE Config_KPP_Standalone !\\ ! !INTERFACE: ! - SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & - State_Grid, State_Chm, State_Met, Input_Opt, & + SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, exitHvalue, & + State_Grid, State_Chm, State_Met, Input_Opt, & KPP_TotSteps, RC, FORCE_WRITE, CELL_NAME ) USE ErrCode_Mod USE State_Grid_Mod, ONLY : GrdState @@ -410,6 +410,7 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & REAL(dp), INTENT(IN) :: initC(NSPEC) ! Initial concentrations REAL(dp), INTENT(IN) :: localRCONST(NREACT) ! Rate constants REAL(dp) :: initHvalue ! Initial timestep + REAL(dp) :: exitHvalue ! Final timestep, RSTATE(Nhexit) ! !OPTIONAL INPUT PARAMETER LOGICAL, OPTIONAL :: FORCE_WRITE ! Write even if not in an active cell @@ -524,8 +525,8 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, & write(IU_FILE,'(a,e11.4)') 'Cloud fraction: ', State_Met%CLDF(I,J,L) write(IU_FILE,'(a,e11.4)') 'Cosine of solar zenith angle: ', State_Met%SUNCOSmid(I,J) write(IU_FILE,'(a)' ) 'KPP Integrator-specific parameters ' - write(IU_FILE,'(a,F11.4)') 'Initial KPP H val (seconds): ', initHvalue - write(IU_FILE,'(a,F11.4)') 'Final KPP H val (seconds): ', State_Chm%KPPHvalue(I,J,L) + write(IU_FILE,'(a,F11.4)') 'Init KPP Timestep (seconds): ', initHvalue + write(IU_FILE,'(a,F11.4)') 'Exit KPP Timestep (seconds): ', exitHvalue write(IU_FILE,'(a,F11.4)') 'Chemistry operator timestep (seconds): ', DT write(IU_FILE,'(a,i6)' ) 'Number of internal timesteps: ', KPP_TotSteps write(IU_File,'(a)' ) 'CSV data of full chemical state, including species concentrations, ' From f611a4c9f4f104b720caf044302da4e2336cc3bd Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Tue, 14 May 2024 12:48:41 -0400 Subject: [PATCH 12/37] three digit exponent, tip from @nicholasbalasus --- GeosCore/kpp_standalone_interface.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 index 1ccef2980..ba4035cb7 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kpp_standalone_interface.F90 @@ -538,16 +538,16 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, exitHvalue, DO N=1,NSPEC SpcID = State_Chm%Map_KppSpc(N) IF ( SpcID <= 0 ) THEN - write(IU_FILE,'(A,I0,A,E25.16)') "C",N,",",initC(N) + write(IU_FILE,'(A,I0,A,E25.16E3)') "C",N,",",initC(N) CYCLE ENDIF - write(IU_FILE,'(A,A,E25.16)') trim(State_Chm%SpcData(SpcID)%Info%Name),',',initC(N) + write(IU_FILE,'(A,A,E25.16E3)') trim(State_Chm%SpcData(SpcID)%Info%Name),',',initC(N) ENDDO DO N=1,NREACT - write(IU_FILE,'(A,I0,A,E25.16)') 'R',N,',', localRCONST(N) + write(IU_FILE,'(A,I0,A,E25.16E3)') 'R',N,',', localRCONST(N) ENDDO DO N=1,NREACT - write(IU_FILE,'(A,I0,A,E25.16)') 'A',N,',', Aout(N) + write(IU_FILE,'(A,I0,A,E25.16E3)') 'A',N,',', Aout(N) ENDDO close(IU_FILE) From e3ddb4a6c1a42ac1abbcef47b8262ebd9798ac80 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 26 Sep 2024 15:30:13 -0400 Subject: [PATCH 13/37] Updated changelog Signed-off-by: Lizzie Lundgren --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 05d62b156..fa603693c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Added computation of water concentration to use in photolysis for application of UV absorption by water in Cloud-J v8 - Added ACO3, ACR, ACRO2, ALK4N{1,2,O}2, ALK4P, ALK7, APAN, APINN, APINO2, APINP, AROCMCHO, AROMCO3, AROMPN, BPINN, BPINO2, BPINON, BPINOO2, BPINOOH, BPINP, BUTN, BUTO2, C4H6, C96N, C96O2, C9602H, EBZ, GCO3, HACTA, LIMAL, LIMKB, LIMKET, LIMKO2, LIMN, LIMNB, LIMO2H, LIMO3, LIMO3H, LIMPAN, MEKCO3, MEKPN, MYRCO, PHAN, PIN, PINAL, PINO3, PINONIC, PINPAN, R7N{1,2}, R7O2, R7P, RNO3, STYR, TLFUO2, TLFUONE, TMB, ZRO2 to `species_database.yml` following Travis et al. 2024. - Added TSOIL1 field to `State_Met` for use in HEMCO soil NOx extension. This should only be read in when the `UseSoilTemperature` option is true in HEMCO config. +- Added KPP standalone interface ### Changed - Copy values from `State_Chm%KPP_AbsTol` to `ATOL` and `State_Chm%KPP_RelTol` to `RTOL` for fullchem and Hg simulations From 2ef41839a8a13ae8b421f199b6b98ba24a935971 Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Sun, 2 Jun 2024 18:51:07 -0400 Subject: [PATCH 14/37] initial version of KPP Standalone in GEOS-Chem --- KPP/fullchem/Makefile | 192 ++ KPP/fullchem/kpp_standalone.F90 | 240 ++ KPP/fullchem/kpp_standalone_init.F90 | 123 + .../Beijing_L1_20200106_1345.txt | 2133 +++++++++++++++++ 4 files changed, 2688 insertions(+) create mode 100644 KPP/fullchem/Makefile create mode 100644 KPP/fullchem/kpp_standalone.F90 create mode 100644 KPP/fullchem/kpp_standalone_init.F90 create mode 100644 KPP/fullchem/samples_kpp_standalone/Beijing_L1_20200106_1345.txt diff --git a/KPP/fullchem/Makefile b/KPP/fullchem/Makefile new file mode 100644 index 000000000..d3d7ce3b8 --- /dev/null +++ b/KPP/fullchem/Makefile @@ -0,0 +1,192 @@ +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# User: Set here the F90 compiler and options +# Pedefined compilers: INTEL, PGF, HPUX, LAHEY +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +#COMPILER = G95 +#COMPILER = LAHEY +#COMPILER = INTEL +#COMPILER = PGF +#COMPILER = HPUX +COMPILER = GFORTRAN + +FC_G95 = g95 +FOPT_G95 = -cpp -O -pg -fbounds-check -fimplicit-none -Wall -ftrace=full + +FC_LAHEY = lf95 +# More aggressive for production runs: +#FOPT_LAHEY = -Cpp --pca -O +# More checking for debugging: +FOPT_LAHEY = -Cpp --chk a,e,s,u --pca --ap -O0 -g --trap --trace --chkglobal + +FC_INTEL = ifort +# More aggressive for production runs: +#FOPT_INTEL = -cpp -O -fp-model precise -pc80 -prec_div +# More checking for debugging: +FOPT_INTEL = -cpp -O0 -fp-model strict -implicitnone -ftrapuv \ + -debug all -check all -warn all + +FC_PGF = pgf90 +# More aggressive for production runs: +FOPT_PGF = -Mpreprocess -O -fast -pc 80 -Kieee +# More checking for debugging: +#FOPT_PGF = -Mpreprocess -O0 -Mbounds -Mchkfpstk -Mchkptr -Mchkstk \ +# -Ktrap=fp -pc 80 -Kieee + +FC_HPUX = f90 +FOPT_HPUX = -O -u +Oall +check=on + +FC_GFORTRAN = gfortran +#FOPT_GFORTRAN = -cpp -g -fbacktrace -fcheck=all -ffpe-trap=invalid,zero,overflow #bounds +FOPT_GFORTRAN = -cpp -O + +# define FULL_ALGEBRA for non-sparse integration +FC = $(FC_$(COMPILER)) +FOPT = $(FOPT_$(COMPILER)) # -DFULL_ALGEBRA + +LIBS = +#LIBS = -llapack -lblas + +# Command to create Matlab mex gateway routines +# Note: use $(FC) as the mex Fortran compiler +MEX = mex + +GENSRC = gckpp_Precision.F90 \ + gckpp_Parameters.F90 \ + gckpp_Global.F90 + +GENOBJ = gckpp_Precision.o \ + gckpp_Parameters.o \ + gckpp_Global.o + +FUNSRC = gckpp_Function.F90 +FUNOBJ = gckpp_Function.o + +JACSRC = gckpp_JacobianSP.F90 gckpp_Jacobian.F90 +JACOBJ = gckpp_JacobianSP.o gckpp_Jacobian.o + +UTLSRC = gckpp_Rates.F90 gckpp_Util.F90 gckpp_Monitor.F90 fullchem_RateLawFuncs.F90 rateLawUtilFuncs.F90 +UTLOBJ = gckpp_Rates.o gckpp_Util.o gckpp_Monitor.o fullchem_RateLawFuncs.o rateLawUtilFuncs.o + +LASRC = gckpp_LinearAlgebra.F90 +LAOBJ = gckpp_LinearAlgebra.o + +STOCHSRC = gckpp_Stochastic.F90 +STOCHOBJ = gckpp_Stochastic.o + +MODSRC = gckpp_Model.F90 +MODOBJ = gckpp_Model.o + +INISRC = gckpp_Initialize.F90 +INIOBJ = gckpp_Initialize.o + +MAINSRC = kpp_standalone.F90 gckpp_Initialize.F90 gckpp_Integrator.F90 gckpp_Model.F90 +MAINOBJ = kpp_standalone.o gckpp_Initialize.o gckpp_Integrator.o + + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# User: modify the line below to include only the +# objects needed by your application +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +ALLOBJ = $(GENOBJ) $(JACOBJ) $(FUNOBJ) $(HESOBJ) $(STMOBJ) \ + $(UTLOBJ) $(LAOBJ) $(MODOBJ) $(INIOBJ) $(SFCOBJ) + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# User: modify the line below to include only the +# executables needed by your application +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +all: exe + +exe: $(ALLOBJ) $(MAINOBJ) kpp_standalone_init.o + $(FC) $(FOPT) kpp_standalone.F90 gckpp_Integrator.o kpp_standalone_init.o $(ALLOBJ) $(LIBS) -o kpp_standalone.exe + + +stochastic:$(ALLOBJ) $(STOCHOBJ) $(MAINOBJ) + $(FC) $(FOPT) $(ALLOBJ) $(STOCHOBJ) $(MAINOBJ) $(LIBS) \ + -o gckpp_stochastic.exe + +mex: $(ALLOBJ) + $(MEX) FC#$(FC) -fortran -O gckpp_mex_Fun.F90 $(ALLOBJ) + $(MEX) FC#$(FC) -fortran -O gckpp_mex_Jac_SP.F90 $(ALLOBJ) + $(MEX) FC#$(FC) -fortran -O gckpp_mex_Hessian.F90 $(ALLOBJ) + +clean: + rm -f *.o *.mod\ + gckpp*.dat kpp_standalone.exe gckpp*.mexglx \ + gckpp.map + +distclean: + rm -f *.o *.mod \ + gckpp*.dat kpp_standalone.exe gckpp.map \ + gckpp*.F90 gckpp_*.mexglx + +gckpp_Precision.o: gckpp_Precision.F90 + $(FC) $(FOPT) -c $< + +gckpp_Parameters.o: gckpp_Parameters.F90 \ + gckpp_Precision.o + $(FC) $(FOPT) -c $< + +gckpp_Monitor.o: gckpp_Monitor.F90 \ + gckpp_Precision.o + $(FC) $(FOPT) -c $< + +gckpp_Global.o: gckpp_Global.F90 \ + gckpp_Parameters.o gckpp_Precision.o + $(FC) $(FOPT) -c $< + +gckpp_Initialize.o: gckpp_Initialize.F90 $(GENOBJ) + $(FC) $(FOPT) -c $< + +gckpp_Function.o: gckpp_Function.F90 $(GENOBJ) + $(FC) $(FOPT) -c $< + +gckpp_Stochastic.o: gckpp_Stochastic.F90 $(GENOBJ) + $(FC) $(FOPT) -c $< + +gckpp_JacobianSP.o: gckpp_JacobianSP.F90 $(GENOBJ) + $(FC) $(FOPT) -c $< + +gckpp_Jacobian.o: gckpp_Jacobian.F90 $(GENOBJ) gckpp_JacobianSP.o + $(FC) $(FOPT) -c $< + +gckpp_LinearAlgebra.o: gckpp_LinearAlgebra.F90 $(GENOBJ) gckpp_JacobianSP.o + $(FC) $(FOPT) -c $< + +rateLawUtilFuncs.o: rateLawUtilFuncs.F90 + $(FC) $(FOPT) -c $< + +fullchem_RateLawFuncs.o: fullchem_RateLawFuncs.F90 rateLawUtilFuncs.o + $(FC) $(FOPT) -c $< + +gckpp_Rates.o: gckpp_Rates.F90 $(GENOBJ) fullchem_RateLawFuncs.o + $(FC) $(FOPT) -c $< + +gckpp_HessianSP.o: gckpp_HessianSP.F90 $(GENOBJ) + $(FC) $(FOPT) -c $< + +gckpp_Hessian.o: gckpp_Hessian.F90 $(GENOBJ) gckpp_HessianSP.o + $(FC) $(FOPT) -c $< + +gckpp_Util.o: gckpp_Util.F90 $(GENOBJ) gckpp_Monitor.o + $(FC) $(FOPT) -c $< + +gckpp_Main.o: gckpp_Main.F90 $(ALLOBJ) gckpp_Initialize.o gckpp_Model.o gckpp_Integrator.o + $(FC) $(FOPT) -c $< + +gckpp_Model.o: gckpp_Model.F90 $(ALLOBJ) gckpp_Integrator.o + $(FC) $(FOPT) -c $< + +gckpp_Integrator.o: gckpp_Integrator.F90 $(ALLOBJ) + $(FC) $(FOPT) -c $< + +kpp_standalone_init.o: kpp_standalone_init.F90 gckpp_Parameters.o + $(FC) $(FOPT) -c $< + +kpp_standalone.o: kpp_standalone.F90 kpp_standalone_init.o gckpp_Integrator.o $(ALLOBJ) + $(FC) $(FOPT) -c $< + + + + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/KPP/fullchem/kpp_standalone.F90 b/KPP/fullchem/kpp_standalone.F90 new file mode 100644 index 000000000..daa67fc58 --- /dev/null +++ b/KPP/fullchem/kpp_standalone.F90 @@ -0,0 +1,240 @@ +program main + +! The KPP Standalone for GEOS-Chem Mechanism Analysis +! +! +! Program Description: +! +! This program runs the GEOS-Chem KPP Standalone for a given set of initial conditions. +! It reads an input file generated by the KPP Standalone Interface that generates model +! output of the full chemical state of grid cells in 3D GEOS-Chem, GCHP, and GEOS-CF runs. +! The full mechanism is run to replicate the chemistry of the specified grid cell. +! Obin Sturm (psturm@usc.edu), Michael S Long, Christoph Keller + +! The KPP Standalone is adapted from a box model used in the following publication: +! Lin, H., Long, M. S., Sander, R., Sandu, A., Yantosca, R. M., Estrada, L. A., et al. (2023). +! An adaptive auto-reduction solver for speeding up integration of chemical kinetics in atmospheric chemistry models: +! Implementation and evaluation in the Kinetic Pre-Processor (KPP) version 3.0.0. +! Journal of Advances in Modeling Earth Systems, 15, e2022MS003293. https://doi.org/10.1029/2022MS003293 + +! Updates: +! - 2024/05/06, Obin Sturm: Simplification of the code for the GEOS-Chem KPP Standalone, +! removed all autoreduce and convergence criteria testing. +! The more general tool just runs one operator timestep +! and then prints out the results to an output file. + + USE GCKPP_GLOBAL + USE GCKPP_JACOBIANSP + USE GCKPP_PARAMETERS + USE GCKPP_MONITOR + USE GCKPP_MODEL + USE KPP_STANDALONE_INIT, ONLY: read_input + + + IMPLICIT NONE + + INTEGER :: ICNTRL(20), IERR, I + INTEGER :: ISTATUS(20) + INTEGER :: fileTotSteps + INTEGER :: level + REAL(dp) :: OperatorTimestep + REAL(dp) :: RCNTRL(20) + REAL(dp) :: Hstart + REAL(dp) :: Hexit + REAL(dp) :: cosSZA + REAL(dp) :: RSTATE(20) + REAL(dp) :: T, TIN, TOUT, start, end + REAL :: full_sumtime, full_avg + + INTEGER :: NRTOL, NSTEPSt ! Number of iterations in the timing averaging loop + + REAL(dp) :: Vloc(NVAR), Cinit(NSPEC), R(NREACT) + + LOGICAL :: OUTPUT + LOGICAL :: ReInit + + + ! Vars for reading files + character(len=256) :: inputfile + character(len=256) :: outputfile + + + ! Check if an argument was provided + if (command_argument_count() .ge. 1) then + ! Get the first argument + call get_command_argument(1, inputfile) + print*, 'Processing sample: ', trim(inputfile) + else + print*, 'No sample provided. Exiting.' + stop + endif + ! If a second argument is provided, use it as the output file + if (command_argument_count() .ge. 2) then + ! Get the second argument + call get_command_argument(2, outputfile) + print*, 'Output file: ', trim(outputfile) + endif + + OUTPUT = .false. + REINIT = .true. ! Reset C every NITR,NRTOL iteration +! REINIT = .false. ! Let C evolve over the NRTOL loop + NRTOL = 0 + + + + + ! Read the input file + call read_input(inputfile, R, Cinit, SPC_NAMES, Hstart, Hexit, cosSZA, level, fileTotSteps, OperatorTimestep) + + + + ! Run the full mechanism + call fullmech(RTOL_VALUE=0.5e-2_dp) + + ! Write the output file + if (command_argument_count() .ge. 2) then + call write_output(inputfile,outputfile) + endif + +CONTAINS + + subroutine fullmech(RTOL_VALUE) + USE GCKPP_INTEGRATOR + USE GCKPP_RATES + USE GCKPP_INITIALIZE + USE GCKPP_GLOBAL + + IMPLICIT NONE + + REAL(dp) :: RTOL_VALUE + + ! Set OPTIONS + IERR = 0 ! Success or failure flag + ISTATUS = 0 ! Rosenbrock output + RCNTRL = 0.0_dp ! Rosenbrock input + RCNTRL(3) = Hstart + ! write(*,'(a,f10.2)') " Hstart: ", Hstart + RSTATE = 0.0_dp ! Rosenbrock output + ICNTRL = 0 + ICNTRL(1) = 1 + ICNTRL(2) = 0.000_dp + ICNTRL(3) = 4 + ICNTRL(7) = 1 + ICNTRL(15) = -1 + + ! Tolerances + ATOL = 1e-2_dp + RTOL = RTOL_VALUE ! default in GEOS-CF 2.0 is 0.5e-2_dp + + ! Set ENV + T = 0d0 + TIN = T + TOUT = T + OperatorTimestep + TEMP = 298. + + full_avg = 0. + full_sumtime = 0. + start = 0. + end = 0. + + ! Initialize concentrations + C(1:NSPEC) = Cinit(1:NSPEC) + ! Assign RCONST to rate constants from file + ! rather than + ! call Update_RCONST() + RCONST = R + + ! Integrate the mechanism for an operator timestep + CALL Integrate( TIN, TOUT, ICNTRL, & + RCNTRL, ISTATUS, RSTATE, IERR ) + NSTEPSt = ISTATUS(3) + write(*,'(a,i5)') " Number of internal timesteps (from 3D run): ", fileTotSteps + write(*,'(a,i5)') " Number of internal timesteps ( standalone): ", ISTATUS(3) + ! write Hexit for 3D vs standalone + write(*,'(a,f10.2)') " Hexit (from 3D run): ", Hexit + write(*,'(a,f10.2)') " Hexit ( standalone): ", RSTATE(2) + + ! Check if 3D results are consistent with standalone + if (fileTotSteps /= ISTATUS(3)) then + write(0,*) "Warning: Number of internal steps do not match 3D grid cell" + endif + if (abs(Hexit-RSTATE(2))/Hexit>.001) then + write(0,*) "Warning: final timestep does not match 3D grid cell within 0.1%" + endif + + ! Run the RTOL variation loop + DO I=1,NRTOL + call Initialize() + C(1:NSPEC) = Cinit(1:NSPEC) + + VAR(1:NVAR) => C(1:NVAR) + FIX(1:NFIX) => C(NVAR+1:NSPEC) + ! Set RCONST + ! call Update_RCONST() + + CALL Fun( C, FIX, RCONST, Vloc ) + + ! Get a random RTOL + CALL RANDOM_NUMBER(RTOL) + RTOL = 10**(-2.*RTOL) + + ! Integrate + CALL Integrate( TIN, TOUT, ICNTRL, & + RCNTRL, ISTATUS, RSTATE, IERR ) + call cpu_time(end) + write(*,*) "Number of internal timesteps random RTOL: ", ISTATUS(3) + ENDDO + + + return + end subroutine fullmech + + subroutine write_output(inputfile, outputfile) + ! USE GCKPP_GLOBAL + character(len=256) :: outputfile + character(len=256) :: inputfile + character(len=256) :: header(30) + integer :: i + character(len=256) :: line + + ! Write meteo data lines of the input to the output file + open(20, file=outputfile) + open(10, file=inputfile, status='old') + + ! Write the header lines to the output file + write(20, '(A)') "30" + write(20, '(A)') "===========================================================================" + write(20, '(A)') "" + write(20, '(A)') "KPP Standalone Output" + write(20, '(A)') "This file contains the concentrations of all the chemical species" + write(20, '(A)') "in a single grid cell of a GEOS-Chem 3D run as replicated by the " + write(20, '(A)') "KPP Standalone. Concentrations before and after the operator timestep" + write(20, '(A)') "are in CSV format, below." + write(20, '(A)') "" + write(20, '(A)') "Generated by the GEOS-Chem KPP Standalone:" + write(20, '(A)') "https://github.com/KineticPreProcessor/KPP-Standalone" + write(20, '(A)') "" + write(20, '(A)') "Input file used: " // trim(inputfile) + + ! Skip the first 26 lines of the input file + do i=1,26 + read(10,'(A)') line + enddo + do i=27,43 + read(10,'(A)') line + write(20,'(A)') line + enddo + close(10) + write(20, '(A)') "" + write(20, '(A)') "===========================================================================" + write(20, '(A)') "Species Name,Initial Concentration (molec/cc),Final Concentration (molec/cc)" + ! write the species names, initial and final concentrations + do i=1,NSPEC + write(20, '(A,E25.16,A,E25.16)') trim(SPC_NAMES(i))//",", Cinit(i), ",", C(i) + enddo + close(20) + + end subroutine write_output + +end program main + diff --git a/KPP/fullchem/kpp_standalone_init.F90 b/KPP/fullchem/kpp_standalone_init.F90 new file mode 100644 index 000000000..f618c3b88 --- /dev/null +++ b/KPP/fullchem/kpp_standalone_init.F90 @@ -0,0 +1,123 @@ +module kpp_standalone_init + implicit none + public +contains + +subroutine read_input(filename, R, C, SPC_NAMES, Hstart, Hexit, cosSZA, level, fileTotSteps, OperatorTimestep) +USE gckpp_Parameters + + IMPLICIT NONE + + real(dp), intent(out) :: C(NSPEC) + real(dp), intent(out) :: R(NREACT) + real(dp), intent(out) :: Hstart + real(dp), intent(out) :: Hexit + real(dp), intent(out) :: cosSZA + real(dp), intent(out) :: OperatorTimestep + integer, intent(out) :: level + integer, intent(out) :: fileTotSteps + integer :: SPC_MAP(NSPEC) + + + + character(len=*), intent(in) :: SPC_NAMES(NSPEC) + character(len=*), intent(in) :: filename + integer :: i, ierr, NHEADER, idx + character(200) :: line + logical :: existbool + + ! Declare variables for file I/O + integer :: file_unit + + ! Open the file for reading + file_unit = 999 + inquire(file=filename, exist=existbool) + if (existbool .neqv. .TRUE.) then + print *, "Error: input file does not exist: ", trim(filename) + stop + end if + open(unit=file_unit, file=filename, iostat=ierr) + if (ierr /= 0) then + print *, "Error opening input file" + stop + end if + + ! Read the number of header lines + read(file_unit, *) NHEADER + + ! Read the header lines + do i = 1, NHEADER + read(file_unit, '(A)', iostat=ierr) line + if (ierr /= 0) then + print *, "Error reading line", i + exit + end if + ! Get level + if (index(line, 'GEOS-Chem Vertical Level:') > 0 ) then + idx = index(line, ':') + 1 + read(line(idx:), *) level + endif + ! Get cosSZA + if (index(line, 'Cosine of solar zenith angle:') > 0 ) then + idx = index(line, ':') + 1 + read(line(idx:), *) cosSZA + end if + ! get Hstart + if (index(line, 'Init KPP Timestep (seconds):') > 0 ) then + idx = index(line, ':') + 1 + read(line(idx:), *) Hstart + end if + + ! get Hexit + if (index(line, 'Exit KPP Timestep (seconds):') > 0 ) then + idx = index(line, ':') + 1 + read(line(idx:), *) Hexit + end if + + ! get fileTotSteps + if (index(line, 'Number of internal timesteps:') > 0 ) then + idx = index(line, ':') + 1 + read(line(idx:), *) fileTotSteps + end if + + ! Get value of operator splitting timestep + if (index(line, 'Chemistry operator timestep (seconds):') > 0 ) then + idx = index(line, ':') + 1 + read(line(idx:), *) OperatorTimestep + end if + end do + + ! Read the species and their concentrations + do i = 1, NSPEC + read(file_unit, '(A)', iostat=ierr) line + if (ierr /= 0) then + print *, "Error reading line", i+NHEADER + exit + end if + idx = index(line, ',') + 1 + read(line(idx:), *) C(i) + ! Check if the species name matches the expected SPC_NAMES(i) + if (trim(line(1:idx-2)) /= trim(SPC_NAMES(i))) then + print *, "Error: species name mismatch" + print *, "Expected: ", SPC_NAMES(i) + print *, "Found: ", line(1:idx-2) + stop + end if + end do + ! Read the rate constants + do i = 1, NREACT + read(file_unit, '(A)', iostat=ierr) line + if (ierr /= 0) then + print *, "Error reading line", i+NSPEC+NHEADER + exit + end if + idx = index(line, ',') + 1 + read(line(idx:), *) R(i) + end do + + ! Close the file + close(file_unit) +end subroutine read_input + +end module kpp_standalone_init + diff --git a/KPP/fullchem/samples_kpp_standalone/Beijing_L1_20200106_1345.txt b/KPP/fullchem/samples_kpp_standalone/Beijing_L1_20200106_1345.txt new file mode 100644 index 000000000..54eb238f1 --- /dev/null +++ b/KPP/fullchem/samples_kpp_standalone/Beijing_L1_20200106_1345.txt @@ -0,0 +1,2133 @@ +48 +=========================================================================== + + KPP Standalone Atmospheric Chemical State +File Description: +This file contains model output of the atmospheric chemical state +as simulated by the GEOS-Chem chemistry module in a 3D setting. +Each grid cell represents the chemical state of an individual location, +suitable for input into a separate KPP Standalone program which will +replicate the chemical evolution of that grid cell for mechanism analysis. +Note that the KPP Standalone will only use concentrations, rate constants, +and KPP-specific fields. All other fields are for reference. The first line +contains the number of lines in this header. If wanting to use this output +for other analysis, a Python class to read these fields is available by +request, contact Obin Sturm (psturm@usc.edu). + +Generated by the GEOS-Chem Model + (https://geos-chem.org/) +Using the KPP Standalone Interface +github.com/GEOS-ESM/geos-chem/tree/feature/psturm/kpp_standalone_interface + With contributions from: + Obin Sturm (psturm@usc.edu) + Christoph Keller + Michael Long + Sam Silva + +Meteorological and general grid cell metadata +Location: Beijing +Timestamp: 2020/01/06 13:45 +Longitude (degrees): 117.0185 +Latitude (degrees): 39.8364 +GEOS-Chem Vertical Level: 1 +Pressure (hPa): 1009.8350 +Temperature (K): 275.90 +Dry air density (molec/cm3): 0.2646E+20 +Water vapor mixing ratio (vol H2O/vol dry air): 0.3956E-02 +Cloud fraction: 0.0000E+00 +Cosine of solar zenith angle: -0.8279E+00 +KPP Integrator-specific parameters +Init KPP Timestep (seconds): 268.3002 +Exit KPP Timestep (seconds): 32.4352 +Chemistry operator timestep (seconds): 900.0000 +Number of internal timesteps: 28 +CSV data of full chemical state, including species concentrations, +rate constants (R) and instantaneous reaction rates (A). +All concentration units are in molecules/cc and rates in molec/cc/s. + +=========================================================================== +Name, Value +CH2I2, 0.5229637490161687E+06 +CH2IBr, 0.5401741649323440E+06 +CH2ICl, 0.2389579494513276E+07 +AERI, 0.1144044191044774E+12 +AONITA, 0.2224684129917660E+10 +BUTDI, 0.0000000000000000E+00 +CO2, 0.7331505456875255E+16 +INDIOL, 0.3917484033613435E+10 +ISALA, 0.1340074753973859E+09 +ISALC, 0.2656091737594891E+08 +LBRO2H, 0.1110359179531490E+11 +LBRO2N, 0.1007852162653296E+13 +BRO2, 0.2641206128574977E-01 +LISOPOH, 0.0000000000000000E+00 +LISOPNO3, 0.0000000000000000E+00 +LNRO2H, 0.0000000000000000E+00 +LNRO2N, 0.0000000000000000E+00 +NRO2, 0.0000000000000000E+00 +NAP, 0.0000000000000000E+00 +LTRO2H, 0.6236742963112886E+11 +LTRO2N, 0.8070360765686937E+13 +TRO2, 0.2093893768543299E+00 +LVOCOA, 0.6865493588792447E+06 +LVOC, 0.3860877065010954E-12 +LXRO2H, 0.1045239082629581E+12 +LXRO2N, 0.1788823543222465E+14 +XRO2, 0.4720263884380698E+00 +MSA, 0.2234785005701510E+08 +SO4s, 0.7764798777941527E+04 +SOAGX, 0.4090001577327538E+10 +SOAIE, 0.2203718566890857E+08 +PH2SO4, 0.0000000000000000E+00 +PSO4AQ, 0.0000000000000000E+00 +POx, 0.0000000000000000E+00 +LOx, 0.0000000000000000E+00 +PCO, 0.0000000000000000E+00 +LCO, 0.0000000000000000E+00 +PSO4, 0.0000000000000000E+00 +LCH4, 0.0000000000000000E+00 +PH2O2, 0.0000000000000000E+00 +FURA, 0.0000000000000000E+00 +I2O4, 0.1167034727981632E+03 +CH3CCl3, 0.3228183624351780E+08 +I2O2, 0.2324264092827573E+01 +MONITA, 0.1940705460275071E+05 +CH3I, 0.2343881382469887E+18 +H1301, 0.8837813935404474E+08 +H2402, 0.1031960367575871E+08 +I2O3, 0.2203119638453422E+04 +PPN, 0.3460312900826755E+10 +BrNO2, 0.6488710748759532E+07 +CCl4, 0.2024494423926137E+10 +CFC11, 0.5883761894554182E+10 +CFC12, 0.1316463914410311E+11 +CFC113, 0.1822336061620289E+10 +CFC114, 0.4170177861429334E+09 +CFC115, 0.2254436296880906E+09 +C2H2, 0.5834922670950449E+07 +H1211, 0.8387986249343947E+08 +INO, 0.9891785567337147E+12 +N2O, 0.8749965335219539E+13 +NIT, 0.3058886926899389E+12 +NITs, 0.6257543667380522E+07 +BENZ, 0.6937024682064159E+11 +N, 0.0000000000000000E+00 +OCS, 0.1323026012059447E+11 +PAN, 0.9333859503481314E+10 +ETHN, 0.6856839955684951E+08 +HI, 0.1269691884187007E+08 +BZCO3H, 0.9872402025956239E+06 +CH2Br2, 0.2931842381278095E+08 +CH2Cl2, 0.1622230536880044E+10 +IBr, 0.1562391091756119E+08 +MPN, 0.6012943409089624E+04 +Cl2O2, 0.5173211532367032E-09 +C2H4, 0.1466026680876448E+12 +CHBr3, 0.4476269237077630E+08 +CHCl3, 0.3257499859497513E+09 +TOLU, 0.1015123360163832E+12 +XYLE, 0.8244156860306589E+11 +HCFC123, 0.4596006423189103E-12 +HCFC141b, 0.6922072309276936E+09 +HCFC142b, 0.6022414644762596E+09 +HCFC22, 0.6637092294037771E+10 +HMHP, 0.5877245987218773E+09 +HMS, 0.6137832069261662E+09 +IPRNO3, 0.6629851971103431E+09 +MAP, 0.1820720190242983E+09 +MENO3, 0.9356153733386898E+08 +DMS, 0.2902139473719242E+07 +NPRNO3, 0.1669379444014273E+09 +OIO, 0.1547825002243250E+06 +R4P, 0.7487585398980704E+08 +RA3P, 0.2082343766763396E+08 +RB3P, 0.5000705540901479E+08 +ETNO3, 0.4927966639222008E+08 +BZPAN, 0.1136449449987494E+09 +IONITA, 0.4729234234451677E+06 +ICl, 0.1013411688899271E+10 +CH3Br, 0.1886743857442678E+09 +BALD, 0.5910334621516049E+09 +HNO4, 0.8513066102930259E-02 +ClOO, 0.3365253171069412E-05 +PYAC, 0.7023899207442132E+06 +HMML, 0.2301945437195899E+07 +RP, 0.4015755068441701E+08 +BENZP, 0.1073868393198497E+09 +ETO, 0.2476500881603519E-09 +IDC, 0.8431471935696354E+06 +ETP, 0.8940086009759392E+08 +OClO, 0.1186007491717479E+03 +PP, 0.1203713763240346E+08 +PRPN, 0.3145851714794756E+07 +ALK4, 0.6551747808160359E+12 +CSL, 0.2579982490777665E+09 +IEPOXD, 0.1442702830805874E+04 +MVKDH, 0.1849508049612781E+06 +PHEN, 0.6743065979240134E+08 +PIP, 0.8167446156122749E+06 +ETHP, 0.3760716219796737E+08 +HPALD1OO, 0.3976332952948804E-07 +SO4, 0.5575080956448196E+11 +HPALD2OO, 0.1842449595925098E-05 +C3H8, 0.6580496174372583E+11 +IDCHP, 0.3403067689047770E+03 +INA, 0.1311257373082687E-05 +HPALD4, 0.1811043958585358E+06 +Br2, 0.1100831081758089E+05 +HPALD3, 0.5514992121742772E+04 +IEPOXA, 0.2067125201519981E+05 +IEPOXB, 0.1127760591493828E+05 +MCRDH, 0.1228901758190398E+05 +EOH, 0.6607085206386980E+11 +HONIT, 0.1242500317585665E-02 +BrCl, 0.6616758481666051E+05 +MACR1OOH, 0.9671446016763883E+04 +MP, 0.1065686935146700E+10 +SALCAL, 0.1120569793240006E-02 +IHN2, 0.8575111261658903E-05 +IHN3, 0.1426043547472750E+01 +IDHDP, 0.5175656020780997E+04 +MCT, 0.3497597127212082E+07 +I2, 0.4981218560868793E+14 +C4HVP1, 0.0000000000000000E+00 +C4HVP2, 0.0000000000000000E+00 +IDNOO, 0.1972225006866904E-09 +SALAAL, 0.4177280042017358E-01 +AROMP5, 0.3032020034279350E+04 +CH3Cl, 0.1464979976877486E+11 +ICNOO, 0.2229150337409803E-03 +INPD, 0.6616683051278342E-01 +ISOPNOO2, 0.1297706055126308E-13 +MPAN, 0.3558758708816536E+07 +MTPA, 0.1763812179356158E+09 +MTPO, 0.5569552889788204E+08 +MVKPC, 0.6877214935803887E+06 +RIPA, 0.8517323717731006E+05 +ROH, 0.4061601567421934E+06 +AROMP4, 0.1963222624667651E+03 +BENZO, 0.3068120088610019E+07 +C2H6, 0.1735389531741626E+12 +RIPB, 0.3596307755298724E+05 +MCRENOL, 0.6170107418458622E+06 +IDHPE, 0.4510092344230966E+05 +RIPD, 0.1538727346345939E+04 +IDHNDOO1, 0.1771693353622311E-11 +ISOPNOO1, 0.0000000000000000E+00 +IDHNDOO2, 0.4686078670812779E-11 +MVKHC, 0.1151088060484353E+06 +LIMO, 0.2118919861350688E+08 +RIPC, 0.1990771385227159E+04 +HPETHNL, 0.2206267657612703E+05 +N2O5, 0.1401616650032463E+01 +ICHE, 0.1176423237001054E+06 +MCRHNB, 0.2771681249767795E+01 +BrNO3, 0.1172947966317992E-02 +H, 0.6216284487152619E-12 +MONITS, 0.1025646587653026E+04 +ETOO, 0.2637593375757233E+00 +BZCO3, 0.5709003507620132E+06 +INPB, 0.1838695869003343E+03 +IHPOO1, 0.1670870041373771E-09 +IHPOO2, 0.4768349246225203E-10 +AROMRO2, 0.3134488407271477E+05 +MVKHCB, 0.1629644198709347E+06 +HPALD1, 0.6105720635230087E+04 +IHPOO3, 0.2813602892501959E-09 +HPALD2, 0.2487249885131977E+06 +IHPNDOO, 0.1516508942336977E-13 +CH4, 0.6413044302139997E+14 +BENZO2, 0.2465783655851324E+07 +HC5A, 0.5072905709936064E+06 +HNO2, 0.8525740815692846E+10 +ICHOO, 0.1467410199462828E-10 +CH3CHOO, 0.1359861488296197E-14 +ATOOH, 0.3044729375275224E+08 +Cl2, 0.4735365483409282E+06 +PROPNN, 0.3255919681598459E+07 +MONITU, 0.4341408198279605E+03 +MCRHN, 0.1206888829438594E+01 +PRN1, 0.5433366490570176E+04 +R4N2, 0.6407243458167418E+03 +IONO, 0.3313107983243786E+12 +MVKOHOO, 0.3616867658827106E-02 +MCROHOO, 0.2452675556329100E-07 +ICPDH, 0.1393770274150725E+04 +MACR1OO, 0.1095612208015128E+06 +ETHLN, 0.1504831475722312E+06 +PO2, 0.1612810645552266E+01 +NPHEN, 0.6214442757117238E+04 +HCOOH, 0.1672242004120760E+12 +H2O2, 0.3117784541616176E+09 +ITCN, 0.1346600894017977E-01 +IHN4, 0.9084082351595475E+01 +OLNN, 0.1237437964152175E+04 +OLND, 0.1024183339842718E+05 +ETO2, 0.3339635176071126E+01 +MOH, 0.9277901237022385E+11 +ACTA, 0.9941165256736954E+09 +IHN1, 0.4735699779400414E+02 +ACET, 0.8215149379623137E+11 +IHPNBOO, 0.1947016777667088E-11 +GLYX, 0.1766483738204901E+08 +ISOP, 0.1203520574782764E+09 +LIMO2, 0.5522630674281831E-03 +MEK, 0.2751213672518024E+11 +IO, 0.6671502960055051E+05 +IEPOXAOO, 0.5034085167488948E-10 +IEPOXBOO, 0.1189694836883926E-10 +MVKHP, 0.5166277125136319E+06 +MCRHP, 0.3539241964918078E+06 +IDHNBOO, 0.1691724669732973E+03 +MGLY, 0.1151735962284400E+10 +CH2OO, 0.8088576389849288E-15 +ClNO2, 0.1065845576213978E+09 +GLYC, 0.7840534786934361E+10 +A3O2, 0.3861667155995023E+07 +PIO2, 0.1834799428456311E-02 +OTHRO2, 0.2874151143844508E+08 +ICN, 0.1853443428266801E+07 +MVKN, 0.1684420580803340E+01 +ITHN, 0.8522523075693068E-01 +IDN, 0.2125575165733714E+02 +IHOO4, 0.9796193577904957E-03 +IHOO1, 0.3096932485757059E-02 +INO2D, 0.3567837301421969E+03 +INO2B, 0.6586029013233600E+03 +MVK, 0.3895414112084697E+09 +MACRNO2, 0.2605624204290140E-13 +HAC, 0.2162080992132292E+08 +MACR, 0.2147413341026408E+09 +ATO2, 0.7247291436094178E-02 +PRPE, 0.7388753852936174E+11 +KO2, 0.2368376959302832E+03 +RCO3, 0.1348986705997912E+08 +R4O2, 0.5512109037082342E+04 +R4N1, 0.4368130203103403E+00 +B3O2, 0.1662387642845000E+08 +RCHO, 0.1029630440947693E+11 +HOBr, 0.1100635022331661E+00 +MCO3, 0.2833419171136089E+08 +ClNO3, 0.1195256835237133E-01 +CH2O, 0.4267270723071190E+11 +ALD2, 0.4478906664812438E+11 +HNO3, 0.2284159652475635E+09 +MO2, 0.1394350001389870E+09 +CO, 0.3465812541980784E+14 +HOI, 0.4263742551677998E+09 +I, 0.2115579960187551E+17 +IONO2, 0.2667006863649932E+00 +HOCl, 0.1140355887407010E+07 +O1D, 0.0000000000000000E+00 +Br, 0.7230565469895693E-10 +BrO, 0.9417417842762022E-19 +HCl, 0.2246683062510476E+06 +SO2, 0.4762242853100073E+12 +BrSALC, 0.2134260311757697E+00 +H2O, 0.1046673573419124E+18 +NO, 0.4247993639083090E+11 +SALACL, 0.2704044127326782E+08 +NO3, 0.2133357435739994E+04 +O3, 0.2782950112007994E-06 +BrSALA, 0.2423984771291159E+05 +HO2, 0.2744808889368235E+02 +ClO, 0.4047240547818320E+02 +OH, 0.8895440896749172E-06 +SALCCL, 0.4405419527867513E+01 +O, 0.0000000000000000E+00 +HBr, 0.3692221687679019E-07 +Cl, 0.1139925326811263E-03 +NO2, 0.4769143727526907E+10 +H2, 0.1323026086022174E+14 +N2, 0.2067773241415970E+20 +O2, 0.5548136254559868E+19 +RCOOH, 0.2648274863298850E+00 +R1, 0.0000000000000000E+00 +R2, 0.0000000000000000E+00 +R3, 0.0000000000000000E+00 +R4, 0.0000000000000000E+00 +R5, 0.0000000000000000E+00 +R6, 0.0000000000000000E+00 +R7, 0.0000000000000000E+00 +R8, 0.0000000000000000E+00 +R9, 0.0000000000000000E+00 +R10, 0.0000000000000000E+00 +R11, 0.0000000000000000E+00 +R12, 0.0000000000000000E+00 +R13, 0.1306125063219363E-13 +R14, 0.5633825441797428E-13 +R15, 0.1693149913550484E-14 +R16, 0.1669776366572876E-16 +R17, 0.7732269875065597E-17 +R18, 0.1800000000000000E-11 +R19, 0.6801111774004697E-11 +R20, 0.1187856520393073E-09 +R21, 0.1800000000000000E-11 +R22, 0.8827182408132897E-11 +R23, 0.4488997706542727E-11 +R24, 0.2524666560669123E-12 +R25, 0.3936901684824494E-14 +R26, 0.8303382066923266E-11 +R27, 0.2491762148721596E-14 +R28, 0.6213726053685217E-11 +R29, 0.2719172281470610E-12 +R30, 0.1147457567596921E-12 +R31, 0.1600000000000000E-09 +R32, 0.7845159822046276E-11 +R33, 0.7845159822046276E-11 +R34, 0.8652150472316413E-11 +R35, 0.1215430843441995E-10 +R36, 0.2087935993488316E-12 +R37, 0.8618009449459809E-11 +R38, 0.7424103252456706E-11 +R39, 0.1558967316575907E-11 +R40, 0.5158210195995977E-02 +R41, 0.4105896714557432E-11 +R42, 0.3500000000000000E-11 +R43, 0.2674301055079618E-10 +R44, 0.2000000000000000E-10 +R45, 0.1366656099068281E-11 +R46, 0.2038458923895630E-02 +R47, 0.4000000000000000E-12 +R48, 0.8304942020575600E-12 +R49, 0.3444116072705968E-15 +R50, 0.5800000000000000E-15 +R51, 0.1646314635570016E-10 +R52, 0.1430062921405061E-14 +R53, 0.1003096910252247E-10 +R54, 0.1022884181504681E-04 +R55, 0.2155209969609968E-10 +R56, 0.1899572857368130E-12 +R57, 0.9499526819508729E-11 +R58, 0.2619732319470269E-12 +R59, 0.9761500051455756E-11 +R60, 0.9068907649326314E-12 +R61, 0.1890975671853794E-12 +R62, 0.9703402065151272E-11 +R63, 0.6082878768639463E-12 +R64, 0.9600538911531409E-11 +R65, 0.2096691524370838E-11 +R66, 0.8214242017216247E-11 +R67, 0.1386296894315162E-11 +R68, 0.9600538911531409E-11 +R69, 0.8602512180110273E-11 +R70, 0.9600538911531409E-11 +R71, 0.9367651017519963E-11 +R72, 0.5872402803047995E-12 +R73, 0.9600538911531409E-11 +R74, 0.1923709855242515E-16 +R75, 0.1600000000000000E-11 +R76, 0.8840447890784166E-12 +R77, 0.2651725457773805E-10 +R78, 0.7574874303619841E-11 +R79, 0.7724297645489294E-05 +R80, 0.2297554070173675E-10 +R81, 0.6500000000000000E-14 +R82, 0.1601569738582206E-12 +R83, 0.5920000000000000E-12 +R84, 0.5920000000000000E-12 +R85, 0.9356112080926369E-11 +R86, 0.9356112080926369E-11 +R87, 0.1087331944540092E-10 +R88, 0.2022437323854658E-10 +R89, 0.1685106914331692E-10 +R90, 0.1685106914331692E-10 +R91, 0.1082487947447955E-11 +R92, 0.3000000000000000E-12 +R93, 0.3000000000000000E-12 +R94, 0.8000000000000000E-15 +R95, 0.8370000000000000E-13 +R96, 0.8370000000000000E-13 +R97, 0.4593109091928188E-11 +R98, 0.8370000000000000E-13 +R99, 0.8370000000000000E-13 +R100, 0.8370000000000000E-13 +R101, 0.3350000000000000E-11 +R102, 0.5670730996787276E-11 +R103, 0.6800000000000000E-13 +R104, 0.6800000000000000E-13 +R105, 0.9482546027965915E-11 +R106, 0.9482546027965915E-11 +R107, 0.1685106914331692E-10 +R108, 0.1685106914331692E-10 +R109, 0.1864331294632794E-10 +R110, 0.2769327712384376E-10 +R111, 0.6639577849380639E-17 +R112, 0.5977233749878582E-11 +R113, 0.2022766250121418E-11 +R114, 0.6952860182249913E-14 +R115, 0.1063047405602745E-10 +R116, 0.1527059371876042E-10 +R117, 0.1024919270693600E-14 +R118, 0.3967619608300904E-14 +R119, 0.4856699383267186E-11 +R120, 0.1522102501135158E-11 +R121, 0.1812644822041218E-10 +R122, 0.1069419154689466E-10 +R123, 0.1069419154689466E-10 +R124, 0.1812644822041218E-10 +R125, 0.1812644822041218E-10 +R126, 0.1265548150240623E-11 +R127, 0.1812644822041218E-10 +R128, 0.1130864681110785E-10 +R129, 0.3000000000000000E-13 +R130, 0.1400000000000000E-17 +R131, 0.1776002182212233E-10 +R132, 0.1224829091180850E-10 +R133, 0.1145215200254095E-10 +R134, 0.1145215200254095E-10 +R135, 0.1145215200254095E-10 +R136, 0.1145215200254095E-10 +R137, 0.1145215200254095E-10 +R138, 0.1145215200254095E-10 +R139, 0.1145215200254095E-10 +R140, 0.1145215200254095E-10 +R141, 0.1145215200254095E-10 +R142, 0.1145215200254095E-10 +R143, 0.1531036363976062E-10 +R144, 0.1145215200254095E-10 +R145, 0.1182758259655787E-15 +R146, 0.4947137674761860E-11 +R147, 0.1078908830003385E+00 +R148, 0.4349464270822050E-11 +R149, 0.5996993069034512E-11 +R150, 0.1297244469788620E-11 +R151, 0.1063957813126977E-11 +R152, 0.9469542707935430E-12 +R153, 0.2383934787834383E-10 +R154, 0.1560533259326667E-11 +R155, 0.1135483658454066E-10 +R156, 0.2774437088686036E-11 +R157, 0.6322317276135703E-12 +R158, 0.2258116429987485E-10 +R159, 0.4900000000000000E-10 +R160, 0.5011885415746155E-10 +R161, 0.2525353145609517E-10 +R162, 0.2525175122224102E-13 +R163, 0.4206991843058800E-10 +R164, 0.1600000000000000E-10 +R165, 0.9357851000639001E-12 +R166, 0.3397743948926645E-11 +R167, 0.1590270957424165E-20 +R168, 0.1911677542279754E-19 +R169, 0.1340249296284895E-16 +R170, 0.5654247311636963E-11 +R171, 0.3631493054842115E-11 +R172, 0.2441011084200365E-12 +R173, 0.9523433650365973E-13 +R174, 0.2198283503669724E-13 +R175, 0.2025970251462506E-09 +R176, 0.3203232552510752E-10 +R177, 0.4027995202004145E-10 +R178, 0.1200000000000000E-09 +R179, 0.1279466093286619E-09 +R180, 0.1750000000000000E-09 +R181, 0.1941017340129432E-13 +R182, 0.4575752636790363E-14 +R183, 0.4109549742094556E-14 +R184, 0.3456279727885131E-10 +R185, 0.6193547227931270E-10 +R186, 0.2400000000000000E-09 +R187, 0.7231345423136929E-14 +R188, 0.1489550159989153E-14 +R189, 0.8817471698036620E-11 +R190, 0.1300000000000000E-10 +R191, 0.1940860238957535E-11 +R192, 0.4541047417729696E-11 +R193, 0.9952817644374045E-15 +R194, 0.1412941861483416E-11 +R195, 0.2548621064987076E-10 +R196, 0.8050000000000001E-10 +R197, 0.3631845019153894E-16 +R198, 0.3017368791689039E-10 +R199, 0.1287443006072349E-10 +R200, 0.4373151567381767E-10 +R201, 0.1030227945296004E-12 +R202, 0.1500000000000000E-09 +R203, 0.1500000000000000E-09 +R204, 0.2700000000000000E-09 +R205, 0.3300000000000000E-09 +R206, 0.2600000000000000E-09 +R207, 0.1800000000000000E-09 +R208, 0.2700000000000000E-09 +R209, 0.6600000000000000E-09 +R210, 0.1020000000000000E-09 +R211, 0.2300000000000000E-09 +R212, 0.1400000000000000E-09 +R213, 0.1500000000000000E-09 +R214, 0.1000000000000000E-09 +R215, 0.2600000000000000E-09 +R216, 0.2000000000000000E-09 +R217, 0.2000000000000000E-09 +R218, 0.2320000000000000E-09 +R219, 0.1423297305464714E-09 +R220, 0.6020277215385516E-10 +R221, 0.1600000000000000E-09 +R222, 0.4824732662734779E-13 +R223, 0.2045586780861232E-11 +R224, 0.1968957256186884E-10 +R225, 0.1380995231804769E-11 +R226, 0.1231920358293981E-10 +R227, 0.6804437300017174E-11 +R228, 0.7273605735767601E-12 +R229, 0.4898642629573272E-12 +R230, 0.2585815287989893E-13 +R231, 0.3628534175979000E-12 +R232, 0.2531318995354032E-13 +R233, 0.7908628103308285E-13 +R234, 0.7838969343650861E-13 +R235, 0.6640878531948427E-14 +R236, 0.3222596092563283E-14 +R237, 0.3787602740058839E-14 +R238, 0.2127170455104025E-14 +R239, 0.2834978860321146E-13 +R240, 0.7114801466428427E-13 +R241, 0.7265446163877199E-10 +R242, 0.1114062708504557E-10 +R243, 0.8149168207387470E-14 +R244, 0.3153432292731612E-12 +R245, 0.3725054268461672E-10 +R246, 0.9247373048982916E-11 +R247, 0.3810270127231294E-10 +R248, 0.7438061010557129E-11 +R249, 0.1830907325675601E-10 +R250, 0.3038155050550292E-11 +R251, 0.3141921419543687E-14 +R252, 0.4174440916432189E-14 +R253, 0.2440975284529570E-14 +R254, 0.7239281854568612E-13 +R255, 0.1264083848896501E+08 +R256, 0.4280737456791907E-12 +R257, 0.7228530585506496E+01 +R258, 0.2420000000000000E-09 +R259, 0.6973866864697971E-11 +R260, 0.5901895214740018E-11 +R261, 0.1172925005510932E-11 +R262, 0.1714218057065875E-12 +R263, 0.1060267967619863E-10 +R264, 0.3632913305920416E-12 +R265, 0.2734065500828660E-12 +R266, 0.9123549979254371E-13 +R267, 0.2000000000000000E-12 +R268, 0.1600000000000000E-09 +R269, 0.5700000000000000E-10 +R270, 0.5586581345147238E-10 +R271, 0.7400000000000000E-10 +R272, 0.7400000000000000E-10 +R273, 0.5500000000000000E-10 +R274, 0.9600000000000000E-10 +R275, 0.2800000000000000E-13 +R276, 0.8128739536542815E-10 +R277, 0.5859868088851597E-10 +R278, 0.1786455069362510E-11 +R279, 0.4654350546487230E-09 +R280, 0.2050000000000000E-09 +R281, 0.2356264875337175E-09 +R282, 0.3600000000000000E-11 +R283, 0.4304819710793876E-12 +R284, 0.6311911208342040E-14 +R285, 0.5729391107568851E-11 +R286, 0.2139150214554144E+00 +R287, 0.2342941325253832E-14 +R288, 0.1500000000000000E-11 +R289, 0.4310729761999653E-11 +R290, 0.6373755534423264E-06 +R291, 0.5360732137484170E-10 +R292, 0.1200000000000000E-10 +R293, 0.8643145921006618E-10 +R294, 0.1000000000000000E-09 +R295, 0.1500000000000000E-09 +R296, 0.3800000000000000E-01 +R297, 0.7844224310426186E-11 +R298, 0.1329818947772808E-10 +R299, 0.9874940109619030E-12 +R300, 0.2886237567646005E-12 +R301, 0.1800000000000000E-09 +R302, 0.3000000000000000E-10 +R303, 0.5000000000000000E-11 +R304, 0.1026065816029982E-09 +R305, 0.1979426498920168E-10 +R306, 0.9186218183856375E-10 +R307, 0.1049070577244259E+00 +R308, 0.5381432585358023E-13 +R309, 0.2400000000000000E-11 +R310, 0.6700000000000000E-12 +R311, 0.1200000000000000E-14 +R312, 0.1000000000000000E-13 +R313, 0.4250000000000000E-11 +R314, 0.2800000000000000E-15 +R315, 0.4456080838947726E-32 +R316, 0.1400000000000000E-11 +R317, 0.3800000000000000E-10 +R318, 0.1200000000000000E-14 +R319, 0.1000000000000000E-13 +R320, 0.4250000000000000E-11 +R321, 0.2650000000000000E-10 +R322, 0.6000000000000000E-17 +R323, 0.1000000000000000E-16 +R324, 0.5961909891796595E-10 +R325, 0.5961909891796595E-10 +R326, 0.4000000000000000E-11 +R327, 0.1500000000000000E-10 +R328, 0.4633470709447861E-12 +R329, 0.1184162572678909E-10 +R330, 0.1200000000000000E-11 +R331, 0.7323214876798035E-16 +R332, 0.7323214876798035E-16 +R333, 0.4919824247890869E-11 +R334, 0.4919824247890869E-11 +R335, 0.1796634682576776E-09 +R336, 0.1727065335557493E-15 +R337, 0.1220000000000000E-10 +R338, 0.4000000000000000E-11 +R339, 0.1500000000000000E-10 +R340, 0.4633470709447861E-12 +R341, 0.1184162572678909E-10 +R342, 0.1200000000000000E-11 +R343, 0.6769493973799105E-11 +R344, 0.4000000000000000E-11 +R345, 0.4000000000000000E-11 +R346, 0.1846827703858681E-10 +R347, 0.1846827703858681E-10 +R348, 0.2082458745819263E-11 +R349, 0.1259887541220654E-11 +R350, 0.1416194428136263E-10 +R351, 0.8593179750386140E-11 +R352, 0.1200000000000000E-11 +R353, 0.1200000000000000E-11 +R354, 0.2625361029555087E-11 +R355, 0.1593969196515589E-11 +R356, 0.1110152663926151E-11 +R357, 0.4800000000000000E-11 +R358, 0.7290000000000000E-10 +R359, 0.1670000000000000E-15 +R360, 0.6210374477015558E-13 +R361, 0.6210374477015558E-13 +R362, 0.2780000000000000E-03 +R363, 0.2780000000000000E-03 +R364, 0.2087935993488316E-12 +R365, 0.2133039965535337E-13 +R366, 0.1693149913550484E-12 +R367, 0.3762462047721781E-12 +R368, 0.7100000000000000E-12 +R369, 0.7820071006293892E-17 +R370, 0.6977373046178490E-10 +R371, 0.3565296154016630E-10 +R372, 0.1049039314165638E-12 +R373, 0.5452117514658089E-11 +R374, 0.2287677670741204E-10 +R375, 0.7092156551205139E-12 +R376, 0.2250783513563761E-10 +R377, 0.1078157226894946E-11 +R378, 0.4599209450878908E-04 +R379, 0.4938757056412127E-04 +R380, 0.8003907193080921E-04 +R381, 0.9798920578692582E-03 +R382, 0.6711920040590271E-13 +R383, 0.5477614496466644E-11 +R384, 0.2963297077519775E-11 +R385, 0.7487270215754705E-13 +R386, 0.1801043351779480E-12 +R387, 0.1167029224802246E-12 +R388, 0.1939861283407593E-11 +R389, 0.6013871659240726E-13 +R390, 0.1908576479605102E-11 +R391, 0.9142352039489748E-13 +R392, 0.1737877810388551E-11 +R393, 0.7573581735932342E-11 +R394, 0.4659637067787865E-13 +R395, 0.2424829945326393E-12 +R396, 0.1593553248008108E-11 +R397, 0.7569055213000182E-11 +R398, 0.7058950606469323E-13 +R399, 0.3673409444584232E-12 +R400, 0.5977599435486738E-10 +R401, 0.5977599435486738E-10 +R402, 0.9043117392061368E-10 +R403, 0.1438677766918854E-09 +R404, 0.4894148321307943E-10 +R405, 0.4353249293178663E-10 +R406, 0.3164320035328412E-10 +R407, 0.1015295452654163E-10 +R408, 0.5912737523035294E-10 +R409, 0.1788070938884861E-10 +R410, 0.1040203823496950E-09 +R411, 0.1259354603012692E-10 +R412, 0.8464514544839402E-11 +R413, 0.1451009290635301E-09 +R414, 0.1451009290635301E-09 +R415, 0.2887268554235268E-02 +R416, 0.7396985708293381E-11 +R417, 0.2203553203238026E-11 +R418, 0.2747990619596953E-10 +R419, 0.5284246221902282E-02 +R420, 0.7558097710646840E-11 +R421, 0.2042441200884569E-11 +R422, 0.2747990619596953E-10 +R423, 0.3404797823390646E-02 +R424, 0.7979311970388622E-11 +R425, 0.1621226941142786E-11 +R426, 0.2747990619596953E-10 +R427, 0.7554739155968315E-11 +R428, 0.2463501898685320E-11 +R429, 0.1049041087929910E-10 +R430, 0.1935608634681323E-11 +R431, 0.7119667158795506E-11 +R432, 0.3404797823390646E-02 +R433, 0.1347550434111841E+00 +R434, 0.2647861406737145E-10 +R435, 0.9217882798624803E-11 +R436, 0.3826561129066057E-12 +R437, 0.3404797823390646E-02 +R438, 0.1347550434111841E+00 +R439, 0.9293596230846684E-11 +R440, 0.3069426806847241E-12 +R441, 0.2647861406737145E-10 +R442, 0.2647861406737145E-10 +R443, 0.3826561129066057E-12 +R444, 0.9217882798624803E-11 +R445, 0.3404797823390646E-02 +R446, 0.9600538911531409E-11 +R447, 0.2647861406737145E-10 +R448, 0.9600538911531409E-11 +R449, 0.2647861406737145E-10 +R450, 0.2934902644514462E-10 +R451, 0.4898460647960096E-11 +R452, 0.4192718063592088E-10 +R453, 0.5687475810432827E-11 +R454, 0.7785030685366780E-11 +R455, 0.8385436127184176E-10 +R456, 0.4781515620947853E-11 +R457, 0.1212599832117320E-09 +R458, 0.8063861932478692E-11 +R459, 0.8063861932478692E-11 +R460, 0.3404797823390646E-02 +R461, 0.2892621704838898E-10 +R462, 0.8633120530414077E-11 +R463, 0.9674183811173308E-12 +R464, 0.3404797823390646E-02 +R465, 0.2892621704838898E-10 +R466, 0.8814430122425533E-11 +R467, 0.7861087891058750E-12 +R468, 0.2280760568628614E-02 +R469, 0.9246522942242757E-03 +R470, 0.2892621704838898E-10 +R471, 0.8346119098822770E-11 +R472, 0.1254419812708638E-11 +R473, 0.2892621704838898E-10 +R474, 0.7308315440142681E-11 +R475, 0.2292223471388727E-11 +R476, 0.2892621704838898E-10 +R477, 0.6943775590326396E-11 +R478, 0.2656763321205012E-11 +R479, 0.5774057022807106E-12 +R480, 0.2747990619596953E-10 +R481, 0.2747990619596953E-10 +R482, 0.1610000000000000E-11 +R483, 0.2560000000000000E-11 +R484, 0.3710000000000000E-11 +R485, 0.1180000000000000E-11 +R486, 0.2800000000000000E-12 +R487, 0.1920000000000000E-11 +R488, 0.7710000000000000E-11 +R489, 0.2300000000000000E-11 +R490, 0.2300000000000000E-11 +R491, 0.9156985258510212E-11 +R492, 0.4435536530211971E-12 +R493, 0.6652946686230504E-11 +R494, 0.2947592225300904E-11 +R495, 0.8427770688616526E-14 +R496, 0.1815892172475011E+05 +R497, 0.2416978648423674E-10 +R498, 0.6617917727826727E-10 +R499, 0.1146266455409855E-10 +R500, 0.2284249686959783E-10 +R501, 0.7498742460162967E-11 +R502, 0.4702966861742478E-11 +R503, 0.7019353524988773E-11 +R504, 0.8063861932478692E-11 +R505, 0.1189409372971132E-02 +R506, 0.1583457974398210E-02 +R507, 0.2937123577221034E-10 +R508, 0.2937123577221034E-10 +R509, 0.8574282196284162E-11 +R510, 0.1026256715247247E-11 +R511, 0.8231203060441915E-11 +R512, 0.1369335851089493E-11 +R513, 0.1491712331325118E-11 +R514, 0.3843324891626081E-10 +R515, 0.9600538911531409E-11 +R516, 0.2825868896265692E-10 +R517, 0.9999999999999999E-11 +R518, 0.9600538911531409E-11 +R519, 0.3015001853889774E-10 +R520, 0.2372295879522071E-10 +R521, 0.3441918751314733E-17 +R522, 0.1744244066693170E-10 +R523, 0.1483154970320850E-10 +R524, 0.7157465461379327E-18 +R525, 0.2410483826339482E-14 +R526, 0.4915596915226207E-11 +R527, 0.5770000000000000E-10 +R528, 0.1483154970320850E-10 +R529, 0.5510225574326152E-10 +R530, 0.1483154970320850E-10 +R531, 0.9600538911531409E-11 +R532, 0.2147215342438105E-10 +R533, 0.9000000000000000E-11 +R534, 0.9600538911531409E-11 +R535, 0.2147215342438105E-10 +R536, 0.9000000000000000E-11 +R537, 0.1308294022245021E-09 +R538, 0.2746583278371944E-10 +R539, 0.1121258174364757E-10 +R540, 0.2746583278371944E-10 +R541, 0.2577604998539671E-11 +R542, 0.3093125998247605E-10 +R543, 0.2358599236253255E-10 +R544, 0.9059571224157017E-11 +R545, 0.5409676873743912E-12 +R546, 0.2358599236253255E-10 +R547, 0.2569818343400271E-10 +R548, 0.1660000000000000E-10 +R549, 0.1331796903715579E+00 +R550, 0.8795900340024027E-11 +R551, 0.8046385715073819E-12 +R552, 0.2488889645840271E-10 +R553, 0.9898388197610070E-11 +R554, 0.2569818343400271E-10 +R555, 0.2145594522276096E-10 +R556, 0.9898388197610070E-11 +R557, 0.4000000000000000E-11 +R558, 0.1776002182212233E-10 +R559, 0.8880320973110359E-05 +R560, 0.2900000000000000E-10 +R561, 0.4330000000000000E-11 +R562, 0.9999999999999999E-11 +R563, 0.2250000000000000E-10 +R564, 0.3000000000000000E-11 +R565, 0.3000000000000000E-11 +R566, 0.9999999999999999E-11 +R567, 0.3000000000000000E-11 +R568, 0.1653174836792043E-14 +R569, 0.8000000000000000E-12 +R570, 0.7961389092675524E-11 +R571, 0.2569818343400271E-10 +R572, 0.5315237028013725E-11 +R573, 0.2910000000000000E-10 +R574, 0.2383928604353185E-10 +R575, 0.1770075258553637E-10 +R576, 0.9244963396289505E-11 +R577, 0.8696048053003735E-18 +R578, 0.8874307769792254E-11 +R579, 0.6265745813372331E-12 +R580, 0.1702196618616736E-10 +R581, 0.9954891297824762E-11 +R582, 0.2300000000000000E-11 +R583, 0.6000000000000000E-12 +R584, 0.3565059078465853E+05 +R585, 0.8427770688616526E-14 +R586, 0.8400000000000000E-12 +R587, 0.3782952514770088E-11 +R588, 0.1380000000000000E-10 +R589, 0.1142689598343042E-11 +R590, 0.6172533322854648E-11 +R591, 0.1700000000000000E-10 +R592, 0.2654759196956376E-10 +R593, 0.9761500051455756E-11 +R594, 0.2300000000000000E-11 +R595, 0.3773539845384472E-13 +R596, 0.9322863147420461E-13 +R597, 0.3912811002660915E-10 +R598, 0.3800000000000000E-11 +R599, 0.4700000000000000E-10 +R600, 0.1400000000000000E-10 +R601, 0.2000000000000000E-10 +R602, 0.9200000000000000E-17 +R603, 0.9899999999999999E-10 +R604, 0.1333590476323586E-10 +R605, 0.2400000000000000E-14 +R606, 0.3772103697300064E-10 +R607, 0.2145594522276096E-10 +R608, 0.1001815178921538E-10 +R609, 0.4660000000000000E-11 +R610, 0.6854286447343410E-05 +R611, 0.1060000000000000E-11 +R612, 0.7000000000000000E-11 +R613, 0.1002430966822572E-10 +R614, 0.2300000000000000E-11 +R615, 0.2492104853399666E-10 +R616, 0.3600000000000000E-11 +R617, 0.2860000000000000E-12 +R618, 0.2080000000000000E-11 +R619, 0.3470000000000000E-11 +R620, 0.2600000000000000E-11 +R621, 0.1002430966822572E-11 +R622, 0.1002430966822572E-10 +R623, 0.5000000000000000E-10 +R624, 0.8000000000000000E-15 +R625, 0.1500000000000000E-02 +R626, 0.5000000000000000E-10 +R627, 0.8000000000000000E-15 +R628, 0.1500000000000000E-02 +R629, 0.1770075258553637E-10 +R630, 0.9244963396289505E-11 +R631, 0.1770075258553637E-10 +R632, 0.9244963396289505E-11 +R633, 0.1770075258553637E-10 +R634, 0.9244963396289505E-11 +R635, 0.1200000000000000E-11 +R636, 0.4429149334337991E-10 +R637, 0.6590335356767159E-01 +R638, 0.5337087225134494E-05 +R639, 0.7917504249163501E-03 +R640, 0.2012573944829506E-07 +R641, 0.1329470130619842E-11 +R642, 0.5415407077728137E-20 +R643, 0.0000000000000000E+00 +R644, 0.0000000000000000E+00 +R645, 0.2834224499151186E-13 +R646, 0.4613985518844530E-13 +R647, 0.2430063744381336E-12 +R648, 0.1861269486775501E-13 +R649, 0.1174255146722783E-19 +R650, 0.0000000000000000E+00 +R651, 0.7061724340248307E-19 +R652, 0.0000000000000000E+00 +R653, 0.0000000000000000E+00 +R654, 0.0000000000000000E+00 +R655, 0.0000000000000000E+00 +R656, 0.2043836528817186E-13 +R657, 0.3414210363378818E-07 +R658, 0.0000000000000000E+00 +R659, 0.0000000000000000E+00 +R660, 0.0000000000000000E+00 +R661, 0.8662655386846380E-14 +R662, 0.0000000000000000E+00 +R663, 0.0000000000000000E+00 +R664, 0.0000000000000000E+00 +R665, 0.0000000000000000E+00 +R666, 0.5702237189752122E-16 +R667, 0.1807709511614873E-16 +R668, 0.0000000000000000E+00 +R669, 0.0000000000000000E+00 +R670, 0.0000000000000000E+00 +R671, 0.3372633441179459E-12 +R672, 0.4433315715799872E-12 +R673, 0.3386066935086624E-08 +R674, 0.0000000000000000E+00 +R675, 0.0000000000000000E+00 +R676, 0.0000000000000000E+00 +R677, 0.4242723223675972E-15 +R678, 0.0000000000000000E+00 +R679, 0.6184793714445779E-02 +R680, 0.1355736734754715E-06 +R681, 0.6743923198623428E-02 +R682, 0.2842688326930065E-05 +R683, 0.1393519570311092E-06 +R684, 0.0000000000000000E+00 +R685, 0.0000000000000000E+00 +R686, 0.9429898022217180E-03 +R687, 0.4101527385982588E-06 +R688, 0.2864515128106286E-07 +R689, 0.9178195441934165E-03 +R690, 0.3992584936902100E-06 +R691, 0.2793582540292971E-07 +R692, 0.8945678255239541E-03 +R693, 0.3891923764119877E-06 +R694, 0.2727841361774535E-07 +R695, 0.0000000000000000E+00 +R696, 0.0000000000000000E+00 +R697, 0.0000000000000000E+00 +R698, 0.0000000000000000E+00 +R699, 0.1018354967694758E-19 +R700, 0.3252656695474025E-11 +R701, 0.0000000000000000E+00 +R702, 0.1652273763811812E-13 +R703, 0.3018313936815677E-08 +R704, 0.1568981792886400E-11 +R705, 0.0000000000000000E+00 +R706, 0.7970061691084235E-14 +R707, 0.3522934928875932E-08 +R708, 0.1796036932864130E-11 +R709, 0.0000000000000000E+00 +R710, 0.9123448863010013E-14 +R711, 0.4009570150075659E-08 +R712, 0.8432582276134732E-06 +R713, 0.3405351184235766E-07 +R714, 0.2749820891205699E-07 +R715, 0.2749820891205699E-07 +R716, 0.2749820891205699E-07 +R717, 0.1201566872099362E+00 +R718, 0.8501160771170284E-03 +R719, 0.9510515967057841E-03 +R720, 0.1413007895237626E-02 +R721, 0.1413007895237626E-02 +R722, 0.1413924856012875E-02 +R723, 0.3080528111268531E-07 +R724, 0.2749821079937958E-07 +R725, 0.8557779082588896E-03 +R726, 0.8402054163924561E-02 +R727, 0.8557779082588896E-03 +R728, 0.8557779082588896E-03 +R729, 0.2749820439797331E-07 +R730, 0.8128039597466691E-03 +R731, 0.8128039597466691E-03 +R732, 0.7490614101660079E-03 +R733, 0.7432907252077029E-03 +R734, 0.7394794863731563E-03 +R735, 0.8501445339752493E-03 +R736, 0.8501445339752493E-03 +R737, 0.1756528045156896E-02 +R738, 0.0000000000000000E+00 +R739, 0.0000000000000000E+00 +R740, 0.0000000000000000E+00 +R741, 0.0000000000000000E+00 +R742, 0.0000000000000000E+00 +R743, 0.0000000000000000E+00 +R744, 0.0000000000000000E+00 +R745, 0.0000000000000000E+00 +R746, 0.0000000000000000E+00 +R747, 0.0000000000000000E+00 +R748, 0.0000000000000000E+00 +R749, 0.0000000000000000E+00 +R750, 0.0000000000000000E+00 +R751, 0.0000000000000000E+00 +R752, 0.0000000000000000E+00 +R753, 0.0000000000000000E+00 +R754, 0.0000000000000000E+00 +R755, 0.0000000000000000E+00 +R756, 0.0000000000000000E+00 +R757, 0.0000000000000000E+00 +R758, 0.0000000000000000E+00 +R759, 0.0000000000000000E+00 +R760, 0.0000000000000000E+00 +R761, 0.0000000000000000E+00 +R762, 0.0000000000000000E+00 +R763, 0.0000000000000000E+00 +R764, 0.0000000000000000E+00 +R765, 0.0000000000000000E+00 +R766, 0.0000000000000000E+00 +R767, 0.0000000000000000E+00 +R768, 0.0000000000000000E+00 +R769, 0.0000000000000000E+00 +R770, 0.0000000000000000E+00 +R771, 0.0000000000000000E+00 +R772, 0.0000000000000000E+00 +R773, 0.0000000000000000E+00 +R774, 0.0000000000000000E+00 +R775, 0.0000000000000000E+00 +R776, 0.0000000000000000E+00 +R777, 0.0000000000000000E+00 +R778, 0.0000000000000000E+00 +R779, 0.0000000000000000E+00 +R780, 0.0000000000000000E+00 +R781, 0.0000000000000000E+00 +R782, 0.0000000000000000E+00 +R783, 0.0000000000000000E+00 +R784, 0.0000000000000000E+00 +R785, 0.0000000000000000E+00 +R786, 0.0000000000000000E+00 +R787, 0.0000000000000000E+00 +R788, 0.0000000000000000E+00 +R789, 0.0000000000000000E+00 +R790, 0.0000000000000000E+00 +R791, 0.0000000000000000E+00 +R792, 0.0000000000000000E+00 +R793, 0.0000000000000000E+00 +R794, 0.0000000000000000E+00 +R795, 0.0000000000000000E+00 +R796, 0.0000000000000000E+00 +R797, 0.0000000000000000E+00 +R798, 0.0000000000000000E+00 +R799, 0.0000000000000000E+00 +R800, 0.0000000000000000E+00 +R801, 0.0000000000000000E+00 +R802, 0.0000000000000000E+00 +R803, 0.0000000000000000E+00 +R804, 0.0000000000000000E+00 +R805, 0.0000000000000000E+00 +R806, 0.0000000000000000E+00 +R807, 0.0000000000000000E+00 +R808, 0.0000000000000000E+00 +R809, 0.0000000000000000E+00 +R810, 0.0000000000000000E+00 +R811, 0.0000000000000000E+00 +R812, 0.0000000000000000E+00 +R813, 0.0000000000000000E+00 +R814, 0.0000000000000000E+00 +R815, 0.0000000000000000E+00 +R816, 0.0000000000000000E+00 +R817, 0.0000000000000000E+00 +R818, 0.0000000000000000E+00 +R819, 0.0000000000000000E+00 +R820, 0.0000000000000000E+00 +R821, 0.0000000000000000E+00 +R822, 0.0000000000000000E+00 +R823, 0.0000000000000000E+00 +R824, 0.0000000000000000E+00 +R825, 0.0000000000000000E+00 +R826, 0.0000000000000000E+00 +R827, 0.0000000000000000E+00 +R828, 0.0000000000000000E+00 +R829, 0.0000000000000000E+00 +R830, 0.0000000000000000E+00 +R831, 0.0000000000000000E+00 +R832, 0.0000000000000000E+00 +R833, 0.0000000000000000E+00 +R834, 0.0000000000000000E+00 +R835, 0.0000000000000000E+00 +R836, 0.0000000000000000E+00 +R837, 0.0000000000000000E+00 +R838, 0.0000000000000000E+00 +R839, 0.0000000000000000E+00 +R840, 0.0000000000000000E+00 +R841, 0.0000000000000000E+00 +R842, 0.0000000000000000E+00 +R843, 0.0000000000000000E+00 +R844, 0.0000000000000000E+00 +R845, 0.0000000000000000E+00 +R846, 0.0000000000000000E+00 +R847, 0.0000000000000000E+00 +R848, 0.0000000000000000E+00 +R849, 0.0000000000000000E+00 +R850, 0.0000000000000000E+00 +R851, 0.0000000000000000E+00 +R852, 0.0000000000000000E+00 +R853, 0.0000000000000000E+00 +R854, 0.0000000000000000E+00 +R855, 0.0000000000000000E+00 +R856, 0.0000000000000000E+00 +R857, 0.0000000000000000E+00 +R858, 0.0000000000000000E+00 +R859, 0.0000000000000000E+00 +R860, 0.0000000000000000E+00 +R861, 0.0000000000000000E+00 +R862, 0.0000000000000000E+00 +R863, 0.0000000000000000E+00 +R864, 0.0000000000000000E+00 +R865, 0.0000000000000000E+00 +R866, 0.0000000000000000E+00 +R867, 0.0000000000000000E+00 +R868, 0.0000000000000000E+00 +R869, 0.0000000000000000E+00 +R870, 0.0000000000000000E+00 +R871, 0.0000000000000000E+00 +R872, 0.0000000000000000E+00 +R873, 0.0000000000000000E+00 +R874, 0.0000000000000000E+00 +R875, 0.0000000000000000E+00 +R876, 0.0000000000000000E+00 +R877, 0.0000000000000000E+00 +R878, 0.0000000000000000E+00 +R879, 0.0000000000000000E+00 +R880, 0.0000000000000000E+00 +R881, 0.0000000000000000E+00 +R882, 0.0000000000000000E+00 +R883, 0.0000000000000000E+00 +R884, 0.0000000000000000E+00 +R885, 0.0000000000000000E+00 +R886, 0.0000000000000000E+00 +R887, 0.0000000000000000E+00 +R888, 0.0000000000000000E+00 +R889, 0.0000000000000000E+00 +R890, 0.0000000000000000E+00 +R891, 0.0000000000000000E+00 +R892, 0.0000000000000000E+00 +R893, 0.0000000000000000E+00 +R894, 0.0000000000000000E+00 +A1, 0.0000000000000000E+00 +A2, 0.0000000000000000E+00 +A3, 0.0000000000000000E+00 +A4, 0.0000000000000000E+00 +A5, 0.0000000000000000E+00 +A6, 0.0000000000000000E+00 +A7, 0.0000000000000000E+00 +A8, 0.0000000000000000E+00 +A9, 0.0000000000000000E+00 +A10, 0.0000000000000000E+00 +A11, 0.0000000000000000E+00 +A12, 0.0000000000000000E+00 +A13, 0.1544095090371950E-09 +A14, 0.1394685501764874E-25 +A15, 0.1293340702651254E-19 +A16, 0.2216175462058372E-13 +A17, 0.3000435022532459E-15 +A18, 0.1424319637456039E-23 +A19, 0.5381642809026870E-23 +A20, 0.2900304363590725E-14 +A21, 0.4992132261374084E-09 +A22, 0.1029243351774655E+02 +A23, 0.3382000026311459E-08 +A24, 0.7783529492022620E-05 +A25, 0.2245878656968180E-06 +A26, 0.4918250909820989E+08 +A27, 0.1475918048360805E+05 +A28, 0.2378132321388914E-01 +A29, 0.5286647179506010E+04 +A30, 0.2230900687932250E+04 +A31, 0.1984537284279314E-07 +A32, 0.7437019419451209E-08 +A33, 0.2124799577070756E-09 +A34, 0.3284291818159132E-06 +A35, 0.5156299587534947E-07 +A36, 0.4242395128398950E-10 +A37, 0.3256554136258845E-06 +A38, 0.5630456501538279E-07 +A39, 0.2040748720606162E+00 +A40, 0.4391218437132260E-04 +A41, 0.3109291964241143E-19 +A42, 0.2049480458836636E-06 +A43, 0.2423582340472064E+04 +A44, 0.3795430996253097E-13 +A45, 0.1390475306762553E+02 +A46, 0.2857137968139373E-02 +A47, 0.5950131965087040E-07 +A48, 0.6854153534377544E-07 +A49, 0.3504142963241850E-02 +A50, 0.5280095961880112E-01 +A51, 0.6559221997113503E-06 +A52, 0.1366440685830269E+00 +A53, 0.1355483176389767E+07 +A54, 0.9547457238498170E+05 +A55, 0.2594085422414428E+08 +A56, 0.2932381069933888E-07 +A57, 0.1347674024628245E+01 +A58, 0.3716548482371428E-01 +A59, 0.1191818222736209E+08 +A60, 0.5308613398569357E-07 +A61, 0.1106909362862180E-07 +A62, 0.1591778825197418E+07 +A63, 0.9978559638312063E+05 +A64, 0.6577530208390460E+00 +A65, 0.1221966191082927E-05 +A66, 0.1923397964338659E+04 +A67, 0.3246070202102973E+03 +A68, 0.1781455773765494E+00 +A69, 0.2648407932236744E-02 +A70, 0.9658958438568591E+02 +A71, 0.6615259160850997E+07 +A72, 0.4146980536146722E+06 +A73, 0.2215891389577489E+04 +A74, 0.2688811567750893E-01 +A75, 0.9119240878913767E-15 +A76, 0.7817700716487269E-09 +A77, 0.2428719783892385E-06 +A78, 0.4873304084815480E+06 +A79, 0.2672848679251233E+05 +A80, 0.1316610360751831E+08 +A81, 0.1427770342219006E+00 +A82, 0.1170385135992689E-07 +A83, 0.3187633237762694E+03 +A84, 0.1331302935313501E-03 +A85, 0.1415550368813226E-05 +A86, 0.1121768143269558E-09 +A87, 0.2162967454746129E-11 +A88, 0.1314734351903356E-06 +A89, 0.7689035643015398E-02 +A90, 0.2513093067514751E-05 +A91, 0.2649200748899162E-07 +A92, 0.1396986093718930E-03 +A93, 0.1202271795424286E+04 +A94, 0.4695457716460690E-01 +A95, 0.6433022336823628E-01 +A96, 0.5097917870941120E-05 +A97, 0.4641456536697745E-05 +A98, 0.2764063950606851E-02 +A99, 0.1940124327537266E+03 +A100, 0.6341124198168652E-01 +A101, 0.1968893354432240E-06 +A102, 0.2048820177489005E-11 +A103, 0.7584150914291102E-12 +A104, 0.5617306462410630E+02 +A105, 0.8692327839315982E-09 +A106, 0.7480776397688000E-02 +A107, 0.1786135534134029E-02 +A108, 0.7459727334030904E-09 +A109, 0.6903079437200014E-02 +A110, 0.1820174513365187E-05 +A111, 0.1365265410416567E-12 +A112, 0.4168822503476795E-07 +A113, 0.1410778600209642E-07 +A114, 0.1095969127947281E+01 +A115, 0.1670435665976086E-09 +A116, 0.1564502742632929E-07 +A117, 0.3862450516744865E-04 +A118, 0.9748697206329562E-02 +A119, 0.9340726583080131E-10 +A120, 0.2927408549005464E-10 +A121, 0.5072457778505291E-10 +A122, 0.8504663487342167E-09 +A123, 0.1980924230701427E-09 +A124, 0.8063275074176582E-09 +A125, 0.1207318851701192E-08 +A126, 0.4520779948652274E-10 +A127, 0.1940901159685058E-09 +A128, 0.3883864701204402E-29 +A129, 0.4858832652547309E-11 +A130, 0.5183088626024881E-03 +A131, 0.1425821473744241E+05 +A132, 0.4839027858077308E+05 +A133, 0.1788610317723219E+01 +A134, 0.2351655264970321E-05 +A135, 0.7685086483538132E-01 +A136, 0.5394239609639514E+04 +A137, 0.1417403519754149E-03 +A138, 0.1763059347996755E+01 +A139, 0.1083669770167318E-02 +A140, 0.9326260340628824E+04 +A141, 0.5233368465250004E-03 +A142, 0.1253062606773393E+04 +A143, 0.5851995772217367E+04 +A144, 0.2154103542600827E+05 +A145, 0.5382985889199357E-09 +A146, 0.3289775098796462E+07 +A147, 0.6487417738377453E+03 +A148, 0.1122849439245198E-10 +A149, 0.1548172346165765E-10 +A150, 0.8031630757084275E-02 +A151, 0.4507164669434901E-06 +A152, 0.1905490074921044E-28 +A153, 0.6162235943787915E-28 +A154, 0.3097115513010166E-20 +A155, 0.3729375692265349E-24 +A156, 0.2460586073970009E-49 +A157, 0.5607121498021447E-50 +A158, 0.9033624380409510E-19 +A159, 0.4155727760989191E-23 +A160, 0.4907827560701223E-12 +A161, 0.0000000000000000E+00 +A162, 0.0000000000000000E+00 +A163, 0.3524284733079588E-35 +A164, 0.2468060897569091E-17 +A165, 0.2887344370879187E-11 +A166, 0.1100360324929323E-10 +A167, 0.9446237385912818E-20 +A168, 0.2398743850871715E-18 +A169, 0.6377001096752690E-16 +A170, 0.1949788362791917E-11 +A171, 0.1631013174213815E-20 +A172, 0.9719712752815177E-11 +A173, 0.2483714412209267E-11 +A174, 0.3689471196039368E-11 +A175, 0.0000000000000000E+00 +A176, 0.0000000000000000E+00 +A177, 0.0000000000000000E+00 +A178, 0.0000000000000000E+00 +A179, 0.0000000000000000E+00 +A180, 0.0000000000000000E+00 +A181, 0.0000000000000000E+00 +A182, 0.0000000000000000E+00 +A183, 0.4836488141068563E-07 +A184, 0.0000000000000000E+00 +A185, 0.0000000000000000E+00 +A186, 0.0000000000000000E+00 +A187, 0.0000000000000000E+00 +A188, 0.1753036642378697E-10 +A189, 0.0000000000000000E+00 +A190, 0.0000000000000000E+00 +A191, 0.0000000000000000E+00 +A192, 0.0000000000000000E+00 +A193, 0.0000000000000000E+00 +A194, 0.4873065985059206E-05 +A195, 0.4409014946757623E-29 +A196, 0.1373532289993859E-20 +A197, 0.0000000000000000E+00 +A198, 0.0000000000000000E+00 +A199, 0.0000000000000000E+00 +A200, 0.0000000000000000E+00 +A201, 0.0000000000000000E+00 +A202, 0.0000000000000000E+00 +A203, 0.0000000000000000E+00 +A204, 0.0000000000000000E+00 +A205, 0.0000000000000000E+00 +A206, 0.0000000000000000E+00 +A207, 0.0000000000000000E+00 +A208, 0.0000000000000000E+00 +A209, 0.0000000000000000E+00 +A210, 0.0000000000000000E+00 +A211, 0.0000000000000000E+00 +A212, 0.0000000000000000E+00 +A213, 0.0000000000000000E+00 +A214, 0.0000000000000000E+00 +A215, 0.0000000000000000E+00 +A216, 0.0000000000000000E+00 +A217, 0.0000000000000000E+00 +A218, 0.0000000000000000E+00 +A219, 0.0000000000000000E+00 +A220, 0.0000000000000000E+00 +A221, 0.0000000000000000E+00 +A222, 0.2032330041575784E-13 +A223, 0.1154379823355828E-01 +A224, 0.7088637765206643E-15 +A225, 0.4971857526607691E-16 +A226, 0.1299683313553025E-14 +A227, 0.3131265782021524E-26 +A228, 0.1453647300827218E-12 +A229, 0.4969167602596347E-12 +A230, 0.2451654483962333E-11 +A231, 0.3857979648517187E-20 +A232, 0.3298724495837125E-09 +A233, 0.1141251087715336E-09 +A234, 0.2271490109518611E-10 +A235, 0.1907002424774826E-12 +A236, 0.1902616293210483E-10 +A237, 0.2332212035621905E-11 +A238, 0.1139568469410342E-11 +A239, 0.1159038681542782E-31 +A240, 0.5201198503217277E-03 +A241, 0.3534181816429206E-03 +A242, 0.3534202755603975E-21 +A243, 0.1229017572061915E-04 +A244, 0.1120742943298902E-07 +A245, 0.1165523725852289E-12 +A246, 0.2893389441772508E-13 +A247, 0.0000000000000000E+00 +A248, 0.8262868959461469E-08 +A249, 0.3147815268312234E+02 +A250, 0.5864207951426836E+00 +A251, 0.5146516315494763E-11 +A252, 0.6837799364061547E-11 +A253, 0.3998355607943692E-11 +A254, 0.4578455599737246E+02 +A255, 0.4253962180996577E+02 +A256, 0.7011914755948523E-09 +A257, 0.3739471778701002E-08 +A258, 0.9283452316418130E-19 +A259, 0.2658058346109079E-28 +A260, 0.2249481118260543E-28 +A261, 0.4470551504274228E-29 +A262, 0.0000000000000000E+00 +A263, 0.1444618857673225E-16 +A264, 0.6066848164475123E-06 +A265, 0.5055893184772958E-07 +A266, 0.3387853827972560E-08 +A267, 0.3812462026109756E-05 +A268, 0.2543127809637811E-05 +A269, 0.6924380108605892E-05 +A270, 0.1105145610572635E-02 +A271, 0.2817131692439818E-13 +A272, 0.2424475084644417E-06 +A273, 0.5816863029854449E-03 +A274, 0.7230320412634117E-03 +A275, 0.3173012095167780E-08 +A276, 0.6097590458791804E-03 +A277, 0.4395647761590923E-03 +A278, 0.1672953868710619E-04 +A279, 0.6385413285411382E-05 +A280, 0.1531043168587445E-01 +A281, 0.1984594169100223E-02 +A282, 0.1923295265085566E-10 +A283, 0.3868728651689194E+15 +A284, 0.6176042377998522E+10 +A285, 0.5780671963784782E+15 +A286, 0.7087235653196994E+11 +A287, 0.2571772774955146E+09 +A288, 0.1594007948381327E+06 +A289, 0.1371560255916829E+04 +A290, 0.1699884975753359E-06 +A291, 0.3024667814552878E+06 +A292, 0.2390796055783201E-13 +A293, 0.5430344329278443E-24 +A294, 0.1032631908411306E+01 +A295, 0.3593643356353974E+01 +A296, 0.4434731966330204E+01 +A297, 0.5157695746723974E+05 +A298, 0.3590667717883087E-04 +A299, 0.5813923807794108E-02 +A300, 0.1675998521975234E+06 +A301, 0.7975824354359697E-02 +A302, 0.3388340733860284E-09 +A303, 0.1896393493370307E-08 +A304, 0.1878931786977346E-03 +A305, 0.5609794092354818E+05 +A306, 0.4088689418737052E+00 +A307, 0.2438317073530726E+00 +A308, 0.1122021068920508E-01 +A309, 0.3212673468445359E-12 +A310, 0.1940510353178839E-11 +A311, 0.3364018739845117E-16 +A312, 0.3436022105331744E-18 +A313, 0.1639462292556558E-16 +A314, 0.2370507763074392E-13 +A315, 0.3948641181851453E-13 +A316, 0.3151414639816281E-33 +A317, 0.1463751073963923E-13 +A318, 0.5655630001792337E-16 +A319, 0.5776682952316307E-18 +A320, 0.2756284327065614E-16 +A321, 0.1716137523268817E-13 +A322, 0.8539986499860171E-15 +A323, 0.1423331083310029E-14 +A324, 0.9354169247325732E-08 +A325, 0.2953746491422258E-08 +A326, 0.3117686520430279E-03 +A327, 0.7554260672151960E-12 +A328, 0.1185405176990208E-06 +A329, 0.6156172132590459E-06 +A330, 0.4697139604546514E-11 +A331, 0.3594674207981100E-14 +A332, 0.1135082768859006E-14 +A333, 0.1851252046675725E+01 +A334, 0.5845659933050691E+00 +A335, 0.3386427555753618E-08 +A336, 0.1018424222835605E-14 +A337, 0.5514904399178571E+00 +A338, 0.9384039990141750E-04 +A339, 0.2273784865119969E-12 +A340, 0.3567994893810536E-07 +A341, 0.1852969023660921E-06 +A342, 0.1413809425658991E-11 +A343, 0.4918242796265270E-11 +A344, 0.2102651440191347E+03 +A345, 0.1740289725162696E+04 +A346, 0.6272807038176483E-06 +A347, 0.5191779021383282E-05 +A348, 0.3593119357445702E+00 +A349, 0.1799207653066133E+01 +A350, 0.4965433218350501E+00 +A351, 0.2493689814486356E+01 +A352, 0.3167876978509202E-05 +A353, 0.2621938972337380E-04 +A354, 0.4020091204689799E-05 +A355, 0.2020138135868733E-04 +A356, 0.1164496317165047E-03 +A357, 0.4379317728681581E-14 +A358, 0.2815306148657827E-13 +A359, 0.2017681046089666E-19 +A360, 0.5751909393721803E-07 +A361, 0.1358873889006326E-06 +A362, 0.1314727117177566E+03 +A363, 0.5395161179564697E+01 +A364, 0.2307709659719508E-21 +A365, 0.1775267572985726E-11 +A366, 0.7422165779049265E-11 +A367, 0.2218929163134110E-09 +A368, 0.1054340498671864E-09 +A369, 0.2619205878191211E-15 +A370, 0.7469868230075904E-08 +A371, 0.3816951207200703E-08 +A372, 0.1123085349331923E-10 +A373, 0.5836953125458992E-09 +A374, 0.1944637616862475E-11 +A375, 0.6028679035750115E-13 +A376, 0.6052059587773872E-12 +A377, 0.2899022381688688E-13 +A378, 0.1424344115722777E-06 +A379, 0.1529499716726462E-06 +A380, 0.7840782424300661E-07 +A381, 0.9599212284338899E-06 +A382, 0.6437396350285181E-18 +A383, 0.5256615133931762E-17 +A384, 0.8990095161218764E-17 +A385, 0.7181033991617623E-18 +A386, 0.1728378611882632E-18 +A387, 0.3540550782602235E-18 +A388, 0.8376724155616681E-06 +A389, 0.2596914760226982E-07 +A390, 0.2606986170612690E-06 +A391, 0.1248783351807517E-07 +A392, 0.2286308513536836E-03 +A393, 0.9963614413695651E-03 +A394, 0.6130101802550409E-05 +A395, 0.3190045534121469E-04 +A396, 0.6631439258938231E-04 +A397, 0.3149799352817428E-03 +A398, 0.2937523564848480E-05 +A399, 0.1528658777823684E-04 +A400, 0.3246618186702964E-12 +A401, 0.1322554894724566E-10 +A402, 0.4436398435563716E-12 +A403, 0.2317714845226771E-10 +A404, 0.2208520300060596E-10 +A405, 0.4555589789244790E-11 +A406, 0.2373292562960970E-10 +A407, 0.7692421504917059E-12 +A408, 0.4479806262918383E-11 +A409, 0.5720171802143974E-12 +A410, 0.3327689327225707E-11 +A411, 0.9541544193078286E-12 +A412, 0.2707861101328804E-12 +A413, 0.2569561764962839E-12 +A414, 0.1986091916537217E-12 +A415, 0.4824250528672271E-12 +A416, 0.5250266029918284E-10 +A417, 0.1564047976340820E-10 +A418, 0.1260288663352272E-18 +A419, 0.2519713148907613E-12 +A420, 0.1530962019219430E-10 +A421, 0.4137151998760797E-11 +A422, 0.3596627115883311E-19 +A423, 0.9579749004276294E-12 +A424, 0.9537007073328073E-10 +A425, 0.1937717545388283E-10 +A426, 0.2122218808639322E-18 +A427, 0.9695357696343289E-14 +A428, 0.4529884841670604E-13 +A429, 0.1928975709350712E-12 +A430, 0.1941788585406793E-13 +A431, 0.7142398609479672E-13 +A432, 0.1714004222102950E-12 +A433, 0.6783683652805710E-11 +A434, 0.3658709432159320E-19 +A435, 0.1971222276732534E-10 +A436, 0.8183009814378561E-12 +A437, 0.4050670391121480E-13 +A438, 0.1603173793903550E-11 +A439, 0.4696812625401136E-11 +A440, 0.1551231861278248E-12 +A441, 0.8646551610229622E-20 +A442, 0.1066495174196559E-19 +A443, 0.2385305703898759E-12 +A444, 0.5746012588278302E-11 +A445, 0.4996235053152272E-13 +A446, 0.1621668990638592E-07 +A447, 0.2889948500338249E-16 +A448, 0.7514067387919777E-06 +A449, 0.1339069064310597E-14 +A450, 0.2238725993141044E-21 +A451, 0.3736516166716327E-22 +A452, 0.5318582814284088E-16 +A453, 0.7214725780084667E-17 +A454, 0.3279532730343488E-15 +A455, 0.3532460352275363E-14 +A456, 0.3863795390710753E-16 +A457, 0.9798645478821553E-15 +A458, 0.3396993564873639E-15 +A459, 0.6516158271979608E-16 +A460, 0.0000000000000000E+00 +A461, 0.0000000000000000E+00 +A462, 0.0000000000000000E+00 +A463, 0.0000000000000000E+00 +A464, 0.4418426751894913E-16 +A465, 0.1030338867990757E-22 +A466, 0.4859084236674413E-14 +A467, 0.4333540311060351E-15 +A468, 0.4040808340643157E-14 +A469, 0.4332993393882480E-14 +A470, 0.1406670268037152E-20 +A471, 0.6281407829283192E-12 +A472, 0.9440941759227247E-13 +A473, 0.3720602962379587E-20 +A474, 0.1454824871637050E-11 +A475, 0.4562999154647097E-12 +A476, 0.1343177581917852E-06 +A477, 0.4990099635144189E+02 +A478, 0.1909265860820600E+02 +A479, 0.1482511986978174E+00 +A480, 0.4967650084301614E-06 +A481, 0.2691115881143271E-06 +A482, 0.6983500284267914E-06 +A483, 0.6015457275305513E-06 +A484, 0.4722630776494077E-06 +A485, 0.5870280456511932E-01 +A486, 0.2571304277851679E-01 +A487, 0.3582908326608880E-01 +A488, 0.7794176707803806E-01 +A489, 0.3231581412497684E-05 +A490, 0.1750638614394786E-05 +A491, 0.2561887250353431E+03 +A492, 0.1240948212149431E+02 +A493, 0.1008330589944530E+03 +A494, 0.4467415038219040E+02 +A495, 0.6131232311327177E-01 +A496, 0.2381101999880997E-01 +A497, 0.3953212798226044E-14 +A498, 0.3895194731330580E-17 +A499, 0.1874834610003191E-14 +A500, 0.1344470830798795E-17 +A501, 0.4413633309404063E-18 +A502, 0.7692177504173946E-15 +A503, 0.4131473069379154E-18 +A504, 0.4746253097329321E-18 +A505, 0.1803749950210138E-16 +A506, 0.3083019242884056E-14 +A507, 0.1569654339286675E-20 +A508, 0.1222585685552472E-22 +A509, 0.7091715826016645E-12 +A510, 0.8488081943732611E-13 +A511, 0.5302640066377654E-14 +A512, 0.8821426339498730E-15 +A513, 0.2459415428568881E-11 +A514, 0.6336565259248951E-10 +A515, 0.9091150113493965E-04 +A516, 0.1729033786620256E-12 +A517, 0.1890792825838208E-15 +A518, 0.8043330812693193E-10 +A519, 0.1632135293881924E-18 +A520, 0.8220343512508614E-08 +A521, 0.3731295709018177E-15 +A522, 0.3331887887521723E-08 +A523, 0.2833150575250874E-08 +A524, 0.4277404568895585E-16 +A525, 0.1104290903236538E-02 +A526, 0.7365365116968668E-17 +A527, 0.2651679249880023E-10 +A528, 0.4669434252497910E-11 +A529, 0.5915672518692208E-16 +A530, 0.3656767040218887E-16 +A531, 0.0000000000000000E+00 +A532, 0.0000000000000000E+00 +A533, 0.0000000000000000E+00 +A534, 0.0000000000000000E+00 +A535, 0.0000000000000000E+00 +A536, 0.0000000000000000E+00 +A537, 0.7180679788842129E-10 +A538, 0.1680245913575859E-10 +A539, 0.1844715201172702E-11 +A540, 0.3981557986807217E-11 +A541, 0.2639322092348438E-12 +A542, 0.3381288717410178E-12 +A543, 0.2341525454693394E-11 +A544, 0.1391951552246406E-02 +A545, 0.8311660602083271E-04 +A546, 0.1587838646302927E-16 +A547, 0.7728076262494791E-04 +A548, 0.1428127488708507E-12 +A549, 0.3266465711737982E-08 +A550, 0.9164404727281037E-08 +A551, 0.8383489174974860E-09 +A552, 0.1158367493055928E+06 +A553, 0.5172038580721696E+04 +A554, 0.1837918783201298E-22 +A555, 0.2374888854683391E-13 +A556, 0.1230032744511442E-14 +A557, 0.2223491108386590E-21 +A558, 0.6452486080772206E-16 +A559, 0.3160291960014262E+02 +A560, 0.9180451050419979E-10 +A561, 0.8866462879922901E-11 +A562, 0.1239820109735366E-13 +A563, 0.6811152186501276E-14 +A564, 0.1381192267042841E-13 +A565, 0.1203577796609625E-12 +A566, 0.1197860866424651E-18 +A567, 0.2274348009330260E-18 +A568, 0.5307258956541251E-06 +A569, 0.4998454421161987E-12 +A570, 0.4162269494766325E-08 +A571, 0.1998597613093787E-01 +A572, 0.1043153725182578E-12 +A573, 0.5711085553254583E-12 +A574, 0.0000000000000000E+00 +A575, 0.0000000000000000E+00 +A576, 0.0000000000000000E+00 +A577, 0.3547882484102420E-13 +A578, 0.1157294366814610E-05 +A579, 0.3252185849784494E-11 +A580, 0.1232337540261104E-09 +A581, 0.1115393792809869E+00 +A582, 0.1294193771344956E-08 +A583, 0.2206636996291806E-04 +A584, 0.8828871950789313E-05 +A585, 0.1157972686065517E-04 +A586, 0.5123547623398150E-10 +A587, 0.1265519762531330E-09 +A588, 0.4616545583045402E-09 +A589, 0.7051296753371779E-07 +A590, 0.5573778982353870E-06 +A591, 0.1246701971604570E-05 +A592, 0.2284041094831776E-04 +A593, 0.1299771729382526E+05 +A594, 0.1538006354705485E-03 +A595, 0.1649253481558453E+00 +A596, 0.8279932668530401E-01 +A597, 0.2347003615788033E-08 +A598, 0.5466440579668983E+00 +A599, 0.1078653842783941E-07 +A600, 0.7705634763091332E+01 +A601, 0.6222533705150954E-10 +A602, 0.8954947251579006E-17 +A603, 0.7387008590175128E+00 +A604, 0.7011356237529493E-08 +A605, 0.3026125515005468E-02 +A606, 0.5910933108251707E-03 +A607, 0.5203455194832734E+06 +A608, 0.2727648025106068E+05 +A609, 0.4092382582857168E-11 +A610, 0.7789550063140152E+03 +A611, 0.1071577204937727E-09 +A612, 0.8231773659019195E+05 +A613, 0.1050009677140692E+07 +A614, 0.1209891516341411E-01 +A615, 0.1686682706422417E-02 +A616, 0.3438911816130324E-09 +A617, 0.2441989591255851E-12 +A618, 0.3043519580585904E+05 +A619, 0.1918223226350207E-13 +A620, 0.3446983192867918E-04 +A621, 0.3446523510088201E+03 +A622, 0.7979700393218594E+03 +A623, 0.8731865412445935E-14 +A624, 0.4370840498572373E-19 +A625, 0.2944833937001476E+00 +A626, 0.1348557750634568E-12 +A627, 0.6750368395206559E-18 +A628, 0.4548030051419025E+01 +A629, 0.1283234832171518E-10 +A630, 0.1037268883902057E-01 +A631, 0.1017322120220641E-09 +A632, 0.8223253871814289E-01 +A633, 0.2293348848446985E-09 +A634, 0.1853767791200916E+00 +A635, 0.3569576332186979E+00 +A636, 0.0000000000000000E+00 +A637, 0.1808921107117228E+01 +A638, 0.2545333606301416E+05 +A639, 0.1689086656245595E+01 +A640, 0.4293539590178599E-04 +A641, 0.2836234988752061E-08 +A642, 0.7944592305260910E-03 +A643, 0.0000000000000000E+00 +A644, 0.0000000000000000E+00 +A645, 0.1074180515007043E-05 +A646, 0.2849001957305408E-12 +A647, 0.5845193854789035E-11 +A648, 0.7293970604304297E-19 +A649, 0.1441625574594696E-05 +A650, 0.0000000000000000E+00 +A651, 0.8834526049890720E-04 +A652, 0.0000000000000000E+00 +A653, 0.0000000000000000E+00 +A654, 0.0000000000000000E+00 +A655, 0.0000000000000000E+00 +A656, 0.6605735306569498E-08 +A657, 0.1797789272970839E-08 +A658, 0.0000000000000000E+00 +A659, 0.0000000000000000E+00 +A660, 0.0000000000000000E+00 +A661, 0.2238077967626876E-01 +A662, 0.0000000000000000E+00 +A663, 0.0000000000000000E+00 +A664, 0.0000000000000000E+00 +A665, 0.0000000000000000E+00 +A666, 0.1758326258742208E-02 +A667, 0.9081473600053109E-10 +A668, 0.0000000000000000E+00 +A669, 0.0000000000000000E+00 +A670, 0.0000000000000000E+00 +A671, 0.1003751585995901E-05 +A672, 0.2149607956741996E-12 +A673, 0.9033764273963111E-05 +A674, 0.0000000000000000E+00 +A675, 0.0000000000000000E+00 +A676, 0.0000000000000000E+00 +A677, 0.2862068404927127E-17 +A678, 0.0000000000000000E+00 +A679, 0.2283562948629758E-09 +A680, 0.5005680574844495E-14 +A681, 0.8562704552872646E+05 +A682, 0.3609338297976244E+02 +A683, 0.1769340488879759E+01 +A684, 0.0000000000000000E+00 +A685, 0.0000000000000000E+00 +A686, 0.2191757337206514E-02 +A687, 0.9533032828988268E-06 +A688, 0.6657889655618817E-07 +A689, 0.2022066262368885E+01 +A690, 0.8796142282682334E-03 +A691, 0.6154596556160044E-04 +A692, 0.1043991718921468E+00 +A693, 0.4542010191384892E-04 +A694, 0.3183485601615590E-05 +A695, 0.0000000000000000E+00 +A696, 0.0000000000000000E+00 +A697, 0.0000000000000000E+00 +A698, 0.0000000000000000E+00 +A699, 0.2842723232397293E-03 +A700, 0.2612183643291028E+05 +A701, 0.0000000000000000E+00 +A702, 0.1480237397864916E+06 +A703, 0.4405419527867512E+04 +A704, 0.1014312842611429E-07 +A705, 0.0000000000000000E+00 +A706, 0.5747772774798096E-07 +A707, 0.4139196340887163E-08 +A708, 0.1856248534737026E+02 +A709, 0.0000000000000000E+00 +A710, 0.1051874169684315E+03 +A711, 0.7531406042467406E+01 +A712, 0.1489601946186687E+02 +A713, 0.3922065423092101E+02 +A714, 0.5684224063877433E-03 +A715, 0.3101139634768223E-03 +A716, 0.3967174383951592E-04 +A717, 0.4639101978565379E-13 +A718, 0.1431953016367722E-02 +A719, 0.6093619121372813E+00 +A720, 0.1449246726077255E+01 +A721, 0.6134444060618438E+00 +A722, 0.1756802082638263E-05 +A723, 0.2163731895924224E-01 +A724, 0.6329938088068282E-01 +A725, 0.4052707251357372E-01 +A726, 0.7204854928213757E-07 +A727, 0.1220376564142316E-02 +A728, 0.7773956993299871E-02 +A729, 0.3234952662958038E-02 +A730, 0.5378066184467710E-04 +A731, 0.1494499283095760E+00 +A732, 0.1592186331058342E-01 +A733, 0.1000915955079963E-04 +A734, 0.6302230986616882E-04 +A735, 0.2356329664411779E-02 +A736, 0.1026029941463008E-02 +A737, 0.1091584298789858E+02 +A738, 0.0000000000000000E+00 +A739, 0.0000000000000000E+00 +A740, 0.0000000000000000E+00 +A741, 0.0000000000000000E+00 +A742, 0.0000000000000000E+00 +A743, 0.0000000000000000E+00 +A744, 0.0000000000000000E+00 +A745, 0.0000000000000000E+00 +A746, 0.0000000000000000E+00 +A747, 0.0000000000000000E+00 +A748, 0.0000000000000000E+00 +A749, 0.0000000000000000E+00 +A750, 0.0000000000000000E+00 +A751, 0.0000000000000000E+00 +A752, 0.0000000000000000E+00 +A753, 0.0000000000000000E+00 +A754, 0.0000000000000000E+00 +A755, 0.0000000000000000E+00 +A756, 0.0000000000000000E+00 +A757, 0.0000000000000000E+00 +A758, 0.0000000000000000E+00 +A759, 0.0000000000000000E+00 +A760, 0.0000000000000000E+00 +A761, 0.0000000000000000E+00 +A762, 0.0000000000000000E+00 +A763, 0.0000000000000000E+00 +A764, 0.0000000000000000E+00 +A765, 0.0000000000000000E+00 +A766, 0.0000000000000000E+00 +A767, 0.0000000000000000E+00 +A768, 0.0000000000000000E+00 +A769, 0.0000000000000000E+00 +A770, 0.0000000000000000E+00 +A771, 0.0000000000000000E+00 +A772, 0.0000000000000000E+00 +A773, 0.0000000000000000E+00 +A774, 0.0000000000000000E+00 +A775, 0.0000000000000000E+00 +A776, 0.0000000000000000E+00 +A777, 0.0000000000000000E+00 +A778, 0.0000000000000000E+00 +A779, 0.0000000000000000E+00 +A780, 0.0000000000000000E+00 +A781, 0.0000000000000000E+00 +A782, 0.0000000000000000E+00 +A783, 0.0000000000000000E+00 +A784, 0.0000000000000000E+00 +A785, 0.0000000000000000E+00 +A786, 0.0000000000000000E+00 +A787, 0.0000000000000000E+00 +A788, 0.0000000000000000E+00 +A789, 0.0000000000000000E+00 +A790, 0.0000000000000000E+00 +A791, 0.0000000000000000E+00 +A792, 0.0000000000000000E+00 +A793, 0.0000000000000000E+00 +A794, 0.0000000000000000E+00 +A795, 0.0000000000000000E+00 +A796, 0.0000000000000000E+00 +A797, 0.0000000000000000E+00 +A798, 0.0000000000000000E+00 +A799, 0.0000000000000000E+00 +A800, 0.0000000000000000E+00 +A801, 0.0000000000000000E+00 +A802, 0.0000000000000000E+00 +A803, 0.0000000000000000E+00 +A804, 0.0000000000000000E+00 +A805, 0.0000000000000000E+00 +A806, 0.0000000000000000E+00 +A807, 0.0000000000000000E+00 +A808, 0.0000000000000000E+00 +A809, 0.0000000000000000E+00 +A810, 0.0000000000000000E+00 +A811, 0.0000000000000000E+00 +A812, 0.0000000000000000E+00 +A813, 0.0000000000000000E+00 +A814, 0.0000000000000000E+00 +A815, 0.0000000000000000E+00 +A816, 0.0000000000000000E+00 +A817, 0.0000000000000000E+00 +A818, 0.0000000000000000E+00 +A819, 0.0000000000000000E+00 +A820, 0.0000000000000000E+00 +A821, 0.0000000000000000E+00 +A822, 0.0000000000000000E+00 +A823, 0.0000000000000000E+00 +A824, 0.0000000000000000E+00 +A825, 0.0000000000000000E+00 +A826, 0.0000000000000000E+00 +A827, 0.0000000000000000E+00 +A828, 0.0000000000000000E+00 +A829, 0.0000000000000000E+00 +A830, 0.0000000000000000E+00 +A831, 0.0000000000000000E+00 +A832, 0.0000000000000000E+00 +A833, 0.0000000000000000E+00 +A834, 0.0000000000000000E+00 +A835, 0.0000000000000000E+00 +A836, 0.0000000000000000E+00 +A837, 0.0000000000000000E+00 +A838, 0.0000000000000000E+00 +A839, 0.0000000000000000E+00 +A840, 0.0000000000000000E+00 +A841, 0.0000000000000000E+00 +A842, 0.0000000000000000E+00 +A843, 0.0000000000000000E+00 +A844, 0.0000000000000000E+00 +A845, 0.0000000000000000E+00 +A846, 0.0000000000000000E+00 +A847, 0.0000000000000000E+00 +A848, 0.0000000000000000E+00 +A849, 0.0000000000000000E+00 +A850, 0.0000000000000000E+00 +A851, 0.0000000000000000E+00 +A852, 0.0000000000000000E+00 +A853, 0.0000000000000000E+00 +A854, 0.0000000000000000E+00 +A855, 0.0000000000000000E+00 +A856, 0.0000000000000000E+00 +A857, 0.0000000000000000E+00 +A858, 0.0000000000000000E+00 +A859, 0.0000000000000000E+00 +A860, 0.0000000000000000E+00 +A861, 0.0000000000000000E+00 +A862, 0.0000000000000000E+00 +A863, 0.0000000000000000E+00 +A864, 0.0000000000000000E+00 +A865, 0.0000000000000000E+00 +A866, 0.0000000000000000E+00 +A867, 0.0000000000000000E+00 +A868, 0.0000000000000000E+00 +A869, 0.0000000000000000E+00 +A870, 0.0000000000000000E+00 +A871, 0.0000000000000000E+00 +A872, 0.0000000000000000E+00 +A873, 0.0000000000000000E+00 +A874, 0.0000000000000000E+00 +A875, 0.0000000000000000E+00 +A876, 0.0000000000000000E+00 +A877, 0.0000000000000000E+00 +A878, 0.0000000000000000E+00 +A879, 0.0000000000000000E+00 +A880, 0.0000000000000000E+00 +A881, 0.0000000000000000E+00 +A882, 0.0000000000000000E+00 +A883, 0.0000000000000000E+00 +A884, 0.0000000000000000E+00 +A885, 0.0000000000000000E+00 +A886, 0.0000000000000000E+00 +A887, 0.0000000000000000E+00 +A888, 0.0000000000000000E+00 +A889, 0.0000000000000000E+00 +A890, 0.0000000000000000E+00 +A891, 0.0000000000000000E+00 +A892, 0.0000000000000000E+00 +A893, 0.0000000000000000E+00 +A894, 0.0000000000000000E+00 + From edcafd0239a03b91bbe114fedc39e7a26fae8629 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Thu, 26 Sep 2024 15:42:22 -0400 Subject: [PATCH 15/37] Updated changelog Signed-off-by: Lizzie Lundgren --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 05d62b156..cbb13a6cb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Added computation of water concentration to use in photolysis for application of UV absorption by water in Cloud-J v8 - Added ACO3, ACR, ACRO2, ALK4N{1,2,O}2, ALK4P, ALK7, APAN, APINN, APINO2, APINP, AROCMCHO, AROMCO3, AROMPN, BPINN, BPINO2, BPINON, BPINOO2, BPINOOH, BPINP, BUTN, BUTO2, C4H6, C96N, C96O2, C9602H, EBZ, GCO3, HACTA, LIMAL, LIMKB, LIMKET, LIMKO2, LIMN, LIMNB, LIMO2H, LIMO3, LIMO3H, LIMPAN, MEKCO3, MEKPN, MYRCO, PHAN, PIN, PINAL, PINO3, PINONIC, PINPAN, R7N{1,2}, R7O2, R7P, RNO3, STYR, TLFUO2, TLFUONE, TMB, ZRO2 to `species_database.yml` following Travis et al. 2024. - Added TSOIL1 field to `State_Met` for use in HEMCO soil NOx extension. This should only be read in when the `UseSoilTemperature` option is true in HEMCO config. +- Added KPP standalone ### Changed - Copy values from `State_Chm%KPP_AbsTol` to `ATOL` and `State_Chm%KPP_RelTol` to `RTOL` for fullchem and Hg simulations From 5cfc36d5bffbd10c1a1c7eb30b9171dcd5a7f20b Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 27 Sep 2024 18:21:22 -0400 Subject: [PATCH 16/37] Fixed incorrect YAML tag in kpp_standalone_interface.yml run/shared/kpp_standalone_interface.yml - Fixed typo: "output_dir" -> "output_directory" Signed-off-by: Bob Yantosca --- run/shared/kpp_standalone_interface.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/run/shared/kpp_standalone_interface.yml b/run/shared/kpp_standalone_interface.yml index fe1ab83d8..a54d3c842 100644 --- a/run/shared/kpp_standalone_interface.yml +++ b/run/shared/kpp_standalone_interface.yml @@ -16,8 +16,8 @@ active_cells: - PacificOcean - ElDjouf settings: - output_dir: "./OutputDir/" # this directory should already exist - levels: + output_directory: "./OutputDir/" # this directory should already exist + levels: - 1 - 2 - 10 From acbc3a058dcb6d7281e42dbf6a26c4bb877a3208 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 27 Sep 2024 18:28:21 -0400 Subject: [PATCH 17/37] Fixed parallelization error in KPP standalone interface GeosCore/fullchem_mod.f90 - Use keyword arguments, for clarity GeosCore/kpp_standalone_interface.F90 - Remove Active_Cell and Active_Cell_Name from KPP_Standalone_YAML - Add new derived type KPP_Standalone_ActiveCell_Type, which is now declared with !$OMP THREADPRIVATE. This contains the Active_Cell and Active_Cell_Name fields. - Added new variable KPP_Standalone_ActiveCell, based on new KPP_Standalone_ActiveCell_Type NOTE: The KPP_Standalone_YAML is initialized outside of a parallel loop, so it does not need to be declared !$OMP THREADPRIVATE. But the choice of whether an (I,J,L) location corresponds to one of the "active_cells" (listed in the kpp_standalone_interface.yml file) happens within a parallelized loop. Thus we need to move the Active_Cell and Active_Cell_Name fields out of KPP_Standalone_YAML and into KPP_Standalone_ActiveCell. Signed-off-by: Bob Yantosca --- GeosCore/fullchem_mod.F90 | 19 +++-- GeosCore/kpp_standalone_interface.F90 | 107 ++++++++++++++++---------- 2 files changed, 79 insertions(+), 47 deletions(-) diff --git a/GeosCore/fullchem_mod.F90 b/GeosCore/fullchem_mod.F90 index f369e5192..e28fe669a 100644 --- a/GeosCore/fullchem_mod.F90 +++ b/GeosCore/fullchem_mod.F90 @@ -1286,11 +1286,20 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! Write chemical state to file for the kpp standalone interface ! No external logic needed, this subroutine exits early if the ! chemical state should not be printed (psturm, 03/23/24) - CALL Write_Samples( I, J, L, C_before_integrate, & - local_RCONST, KPPH_before_integrate, & - RSTATE(Nhexit), & - State_Grid, State_Chm, State_Met, & - Input_Opt, ISTATUS(3), RC ) + CALL Write_Samples( & + I = I, & + J = J, & + L = L, & + initC = C_before_integrate, & + localRCONST = local_RCONST, & + initHvalue = KPPH_before_integrate, & + exitHvalue = RSTATE(Nhexit), & + State_Grid = State_Grid, & + State_Chm = State_Chm, & + State_Met = State_Met, & + Input_Opt = Input_Opt, & + KPP_TotSteps = ISTATUS(3), & + RC = RC ) ! test the force write option on the root node ! example use case: printing chemical state under conditions diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 index ba4035cb7..3422f1ae7 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kpp_standalone_interface.F90 @@ -26,8 +26,10 @@ MODULE KPP_Standalone_Interface PUBLIC :: Config_KPP_Standalone PUBLIC :: Write_Samples PUBLIC :: Cleanup_KPP_Standalone - - TYPE :: KPP_Standalone_Interface_Type +! +! !DERIVED TYPES: +! + TYPE, PRIVATE :: KPP_Standalone_Interface_Type ! Scalars INTEGER :: NLOC LOGICAL :: Active_Cell @@ -45,15 +47,25 @@ MODULE KPP_Standalone_Interface INTEGER, DIMENSION(:), ALLOCATABLE :: JDX INTEGER, DIMENSION(:), ALLOCATABLE :: Levels END TYPE KPP_Standalone_Interface_Type + + TYPE, PRIVATE :: KPP_Standalone_ActiveCell_Type + ! Scalars + LOGICAL :: Active_Cell + CHARACTER(LEN=255) :: Active_Cell_Name + END TYPE KPP_Standalone_ActiveCell_Type ! - -TYPE(KPP_Standalone_Interface_Type) :: KPP_Standalone_YAML +! !PRIVATE DATA MEMBERS: +! + TYPE(KPP_Standalone_Interface_Type), PRIVATE :: KPP_Standalone_YAML + TYPE(KPP_Standalone_ActiveCell_Type), PRIVATE :: KPP_Standalone_ActiveCell + !$OMP THREADPRIVATE( KPP_Standalone_ActiveCell ) + ! !REVISION HISTORY: -CONTAINS !EOP !------------------------------------------------------------------------------ !BOC -! +CONTAINS +!EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! !------------------------------------------------------------------------------ @@ -118,24 +130,24 @@ SUBROUTINE Check_ActiveCell( I, J, L, State_Grid ) ! !LOCAL VARIABLES INTEGER :: K - KPP_Standalone_YAML%Active_Cell = .FALSE. - KPP_Standalone_YAML%Active_Cell_Name = '' - ! Early exit if there was no YAML file or no active cells - IF ( KPP_Standalone_YAML%SkipIt ) THEN - RETURN - END IF + IF ( KPP_Standalone_YAML%SkipIt ) RETURN + KPP_Standalone_ActiveCell%Active_Cell = .FALSE. + KPP_Standalone_ActiveCell%Active_Cell_Name = '' + IF ( ANY(L == KPP_Standalone_YAML%Levels) ) THEN - DO K = 1,KPP_Standalone_YAML%NLOC - IF ( KPP_Standalone_YAML%IDX(K) == I .AND. KPP_Standalone_YAML%JDX(K) == J ) THEN - KPP_Standalone_YAML%Active_Cell = .TRUE. - KPP_Standalone_YAML%Active_Cell_Name = KPP_Standalone_YAML%LocationName(K) - !write(*,*) trim(KPP_Standalone_YAML%Active_Cell_Name), " LatLon: " , State_Grid%YMid(I,J), State_Grid%XMid(I,J) - ENDIF - ENDDO + DO K = 1,KPP_Standalone_YAML%NLOC + IF ( KPP_Standalone_YAML%IDX(K) == I .AND. & + KPP_Standalone_YAML%JDX(K) == J ) THEN + KPP_Standalone_ActiveCell%Active_Cell = .TRUE. + KPP_Standalone_ActiveCell%Active_Cell_Name = & + KPP_Standalone_YAML%LocationName(K) + !write(*,*) trim(KPP_Standalone_YAML%Active_Cell_Name), " LatLon: " , State_Grid%YMid(I,J), State_Grid%XMid(I,J) + ENDIF + ENDDO ENDIF - END SUBROUTINE Check_ActiveCell + END SUBROUTINE Check_ActiveCell !EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! @@ -244,8 +256,9 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) IF ( RC /= GC_SUCCESS ) RETURN DO I = 1,KPP_Standalone_YAML%NLOC KPP_Standalone_YAML%LocationName(I) = TRIM( a_str(I) ) + print*, trim(KPP_Standalone_YAML%LocationName(I)) END DO - + !======================================================================== ! Read latitude and longitude of active cells !======================================================================== @@ -340,6 +353,7 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) IU_FILE = findFreeLUN() open(IU_FILE,FILE=trim(v_str)//'/.test_directory_existence', & action = "WRITE",iostat=path_exists,access='SEQUENTIAL') + ! If the specified folder doesn't exist, try OutputDir IF ( path_exists /= 0 ) THEN open(IU_FILE,FILE='./OutputDir/.test_directory_existence', & @@ -433,31 +447,28 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, exitHvalue, ! Strings CHARACTER(LEN=255) :: YYYYMMDD_hhmmz CHARACTER(LEN=255) :: level_string - CHARACTER(LEN=512) :: errMsg + CHARACTER(LEN=512) :: errMsg, filename ! Arrays REAL(dp) :: Vloc(NVAR), Aout(NREACT) ! For KPP reaction rate diagnostics - ! Did a user want to write the chemical state even if not in an active cell? - IF ( PRESENT(FORCE_WRITE) ) THEN - FORCE_WRITE_AUX = FORCE_WRITE - ELSE - FORCE_WRITE_AUX = .FALSE. - END IF + ! Did a user want to write the chemical state even if + ! not in an active cell? + FORCE_WRITE_AUX = .FALSE. + IF ( PRESENT( FORCE_WRITE ) ) FORCE_WRITE_AUX = FORCE_WRITE ! Quit early if there's no writing to be done - IF ( (.not. KPP_Standalone_YAML%Active_Cell) .AND. (.not. FORCE_WRITE_AUX) ) THEN + IF ( .not. KPP_Standalone_ActiveCell%Active_Cell .AND. & + .not. FORCE_WRITE_AUX ) THEN RETURN END IF ! Did the call include an optional cell name? - IF ( PRESENT(CELL_NAME) ) THEN - CELL_NAME_AUX = CELL_NAME - ELSE - CELL_NAME_AUX = '' - END IF + CELL_NAME_AUX = '' + IF ( PRESENT( CELL_NAME ) ) CELL_NAME_AUX = CELL_NAME + ! Get KPP state CALL Fun( V = initC(1:NVAR), & F = initC(NVAR+1:NSPEC), & RCT = localRCONST, & @@ -469,21 +480,33 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, exitHvalue, !======================================================================== ! Write the file !======================================================================== + ! Find a free file LUN IU_FILE = findFreeLUN() write(level_string,'(I0)') L write(YYYYMMDD_hhmmz,'(I0.4,I0.2,I0.2,a,I0.2,I0.2)' ) & Get_Year(), Get_Month(), Get_Day(),'_', Get_Hour(), Get_Minute() - open(IU_FILE,FILE=trim(KPP_Standalone_YAML%Output_Directory)//'/' & - //trim(CELL_NAME_AUX)//trim(KPP_Standalone_YAML%ACTIVE_CELL_NAME) & - //'_L'//trim(level_string)//'_' //trim(YYYYMMDD_hhmmz)//'.txt', & - action = "WRITE",iostat=RC,access='SEQUENTIAL') - IF ( RC /= 0 ) THEN - IF ( Input_Opt%amIRoot ) & - errMsg = 'Error writing chemical state to KPP Standalone file' + + ! Filename for output + filename = TRIM( KPP_Standalone_YAML%Output_Directory ) // & + '/' // & + TRIM( Cell_Name_Aux ) // & + TRIM( KPP_Standalone_ActiveCell%Active_Cell_Name ) // & + '_L' // & + trim( level_string ) // & + '_' // & + TRIM( YYYYMMDD_hhmmz ) // & + '.txt' + + ! Open the file + open( IU_FILE, FILE=TRIM(filename), ACTION="WRITE", & + IOSTAT=RC, ACCESS='SEQUENTIAL') + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error writing chemical state to KPP Standalone file' CALL GC_Error( errMsg, RC, '' ) RETURN - END IF + ENDIF + ! Write header to file write(IU_FILE, '(a)') '48 ' write(IU_FILE, '(a)') '===========================================================================' From a12c2996364190e48bb7f3be7894c7ba8e6015da Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 3 Oct 2024 13:21:36 -0400 Subject: [PATCH 18/37] Add settings:activate switch in kpp_standalone_interface.yml run/shared/kpp_standalone_interface.yml - Reorganize file so that "settings:" comes first, then "active_cells:", and then "locations:" - Add "settings:activate" YAML tag to toggle the KPP standalone interface on or off GeosCore/kpp_standalone_interface.F90 - Add call to QFYAML_Add_Get to parse the "settings:activate" YAML tag - Set KPP_Standalone_YAML%SkipIt to .TRUE. if "settings:activate" is false. This will cause the code to ignore saving out the state of the model for the KPP standalone even if kpp_standalone_interface.yml is present in the run directory. Signed-off-by: Bob Yantosca --- GeosCore/kpp_standalone_interface.F90 | 31 +++++++++++++++++------ run/shared/kpp_standalone_interface.yml | 33 ++++++++++++++++--------- 2 files changed, 45 insertions(+), 19 deletions(-) diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 index 3422f1ae7..8fb6e9dc0 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kpp_standalone_interface.F90 @@ -180,19 +180,20 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) ! !LOCAL VARIABLES: ! ! Scalars - INTEGER :: I, N - INTEGER :: IU_FILE ! Available unit for writing - INTEGER :: path_exists - LOGICAL :: file_exists + INTEGER :: I, N + INTEGER :: IU_FILE ! Available unit for writing + INTEGER :: path_exists + LOGICAL :: file_exists + LOGICAL :: v_bool ! Strings - CHARACTER(LEN=255) :: thisLoc - CHARACTER(LEN=512) :: errMsg + CHARACTER(LEN=255) :: thisLoc + CHARACTER(LEN=512) :: errMsg CHARACTER(LEN=QFYAML_NamLen) :: key CHARACTER(LEN=QFYAML_StrLen) :: v_str ! Objects - TYPE(QFYAML_t) :: Config, ConfigAnchored + TYPE(QFYAML_t) :: Config, ConfigAnchored ! Arrays INTEGER :: a_int(QFYAML_MaxArr) @@ -201,7 +202,8 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) CHARACTER(LEN=QFYAML_NamLen) :: a_str(QFYAML_MaxArr) ! YAML configuration file name to be read - CHARACTER(LEN=30), PARAMETER :: configFile = './kpp_standalone_interface.yml' + CHARACTER(LEN=30), PARAMETER :: configFile = & + './kpp_standalone_interface.yml' ! Inquire if YAML interface exists -- if not, skip initializing KPP_Standalone_YAML%SkipIt = .FALSE. @@ -228,6 +230,19 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) RETURN ENDIF + !======================================================================== + ! Read the main on/off switch; Exit if the switch is turned off + !======================================================================== + key = "settings%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 + KPP_Standalone_YAML%SkipIt = ( .not. v_bool ) + !======================================================================== ! Read the list of active cells !======================================================================== diff --git a/run/shared/kpp_standalone_interface.yml b/run/shared/kpp_standalone_interface.yml index a54d3c842..b468240dd 100644 --- a/run/shared/kpp_standalone_interface.yml +++ b/run/shared/kpp_standalone_interface.yml @@ -1,3 +1,24 @@ +--- +# ============================================================================ +# Configuration file for KPP standalone interface +# +# This file specifies at which locations we will archive the model +# state so that we can initialize KPP standalone box model simulations. +# ============================================================================ + +settings: + activate: false # Master on-off switch + output_directory: "./OutputDir/" # this directory should already exist + levels: # Model levels to archive + - 1 + - 2 + - 10 + - 23 + - 35 + - 48 + - 56 + timestep: 15 # defult to heartbeat timestep + active_cells: - LosAngeles - McMurdo @@ -15,17 +36,7 @@ active_cells: - AtlanticOcean - PacificOcean - ElDjouf -settings: - output_directory: "./OutputDir/" # this directory should already exist - levels: - - 1 - - 2 - - 10 - - 23 - - 35 - - 48 - - 56 - timestep: 15 # default to heartbeat / operator splitting timestep + locations: LosAngeles: longitude: -118.243 From 711e09d3fa951fdef4b2fe997911e419816b286c Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 4 Oct 2024 12:25:42 -0400 Subject: [PATCH 19/37] Update run directory scripts for the KPP standalone interface run/GCClassic/createRunDir.sh - Copy run/shared/kpp_standalone_interface.yml to fullchem rundirs run/shared/cleanRunDir.sh - Skip removing bpch files (and {diag,tracer}info.dat files), we no longer generate bpch output - Add comments and usage examples - Remove all fort.* files - Remove OututDir/*.txt files as well (these are KPP standalone interface files) CHANGELOG.md - Updated accordingly Signed-off-by: Bob Yantosca --- CHANGELOG.md | 1 + run/GCClassic/createRunDir.sh | 7 +++++++ run/shared/cleanRunDir.sh | 37 ++++++++++++++++++++++++++--------- 3 files changed, 36 insertions(+), 9 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fa603693c..020c8f057 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -33,6 +33,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Read aerosol optical properties files from new data directory specified in geoschem_config.yml rather than directory containing photolysis input files - Call `RD_AOD` and `CALC_AOD` from `Init_Aerosol` rather than `Init_Photolysis` - Moved PINO3H to be in alphabetical order in `species_database.yml` +- Modified `run/GCClassic/cleanRunDir.sh` to skip removing bpch files, as well as now removing `fort.*` and `OutputDir/*.txt` files ### Fixed - Simplified SOA representations and fixed related AOD and TotalOA/OC calculations in benchmark. diff --git a/run/GCClassic/createRunDir.sh b/run/GCClassic/createRunDir.sh index 39d34e84b..638eb8825 100755 --- a/run/GCClassic/createRunDir.sh +++ b/run/GCClassic/createRunDir.sh @@ -876,11 +876,18 @@ if [[ ${met} = "ModelE2.1" ]] || [[ ${met} = "ModelE2.2" ]]; then cp ${gcdir}/run/shared/download_data.gcap2.40L.yml ${rundir}/download_data.yml fi +# Copy the OH metrics Python script to the rundir (fullchem/CH4 only) if [[ "x${sim_name}" == "xfullchem" || "x${sim_name}" == "xCH4" ]]; then cp -r ${gcdir}/run/shared/metrics.py ${rundir} chmod 744 ${rundir}/metrics.py fi +# Copy the KPP standalone interface config file to ther rundir (fullchem only) +if [[ "x${sim_name}" == "xfullchem" ]]; then + cp -r ${gcdir}/run/shared/kpp_standalone_interface.yml ${rundir} + chmod 644 ${rundir}/kpp_standalone_interface.yml +fi + # Set permissions chmod 744 ${rundir}/cleanRunDir.sh chmod 744 ${rundir}/archiveRun.sh diff --git a/run/shared/cleanRunDir.sh b/run/shared/cleanRunDir.sh index 2c2ca77e0..e0b216848 100755 --- a/run/shared/cleanRunDir.sh +++ b/run/shared/cleanRunDir.sh @@ -1,8 +1,20 @@ #!/bin/bash -rm -fv trac_avg.* -rm -fv tracerinfo.dat -rm -fv diaginfo.dat +#============================================================================ +# cleanRunDir.sh: Removes files created by GEOS-Chem from a run directory +# +# Usage: +# ------ +# $ ./cleanRunDir.sh # Removes model output files in the run directory. +# # Also prompts the user before removing diagnostic +# # output files in OutputDir/. +# +# $ ./cleanRunDir.sh 1 # Removes model ouptut files in the run directory, +# # but will remove diagnostic output files without +# # prompting first. USE WITH CAUTION! +#============================================================================ + +# Clean model output files in the run directory rm -fv gcchem* rm -fv *.rcx rm -fv *~ @@ -22,14 +34,21 @@ rm -fv EGRESS rm -fv core.* rm -fv PET*.ESMF_LogFile rm -fv allPEs.log +rm -fv fort.* -# Clean data too. If an argument is passed, then prompt user to confirm -# perhaps asking if they want to archive before deletion. -if [[ "x${1}" == "x" ]]; then - rm -Iv ./OutputDir/*.nc* # Get confirmation from user -else - rm -fv ./OutputDir/*.nc* # Skip confirmation from user +#---------------------------------------------------------------------------- +# Clean data files in OutputDir. +# These are netCDF files (*.nc) and KPP standalone interface files (*.txt). +#---------------------------------------------------------------------------- +if [[ "x${1}" == "x" ]]; then # User confirmation required + rm -Iv ./OutputDir/*.nc* + rm -Iv ./OutputDir/*.txt +else # User Confirmation not required + rm -fv ./OutputDir/*.nc* + rm -fv ./OutputDir/*.txt* fi +#--------------------------------------------------------------------------- # Give instruction to reset start date if using GCHP +#--------------------------------------------------------------------------- echo "Reset simulation start date in cap_restart if using GCHP" From 73bd391d5262612b0cb965b1fea4859a1df3a4ce Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 4 Oct 2024 12:35:33 -0400 Subject: [PATCH 20/37] Fix parallel issues in KPP standalone interface; Add structural updates .gitignore - Also ignore *.exe files GeosCore/fullchem_mod.F90 - Remove State_Grid from call to Check_ActiveCell GeosCore/kpp_standalone_interface.F90 - Updated subroutine header comments - Added cosmetic changes for clarity (mostly making code fit within 80 characters, for better readability) - Removed Active_Cell and Active_Cell_name from the KPP_Standalone_Interface_Type (should have been done previously) - Remove State_Grid argument from Check_ActiveCell, this was only used for debugging. Also removed commented out debug prints. - Use Format statements with write statments where expedient - Echo a message when the KPP standalone interface is manually disabled (i.e. when settings:activate = false) - Added display of location names and lon/lats at end of the routine Config_KPP_Standalone - In routine Write_Samples, wrap file I/O in an !$OMP CRITICAL block, in order to prevent more than one thread from writing to each file. - Removed RETURN statement from within !$OMP CRITICAL block, this is not allowed. - Bug fix: Write Kpp_Standalone_ActiveCell%Active_Cell_Name to file, and not Kpp_Standalone_YAML%Active_Cell_Name (which has been removed). Signed-off-by: Bob Yantosca --- .gitignore | 3 +- GeosCore/fullchem_mod.F90 | 5 +- GeosCore/kpp_standalone_interface.F90 | 589 ++++++++++++++++---------- 3 files changed, 377 insertions(+), 220 deletions(-) diff --git a/.gitignore b/.gitignore index 9cd76c482..a8d8153ad 100644 --- a/.gitignore +++ b/.gitignore @@ -24,4 +24,5 @@ build/ build_*/ *___.h *___.rc -core.* \ No newline at end of file +core.* +*.exe \ No newline at end of file diff --git a/GeosCore/fullchem_mod.F90 b/GeosCore/fullchem_mod.F90 index e28fe669a..3d67554e3 100644 --- a/GeosCore/fullchem_mod.F90 +++ b/GeosCore/fullchem_mod.F90 @@ -583,9 +583,8 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! Check if the current grid cell in this loop should have its ! full chemical state printed (concentrations, rates, constants) - ! for use with the KPP Standalone - ! (psturm, 03/22/24) - CALL Check_ActiveCell( I, J, L, State_Grid ) + ! for use with the KPP Standalone (psturm, 03/22/24) + CALL Check_ActiveCell( I, J, L ) ! Start measuring KPP-related routine timing for this grid box IF ( State_Diag%Archive_KppTime ) THEN diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kpp_standalone_interface.F90 index 8fb6e9dc0..4d2fe9dc1 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kpp_standalone_interface.F90 @@ -5,7 +5,8 @@ ! ! !MODULE: kpp_standalone_interface.F90 ! -! !DESCRIPTION: Contains routines to print the full chemical state in fullchem, which can be used as input to the KPP Standalone. +! !DESCRIPTION: Contains routines to print the full chemical state +! which can be used as input to the KPP Standalone. !\\ !\\ ! !INTERFACE: @@ -14,8 +15,9 @@ MODULE KPP_Standalone_Interface ! ! !USES: ! - USE PRECISION_MOD ! For GEOS-Chem Precision (fp) - USE HCO_ERROR_MOD ! For real precisions (hp) + USE Precision_Mod + USE HCO_Error_Mod, ONLY : hp + IMPLICIT NONE PRIVATE ! @@ -29,29 +31,23 @@ MODULE KPP_Standalone_Interface ! ! !DERIVED TYPES: ! + ! Type to hold information read from the YAML config file TYPE, PRIVATE :: KPP_Standalone_Interface_Type - ! Scalars - INTEGER :: NLOC - LOGICAL :: Active_Cell - LOGICAL :: SkipIt - - ! Strings - CHARACTER(LEN=255) :: Active_Cell_Name - CHARACTER(LEN=255) :: Output_Directory - - ! Allocatable arrays - CHARACTER(LEN=255), DIMENSION(:), ALLOCATABLE :: LocationName - REAL(hp), DIMENSION(:), ALLOCATABLE :: LocationLons - REAL(hp), DIMENSION(:), ALLOCATABLE :: LocationLats - INTEGER, DIMENSION(:), ALLOCATABLE :: IDX - INTEGER, DIMENSION(:), ALLOCATABLE :: JDX - INTEGER, DIMENSION(:), ALLOCATABLE :: Levels + INTEGER :: NLOC + LOGICAL :: SkipIt + CHARACTER(LEN=255) :: Output_Directory + CHARACTER(LEN=255), ALLOCATABLE :: LocationName(:) + REAL(hp), ALLOCATABLE :: LocationLons(:) + REAL(hp), ALLOCATABLE :: LocationLats(:) + INTEGER, ALLOCATABLE :: IDX(:) + INTEGER, ALLOCATABLE :: JDX(:) + INTEGER, ALLOCATABLE :: Levels(:) END TYPE KPP_Standalone_Interface_Type + ! Type to denote active cells TYPE, PRIVATE :: KPP_Standalone_ActiveCell_Type - ! Scalars - LOGICAL :: Active_Cell - CHARACTER(LEN=255) :: Active_Cell_Name + LOGICAL :: Active_Cell + CHARACTER(LEN=255) :: Active_Cell_Name END TYPE KPP_Standalone_ActiveCell_Type ! ! !PRIVATE DATA MEMBERS: @@ -59,8 +55,13 @@ MODULE KPP_Standalone_Interface TYPE(KPP_Standalone_Interface_Type), PRIVATE :: KPP_Standalone_YAML TYPE(KPP_Standalone_ActiveCell_Type), PRIVATE :: KPP_Standalone_ActiveCell !$OMP THREADPRIVATE( KPP_Standalone_ActiveCell ) - +! +! !AUTHORS: +! P. Obin Sturm (psturm@usc.edu) +! ! !REVISION HISTORY: +! 11 Mar 2024 - P. Obin Sturm - Initial version +! See https://github.com/geoschem/geos-chem for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -76,25 +77,29 @@ MODULE KPP_Standalone_Interface ! !DESCRIPTION: Subroutine Check_Domain is used to identify if a ! specified latitude and longitude falls within a grid cell on the ! current CPU. Multiple lat/lon pairs can be checked simultaneously. -! Obin Sturm (psturm@usc.edu) 2023/12/29 !\\ !\\ ! !INTERFACE: ! SUBROUTINE Check_Domain( RC ) - +! ! !USES: - USE HCO_GeoTools_Mod, ONLY: HCO_GetHorzIJIndex - USE HCO_State_GC_Mod, ONLY : HcoState - USE HCO_ERROR_MOD ! For real precisions (hp) +! + USE HCO_GeoTools_Mod, ONLY : HCO_GetHorzIJIndex + USE HCO_State_GC_Mod, ONLY : HcoState +! ! !OUTPUT PARAMETERS - integer, intent(out) :: RC - - +! + INTEGER, INTENT(out) :: RC +! +! !REVISION HISTORY: +! 11 Mar 2024 - P. Obin Sturm - Initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC ! Early exit if no locations - IF ( KPP_Standalone_YAML%SkipIt ) THEN - RETURN - END IF + IF ( KPP_Standalone_YAML%SkipIt ) RETURN CALL HCO_GetHorzIJIndex( HcoState, & KPP_Standalone_YAML%NLOC, & @@ -103,6 +108,7 @@ SUBROUTINE Check_Domain( RC ) KPP_Standalone_YAML%IDX, & KPP_Standalone_YAML%JDX, & RC) + END SUBROUTINE Check_Domain !EOC !------------------------------------------------------------------------------ @@ -115,38 +121,45 @@ END SUBROUTINE Check_Domain ! !DESCRIPTION: Subroutine Check_ActiveCell is used to identify if a grid cell ! is within a specified latitude and longitude to print the full chemical state ! (all concentrations, reaction rates, rate constants, and meteo metadata). -! Obin Sturm (psturm@usc.edu) 2024/03/11 !\\ !\\ ! !INTERFACE: ! - SUBROUTINE Check_ActiveCell( I, J, L, State_Grid ) - -! !USES: - USE State_Grid_Mod, ONLY : GrdState + SUBROUTINE Check_ActiveCell( I, J, L ) +! ! !INPUT PARAMETERS: - INTEGER, INTENT(IN) :: I,J,L ! Grid Indices - TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object +! + INTEGER, INTENT(IN) :: I, J, L ! Grid Indices +! +! !REVISION HISTORY: +! 11 Mar 2024 - P. Obin Sturm - Initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! ! !LOCAL VARIABLES - INTEGER :: K +! + INTEGER :: K ! Early exit if there was no YAML file or no active cells IF ( KPP_Standalone_YAML%SkipIt ) RETURN - KPP_Standalone_ActiveCell%Active_Cell = .FALSE. + ! Initialize + KPP_Standalone_ActiveCell%Active_Cell = .FALSE. KPP_Standalone_ActiveCell%Active_Cell_Name = '' - - IF ( ANY(L == KPP_Standalone_YAML%Levels) ) THEN - DO K = 1,KPP_Standalone_YAML%NLOC - IF ( KPP_Standalone_YAML%IDX(K) == I .AND. & + + IF ( ANY( L == KPP_Standalone_YAML%Levels ) ) THEN + DO K = 1, KPP_Standalone_YAML%NLOC + IF ( KPP_Standalone_YAML%IDX(K) == I .AND. & KPP_Standalone_YAML%JDX(K) == J ) THEN KPP_Standalone_ActiveCell%Active_Cell = .TRUE. - KPP_Standalone_ActiveCell%Active_Cell_Name = & + KPP_Standalone_ActiveCell%Active_Cell_Name = & KPP_Standalone_YAML%LocationName(K) - !write(*,*) trim(KPP_Standalone_YAML%Active_Cell_Name), " LatLon: " , State_Grid%YMid(I,J), State_Grid%XMid(I,J) ENDIF ENDDO ENDIF + END SUBROUTINE Check_ActiveCell !EOC !------------------------------------------------------------------------------ @@ -156,14 +169,13 @@ END SUBROUTINE Check_ActiveCell ! ! !IROUTINE: Config_KPP_Standalone ! -! !DESCRIPTION: Subroutine Config_KPP_Standalone reads a set of gridcells to be sampled -! and the full chemical state printed. -! Obin Sturm (psturm@usc.edu) 2024/03/11 +! !DESCRIPTION: Subroutine Config_KPP_Standalone reads a set of gridcells +! to be sampled and the full chemical state printed. !\\ !\\ ! !INTERFACE: ! - SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) + SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) USE QfYaml_Mod USE ErrCode_Mod USE Input_Opt_Mod, ONLY : OptInput @@ -175,7 +187,14 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) ! ! !OUTPUT PARAMETERS: ! - INTEGER, INTENT(OUT) :: RC ! Success or failure + INTEGER, INTENT(OUT) :: RC ! Success or failure +! +! !REVISION HISTORY: +! 11 Mar 2024 - P. Obin Sturm - Initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC ! ! !LOCAL VARIABLES: ! @@ -185,7 +204,7 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) INTEGER :: path_exists LOGICAL :: file_exists LOGICAL :: v_bool - + ! Strings CHARACTER(LEN=255) :: thisLoc CHARACTER(LEN=512) :: errMsg @@ -200,26 +219,29 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) ! String arrays CHARACTER(LEN=QFYAML_NamLen) :: a_str(QFYAML_MaxArr) - + ! YAML configuration file name to be read CHARACTER(LEN=30), PARAMETER :: configFile = & './kpp_standalone_interface.yml' - - ! Inquire if YAML interface exists -- if not, skip initializing + + ! Inquire if YAML interface exists -- if not, skip initializing KPP_Standalone_YAML%SkipIt = .FALSE. - INQUIRE( FILE=configFile, EXIST=file_exists ) + INQUIRE( FILE=configFile, EXIST=file_exists ) IF ( .NOT. file_exists ) THEN KPP_Standalone_YAML%SkipIt = .TRUE. - IF ( Input_Opt%amIRoot ) & - write(*,*) "Config file ", configFile, " not found, skipping KPP Standalone interface" - RETURN - END IF - + IF ( Input_Opt%amIRoot ) THEN + WRITE( 6, 100 ) TRIM( configFile ) + 100 FORMAT( "Config file ", a ", not found, ", & + "skipping KPP standalone interface" ) + RETURN + ENDIF + ENDIF + ! Assume success RC = GC_SUCCESS errMsg = '' - thisLoc = ' -> at Config_KPP_Standalone (in module GeosCore/kpp_standalone_interface.F90)' - + thisLoc = ' -> at Config_KPP_Standalone (in module GeosCore/kpp_standalone_interface.F90)' + !======================================================================== ! Read the YAML file into the Config object !======================================================================== @@ -242,6 +264,11 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) RETURN ENDIF KPP_Standalone_YAML%SkipIt = ( .not. v_bool ) + IF ( KPP_Standalone_YAML%SkipIt ) THEN + WRITE( 6, 110 ) + 110 FORMAT( "KPP standalone interface was manually disabled" ) + RETURN + ENDIF !======================================================================== ! Read the list of active cells @@ -262,16 +289,18 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) IF ( KPP_Standalone_YAML%NLOC .eq. 0 ) THEN ! Set SkipIt flag to short circuit other subroutines KPP_Standalone_YAML%SkipIt = .TRUE. - IF ( Input_Opt%amIRoot ) & - write(*,*) "No active cells for box modeling in kpp_standalone_interface.yml" - RETURN - END IF + IF ( Input_Opt%amIRoot ) THEN + WRITE( 6, 120 ) + 120 FORMAT( "No active cells for box modeling ", & + "in kpp_standalone_interface.yml") + RETURN + ENDIF + ENDIF ALLOCATE( KPP_Standalone_YAML%LocationName( KPP_Standalone_YAML%NLOC ), STAT=RC ) CALL GC_CheckVar( 'KPP_Standalone_YAML%LocationName', 0, RC ) IF ( RC /= GC_SUCCESS ) RETURN DO I = 1,KPP_Standalone_YAML%NLOC KPP_Standalone_YAML%LocationName(I) = TRIM( a_str(I) ) - print*, trim(KPP_Standalone_YAML%LocationName(I)) END DO !======================================================================== @@ -282,11 +311,11 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) ALLOCATE( KPP_Standalone_YAML%LocationLons( KPP_Standalone_YAML%NLOC ), STAT=RC ) CALL GC_CheckVar( 'KPP_Standalone_YAML%LocationLons', 0, RC ) IF ( RC /= GC_SUCCESS ) RETURN - + ALLOCATE( KPP_Standalone_YAML%LocationLats( KPP_Standalone_YAML%NLOC ), STAT=RC ) CALL GC_CheckVar( 'KPP_Standalone_YAML%LocationLats', 0, RC ) IF ( RC /= GC_SUCCESS ) RETURN - + ! Read coordinates DO I = 1,KPP_Standalone_YAML%NLOC ! Read longitudes @@ -308,9 +337,9 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF - KPP_Standalone_YAML%LocationLats( I ) = Cast_and_RoundOff( TRIM( v_str ), places=-1 ) + KPP_Standalone_YAML%LocationLats( I ) = Cast_and_RoundOff( TRIM( v_str ), places=-1 ) END DO - + ! Allocate IDX and JDX (masks for whether a location is on the CPU) ALLOCATE( KPP_Standalone_YAML%IDX( KPP_Standalone_YAML%NLOC ), STAT=RC ) CALL GC_CheckVar( 'KPP_Standalone_YAML%IDX', 0, RC ) @@ -326,7 +355,7 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) !======================================================================== ! Get the list of levels and number of levels !======================================================================== - ! Note: could add capability for location specific levels + ! TODO: could add capability for location specific levels key = "settings%levels" a_int = MISSING_INT CALL QFYAML_Add_Get( Config, key, a_int, "", RC, dynamic_size=.TRUE. ) @@ -366,30 +395,59 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) ! So instead try to open a test file within the output directory ! Check ./OutputDir (which exists for GEOS-Chem and GCHP) as backup IU_FILE = findFreeLUN() - open(IU_FILE,FILE=trim(v_str)//'/.test_directory_existence', & - action = "WRITE",iostat=path_exists,access='SEQUENTIAL') + OPEN( IU_FILE, FILE = trim(v_str)//'/.test_directory_existence', & + ACTION = "WRITE", & + IOSTAT = path_exists, & + ACCESS = 'SEQUENTIAL' ) ! If the specified folder doesn't exist, try OutputDir - IF ( path_exists /= 0 ) THEN - open(IU_FILE,FILE='./OutputDir/.test_directory_existence', & - action = "WRITE",iostat=path_exists,access='SEQUENTIAL') + IF ( path_exists /= 0 ) THEN + OPEN( IU_FILE, FILE = './OutputDir/.test_directory_existence', & + ACTION = "WRITE", & + IOSTAT = path_exists, & + ACCESS ='SEQUENTIAL' ) KPP_Standalone_YAML%Output_Directory = "./OutputDir" - IF ( Input_Opt%amIRoot ) & - write(*,*) "KPP Standalone Interface warning: Specified output directory ", & - trim(v_str), " was not found, trying default output path './OutputDir' " + IF ( Input_Opt%amIRoot ) THEN + WRITE( 6, '(a)' ) & + "KPP Standalone Interface warning: Specified output directory ",& + trim(v_str), & + " was not found, trying default output path './OutputDir' " + ENDIF + ! If OutputDir doesn't exist, write to the current directory - IF ( (path_exists /= 0) ) THEN - IF ( Input_Opt%amIRoot ) & - write(*,*) "KPP Standalone Interface warning: Specified output directory ", & - trim(v_str), " and default output directory './OutputDir' " // & - "were not found, writing output to the current directory './'" - KPP_Standalone_YAML%Output_Directory = "./" + IF ( path_exists /= 0 ) THEN + IF ( Input_Opt%amIRoot ) THEN + WRITE( 6, '(a)' ) & + "KPP Standalone Interface warning: Specified output directory ", & + trim(v_str), & + " and default output directory './OutputDir' " // & + "were not found, writing output to the current directory './'" + KPP_Standalone_YAML%Output_Directory = "./" + ENDIF ENDIF - ELSE + ELSE KPP_Standalone_YAML%Output_Directory = trim(v_str) close(IU_FILE) END IF - + + !======================================================================= + ! Print information about sites that will be archived + !======================================================================= + IF ( Input_Opt%amIRoot ) THEN + WRITE( 6, '(a)' ) REPEAT( "=", 79 ) + WRITE( 6, '(a,/)' ) "KPP STANDALONE INTERFACE" + WRITE( 6, '(a,/)' ) "Model state will be archived at these sites:" + DO I = 1, KPP_Standalone_YAML%NLOC + WRITE( 6, 150 ) KPP_Standalone_YAML%LocationName(I), & + KPP_Standalone_YAML%LocationLons(I), & + KPP_Standalone_YAML%LocationLats(I) + 150 FORMAT( a25, "( ", f9.4, ", ", f9.4, " )") + ENDDO + WRITE( 6, '(/,a)' ) "For GEOS-Chem vertical levels:" + WRITE( 6, '(100i4)' ) KPP_Standalone_YAML%Levels + WRITE( 6, '(a)' ) REPEAT( "=", 79 ) + ENDIF + END SUBROUTINE Config_KPP_Standalone !EOC !------------------------------------------------------------------------------ @@ -400,22 +458,27 @@ END SUBROUTINE Config_KPP_Standalone ! !IROUTINE: Write_Samples ! ! !DESCRIPTION: Subroutine Write_Samples writes the full chemical state -! (concentrations, reaction rates and rate constants, meteorological conditions). -! Obin Sturm (psturm@usc.edu) 2024/03/11 +! (concentrations, reaction rates and rate constants, meteorological +! conditions). !\\ !\\ ! !INTERFACE: ! - SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, exitHvalue, & - State_Grid, State_Chm, State_Met, Input_Opt, & - KPP_TotSteps, RC, FORCE_WRITE, CELL_NAME ) + SUBROUTINE Write_Samples( I, J, L, & + initC, localRCONST, initHvalue, & + exitHvalue, State_Grid, State_Chm, & + State_Met, Input_Opt, KPP_TotSteps, & + RC, FORCE_WRITE, CELL_NAME ) +! +! !USES: +! USE ErrCode_Mod USE State_Grid_Mod, ONLY : GrdState USE State_Chm_Mod, ONLY : ChmState USE State_Met_Mod, ONLY : MetState USE Input_Opt_Mod, ONLY : OptInput USE GcKpp_Function - USE GcKpp_Parameters, ONLY : NSPEC, NREACT, NVAR + USE GcKpp_Parameters, ONLY : NSPEC, NREACT, NVAR USE TIME_MOD, ONLY : GET_TS_CHEM USE TIME_MOD, ONLY : TIMESTAMP_STRING USE TIME_MOD, ONLY : Get_Minute @@ -425,51 +488,63 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, exitHvalue, USE TIME_MOD, ONLY : Get_Year USE Pressure_Mod, ONLY : Get_Pcenter USE inquireMod, ONLY : findFreeLUN -! !INPUT PARAMETERS: ! - INTEGER, INTENT(IN) :: I ! Longitude index - INTEGER, INTENT(IN) :: J ! Latitude index - INTEGER, INTENT(IN) :: L ! GEOS-Chem vertical level - INTEGER, INTENT(IN) :: KPP_TotSteps ! Total KPP integrator steps - - TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object - TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object - TYPE(MetState), INTENT(IN) :: State_Met ! Meteorology State object - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object - REAL(dp), INTENT(IN) :: initC(NSPEC) ! Initial concentrations - REAL(dp), INTENT(IN) :: localRCONST(NREACT) ! Rate constants - REAL(dp) :: initHvalue ! Initial timestep - REAL(dp) :: exitHvalue ! Final timestep, RSTATE(Nhexit) - -! !OPTIONAL INPUT PARAMETER - LOGICAL, OPTIONAL :: FORCE_WRITE ! Write even if not in an active cell - CHARACTER(LEN=*), OPTIONAL :: CELL_NAME ! Customize the name of this file +! !INPUT PARAMETERS: ! -! !AUXILLIARY LOCAL PARAMETERS (pass the aux bc Fortran doesn't have defaults for kwargs) - LOGICAL :: FORCE_WRITE_AUX ! Write even if not in an active cell - CHARACTER(LEN=255) :: CELL_NAME_AUX ! Customize the name of this file + INTEGER, INTENT(IN) :: I ! Longitude index + INTEGER, INTENT(IN) :: J ! Latitude index + INTEGER, INTENT(IN) :: L ! Vertical level + INTEGER, INTENT(IN) :: KPP_TotSteps ! Total integr. steps + TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object + TYPE(ChmState), INTENT(IN) :: State_Chm ! Chem State obj + TYPE(MetState), INTENT(IN) :: State_Met ! Met State obj + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options obj + REAL(dp), INTENT(IN) :: initC(NSPEC) ! Initial conc. + REAL(dp), INTENT(IN) :: localRCONST(NREACT) ! Rate constants + REAL(dp) :: initHvalue ! Initial timestep + REAL(dp) :: exitHvalue ! Final timestep: + ! RSTATE(Nhexit) + LOGICAL, OPTIONAL :: FORCE_WRITE ! Write even if not + ! in an active cell + CHARACTER(LEN=*), OPTIONAL :: CELL_NAME ! Customize name of + ! this file ! ! !OUTPUT PARAMETERS: ! INTEGER, INTENT(OUT) :: RC ! Success or failure ! +! !REVISION HISTORY: +! 11 Mar 2024 - P. Obin Sturm - Initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! ! !LOCAL VARIABLES: +! ! Integers - INTEGER :: N ! Loop index - INTEGER :: IU_FILE ! Available unit for writing - INTEGER :: SpcID ! Mapping from State_Chm and KPP - REAL(fp) :: DT ! Chemistry operator timestep + INTEGER :: N + INTEGER :: IU_FILE + INTEGER :: SpcID + REAL(fp) :: DT + LOGICAL :: FORCE_WRITE_AUX + CHARACTER(LEN=255) :: CELL_NAME_AUX + ! Strings - CHARACTER(LEN=255) :: YYYYMMDD_hhmmz - CHARACTER(LEN=255) :: level_string - CHARACTER(LEN=512) :: errMsg, filename - + CHARACTER(LEN=255) :: YYYYMMDD_hhmmz + CHARACTER(LEN=255) :: level_string + CHARACTER(LEN=512) :: errMsg, filename + ! Arrays - REAL(dp) :: Vloc(NVAR), Aout(NREACT) ! For KPP reaction rate diagnostics + REAL(dp) :: Aout(NREACT) + REAL(dp) :: Vloc(NVAR) + !====================================================================== + ! Write_Samples begins here! + !====================================================================== - ! Did a user want to write the chemical state even if - ! not in an active cell? + ! Did a user want to write the chemical state + ! even if not in an active cell? FORCE_WRITE_AUX = .FALSE. IF ( PRESENT( FORCE_WRITE ) ) FORCE_WRITE_AUX = FORCE_WRITE @@ -484,23 +559,27 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, exitHvalue, IF ( PRESENT( CELL_NAME ) ) CELL_NAME_AUX = CELL_NAME ! Get KPP state - CALL Fun( V = initC(1:NVAR), & - F = initC(NVAR+1:NSPEC), & - RCT = localRCONST, & - Vdot = Vloc, & - Aout = Aout ) + CALL Fun( V = initC(1:NVAR), & + F = initC(NVAR+1:NSPEC), & + RCT = localRCONST, & + Vdot = Vloc, & + Aout = Aout ) + ! Chemistry timestep (seconds) DT = GET_TS_CHEM() - !======================================================================== - ! Write the file - !======================================================================== + !====================================================================== + ! Write the file. We need to place this into an !$OMP CRITICAL + ! block to ensure that only one thread can open & write to the file + ! at a time. Otherwise we will get corrupted files + !====================================================================== + !$OMP CRITICAL ! Find a free file LUN IU_FILE = findFreeLUN() - write(level_string,'(I0)') L - write(YYYYMMDD_hhmmz,'(I0.4,I0.2,I0.2,a,I0.2,I0.2)' ) & - Get_Year(), Get_Month(), Get_Day(),'_', Get_Hour(), Get_Minute() + WRITE(level_string,'(I0)') L + WRITE( YYYYMMDD_hhmmz,'(I0.4,I0.2,I0.2,a,I0.2,I0.2)' ) & + Get_Year(), Get_Month(), Get_Day(), '_', Get_Hour(), Get_Minute() ! Filename for output filename = TRIM( KPP_Standalone_YAML%Output_Directory ) // & @@ -514,84 +593,144 @@ SUBROUTINE Write_Samples( I, J, L, initC, localRCONST, initHvalue, exitHvalue, '.txt' ! Open the file - open( IU_FILE, FILE=TRIM(filename), ACTION="WRITE", & + OPEN( IU_FILE, FILE=TRIM(filename), ACTION="WRITE", & IOSTAT=RC, ACCESS='SEQUENTIAL') - IF ( RC /= GC_SUCCESS ) THEN - errMsg = 'Error writing chemical state to KPP Standalone file' - CALL GC_Error( errMsg, RC, '' ) - RETURN - ENDIF + + ! NOTE: Cannot exit from an !$OMP CRITICAL block, so comment out + ! for now + !IF ( RC /= GC_SUCCESS ) THEN + ! errMsg = 'Error writing chemical state to KPP Standalone file' + ! CALL GC_Error( errMsg, RC, '' ) + ! RETURN + !ENDIF ! Write header to file - write(IU_FILE, '(a)') '48 ' - write(IU_FILE, '(a)') '===========================================================================' - write(IU_FILE, '(a)') ' ' - write(IU_FILE, '(a)') ' KPP Standalone Atmospheric Chemical State ' - write(IU_FILE, '(a)') 'File Description: ' - write(IU_FILE, '(a)') 'This file contains model output of the atmospheric chemical state ' - write(IU_FILE, '(a)') 'as simulated by the GEOS-Chem chemistry module in a 3D setting. ' - write(IU_FILE, '(a)') 'Each grid cell represents the chemical state of an individual location, ' - write(IU_FILE, '(a)') 'suitable for input into a separate KPP Standalone program which will ' - write(IU_FILE, '(a)') 'replicate the chemical evolution of that grid cell for mechanism analysis. ' - write(IU_FILE, '(a)') 'Note that the KPP Standalone will only use concentrations, rate constants, ' - write(IU_FILE, '(a)') 'and KPP-specific fields. All other fields are for reference. The first line' - write(IU_FILE, '(a)') 'contains the number of lines in this header. If wanting to use this output ' - write(IU_FILE, '(a)') 'for other analysis, a Python class to read these fields is available by ' - write(IU_FILE, '(a)') 'request, contact Obin Sturm (psturm@usc.edu). ' - write(IU_FILE, '(a)') ' ' - write(IU_FILE, '(a)') 'Generated by the GEOS-Chem Model ' - write(IU_FILE, '(a)') ' (https://geos-chem.org/) ' - write(IU_FILE, '(a)') 'Using the KPP Standalone Interface ' - write(IU_FILE, '(a)') 'github.com/GEOS-ESM/geos-chem/tree/feature/psturm/kpp_standalone_interface ' - write(IU_FILE, '(a)') ' With contributions from: ' - write(IU_FILE, '(a)') ' Obin Sturm (psturm@usc.edu) ' - write(IU_FILE, '(a)') ' Christoph Keller ' - write(IU_FILE, '(a)') ' Michael Long ' - write(IU_FILE, '(a)') ' Sam Silva ' - write(IU_FILE, '(a)') ' ' + WRITE( IU_FILE, '(a)' ) '48' + WRITE( IU_FILE, '(a)' ) REPEAT("=", 76 ) + WRITE( IU_FILE, '(a)' ) '' + WRITE( IU_FILE, '(a)' ) & + ' KPP Standalone Atmospheric Chemical State' + WRITE( IU_FILE, '(a)' ) 'File Description:' + WRITE( IU_FILE, '(a)' ) & + 'This file contains model output of the atmospheric chemical state' + WRITE( IU_FILE, '(a)' ) & + 'as simulated by the GEOS-Chem chemistry module in a 3D setting.' + WRITE( IU_FILE, '(a)' ) & + 'Each grid cell represents the chemical state of an individual location,' + WRITE( IU_FILE, '(a)' ) & + 'suitable for input into a separate KPP Standalone program which will' + WRITE( IU_FILE, '(a)' ) & + 'replicate the chemical evolution of that grid cell for mechanism analysis.' + WRITE( IU_FILE, '(a)' ) & + 'Note that the KPP Standalone will only use concentrations, rate constants,' + WRITE( IU_FILE, '(a)' ) & + 'and KPP-specific fields. All other fields are for reference. The first line' + WRITE( IU_FILE, '(a)' ) & + 'contains the number of lines in this header. If wanting to use this output' + WRITE( IU_FILE, '(a)' ) & + 'for other analysis, a Python class to read these fields is available by' + WRITE( IU_FILE, '(a)' ) & + 'request, contact Obin Sturm (psturm@usc.edu).' + WRITE( IU_FILE, '(a)' ) '' + WRITE( IU_FILE, '(a)' ) 'Generated by the GEOS-Chem Model' + WRITE( IU_FILE, '(a)' ) ' (https://geos-chem.org/)' + WRITE( IU_FILE, '(a)' ) 'Using the KPP Standalone Interface' + WRITE( IU_FILE, '(a)' ) 'github.com/GEOS-ESM/geos-chem/tree/feature/psturm/kpp_standalone_interface' + WRITE( IU_FILE, '(a)' ) ' With contributions from:' + WRITE( IU_FILE, '(a)' ) ' Obin Sturm (psturm@usc.edu)' + WRITE( IU_FILE, '(a)' ) ' Christoph Keller' + WRITE( IU_FILE, '(a)' ) ' Michael Long' + WRITE( IU_FILE, '(a)' ) ' Sam Silva' + WRITE( IU_FILE, '(a)' ) '' + ! Write the grid cell metadata as part of the header - write(IU_FILE,'(a)' ) 'Meteorological and general grid cell metadata ' - write(IU_FILE,'(a,a)' ) 'Location: ', trim(CELL_NAME_AUX)//trim(KPP_Standalone_YAML%ACTIVE_CELL_NAME) - write(IU_FILE,'(a,a)' ) 'Timestamp: ', TIMESTAMP_STRING() - write(IU_FILE,'(a,F11.4)') 'Longitude (degrees): ', State_Grid%XMid(I,J) - write(IU_FILE,'(a,F11.4)') 'Latitude (degrees): ', State_Grid%YMid(I,J) - write(IU_FILE,'(a,i6)' ) 'GEOS-Chem Vertical Level: ', L - write(IU_FILE,'(a,F11.4)') 'Pressure (hPa): ', Get_Pcenter(I,J,L) - write(IU_FILE,'(a,F11.2)') 'Temperature (K): ', State_Met%T(I,J,L) - write(IU_FILE,'(a,e11.4)') 'Dry air density (molec/cm3): ', State_Met%AIRNUMDEN(I,J,L) - write(IU_FILE,'(a,e11.4)') 'Water vapor mixing ratio (vol H2O/vol dry air): ', State_Met%AVGW(I,J,L) - write(IU_FILE,'(a,e11.4)') 'Cloud fraction: ', State_Met%CLDF(I,J,L) - write(IU_FILE,'(a,e11.4)') 'Cosine of solar zenith angle: ', State_Met%SUNCOSmid(I,J) - write(IU_FILE,'(a)' ) 'KPP Integrator-specific parameters ' - write(IU_FILE,'(a,F11.4)') 'Init KPP Timestep (seconds): ', initHvalue - write(IU_FILE,'(a,F11.4)') 'Exit KPP Timestep (seconds): ', exitHvalue - write(IU_FILE,'(a,F11.4)') 'Chemistry operator timestep (seconds): ', DT - write(IU_FILE,'(a,i6)' ) 'Number of internal timesteps: ', KPP_TotSteps - write(IU_File,'(a)' ) 'CSV data of full chemical state, including species concentrations, ' - write(IU_File,'(a)' ) 'rate constants (R) and instantaneous reaction rates (A). ' - write(IU_File,'(a)' ) 'All concentration units are in molecules/cc and rates in molec/cc/s. ' - write(IU_FILE, '(a)') ' ' - write(IU_FILE, '(a)') '===========================================================================' - write(IU_FILE, '(a)') 'Name, Value ' - DO N=1,NSPEC + WRITE( IU_FILE, '(a)' ) & + 'Meteorological and general grid cell metadata ' + WRITE( IU_FILE, '(a,a)' ) & + 'Location: ' // & + TRIM( CELL_NAME_AUX ) // & + TRIM( KPP_Standalone_ActiveCell%ACTIVE_CELL_NAME ) + WRITE( IU_FILE, '(a,a)' ) & + 'Timestamp: ', & + TIMESTAMP_STRING() + WRITE( IU_FILE, '(a,f11.4)' ) & + 'Longitude (degrees): ', & + State_Grid%XMid(I,J) + WRITE( IU_FILE, '(a,f11.4)' ) & + 'Latitude (degrees): ', & + State_Grid%YMid(I,J) + WRITE( IU_FILE, '(a,i6)' ) & + 'GEOS-Chem Vertical Level: ', & + L + WRITE( IU_FILE, '(a,f11.4)' ) & + 'Pressure (hPa): ', & + Get_Pcenter( I, J, L ) + WRITE( IU_FILE, '(a,f11.2)' ) & + 'Temperature (K): ', & + State_Met%T(I,J,L) + WRITE( IU_FILE, '(a,e11.4)' ) & + 'Dry air density (molec/cm3): ', & + State_Met%AIRNUMDEN(I,J,L) + WRITE( IU_FILE, '(a,e11.4)' ) & + 'Water vapor mixing ratio (vol H2O/vol dry air): ', & + State_Met%AVGW(I,J,L) + WRITE( IU_FILE, '(a,e11.4)' ) & + 'Cloud fraction: ', & + State_Met%CLDF(I,J,L) + WRITE( IU_FILE, '(a,e11.4)' ) & + 'Cosine of solar zenith angle: ', & + State_Met%SUNCOSmid(I,J) + WRITE( IU_FILE, '(a)' ) & + 'KPP Integrator-specific parameters ' + WRITE( IU_FILE, '(a,f11.4)' ) & + 'Init KPP Timestep (seconds): ', & + initHvalue + WRITE( IU_FILE, '(a,f11.4)' ) & + 'Exit KPP Timestep (seconds): ', & + exitHvalue + WRITE( IU_FILE, '(a,f11.4)' ) & + 'Chemistry operator timestep (seconds): ', & + DT + WRITE( IU_FILE, '(a,i6)' ) & + 'Number of internal timesteps: ', & + KPP_TotSteps + WRITE( IU_FILE, '(a)' ) & + 'CSV data of full chemical state, including species concentrations,' + WRITE( IU_FILE, '(a)' ) & + 'rate constants (R) and instantaneous reaction rates (A).' + WRITE( IU_FILE, '(a)' ) & + 'All concentration units are in molecules/cc and rates in molec/cc/s.' + WRITE( IU_FILE, '(a)' ) '' + WRITE( IU_FILE, '(a)' ) REPEAT("=", 76 ) + WRITE( IU_FILE, '(a)' ) 'Name, Value' + + ! Write species concentrations + DO N = 1, NSPEC SpcID = State_Chm%Map_KppSpc(N) IF ( SpcID <= 0 ) THEN - write(IU_FILE,'(A,I0,A,E25.16E3)') "C",N,",",initC(N) + WRITE( IU_FILE, '(a,i0,a,e25.16e3)' ) "C", N, ",", initC(N) CYCLE ENDIF - write(IU_FILE,'(A,A,E25.16E3)') trim(State_Chm%SpcData(SpcID)%Info%Name),',',initC(N) + WRITE( IU_FILE, '(a,a,e25.16e3)' ) & + TRIM(State_Chm%SpcData(SpcID)%Info%Name), ',', initC(N) ENDDO - DO N=1,NREACT - write(IU_FILE,'(A,I0,A,E25.16E3)') 'R',N,',', localRCONST(N) + + ! Write reaction rates + DO N = 1, NREACT + WRITE( IU_FILE,'(a,I0,a,e25.16e3)' ) 'R', N, ',', localRCONST(N) ENDDO - DO N=1,NREACT - write(IU_FILE,'(A,I0,A,E25.16E3)') 'A',N,',', Aout(N) + + ! Write instantaneous reaction rates + DO N = 1, NREACT + WRITE( IU_FILE,'(A,I0,A,E25.16E3)' ) 'A', N, ',', Aout(N) ENDDO - close(IU_FILE) + + ! Close file + CLOSE( IU_FILE ) + !$OMP END CRITICAL END SUBROUTINE Write_Samples !EOC -! !INPUT PARAMETERS: !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! !------------------------------------------------------------------------------ @@ -599,11 +738,12 @@ END SUBROUTINE Write_Samples ! ! !IROUTINE: cleanup_kpp_standalone ! -! !DESCRIPTION: Deallocates module variables that may have been allocated at run time -! and unnecessary files required during the process +! !DESCRIPTION: Deallocates module variables that may have been allocated +! at run time and unnecessary files required during the process !\\ !\\ ! !INTERFACE: +! SUBROUTINE Cleanup_KPP_Standalone( RC ) ! ! !USES: @@ -616,52 +756,63 @@ SUBROUTINE Cleanup_KPP_Standalone( RC ) INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: -! 11 Mar 2024 - Obin Sturm - Initial version +! 11 Mar 2024 - P. Obin Sturm - Initial version !EOP !------------------------------------------------------------------------------ !BOC +! +! !LOCAL VARIABLES:: +! + ! Strings + CHARACTER(LEN=255) :: arrayId + ! Assume success RC = GC_SUCCESS IF ( ALLOCATED( KPP_Standalone_YAML%LocationName ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationName' DEALLOCATE( KPP_Standalone_YAML%LocationName, STAT=RC ) - CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationName', 2, RC ) + CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF IF ( ALLOCATED( KPP_Standalone_YAML%LocationLons ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationLons' DEALLOCATE( KPP_Standalone_YAML%LocationLons, STAT=RC ) - CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationLons', 2, RC ) + CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF IF ( ALLOCATED( KPP_Standalone_YAML%LocationLats ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationLats' DEALLOCATE( KPP_Standalone_YAML%LocationLats, STAT=RC ) - CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationLats', 2, RC ) + CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF IF ( ALLOCATED( KPP_Standalone_YAML%IDX ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%IDX' DEALLOCATE( KPP_Standalone_YAML%IDX, STAT=RC ) - CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%IDX', 2, RC ) + CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF IF ( ALLOCATED( KPP_Standalone_YAML%JDX ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%JDX' DEALLOCATE( KPP_Standalone_YAML%JDX, STAT=RC ) - CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%JDX', 2, RC ) + CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF IF ( ALLOCATED( KPP_Standalone_YAML%Levels ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%Levels' DEALLOCATE( KPP_Standalone_YAML%Levels, STAT=RC ) - CALL GC_CheckVar( 'kpp_standalone_interface.F90:KPP_Standalone_YAML%Levels', 2, RC ) + CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF - + END SUBROUTINE Cleanup_KPP_Standalone !EOC -! !INPUT PARAMETERS: !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! !------------------------------------------------------------------------------ @@ -685,6 +836,10 @@ FUNCTION Find_Number_of_Locations( a_str ) RESULT( n_valid ) ! !RETURN VALUE: ! INTEGER :: n_valid +! +! !REVISION HISTORY: +! 11 Mar 2024 - P. Obin Sturm - Initial version +! See https://github.com/geoschem/geos-chem for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -725,6 +880,8 @@ FUNCTION Find_Number_of_Levels( a_int ) RESULT( n_valid ) ! !RETURN VALUE: ! INTEGER :: n_valid +! 11 Mar 2024 - P. Obin Sturm - Initial version +! See https://github.com/geoschem/geos-chem for complete history !EOP !------------------------------------------------------------------------------ !BOC From defef0f4e4e0f9d1b0317b697ea3120578a08471 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 8 Oct 2024 14:52:34 -0400 Subject: [PATCH 21/37] Now use consistent nomenclature for KPP standalone interface GeosCore/kpp_standalone_interface.F90 - Moved to kppsa_interface_mod.F90 GeosCore/kppsa_interface_mod.F90 - Moved from kpp_standalone_interface - Renamed types, variables and routines using "KppSa" prefix: - KPP_Standalone_Interface_Type -> KppSa_Interface_Type - KPP_Standalone_ActiveCell_Type -> KppSa_ActiveCell_Type - KPP_Standalone_YAML -> KppSa_State - KPP_Standalone_ActiveCell -> KppSa_ActiveCell - Check_Domain -> KppSa_Check_Domain - Check_ActiveCell -> KppSa_Check_ActiveCell - Config_KPP_Standalone -> KppSa_Config - Write_Samples -> KppSa_Write_Samples - Cleanup_KPP_Standalone -> KppSa_Cleanup - Added KppSa_Check_Time function to determine if it is time to write KPP standalone output. This allows you to only write output e.g. at the end of a run instead of for each timestep. - Added KppSa_State%SkipWriteAtThisTime field, which is used to determine if we need to exit a routine early. GeosCore/fullchem_mod.F90 - "USE Kpp_Standalone_Interface" -> "USE KppSa_Interface_Mod" - Call renamed routines from kppsa_interface_mod.F90 - Now call KppSa_Check_Domain only if it is the first call to DO_FULLCHEM. This is to avoid repeated computations. - Now call KppSa_Check_Time to determine if we are in the time window when the model state should be archived to disk. - Updated comments and comment headers run/shared/kpp_standalone_interface.yml - Added "start_output_at" to denote starting date time for archiving model state - Added "stop_output_at" to denote ending date time for archiving model state - Updated comments CHANGELOG.md GeosCore/CMakeLists.txt - Updated accordingly Signed-off-by: Bob Yantosca --- CHANGELOG.md | 2 +- GeosCore/CMakeLists.txt | 4 +- GeosCore/fullchem_mod.F90 | 87 +++-- ..._interface.F90 => kppsa_interface_mod.F90} | 368 +++++++++++------- run/shared/kpp_standalone_interface.yml | 19 +- 5 files changed, 301 insertions(+), 179 deletions(-) rename GeosCore/{kpp_standalone_interface.F90 => kppsa_interface_mod.F90} (74%) diff --git a/CHANGELOG.md b/CHANGELOG.md index 020c8f057..bef5b5c1f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,7 +17,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Added computation of water concentration to use in photolysis for application of UV absorption by water in Cloud-J v8 - Added ACO3, ACR, ACRO2, ALK4N{1,2,O}2, ALK4P, ALK7, APAN, APINN, APINO2, APINP, AROCMCHO, AROMCO3, AROMPN, BPINN, BPINO2, BPINON, BPINOO2, BPINOOH, BPINP, BUTN, BUTO2, C4H6, C96N, C96O2, C9602H, EBZ, GCO3, HACTA, LIMAL, LIMKB, LIMKET, LIMKO2, LIMN, LIMNB, LIMO2H, LIMO3, LIMO3H, LIMPAN, MEKCO3, MEKPN, MYRCO, PHAN, PIN, PINAL, PINO3, PINONIC, PINPAN, R7N{1,2}, R7O2, R7P, RNO3, STYR, TLFUO2, TLFUONE, TMB, ZRO2 to `species_database.yml` following Travis et al. 2024. - Added TSOIL1 field to `State_Met` for use in HEMCO soil NOx extension. This should only be read in when the `UseSoilTemperature` option is true in HEMCO config. -- Added KPP standalone interface +- Added KPP standalone interface (archives model state to selected locations) ### Changed - Copy values from `State_Chm%KPP_AbsTol` to `ATOL` and `State_Chm%KPP_RelTol` to `RTOL` for fullchem and Hg simulations diff --git a/GeosCore/CMakeLists.txt b/GeosCore/CMakeLists.txt index 226de8624..ebb7ae2dd 100755 --- a/GeosCore/CMakeLists.txt +++ b/GeosCore/CMakeLists.txt @@ -19,6 +19,7 @@ add_library(GeosCore STATIC EXCLUDE_FROM_ALL aero_drydep.F90 aerosol_mod.F90 + aerosol_thermodynamics_mod.F90 airs_ch4_mod.F90 calc_met_mod.F90 carbon_mod.F90 @@ -47,7 +48,7 @@ add_library(GeosCore hco_interface_gc_mod.F90 hco_utilities_gc_mod.F90 input_mod.F90 - aerosol_thermodynamics_mod.F90 + kppsa_interface_mod.F90 land_mercury_mod.F90 linear_chem_mod.F90 linoz_mod.F90 @@ -82,7 +83,6 @@ add_library(GeosCore vdiff_mod.F90 wetscav_mod.F90 YuIMN_Code.F90 - kpp_standalone_interface.F90 # Files only included for special cases $<$:flexgrid_read_mod.F90 get_met_mod.F90 set_boundary_conditions_mod.F90> diff --git a/GeosCore/fullchem_mod.F90 b/GeosCore/fullchem_mod.F90 index 3d67554e3..5d3639e25 100644 --- a/GeosCore/fullchem_mod.F90 +++ b/GeosCore/fullchem_mod.F90 @@ -120,6 +120,7 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & USE GcKpp_Rates, ONLY : UPDATE_RCONST, RCONST USE GcKpp_Util, ONLY : Get_OHreactivity USE Input_Opt_Mod, ONLY : OptInput + USE KppSa_Interface_Mod USE Photolysis_Mod, ONLY : Do_Photolysis, PhotRate_Adj USE PhysConstants, ONLY : AVO, AIRMW USE PRESSURE_MOD @@ -140,7 +141,6 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & USE UCX_MOD, ONLY : SO4_PHOTFRAC USE UCX_MOD, ONLY : UCX_NOX USE UCX_MOD, ONLY : UCX_H2SO4PHOT - USE KPP_Standalone_Interface #ifdef TOMAS USE TOMAS_MOD, ONLY : H2SO4_RATE USE TOMAS_MOD, ONLY : PSO4AQ_RATE @@ -443,11 +443,28 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ENDIF !======================================================================= - ! Should we print the full chemical state for any grid cell on this CPU? - ! for use with the KPP Standalone - ! (psturm, 03/22/24) + ! Setup for the KPP standalone interface (Obin Sturm, Bob Yantosca) + ! + ! NOTE: These routines return immediately if the KPP standalone + ! interface has been disabled (or if the *.yml file is missing.) !======================================================================= - CALL Check_Domain( RC ) + + ! Get the (I,J) grid box indices for active cells that are on this CPU + ! so that we can print the full chemical state to text files. + ! + ! For computational efficency, only do this on the first call, as + ! this information does not change with time. + IF ( FirstChem ) THEN + CALL KppSa_Check_Domain( RC ) + IF ( RC /= GC_SUCCESS ) THEN + ErrMsg = 'Error encountered in "Check_Domain"!' + CALL GC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + ENDIF + + ! Are we within the time window for archiving model state? + CALL KppSa_Check_Time( RC ) !======================================================================== ! Set up integration convergence conditions and timesteps @@ -584,7 +601,7 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! Check if the current grid cell in this loop should have its ! full chemical state printed (concentrations, rates, constants) ! for use with the KPP Standalone (psturm, 03/22/24) - CALL Check_ActiveCell( I, J, L ) + CALL KppSa_Check_ActiveCell( I, J, L ) ! Start measuring KPP-related routine timing for this grid box IF ( State_Diag%Archive_KppTime ) THEN @@ -1285,7 +1302,7 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & ! Write chemical state to file for the kpp standalone interface ! No external logic needed, this subroutine exits early if the ! chemical state should not be printed (psturm, 03/23/24) - CALL Write_Samples( & + CALL KppSa_Write_Samples( & I = I, & J = J, & L = L, & @@ -2715,10 +2732,10 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) USE Gckpp_Parameters, ONLY : nFam, nReact USE Gckpp_Global, ONLY : Henry_K0, Henry_CR, MW, SR_MW USE Input_Opt_Mod, ONLY : OptInput + USE KppSa_Interface_Mod, ONLY : KppSa_Config USE State_Chm_Mod, ONLY : ChmState USE State_Chm_Mod, ONLY : Ind_ USE State_Diag_Mod, ONLY : DgnState - USE KPP_Standalone_Interface, ONLY : Config_KPP_Standalone ! ! !INPUT PARAMETERS: ! @@ -2745,9 +2762,9 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) ! Strings CHARACTER(LEN=255) :: ErrMsg, ThisLoc - !======================================================================= + !======================================================================== ! Init_FullChem begins here! - !======================================================================= + !======================================================================== ! Assume success RC = GC_SUCCESS @@ -2757,9 +2774,9 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) ! modify the IF statement accordingly to allow initialization IF ( .not. Input_Opt%ITS_A_FULLCHEM_SIM ) RETURN - !======================================================================= + !======================================================================== ! Initialize variables - !======================================================================= + !======================================================================== ErrMsg = '' ThisLoc = ' -> at Init_FullChem (in module GeosCore/FullChem_mod.F90)' @@ -2875,10 +2892,10 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) State_Diag%Archive_O3PconcAfterChem ) - !======================================================================= + !======================================================================== ! Assign default values for KPP absolute and relative tolerances ! for species where these have not been explicitly defined. - !======================================================================= + !======================================================================== WHERE( State_Chm%KPP_AbsTol == MISSING_DBLE ) State_Chm%KPP_AbsTol = 1.0e-2_f8 ENDWHERE @@ -2887,10 +2904,10 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) State_Chm%KPP_RelTol = 0.5e-2_f8 ENDWHERE - !======================================================================= + !======================================================================== ! Save physical parameters from the species database into KPP arrays ! in gckpp_Global.F90. These are for the hetchem routines. - !======================================================================= + !======================================================================== DO KppId = 1, State_Chm%nKppSpc + State_Chm%nOmitted N = State_Chm%Map_KppSpc(KppId) IF ( N > 0 ) THEN @@ -2900,18 +2917,18 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) HENRY_CR(KppId) = State_Chm%SpcData(N)%Info%Henry_CR ENDIF ENDDO - !======================================================================= + !======================================================================== ! Allocate arrays - !======================================================================= + !======================================================================== ! Initialize id_PSO4 = -1 id_PCO = -1 id_LCH4 = -1 - !-------------------------------------------------------------------- + !------------------------------------------------------------------------ ! Pre-store the KPP indices for each KPP prod/loss species or family - !-------------------------------------------------------------------- + !------------------------------------------------------------------------ IF ( nFam > 0 ) THEN @@ -2952,11 +2969,11 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) ENDIF #ifdef MODEL_CESM - !-------------------------------------------------------------------- + !------------------------------------------------------------------------ ! If we are finding H2SO4_RATE from a fullchem ! simulation for the CESM, throw an error if we cannot find ! the PSO4 prod family in this KPP mechanism. - !-------------------------------------------------------------------- + !------------------------------------------------------------------------ IF ( id_PSO4 < 1 ) THEN ErrMsg = 'Could not find PSO4 in list of KPP families! This ' // & 'is needed for State_Chm%H2SO4_PRDR and coupling to CESM!' @@ -2965,11 +2982,11 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) ENDIF #endif - !-------------------------------------------------------------------- + !------------------------------------------------------------------------ ! If we are archiving the P(CO) from CH4 and from NMVOC from a fullchem ! simulation for the tagCO simulation, throw an error if we cannot find ! the PCO or LCH4 prod/loss families in this KPP mechanism. - !-------------------------------------------------------------------- + !------------------------------------------------------------------------ IF ( State_Diag%Archive_ProdCOfromCH4 .or. & State_Diag%Archive_ProdCOfromNMVOC ) THEN @@ -2989,9 +3006,9 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) ENDIF - !-------------------------------------------------------------------- + !------------------------------------------------------------------------ ! Initialize sulfate chemistry code (cf Mike Long) - !-------------------------------------------------------------------- + !------------------------------------------------------------------------ CALL fullchem_InitSulfurChem( RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "fullchem_InitSulfurCldChem"!' @@ -2999,9 +3016,9 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) RETURN ENDIF - !-------------------------------------------------------------------- + !------------------------------------------------------------------------ ! Initialize dust acid uptake code (Mike Long, Bob Yantosca) - !-------------------------------------------------------------------- + !------------------------------------------------------------------------ IF ( Input_Opt%LDSTUP ) THEN CALL aciduptake_InitDustChem( RC ) IF ( RC /= GC_SUCCESS ) THEN @@ -3011,10 +3028,12 @@ SUBROUTINE Init_FullChem( Input_Opt, State_Chm, State_Diag, RC ) ENDIF ENDIF - !-------------------------------------------------------------------- - ! Initialize grid cells for input to KPP Standalone (Obin Sturm) - !-------------------------------------------------------------------- - CALL Config_KPP_Standalone( Input_Opt, RC ) + !------------------------------------------------------------------------ + ! Initialize the KPP standalone interface, which will save model state + ! for the grid cells specified in kpp_standalone_interface.yml. + ! This is needed for input to the KPP standalone box model. + !------------------------------------------------------------------------ + CALL KppSa_Config( Input_Opt, RC ) IF ( RC /= GC_SUCCESS ) THEN ErrMsg = 'Error encountered in "KPP_Standalone"!' CALL GC_Error( ErrMsg, RC, ThisLoc ) @@ -3040,7 +3059,7 @@ SUBROUTINE Cleanup_FullChem( RC ) ! !USES: ! USE ErrCode_Mod - USE KPP_Standalone_Interface, ONLY : Cleanup_KPP_Standalone + USE KppSa_Interface_Mod, ONLY : KppSa_Cleanup ! ! !OUTPUT PARAMETERS: ! @@ -3092,7 +3111,7 @@ SUBROUTINE Cleanup_FullChem( RC ) ! Deallocate variables from kpp standalone module ! psturm, 03/22/2024 - CALL Cleanup_KPP_Standalone( RC ) + CALL KppSa_Cleanup( RC ) END SUBROUTINE Cleanup_FullChem !EOC diff --git a/GeosCore/kpp_standalone_interface.F90 b/GeosCore/kppsa_interface_mod.F90 similarity index 74% rename from GeosCore/kpp_standalone_interface.F90 rename to GeosCore/kppsa_interface_mod.F90 index 4d2fe9dc1..3872e6872 100644 --- a/GeosCore/kpp_standalone_interface.F90 +++ b/GeosCore/kppsa_interface_mod.F90 @@ -3,7 +3,7 @@ !------------------------------------------------------------------------------ !BOP ! -! !MODULE: kpp_standalone_interface.F90 +! !MODULE: kppsa_interface_mod.F90 ! ! !DESCRIPTION: Contains routines to print the full chemical state ! which can be used as input to the KPP Standalone. @@ -11,7 +11,7 @@ !\\ ! !INTERFACE: ! -MODULE KPP_Standalone_Interface +MODULE KppSa_Interface_Mod ! ! !USES: ! @@ -23,38 +23,42 @@ MODULE KPP_Standalone_Interface ! ! !PUBLIC MEMBERS: ! - PUBLIC :: Check_Domain - PUBLIC :: Check_ActiveCell - PUBLIC :: Config_KPP_Standalone - PUBLIC :: Write_Samples - PUBLIC :: Cleanup_KPP_Standalone + PUBLIC :: KppSa_Check_ActiveCell + PUBLIC :: KppSa_Check_Domain + PUBLIC :: KppSa_Check_Time + PUBLIC :: KppSa_Cleanup + PUBLIC :: KppSa_Config + PUBLIC :: KppSa_Write_Samples ! ! !DERIVED TYPES: ! ! Type to hold information read from the YAML config file - TYPE, PRIVATE :: KPP_Standalone_Interface_Type - INTEGER :: NLOC - LOGICAL :: SkipIt - CHARACTER(LEN=255) :: Output_Directory - CHARACTER(LEN=255), ALLOCATABLE :: LocationName(:) - REAL(hp), ALLOCATABLE :: LocationLons(:) - REAL(hp), ALLOCATABLE :: LocationLats(:) - INTEGER, ALLOCATABLE :: IDX(:) - INTEGER, ALLOCATABLE :: JDX(:) - INTEGER, ALLOCATABLE :: Levels(:) - END TYPE KPP_Standalone_Interface_Type + TYPE, PRIVATE :: KppSa_Interface_Type + INTEGER :: NLOC + INTEGER :: Start_Output(2) + INTEGER :: Stop_Output(2) + LOGICAL :: SkipIt + LOGICAL :: SkipWriteAtThisTime + CHARACTER(LEN=255) :: Output_Directory + CHARACTER(LEN=255), ALLOCATABLE :: LocationName(:) + REAL(hp), ALLOCATABLE :: LocationLons(:) + REAL(hp), ALLOCATABLE :: LocationLats(:) + INTEGER, ALLOCATABLE :: IDX(:) + INTEGER, ALLOCATABLE :: JDX(:) + INTEGER, ALLOCATABLE :: Levels(:) + END TYPE KppSa_Interface_Type ! Type to denote active cells - TYPE, PRIVATE :: KPP_Standalone_ActiveCell_Type - LOGICAL :: Active_Cell - CHARACTER(LEN=255) :: Active_Cell_Name - END TYPE KPP_Standalone_ActiveCell_Type + TYPE, PRIVATE :: KppSa_ActiveCell_Type + LOGICAL :: Active_Cell + CHARACTER(LEN=255) :: Active_Cell_Name + END TYPE KppSa_ActiveCell_Type ! ! !PRIVATE DATA MEMBERS: ! - TYPE(KPP_Standalone_Interface_Type), PRIVATE :: KPP_Standalone_YAML - TYPE(KPP_Standalone_ActiveCell_Type), PRIVATE :: KPP_Standalone_ActiveCell - !$OMP THREADPRIVATE( KPP_Standalone_ActiveCell ) + TYPE(KppSa_Interface_Type), PRIVATE :: KppSa_State + TYPE(KppSa_ActiveCell_Type), PRIVATE :: KppSa_ActiveCell + !$OMP THREADPRIVATE( KppSa_ActiveCell ) ! ! !AUTHORS: ! P. Obin Sturm (psturm@usc.edu) @@ -72,7 +76,53 @@ MODULE KPP_Standalone_Interface !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: check_domain +! !IROUTINE: kppsa_check_domain +! +! !DESCRIPTION: Subroutine Check_Domain is used to identify if a +! specified latitude and longitude falls within a grid cell on the +! current CPU. Multiple lat/lon pairs can be checked simultaneously. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE KppSa_Check_Domain( RC ) +! +! !USES: +! + USE HCO_GeoTools_Mod, ONLY : HCO_GetHorzIJIndex + USE HCO_State_GC_Mod, ONLY : HcoState +! +! !OUTPUT PARAMETERS +! + INTEGER, INTENT(out) :: RC +! +! !REVISION HISTORY: +! 11 Mar 2024 - P. Obin Sturm - Initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC + + ! Early exit if no locations + IF ( KppSa_State%SkipIt ) RETURN + + ! Compute (I,J) indices of grid boxes + CALL HCO_GetHorzIJIndex( HcoState, & + KppSa_State%NLOC, & + KppSa_State%LocationLons, & + KppSa_State%LocationLats, & + KppSa_State%IDX, & + KppSa_State%JDX, & + RC ) + + END SUBROUTINE KppSa_Check_Domain +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: kppsa_check_time ! ! !DESCRIPTION: Subroutine Check_Domain is used to identify if a ! specified latitude and longitude falls within a grid cell on the @@ -81,16 +131,16 @@ MODULE KPP_Standalone_Interface !\\ ! !INTERFACE: ! - SUBROUTINE Check_Domain( RC ) + SUBROUTINE KppSa_Check_Time( RC ) ! ! !USES: ! - USE HCO_GeoTools_Mod, ONLY : HCO_GetHorzIJIndex - USE HCO_State_GC_Mod, ONLY : HcoState + USE ErrCode_Mod + USE Time_Mod, ONLY : Get_Nymd, Get_Nhms ! ! !OUTPUT PARAMETERS ! - INTEGER, INTENT(out) :: RC + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 11 Mar 2024 - P. Obin Sturm - Initial version @@ -98,34 +148,53 @@ SUBROUTINE Check_Domain( RC ) !EOP !------------------------------------------------------------------------------ !BOC +! +! !LOCAL VARIABLES: +! + INTEGER :: yyyymmdd, hhmmss + + ! Initialize + RC = GC_SUCCESS + ! Early exit if no locations - IF ( KPP_Standalone_YAML%SkipIt ) RETURN + IF ( KppSa_State%SkipIt ) RETURN + + ! Assume we will not write to disk at this date/time + KppSa_State%SkipWriteAtThisTime = .TRUE. + + ! Get current date & time + yyyymmdd = Get_Nymd() + hhmmss = Get_Nhms() + + print*, '%%%', yyyymmdd, hhmmss + + IF ( yyyymmdd < KppSa_State%Start_Output(1) ) RETURN + IF ( yyyymmdd > KppSa_State%Stop_Output(1) ) RETURN + IF ( hhmmss < KppSa_State%Start_Output(2) ) RETURN + IF ( hhmmss > KppSa_State%Stop_Output(2) ) RETURN - CALL HCO_GetHorzIJIndex( HcoState, & - KPP_Standalone_YAML%NLOC, & - KPP_Standalone_YAML%LocationLons, & - KPP_Standalone_YAML%LocationLats, & - KPP_Standalone_YAML%IDX, & - KPP_Standalone_YAML%JDX, & - RC) + ! If we get this far, we're in the time window where we + ! archive the chemical state for the KPP standalone + KppSa_State%SkipWriteAtThisTime = .FALSE. + print*, '%%% ---> archiving this time!!!' - END SUBROUTINE Check_Domain + END SUBROUTINE KppSa_Check_Time !EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: check_activecell +! !IROUTINE: kppsa_check_activecell ! -! !DESCRIPTION: Subroutine Check_ActiveCell is used to identify if a grid cell -! is within a specified latitude and longitude to print the full chemical state -! (all concentrations, reaction rates, rate constants, and meteo metadata). +! !DESCRIPTION: Identifies if a grid cell is within a specified latitude +! and longitude to print the full chemical state (all concentrations, +! reaction rates, rate constants, and meteo metadata). !\\ !\\ ! !INTERFACE: ! - SUBROUTINE Check_ActiveCell( I, J, L ) + SUBROUTINE KppSa_Check_ActiveCell( I, J, L ) ! ! !INPUT PARAMETERS: ! @@ -143,31 +212,32 @@ SUBROUTINE Check_ActiveCell( I, J, L ) INTEGER :: K ! Early exit if there was no YAML file or no active cells - IF ( KPP_Standalone_YAML%SkipIt ) RETURN + IF ( KppSa_State%SkipIt ) RETURN ! Initialize - KPP_Standalone_ActiveCell%Active_Cell = .FALSE. - KPP_Standalone_ActiveCell%Active_Cell_Name = '' - - IF ( ANY( L == KPP_Standalone_YAML%Levels ) ) THEN - DO K = 1, KPP_Standalone_YAML%NLOC - IF ( KPP_Standalone_YAML%IDX(K) == I .AND. & - KPP_Standalone_YAML%JDX(K) == J ) THEN - KPP_Standalone_ActiveCell%Active_Cell = .TRUE. - KPP_Standalone_ActiveCell%Active_Cell_Name = & - KPP_Standalone_YAML%LocationName(K) + KppSa_ActiveCell%Active_Cell = .FALSE. + KppSa_ActiveCell%Active_Cell_Name = '' + + ! Flag active cells + IF ( ANY( L == KppSa_State%Levels ) ) THEN + DO K = 1, KppSa_State%NLOC + IF ( KppSa_State%IDX(K) == I .AND. & + KppSa_State%JDX(K) == J ) THEN + KppSa_ActiveCell%Active_Cell = .TRUE. + KppSa_ActiveCell%Active_Cell_Name = & + KppSa_State%LocationName(K) ENDIF ENDDO ENDIF - END SUBROUTINE Check_ActiveCell + END SUBROUTINE KppSa_Check_ActiveCell !EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: Config_KPP_Standalone +! !IROUTINE: kppsa_config ! ! !DESCRIPTION: Subroutine Config_KPP_Standalone reads a set of gridcells ! to be sampled and the full chemical state printed. @@ -175,12 +245,16 @@ END SUBROUTINE Check_ActiveCell !\\ ! !INTERFACE: ! - SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) + SUBROUTINE KppSa_Config( Input_Opt, RC ) +! +! !USES: +! USE QfYaml_Mod USE ErrCode_Mod USE Input_Opt_Mod, ONLY : OptInput USE RoundOff_Mod, ONLY : Cast_and_RoundOff USE inquireMod, ONLY : findFreeLUN +! ! !INPUT PARAMETERS: ! TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options object @@ -225,10 +299,10 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) './kpp_standalone_interface.yml' ! Inquire if YAML interface exists -- if not, skip initializing - KPP_Standalone_YAML%SkipIt = .FALSE. + KppSa_State%SkipIt = .FALSE. INQUIRE( FILE=configFile, EXIST=file_exists ) IF ( .NOT. file_exists ) THEN - KPP_Standalone_YAML%SkipIt = .TRUE. + KppSa_State%SkipIt = .TRUE. IF ( Input_Opt%amIRoot ) THEN WRITE( 6, 100 ) TRIM( configFile ) 100 FORMAT( "Config file ", a ", not found, ", & @@ -263,8 +337,8 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF - KPP_Standalone_YAML%SkipIt = ( .not. v_bool ) - IF ( KPP_Standalone_YAML%SkipIt ) THEN + KppSa_State%SkipIt = ( .not. v_bool ) + IF ( KppSa_State%SkipIt ) THEN WRITE( 6, 110 ) 110 FORMAT( "KPP standalone interface was manually disabled" ) RETURN @@ -285,10 +359,10 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) !======================================================================== ! Get the number of active cells (if 0, return) and the list of names !======================================================================== - KPP_Standalone_YAML%NLOC = Find_Number_of_Locations( a_str ) - IF ( KPP_Standalone_YAML%NLOC .eq. 0 ) THEN + KppSa_State%NLOC = Find_Number_of_Locations( a_str ) + IF ( KppSa_State%NLOC .eq. 0 ) THEN ! Set SkipIt flag to short circuit other subroutines - KPP_Standalone_YAML%SkipIt = .TRUE. + KppSa_State%SkipIt = .TRUE. IF ( Input_Opt%amIRoot ) THEN WRITE( 6, 120 ) 120 FORMAT( "No active cells for box modeling ", & @@ -296,11 +370,11 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) RETURN ENDIF ENDIF - ALLOCATE( KPP_Standalone_YAML%LocationName( KPP_Standalone_YAML%NLOC ), STAT=RC ) - CALL GC_CheckVar( 'KPP_Standalone_YAML%LocationName', 0, RC ) + ALLOCATE( KppSa_State%LocationName( KppSa_State%NLOC ), STAT=RC ) + CALL GC_CheckVar( 'KppSa_State%LocationName', 0, RC ) IF ( RC /= GC_SUCCESS ) RETURN - DO I = 1,KPP_Standalone_YAML%NLOC - KPP_Standalone_YAML%LocationName(I) = TRIM( a_str(I) ) + DO I = 1,KppSa_State%NLOC + KppSa_State%LocationName(I) = TRIM( a_str(I) ) END DO !======================================================================== @@ -308,18 +382,18 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) !======================================================================== ! Allocate number of locations for lats and lons - ALLOCATE( KPP_Standalone_YAML%LocationLons( KPP_Standalone_YAML%NLOC ), STAT=RC ) - CALL GC_CheckVar( 'KPP_Standalone_YAML%LocationLons', 0, RC ) + ALLOCATE( KppSa_State%LocationLons( KppSa_State%NLOC ), STAT=RC ) + CALL GC_CheckVar( 'KppSa_State%LocationLons', 0, RC ) IF ( RC /= GC_SUCCESS ) RETURN - ALLOCATE( KPP_Standalone_YAML%LocationLats( KPP_Standalone_YAML%NLOC ), STAT=RC ) - CALL GC_CheckVar( 'KPP_Standalone_YAML%LocationLats', 0, RC ) + ALLOCATE( KppSa_State%LocationLats( KppSa_State%NLOC ), STAT=RC ) + CALL GC_CheckVar( 'KppSa_State%LocationLats', 0, RC ) IF ( RC /= GC_SUCCESS ) RETURN ! Read coordinates - DO I = 1,KPP_Standalone_YAML%NLOC + DO I = 1,KppSa_State%NLOC ! Read longitudes - key = "locations%"//TRIM( KPP_Standalone_YAML%LocationName(I) )//"%longitude" + key = "locations%"//TRIM( KppSa_State%LocationName(I) )//"%longitude" v_str = MISSING_STR CALL QFYAML_Add_Get( Config, TRIM( key ), v_str, "", RC ) IF ( RC /= GC_SUCCESS ) THEN @@ -327,9 +401,9 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF - KPP_Standalone_YAML%LocationLons( I ) = Cast_and_RoundOff( TRIM( v_str ), places=-1 ) + KppSa_State%LocationLons( I ) = Cast_and_RoundOff( TRIM( v_str ), places=-1 ) ! Read latitudes - key = "locations%"//TRIM( KPP_Standalone_YAML%LocationName(I) )//"%latitude" + key = "locations%"//TRIM( KppSa_State%LocationName(I) )//"%latitude" v_str = MISSING_STR CALL QFYAML_Add_Get( Config, TRIM( key ), v_str, "", RC ) IF ( RC /= GC_SUCCESS ) THEN @@ -337,20 +411,20 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) CALL GC_Error( errMsg, RC, thisLoc ) RETURN ENDIF - KPP_Standalone_YAML%LocationLats( I ) = Cast_and_RoundOff( TRIM( v_str ), places=-1 ) + KppSa_State%LocationLats( I ) = Cast_and_RoundOff( TRIM( v_str ), places=-1 ) END DO ! Allocate IDX and JDX (masks for whether a location is on the CPU) - ALLOCATE( KPP_Standalone_YAML%IDX( KPP_Standalone_YAML%NLOC ), STAT=RC ) - CALL GC_CheckVar( 'KPP_Standalone_YAML%IDX', 0, RC ) + ALLOCATE( KppSa_State%IDX( KppSa_State%NLOC ), STAT=RC ) + CALL GC_CheckVar( 'KppSa_State%IDX', 0, RC ) IF ( RC /= GC_SUCCESS ) RETURN - ALLOCATE( KPP_Standalone_YAML%JDX( KPP_Standalone_YAML%NLOC ), STAT=RC ) - CALL GC_CheckVar( 'KPP_Standalone_YAML%JDX', 0, RC ) + ALLOCATE( KppSa_State%JDX( KppSa_State%NLOC ), STAT=RC ) + CALL GC_CheckVar( 'KppSa_State%JDX', 0, RC ) IF ( RC /= GC_SUCCESS ) RETURN - KPP_Standalone_YAML%IDX(:) = -1 - KPP_Standalone_YAML%JDX(:) = -1 + KppSa_State%IDX(:) = -1 + KppSa_State%JDX(:) = -1 !======================================================================== ! Get the list of levels and number of levels @@ -370,13 +444,36 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) N = 1 a_int(1) = 1 END IF - ALLOCATE( KPP_Standalone_YAML%Levels( N ), STAT=RC ) - CALL GC_CheckVar( 'KPP_Standalone_YAML%Levels', 0, RC ) + ALLOCATE( KppSa_State%Levels( N ), STAT=RC ) + CALL GC_CheckVar( 'KppSa_State%Levels', 0, RC ) IF ( RC /= GC_SUCCESS ) RETURN DO I = 1,N - KPP_Standalone_YAML%Levels(I) = a_int(I) + KppSa_State%Levels(I) = a_int(I) END DO + !======================================================================== + ! Get the start & stop date/time for which output will be printed + !======================================================================== + key = "settings%start_output_at" + a_int = MISSING_INT + CALL QFYAML_Add_Get( Config, key, a_int(1:2), "", RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error parsing ' // TRIM( key ) // '!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + KppSa_State%Start_Output = a_int(1:2) + + key = "settings%stop_output_at" + a_int = MISSING_INT + CALL QFYAML_Add_Get( Config, key, a_int(1:2), "", RC ) + IF ( RC /= GC_SUCCESS ) THEN + errMsg = 'Error parsing ' // TRIM( key ) // '!' + CALL GC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + KppSa_State%Stop_Output = a_int(1:2) + !======================================================================== ! Set the output directory !======================================================================== @@ -406,7 +503,7 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) ACTION = "WRITE", & IOSTAT = path_exists, & ACCESS ='SEQUENTIAL' ) - KPP_Standalone_YAML%Output_Directory = "./OutputDir" + KppSa_State%Output_Directory = "./OutputDir" IF ( Input_Opt%amIRoot ) THEN WRITE( 6, '(a)' ) & "KPP Standalone Interface warning: Specified output directory ",& @@ -422,11 +519,11 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) trim(v_str), & " and default output directory './OutputDir' " // & "were not found, writing output to the current directory './'" - KPP_Standalone_YAML%Output_Directory = "./" + KppSa_State%Output_Directory = "./" ENDIF ENDIF ELSE - KPP_Standalone_YAML%Output_Directory = trim(v_str) + KppSa_State%Output_Directory = trim(v_str) close(IU_FILE) END IF @@ -437,25 +534,25 @@ SUBROUTINE Config_KPP_Standalone( Input_Opt, RC ) WRITE( 6, '(a)' ) REPEAT( "=", 79 ) WRITE( 6, '(a,/)' ) "KPP STANDALONE INTERFACE" WRITE( 6, '(a,/)' ) "Model state will be archived at these sites:" - DO I = 1, KPP_Standalone_YAML%NLOC - WRITE( 6, 150 ) KPP_Standalone_YAML%LocationName(I), & - KPP_Standalone_YAML%LocationLons(I), & - KPP_Standalone_YAML%LocationLats(I) + DO I = 1, KppSa_State%NLOC + WRITE( 6, 150 ) KppSa_State%LocationName(I), & + KppSa_State%LocationLons(I), & + KppSa_State%LocationLats(I) 150 FORMAT( a25, "( ", f9.4, ", ", f9.4, " )") ENDDO WRITE( 6, '(/,a)' ) "For GEOS-Chem vertical levels:" - WRITE( 6, '(100i4)' ) KPP_Standalone_YAML%Levels + WRITE( 6, '(100i4)' ) KppSa_State%Levels WRITE( 6, '(a)' ) REPEAT( "=", 79 ) ENDIF - END SUBROUTINE Config_KPP_Standalone + END SUBROUTINE kppSa_Config !EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: Write_Samples +! !IROUTINE: kppsa_write_samples ! ! !DESCRIPTION: Subroutine Write_Samples writes the full chemical state ! (concentrations, reaction rates and rate constants, meteorological @@ -464,11 +561,11 @@ END SUBROUTINE Config_KPP_Standalone !\\ ! !INTERFACE: ! - SUBROUTINE Write_Samples( I, J, L, & - initC, localRCONST, initHvalue, & - exitHvalue, State_Grid, State_Chm, & - State_Met, Input_Opt, KPP_TotSteps, & - RC, FORCE_WRITE, CELL_NAME ) + SUBROUTINE KppSa_Write_Samples( I, J, L, & + initC, localRCONST, initHvalue, & + exitHvalue, State_Grid, State_Chm, & + State_Met, Input_Opt, KPP_TotSteps, & + RC, FORCE_WRITE, CELL_NAME ) ! ! !USES: ! @@ -549,7 +646,7 @@ SUBROUTINE Write_Samples( I, J, L, & IF ( PRESENT( FORCE_WRITE ) ) FORCE_WRITE_AUX = FORCE_WRITE ! Quit early if there's no writing to be done - IF ( .not. KPP_Standalone_ActiveCell%Active_Cell .AND. & + IF ( .not. KppSa_ActiveCell%Active_Cell .AND. & .not. FORCE_WRITE_AUX ) THEN RETURN END IF @@ -582,10 +679,10 @@ SUBROUTINE Write_Samples( I, J, L, & Get_Year(), Get_Month(), Get_Day(), '_', Get_Hour(), Get_Minute() ! Filename for output - filename = TRIM( KPP_Standalone_YAML%Output_Directory ) // & + filename = TRIM( KppSa_State%Output_Directory ) // & '/' // & TRIM( Cell_Name_Aux ) // & - TRIM( KPP_Standalone_ActiveCell%Active_Cell_Name ) // & + TRIM( KppSa_ActiveCell%Active_Cell_Name ) // & '_L' // & trim( level_string ) // & '_' // & @@ -593,17 +690,10 @@ SUBROUTINE Write_Samples( I, J, L, & '.txt' ! Open the file + ! NOTE: We cannot exit from within an !$OMP CRITICAL block OPEN( IU_FILE, FILE=TRIM(filename), ACTION="WRITE", & IOSTAT=RC, ACCESS='SEQUENTIAL') - ! NOTE: Cannot exit from an !$OMP CRITICAL block, so comment out - ! for now - !IF ( RC /= GC_SUCCESS ) THEN - ! errMsg = 'Error writing chemical state to KPP Standalone file' - ! CALL GC_Error( errMsg, RC, '' ) - ! RETURN - !ENDIF - ! Write header to file WRITE( IU_FILE, '(a)' ) '48' WRITE( IU_FILE, '(a)' ) REPEAT("=", 76 ) @@ -648,8 +738,8 @@ SUBROUTINE Write_Samples( I, J, L, & 'Meteorological and general grid cell metadata ' WRITE( IU_FILE, '(a,a)' ) & 'Location: ' // & - TRIM( CELL_NAME_AUX ) // & - TRIM( KPP_Standalone_ActiveCell%ACTIVE_CELL_NAME ) + TRIM( CELL_NAME_AUX ) // & + TRIM( KppSa_ActiveCell%ACTIVE_CELL_NAME ) WRITE( IU_FILE, '(a,a)' ) & 'Timestamp: ', & TIMESTAMP_STRING() @@ -729,14 +819,14 @@ SUBROUTINE Write_Samples( I, J, L, & CLOSE( IU_FILE ) !$OMP END CRITICAL - END SUBROUTINE Write_Samples + END SUBROUTINE KppSa_Write_Samples !EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: cleanup_kpp_standalone +! !IROUTINE: kppsa_cleanup ! ! !DESCRIPTION: Deallocates module variables that may have been allocated ! at run time and unnecessary files required during the process @@ -744,7 +834,7 @@ END SUBROUTINE Write_Samples !\\ ! !INTERFACE: ! - SUBROUTINE Cleanup_KPP_Standalone( RC ) + SUBROUTINE KppSa_Cleanup( RC ) ! ! !USES: ! @@ -769,49 +859,49 @@ SUBROUTINE Cleanup_KPP_Standalone( RC ) ! Assume success RC = GC_SUCCESS - IF ( ALLOCATED( KPP_Standalone_YAML%LocationName ) ) THEN - arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationName' - DEALLOCATE( KPP_Standalone_YAML%LocationName, STAT=RC ) + IF ( ALLOCATED( KppSa_State%LocationName ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KppSa_State%LocationName' + DEALLOCATE( KppSa_State%LocationName, STAT=RC ) CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF - IF ( ALLOCATED( KPP_Standalone_YAML%LocationLons ) ) THEN - arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationLons' - DEALLOCATE( KPP_Standalone_YAML%LocationLons, STAT=RC ) + IF ( ALLOCATED( KppSa_State%LocationLons ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KppSa_State%LocationLons' + DEALLOCATE( KppSa_State%LocationLons, STAT=RC ) CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF - IF ( ALLOCATED( KPP_Standalone_YAML%LocationLats ) ) THEN - arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%LocationLats' - DEALLOCATE( KPP_Standalone_YAML%LocationLats, STAT=RC ) + IF ( ALLOCATED( KppSa_State%LocationLats ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KppSa_State%LocationLats' + DEALLOCATE( KppSa_State%LocationLats, STAT=RC ) CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF - IF ( ALLOCATED( KPP_Standalone_YAML%IDX ) ) THEN - arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%IDX' - DEALLOCATE( KPP_Standalone_YAML%IDX, STAT=RC ) + IF ( ALLOCATED( KppSa_State%IDX ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KppSa_State%IDX' + DEALLOCATE( KppSa_State%IDX, STAT=RC ) CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF - IF ( ALLOCATED( KPP_Standalone_YAML%JDX ) ) THEN - arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%JDX' - DEALLOCATE( KPP_Standalone_YAML%JDX, STAT=RC ) + IF ( ALLOCATED( KppSa_State%JDX ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KppSa_State%JDX' + DEALLOCATE( KppSa_State%JDX, STAT=RC ) CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF - IF ( ALLOCATED( KPP_Standalone_YAML%Levels ) ) THEN - arrayId = 'kpp_standalone_interface.F90:KPP_Standalone_YAML%Levels' - DEALLOCATE( KPP_Standalone_YAML%Levels, STAT=RC ) + IF ( ALLOCATED( KppSa_State%Levels ) ) THEN + arrayId = 'kpp_standalone_interface.F90:KppSa_State%Levels' + DEALLOCATE( KppSa_State%Levels, STAT=RC ) CALL GC_CheckVar( arrayId, 2, RC ) IF ( RC /= GC_SUCCESS ) RETURN ENDIF - END SUBROUTINE Cleanup_KPP_Standalone + END SUBROUTINE KppSa_Cleanup !EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! @@ -880,6 +970,8 @@ FUNCTION Find_Number_of_Levels( a_int ) RESULT( n_valid ) ! !RETURN VALUE: ! INTEGER :: n_valid +! +! !REVISION HISTORY: ! 11 Mar 2024 - P. Obin Sturm - Initial version ! See https://github.com/geoschem/geos-chem for complete history !EOP @@ -899,4 +991,4 @@ FUNCTION Find_Number_of_Levels( a_int ) RESULT( n_valid ) END FUNCTION Find_Number_of_Levels !EOC -END MODULE KPP_Standalone_Interface +END MODULE KppSa_Interface_Mod diff --git a/run/shared/kpp_standalone_interface.yml b/run/shared/kpp_standalone_interface.yml index b468240dd..634751772 100644 --- a/run/shared/kpp_standalone_interface.yml +++ b/run/shared/kpp_standalone_interface.yml @@ -6,10 +6,15 @@ # state so that we can initialize KPP standalone box model simulations. # ============================================================================ +# ------------------------------------ +# General settngs +# ------------------------------------ settings: - activate: false # Master on-off switch - output_directory: "./OutputDir/" # this directory should already exist - levels: # Model levels to archive + activate: false # Main on/off switch + start_output_at: [19000101, 000000] # Save model state for KPP standalone + stop_output_at: [21000101, 000000] # ... if between these 2 datetimes + output_directory: "./OutputDir/" # This directory should already exist + levels: # Model levels to archive - 1 - 2 - 10 @@ -17,8 +22,11 @@ settings: - 35 - 48 - 56 - timestep: 15 # defult to heartbeat timestep + timestep: 15 # Timestep (mins) for KPP standalone +# ------------------------------------ +# Where to archive model state? +# ------------------------------------ active_cells: - LosAngeles - McMurdo @@ -37,6 +45,9 @@ active_cells: - PacificOcean - ElDjouf +# ------------------------------------ +# Active cell geographic coordinates +# ------------------------------------ locations: LosAngeles: longitude: -118.243 From bd24363a0267c1b005aafe7e9cb543e6fd31b1be Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 8 Oct 2024 15:26:10 -0400 Subject: [PATCH 22/37] Further updates for KPP standalone interface GeosCore/kppsa_interface_mod.F90 - In routine KppSa_Check_Time: - rRmoved leftover debug print statements - In routine Kpp_Check_ActiveCell - Added an IF statement to exit after setting KppSa_State%Active_Cell to .FALSE. and KppSa_Active_Cell_Name to '' if we are outside of the time window specified in the kpp_standalone_interface.yml fiel. - This will ensure that we only archive model state to disk during the specified time window, which helps with computatonal efficiency. - In routine KppSa_Config: - Now write starting & ending date of archival window to log file Signed-off-by: Bob Yantosca --- GeosCore/kppsa_interface_mod.F90 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/GeosCore/kppsa_interface_mod.F90 b/GeosCore/kppsa_interface_mod.F90 index 3872e6872..e58890094 100644 --- a/GeosCore/kppsa_interface_mod.F90 +++ b/GeosCore/kppsa_interface_mod.F90 @@ -166,8 +166,7 @@ SUBROUTINE KppSa_Check_Time( RC ) yyyymmdd = Get_Nymd() hhmmss = Get_Nhms() - print*, '%%%', yyyymmdd, hhmmss - + ! Exit if we are outside the window for archiving model state IF ( yyyymmdd < KppSa_State%Start_Output(1) ) RETURN IF ( yyyymmdd > KppSa_State%Stop_Output(1) ) RETURN IF ( hhmmss < KppSa_State%Start_Output(2) ) RETURN @@ -176,7 +175,6 @@ SUBROUTINE KppSa_Check_Time( RC ) ! If we get this far, we're in the time window where we ! archive the chemical state for the KPP standalone KppSa_State%SkipWriteAtThisTime = .FALSE. - print*, '%%% ---> archiving this time!!!' END SUBROUTINE KppSa_Check_Time !EOC @@ -211,13 +209,16 @@ SUBROUTINE KppSa_Check_ActiveCell( I, J, L ) ! INTEGER :: K - ! Early exit if there was no YAML file or no active cells + ! Early exit if KPP standalone interface is disabled IF ( KppSa_State%SkipIt ) RETURN ! Initialize KppSa_ActiveCell%Active_Cell = .FALSE. KppSa_ActiveCell%Active_Cell_Name = '' + ! Skip if we are outside the time interval + IF ( KppSa_State%SkipWriteAtThisTime ) RETURN + ! Flag active cells IF ( ANY( L == KppSa_State%Levels ) ) THEN DO K = 1, KppSa_State%NLOC @@ -542,10 +543,14 @@ SUBROUTINE KppSa_Config( Input_Opt, RC ) ENDDO WRITE( 6, '(/,a)' ) "For GEOS-Chem vertical levels:" WRITE( 6, '(100i4)' ) KppSa_State%Levels - WRITE( 6, '(a)' ) REPEAT( "=", 79 ) + WRITE( 6, 160 ) KppSa_State%Start_Output + 160 FORMAT( "Starting at ", i8.8, 1x, i6.6 ) + WRITE( 6, 170 ) KppSa_State%Stop_Output + 170 FORMAT( "Ending at ", i8.8, 1x, i6.6 ) + WRITE( 6, '(a)' ) REPEAT( "=", 79 ) ENDIF - END SUBROUTINE kppSa_Config + END SUBROUTINE KppSa_Config !EOC !------------------------------------------------------------------------------ ! GEOS-Chem Global Chemical Transport Model ! @@ -646,7 +651,7 @@ SUBROUTINE KppSa_Write_Samples( I, J, L, & IF ( PRESENT( FORCE_WRITE ) ) FORCE_WRITE_AUX = FORCE_WRITE ! Quit early if there's no writing to be done - IF ( .not. KppSa_ActiveCell%Active_Cell .AND. & + IF ( .not. KppSa_ActiveCell%Active_Cell .AND. & .not. FORCE_WRITE_AUX ) THEN RETURN END IF From 8404d6d2093846f8bd7100a5cb3877a53d47ad7f Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Wed, 9 Oct 2024 14:19:55 -0400 Subject: [PATCH 23/37] Now copy kpp_standalone_interface.yml to GCHP fullchem rundirs run/GCHP/createRunDir.sh - Added an if statement to copy run/shared/kpp_standalone_interface.yml to GCHP fullchem run directories (any option) Signed-off-by: Bob Yantosca --- run/GCHP/createRunDir.sh | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/run/GCHP/createRunDir.sh b/run/GCHP/createRunDir.sh index 095d59385..6a14c52db 100755 --- a/run/GCHP/createRunDir.sh +++ b/run/GCHP/createRunDir.sh @@ -622,6 +622,12 @@ if [[ "x${sim_name}" == "xfullchem" || "x${sim_name}" == "xcarbon" ]]; then chmod 744 ${rundir}/metrics.py fi +# Copy the KPP standalone interface config file to ther rundir (fullchem only) +if [[ "x${sim_name}" == "xfullchem" ]]; then + cp -r ${gcdir}/run/shared/kpp_standalone_interface.yml ${rundir} + chmod 644 ${rundir}/kpp_standalone_interface.yml +fi + # Set permissions chmod 744 ${rundir}/cleanRunDir.sh chmod 744 ${rundir}/archiveRun.sh From 1f1b7a0e4315b85bf9b57459fcbb0513b128e22b Mon Sep 17 00:00:00 2001 From: kelvinhb <52680278+kelvinhb@users.noreply.github.com> Date: Wed, 9 Oct 2024 13:50:37 -0600 Subject: [PATCH 24/37] Update HEMCO_Config.rc.fullchem Changed the CEDS TMB emission fields to actually emit TMB like they're supposed to, instead of emitting HCOOH. I'm not sure if this fix needs to go into any other HEMCO_Config.rc template files, either in run/GCClassic or in other run/ directories, but hopefully we can make any other necessary changes down the line --- .../HEMCO_Config.rc.fullchem | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem index 9982d9da4..a953c88f7 100644 --- a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem +++ b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem @@ -1630,13 +1630,13 @@ VerboseOnCores: root # Accepted values: root all 0 CEDS_HCOOH_SLV $ROOT/CEDS/v2021-06/$YYYY/HCOOH-em-anthro_CMIP_CEDS_$YYYY.nc HCOOH_slv 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 2407/707 1 5 0 CEDS_HCOOH_WST $ROOT/CEDS/v2021-06/$YYYY/HCOOH-em-anthro_CMIP_CEDS_$YYYY.nc HCOOH_wst 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 -0 CEDS_TMB_AGR $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_agr 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 -0 CEDS_TMB_ENE $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ene 1750-2019/1-12/1/0 C xyL* kg/m2/s HCOOH 26/315 1 5 -0 CEDS_TMB_IND $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ind 1750-2019/1-12/1/0 C xyL* kg/m2/s HCOOH 26/316 1 5 -0 CEDS_TMB_TRA $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_tra 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 -0 CEDS_TMB_RCO $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_rco 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 -0 CEDS_TMB_SLV $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_slv 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 -0 CEDS_TMB_WST $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_wst 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 +0 CEDS_TMB_AGR $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_agr 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 1 5 +0 CEDS_TMB_ENE $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ene 1750-2019/1-12/1/0 C xyL* kg/m2/s TMB 26/315 1 5 +0 CEDS_TMB_IND $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ind 1750-2019/1-12/1/0 C xyL* kg/m2/s TMB 26/316 1 5 +0 CEDS_TMB_TRA $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_tra 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 1 5 +0 CEDS_TMB_RCO $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_rco 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 1 5 +0 CEDS_TMB_SLV $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_slv 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 1 5 +0 CEDS_TMB_WST $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_wst 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 1 5 0 CEDS_OTH_AGR $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_agr 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 1 5 0 CEDS_OTH_ENE $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_ene 1750-2019/1-12/1/0 C xyL* kg/m2/s ALK6 26/315 1 5 From 5d5c4a31df8efc06ec8dea9e5f1d38ed404c46a7 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 10 Oct 2024 15:38:44 -0400 Subject: [PATCH 25/37] Now import the KPP-Standalone repo as a Git submodule KPP/standalone - Folder which contains source code from the GitHub repository: https://github.com/geoschem/KPP-Standalone. This is a fork of the https://github.com/KineticPreProcessor/KPP-Standalone repo by Obin Sturm, Mike Long, and Christoph Keller. The branch geoschem-dev is checked out. This is where we can place GEOS-Chem-specific updates without touching the original code in the kpp-standalone branch. branch is set to geoschem-dev, which is the branch to be used for interfacing into the GEOS-Chem model .gitmodules - This was updated by running the command: git submodule add -b geoschem-dev \ https://github.com/geoschem/KPP-Standalone \ KPP/standalone CHANGELOG.md - Updated accordingly KPP/fullchem/Makefile KPP/fullchem/kpp_standalone*.F90 KPP/fullchem/samples_kpp_standalone/* - Removed from the KPP/fullchem folder. KPP/standalone - Folder containing code from https://github.com/geoschem/KPP-Standalone Signed-off-by: Bob Yantosca --- .gitmodules | 4 + CHANGELOG.md | 2 +- KPP/fullchem/Makefile | 192 -- KPP/fullchem/kpp_standalone.F90 | 240 -- KPP/fullchem/kpp_standalone_init.F90 | 123 - .../Beijing_L1_20200106_1345.txt | 2133 ----------------- KPP/standalone | 1 + 7 files changed, 6 insertions(+), 2689 deletions(-) create mode 100644 .gitmodules delete mode 100644 KPP/fullchem/Makefile delete mode 100644 KPP/fullchem/kpp_standalone.F90 delete mode 100644 KPP/fullchem/kpp_standalone_init.F90 delete mode 100644 KPP/fullchem/samples_kpp_standalone/Beijing_L1_20200106_1345.txt create mode 160000 KPP/standalone diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 000000000..9ec985b8f --- /dev/null +++ b/.gitmodules @@ -0,0 +1,4 @@ +[submodule "KPP/standalone"] + path = KPP/standalone + url = https://github.com/geoschem/KPP-Standalone + branch = geoschem-dev diff --git a/CHANGELOG.md b/CHANGELOG.md index cbb13a6cb..a19eed2e5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,7 +17,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Added computation of water concentration to use in photolysis for application of UV absorption by water in Cloud-J v8 - Added ACO3, ACR, ACRO2, ALK4N{1,2,O}2, ALK4P, ALK7, APAN, APINN, APINO2, APINP, AROCMCHO, AROMCO3, AROMPN, BPINN, BPINO2, BPINON, BPINOO2, BPINOOH, BPINP, BUTN, BUTO2, C4H6, C96N, C96O2, C9602H, EBZ, GCO3, HACTA, LIMAL, LIMKB, LIMKET, LIMKO2, LIMN, LIMNB, LIMO2H, LIMO3, LIMO3H, LIMPAN, MEKCO3, MEKPN, MYRCO, PHAN, PIN, PINAL, PINO3, PINONIC, PINPAN, R7N{1,2}, R7O2, R7P, RNO3, STYR, TLFUO2, TLFUONE, TMB, ZRO2 to `species_database.yml` following Travis et al. 2024. - Added TSOIL1 field to `State_Met` for use in HEMCO soil NOx extension. This should only be read in when the `UseSoilTemperature` option is true in HEMCO config. -- Added KPP standalone +- Added `https://github/geoschem/KPP-Standalone` as a Git submodule (`geoschem-dev` branch) ### Changed - Copy values from `State_Chm%KPP_AbsTol` to `ATOL` and `State_Chm%KPP_RelTol` to `RTOL` for fullchem and Hg simulations diff --git a/KPP/fullchem/Makefile b/KPP/fullchem/Makefile deleted file mode 100644 index d3d7ce3b8..000000000 --- a/KPP/fullchem/Makefile +++ /dev/null @@ -1,192 +0,0 @@ -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# User: Set here the F90 compiler and options -# Pedefined compilers: INTEL, PGF, HPUX, LAHEY -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -#COMPILER = G95 -#COMPILER = LAHEY -#COMPILER = INTEL -#COMPILER = PGF -#COMPILER = HPUX -COMPILER = GFORTRAN - -FC_G95 = g95 -FOPT_G95 = -cpp -O -pg -fbounds-check -fimplicit-none -Wall -ftrace=full - -FC_LAHEY = lf95 -# More aggressive for production runs: -#FOPT_LAHEY = -Cpp --pca -O -# More checking for debugging: -FOPT_LAHEY = -Cpp --chk a,e,s,u --pca --ap -O0 -g --trap --trace --chkglobal - -FC_INTEL = ifort -# More aggressive for production runs: -#FOPT_INTEL = -cpp -O -fp-model precise -pc80 -prec_div -# More checking for debugging: -FOPT_INTEL = -cpp -O0 -fp-model strict -implicitnone -ftrapuv \ - -debug all -check all -warn all - -FC_PGF = pgf90 -# More aggressive for production runs: -FOPT_PGF = -Mpreprocess -O -fast -pc 80 -Kieee -# More checking for debugging: -#FOPT_PGF = -Mpreprocess -O0 -Mbounds -Mchkfpstk -Mchkptr -Mchkstk \ -# -Ktrap=fp -pc 80 -Kieee - -FC_HPUX = f90 -FOPT_HPUX = -O -u +Oall +check=on - -FC_GFORTRAN = gfortran -#FOPT_GFORTRAN = -cpp -g -fbacktrace -fcheck=all -ffpe-trap=invalid,zero,overflow #bounds -FOPT_GFORTRAN = -cpp -O - -# define FULL_ALGEBRA for non-sparse integration -FC = $(FC_$(COMPILER)) -FOPT = $(FOPT_$(COMPILER)) # -DFULL_ALGEBRA - -LIBS = -#LIBS = -llapack -lblas - -# Command to create Matlab mex gateway routines -# Note: use $(FC) as the mex Fortran compiler -MEX = mex - -GENSRC = gckpp_Precision.F90 \ - gckpp_Parameters.F90 \ - gckpp_Global.F90 - -GENOBJ = gckpp_Precision.o \ - gckpp_Parameters.o \ - gckpp_Global.o - -FUNSRC = gckpp_Function.F90 -FUNOBJ = gckpp_Function.o - -JACSRC = gckpp_JacobianSP.F90 gckpp_Jacobian.F90 -JACOBJ = gckpp_JacobianSP.o gckpp_Jacobian.o - -UTLSRC = gckpp_Rates.F90 gckpp_Util.F90 gckpp_Monitor.F90 fullchem_RateLawFuncs.F90 rateLawUtilFuncs.F90 -UTLOBJ = gckpp_Rates.o gckpp_Util.o gckpp_Monitor.o fullchem_RateLawFuncs.o rateLawUtilFuncs.o - -LASRC = gckpp_LinearAlgebra.F90 -LAOBJ = gckpp_LinearAlgebra.o - -STOCHSRC = gckpp_Stochastic.F90 -STOCHOBJ = gckpp_Stochastic.o - -MODSRC = gckpp_Model.F90 -MODOBJ = gckpp_Model.o - -INISRC = gckpp_Initialize.F90 -INIOBJ = gckpp_Initialize.o - -MAINSRC = kpp_standalone.F90 gckpp_Initialize.F90 gckpp_Integrator.F90 gckpp_Model.F90 -MAINOBJ = kpp_standalone.o gckpp_Initialize.o gckpp_Integrator.o - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# User: modify the line below to include only the -# objects needed by your application -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -ALLOBJ = $(GENOBJ) $(JACOBJ) $(FUNOBJ) $(HESOBJ) $(STMOBJ) \ - $(UTLOBJ) $(LAOBJ) $(MODOBJ) $(INIOBJ) $(SFCOBJ) - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# User: modify the line below to include only the -# executables needed by your application -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -all: exe - -exe: $(ALLOBJ) $(MAINOBJ) kpp_standalone_init.o - $(FC) $(FOPT) kpp_standalone.F90 gckpp_Integrator.o kpp_standalone_init.o $(ALLOBJ) $(LIBS) -o kpp_standalone.exe - - -stochastic:$(ALLOBJ) $(STOCHOBJ) $(MAINOBJ) - $(FC) $(FOPT) $(ALLOBJ) $(STOCHOBJ) $(MAINOBJ) $(LIBS) \ - -o gckpp_stochastic.exe - -mex: $(ALLOBJ) - $(MEX) FC#$(FC) -fortran -O gckpp_mex_Fun.F90 $(ALLOBJ) - $(MEX) FC#$(FC) -fortran -O gckpp_mex_Jac_SP.F90 $(ALLOBJ) - $(MEX) FC#$(FC) -fortran -O gckpp_mex_Hessian.F90 $(ALLOBJ) - -clean: - rm -f *.o *.mod\ - gckpp*.dat kpp_standalone.exe gckpp*.mexglx \ - gckpp.map - -distclean: - rm -f *.o *.mod \ - gckpp*.dat kpp_standalone.exe gckpp.map \ - gckpp*.F90 gckpp_*.mexglx - -gckpp_Precision.o: gckpp_Precision.F90 - $(FC) $(FOPT) -c $< - -gckpp_Parameters.o: gckpp_Parameters.F90 \ - gckpp_Precision.o - $(FC) $(FOPT) -c $< - -gckpp_Monitor.o: gckpp_Monitor.F90 \ - gckpp_Precision.o - $(FC) $(FOPT) -c $< - -gckpp_Global.o: gckpp_Global.F90 \ - gckpp_Parameters.o gckpp_Precision.o - $(FC) $(FOPT) -c $< - -gckpp_Initialize.o: gckpp_Initialize.F90 $(GENOBJ) - $(FC) $(FOPT) -c $< - -gckpp_Function.o: gckpp_Function.F90 $(GENOBJ) - $(FC) $(FOPT) -c $< - -gckpp_Stochastic.o: gckpp_Stochastic.F90 $(GENOBJ) - $(FC) $(FOPT) -c $< - -gckpp_JacobianSP.o: gckpp_JacobianSP.F90 $(GENOBJ) - $(FC) $(FOPT) -c $< - -gckpp_Jacobian.o: gckpp_Jacobian.F90 $(GENOBJ) gckpp_JacobianSP.o - $(FC) $(FOPT) -c $< - -gckpp_LinearAlgebra.o: gckpp_LinearAlgebra.F90 $(GENOBJ) gckpp_JacobianSP.o - $(FC) $(FOPT) -c $< - -rateLawUtilFuncs.o: rateLawUtilFuncs.F90 - $(FC) $(FOPT) -c $< - -fullchem_RateLawFuncs.o: fullchem_RateLawFuncs.F90 rateLawUtilFuncs.o - $(FC) $(FOPT) -c $< - -gckpp_Rates.o: gckpp_Rates.F90 $(GENOBJ) fullchem_RateLawFuncs.o - $(FC) $(FOPT) -c $< - -gckpp_HessianSP.o: gckpp_HessianSP.F90 $(GENOBJ) - $(FC) $(FOPT) -c $< - -gckpp_Hessian.o: gckpp_Hessian.F90 $(GENOBJ) gckpp_HessianSP.o - $(FC) $(FOPT) -c $< - -gckpp_Util.o: gckpp_Util.F90 $(GENOBJ) gckpp_Monitor.o - $(FC) $(FOPT) -c $< - -gckpp_Main.o: gckpp_Main.F90 $(ALLOBJ) gckpp_Initialize.o gckpp_Model.o gckpp_Integrator.o - $(FC) $(FOPT) -c $< - -gckpp_Model.o: gckpp_Model.F90 $(ALLOBJ) gckpp_Integrator.o - $(FC) $(FOPT) -c $< - -gckpp_Integrator.o: gckpp_Integrator.F90 $(ALLOBJ) - $(FC) $(FOPT) -c $< - -kpp_standalone_init.o: kpp_standalone_init.F90 gckpp_Parameters.o - $(FC) $(FOPT) -c $< - -kpp_standalone.o: kpp_standalone.F90 kpp_standalone_init.o gckpp_Integrator.o $(ALLOBJ) - $(FC) $(FOPT) -c $< - - - - -#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/KPP/fullchem/kpp_standalone.F90 b/KPP/fullchem/kpp_standalone.F90 deleted file mode 100644 index daa67fc58..000000000 --- a/KPP/fullchem/kpp_standalone.F90 +++ /dev/null @@ -1,240 +0,0 @@ -program main - -! The KPP Standalone for GEOS-Chem Mechanism Analysis -! -! -! Program Description: -! -! This program runs the GEOS-Chem KPP Standalone for a given set of initial conditions. -! It reads an input file generated by the KPP Standalone Interface that generates model -! output of the full chemical state of grid cells in 3D GEOS-Chem, GCHP, and GEOS-CF runs. -! The full mechanism is run to replicate the chemistry of the specified grid cell. -! Obin Sturm (psturm@usc.edu), Michael S Long, Christoph Keller - -! The KPP Standalone is adapted from a box model used in the following publication: -! Lin, H., Long, M. S., Sander, R., Sandu, A., Yantosca, R. M., Estrada, L. A., et al. (2023). -! An adaptive auto-reduction solver for speeding up integration of chemical kinetics in atmospheric chemistry models: -! Implementation and evaluation in the Kinetic Pre-Processor (KPP) version 3.0.0. -! Journal of Advances in Modeling Earth Systems, 15, e2022MS003293. https://doi.org/10.1029/2022MS003293 - -! Updates: -! - 2024/05/06, Obin Sturm: Simplification of the code for the GEOS-Chem KPP Standalone, -! removed all autoreduce and convergence criteria testing. -! The more general tool just runs one operator timestep -! and then prints out the results to an output file. - - USE GCKPP_GLOBAL - USE GCKPP_JACOBIANSP - USE GCKPP_PARAMETERS - USE GCKPP_MONITOR - USE GCKPP_MODEL - USE KPP_STANDALONE_INIT, ONLY: read_input - - - IMPLICIT NONE - - INTEGER :: ICNTRL(20), IERR, I - INTEGER :: ISTATUS(20) - INTEGER :: fileTotSteps - INTEGER :: level - REAL(dp) :: OperatorTimestep - REAL(dp) :: RCNTRL(20) - REAL(dp) :: Hstart - REAL(dp) :: Hexit - REAL(dp) :: cosSZA - REAL(dp) :: RSTATE(20) - REAL(dp) :: T, TIN, TOUT, start, end - REAL :: full_sumtime, full_avg - - INTEGER :: NRTOL, NSTEPSt ! Number of iterations in the timing averaging loop - - REAL(dp) :: Vloc(NVAR), Cinit(NSPEC), R(NREACT) - - LOGICAL :: OUTPUT - LOGICAL :: ReInit - - - ! Vars for reading files - character(len=256) :: inputfile - character(len=256) :: outputfile - - - ! Check if an argument was provided - if (command_argument_count() .ge. 1) then - ! Get the first argument - call get_command_argument(1, inputfile) - print*, 'Processing sample: ', trim(inputfile) - else - print*, 'No sample provided. Exiting.' - stop - endif - ! If a second argument is provided, use it as the output file - if (command_argument_count() .ge. 2) then - ! Get the second argument - call get_command_argument(2, outputfile) - print*, 'Output file: ', trim(outputfile) - endif - - OUTPUT = .false. - REINIT = .true. ! Reset C every NITR,NRTOL iteration -! REINIT = .false. ! Let C evolve over the NRTOL loop - NRTOL = 0 - - - - - ! Read the input file - call read_input(inputfile, R, Cinit, SPC_NAMES, Hstart, Hexit, cosSZA, level, fileTotSteps, OperatorTimestep) - - - - ! Run the full mechanism - call fullmech(RTOL_VALUE=0.5e-2_dp) - - ! Write the output file - if (command_argument_count() .ge. 2) then - call write_output(inputfile,outputfile) - endif - -CONTAINS - - subroutine fullmech(RTOL_VALUE) - USE GCKPP_INTEGRATOR - USE GCKPP_RATES - USE GCKPP_INITIALIZE - USE GCKPP_GLOBAL - - IMPLICIT NONE - - REAL(dp) :: RTOL_VALUE - - ! Set OPTIONS - IERR = 0 ! Success or failure flag - ISTATUS = 0 ! Rosenbrock output - RCNTRL = 0.0_dp ! Rosenbrock input - RCNTRL(3) = Hstart - ! write(*,'(a,f10.2)') " Hstart: ", Hstart - RSTATE = 0.0_dp ! Rosenbrock output - ICNTRL = 0 - ICNTRL(1) = 1 - ICNTRL(2) = 0.000_dp - ICNTRL(3) = 4 - ICNTRL(7) = 1 - ICNTRL(15) = -1 - - ! Tolerances - ATOL = 1e-2_dp - RTOL = RTOL_VALUE ! default in GEOS-CF 2.0 is 0.5e-2_dp - - ! Set ENV - T = 0d0 - TIN = T - TOUT = T + OperatorTimestep - TEMP = 298. - - full_avg = 0. - full_sumtime = 0. - start = 0. - end = 0. - - ! Initialize concentrations - C(1:NSPEC) = Cinit(1:NSPEC) - ! Assign RCONST to rate constants from file - ! rather than - ! call Update_RCONST() - RCONST = R - - ! Integrate the mechanism for an operator timestep - CALL Integrate( TIN, TOUT, ICNTRL, & - RCNTRL, ISTATUS, RSTATE, IERR ) - NSTEPSt = ISTATUS(3) - write(*,'(a,i5)') " Number of internal timesteps (from 3D run): ", fileTotSteps - write(*,'(a,i5)') " Number of internal timesteps ( standalone): ", ISTATUS(3) - ! write Hexit for 3D vs standalone - write(*,'(a,f10.2)') " Hexit (from 3D run): ", Hexit - write(*,'(a,f10.2)') " Hexit ( standalone): ", RSTATE(2) - - ! Check if 3D results are consistent with standalone - if (fileTotSteps /= ISTATUS(3)) then - write(0,*) "Warning: Number of internal steps do not match 3D grid cell" - endif - if (abs(Hexit-RSTATE(2))/Hexit>.001) then - write(0,*) "Warning: final timestep does not match 3D grid cell within 0.1%" - endif - - ! Run the RTOL variation loop - DO I=1,NRTOL - call Initialize() - C(1:NSPEC) = Cinit(1:NSPEC) - - VAR(1:NVAR) => C(1:NVAR) - FIX(1:NFIX) => C(NVAR+1:NSPEC) - ! Set RCONST - ! call Update_RCONST() - - CALL Fun( C, FIX, RCONST, Vloc ) - - ! Get a random RTOL - CALL RANDOM_NUMBER(RTOL) - RTOL = 10**(-2.*RTOL) - - ! Integrate - CALL Integrate( TIN, TOUT, ICNTRL, & - RCNTRL, ISTATUS, RSTATE, IERR ) - call cpu_time(end) - write(*,*) "Number of internal timesteps random RTOL: ", ISTATUS(3) - ENDDO - - - return - end subroutine fullmech - - subroutine write_output(inputfile, outputfile) - ! USE GCKPP_GLOBAL - character(len=256) :: outputfile - character(len=256) :: inputfile - character(len=256) :: header(30) - integer :: i - character(len=256) :: line - - ! Write meteo data lines of the input to the output file - open(20, file=outputfile) - open(10, file=inputfile, status='old') - - ! Write the header lines to the output file - write(20, '(A)') "30" - write(20, '(A)') "===========================================================================" - write(20, '(A)') "" - write(20, '(A)') "KPP Standalone Output" - write(20, '(A)') "This file contains the concentrations of all the chemical species" - write(20, '(A)') "in a single grid cell of a GEOS-Chem 3D run as replicated by the " - write(20, '(A)') "KPP Standalone. Concentrations before and after the operator timestep" - write(20, '(A)') "are in CSV format, below." - write(20, '(A)') "" - write(20, '(A)') "Generated by the GEOS-Chem KPP Standalone:" - write(20, '(A)') "https://github.com/KineticPreProcessor/KPP-Standalone" - write(20, '(A)') "" - write(20, '(A)') "Input file used: " // trim(inputfile) - - ! Skip the first 26 lines of the input file - do i=1,26 - read(10,'(A)') line - enddo - do i=27,43 - read(10,'(A)') line - write(20,'(A)') line - enddo - close(10) - write(20, '(A)') "" - write(20, '(A)') "===========================================================================" - write(20, '(A)') "Species Name,Initial Concentration (molec/cc),Final Concentration (molec/cc)" - ! write the species names, initial and final concentrations - do i=1,NSPEC - write(20, '(A,E25.16,A,E25.16)') trim(SPC_NAMES(i))//",", Cinit(i), ",", C(i) - enddo - close(20) - - end subroutine write_output - -end program main - diff --git a/KPP/fullchem/kpp_standalone_init.F90 b/KPP/fullchem/kpp_standalone_init.F90 deleted file mode 100644 index f618c3b88..000000000 --- a/KPP/fullchem/kpp_standalone_init.F90 +++ /dev/null @@ -1,123 +0,0 @@ -module kpp_standalone_init - implicit none - public -contains - -subroutine read_input(filename, R, C, SPC_NAMES, Hstart, Hexit, cosSZA, level, fileTotSteps, OperatorTimestep) -USE gckpp_Parameters - - IMPLICIT NONE - - real(dp), intent(out) :: C(NSPEC) - real(dp), intent(out) :: R(NREACT) - real(dp), intent(out) :: Hstart - real(dp), intent(out) :: Hexit - real(dp), intent(out) :: cosSZA - real(dp), intent(out) :: OperatorTimestep - integer, intent(out) :: level - integer, intent(out) :: fileTotSteps - integer :: SPC_MAP(NSPEC) - - - - character(len=*), intent(in) :: SPC_NAMES(NSPEC) - character(len=*), intent(in) :: filename - integer :: i, ierr, NHEADER, idx - character(200) :: line - logical :: existbool - - ! Declare variables for file I/O - integer :: file_unit - - ! Open the file for reading - file_unit = 999 - inquire(file=filename, exist=existbool) - if (existbool .neqv. .TRUE.) then - print *, "Error: input file does not exist: ", trim(filename) - stop - end if - open(unit=file_unit, file=filename, iostat=ierr) - if (ierr /= 0) then - print *, "Error opening input file" - stop - end if - - ! Read the number of header lines - read(file_unit, *) NHEADER - - ! Read the header lines - do i = 1, NHEADER - read(file_unit, '(A)', iostat=ierr) line - if (ierr /= 0) then - print *, "Error reading line", i - exit - end if - ! Get level - if (index(line, 'GEOS-Chem Vertical Level:') > 0 ) then - idx = index(line, ':') + 1 - read(line(idx:), *) level - endif - ! Get cosSZA - if (index(line, 'Cosine of solar zenith angle:') > 0 ) then - idx = index(line, ':') + 1 - read(line(idx:), *) cosSZA - end if - ! get Hstart - if (index(line, 'Init KPP Timestep (seconds):') > 0 ) then - idx = index(line, ':') + 1 - read(line(idx:), *) Hstart - end if - - ! get Hexit - if (index(line, 'Exit KPP Timestep (seconds):') > 0 ) then - idx = index(line, ':') + 1 - read(line(idx:), *) Hexit - end if - - ! get fileTotSteps - if (index(line, 'Number of internal timesteps:') > 0 ) then - idx = index(line, ':') + 1 - read(line(idx:), *) fileTotSteps - end if - - ! Get value of operator splitting timestep - if (index(line, 'Chemistry operator timestep (seconds):') > 0 ) then - idx = index(line, ':') + 1 - read(line(idx:), *) OperatorTimestep - end if - end do - - ! Read the species and their concentrations - do i = 1, NSPEC - read(file_unit, '(A)', iostat=ierr) line - if (ierr /= 0) then - print *, "Error reading line", i+NHEADER - exit - end if - idx = index(line, ',') + 1 - read(line(idx:), *) C(i) - ! Check if the species name matches the expected SPC_NAMES(i) - if (trim(line(1:idx-2)) /= trim(SPC_NAMES(i))) then - print *, "Error: species name mismatch" - print *, "Expected: ", SPC_NAMES(i) - print *, "Found: ", line(1:idx-2) - stop - end if - end do - ! Read the rate constants - do i = 1, NREACT - read(file_unit, '(A)', iostat=ierr) line - if (ierr /= 0) then - print *, "Error reading line", i+NSPEC+NHEADER - exit - end if - idx = index(line, ',') + 1 - read(line(idx:), *) R(i) - end do - - ! Close the file - close(file_unit) -end subroutine read_input - -end module kpp_standalone_init - diff --git a/KPP/fullchem/samples_kpp_standalone/Beijing_L1_20200106_1345.txt b/KPP/fullchem/samples_kpp_standalone/Beijing_L1_20200106_1345.txt deleted file mode 100644 index 54eb238f1..000000000 --- a/KPP/fullchem/samples_kpp_standalone/Beijing_L1_20200106_1345.txt +++ /dev/null @@ -1,2133 +0,0 @@ -48 -=========================================================================== - - KPP Standalone Atmospheric Chemical State -File Description: -This file contains model output of the atmospheric chemical state -as simulated by the GEOS-Chem chemistry module in a 3D setting. -Each grid cell represents the chemical state of an individual location, -suitable for input into a separate KPP Standalone program which will -replicate the chemical evolution of that grid cell for mechanism analysis. -Note that the KPP Standalone will only use concentrations, rate constants, -and KPP-specific fields. All other fields are for reference. The first line -contains the number of lines in this header. If wanting to use this output -for other analysis, a Python class to read these fields is available by -request, contact Obin Sturm (psturm@usc.edu). - -Generated by the GEOS-Chem Model - (https://geos-chem.org/) -Using the KPP Standalone Interface -github.com/GEOS-ESM/geos-chem/tree/feature/psturm/kpp_standalone_interface - With contributions from: - Obin Sturm (psturm@usc.edu) - Christoph Keller - Michael Long - Sam Silva - -Meteorological and general grid cell metadata -Location: Beijing -Timestamp: 2020/01/06 13:45 -Longitude (degrees): 117.0185 -Latitude (degrees): 39.8364 -GEOS-Chem Vertical Level: 1 -Pressure (hPa): 1009.8350 -Temperature (K): 275.90 -Dry air density (molec/cm3): 0.2646E+20 -Water vapor mixing ratio (vol H2O/vol dry air): 0.3956E-02 -Cloud fraction: 0.0000E+00 -Cosine of solar zenith angle: -0.8279E+00 -KPP Integrator-specific parameters -Init KPP Timestep (seconds): 268.3002 -Exit KPP Timestep (seconds): 32.4352 -Chemistry operator timestep (seconds): 900.0000 -Number of internal timesteps: 28 -CSV data of full chemical state, including species concentrations, -rate constants (R) and instantaneous reaction rates (A). -All concentration units are in molecules/cc and rates in molec/cc/s. - -=========================================================================== -Name, Value -CH2I2, 0.5229637490161687E+06 -CH2IBr, 0.5401741649323440E+06 -CH2ICl, 0.2389579494513276E+07 -AERI, 0.1144044191044774E+12 -AONITA, 0.2224684129917660E+10 -BUTDI, 0.0000000000000000E+00 -CO2, 0.7331505456875255E+16 -INDIOL, 0.3917484033613435E+10 -ISALA, 0.1340074753973859E+09 -ISALC, 0.2656091737594891E+08 -LBRO2H, 0.1110359179531490E+11 -LBRO2N, 0.1007852162653296E+13 -BRO2, 0.2641206128574977E-01 -LISOPOH, 0.0000000000000000E+00 -LISOPNO3, 0.0000000000000000E+00 -LNRO2H, 0.0000000000000000E+00 -LNRO2N, 0.0000000000000000E+00 -NRO2, 0.0000000000000000E+00 -NAP, 0.0000000000000000E+00 -LTRO2H, 0.6236742963112886E+11 -LTRO2N, 0.8070360765686937E+13 -TRO2, 0.2093893768543299E+00 -LVOCOA, 0.6865493588792447E+06 -LVOC, 0.3860877065010954E-12 -LXRO2H, 0.1045239082629581E+12 -LXRO2N, 0.1788823543222465E+14 -XRO2, 0.4720263884380698E+00 -MSA, 0.2234785005701510E+08 -SO4s, 0.7764798777941527E+04 -SOAGX, 0.4090001577327538E+10 -SOAIE, 0.2203718566890857E+08 -PH2SO4, 0.0000000000000000E+00 -PSO4AQ, 0.0000000000000000E+00 -POx, 0.0000000000000000E+00 -LOx, 0.0000000000000000E+00 -PCO, 0.0000000000000000E+00 -LCO, 0.0000000000000000E+00 -PSO4, 0.0000000000000000E+00 -LCH4, 0.0000000000000000E+00 -PH2O2, 0.0000000000000000E+00 -FURA, 0.0000000000000000E+00 -I2O4, 0.1167034727981632E+03 -CH3CCl3, 0.3228183624351780E+08 -I2O2, 0.2324264092827573E+01 -MONITA, 0.1940705460275071E+05 -CH3I, 0.2343881382469887E+18 -H1301, 0.8837813935404474E+08 -H2402, 0.1031960367575871E+08 -I2O3, 0.2203119638453422E+04 -PPN, 0.3460312900826755E+10 -BrNO2, 0.6488710748759532E+07 -CCl4, 0.2024494423926137E+10 -CFC11, 0.5883761894554182E+10 -CFC12, 0.1316463914410311E+11 -CFC113, 0.1822336061620289E+10 -CFC114, 0.4170177861429334E+09 -CFC115, 0.2254436296880906E+09 -C2H2, 0.5834922670950449E+07 -H1211, 0.8387986249343947E+08 -INO, 0.9891785567337147E+12 -N2O, 0.8749965335219539E+13 -NIT, 0.3058886926899389E+12 -NITs, 0.6257543667380522E+07 -BENZ, 0.6937024682064159E+11 -N, 0.0000000000000000E+00 -OCS, 0.1323026012059447E+11 -PAN, 0.9333859503481314E+10 -ETHN, 0.6856839955684951E+08 -HI, 0.1269691884187007E+08 -BZCO3H, 0.9872402025956239E+06 -CH2Br2, 0.2931842381278095E+08 -CH2Cl2, 0.1622230536880044E+10 -IBr, 0.1562391091756119E+08 -MPN, 0.6012943409089624E+04 -Cl2O2, 0.5173211532367032E-09 -C2H4, 0.1466026680876448E+12 -CHBr3, 0.4476269237077630E+08 -CHCl3, 0.3257499859497513E+09 -TOLU, 0.1015123360163832E+12 -XYLE, 0.8244156860306589E+11 -HCFC123, 0.4596006423189103E-12 -HCFC141b, 0.6922072309276936E+09 -HCFC142b, 0.6022414644762596E+09 -HCFC22, 0.6637092294037771E+10 -HMHP, 0.5877245987218773E+09 -HMS, 0.6137832069261662E+09 -IPRNO3, 0.6629851971103431E+09 -MAP, 0.1820720190242983E+09 -MENO3, 0.9356153733386898E+08 -DMS, 0.2902139473719242E+07 -NPRNO3, 0.1669379444014273E+09 -OIO, 0.1547825002243250E+06 -R4P, 0.7487585398980704E+08 -RA3P, 0.2082343766763396E+08 -RB3P, 0.5000705540901479E+08 -ETNO3, 0.4927966639222008E+08 -BZPAN, 0.1136449449987494E+09 -IONITA, 0.4729234234451677E+06 -ICl, 0.1013411688899271E+10 -CH3Br, 0.1886743857442678E+09 -BALD, 0.5910334621516049E+09 -HNO4, 0.8513066102930259E-02 -ClOO, 0.3365253171069412E-05 -PYAC, 0.7023899207442132E+06 -HMML, 0.2301945437195899E+07 -RP, 0.4015755068441701E+08 -BENZP, 0.1073868393198497E+09 -ETO, 0.2476500881603519E-09 -IDC, 0.8431471935696354E+06 -ETP, 0.8940086009759392E+08 -OClO, 0.1186007491717479E+03 -PP, 0.1203713763240346E+08 -PRPN, 0.3145851714794756E+07 -ALK4, 0.6551747808160359E+12 -CSL, 0.2579982490777665E+09 -IEPOXD, 0.1442702830805874E+04 -MVKDH, 0.1849508049612781E+06 -PHEN, 0.6743065979240134E+08 -PIP, 0.8167446156122749E+06 -ETHP, 0.3760716219796737E+08 -HPALD1OO, 0.3976332952948804E-07 -SO4, 0.5575080956448196E+11 -HPALD2OO, 0.1842449595925098E-05 -C3H8, 0.6580496174372583E+11 -IDCHP, 0.3403067689047770E+03 -INA, 0.1311257373082687E-05 -HPALD4, 0.1811043958585358E+06 -Br2, 0.1100831081758089E+05 -HPALD3, 0.5514992121742772E+04 -IEPOXA, 0.2067125201519981E+05 -IEPOXB, 0.1127760591493828E+05 -MCRDH, 0.1228901758190398E+05 -EOH, 0.6607085206386980E+11 -HONIT, 0.1242500317585665E-02 -BrCl, 0.6616758481666051E+05 -MACR1OOH, 0.9671446016763883E+04 -MP, 0.1065686935146700E+10 -SALCAL, 0.1120569793240006E-02 -IHN2, 0.8575111261658903E-05 -IHN3, 0.1426043547472750E+01 -IDHDP, 0.5175656020780997E+04 -MCT, 0.3497597127212082E+07 -I2, 0.4981218560868793E+14 -C4HVP1, 0.0000000000000000E+00 -C4HVP2, 0.0000000000000000E+00 -IDNOO, 0.1972225006866904E-09 -SALAAL, 0.4177280042017358E-01 -AROMP5, 0.3032020034279350E+04 -CH3Cl, 0.1464979976877486E+11 -ICNOO, 0.2229150337409803E-03 -INPD, 0.6616683051278342E-01 -ISOPNOO2, 0.1297706055126308E-13 -MPAN, 0.3558758708816536E+07 -MTPA, 0.1763812179356158E+09 -MTPO, 0.5569552889788204E+08 -MVKPC, 0.6877214935803887E+06 -RIPA, 0.8517323717731006E+05 -ROH, 0.4061601567421934E+06 -AROMP4, 0.1963222624667651E+03 -BENZO, 0.3068120088610019E+07 -C2H6, 0.1735389531741626E+12 -RIPB, 0.3596307755298724E+05 -MCRENOL, 0.6170107418458622E+06 -IDHPE, 0.4510092344230966E+05 -RIPD, 0.1538727346345939E+04 -IDHNDOO1, 0.1771693353622311E-11 -ISOPNOO1, 0.0000000000000000E+00 -IDHNDOO2, 0.4686078670812779E-11 -MVKHC, 0.1151088060484353E+06 -LIMO, 0.2118919861350688E+08 -RIPC, 0.1990771385227159E+04 -HPETHNL, 0.2206267657612703E+05 -N2O5, 0.1401616650032463E+01 -ICHE, 0.1176423237001054E+06 -MCRHNB, 0.2771681249767795E+01 -BrNO3, 0.1172947966317992E-02 -H, 0.6216284487152619E-12 -MONITS, 0.1025646587653026E+04 -ETOO, 0.2637593375757233E+00 -BZCO3, 0.5709003507620132E+06 -INPB, 0.1838695869003343E+03 -IHPOO1, 0.1670870041373771E-09 -IHPOO2, 0.4768349246225203E-10 -AROMRO2, 0.3134488407271477E+05 -MVKHCB, 0.1629644198709347E+06 -HPALD1, 0.6105720635230087E+04 -IHPOO3, 0.2813602892501959E-09 -HPALD2, 0.2487249885131977E+06 -IHPNDOO, 0.1516508942336977E-13 -CH4, 0.6413044302139997E+14 -BENZO2, 0.2465783655851324E+07 -HC5A, 0.5072905709936064E+06 -HNO2, 0.8525740815692846E+10 -ICHOO, 0.1467410199462828E-10 -CH3CHOO, 0.1359861488296197E-14 -ATOOH, 0.3044729375275224E+08 -Cl2, 0.4735365483409282E+06 -PROPNN, 0.3255919681598459E+07 -MONITU, 0.4341408198279605E+03 -MCRHN, 0.1206888829438594E+01 -PRN1, 0.5433366490570176E+04 -R4N2, 0.6407243458167418E+03 -IONO, 0.3313107983243786E+12 -MVKOHOO, 0.3616867658827106E-02 -MCROHOO, 0.2452675556329100E-07 -ICPDH, 0.1393770274150725E+04 -MACR1OO, 0.1095612208015128E+06 -ETHLN, 0.1504831475722312E+06 -PO2, 0.1612810645552266E+01 -NPHEN, 0.6214442757117238E+04 -HCOOH, 0.1672242004120760E+12 -H2O2, 0.3117784541616176E+09 -ITCN, 0.1346600894017977E-01 -IHN4, 0.9084082351595475E+01 -OLNN, 0.1237437964152175E+04 -OLND, 0.1024183339842718E+05 -ETO2, 0.3339635176071126E+01 -MOH, 0.9277901237022385E+11 -ACTA, 0.9941165256736954E+09 -IHN1, 0.4735699779400414E+02 -ACET, 0.8215149379623137E+11 -IHPNBOO, 0.1947016777667088E-11 -GLYX, 0.1766483738204901E+08 -ISOP, 0.1203520574782764E+09 -LIMO2, 0.5522630674281831E-03 -MEK, 0.2751213672518024E+11 -IO, 0.6671502960055051E+05 -IEPOXAOO, 0.5034085167488948E-10 -IEPOXBOO, 0.1189694836883926E-10 -MVKHP, 0.5166277125136319E+06 -MCRHP, 0.3539241964918078E+06 -IDHNBOO, 0.1691724669732973E+03 -MGLY, 0.1151735962284400E+10 -CH2OO, 0.8088576389849288E-15 -ClNO2, 0.1065845576213978E+09 -GLYC, 0.7840534786934361E+10 -A3O2, 0.3861667155995023E+07 -PIO2, 0.1834799428456311E-02 -OTHRO2, 0.2874151143844508E+08 -ICN, 0.1853443428266801E+07 -MVKN, 0.1684420580803340E+01 -ITHN, 0.8522523075693068E-01 -IDN, 0.2125575165733714E+02 -IHOO4, 0.9796193577904957E-03 -IHOO1, 0.3096932485757059E-02 -INO2D, 0.3567837301421969E+03 -INO2B, 0.6586029013233600E+03 -MVK, 0.3895414112084697E+09 -MACRNO2, 0.2605624204290140E-13 -HAC, 0.2162080992132292E+08 -MACR, 0.2147413341026408E+09 -ATO2, 0.7247291436094178E-02 -PRPE, 0.7388753852936174E+11 -KO2, 0.2368376959302832E+03 -RCO3, 0.1348986705997912E+08 -R4O2, 0.5512109037082342E+04 -R4N1, 0.4368130203103403E+00 -B3O2, 0.1662387642845000E+08 -RCHO, 0.1029630440947693E+11 -HOBr, 0.1100635022331661E+00 -MCO3, 0.2833419171136089E+08 -ClNO3, 0.1195256835237133E-01 -CH2O, 0.4267270723071190E+11 -ALD2, 0.4478906664812438E+11 -HNO3, 0.2284159652475635E+09 -MO2, 0.1394350001389870E+09 -CO, 0.3465812541980784E+14 -HOI, 0.4263742551677998E+09 -I, 0.2115579960187551E+17 -IONO2, 0.2667006863649932E+00 -HOCl, 0.1140355887407010E+07 -O1D, 0.0000000000000000E+00 -Br, 0.7230565469895693E-10 -BrO, 0.9417417842762022E-19 -HCl, 0.2246683062510476E+06 -SO2, 0.4762242853100073E+12 -BrSALC, 0.2134260311757697E+00 -H2O, 0.1046673573419124E+18 -NO, 0.4247993639083090E+11 -SALACL, 0.2704044127326782E+08 -NO3, 0.2133357435739994E+04 -O3, 0.2782950112007994E-06 -BrSALA, 0.2423984771291159E+05 -HO2, 0.2744808889368235E+02 -ClO, 0.4047240547818320E+02 -OH, 0.8895440896749172E-06 -SALCCL, 0.4405419527867513E+01 -O, 0.0000000000000000E+00 -HBr, 0.3692221687679019E-07 -Cl, 0.1139925326811263E-03 -NO2, 0.4769143727526907E+10 -H2, 0.1323026086022174E+14 -N2, 0.2067773241415970E+20 -O2, 0.5548136254559868E+19 -RCOOH, 0.2648274863298850E+00 -R1, 0.0000000000000000E+00 -R2, 0.0000000000000000E+00 -R3, 0.0000000000000000E+00 -R4, 0.0000000000000000E+00 -R5, 0.0000000000000000E+00 -R6, 0.0000000000000000E+00 -R7, 0.0000000000000000E+00 -R8, 0.0000000000000000E+00 -R9, 0.0000000000000000E+00 -R10, 0.0000000000000000E+00 -R11, 0.0000000000000000E+00 -R12, 0.0000000000000000E+00 -R13, 0.1306125063219363E-13 -R14, 0.5633825441797428E-13 -R15, 0.1693149913550484E-14 -R16, 0.1669776366572876E-16 -R17, 0.7732269875065597E-17 -R18, 0.1800000000000000E-11 -R19, 0.6801111774004697E-11 -R20, 0.1187856520393073E-09 -R21, 0.1800000000000000E-11 -R22, 0.8827182408132897E-11 -R23, 0.4488997706542727E-11 -R24, 0.2524666560669123E-12 -R25, 0.3936901684824494E-14 -R26, 0.8303382066923266E-11 -R27, 0.2491762148721596E-14 -R28, 0.6213726053685217E-11 -R29, 0.2719172281470610E-12 -R30, 0.1147457567596921E-12 -R31, 0.1600000000000000E-09 -R32, 0.7845159822046276E-11 -R33, 0.7845159822046276E-11 -R34, 0.8652150472316413E-11 -R35, 0.1215430843441995E-10 -R36, 0.2087935993488316E-12 -R37, 0.8618009449459809E-11 -R38, 0.7424103252456706E-11 -R39, 0.1558967316575907E-11 -R40, 0.5158210195995977E-02 -R41, 0.4105896714557432E-11 -R42, 0.3500000000000000E-11 -R43, 0.2674301055079618E-10 -R44, 0.2000000000000000E-10 -R45, 0.1366656099068281E-11 -R46, 0.2038458923895630E-02 -R47, 0.4000000000000000E-12 -R48, 0.8304942020575600E-12 -R49, 0.3444116072705968E-15 -R50, 0.5800000000000000E-15 -R51, 0.1646314635570016E-10 -R52, 0.1430062921405061E-14 -R53, 0.1003096910252247E-10 -R54, 0.1022884181504681E-04 -R55, 0.2155209969609968E-10 -R56, 0.1899572857368130E-12 -R57, 0.9499526819508729E-11 -R58, 0.2619732319470269E-12 -R59, 0.9761500051455756E-11 -R60, 0.9068907649326314E-12 -R61, 0.1890975671853794E-12 -R62, 0.9703402065151272E-11 -R63, 0.6082878768639463E-12 -R64, 0.9600538911531409E-11 -R65, 0.2096691524370838E-11 -R66, 0.8214242017216247E-11 -R67, 0.1386296894315162E-11 -R68, 0.9600538911531409E-11 -R69, 0.8602512180110273E-11 -R70, 0.9600538911531409E-11 -R71, 0.9367651017519963E-11 -R72, 0.5872402803047995E-12 -R73, 0.9600538911531409E-11 -R74, 0.1923709855242515E-16 -R75, 0.1600000000000000E-11 -R76, 0.8840447890784166E-12 -R77, 0.2651725457773805E-10 -R78, 0.7574874303619841E-11 -R79, 0.7724297645489294E-05 -R80, 0.2297554070173675E-10 -R81, 0.6500000000000000E-14 -R82, 0.1601569738582206E-12 -R83, 0.5920000000000000E-12 -R84, 0.5920000000000000E-12 -R85, 0.9356112080926369E-11 -R86, 0.9356112080926369E-11 -R87, 0.1087331944540092E-10 -R88, 0.2022437323854658E-10 -R89, 0.1685106914331692E-10 -R90, 0.1685106914331692E-10 -R91, 0.1082487947447955E-11 -R92, 0.3000000000000000E-12 -R93, 0.3000000000000000E-12 -R94, 0.8000000000000000E-15 -R95, 0.8370000000000000E-13 -R96, 0.8370000000000000E-13 -R97, 0.4593109091928188E-11 -R98, 0.8370000000000000E-13 -R99, 0.8370000000000000E-13 -R100, 0.8370000000000000E-13 -R101, 0.3350000000000000E-11 -R102, 0.5670730996787276E-11 -R103, 0.6800000000000000E-13 -R104, 0.6800000000000000E-13 -R105, 0.9482546027965915E-11 -R106, 0.9482546027965915E-11 -R107, 0.1685106914331692E-10 -R108, 0.1685106914331692E-10 -R109, 0.1864331294632794E-10 -R110, 0.2769327712384376E-10 -R111, 0.6639577849380639E-17 -R112, 0.5977233749878582E-11 -R113, 0.2022766250121418E-11 -R114, 0.6952860182249913E-14 -R115, 0.1063047405602745E-10 -R116, 0.1527059371876042E-10 -R117, 0.1024919270693600E-14 -R118, 0.3967619608300904E-14 -R119, 0.4856699383267186E-11 -R120, 0.1522102501135158E-11 -R121, 0.1812644822041218E-10 -R122, 0.1069419154689466E-10 -R123, 0.1069419154689466E-10 -R124, 0.1812644822041218E-10 -R125, 0.1812644822041218E-10 -R126, 0.1265548150240623E-11 -R127, 0.1812644822041218E-10 -R128, 0.1130864681110785E-10 -R129, 0.3000000000000000E-13 -R130, 0.1400000000000000E-17 -R131, 0.1776002182212233E-10 -R132, 0.1224829091180850E-10 -R133, 0.1145215200254095E-10 -R134, 0.1145215200254095E-10 -R135, 0.1145215200254095E-10 -R136, 0.1145215200254095E-10 -R137, 0.1145215200254095E-10 -R138, 0.1145215200254095E-10 -R139, 0.1145215200254095E-10 -R140, 0.1145215200254095E-10 -R141, 0.1145215200254095E-10 -R142, 0.1145215200254095E-10 -R143, 0.1531036363976062E-10 -R144, 0.1145215200254095E-10 -R145, 0.1182758259655787E-15 -R146, 0.4947137674761860E-11 -R147, 0.1078908830003385E+00 -R148, 0.4349464270822050E-11 -R149, 0.5996993069034512E-11 -R150, 0.1297244469788620E-11 -R151, 0.1063957813126977E-11 -R152, 0.9469542707935430E-12 -R153, 0.2383934787834383E-10 -R154, 0.1560533259326667E-11 -R155, 0.1135483658454066E-10 -R156, 0.2774437088686036E-11 -R157, 0.6322317276135703E-12 -R158, 0.2258116429987485E-10 -R159, 0.4900000000000000E-10 -R160, 0.5011885415746155E-10 -R161, 0.2525353145609517E-10 -R162, 0.2525175122224102E-13 -R163, 0.4206991843058800E-10 -R164, 0.1600000000000000E-10 -R165, 0.9357851000639001E-12 -R166, 0.3397743948926645E-11 -R167, 0.1590270957424165E-20 -R168, 0.1911677542279754E-19 -R169, 0.1340249296284895E-16 -R170, 0.5654247311636963E-11 -R171, 0.3631493054842115E-11 -R172, 0.2441011084200365E-12 -R173, 0.9523433650365973E-13 -R174, 0.2198283503669724E-13 -R175, 0.2025970251462506E-09 -R176, 0.3203232552510752E-10 -R177, 0.4027995202004145E-10 -R178, 0.1200000000000000E-09 -R179, 0.1279466093286619E-09 -R180, 0.1750000000000000E-09 -R181, 0.1941017340129432E-13 -R182, 0.4575752636790363E-14 -R183, 0.4109549742094556E-14 -R184, 0.3456279727885131E-10 -R185, 0.6193547227931270E-10 -R186, 0.2400000000000000E-09 -R187, 0.7231345423136929E-14 -R188, 0.1489550159989153E-14 -R189, 0.8817471698036620E-11 -R190, 0.1300000000000000E-10 -R191, 0.1940860238957535E-11 -R192, 0.4541047417729696E-11 -R193, 0.9952817644374045E-15 -R194, 0.1412941861483416E-11 -R195, 0.2548621064987076E-10 -R196, 0.8050000000000001E-10 -R197, 0.3631845019153894E-16 -R198, 0.3017368791689039E-10 -R199, 0.1287443006072349E-10 -R200, 0.4373151567381767E-10 -R201, 0.1030227945296004E-12 -R202, 0.1500000000000000E-09 -R203, 0.1500000000000000E-09 -R204, 0.2700000000000000E-09 -R205, 0.3300000000000000E-09 -R206, 0.2600000000000000E-09 -R207, 0.1800000000000000E-09 -R208, 0.2700000000000000E-09 -R209, 0.6600000000000000E-09 -R210, 0.1020000000000000E-09 -R211, 0.2300000000000000E-09 -R212, 0.1400000000000000E-09 -R213, 0.1500000000000000E-09 -R214, 0.1000000000000000E-09 -R215, 0.2600000000000000E-09 -R216, 0.2000000000000000E-09 -R217, 0.2000000000000000E-09 -R218, 0.2320000000000000E-09 -R219, 0.1423297305464714E-09 -R220, 0.6020277215385516E-10 -R221, 0.1600000000000000E-09 -R222, 0.4824732662734779E-13 -R223, 0.2045586780861232E-11 -R224, 0.1968957256186884E-10 -R225, 0.1380995231804769E-11 -R226, 0.1231920358293981E-10 -R227, 0.6804437300017174E-11 -R228, 0.7273605735767601E-12 -R229, 0.4898642629573272E-12 -R230, 0.2585815287989893E-13 -R231, 0.3628534175979000E-12 -R232, 0.2531318995354032E-13 -R233, 0.7908628103308285E-13 -R234, 0.7838969343650861E-13 -R235, 0.6640878531948427E-14 -R236, 0.3222596092563283E-14 -R237, 0.3787602740058839E-14 -R238, 0.2127170455104025E-14 -R239, 0.2834978860321146E-13 -R240, 0.7114801466428427E-13 -R241, 0.7265446163877199E-10 -R242, 0.1114062708504557E-10 -R243, 0.8149168207387470E-14 -R244, 0.3153432292731612E-12 -R245, 0.3725054268461672E-10 -R246, 0.9247373048982916E-11 -R247, 0.3810270127231294E-10 -R248, 0.7438061010557129E-11 -R249, 0.1830907325675601E-10 -R250, 0.3038155050550292E-11 -R251, 0.3141921419543687E-14 -R252, 0.4174440916432189E-14 -R253, 0.2440975284529570E-14 -R254, 0.7239281854568612E-13 -R255, 0.1264083848896501E+08 -R256, 0.4280737456791907E-12 -R257, 0.7228530585506496E+01 -R258, 0.2420000000000000E-09 -R259, 0.6973866864697971E-11 -R260, 0.5901895214740018E-11 -R261, 0.1172925005510932E-11 -R262, 0.1714218057065875E-12 -R263, 0.1060267967619863E-10 -R264, 0.3632913305920416E-12 -R265, 0.2734065500828660E-12 -R266, 0.9123549979254371E-13 -R267, 0.2000000000000000E-12 -R268, 0.1600000000000000E-09 -R269, 0.5700000000000000E-10 -R270, 0.5586581345147238E-10 -R271, 0.7400000000000000E-10 -R272, 0.7400000000000000E-10 -R273, 0.5500000000000000E-10 -R274, 0.9600000000000000E-10 -R275, 0.2800000000000000E-13 -R276, 0.8128739536542815E-10 -R277, 0.5859868088851597E-10 -R278, 0.1786455069362510E-11 -R279, 0.4654350546487230E-09 -R280, 0.2050000000000000E-09 -R281, 0.2356264875337175E-09 -R282, 0.3600000000000000E-11 -R283, 0.4304819710793876E-12 -R284, 0.6311911208342040E-14 -R285, 0.5729391107568851E-11 -R286, 0.2139150214554144E+00 -R287, 0.2342941325253832E-14 -R288, 0.1500000000000000E-11 -R289, 0.4310729761999653E-11 -R290, 0.6373755534423264E-06 -R291, 0.5360732137484170E-10 -R292, 0.1200000000000000E-10 -R293, 0.8643145921006618E-10 -R294, 0.1000000000000000E-09 -R295, 0.1500000000000000E-09 -R296, 0.3800000000000000E-01 -R297, 0.7844224310426186E-11 -R298, 0.1329818947772808E-10 -R299, 0.9874940109619030E-12 -R300, 0.2886237567646005E-12 -R301, 0.1800000000000000E-09 -R302, 0.3000000000000000E-10 -R303, 0.5000000000000000E-11 -R304, 0.1026065816029982E-09 -R305, 0.1979426498920168E-10 -R306, 0.9186218183856375E-10 -R307, 0.1049070577244259E+00 -R308, 0.5381432585358023E-13 -R309, 0.2400000000000000E-11 -R310, 0.6700000000000000E-12 -R311, 0.1200000000000000E-14 -R312, 0.1000000000000000E-13 -R313, 0.4250000000000000E-11 -R314, 0.2800000000000000E-15 -R315, 0.4456080838947726E-32 -R316, 0.1400000000000000E-11 -R317, 0.3800000000000000E-10 -R318, 0.1200000000000000E-14 -R319, 0.1000000000000000E-13 -R320, 0.4250000000000000E-11 -R321, 0.2650000000000000E-10 -R322, 0.6000000000000000E-17 -R323, 0.1000000000000000E-16 -R324, 0.5961909891796595E-10 -R325, 0.5961909891796595E-10 -R326, 0.4000000000000000E-11 -R327, 0.1500000000000000E-10 -R328, 0.4633470709447861E-12 -R329, 0.1184162572678909E-10 -R330, 0.1200000000000000E-11 -R331, 0.7323214876798035E-16 -R332, 0.7323214876798035E-16 -R333, 0.4919824247890869E-11 -R334, 0.4919824247890869E-11 -R335, 0.1796634682576776E-09 -R336, 0.1727065335557493E-15 -R337, 0.1220000000000000E-10 -R338, 0.4000000000000000E-11 -R339, 0.1500000000000000E-10 -R340, 0.4633470709447861E-12 -R341, 0.1184162572678909E-10 -R342, 0.1200000000000000E-11 -R343, 0.6769493973799105E-11 -R344, 0.4000000000000000E-11 -R345, 0.4000000000000000E-11 -R346, 0.1846827703858681E-10 -R347, 0.1846827703858681E-10 -R348, 0.2082458745819263E-11 -R349, 0.1259887541220654E-11 -R350, 0.1416194428136263E-10 -R351, 0.8593179750386140E-11 -R352, 0.1200000000000000E-11 -R353, 0.1200000000000000E-11 -R354, 0.2625361029555087E-11 -R355, 0.1593969196515589E-11 -R356, 0.1110152663926151E-11 -R357, 0.4800000000000000E-11 -R358, 0.7290000000000000E-10 -R359, 0.1670000000000000E-15 -R360, 0.6210374477015558E-13 -R361, 0.6210374477015558E-13 -R362, 0.2780000000000000E-03 -R363, 0.2780000000000000E-03 -R364, 0.2087935993488316E-12 -R365, 0.2133039965535337E-13 -R366, 0.1693149913550484E-12 -R367, 0.3762462047721781E-12 -R368, 0.7100000000000000E-12 -R369, 0.7820071006293892E-17 -R370, 0.6977373046178490E-10 -R371, 0.3565296154016630E-10 -R372, 0.1049039314165638E-12 -R373, 0.5452117514658089E-11 -R374, 0.2287677670741204E-10 -R375, 0.7092156551205139E-12 -R376, 0.2250783513563761E-10 -R377, 0.1078157226894946E-11 -R378, 0.4599209450878908E-04 -R379, 0.4938757056412127E-04 -R380, 0.8003907193080921E-04 -R381, 0.9798920578692582E-03 -R382, 0.6711920040590271E-13 -R383, 0.5477614496466644E-11 -R384, 0.2963297077519775E-11 -R385, 0.7487270215754705E-13 -R386, 0.1801043351779480E-12 -R387, 0.1167029224802246E-12 -R388, 0.1939861283407593E-11 -R389, 0.6013871659240726E-13 -R390, 0.1908576479605102E-11 -R391, 0.9142352039489748E-13 -R392, 0.1737877810388551E-11 -R393, 0.7573581735932342E-11 -R394, 0.4659637067787865E-13 -R395, 0.2424829945326393E-12 -R396, 0.1593553248008108E-11 -R397, 0.7569055213000182E-11 -R398, 0.7058950606469323E-13 -R399, 0.3673409444584232E-12 -R400, 0.5977599435486738E-10 -R401, 0.5977599435486738E-10 -R402, 0.9043117392061368E-10 -R403, 0.1438677766918854E-09 -R404, 0.4894148321307943E-10 -R405, 0.4353249293178663E-10 -R406, 0.3164320035328412E-10 -R407, 0.1015295452654163E-10 -R408, 0.5912737523035294E-10 -R409, 0.1788070938884861E-10 -R410, 0.1040203823496950E-09 -R411, 0.1259354603012692E-10 -R412, 0.8464514544839402E-11 -R413, 0.1451009290635301E-09 -R414, 0.1451009290635301E-09 -R415, 0.2887268554235268E-02 -R416, 0.7396985708293381E-11 -R417, 0.2203553203238026E-11 -R418, 0.2747990619596953E-10 -R419, 0.5284246221902282E-02 -R420, 0.7558097710646840E-11 -R421, 0.2042441200884569E-11 -R422, 0.2747990619596953E-10 -R423, 0.3404797823390646E-02 -R424, 0.7979311970388622E-11 -R425, 0.1621226941142786E-11 -R426, 0.2747990619596953E-10 -R427, 0.7554739155968315E-11 -R428, 0.2463501898685320E-11 -R429, 0.1049041087929910E-10 -R430, 0.1935608634681323E-11 -R431, 0.7119667158795506E-11 -R432, 0.3404797823390646E-02 -R433, 0.1347550434111841E+00 -R434, 0.2647861406737145E-10 -R435, 0.9217882798624803E-11 -R436, 0.3826561129066057E-12 -R437, 0.3404797823390646E-02 -R438, 0.1347550434111841E+00 -R439, 0.9293596230846684E-11 -R440, 0.3069426806847241E-12 -R441, 0.2647861406737145E-10 -R442, 0.2647861406737145E-10 -R443, 0.3826561129066057E-12 -R444, 0.9217882798624803E-11 -R445, 0.3404797823390646E-02 -R446, 0.9600538911531409E-11 -R447, 0.2647861406737145E-10 -R448, 0.9600538911531409E-11 -R449, 0.2647861406737145E-10 -R450, 0.2934902644514462E-10 -R451, 0.4898460647960096E-11 -R452, 0.4192718063592088E-10 -R453, 0.5687475810432827E-11 -R454, 0.7785030685366780E-11 -R455, 0.8385436127184176E-10 -R456, 0.4781515620947853E-11 -R457, 0.1212599832117320E-09 -R458, 0.8063861932478692E-11 -R459, 0.8063861932478692E-11 -R460, 0.3404797823390646E-02 -R461, 0.2892621704838898E-10 -R462, 0.8633120530414077E-11 -R463, 0.9674183811173308E-12 -R464, 0.3404797823390646E-02 -R465, 0.2892621704838898E-10 -R466, 0.8814430122425533E-11 -R467, 0.7861087891058750E-12 -R468, 0.2280760568628614E-02 -R469, 0.9246522942242757E-03 -R470, 0.2892621704838898E-10 -R471, 0.8346119098822770E-11 -R472, 0.1254419812708638E-11 -R473, 0.2892621704838898E-10 -R474, 0.7308315440142681E-11 -R475, 0.2292223471388727E-11 -R476, 0.2892621704838898E-10 -R477, 0.6943775590326396E-11 -R478, 0.2656763321205012E-11 -R479, 0.5774057022807106E-12 -R480, 0.2747990619596953E-10 -R481, 0.2747990619596953E-10 -R482, 0.1610000000000000E-11 -R483, 0.2560000000000000E-11 -R484, 0.3710000000000000E-11 -R485, 0.1180000000000000E-11 -R486, 0.2800000000000000E-12 -R487, 0.1920000000000000E-11 -R488, 0.7710000000000000E-11 -R489, 0.2300000000000000E-11 -R490, 0.2300000000000000E-11 -R491, 0.9156985258510212E-11 -R492, 0.4435536530211971E-12 -R493, 0.6652946686230504E-11 -R494, 0.2947592225300904E-11 -R495, 0.8427770688616526E-14 -R496, 0.1815892172475011E+05 -R497, 0.2416978648423674E-10 -R498, 0.6617917727826727E-10 -R499, 0.1146266455409855E-10 -R500, 0.2284249686959783E-10 -R501, 0.7498742460162967E-11 -R502, 0.4702966861742478E-11 -R503, 0.7019353524988773E-11 -R504, 0.8063861932478692E-11 -R505, 0.1189409372971132E-02 -R506, 0.1583457974398210E-02 -R507, 0.2937123577221034E-10 -R508, 0.2937123577221034E-10 -R509, 0.8574282196284162E-11 -R510, 0.1026256715247247E-11 -R511, 0.8231203060441915E-11 -R512, 0.1369335851089493E-11 -R513, 0.1491712331325118E-11 -R514, 0.3843324891626081E-10 -R515, 0.9600538911531409E-11 -R516, 0.2825868896265692E-10 -R517, 0.9999999999999999E-11 -R518, 0.9600538911531409E-11 -R519, 0.3015001853889774E-10 -R520, 0.2372295879522071E-10 -R521, 0.3441918751314733E-17 -R522, 0.1744244066693170E-10 -R523, 0.1483154970320850E-10 -R524, 0.7157465461379327E-18 -R525, 0.2410483826339482E-14 -R526, 0.4915596915226207E-11 -R527, 0.5770000000000000E-10 -R528, 0.1483154970320850E-10 -R529, 0.5510225574326152E-10 -R530, 0.1483154970320850E-10 -R531, 0.9600538911531409E-11 -R532, 0.2147215342438105E-10 -R533, 0.9000000000000000E-11 -R534, 0.9600538911531409E-11 -R535, 0.2147215342438105E-10 -R536, 0.9000000000000000E-11 -R537, 0.1308294022245021E-09 -R538, 0.2746583278371944E-10 -R539, 0.1121258174364757E-10 -R540, 0.2746583278371944E-10 -R541, 0.2577604998539671E-11 -R542, 0.3093125998247605E-10 -R543, 0.2358599236253255E-10 -R544, 0.9059571224157017E-11 -R545, 0.5409676873743912E-12 -R546, 0.2358599236253255E-10 -R547, 0.2569818343400271E-10 -R548, 0.1660000000000000E-10 -R549, 0.1331796903715579E+00 -R550, 0.8795900340024027E-11 -R551, 0.8046385715073819E-12 -R552, 0.2488889645840271E-10 -R553, 0.9898388197610070E-11 -R554, 0.2569818343400271E-10 -R555, 0.2145594522276096E-10 -R556, 0.9898388197610070E-11 -R557, 0.4000000000000000E-11 -R558, 0.1776002182212233E-10 -R559, 0.8880320973110359E-05 -R560, 0.2900000000000000E-10 -R561, 0.4330000000000000E-11 -R562, 0.9999999999999999E-11 -R563, 0.2250000000000000E-10 -R564, 0.3000000000000000E-11 -R565, 0.3000000000000000E-11 -R566, 0.9999999999999999E-11 -R567, 0.3000000000000000E-11 -R568, 0.1653174836792043E-14 -R569, 0.8000000000000000E-12 -R570, 0.7961389092675524E-11 -R571, 0.2569818343400271E-10 -R572, 0.5315237028013725E-11 -R573, 0.2910000000000000E-10 -R574, 0.2383928604353185E-10 -R575, 0.1770075258553637E-10 -R576, 0.9244963396289505E-11 -R577, 0.8696048053003735E-18 -R578, 0.8874307769792254E-11 -R579, 0.6265745813372331E-12 -R580, 0.1702196618616736E-10 -R581, 0.9954891297824762E-11 -R582, 0.2300000000000000E-11 -R583, 0.6000000000000000E-12 -R584, 0.3565059078465853E+05 -R585, 0.8427770688616526E-14 -R586, 0.8400000000000000E-12 -R587, 0.3782952514770088E-11 -R588, 0.1380000000000000E-10 -R589, 0.1142689598343042E-11 -R590, 0.6172533322854648E-11 -R591, 0.1700000000000000E-10 -R592, 0.2654759196956376E-10 -R593, 0.9761500051455756E-11 -R594, 0.2300000000000000E-11 -R595, 0.3773539845384472E-13 -R596, 0.9322863147420461E-13 -R597, 0.3912811002660915E-10 -R598, 0.3800000000000000E-11 -R599, 0.4700000000000000E-10 -R600, 0.1400000000000000E-10 -R601, 0.2000000000000000E-10 -R602, 0.9200000000000000E-17 -R603, 0.9899999999999999E-10 -R604, 0.1333590476323586E-10 -R605, 0.2400000000000000E-14 -R606, 0.3772103697300064E-10 -R607, 0.2145594522276096E-10 -R608, 0.1001815178921538E-10 -R609, 0.4660000000000000E-11 -R610, 0.6854286447343410E-05 -R611, 0.1060000000000000E-11 -R612, 0.7000000000000000E-11 -R613, 0.1002430966822572E-10 -R614, 0.2300000000000000E-11 -R615, 0.2492104853399666E-10 -R616, 0.3600000000000000E-11 -R617, 0.2860000000000000E-12 -R618, 0.2080000000000000E-11 -R619, 0.3470000000000000E-11 -R620, 0.2600000000000000E-11 -R621, 0.1002430966822572E-11 -R622, 0.1002430966822572E-10 -R623, 0.5000000000000000E-10 -R624, 0.8000000000000000E-15 -R625, 0.1500000000000000E-02 -R626, 0.5000000000000000E-10 -R627, 0.8000000000000000E-15 -R628, 0.1500000000000000E-02 -R629, 0.1770075258553637E-10 -R630, 0.9244963396289505E-11 -R631, 0.1770075258553637E-10 -R632, 0.9244963396289505E-11 -R633, 0.1770075258553637E-10 -R634, 0.9244963396289505E-11 -R635, 0.1200000000000000E-11 -R636, 0.4429149334337991E-10 -R637, 0.6590335356767159E-01 -R638, 0.5337087225134494E-05 -R639, 0.7917504249163501E-03 -R640, 0.2012573944829506E-07 -R641, 0.1329470130619842E-11 -R642, 0.5415407077728137E-20 -R643, 0.0000000000000000E+00 -R644, 0.0000000000000000E+00 -R645, 0.2834224499151186E-13 -R646, 0.4613985518844530E-13 -R647, 0.2430063744381336E-12 -R648, 0.1861269486775501E-13 -R649, 0.1174255146722783E-19 -R650, 0.0000000000000000E+00 -R651, 0.7061724340248307E-19 -R652, 0.0000000000000000E+00 -R653, 0.0000000000000000E+00 -R654, 0.0000000000000000E+00 -R655, 0.0000000000000000E+00 -R656, 0.2043836528817186E-13 -R657, 0.3414210363378818E-07 -R658, 0.0000000000000000E+00 -R659, 0.0000000000000000E+00 -R660, 0.0000000000000000E+00 -R661, 0.8662655386846380E-14 -R662, 0.0000000000000000E+00 -R663, 0.0000000000000000E+00 -R664, 0.0000000000000000E+00 -R665, 0.0000000000000000E+00 -R666, 0.5702237189752122E-16 -R667, 0.1807709511614873E-16 -R668, 0.0000000000000000E+00 -R669, 0.0000000000000000E+00 -R670, 0.0000000000000000E+00 -R671, 0.3372633441179459E-12 -R672, 0.4433315715799872E-12 -R673, 0.3386066935086624E-08 -R674, 0.0000000000000000E+00 -R675, 0.0000000000000000E+00 -R676, 0.0000000000000000E+00 -R677, 0.4242723223675972E-15 -R678, 0.0000000000000000E+00 -R679, 0.6184793714445779E-02 -R680, 0.1355736734754715E-06 -R681, 0.6743923198623428E-02 -R682, 0.2842688326930065E-05 -R683, 0.1393519570311092E-06 -R684, 0.0000000000000000E+00 -R685, 0.0000000000000000E+00 -R686, 0.9429898022217180E-03 -R687, 0.4101527385982588E-06 -R688, 0.2864515128106286E-07 -R689, 0.9178195441934165E-03 -R690, 0.3992584936902100E-06 -R691, 0.2793582540292971E-07 -R692, 0.8945678255239541E-03 -R693, 0.3891923764119877E-06 -R694, 0.2727841361774535E-07 -R695, 0.0000000000000000E+00 -R696, 0.0000000000000000E+00 -R697, 0.0000000000000000E+00 -R698, 0.0000000000000000E+00 -R699, 0.1018354967694758E-19 -R700, 0.3252656695474025E-11 -R701, 0.0000000000000000E+00 -R702, 0.1652273763811812E-13 -R703, 0.3018313936815677E-08 -R704, 0.1568981792886400E-11 -R705, 0.0000000000000000E+00 -R706, 0.7970061691084235E-14 -R707, 0.3522934928875932E-08 -R708, 0.1796036932864130E-11 -R709, 0.0000000000000000E+00 -R710, 0.9123448863010013E-14 -R711, 0.4009570150075659E-08 -R712, 0.8432582276134732E-06 -R713, 0.3405351184235766E-07 -R714, 0.2749820891205699E-07 -R715, 0.2749820891205699E-07 -R716, 0.2749820891205699E-07 -R717, 0.1201566872099362E+00 -R718, 0.8501160771170284E-03 -R719, 0.9510515967057841E-03 -R720, 0.1413007895237626E-02 -R721, 0.1413007895237626E-02 -R722, 0.1413924856012875E-02 -R723, 0.3080528111268531E-07 -R724, 0.2749821079937958E-07 -R725, 0.8557779082588896E-03 -R726, 0.8402054163924561E-02 -R727, 0.8557779082588896E-03 -R728, 0.8557779082588896E-03 -R729, 0.2749820439797331E-07 -R730, 0.8128039597466691E-03 -R731, 0.8128039597466691E-03 -R732, 0.7490614101660079E-03 -R733, 0.7432907252077029E-03 -R734, 0.7394794863731563E-03 -R735, 0.8501445339752493E-03 -R736, 0.8501445339752493E-03 -R737, 0.1756528045156896E-02 -R738, 0.0000000000000000E+00 -R739, 0.0000000000000000E+00 -R740, 0.0000000000000000E+00 -R741, 0.0000000000000000E+00 -R742, 0.0000000000000000E+00 -R743, 0.0000000000000000E+00 -R744, 0.0000000000000000E+00 -R745, 0.0000000000000000E+00 -R746, 0.0000000000000000E+00 -R747, 0.0000000000000000E+00 -R748, 0.0000000000000000E+00 -R749, 0.0000000000000000E+00 -R750, 0.0000000000000000E+00 -R751, 0.0000000000000000E+00 -R752, 0.0000000000000000E+00 -R753, 0.0000000000000000E+00 -R754, 0.0000000000000000E+00 -R755, 0.0000000000000000E+00 -R756, 0.0000000000000000E+00 -R757, 0.0000000000000000E+00 -R758, 0.0000000000000000E+00 -R759, 0.0000000000000000E+00 -R760, 0.0000000000000000E+00 -R761, 0.0000000000000000E+00 -R762, 0.0000000000000000E+00 -R763, 0.0000000000000000E+00 -R764, 0.0000000000000000E+00 -R765, 0.0000000000000000E+00 -R766, 0.0000000000000000E+00 -R767, 0.0000000000000000E+00 -R768, 0.0000000000000000E+00 -R769, 0.0000000000000000E+00 -R770, 0.0000000000000000E+00 -R771, 0.0000000000000000E+00 -R772, 0.0000000000000000E+00 -R773, 0.0000000000000000E+00 -R774, 0.0000000000000000E+00 -R775, 0.0000000000000000E+00 -R776, 0.0000000000000000E+00 -R777, 0.0000000000000000E+00 -R778, 0.0000000000000000E+00 -R779, 0.0000000000000000E+00 -R780, 0.0000000000000000E+00 -R781, 0.0000000000000000E+00 -R782, 0.0000000000000000E+00 -R783, 0.0000000000000000E+00 -R784, 0.0000000000000000E+00 -R785, 0.0000000000000000E+00 -R786, 0.0000000000000000E+00 -R787, 0.0000000000000000E+00 -R788, 0.0000000000000000E+00 -R789, 0.0000000000000000E+00 -R790, 0.0000000000000000E+00 -R791, 0.0000000000000000E+00 -R792, 0.0000000000000000E+00 -R793, 0.0000000000000000E+00 -R794, 0.0000000000000000E+00 -R795, 0.0000000000000000E+00 -R796, 0.0000000000000000E+00 -R797, 0.0000000000000000E+00 -R798, 0.0000000000000000E+00 -R799, 0.0000000000000000E+00 -R800, 0.0000000000000000E+00 -R801, 0.0000000000000000E+00 -R802, 0.0000000000000000E+00 -R803, 0.0000000000000000E+00 -R804, 0.0000000000000000E+00 -R805, 0.0000000000000000E+00 -R806, 0.0000000000000000E+00 -R807, 0.0000000000000000E+00 -R808, 0.0000000000000000E+00 -R809, 0.0000000000000000E+00 -R810, 0.0000000000000000E+00 -R811, 0.0000000000000000E+00 -R812, 0.0000000000000000E+00 -R813, 0.0000000000000000E+00 -R814, 0.0000000000000000E+00 -R815, 0.0000000000000000E+00 -R816, 0.0000000000000000E+00 -R817, 0.0000000000000000E+00 -R818, 0.0000000000000000E+00 -R819, 0.0000000000000000E+00 -R820, 0.0000000000000000E+00 -R821, 0.0000000000000000E+00 -R822, 0.0000000000000000E+00 -R823, 0.0000000000000000E+00 -R824, 0.0000000000000000E+00 -R825, 0.0000000000000000E+00 -R826, 0.0000000000000000E+00 -R827, 0.0000000000000000E+00 -R828, 0.0000000000000000E+00 -R829, 0.0000000000000000E+00 -R830, 0.0000000000000000E+00 -R831, 0.0000000000000000E+00 -R832, 0.0000000000000000E+00 -R833, 0.0000000000000000E+00 -R834, 0.0000000000000000E+00 -R835, 0.0000000000000000E+00 -R836, 0.0000000000000000E+00 -R837, 0.0000000000000000E+00 -R838, 0.0000000000000000E+00 -R839, 0.0000000000000000E+00 -R840, 0.0000000000000000E+00 -R841, 0.0000000000000000E+00 -R842, 0.0000000000000000E+00 -R843, 0.0000000000000000E+00 -R844, 0.0000000000000000E+00 -R845, 0.0000000000000000E+00 -R846, 0.0000000000000000E+00 -R847, 0.0000000000000000E+00 -R848, 0.0000000000000000E+00 -R849, 0.0000000000000000E+00 -R850, 0.0000000000000000E+00 -R851, 0.0000000000000000E+00 -R852, 0.0000000000000000E+00 -R853, 0.0000000000000000E+00 -R854, 0.0000000000000000E+00 -R855, 0.0000000000000000E+00 -R856, 0.0000000000000000E+00 -R857, 0.0000000000000000E+00 -R858, 0.0000000000000000E+00 -R859, 0.0000000000000000E+00 -R860, 0.0000000000000000E+00 -R861, 0.0000000000000000E+00 -R862, 0.0000000000000000E+00 -R863, 0.0000000000000000E+00 -R864, 0.0000000000000000E+00 -R865, 0.0000000000000000E+00 -R866, 0.0000000000000000E+00 -R867, 0.0000000000000000E+00 -R868, 0.0000000000000000E+00 -R869, 0.0000000000000000E+00 -R870, 0.0000000000000000E+00 -R871, 0.0000000000000000E+00 -R872, 0.0000000000000000E+00 -R873, 0.0000000000000000E+00 -R874, 0.0000000000000000E+00 -R875, 0.0000000000000000E+00 -R876, 0.0000000000000000E+00 -R877, 0.0000000000000000E+00 -R878, 0.0000000000000000E+00 -R879, 0.0000000000000000E+00 -R880, 0.0000000000000000E+00 -R881, 0.0000000000000000E+00 -R882, 0.0000000000000000E+00 -R883, 0.0000000000000000E+00 -R884, 0.0000000000000000E+00 -R885, 0.0000000000000000E+00 -R886, 0.0000000000000000E+00 -R887, 0.0000000000000000E+00 -R888, 0.0000000000000000E+00 -R889, 0.0000000000000000E+00 -R890, 0.0000000000000000E+00 -R891, 0.0000000000000000E+00 -R892, 0.0000000000000000E+00 -R893, 0.0000000000000000E+00 -R894, 0.0000000000000000E+00 -A1, 0.0000000000000000E+00 -A2, 0.0000000000000000E+00 -A3, 0.0000000000000000E+00 -A4, 0.0000000000000000E+00 -A5, 0.0000000000000000E+00 -A6, 0.0000000000000000E+00 -A7, 0.0000000000000000E+00 -A8, 0.0000000000000000E+00 -A9, 0.0000000000000000E+00 -A10, 0.0000000000000000E+00 -A11, 0.0000000000000000E+00 -A12, 0.0000000000000000E+00 -A13, 0.1544095090371950E-09 -A14, 0.1394685501764874E-25 -A15, 0.1293340702651254E-19 -A16, 0.2216175462058372E-13 -A17, 0.3000435022532459E-15 -A18, 0.1424319637456039E-23 -A19, 0.5381642809026870E-23 -A20, 0.2900304363590725E-14 -A21, 0.4992132261374084E-09 -A22, 0.1029243351774655E+02 -A23, 0.3382000026311459E-08 -A24, 0.7783529492022620E-05 -A25, 0.2245878656968180E-06 -A26, 0.4918250909820989E+08 -A27, 0.1475918048360805E+05 -A28, 0.2378132321388914E-01 -A29, 0.5286647179506010E+04 -A30, 0.2230900687932250E+04 -A31, 0.1984537284279314E-07 -A32, 0.7437019419451209E-08 -A33, 0.2124799577070756E-09 -A34, 0.3284291818159132E-06 -A35, 0.5156299587534947E-07 -A36, 0.4242395128398950E-10 -A37, 0.3256554136258845E-06 -A38, 0.5630456501538279E-07 -A39, 0.2040748720606162E+00 -A40, 0.4391218437132260E-04 -A41, 0.3109291964241143E-19 -A42, 0.2049480458836636E-06 -A43, 0.2423582340472064E+04 -A44, 0.3795430996253097E-13 -A45, 0.1390475306762553E+02 -A46, 0.2857137968139373E-02 -A47, 0.5950131965087040E-07 -A48, 0.6854153534377544E-07 -A49, 0.3504142963241850E-02 -A50, 0.5280095961880112E-01 -A51, 0.6559221997113503E-06 -A52, 0.1366440685830269E+00 -A53, 0.1355483176389767E+07 -A54, 0.9547457238498170E+05 -A55, 0.2594085422414428E+08 -A56, 0.2932381069933888E-07 -A57, 0.1347674024628245E+01 -A58, 0.3716548482371428E-01 -A59, 0.1191818222736209E+08 -A60, 0.5308613398569357E-07 -A61, 0.1106909362862180E-07 -A62, 0.1591778825197418E+07 -A63, 0.9978559638312063E+05 -A64, 0.6577530208390460E+00 -A65, 0.1221966191082927E-05 -A66, 0.1923397964338659E+04 -A67, 0.3246070202102973E+03 -A68, 0.1781455773765494E+00 -A69, 0.2648407932236744E-02 -A70, 0.9658958438568591E+02 -A71, 0.6615259160850997E+07 -A72, 0.4146980536146722E+06 -A73, 0.2215891389577489E+04 -A74, 0.2688811567750893E-01 -A75, 0.9119240878913767E-15 -A76, 0.7817700716487269E-09 -A77, 0.2428719783892385E-06 -A78, 0.4873304084815480E+06 -A79, 0.2672848679251233E+05 -A80, 0.1316610360751831E+08 -A81, 0.1427770342219006E+00 -A82, 0.1170385135992689E-07 -A83, 0.3187633237762694E+03 -A84, 0.1331302935313501E-03 -A85, 0.1415550368813226E-05 -A86, 0.1121768143269558E-09 -A87, 0.2162967454746129E-11 -A88, 0.1314734351903356E-06 -A89, 0.7689035643015398E-02 -A90, 0.2513093067514751E-05 -A91, 0.2649200748899162E-07 -A92, 0.1396986093718930E-03 -A93, 0.1202271795424286E+04 -A94, 0.4695457716460690E-01 -A95, 0.6433022336823628E-01 -A96, 0.5097917870941120E-05 -A97, 0.4641456536697745E-05 -A98, 0.2764063950606851E-02 -A99, 0.1940124327537266E+03 -A100, 0.6341124198168652E-01 -A101, 0.1968893354432240E-06 -A102, 0.2048820177489005E-11 -A103, 0.7584150914291102E-12 -A104, 0.5617306462410630E+02 -A105, 0.8692327839315982E-09 -A106, 0.7480776397688000E-02 -A107, 0.1786135534134029E-02 -A108, 0.7459727334030904E-09 -A109, 0.6903079437200014E-02 -A110, 0.1820174513365187E-05 -A111, 0.1365265410416567E-12 -A112, 0.4168822503476795E-07 -A113, 0.1410778600209642E-07 -A114, 0.1095969127947281E+01 -A115, 0.1670435665976086E-09 -A116, 0.1564502742632929E-07 -A117, 0.3862450516744865E-04 -A118, 0.9748697206329562E-02 -A119, 0.9340726583080131E-10 -A120, 0.2927408549005464E-10 -A121, 0.5072457778505291E-10 -A122, 0.8504663487342167E-09 -A123, 0.1980924230701427E-09 -A124, 0.8063275074176582E-09 -A125, 0.1207318851701192E-08 -A126, 0.4520779948652274E-10 -A127, 0.1940901159685058E-09 -A128, 0.3883864701204402E-29 -A129, 0.4858832652547309E-11 -A130, 0.5183088626024881E-03 -A131, 0.1425821473744241E+05 -A132, 0.4839027858077308E+05 -A133, 0.1788610317723219E+01 -A134, 0.2351655264970321E-05 -A135, 0.7685086483538132E-01 -A136, 0.5394239609639514E+04 -A137, 0.1417403519754149E-03 -A138, 0.1763059347996755E+01 -A139, 0.1083669770167318E-02 -A140, 0.9326260340628824E+04 -A141, 0.5233368465250004E-03 -A142, 0.1253062606773393E+04 -A143, 0.5851995772217367E+04 -A144, 0.2154103542600827E+05 -A145, 0.5382985889199357E-09 -A146, 0.3289775098796462E+07 -A147, 0.6487417738377453E+03 -A148, 0.1122849439245198E-10 -A149, 0.1548172346165765E-10 -A150, 0.8031630757084275E-02 -A151, 0.4507164669434901E-06 -A152, 0.1905490074921044E-28 -A153, 0.6162235943787915E-28 -A154, 0.3097115513010166E-20 -A155, 0.3729375692265349E-24 -A156, 0.2460586073970009E-49 -A157, 0.5607121498021447E-50 -A158, 0.9033624380409510E-19 -A159, 0.4155727760989191E-23 -A160, 0.4907827560701223E-12 -A161, 0.0000000000000000E+00 -A162, 0.0000000000000000E+00 -A163, 0.3524284733079588E-35 -A164, 0.2468060897569091E-17 -A165, 0.2887344370879187E-11 -A166, 0.1100360324929323E-10 -A167, 0.9446237385912818E-20 -A168, 0.2398743850871715E-18 -A169, 0.6377001096752690E-16 -A170, 0.1949788362791917E-11 -A171, 0.1631013174213815E-20 -A172, 0.9719712752815177E-11 -A173, 0.2483714412209267E-11 -A174, 0.3689471196039368E-11 -A175, 0.0000000000000000E+00 -A176, 0.0000000000000000E+00 -A177, 0.0000000000000000E+00 -A178, 0.0000000000000000E+00 -A179, 0.0000000000000000E+00 -A180, 0.0000000000000000E+00 -A181, 0.0000000000000000E+00 -A182, 0.0000000000000000E+00 -A183, 0.4836488141068563E-07 -A184, 0.0000000000000000E+00 -A185, 0.0000000000000000E+00 -A186, 0.0000000000000000E+00 -A187, 0.0000000000000000E+00 -A188, 0.1753036642378697E-10 -A189, 0.0000000000000000E+00 -A190, 0.0000000000000000E+00 -A191, 0.0000000000000000E+00 -A192, 0.0000000000000000E+00 -A193, 0.0000000000000000E+00 -A194, 0.4873065985059206E-05 -A195, 0.4409014946757623E-29 -A196, 0.1373532289993859E-20 -A197, 0.0000000000000000E+00 -A198, 0.0000000000000000E+00 -A199, 0.0000000000000000E+00 -A200, 0.0000000000000000E+00 -A201, 0.0000000000000000E+00 -A202, 0.0000000000000000E+00 -A203, 0.0000000000000000E+00 -A204, 0.0000000000000000E+00 -A205, 0.0000000000000000E+00 -A206, 0.0000000000000000E+00 -A207, 0.0000000000000000E+00 -A208, 0.0000000000000000E+00 -A209, 0.0000000000000000E+00 -A210, 0.0000000000000000E+00 -A211, 0.0000000000000000E+00 -A212, 0.0000000000000000E+00 -A213, 0.0000000000000000E+00 -A214, 0.0000000000000000E+00 -A215, 0.0000000000000000E+00 -A216, 0.0000000000000000E+00 -A217, 0.0000000000000000E+00 -A218, 0.0000000000000000E+00 -A219, 0.0000000000000000E+00 -A220, 0.0000000000000000E+00 -A221, 0.0000000000000000E+00 -A222, 0.2032330041575784E-13 -A223, 0.1154379823355828E-01 -A224, 0.7088637765206643E-15 -A225, 0.4971857526607691E-16 -A226, 0.1299683313553025E-14 -A227, 0.3131265782021524E-26 -A228, 0.1453647300827218E-12 -A229, 0.4969167602596347E-12 -A230, 0.2451654483962333E-11 -A231, 0.3857979648517187E-20 -A232, 0.3298724495837125E-09 -A233, 0.1141251087715336E-09 -A234, 0.2271490109518611E-10 -A235, 0.1907002424774826E-12 -A236, 0.1902616293210483E-10 -A237, 0.2332212035621905E-11 -A238, 0.1139568469410342E-11 -A239, 0.1159038681542782E-31 -A240, 0.5201198503217277E-03 -A241, 0.3534181816429206E-03 -A242, 0.3534202755603975E-21 -A243, 0.1229017572061915E-04 -A244, 0.1120742943298902E-07 -A245, 0.1165523725852289E-12 -A246, 0.2893389441772508E-13 -A247, 0.0000000000000000E+00 -A248, 0.8262868959461469E-08 -A249, 0.3147815268312234E+02 -A250, 0.5864207951426836E+00 -A251, 0.5146516315494763E-11 -A252, 0.6837799364061547E-11 -A253, 0.3998355607943692E-11 -A254, 0.4578455599737246E+02 -A255, 0.4253962180996577E+02 -A256, 0.7011914755948523E-09 -A257, 0.3739471778701002E-08 -A258, 0.9283452316418130E-19 -A259, 0.2658058346109079E-28 -A260, 0.2249481118260543E-28 -A261, 0.4470551504274228E-29 -A262, 0.0000000000000000E+00 -A263, 0.1444618857673225E-16 -A264, 0.6066848164475123E-06 -A265, 0.5055893184772958E-07 -A266, 0.3387853827972560E-08 -A267, 0.3812462026109756E-05 -A268, 0.2543127809637811E-05 -A269, 0.6924380108605892E-05 -A270, 0.1105145610572635E-02 -A271, 0.2817131692439818E-13 -A272, 0.2424475084644417E-06 -A273, 0.5816863029854449E-03 -A274, 0.7230320412634117E-03 -A275, 0.3173012095167780E-08 -A276, 0.6097590458791804E-03 -A277, 0.4395647761590923E-03 -A278, 0.1672953868710619E-04 -A279, 0.6385413285411382E-05 -A280, 0.1531043168587445E-01 -A281, 0.1984594169100223E-02 -A282, 0.1923295265085566E-10 -A283, 0.3868728651689194E+15 -A284, 0.6176042377998522E+10 -A285, 0.5780671963784782E+15 -A286, 0.7087235653196994E+11 -A287, 0.2571772774955146E+09 -A288, 0.1594007948381327E+06 -A289, 0.1371560255916829E+04 -A290, 0.1699884975753359E-06 -A291, 0.3024667814552878E+06 -A292, 0.2390796055783201E-13 -A293, 0.5430344329278443E-24 -A294, 0.1032631908411306E+01 -A295, 0.3593643356353974E+01 -A296, 0.4434731966330204E+01 -A297, 0.5157695746723974E+05 -A298, 0.3590667717883087E-04 -A299, 0.5813923807794108E-02 -A300, 0.1675998521975234E+06 -A301, 0.7975824354359697E-02 -A302, 0.3388340733860284E-09 -A303, 0.1896393493370307E-08 -A304, 0.1878931786977346E-03 -A305, 0.5609794092354818E+05 -A306, 0.4088689418737052E+00 -A307, 0.2438317073530726E+00 -A308, 0.1122021068920508E-01 -A309, 0.3212673468445359E-12 -A310, 0.1940510353178839E-11 -A311, 0.3364018739845117E-16 -A312, 0.3436022105331744E-18 -A313, 0.1639462292556558E-16 -A314, 0.2370507763074392E-13 -A315, 0.3948641181851453E-13 -A316, 0.3151414639816281E-33 -A317, 0.1463751073963923E-13 -A318, 0.5655630001792337E-16 -A319, 0.5776682952316307E-18 -A320, 0.2756284327065614E-16 -A321, 0.1716137523268817E-13 -A322, 0.8539986499860171E-15 -A323, 0.1423331083310029E-14 -A324, 0.9354169247325732E-08 -A325, 0.2953746491422258E-08 -A326, 0.3117686520430279E-03 -A327, 0.7554260672151960E-12 -A328, 0.1185405176990208E-06 -A329, 0.6156172132590459E-06 -A330, 0.4697139604546514E-11 -A331, 0.3594674207981100E-14 -A332, 0.1135082768859006E-14 -A333, 0.1851252046675725E+01 -A334, 0.5845659933050691E+00 -A335, 0.3386427555753618E-08 -A336, 0.1018424222835605E-14 -A337, 0.5514904399178571E+00 -A338, 0.9384039990141750E-04 -A339, 0.2273784865119969E-12 -A340, 0.3567994893810536E-07 -A341, 0.1852969023660921E-06 -A342, 0.1413809425658991E-11 -A343, 0.4918242796265270E-11 -A344, 0.2102651440191347E+03 -A345, 0.1740289725162696E+04 -A346, 0.6272807038176483E-06 -A347, 0.5191779021383282E-05 -A348, 0.3593119357445702E+00 -A349, 0.1799207653066133E+01 -A350, 0.4965433218350501E+00 -A351, 0.2493689814486356E+01 -A352, 0.3167876978509202E-05 -A353, 0.2621938972337380E-04 -A354, 0.4020091204689799E-05 -A355, 0.2020138135868733E-04 -A356, 0.1164496317165047E-03 -A357, 0.4379317728681581E-14 -A358, 0.2815306148657827E-13 -A359, 0.2017681046089666E-19 -A360, 0.5751909393721803E-07 -A361, 0.1358873889006326E-06 -A362, 0.1314727117177566E+03 -A363, 0.5395161179564697E+01 -A364, 0.2307709659719508E-21 -A365, 0.1775267572985726E-11 -A366, 0.7422165779049265E-11 -A367, 0.2218929163134110E-09 -A368, 0.1054340498671864E-09 -A369, 0.2619205878191211E-15 -A370, 0.7469868230075904E-08 -A371, 0.3816951207200703E-08 -A372, 0.1123085349331923E-10 -A373, 0.5836953125458992E-09 -A374, 0.1944637616862475E-11 -A375, 0.6028679035750115E-13 -A376, 0.6052059587773872E-12 -A377, 0.2899022381688688E-13 -A378, 0.1424344115722777E-06 -A379, 0.1529499716726462E-06 -A380, 0.7840782424300661E-07 -A381, 0.9599212284338899E-06 -A382, 0.6437396350285181E-18 -A383, 0.5256615133931762E-17 -A384, 0.8990095161218764E-17 -A385, 0.7181033991617623E-18 -A386, 0.1728378611882632E-18 -A387, 0.3540550782602235E-18 -A388, 0.8376724155616681E-06 -A389, 0.2596914760226982E-07 -A390, 0.2606986170612690E-06 -A391, 0.1248783351807517E-07 -A392, 0.2286308513536836E-03 -A393, 0.9963614413695651E-03 -A394, 0.6130101802550409E-05 -A395, 0.3190045534121469E-04 -A396, 0.6631439258938231E-04 -A397, 0.3149799352817428E-03 -A398, 0.2937523564848480E-05 -A399, 0.1528658777823684E-04 -A400, 0.3246618186702964E-12 -A401, 0.1322554894724566E-10 -A402, 0.4436398435563716E-12 -A403, 0.2317714845226771E-10 -A404, 0.2208520300060596E-10 -A405, 0.4555589789244790E-11 -A406, 0.2373292562960970E-10 -A407, 0.7692421504917059E-12 -A408, 0.4479806262918383E-11 -A409, 0.5720171802143974E-12 -A410, 0.3327689327225707E-11 -A411, 0.9541544193078286E-12 -A412, 0.2707861101328804E-12 -A413, 0.2569561764962839E-12 -A414, 0.1986091916537217E-12 -A415, 0.4824250528672271E-12 -A416, 0.5250266029918284E-10 -A417, 0.1564047976340820E-10 -A418, 0.1260288663352272E-18 -A419, 0.2519713148907613E-12 -A420, 0.1530962019219430E-10 -A421, 0.4137151998760797E-11 -A422, 0.3596627115883311E-19 -A423, 0.9579749004276294E-12 -A424, 0.9537007073328073E-10 -A425, 0.1937717545388283E-10 -A426, 0.2122218808639322E-18 -A427, 0.9695357696343289E-14 -A428, 0.4529884841670604E-13 -A429, 0.1928975709350712E-12 -A430, 0.1941788585406793E-13 -A431, 0.7142398609479672E-13 -A432, 0.1714004222102950E-12 -A433, 0.6783683652805710E-11 -A434, 0.3658709432159320E-19 -A435, 0.1971222276732534E-10 -A436, 0.8183009814378561E-12 -A437, 0.4050670391121480E-13 -A438, 0.1603173793903550E-11 -A439, 0.4696812625401136E-11 -A440, 0.1551231861278248E-12 -A441, 0.8646551610229622E-20 -A442, 0.1066495174196559E-19 -A443, 0.2385305703898759E-12 -A444, 0.5746012588278302E-11 -A445, 0.4996235053152272E-13 -A446, 0.1621668990638592E-07 -A447, 0.2889948500338249E-16 -A448, 0.7514067387919777E-06 -A449, 0.1339069064310597E-14 -A450, 0.2238725993141044E-21 -A451, 0.3736516166716327E-22 -A452, 0.5318582814284088E-16 -A453, 0.7214725780084667E-17 -A454, 0.3279532730343488E-15 -A455, 0.3532460352275363E-14 -A456, 0.3863795390710753E-16 -A457, 0.9798645478821553E-15 -A458, 0.3396993564873639E-15 -A459, 0.6516158271979608E-16 -A460, 0.0000000000000000E+00 -A461, 0.0000000000000000E+00 -A462, 0.0000000000000000E+00 -A463, 0.0000000000000000E+00 -A464, 0.4418426751894913E-16 -A465, 0.1030338867990757E-22 -A466, 0.4859084236674413E-14 -A467, 0.4333540311060351E-15 -A468, 0.4040808340643157E-14 -A469, 0.4332993393882480E-14 -A470, 0.1406670268037152E-20 -A471, 0.6281407829283192E-12 -A472, 0.9440941759227247E-13 -A473, 0.3720602962379587E-20 -A474, 0.1454824871637050E-11 -A475, 0.4562999154647097E-12 -A476, 0.1343177581917852E-06 -A477, 0.4990099635144189E+02 -A478, 0.1909265860820600E+02 -A479, 0.1482511986978174E+00 -A480, 0.4967650084301614E-06 -A481, 0.2691115881143271E-06 -A482, 0.6983500284267914E-06 -A483, 0.6015457275305513E-06 -A484, 0.4722630776494077E-06 -A485, 0.5870280456511932E-01 -A486, 0.2571304277851679E-01 -A487, 0.3582908326608880E-01 -A488, 0.7794176707803806E-01 -A489, 0.3231581412497684E-05 -A490, 0.1750638614394786E-05 -A491, 0.2561887250353431E+03 -A492, 0.1240948212149431E+02 -A493, 0.1008330589944530E+03 -A494, 0.4467415038219040E+02 -A495, 0.6131232311327177E-01 -A496, 0.2381101999880997E-01 -A497, 0.3953212798226044E-14 -A498, 0.3895194731330580E-17 -A499, 0.1874834610003191E-14 -A500, 0.1344470830798795E-17 -A501, 0.4413633309404063E-18 -A502, 0.7692177504173946E-15 -A503, 0.4131473069379154E-18 -A504, 0.4746253097329321E-18 -A505, 0.1803749950210138E-16 -A506, 0.3083019242884056E-14 -A507, 0.1569654339286675E-20 -A508, 0.1222585685552472E-22 -A509, 0.7091715826016645E-12 -A510, 0.8488081943732611E-13 -A511, 0.5302640066377654E-14 -A512, 0.8821426339498730E-15 -A513, 0.2459415428568881E-11 -A514, 0.6336565259248951E-10 -A515, 0.9091150113493965E-04 -A516, 0.1729033786620256E-12 -A517, 0.1890792825838208E-15 -A518, 0.8043330812693193E-10 -A519, 0.1632135293881924E-18 -A520, 0.8220343512508614E-08 -A521, 0.3731295709018177E-15 -A522, 0.3331887887521723E-08 -A523, 0.2833150575250874E-08 -A524, 0.4277404568895585E-16 -A525, 0.1104290903236538E-02 -A526, 0.7365365116968668E-17 -A527, 0.2651679249880023E-10 -A528, 0.4669434252497910E-11 -A529, 0.5915672518692208E-16 -A530, 0.3656767040218887E-16 -A531, 0.0000000000000000E+00 -A532, 0.0000000000000000E+00 -A533, 0.0000000000000000E+00 -A534, 0.0000000000000000E+00 -A535, 0.0000000000000000E+00 -A536, 0.0000000000000000E+00 -A537, 0.7180679788842129E-10 -A538, 0.1680245913575859E-10 -A539, 0.1844715201172702E-11 -A540, 0.3981557986807217E-11 -A541, 0.2639322092348438E-12 -A542, 0.3381288717410178E-12 -A543, 0.2341525454693394E-11 -A544, 0.1391951552246406E-02 -A545, 0.8311660602083271E-04 -A546, 0.1587838646302927E-16 -A547, 0.7728076262494791E-04 -A548, 0.1428127488708507E-12 -A549, 0.3266465711737982E-08 -A550, 0.9164404727281037E-08 -A551, 0.8383489174974860E-09 -A552, 0.1158367493055928E+06 -A553, 0.5172038580721696E+04 -A554, 0.1837918783201298E-22 -A555, 0.2374888854683391E-13 -A556, 0.1230032744511442E-14 -A557, 0.2223491108386590E-21 -A558, 0.6452486080772206E-16 -A559, 0.3160291960014262E+02 -A560, 0.9180451050419979E-10 -A561, 0.8866462879922901E-11 -A562, 0.1239820109735366E-13 -A563, 0.6811152186501276E-14 -A564, 0.1381192267042841E-13 -A565, 0.1203577796609625E-12 -A566, 0.1197860866424651E-18 -A567, 0.2274348009330260E-18 -A568, 0.5307258956541251E-06 -A569, 0.4998454421161987E-12 -A570, 0.4162269494766325E-08 -A571, 0.1998597613093787E-01 -A572, 0.1043153725182578E-12 -A573, 0.5711085553254583E-12 -A574, 0.0000000000000000E+00 -A575, 0.0000000000000000E+00 -A576, 0.0000000000000000E+00 -A577, 0.3547882484102420E-13 -A578, 0.1157294366814610E-05 -A579, 0.3252185849784494E-11 -A580, 0.1232337540261104E-09 -A581, 0.1115393792809869E+00 -A582, 0.1294193771344956E-08 -A583, 0.2206636996291806E-04 -A584, 0.8828871950789313E-05 -A585, 0.1157972686065517E-04 -A586, 0.5123547623398150E-10 -A587, 0.1265519762531330E-09 -A588, 0.4616545583045402E-09 -A589, 0.7051296753371779E-07 -A590, 0.5573778982353870E-06 -A591, 0.1246701971604570E-05 -A592, 0.2284041094831776E-04 -A593, 0.1299771729382526E+05 -A594, 0.1538006354705485E-03 -A595, 0.1649253481558453E+00 -A596, 0.8279932668530401E-01 -A597, 0.2347003615788033E-08 -A598, 0.5466440579668983E+00 -A599, 0.1078653842783941E-07 -A600, 0.7705634763091332E+01 -A601, 0.6222533705150954E-10 -A602, 0.8954947251579006E-17 -A603, 0.7387008590175128E+00 -A604, 0.7011356237529493E-08 -A605, 0.3026125515005468E-02 -A606, 0.5910933108251707E-03 -A607, 0.5203455194832734E+06 -A608, 0.2727648025106068E+05 -A609, 0.4092382582857168E-11 -A610, 0.7789550063140152E+03 -A611, 0.1071577204937727E-09 -A612, 0.8231773659019195E+05 -A613, 0.1050009677140692E+07 -A614, 0.1209891516341411E-01 -A615, 0.1686682706422417E-02 -A616, 0.3438911816130324E-09 -A617, 0.2441989591255851E-12 -A618, 0.3043519580585904E+05 -A619, 0.1918223226350207E-13 -A620, 0.3446983192867918E-04 -A621, 0.3446523510088201E+03 -A622, 0.7979700393218594E+03 -A623, 0.8731865412445935E-14 -A624, 0.4370840498572373E-19 -A625, 0.2944833937001476E+00 -A626, 0.1348557750634568E-12 -A627, 0.6750368395206559E-18 -A628, 0.4548030051419025E+01 -A629, 0.1283234832171518E-10 -A630, 0.1037268883902057E-01 -A631, 0.1017322120220641E-09 -A632, 0.8223253871814289E-01 -A633, 0.2293348848446985E-09 -A634, 0.1853767791200916E+00 -A635, 0.3569576332186979E+00 -A636, 0.0000000000000000E+00 -A637, 0.1808921107117228E+01 -A638, 0.2545333606301416E+05 -A639, 0.1689086656245595E+01 -A640, 0.4293539590178599E-04 -A641, 0.2836234988752061E-08 -A642, 0.7944592305260910E-03 -A643, 0.0000000000000000E+00 -A644, 0.0000000000000000E+00 -A645, 0.1074180515007043E-05 -A646, 0.2849001957305408E-12 -A647, 0.5845193854789035E-11 -A648, 0.7293970604304297E-19 -A649, 0.1441625574594696E-05 -A650, 0.0000000000000000E+00 -A651, 0.8834526049890720E-04 -A652, 0.0000000000000000E+00 -A653, 0.0000000000000000E+00 -A654, 0.0000000000000000E+00 -A655, 0.0000000000000000E+00 -A656, 0.6605735306569498E-08 -A657, 0.1797789272970839E-08 -A658, 0.0000000000000000E+00 -A659, 0.0000000000000000E+00 -A660, 0.0000000000000000E+00 -A661, 0.2238077967626876E-01 -A662, 0.0000000000000000E+00 -A663, 0.0000000000000000E+00 -A664, 0.0000000000000000E+00 -A665, 0.0000000000000000E+00 -A666, 0.1758326258742208E-02 -A667, 0.9081473600053109E-10 -A668, 0.0000000000000000E+00 -A669, 0.0000000000000000E+00 -A670, 0.0000000000000000E+00 -A671, 0.1003751585995901E-05 -A672, 0.2149607956741996E-12 -A673, 0.9033764273963111E-05 -A674, 0.0000000000000000E+00 -A675, 0.0000000000000000E+00 -A676, 0.0000000000000000E+00 -A677, 0.2862068404927127E-17 -A678, 0.0000000000000000E+00 -A679, 0.2283562948629758E-09 -A680, 0.5005680574844495E-14 -A681, 0.8562704552872646E+05 -A682, 0.3609338297976244E+02 -A683, 0.1769340488879759E+01 -A684, 0.0000000000000000E+00 -A685, 0.0000000000000000E+00 -A686, 0.2191757337206514E-02 -A687, 0.9533032828988268E-06 -A688, 0.6657889655618817E-07 -A689, 0.2022066262368885E+01 -A690, 0.8796142282682334E-03 -A691, 0.6154596556160044E-04 -A692, 0.1043991718921468E+00 -A693, 0.4542010191384892E-04 -A694, 0.3183485601615590E-05 -A695, 0.0000000000000000E+00 -A696, 0.0000000000000000E+00 -A697, 0.0000000000000000E+00 -A698, 0.0000000000000000E+00 -A699, 0.2842723232397293E-03 -A700, 0.2612183643291028E+05 -A701, 0.0000000000000000E+00 -A702, 0.1480237397864916E+06 -A703, 0.4405419527867512E+04 -A704, 0.1014312842611429E-07 -A705, 0.0000000000000000E+00 -A706, 0.5747772774798096E-07 -A707, 0.4139196340887163E-08 -A708, 0.1856248534737026E+02 -A709, 0.0000000000000000E+00 -A710, 0.1051874169684315E+03 -A711, 0.7531406042467406E+01 -A712, 0.1489601946186687E+02 -A713, 0.3922065423092101E+02 -A714, 0.5684224063877433E-03 -A715, 0.3101139634768223E-03 -A716, 0.3967174383951592E-04 -A717, 0.4639101978565379E-13 -A718, 0.1431953016367722E-02 -A719, 0.6093619121372813E+00 -A720, 0.1449246726077255E+01 -A721, 0.6134444060618438E+00 -A722, 0.1756802082638263E-05 -A723, 0.2163731895924224E-01 -A724, 0.6329938088068282E-01 -A725, 0.4052707251357372E-01 -A726, 0.7204854928213757E-07 -A727, 0.1220376564142316E-02 -A728, 0.7773956993299871E-02 -A729, 0.3234952662958038E-02 -A730, 0.5378066184467710E-04 -A731, 0.1494499283095760E+00 -A732, 0.1592186331058342E-01 -A733, 0.1000915955079963E-04 -A734, 0.6302230986616882E-04 -A735, 0.2356329664411779E-02 -A736, 0.1026029941463008E-02 -A737, 0.1091584298789858E+02 -A738, 0.0000000000000000E+00 -A739, 0.0000000000000000E+00 -A740, 0.0000000000000000E+00 -A741, 0.0000000000000000E+00 -A742, 0.0000000000000000E+00 -A743, 0.0000000000000000E+00 -A744, 0.0000000000000000E+00 -A745, 0.0000000000000000E+00 -A746, 0.0000000000000000E+00 -A747, 0.0000000000000000E+00 -A748, 0.0000000000000000E+00 -A749, 0.0000000000000000E+00 -A750, 0.0000000000000000E+00 -A751, 0.0000000000000000E+00 -A752, 0.0000000000000000E+00 -A753, 0.0000000000000000E+00 -A754, 0.0000000000000000E+00 -A755, 0.0000000000000000E+00 -A756, 0.0000000000000000E+00 -A757, 0.0000000000000000E+00 -A758, 0.0000000000000000E+00 -A759, 0.0000000000000000E+00 -A760, 0.0000000000000000E+00 -A761, 0.0000000000000000E+00 -A762, 0.0000000000000000E+00 -A763, 0.0000000000000000E+00 -A764, 0.0000000000000000E+00 -A765, 0.0000000000000000E+00 -A766, 0.0000000000000000E+00 -A767, 0.0000000000000000E+00 -A768, 0.0000000000000000E+00 -A769, 0.0000000000000000E+00 -A770, 0.0000000000000000E+00 -A771, 0.0000000000000000E+00 -A772, 0.0000000000000000E+00 -A773, 0.0000000000000000E+00 -A774, 0.0000000000000000E+00 -A775, 0.0000000000000000E+00 -A776, 0.0000000000000000E+00 -A777, 0.0000000000000000E+00 -A778, 0.0000000000000000E+00 -A779, 0.0000000000000000E+00 -A780, 0.0000000000000000E+00 -A781, 0.0000000000000000E+00 -A782, 0.0000000000000000E+00 -A783, 0.0000000000000000E+00 -A784, 0.0000000000000000E+00 -A785, 0.0000000000000000E+00 -A786, 0.0000000000000000E+00 -A787, 0.0000000000000000E+00 -A788, 0.0000000000000000E+00 -A789, 0.0000000000000000E+00 -A790, 0.0000000000000000E+00 -A791, 0.0000000000000000E+00 -A792, 0.0000000000000000E+00 -A793, 0.0000000000000000E+00 -A794, 0.0000000000000000E+00 -A795, 0.0000000000000000E+00 -A796, 0.0000000000000000E+00 -A797, 0.0000000000000000E+00 -A798, 0.0000000000000000E+00 -A799, 0.0000000000000000E+00 -A800, 0.0000000000000000E+00 -A801, 0.0000000000000000E+00 -A802, 0.0000000000000000E+00 -A803, 0.0000000000000000E+00 -A804, 0.0000000000000000E+00 -A805, 0.0000000000000000E+00 -A806, 0.0000000000000000E+00 -A807, 0.0000000000000000E+00 -A808, 0.0000000000000000E+00 -A809, 0.0000000000000000E+00 -A810, 0.0000000000000000E+00 -A811, 0.0000000000000000E+00 -A812, 0.0000000000000000E+00 -A813, 0.0000000000000000E+00 -A814, 0.0000000000000000E+00 -A815, 0.0000000000000000E+00 -A816, 0.0000000000000000E+00 -A817, 0.0000000000000000E+00 -A818, 0.0000000000000000E+00 -A819, 0.0000000000000000E+00 -A820, 0.0000000000000000E+00 -A821, 0.0000000000000000E+00 -A822, 0.0000000000000000E+00 -A823, 0.0000000000000000E+00 -A824, 0.0000000000000000E+00 -A825, 0.0000000000000000E+00 -A826, 0.0000000000000000E+00 -A827, 0.0000000000000000E+00 -A828, 0.0000000000000000E+00 -A829, 0.0000000000000000E+00 -A830, 0.0000000000000000E+00 -A831, 0.0000000000000000E+00 -A832, 0.0000000000000000E+00 -A833, 0.0000000000000000E+00 -A834, 0.0000000000000000E+00 -A835, 0.0000000000000000E+00 -A836, 0.0000000000000000E+00 -A837, 0.0000000000000000E+00 -A838, 0.0000000000000000E+00 -A839, 0.0000000000000000E+00 -A840, 0.0000000000000000E+00 -A841, 0.0000000000000000E+00 -A842, 0.0000000000000000E+00 -A843, 0.0000000000000000E+00 -A844, 0.0000000000000000E+00 -A845, 0.0000000000000000E+00 -A846, 0.0000000000000000E+00 -A847, 0.0000000000000000E+00 -A848, 0.0000000000000000E+00 -A849, 0.0000000000000000E+00 -A850, 0.0000000000000000E+00 -A851, 0.0000000000000000E+00 -A852, 0.0000000000000000E+00 -A853, 0.0000000000000000E+00 -A854, 0.0000000000000000E+00 -A855, 0.0000000000000000E+00 -A856, 0.0000000000000000E+00 -A857, 0.0000000000000000E+00 -A858, 0.0000000000000000E+00 -A859, 0.0000000000000000E+00 -A860, 0.0000000000000000E+00 -A861, 0.0000000000000000E+00 -A862, 0.0000000000000000E+00 -A863, 0.0000000000000000E+00 -A864, 0.0000000000000000E+00 -A865, 0.0000000000000000E+00 -A866, 0.0000000000000000E+00 -A867, 0.0000000000000000E+00 -A868, 0.0000000000000000E+00 -A869, 0.0000000000000000E+00 -A870, 0.0000000000000000E+00 -A871, 0.0000000000000000E+00 -A872, 0.0000000000000000E+00 -A873, 0.0000000000000000E+00 -A874, 0.0000000000000000E+00 -A875, 0.0000000000000000E+00 -A876, 0.0000000000000000E+00 -A877, 0.0000000000000000E+00 -A878, 0.0000000000000000E+00 -A879, 0.0000000000000000E+00 -A880, 0.0000000000000000E+00 -A881, 0.0000000000000000E+00 -A882, 0.0000000000000000E+00 -A883, 0.0000000000000000E+00 -A884, 0.0000000000000000E+00 -A885, 0.0000000000000000E+00 -A886, 0.0000000000000000E+00 -A887, 0.0000000000000000E+00 -A888, 0.0000000000000000E+00 -A889, 0.0000000000000000E+00 -A890, 0.0000000000000000E+00 -A891, 0.0000000000000000E+00 -A892, 0.0000000000000000E+00 -A893, 0.0000000000000000E+00 -A894, 0.0000000000000000E+00 - diff --git a/KPP/standalone b/KPP/standalone new file mode 160000 index 000000000..2e56d7bdf --- /dev/null +++ b/KPP/standalone @@ -0,0 +1 @@ +Subproject commit 2e56d7bdf4e3e38f0fd3b1c2ad7cd17dec5f2ca2 From 6d1a8fb35eb79ef4303359c9eb3cc3692f70e75a Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 10 Oct 2024 16:06:29 -0400 Subject: [PATCH 26/37] Edit KPP/CMakeLists.txt to build KPP standalone (fullchem, custom) KPP/CMakeLists.txt - Add calls to "add_directory(standalone)" in the fullchem and custom "if" blocks. This will tell CMake to look for the CMakeLists.txt file in the KPP/standalone folder, and to build the standalone files (libKppStandalone.a) after libKPP.a has been built. Signed-off-by: Bob Yantosca --- KPP/CMakeLists.txt | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/KPP/CMakeLists.txt b/KPP/CMakeLists.txt index f89bc8016..b178e0188 100755 --- a/KPP/CMakeLists.txt +++ b/KPP/CMakeLists.txt @@ -1,11 +1,12 @@ # KPP/CMakeLists.txt #----------------------------------------------------------------------------- -# Build the fullchem mechanism if configured with -DMECH=fullchem -# (This is the default option) +# Build the fullchem mechanism and the KPP standalone executable +# if configured with -DMECH=fullchem (This is the default option) #----------------------------------------------------------------------------- if("${MECH}" STREQUAL fullchem) add_subdirectory(fullchem) + add_subdirectory(standalone) endif() #----------------------------------------------------------------------------- @@ -16,10 +17,12 @@ if("${MECH}" STREQUAL carbon) endif() #----------------------------------------------------------------------------- -# Build the custom mechanism if configured with -DMECH=custom +# Build the custom mechanism and the KPP standalone executable +# if configured with -DMECH=custom #----------------------------------------------------------------------------- if("${MECH}" STREQUAL custom) add_subdirectory(custom) + add_subdirectory(standalone) endif() #----------------------------------------------------------------------------- From 93a5ffba2c1af18c911783dc14a8400c0dd38ee6 Mon Sep 17 00:00:00 2001 From: kelvinhb <52680278+kelvinhb@users.noreply.github.com> Date: Fri, 11 Oct 2024 15:44:26 -0600 Subject: [PATCH 27/37] Update HEMCO_Config.rc.fullchem Changed the CEDS TMB emission fields to actually emit TMB like they're supposed to, instead of emitting HCOOH. --- .../HEMCO_Config.rc.fullchem | 32 +++++++++---------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem b/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem index 06b975325..7a3975578 100644 --- a/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem +++ b/run/GCHP/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem @@ -1629,20 +1629,20 @@ VerboseOnCores: root # Accepted values: root all 0 CEDS_HCOOH_SLV $ROOT/CEDS/v2021-06/$YYYY/HCOOH-em-anthro_CMIP_CEDS_$YYYY.nc HCOOH_slv 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 2407/707 1 5 0 CEDS_HCOOH_WST $ROOT/CEDS/v2021-06/$YYYY/HCOOH-em-anthro_CMIP_CEDS_$YYYY.nc HCOOH_wst 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 -0 CEDS_TMB_AGR $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_agr 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 -0 CEDS_TMB_ENE $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ene 1750-2019/1-12/1/0 C xyL* kg/m2/s HCOOH 26/315 1 5 -0 CEDS_TMB_IND $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ind 1750-2019/1-12/1/0 C xyL* kg/m2/s HCOOH 26/316 1 5 -0 CEDS_TMB_TRA $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_tra 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 -0 CEDS_TMB_RCO $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_rco 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 -0 CEDS_TMB_SLV $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_slv 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 -0 CEDS_TMB_WST $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_wst 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 - -0 CEDS_OTH_AGR $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_agr 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 1 5 -0 CEDS_OTH_ENE $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_ene 1750-2019/1-12/1/0 C xyL* kg/m2/s ALK6 26/315 1 5 -0 CEDS_OTH_IND $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_ind 1750-2019/1-12/1/0 C xyL* kg/m2/s ALK6 26/316 1 5 -0 CEDS_OTH_TRA $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_tra 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 1 5 -0 CEDS_OTH_RCO $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_rco 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 1 5 -0 CEDS_OTH_SLV $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_slv 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 1 5 +0 CEDS_TMB_AGR $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_agr 1750-2019/1-12/1/0 C xy kg/m2/s TMB 2401 1 5 +0 CEDS_TMB_ENE $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ene 1750-2019/1-12/1/0 C xyL* kg/m2/s TMB 2406/706/315 1 5 +0 CEDS_TMB_IND $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ind 1750-2019/1-12/1/0 C xyL* kg/m2/s TMB 2407/707/316 1 5 +0 CEDS_TMB_TRA $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_tra 1750-2019/1-12/1/0 C xy kg/m2/s TMB 2411/711 1 5 +0 CEDS_TMB_RCO $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_rco 1750-2019/1-12/1/0 C xy kg/m2/s TMB 2409/709 1 5 +0 CEDS_TMB_SLV $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_slv 1750-2019/1-12/1/0 C xy kg/m2/s TMB 2407/707 1 5 +0 CEDS_TMB_WST $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_wst 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 1 5 + +0 CEDS_OTH_AGR $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_agr 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 2401 1 5 +0 CEDS_OTH_ENE $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_ene 1750-2019/1-12/1/0 C xyL* kg/m2/s ALK6 2406/706/315 1 5 +0 CEDS_OTH_IND $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_ind 1750-2019/1-12/1/0 C xyL* kg/m2/s ALK6 2407/707/316 1 5 +0 CEDS_OTH_TRA $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_tra 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 2411/711 1 5 +0 CEDS_OTH_RCO $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_rco 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 2409/709 1 5 +0 CEDS_OTH_SLV $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_slv 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 2407/707 1 5 0 CEDS_OTH_WST $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_wst 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 1 5 )))CEDSv2 @@ -2673,7 +2673,7 @@ VerboseOnCores: root # Accepted values: root all 0 CEDS_ALD2_SHP $ROOT/CEDS/v2021-06/$YYYY/ALD2-em-anthro_CMIP_CEDS_$YYYY.nc ALD2_shp 1750-2019/1-12/1/0 C xy kg/m2/s ALD2 26 10 4 0 CEDS_MEK_SHP $ROOT/CEDS/v2021-06/$YYYY/MEK-em-anthro_CMIP_CEDS_$YYYY.nc MEK_shp 1750-2019/1-12/1/0 C xy kg/m2/s MEK 26 10 4 0 CEDS_HCOOH_SHP $ROOT/CEDS/v2021-06/$YYYY/HCOOH-em-anthro_CMIP_CEDS_$YYYY.nc HCOOH_shp 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 10 4 -0 CEDS_TMB_SHP $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_shp 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 10 4 +0 CEDS_TMB_SHP $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_shp 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 10 4 0 CEDS_OTH_SHP $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_shp 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 10 4 )))HTAPv3_SHIP @@ -2708,7 +2708,7 @@ VerboseOnCores: root # Accepted values: root all 0 CEDS_ALD2_SHP $ROOT/CEDS/v2021-06/$YYYY/ALD2-em-anthro_CMIP_CEDS_$YYYY.nc ALD2_shp 1750-2019/1-12/1/0 C xy kg/m2/s ALD2 26 10 5 0 CEDS_MEK_SHP $ROOT/CEDS/v2021-06/$YYYY/MEK-em-anthro_CMIP_CEDS_$YYYY.nc MEK_shp 1750-2019/1-12/1/0 C xy kg/m2/s MEK 26 10 5 0 CEDS_HCOOH_SHP $ROOT/CEDS/v2021-06/$YYYY/HCOOH-em-anthro_CMIP_CEDS_$YYYY.nc HCOOH_shp 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 10 5 -0 CEDS_TMB_SHP $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_shp 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 10 5 +0 CEDS_TMB_SHP $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_shp 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 10 5 0 CEDS_OTH_SHP $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_shp 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 10 5 )))CEDSv2_SHIP From 4d9f98cadcb3be60cdf210872c5ba8afb7abbf8e Mon Sep 17 00:00:00 2001 From: kelvinhb <52680278+kelvinhb@users.noreply.github.com> Date: Fri, 11 Oct 2024 15:46:07 -0600 Subject: [PATCH 28/37] Update HEMCO_Config.rc.fullchem Changed the CEDS TMB emission fields to actually emit TMB like they're supposed to, instead of emitting HCOOH. --- .../HEMCO_Config.rc.fullchem | 28 +++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem index a953c88f7..4f7b0b1db 100644 --- a/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem +++ b/run/GCClassic/HEMCO_Config.rc.templates/HEMCO_Config.rc.fullchem @@ -1630,20 +1630,20 @@ VerboseOnCores: root # Accepted values: root all 0 CEDS_HCOOH_SLV $ROOT/CEDS/v2021-06/$YYYY/HCOOH-em-anthro_CMIP_CEDS_$YYYY.nc HCOOH_slv 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 2407/707 1 5 0 CEDS_HCOOH_WST $ROOT/CEDS/v2021-06/$YYYY/HCOOH-em-anthro_CMIP_CEDS_$YYYY.nc HCOOH_wst 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 1 5 -0 CEDS_TMB_AGR $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_agr 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 1 5 -0 CEDS_TMB_ENE $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ene 1750-2019/1-12/1/0 C xyL* kg/m2/s TMB 26/315 1 5 -0 CEDS_TMB_IND $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ind 1750-2019/1-12/1/0 C xyL* kg/m2/s TMB 26/316 1 5 -0 CEDS_TMB_TRA $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_tra 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 1 5 -0 CEDS_TMB_RCO $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_rco 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 1 5 -0 CEDS_TMB_SLV $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_slv 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 1 5 +0 CEDS_TMB_AGR $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_agr 1750-2019/1-12/1/0 C xy kg/m2/s TMB 2401 1 5 +0 CEDS_TMB_ENE $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ene 1750-2019/1-12/1/0 C xyL* kg/m2/s TMB 2406/706/315 1 5 +0 CEDS_TMB_IND $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_ind 1750-2019/1-12/1/0 C xyL* kg/m2/s TMB 2407/707/316 1 5 +0 CEDS_TMB_TRA $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_tra 1750-2019/1-12/1/0 C xy kg/m2/s TMB 2411/711 1 5 +0 CEDS_TMB_RCO $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_rco 1750-2019/1-12/1/0 C xy kg/m2/s TMB 2409/709 1 5 +0 CEDS_TMB_SLV $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_slv 1750-2019/1-12/1/0 C xy kg/m2/s TMB 2407/707 1 5 0 CEDS_TMB_WST $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_wst 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 1 5 -0 CEDS_OTH_AGR $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_agr 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 1 5 -0 CEDS_OTH_ENE $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_ene 1750-2019/1-12/1/0 C xyL* kg/m2/s ALK6 26/315 1 5 -0 CEDS_OTH_IND $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_ind 1750-2019/1-12/1/0 C xyL* kg/m2/s ALK6 26/316 1 5 -0 CEDS_OTH_TRA $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_tra 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 1 5 -0 CEDS_OTH_RCO $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_rco 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 1 5 -0 CEDS_OTH_SLV $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_slv 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 1 5 +0 CEDS_OTH_AGR $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_agr 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 2401 1 5 +0 CEDS_OTH_ENE $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_ene 1750-2019/1-12/1/0 C xyL* kg/m2/s ALK6 2406/706/315 1 5 +0 CEDS_OTH_IND $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_ind 1750-2019/1-12/1/0 C xyL* kg/m2/s ALK6 2407/707/316 1 5 +0 CEDS_OTH_TRA $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_tra 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 2411/711 1 5 +0 CEDS_OTH_RCO $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_rco 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 2409/709 1 5 +0 CEDS_OTH_SLV $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_slv 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 2407/707 1 5 0 CEDS_OTH_WST $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_wst 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 1 5 )))CEDSv2 @@ -2674,7 +2674,7 @@ VerboseOnCores: root # Accepted values: root all 0 CEDS_ALD2_SHP $ROOT/CEDS/v2021-06/$YYYY/ALD2-em-anthro_CMIP_CEDS_$YYYY.nc ALD2_shp 1750-2019/1-12/1/0 C xy kg/m2/s ALD2 26 10 4 0 CEDS_MEK_SHP $ROOT/CEDS/v2021-06/$YYYY/MEK-em-anthro_CMIP_CEDS_$YYYY.nc MEK_shp 1750-2019/1-12/1/0 C xy kg/m2/s MEK 26 10 4 0 CEDS_HCOOH_SHP $ROOT/CEDS/v2021-06/$YYYY/HCOOH-em-anthro_CMIP_CEDS_$YYYY.nc HCOOH_shp 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 10 4 -0 CEDS_TMB_SHP $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_shp 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 10 4 +0 CEDS_TMB_SHP $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_shp 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 10 4 0 CEDS_OTH_SHP $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_shp 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 10 4 )))HTAPv3_SHIP @@ -2709,7 +2709,7 @@ VerboseOnCores: root # Accepted values: root all 0 CEDS_ALD2_SHP $ROOT/CEDS/v2021-06/$YYYY/ALD2-em-anthro_CMIP_CEDS_$YYYY.nc ALD2_shp 1750-2019/1-12/1/0 C xy kg/m2/s ALD2 26 10 5 0 CEDS_MEK_SHP $ROOT/CEDS/v2021-06/$YYYY/MEK-em-anthro_CMIP_CEDS_$YYYY.nc MEK_shp 1750-2019/1-12/1/0 C xy kg/m2/s MEK 26 10 5 0 CEDS_HCOOH_SHP $ROOT/CEDS/v2021-06/$YYYY/HCOOH-em-anthro_CMIP_CEDS_$YYYY.nc HCOOH_shp 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 10 5 -0 CEDS_TMB_SHP $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_shp 1750-2019/1-12/1/0 C xy kg/m2/s HCOOH 26 10 5 +0 CEDS_TMB_SHP $ROOT/CEDS/v2021-06/$YYYY/TMB-em-anthro_CMIP_CEDS_$YYYY.nc TMB_shp 1750-2019/1-12/1/0 C xy kg/m2/s TMB 26 10 5 0 CEDS_OTH_SHP $ROOT/CEDS/v2021-06/$YYYY/OTHER_VOC-em-anthro_CMIP_CEDS_$YYYY.nc OTHER_VOC_shp 1750-2019/1-12/1/0 C xy kg/m2/s ALK6 26 10 5 )))CEDSv2_SHIP From 0a9c1a8bbc365d7299a5507521087e1a05cc259d Mon Sep 17 00:00:00 2001 From: kelvinhb <52680278+kelvinhb@users.noreply.github.com> Date: Fri, 11 Oct 2024 15:47:38 -0600 Subject: [PATCH 29/37] Update CHANGELOG.md --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6e9e4f551..91fd421cb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,6 +30,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Moved aerosol optical properties files to a new data directory specified in geoschem_config.yml rather than specifying in photolysis input files - Moved calls to `RD_AOD` and `CALC_AOD` from `Init_Aerosol` rather than `Init_Photolysis` - Updated ResME CH4 reservoir emissions to apply seasonality via mask file +- Updated `HEMCO_Config.rc.fullchem` (GCClassic + GCHP) to make the the CEDS TMB emission fields actually emit TMB like they're supposed to ### Fixed - Simplified SOA representations and fixed related AOD and TotalOA/OC calculations in benchmark From 1c1c89f7766bfc465cb7fe4804ac5e1e0a9f8908 Mon Sep 17 00:00:00 2001 From: kelvinhb <52680278+kelvinhb@users.noreply.github.com> Date: Fri, 11 Oct 2024 15:48:52 -0600 Subject: [PATCH 30/37] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 91fd421cb..9d1c9c64c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,7 +30,6 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Moved aerosol optical properties files to a new data directory specified in geoschem_config.yml rather than specifying in photolysis input files - Moved calls to `RD_AOD` and `CALC_AOD` from `Init_Aerosol` rather than `Init_Photolysis` - Updated ResME CH4 reservoir emissions to apply seasonality via mask file -- Updated `HEMCO_Config.rc.fullchem` (GCClassic + GCHP) to make the the CEDS TMB emission fields actually emit TMB like they're supposed to ### Fixed - Simplified SOA representations and fixed related AOD and TotalOA/OC calculations in benchmark @@ -41,6 +40,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Removed EDGAR8_CH4_AWB emissions from CH4 and carbon simulations to avoid double counting with GFED - Fixed formatting error in `.github/workflows/stale.yml` that caused the Mark Stale Issues action not to run - Fixed emissions in GCHP carbon ExtData.rc so that data in molecules/cm2/s are converted to kg/m2/s +- Fixed CEDS HEMCO_Config.rc entries to emit TMB into the TMB species (and not HCOOH) ## [14.4.3] - 2024-08-13 ### Added From 72f149c2571f1e731b2a00f75a290e82c9064a3d Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Wed, 30 Oct 2024 11:12:51 -0400 Subject: [PATCH 31/37] Now pass ICNTRL and RCNTRL to KppSa_Write_Samples GeosCore/fullchem_mod.F90 - Pass KPP integrator arguments ICNTRL and RCNTRL to KppSa_Write_Samples so that we can include it in the KPP standalone output. Signed-off-by: Bob Yantosca --- GeosCore/fullchem_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/GeosCore/fullchem_mod.F90 b/GeosCore/fullchem_mod.F90 index 5d3639e25..aacee485f 100644 --- a/GeosCore/fullchem_mod.F90 +++ b/GeosCore/fullchem_mod.F90 @@ -1310,6 +1310,8 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & localRCONST = local_RCONST, & initHvalue = KPPH_before_integrate, & exitHvalue = RSTATE(Nhexit), & + ICNTRL = ICNTRL, & + RCNTRL = RCNTRL, & State_Grid = State_Grid, & State_Chm = State_Chm, & State_Met = State_Met, & From 69f831b53d909d95ad56c824509568232d0e7ac3 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Wed, 30 Oct 2024 11:53:03 -0400 Subject: [PATCH 32/37] Now write ICNTRL, RCNTRL and ATOL to KPP standalone input files GeosCore/CMakeLists.txt - Changed permission from chmod 755 to chmod 644 GeosCore/kppsa_interface_mod.F90 - Now accept ICNTRL and RCNTRL as inputs to routine KppSa_Write_Samples - Change number of header lines from 48 to 60 - Better separate Meteorological metadata and KPP parameters for readability - Write out ICNTRL as 2 lines of format 10i6 - Write out RCNTRL as 4 lines of format 5f13.6 - Changed format e25.16e3 to es25.16e3, which changes the output from e.g. 0.5e1 to 5.0e0, etc., which is more standard - Write out ATOL after the species concentration with format es10.2e2 - Cosmetic changes (indentation, comments) Signed-off-by: Bob Yantosca --- GeosCore/CMakeLists.txt | 0 GeosCore/kppsa_interface_mod.F90 | 96 ++++++++++++++++++-------------- 2 files changed, 55 insertions(+), 41 deletions(-) mode change 100755 => 100644 GeosCore/CMakeLists.txt diff --git a/GeosCore/CMakeLists.txt b/GeosCore/CMakeLists.txt old mode 100755 new mode 100644 diff --git a/GeosCore/kppsa_interface_mod.F90 b/GeosCore/kppsa_interface_mod.F90 index e58890094..f5d16736a 100644 --- a/GeosCore/kppsa_interface_mod.F90 +++ b/GeosCore/kppsa_interface_mod.F90 @@ -566,54 +566,58 @@ END SUBROUTINE KppSa_Config !\\ ! !INTERFACE: ! - SUBROUTINE KppSa_Write_Samples( I, J, L, & - initC, localRCONST, initHvalue, & - exitHvalue, State_Grid, State_Chm, & - State_Met, Input_Opt, KPP_TotSteps, & - RC, FORCE_WRITE, CELL_NAME ) + SUBROUTINE KppSa_Write_Samples( I, J, L, & + initC, localRCONST, initHvalue, & + exitHvalue, ICNTRL, RCNTRL, & + State_Grid, State_Chm, State_Met, & + Input_Opt, KPP_TotSteps, RC, & + FORCE_WRITE, CELL_NAME ) ! ! !USES: ! USE ErrCode_Mod - USE State_Grid_Mod, ONLY : GrdState - USE State_Chm_Mod, ONLY : ChmState - USE State_Met_Mod, ONLY : MetState - USE Input_Opt_Mod, ONLY : OptInput + USE State_Grid_Mod, ONLY : GrdState + USE State_Chm_Mod, ONLY : ChmState + USE State_Met_Mod, ONLY : MetState + USE Input_Opt_Mod, ONLY : OptInput + USE GcKpp_Global, ONLY : ATOL USE GcKpp_Function - USE GcKpp_Parameters, ONLY : NSPEC, NREACT, NVAR - USE TIME_MOD, ONLY : GET_TS_CHEM - USE TIME_MOD, ONLY : TIMESTAMP_STRING - USE TIME_MOD, ONLY : Get_Minute - USE TIME_MOD, ONLY : Get_Hour - USE TIME_MOD, ONLY : Get_Day - USE TIME_MOD, ONLY : Get_Month - USE TIME_MOD, ONLY : Get_Year - USE Pressure_Mod, ONLY : Get_Pcenter - USE inquireMod, ONLY : findFreeLUN + USE GcKpp_Parameters, ONLY : NSPEC, NREACT, NVAR + USE TIME_MOD, ONLY : GET_TS_CHEM + USE TIME_MOD, ONLY : TIMESTAMP_STRING + USE TIME_MOD, ONLY : Get_Minute + USE TIME_MOD, ONLY : Get_Hour + USE TIME_MOD, ONLY : Get_Day + USE TIME_MOD, ONLY : Get_Month + USE TIME_MOD, ONLY : Get_Year + USE Pressure_Mod, ONLY : Get_Pcenter + USE inquireMod, ONLY : findFreeLUN ! ! !INPUT PARAMETERS: ! - INTEGER, INTENT(IN) :: I ! Longitude index - INTEGER, INTENT(IN) :: J ! Latitude index - INTEGER, INTENT(IN) :: L ! Vertical level - INTEGER, INTENT(IN) :: KPP_TotSteps ! Total integr. steps - TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object - TYPE(ChmState), INTENT(IN) :: State_Chm ! Chem State obj - TYPE(MetState), INTENT(IN) :: State_Met ! Met State obj - TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options obj - REAL(dp), INTENT(IN) :: initC(NSPEC) ! Initial conc. - REAL(dp), INTENT(IN) :: localRCONST(NREACT) ! Rate constants + INTEGER, INTENT(IN) :: I ! Longitude index + INTEGER, INTENT(IN) :: J ! Latitude index + INTEGER, INTENT(IN) :: L ! Vertical level + INTEGER, INTENT(IN) :: KPP_TotSteps ! Total integr. steps + INTEGER, INTENT(IN) :: ICNTRL(20) ! Integrator options + TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object + TYPE(ChmState), INTENT(IN) :: State_Chm ! Chem State obj + TYPE(MetState), INTENT(IN) :: State_Met ! Met State obj + TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options obj + REAL(dp), INTENT(IN) :: initC(NSPEC) ! Initial conc. + REAL(dp), INTENT(IN) :: localRCONST(NREACT) ! Rate constants REAL(dp) :: initHvalue ! Initial timestep REAL(dp) :: exitHvalue ! Final timestep: ! RSTATE(Nhexit) - LOGICAL, OPTIONAL :: FORCE_WRITE ! Write even if not + REAL(dp), INTENT(IN) :: RCNTRL(20) ! Integrator options + LOGICAL, OPTIONAL :: FORCE_WRITE ! Write even if not ! in an active cell CHARACTER(LEN=*), OPTIONAL :: CELL_NAME ! Customize name of ! this file ! ! !OUTPUT PARAMETERS: ! - INTEGER, INTENT(OUT) :: RC ! Success or failure + INTEGER, INTENT(OUT) :: RC ! Success or failure ! ! !REVISION HISTORY: ! 11 Mar 2024 - P. Obin Sturm - Initial version @@ -700,7 +704,7 @@ SUBROUTINE KppSa_Write_Samples( I, J, L, & IOSTAT=RC, ACCESS='SEQUENTIAL') ! Write header to file - WRITE( IU_FILE, '(a)' ) '48' + WRITE( IU_FILE, '(a)' ) '60' WRITE( IU_FILE, '(a)' ) REPEAT("=", 76 ) WRITE( IU_FILE, '(a)' ) '' WRITE( IU_FILE, '(a)' ) & @@ -739,7 +743,7 @@ SUBROUTINE KppSa_Write_Samples( I, J, L, & WRITE( IU_FILE, '(a)' ) '' ! Write the grid cell metadata as part of the header - WRITE( IU_FILE, '(a)' ) & + WRITE( IU_FILE, '(a,/)' ) & 'Meteorological and general grid cell metadata ' WRITE( IU_FILE, '(a,a)' ) & 'Location: ' // & @@ -775,7 +779,7 @@ SUBROUTINE KppSa_Write_Samples( I, J, L, & WRITE( IU_FILE, '(a,e11.4)' ) & 'Cosine of solar zenith angle: ', & State_Met%SUNCOSmid(I,J) - WRITE( IU_FILE, '(a)' ) & + WRITE( IU_FILE, '(/,a,/)' ) & 'KPP Integrator-specific parameters ' WRITE( IU_FILE, '(a,f11.4)' ) & 'Init KPP Timestep (seconds): ', & @@ -789,25 +793,35 @@ SUBROUTINE KppSa_Write_Samples( I, J, L, & WRITE( IU_FILE, '(a,i6)' ) & 'Number of internal timesteps: ', & KPP_TotSteps - WRITE( IU_FILE, '(a)' ) & + WRITE( IU_FILE, '(a)' ) 'ICNTRL integrator options used:' + WRITE( IU_FILE, '(10i6)' ) ICNTRL( 1:10) + WRITE( IU_FILE, '(10i6)' ) ICNTRL(11:20) + WRITE( IU_FILE, '(a)' ) 'RCNTRL integrator options used:' + WRITE( IU_FILE, '(5F13.6)' ) RCNTRL( 1: 5) + WRITE( IU_FILE, '(5F13.6)' ) RCNTRL( 6:10) + WRITE( IU_FILE, '(5F13.6)' ) RCNTRL(11:15) + WRITE( IU_FILE, '(5F13.6)' ) RCNTRL(16:20) + WRITE( IU_FILE, '(/,a)' ) & 'CSV data of full chemical state, including species concentrations,' WRITE( IU_FILE, '(a)' ) & 'rate constants (R) and instantaneous reaction rates (A).' WRITE( IU_FILE, '(a)' ) & - 'All concentration units are in molecules/cc and rates in molec/cc/s.' + 'All concentration units are in molec/cm3 and rates in molec/cm3/s.' WRITE( IU_FILE, '(a)' ) '' WRITE( IU_FILE, '(a)' ) REPEAT("=", 76 ) - WRITE( IU_FILE, '(a)' ) 'Name, Value' + WRITE( IU_FILE, '(a)' ) 'Name, Value, Absolute Tolerance' - ! Write species concentrations + ! Write species concentrations and absolute tolerances DO N = 1, NSPEC SpcID = State_Chm%Map_KppSpc(N) IF ( SpcID <= 0 ) THEN - WRITE( IU_FILE, '(a,i0,a,e25.16e3)' ) "C", N, ",", initC(N) + WRITE( IU_FILE, 120 ) "C", N, ",", initC(N), ATOL(N) + 120 FORMAT( a, i0, a, es25.16e3, es10.2e2 ) CYCLE ENDIF - WRITE( IU_FILE, '(a,a,e25.16e3)' ) & - TRIM(State_Chm%SpcData(SpcID)%Info%Name), ',', initC(N) + WRITE( IU_FILE, 130 ) TRIM(State_Chm%SpcData(SpcID)%Info%Name), & + ',', initC(N), ATOL(N) + 130 FORMAT( a, a, es25.16e3, es10.2e2 ) ENDDO ! Write reaction rates From 96388140aa3db15f9226548729b74be1934eb3fc Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Wed, 30 Oct 2024 14:35:52 -0400 Subject: [PATCH 33/37] Added formatting fixes in kppsa_interface_mod.F90 GeosCore/kppsa_interface_mod.F90 - In routine KppSa_Write_Samples: - Added a "," in between the concentration and abs tolerance output - Simplified FORMAT statements 120 and 130 - Added FORMAT statements 140 and 150 Signed-off-by: Bob Yantosca --- GeosCore/kppsa_interface_mod.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/GeosCore/kppsa_interface_mod.F90 b/GeosCore/kppsa_interface_mod.F90 index f5d16736a..226626d85 100644 --- a/GeosCore/kppsa_interface_mod.F90 +++ b/GeosCore/kppsa_interface_mod.F90 @@ -815,23 +815,25 @@ SUBROUTINE KppSa_Write_Samples( I, J, L, & DO N = 1, NSPEC SpcID = State_Chm%Map_KppSpc(N) IF ( SpcID <= 0 ) THEN - WRITE( IU_FILE, 120 ) "C", N, ",", initC(N), ATOL(N) - 120 FORMAT( a, i0, a, es25.16e3, es10.2e2 ) + WRITE( IU_FILE, 120 ) N, initC(N), ATOL(N) + 120 FORMAT( "C", i0, ",", es25.16e3, ",", es10.2e2 ) CYCLE ENDIF - WRITE( IU_FILE, 130 ) TRIM(State_Chm%SpcData(SpcID)%Info%Name), & - ',', initC(N), ATOL(N) - 130 FORMAT( a, a, es25.16e3, es10.2e2 ) + WRITE( IU_FILE, 130 ) & + TRIM(State_Chm%SpcData(SpcID)%Info%Name), initC(N), ATOL(N) + 130 FORMAT( a, ",", es25.16e3, ",", es10.2e2 ) ENDDO ! Write reaction rates DO N = 1, NREACT - WRITE( IU_FILE,'(a,I0,a,e25.16e3)' ) 'R', N, ',', localRCONST(N) + WRITE( IU_FILE, 140 ) N, localRCONST(N) + 140 FORMAT( "R", i0, ",", es25.16e3 ) ENDDO ! Write instantaneous reaction rates DO N = 1, NREACT - WRITE( IU_FILE,'(A,I0,A,E25.16E3)' ) 'A', N, ',', Aout(N) + WRITE( IU_FILE, 150 ) N, Aout(N) + 150 FORMAT( "A", i0, ",", es25.16e3 ) ENDDO ! Close file From a1b784fd770e78e1899334d9ce1b46b7e806ecaf Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 19 Nov 2024 16:54:53 -0500 Subject: [PATCH 34/37] PR #2507 post-merge fixes: Update CHANGELOG.md CHANGELOG.md - Move the entry pertaining to PR #2507 (CEDS TMB emissions) out of the 14.5.0 section and into the Unreleased section Signed-off-by: Bob Yantosca --- CHANGELOG.md | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2d6f96aa0..9d8353d2a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,11 @@ 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 +### Fixed +- Fixed CEDS HEMCO_Config.rc entries to emit TMB into the TMB species (and not HCOOH) + + ## [14.5.0] - 2024-11-07 ### Added - Added vectors `State_Chm%KPP_AbsTol` and `State_Chm%KPP_RelTol` @@ -41,7 +46,6 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Removed EDGAR8_CH4_AWB emissions from CH4 and carbon simulations to avoid double counting with GFED - Fixed formatting error in `.github/workflows/stale.yml` that caused the Mark Stale Issues action not to run - Fixed emissions in GCHP carbon ExtData.rc so that data in molecules/cm2/s are converted to kg/m2/s -- Fixed CEDS HEMCO_Config.rc entries to emit TMB into the TMB species (and not HCOOH) ### Removed - Removed dry-run checks for files that are no longer needed for Cloud-J v8 from `cldj_interface_mod.F90` From db365d0219fbdcd35dcfc3ea18d03e36304468ba Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 22 Nov 2024 12:18:29 -0500 Subject: [PATCH 35/37] KPP-Standalone update: Update to 14.5.0; Update geoschem-dev This commit informs the GEOS-Chem repository about the following commits that were pushed to the geoschem/KPP-Standalone repo: cfccbe7 (HEAD -> geoschem-dev, origin/geoschem-dev) Remove build_executable.sh from geoschem-dev branch 337668e Merge kpp-standalone into geoschem-dev (14.5.0 mechanism) Signed-off-by: Bob Yantosca --- KPP/standalone | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/KPP/standalone b/KPP/standalone index 2e56d7bdf..cfccbe752 160000 --- a/KPP/standalone +++ b/KPP/standalone @@ -1 +1 @@ -Subproject commit 2e56d7bdf4e3e38f0fd3b1c2ad7cd17dec5f2ca2 +Subproject commit cfccbe75280744f7b33fd9f119da756d042803af From 0947b8f961dc94796a55cef013df7021e9ca11a3 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 22 Nov 2024 14:44:10 -0500 Subject: [PATCH 36/37] Minor updates to the KPP standalone and interface .gitmodules - Now pull the "GC_Interface" tag instead of the geoschem-dev branch GeosCore/fullchem_mod.F90 - Removed unused code run/shared/cleanRunDir.sh - Updated comments in header. Now use --force (but any non-empty argument) will cause files to be removed w/o user confirmation. CHANGELOG.md - Updated accordingly Signed-off-by: Bob Yantosca --- .gitmodules | 2 +- CHANGELOG.md | 3 +-- GeosCore/fullchem_mod.F90 | 11 ----------- run/shared/cleanRunDir.sh | 14 ++++++++------ 4 files changed, 10 insertions(+), 20 deletions(-) diff --git a/.gitmodules b/.gitmodules index 9ec985b8f..46b0b1516 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,4 @@ [submodule "KPP/standalone"] path = KPP/standalone url = https://github.com/geoschem/KPP-Standalone - branch = geoschem-dev + tag = "GC_Interface" diff --git a/CHANGELOG.md b/CHANGELOG.md index 49d09d904..b678cfb80 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,14 +13,13 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Added routine `SatDiagn_or_SatDiagnEdge` in `History/history_utils_mod.F90` - Added KPP standalone interface (archives model state to selected locations) - Added `https://github/geoschem/KPP-Standalone` as a Git submodule (`geoschem-dev` branch) +- Added comments in `./run/sharedcleanRunDir.sh` describing the `--force` option (i.e. remove files w/o user confirmation) ### 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 - Allocated `State_Diag%SatDiagnPEDGE` ffield with vertical dimension `State_Grid%NZ+1` -- Moved PINO3H to be in alphabetical order in `species_database.yml` - Modified `run/GCClassic/cleanRunDir.sh` to skip removing bpch files, as well as now removing `fort.*` and `OutputDir/*.txt` files -- Moved PINO3H to be in alphabetical order in `species_database.yml` ### Fixed - Added a fix to skip the call to KPP when only CO2 is defined in the carbon simulation diff --git a/GeosCore/fullchem_mod.F90 b/GeosCore/fullchem_mod.F90 index aacee485f..11f699c2e 100644 --- a/GeosCore/fullchem_mod.F90 +++ b/GeosCore/fullchem_mod.F90 @@ -1319,17 +1319,6 @@ SUBROUTINE Do_FullChem( Input_Opt, State_Chm, State_Diag, & KPP_TotSteps = ISTATUS(3), & RC = RC ) - ! test the force write option on the root node - ! example use case: printing chemical state under conditions - ! without knowing where those conditions will happen - ! IF ( Input_Opt%amIRoot .AND. L == 1 ) & - ! CALL Write_Samples( I, J, L, C_before_integrate, & - ! local_RCONST, KPPH_before_integrate, & - ! RSTATE(Nhexit), & - ! State_Grid, State_Chm, State_Met, & - ! Input_Opt, ISTATUS(3), RC, & - ! FORCE_WRITE = .TRUE., CELL_NAME = 'root') - !===================================================================== ! Check we have no negative values and copy the concentrations ! calculated from the C array back into State_Chm%Species%Conc diff --git a/run/shared/cleanRunDir.sh b/run/shared/cleanRunDir.sh index e0b216848..0960e6143 100755 --- a/run/shared/cleanRunDir.sh +++ b/run/shared/cleanRunDir.sh @@ -5,13 +5,15 @@ # # Usage: # ------ -# $ ./cleanRunDir.sh # Removes model output files in the run directory. -# # Also prompts the user before removing diagnostic -# # output files in OutputDir/. +# $ ./cleanRunDir.sh # Removes model output files in the run +# # directory. Also prompts the user before +# # removing diagnostic output files from +# # from OutputDir/. # -# $ ./cleanRunDir.sh 1 # Removes model ouptut files in the run directory, -# # but will remove diagnostic output files without -# # prompting first. USE WITH CAUTION! +# $ ./cleanRunDir.sh --force # Removes model output files in the run +# # directory, but will remove diagnostic +# # output files without prompting first. +# # USE WITH CAUTION! #============================================================================ # Clean model output files in the run directory From f14b9a42e08ac993cce89fbb20000a5db0dd6833 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 22 Nov 2024 14:58:51 -0500 Subject: [PATCH 37/37] One more changelog update for KPP Standalone integration CHANGELOG.md - Now note that we pull the KPP-Standalone repo from the "GC_Interface" tag, not a branch. Signed-off-by: Bob Yantosca --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b678cfb80..86fab4195 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,7 +12,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), - Added `State_Diag%Archive_SatDiagnEdge` field - Added routine `SatDiagn_or_SatDiagnEdge` in `History/history_utils_mod.F90` - Added KPP standalone interface (archives model state to selected locations) -- Added `https://github/geoschem/KPP-Standalone` as a Git submodule (`geoschem-dev` branch) +- Added `https://github/geoschem/KPP-Standalone` as a Git submodule (`GC_Interface` tag) - Added comments in `./run/sharedcleanRunDir.sh` describing the `--force` option (i.e. remove files w/o user confirmation) ### Changed