tvbasemodule Module Reference

This module contains common time-varying property functionality. More...

Data Types
type	tvbasetype
interface	ar_set_pointers
	Announce package and set pointers to variables. More...
interface	read_option
	Announce package and set pointers to variables. More...
interface	get_pointer_to_value
	Get an array value pointer given a variable name and node index. More...
interface	set_changed_at
	Mark property changes as having occurred at (kper, kstp) More...
interface	reset_change_flags
	Clear all per-node change flags. More...
interface	validate_change
	Check that a given property value is valid. More...

Functions/Subroutines
subroutine	init (this, name_model, pakname, ftype, inunit, iout)
	Initialise the TvBaseType object. More...
subroutine	tvbase_allocate_scalars (this)
	Allocate scalar variables. More...
subroutine	ar (this, dis)
	Allocate and read method for package. More...
subroutine	read_options (this)
	Read OPTIONS block of package input file. More...
subroutine	rp (this)
	Read and prepare method for package. More...
subroutine	ad (this)
	Advance the package. More...
subroutine, public	tvbase_da (this)
	Deallocate package memory. More...

Detailed Description

This module contains methods implementing functionality common to both time-varying hydraulic conductivity (TVK) and time-varying storage (TVS) packages.

Function/Subroutine Documentation

ad()

subroutine tvbasemodule::ad ( class(tvbasetype)  this )

private

Advance data for a new time step.

Definition at line 422 of file TvBase.f90.

    ! -- dummy variables
    class(TvBaseType) :: this
    ! -- local variables
    integer(I4B) :: i, n, numlinks
    type(TimeSeriesLinkType), pointer :: tsLink
    !
    ! -- Advance the time series manager;
    ! -- this will apply any time series changes to property values
    call this%tsmanager%ad()
    !
    ! -- If there are no time series property changes,
    ! -- there is nothing else to be done
    numlinks = this%tsmanager%CountLinks('BND')
    if (numlinks <= 0) then
      return
    end if
    !
    ! -- Record that changes were made at the current time step
    ! -- (as we have at least one active time series link)
    call this%set_changed_at(kper, kstp)
    !
    ! -- Reset node K change flags at all time steps except the first of each
    ! -- period (the first is done in rp(), to allow non-time series changes)
    if (kstp /= 1) then
      call this%reset_change_flags()
    end if
    !
    ! -- Validate all new property values
    do i = 1, numlinks
      tslink => this%tsmanager%GetLink('BND', i)
      n = tslink%iRow
      call this%validate_change(n, tslink%Text)
    end do
    !
    ! -- Terminate if there were errors
    if (count_errors() > 0) then
      call this%parser%StoreErrorUnit()
      call ustop()
    end if
    !
    return

Here is the call graph for this function:

ar()

subroutine tvbasemodule::ar ( class(tvbasetype)  this, class(disbasetype), intent(in), pointer  dis  )

private

Allocate and read static data for the package.

Definition at line 193 of file TvBase.f90.

    ! -- dummy variables
    class(TvBaseType) :: this
    class(DisBaseType), pointer, intent(in) :: dis
    !
    ! -- Set pointers to other package variables and announce package
    this%dis => dis
    call this%ar_set_pointers()
    !
    ! -- Create time series manager
    call tsmanager_cr(this%tsmanager, &
                      this%iout, &
                      removetslinksoncompletion=.true., &
                      extendtstoendofsimulation=.true.)
    !
    ! -- Read options
    call this%read_options()
    !
    ! -- Now that time series will have been read, need to call the df routine
    ! -- to define the manager
    call this%tsmanager%tsmanager_df()
    !
    ! -- Terminate if any errors were encountered
    if (count_errors() > 0) then
      call this%parser%StoreErrorUnit()
      call ustop()
    end if
    !
    return

Here is the call graph for this function:

init()

subroutine tvbasemodule::init	(	class(tvbasetype)	this,
		character(len=*), intent(in)	name_model,
		character(len=*), intent(in)	pakname,
		character(len=*), intent(in)	ftype,
		integer(i4b), intent(in)	inunit,
		integer(i4b), intent(in)	iout
	)

Allocate and initialize data members of the object.

Definition at line 152 of file TvBase.f90.

    ! -- dummy variables
    class(TvBaseType) :: this
    character(len=*), intent(in) :: name_model
    character(len=*), intent(in) :: pakname
    character(len=*), intent(in) :: ftype
    integer(I4B), intent(in) :: inunit
    integer(I4B), intent(in) :: iout
    !
    call this%set_names(1, name_model, pakname, ftype)
    call this%tvbase_allocate_scalars()
    this%inunit = inunit
    this%iout = iout
    call this%parser%Initialize(this%inunit, this%iout)
    !
    return

read_options()

subroutine tvbasemodule::read_options ( class(tvbasetype)  this )

private

Reads the OPTIONS block of the package's input file, deferring to the derived type to process any package-specific keywords.

Definition at line 230 of file TvBase.f90.

    ! -- dummy variables
    class(TvBaseType) :: this
    ! -- local variables
    character(len=LINELENGTH) :: keyword
    character(len=MAXCHARLEN) :: fname
    logical :: isfound
    logical :: endOfBlock
    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
          !
          ! -- 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
    !
    return

Here is the call graph for this function:

rp()

subroutine tvbasemodule::rp ( class(tvbasetype)  this )

private

Read and prepare stress period data for the package.

Definition at line 299 of file TvBase.f90.

    ! -- dummy variables
    class(TvBaseType) :: this
    ! -- local variables
    character(len=LINELENGTH) :: line, cellid, varName, text
    logical :: isfound, endOfBlock, haveChanges
    integer(I4B) :: ierr, node
    real(DP), pointer :: bndElem => null()
    ! -- formats
    character(len=*), parameter :: fmtblkerr = &
      &"('Looking for BEGIN PERIOD iper.  Found ', a, ' instead.')"
    character(len=*), parameter :: fmtvalchg = &
      "(a, ' package: Setting ', a, ' value for cell ', a, ' at start of &
      &stress period ', i0, ' = ', g12.5)"
    !
    if (this%inunit == 0) return
    !
    ! -- Get stress period data
    if (this%ionper < kper) then
      !
      ! -- Get PERIOD block
      call this%parser%GetBlock('PERIOD', isfound, ierr, &
                                supportopenclose=.true., &
                                blockrequired=.false.)
      if (isfound) then
        !
        ! -- Read ionper and check for increasing period numbers
        call this%read_check_ionper()
      else
        !
        ! -- PERIOD block not found
        if (ierr < 0) then
          ! -- End of file found; data applies for remainder of simulation.
          this%ionper = nper + 1
        else
          ! -- Found invalid block
          call this%parser%GetCurrentLine(line)
          write (errmsg, fmtblkerr) adjustl(trim(line))
          call store_error(errmsg)
        end if
      end if
    end if
    !
    ! -- Read data if ionper == kper
    if (this%ionper == kper) then
      !
      ! -- Reset per-node property change flags
      call this%reset_change_flags()
      !
      havechanges = .false.
      do
        call this%parser%GetNextLine(endofblock)
        if (endofblock) then
          exit
        end if
        !
        ! -- Read cell ID
        call this%parser%GetCellid(this%dis%ndim, cellid)
        node = this%dis%noder_from_cellid(cellid, this%parser%iuactive, &
                                          this%iout)
        !
        ! -- Validate cell ID
        if (node < 1 .or. node > this%dis%nodes) then
          write (errmsg, '(a,2(1x,a))') &
            'CELLID', cellid, 'is not in the active model domain.'
          call store_error(errmsg)
          cycle
        end if
        !
        ! -- Read variable name
        call this%parser%GetStringCaps(varname)
        !
        ! -- Get a pointer to the property value given by varName for the node
        ! -- with the specified cell ID
        bndelem => this%get_pointer_to_value(node, varname)
        if (.not. associated(bndelem)) then
          write (errmsg, '(a,3(1x,a),a)') &
            'Unknown', trim(adjustl(this%packName)), "variable '", &
            trim(varname), "'."
          call store_error(errmsg)
          cycle
        end if
        !
        ! -- Read and apply value or time series link
        call this%parser%GetString(text)
        call read_value_or_time_series_adv(text, node, 0, bndelem, &
                                           this%packName, 'BND', &
                                           this%tsmanager, this%iprpak, &
                                           varname)
        !
        ! -- Report value change
        if (this%iprpak /= 0) then
          write (this%iout, fmtvalchg) &
            trim(adjustl(this%packName)), trim(varname), trim(cellid), &
            kper, bndelem
        end if
        !
        ! -- Validate the new property value
        call this%validate_change(node, varname)
        havechanges = .true.
      end do
      !
      ! -- Record that any changes were made at the first time step of the
      ! -- stress period
      if (havechanges) then
        call this%set_changed_at(kper, 1)
      end if
    end if
    !
    ! -- Terminate if errors were encountered in the PERIOD block
    if (count_errors() > 0) then
      call this%parser%StoreErrorUnit()
      call ustop()
    end if
    !
    return

Here is the call graph for this function:

tvbase_allocate_scalars()

subroutine tvbasemodule::tvbase_allocate_scalars ( class(tvbasetype)  this )

private

Allocate scalar data members of the object.

Definition at line 175 of file TvBase.f90.

    ! -- dummy variables
    class(TvBaseType) :: this
    !
    ! -- Call standard NumericalPackageType allocate scalars
    call this%NumericalPackageType%allocate_scalars()
    !
    ! -- Allocate time series manager
    allocate (this%tsmanager)
    !
    return

tvbase_da()

subroutine, public tvbasemodule::tvbase_da

(

class(tvbasetype)

this

)

Deallocate package scalars and arrays.

Definition at line 471 of file TvBase.f90.

    ! -- dummy variables
    class(TvBaseType) :: this
    !
    ! -- Deallocate time series manager
    deallocate (this%tsmanager)
    !
    ! -- Deallocate parent
    call this%NumericalPackageType%da()
    !
    return

Here is the caller graph for this function: