mvrmodule Module Reference

This module contains the MvrModule Module. More...

Data Types
type	mvrtype
	Derived type for MvrType. More...

Functions/Subroutines
subroutine	set_values (this, mname1, pname1, id1, mname2, pname2, id2, imvrtype, value)
	@ brief Set values from input data More...
subroutine	prepare (this, inunit, pckMemPaths, pakmovers)
	@ brief Prepare object More...
subroutine	echo (this, iout)
	@ brief Echo data to list file More...
subroutine	advance (this)
	@ brief Advance More...
subroutine	update_provider (this)
	@ brief Formulate coefficients More...
subroutine	update_receiver (this)
	@ brief Formulate coefficients More...
real(dp) function	qrcalc (this, qa, qta)
	@ brief Flow to receiver More...
subroutine	writeflow (this, iout)
	@ brief Write flow More...

Variables
character(len=12), dimension(4)	mvrtypes = [character(len=12) :: 'FACTOR', 'EXCESS', 'THRESHOLD', 'UPTO']

Detailed Description

This module contains the code for the low-level MvrType object.

Function/Subroutine Documentation

advance()

subroutine mvrmodule::advance ( class(mvrtype)  this )

private

Advance mover object. Does nothing now.

Definition at line 219 of file Mover.f90.

    ! -- modules
    ! -- dummy
    class(MvrType) :: this
    ! -- local
    !
    ! -- return
    return

echo()

subroutine mvrmodule::echo	(	class(mvrtype)	this,
		integer(i4b), intent(in)	iout
	)

Write mover values to output file.

Parameters

	this	MvrType
[in]	iout	unit number for output file

Definition at line 196 of file Mover.f90.

    ! -- modules
    ! -- dummy
    class(MvrType) :: this !< MvrType
    integer(I4B), intent(in) :: iout !< unit number for output file
    ! -- local
    !
    write (iout, '(4x, a, a, a, i0)') 'FROM PACKAGE: ', trim(this%mem_path_src), &
      ' FROM ID: ', this%iRchNrSrc
    write (iout, '(4x, a, a, a, i0)') 'TO PACKAGE: ', trim(this%mem_path_tgt), &
      ' TO ID: ', this%iRchNrTgt
    write (iout, '(4x, a, a, a, 1pg15.6,/)') 'MOVER TYPE: ', &
      trim(mvrtypes(this%imvrtype)), ' ', this%value
    !
    ! -- return
    return

prepare()

subroutine mvrmodule::prepare	(	class(mvrtype)	this,
		integer(i4b), intent(in)	inunit,
		character(len=lenmempath), dimension(:), pointer, contiguous	pckMemPaths,
		type(packagemovertype), dimension(:), pointer, contiguous	pakmovers
	)

Set values and pointers for mover object. pckMemPaths is an array of strings which are the memory paths for those packages. They are composed of model names and package names. The mover entries must be in pckMemPaths, or this routine will terminate with an error.

Parameters

	this	MvrType object
[in]	inunit	input file unit number
	pckmempaths	array of strings
	pakmovers	Array of package mover objects

Definition at line 96 of file Mover.f90.

    ! -- modules
    use simmodule, only: store_error, store_error_unit, count_errors
    ! -- dummy
    class(MvrType) :: this !< MvrType object
    integer(I4B), intent(in) :: inunit !< input file unit number
    character(len=LENMEMPATH), &
      dimension(:), pointer, contiguous :: pckMemPaths !< array of strings
    type(PackageMoverType), dimension(:), pointer, contiguous :: pakmovers !< Array of package mover objects
    ! -- local
    real(DP), dimension(:), pointer, contiguous :: temp_ptr => null()
    logical :: found
    integer(I4B) :: i
    integer(I4B) :: ipakloc1, ipakloc2
    !
    ! -- Check to make sure provider and receiver are not the same
    if (this%mem_path_src == this%mem_path_tgt .and. &
        this%iRchNrSrc == this%iRchNrTgt) then
      call store_error('Provider and receiver are the same: '// &
                       trim(this%mem_path_src)//' : '//trim(this%mem_path_tgt))
      call store_error_unit(inunit)
    end if
    !
    ! -- Check to make sure pname1 and pname2 are both listed in pckMemPaths
    !    pname1 is the provider package; pname2 is the receiver package
    found = .false.
    ipakloc1 = 0
    do i = 1, size(pckmempaths)
      if (this%mem_path_src == pckmempaths(i)) then
        found = .true.
        ipakloc1 = i
        exit
      end if
    end do
    if (.not. found) then
      call store_error('Mover capability not activated in '//this%mem_path_src)
      call store_error('Add "MOVER" keyword to package options block.')
    end if
    found = .false.
    ipakloc2 = 0
    do i = 1, size(pckmempaths)
      if (this%mem_path_tgt == pckmempaths(i)) then
        found = .true.
        ipakloc2 = i
        exit
      end if
    end do
    if (.not. found) then
      call store_error('Mover capability not activated in '//this%mem_path_tgt)
      call store_error('Add "MOVER" keyword to package options block.')
    end if
    if (count_errors() > 0) then
      call store_error_unit(inunit)
    end if
 
    if (this%is_provider_active) then
      !
      ! -- Set pointer to QTOMVR array in the provider boundary package
      temp_ptr => pakmovers(ipakloc1)%qtomvr
      if (this%iRchNrSrc < 1 .or. this%iRchNrSrc > size(temp_ptr)) then
        call store_error('Provider ID < 1 or greater than package size ')
        write (errmsg, '(a,i0,a,i0)') 'Provider ID = ', this%iRchNrSrc, &
          '; Package size = ', size(temp_ptr)
        call store_error(trim(errmsg))
        call store_error_unit(inunit)
      end if
      this%qtomvr_ptr => temp_ptr(this%iRchNrSrc)
      !
      ! -- Set pointer to QFORMVR array in the provider boundary package
      temp_ptr => pakmovers(ipakloc1)%qformvr
      this%qformvr_ptr => temp_ptr(this%iRchNrSrc)
      !
      ! -- Set pointer to QTFORMVR array in the provider boundary package
      temp_ptr => pakmovers(ipakloc1)%qtformvr
      this%qtformvr_ptr => temp_ptr(this%iRchNrSrc)
    end if
 
    if (this%is_receiver_active) then
      !
      ! -- Set pointer to QFROMMVR array in the receiver boundary package
      temp_ptr => pakmovers(ipakloc2)%qfrommvr
      if (this%iRchNrTgt < 1 .or. this%iRchNrTgt > size(temp_ptr)) then
        call store_error('Receiver ID < 1 or greater than package size ')
        write (errmsg, '(a,i0,a,i0)') 'Receiver ID = ', this%iRchNrTgt, &
          '; package size = ', size(temp_ptr)
        call store_error(trim(errmsg))
        call store_error_unit(inunit)
      end if
      this%qfrommvr_ptr => temp_ptr(this%iRchNrTgt)
    end if
    !
    ! -- return
    return

Here is the call graph for this function:

qrcalc()

real(dp) function mvrmodule::qrcalc ( class(mvrtype)  this, real(dp), intent(in)  qa, real(dp), intent(in)  qta  )

private

Calculate the rate of water provided to receiver.

Parameters

	this	MvrType
[in]	qa	actual flow
[in]	qta	total available flow

Definition at line 285 of file Mover.f90.

    ! -- modules
    ! -- return
    real(DP) :: qr
    ! -- dummy
    class(MvrType) :: this !< MvrType
    real(DP), intent(in) :: qa !< actual flow
    real(DP), intent(in) :: qta !< total available flow
    ! -- local
    ! -- Using the mover rules, calculate how much of the available water will
    !    go to the receiver.
    qr = dzero
    ! -- Calculate qr
    select case (this%imvrtype)
    case (1)
      ! -- FACTOR uses total available to make calculation, and then
      !    limits qr by consumed available
      if (qta > dzero) qr = qta * this%value
      qr = min(qr, qa)
    case (2)
      ! -- EXCESS
      if (qa > this%value) then
        qr = qa - this%value
      else
        qr = dzero
      end if
    case (3)
      ! -- THRESHOLD
      if (this%value > qa) then
        qr = dzero
      else
        qr = this%value
      end if
    case (4)
      ! -- UPTO
      if (qa > this%value) then
        qr = this%value
      else
        qr = qa
      end if
    end select
    !
    ! -- return
    return

set_values()

subroutine mvrmodule::set_values ( class(mvrtype)  this, character(len=*), intent(in)  mname1, character(len=*), intent(in)  pname1, integer(i4b), intent(in), target  id1, character(len=*), intent(in)  mname2, character(len=*), intent(in)  pname2, integer(i4b), intent(in), target  id2, integer(i4b), intent(in), target  imvrtype, real(dp), intent(in), target  value  )

private

Set values and pointers for mover object.

Definition at line 63 of file Mover.f90.

    use memoryhelpermodule, only: create_mem_path
    class(MvrType) :: this
    character(len=*), intent(in) :: mname1
    character(len=*), intent(in) :: pname1
    integer(I4B), intent(in), target :: id1
    character(len=*), intent(in) :: mname2
    character(len=*), intent(in) :: pname2
    integer(I4B), intent(in), target :: id2
    integer(I4B), intent(in), target :: imvrtype
    real(DP), intent(in), target :: value
 
    this%mem_path_src = create_mem_path(mname1, pname1)
    this%iRchNrSrc => id1
    this%mem_path_tgt = create_mem_path(mname2, pname2)
    this%iRchNrTgt => id2
    this%imvrtype => imvrtype
    this%value => value
 
    ! to be set later
    this%iRchNrSrcMapped = -1
 
    return

Here is the call graph for this function:

update_provider()

subroutine mvrmodule::update_provider ( class(mvrtype)  this )

private

Make mover calculations for provider.

Parameters

this

MvrType

Definition at line 234 of file Mover.f90.

    ! -- modules
    ! -- dummy
    class(MvrType) :: this !< MvrType
    ! -- local
    real(DP) :: qavailable, qtanew, qpactual
    !
    ! -- Set qa and this%qavailable equal to available water in package (qtomvr)
    qavailable = this%qformvr_ptr
    qtanew = this%qtformvr_ptr
    this%qavailable = qavailable
    !
    ! -- Using the mover rules, calculate how much of the available water will
    !    be provided from the mover to the receiver.
    qpactual = this%qrcalc(qavailable, qtanew)
    !
    ! -- Store qpactual
    this%qpactual = qpactual
    !
    ! -- Add the calculated qpactual term directly into the provider package
    !    qtomvr array.
    this%qtomvr_ptr = this%qtomvr_ptr + qpactual
    !
    ! -- Reduce the amount of water that is available in the provider package
    !    qformvr array.
    this%qformvr_ptr = this%qformvr_ptr - qpactual
    !
    ! -- return
    return

update_receiver()

subroutine mvrmodule::update_receiver ( class(mvrtype)  this )

private

Make mover calculations for receiver.

Parameters

this

MvrType

Definition at line 270 of file Mover.f90.

    class(MvrType) :: this !< MvrType
    ! -- Add the calculated qpactual term directly into the receiver package
    !    qfrommvr array.
    this%qfrommvr_ptr = this%qfrommvr_ptr + this%qpactual
    !
    ! -- return
    return

writeflow()

subroutine mvrmodule::writeflow ( class(mvrtype)  this, integer(i4b), intent(in)  iout  )

private

Write a line of output for this mover object.

Parameters

	this	MvrType
[in]	iout	output file unit number

Definition at line 336 of file Mover.f90.

    ! -- modules
    ! -- dummy
    class(MvrType) :: this !< MvrType
    integer(I4B), intent(in) :: iout !< output file unit number
    ! -- local
    character(len=*), parameter :: fmt = &
      "(1x, a, ' ID ', i0, ' AVAILABLE ', 1(1pg15.6), &
      &' PROVIDED ', 1(1pg15.6), ' TO ', a, ' ID ', i0)"
    !
    write (iout, fmt) trim(this%mem_path_src), this%iRchNrSrc, this%qavailable, &
      this%qpactual, trim(this%mem_path_tgt), this%iRchNrTgt
    !
    ! -- return
    return

Variable Documentation

mvrtypes

character(len=12), dimension(4) mvrmodule::mvrtypes = [character(len=12) :: 'FACTOR', 'EXCESS', 'THRESHOLD', 'UPTO']

private

Definition at line 20 of file Mover.f90.

  character(len=12), dimension(4) :: mvrtypes = &
    &[character(len=12) :: 'FACTOR', 'EXCESS', 'THRESHOLD', 'UPTO']