From c2825738135b979699a7ce8cc54837bca4c693b5 Mon Sep 17 00:00:00 2001 From: Obin Sturm Date: Tue, 26 Mar 2024 11:53:28 -0400 Subject: [PATCH 01/24] 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/24] 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/24] 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/24] 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/24] 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/24] 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/24] 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/24] 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/24] 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/24] 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/24] 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/24] 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/24] 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 5cfc36d5bffbd10c1a1c7eb30b9171dcd5a7f20b Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 27 Sep 2024 18:21:22 -0400 Subject: [PATCH 14/24] 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 15/24] 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 16/24] 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 17/24] 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 18/24] 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 19/24] 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 20/24] 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 21/24] 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 72f149c2571f1e731b2a00f75a290e82c9064a3d Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Wed, 30 Oct 2024 11:12:51 -0400 Subject: [PATCH 22/24] 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 23/24] 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 24/24] 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