Skip to content

Commit

Permalink
refactor(tsp): Elevate OBS to generalized transport class
Browse files Browse the repository at this point in the history
  • Loading branch information
@emorway-usgs
emorway-usgs committed Oct 12, 2023
1 parent f67f101 commit 9fff081
Showing 1 changed file with 73 additions and 100 deletions.
173 changes: 73 additions & 100 deletions src/Model/GroundWaterTransport/gwt1obs1.f90 → src/Model/TransportModel/tsp1obs1.f90
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module GwtObsModule
module TspObsModule

use KindModule, only: DP, I4B
use ConstantsModule, only: LINELENGTH, MAXOBSTYPES
Expand All @@ -11,89 +11,80 @@ module GwtObsModule
implicit none

private
public :: GwtObsType, gwt_obs_cr
public :: TspObsType, tsp_obs_cr

type, extends(ObsType) :: GwtObsType
type, extends(ObsType) :: TspObsType
! -- Private members
type(TspIcType), pointer, private :: ic => null() ! initial conditions
real(DP), dimension(:), pointer, contiguous, private :: x => null() ! concentration
real(DP), dimension(:), pointer, contiguous, private :: flowja => null() ! intercell flows
contains
! -- Public procedures
procedure, public :: gwt_obs_ar
procedure, public :: obs_bd => gwt_obs_bd
procedure, public :: obs_df => gwt_obs_df
procedure, public :: obs_rp => gwt_obs_rp
procedure, public :: obs_da => gwt_obs_da
procedure, public :: tsp_obs_ar
procedure, public :: obs_bd => tsp_obs_bd
procedure, public :: obs_df => tsp_obs_df
procedure, public :: obs_rp => tsp_obs_rp
procedure, public :: obs_da => tsp_obs_da
! -- Private procedures
procedure, private :: set_pointers
end type GwtObsType
end type TspObsType

contains

subroutine gwt_obs_cr(obs, inobs)
! ******************************************************************************
! gwt_obs_cr -- Create a new GwtObsType object
! Subroutine: (1) creates object
! (2) allocates pointers
! (3) initializes values
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
!> @brief Create a new TspObsType object
!!
!! This routine:
!! - creates an observation object
!! - allocates pointers
!! - initializes values
!<
subroutine tsp_obs_cr(obs, inobs)
! -- dummy
type(GwtObsType), pointer, intent(out) :: obs
type(TspObsType), pointer, intent(out) :: obs
integer(I4B), pointer, intent(in) :: inobs
! ------------------------------------------------------------------------------
!
allocate (obs)
call obs%allocate_scalars()
obs%active = .false.
obs%inputFilename = ''
obs%inUnitObs => inobs
!
! -- Return
return
end subroutine gwt_obs_cr
end subroutine tsp_obs_cr

subroutine gwt_obs_ar(this, ic, x, flowja)
! ******************************************************************************
! gwt_obs_ar -- allocate and read
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
!> @brief Allocate and read method for package
!!
!! Method to allocate and read static data for the package.
!<
subroutine tsp_obs_ar(this, ic, x, flowja)
! -- dummy
class(GwtObsType), intent(inout) :: this
class(TspObsType), intent(inout) :: this
type(TspIcType), pointer, intent(in) :: ic
real(DP), dimension(:), pointer, contiguous, intent(in) :: x
real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja
! ------------------------------------------------------------------------------
!
! Call ar method of parent class
call this%obs_ar()
!
! set pointers
call this%set_pointers(ic, x, flowja)
!
! -- Return
return
end subroutine gwt_obs_ar
end subroutine tsp_obs_ar

subroutine gwt_obs_df(this, iout, pkgname, filtyp, dis)
! ******************************************************************************
! gwt_obs_df -- define
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
!> @brief Define observation object
!<
subroutine tsp_obs_df(this, iout, pkgname, filtyp, dis)
! -- dummy
class(GwtObsType), intent(inout) :: this
class(TspObsType), intent(inout) :: this
integer(I4B), intent(in) :: iout
character(len=*), intent(in) :: pkgname
character(len=*), intent(in) :: filtyp
class(DisBaseType), pointer :: dis
! -- local
integer(I4B) :: indx
! ------------------------------------------------------------------------------
!
! Call overridden method of parent class
call this%ObsType%obs_df(iout, pkgname, filtyp, dis)
Expand All @@ -107,25 +98,21 @@ subroutine gwt_obs_df(this, iout, pkgname, filtyp, dis)
!
! -- Store obs type and assign procedure pointer for flow-ja-face observation type
call this%StoreObsType('flow-ja-face', .true., indx)
this%obsData(indx)%ProcessIdPtr => gwt_process_intercell_obs_id
this%obsData(indx)%ProcessIdPtr => tsp_process_intercell_obs_id
!
! -- Return
return
end subroutine gwt_obs_df
end subroutine tsp_obs_df

subroutine gwt_obs_bd(this)
! ******************************************************************************
! gwt_obs_bd -- save obs
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
!> @brief Save observations
!<
subroutine tsp_obs_bd(this)
! -- dummy
class(GwtObsType), intent(inout) :: this
class(TspObsType), intent(inout) :: this
! -- local
integer(I4B) :: i, jaindex, nodenumber
character(len=100) :: msg
class(ObserveType), pointer :: obsrv => null()
! ------------------------------------------------------------------------------
!
call this%obs_bd_clear()
!
Expand All @@ -148,72 +135,60 @@ subroutine gwt_obs_bd(this)
end do
end if
!
! -- Return
return
end subroutine gwt_obs_bd
end subroutine tsp_obs_bd

subroutine gwt_obs_rp(this)
! ******************************************************************************
! gwt_obs_rp
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
class(GwtObsType), intent(inout) :: this
! ------------------------------------------------------------------------------
!> @brief If transport model observations need checks, add them here
!<
subroutine tsp_obs_rp(this)
! -- dummy
class(TspObsType), intent(inout) :: this
!
! Do GWT observations need any checking? If so, add checks here
!
! -- Return
return
end subroutine gwt_obs_rp
end subroutine tsp_obs_rp

subroutine gwt_obs_da(this)
! ******************************************************************************
! gwt_obs_da
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
!> Deallocate memory
!!
!! Deallocate memory associated with transport model
subroutine tsp_obs_da(this)
! -- dummy
class(GwtObsType), intent(inout) :: this
! ------------------------------------------------------------------------------
class(TspObsType), intent(inout) :: this
!
nullify (this%ic)
nullify (this%x)
nullify (this%flowja)
call this%ObsType%obs_da()
!
! -- Return
return
end subroutine gwt_obs_da
end subroutine tsp_obs_da

!> @brief Set pointers needed by the transport OBS package
!<
subroutine set_pointers(this, ic, x, flowja)
! ******************************************************************************
! set_pointers
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
class(GwtObsType), intent(inout) :: this
class(TspObsType), intent(inout) :: this
type(TspIcType), pointer, intent(in) :: ic
real(DP), dimension(:), pointer, contiguous, intent(in) :: x
real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja
! ------------------------------------------------------------------------------
!
this%ic => ic
this%x => x
this%flowja => flowja
!
! -- Return
return
end subroutine set_pointers

! -- Procedures related to GWF observations (NOT type-bound)

!> @brief Procedure related to Tsp observations (NOT type-bound)
!!
!! Process a specific observation ID
!<
subroutine gwt_process_concentration_obs_id(obsrv, dis, inunitobs, iout)
! ******************************************************************************
! gwt_process_concentration_obs_id
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
type(ObserveType), intent(inout) :: obsrv
class(DisBaseType), intent(in) :: dis
Expand All @@ -223,7 +198,6 @@ subroutine gwt_process_concentration_obs_id(obsrv, dis, inunitobs, iout)
integer(I4B) :: nn1
integer(I4B) :: icol, istart, istop
character(len=LINELENGTH) :: ermsg, strng
! ------------------------------------------------------------------------------
!
! -- Initialize variables
strng = obsrv%IDstring
Expand All @@ -242,16 +216,15 @@ subroutine gwt_process_concentration_obs_id(obsrv, dis, inunitobs, iout)
call store_error_unit(inunitobs)
end if
!
! -- Return
return
end subroutine gwt_process_concentration_obs_id

subroutine gwt_process_intercell_obs_id(obsrv, dis, inunitobs, iout)
! ******************************************************************************
! gwt_process_intercell_obs_id
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
!> @brief Procedure related to Tsp observations (NOT type-bound)
!!
!! Process an intercell observation requested by the user
!<
subroutine tsp_process_intercell_obs_id(obsrv, dis, inunitobs, iout)
! -- dummy
type(ObserveType), intent(inout) :: obsrv
class(DisBaseType), intent(in) :: dis
Expand All @@ -263,7 +236,6 @@ subroutine gwt_process_intercell_obs_id(obsrv, dis, inunitobs, iout)
character(len=LINELENGTH) :: ermsg, strng
! formats
70 format('Error: No connection exists between cells identified in text: ', a)
! ------------------------------------------------------------------------------
!
! -- Initialize variables
strng = obsrv%IDstring
Expand Down Expand Up @@ -304,7 +276,8 @@ subroutine gwt_process_intercell_obs_id(obsrv, dis, inunitobs, iout)
call store_error_unit(inunitobs)
end if
!
! -- Return
return
end subroutine gwt_process_intercell_obs_id
end subroutine tsp_process_intercell_obs_id

end module GwtObsModule
end module TspObsModule

0 comments on commit 9fff081

Please sign in to comment.