blockparsermodule Module Reference

This module contains block parser methods. More...

Data Types
type	blockparsertype

Functions/Subroutines
subroutine	initialize (this, inunit, iout)
	@ brief Initialize the block parser More...
subroutine	clear (this)
	@ brief Close the block parser More...
subroutine	getblock (this, blockName, isFound, ierr, supportOpenClose, blockRequired, blockNameFound)
	@ brief Get block More...
subroutine	getnextline (this, endOfBlock)
	@ brief Get the next line More...
integer(i4b) function	getinteger (this)
	@ brief Get a integer More...
integer(i4b) function	getlinesread (this)
	@ brief Get the number of lines read More...
real(dp) function	getdouble (this)
	@ brief Get a double precision real More...
subroutine	trygetdouble (this, r, success)
subroutine	readscalarerror (this, vartype)
	@ brief Issue a read error More...
subroutine	getstring (this, string, convertToUpper)
	@ brief Get a string More...
subroutine	getstringcaps (this, string)
	@ brief Get an upper case string More...
subroutine	getremainingline (this, line)
	@ brief Get the rest of a line More...
subroutine	terminateblock (this)
	@ brief Ensure that the block is closed More...
subroutine	getcellid (this, ndim, cellid, flag_string)
	@ brief Get a cellid More...
subroutine	getcurrentline (this, line)
	@ brief Get the current line More...
subroutine	storeerrorunit (this, terminate)
	@ brief Store the unit number More...
integer(i4b) function	getunit (this)
	@ brief Get the unit number More...
subroutine	devopt (this)
	@ brief Disable development option in release mode More...
subroutine, public	uget_block (line_reader, iin, iout, ctag, ierr, isfound, lloc, line, iuext, blockRequired, supportopenclose)
	Find a block in a file. More...
subroutine, public	uget_any_block (line_reader, iin, iout, isfound, lloc, line, ctagfound, iuext)
	Find the next block in a file. More...
subroutine, public	uterminate_block (iin, iout, key, ctag, lloc, line, ierr, iuext)
	Evaluate if the end of a block has been found. More...

Detailed Description

This module contains the generic block parser type and methods that are used to parse MODFLOW 6 block data.

Function/Subroutine Documentation

clear()

subroutine blockparsermodule::clear ( class(blockparsertype), intent(inout)  this )

private

Method to clear the block parser, which closes file(s) and clears member variables.

Parameters

[in,out]

this

BlockParserType object

Definition at line 84 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    ! -- local variables
    logical :: lop
    !
    ! Close any connected files
    if (this%inunit > 0) then
      inquire (unit=this%inunit, opened=lop)
      if (lop) then
        close (this%inunit)
      end if
    end if
    !
    if (this%iuext /= this%inunit .and. this%iuext > 0) then
      inquire (unit=this%iuext, opened=lop)
      if (lop) then
        close (this%iuext)
      end if
    end if
    !
    ! Clear all member variables
    this%inunit = 0
    this%iuext = 0
    this%iuactive = 0
    this%iout = 0
    this%lloc = 0
    this%linesRead = 0
    this%blockName = ''
    this%line = ''
    deallocate (this%line)

devopt()

subroutine blockparsermodule::devopt ( class(blockparsertype), intent(inout)  this )

private

Terminate with an error if in release mode (IDEVELOPMODE = 0). Enables options for development and testing while disabling for public release.

Definition at line 549 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this
    !
    errmsg = "Invalid keyword '"//trim(this%laststring)// &
             "' detected in block '"//trim(this%blockname)//"'."
    call dev_feature(errmsg, this%iuext)

Here is the call graph for this function:

getblock()

subroutine blockparsermodule::getblock ( class(blockparsertype), intent(inout)  this, character(len=*), intent(in)  blockName, logical, intent(out)  isFound, integer(i4b), intent(out)  ierr, logical, intent(in), optional  supportOpenClose, logical, intent(in), optional  blockRequired, character(len=*), intent(inout), optional  blockNameFound  )

private

Method to get the block from a file. The file is read until the blockname is found.

Parameters

[in,out]	this	BlockParserType object
[in]	blockname	block name to search for
[out]	isfound	boolean indicating if the block name was found
[out]	ierr	return error code, 0 indicates block was found
[in]	supportopenclose	boolean indicating if the block supports open/close, default false
[in]	blockrequired	boolean indicating if the block is required, default true
[in,out]	blocknamefound	optional return value of block name found

Definition at line 123 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    character(len=*), intent(in) :: blockName !< block name to search for
    logical, intent(out) :: isFound !< boolean indicating if the block name was found
    integer(I4B), intent(out) :: ierr !< return error code, 0 indicates block was found
    logical, intent(in), optional :: supportOpenClose !< boolean indicating if the block supports open/close, default false
    logical, intent(in), optional :: blockRequired !< boolean indicating if the block is required, default true
    character(len=*), intent(inout), optional :: blockNameFound !< optional return value of block name found
    ! -- local variables
    logical :: continueRead
    logical :: supportOpenCloseLocal
    logical :: blockRequiredLocal
    !
    ! -- process optional variables
    if (present(supportopenclose)) then
      supportopencloselocal = supportopenclose
    else
      supportopencloselocal = .false.
    end if
    !
    if (present(blockrequired)) then
      blockrequiredlocal = blockrequired
    else
      blockrequiredlocal = .true.
    end if
    continueread = blockrequiredlocal
    this%blockName = blockname
    this%blockNameFound = ''
    !
    if (blockname == '*') then
      call uget_any_block(this%line_reader, this%inunit, this%iout, &
                          isfound, this%lloc, this%line, blocknamefound, &
                          this%iuext)
      if (isfound) then
        this%blockNameFound = blocknamefound
        ierr = 0
      else
        ierr = 1
      end if
    else
      call uget_block(this%line_reader, this%inunit, this%iout, &
                      this%blockName, ierr, isfound, &
                      this%lloc, this%line, this%iuext, continueread, &
                      supportopencloselocal)
      if (isfound) this%blockNameFound = this%blockName
    end if
    this%iuactive = this%iuext
    this%linesRead = 0

Here is the call graph for this function:

getcellid()

subroutine blockparsermodule::getcellid ( class(blockparsertype), intent(inout)  this, integer(i4b), intent(in)  ndim, character(len=*), intent(out)  cellid, logical, intent(in), optional  flag_string  )

private

Method to get a cellid from a line.

Parameters

[in,out]	this	BlockParserType object
[in]	ndim	number of dimensions (1, 2, or 3)
[out]	cellid	cell =id
[in]	flag_string	boolean indicating id cellid is a string

Definition at line 446 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    integer(I4B), intent(in) :: ndim !< number of dimensions (1, 2, or 3)
    character(len=*), intent(out) :: cellid !< cell =id
    logical, optional, intent(in) :: flag_string !< boolean indicating id cellid is a string
    ! -- local variables
    integer(I4B) :: i
    integer(I4B) :: j
    integer(I4B) :: lloc
    integer(I4B) :: istart
    integer(I4B) :: istop
    integer(I4B) :: ival
    integer(I4B) :: istat
    real(DP) :: rval
    character(len=10) :: cint
    character(len=100) :: firsttoken
    !
    ! -- process optional variables
    if (present(flag_string)) then
      lloc = this%lloc
      call urword(this%line, lloc, istart, istop, 0, ival, rval, this%iout, &
                  this%iuext)
      firsttoken = this%line(istart:istop)
      read (firsttoken, *, iostat=istat) ival
      if (istat > 0) then
        call upcase(firsttoken)
        cellid = firsttoken
        return
      end if
    end if
    !
    cellid = ''
    do i = 1, ndim
      j = this%GetInteger()
      write (cint, '(i0)') j
      if (i == 1) then
        cellid = cint
      else
        cellid = trim(cellid)//' '//cint
      end if
    end do

Here is the call graph for this function:

getcurrentline()

subroutine blockparsermodule::getcurrentline ( class(blockparsertype), intent(inout)  this, character(len=*), intent(out)  line  )

private

Method to get the current line.

Parameters

[in,out]	this	BlockParserType object
[out]	line	current line

Definition at line 495 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    character(len=*), intent(out) :: line !< current line
    !
    ! -- get the current line
    line = this%line

getdouble()

real(dp) function blockparsermodule::getdouble ( class(blockparsertype), intent(inout)  this )

private

Function to get adouble precision floating point number from the current line.

Returns

double precision real variable

Parameters

[in,out]

this

BlockParserType object

Definition at line 281 of file BlockParser.f90.

    ! -- return variable
    real(DP) :: r !< double precision real variable
    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    ! -- local variables
    integer(I4B) :: istart
    integer(I4B) :: istop
    integer(I4B) :: ival
    !
    ! -- get double precision real using urword
    call urword(this%line, this%lloc, istart, istop, 3, ival, r, &
                this%iout, this%iuext)
    !
    ! -- Make sure variable was read before end of line
    if (istart == istop .and. istop == len(this%line)) then
      call this%ReadScalarError('DOUBLE PRECISION')
    end if
 

Here is the call graph for this function:

getinteger()

integer(i4b) function blockparsermodule::getinteger ( class(blockparsertype), intent(inout)  this )

private

Function to get a integer from the current line.

Returns

integer variable

Parameters

[in,out]

this

BlockParserType object

Definition at line 240 of file BlockParser.f90.

    ! -- return variable
    integer(I4B) :: i !< integer variable
    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    ! -- local variables
    integer(I4B) :: istart
    integer(I4B) :: istop
    real(DP) :: rval
    !
    ! -- get integer using urword
    call urword(this%line, this%lloc, istart, istop, 2, i, rval, &
                this%iout, this%iuext)
    !
    ! -- Make sure variable was read before end of line
    if (istart == istop .and. istop == len(this%line)) then
      call this%ReadScalarError('INTEGER')
    end if

Here is the call graph for this function:

getlinesread()

integer(i4b) function blockparsermodule::getlinesread ( class(blockparsertype), intent(inout)  this )

private

Function to get the number of lines read from the current block.

Returns

number of lines read

Parameters

[in,out]

this

BlockParserType object

Definition at line 265 of file BlockParser.f90.

    ! -- return variable
    integer(I4B) :: nlines !< number of lines read
    ! -- dummy variable
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    !
    ! -- number of lines read
    nlines = this%linesRead

getnextline()

subroutine blockparsermodule::getnextline ( class(blockparsertype), intent(inout)  this, logical, intent(out)  endOfBlock  )

private

Method to get the next line from a file.

Parameters

[in,out]	this	BlockParserType object
[out]	endofblock	boolean indicating if the end of the block was read

Definition at line 180 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    logical, intent(out) :: endOfBlock !< boolean indicating if the end of the block was read
    ! -- local variables
    integer(I4B) :: ierr
    integer(I4B) :: ival
    integer(I4B) :: istart
    integer(I4B) :: istop
    real(DP) :: rval
    character(len=10) :: key
    logical :: lineread
    !
    ! -- initialize local variables
    endofblock = .false.
    ierr = 0
    lineread = .false.
    !
    ! -- read next line
    loop1: do
      if (lineread) exit loop1
      call this%line_reader%rdcom(this%iuext, this%iout, this%line, ierr)
      this%lloc = 1
      call urword(this%line, this%lloc, istart, istop, 0, ival, rval, &
                  this%iout, this%iuext)
      key = this%line(istart:istop)
      call upcase(key)
      if (key == 'END' .or. key == 'BEGIN') then
        call uterminate_block(this%inunit, this%iout, key, &
                              this%blockNameFound, this%lloc, this%line, &
                              ierr, this%iuext)
        this%iuactive = this%iuext
        endofblock = .true.
        lineread = .true.
      elseif (key == '') then
        ! End of file reached.
        ! If this is an OPEN/CLOSE file, close the file and read the next
        ! line from this%inunit.
        if (this%iuext /= this%inunit) then
          close (this%iuext)
          this%iuext = this%inunit
          this%iuactive = this%inunit
        else
          errmsg = 'Unexpected end of file reached.'
          call store_error(errmsg)
          call this%StoreErrorUnit()
        end if
      else
        this%lloc = 1
        this%linesRead = this%linesRead + 1
        lineread = .true.
      end if
    end do loop1

Here is the call graph for this function:

getremainingline()

subroutine blockparsermodule::getremainingline ( class(blockparsertype), intent(inout)  this, character(len=:), intent(out), allocatable  line  )

private

Method to get the rest of the line from the current line.

Parameters

[in,out]	this	BlockParserType object
[out]	line	remainder of the line

Definition at line 403 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    character(len=:), allocatable, intent(out) :: line !< remainder of the line
    ! -- local variables
    integer(I4B) :: lastpos
    integer(I4B) :: newlinelen
    !
    ! -- get the rest of the line
    lastpos = len_trim(this%line)
    newlinelen = lastpos - this%lloc + 2
    newlinelen = max(newlinelen, 1)
    allocate (character(len=newlinelen) :: line)
    line(:) = this%line(this%lloc:lastpos)
    line(newlinelen:newlinelen) = ' '

getstring()

subroutine blockparsermodule::getstring ( class(blockparsertype), intent(inout)  this, character(len=*), intent(out)  string, logical, intent(in), optional  convertToUpper  )

private

Method to get a string from the current line and optionally convert it to upper case.

Parameters

[in,out]	this	BlockParserType object
[in]	converttoupper	boolean indicating if the string should be converted to upper case, default false

Definition at line 354 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    character(len=*), intent(out) :: string !< string
    logical, optional, intent(in) :: convertToUpper !< boolean indicating if the string should be converted to upper case, default false
    ! -- local variables
    integer(I4B) :: istart
    integer(I4B) :: istop
    integer(I4B) :: ival
    integer(I4B) :: ncode
    real(DP) :: rval
    !
    ! -- process optional variables
    if (present(converttoupper)) then
      if (converttoupper) then
        ncode = 1
      else
        ncode = 0
      end if
    else
      ncode = 0
    end if
    !
    call urword(this%line, this%lloc, istart, istop, ncode, &
                ival, rval, this%iout, this%iuext)
    string = this%line(istart:istop)
    this%laststring = this%line(istart:istop)

Here is the call graph for this function:

getstringcaps()

subroutine blockparsermodule::getstringcaps ( class(blockparsertype), intent(inout)  this, character(len=*), intent(out)  string  )

private

Method to get a string from the current line and convert it to upper case.

Parameters

[in,out]	this	BlockParserType object
[out]	string	upper case string

Definition at line 389 of file BlockParser.f90.

    ! -- dummy  variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    character(len=*), intent(out) :: string !< upper case string
    !
    ! -- call base GetString method with convertToUpper variable
    call this%GetString(string, converttoupper=.true.)

getunit()

integer(i4b) function blockparsermodule::getunit ( class(blockparsertype), intent(inout)  this )

private

Function to get the unit number for the block parser.

Returns

unit number for the block parser

Parameters

[in,out]

this

BlockParserType object

Definition at line 533 of file BlockParser.f90.

    ! -- return variable
    integer(I4B) :: i !< unit number for the block parser
    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    !
    ! -- block parser unit number
    i = this%iuext

initialize()

subroutine blockparsermodule::initialize ( class(blockparsertype), intent(inout)  this, integer(i4b), intent(in)  inunit, integer(i4b), intent(in)  iout  )

private

Method to initialize the block parser.

Parameters

[in,out]	this	BlockParserType object
[in]	inunit	input file unit number
[in]	iout	listing file unit number

Definition at line 63 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    integer(I4B), intent(in) :: inunit !< input file unit number
    integer(I4B), intent(in) :: iout !< listing file unit number
    !
    ! -- initialize values
    this%inunit = inunit
    this%iuext = inunit
    this%iuactive = inunit
    this%iout = iout
    this%blockName = ''
    this%linesRead = 0

readscalarerror()

subroutine blockparsermodule::readscalarerror ( class(blockparsertype), intent(inout)  this, character(len=*), intent(in)  vartype  )

private

Method to issue an unable to read error.

Parameters

[in,out]	this	BlockParserType object
[in]	vartype	string of variable type

Definition at line 327 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    character(len=*), intent(in) :: vartype !< string of variable type
    ! -- local variables
    character(len=MAXCHARLEN - 100) :: linetemp
    !
    ! -- use linetemp as line may be longer than MAXCHARLEN
    linetemp = this%line
    !
    ! -- write the message
    write (errmsg, '(3a)') 'Error in block ', trim(this%blockName), '.'
    write (errmsg, '(4a)') &
      trim(errmsg), ' Could not read variable of type ', trim(vartype), &
      " from the following line: '"
    write (errmsg, '(3a)') &
      trim(errmsg), trim(adjustl(this%line)), "'."
    call store_error(errmsg)
    call this%StoreErrorUnit()

Here is the call graph for this function:

storeerrorunit()

subroutine blockparsermodule::storeerrorunit ( class(blockparsertype), intent(inout)  this, logical, intent(in), optional  terminate  )

private

Method to store the unit number for the file that caused a read error. Default is to terminate the simulation when this method is called.

Parameters

[in,out]	this	BlockParserType object
[in]	terminate	boolean indicating if the simulation should be terminated

Definition at line 510 of file BlockParser.f90.

    ! -- dummy variable
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    logical, intent(in), optional :: terminate !< boolean indicating if the simulation should be terminated
    ! -- local variables
    logical :: lterminate
    !
    ! -- process optional variables
    if (present(terminate)) then
      lterminate = terminate
    else
      lterminate = .true.
    end if
    !
    ! -- store error unit
    call store_error_unit(this%iuext, terminate=lterminate)

Here is the call graph for this function:

terminateblock()

subroutine blockparsermodule::terminateblock ( class(blockparsertype), intent(inout)  this )

private

Method to ensure that the block is closed with an "end".

Parameters

[in,out]

this

BlockParserType object

Definition at line 425 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    ! -- local variables
    logical :: endofblock
    !
    ! -- look for block termination
    call this%GetNextLine(endofblock)
    if (.not. endofblock) then
      errmsg = "LOOKING FOR 'END "//trim(this%blockname)// &
               "'.  FOUND: "//"'"//trim(this%line)//"'."
      call store_error(errmsg)
      call this%StoreErrorUnit()
    end if

Here is the call graph for this function:

trygetdouble()

subroutine blockparsermodule::trygetdouble ( class(blockparsertype), intent(inout)  this, real(dp), intent(inout)  r, logical(lgp), intent(inout)  success  )

private

Parameters

[in,out]	this	BlockParserType object
[in,out]	r	double precision real variable
[in,out]	success	whether parsing was successful

Definition at line 302 of file BlockParser.f90.

    ! -- dummy variables
    class(BlockParserType), intent(inout) :: this !< BlockParserType object
    real(DP), intent(inout) :: r !< double precision real variable
    logical(LGP), intent(inout) :: success !< whether parsing was successful
    ! -- local variables
    integer(I4B) :: istart
    integer(I4B) :: istop
    integer(I4B) :: ival
 
    call urword(this%line, this%lloc, istart, istop, 3, ival, r, &
                this%iout, this%iuext)
 
    success = .true.
    if (istart == istop .and. istop == len(this%line)) then
      success = .false.
    end if
 

Here is the call graph for this function:

uget_any_block()

subroutine, public blockparsermodule::uget_any_block	(	type(longlinereadertype), intent(inout)	line_reader,
		integer(i4b), intent(in)	iin,
		integer(i4b), intent(in)	iout,
		logical, intent(inout)	isfound,
		integer(i4b), intent(inout)	lloc,
		character(len=:), intent(inout), allocatable	line,
		character(len=*), intent(out)	ctagfound,
		integer(i4b), intent(inout)	iuext
	)

Subroutine to read from a file until next block is found. Return isfound with true, if found, and return the block name.

Parameters

[in]	iin	file unit number
[in]	iout	output listing file unit
[in,out]	isfound	boolean indicating if a block was found
[in,out]	lloc	position in line
[out]	ctagfound	block name
[in,out]	iuext	external file unit number

Definition at line 678 of file BlockParser.f90.

    implicit none
    ! -- dummy variables
    type(LongLineReaderType), intent(inout) :: line_reader
    integer(I4B), intent(in) :: iin !< file unit number
    integer(I4B), intent(in) :: iout !< output listing file unit
    logical, intent(inout) :: isfound !< boolean indicating if a block was found
    integer(I4B), intent(inout) :: lloc !< position in line
    character(len=:), allocatable, intent(inout) :: line !< line
    character(len=*), intent(out) :: ctagfound !< block name
    integer(I4B), intent(inout) :: iuext !< external file unit number
    ! -- local variables
    integer(I4B) :: ierr, istart, istop
    integer(I4B) :: ival, lloc2
    real(DP) :: rval
    character(len=100) :: ermsg
    character(len=:), allocatable :: line2
    character(len=LINELENGTH) :: fname
    !
    ! -- code
    isfound = .false.
    ctagfound = ''
    iuext = iin
    do
      lloc = 1
      call line_reader%rdcom(iin, iout, line, ierr)
      if (ierr < 0) exit
      call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout)
      if (line(istart:istop) == 'BEGIN') then
        call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout)
        if (line(istart:istop) /= '') then
          isfound = .true.
          ctagfound = line(istart:istop)
          call line_reader%rdcom(iin, iout, line2, ierr)
          if (ierr < 0) exit
          lloc2 = 1
          call urword(line2, lloc2, istart, istop, 1, ival, rval, iout, iin)
          if (line2(istart:istop) == 'OPEN/CLOSE') then
            iuext = io_getunit()
            call urword(line2, lloc2, istart, istop, 0, ival, rval, iout, iin)
            fname = line2(istart:istop)
            call openfile(iuext, iout, fname, 'OPEN/CLOSE')
          else
            call line_reader%bkspc(iin)
          end if
        else
          ermsg = 'Block name missing in file.'
          call store_error(ermsg)
          call store_error_unit(iin)
        end if
        exit
      end if
    end do

Here is the call graph for this function:

Here is the caller graph for this function:

uget_block()

subroutine, public blockparsermodule::uget_block	(	type(longlinereadertype), intent(inout)	line_reader,
		integer(i4b), intent(in)	iin,
		integer(i4b), intent(in)	iout,
		character(len=*), intent(in)	ctag,
		integer(i4b), intent(out)	ierr,
		logical, intent(inout)	isfound,
		integer(i4b), intent(inout)	lloc,
		character(len=:), intent(inout), allocatable	line,
		integer(i4b), intent(inout)	iuext,
		logical, intent(in), optional	blockRequired,
		logical, intent(in), optional	supportopenclose
	)

Subroutine to read from a file until the tag (ctag) for a block is is found. Return isfound with true, if found.

Parameters

[in]	iin	file unit
[in]	iout	output listing file unit
[in]	ctag	block tag
[out]	ierr	error
[in,out]	isfound	boolean indicating if the block was found
[in,out]	lloc	position in line
[in,out]	iuext	external file unit number
[in]	blockrequired	boolean indicating if the block is required
[in]	supportopenclose	boolean indicating if the block supports open/close

Definition at line 565 of file BlockParser.f90.

    implicit none
    ! -- dummy variables
    type(LongLineReaderType), intent(inout) :: line_reader
    integer(I4B), intent(in) :: iin !< file unit
    integer(I4B), intent(in) :: iout !< output listing file unit
    character(len=*), intent(in) :: ctag !< block tag
    integer(I4B), intent(out) :: ierr !< error
    logical, intent(inout) :: isfound !< boolean indicating if the block was found
    integer(I4B), intent(inout) :: lloc !< position in line
    character(len=:), allocatable, intent(inout) :: line !< line
    integer(I4B), intent(inout) :: iuext !< external file unit number
    logical, optional, intent(in) :: blockRequired !< boolean indicating if the block is required
    logical, optional, intent(in) :: supportopenclose !< boolean indicating if the block supports open/close
    ! -- local variables
    integer(I4B) :: istart
    integer(I4B) :: istop
    integer(I4B) :: ival
    integer(I4B) :: lloc2
    real(DP) :: rval
    character(len=:), allocatable :: line2
    character(len=LINELENGTH) :: fname
    character(len=MAXCHARLEN) :: ermsg
    logical :: supportoc, blockRequiredLocal
    !
    ! -- code
    if (present(blockrequired)) then
      blockrequiredlocal = blockrequired
    else
      blockrequiredlocal = .true.
    end if
    supportoc = .false.
    if (present(supportopenclose)) then
      supportoc = supportopenclose
    end if
    iuext = iin
    isfound = .false.
    mainloop: do
      lloc = 1
      call line_reader%rdcom(iin, iout, line, ierr)
      if (ierr < 0) then
        if (blockrequiredlocal) then
          ermsg = 'Required block "'//trim(ctag)// &
                  '" not found.  Found end of file instead.'
          call store_error(ermsg)
          call store_error_unit(iuext)
        end if
        ! block not found so exit
        exit
      end if
      call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout)
      if (line(istart:istop) == 'BEGIN') then
        call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout)
        if (line(istart:istop) == ctag) then
          isfound = .true.
          if (supportoc) then
            ! Look for OPEN/CLOSE on 1st line after line starting with BEGIN
            call line_reader%rdcom(iin, iout, line2, ierr)
            if (ierr < 0) exit
            lloc2 = 1
            call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout)
            if (line2(istart:istop) == 'OPEN/CLOSE') then
              ! -- Get filename and preserve case
              call urword(line2, lloc2, istart, istop, 0, ival, rval, iin, iout)
              fname = line2(istart:istop)
              ! If line contains '(BINARY)' or 'SFAC', handle this block elsewhere
              chk: do
                call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout)
                if (line2(istart:istop) == '') exit chk
                if (line2(istart:istop) == '(BINARY)' .or. &
                    line2(istart:istop) == 'SFAC') then
                  call line_reader%bkspc(iin)
                  exit mainloop
                end if
              end do chk
              iuext = io_getunit()
              call openfile(iuext, iout, fname, 'OPEN/CLOSE')
            else
              call line_reader%bkspc(iin)
            end if
          end if
        else
          if (blockrequiredlocal) then
            ermsg = 'Error: Required block "'//trim(ctag)// &
                    '" not found. Found block "'//line(istart:istop)// &
                    '" instead.'
            call store_error(ermsg)
            call store_error_unit(iuext)
          else
            call line_reader%bkspc(iin)
          end if
        end if
        exit mainloop
      else if (line(istart:istop) == 'END') then
        call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout)
        if (line(istart:istop) == ctag) then
          ermsg = 'Error: Looking for BEGIN '//trim(ctag)// &
                  ' but found END '//line(istart:istop)// &
                  ' instead.'
          call store_error(ermsg)
          call store_error_unit(iuext)
        end if
      end if
    end do mainloop

Here is the call graph for this function:

Here is the caller graph for this function:

uterminate_block()

subroutine, public blockparsermodule::uterminate_block	(	integer(i4b), intent(in)	iin,
		integer(i4b), intent(in)	iout,
		character(len=*), intent(in)	key,
		character(len=*), intent(in)	ctag,
		integer(i4b), intent(inout)	lloc,
		character(len=*), intent(inout)	line,
		integer(i4b), intent(inout)	ierr,
		integer(i4b), intent(inout)	iuext
	)

Subroutine to evaluate if the end of a block has been found. Abnormal termination if 'begin' is found or if 'end' encountered with incorrect tag.

Parameters

[in]	iin	file unit number
[in]	iout	output listing file unit number
[in]	key	keyword in block
[in]	ctag	block name
[in,out]	lloc	position in line
[in,out]	ierr	error
[in,out]	iuext	external file unit number

Definition at line 741 of file BlockParser.f90.

    implicit none
    ! -- dummy variables
    integer(I4B), intent(in) :: iin !< file unit number
    integer(I4B), intent(in) :: iout !< output listing file unit number
    character(len=*), intent(in) :: key !< keyword in block
    character(len=*), intent(in) :: ctag !< block name
    integer(I4B), intent(inout) :: lloc !< position in line
    character(len=*), intent(inout) :: line !< line
    integer(I4B), intent(inout) :: ierr !< error
    integer(I4B), intent(inout) :: iuext !< external file unit number
    ! -- local variables
    character(len=LENBIGLINE) :: ermsg
    integer(I4B) :: istart
    integer(I4B) :: istop
    integer(I4B) :: ival
    real(DP) :: rval
    ! -- format
1   format('ERROR. "', a, '" DETECTED WITHOUT "', a, '". ', '"END', 1x, a, &
           '" MUST BE USED TO END ', a, '.')
2   format('ERROR. "', a, '" DETECTED BEFORE "END', 1x, a, '". ', '"END', 1x, a, &
           '" MUST BE USED TO END ', a, '.')
    !
    ! -- code
    ierr = 1
    select case (key)
    case ('END')
      call urword(line, lloc, istart, istop, 1, ival, rval, iout, iin)
      if (line(istart:istop) /= ctag) then
        write (ermsg, 1) trim(key), trim(ctag), trim(ctag), trim(ctag)
        call store_error(ermsg)
        call store_error_unit(iin)
      else
        ierr = 0
        if (iuext /= iin) then
          ! -- close external file
          close (iuext)
          iuext = iin
        end if
      end if
    case ('BEGIN')
      write (ermsg, 2) trim(key), trim(ctag), trim(ctag), trim(ctag)
      call store_error(ermsg)
      call store_error_unit(iin)
    end select

Here is the call graph for this function:

Here is the caller graph for this function: