drnmodule Module Reference

Data Types
type	drntype

Functions/Subroutines
subroutine, public	drn_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
	Create a New Drn Package and point packobj to the new package. More...
subroutine	drn_da (this)
	Deallocate memory. More...
subroutine	drn_allocate_scalars (this)
	Allocate package scalar members. More...
subroutine	drn_allocate_arrays (this, nodelist, auxvar)
	Allocate package arrays. More...
subroutine	drn_rp (this)
	Read and prepare. More...
subroutine	drn_options (this)
	Source options specific to DrnType. More...
subroutine	log_drn_options (this, found)
	@ brief Log DRN specific package options More...
subroutine	drn_ck (this)
	Check drain boundary condition data. More...
subroutine	drn_cf (this)
	Formulate the HCOF and RHS terms. More...
subroutine	drn_fc (this, rhs, ia, idxglo, matrix_sln)
	Copy rhs and hcof into solution rhs and amat. More...
subroutine	drn_fn (this, rhs, ia, idxglo, matrix_sln)
	Fill newton terms. More...
subroutine	define_listlabel (this)
	Define the list heading that is written to iout when PRINT_INPUT option is used. More...
subroutine	get_drain_elevations (this, i, drndepth, drntop, drnbot)
	Define drain depth and the top and bottom elevations used to scale the drain conductance. More...
subroutine	get_drain_factor (this, i, factor, opt_drnbot)
	Get the drain conductance scale factor. More...
logical function	drn_obs_supported (this)
	Return true because DRN package supports observations. More...
subroutine	drn_df_obs (this)
	Store observation type supported by DRN package. More...
subroutine	drn_store_user_cond (this)
	Store user-specified drain conductance. More...
real(dp) function	cond_mult (this, row)
	Apply multiplier to conductance value depending on user-selected option. More...
real(dp) function	drn_bound_value (this, col, row)
	Return requested boundary value. More...

Variables
character(len=lenftype)	ftype = 'DRN'
character(len=lenpackagename)	text = ' DRN'

Function/Subroutine Documentation

cond_mult()

real(dp) function drnmodule::cond_mult ( class(drntype), intent(inout)  this, integer(i4b), intent(in)  row  )

private

Definition at line 622 of file gwf-drn.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy variables
    class(DrnType), intent(inout) :: this
    integer(I4B), intent(in) :: row
    ! -- result
    real(DP) :: cond
    !
    if (this%iauxmultcol > 0) then
      cond = this%cond(row) * this%auxvar(this%iauxmultcol, row)
    else
      cond = this%cond(row)
    end if

define_listlabel()

subroutine drnmodule::define_listlabel ( class(drntype), intent(inout)  this )

private

Definition at line 471 of file gwf-drn.f90.

    ! -- dummy
    class(DrnType), intent(inout) :: this
    !
    ! -- 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), 'DRAIN EL.'
    write (this%listlabel, '(a, a16)') trim(this%listlabel), 'CONDUCTANCE'
    if (this%inamedbound == 1) then
      write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
    end if

drn_allocate_arrays()

subroutine drnmodule::drn_allocate_arrays	(	class(drntype)	this,
		integer(i4b), dimension(:), optional, pointer, contiguous	nodelist,
		real(dp), dimension(:, :), optional, pointer, contiguous	auxvar
	)

Definition at line 141 of file gwf-drn.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate, mem_setptr, mem_checkin
    ! -- dummy
    class(DrnType) :: this
    integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist
    real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar
    !
    ! -- call base type allocate arrays
    call this%BndExtType%allocate_arrays(nodelist, auxvar)
    !
    ! -- set drn input context pointers
    call mem_setptr(this%elev, 'ELEV', this%input_mempath)
    call mem_setptr(this%cond, 'COND', this%input_mempath)
    !
    ! --checkin drn input context pointers
    call mem_checkin(this%elev, 'ELEV', this%memoryPath, &
                     'ELEV', this%input_mempath)
    call mem_checkin(this%cond, 'COND', this%memoryPath, &
                     'COND', this%input_mempath)

drn_allocate_scalars()

subroutine drnmodule::drn_allocate_scalars

(

class(drntype)

this

)

Definition at line 117 of file gwf-drn.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(DrnType) :: this
    !
    ! -- call base type allocate scalars
    call this%BndExtType%allocate_scalars()
    !
    ! -- allocate the object and assign values to object variables
    call mem_allocate(this%iauxddrncol, 'IAUXDDRNCOL', this%memoryPath)
    call mem_allocate(this%icubic_scaling, 'ICUBIC_SCALING', this%memoryPath)
    !
    ! -- Set values
    this%iauxddrncol = 0
    if (this%inewton /= 0) then
      this%icubic_scaling = 1
    else
      this%icubic_scaling = 0
    end if

drn_bound_value()

real(dp) function drnmodule::drn_bound_value	(	class(drntype), intent(inout)	this,
		integer(i4b), intent(in)	col,
		integer(i4b), intent(in)	row
	)

Definition at line 640 of file gwf-drn.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy variables
    class(DrnType), intent(inout) :: this
    integer(I4B), intent(in) :: col
    integer(I4B), intent(in) :: row
    ! -- result
    real(DP) :: bndval
    !
    select case (col)
    case (1)
      bndval = this%elev(row)
    case (2)
      bndval = this%cond_mult(row)
    case default
      errmsg = 'Programming error. DRN bound value requested column '&
               &'outside range of ncolbnd (2).'
      call store_error(errmsg)
      call store_error_filename(this%input_fname)
    end select

Here is the call graph for this function:

drn_cf()

subroutine drnmodule::drn_cf ( class(drntype)  this )

private

Skip if no drains

Definition at line 336 of file gwf-drn.f90.

    ! -- dummy
    class(DrnType) :: this
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: node
    real(DP) :: cdrn
    real(DP) :: drnbot
    real(DP) :: fact
    !
    ! -- Return if no drains
    if (this%nbound == 0) return
    !
    ! -- Calculate hcof and rhs for each drn 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
      !
      ! -- set local variables for this drain
      cdrn = this%cond_mult(i)
 
      !
      ! -- calculate the drainage scaling factor
      call this%get_drain_factor(i, fact, drnbot)
      !
      ! -- calculate rhs and hcof
      this%rhs(i) = -fact * cdrn * drnbot
      this%hcof(i) = -fact * cdrn
    end do

drn_ck()

subroutine drnmodule::drn_ck

(

class(drntype), intent(inout)

this

)

Definition at line 271 of file gwf-drn.f90.

    ! -- dummy
    class(DrnType), intent(inout) :: this
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: node
    real(DP) :: bt
    real(DP) :: drndepth
    real(DP) :: drntop
    real(DP) :: drnbot
    ! -- formats
    character(len=*), parameter :: fmtddrnerr = &
      "('SCALED-CONDUCTANCE DRN BOUNDARY (',i0,') BOTTOM ELEVATION &
      &(',f10.3,') IS LESS THAN CELL BOTTOM (',f10.3,')')"
    character(len=*), parameter :: fmtdrnerr = &
      "('DRN BOUNDARY (',i0,') ELEVATION (',f10.3,') IS LESS THAN CELL &
      &BOTTOM (',f10.3,')')"
    character(len=*), parameter :: fmtcondmulterr = &
      "('DRN BOUNDARY (',i0,') CONDUCTANCE MULTIPLIER (',g10.3,') IS &
      &LESS THAN ZERO')"
    character(len=*), parameter :: fmtconderr = &
      "('DRN BOUNDARY (',i0,') CONDUCTANCE (',g10.3,') IS LESS THAN &
      &ZERO')"
    !
    ! -- check stress period data
    do i = 1, this%nbound
      node = this%nodelist(i)
      bt = this%dis%bot(node)
      !
      ! -- calculate the drainage depth and the top and bottom of
      !    the conductance scaling elevations
      call this%get_drain_elevations(i, drndepth, drntop, drnbot)
      !
      ! -- accumulate errors
      if (drnbot < bt .and. this%icelltype(node) /= 0) then
        if (drndepth /= dzero) then
          write (errmsg, fmt=fmtddrnerr) i, drnbot, bt
        else
          write (errmsg, fmt=fmtdrnerr) i, drnbot, bt
        end if
        call store_error(errmsg)
      end if
      if (this%iauxmultcol > 0) then
        if (this%auxvar(this%iauxmultcol, i) < dzero) then
          write (errmsg, fmt=fmtcondmulterr) &
            i, this%auxvar(this%iauxmultcol, i)
          call store_error(errmsg)
        end if
      end if
      if (this%cond(i) < dzero) then
        write (errmsg, fmt=fmtconderr) i, this%cond(i)
        call store_error(errmsg)
      end if
    end do
    !
    ! -- write summary of drain package error messages
    if (count_errors() > 0) then
      call store_error_filename(this%input_fname)
    end if

Here is the call graph for this function:

drn_create()

subroutine, public drnmodule::drn_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
	)

Definition at line 58 of file gwf-drn.f90.

    ! -- dummy
    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
    ! -- local
    type(DrnType), pointer :: drnobj
    !
    ! -- allocate the object and assign values to object variables
    allocate (drnobj)
    packobj => drnobj
    !
    ! -- create name and memory path
    call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
    packobj%text = text
    !
    ! -- allocate scalars
    call drnobj%allocate_scalars()
    !s
    ! -- initialize package
    call packobj%pack_initialize()
    !
    ! -- initialize
    packobj%inunit = inunit
    packobj%iout = iout
    packobj%id = id
    packobj%ibcnum = ibcnum
    packobj%ncolbnd = 2
    packobj%ictMemPath = create_mem_path(namemodel, 'NPF')

Here is the call graph for this function:

Here is the caller graph for this function:

drn_da()

subroutine drnmodule::drn_da ( class(drntype)  this )

private

Definition at line 97 of file gwf-drn.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(DrnType) :: this
    !
    ! -- Deallocate parent package
    call this%BndExtType%bnd_da()
    !
    ! -- scalars
    call mem_deallocate(this%iauxddrncol)
    call mem_deallocate(this%icubic_scaling)
    !
    ! -- arrays
    call mem_deallocate(this%elev, 'ELEV', this%memoryPath)
    call mem_deallocate(this%cond, 'COND', this%memoryPath)

drn_df_obs()

subroutine drnmodule::drn_df_obs ( class(drntype)  this )

private

Overrides BndTypebnd_df_obs

Definition at line 590 of file gwf-drn.f90.

    implicit none
    ! -- dummy
    class(DrnType) :: this
    ! -- local
    integer(I4B) :: indx
    !
    call this%obs%StoreObsType('drn', .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

Here is the call graph for this function:

drn_fc()

subroutine drnmodule::drn_fc ( class(drntype)  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

Definition at line 373 of file gwf-drn.f90.

    ! -- dummy
    class(DrnType) :: this
    real(DP), dimension(:), intent(inout) :: rhs
    integer(I4B), dimension(:), intent(in) :: ia
    integer(I4B), dimension(:), intent(in) :: idxglo
    class(MatrixBaseType), pointer :: matrix_sln
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: n
    integer(I4B) :: ipos
    real(DP) :: fact
    real(DP) :: drnbot
    real(DP) :: drncond
    real(DP) :: qdrn
    !
    ! -- packmvrobj 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))
      !
      ! -- calculate the drainage scaling factor
      call this%get_drain_factor(i, fact, drnbot)
      !
      ! -- If mover is active and this drain is discharging,
      !    store available water (as positive value).
      if (this%imover == 1 .and. fact > dzero) then
        drncond = this%cond_mult(i)
        qdrn = fact * drncond * (this%xnew(n) - drnbot)
        call this%pakmvrobj%accumulate_qformvr(i, qdrn)
      end if
    end do

drn_fn()

subroutine drnmodule::drn_fn ( class(drntype)  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

Definition at line 416 of file gwf-drn.f90.

    implicit none
    ! -- dummy
    class(DrnType) :: this
    real(DP), dimension(:), intent(inout) :: rhs
    integer(I4B), dimension(:), intent(in) :: ia
    integer(I4B), dimension(:), intent(in) :: idxglo
    class(MatrixBaseType), pointer :: matrix_sln
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: node
    integer(I4B) :: ipos
    real(DP) :: cdrn
    real(DP) :: xnew
    real(DP) :: drndepth
    real(DP) :: drntop
    real(DP) :: drnbot
    real(DP) :: drterm
    !
    ! -- Copy package rhs and hcof into solution rhs and amat
    if (this%iauxddrncol /= 0) then
      do i = 1, this%nbound
        node = this%nodelist(i)
        !
        ! -- test if node is constant or inactive
        if (this%ibound(node) <= 0) then
          cycle
        end if
        !
        ! -- set local variables for this drain
        cdrn = this%cond_mult(i)
        xnew = this%xnew(node)
        !
        ! -- calculate the drainage depth and the top and bottom of
        !    the conductance scaling elevations
        call this%get_drain_elevations(i, drndepth, drntop, drnbot)
        !
        ! -- calculate scaling factor
        if (drndepth /= dzero) then
          drterm = sqsaturationderivative(drntop, drnbot, xnew, &
                                          c1=-done, c2=dtwo)
          drterm = drterm * cdrn * (drnbot - xnew)
          !
          ! -- fill amat and rhs with newton-raphson terms
          ipos = ia(node)
          call matrix_sln%add_value_pos(idxglo(ipos), drterm)
          rhs(node) = rhs(node) + drterm * xnew
        end if
      end do
    end if

Here is the call graph for this function:

drn_obs_supported()

logical function drnmodule::drn_obs_supported ( class(drntype)  this )

private

Overrides BndTypebnd_obs_supported()

Definition at line 578 of file gwf-drn.f90.

    implicit none
    ! -- dummy
    class(DrnType) :: this
    !
    drn_obs_supported = .true.

drn_options()

subroutine drnmodule::drn_options

(

class(drntype), intent(inout)

this

)

Definition at line 183 of file gwf-drn.f90.

    ! -- modules
    use inputoutputmodule, only: urword
    use memorymanagerextmodule, only: mem_set_value
    use characterstringmodule, only: characterstringtype
    use gwfdrninputmodule, only: gwfdrnparamfoundtype
    ! -- dummy
    class(DrnType), intent(inout) :: this
    ! -- local
    type(GwfDrnParamFoundType) :: found
    character(len=LENAUXNAME) :: ddrnauxname
    integer(I4B) :: n
    !
    ! -- source base class options
    call this%BndExtType%source_options()
    !
    ! -- source drain options
    call mem_set_value(this%imover, 'MOVER', this%input_mempath, found%mover)
    call mem_set_value(ddrnauxname, 'AUXDEPTHNAME', this%input_mempath, &
                       found%auxdepthname)
    call mem_set_value(this%icubic_scaling, 'ICUBICSFAC', this%input_mempath, &
                       found%icubicsfac)
    !
    if (found%auxdepthname) then
      this%iauxddrncol = -1
      !
      ! -- Error if no aux variable specified
      if (this%naux == 0) then
        write (errmsg, '(a,2(1x,a))') &
          'AUXDEPTHNAME was specified as', trim(adjustl(ddrnauxname)), &
          'but no AUX variables specified.'
        call store_error(errmsg)
      end if
      !
      ! -- Assign ddrn column
      this%iauxddrncol = 0
      do n = 1, this%naux
        if (ddrnauxname == this%auxname(n)) then
          this%iauxddrncol = n
          exit
        end if
      end do
      !
      ! -- Error if aux variable cannot be found
      if (this%iauxddrncol == 0) then
        write (errmsg, '(a,2(1x,a))') &
          'AUXDEPTHNAME was specified as', trim(adjustl(ddrnauxname)), &
          'but no AUX variable found with this name.'
        call store_error(errmsg)
      end if
    end if
    !
    ! -- log DRN specific options
    call this%log_drn_options(found)

Here is the call graph for this function:

drn_rp()

subroutine drnmodule::drn_rp

(

class(drntype), intent(inout)

this

)

Definition at line 165 of file gwf-drn.f90.

    use tdismodule, only: kper
    ! -- dummy
    class(DrnType), intent(inout) :: this
    !
    if (this%iper /= kper) return
    !
    ! -- Call the parent class read and prepare
    call this%BndExtType%bnd_rp()
    !
    ! -- store user cond
    if (this%ivsc == 1) then
      call this%drn_store_user_cond()
    end if

drn_store_user_cond()

subroutine drnmodule::drn_store_user_cond ( class(drntype), intent(inout)  this )

private

Definition at line 608 of file gwf-drn.f90.

    ! -- dummy
    class(DrnType), intent(inout) :: this
    ! -- local
    integer(I4B) :: n
    !
    ! -- store backup copy of conductance values
    do n = 1, this%nbound
      this%condinput(n) = this%cond_mult(n)
    end do

get_drain_elevations()

subroutine drnmodule::get_drain_elevations ( class(drntype), intent(inout)  this, integer(i4b), intent(in)  i, real(dp), intent(inout)  drndepth, real(dp), intent(inout)  drntop, real(dp), intent(inout)  drnbot  )

private

Definition at line 497 of file gwf-drn.f90.

    ! -- dummy
    class(DrnType), intent(inout) :: this
    integer(I4B), intent(in) :: i
    real(DP), intent(inout) :: drndepth
    real(DP), intent(inout) :: drntop
    real(DP), intent(inout) :: drnbot
    ! -- local
    real(DP) :: drnelev
    real(DP) :: elev
    !
    ! -- initialize dummy and local variables
    drndepth = dzero
    drnelev = this%elev(i)
    !
    ! -- set the drain depth
    if (this%iauxddrncol > 0) then
      drndepth = this%auxvar(this%iauxddrncol, i)
    end if
    !
    ! -- calculate the top and bottom drain elevations
    if (drndepth /= dzero) then
      elev = drnelev + drndepth
      drntop = max(elev, drnelev)
      drnbot = min(elev, drnelev)
    else
      drntop = drnelev
      drnbot = drnelev
    end if

get_drain_factor()

subroutine drnmodule::get_drain_factor ( class(drntype), intent(inout)  this, integer(i4b), intent(in)  i, real(dp), intent(inout)  factor, real(dp), intent(inout), optional  opt_drnbot  )

private

Definition at line 530 of file gwf-drn.f90.

    ! -- dummy
    class(DrnType), intent(inout) :: this
    integer(I4B), intent(in) :: i
    real(DP), intent(inout) :: factor
    real(DP), intent(inout), optional :: opt_drnbot
    ! -- local
    integer(I4B) :: node
    real(DP) :: xnew
    real(DP) :: drndepth
    real(DP) :: drntop
    real(DP) :: drnbot
    !
    ! -- set local variables for this drain
    node = this%nodelist(i)
    xnew = this%xnew(node)
    !
    ! -- calculate the drainage depth and the top and bottom of
    !    the conductance scaling elevations
    call this%get_drain_elevations(i, drndepth, drntop, drnbot)
    !
    ! -- set opt_drnbot to drnbot if passed as dummy variable
    if (present(opt_drnbot)) then
      opt_drnbot = drnbot
    end if
    !
    ! -- calculate scaling factor
    if (drndepth /= dzero) then
      if (this%icubic_scaling /= 0) then
        factor = sqsaturation(drntop, drnbot, xnew, c1=-done, c2=dtwo)
      else
        factor = squadraticsaturation(drntop, drnbot, xnew, eps=dzero)
      end if
    else
      if (xnew <= drnbot) then
        factor = dzero
      else
        factor = done
      end if
    end if

Here is the call graph for this function:

log_drn_options()

subroutine drnmodule::log_drn_options	(	class(drntype), intent(inout)	this,
		type(gwfdrnparamfoundtype), intent(in)	found
	)

Definition at line 241 of file gwf-drn.f90.

    ! -- modules
    use gwfdrninputmodule, only: gwfdrnparamfoundtype
    ! -- dummy variables
    class(DrnType), intent(inout) :: this
    type(GwfDrnParamFoundType), 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
    !
    if (found%icubicsfac) then
      write (this%iout, '(4x,a,1x,a)') &
        'CUBIC SCALING will be used for drains with non-zero DDRN values', &
        'even if the NEWTON-RAPHSON method is not being used.'
    end if
    !
    ! -- close logging block
    write (this%iout, '(1x,a)') &
      'END OF '//trim(adjustl(this%text))//' OPTIONS'

Variable Documentation

ftype

character(len=lenftype) drnmodule::ftype = 'DRN'

private

Definition at line 21 of file gwf-drn.f90.

  character(len=LENFTYPE) :: ftype = 'DRN'

text

character(len=lenpackagename) drnmodule::text = ' DRN'

private

Definition at line 22 of file gwf-drn.f90.

  character(len=LENPACKAGENAME) :: text = '             DRN'