swfzdgmodule Module Reference

This module contains the ZDG package methods. More...

Data Types
type	swfzdgtype

Functions/Subroutines
subroutine, public	zdg_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath, dis, cxs, unitconv)
	@ brief Create a new package object More...
subroutine	zdg_allocate_scalars (this)
	@ brief Allocate scalars More...
subroutine	zdg_allocate_arrays (this, nodelist, auxvar)
	@ brief Allocate arrays More...
subroutine	zdg_da (this)
	@ brief Deallocate package memory More...
subroutine	zdg_options (this)
	@ brief Source additional options for package More...
subroutine	log_zdg_options (this, found)
	@ brief Log SWF specific package options More...
subroutine	zdg_rp (this)
	@ brief SWF read and prepare More...
subroutine	zdg_cf (this)
	@ brief Formulate the package hcof and rhs terms. More...
real(dp) function	get_cond (this, i, depth, absdhdxsq, unitconv)
	Calculate conductance-like term. More...
subroutine	zdg_fc (this, rhs, ia, idxglo, matrix_sln)
	@ brief Copy hcof and rhs terms into solution. More...
subroutine	define_listlabel (this)
	@ brief Define the list label for the package More...
logical function	zdg_obs_supported (this)
	Determine if observations are supported. More...
subroutine	zdg_df_obs (this)
	Define the observation types available in the package. More...
subroutine	zdg_bd_obs (this)
	Save observations for the package. More...
subroutine	zdg_rp_ts (this)
	Assign time series links for the package. More...
real(dp) function	zdg_bound_value (this, col, row)
	@ brief Return a bound value More...

Variables
character(len=lenftype)	ftype = 'ZDG'
	package ftype More...
character(len=16)	text = ' ZDG'
	package flow text string More...

Detailed Description

This module can be used to represent outflow from streams using a zero-depth-gradient boundary.

Function/Subroutine Documentation

define_listlabel()

subroutine swfzdgmodule::define_listlabel ( class(swfzdgtype), intent(inout)  this )

private

Method defined the list label for the ZDG package. The list label is the heading that is written to iout when PRINT_INPUT option is used.

Parameters

[in,out]

this

SwfZdgType object

Definition at line 449 of file swf-zdg.f90.

    ! -- dummy variables
    class(SwfZdgType), intent(inout) :: this !< SwfZdgType  object
    !
    ! -- create the header list label
    this%listlabel = trim(this%filtyp)//' NO.'
    if (this%dis%ndim == 3) then
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER'
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'ROW'
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'COL'
    elseif (this%dis%ndim == 2) then
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER'
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'CELL2D'
    else
      write (this%listlabel, '(a, a7)') trim(this%listlabel), 'NODE'
    end if
    write (this%listlabel, '(a, a16)') trim(this%listlabel), 'FLOW RATE'
    if (this%inamedbound == 1) then
      write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
    end if
    !
    ! -- return
    return

get_cond()

real(dp) function swfzdgmodule::get_cond	(	class(swfzdgtype)	this,
		integer(i4b), intent(in)	i,
		real(dp), intent(in)	depth,
		real(dp), intent(in)	absdhdxsq,
		real(dp), intent(in)	unitconv
	)

Conductance normally has a dx term in the denominator but that is not included here, as the flow is calculated using Q = C * slope. The returned c value from this function has dimensions of L3/T.

Parameters

[in]	i	boundary number
[in]	depth	simulated depth (stage - elevation) in reach n for this iteration
[in]	absdhdxsq	absolute value of simulated hydraulic gradient
[in]	unitconv	conversion factor for roughness to length and time units of meters and seconds

Definition at line 368 of file swf-zdg.f90.

    ! -- modules
    ! -- dummy
    class(SwfZdgType) :: this
    integer(I4B), intent(in) :: i !< boundary number
    real(DP), intent(in) :: depth !< simulated depth (stage - elevation) in reach n for this iteration
    real(DP), intent(in) :: absdhdxsq !< absolute value of simulated hydraulic gradient
    real(DP), intent(in) :: unitconv !< conversion factor for roughness to length and time units of meters and seconds
    ! -- local
    integer(I4B) :: idcxs
    real(DP) :: c
    real(DP) :: width
    real(DP) :: rough
    real(DP) :: slope
    real(DP) :: roughc
    real(DP) :: a
    real(DP) :: r
    real(DP) :: conveyance
    !
    idcxs = this%idcxs(i)
    width = this%width(i)
    rough = this%rough(i)
    slope = this%slope(i)
    roughc = this%cxs%get_roughness(idcxs, width, depth, rough, &
                                    slope)
    a = this%cxs%get_area(idcxs, width, depth)
    r = this%cxs%get_hydraulic_radius(idcxs, width, depth, area=a)
 
    !conveyance = a * r**DTWOTHIRDS / roughc
    conveyance = this%cxs%get_conveyance(idcxs, width, depth, rough)
    c = conveyance / absdhdxsq
 

log_zdg_options()

subroutine swfzdgmodule::log_zdg_options	(	class(swfzdgtype), intent(inout)	this,
		type(swfzdgparamfoundtype), intent(in)	found
	)

Parameters

[in,out]

this

BndExtType object

Definition at line 252 of file swf-zdg.f90.

    ! -- modules
    use swfzdginputmodule, only: swfzdgparamfoundtype
    ! -- dummy variables
    class(SwfZdgType), intent(inout) :: this !< BndExtType object
    type(SwfZdgParamFoundType), intent(in) :: found
    ! -- local variables
    ! -- format
    !
    ! -- log found options
    write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) &
      //' OPTIONS'
    !
    ! if (found%mover) then
    !   write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED'
    ! end if
    !
    ! -- close logging block
    write (this%iout, '(1x,a)') &
      'END OF '//trim(adjustl(this%text))//' OPTIONS'
    !
    ! -- return
    return

zdg_allocate_arrays()

subroutine swfzdgmodule::zdg_allocate_arrays	(	class(swfzdgtype)	this,
		integer(i4b), dimension(:), optional, pointer, contiguous	nodelist,
		real(dp), dimension(:, :), optional, pointer, contiguous	auxvar
	)

Allocate and initialize arrays for the SWF package

Definition at line 162 of file swf-zdg.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate, mem_setptr, mem_checkin
    ! -- dummy
    class(SwfZdgType) :: this
    integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist
    real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar
    ! -- local
    !
    ! -- call BndExtType allocate scalars
    call this%BndExtType%allocate_arrays(nodelist, auxvar)
    !
    ! -- set array input context pointer
    call mem_setptr(this%idcxs, 'IDCXS', this%input_mempath)
    call mem_setptr(this%width, 'WIDTH', this%input_mempath)
    call mem_setptr(this%slope, 'SLOPE', this%input_mempath)
    call mem_setptr(this%rough, 'ROUGH', this%input_mempath)
    !
    ! -- checkin array input context pointer
    call mem_checkin(this%idcxs, 'IDCXS', this%memoryPath, &
                     'IDCXS', this%input_mempath)
    call mem_checkin(this%width, 'WIDTH', this%memoryPath, &
                     'WIDTH', this%input_mempath)
    call mem_checkin(this%slope, 'SLOPE', this%memoryPath, &
                     'SLOPE', this%input_mempath)
    call mem_checkin(this%rough, 'ROUGH', this%memoryPath, &
                     'ROUGH', this%input_mempath)
    !
    ! -- return
    return

zdg_allocate_scalars()

subroutine swfzdgmodule::zdg_allocate_scalars ( class(swfzdgtype)  this )

private

Allocate and initialize scalars for the ZDG package. The base model allocate scalars method is also called.

Parameters

this	SwfZdgType object

Definition at line 138 of file swf-zdg.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy variables
    class(SwfZdgType) :: this !< SwfZdgType object
    !
    ! -- call base type allocate scalars
    call this%BndExtType%allocate_scalars()
    !
    ! -- allocate the object and assign values to object variables
    call mem_allocate(this%unitconv, 'UNITCONV', this%memoryPath)
    !
    ! -- Set values
    this%unitconv = dzero
    !
    ! -- return
    return

zdg_bd_obs()

subroutine swfzdgmodule::zdg_bd_obs ( class(swfzdgtype)  this )

private

Method to save simulated values for the ZDG package.

Parameters

this	SwfZdgType object

Definition at line 524 of file swf-zdg.f90.

    ! -- dummy variables
    class(SwfZdgType) :: this !< SwfZdgType  object
    ! -- local variables
    integer(I4B) :: i
    integer(I4B) :: n
    integer(I4B) :: jj
    real(DP) :: v
    type(ObserveType), pointer :: obsrv => null()
    !
    ! -- clear the observations
    call this%obs%obs_bd_clear()
    !
    ! -- Save simulated values for all of package's observations.
    do i = 1, this%obs%npakobs
      obsrv => this%obs%pakobs(i)%obsrv
      if (obsrv%BndFound) then
        do n = 1, obsrv%indxbnds_count
          v = dnodata
          jj = obsrv%indxbnds(n)
          select case (obsrv%ObsTypeId)
          case ('TO-MVR')
            if (this%imover == 1) then
              v = this%pakmvrobj%get_qtomvr(jj)
              if (v > dzero) then
                v = -v
              end if
            end if
          case ('ZDG')
            v = this%simvals(jj)
          case default
            errmsg = 'Unrecognized observation type: '//trim(obsrv%ObsTypeId)
            call store_error(errmsg)
          end select
          call this%obs%SaveOneSimval(obsrv, v)
        end do
      else
        call this%obs%SaveOneSimval(obsrv, dnodata)
      end if
    end do
    !
    ! -- return
    return

Here is the call graph for this function:

zdg_bound_value()

real(dp) function swfzdgmodule::zdg_bound_value ( class(swfzdgtype), intent(inout)  this, integer(i4b), intent(in)  col, integer(i4b), intent(in)  row  )

private

Return a bound value associated with an ncolbnd index and row.

Parameters

[in,out]

this

BndExtType object

Definition at line 605 of file swf-zdg.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy variables
    class(SwfZdgType), intent(inout) :: this !< BndExtType object
    integer(I4B), intent(in) :: col
    integer(I4B), intent(in) :: row
    ! -- result
    real(DP) :: bndval
    !
    select case (col)
    case (1)
      bndval = this%idcxs(row)
    case (2)
      bndval = this%width(row)
    case (3)
      bndval = this%slope(row)
    case (4)
      bndval = this%rough(row)
    case default
      errmsg = 'Programming error. ZDG bound value requested column '&
               &'outside range of ncolbnd (1).'
      call store_error(errmsg)
      call store_error_filename(this%input_fname)
    end select
    !
    ! -- return
    return

Here is the call graph for this function:

zdg_cf()

subroutine swfzdgmodule::zdg_cf

(

class(swfzdgtype)

this

)

Formulate the hcof and rhs terms for the ZDG package that will be added to the coefficient matrix and right-hand side vector.

Parameters

this	SwfZdgType object

Definition at line 306 of file swf-zdg.f90.

    ! modules
    use mathutilmodule, only: get_perturbation
    ! -- dummy variables
    class(SwfZdgType) :: this !< SwfZdgType  object
    ! -- local variables
    integer(I4B) :: i, node
    real(DP) :: q
    real(DP) :: qeps
    real(DP) :: absdhdxsq
    real(DP) :: depth
    real(DP) :: cond
    real(DP) :: derv
    real(DP) :: eps
    !
    ! -- Return if no inflows
    if (this%nbound == 0) return
    !
    ! -- Calculate hcof and rhs for each zdg entry
    do i = 1, this%nbound
 
      node = this%nodelist(i)
      if (this%ibound(node) <= 0) then
        this%hcof(i) = dzero
        this%rhs(i) = dzero
        cycle
      end if
 
      ! -- calculate terms and add to hcof and rhs
      absdhdxsq = this%slope(i)**dhalf
      depth = this%xnew(node) - this%dis%bot(node)
 
      ! -- calculate unperturbed q
      ! TODO: UNITCONV?!
      cond = this%get_cond(i, depth, absdhdxsq, this%unitconv)
      q = -cond * this%slope(i)
 
      ! -- calculate perturbed q
      eps = get_perturbation(depth)
      cond = this%get_cond(i, depth + eps, absdhdxsq, this%unitconv)
      qeps = -cond * this%slope(i)
 
      ! -- calculate derivative
      derv = (qeps - q) / eps
 
      ! -- add terms to hcof and rhs
      this%hcof(i) = derv
      this%rhs(i) = -q + derv * this%xnew(node)
 
    end do
    !
    return

Here is the call graph for this function:

zdg_create()

subroutine, public swfzdgmodule::zdg_create	(	class(bndtype), pointer	packobj,
		integer(i4b), intent(in)	id,
		integer(i4b), intent(in)	ibcnum,
		integer(i4b), intent(in)	inunit,
		integer(i4b), intent(in)	iout,
		character(len=*), intent(in)	namemodel,
		character(len=*), intent(in)	pakname,
		character(len=*), intent(in)	mempath,
		class(disbasetype), intent(inout), pointer	dis,
		type(swfcxstype), intent(in), pointer	cxs,
		real(dp), intent(in)	unitconv
	)

Create a new ZDG Package object

Parameters

	packobj	pointer to default package type
[in]	id	package id
[in]	ibcnum	boundary condition number
[in]	inunit	unit number of ZDG package input file
[in]	iout	unit number of model listing file
[in]	namemodel	model name
[in]	pakname	package name
[in]	mempath	input mempath
[in,out]	dis	the pointer to the discretization
[in]	cxs	the pointer to the cxs package
[in]	unitconv	unit conversion for roughness

Definition at line 77 of file swf-zdg.f90.

    ! -- dummy variables
    class(BndType), pointer :: packobj !< pointer to default package type
    integer(I4B), intent(in) :: id !< package id
    integer(I4B), intent(in) :: ibcnum !< boundary condition number
    integer(I4B), intent(in) :: inunit !< unit number of ZDG package input file
    integer(I4B), intent(in) :: iout !< unit number of model listing file
    character(len=*), intent(in) :: namemodel !< model name
    character(len=*), intent(in) :: pakname !< package name
    character(len=*), intent(in) :: mempath !< input mempath
    class(DisBaseType), pointer, intent(inout) :: dis !< the pointer to the discretization
    type(SwfCxsType), pointer, intent(in) :: cxs !< the pointer to the cxs package
    real(DP), intent(in) :: unitconv !< unit conversion for roughness
    ! -- local variables
    type(SwfZdgType), pointer :: zdgobj
    !
    ! -- allocate the object and assign values to object variables
    allocate (zdgobj)
    packobj => zdgobj
    !
    ! -- create name and memory path
    call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
    packobj%text = text
    !
    ! -- allocate scalars
    call zdgobj%allocate_scalars()
    !
    ! -- initialize package
    call packobj%pack_initialize()
 
    packobj%inunit = inunit
    packobj%iout = iout
    packobj%id = id
    packobj%ibcnum = ibcnum
    packobj%ncolbnd = 1
    packobj%iscloc = 1
    packobj%ictMemPath = create_mem_path(namemodel, 'DFW')
    !
    ! -- store pointer to disv1d
    select type (dis)
    type is (disv1dtype)
      zdgobj%disv1d => dis
    end select
    !
    ! -- store pointer to cxs
    zdgobj%cxs => cxs
    !
    ! -- store unit conversion
    zdgobj%unitconv = unitconv
    !
    ! -- return
    return

Here is the call graph for this function:

Here is the caller graph for this function:

zdg_da()

subroutine swfzdgmodule::zdg_da

(

class(swfzdgtype)

this

)

Deallocate SWF package scalars and arrays.

Parameters

this	SwfZdgType object

Definition at line 199 of file swf-zdg.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy variables
    class(SwfZdgType) :: this !< SwfZdgType object
    !
    ! -- Deallocate parent package
    call this%BndExtType%bnd_da()
    !
    ! -- arrays
    call mem_deallocate(this%idcxs, 'IDCXS', this%memoryPath)
    call mem_deallocate(this%width, 'WIDTH', this%memoryPath)
    call mem_deallocate(this%slope, 'SLOPE', this%memoryPath)
    call mem_deallocate(this%rough, 'ROUGH', this%memoryPath)
    !
    ! -- scalars
    call mem_deallocate(this%unitconv)
    !
    ! -- return
    return

zdg_df_obs()

subroutine swfzdgmodule::zdg_df_obs ( class(swfzdgtype)  this )

private

Method to define the observation types available in the ZDG package.

Parameters

this	SwfZdgType object

Definition at line 500 of file swf-zdg.f90.

    ! -- dummy variables
    class(SwfZdgType) :: this !< SwfZdgType  object
    ! -- local variables
    integer(I4B) :: indx
    !
    ! -- initialize observations
    call this%obs%StoreObsType('zdg', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => defaultobsidprocessor
    !
    ! -- Store obs type and assign procedure pointer
    !    for to-mvr observation type.
    call this%obs%StoreObsType('to-mvr', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => defaultobsidprocessor
    !
    ! -- return
    return

Here is the call graph for this function:

zdg_fc()

subroutine swfzdgmodule::zdg_fc ( class(swfzdgtype)  this, real(dp), dimension(:), intent(inout)  rhs, integer(i4b), dimension(:), intent(in)  ia, integer(i4b), dimension(:), intent(in)  idxglo, class(matrixbasetype), pointer  matrix_sln  )

private

Add the hcof and rhs terms for the ZDG package to the coefficient matrix and right-hand side vector.

Parameters

	this	SwfZdgType object
[in,out]	rhs	right-hand side vector for model
[in]	ia	solution CRS row pointers
[in]	idxglo	mapping vector for model (local) to solution (global)
	matrix_sln	solution coefficient matrix

Definition at line 408 of file swf-zdg.f90.

    ! -- dummy variables
    class(SwfZdgType) :: this !< SwfZdgType  object
    real(DP), dimension(:), intent(inout) :: rhs !< right-hand side vector for model
    integer(I4B), dimension(:), intent(in) :: ia !< solution CRS row pointers
    integer(I4B), dimension(:), intent(in) :: idxglo !< mapping vector for model (local) to solution (global)
    class(MatrixBaseType), pointer :: matrix_sln !< solution coefficient matrix
    ! -- local variables
    integer(I4B) :: i
    integer(I4B) :: n
    integer(I4B) :: ipos
    !
    ! -- pakmvrobj fc
    if (this%imover == 1) then
      call this%pakmvrobj%fc()
    end if
    !
    ! -- Copy package rhs and hcof into solution rhs and amat
    do i = 1, this%nbound
      n = this%nodelist(i)
      rhs(n) = rhs(n) + this%rhs(i)
      ipos = ia(n)
      call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i))
      !
      ! -- If mover is active and this zdg item is discharging,
      !    store available water (as positive value).
      if (this%imover == 1 .and. this%rhs(i) > dzero) then
        call this%pakmvrobj%accumulate_qformvr(i, this%rhs(i))
      end if
    end do
    !
    ! -- return
    return

zdg_obs_supported()

logical function swfzdgmodule::zdg_obs_supported ( class(swfzdgtype)  this )

private

Function to determine if observations are supported by the ZDG package. Observations are supported by the ZDG package.

Returns

zdg_obs_supported boolean indicating if observations are supported

Parameters

this	SwfZdgType object

Definition at line 484 of file swf-zdg.f90.

    ! -- dummy variables
    class(SwfZdgType) :: this !< SwfZdgType  object
    !
    ! -- set boolean
    zdg_obs_supported = .true.
    !
    ! -- return
    return

zdg_options()

subroutine swfzdgmodule::zdg_options

(

class(swfzdgtype), intent(inout)

this

)

Source additional options for SWF package.

Parameters

[in,out]

this

SwfZdgType object

Definition at line 226 of file swf-zdg.f90.

    ! -- modules
    use inputoutputmodule, only: urword
    use memorymanagerextmodule, only: mem_set_value
    use swfzdginputmodule, only: swfzdgparamfoundtype
    ! -- dummy variables
    class(SwfZdgType), intent(inout) :: this !< SwfZdgType object
    ! -- local variables
    type(SwfZdgParamFoundType) :: found
    ! -- formats
    !
    ! -- source base BndExtType options
    call this%BndExtType%source_options()
    !
    ! -- source options from input context
    ! none
    !
    ! -- log SWF specific options
    call this%log_zdg_options(found)
    !
    ! -- return
    return

Here is the call graph for this function:

zdg_rp()

subroutine swfzdgmodule::zdg_rp

(

class(swfzdgtype), intent(inout)

this

)

Definition at line 280 of file swf-zdg.f90.

    use tdismodule, only: kper
    ! -- dummy
    class(SwfZdgType), intent(inout) :: this
    ! -- local
    !
    if (this%iper /= kper) return
    !
    ! -- Call the parent class read and prepare
    call this%BndExtType%bnd_rp()
    !
    ! -- Write the list to iout if requested
    if (this%iprpak /= 0) then
      call this%write_list()
    end if
    !
    ! -- return
    return

zdg_rp_ts()

subroutine swfzdgmodule::zdg_rp_ts ( class(swfzdgtype), intent(inout)  this )

private

Assign the time series links for the ZDG package. Only the Q variable can be defined with time series.

Parameters

[in,out]

this

SwfZdgType object

Definition at line 577 of file swf-zdg.f90.

    ! -- dummy variables
    class(SwfZdgType), intent(inout) :: this !< SwfZdgType  object
    ! -- local variables
    integer(I4B) :: i, nlinks
    type(TimeSeriesLinkType), pointer :: tslink => null()
    !
    ! -- set up the time series links
    nlinks = this%TsManager%boundtslinks%Count()
    do i = 1, nlinks
      tslink => gettimeserieslinkfromlist(this%TsManager%boundtslinks, i)
      if (associated(tslink)) then
        if (tslink%JCol == 1) then
          tslink%Text = 'Q'
        end if
      end if
    end do
    !
    ! -- return
    return

Here is the call graph for this function:

Variable Documentation

ftype

character(len=lenftype) swfzdgmodule::ftype = 'ZDG'

private

Definition at line 34 of file swf-zdg.f90.

  character(len=LENFTYPE) :: ftype = 'ZDG' !< package ftype

text

character(len=16) swfzdgmodule::text = ' ZDG'

private

Definition at line 35 of file swf-zdg.f90.

  character(len=16) :: text = '             ZDG' !< package flow text string