checking in today's progress. Reworked some of the previous code that unfortunately had some bad wiring

emorway-usgs · emorway-usgs · commit 4c786902d8c9 · 2025-04-14T09:19:38.000-07:00
diff --git a/src/Model/GroundWaterEnergy/PbstBase.f90 b/src/Model/GroundWaterEnergy/PbstBase.f90
@@ -7,7 +7,7 @@
 !! flux.  
 !<
 module PbstBaseModule
-  use ConstantsModule, only: LINELENGTH, MAXCHARLEN, DZERO
+  use ConstantsModule, only: LINELENGTH, MAXCHARLEN, DZERO, LGP
   use KindModule, only: I4B, DP
   use NumericalPackageModule, only: NumericalPackageType
   use SimModule, only: count_errors, store_error, ustop
@@ -34,13 +34,32 @@ module PbstBaseModule
   contains
 
     procedure :: init
+    procedure :: ar
+    procedure, private :: read_options
+    procedure :: pbst_options
+    procedure(read_option), deferred :: read_option
     procedure, private :: pbstbase_allocate_scalars
     procedure :: da => pbstbase_da
   
   end type PbstBaseType
   
   abstract interface
   
+    !> @brief Announce package and set pointers to variables
+    !!
+    !! Deferred procedure called by the PbstBaseType code to process a single
+    !! keyword from the OPTIONS block of the package input file.
+    !<
+    function read_option(this, keyword) result(success)
+      ! -- modules
+      import PbstBaseType
+      ! -- dummy
+      class(PbstBaseType) :: this
+      character(len=*), intent(in) :: keyword
+      ! -- return
+      logical :: success
+    end function
+  
   end interface
   
 contains
@@ -65,7 +84,108 @@ subroutine init(this, name_model, pakname, ftype, inunit, iout)
     call this%parser%Initialize(this%inunit, this%iout)
   end subroutine init
   
-  
+  !> @brief Allocate and read
+  !!
+  !!  Method to allocate and read static data for the SHF package
+  !<
+  subroutine ar(this)
+    ! -- dummy
+    class(PbstBaseType) :: this !< ShfType object
+    !
+    ! -- Create time series manager
+    call tsmanager_cr(this%tsmanager, this%iout, &
+                      removeTsLinksOnCompletion=.true., &
+                      extendTsToEndOfSimulation=.true.)
+    !
+    ! -- Read options
+    call this%read_options()
+  end subroutine ar
+
+
+  !> @brief Read the SHF-specific options from the OPTIONS block
+  !<
+  subroutine read_options(this)
+    ! -- dummy
+    class(PbstBaseType) :: this
+    ! -- local
+    character(len=LINELENGTH) :: keyword
+    character(len=MAXCHARLEN) :: fname
+    logical :: isfound
+    logical :: endOfBlock
+    logical(LGP) :: foundchildclassoption
+    integer(I4B) :: ierr
+    ! -- formats
+    character(len=*), parameter :: fmtts = &
+      &"(4x, 'TIME-SERIES DATA WILL BE READ FROM FILE: ', a)"
+    !
+    ! -- Get options block
+    call this%parser%GetBlock('OPTIONS', isfound, ierr, &
+                              blockRequired=.false., supportOpenClose=.true.)
+    !
+    ! -- Parse options block if detected
+    if (isfound) then
+      write (this%iout, '(1x,a)') &
+        'PROCESSING '//trim(adjustl(this%packName))//' OPTIONS'
+      do
+        call this%parser%GetNextLine(endOfBlock)
+        if (endOfBlock) then
+          exit
+        end if
+        call this%parser%GetStringCaps(keyword)
+        select case (keyword)
+        case ('PRINT_INPUT')
+          this%iprpak = 1
+          write (this%iout, '(4x,a)') 'TIME-VARYING INPUT WILL BE PRINTED.'
+        case ('TS6')
+          !
+          ! -- Add a time series file
+          call this%parser%GetStringCaps(keyword)
+          if (trim(adjustl(keyword)) /= 'FILEIN') then
+            errmsg = &
+              'TS6 keyword must be followed by "FILEIN" then by filename.'
+            call store_error(errmsg)
+            call this%parser%StoreErrorUnit()
+            call ustop()
+          end if
+          call this%parser%GetString(fname)
+          write (this%iout, fmtts) trim(fname)
+          call this%tsmanager%add_tsfile(fname, this%inunit)
+        case default
+          !
+          ! -- Check for child class options
+          call this%pbst_options(keyword, foundchildclassoption)
+          !
+          ! -- Defer to subtype to read the option;
+          ! -- if the subtype can't handle it, report an error
+          if (.not. this%read_option(keyword)) then
+            write (errmsg, '(a,3(1x,a),a)') &
+              'Unknown', trim(adjustl(this%packName)), "option '", &
+              trim(keyword), "'."
+            call store_error(errmsg)
+          end if
+        end select
+      end do
+      write (this%iout, '(1x,a)') &
+        'END OF '//trim(adjustl(this%packName))//' OPTIONS'
+    end if
+  end subroutine read_options
+
+  !> @ brief Read additional options for sub-package
+  !!
+  !!  Read additional options for the SFE boundary package. This method should
+  !!  be overridden by option-processing routine that is in addition to the 
+  !!  base options available for all PbstBase packages.
+  !<
+  subroutine pbst_options(this, option, found)
+    ! -- dummy
+    class(PbstBaseType), intent(inout) :: this !< PbstBaseType object
+    character(len=*), intent(inout) :: option !< option keyword string
+    logical(LGP), intent(inout) :: found !< boolean indicating if the option was found
+    !
+    ! Return with found = .false.
+    found = .false.
+  end subroutine pbst_options
+
   !> @brief Allocate scalar variables
   !!
   !! Allocate scalar data members of the object.
diff --git a/src/Model/GroundWaterEnergy/gwe-sfe.f90 b/src/Model/GroundWaterEnergy/gwe-sfe.f90
@@ -70,20 +70,23 @@ module GweSfeModule
     integer(I4B), pointer :: idxbudiflw => null() !< index of inflow terms in flowbudptr
     integer(I4B), pointer :: idxbudoutf => null() !< index of outflow terms in flowbudptr
 
+    logical, pointer, public :: shf_active => null() !< logical indicating if a sensible heat flux object is active
+
     real(DP), dimension(:), pointer, contiguous :: temprain => null() !< rainfall temperature
     real(DP), dimension(:), pointer, contiguous :: tempevap => null() !< evaporation temperature
     real(DP), dimension(:), pointer, contiguous :: temproff => null() !< runoff temperature
     real(DP), dimension(:), pointer, contiguous :: tempiflw => null() !< inflow temperature
     real(DP), dimension(:), pointer, contiguous :: ktf => null() !< thermal conductivity between the sfe and groundwater cell
     real(DP), dimension(:), pointer, contiguous :: rfeatthk => null() !< thickness of streambed material through which thermal conduction occurs
-    
+        
     type(ShfType), pointer :: shf => null() ! sensible heat flux (shf) object
     integer(I4B), pointer :: inshf => null() ! SHF (sensible heat flux utility) unit number (0 if unused)
 
   contains
 
     !procedure :: bnd_df => sfe_df
     procedure :: bnd_da => sfe_da
+    procedure :: bnd_ar => sfe_ar
     procedure :: allocate_scalars
     procedure :: apt_allocate_arrays => sfe_allocate_arrays
     procedure :: find_apt_package => find_sfe_package
@@ -172,10 +175,6 @@ subroutine sfe_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
     sfeobj%depvartype = dvt
     sfeobj%depvarunit = dvu
     sfeobj%depvarunitabbrev = dvua
-    !
-    ! -- create sensible heat flux package
-    inshf = GetUnit()
-    call shf_cr(sfeobj%shf, namemodel, inshf, iout)
   end subroutine sfe_create
                         
   !> @brief Override boundary package type define function
@@ -202,11 +201,11 @@ subroutine sfe_ar(this)
     class(GweSfeType), intent(inout) :: this
     !
     ! -- call parent class _ar routine
-    call this%tspapttype%bndtype%bnd_ar()
+    call this%tspapttype%bnd_ar()
     !
     ! -- activate appropriate pbst sub-packages
     if (this%inshf /= 0) then
-      call this%shf%shf_ar()
+      call this%shf%ar()
     end if
   end subroutine sfe_ar
   
@@ -252,24 +251,26 @@ subroutine sfe_options(this, option, found)
     found = .true.
     select case (option)
     case ('SHF6')
+      !
       call this%parser%GetStringCaps(keyword)
       if (trim(adjustl(keyword)) /= 'FILEIN') then
         errmsg = 'SHF6 keyword must be followed by "FILEIN" '// &
                      'then by filename.'
         call store_error(errmsg)
         call this%parser%StoreErrorUnit()
       end if
-      if (this%shf%active) then
+      if (this%shf_active) then
         errmsg = 'Multiple SHF6 keywords detected in OPTIONS block. '// &
                  'Only one SHF6 entry allowed for a package.'
         call store_error(errmsg)
       end if
-      this%shf%active = .true.
+      this%shf_active = .true.
       call this%parser%GetString(fname)
+      !
+      ! -- create sensible heat flux object
+      call openfile(this%inshf, this%iout, fname, 'SHF')
+      call shf_cr(this%shf, this%name_model, this%inshf, this%iout)
       this%shf%inputFilename = fname
-      !inshf = GetUnit()
-      call openfile(this%inshf, this%iout, this%shf%inputFilename, 'SHF')
-      !this%shf%inunit = inshf
     case default
       !
       ! -- No options found
@@ -773,6 +774,7 @@ subroutine allocate_scalars(this)
     call mem_allocate(this%idxbudroff, 'IDXBUDROFF', this%memoryPath)
     call mem_allocate(this%idxbudiflw, 'IDXBUDIFLW', this%memoryPath)
     call mem_allocate(this%idxbudoutf, 'IDXBUDOUTF', this%memoryPath)
+    call mem_allocate(this%shf_active, 'SHF_ACTIVE', this%memoryPath)
     call mem_allocate(this%inshf, 'INSHF', this%memoryPath)
     !
     ! -- Initialize
@@ -782,6 +784,7 @@ subroutine allocate_scalars(this)
     this%idxbudiflw = 0
     this%idxbudoutf = 0
     !
+    this%shf_active = .false.
     this%inshf = 0
   end subroutine allocate_scalars
 
@@ -835,6 +838,7 @@ subroutine sfe_da(this)
     call mem_deallocate(this%idxbudiflw)
     call mem_deallocate(this%idxbudoutf)
     !
+    call mem_deallocate(this%shf_active)
     call mem_deallocate(this%inshf)
     !
     ! -- Deallocate time series
diff --git a/src/Model/GroundWaterEnergy/gwe-shf.f90 b/src/Model/GroundWaterEnergy/gwe-shf.f90
@@ -33,8 +33,10 @@ module SensHeatModule
 
   contains
 
-    procedure, public :: shf_ar
     procedure :: da => shf_da
+    procedure :: read_option => shf_read_option
+    procedure :: pbst_options => shf_options
+    procedure, private :: shf_allocate_scalars
   
   end type ShfType
   
@@ -56,24 +58,14 @@ subroutine shf_cr(shf, name_model, inunit, iout)
     call shf%init(name_model, 'SHF', 'SHF', inunit, iout)
     !
     ! -- allocate scalars
-    call shf%allocate_scalars()
+    call shf%shf_allocate_scalars()
   end subroutine shf_cr
   
-  !> @brief Allocate and read
-  !!
-  !!  Method to read and prepare period data for the SHF package
-  !<
-  subroutine shf_ar(this)
-    ! -- dummy
-    class(ShfType), intent(out) :: this !< ShfType object
-    !
-    
-  end subroutine shf_ar
 
   !> @brief Allocate scalars specific to the streamflow energy transport (SFE)
   !! package.
   !<
-  subroutine allocate_scalars(this)
+  subroutine shf_allocate_scalars(this)
     ! -- modules
     use MemoryManagerModule, only: mem_allocate
     ! -- dummy
@@ -88,7 +80,7 @@ subroutine allocate_scalars(this)
     this%rhoa = 1.225  ! kg/m3
     this%cpa = 717.0  ! J/kg/C
     this%cd = 0.002  ! unitless
-  end subroutine allocate_scalars
+  end subroutine shf_allocate_scalars
   
   !> @brief Allocate arrays specific to the sensible heat flux (SHF) package
   !< 
@@ -111,6 +103,23 @@ subroutine shf_allocate_arrays(this)
     end do
   end subroutine
 
+  !> @brief Set options specific to the ShfType
+  !!
+  !! This routine overrides PbstBaseType%bnd_options
+  !<
+  subroutine shf_options(this, option, found)
+    
+    found = .true.
+    foundgcclassoption = .false.
+    select case (option)
+    case ('FLOW_PACKAGE_NAME')
+      call this%parser%GetStringCaps(this%flowpackagename)
+      write (this%iout, '(4x,a)') &
+        'THIS '//trim(adjustl(this%text))//' PACKAGE CORRESPONDS TO A GWF &
+        &PACKAGE WITH THE NAME '//trim(adjustl(this%flowpackagename))
+
+  end subroutine shf_options
+  
   !> @brief Deallocate package memory
   !!
   !! Deallocate TVK package scalars and arrays.
@@ -129,5 +138,21 @@ subroutine shf_da(this)
     ! -- Deallocate parent
     call pbstbase_da(this)
   end subroutine shf_da
-
+  
+  !> @brief Read a SHF-specific option from the OPTIONS block
+  !!
+  !! Process a single SHF-specific option. Used when reading the OPTIONS block
+  !! of the SHF package input file.
+  !<
+  function shf_read_option(this, keyword) result(success)
+    ! -- dummy
+    class(ShfType) :: this
+    character(len=*), intent(in) :: keyword
+    ! -- return
+    logical :: success
+    !
+    ! -- There are no TVK-specific options, so just return false
+    success = .false.
+  end function shf_read_option
+  
 end module SensHeatModule
