swfgwfexchangemodule Module Reference

This module contains the SwfGwfExchangeModule Module. More...

Data Types
type	swfgwfexchangetype

Functions/Subroutines
subroutine, public	swfgwf_cr (filename, name, id, m1_id, m2_id, input_mempath)
	@ brief Create SWF GWF exchange More...
subroutine	swf_gwf_df (this)
	@ brief Define 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...
subroutine	source_options (this, iout)
	@ brief Source options More...
subroutine	source_dimensions (this, iout)
	Source dimension from input context. More...
integer(i4b) function	noder (this, model, cellid, iout)
character(len=20) function	cellstr (this, model, cellid, iout)
subroutine	source_data (this, iout)
	Source exchange data from input context. More...
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, n1, n2)
	@ brief Calculate flow 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.

Function/Subroutine Documentation

allocate_arrays()

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

private

Parameters

nexg
this	instance of exchange object

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

    ! -- dummy
    class(SwfGwfExchangeType) :: this !< instance of exchange object
    !
    call mem_allocate(this%nodem1, this%nexg, 'NODEM1', this%memoryPath)
    call mem_allocate(this%nodem2, this%nexg, 'NODEM2', this%memoryPath)
    call mem_allocate(this%cond, this%nexg, 'COND', 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)
    !
    ! -- Return
    return

allocate_scalars()

subroutine swfgwfexchangemodule::allocate_scalars

(

class(swfgwfexchangetype)

this

)

Allocate scalar variables

Parameters

this	SwfGwfExchangeType

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

    ! -- modules
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    !
    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%nexg, 'NEXG', this%memoryPath)
    call mem_allocate(this%inobs, 'INOBS', this%memoryPath)
    !
    this%ipr_input = 0
    this%ipr_flow = 0
    this%nexg = 0
    this%inobs = 0
    !
    ! -- Return
    return

cellstr()

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

Parameters

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

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

    ! -- modules
    ! -- dummy
    class(SwfGwfExchangeType) :: this !< instance of exchange object
    class(NumericalModelType), pointer, intent(in) :: model
    integer(I4B), dimension(:), pointer, 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
    !
    ! -- return
    return

noder()

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

Parameters

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

Definition at line 491 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(:), pointer, 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)
    !
    ! -- return
    return

Here is the call graph for this function:

qcalc()

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

Calculate the flow for the specified exchange and node numbers

Parameters

this	SwfGwfExchangeType

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

    ! -- return
    real(DP) :: qcalc
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    integer(I4B), intent(in) :: iexg
    integer(I4B), intent(in) :: n1
    integer(I4B), intent(in) :: n2
    ! -- local
    !
    ! -- Calculate flow between nodes in the two models
    qcalc = this%cond(iexg) * (this%gwfmodel2%x(n2) - this%swfmodel1%x(n1))
    !
    ! -- Return
    return

source_data()

subroutine swfgwfexchangemodule::source_data ( class(swfgwfexchangetype)  this, integer(i4b), intent(in)  iout  )

private

Parameters

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

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

    ! -- modules
    use memorymanagermodule, only: mem_setptr
    ! -- dummy
    class(SwfGwfExchangeType) :: this !< instance of exchange object
    integer(I4B), intent(in) :: iout !< the output file unit
    ! -- local
    integer(I4B), dimension(:, :), contiguous, pointer :: cellidm1
    integer(I4B), dimension(:, :), contiguous, pointer :: cellidm2
    real(DP), dimension(:), contiguous, pointer :: cond
    character(len=20) :: cellstr1, cellstr2
    integer(I4B) :: nerr
    integer(I4B) :: iexg, nodem1, nodem2
    ! -- format
    character(len=*), parameter :: fmtexglabel = "(1x, 3a10, 50(a16))"
    character(len=*), parameter :: fmtexgdata = &
                                   "(5x, a, 1x, a ,50(1pg16.6))"
    !
    call mem_setptr(cellidm1, 'CELLIDM1', this%input_mempath)
    call mem_setptr(cellidm2, 'CELLIDM2', this%input_mempath)
    call mem_setptr(cond, 'COND', this%input_mempath)
    !
    write (iout, '(1x,a)') 'PROCESSING EXCHANGEDATA'
    !
    if (this%ipr_input /= 0) then
      write (iout, fmtexglabel) 'NODEM1', 'NODEM2', 'COND'
    end if
    !
    do iexg = 1, this%nexg
      !
      if (associated(this%model1)) then
        !
        ! -- Determine user node number
        nodem1 = this%noder(this%model1, cellidm1(:, iexg), iout)
        this%nodem1(iexg) = nodem1
        !
      else
        this%nodem1(iexg) = -1
      end if
      !
      if (associated(this%model2)) then
        !
        ! -- Determine user node number
        nodem2 = this%noder(this%model2, cellidm2(:, iexg), iout)
        this%nodem2(iexg) = nodem2
        !
      else
        this%nodem2(iexg) = -1
      end if
      !
      ! -- Read rest of input line
      this%cond(iexg) = cond(iexg)
      !
      ! -- Write the data to listing file if requested
      if (this%ipr_input /= 0) then
        cellstr1 = this%cellstr(this%model1, cellidm1(:, iexg), iout)
        cellstr2 = this%cellstr(this%model2, cellidm2(:, iexg), iout)
        write (iout, fmtexgdata) trim(cellstr1), trim(cellstr2), &
          this%cond(iexg)
      end if
      !
      ! -- Check to see if nodem1 is outside of active domain
      if (associated(this%model1)) then
        if (nodem1 <= 0) then
          cellstr1 = this%cellstr(this%model1, cellidm1(:, iexg), iout)
          write (errmsg, *) &
            trim(adjustl(this%model1%name))// &
            ' Cell is outside active grid domain ('// &
            trim(adjustl(cellstr1))//').'
          call store_error(errmsg)
        end if
      end if
      !
      ! -- Check to see if nodem2 is outside of active domain
      if (associated(this%model2)) then
        if (nodem2 <= 0) then
          cellstr2 = this%cellstr(this%model2, cellidm2(:, iexg), iout)
          write (errmsg, *) &
            trim(adjustl(this%model2%name))// &
            ' Cell is outside active grid domain ('// &
            trim(adjustl(cellstr2))//').'
          call store_error(errmsg)
        end if
      end if
    end do
    !
    write (iout, '(1x,a)') 'END OF EXCHANGEDATA'
    !
    ! -- Stop if errors
    nerr = count_errors()
    if (nerr > 0) then
      call store_error('Errors encountered in exchange input file.')
      call store_error_filename(this%filename)
    end if
    !
    ! -- Return
    return

Here is the call graph for this function:

source_dimensions()

subroutine swfgwfexchangemodule::source_dimensions	(	class(swfgwfexchangetype)	this,
		integer(i4b), intent(in)	iout
	)

Parameters

	this	instance of exchange object
[in]	iout	for logging

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

    ! -- modules
    use memorymanagerextmodule, only: mem_set_value
    use exgswfgwfinputmodule, only: exgswfgwfparamfoundtype
    ! -- dummy
    class(SwfGwfExchangeType) :: this !< instance of exchange object
    integer(I4B), intent(in) :: iout !< for logging
    ! -- local
    type(ExgSwfgwfParamFoundType) :: found
    !
    ! -- update defaults with idm sourced values
    call mem_set_value(this%nexg, 'NEXG', this%input_mempath, found%nexg)
    !
    write (iout, '(1x,a)') 'PROCESSING EXCHANGE DIMENSIONS'
    !
    if (found%nexg) then
      write (iout, '(4x,a,i0)') 'NEXG = ', this%nexg
    end if
    !
    write (iout, '(1x,a)') 'END OF EXCHANGE DIMENSIONS'
    !
    ! -- return
    return

source_options()

subroutine swfgwfexchangemodule::source_options ( class(swfgwfexchangetype)  this, integer(i4b), intent(in)  iout  )

private

Source the options block

Parameters

this	GwfExchangeType

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

    ! -- modules
    use constantsmodule, only: lenvarname, dem6
    use inputoutputmodule, only: getunit, openfile
    use memorymanagerextmodule, only: mem_set_value
    use characterstringmodule, only: characterstringtype
    use exgswfgwfinputmodule, only: exgswfgwfparamfoundtype
    use sourcecommonmodule, only: filein_fname
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  GwfExchangeType
    integer(I4B), intent(in) :: iout
    ! -- local
    type(ExgSwfgwfParamFoundType) :: found
    !
    ! -- update defaults with idm sourced values
    call mem_set_value(this%ipr_input, 'IPR_INPUT', &
                       this%input_mempath, found%ipr_input)
    call mem_set_value(this%ipr_flow, 'IPR_FLOW', &
                       this%input_mempath, found%ipr_flow)
    !
    write (iout, '(1x,a)') 'PROCESSING SWF-GWF EXCHANGE OPTIONS'
    !
    if (found%ipr_input) then
      write (iout, '(4x,a)') &
        'THE LIST OF EXCHANGES WILL BE PRINTED.'
    end if
    !
    if (found%ipr_flow) then
      write (iout, '(4x,a)') &
        'EXCHANGE FLOWS WILL BE PRINTED TO LIST FILES.'
    end if
    !
    ! -- enforce 0 or 1 OBS6_FILENAME entries in option block
    ! if (.not. this%is_datacopy) then
    !   if (filein_fname(this%obs%inputFilename, 'OBS6_FILENAME', &
    !                    this%input_mempath, this%filename)) then
    !     this%obs%active = .true.
    !     this%obs%inUnitObs = GetUnit()
    !     call openfile(this%obs%inUnitObs, iout, this%obs%inputFilename, 'OBS')
    !   end if
    ! end if
    !
    write (iout, '(1x,a)') 'END OF SWF-GWF EXCHANGE OPTIONS'
    !
    ! -- Return
    return

Here is the call graph for this function:

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 229 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%nodem1(n) + this%swfmodel1%moffset
      jglo = this%nodem2(n) + this%gwfmodel2%moffset
      call sparse%addconnection(iglo, jglo, 1)
      call sparse%addconnection(jglo, iglo, 1)
    end do
    !
    ! -- Return
    return

swf_gwf_add_to_flowja()

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

private

Parameters

this	SwfGwfExchangeType

Definition at line 707 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%swfmodel1)) then
        n = this%nodem1(i)
        if (this%swfmodel1%ibound(n) > 0) then
          flow = this%simvals(i)
          idiag = this%swfmodel1%ia(n)
          this%swfmodel1%flowja(idiag) = this%swfmodel1%flowja(idiag) + flow
        end if
      end if
      !
      if (associated(this%gwfmodel2)) then
        n = this%nodem2(i)
        if (this%gwfmodel2%ibound(n) > 0) then
          flow = -this%simvals(i)
          idiag = this%gwfmodel2%ia(n)
          this%gwfmodel2%flowja(idiag) = this%gwfmodel2%flowja(idiag) + flow
        end if
      end if
      !
    end do
    !
    ! -- Return
    return

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 746 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%swfmodel1)) then
      budterm(1, 1) = ratin
      budterm(2, 1) = ratout
      call this%swfmodel1%model_bdentry(budterm, budtxt, this%name)
    end if
    !
    ! -- Add the budget terms to model 2
    if (associated(this%gwfmodel2)) then
      budterm(1, 1) = ratout
      budterm(2, 1) = ratin
      call this%gwfmodel2%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()
    !
    ! -- Return
    return

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 857 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
    !
    ! -- Return
    return

swf_gwf_calc_simvals()

subroutine swfgwfexchangemodule::swf_gwf_calc_simvals

(

class(swfgwfexchangetype)

this

)

Parameters

this	SwfGwfExchangeType

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

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: n1, n2
    integer(I4B) :: ibdn1, ibdn2
    real(DP) :: rrate
    !
    do i = 1, this%nexg
      rrate = dzero
      n1 = this%nodem1(i)
      n2 = this%nodem2(i)
      ibdn1 = this%swfmodel1%ibound(n1)
      ibdn2 = this%gwfmodel2%ibound(n2)
      if (ibdn1 /= 0 .and. ibdn2 /= 0) then
        rrate = this%qcalc(i, n1, n2)
      end if
      this%simvals(i) = rrate
    end do
    !
    ! -- Return
    return

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 792 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%swfmodel1)) then
      ratin = dzero
      ratout = dzero
      do i = 1, this%nexg
        n = this%nodem1(i)
        if (this%swfmodel1%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%swfmodel1%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%gwfmodel2)) then
      ratin = dzero
      ratout = dzero
      do i = 1, this%nexg
        n = this%nodem2(i)
        if (this%gwfmodel2%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%gwfmodel2%model_bdentry(budterm, budtxt, this%name)
    end if
    !
    ! -- Return
    return

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 1142 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%gwfmodel2, model)) then
        is_connected = .true.
      end if
    class is (swfmodeltype)
      if (associated(this%swfmodel1, model)) then
        is_connected = .true.
      end if
    end select
    !
    ! -- Return
    return

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  )

private

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

Parameters

this	SwfGwfExchangeType

Definition at line 312 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()
    !
    ! -- Return
    return

swf_gwf_da()

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

private

Deallocate memory associated with this object

Parameters

this	SwfGwfExchangeType

Definition at line 337 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%nodem1)
    call mem_deallocate(this%nodem2)
    call mem_deallocate(this%cond)
    call mem_deallocate(this%idxglo)
    call mem_deallocate(this%idxsymglo)
    call mem_deallocate(this%simvals)
    !
    ! -- scalars
    deallocate (this%filename)
    call mem_deallocate(this%ipr_input)
    call mem_deallocate(this%ipr_flow)
    call mem_deallocate(this%nexg)
    call mem_deallocate(this%inobs)
    !
    ! -- Return
    return

swf_gwf_df()

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

private

Define SWF to GWF exchange object.

Parameters

this	SwfGwfExchangeType

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

    ! -- modules
    ! -- dummy
    class(SwfGwfExchangeType) :: this !<  SwfGwfExchangeType
    ! -- local
    !
    ! -- log the exchange
    write (iout, '(/a,a)') ' Creating exchange: ', this%name
    !
    ! -- Ensure models are in same solution
    if (associated(this%swfmodel1) .and. associated(this%gwfmodel2)) then
      if (this%swfmodel1%idsoln /= this%gwfmodel2%idsoln) then
        call store_error('Two models are connected in a SWF-GWF '// &
                         'exchange but they are in different solutions. '// &
                         'Models must be in same solution: '// &
                         trim(this%swfmodel1%name)//' '// &
                         trim(this%gwfmodel2%name))
        call this%parser%StoreErrorUnit()
      end if
    end if
    !
    ! -- source options
    call this%source_options(iout)
    !
    ! -- source dimensions
    call this%source_dimensions(iout)
    !
    ! -- allocate arrays
    call this%allocate_arrays()
    !
    ! -- source exchange data
    call this%source_data(iout)
    !
    ! -- Store obs
    ! call this%swf_gwf_df_obs()
    ! if (associated(this%swfmodel1)) then
    !   call this%obs%obs_df(iout, this%name, 'SWF-GWF', this%swfmodel1%dis)
    ! end if
    ! !
    ! ! -- validate
    ! call this%validate_exchange()
    !
    ! -- Return
    return

Here is the call graph for this function:

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 281 of file exg-swfgwf.f90.

    ! -- modules
    ! -- 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) :: i, nodem1sln, nodem2sln
    !
    ! -- Put this%cond into amatsln
    do i = 1, this%nexg
      call matrix_sln%set_value_pos(this%idxglo(i), this%cond(i))
      call matrix_sln%set_value_pos(this%idxsymglo(i), this%cond(i))
 
      nodem1sln = this%nodem1(i) + this%swfmodel1%moffset
      nodem2sln = this%nodem2(i) + this%gwfmodel2%moffset
      call matrix_sln%add_diag_value(nodem1sln, -this%cond(i))
      call matrix_sln%add_diag_value(nodem2sln, -this%cond(i))
    end do
    !
    ! -- Return
    return

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 254 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%nodem1(n) + this%swfmodel1%moffset
      jglo = this%nodem2(n) + this%gwfmodel2%moffset
      this%idxglo(n) = matrix_sln%get_position(iglo, jglo)
      this%idxsymglo(n) = matrix_sln%get_position(jglo, iglo)
    end do
    !
    ! -- Return
    return

swf_gwf_ot()

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

private

Write output

Parameters

this	SwfGwfExchangeType

Definition at line 1046 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%nodem1(iexg)
        n2 = this%nodem2(iexg)
        flow = this%simvals(iexg)
        call this%swfmodel1%dis%noder_to_string(n1, node1str)
        call this%gwfmodel2%dis%noder_to_string(n2, node2str)
        write (iout, fmtdata) trim(adjustl(node1str)), &
          trim(adjustl(node2str)), &
          this%cond(iexg), this%swfmodel1%x(n1), &
          this%gwfmodel2%x(n2), flow
      end do
    end if
    !
    ! -- OBS output
    call this%obs%obs_ot()
    !
    ! -- Return
    return

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 1094 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%nodem1(iexg)
            n2 = this%nodem2(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
    !
    ! -- Return
    return

Here is the call graph for this function:

swfgwf_cr()

subroutine, public swfgwfexchangemodule::swfgwf_cr	(	character(len=*), intent(in)	filename,
		character(len=*)	name,
		integer(i4b), intent(in)	id,
		integer(i4b), intent(in)	m1_id,
		integer(i4b), intent(in)	m2_id,
		character(len=*), intent(in)	input_mempath
	)

Create a new SWF to GWF exchange object.

Parameters

[in]	filename	filename for reading
	name	exchange name
[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.

    ! -- modules
    ! -- dummy
    character(len=*), intent(in) :: filename !< filename for reading
    character(len=*) :: name !< exchange name
    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
    type(SwfGwfExchangeType), pointer :: exchange
    class(BaseModelType), pointer :: mb
    class(BaseExchangeType), pointer :: baseexchange
    integer(I4B) :: m1_index, m2_index
    !
    ! -- Create a new exchange and add it to the baseexchangelist container
    allocate (exchange)
    baseexchange => exchange
    call addbaseexchangetolist(baseexchangelist, baseexchange)
    !
    ! -- Assign id and name
    exchange%id = id
    exchange%name = name
    exchange%memoryPath = create_mem_path(exchange%name)
    exchange%input_mempath = input_mempath
    !
    ! -- allocate scalars and set defaults
    call exchange%allocate_scalars()
    exchange%filename = filename
    exchange%typename = 'SWF-GWF'
    !
    ! -- set swfmodel1
    m1_index = model_loc_idx(m1_id)
    if (m1_index > 0) then
      mb => getbasemodelfromlist(basemodellist, m1_index)
      select type (mb)
      type is (swfmodeltype)
        exchange%model1 => mb
        exchange%swfmodel1 => mb
      end select
    end if
    ! exchange%v_model1 => get_virtual_model(m1_id)
    ! exchange%is_datacopy = .not. exchange%v_model1%is_local
    !
    ! -- set gwfmodel2
    m2_index = model_loc_idx(m2_id)
    if (m2_index > 0) then
      mb => getbasemodelfromlist(basemodellist, m2_index)
      select type (mb)
      type is (gwfmodeltype)
        exchange%model2 => mb
        exchange%gwfmodel2 => mb
      end select
    end if
    ! exchange%v_model2 => get_virtual_model(m2_id)
    !
    ! -- Verify that gwf model1 is of the correct type
    if (.not. associated(exchange%swfmodel1) .and. m1_index > 0) then
      write (errmsg, '(3a)') 'Problem with SWF-GWF exchange ', &
        trim(exchange%name), &
        '.  Specified SWF Model does not appear to be of the correct type.'
      call store_error(errmsg, terminate=.true.)
    end if
    !
    ! -- Verify that gwf model2 is of the correct type
    if (.not. associated(exchange%gwfmodel2) .and. m2_index > 0) then
      write (errmsg, '(3a)') 'Problem with SWF-GWF exchange ', &
        trim(exchange%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(exchange%obs, exchange%inobs)
    !
    ! -- Return
    return

Here is the call graph for this function:

Here is the caller graph for this function: