swfpcpmodule Module Reference

This module contains the precipitation (PCP) package methods. More...

Data Types
type	swfpcptype

Functions/Subroutines
subroutine, public	pcp_create (packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath, dis, dfw, cxs)
	Create a Precipitation Package. More...
subroutine	pcp_allocate_scalars (this)
	Allocate scalar members. More...
subroutine	pcp_allocate_arrays (this, nodelist, auxvar)
	Allocate package arrays. More...
subroutine	pcp_source_options (this)
	Source options specific to PCPType. More...
subroutine	log_pcp_options (this, found_readasarrays)
	Log options specific to SwfPcpType. More...
subroutine	pcp_source_dimensions (this)
	Source the dimensions for this package. More...
subroutine	pcp_read_initial_attr (this)
	Part of allocate and read. More...
subroutine	pcp_rp (this)
	Read and Prepare. More...
subroutine	pcp_ck (this)
	Ensure precipitation is positive. More...
subroutine	pcp_cf (this)
	Formulate the HCOF and RHS terms. More...
subroutine	pcp_fc (this, rhs, ia, idxglo, matrix_sln)
	Copy rhs and hcof into solution rhs and amat. More...
subroutine	pcp_da (this)
	Deallocate memory. More...
subroutine	pcp_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	pcp_obs_supported (this)
	Overrides BndTypebnd_obs_supported() More...
subroutine	pcp_df_obs (this)
	Implements bnd_df_obs. More...
real(dp) function	pcp_bound_value (this, col, row)
	Return requested boundary value. More...
real(dp) function, dimension(:), pointer	reach_length_pointer (this)

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

Detailed Description

This module can be used to represent precipitation onto streams and overland flow cells.

Function/Subroutine Documentation

default_nodelist()

subroutine swfpcpmodule::default_nodelist ( class(swfpcptype)  this )

private

Definition at line 442 of file swf-pcp.f90.

    ! dummy
    class(SwfPcpType) :: this
    ! local
    integer(I4B) :: nodeu, noder
 
    ! This is only called for readasarrays, so nodelist will be the size of
    ! the user grid, and will have a value of 0 for any entries where idomain
    ! is not 1
    do nodeu = 1, this%maxbound
      noder = this%dis%get_nodenumber(nodeu, 0)
      this%nodelist(nodeu) = noder
    end do
 
    ! Assign nbound
    this%nbound = this%maxbound
 

log_pcp_options()

subroutine swfpcpmodule::log_pcp_options	(	class(swfpcptype), intent(inout)	this,
		logical(lgp), intent(in)	found_readasarrays
	)

Definition at line 180 of file swf-pcp.f90.

    implicit none
    ! dummy
    class(SwfPcpType), intent(inout) :: this
    logical(LGP), intent(in) :: found_readasarrays
    ! formats
    character(len=*), parameter :: fmtreadasarrays = &
      &"(4x, 'PRECIPITATION INPUT WILL BE READ AS ARRAY(S).')"
 
    ! log found options
    write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) &
      //' OPTIONS'
 
    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'

pcp_allocate_arrays()

subroutine swfpcpmodule::pcp_allocate_arrays ( class(swfpcptype)  this, integer(i4b), dimension(:), optional, pointer, contiguous  nodelist, real(dp), dimension(:, :), optional, pointer, contiguous  auxvar  )

private

Definition at line 137 of file swf-pcp.f90.

    ! modules
    use memorymanagermodule, only: mem_setptr, mem_checkin
    ! dummy
    class(SwfPcpType) :: 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 input context pointers
    call mem_setptr(this%precipitation, 'PRECIPITATION', this%input_mempath)
 
    ! checkin input context pointers
    call mem_checkin(this%precipitation, 'PRECIPITATION', this%memoryPath, &
                     'PRECIPITATION', this%input_mempath)

pcp_allocate_scalars()

subroutine swfpcpmodule::pcp_allocate_scalars ( class(swfpcptype), intent(inout)  this )

private

Definition at line 121 of file swf-pcp.f90.

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

pcp_bound_value()

real(dp) function swfpcpmodule::pcp_bound_value ( class(swfpcptype), intent(inout)  this, integer(i4b), intent(in)  col, integer(i4b), intent(in)  row  )

private

Definition at line 492 of file swf-pcp.f90.

    ! modules
    use constantsmodule, only: dzero
    ! dummy
    class(SwfPcpType), intent(inout) :: this
    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%precipitation(row) * this%auxvar(this%iauxmultcol, row)
      else
        bndval = this%precipitation(row)
      end if
    case default
      errmsg = 'Programming error. PCP bound value requested column '&
               &'outside range of ncolbnd (1).'
      call store_error(errmsg)
      call store_error_filename(this%input_fname)
    end select

Here is the call graph for this function:

pcp_cf()

subroutine swfpcpmodule::pcp_cf ( class(swfpcptype)  this )

private

Skip if no precipitation. Otherwise, calculate hcof and rhs

Definition at line 299 of file swf-pcp.f90.

    ! dummy
    class(SwfPcpType) :: this
    ! local
    integer(I4B) :: i
    integer(I4B) :: node
    integer(I4B) :: idcxs
    real(DP) :: qpcp
    real(DP) :: area
    real(DP) :: width_channel
    real(DP) :: top_width
    real(DP) :: dummy
    real(DP), dimension(:), pointer :: reach_length
 
    ! Return if no precipitation
    if (this%nbound == 0) return
 
    ! Set pointer to reach_length for 1d
    reach_length => this%reach_length_pointer()
 
    ! Calculate hcof and rhs for each precipitation entry
    do i = 1, this%nbound
 
      ! Find the node number
      node = this%nodelist(i)
 
      ! cycle if nonexistent bound
      if (node <= 0) then
        this%hcof(i) = dzero
        this%rhs(i) = dzero
        cycle
      end if
 
      ! Initialize hcof
      this%hcof(i) = dzero
 
      ! Determine the water surface area
      if (this%dis%is_2d()) then
        ! this is for overland flow case
        area = this%dis%get_area(node)
      else if (this%dis%is_1d()) then
        ! this is for channel case
        idcxs = this%dfw%idcxs(node)
        call this%dis%get_flow_width(node, node, 0, width_channel, &
                                     dummy)
        top_width = this%cxs%get_maximum_top_width(idcxs, width_channel)
        area = reach_length(node) * top_width
      end if
 
      ! calculate volumetric precipitation flow in L^3/T
      qpcp = this%precipitation(i) * area
 
      ! multiplier
      if (this%iauxmultcol > 0) then
        qpcp = qpcp * this%auxvar(this%iauxmultcol, i)
      end if
 
      ! rhs contribution
      this%rhs(i) = -qpcp
 
      ! zero out contribution if cell is inactive or constant head
      if (this%ibound(node) <= 0) then
        this%rhs(i) = dzero
        cycle
      end if
 
    end do

pcp_ck()

subroutine swfpcpmodule::pcp_ck

(

class(swfpcptype), intent(inout)

this

)

Definition at line 268 of file swf-pcp.f90.

    ! dummy
    class(SwfPcpType), intent(inout) :: this
    ! local
    character(len=30) :: nodestr
    integer(I4B) :: i, nr
    character(len=*), parameter :: fmterr = &
      &"('Specified stress ',i0, &
      &' precipitation (',g0,') is less than zero for cell', a)"
 
    ! Ensure precipitation rates are positive
    do i = 1, this%nbound
      nr = this%nodelist(i)
      if (nr <= 0) cycle
      if (this%precipitation(i) < dzero) then
        call this%dis%noder_to_string(nr, nodestr)
        write (errmsg, fmt=fmterr) i, this%precipitation(i), trim(nodestr)
        call store_error(errmsg)
      end if
    end do
 
    ! write summary of 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:

pcp_create()

subroutine, public swfpcpmodule::pcp_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(swfdfwtype), intent(in), pointer	dfw,
		type(swfcxstype), intent(in), pointer	cxs
	)

Parameters

	packobj	pointer to default package type
[in]	id	package id
[in]	ibcnum	boundary condition number
[in]	inunit	unit number of CDB 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]	dfw	the pointer to the dfw package
[in]	cxs	the pointer to the cxs package

Definition at line 71 of file swf-pcp.f90.

    ! dummy
    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 CDB 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(SwfDfwType), pointer, intent(in) :: dfw !< the pointer to the dfw package
    type(SwfCxsType), pointer, intent(in) :: cxs !< the pointer to the cxs package
    ! local
    type(SwfPcpType), pointer :: pcpobj
 
    ! allocate precipitation object and scalar variables
    allocate (pcpobj)
    packobj => pcpobj
 
    ! create name and memory path
    call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath)
    packobj%text = text
 
    ! allocate scalars
    call pcpobj%pcp_allocate_scalars()
 
    ! initialize package
    call packobj%pack_initialize()
 
    packobj%inunit = inunit
    packobj%iout = iout
    packobj%id = id
    packobj%ibcnum = ibcnum
    packobj%ncolbnd = 1
    packobj%ictMemPath = create_mem_path(namemodel, 'DFW')
 
    ! store pointer to dis
    pcpobj%dis => dis
 
    ! store pointer to dfw
    pcpobj%dfw => dfw
 
    ! store pointer to cxs
    pcpobj%cxs => cxs

Here is the call graph for this function:

Here is the caller graph for this function:

pcp_da()

subroutine swfpcpmodule::pcp_da ( class(swfpcptype)  this )

private

Definition at line 392 of file swf-pcp.f90.

    ! modules
    use memorymanagermodule, only: mem_deallocate
    ! dummy
    class(SwfPcpType) :: this
 
    ! Deallocate parent package
    call this%BndExtType%bnd_da()
 
    ! scalars
    deallocate (this%read_as_arrays)
 
    ! arrays
    call mem_deallocate(this%precipitation, 'PRECIPITATION', this%memoryPath)
 
    ! pointers
    nullify (this%dis)
    nullify (this%dfw)
    nullify (this%cxs)

pcp_define_listlabel()

subroutine swfpcpmodule::pcp_define_listlabel

(

class(swfpcptype), intent(inout)

this

)

Definition at line 416 of file swf-pcp.f90.

    ! dummy
    class(SwfPcpType), 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), 'PRECIPITATION'
!    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

pcp_df_obs()

subroutine swfpcpmodule::pcp_df_obs ( class(swfpcptype)  this )

private

Store observation type supported by PCP package. Overrides BndTypebnd_df_obs

Definition at line 479 of file swf-pcp.f90.

    implicit none
    ! dummy
    class(SwfPcpType) :: this
    ! local
    integer(I4B) :: indx
 
    call this%obs%StoreObsType('pcp', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => defaultobsidprocessor

Here is the call graph for this function:

pcp_fc()

subroutine swfpcpmodule::pcp_fc ( class(swfpcptype)  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 370 of file swf-pcp.f90.

    ! dummy
    class(SwfPcpType) :: 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
      rhs(n) = rhs(n) + this%rhs(i)
      ipos = ia(n)
      call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i))
    end do

pcp_obs_supported()

logical function swfpcpmodule::pcp_obs_supported ( class(swfpcptype)  this )

private

Definition at line 467 of file swf-pcp.f90.

    implicit none
    ! dummy
    class(SwfPcpType) :: this
    pcp_obs_supported = .true.

pcp_read_initial_attr()

subroutine swfpcpmodule::pcp_read_initial_attr ( class(swfpcptype), intent(inout)  this )

private

Definition at line 236 of file swf-pcp.f90.

    ! dummy
    class(SwfPcpType), intent(inout) :: this
 
    if (this%read_as_arrays) then
      call this%default_nodelist()
    end if

pcp_rp()

subroutine swfpcpmodule::pcp_rp ( class(swfpcptype), intent(inout)  this )

private

Read itmp and read new boundaries if itmp > 0

Definition at line 249 of file swf-pcp.f90.

    ! modules
    use tdismodule, only: kper
    implicit none
    ! dummy
    class(SwfPcpType), intent(inout) :: this
 
    if (this%iper /= kper) return
 
    if (this%read_as_arrays) then
      ! no need to do anything because this%precipitation points directly to
      ! the input context precipitation, which is automatically updated by idm
    else
      call this%BndExtType%bnd_rp()
    end if

pcp_source_dimensions()

subroutine swfpcpmodule::pcp_source_dimensions ( class(swfpcptype), intent(inout)  this )

private

Definition at line 204 of file swf-pcp.f90.

    ! dummy
    class(SwfPcpType), intent(inout) :: this
 
    if (this%read_as_arrays) then
 
      ! Set maxbound to the number of cells per layer, which is simply
      ! nrow * ncol for a dis2d grid, and nodesuser for disv2d and disv1d
      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()

Here is the call graph for this function:

pcp_source_options()

subroutine swfpcpmodule::pcp_source_options

(

class(swfpcptype), intent(inout)

this

)

Definition at line 158 of file swf-pcp.f90.

    ! modules
    use memorymanagerextmodule, only: mem_set_value
    implicit none
    ! dummy
    class(SwfPcpType), intent(inout) :: this
    ! local
    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%read_as_arrays, 'READASARRAYS', this%input_mempath, &
                       found_readasarrays)
 
    ! log pcp params
    call this%log_pcp_options(found_readasarrays)

reach_length_pointer()

real(dp) function, dimension(:), pointer swfpcpmodule::reach_length_pointer

(

class(swfpcptype)

this

)

Parameters

this	this instance

Definition at line 517 of file swf-pcp.f90.

    ! dummy
    class(SwfPcpType) :: this !< this instance
    ! return
    real(DP), dimension(:), pointer :: ptr
    ! local
    class(DisBaseType), pointer :: dis
 
    ptr => null()
    dis => this%dis
    select type (dis)
    type is (disv1dtype)
      ptr => dis%length
    end select
 

Variable Documentation

ftype

character(len=lenftype) swfpcpmodule::ftype = 'PCP'

private

Definition at line 32 of file swf-pcp.f90.

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

text

character(len=lenpackagename) swfpcpmodule::text = ' PCP'

private

Definition at line 33 of file swf-pcp.f90.

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