prtfmimodule Module Reference

Data Types
type	prtfmitype

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	accumulate_flows (this)
	Accumulate flows. More...
subroutine	mark_boundary_face (this, ic, iface)
	Mark a face as a boundary face. More...
logical(lgp) function	is_boundary_face (this, ic, iface)
	Check if a face is assigned to a boundary package. More...
logical(lgp) function	is_net_out_boundary_face (this, ic, iface)
	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'

Function/Subroutine Documentation

accumulate_flows()

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

private

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

    ! dummy
    class(PrtFmiType) :: this
    ! local
    integer(I4B) :: j, i, ip, ib
    integer(I4B) :: ioffset, 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)
          ioffset = (i - 1) * this%max_faces
          this%BoundaryFlows(ioffset + icellface) = &
            this%BoundaryFlows(ioffset + 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 71 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 43 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 285 of file prt-fmi.f90.

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

is_boundary_face()

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

private

Parameters

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

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

    class(PrtFmiType) :: this
    integer(I4B), intent(in) :: ic !< node number (reduced)
    integer(I4B), intent(in) :: iface !< 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 (iface <= 0) then
      print *, 'Invalid face number: ', iface
      print *, 'Expected a value in range [1, ', this%max_faces, ']'
      call pstop(1)
    end if
    bit_pos = iface - 1 ! bit position 0-based
    if (bit_pos < 0 .or. bit_pos > 31) then
      print *, 'Invalid bitmask position: ', iface
      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)  iface  )

private

Parameters

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

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

    class(PrtFmiType) :: this
    integer(I4B), intent(in) :: ic !< node number (reduced)
    integer(I4B), intent(in) :: iface !< cell face number
    logical(LGP) :: is_net_out_boundary
    ! local
    integer(I4B) :: ioffset
 
    is_net_out_boundary = .false.
    if (.not. this%is_boundary_face(ic, iface)) return
    ioffset = (ic - 1) * this%max_faces
    if (this%BoundaryFlows(ioffset + iface) < 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)  iface  )

private

Parameters

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

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

    class(PrtFmiType) :: this
    integer(I4B), intent(in) :: ic !< node number (reduced)
    integer(I4B), intent(in) :: iface !< 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 (iface <= 0) then
      print *, 'Invalid face number: ', iface
      print *, 'Expected a value in range [1, ', this%max_faces, ']'
      call pstop(1)
    end if
    bit_pos = iface - 1 ! bit position 0-based
    if (bit_pos < 0 .or. bit_pos > 31) then
      print *, 'Invalid bitmask position: ', iface
      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_df()

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

Definition at line 136 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
    allocate (this%StorageFlows(this%dis%nodes))
    allocate (this%SourceFlows(this%dis%nodes))
    allocate (this%SinkFlows(this%dis%nodes))
    allocate (this%BoundaryFlows(this%dis%nodes * this%max_faces))
    allocate (this%BoundaryFaces(this%dis%nodes))
 

Variable Documentation

text

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

private

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

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