gwtgwtexchangemodule Module Reference

This module contains the GwtGwtExchangeModule Module. More...

Data Types
type	gwtexchangetype
	Derived type for GwtExchangeType. More...

Functions/Subroutines
subroutine, public	gwtexchange_create (filename, name, id, m1_id, m2_id, input_mempath)
	@ brief Create GWT GWT exchange More...
subroutine	gwt_gwt_df (this)
	@ brief Define GWT GWT exchange More...
subroutine	validate_exchange (this)
	validate exchange data after reading More...
subroutine	gwt_gwt_ar (this)
	@ brief Allocate and read More...
subroutine	gwt_gwt_rp (this)
	@ brief Read and prepare More...
subroutine	gwt_gwt_ad (this)
	@ brief Advance More...
subroutine	gwt_gwt_cf (this, kiter)
subroutine	gwt_gwt_fc (this, kiter, matrix_sln, rhs_sln, inwtflag)
	@ brief Fill coefficients More...
subroutine	gwt_gwt_bd (this, icnvg, isuppress_output, isolnid)
	@ brief Budget More...
subroutine	gwt_gwt_bdsav (this)
	@ brief Budget save More...
subroutine	gwt_gwt_bdsav_model (this, model)
	@ brief Budget save More...
subroutine	gwt_gwt_ot (this)
	@ brief Output More...
subroutine	source_options (this, iout)
	@ brief Source options More...
subroutine	read_mvt (this, iout)
	@ brief Read mover More...
subroutine	allocate_scalars (this)
	@ brief Allocate scalars More...
subroutine	gwt_gwt_da (this)
	@ brief Deallocate More...
subroutine	allocate_arrays (this)
	@ brief Allocate arrays More...
subroutine	gwt_gwt_df_obs (this)
	@ brief Define observations More...
subroutine	gwt_gwt_rp_obs (this)
	@ brief Read and prepare observations More...
subroutine	gwt_gwt_fp (this)
	@ brief Final processing More...
logical(lgp) function	gwt_gwt_connects_model (this, model)
	Return true when this exchange provides matrix coefficients for solving. More...
logical(lgp) function	use_interface_model (this)
	Should interface model be used for this exchange. More...
subroutine	gwt_gwt_save_simvals (this)
	@ brief Save simulated flow observations More...
subroutine	gwt_gwt_process_obsid (obsrv, dis, inunitobs, iout)
	@ brief Obs ID processor More...
class(gwtexchangetype) function, pointer, public	castasgwtexchange (obj)
	@ brief Cast polymorphic object as exchange More...
class(gwtexchangetype) function, pointer, public	getgwtexchangefromlist (list, idx)
	@ brief Get exchange from list More...

Detailed Description

This module contains the code for connecting two GWT Models. The methods are based on the simple two point flux approximation with the option to use ghost nodes to improve accuracy. This exchange is used by GwtGwtConnection with the more sophisticated interface model coupling approach when XT3D is needed.

Function/Subroutine Documentation

allocate_arrays()

subroutine gwtgwtexchangemodule::allocate_arrays

(

class(gwtexchangetype)

this

)

Allocate arrays

Parameters

this	GwtExchangeType

Definition at line 884 of file exg-gwtgwt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    ! -- local
    character(len=LINELENGTH) :: text
    integer(I4B) :: ntabcol, i
    !
    call this%DisConnExchangeType%allocate_arrays()
    !
    call mem_allocate(this%cond, this%nexg, 'COND', this%memoryPath)
    call mem_allocate(this%simvals, this%nexg, 'SIMVALS', this%memoryPath)
    !
    ! -- Initialize
    do i = 1, this%nexg
      this%cond(i) = dnodata
    end do
    !
    ! -- allocate and initialize the output table
    if (this%iprflow /= 0) then
      !
      ! -- dimension table
      ntabcol = 3
      if (this%inamedbound > 0) then
        ntabcol = ntabcol + 1
      end if
      !
      ! -- initialize the output table objects
      !    outouttab1
      if (this%v_model1%is_local) then
        call table_cr(this%outputtab1, this%name, '    ')
        call this%outputtab1%table_df(this%nexg, ntabcol, this%gwtmodel1%iout, &
                                      transient=.true.)
        text = 'NUMBER'
        call this%outputtab1%initialize_column(text, 10, alignment=tabcenter)
        text = 'CELLID'
        call this%outputtab1%initialize_column(text, 20, alignment=tableft)
        text = 'RATE'
        call this%outputtab1%initialize_column(text, 15, alignment=tabcenter)
        if (this%inamedbound > 0) then
          text = 'NAME'
          call this%outputtab1%initialize_column(text, 20, alignment=tableft)
        end if
      end if
      !    outouttab2
      if (this%v_model2%is_local) then
        call table_cr(this%outputtab2, this%name, '    ')
        call this%outputtab2%table_df(this%nexg, ntabcol, this%gwtmodel2%iout, &
                                      transient=.true.)
        text = 'NUMBER'
        call this%outputtab2%initialize_column(text, 10, alignment=tabcenter)
        text = 'CELLID'
        call this%outputtab2%initialize_column(text, 20, alignment=tableft)
        text = 'RATE'
        call this%outputtab2%initialize_column(text, 15, alignment=tabcenter)
        if (this%inamedbound > 0) then
          text = 'NAME'
          call this%outputtab2%initialize_column(text, 20, alignment=tableft)
        end if
      end if
    end if

Here is the call graph for this function:

allocate_scalars()

subroutine gwtgwtexchangemodule::allocate_scalars

(

class(gwtexchangetype)

this

)

Allocate scalar variables

Parameters

this	GwtExchangeType

Definition at line 814 of file exg-gwtgwt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    use constantsmodule, only: dzero
    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    !
    call this%DisConnExchangeType%allocate_scalars()
    !
    call mem_allocate(this%inewton, 'INEWTON', this%memoryPath)
    call mem_allocate(this%inobs, 'INOBS', this%memoryPath)
    call mem_allocate(this%iAdvScheme, 'IADVSCHEME', this%memoryPath)
    this%inewton = 0
    this%inobs = 0
    this%iAdvScheme = 0
    !
    call mem_allocate(this%inmvt, 'INMVT', this%memoryPath)
    this%inmvt = 0

castasgwtexchange()

class(gwtexchangetype) function, pointer, public gwtgwtexchangemodule::castasgwtexchange

(

class(*), intent(inout), pointer

obj

)

Cast polymorphic object as exchange

Definition at line 1173 of file exg-gwtgwt.f90.

    implicit none
    ! -- dummy
    class(*), pointer, intent(inout) :: obj
    ! -- return
    class(GwtExchangeType), pointer :: res
    !
    res => null()
    if (.not. associated(obj)) return
    !
    select type (obj)
    class is (gwtexchangetype)
      res => obj
    end select

Here is the caller graph for this function:

getgwtexchangefromlist()

class(gwtexchangetype) function, pointer, public gwtgwtexchangemodule::getgwtexchangefromlist	(	type(listtype), intent(inout)	list,
		integer(i4b), intent(in)	idx
	)

Return an exchange from the list for specified index

Definition at line 1193 of file exg-gwtgwt.f90.

    implicit none
    ! -- dummy
    type(ListType), intent(inout) :: list
    integer(I4B), intent(in) :: idx
    ! -- return
    class(GwtExchangeType), pointer :: res
    ! -- local
    class(*), pointer :: obj
    !
    obj => list%GetItem(idx)
    res => castasgwtexchange(obj)

Here is the call graph for this function:

gwt_gwt_ad()

subroutine gwtgwtexchangemodule::gwt_gwt_ad

(

class(gwtexchangetype)

this

)

Advance mover and obs

Parameters

this	GwtExchangeType

Definition at line 346 of file exg-gwtgwt.f90.

    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    !
    ! -- Advance mover
    !if(this%inmvt > 0) call this%mvt%mvt_ad()
    !
    ! -- Push simulated values to preceding time step
    call this%obs%obs_ad()

gwt_gwt_ar()

subroutine gwtgwtexchangemodule::gwt_gwt_ar ( class(gwtexchangetype)  this )

private

Allocated and read and calculate saturated conductance

Parameters

this	GwtExchangeType

Definition at line 311 of file exg-gwtgwt.f90.

    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    !
    ! -- If mover is active, then call ar routine
    if (this%inmvt > 0) call this%mvt%mvt_ar()
    !
    ! -- Observation AR
    call this%obs%obs_ar()

gwt_gwt_bd()

subroutine gwtgwtexchangemodule::gwt_gwt_bd ( class(gwtexchangetype)  this, integer(i4b), intent(inout)  icnvg, integer(i4b), intent(in)  isuppress_output, integer(i4b), intent(in)  isolnid  )

private

Accumulate budget terms

Parameters

this	GwtExchangeType

Definition at line 402 of file exg-gwtgwt.f90.

    ! -- modules
    use constantsmodule, only: dzero, lenbudtxt, lenpackagename
    use budgetmodule, only: rate_accumulator
    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    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%gwtmodel1)) then
      budterm(1, 1) = ratin
      budterm(2, 1) = ratout
      call this%gwtmodel1%model_bdentry(budterm, budtxt, this%name)
    end if
    !
    ! -- Add the budget terms to model 2
    if (associated(this%gwtmodel2)) then
      budterm(1, 1) = ratout
      budterm(2, 1) = ratin
      call this%gwtmodel2%model_bdentry(budterm, budtxt, this%name)
    end if
    !
    ! -- Call mvt bd routine
    if (this%inmvt > 0) call this%mvt%mvt_bd()

Here is the call graph for this function:

gwt_gwt_bdsav()

subroutine gwtgwtexchangemodule::gwt_gwt_bdsav

(

class(gwtexchangetype)

this

)

Output individual flows to listing file and binary budget files

Parameters

this	GwtExchangeType

Definition at line 444 of file exg-gwtgwt.f90.

    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    ! -- local
    integer(I4B) :: icbcfl, ibudfl
    !
    ! -- budget for model1
    if (associated(this%gwtmodel1)) then
      call this%gwt_gwt_bdsav_model(this%gwtmodel1)
    end if
    !
    ! -- budget for model2
    if (associated(this%gwtmodel2)) then
      call this%gwt_gwt_bdsav_model(this%gwtmodel2)
    end if
    !
    ! -- Set icbcfl, ibudfl to zero so that flows will be printed and
    !    saved, if the options were set in the MVT package
    icbcfl = 1
    ibudfl = 1
    !
    ! -- Call mvt bd routine
    !cdl todo: if(this%inmvt > 0) call this%mvt%mvt_bdsav(icbcfl, ibudfl, isuppress_output)
    !
    ! -- Calculate and write simulated values for observations
    if (this%inobs /= 0) then
      call this%gwt_gwt_save_simvals()
    end if

gwt_gwt_bdsav_model()

subroutine gwtgwtexchangemodule::gwt_gwt_bdsav_model ( class(gwtexchangetype)  this, class(gwtmodeltype), pointer  model  )

private

Output individual flows to listing file and binary budget files

Parameters

this	GwtExchangeType

Definition at line 478 of file exg-gwtgwt.f90.

    ! -- modules
    use constantsmodule, only: dzero, lenbudtxt, lenpackagename
    use tdismodule, only: kstp, kper
    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    class(GwtModelType), pointer :: model
    ! -- local
    character(len=LENBOUNDNAME) :: bname
    character(len=LENPACKAGENAME + 4) :: packname
    character(len=LENBUDTXT), dimension(1) :: budtxt
    type(TableType), pointer :: output_tab
    class(VirtualModelType), pointer :: nbr_model
    character(len=20) :: nodestr
    integer(I4B) :: ntabrows
    integer(I4B) :: nodeu
    integer(I4B) :: i, n1, n2, n1u, n2u
    integer(I4B) :: ibinun
    real(DP) :: ratin, ratout, rrate
    logical(LGP) :: is_for_model1
    integer(I4B) :: isuppress_output
    real(DP), dimension(this%naux) :: auxrow
    !
    ! -- initialize local variables
    isuppress_output = 0
    budtxt(1) = '    FLOW-JA-FACE'
    packname = 'EXG '//this%name
    packname = adjustr(packname)
    if (associated(model, this%gwtmodel1)) then
      output_tab => this%outputtab1
      nbr_model => this%v_model2
      is_for_model1 = .true.
    else
      output_tab => this%outputtab2
      nbr_model => this%v_model1
      is_for_model1 = .false.
    end if
    !
    ! -- update output tables
    if (this%iprflow /= 0) then
      !
      ! -- update titles
      if (model%oc%oc_save('BUDGET')) then
        call output_tab%set_title(packname)
      end if
      !
      ! -- set table kstp and kper
      call output_tab%set_kstpkper(kstp, kper)
      !
      ! -- update maxbound of tables
      ntabrows = 0
      do i = 1, this%nexg
        n1 = this%nodem1(i)
        n2 = this%nodem2(i)
        !
        ! -- If both cells are active then calculate flow rate
        if (this%v_model1%ibound%get(n1) /= 0 .and. &
            this%v_model2%ibound%get(n2) /= 0) then
          ntabrows = ntabrows + 1
        end if
      end do
      if (ntabrows > 0) then
        call output_tab%set_maxbound(ntabrows)
      end if
    end if
    !
    ! -- Print and write budget terms for model 1
    !
    ! -- Set binary unit numbers for saving flows
    if (this%ipakcb /= 0) then
      ibinun = model%oc%oc_save_unit('BUDGET')
    else
      ibinun = 0
    end if
    !
    ! -- If save budget flag is zero for this stress period, then
    !    shut off saving
    if (.not. model%oc%oc_save('BUDGET')) ibinun = 0
    if (isuppress_output /= 0) then
      ibinun = 0
    end if
    !
    ! -- If cell-by-cell flows will be saved as a list, write header.
    if (ibinun /= 0) then
      call model%dis%record_srcdst_list_header(budtxt(1), &
                                               model%name, &
                                               this%name, &
                                               nbr_model%name, &
                                               this%name, &
                                               this%naux, this%auxname, &
                                               ibinun, this%nexg, &
                                               model%iout)
    end if
    !
    ! Initialize accumulators
    ratin = dzero
    ratout = dzero
    !
    ! -- Loop through all exchanges
    do i = 1, this%nexg
      !
      ! -- Assign boundary name
      if (this%inamedbound > 0) then
        bname = this%boundname(i)
      else
        bname = ''
      end if
      !
      ! -- Calculate the flow rate between n1 and n2
      rrate = dzero
      n1 = this%nodem1(i)
      n2 = this%nodem2(i)
      !
      ! -- If both cells are active then calculate flow rate
      if (this%v_model1%ibound%get(n1) /= 0 .and. &
          this%v_model2%ibound%get(n2) /= 0) then
        rrate = this%simvals(i)
        !
        ! -- Print the individual rates to model list files if requested
        if (this%iprflow /= 0) then
          if (model%oc%oc_save('BUDGET')) then
            !
            ! -- set nodestr and write outputtab table
            if (is_for_model1) then
              nodeu = model%dis%get_nodeuser(n1)
              call model%dis%nodeu_to_string(nodeu, nodestr)
              call output_tab%print_list_entry(i, trim(adjustl(nodestr)), &
                                               rrate, bname)
            else
              nodeu = model%dis%get_nodeuser(n2)
              call model%dis%nodeu_to_string(nodeu, nodestr)
              call output_tab%print_list_entry(i, trim(adjustl(nodestr)), &
                                               -rrate, bname)
            end if
          end if
        end if
        if (rrate < dzero) then
          ratout = ratout - rrate
        else
          ratin = ratin + rrate
        end if
      end if
      !
      ! -- If saving cell-by-cell flows in list, write flow
      n1u = this%v_model1%dis_get_nodeuser(n1)
      n2u = this%v_model2%dis_get_nodeuser(n2)
      if (ibinun /= 0) then
        if (this%naux > 0) then
          auxrow(:) = this%auxvar(:, i)
        end if
        if (is_for_model1) then
          call model%dis%record_mf6_list_entry( &
            ibinun, n1u, n2u, rrate, this%naux, auxrow, &
            .false., .false.)
        else
          call model%dis%record_mf6_list_entry( &
            ibinun, n2u, n1u, -rrate, this%naux, auxrow, &
            .false., .false.)
        end if
      end if
      !
    end do

gwt_gwt_cf()

subroutine gwtgwtexchangemodule::gwt_gwt_cf ( class(gwtexchangetype)  this, integer(i4b), intent(in)  kiter  )

private

Parameters

this	GwfExchangeType

Definition at line 357 of file exg-gwtgwt.f90.

    class(GwtExchangeType) :: this !<  GwfExchangeType
    integer(I4B), intent(in) :: kiter
    ! local
    real(DP), dimension(:), pointer, contiguous :: x_m1, x_m2
 
    ! call mvt cf routine
    if (this%inmvt > 0) then
      x_m1 => null()
      x_m2 => null()
      if (associated(this%gwtmodel1)) x_m1 => this%gwtmodel1%x
      if (associated(this%gwtmodel2)) x_m2 => this%gwtmodel2%x
      call this%mvt%xmvt_cf(x_m1, x_m2)
    end if
 

gwt_gwt_connects_model()

logical(lgp) function gwtgwtexchangemodule::gwt_gwt_connects_model ( class(gwtexchangetype)  this, class(basemodeltype), intent(in), pointer  model  )

private

Parameters

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

Returns

true, when connected

Definition at line 1047 of file exg-gwtgwt.f90.

    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    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.
    !
    ! only connected when model is GwtModelType of course
    select type (model)
    class is (gwtmodeltype)
      if (associated(this%gwtmodel1, model)) then
        is_connected = .true.
      else if (associated(this%gwtmodel2, model)) then
        is_connected = .true.
      end if
    end select

gwt_gwt_da()

subroutine gwtgwtexchangemodule::gwt_gwt_da

(

class(gwtexchangetype)

this

)

Deallocate memory associated with this object

Parameters

this	GwtExchangeType

Definition at line 838 of file exg-gwtgwt.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    !
    ! -- objects
    if (this%inmvt > 0) then
      call this%mvt%mvt_da()
      deallocate (this%mvt)
    end if
    call this%obs%obs_da()
    deallocate (this%obs)
    !
    ! -- arrays
    call mem_deallocate(this%cond)
    call mem_deallocate(this%simvals)
    call mem_deallocate(this%gwfsimvals, 'GWFSIMVALS', this%memoryPath) ! linked memory
    !
    ! -- output table objects
    if (associated(this%outputtab1)) then
      call this%outputtab1%table_da()
      deallocate (this%outputtab1)
      nullify (this%outputtab1)
    end if
    if (associated(this%outputtab2)) then
      call this%outputtab2%table_da()
      deallocate (this%outputtab2)
      nullify (this%outputtab2)
    end if
    !
    ! -- scalars
    deallocate (this%filename)
    call mem_deallocate(this%inewton)
    call mem_deallocate(this%inobs)
    call mem_deallocate(this%iAdvScheme)
    call mem_deallocate(this%inmvt)
    !
    ! -- deallocate base
    call this%DisConnExchangeType%disconnex_da()

gwt_gwt_df()

subroutine gwtgwtexchangemodule::gwt_gwt_df

(

class(gwtexchangetype)

this

)

Define GWT to GWT exchange object.

Parameters

this	GwtExchangeType

Definition at line 196 of file exg-gwtgwt.f90.

    ! -- modules
    use simvariablesmodule, only: iout
    use inputoutputmodule, only: getunit, openfile
    use ghostnodemodule, only: gnc_cr
    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    ! -- local
    !
    ! -- log the exchange
    write (iout, '(/a,a)') ' Creating exchange: ', this%name
    !
    ! -- Ensure models are in same solution
    if (this%v_model1%idsoln%get() /= this%v_model2%idsoln%get()) then
      call store_error('Two models are connected in a GWT '// &
                       'exchange but they are in different solutions. '// &
                       'GWT models must be in same solution: '// &
                       trim(this%v_model1%name)//' '// &
                       trim(this%v_model2%name))
      call store_error_filename(this%filename)
    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)
    !
    ! -- Read mover information
    if (this%inmvt > 0) then
      call this%read_mvt(iout)
      if (this%v_model1%is_local) then
        call this%mvt%mvt_df(this%gwtmodel1%dis)
      else
        call this%mvt%mvt_df(this%gwtmodel2%dis)
      end if
    end if
    !
    ! -- Store obs
    call this%gwt_gwt_df_obs()
    if (associated(this%gwtmodel1)) then
      call this%obs%obs_df(iout, this%name, 'GWT-GWT', this%gwtmodel1%dis)
    end if
    !
    ! -- validate
    call this%validate_exchange()

Here is the call graph for this function:

gwt_gwt_df_obs()

subroutine gwtgwtexchangemodule::gwt_gwt_df_obs

(

class(gwtexchangetype)

this

)

Define the observations associated with this object

Parameters

this	GwtExchangeType

Definition at line 952 of file exg-gwtgwt.f90.

    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    ! -- local
    integer(I4B) :: indx
    !
    ! -- Store obs type and assign procedure pointer
    !    for gwt-gwt observation type.
    call this%obs%StoreObsType('flow-ja-face', .true., indx)
    this%obs%obsData(indx)%ProcessIdPtr => gwt_gwt_process_obsid

Here is the call graph for this function:

gwt_gwt_fc()

subroutine gwtgwtexchangemodule::gwt_gwt_fc ( class(gwtexchangetype)  this, integer(i4b), intent(in)  kiter, class(matrixbasetype), pointer  matrix_sln, real(dp), dimension(:), intent(inout)  rhs_sln, integer(i4b), intent(in), optional  inwtflag  )

private

Calculate conductance and fill coefficient matrix

Parameters

this	GwtExchangeType

Definition at line 378 of file exg-gwtgwt.f90.

    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    integer(I4B), intent(in) :: kiter
    class(MatrixBaseType), pointer :: matrix_sln
    real(DP), dimension(:), intent(inout) :: rhs_sln
    integer(I4B), optional, intent(in) :: inwtflag
    ! local
    real(DP), dimension(:), pointer, contiguous :: x_m1, x_m2
    !
    ! -- Call mvt fc routine
    if (this%inmvt > 0) then
      x_m1 => null()
      x_m2 => null()
      if (associated(this%gwtmodel1)) x_m1 => this%gwtmodel1%x
      if (associated(this%gwtmodel2)) x_m2 => this%gwtmodel2%x
      call this%mvt%mvt_fc(x_m1, x_m2)
    end if

gwt_gwt_fp()

subroutine gwtgwtexchangemodule::gwt_gwt_fp

(

class(gwtexchangetype)

this

)

Conduct any final processing

Parameters

this	GwtExchangeType

Definition at line 1039 of file exg-gwtgwt.f90.

    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType

gwt_gwt_ot()

subroutine gwtgwtexchangemodule::gwt_gwt_ot

(

class(gwtexchangetype)

this

)

Write output

Parameters

this	GwtExchangeType

Definition at line 646 of file exg-gwtgwt.f90.

    ! -- modules
    use simvariablesmodule, only: iout
    use constantsmodule, only: dzero
    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    ! -- local
    integer(I4B) :: iexg, n1, n2
    integer(I4B) :: ibudfl
    real(DP) :: flow
    character(len=LINELENGTH) :: node1str, node2str
    ! -- format
    character(len=*), parameter :: fmtheader = &
     "(/1x, 'SUMMARY OF EXCHANGE RATES FOR EXCHANGE ', a, ' WITH ID ', i0, /, &
       &2a16, 5a16, /, 112('-'))"
    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%gwt_gwt_bdsav()
    !
    ! -- Write a table of exchanges
    if (this%iprflow /= 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%v_model1%dis_noder_to_string(n1, node1str)
        call this%v_model2%dis_noder_to_string(n2, node2str)
        write (iout, fmtdata) trim(adjustl(node1str)), &
          trim(adjustl(node2str)), &
          this%cond(iexg), this%v_model1%x%get(n1), &
          this%v_model2%x%get(n2), flow
      end do
    end if
    !
    !cdl Implement when MVT is ready
    ! -- Mover budget output
    ibudfl = 1
    if (this%inmvt > 0) call this%mvt%mvt_ot_bdsummary(ibudfl)
    !
    ! -- OBS output
    call this%obs%obs_ot()

gwt_gwt_process_obsid()

subroutine gwtgwtexchangemodule::gwt_gwt_process_obsid	(	type(observetype), intent(inout)	obsrv,
		class(disbasetype), intent(in)	dis,
		integer(i4b), intent(in)	inunitobs,
		integer(i4b), intent(in)	iout
	)

Process observations for this exchange

Definition at line 1134 of file exg-gwtgwt.f90.

    ! -- modules
    use constantsmodule, only: linelength
    use inputoutputmodule, only: urword
    use observemodule, only: observetype
    use basedismodule, only: disbasetype
    ! -- dummy
    type(ObserveType), intent(inout) :: obsrv
    class(DisBaseType), intent(in) :: dis
    integer(I4B), intent(in) :: inunitobs
    integer(I4B), intent(in) :: iout
    ! -- local
    integer(I4B) :: n, iexg, istat
    integer(I4B) :: icol, istart, istop
    real(DP) :: r
    character(len=LINELENGTH) :: string
    !
    string = obsrv%IDstring
    icol = 1
    ! -- get exchange index
    call urword(string, icol, istart, istop, 1, n, r, iout, inunitobs)
    read (string(istart:istop), '(i10)', iostat=istat) iexg
    if (istat == 0) then
      obsrv%intPak1 = iexg
    else
      ! Integer can't be read from string; it's presumed to be an exchange
      ! boundary name (already converted to uppercase)
      obsrv%FeatureName = trim(adjustl(string))
      ! -- Observation may require summing rates from multiple exchange
      !    boundaries, so assign intPak1 as a value that indicates observation
      !    is for a named exchange boundary or group of exchange boundaries.
      obsrv%intPak1 = namedboundflag
    end if

Here is the call graph for this function:

Here is the caller graph for this function:

gwt_gwt_rp()

subroutine gwtgwtexchangemodule::gwt_gwt_rp ( class(gwtexchangetype)  this )

private

Read new data for mover and obs

Parameters

this	GwtExchangeType

Definition at line 326 of file exg-gwtgwt.f90.

    ! -- modules
    use tdismodule, only: readnewdata
    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    !
    ! -- Check with TDIS on whether or not it is time to RP
    if (.not. readnewdata) return
    !
    ! -- Read and prepare for mover
    if (this%inmvt > 0) call this%mvt%mvt_rp()
    !
    ! -- Read and prepare for observations
    call this%gwt_gwt_rp_obs()

gwt_gwt_rp_obs()

subroutine gwtgwtexchangemodule::gwt_gwt_rp_obs ( class(gwtexchangetype)  this )

private

Handle observation exchanges exchange-boundary names.

Parameters

this	GwtExchangeType

Definition at line 968 of file exg-gwtgwt.f90.

    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    ! -- local
    integer(I4B) :: i
    integer(I4B) :: j
    class(ObserveType), pointer :: obsrv => null()
    character(len=LENBOUNDNAME) :: bname
    logical :: jfound
    ! -- formats
10  format('Exchange "', a, '" for observation "', a, &
           '" is invalid in package "', a, '"')
20  format('Exchange id "', i0, '" for observation "', a, &
           '" is invalid in package "', a, '"')
    !
    do i = 1, this%obs%npakobs
      obsrv => this%obs%pakobs(i)%obsrv
      !
      ! -- indxbnds needs to be reset each stress period because
      !    list of boundaries can change each stress period.
      ! -- Not true for exchanges, but leave this in for now anyway.
      call obsrv%ResetObsIndex()
      obsrv%BndFound = .false.
      !
      bname = obsrv%FeatureName
      if (bname /= '') then
        ! -- Observation location(s) is(are) based on a boundary name.
        !    Iterate through all boundaries to identify and store
        !    corresponding index(indices) in bound array.
        jfound = .false.
        do j = 1, this%nexg
          if (this%boundname(j) == bname) then
            jfound = .true.
            obsrv%BndFound = .true.
            obsrv%CurrentTimeStepEndValue = dzero
            call obsrv%AddObsIndex(j)
          end if
        end do
        if (.not. jfound) then
          write (errmsg, 10) trim(bname), trim(obsrv%ObsTypeId), trim(this%name)
          call store_error(errmsg)
        end if
      else
        ! -- Observation location is a single exchange number
        if (obsrv%intPak1 <= this%nexg .and. obsrv%intPak1 > 0) then
          jfound = .true.
          obsrv%BndFound = .true.
          obsrv%CurrentTimeStepEndValue = dzero
          call obsrv%AddObsIndex(obsrv%intPak1)
        else
          jfound = .false.
        end if
        if (.not. jfound) then
          write (errmsg, 20) obsrv%intPak1, trim(obsrv%ObsTypeId), trim(this%name)
          call store_error(errmsg)
        end if
      end if
    end do
    !
    ! -- write summary of error messages
    if (count_errors() > 0) then
      call store_error_filename(this%obs%inputFilename)
    end if

Here is the call graph for this function:

gwt_gwt_save_simvals()

subroutine gwtgwtexchangemodule::gwt_gwt_save_simvals ( class(gwtexchangetype), intent(inout)  this )

private

Save the simulated flows for each exchange

Definition at line 1090 of file exg-gwtgwt.f90.

    ! -- dummy
    use simvariablesmodule, only: errmsg
    use constantsmodule, only: dzero
    use observemodule, only: observetype
    class(GwtExchangeType), 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 gwt-gwt 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_filename(this%obs%inputFilename)
          end select
          call this%obs%SaveOneSimval(obsrv, v)
        end do
      end do
    end if

Here is the call graph for this function:

gwtexchange_create()

subroutine, public gwtgwtexchangemodule::gwtexchange_create	(	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 GWT to GWT exchange object.

Parameters

[in]	filename	filename for reading
[in]	id	id for the exchange
	name	the exchange name
[in]	m1_id	id for model 1
[in]	m2_id	id for model 2

Definition at line 111 of file exg-gwtgwt.f90.

    ! -- modules
    use basemodelmodule, only: basemodeltype
    use listsmodule, only: baseexchangelist
    use obsmodule, only: obs_cr
    use memoryhelpermodule, only: create_mem_path
    ! -- dummy
    character(len=*), intent(in) :: filename !< filename for reading
    integer(I4B), intent(in) :: id !< id for the exchange
    character(len=*) :: name !< the exchange name
    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(GwtExchangeType), 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 = 'GWT-GWT'
    exchange%iAdvScheme = 0
    exchange%ixt3d = 1
    !
    ! -- set gwtmodel1
    m1_index = model_loc_idx(m1_id)
    mb => getbasemodelfromlist(basemodellist, m1_index)
    if (m1_index > 0) then
      select type (mb)
      type is (gwtmodeltype)
        exchange%model1 => mb
        exchange%gwtmodel1 => mb
      end select
    end if
    exchange%v_model1 => get_virtual_model(m1_id)
    !
    ! -- set gwtmodel2
    m2_index = model_loc_idx(m2_id)
    if (m2_index > 0) then
      mb => getbasemodelfromlist(basemodellist, m2_index)
      select type (mb)
      type is (gwtmodeltype)
        exchange%model2 => mb
        exchange%gwtmodel2 => mb
      end select
    end if
    exchange%v_model2 => get_virtual_model(m2_id)
    !
    ! -- Verify that gwt model1 is of the correct type
    if (.not. associated(exchange%gwtmodel1) .and. m1_index > 0) then
      write (errmsg, '(3a)') 'Problem with GWT-GWT exchange ', &
        trim(exchange%name), &
        '.  First specified GWT Model does not appear to be of the correct type.'
      call store_error(errmsg, terminate=.true.)
    end if
    !
    ! -- Verify that gwt model2 is of the correct type
    if (.not. associated(exchange%gwtmodel2) .and. m2_index > 0) then
      write (errmsg, '(3a)') 'Problem with GWT-GWT exchange ', &
        trim(exchange%name), &
        '.  Second specified GWT 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)

Here is the call graph for this function:

Here is the caller graph for this function:

read_mvt()

subroutine gwtgwtexchangemodule::read_mvt	(	class(gwtexchangetype)	this,
		integer(i4b), intent(in)	iout
	)

Read and process movers

Parameters

this	GwtExchangeType

Definition at line 793 of file exg-gwtgwt.f90.

    ! -- modules
    use tspmvtmodule, only: mvt_cr
    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    integer(I4B), intent(in) :: iout
    ! -- local
    class(TransportModelType), pointer :: tspmodel1, tspmodel2
    !
    ! -- Create and initialize the mover object
    tspmodel1 => this%gwtmodel1
    tspmodel2 => this%gwtmodel2
    call xmvt_cr(this%mvt, this%name, tspmodel1, tspmodel2, &
                 this%gwfmodelname1, this%gwfmodelname2, this%inmvt, iout)
 

Here is the call graph for this function:

source_options()

subroutine gwtgwtexchangemodule::source_options	(	class(gwtexchangetype)	this,
		integer(i4b), intent(in)	iout
	)

Source the options block

Parameters

this	GwtExchangeType

Definition at line 700 of file exg-gwtgwt.f90.

    ! -- modules
    use constantsmodule, only: lenvarname
    use inputoutputmodule, only: getunit, openfile
    use memorymanagerextmodule, only: mem_set_value
    use characterstringmodule, only: characterstringtype
    use exggwtgwtinputmodule, only: exggwtgwtparamfoundtype
    use sourcecommonmodule, only: filein_fname
    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    integer(I4B), intent(in) :: iout
    ! -- local
    type(ExgGwtgwtParamFoundType) :: found
    character(len=LENVARNAME), dimension(4) :: adv_scheme = &
      &[character(len=LENVARNAME) :: 'UPSTREAM', 'CENTRAL', 'TVD', 'UTVD']
    character(len=linelength) :: mvt_fname
    !
    ! -- update defaults with values sourced from input context
    call mem_set_value(this%gwfmodelname1, 'GWFMODELNAME1', this%input_mempath, &
                       found%gwfmodelname1)
    call mem_set_value(this%gwfmodelname2, 'GWFMODELNAME2', this%input_mempath, &
                       found%gwfmodelname2)
    call mem_set_value(this%iAdvScheme, 'ADV_SCHEME', this%input_mempath, &
                       adv_scheme, found%adv_scheme)
    call mem_set_value(this%ixt3d, 'DSP_XT3D_OFF', this%input_mempath, &
                       found%dsp_xt3d_off)
    call mem_set_value(this%ixt3d, 'DSP_XT3D_RHS', this%input_mempath, &
                       found%dsp_xt3d_rhs)
    !
    write (iout, '(1x,a)') 'PROCESSING GWT-GWT EXCHANGE OPTIONS'
    !
    ! -- source base class options
    call this%DisConnExchangeType%source_options(iout)
    !
    if (found%gwfmodelname1) then
      write (iout, '(4x,a,a)') &
        'GWFMODELNAME1 IS SET TO: ', trim(this%gwfmodelname1)
    end if
    !
    if (found%gwfmodelname2) then
      write (iout, '(4x,a,a)') &
        'GWFMODELNAME2 IS SET TO: ', trim(this%gwfmodelname2)
    end if
    !
    if (found%adv_scheme) then
      if (this%iAdvScheme == 0) then
        call store_error('Unrecognized input value for ADV_SCHEME option.')
        call store_error_filename(this%filename)
      else
        ! -- count from 0
        this%iAdvScheme = this%iAdvScheme - 1
        write (iout, '(4x,a,a)') &
          'ADVECTION SCHEME METHOD HAS BEEN SET TO: ', &
          trim(adv_scheme(this%iAdvScheme + 1))
      end if
    end if
    !
    if (found%dsp_xt3d_off .and. found%dsp_xt3d_rhs) then
      errmsg = 'DSP_XT3D_OFF and DSP_XT3D_RHS cannot both be set as options.'
      call store_error(errmsg)
      call store_error_filename(this%filename)
    else if (found%dsp_xt3d_off) then
      this%ixt3d = 0
      write (iout, '(4x,a)') 'XT3D FORMULATION HAS BEEN SHUT OFF.'
    else if (found%dsp_xt3d_rhs) then
      this%ixt3d = 2
      write (iout, '(4x,a)') 'XT3D RIGHT-HAND SIDE FORMULATION IS SELECTED.'
    end if
    !
    ! -- enforce 0 or 1 MVR6_FILENAME entries in option block
    if (filein_fname(mvt_fname, 'MVT6_FILENAME', this%input_mempath, &
                     this%filename)) then
      this%inmvt = getunit()
      call openfile(this%inmvt, iout, mvt_fname, 'MVT')
      write (iout, '(4x,a)') &
        'WATER MOVER TRANSPORT INFORMATION WILL BE READ FROM ', trim(mvt_fname)
    end if
    !
    ! -- enforce 0 or 1 OBS6_FILENAME entries in option block
    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
    !
    write (iout, '(1x,a)') 'END OF GWT-GWT EXCHANGE OPTIONS'

Here is the call graph for this function:

use_interface_model()

logical(lgp) function gwtgwtexchangemodule::use_interface_model ( class(gwtexchangetype)  this )

private

For now this always returns true, since we do not support a classic-style two-point flux approximation for GWT-GWT. If we ever add logic to support a simpler non-interface model flux calculation, then logic should be added here to set the return accordingly.

Parameters

this	GwtExchangeType

Returns

true when interface model should be used

Definition at line 1075 of file exg-gwtgwt.f90.

    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    ! -- return
    logical(LGP) :: use_im !< true when interface model should be used
    !
    ! For now set use_im to .true. since the interface model approach
    ! must currently be used for any GWT-GWT exchange.
    use_im = .true.

validate_exchange()

subroutine gwtgwtexchangemodule::validate_exchange

(

class(gwtexchangetype)

this

)

Parameters

this	GwtExchangeType

Definition at line 252 of file exg-gwtgwt.f90.

    ! -- dummy
    class(GwtExchangeType) :: this !<  GwtExchangeType
    !
    ! Ensure gwfmodel names were entered
    if (this%gwfmodelname1 == '') then
      write (errmsg, '(3a)') 'GWT-GWT exchange ', trim(this%name), &
                            ' requires that GWFMODELNAME1 be entered in the &
                            &OPTIONS block.'
      call store_error(errmsg)
    end if
    if (this%gwfmodelname2 == '') then
      write (errmsg, '(3a)') 'GWT-GWT exchange ', trim(this%name), &
                            ' requires that GWFMODELNAME2 be entered in the &
                            &OPTIONS block.'
      call store_error(errmsg)
    end if
    !
    ! Periodic boundary condition in exchange don't allow XT3D (=interface model)
    if (this%v_model1 == this%v_model2) then
      if (this%ixt3d > 0) then
        write (errmsg, '(3a)') 'GWT-GWT exchange ', trim(this%name), &
          ' is a periodic boundary condition which cannot'// &
          ' be configured with XT3D'
        call store_error(errmsg)
      end if
    end if
    !
    ! Check to see if dispersion is on in either model1 or model2.
    ! If so, then ANGLDEGX must be provided as an auxiliary variable for this
    ! GWT-GWT exchange (this%ianglex > 0).
    if (associated(this%gwtmodel1) .and. associated(this%gwtmodel2)) then
      if (this%gwtmodel1%indsp /= 0 .or. this%gwtmodel2%indsp /= 0) then
        if (this%ianglex == 0) then
          write (errmsg, '(3a)') 'GWT-GWT exchange ', trim(this%name), &
            ' requires that ANGLDEGX be specified as an'// &
            ' auxiliary variable because dispersion was '// &
            'specified in one or both transport models.'
          call store_error(errmsg)
        end if
      end if
    end if
    !
    if (this%ixt3d > 0 .and. this%ianglex == 0) then
      write (errmsg, '(3a)') 'GWT-GWT exchange ', trim(this%name), &
        ' requires that ANGLDEGX be specified as an'// &
        ' auxiliary variable because XT3D is enabled'
      call store_error(errmsg)
    end if
    !
    if (count_errors() > 0) then
      call ustop()
    end if

Here is the call graph for this function: