Data Types
type	prtfmitype

Enumerations
enum
	IFLOWFACE numbers for top and bottom faces. More...

Functions/Subroutines
subroutine, public	fmi_cr (fmiobj, name_model, input_mempath, inunit, iout)
	Create a new PrtFmi object. More...

subroutine	fmi_ad (this)
	Time step advance. More...

subroutine	prtfmi_df (this, dis, idryinactive)
	Define the flow model interface. More...

subroutine	prtfmi_allocate_scalars (this)
	Allocate scalars. More...

subroutine	prtfmi_allocate_arrays (this, nodes)
	Allocate arrays. More...

subroutine	prtfmi_da (this)
	Deallocate memory. More...

subroutine	accumulate_flows (this)
	Accumulate flows. More...

subroutine	mark_boundary_face (this, ic, icellface)
	Mark a face as a boundary face. More...

logical(lgp) function	is_boundary_face (this, ic, icellface)
	Check if a face is assigned to a boundary package. More...

logical(lgp) function	is_net_out_boundary_face (this, ic, icellface)
	Check if a face is an assigned boundary with net outflow. More...

integer(i4b) function	iflowface_to_icellface (this, iflowface)
	Convert an iflowface number to a cell face number. Maps bottom (-2) -> max_faces - 1, top (-1) -> max_faces. More...

Variables
character(len=lenpackagename)	text = ' PRTFMI'

@, public	iflowface_top = -1

@, public	iflowface_bottom = -2

Enumeration Type Documentation

◆ anonymous enum

anonymous enum

private

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

Function/Subroutine Documentation

◆ accumulate_flows()

subroutine prtfmimodule::accumulate_flows ( class(prtfmitype) this )

private

Definition at line 219 of file prt-fmi.f90.

     ! dummy
     class(PrtFmiType) :: this
     ! local
     integer(I4B) :: j, i, ip, ib
     integer(I4B) :: iflowface, iauxiflowface, icellface
     real(DP) :: qbnd
     character(len=LENAUXNAME) :: auxname
     integer(I4B) :: naux
  
     this%StorageFlows = dzero
     if (this%igwfstrgss /= 0) &
       this%StorageFlows = this%StorageFlows + this%gwfstrgss
     if (this%igwfstrgsy /= 0) &
       this%StorageFlows = this%StorageFlows + this%gwfstrgsy
  
     this%SourceFlows = dzero
     this%SinkFlows = dzero
     this%BoundaryFlows = dzero
     this%BoundaryFaces = 0
     do ip = 1, this%nflowpack
       iauxiflowface = 0
       naux = this%gwfpackages(ip)%naux
       if (naux > 0) then
         do j = 1, naux
           auxname = this%gwfpackages(ip)%auxname(j)
           if (trim(adjustl(auxname)) == "IFLOWFACE") then
             iauxiflowface = j
             exit
           end if
         end do
       end if
       do ib = 1, this%gwfpackages(ip)%nbound
         i = this%gwfpackages(ip)%nodelist(ib)
         if (i <= 0) cycle
         if (this%ibound(i) <= 0) cycle
         qbnd = this%gwfpackages(ip)%get_flow(ib)
         ! todo, after initial release: default iflowface values for different packages
         iflowface = 0
         icellface = 0
         if (iauxiflowface > 0) then
           iflowface = nint(this%gwfpackages(ip)%auxvar(iauxiflowface, ib))
           icellface = this%iflowface_to_icellface(iflowface)
         end if
         if (icellface > 0) then
           call this%mark_boundary_face(i, icellface)
           this%BoundaryFlows(i, icellface) = &
             this%BoundaryFlows(i, icellface) + qbnd
         else if (qbnd .gt. dzero) then
           this%SourceFlows(i) = this%SourceFlows(i) + qbnd
         else if (qbnd .lt. dzero) then
           this%SinkFlows(i) = this%SinkFlows(i) + qbnd
         end if
       end do
     end do
  

◆ fmi_ad()

subroutine prtfmimodule::fmi_ad ( class(prtfmitype) this )

private

Definition at line 87 of file prt-fmi.f90.

     ! modules
     use constantsmodule, only: dhdry
     ! dummy
     class(PrtFmiType) :: this
     ! local
     integer(I4B) :: n
     character(len=15) :: nodestr
     character(len=*), parameter :: fmtdry = &
      &"(/1X,'WARNING: DRY CELL ENCOUNTERED AT ',a,';  RESET AS INACTIVE')"
     character(len=*), parameter :: fmtrewet = &
      &"(/1X,'DRY CELL REACTIVATED AT ', a)"
  
     ! 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 indicated 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) call this%advance_bfr()
  
     ! If reading heads from a head file, read the next set of records
     if (this%iuhds /= 0) call this%advance_hfr()
  
     ! If mover flows are being read from file, read the next set of records
     if (this%iumvr /= 0) &
       call this%mvrbudobj%bfr_advance(this%dis, this%iout)
  
     ! Accumulate flows
     call this%accumulate_flows()
  
     ! if flow cell is dry, then set this%ibound = 0
     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 model cell is inactive for flow
       if (this%ibound(n) > 0) then
         if (this%gwfhead(n) == dhdry) then
           ! cell should be made inactive
           this%ibound(n) = 0
           call this%dis%noder_to_string(n, nodestr)
           write (this%iout, fmtdry) trim(nodestr)
         end if
       end if
  
       ! Convert dry model cell to active if flow has rewet
       if (this%ibound(n) == 0) then
         if (this%gwfhead(n) /= dhdry) then
           ! cell is now wet
           this%ibound(n) = 1
           call this%dis%noder_to_string(n, nodestr)
           write (this%iout, fmtrewet) trim(nodestr)
         end if
       end if
     end do
  

◆ fmi_cr()

subroutine, public prtfmimodule::fmi_cr	(	type(prtfmitype), pointer	fmiobj,
		character(len=*), intent(in)	name_model,
		character(len=*), intent(in)	input_mempath,
		integer(i4b), intent(inout)	inunit,
		integer(i4b), intent(in)	iout
	)

Definition at line 59 of file prt-fmi.f90.

     ! dummy
     type(PrtFmiType), pointer :: fmiobj
     character(len=*), intent(in) :: name_model
     character(len=*), intent(in) :: input_mempath
     integer(I4B), intent(inout) :: inunit
     integer(I4B), intent(in) :: iout
  
     ! 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 dependent variable label
     fmiobj%depvartype = 'TRACKS          '
  

Here is the caller graph for this function:

◆ iflowface_to_icellface()

integer(i4b) function prtfmimodule::iflowface_to_icellface	(	class(prtfmitype), intent(inout)	this,
		integer(i4b), intent(in)	iflowface
	)

private

Definition at line 349 of file prt-fmi.f90.

     class(PrtFmiType), intent(inout) :: this
     integer(I4B), intent(in) :: iflowface
     integer(I4B) :: icellface
  
     icellface = iflowface
     if (icellface < 0) icellface = icellface + this%max_faces - iflowface_top

◆ is_boundary_face()

logical(lgp) function prtfmimodule::is_boundary_face	(	class(prtfmitype)	this,
		integer(i4b), intent(in)	ic,
		integer(i4b), intent(in)	icellface
	)

private

Parameters

[in]	ic	node number (reduced)
[in]	icellface	cell face number

Definition at line 305 of file prt-fmi.f90.

     class(PrtFmiType) :: this
     integer(I4B), intent(in) :: ic !< node number (reduced)
     integer(I4B), intent(in) :: icellface !< cell face number
     logical(LGP) :: is_boundary
     ! local
     integer(I4B) :: bit_pos
  
     is_boundary = .false.
     if (ic <= 0 .or. ic > this%dis%nodes) then
       print *, 'Invalid cell number: ', ic
       print *, 'Expected a value in range [1, ', this%dis%nodes, ']'
       call pstop(1)
     end if
     if (icellface <= 0) then
       print *, 'Invalid face number: ', icellface
       print *, 'Expected a value in range [1, ', this%max_faces, ']'
       call pstop(1)
     end if
     bit_pos = icellface - 1 ! bit position 0-based
     if (bit_pos < 0 .or. bit_pos > 31) then
       print *, 'Invalid bitmask position: ', bit_pos
       print *, 'Expected a value in range [0, 31]'
       call pstop(1)
     end if
     is_boundary = btest(this%BoundaryFaces(ic), bit_pos)

Here is the call graph for this function:

◆ is_net_out_boundary_face()

logical(lgp) function prtfmimodule::is_net_out_boundary_face	(	class(prtfmitype)	this,
		integer(i4b), intent(in)	ic,
		integer(i4b), intent(in)	icellface
	)

private

Parameters

[in]	ic	node number (reduced)
[in]	icellface	cell face number

Definition at line 334 of file prt-fmi.f90.

     class(PrtFmiType) :: this
     integer(I4B), intent(in) :: ic !< node number (reduced)
     integer(I4B), intent(in) :: icellface !< cell face number
     logical(LGP) :: is_net_out_boundary
  
     is_net_out_boundary = .false.
     if (.not. this%is_boundary_face(ic, icellface)) return
     if (this%BoundaryFlows(ic, icellface) < dzero) &
       is_net_out_boundary = .true.

◆ mark_boundary_face()

subroutine prtfmimodule::mark_boundary_face	(	class(prtfmitype)	this,
		integer(i4b), intent(in)	ic,
		integer(i4b), intent(in)	icellface
	)

private

Parameters

[in]	ic	node number (reduced)
[in]	icellface	cell face number

Definition at line 278 of file prt-fmi.f90.

     class(PrtFmiType) :: this
     integer(I4B), intent(in) :: ic !< node number (reduced)
     integer(I4B), intent(in) :: icellface !< cell face number
     ! local
     integer(I4B) :: bit_pos
  
     if (ic <= 0 .or. ic > this%dis%nodes) then
       print *, 'Invalid cell number: ', ic
       print *, 'Expected a value in range [1, ', this%dis%nodes, ']'
       call pstop(1)
     end if
     if (icellface <= 0) then
       print *, 'Invalid face number: ', icellface
       print *, 'Expected a value in range [1, ', this%max_faces, ']'
       call pstop(1)
     end if
     bit_pos = icellface - 1 ! bit position 0-based
     if (bit_pos < 0 .or. bit_pos > 31) then
       print *, 'Invalid bitmask position: ', bit_pos
       print *, 'Expected a value in range [0, 31]'
       call pstop(1)
     end if
     this%BoundaryFaces(ic) = ibset(this%BoundaryFaces(ic), bit_pos)

Here is the call graph for this function:

◆ prtfmi_allocate_arrays()

subroutine prtfmimodule::prtfmi_allocate_arrays	(	class(prtfmitype)	this,
		integer(i4b), intent(in)	nodes
	)

private

Definition at line 183 of file prt-fmi.f90.

     class(PrtFmiType) :: this
     integer(I4B), intent(in) :: nodes
  
     ! allocate parent arrays
     call this%FlowModelInterfaceType%allocate_arrays(nodes)
  
     call mem_allocate(this%StorageFlows, nodes, &
                       'STORAGEFLOWS', this%memoryPath)
     call mem_allocate(this%SourceFlows, nodes, &
                       'SOURCEFLOWS', this%memoryPath)
     call mem_allocate(this%SinkFlows, nodes, &
                       'SINKFLOWS', this%memoryPath)
     call mem_allocate(this%BoundaryFlows, nodes, this%max_faces, &
                       'BOUNDARYFLOWS', this%memoryPath)
     call mem_allocate(this%BoundaryFaces, nodes, &
                       'BOUNDARYFACES', this%memoryPath)
  

◆ prtfmi_allocate_scalars()

subroutine prtfmimodule::prtfmi_allocate_scalars ( class(prtfmitype) this )

private

Definition at line 172 of file prt-fmi.f90.

     class(PrtFmiType) :: this
  
     call this%FlowModelInterfaceType%allocate_scalars()
  
     call mem_allocate(this%max_faces, 'MAX_FACES', this%memoryPath)
     this%max_faces = 0

◆ prtfmi_da()

subroutine prtfmimodule::prtfmi_da ( class(prtfmitype) this )

private

Definition at line 204 of file prt-fmi.f90.

     class(PrtFmiType) :: this
  
     call mem_deallocate(this%max_faces)
     call mem_deallocate(this%StorageFlows)
     call mem_deallocate(this%SourceFlows)
     call mem_deallocate(this%SinkFlows)
     call mem_deallocate(this%BoundaryFlows)
     call mem_deallocate(this%BoundaryFaces)
  
     call this%FlowModelInterfaceType%fmi_da()
  

◆ prtfmi_df()

subroutine prtfmimodule::prtfmi_df	(	class(prtfmitype)	this,
		class(disbasetype), intent(in), pointer	dis,
		integer(i4b), intent(in)	idryinactive
	)

Definition at line 152 of file prt-fmi.f90.

     class(PrtFmiType) :: this
     class(DisBaseType), pointer, intent(in) :: dis
     integer(I4B), intent(in) :: idryinactive
  
     call this%FlowModelInterfaceType%fmi_df(dis, idryinactive)
  
     this%max_faces = this%dis%get_max_npolyverts() + 2
     if (this%max_faces > 32) then
       write (errmsg, '(a,i0,a,i0,a)') &
         'DISV grid contains a cell with ', this%max_faces - 2, &
         ' lateral faces. Cells may have at most 30 lateral faces.'
       call store_error(errmsg)
       call this%parser%StoreErrorUnit()
       return
     end if
  

Here is the call graph for this function:

Variable Documentation

◆ iflowface_bottom

@, public prtfmimodule::iflowface_bottom = -2

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

24 enumerator :: IFLOWFACE_BOTTOM = -2

◆ iflowface_top

@, public prtfmimodule::iflowface_top = -1

Definition at line 23 of file prt-fmi.f90.

23 enumerator :: IFLOWFACE_TOP = -1

◆ text

character(len=lenpackagename) prtfmimodule::text = ' PRTFMI'

private

Definition at line 19 of file prt-fmi.f90.

19 character(len=LENPACKAGENAME) :: text = ' PRTFMI'

Data Types

Enumerations

Functions/Subroutines

Variables

Enumeration Type Documentation

◆ anonymous enum

Function/Subroutine Documentation

◆ accumulate_flows()

◆ fmi_ad()

◆ fmi_cr()

◆ iflowface_to_icellface()

◆ is_boundary_face()

◆ is_net_out_boundary_face()

◆ mark_boundary_face()

◆ prtfmi_allocate_arrays()

◆ prtfmi_allocate_scalars()

◆ prtfmi_da()

◆ prtfmi_df()

Variable Documentation

◆ iflowface_bottom

◆ iflowface_top

◆ text