Data Types
type	dataadvancedpackagetype

type	budobjptrarray

type	tspfmitype

Functions/Subroutines
subroutine, public	fmi_cr (fmiobj, name_model, 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_read_options (this)
	Read options from input file. More...

subroutine	gwtfmi_read_packagedata (this)
	Read PACKAGEDATA block. 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 138 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 251 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 222 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,
		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
     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')
     fmiobj%text = text
     !
     ! -- Allocate scalars
     call fmiobj%allocate_scalars()
     !
     ! -- Set variables
     fmiobj%inunit = inunit
     fmiobj%iout = iout
     !
     ! -- Initialize block parser
     call fmiobj%parser%Initialize(fmiobj%inunit, fmiobj%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 189 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 272 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 109 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 904 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 312 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%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 942 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_read_options()

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

private

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

     ! -- modules
     use constantsmodule, only: linelength, dem6
     use inputoutputmodule, only: getunit, openfile, urdaux
     use simmodule, only: store_error, store_error_unit
     ! -- dummy
     class(TspFmiType) :: this
     ! -- local
     character(len=LINELENGTH) :: keyword
     integer(I4B) :: ierr
     logical :: isfound, endOfBlock
     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.')"
     !
     ! -- get options block
     call this%parser%GetBlock('OPTIONS', isfound, ierr, blockrequired=.false., &
                               supportopenclose=.true.)
     !
     ! -- parse options block if detected
     if (isfound) then
       write (this%iout, '(1x,a)') 'PROCESSING FMI OPTIONS'
       do
         call this%parser%GetNextLine(endofblock)
         if (endofblock) exit
         call this%parser%GetStringCaps(keyword)
         select case (keyword)
         case ('SAVE_FLOWS')
           this%ipakcb = -1
           write (this%iout, fmtisvflow)
         case ('FLOW_IMBALANCE_CORRECTION')
           write (this%iout, fmtifc)
           this%iflowerr = 1
         case default
           write (errmsg, '(a,a)') 'Unknown FMI option: ', &
             trim(keyword)
           call store_error(errmsg)
           call this%parser%StoreErrorUnit()
         end select
       end do
       write (this%iout, '(1x,a)') 'END OF FMI OPTIONS'
     end if

Here is the call graph for this function:

◆ gwtfmi_read_packagedata()

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

Read packagedata block from input file

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

     ! -- modules
     use openspecmodule, only: access, form
     use constantsmodule, only: linelength, dem6, lenpackagename
     use inputoutputmodule, only: getunit, openfile, urdaux
     use simmodule, only: store_error, store_error_unit
     ! -- dummy
     class(TspFmiType) :: this
     ! -- local
     type(BudgetObjectType), pointer :: budobjptr
     character(len=LINELENGTH) :: keyword, fname
     character(len=LENPACKAGENAME) :: pname
     integer(I4B) :: i
     integer(I4B) :: ierr
     integer(I4B) :: inunit
     integer(I4B) :: iapt
     logical :: isfound, endOfBlock
     logical :: blockrequired
     logical :: exist
     type(BudObjPtrArray), dimension(:), allocatable :: tmpbudobj
     !
     ! -- initialize
     iapt = 0
     blockrequired = .true.
     !
     ! -- get options block
     call this%parser%GetBlock('PACKAGEDATA', isfound, ierr, &
                               blockrequired=blockrequired, &
                               supportopenclose=.true.)
     !
     ! -- parse options block if detected
     if (isfound) then
       write (this%iout, '(1x,a)') 'PROCESSING FMI PACKAGEDATA'
       do
         call this%parser%GetNextLine(endofblock)
         if (endofblock) exit
         call this%parser%GetStringCaps(keyword)
         select case (keyword)
         case ('GWFBUDGET')
           call this%parser%GetStringCaps(keyword)
           if (keyword /= 'FILEIN') then
             call store_error('GWFBUDGET keyword must be followed by '// &
                              '"FILEIN" then by filename.')
             call this%parser%StoreErrorUnit()
           end if
           call this%parser%GetString(fname)
           inunit = getunit()
           inquire (file=trim(fname), exist=exist)
           if (.not. exist) then
             call store_error('Could not find file '//trim(fname))
             call this%parser%StoreErrorUnit()
           end if
           call openfile(inunit, this%iout, fname, 'DATA(BINARY)', form, &
                         access, 'UNKNOWN')
           this%iubud = inunit
           call this%initialize_bfr()
         case ('GWFHEAD')
           call this%parser%GetStringCaps(keyword)
           if (keyword /= 'FILEIN') then
             call store_error('GWFHEAD keyword must be followed by '// &
                              '"FILEIN" then by filename.')
             call this%parser%StoreErrorUnit()
           end if
           call this%parser%GetString(fname)
           inquire (file=trim(fname), exist=exist)
           if (.not. exist) then
             call store_error('Could not find file '//trim(fname))
             call this%parser%StoreErrorUnit()
           end if
           inunit = getunit()
           call openfile(inunit, this%iout, fname, 'DATA(BINARY)', form, &
                         access, 'UNKNOWN')
           this%iuhds = inunit
           call this%initialize_hfr()
         case ('GWFMOVER')
           call this%parser%GetStringCaps(keyword)
           if (keyword /= 'FILEIN') then
             call store_error('GWFMOVER keyword must be followed by '// &
                              '"FILEIN" then by filename.')
             call this%parser%StoreErrorUnit()
           end if
           call this%parser%GetString(fname)
           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
           pname = keyword(1:lenpackagename)
           call this%parser%GetStringCaps(keyword)
           if (keyword /= 'FILEIN') then
             call store_error('Package name must be followed by '// &
                              '"FILEIN" then by filename.')
             call this%parser%StoreErrorUnit()
           end if
           call this%parser%GetString(fname)
           inunit = getunit()
           call openfile(inunit, this%iout, fname, 'DATA(BINARY)', form, &
                         access, 'UNKNOWN')
           call budgetobject_cr_bfr(budobjptr, pname, inunit, &
                                    this%iout, colconv2=['GWF             '])
           call budobjptr%fill_from_bfr(this%dis, this%iout)
           this%aptbudobj(iapt)%ptr => budobjptr
         end select
       end do
       write (this%iout, '(1x,a)') 'END OF FMI PACKAGEDATA'
     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 734 of file tsp-fmi.f90.

     ! -- modules
     use memorymanagermodule, only: mem_allocate
     use simmodule, only: store_error, store_error_unit, count_errors
     ! -- 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 this%parser%StoreErrorUnit()
     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 834 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 710 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.

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

◆ nbditems

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

private

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

24 integer(I4B), parameter :: NBDITEMS = 2

◆ text

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

private

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

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

Data Types

Functions/Subroutines

Variables

Function/Subroutine Documentation

◆ fmi_ad()

◆ fmi_bd()

◆ fmi_cq()

◆ fmi_cr()

◆ fmi_fc()

◆ fmi_ot_flow()

◆ fmi_rp()

◆ gwfsatold()

◆ gwtfmi_allocate_arrays()

◆ gwtfmi_allocate_gwfpackages()

◆ gwtfmi_allocate_scalars()

◆ gwtfmi_da()

◆ gwtfmi_deallocate_gwfpackages()

◆ gwtfmi_read_options()

◆ gwtfmi_read_packagedata()

◆ initialize_gwfterms_from_bfr()

◆ initialize_gwfterms_from_gwfbndlist()

◆ set_active_status()

◆ set_aptbudobj_pointer()

Variable Documentation

◆ budtxt

◆ nbditems

◆ text