rivmodule Module Reference

Data Types
type	rivtype

Functions/Subroutines
subroutine, public	riv_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
	Create a New Riv Package and point packobj to the new package. More...
subroutine	riv_da (this)
	Deallocate memory. More...
subroutine	riv_options (this)
	Set options specific to RivType. More...
subroutine	log_riv_options (this, found)
	Log options specific to RivType. More...
subroutine	riv_allocate_arrays (this, nodelist, auxvar)
	Allocate package arrays. More...
subroutine	riv_rp (this)
	Read and prepare. More...
subroutine	riv_ck (this)
	Check river boundary condition data. More...
subroutine	riv_cf (this)
	Formulate the HCOF and RHS terms. More...
subroutine	riv_fc (this, rhs, ia, idxglo, matrix_sln)
	Copy rhs and hcof into solution rhs and amat. More...
subroutine	define_listlabel (this)
	Define the list heading that is written to iout when PRINT_INPUT option is used. More...
logical function	riv_obs_supported (this)
	Return true because RIV package supports observations. More...
subroutine	riv_df_obs (this)
	Store observation type supported by RIV package. More...
subroutine	riv_store_user_cond (this)
	Store user-specified conductance value. More...
real(dp) function	cond_mult (this, row)
	Apply multiplier to conductance if auxmultcol option is in use. More...
real(dp) function	riv_bound_value (this, col, row)
	Return requested boundary value. More...

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

Function/Subroutine Documentation

cond_mult()

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

private

Definition at line 410 of file gwf-riv.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy
    class(RivType), 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 rivmodule::define_listlabel ( class(rivtype), intent(inout)  this )

private

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

    ! -- modules
    class(RivType), 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), 'STAGE'
    write (this%listlabel, '(a, a16)') trim(this%listlabel), 'CONDUCTANCE'
    write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOTTOM EL.'
    if (this%inamedbound == 1) then
      write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
    end if

log_riv_options()

subroutine rivmodule::log_riv_options	(	class(rivtype), intent(inout)	this,
		type(gwfrivparamfoundtype), intent(in)	found
	)

Definition at line 126 of file gwf-riv.f90.

    ! -- modules
    use gwfrivinputmodule, only: gwfrivparamfoundtype
    ! -- dummy variables
    class(RivType), intent(inout) :: this
    type(GwfRivParamFoundType), intent(in) :: found
    !
    ! -- 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'

riv_allocate_arrays()

subroutine rivmodule::riv_allocate_arrays	(	class(rivtype)	this,
		integer(i4b), dimension(:), optional, pointer, contiguous	nodelist,
		real(dp), dimension(:, :), optional, pointer, contiguous	auxvar
	)

Definition at line 148 of file gwf-riv.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate, mem_setptr, mem_checkin
    ! -- dummy
    class(RivType) :: 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 riv input context pointers
    call mem_setptr(this%stage, 'STAGE', this%input_mempath)
    call mem_setptr(this%cond, 'COND', this%input_mempath)
    call mem_setptr(this%rbot, 'RBOT', this%input_mempath)
    !
    ! --checkin riv input context pointers
    call mem_checkin(this%stage, 'STAGE', this%memoryPath, &
                     'STAGE', this%input_mempath)
    call mem_checkin(this%cond, 'COND', this%memoryPath, &
                     'COND', this%input_mempath)
    call mem_checkin(this%rbot, 'RBOT', this%memoryPath, &
                     'RBOT', this%input_mempath)

riv_bound_value()

real(dp) function rivmodule::riv_bound_value	(	class(rivtype), intent(inout)	this,
		integer(i4b), intent(in)	col,
		integer(i4b), intent(in)	row
	)

Definition at line 428 of file gwf-riv.f90.

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

Here is the call graph for this function:

riv_cf()

subroutine rivmodule::riv_cf

(

class(rivtype)

this

)

Skip in no rivs, otherwise calculate hcof and rhs

Definition at line 266 of file gwf-riv.f90.

    ! -- dummy
    class(RivType) :: this
    ! -- local
    integer(I4B) :: i, node
    real(DP) :: hriv, criv, rbot
    !
    ! -- Return if no rivs
    if (this%nbound .eq. 0) return
    !
    ! -- Calculate hcof and rhs for each riv 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
      hriv = this%stage(i)
      criv = this%cond_mult(i)
      rbot = this%rbot(i)
      if (this%xnew(node) <= rbot) then
        this%rhs(i) = -criv * (hriv - rbot)
        this%hcof(i) = dzero
      else
        this%rhs(i) = -criv * hriv
        this%hcof(i) = -criv
      end if
    end do

riv_ck()

subroutine rivmodule::riv_ck

(

class(rivtype), intent(inout)

this

)

Definition at line 194 of file gwf-riv.f90.

    ! -- modules
    use constantsmodule, only: linelength
    use simmodule, only: store_error, count_errors, store_error_unit
    ! -- dummy
    class(RivType), intent(inout) :: this
    ! -- local
    character(len=LINELENGTH) :: errmsg
    integer(I4B) :: i
    integer(I4B) :: node
    real(DP) :: bt
    real(DP) :: stage
    real(DP) :: rbot
    ! -- formats
    character(len=*), parameter :: fmtriverr = &
      "('RIV BOUNDARY (',i0,') RIVER BOTTOM (',f10.4,') IS LESS &
      &THAN CELL BOTTOM (',f10.4,')')"
    character(len=*), parameter :: fmtriverr2 = &
      "('RIV BOUNDARY (',i0,') RIVER STAGE (',f10.4,') IS LESS &
      &THAN RIVER BOTTOM (',f10.4,')')"
    character(len=*), parameter :: fmtriverr3 = &
      "('RIV BOUNDARY (',i0,') RIVER STAGE (',f10.4,') IS LESS &
      &THAN CELL BOTTOM (',f10.4,')')"
    character(len=*), parameter :: fmtcondmulterr = &
      "('RIV BOUNDARY (',i0,') CONDUCTANCE MULTIPLIER (',g10.3,') IS &
      &LESS THAN ZERO')"
    character(len=*), parameter :: fmtconderr = &
      "('RIV 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)
      stage = this%stage(i)
      rbot = this%rbot(i)
      ! -- accumulate errors
      if (rbot < bt .and. this%icelltype(node) /= 0) then
        write (errmsg, fmt=fmtriverr) i, rbot, bt
        call store_error(errmsg)
      end if
      if (stage < rbot) then
        write (errmsg, fmt=fmtriverr2) i, stage, rbot
        call store_error(errmsg)
      end if
      if (stage < bt .and. this%icelltype(node) /= 0) then
        write (errmsg, fmt=fmtriverr3) i, stage, bt
        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 river package error messages
    if (count_errors() > 0) then
      call store_error_unit(this%inunit)
    end if

Here is the call graph for this function:

riv_create()

subroutine, public rivmodule::riv_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 49 of file gwf-riv.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(RivType), pointer :: rivobj
    !
    ! -- allocate the object and assign values to object variables
    allocate (rivobj)
    packobj => rivobj
    !
    ! -- create name and memory path
    call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
    packobj%text = text
    !
    ! -- allocate scalars
    call rivobj%allocate_scalars()
    !
    ! -- initialize package
    call packobj%pack_initialize()
    !
    packobj%inunit = inunit
    packobj%iout = iout
    packobj%id = id
    packobj%ibcnum = ibcnum
    packobj%ncolbnd = 3
    packobj%ictMemPath = create_mem_path(namemodel, 'NPF')

Here is the call graph for this function:

Here is the caller graph for this function:

riv_da()

subroutine rivmodule::riv_da ( class(rivtype)  this )

private

Definition at line 87 of file gwf-riv.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(RivType) :: this
    !
    ! -- Deallocate parent package
    call this%BndExtType%bnd_da()
    !
    ! -- arrays
    call mem_deallocate(this%stage, 'STAGE', this%memoryPath)
    call mem_deallocate(this%cond, 'COND', this%memoryPath)
    call mem_deallocate(this%rbot, 'RBOT', this%memoryPath)

riv_df_obs()

subroutine rivmodule::riv_df_obs ( class(rivtype)  this )

private

Overrides BndTypebnd_df_obs

Definition at line 378 of file gwf-riv.f90.

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

riv_fc()

subroutine rivmodule::riv_fc ( class(rivtype)  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 299 of file gwf-riv.f90.

    ! -- dummy
    class(RivType) :: 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, n, ipos
    real(DP) :: cond, stage, qriv !, rbot
    !
    ! -- 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 river cell is discharging,
      !    store available water (as positive value).
      stage = this%stage(i)
      if (this%imover == 1 .and. this%xnew(n) > stage) then
        cond = this%cond_mult(i)
        qriv = cond * (this%xnew(n) - stage)
        call this%pakmvrobj%accumulate_qformvr(i, qriv)
      end if
    end do

riv_obs_supported()

logical function rivmodule::riv_obs_supported ( class(rivtype)  this )

private

Return true because RIV package supports observations.

Definition at line 366 of file gwf-riv.f90.

    implicit none
    ! -- dummy
    class(RivType) :: this
    !
    riv_obs_supported = .true.

riv_options()

subroutine rivmodule::riv_options

(

class(rivtype), intent(inout)

this

)

Definition at line 104 of file gwf-riv.f90.

    ! -- modules
    use memorymanagerextmodule, only: mem_set_value
    use characterstringmodule, only: characterstringtype
    use gwfrivinputmodule, only: gwfrivparamfoundtype
    ! -- dummy
    class(RivType), intent(inout) :: this
    ! -- local
    type(GwfRivParamFoundType) :: found
    !
    ! -- source base class options
    call this%BndExtType%source_options()
    !
    ! -- source options from input context
    call mem_set_value(this%imover, 'MOVER', this%input_mempath, found%mover)
    !
    ! -- log riv specific options
    call this%log_riv_options(found)

riv_rp()

subroutine rivmodule::riv_rp

(

class(rivtype), intent(inout)

this

)

Definition at line 175 of file gwf-riv.f90.

    ! -- modules
    use tdismodule, only: kper
    ! -- dummy
    class(RivType), 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%riv_store_user_cond()
    end if

riv_store_user_cond()

subroutine rivmodule::riv_store_user_cond ( class(rivtype), intent(inout)  this )

private

Definition at line 396 of file gwf-riv.f90.

    ! -- dummy
    class(RivType), 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

Variable Documentation

ftype

character(len=lenftype) rivmodule::ftype = 'RIV'

private

Definition at line 18 of file gwf-riv.f90.

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

text

character(len=lenpackagename) rivmodule::text = ' RIV'

private

Definition at line 19 of file gwf-riv.f90.

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