rchmodule Module Reference

Data Types
type	rchtype

Functions/Subroutines
subroutine, public	rch_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
	Create a New Recharge Package. More...
subroutine	rch_allocate_scalars (this)
	Allocate scalar members. More...
subroutine	rch_allocate_arrays (this, nodelist, auxvar)
	Allocate package arrays. More...
subroutine	rch_source_options (this)
	Source options specific to RchType. More...
subroutine	log_rch_options (this, found_fixed_cell, found_readasarrays)
	Log options specific to RchType. More...
subroutine	rch_source_dimensions (this)
	Source the dimensions for this package. More...
subroutine	rch_read_initial_attr (this)
	Part of allocate and read. More...
subroutine	rch_rp (this)
	Read and Prepare. More...
subroutine	set_nodesontop (this)
	Store nodelist in nodesontop. More...
subroutine	rch_cf (this)
	Formulate the HCOF and RHS terms. More...
subroutine	rch_fc (this, rhs, ia, idxglo, matrix_sln)
	Copy rhs and hcof into solution rhs and amat. More...
subroutine	rch_da (this)
	Deallocate memory. More...
subroutine	rch_define_listlabel (this)
	Define the list heading that is written to iout when PRINT_INPUT option is used. More...
subroutine	default_nodelist (this)
	Assign default nodelist when READASARRAYS is specified. More...
logical function	rch_obs_supported (this)
	Overrides BndTypebnd_obs_supported() More...
subroutine	rch_df_obs (this)
	Implements bnd_df_obs. More...
real(dp) function	rch_bound_value (this, col, row)
	Return requested boundary value. More...
subroutine	nodelist_update (nodelist, nbound, maxbound, dis, input_mempath)
	Update the nodelist based on IRCH input. More...

Variables
character(len=lenftype)	ftype = 'RCH'
character(len=lenpackagename)	text = ' RCH'
character(len=lenpackagename)	texta = ' RCHA'

Function/Subroutine Documentation

default_nodelist()

subroutine rchmodule::default_nodelist ( class(rchtype)  this )

private

Equivalent to reading IRCH as CONSTANT 1

Definition at line 473 of file gwf-rch.f90.

    ! -- dummy
    class(RchType) :: this
    ! -- local
    integer(I4B) :: il, ir, ic, ncol, nrow, nlay, nodeu, noder, ipos
    !
    ! -- set variables
    if (this%dis%ndim == 3) then
      nlay = this%dis%mshape(1)
      nrow = this%dis%mshape(2)
      ncol = this%dis%mshape(3)
    elseif (this%dis%ndim == 2) then
      nlay = this%dis%mshape(1)
      nrow = 1
      ncol = this%dis%mshape(2)
    end if
    !
    ! -- Populate nodelist
    ipos = 1
    il = 1
    do ir = 1, nrow
      do ic = 1, ncol
        nodeu = get_node(il, ir, ic, nlay, nrow, ncol)
        noder = this%dis%get_nodenumber(nodeu, 0)
        this%nodelist(ipos) = noder
        ipos = ipos + 1
      end do
    end do
    !
    ! -- Assign nbound
    this%nbound = ipos - 1
    !
    ! -- if fixed_cell option not set, then need to store nodelist
    !    in the nodesontop array
    if (.not. this%fixed_cell) call this%set_nodesontop()
    !
    ! -- Return
    return

Here is the call graph for this function:

log_rch_options()

subroutine rchmodule::log_rch_options	(	class(rchtype), intent(inout)	this,
		logical(lgp), intent(in)	found_fixed_cell,
		logical(lgp), intent(in)	found_readasarrays
	)

Definition at line 185 of file gwf-rch.f90.

    implicit none
    ! -- dummy
    class(RchType), intent(inout) :: this
    logical(LGP), intent(in) :: found_fixed_cell
    logical(LGP), intent(in) :: found_readasarrays
    ! -- formats
    character(len=*), parameter :: fmtfixedcell = &
      &"(4x, 'RECHARGE WILL BE APPLIED TO SPECIFIED CELL.')"
    character(len=*), parameter :: fmtreadasarrays = &
      &"(4x, 'RECHARGE INPUT WILL BE READ AS ARRAY(S).')"
    !
    ! -- log found options
    write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) &
      //' OPTIONS'
    !
    if (found_fixed_cell) then
      write (this%iout, fmtfixedcell)
    end if
    !
    if (found_readasarrays) then
      write (this%iout, fmtreadasarrays)
    end if
    !
    ! -- close logging block
    write (this%iout, '(1x,a)') &
      'END OF '//trim(adjustl(this%text))//' OPTIONS'
    !
    ! -- Return
    return

nodelist_update()

subroutine rchmodule::nodelist_update	(	integer(i4b), dimension(:), intent(inout), pointer, contiguous	nodelist,
		integer(i4b), intent(inout)	nbound,
		integer(i4b), intent(in)	maxbound,
		class(disbasetype), intent(in), pointer	dis,
		character(len=*), intent(in)	input_mempath
	)

This is a module scoped routine to check for IRCH input. If array input was provided, INIRCH and IRCH will be allocated in the input context. If the read state variable INIRCH is set to 1 during this period update, IRCH input was read and is used here to update the nodelist.

Definition at line 589 of file gwf-rch.f90.

    ! -- modules
    use memorymanagermodule, only: mem_setptr
    use basedismodule, only: disbasetype
    ! -- dummy
    integer(I4B), dimension(:), contiguous, &
      pointer, intent(inout) :: nodelist
    class(DisBaseType), pointer, intent(in) :: dis
    character(len=*), intent(in) :: input_mempath
    integer(I4B), intent(inout) :: nbound
    integer(I4B), intent(in) :: maxbound
    character(len=24) :: aname = '     LAYER OR NODE INDEX'
    ! -- local
    integer(I4B), dimension(:), contiguous, &
      pointer :: irch => null()
    integer(I4B), pointer :: inirch => null()
    !
    ! -- set pointer to input context INIRCH
    call mem_setptr(inirch, 'INIRCH', input_mempath)
    !
    ! -- check INIRCH read state
    if (inirch == 1) then
      ! -- irch was read this period
      !
      ! -- set pointer to input context IRCH
      call mem_setptr(irch, 'IRCH', input_mempath)
      !
      ! -- update nodelist
      call dis%nlarray_to_nodelist(irch, nodelist, &
                                   maxbound, nbound, aname)
    end if
    !
    ! -- Return
    return

Here is the caller graph for this function:

rch_allocate_arrays()

subroutine rchmodule::rch_allocate_arrays ( class(rchtype)  this, integer(i4b), dimension(:), optional, pointer, contiguous  nodelist, real(dp), dimension(:, :), optional, pointer, contiguous  auxvar  )

private

Definition at line 122 of file gwf-rch.f90.

    ! -- modules
    use memorymanagermodule, only: mem_setptr, mem_checkin
    ! -- dummy
    class(RchType) :: this
    integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist
    real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar
    !
    ! -- allocate base arrays
    call this%BndExtType%allocate_arrays(nodelist, auxvar)
    !
    ! -- set recharge input context pointer
    call mem_setptr(this%recharge, 'RECHARGE', this%input_mempath)
    !
    ! -- checkin recharge input context pointer
    call mem_checkin(this%recharge, 'RECHARGE', this%memoryPath, &
                     'RECHARGE', this%input_mempath)
    !
    ! -- Return
    return

rch_allocate_scalars()

subroutine rchmodule::rch_allocate_scalars ( class(rchtype), intent(inout)  this )

private

Definition at line 101 of file gwf-rch.f90.

    ! -- dummy
    class(RchType), intent(inout) :: this
    !
    ! -- allocate base scalars
    call this%BndExtType%allocate_scalars()
    !
    ! -- allocate internal members
    allocate (this%fixed_cell)
    allocate (this%read_as_arrays)
    !
    ! -- Set values
    this%fixed_cell = .false.
    this%read_as_arrays = .false.
    !
    ! -- Return
    return

rch_bound_value()

real(dp) function rchmodule::rch_bound_value ( class(rchtype), intent(inout)  this, integer(i4b), intent(in)  col, integer(i4b), intent(in)  row  )

private

Parameters

[in,out]

this

BndExtType object

Definition at line 551 of file gwf-rch.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy
    class(RchType), intent(inout) :: this !< BndExtType object
    integer(I4B), intent(in) :: col
    integer(I4B), intent(in) :: row
    ! -- result
    real(DP) :: bndval
    !
    select case (col)
    case (1)
      if (this%iauxmultcol > 0) then
        bndval = this%recharge(row) * this%auxvar(this%iauxmultcol, row)
      else
        bndval = this%recharge(row)
      end if
    case default
      errmsg = 'Programming error. RCH 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:

rch_cf()

subroutine rchmodule::rch_cf ( class(rchtype)  this )

private

Skip if no recharge. Otherwise, calculate hcof and rhs

Definition at line 330 of file gwf-rch.f90.

    ! -- dummy
    class(rchtype) :: this
    ! -- local
    integer(I4B) :: i, node
    !
    ! -- Return if no recharge
    if (this%nbound == 0) return
    !
    ! -- Calculate hcof and rhs for each recharge entry
    do i = 1, this%nbound
      !
      ! -- Find the node number
      if (this%fixed_cell) then
        node = this%nodelist(i)
      else
        node = this%nodesontop(i)
      end if
      !
      ! -- cycle if nonexistent bound
      if (node <= 0) then
        this%hcof(i) = dzero
        this%rhs(i) = dzero
        cycle
      end if
      !
      ! -- reset nodelist to highest active
      if (.not. this%fixed_cell) then
        if (this%ibound(node) == 0) &
          call this%dis%highest_active(node, this%ibound)
        this%nodelist(i) = node
      end if
      !
      ! -- Set rhs and hcof
      this%hcof(i) = dzero
      if (this%iauxmultcol > 0) then
        this%rhs(i) = -this%recharge(i) * this%dis%get_area(node) * &
                      this%auxvar(this%iauxmultcol, i)
      else
        this%rhs(i) = -this%recharge(i) * this%dis%get_area(node)
      end if
      if (this%ibound(node) <= 0) then
        this%rhs(i) = dzero
        cycle
      end if
      if (this%ibound(node) == iwetlake) then
        this%rhs(i) = dzero
        cycle
      end if
    end do
    !
    ! -- Return
    return

rch_create()

subroutine, public rchmodule::rch_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
	)

Create new RCH package and point packobj to the new package

Definition at line 61 of file gwf-rch.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(rchtype), pointer :: rchobj
    !
    ! -- allocate recharge object and scalar variables
    allocate (rchobj)
    packobj => rchobj
    !
    ! -- create name and memory path
    call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
    packobj%text = text
    !
    ! -- allocate scalars
    call rchobj%rch_allocate_scalars()
    !
    ! -- initialize package
    call packobj%pack_initialize()
    !
    packobj%inunit = inunit
    packobj%iout = iout
    packobj%id = id
    packobj%ibcnum = ibcnum
    packobj%ictMemPath = create_mem_path(namemodel, 'NPF')
    !
    ! -- Return
    return

Here is the call graph for this function:

Here is the caller graph for this function:

rch_da()

subroutine rchmodule::rch_da ( class(rchtype)  this )

private

Definition at line 418 of file gwf-rch.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(RchType) :: this
    !
    ! -- Deallocate parent package
    call this%BndExtType%bnd_da()
    !
    ! -- scalars
    deallocate (this%fixed_cell)
    deallocate (this%read_as_arrays)
    !
    ! -- arrays
    if (associated(this%nodesontop)) deallocate (this%nodesontop)
    call mem_deallocate(this%recharge, 'RECHARGE', this%memoryPath)
    !
    ! -- Return
    return

rch_define_listlabel()

subroutine rchmodule::rch_define_listlabel

(

class(rchtype), intent(inout)

this

)

Definition at line 442 of file gwf-rch.f90.

    ! -- dummy
    class(RchType), 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), 'RECHARGE'
!    if(this%multindex > 0) &
!      write(this%listlabel, '(a, a16)') trim(this%listlabel), 'MULTIPLIER'
    if (this%inamedbound == 1) then
      write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
    end if
    !
    ! -- Return
    return

rch_df_obs()

subroutine rchmodule::rch_df_obs ( class(rchtype)  this )

private

Store observation type supported by RCH package. Overrides BndTypebnd_df_obs

Definition at line 535 of file gwf-rch.f90.

    implicit none
    ! -- dummy
    class(RchType) :: this
    ! -- local
    integer(I4B) :: indx
    !
    call this%obs%StoreObsType('rch', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => defaultobsidprocessor
    !
    ! -- Return
    return

Here is the call graph for this function:

rch_fc()

subroutine rchmodule::rch_fc ( class(rchtype)  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 387 of file gwf-rch.f90.

    ! -- dummy
    class(RchType) :: 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
    !
    ! -- Copy package rhs and hcof into solution rhs and amat
    do i = 1, this%nbound
      n = this%nodelist(i)
      if (n <= 0) cycle
      ! -- reset hcof and rhs for excluded cells
      if (this%ibound(n) == iwetlake) then
        this%hcof(i) = dzero
        this%rhs(i) = dzero
        cycle
      end if
      rhs(n) = rhs(n) + this%rhs(i)
      ipos = ia(n)
      call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i))
    end do
    !
    ! -- Return
    return

rch_obs_supported()

logical function rchmodule::rch_obs_supported ( class(rchtype)  this )

private

Definition at line 519 of file gwf-rch.f90.

    implicit none
    ! -- dummy
    class(RchType) :: this
    !
    rch_obs_supported = .true.
    !
    ! -- Return
    return

rch_read_initial_attr()

subroutine rchmodule::rch_read_initial_attr ( class(rchtype), intent(inout)  this )

private

Definition at line 254 of file gwf-rch.f90.

    ! -- dummy
    class(RchType), intent(inout) :: this
    !
    if (this%read_as_arrays) then
      call this%default_nodelist()
    end if
    !
    ! -- Return
    return

rch_rp()

subroutine rchmodule::rch_rp ( class(rchtype), intent(inout)  this )

private

Read itmp and read new boundaries if itmp > 0

Definition at line 270 of file gwf-rch.f90.

    ! -- modules
    use tdismodule, only: kper
    implicit none
    ! -- dummy
    class(RchType), intent(inout) :: this
    !
    if (this%iper /= kper) return
    !
    if (this%read_as_arrays) then
      !
      ! -- update nodelist based on IRCH input
      call nodelist_update(this%nodelist, this%nbound, this%maxbound, &
                           this%dis, this%input_mempath)
      !
    else
      !
      call this%BndExtType%bnd_rp()
      !
    end if
    !
    ! -- copy nodelist to nodesontop if not fixed cell
    if (.not. this%fixed_cell) call this%set_nodesontop()
    !
    ! -- Write the list to iout if requested
    if (this%iprpak /= 0) then
      call this%write_list()
    end if
    !
    ! -- Return
    return

Here is the call graph for this function:

rch_source_dimensions()

subroutine rchmodule::rch_source_dimensions ( class(rchtype), intent(inout)  this )

private

Dimensions block is not required if: (1) discretization is DIS or DISV, and (2) READASARRAYS option has been specified.

Definition at line 223 of file gwf-rch.f90.

    ! -- dummy
    class(RchType), intent(inout) :: this
    !
    if (this%read_as_arrays) then
      this%maxbound = this%dis%get_ncpl()
      !
      ! -- verify dimensions were set
      if (this%maxbound <= 0) then
        write (errmsg, '(a)') &
          'MAXBOUND must be an integer greater than zero.'
        call store_error(errmsg)
        call store_error_filename(this%input_fname)
      end if
      !
    else
      !
      ! -- source maxbound
      call this%BndExtType%source_dimensions()
    end if
    !
    ! -- Call define_listlabel to construct the list label that is written
    !    when PRINT_INPUT option is used.
    call this%define_listlabel()
    !
    ! -- Return
    return

Here is the call graph for this function:

rch_source_options()

subroutine rchmodule::rch_source_options

(

class(rchtype), intent(inout)

this

)

Definition at line 146 of file gwf-rch.f90.

    ! -- modules
    use memorymanagerextmodule, only: mem_set_value
    implicit none
    ! -- dummy
    class(RchType), intent(inout) :: this
    ! -- local
    logical(LGP) :: found_fixed_cell = .false.
    logical(LGP) :: found_readasarrays = .false.
    !
    ! -- source common bound options
    call this%BndExtType%source_options()
    !
    ! -- update defaults with idm sourced values
    call mem_set_value(this%fixed_cell, 'FIXED_CELL', this%input_mempath, &
                       found_fixed_cell)
    call mem_set_value(this%read_as_arrays, 'READASARRAYS', this%input_mempath, &
                       found_readasarrays)
    !
    if (found_readasarrays) then
      if (this%dis%supports_layers()) then
        this%text = texta
      else
        errmsg = 'READASARRAYS option is not compatible with selected'// &
                 ' discretization type.'
        call store_error(errmsg)
        call store_error_filename(this%input_fname)
      end if
    end if
    !
    ! -- log rch params
    call this%log_rch_options(found_fixed_cell, found_readasarrays)
    !
    ! -- Return
    return

Here is the call graph for this function:

set_nodesontop()

subroutine rchmodule::set_nodesontop

(

class(rchtype), intent(inout)

this

)

Definition at line 305 of file gwf-rch.f90.

    implicit none
    ! -- dummy
    class(RchType), intent(inout) :: this
    ! -- local
    integer(I4B) :: n
    !
    ! -- allocate if necessary
    if (.not. associated(this%nodesontop)) then
      allocate (this%nodesontop(this%maxbound))
    end if
    !
    ! -- copy nodelist into nodesontop
    do n = 1, this%nbound
      this%nodesontop(n) = this%nodelist(n)
    end do
    !
    ! -- Return
    return

Variable Documentation

ftype

character(len=lenftype) rchmodule::ftype = 'RCH'

private

Definition at line 23 of file gwf-rch.f90.

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

text

character(len=lenpackagename) rchmodule::text = ' RCH'

private

Definition at line 24 of file gwf-rch.f90.

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

texta

character(len=lenpackagename) rchmodule::texta = ' RCHA'

private

Definition at line 25 of file gwf-rch.f90.

  character(len=LENPACKAGENAME) :: texta = '            RCHA'