sfrcrosssectionmanager Module Reference

Data Types
type	sfrcrosssectiontype
type	sfrcrosssection

Functions/Subroutines
subroutine, public	cross_section_cr (this, iout, iprpak, nreaches)
	Create a cross-section object. More...
subroutine	initialize (this, ncrossptstot, ncrosspts, iacross, station, height, roughfraction)
	Initialize a cross-section object. More...
subroutine	source_table (this, irch, width, mempath, filename)
	Source a reach's cross-section table from its SFRTAB6 subpackage. More...
subroutine	read_table (this, irch, width, filename)
	Read a cross-section table file for a reach. More...
subroutine	validate (this, irch)
	Validate cross-section tables. More...
subroutine	output (this, widths, roughs, kstp, kper)
	Write cross-section tables. More...
integer(i4b) function	get_ncrossptstot (this)
	Get the total number of cross-section points. More...
subroutine	pack (this, ncrossptstot, ncrosspts, iacross, station, height, roughfraction)
	Pack the cross-section object. More...
subroutine	destroy (this)
	Deallocate the cross-section object. More...

Function/Subroutine Documentation

cross_section_cr()

subroutine, public sfrcrosssectionmanager::cross_section_cr	(	type(sfrcrosssection), pointer	this,
		integer(i4b), intent(in), pointer	iout,
		integer(i4b), intent(in), pointer	iprpak,
		integer(i4b), intent(in), pointer	nreaches
	)

Subroutine to calculate the maximum top width for a reach using the cross-section station data.

Parameters

	this	SfrCrossSection object
[in]	iout	model listing file
[in]	iprpak	flag for printing table input data
[in]	nreaches	number of reaches

Definition at line 58 of file SfrCrossSectionManager.f90.

    ! -- dummy variables
    type(SfrCrossSection), pointer :: this !< SfrCrossSection object
    integer(I4B), pointer, intent(in) :: iout !< model listing file
    integer(I4B), pointer, intent(in) :: iprpak !< flag for printing table input data
    integer(I4B), pointer, intent(in) :: nreaches !< number of reaches
    !
    ! -- check if table already associated and reset if necessary
    if (associated(this)) then
      call this%destroy()
      deallocate (this)
      nullify (this)
    end if
    !
    ! -- Create the object
    allocate (this)
    !
    ! -- initialize scalars
    this%iout => iout
    this%iprpak => iprpak
    this%nreaches => nreaches

Here is the caller graph for this function:

destroy()

subroutine sfrcrosssectionmanager::destroy

(

class(sfrcrosssection)

this

)

Subroutine to deallocate the cross-section object.

Parameters

this	SfrCrossSection object

Definition at line 788 of file SfrCrossSectionManager.f90.

    ! -- dummy variables
    class(SfrCrossSection) :: this !< SfrCrossSection object
    ! -- local variables
    integer(I4B) :: n
    !
    ! -- deallocate and nullify pointers
    deallocate (this%npoints)
    nullify (this%npoints)
    do n = 1, this%nreaches
      deallocate (this%cross_sections(n)%npoints)
      nullify (this%cross_sections(n)%npoints)
      deallocate (this%cross_sections(n)%station)
      nullify (this%cross_sections(n)%station)
      deallocate (this%cross_sections(n)%height)
      nullify (this%cross_sections(n)%height)
      deallocate (this%cross_sections(n)%roughfraction)
      nullify (this%cross_sections(n)%roughfraction)
      deallocate (this%cross_sections(n)%valid)
      nullify (this%cross_sections(n)%valid)
    end do
    deallocate (this%cross_sections)
    nullify (this%cross_sections)
    !
    ! -- input table
    if (associated(this%inputtab)) then
      call this%inputtab%table_da()
      deallocate (this%inputtab)
      nullify (this%inputtab)
    end if
    !
    ! -- deallocate and nullify class scalars
    deallocate (this%invalid)
    nullify (this%invalid)
    !
    ! -- nullify scalars that are pointers to external variables
    nullify (this%iout)
    nullify (this%iprpak)
    nullify (this%nreaches)

get_ncrossptstot()

integer(i4b) function sfrcrosssectionmanager::get_ncrossptstot

(

class(sfrcrosssection)

this

)

Function to get the total number of cross-section points to get the new size of the station xsheight data for all reaches.

Definition at line 732 of file SfrCrossSectionManager.f90.

    ! -- dummy variables
    class(SfrCrossSection) :: this
    ! -- local variables
    integer(I4B) :: nptstot
    integer(I4B) :: n
    !
    !
    nptstot = 0
    do n = 1, this%nreaches
      nptstot = nptstot + this%npoints(n)
    end do

initialize()

subroutine sfrcrosssectionmanager::initialize	(	class(sfrcrosssection)	this,
		integer(i4b), intent(in)	ncrossptstot,
		integer(i4b), dimension(this%nreaches), intent(in)	ncrosspts,
		integer(i4b), dimension(this%nreaches + 1), intent(in)	iacross,
		real(dp), dimension(ncrossptstot), intent(in)	station,
		real(dp), dimension(ncrossptstot), intent(in)	height,
		real(dp), dimension(ncrossptstot), intent(in)	roughfraction
	)

Subroutine to initialize the cross-section object with the current data.

Parameters

	this	SfrCrossSection object
[in]	ncrossptstot	total number of cross-section points
[in]	ncrosspts	pointers to cross-section data in data vector
[in]	iacross	pointers to cross-section data in data vector
[in]	station	cross-section station data
[in]	height	cross-section height data
[in]	roughfraction	cross-section roughness fraction data

Definition at line 87 of file SfrCrossSectionManager.f90.

    ! -- dummy variables
    class(SfrCrossSection) :: this !< SfrCrossSection object
    integer(I4B), intent(in) :: ncrossptstot !< total number of cross-section points
    integer(I4B), dimension(this%nreaches), intent(in) :: ncrosspts !< pointers to cross-section data in data vector
    integer(I4B), dimension(this%nreaches + 1), intent(in) :: iacross !< pointers to cross-section data in data vector
    real(DP), dimension(ncrossptstot), intent(in) :: station !< cross-section station data
    real(DP), dimension(ncrossptstot), intent(in) :: height !< cross-section height data
    real(DP), dimension(ncrossptstot), intent(in) :: roughfraction !< cross-section roughness fraction data
    ! -- local variables
    integer(I4B) :: i
    integer(I4B) :: n
    integer(I4B) :: npoints
    integer(I4B) :: i0
    integer(I4B) :: i1
    integer(I4B) :: ipos
    !
    ! -- allocate scalars
    allocate (this%invalid)
    !
    ! -- initialize scalars
    this%invalid = 0
    !
    ! -- create cross-section container
    allocate (this%filenames(this%nreaches))
    allocate (this%npoints(this%nreaches))
    allocate (this%cross_sections(this%nreaches))
    do n = 1, this%nreaches
      npoints = ncrosspts(n)
      allocate (this%cross_sections(n)%npoints)
      allocate (this%cross_sections(n)%station(npoints))
      allocate (this%cross_sections(n)%height(npoints))
      allocate (this%cross_sections(n)%roughfraction(npoints))
      allocate (this%cross_sections(n)%valid(npoints))
    end do
    !
    ! -- fill cross-section container with current values
    do n = 1, this%nreaches
      this%filenames(n) = 'NONE'
      this%cross_sections(n)%npoints = ncrosspts(n)
      this%npoints(n) = ncrosspts(n)
      i0 = iacross(n)
      i1 = iacross(n + 1) - 1
      ipos = 1
      do i = i0, i1
        this%cross_sections(n)%station(ipos) = station(i)
        this%cross_sections(n)%height(ipos) = height(i)
        this%cross_sections(n)%roughfraction(ipos) = roughfraction(i)
        this%cross_sections(n)%valid(ipos) = .true.
        ipos = ipos + 1
      end do
    end do

output()

subroutine sfrcrosssectionmanager::output	(	class(sfrcrosssection)	this,
		real(dp), dimension(this%nreaches), intent(in)	widths,
		real(dp), dimension(this%nreaches), intent(in)	roughs,
		integer(i4b), intent(in), optional	kstp,
		integer(i4b), intent(in), optional	kper
	)

Subroutine to write the cross-section tables to the model listing file.

Parameters

	this	SfrCrossSection object
[in]	widths	reach widths
[in]	roughs	reach Manning's roughness coefficients
[in]	kstp	time step
[in]	kper	stress period

Definition at line 570 of file SfrCrossSectionManager.f90.

    use constantsmodule, only: tableft
    use simmodule, only: store_warning
    ! -- dummy variables
    class(SfrCrossSection) :: this !< SfrCrossSection object
    real(DP), dimension(this%nreaches), intent(in) :: widths !< reach widths
    real(DP), dimension(this%nreaches), intent(in) :: roughs !< reach Manning's roughness coefficients
    integer(I4B), intent(in), optional :: kstp !< time step
    integer(I4B), intent(in), optional :: kper !< stress period
    ! -- local variables
    character(len=LINELENGTH) :: title
    character(len=LINELENGTH) :: text
    character(len=LINELENGTH) :: filename
    character(len=10) :: cvalid
    logical(LGP) :: transient
    integer(I4B) :: kkstp
    integer(I4B) :: kkper
    integer(I4B) :: irch
    integer(I4B) :: n
    integer(I4B) :: ntabcols
    integer(I4B) :: ninvalid_reaches
    real(DP) :: width
    real(DP) :: xfraction
    real(DP) :: rough
    real(DP) :: r
    integer(I4B), dimension(this%nreaches) :: reach_fail
    !
    ! -- initialize local variables
    kkstp = 0
    kkper = 0
    !
    ! -- process optional parameters
    if (present(kstp)) then
      kkstp = kstp
    end if
    if (present(kper)) then
      kkper = kper
    end if
    !
    ! -- set transient boolean
    if (kkstp > 0 .and. kkper > 0) then
      transient = .true.
    else
      transient = .false.
    end if
    !
    ! -- set reach failure
    do irch = 1, this%nreaches
      filename = this%filenames(irch)
      reach_fail(irch) = 0
      !
      ! -- output cross-section data read from a file
      if (trim(adjustl(filename)) /= 'NONE') then
        do n = 1, this%npoints(irch)
          if (.not. this%cross_sections(irch)%valid(n)) then
            reach_fail(irch) = reach_fail(irch) + 1
          end if
        end do
      end if
    end do
    !
    ! -- iterate over each reach
    do irch = 1, this%nreaches
      filename = this%filenames(irch)
      !
      ! -- output cross-section data read from a file
      if (trim(adjustl(filename)) /= 'NONE') then
        !
        ! -- build and write the table for a reach, if required, or
        !    the cross-section is invalid
        if (this%iprpak > 0 .or. reach_fail(irch) > 0) then
          !
          ! -- calculate the number of table columns
          if (reach_fail(irch) > 0) then
            ntabcols = 6
          else
            ntabcols = 5
          end if
          !
          ! -- reset the input table object
          write (title, '(a,1x,i0,1x,3a)') &
            'CROSS_SECTION DATA FOR REACH', irch, "FROM TAB6 FILE ('", &
            trim(adjustl(filename)), "')"
          call table_cr(this%inputtab, trim(adjustl(filename)), title)
          call this%inputtab%table_df(this%npoints(irch), ntabcols, &
                                      this%iout, finalize=.false., &
                                      transient=transient)
          if (transient) then
            call this%inputtab%set_kstpkper(kkstp, kkper)
          end if
          text = 'XFRACTION'
          call this%inputtab%initialize_column(text, 20, alignment=tableft)
          text = 'STATION'
          call this%inputtab%initialize_column(text, 20, alignment=tableft)
          text = 'HEIGHT'
          call this%inputtab%initialize_column(text, 20, alignment=tableft)
          text = "MANFRACTION"
          call this%inputtab%initialize_column(text, 20, alignment=tableft)
          text = "MANNING'S ROUGHNESS COEFFICIENT"
          call this%inputtab%initialize_column(text, 20, alignment=tableft)
          if (reach_fail(irch) > 0) then
            text = 'NEEDS ADJUSTMENT'
            call this%inputtab%initialize_column(text, 10, alignment=tableft)
          end if
          !
          ! -- set the width and roughness for the reach
          width = widths(irch)
          rough = roughs(irch)
          !
          ! -- fill the table
          do n = 1, this%npoints(irch)
            xfraction = this%cross_sections(irch)%station(n) / width
            r = this%cross_sections(irch)%roughfraction(n) * rough
            call this%inputtab%add_term(xfraction)
            call this%inputtab%add_term(this%cross_sections(irch)%station(n))
            call this%inputtab%add_term(this%cross_sections(irch)%height(n))
            call this%inputtab%add_term(&
                   &this%cross_sections(irch)%roughfraction(n))
            call this%inputtab%add_term(r)
            if (reach_fail(irch) > 0) then
              if (this%cross_sections(irch)%valid(n)) then
                cvalid = ''
              else
                cvalid = 'TRUE'
              end if
              call this%inputtab%add_term(cvalid)
            end if
          end do
          !
          ! -- finalize the table
          call this%inputtab%finalize_table()
        end if
      end if
    end do
    !
    ! -- save warning message and write summary information to the listing file
    if (this%invalid > 0) then
      ninvalid_reaches = 0
      do irch = 1, this%nreaches
        if (reach_fail(irch) > 0) then
          ninvalid_reaches = ninvalid_reaches + 1
        end if
      end do
      write (warnmsg, '(a,1x,i0,7(1x,a))') &
        'Cross-section data for', ninvalid_reaches, &
        'reaches include one or more points that result in a', &
        'non-unique depth-conveyance relation. This occurs when', &
        'there are horizontal sections at non-zero heights', &
        '(for example, flat overbank sections). This can usually', &
        'be resolved by adding a small slope to these flat', &
        'sections. See the cross-section tables in the model', &
        'listing file for more information.'
      call store_warning(warnmsg)
    end if

Here is the call graph for this function:

pack()

subroutine sfrcrosssectionmanager::pack	(	class(sfrcrosssection)	this,
		integer(i4b), intent(in)	ncrossptstot,
		integer(i4b), dimension(this%nreaches), intent(inout)	ncrosspts,
		integer(i4b), dimension(this%nreaches + 1), intent(inout)	iacross,
		real(dp), dimension(ncrossptstot), intent(inout)	station,
		real(dp), dimension(ncrossptstot), intent(inout)	height,
		real(dp), dimension(ncrossptstot), intent(inout)	roughfraction
	)

Subroutine to pack the cross-section object into vectors.

Parameters

	this	SfrCrossSection object
[in]	ncrossptstot	total number of cross-section points
[in,out]	ncrosspts	pointers to cross-section data in data vector
[in,out]	iacross	pointers to cross-section data in data vector
[in,out]	station	cross-section station data
[in,out]	height	cross-section height data
[in,out]	roughfraction	cross-section roughness fraction data

Definition at line 751 of file SfrCrossSectionManager.f90.

    ! -- dummy variables
    class(SfrCrossSection) :: this !< SfrCrossSection object
    integer(I4B), intent(in) :: ncrossptstot !< total number of cross-section points
    integer(I4B), dimension(this%nreaches), intent(inout) :: ncrosspts !< pointers to cross-section data in data vector
    integer(I4B), dimension(this%nreaches + 1), intent(inout) :: iacross !< pointers to cross-section data in data vector
    real(DP), dimension(ncrossptstot), intent(inout) :: station !< cross-section station data
    real(DP), dimension(ncrossptstot), intent(inout) :: height !< cross-section height data
    real(DP), dimension(ncrossptstot), intent(inout) :: roughfraction !< cross-section roughness fraction data
    ! -- local variables
    integer(I4B) :: i
    integer(I4B) :: n
    integer(I4B) :: npoints
    integer(I4B) :: ipos
    !
    ! -- pack the data
    ipos = 1
    iacross(1) = ipos
    do n = 1, this%nreaches
      npoints = this%npoints(n)
      ncrosspts(n) = npoints
      do i = 1, npoints
        station(ipos) = this%cross_sections(n)%station(i)
        height(ipos) = this%cross_sections(n)%height(i)
        roughfraction(ipos) = this%cross_sections(n)%roughfraction(i)
        ipos = ipos + 1
      end do
      iacross(n + 1) = ipos
    end do

read_table()

subroutine sfrcrosssectionmanager::read_table	(	class(sfrcrosssection)	this,
		integer(i4b), intent(in)	irch,
		real(dp), intent(in)	width,
		character(len=*), intent(in)	filename
	)

Used only for the PERIOD block's dynamic CROSS_SECTION reissue, whose file path is not known until runtime.

Parameters

	this	SfrCrossSection object
[in]	irch	current reach
[in]	width	reach width
[in]	filename	table file with station height data

Definition at line 243 of file SfrCrossSectionManager.f90.

    use constantsmodule, only: iuoc
    use inputoutputmodule, only: openfile
    use simmodule, only: store_error, store_error_filename, count_errors
    use blockparsermodule, only: blockparsertype
    ! -- dummy variables
    class(SfrCrossSection) :: this !< SfrCrossSection object
    integer(I4B), intent(in) :: irch !< current reach
    real(DP), intent(in) :: width !< reach width
    character(len=*), intent(in) :: filename !< table file with station height data
    ! -- local variables
    character(len=LINELENGTH) :: tag
    character(len=LINELENGTH) :: keyword
    integer(I4B) :: ierr
    logical :: isfound
    logical :: endOfBlock
    integer(I4B) :: iu
    integer(I4B) :: n
    integer(I4B) :: j
    integer(I4B) :: ipos
    integer(I4B) :: jmin
    integer(I4B) :: nerr0
    type(BlockParserType) :: parser
    !
    ! -- initialize local variables
    j = 0
    n = 0
    jmin = 2
    !
    ! -- errors added below this point belong to this reach's own table
    nerr0 = count_errors()
    !
    ! -- create a tag with the file name and reach number
    write (tag, "('Reach',1x,i0,1x,'(',a, ')')") &
      irch, trim(adjustl(filename))
    !
    ! -- open the table file
    iu = iuoc
    call openfile(iu, this%iout, filename, 'SFR TABLE')
    call parser%Initialize(iu, this%iout)
    !
    ! -- get dimensions block
    call parser%GetBlock('DIMENSIONS', isfound, ierr, supportopenclose=.true.)
    !
    ! -- parse table dimensions block if detected
    if (isfound) then
      !
      ! -- process the table dimension data
      if (this%iprpak /= 0) then
        write (this%iout, '(/1x,a)') &
          'PROCESSING '//trim(adjustl(tag))//' DIMENSIONS'
      end if
      readdims: do
        call parser%GetNextLine(endofblock)
        if (endofblock) exit
        call parser%GetStringCaps(keyword)
        select case (keyword)
        case ('NROW')
          n = parser%GetInteger()
          if (n < 1) then
            write (errmsg, '(a,1x,a)') &
              'TABLE NROW MUST BE > 0 FOR', trim(adjustl(tag))
            call store_error(errmsg)
          end if
        case ('NCOL')
          j = parser%GetInteger()
          jmin = 2
          if (j < jmin) then
            write (errmsg, '(a,1x,i0,1x,a,1x,a)') &
              'TABLE NCOL MUST BE >=', jmin, 'FOR', trim(adjustl(tag))
            call store_error(errmsg)
          end if
        case default
          write (errmsg, '(a,a)') &
            'UNKNOWN '//trim(adjustl(tag))//' DIMENSIONS keyword: ', &
            trim(keyword)
          call store_error(errmsg)
        end select
      end do readdims
      if (this%iprpak /= 0) then
        write (this%iout, '(1x,a)') &
          'END OF '//trim(adjustl(tag))//' DIMENSIONS'
      end if
    else
      call store_error('Required DIMENSIONS block not found.')
    end if
    !
    ! -- check that ncol and nrow have been specified
    if (n < 1) then
      write (errmsg, '(a)') &
        'NROW not specified in the table DIMENSIONS block'
      call store_error(errmsg)
    end if
    if (j < 1) then
      write (errmsg, '(a)') &
        'NCOL not specified in the table DIMENSIONS block'
      call store_error(errmsg)
    end if
    !
    ! -- only read the table data if n and j are specified to be greater
    !    than zero - an error condition exists if n * j = 0
    if (n * j > 0) then
      !
      ! -- set the filename and reset the number of points
      this%filenames(irch) = filename
      this%npoints(irch) = n
      !
      ! -- deallocate
      deallocate (this%cross_sections(irch)%npoints)
      deallocate (this%cross_sections(irch)%station)
      deallocate (this%cross_sections(irch)%height)
      deallocate (this%cross_sections(irch)%roughfraction)
      deallocate (this%cross_sections(irch)%valid)
      !
      ! -- reallocate
      allocate (this%cross_sections(irch)%npoints)
      allocate (this%cross_sections(irch)%station(n))
      allocate (this%cross_sections(irch)%height(n))
      allocate (this%cross_sections(irch)%roughfraction(n))
      allocate (this%cross_sections(irch)%valid(n))
      !
      ! -- initialize
      this%cross_sections(irch)%npoints = n
      !
      ! -- get table block
      call parser%GetBlock('TABLE', isfound, ierr, supportopenclose=.true.)
      !
      ! -- parse well_connections block if detected
      if (isfound) then
 
        ! -- process the table data
        if (this%iprpak /= 0) then
          write (this%iout, '(/1x,a)') &
            'PROCESSING '//trim(adjustl(tag))//' TABLE'
        end if
        ipos = 0
        readtabledata: do
          call parser%GetNextLine(endofblock)
          if (endofblock) exit
          ipos = ipos + 1
          if (ipos > this%npoints(irch)) then
            cycle readtabledata
          end if
          this%cross_sections(irch)%station(ipos) = parser%GetDouble() * width
          this%cross_sections(irch)%height(ipos) = parser%GetDouble()
          if (j > 2) then
            this%cross_sections(irch)%roughfraction(ipos) = parser%GetDouble()
          else
            this%cross_sections(irch)%roughfraction(ipos) = done
          end if
          this%cross_sections(irch)%valid(ipos) = .true.
        end do readtabledata
 
        if (this%iprpak /= 0) then
          write (this%iout, '(1x,a)') &
            'END OF '//trim(adjustl(tag))//' TABLE'
        end if
      else
        call store_error('Required TABLE block not found.')
      end if
      !
      ! -- error condition if number of rows read are not equal to nrow
      if (ipos /= this%npoints(irch)) then
        write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a)') &
          'NROW set to', this%npoints(irch), 'but', ipos, 'rows were read'
        call store_error(errmsg)
      end if
    end if
    !
    ! -- close the open table file
    if (iu > 0) then
      close (iu)
    end if
    !
    ! -- validate the table
    call this%validate(irch)
    !
    if (count_errors() > nerr0) then
      call store_error_filename(filename, terminate=.false.)
    end if

Here is the call graph for this function:

source_table()

subroutine sfrcrosssectionmanager::source_table	(	class(sfrcrosssection)	this,
		integer(i4b), intent(in)	irch,
		real(dp), intent(in)	width,
		character(len=*), intent(in)	mempath,
		character(len=*), intent(in)	filename
	)

Parameters

	this	SfrCrossSection object
[in]	irch	current reach
[in]	width	reach width
[in]	mempath	SFRTAB6 input mempath
[in]	filename	table file name, for reporting

Definition at line 144 of file SfrCrossSectionManager.f90.

    use memorymanagermodule, only: mem_setptr
    use memorymanagerextmodule, only: memorystore_release
    use simmodule, only: store_error, store_error_filename, count_errors
    ! -- dummy variables
    class(SfrCrossSection) :: this !< SfrCrossSection object
    integer(I4B), intent(in) :: irch !< current reach
    real(DP), intent(in) :: width !< reach width
    character(len=*), intent(in) :: mempath !< SFRTAB6 input mempath
    character(len=*), intent(in) :: filename !< table file name, for reporting
    ! -- local variables
    integer(I4B), pointer :: nrow => null()
    integer(I4B), pointer :: ncol => null()
    real(DP), dimension(:), pointer, contiguous :: xfraction => null()
    real(DP), dimension(:), pointer, contiguous :: height => null()
    real(DP), dimension(:), pointer, contiguous :: manfraction => null()
    integer(I4B) :: n, nerr0
    !
    ! -- table dimensions, auto-loaded from the SFRTAB6 subpackage input
    call mem_setptr(nrow, 'NROW', mempath)
    call mem_setptr(ncol, 'NCOL', mempath)
    !
    ! -- errors added below this point belong to this reach's own table
    nerr0 = count_errors()
    !
    if (nrow < 1) then
      write (errmsg, '(a,1x,i0,3a)') &
        'TABLE NROW MUST BE > 0 FOR REACH', irch, " ('", &
        trim(adjustl(filename)), "')"
      call store_error(errmsg)
    end if
    if (ncol < 2) then
      write (errmsg, '(a,1x,i0,3a)') &
        'TABLE NCOL MUST BE >= 2 FOR REACH', irch, " ('", &
        trim(adjustl(filename)), "')"
      call store_error(errmsg)
    end if
    !
    if (count_errors() > nerr0) then
      call store_error_filename(filename, terminate=.false.)
      call memorystore_release('NROW', mempath)
      call memorystore_release('NCOL', mempath)
      call memorystore_release('INPUT_FNAME', mempath)
      return
    end if
    !
    ! -- set the filename and number of points, and reallocate for nrow
    this%filenames(irch) = filename
    this%npoints(irch) = nrow
    deallocate (this%cross_sections(irch)%npoints)
    deallocate (this%cross_sections(irch)%station)
    deallocate (this%cross_sections(irch)%height)
    deallocate (this%cross_sections(irch)%roughfraction)
    deallocate (this%cross_sections(irch)%valid)
    allocate (this%cross_sections(irch)%npoints)
    allocate (this%cross_sections(irch)%station(nrow))
    allocate (this%cross_sections(irch)%height(nrow))
    allocate (this%cross_sections(irch)%roughfraction(nrow))
    allocate (this%cross_sections(irch)%valid(nrow))
    this%cross_sections(irch)%npoints = nrow
    !
    ! -- copy the auto-loaded table data
    call mem_setptr(xfraction, 'XFRACTION', mempath)
    call mem_setptr(height, 'HEIGHT', mempath)
    do n = 1, nrow
      this%cross_sections(irch)%station(n) = xfraction(n) * width
      this%cross_sections(irch)%height(n) = height(n)
      this%cross_sections(irch)%valid(n) = .true.
    end do
    if (ncol > 2) then
      call mem_setptr(manfraction, 'MANFRACTION', mempath)
      this%cross_sections(irch)%roughfraction = manfraction
    else
      this%cross_sections(irch)%roughfraction = done
    end if
    !
    ! -- validate the table
    call this%validate(irch)
    !
    if (count_errors() > nerr0) then
      call store_error_filename(filename, terminate=.false.)
    end if
    !
    ! -- release this reach's own input context memory
    call memorystore_release('NROW', mempath)
    call memorystore_release('NCOL', mempath)
    call memorystore_release('XFRACTION', mempath)
    call memorystore_release('HEIGHT', mempath)
    if (ncol > 2) then
      call memorystore_release('MANFRACTION', mempath)
    end if
    call memorystore_release('INPUT_FNAME', mempath)

Here is the call graph for this function:

validate()

subroutine sfrcrosssectionmanager::validate	(	class(sfrcrosssection)	this,
		integer(i4b), intent(in)	irch
	)

Subroutine to validate a cross-section table.

Parameters

	this	SfrCrossSection object
[in]	irch	current reach

Definition at line 430 of file SfrCrossSectionManager.f90.

    use constantsmodule, only: dem6, dtwothirds
    use simmodule, only: store_error
    use sortmodule, only: unique_values
    use gwfsfrcrosssectionutilsmodule, only: get_cross_section_area, &
                                             get_hydraulic_radius
    ! -- dummy variables
    class(SfrCrossSection) :: this !< SfrCrossSection object
    integer(I4B), intent(in) :: irch !< current reach
    ! -- local variables
    logical(LGP) :: station_error
    logical(LGP) :: height_error
    logical(LGP) :: height_zero_error
    logical(LGP) :: roughness_error
    character(len=LINELENGTH) :: filename
    integer(I4B) :: npts
    integer(I4B) :: n
    integer(I4B) :: i
    integer(I4B) :: ipos
    real(DP) :: station
    real(DP) :: height
    real(DP) :: roughfraction
    real(DP) :: aw
    real(DP) :: rh
    real(DP) :: dc0
    real(DP) :: dc1
    real(DP), dimension(:), allocatable :: heights
    real(DP), dimension(:), allocatable :: unique_heights
    real(DP), dimension(3) :: factor
    !
    ! -- initialize local variables
    station_error = .false.
    height_error = .false.
    height_zero_error = .true.
    roughness_error = .false.
    npts = this%npoints(irch)
    !
    ! -- validate the station and height data
    do n = 1, npts
      station = this%cross_sections(irch)%station(n)
      if (station < dzero) then
        station_error = .true.
      end if
      height = this%cross_sections(irch)%height(n)
      if (height < dzero) then
        height_error = .true.
      else if (height == dzero) then
        height_zero_error = .false.
      end if
      roughfraction = this%cross_sections(irch)%roughfraction(n)
      if (roughfraction <= dzero) then
        roughness_error = .true.
      end if
      if (station_error .and. height_error .and. &
          roughness_error) then
        exit
      end if
    end do
    !
    ! -- write error messages
    if (station_error .or. height_error .or. &
        height_zero_error .or. roughness_error) then
      filename = this%filenames(irch)
      if (station_error) then
        write (errmsg, '(3a,1x,i0,1x,a)') &
          "All xfraction data in '", trim(adjustl(filename)), &
          "' for reach", irch, 'must be greater than or equal to zero.'
        call store_error(errmsg)
      end if
      if (height_error) then
        write (errmsg, '(3a,1x,i0,1x,a)') &
          "All height data in '", trim(adjustl(filename)), &
          "' for reach", irch, 'must be greater than or equal to zero.'
        call store_error(errmsg)
      end if
      if (height_zero_error) then
        write (errmsg, '(3a,1x,i0,1x,a)') &
          "At least one height data value in '", trim(adjustl(filename)), &
          "' for reach", irch, 'must be equal to zero.'
        call store_error(errmsg)
      end if
      if (roughness_error) then
        write (errmsg, '(3a,1x,i0,1x,a)') &
          "All manfraction data in '", trim(adjustl(filename)), &
          "' for reach", irch, 'must be greater than zero.'
        call store_error(errmsg)
      end if
    end if
    !
    ! -- initialize and fill heights
    allocate (heights(npts))
    do n = 1, npts
      heights(n) = this%cross_sections(irch)%height(n)
    end do
    !
    ! -- get unique heights
    call unique_values(heights, unique_heights)
    !
    ! -- calculate the product of the area and the hydraulic radius to
    !    the 2/3 power
    do n = 1, size(unique_heights)
      if (unique_heights(n) <= dzero) cycle
      ipos = 1
      do i = -1, 1, 1
        height = unique_heights(n) + real(i, dp) * dem6
        aw = get_cross_section_area(npts, this%cross_sections(irch)%station, &
                                    this%cross_sections(irch)%height, height)
        rh = get_hydraulic_radius(npts, this%cross_sections(irch)%station, &
                                  this%cross_sections(irch)%height, height)
        factor(ipos) = aw * rh**dtwothirds
        ipos = ipos + 1
      end do
      !
      ! -- calculate the derivative
      dc0 = (factor(2) - factor(1)) / dem6
      dc1 = (factor(3) - factor(2)) / dem6
      !
      ! -- evaluate the difference
      if (dc0 < dzero .or. dc1 < dzero) then
        this%invalid = this%invalid + 1
        height = unique_heights(n)
        do i = 1, npts
          if (this%cross_sections(irch)%height(i) == height) then
            this%cross_sections(irch)%valid(i) = .false.
          end if
        end do
      end if
    end do
    !
    ! -- deallocate local storage
    deallocate (heights)
    deallocate (unique_heights)

Here is the call graph for this function: