tspfmimodule Module Reference

Data Types
type	dataadvancedpackagetype
type	budobjptrarray
type	tspfmitype

Functions/Subroutines
subroutine, public	fmi_cr (fmiobj, name_model, input_mempath, inunit, iout, eqnsclfac, depvartype)
	Create a new FMI object. More...
subroutine	fmi_rp (this, inmvr)
	Read and prepare. More...
subroutine	fmi_ad (this, cnew)
	Advance routine for FMI object. More...
subroutine	fmi_fc (this, nodes, cold, nja, matrix_sln, idxglo, rhs)
	Calculate coefficients and fill matrix and rhs terms associated with FMI object. More...
subroutine	fmi_cq (this, cnew, flowja)
	Calculate flow correction. More...
subroutine	fmi_bd (this, isuppress_output, model_budget)
	Calculate budget terms associated with FMI object. More...
subroutine	fmi_ot_flow (this, icbcfl, icbcun)
	Save budget terms associated with FMI object. More...
subroutine	gwtfmi_da (this)
	Deallocate variables. More...
subroutine	gwtfmi_allocate_scalars (this)
	@ brief Allocate scalars More...
subroutine	gwtfmi_allocate_arrays (this, nodes)
	@ brief Allocate arrays for FMI object More...
subroutine	set_active_status (this, cnew)
	Set gwt transport cell status. More...
real(dp) function	gwfsatold (this, n, delt)
	Calculate the previous saturation level. More...
subroutine	gwtfmi_source_options (this)
	@ brief Source input options for package More...
subroutine	gwtfmi_source_packagedata (this)
	@ brief Source input options for package More...
subroutine	set_aptbudobj_pointer (this, name, budobjptr)
	Set the pointer to a budget object. More...
subroutine	initialize_gwfterms_from_bfr (this)
	Initialize the groundwater flow terms based on the budget file reader. More...
subroutine	initialize_gwfterms_from_gwfbndlist (this)
	Initialize groundwater flow terms from the groundwater budget. More...
subroutine	gwtfmi_allocate_gwfpackages (this, ngwfterms)
	Initialize an array for storing PackageBudget objects. More...
subroutine	gwtfmi_deallocate_gwfpackages (this)
	Deallocate memory. More...

Variables
character(len=lenpackagename)	text = ' GWTFMI'
integer(i4b), parameter	nbditems = 2
character(len=lenbudtxt), dimension(nbditems)	budtxt

Function/Subroutine Documentation

fmi_ad()

subroutine tspfmimodule::fmi_ad	(	class(tspfmitype)	this,
		real(dp), dimension(:), intent(inout)	cnew
	)

Definition at line 137 of file tsp-fmi.f90.

    ! -- modules
    use constantsmodule, only: dhdry
    ! -- dummy
    class(TspFmiType) :: this
    real(DP), intent(inout), dimension(:) :: cnew
    ! -- local
    integer(I4B) :: n
    character(len=*), parameter :: fmtdry = &
     &"(/1X,'WARNING: DRY CELL ENCOUNTERED AT ',a,';  RESET AS INACTIVE &
     &WITH DRY CONCENTRATION = ', G13.5)"
    character(len=*), parameter :: fmtrewet = &
     &"(/1X,'DRY CELL REACTIVATED AT ', a,&
     &' WITH STARTING CONCENTRATION =',G13.5)"
    !
    ! -- Set flag to indicated that flows are being updated.  For the case where
    !    flows may be reused (only when flows are read from a file) then set
    !    the flag to zero to indicate that flows were not updated
    this%iflowsupdated = 1
    !
    ! -- If reading flows from a budget file, read the next set of records
    if (this%iubud /= 0) then
      call this%advance_bfr()
    end if
    !
    ! -- If reading heads from a head file, read the next set of records
    if (this%iuhds /= 0) then
      call this%advance_hfr()
    end if
    !
    ! -- If mover flows are being read from file, read the next set of records
    if (this%iumvr /= 0) then
      call this%mvrbudobj%bfr_advance(this%dis, this%iout)
    end if
    !
    ! -- If advanced package flows are being read from file, read the next set of records
    if (this%flows_from_file .and. this%inunit /= 0) then
      do n = 1, size(this%aptbudobj)
        call this%aptbudobj(n)%ptr%bfr_advance(this%dis, this%iout)
      end do
    end if
    !
    ! -- set inactive transport cell status
    if (this%idryinactive /= 0) then
      call this%set_active_status(cnew)
    end if

fmi_bd()

subroutine tspfmimodule::fmi_bd ( class(tspfmitype)  this, integer(i4b), intent(in)  isuppress_output, type(budgettype), intent(inout)  model_budget  )

private

Definition at line 250 of file tsp-fmi.f90.

    ! -- modules
    use tdismodule, only: delt
    use budgetmodule, only: budgettype, rate_accumulator
    ! -- dummy
    class(TspFmiType) :: this
    integer(I4B), intent(in) :: isuppress_output
    type(BudgetType), intent(inout) :: model_budget
    ! -- local
    real(DP) :: rin
    real(DP) :: rout
    !
    ! -- flow correction
    if (this%iflowerr /= 0) then
      call rate_accumulator(this%flowcorrect, rin, rout)
      call model_budget%addentry(rin, rout, delt, budtxt(2), isuppress_output)
    end if

Here is the call graph for this function:

fmi_cq()

subroutine tspfmimodule::fmi_cq ( class(tspfmitype)  this, real(dp), dimension(:), intent(in)  cnew, real(dp), dimension(:), intent(inout), contiguous  flowja  )

private

Where there is a flow imbalance for a given cell, a correction may be applied if selected

Definition at line 221 of file tsp-fmi.f90.

    ! -- modules
    ! -- dummy
    class(TspFmiType) :: this
    real(DP), intent(in), dimension(:) :: cnew
    real(DP), dimension(:), contiguous, intent(inout) :: flowja
    ! -- local
    integer(I4B) :: n
    integer(I4B) :: idiag
    real(DP) :: rate
    !
    ! -- If not adding flow error correction, return
    if (this%iflowerr /= 0) then
      !
      ! -- Accumulate the flow correction term
      do n = 1, this%dis%nodes
        rate = dzero
        idiag = this%dis%con%ia(n)
        if (this%ibound(n) > 0) then
          rate = -this%gwfflowja(idiag) * cnew(n) * this%eqnsclfac
        end if
        this%flowcorrect(n) = rate
        flowja(idiag) = flowja(idiag) + rate
      end do
    end if

fmi_cr()

subroutine, public tspfmimodule::fmi_cr	(	type(tspfmitype), pointer	fmiobj,
		character(len=*), intent(in)	name_model,
		character(len=*), intent(in)	input_mempath,
		integer(i4b), intent(in)	inunit,
		integer(i4b), intent(in)	iout,
		real(dp), intent(in), pointer	eqnsclfac,
		character(len=lenvarname), intent(in)	depvartype
	)

Parameters

[in]

eqnsclfac

governing equation scale factor

Definition at line 74 of file tsp-fmi.f90.

    ! -- dummy
    type(TspFmiType), pointer :: fmiobj
    character(len=*), intent(in) :: name_model
    character(len=*), intent(in) :: input_mempath
    integer(I4B), intent(in) :: inunit
    integer(I4B), intent(in) :: iout
    real(DP), intent(in), pointer :: eqnsclfac !< governing equation scale factor
    character(len=LENVARNAME), intent(in) :: depvartype
    !
    ! -- Create the object
    allocate (fmiobj)
    !
    ! -- create name and memory path
    call fmiobj%set_names(1, name_model, 'FMI', 'FMI', input_mempath)
    fmiobj%text = text
    !
    ! -- Allocate scalars
    call fmiobj%allocate_scalars()
    !
    ! -- Set variables
    fmiobj%inunit = inunit
    fmiobj%iout = iout
    !
    ! -- Assign label based on dependent variable
    fmiobj%depvartype = depvartype
    !
    ! -- Store pointer to governing equation scale factor
    fmiobj%eqnsclfac => eqnsclfac

Here is the caller graph for this function:

fmi_fc()

subroutine tspfmimodule::fmi_fc	(	class(tspfmitype)	this,
		integer, intent(in)	nodes,
		real(dp), dimension(nodes), intent(in)	cold,
		integer(i4b), intent(in)	nja,
		class(matrixbasetype), pointer	matrix_sln,
		integer(i4b), dimension(nja), intent(in)	idxglo,
		real(dp), dimension(nodes), intent(inout)	rhs
	)

Definition at line 188 of file tsp-fmi.f90.

    ! -- dummy
    class(TspFmiType) :: this
    integer, intent(in) :: nodes
    real(DP), intent(in), dimension(nodes) :: cold
    integer(I4B), intent(in) :: nja
    class(MatrixBaseType), pointer :: matrix_sln
    integer(I4B), intent(in), dimension(nja) :: idxglo
    real(DP), intent(inout), dimension(nodes) :: rhs
    ! -- local
    integer(I4B) :: n, idiag, idiag_sln
    real(DP) :: qcorr
    !
    ! -- Calculate the flow imbalance error and make a correction for it
    if (this%iflowerr /= 0) then
      !
      ! -- Correct the transport solution for the flow imbalance by adding
      !    the flow residual to the diagonal
      do n = 1, nodes
        idiag = this%dis%con%ia(n)
        idiag_sln = idxglo(idiag)
        !call matrix_sln%add_value_pos(idiag_sln, -this%gwfflowja(idiag))
        qcorr = -this%gwfflowja(idiag) * this%eqnsclfac
        call matrix_sln%add_value_pos(idiag_sln, qcorr)
      end do
    end if

fmi_ot_flow()

subroutine tspfmimodule::fmi_ot_flow	(	class(tspfmitype)	this,
		integer(i4b), intent(in)	icbcfl,
		integer(i4b), intent(in)	icbcun
	)

Definition at line 271 of file tsp-fmi.f90.

    ! -- dummy
    class(TspFmiType) :: this
    integer(I4B), intent(in) :: icbcfl
    integer(I4B), intent(in) :: icbcun
    ! -- local
    integer(I4B) :: ibinun
    integer(I4B) :: iprint, nvaluesp, nwidthp
    character(len=1) :: cdatafmp = ' ', editdesc = ' '
    real(DP) :: dinact
    !
    ! -- Set unit number for binary output
    if (this%ipakcb < 0) then
      ibinun = icbcun
    elseif (this%ipakcb == 0) then
      ibinun = 0
    else
      ibinun = this%ipakcb
    end if
    if (icbcfl == 0) ibinun = 0
    !
    ! -- Do not save flow corrections if not active
    if (this%iflowerr == 0) ibinun = 0
    !
    ! -- Record the storage rates if requested
    if (ibinun /= 0) then
      iprint = 0
      dinact = dzero
      !
      ! -- flow correction
      call this%dis%record_array(this%flowcorrect, this%iout, iprint, -ibinun, &
                                 budtxt(2), cdatafmp, nvaluesp, &
                                 nwidthp, editdesc, dinact)
    end if

fmi_rp()

subroutine tspfmimodule::fmi_rp ( class(tspfmitype)  this, integer(i4b), intent(in)  inmvr  )

private

Definition at line 108 of file tsp-fmi.f90.

    ! -- modules
    use tdismodule, only: kper, kstp
    ! -- dummy
    class(TspFmiType) :: this
    integer(I4B), intent(in) :: inmvr
    ! -- local
    ! -- formats
    !
    ! --Check to make sure MVT Package is active if mvr flows are available.
    !   This cannot be checked until RP because exchange doesn't set a pointer
    !   to mvrbudobj until exg_ar().
    if (kper * kstp == 1) then
      if (associated(this%mvrbudobj) .and. inmvr == 0) then
        write (errmsg, '(a)') 'GWF water mover is active but the GWT MVT &
          &package has not been specified.  activate GWT MVT package.'
        call store_error(errmsg, terminate=.true.)
      end if
      if (.not. associated(this%mvrbudobj) .and. inmvr > 0) then
        write (errmsg, '(a)') 'GWF water mover terms are not available &
          &but the GWT MVT package has been activated.  Activate GWF-GWT &
          &exchange or specify GWFMOVER in FMI PACKAGEDATA.'
        call store_error(errmsg, terminate=.true.)
      end if
    end if

Here is the call graph for this function:

gwfsatold()

real(dp) function tspfmimodule::gwfsatold	(	class(tspfmitype)	this,
		integer(i4b), intent(in)	n,
		real(dp), intent(in)	delt
	)

Calculate the groundwater cell head saturation for the end of the last time step

Definition at line 503 of file tsp-fmi.f90.

    ! -- modules
    ! -- dummy
    class(TspFmiType) :: this
    integer(I4B), intent(in) :: n
    real(DP), intent(in) :: delt
    ! -- result
    real(DP) :: satold
    ! -- local
    real(DP) :: vcell
    real(DP) :: vnew
    real(DP) :: vold
    !
    ! -- calculate the value
    vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
    vnew = vcell * this%gwfsat(n)
    vold = vnew
    if (this%igwfstrgss /= 0) vold = vold + this%gwfstrgss(n) * delt
    if (this%igwfstrgsy /= 0) vold = vold + this%gwfstrgsy(n) * delt
    satold = vold / vcell

gwtfmi_allocate_arrays()

subroutine tspfmimodule::gwtfmi_allocate_arrays	(	class(tspfmitype)	this,
		integer(i4b), intent(in)	nodes
	)

Method to allocate arrays for the FMI package.

Definition at line 390 of file tsp-fmi.f90.

    use memorymanagermodule, only: mem_allocate
    ! -- modules
    use constantsmodule, only: dzero
    ! -- dummy
    class(TspFmiType) :: this
    integer(I4B), intent(in) :: nodes
    ! -- local
    integer(I4B) :: n
    !
    ! -- allocate parent arrays
    call this%FlowModelInterfaceType%allocate_arrays(nodes)
    !
    ! -- Allocate variables needed for all cases
    if (this%iflowerr == 0) then
      call mem_allocate(this%flowcorrect, 1, 'FLOWCORRECT', this%memoryPath)
    else
      call mem_allocate(this%flowcorrect, nodes, 'FLOWCORRECT', this%memoryPath)
    end if
    do n = 1, size(this%flowcorrect)
      this%flowcorrect(n) = dzero
    end do

gwtfmi_allocate_gwfpackages()

subroutine tspfmimodule::gwtfmi_allocate_gwfpackages	(	class(tspfmitype)	this,
		integer(i4b), intent(in)	ngwfterms
	)

This routine allocates gwfpackages (an array of PackageBudget objects) to the proper size and initializes member variables.

Definition at line 856 of file tsp-fmi.f90.

    ! -- modules
    use constantsmodule, only: lenmempath
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(TspFmiType) :: this
    integer(I4B), intent(in) :: ngwfterms
    ! -- local
    integer(I4B) :: n
    character(len=LENMEMPATH) :: memPath
    !
    ! -- direct allocate
    allocate (this%gwfpackages(ngwfterms))
    allocate (this%flowpacknamearray(ngwfterms))
    allocate (this%datp(ngwfterms))
    !
    ! -- mem_allocate
    call mem_allocate(this%iatp, ngwfterms, 'IATP', this%memoryPath)
    call mem_allocate(this%igwfmvrterm, ngwfterms, 'IGWFMVRTERM', this%memoryPath)
    !
    ! -- initialize
    this%nflowpack = ngwfterms
    do n = 1, this%nflowpack
      this%iatp(n) = 0
      this%igwfmvrterm(n) = 0
      this%flowpacknamearray(n) = ''
      !
      ! -- Create a mempath for each individual flow package data set
      !    of the form, MODELNAME/FMI-FTn
      write (mempath, '(a, i0)') trim(this%memoryPath)//'-FT', n
      call this%gwfpackages(n)%initialize(mempath)
    end do

gwtfmi_allocate_scalars()

subroutine tspfmimodule::gwtfmi_allocate_scalars

(

class(tspfmitype)

this

)

Allocate scalar variables for an FMI object

Definition at line 365 of file tsp-fmi.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate, mem_setptr
    ! -- dummy
    class(TspFmiType) :: this
    ! -- local
    !
    ! -- allocate scalars in parent
    call this%FlowModelInterfaceType%allocate_scalars()
    !
    ! -- Allocate
    call mem_allocate(this%iflowerr, 'IFLOWERR', this%memoryPath)
    !
    ! -- Although not a scalar, allocate the advanced package transport
    !    budget object to zero so that it can be dynamically resized later
    allocate (this%aptbudobj(0))
    !
    ! -- Initialize
    this%iflowerr = 0

gwtfmi_da()

subroutine tspfmimodule::gwtfmi_da ( class(tspfmitype)  this )

private

Deallocate memory associated with FMI object

Definition at line 311 of file tsp-fmi.f90.

    ! -- modules
    use memorymanagermodule, only: mem_deallocate
    ! -- dummy
    class(TspFmiType) :: this
    ! -- todo: finalize hfr and bfr either here or in a finalize routine
    !
    ! -- deallocate any memory stored with gwfpackages
    call this%deallocate_gwfpackages()
    !
    ! -- deallocate fmi arrays
    if (associated(this%datp)) then
      deallocate (this%datp)
      deallocate (this%gwfpackages)
      deallocate (this%flowpacknamearray)
      call mem_deallocate(this%iatp)
      call mem_deallocate(this%igwfmvrterm)
    end if
 
    deallocate (this%aptbudobj)
    call mem_deallocate(this%flowcorrect)
    call mem_deallocate(this%ibdgwfsat0)
    if (this%flows_from_file) then
      call mem_deallocate(this%gwfstrgss)
      call mem_deallocate(this%gwfstrgsy)
    end if
    !
    ! -- special treatment, these could be from mem_checkin
    call mem_deallocate(this%gwfhead, 'GWFHEAD', this%memoryPath)
    call mem_deallocate(this%gwfsat, 'GWFSAT', this%memoryPath)
    call mem_deallocate(this%gwfspdis, 'GWFSPDIS', this%memoryPath)
    call mem_deallocate(this%gwfflowja, 'GWFFLOWJA', this%memoryPath)
    !
    ! -- deallocate scalars
    call mem_deallocate(this%flows_from_file)
    call mem_deallocate(this%iflowsupdated)
    call mem_deallocate(this%iflowerr)
    call mem_deallocate(this%igwfstrgss)
    call mem_deallocate(this%igwfstrgsy)
    call mem_deallocate(this%iubud)
    call mem_deallocate(this%iuhds)
    call mem_deallocate(this%iumvr)
    call mem_deallocate(this%iugrb)
    call mem_deallocate(this%nflowpack)
    call mem_deallocate(this%idryinactive)
    !
    ! -- deallocate parent
    call this%NumericalPackageType%da()

gwtfmi_deallocate_gwfpackages()

subroutine tspfmimodule::gwtfmi_deallocate_gwfpackages

(

class(tspfmitype)

this

)

Deallocate memory that stores the gwfpackages array

Definition at line 894 of file tsp-fmi.f90.

    ! -- modules
    ! -- dummy
    class(TspFmiType) :: this
    ! -- local
    integer(I4B) :: n
    !
    ! -- initialize
    do n = 1, this%nflowpack
      call this%gwfpackages(n)%da()
    end do

gwtfmi_source_options()

subroutine tspfmimodule::gwtfmi_source_options ( class(tspfmitype)  this )

private

Definition at line 527 of file tsp-fmi.f90.

    ! -- modules
    use memorymanagerextmodule, only: mem_set_value
    ! -- dummy
    class(TspFmiType) :: this
    ! -- local
    logical(LGP) :: found_ipakcb, found_flowerr
    character(len=*), parameter :: fmtisvflow = &
      "(4x,'CELL-BY-CELL FLOW INFORMATION WILL BE SAVED TO BINARY FILE &
      &WHENEVER ICBCFL IS NOT ZERO AND FLOW IMBALANCE CORRECTION ACTIVE.')"
    character(len=*), parameter :: fmtifc = &
      &"(4x,'MASS WILL BE ADDED OR REMOVED TO COMPENSATE FOR FLOW IMBALANCE.')"
 
    write (this%iout, '(1x,a)') 'PROCESSING FMI OPTIONS'
 
    call mem_set_value(this%ipakcb, 'SAVE_FLOWS', this%input_mempath, &
                       found_ipakcb)
    call mem_set_value(this%iflowerr, 'IMBALANCECORRECT', this%input_mempath, &
                       found_flowerr)
 
    if (found_ipakcb) then
      this%ipakcb = -1
      write (this%iout, fmtisvflow)
    end if
    if (found_flowerr) write (this%iout, fmtifc)
 
    write (this%iout, '(1x,a)') 'END OF FMI OPTIONS'

gwtfmi_source_packagedata()

subroutine tspfmimodule::gwtfmi_source_packagedata

(

class(tspfmitype)

this

)

Definition at line 558 of file tsp-fmi.f90.

    ! -- modules
    use memorymanagermodule, only: mem_setptr
    use memorymanagerextmodule, only: mem_set_value
    use characterstringmodule, only: characterstringtype
    use openspecmodule, only: access, form
    use constantsmodule, only: linelength, dem6, lenpackagename
    use inputoutputmodule, only: getunit, openfile, urdaux
    ! -- dummy
    class(TspFmiType) :: this
    ! -- local
    type(CharacterStringType), dimension(:), contiguous, &
      pointer :: flowtypes
    type(CharacterStringType), dimension(:), contiguous, &
      pointer :: fileops
    type(CharacterStringType), dimension(:), contiguous, &
      pointer :: fnames
    type(BudgetObjectType), pointer :: budobjptr
    type(BudObjPtrArray), dimension(:), allocatable :: tmpbudobj
    character(len=LINELENGTH) :: flowtype, fileop, fname
    integer(I4B) :: iapt, inunit, n, i
    logical(LGP) :: exist
 
    iapt = 0
 
    call mem_setptr(flowtypes, 'FLOWTYPE', this%input_mempath)
    call mem_setptr(fileops, 'FILEIN', this%input_mempath)
    call mem_setptr(fnames, 'FNAME', this%input_mempath)
 
    do n = 1, size(flowtypes)
      flowtype = flowtypes(n)
      fileop = fileops(n)
      fname = fnames(n)
 
      inquire (file=trim(fname), exist=exist)
      if (.not. exist) then
        call store_error('Could not find file '//trim(fname))
        cycle
      end if
 
      if (fileop /= 'FILEIN') then
        call store_error('Unexpected packagedata input keyword read: "' &
                         //trim(fileop)//'".')
        cycle
      end if
 
      select case (flowtype)
      case ('GWFBUDGET')
        inunit = getunit()
        call openfile(inunit, this%iout, fname, 'DATA(BINARY)', form, &
                      access, 'UNKNOWN')
        this%iubud = inunit
        call this%initialize_bfr()
      case ('GWFHEAD')
        inunit = getunit()
        call openfile(inunit, this%iout, fname, 'DATA(BINARY)', form, &
                      access, 'UNKNOWN')
        this%iuhds = inunit
        call this%initialize_hfr()
      case ('GWFMOVER')
        inunit = getunit()
        call openfile(inunit, this%iout, fname, 'DATA(BINARY)', form, &
                      access, 'UNKNOWN')
        this%iumvr = inunit
        call budgetobject_cr_bfr(this%mvrbudobj, 'MVT', this%iumvr, &
                                 this%iout)
        call this%mvrbudobj%fill_from_bfr(this%dis, this%iout)
      case default
        !
        ! --expand the size of aptbudobj, which stores a pointer to the budobj
        allocate (tmpbudobj(iapt))
        do i = 1, size(this%aptbudobj)
          tmpbudobj(i)%ptr => this%aptbudobj(i)%ptr
        end do
        deallocate (this%aptbudobj)
        allocate (this%aptbudobj(iapt + 1))
        do i = 1, size(tmpbudobj)
          this%aptbudobj(i)%ptr => tmpbudobj(i)%ptr
        end do
        deallocate (tmpbudobj)
        !
        ! -- Open the budget file and start filling it
        iapt = iapt + 1
        inunit = getunit()
        call openfile(inunit, this%iout, fname, 'DATA(BINARY)', form, &
                      access, 'UNKNOWN')
        call budgetobject_cr_bfr(budobjptr, flowtype, inunit, &
                                 this%iout, colconv2=['GWF             '])
        call budobjptr%fill_from_bfr(this%dis, this%iout)
        this%aptbudobj(iapt)%ptr => budobjptr
      end select
    end do
 
    if (count_errors() > 0) then
      call store_error_filename(this%input_fname)
    end if

Here is the call graph for this function:

initialize_gwfterms_from_bfr()

subroutine tspfmimodule::initialize_gwfterms_from_bfr ( class(tspfmitype)  this )

private

Initialize terms and figure out how many different terms and packages are contained within the file

Definition at line 687 of file tsp-fmi.f90.

    ! -- modules
    use memorymanagermodule, only: mem_allocate
    ! -- dummy
    class(TspFmiType) :: this
    ! -- local
    integer(I4B) :: nflowpack
    integer(I4B) :: i, ip
    integer(I4B) :: naux
    logical :: found_flowja
    logical :: found_dataspdis
    logical :: found_datasat
    logical :: found_stoss
    logical :: found_stosy
    integer(I4B), dimension(:), allocatable :: imap
    !
    ! -- Calculate the number of gwf flow packages
    allocate (imap(this%bfr%nbudterms))
    imap(:) = 0
    nflowpack = 0
    found_flowja = .false.
    found_dataspdis = .false.
    found_datasat = .false.
    found_stoss = .false.
    found_stosy = .false.
    do i = 1, this%bfr%nbudterms
      select case (trim(adjustl(this%bfr%budtxtarray(i))))
      case ('FLOW-JA-FACE')
        found_flowja = .true.
      case ('DATA-SPDIS')
        found_dataspdis = .true.
      case ('DATA-SAT')
        found_datasat = .true.
      case ('STO-SS')
        found_stoss = .true.
        this%igwfstrgss = 1
      case ('STO-SY')
        found_stosy = .true.
        this%igwfstrgsy = 1
      case default
        nflowpack = nflowpack + 1
        imap(i) = 1
      end select
    end do
    !
    ! -- allocate gwfpackage arrays (gwfpackages, iatp, datp, ...)
    call this%allocate_gwfpackages(nflowpack)
    !
    ! -- Copy the package name and aux names from budget file reader
    !    to the gwfpackages derived-type variable
    ip = 1
    do i = 1, this%bfr%nbudterms
      if (imap(i) == 0) cycle
      call this%gwfpackages(ip)%set_name(this%bfr%dstpackagenamearray(i), &
                                         this%bfr%budtxtarray(i))
      naux = this%bfr%nauxarray(i)
      call this%gwfpackages(ip)%set_auxname(naux, &
                                            this%bfr%auxtxtarray(1:naux, i))
      ip = ip + 1
    end do
    !
    ! -- Copy just the package names for the boundary packages into
    !    the flowpacknamearray
    ip = 1
    do i = 1, size(imap)
      if (imap(i) == 1) then
        this%flowpacknamearray(ip) = this%bfr%dstpackagenamearray(i)
        ip = ip + 1
      end if
    end do
    !
    ! -- Error if specific discharge, saturation or flowja not found
    if (.not. found_dataspdis) then
      write (errmsg, '(a)') 'Specific discharge not found in &
                            &budget file. SAVE_SPECIFIC_DISCHARGE and &
                            &SAVE_FLOWS must be activated in the NPF package.'
      call store_error(errmsg)
    end if
    if (.not. found_datasat) then
      write (errmsg, '(a)') 'Saturation not found in &
                            &budget file. SAVE_SATURATION and &
                            &SAVE_FLOWS must be activated in the NPF package.'
      call store_error(errmsg)
    end if
    if (.not. found_flowja) then
      write (errmsg, '(a)') 'FLOWJA not found in &
                            &budget file. SAVE_FLOWS must &
                            &be activated in the NPF package.'
      call store_error(errmsg)
    end if
    if (count_errors() > 0) then
      call store_error_filename(this%input_fname)
    end if

Here is the call graph for this function:

initialize_gwfterms_from_gwfbndlist()

subroutine tspfmimodule::initialize_gwfterms_from_gwfbndlist

(

class(tspfmitype)

this

)

Flows are coming from a gwf-gwt exchange object

Definition at line 786 of file tsp-fmi.f90.

    ! -- modules
    use bndmodule, only: bndtype, getbndfromlist
    ! -- dummy
    class(TspFmiType) :: this
    ! -- local
    integer(I4B) :: ngwfpack
    integer(I4B) :: ngwfterms
    integer(I4B) :: ip
    integer(I4B) :: imover
    integer(I4B) :: ntomvr
    integer(I4B) :: iterm
    character(len=LENPACKAGENAME) :: budtxt
    class(BndType), pointer :: packobj => null()
    !
    ! -- determine size of gwf terms
    ngwfpack = this%gwfbndlist%Count()
    !
    ! -- Count number of to-mvr terms, but do not include advanced packages
    !    as those mover terms are not losses from the cell, but rather flows
    !    within the advanced package
    ntomvr = 0
    do ip = 1, ngwfpack
      packobj => getbndfromlist(this%gwfbndlist, ip)
      imover = packobj%imover
      if (packobj%isadvpak /= 0) imover = 0
      if (imover /= 0) then
        ntomvr = ntomvr + 1
      end if
    end do
    !
    ! -- Allocate arrays in fmi of size ngwfterms, which is the number of
    !    packages plus the number of packages with mover terms.
    ngwfterms = ngwfpack + ntomvr
    call this%allocate_gwfpackages(ngwfterms)
    !
    ! -- Assign values in the fmi package
    iterm = 1
    do ip = 1, ngwfpack
      !
      ! -- set and store names
      packobj => getbndfromlist(this%gwfbndlist, ip)
      budtxt = adjustl(packobj%text)
      call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt)
      this%flowpacknamearray(iterm) = packobj%packName
      call this%gwfpackages(iterm)%set_auxname(packobj%naux, &
                                               packobj%auxname)
      iterm = iterm + 1
      !
      ! -- if this package has a mover associated with it, then add another
      !    term that corresponds to the mover flows
      imover = packobj%imover
      if (packobj%isadvpak /= 0) imover = 0
      if (imover /= 0) then
        budtxt = trim(adjustl(packobj%text))//'-TO-MVR'
        call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt)
        this%flowpacknamearray(iterm) = packobj%packName
        call this%gwfpackages(iterm)%set_auxname(packobj%naux, &
                                                 packobj%auxname)
        this%igwfmvrterm(iterm) = 1
        iterm = iterm + 1
      end if
    end do

Here is the call graph for this function:

set_active_status()

subroutine tspfmimodule::set_active_status	(	class(tspfmitype)	this,
		real(dp), dimension(:), intent(inout)	cnew
	)

Dry GWF cells are treated differently by GWT and GWE. Transport does not occur in deactivated GWF cells; however, GWE still simulates conduction through dry cells.

Definition at line 420 of file tsp-fmi.f90.

    ! -- modules
    use constantsmodule, only: dhdry
    ! -- dummy
    class(TspFmiType) :: this
    real(DP), intent(inout), dimension(:) :: cnew
    ! -- local
    integer(I4B) :: n
    integer(I4B) :: m
    integer(I4B) :: ipos
    real(DP) :: crewet, tflow, flownm
    character(len=15) :: nodestr
    ! -- formats
    character(len=*), parameter :: fmtoutmsg1 = &
      "(1x,'WARNING: DRY CELL ENCOUNTERED AT ', a,'; RESET AS INACTIVE WITH &
      &DRY ', a, '=', G13.5)"
    character(len=*), parameter :: fmtoutmsg2 = &
      &"(1x,'DRY CELL REACTIVATED AT', a, 'WITH STARTING', a, '=', G13.5)"
    !
    do n = 1, this%dis%nodes
      ! -- Calculate the ibound-like array that has 0 if saturation
      !    is zero and 1 otherwise
      if (this%gwfsat(n) > dzero) then
        this%ibdgwfsat0(n) = 1
      else
        this%ibdgwfsat0(n) = 0
      end if
      !
      ! -- Check if active transport cell is inactive for flow
      if (this%ibound(n) > 0) then
        if (this%gwfhead(n) == dhdry) then
          ! -- transport cell should be made inactive
          this%ibound(n) = 0
          cnew(n) = dhdry
          call this%dis%noder_to_string(n, nodestr)
          write (this%iout, fmtoutmsg1) &
            trim(nodestr), trim(adjustl(this%depvartype)), dhdry
        end if
      end if
    end do
    !
    ! -- if flow cell is dry, then set gwt%ibound = 0 and conc to dry
    do n = 1, this%dis%nodes
      !
      ! -- Convert dry transport cell to active if flow has rewet
      if (cnew(n) == dhdry) then
        if (this%gwfhead(n) /= dhdry) then
          !
          ! -- obtain weighted concentration/temperature
          crewet = dzero
          tflow = dzero
          do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1
            m = this%dis%con%ja(ipos)
            flownm = this%gwfflowja(ipos)
            if (flownm > 0) then
              if (this%ibound(m) /= 0) then
                crewet = crewet + cnew(m) * flownm ! kluge note: apparently no need to multiply flows by eqnsclfac
                tflow = tflow + this%gwfflowja(ipos) !             since it will divide out below anyway
              end if
            end if
          end do
          if (tflow > dzero) then
            crewet = crewet / tflow
          else
            crewet = dzero
          end if
          !
          ! -- cell is now wet
          this%ibound(n) = 1
          cnew(n) = crewet
          call this%dis%noder_to_string(n, nodestr)
          write (this%iout, fmtoutmsg2) &
            trim(nodestr), trim(adjustl(this%depvartype)), crewet
        end if
      end if
    end do

set_aptbudobj_pointer()

subroutine tspfmimodule::set_aptbudobj_pointer	(	class(tspfmitype)	this,
		character(len=*), intent(in)	name,
		type(budgetobjecttype), pointer	budobjptr
	)

An advanced transport can pass in a name and a pointer budget object, and this routine will look through the budget objects managed by FMI and point to the one with the same name, such as LAK-1, SFR-1, etc.

Definition at line 663 of file tsp-fmi.f90.

    ! -- modules
    class(TspFmiType) :: this
    ! -- dumm
    character(len=*), intent(in) :: name
    type(BudgetObjectType), pointer :: budobjptr
    ! -- local
    integer(I4B) :: i
    !
    ! -- find and set the pointer
    do i = 1, size(this%aptbudobj)
      if (this%aptbudobj(i)%ptr%name == name) then
        budobjptr => this%aptbudobj(i)%ptr
        exit
      end if
    end do

Variable Documentation

budtxt

character(len=lenbudtxt), dimension(nbditems) tspfmimodule::budtxt

private

Definition at line 25 of file tsp-fmi.f90.

  character(len=LENBUDTXT), dimension(NBDITEMS) :: budtxt

nbditems

integer(i4b), parameter tspfmimodule::nbditems = 2

private

Definition at line 24 of file tsp-fmi.f90.

  integer(I4B), parameter :: NBDITEMS = 2

text

character(len=lenpackagename) tspfmimodule::text = ' GWTFMI'

private

Definition at line 22 of file tsp-fmi.f90.

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