swfgwfexchangemodule Module Reference

This module contains the SwfGwfExchangeModule Module. More...

Data Types
type	swfgwfexchangetype

Functions/Subroutines
subroutine	initialize (this, filename, name, swf_ftype, id, m1_id, m2_id, input_mempath)
	@ brief Initialize SWF GWF exchange More...
subroutine	swf_gwf_ac (this, sparse)
	@ brief Add connections More...
subroutine	swf_gwf_mc (this, matrix_sln)
	@ brief Map connections More...
subroutine	swf_gwf_fc (this, kiter, matrix_sln, rhs_sln, inwtflag)
	@ brief Fill coefficients More...
subroutine	swf_gwf_cq (this, icnvg, isuppress_output, isolnid)
	@ brief Calculate flow More...
subroutine	swf_gwf_da (this)
	@ brief Deallocate More...
subroutine	allocate_scalars (this)
	@ brief Allocate scalars More...
subroutine	allocate_arrays (this)
	Allocate array data, using the number of connected nodes. More...
integer(i4b) function	noder (this, model, cellid, iout)
character(len=20) function	cellstr (this, model, cellid, iout)
subroutine	swf_gwf_calc_simvals (this)
	Calculate flow rates for the exchanges and store them in a member array. More...
real(dp) function	qcalc (this, iexg, hswf, hgwf)
	@ brief Calculate flow More...
real(dp) function	get_cond (this, iexg, hswf, hgwf)
	@ brief Calculate conductance More...
real(dp) function	get_wetted_perimeter (this, nodeswf, depth)
	@ brief Get wetted perimeter for swf channel model More...
subroutine	swf_gwf_add_to_flowja (this)
	Add exchange flow to each model flowja diagonal position so that residual is calculated correctly. More...
subroutine	swf_gwf_bd (this, icnvg, isuppress_output, isolnid)
	@ brief Budget More...
subroutine	swf_gwf_chd_bd (this)
	@ brief swf-gwf-chd-bd More...
subroutine	swf_gwf_bdsav (this)
	@ brief Budget save More...
subroutine	swf_gwf_ot (this)
	@ brief Output More...
subroutine	swf_gwf_save_simvals (this)
	@ brief Save simulated flow observations More...
logical(lgp) function	swf_gwf_connects_model (this, model)
	Should return true when the exchange should be added to the solution where the model resides. More...

Detailed Description

This module contains the code for connecting a SWF model with a GWF model. The SwfGwfExchangeType class is a parent to the CHF and OLF models and should not be used directly.

Function/Subroutine Documentation

allocate_arrays()

subroutine swfgwfexchangemodule::allocate_arrays ( class(swfgwfexchangetype)  this )

private

Parameters

nexg
this	instance of exchange object

Definition at line 390 of file exg-swfgwf.f90.

    ! -- dummy
    class(SwfGwfExchangeType) :: this !< instance of exchange object
    !
    call mem_allocate(this%nodeswf, this%nexg, 'NODEM1', this%memoryPath)
    call mem_allocate(this%nodegwf, this%nexg, 'NODEM2', this%memoryPath)
    call mem_allocate(this%bedleak, this%nexg, 'BEDLEAK', this%memoryPath)
    call mem_allocate(this%cfact, this%nexg, 'CFACT', this%memoryPath)
    call mem_allocate(this%idxglo, this%nexg, 'IDXGLO', this%memoryPath)
    call mem_allocate(this%idxsymglo, this%nexg, 'IDXSYMGLO', this%memoryPath)
    call mem_allocate(this%simvals, this%nexg, 'SIMVALS', this%memoryPath)

allocate_scalars()

subroutine swfgwfexchangemodule::allocate_scalars

(

class(swfgwfexchangetype)

this

)

Allocate scalar variables

Parameters

this	SwfGwfExchangeType

Definition at line 364 of file exg-swfgwf.f90.

    ! -- modules
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    !
    allocate (this%swf_ftype)
    this%swf_ftype = ''
    allocate (this%filename)
    this%filename = ''
    !
    call mem_allocate(this%ipr_input, 'IPR_INPUT', this%memoryPath)
    call mem_allocate(this%ipr_flow, 'IPR_FLOW', this%memoryPath)
    call mem_allocate(this%ifixedcond, 'IFIXEDCOND', this%memoryPath)
    call mem_allocate(this%nexg, 'NEXG', this%memoryPath)
    call mem_allocate(this%inobs, 'INOBS', this%memoryPath)
    !
    this%ipr_input = 0
    this%ipr_flow = 0
    this%ifixedcond = 0
    this%nexg = 0
    this%inobs = 0

cellstr()

character(len=20) function swfgwfexchangemodule::cellstr	(	class(swfgwfexchangetype)	this,
		class(numericalmodeltype), intent(in), pointer	model,
		integer(i4b), dimension(:), intent(in)	cellid,
		integer(i4b), intent(in)	iout
	)

Parameters

	this	instance of exchange object
[in]	iout	the output file unit

Definition at line 432 of file exg-swfgwf.f90.

    ! -- modules
    ! -- dummy
    class(SwfGwfExchangeType) :: this !< instance of exchange object
    class(NumericalModelType), pointer, intent(in) :: model
    integer(I4B), dimension(:), intent(in) :: cellid
    integer(I4B), intent(in) :: iout !< the output file unit
    character(len=20) :: cellstr
    character(len=*), parameter :: fmtndim1 = &
                                   "('(',i0,')')"
    character(len=*), parameter :: fmtndim2 = &
                                   "('(',i0,',',i0,')')"
    character(len=*), parameter :: fmtndim3 = &
                                   "('(',i0,',',i0,',',i0,')')"
    !
    cellstr = ''
    !
    select case (model%dis%ndim)
    case (1)
      write (cellstr, fmtndim1) cellid(1)
    case (2)
      write (cellstr, fmtndim2) cellid(1), cellid(2)
    case (3)
      write (cellstr, fmtndim3) cellid(1), cellid(2), cellid(3)
    case default
    end select

get_cond()

real(dp) function swfgwfexchangemodule::get_cond ( class(swfgwfexchangetype)  this, integer(i4b), intent(in)  iexg, real(dp), intent(in)  hswf, real(dp), intent(in)  hgwf  )

private

Calculate the conductance between the surface water cell and the underlying groundwater cell.

Parameters

	this	SwfGwfExchangeType
[in]	iexg	exchange number
[in]	hswf	surface water model head
[in]	hgwf	groundwater model head

Definition at line 518 of file exg-swfgwf.f90.

    ! module
    use smoothingmodule, only: squadratic
    ! return
    real(DP) :: get_cond
    ! dummy
    class(SwfGwfExchangeType) :: this !< SwfGwfExchangeType
    integer(I4B), intent(in) :: iexg !< exchange number
    real(DP), intent(in) :: hswf !< surface water model head
    real(DP), intent(in) :: hgwf !< groundwater model head
    ! local
    integer(I4B) :: nodeswf
    real(DP) :: range = 1.d-6
    real(DP) :: depth_ups
    real(DP) :: dydx
    real(DP) :: smooth_factor
    real(DP) :: area
    real(DP) :: perimeter
 
    ! -- Calculate or return conductance
    area = this%cfact(iexg)
    if (this%ifixedcond == 1) then
      get_cond = this%bedleak(iexg) * area
      return
    end if
 
    ! Calculate smooth factor between zero, when the upstream-weighted
    ! depth is zero, and 1.0, when the upstream weighted depth is
    ! greater than or equal to the smoothening depth
    nodeswf = this%nodeswf(iexg)
    depth_ups = max(hswf, hgwf) - this%swfmodel%dis%bot(nodeswf)
    call squadratic(depth_ups, range, dydx, smooth_factor)
 
    ! For channel model calculate the interaction area as product
    ! of cfact and upstream-wetted perimeter
    if (this%swfmodel%dfw%is2d == 0) then
      perimeter = this%get_wetted_perimeter(nodeswf, depth_ups)
      area = area * perimeter
    end if
 
    ! Calculate conductance
    get_cond = smooth_factor * this%bedleak(iexg) * area

Here is the call graph for this function:

get_wetted_perimeter()

real(dp) function swfgwfexchangemodule::get_wetted_perimeter	(	class(swfgwfexchangetype)	this,
		integer(i4b), intent(in)	nodeswf,
		real(dp), intent(in)	depth
	)

Parameters

	this	SwfGwfExchangeType
[in]	nodeswf	node number for surface water model cell
[in]	depth	water depth in surface water model cell

Definition at line 564 of file exg-swfgwf.f90.

    ! return
    real(DP) :: wp
    ! dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    integer(I4B), intent(in) :: nodeswf !< node number for surface water model cell
    real(DP), intent(in) :: depth !< water depth in surface water model cell
    ! local
    integer(I4B) :: idcxs
    real(DP) :: width
    real(DP) :: dummy
 
    idcxs = this%swfmodel%dfw%idcxs(nodeswf)
    call this%swfmodel%dis%get_flow_width(nodeswf, nodeswf, 0, width, dummy)
    wp = this%swfmodel%cxs%get_wetted_perimeter(idcxs, width, depth)
 

initialize()

subroutine swfgwfexchangemodule::initialize ( class(swfgwfexchangetype)  this, character(len=*), intent(in)  filename, character(len=*)  name, character(len=*)  swf_ftype, integer(i4b), intent(in)  id, integer(i4b), intent(in)  m1_id, integer(i4b), intent(in)  m2_id, character(len=*), intent(in)  input_mempath  )

private

Parameters

	this	SwfGwfExchangeType
[in]	filename	filename for reading
	name	exchange name
	swf_ftype	type of swf model, CHF or OLF
[in]	id	id for the exchange
[in]	m1_id	id for model 1
[in]	m2_id	id for model 2

Definition at line 96 of file exg-swfgwf.f90.

    ! dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    character(len=*), intent(in) :: filename !< filename for reading
    character(len=*) :: name !< exchange name
    character(len=*) :: swf_ftype !< type of swf model, CHF or OLF
    integer(I4B), intent(in) :: id !< id for the exchange
    integer(I4B), intent(in) :: m1_id !< id for model 1
    integer(I4B), intent(in) :: m2_id !< id for model 2
    character(len=*), intent(in) :: input_mempath
    ! -- local
    class(BaseModelType), pointer :: mb
    integer(I4B) :: m1_index, m2_index
 
    ! Assign id and name
    this%id = id
    this%name = name
    this%memoryPath = create_mem_path(this%name)
    this%input_mempath = input_mempath
 
    ! allocate scalars and set defaults
    call this%allocate_scalars()
    this%filename = filename
    this%swf_ftype = swf_ftype
    this%typename = trim(swf_ftype)//'-GWF'
 
    ! set swfmodel
    m1_index = model_loc_idx(m1_id)
    if (m1_index > 0) then
      mb => getbasemodelfromlist(basemodellist, m1_index)
      select type (mb)
      class is (swfmodeltype)
        this%model1 => mb
        this%swfmodel => mb
      end select
    end if
    ! this%v_model1 => get_virtual_model(m1_id)
    ! this%is_datacopy = .not. this%v_model1%is_local
 
    ! set gwfmodel
    m2_index = model_loc_idx(m2_id)
    if (m2_index > 0) then
      mb => getbasemodelfromlist(basemodellist, m2_index)
      select type (mb)
      type is (gwfmodeltype)
        this%model2 => mb
        this%gwfmodel => mb
      end select
    end if
    ! this%v_model2 => get_virtual_model(m2_id)
 
    ! Verify that the surface water model is of the correct type
    if (.not. associated(this%swfmodel) .and. m1_index > 0) then
      write (errmsg, '(7a)') &
        'Problem with ', &
        trim(this%typename), &
        ' exchange ', &
        trim(this%name), &
        '.  Specified ', &
        trim(this%swf_ftype), &
        ' model does not appear to be of the correct type.'
      call store_error(errmsg, terminate=.true.)
    end if
 
    ! Verify that gwf model is of the correct type
    if (.not. associated(this%gwfmodel) .and. m2_index > 0) then
      write (errmsg, '(3a)') 'Problem with SWF-GWF exchange ', &
        trim(this%name), &
        '.  Specified GWF model does not appear to be of the correct type.'
      call store_error(errmsg, terminate=.true.)
    end if
 
    ! Create the obs package
    call obs_cr(this%obs, this%inobs)
 

Here is the call graph for this function:

noder()

integer(i4b) function swfgwfexchangemodule::noder ( class(swfgwfexchangetype)  this, class(numericalmodeltype), intent(in), pointer  model, integer(i4b), dimension(:), intent(in)  cellid, integer(i4b), intent(in)  iout  )

private

Parameters

	this	instance of exchange object
[in]	iout	the output file unit

Definition at line 405 of file exg-swfgwf.f90.

    ! -- modules
    use geomutilmodule, only: get_node
    ! -- dummy
    class(SwfGwfExchangeType) :: this !< instance of exchange object
    class(NumericalModelType), pointer, intent(in) :: model
    integer(I4B), dimension(:), intent(in) :: cellid
    integer(I4B), intent(in) :: iout !< the output file unit
    integer(I4B) :: noder, node
    !
    if (model%dis%ndim == 1) then
      node = cellid(1)
    elseif (model%dis%ndim == 2) then
      node = get_node(cellid(1), 1, cellid(2), &
                      model%dis%mshape(1), 1, &
                      model%dis%mshape(2))
    else
      node = get_node(cellid(1), cellid(2), cellid(3), &
                      model%dis%mshape(1), &
                      model%dis%mshape(2), &
                      model%dis%mshape(3))
    end if
    noder = model%dis%get_nodenumber(node, 0)

Here is the call graph for this function:

qcalc()

real(dp) function swfgwfexchangemodule::qcalc	(	class(swfgwfexchangetype)	this,
		integer(i4b), intent(in)	iexg,
		real(dp), intent(in)	hswf,
		real(dp), intent(in)	hgwf
	)

Calculate the flow for the specified exchange and node numbers. Flow is positive into the surface water model

Parameters

this	SwfGwfExchangeType

Definition at line 496 of file exg-swfgwf.f90.

    ! -- return
    real(DP) :: qcalc
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    integer(I4B), intent(in) :: iexg
    real(DP), intent(in) :: hswf
    real(DP), intent(in) :: hgwf
    ! -- local
    real(DP) :: cond
 
    ! Calculate flow between swf and gwf models; positive into swf
    cond = this%get_cond(iexg, hswf, hgwf)
    qcalc = cond * (hgwf - hswf)
 

swf_gwf_ac()

subroutine swfgwfexchangemodule::swf_gwf_ac ( class(swfgwfexchangetype)  this, type(sparsematrix), intent(inout)  sparse  )

private

Override parent exg_ac so that gnc can add connections here.

Parameters

this	SwfGwfExchangeType

Definition at line 178 of file exg-swfgwf.f90.

    ! -- modules
    use sparsemodule, only: sparsematrix
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    type(sparsematrix), intent(inout) :: sparse
    ! -- local
    integer(I4B) :: n, iglo, jglo
    !
    ! -- add exchange connections
    do n = 1, this%nexg
      iglo = this%nodeswf(n) + this%swfmodel%moffset
      jglo = this%nodegwf(n) + this%gwfmodel%moffset
      call sparse%addconnection(iglo, jglo, 1)
      call sparse%addconnection(jglo, iglo, 1)
    end do

swf_gwf_add_to_flowja()

subroutine swfgwfexchangemodule::swf_gwf_add_to_flowja ( class(swfgwfexchangetype)  this )

private

Parameters

this	SwfGwfExchangeType

Definition at line 585 of file exg-swfgwf.f90.

    ! -- modules
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: n
    integer(I4B) :: idiag
    real(DP) :: flow
    !
    do i = 1, this%nexg
      !
      if (associated(this%swfmodel)) then
        n = this%nodeswf(i)
        if (this%swfmodel%ibound(n) > 0) then
          flow = this%simvals(i)
          idiag = this%swfmodel%ia(n)
          this%swfmodel%flowja(idiag) = this%swfmodel%flowja(idiag) + flow
        end if
      end if
      !
      if (associated(this%gwfmodel)) then
        n = this%nodegwf(i)
        if (this%gwfmodel%ibound(n) > 0) then
          flow = -this%simvals(i)
          idiag = this%gwfmodel%ia(n)
          this%gwfmodel%flowja(idiag) = this%gwfmodel%flowja(idiag) + flow
        end if
      end if
      !
    end do

swf_gwf_bd()

subroutine swfgwfexchangemodule::swf_gwf_bd ( class(swfgwfexchangetype)  this, integer(i4b), intent(inout)  icnvg, integer(i4b), intent(in)  isuppress_output, integer(i4b), intent(in)  isolnid  )

private

Accumulate budget terms

Parameters

this	SwfGwfExchangeType

Definition at line 621 of file exg-swfgwf.f90.

    ! -- modules
    use constantsmodule, only: dzero, lenbudtxt, lenpackagename
    use budgetmodule, only: rate_accumulator
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    integer(I4B), intent(inout) :: icnvg
    integer(I4B), intent(in) :: isuppress_output
    integer(I4B), intent(in) :: isolnid
    ! -- local
    character(len=LENBUDTXT), dimension(1) :: budtxt
    real(DP), dimension(2, 1) :: budterm
    real(DP) :: ratin, ratout
    !
    ! -- initialize
    budtxt(1) = '    FLOW-JA-FACE'
    !
    ! -- Calculate ratin/ratout and pass to model budgets
    call rate_accumulator(this%simvals, ratin, ratout)
    !
    ! -- Add the budget terms to model 1
    if (associated(this%swfmodel)) then
      budterm(1, 1) = ratin
      budterm(2, 1) = ratout
      call this%swfmodel%model_bdentry(budterm, budtxt, this%name)
    end if
    !
    ! -- Add the budget terms to model 2
    if (associated(this%gwfmodel)) then
      budterm(1, 1) = ratout
      budterm(2, 1) = ratin
      call this%gwfmodel%model_bdentry(budterm, budtxt, this%name)
    end if
    !
    ! -- Add any flows from one model into a constant head in another model
    !    as a separate budget term called FLOW-JA-FACE-CHD
    call this%swf_gwf_chd_bd()

Here is the call graph for this function:

swf_gwf_bdsav()

subroutine swfgwfexchangemodule::swf_gwf_bdsav

(

class(swfgwfexchangetype)

this

)

Output individual flows to listing file and binary budget files

Parameters

this	SwfGwfExchangeType

Definition at line 726 of file exg-swfgwf.f90.

    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    ! -- local
    integer(I4B) :: icbcfl, ibudfl
    ! !
    ! ! -- budget for model1
    ! if (associated(this%swfmodel1)) then
    !   call this%swf_gwf_bdsav_model(this%swfmodel1, this%gwfmodel2%name)
    ! end if
    ! !
    ! ! -- budget for model2
    ! if (associated(this%gwfmodel2)) then
    !   call this%swf_gwf_bdsav_model(this%gwfmodel2, this%swfmodel1%name)
    ! end if
    !
    ! -- Set icbcfl, ibudfl to zero so that flows will be printed and
    !    saved, if the options were set in the MVR package
    icbcfl = 1
    ibudfl = 1
    !
    ! -- Calculate and write simulated values for observations
    if (this%inobs /= 0) then
      call this%swf_gwf_save_simvals()
    end if

swf_gwf_calc_simvals()

subroutine swfgwfexchangemodule::swf_gwf_calc_simvals ( class(swfgwfexchangetype)  this )

private

Parameters

this	SwfGwfExchangeType

Definition at line 463 of file exg-swfgwf.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    ! -- local
    integer(I4B) :: iexg
    integer(I4B) :: nodeswf, nodegwf
    integer(I4B) :: ibdn1, ibdn2
    real(DP) :: hswf
    real(DP) :: hgwf
    real(DP) :: rrate
    !
    do iexg = 1, this%nexg
      rrate = dzero
      nodeswf = this%nodeswf(iexg)
      nodegwf = this%nodegwf(iexg)
      ibdn1 = this%swfmodel%ibound(nodeswf)
      ibdn2 = this%gwfmodel%ibound(nodegwf)
      hswf = this%swfmodel%x(nodeswf)
      hgwf = this%gwfmodel%x(nodegwf)
      if (ibdn1 /= 0 .and. ibdn2 /= 0) then
        rrate = this%qcalc(iexg, hswf, hgwf)
      end if
      this%simvals(iexg) = rrate
    end do

swf_gwf_chd_bd()

subroutine swfgwfexchangemodule::swf_gwf_chd_bd

(

class(swfgwfexchangetype)

this

)

Account for flow from an external model into a chd cell

Parameters

this	GwfExchangeType

Definition at line 664 of file exg-swfgwf.f90.

    ! -- modules
    use constantsmodule, only: dzero, lenbudtxt, lenpackagename
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  GwfExchangeType
    ! -- local
    character(len=LENBUDTXT), dimension(1) :: budtxt
    integer(I4B) :: n
    integer(I4B) :: i
    real(DP), dimension(2, 1) :: budterm
    real(DP) :: ratin, ratout
    real(DP) :: q
    !
    ! -- initialize
    budtxt(1) = 'FLOW-JA-FACE-CHD'
    !
    ! -- Add the constant-head budget terms for flow from model 2 into model 1
    if (associated(this%swfmodel)) then
      ratin = dzero
      ratout = dzero
      do i = 1, this%nexg
        n = this%nodeswf(i)
        if (this%swfmodel%ibound(n) < 0) then
          q = this%simvals(i)
          if (q > dzero) then
            ratout = ratout + q
          else
            ratin = ratin - q
          end if
        end if
      end do
      budterm(1, 1) = ratin
      budterm(2, 1) = ratout
      call this%swfmodel%model_bdentry(budterm, budtxt, this%name)
    end if
    !
    ! -- Add the constant-head budget terms for flow from model 1 into model 2
    if (associated(this%gwfmodel)) then
      ratin = dzero
      ratout = dzero
      do i = 1, this%nexg
        n = this%nodegwf(i)
        if (this%gwfmodel%ibound(n) < 0) then
          ! -- flip flow sign as flow is relative to model 1
          q = -this%simvals(i)
          if (q > dzero) then
            ratout = ratout + q
          else
            ratin = ratin - q
          end if
        end if
      end do
      budterm(1, 1) = ratin
      budterm(2, 1) = ratout
      call this%gwfmodel%model_bdentry(budterm, budtxt, this%name)
    end if

swf_gwf_connects_model()

logical(lgp) function swfgwfexchangemodule::swf_gwf_connects_model	(	class(swfgwfexchangetype)	this,
		class(basemodeltype), intent(in), pointer	model
	)

Parameters

	this	the instance of the exchange
[in]	model	the model to which the exchange might hold a connection

Returns

true, when connected

Definition at line 1006 of file exg-swfgwf.f90.

    ! -- dummy
    class(SwfGwfExchangeType) :: this !< the instance of the exchange
    class(BaseModelType), pointer, intent(in) :: model !< the model to which the exchange might hold a connection
    ! -- return
    logical(LGP) :: is_connected !< true, when connected
    !
    is_connected = .false.
    select type (model)
    class is (gwfmodeltype)
      if (associated(this%gwfmodel, model)) then
        is_connected = .true.
      end if
    class is (swfmodeltype)
      if (associated(this%swfmodel, model)) then
        is_connected = .true.
      end if
    end select

swf_gwf_cq()

subroutine swfgwfexchangemodule::swf_gwf_cq	(	class(swfgwfexchangetype)	this,
		integer(i4b), intent(inout)	icnvg,
		integer(i4b), intent(in)	isuppress_output,
		integer(i4b), intent(in)	isolnid
	)

Calculate flow between two cells and store in simvals, also set information needed for specific discharge calculation

Parameters

this	SwfGwfExchangeType

Definition at line 309 of file exg-swfgwf.f90.

    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    integer(I4B), intent(inout) :: icnvg
    integer(I4B), intent(in) :: isuppress_output
    integer(I4B), intent(in) :: isolnid
    !
    ! -- calculate flow and store in simvals
    call this%swf_gwf_calc_simvals()
    !
    ! -- set flows to model edges in NPF
    ! todo: do we add these flows for specific discharge calculation?
    !call this%swf_gwf_set_flow_to_npf()
    !
    ! -- add exchange flows to model's flowja diagonal
    call this%swf_gwf_add_to_flowja()

swf_gwf_da()

subroutine swfgwfexchangemodule::swf_gwf_da ( class(swfgwfexchangetype)  this )

private

Deallocate memory associated with this object

Parameters

this	SwfGwfExchangeType

Definition at line 331 of file exg-swfgwf.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    !
    ! -- objects
    call this%obs%obs_da()
    deallocate (this%obs)
    !
    ! -- arrays
    call mem_deallocate(this%nodeswf)
    call mem_deallocate(this%nodegwf)
    call mem_deallocate(this%bedleak)
    call mem_deallocate(this%cfact)
    call mem_deallocate(this%idxglo)
    call mem_deallocate(this%idxsymglo)
    call mem_deallocate(this%simvals)
    !
    ! -- scalars
    deallocate (this%swf_ftype)
    deallocate (this%filename)
    call mem_deallocate(this%ipr_input)
    call mem_deallocate(this%ipr_flow)
    call mem_deallocate(this%ifixedcond)
    call mem_deallocate(this%nexg)
    call mem_deallocate(this%inobs)

swf_gwf_fc()

subroutine swfgwfexchangemodule::swf_gwf_fc	(	class(swfgwfexchangetype)	this,
		integer(i4b), intent(in)	kiter,
		class(matrixbasetype), pointer	matrix_sln,
		real(dp), dimension(:), intent(inout)	rhs_sln,
		integer(i4b), intent(in), optional	inwtflag
	)

Fill conductance into coefficient matrix. For now assume all connections are vertical and no newton correction is needed.

Parameters

this	SwfGwfExchangeType

Definition at line 224 of file exg-swfgwf.f90.

    ! modules
    use mathutilmodule, only: get_perturbation
    ! dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    integer(I4B), intent(in) :: kiter
    class(MatrixBaseType), pointer :: matrix_sln
    real(DP), dimension(:), intent(inout) :: rhs_sln
    integer(I4B), optional, intent(in) :: inwtflag
    ! -- local
    integer(I4B) :: iexg
    integer(I4B) :: nodeswf
    integer(I4B) :: nodegwf
    integer(I4B) :: nodeswf_sln
    integer(I4B) :: nodegwf_sln
    integer(I4B) :: ibdn1
    integer(I4B) :: ibdn2
    real(DP) :: hswf
    real(DP) :: hgwf
    real(DP) :: qnm
    real(DP) :: qeps
    real(DP) :: eps
    real(DP) :: derv
 
    ! Fill terms into solution matrix and rhs vector
    do iexg = 1, this%nexg
 
      nodeswf = this%nodeswf(iexg)
      nodegwf = this%nodegwf(iexg)
      nodeswf_sln = this%nodeswf(iexg) + this%swfmodel%moffset
      nodegwf_sln = this%nodegwf(iexg) + this%gwfmodel%moffset
      ibdn1 = this%swfmodel%ibound(nodeswf)
      ibdn2 = this%gwfmodel%ibound(nodegwf)
      hswf = this%swfmodel%x(nodeswf)
      hgwf = this%gwfmodel%x(nodegwf)
 
      ! First add these terms to the row for the surface water model
 
      ! Fill the qnm term on the right-hand side
      qnm = this%qcalc(iexg, hswf, hgwf)
      rhs_sln(nodeswf_sln) = rhs_sln(nodeswf_sln) - qnm
 
      ! Derivative calculation and fill of n terms
      eps = get_perturbation(hswf)
      qeps = this%qcalc(iexg, hswf + eps, hgwf)
      derv = (qeps - qnm) / eps
      call matrix_sln%add_diag_value(nodeswf_sln, derv)
      rhs_sln(nodeswf_sln) = rhs_sln(nodeswf_sln) + derv * hswf
 
      ! Derivative calculation and fill of m terms
      eps = get_perturbation(hgwf)
      qeps = this%qcalc(iexg, hswf, hgwf + eps)
      derv = (qeps - qnm) / eps
      call matrix_sln%add_value_pos(this%idxglo(iexg), derv)
      rhs_sln(nodeswf_sln) = rhs_sln(nodeswf_sln) + derv * hgwf
 
      ! now add these terms to the row for the groundwater model
 
      ! Fill the qnm term on the right-hand side
      qnm = -this%qcalc(iexg, hswf, hgwf)
      rhs_sln(nodegwf_sln) = rhs_sln(nodegwf_sln) - qnm
 
      ! Derivative calculation and fill of n terms
      eps = get_perturbation(hgwf)
      qeps = -this%qcalc(iexg, hswf, hgwf + eps)
      derv = (qeps - qnm) / eps
      call matrix_sln%add_diag_value(nodegwf_sln, derv)
      rhs_sln(nodegwf_sln) = rhs_sln(nodegwf_sln) + derv * hgwf
 
      ! Derivative calculation and fill of m terms
      eps = get_perturbation(hswf)
      qeps = -this%qcalc(iexg, hswf + eps, hgwf)
      derv = (qeps - qnm) / eps
      call matrix_sln%add_value_pos(this%idxsymglo(iexg), derv)
      rhs_sln(nodegwf_sln) = rhs_sln(nodegwf_sln) + derv * hswf
 
    end do
 

Here is the call graph for this function:

swf_gwf_mc()

subroutine swfgwfexchangemodule::swf_gwf_mc	(	class(swfgwfexchangetype)	this,
		class(matrixbasetype), pointer	matrix_sln
	)

Map the connections in the global matrix

Parameters

this	SwfGwfExchangeType
matrix_sln	the system matrix

Definition at line 200 of file exg-swfgwf.f90.

    ! -- modules
    use sparsemodule, only: sparsematrix
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    class(MatrixBaseType), pointer :: matrix_sln !< the system matrix
    ! -- local
    integer(I4B) :: n, iglo, jglo
    !
    ! -- map exchange connections
    do n = 1, this%nexg
      iglo = this%nodeswf(n) + this%swfmodel%moffset
      jglo = this%nodegwf(n) + this%gwfmodel%moffset
      this%idxglo(n) = matrix_sln%get_position(iglo, jglo)
      this%idxsymglo(n) = matrix_sln%get_position(jglo, iglo)
    end do

swf_gwf_ot()

subroutine swfgwfexchangemodule::swf_gwf_ot ( class(swfgwfexchangetype)  this )

private

Write output

Parameters

this	SwfGwfExchangeType

Definition at line 916 of file exg-swfgwf.f90.

    ! -- modules
    use simvariablesmodule, only: iout
    use constantsmodule, only: dzero, linelength
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    ! -- local
    integer(I4B) :: iexg, n1, n2
    real(DP) :: flow
    character(len=LINELENGTH) :: node1str, node2str
    ! -- format
    character(len=*), parameter :: fmtheader2 = &
     "(/1x, 'SUMMARY OF EXCHANGE RATES FOR EXCHANGE ', a, ' WITH ID ', i0, /, &
       &2a16, 4a16, /, 96('-'))"
    character(len=*), parameter :: fmtdata = &
                                   "(2a16, 5(1pg16.6))"
    !
    ! -- Call bdsave
    call this%swf_gwf_bdsav()
    !
    ! -- Write a table of exchanges
    if (this%ipr_flow /= 0) then
      write (iout, fmtheader2) trim(adjustl(this%name)), this%id, 'NODEM1', &
        'NODEM2', 'COND', 'X_M1', 'X_M2', 'FLOW'
      do iexg = 1, this%nexg
        n1 = this%nodeswf(iexg)
        n2 = this%nodegwf(iexg)
        flow = this%simvals(iexg)
        call this%swfmodel%dis%noder_to_string(n1, node1str)
        call this%gwfmodel%dis%noder_to_string(n2, node2str)
        write (iout, fmtdata) trim(adjustl(node1str)), &
          trim(adjustl(node2str)), &
          this%bedleak(iexg), this%swfmodel%x(n1), &
          this%gwfmodel%x(n2), flow
      end do
    end if
    !
    ! -- OBS output
    call this%obs%obs_ot()

swf_gwf_save_simvals()

subroutine swfgwfexchangemodule::swf_gwf_save_simvals

(

class(swfgwfexchangetype), intent(inout)

this

)

Save the simulated flows for each exchange

Definition at line 961 of file exg-swfgwf.f90.

    ! -- modules
    use simmodule, only: store_error, store_error_unit
    use simvariablesmodule, only: errmsg
    use constantsmodule, only: dzero
    use observemodule, only: observetype
    ! -- dummy
    class(SwfGwfExchangeType), intent(inout) :: this
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: j
    integer(I4B) :: n1
    integer(I4B) :: n2
    integer(I4B) :: iexg
    real(DP) :: v
    type(ObserveType), pointer :: obsrv => null()
    !
    ! -- Write simulated values for all gwf-gwf observations
    if (this%obs%npakobs > 0) then
      call this%obs%obs_bd_clear()
      do i = 1, this%obs%npakobs
        obsrv => this%obs%pakobs(i)%obsrv
        do j = 1, obsrv%indxbnds_count
          iexg = obsrv%indxbnds(j)
          v = dzero
          select case (obsrv%ObsTypeId)
          case ('FLOW-JA-FACE')
            n1 = this%nodeswf(iexg)
            n2 = this%nodegwf(iexg)
            v = this%simvals(iexg)
          case default
            errmsg = 'Unrecognized observation type: '// &
                     trim(obsrv%ObsTypeId)
            call store_error(errmsg)
            call store_error_unit(this%inobs)
          end select
          call this%obs%SaveOneSimval(obsrv, v)
        end do
      end do
    end if

Here is the call graph for this function: