24 integer(I4B),
public :: iuactive
25 integer(I4B),
private :: inunit
26 integer(I4B),
private :: iuext
27 integer(I4B),
private :: iout
28 integer(I4B),
private :: linesread
29 integer(I4B),
private :: lloc
30 character(len=LINELENGTH),
private :: blockname
31 character(len=LINELENGTH),
private :: blocknamefound
32 character(len=LENHUGELINE),
private :: laststring
33 character(len=:),
allocatable,
private :: line
66 integer(I4B),
intent(in) :: inunit
67 integer(I4B),
intent(in) :: iout
72 this%iuactive = inunit
94 if (this%inunit > 0)
then
95 inquire (unit=this%inunit, opened=lop)
101 if (this%iuext /= this%inunit .and. this%iuext > 0)
then
102 inquire (unit=this%iuext, opened=lop)
117 deallocate (this%line)
129 subroutine getblock(this, blockName, isFound, ierr, supportOpenClose, &
130 blockRequired, blockNameFound)
133 character(len=*),
intent(in) :: blockName
134 logical,
intent(out) :: isFound
135 integer(I4B),
intent(out) :: ierr
136 logical,
intent(in),
optional :: supportOpenClose
137 logical,
intent(in),
optional :: blockRequired
138 character(len=*),
intent(inout),
optional :: blockNameFound
140 logical :: continueRead
141 logical :: supportOpenCloseLocal
142 logical :: blockRequiredLocal
145 if (
present(supportopenclose))
then
146 supportopencloselocal = supportopenclose
148 supportopencloselocal = .false.
151 if (
present(blockrequired))
then
152 blockrequiredlocal = blockrequired
154 blockrequiredlocal = .true.
156 continueread = blockrequiredlocal
157 this%blockName = blockname
158 this%blockNameFound =
''
160 if (blockname ==
'*')
then
162 isfound, this%lloc, this%line, blocknamefound, &
165 this%blockNameFound = blocknamefound
171 call uget_block(this%line_reader, this%inunit, this%iout, &
172 this%blockName, ierr, isfound, &
173 this%lloc, this%line, this%iuext, continueread, &
174 supportopencloselocal)
175 if (isfound) this%blockNameFound = this%blockName
177 this%iuactive = this%iuext
192 logical,
intent(out) :: endOfBlock
196 integer(I4B) :: istart
197 integer(I4B) :: istop
199 character(len=10) :: key
209 if (lineread)
exit loop1
210 call this%line_reader%rdcom(this%iuext, this%iout, this%line, ierr)
212 call urword(this%line, this%lloc, istart, istop, 0, ival, rval, &
213 this%iout, this%iuext)
214 key = this%line(istart:istop)
216 if (key ==
'END' .or. key ==
'BEGIN')
then
218 this%blockNameFound, this%lloc, this%line, &
220 this%iuactive = this%iuext
223 elseif (key ==
'')
then
227 if (this%iuext /= this%inunit)
then
229 this%iuext = this%inunit
230 this%iuactive = this%inunit
232 errmsg =
'Unexpected end of file reached.'
234 call this%StoreErrorUnit()
238 this%linesRead = this%linesRead + 1
258 integer(I4B) :: istart
259 integer(I4B) :: istop
263 call urword(this%line, this%lloc, istart, istop, 2, i, rval, &
264 this%iout, this%iuext)
267 if (istart == istop .and. istop == len(this%line))
then
268 call this%ReadScalarError(
'INTEGER')
282 integer(I4B) :: nlines
287 nlines = this%linesRead
305 integer(I4B) :: istart
306 integer(I4B) :: istop
310 call urword(this%line, this%lloc, istart, istop, 3, ival, r, &
311 this%iout, this%iuext)
314 if (istart == istop .and. istop == len(this%line))
then
315 call this%ReadScalarError(
'DOUBLE PRECISION')
323 real(DP),
intent(inout) :: r
324 logical(LGP),
intent(inout) :: success
326 integer(I4B) :: istart
327 integer(I4B) :: istop
330 call urword(this%line, this%lloc, istart, istop, 3, ival, r, &
331 this%iout, this%iuext)
334 if (istart == istop .and. istop == len(this%line))
then
348 character(len=*),
intent(in) :: vartype
350 character(len=MAXCHARLEN - 100) :: linetemp
356 write (
errmsg,
'(3a)')
'Error in block ', trim(this%blockName),
'.'
358 trim(
errmsg),
' Could not read variable of type ', trim(vartype), &
359 " from the following line: '"
361 trim(
errmsg), trim(adjustl(this%line)),
"'."
363 call this%StoreErrorUnit()
378 character(len=*),
intent(out) :: string
379 logical,
optional,
intent(in) :: convertToUpper
381 integer(I4B) :: istart
382 integer(I4B) :: istop
384 integer(I4B) :: ncode
388 if (
present(converttoupper))
then
389 if (converttoupper)
then
398 call urword(this%line, this%lloc, istart, istop, ncode, &
399 ival, rval, this%iout, this%iuext)
400 string = this%line(istart:istop)
401 this%laststring = this%line(istart:istop)
416 character(len=*),
intent(out) :: string
419 call this%GetString(string, converttoupper=.true.)
433 character(len=:),
allocatable,
intent(out) :: line
435 integer(I4B) :: lastpos
436 integer(I4B) :: newlinelen
439 lastpos = len_trim(this%line)
440 newlinelen = lastpos - this%lloc + 2
441 newlinelen = max(newlinelen, 1)
442 allocate (
character(len=newlinelen) :: line)
443 line(:) = this%line(this%lloc:lastpos)
444 line(newlinelen:newlinelen) =
' '
459 logical :: endofblock
462 call this%GetNextLine(endofblock)
463 if (.not. endofblock)
then
464 errmsg =
"LOOKING FOR 'END "//trim(this%blockname)// &
465 "'. FOUND: "//
"'"//trim(this%line)//
"'."
467 call this%StoreErrorUnit()
482 integer(I4B),
intent(in) :: ndim
483 character(len=*),
intent(out) :: cellid
484 logical,
optional,
intent(in) :: flag_string
489 integer(I4B) :: istart
490 integer(I4B) :: istop
492 integer(I4B) :: istat
494 character(len=10) :: cint
495 character(len=100) :: firsttoken
498 if (
present(flag_string))
then
500 call urword(this%line, lloc, istart, istop, 0, ival, rval, this%iout, &
502 firsttoken = this%line(istart:istop)
503 read (firsttoken, *, iostat=istat) ival
513 j = this%GetInteger()
514 write (cint,
'(i0)') j
518 cellid = trim(cellid)//
' '//cint
534 character(len=*),
intent(out) :: line
552 logical,
intent(in),
optional :: terminate
554 logical :: lterminate
557 if (
present(terminate))
then
558 lterminate = terminate
598 errmsg =
"Invalid keyword '"//trim(this%laststring)// &
599 "' detected in block '"//trim(this%blockname)//
"'."
612 subroutine uget_block(line_reader, iin, iout, ctag, ierr, isfound, &
613 lloc, line, iuext, blockRequired, supportopenclose)
617 integer(I4B),
intent(in) :: iin
618 integer(I4B),
intent(in) :: iout
619 character(len=*),
intent(in) :: ctag
620 integer(I4B),
intent(out) :: ierr
621 logical,
intent(inout) :: isfound
622 integer(I4B),
intent(inout) :: lloc
623 character(len=:),
allocatable,
intent(inout) :: line
624 integer(I4B),
intent(inout) :: iuext
625 logical,
optional,
intent(in) :: blockrequired
626 logical,
optional,
intent(in) :: supportopenclose
628 integer(I4B) :: istart
629 integer(I4B) :: istop
631 integer(I4B) :: lloc2
633 character(len=:),
allocatable :: line2
634 character(len=LINELENGTH) :: fname
635 character(len=MAXCHARLEN) :: ermsg
636 logical :: supportoc, blockrequiredlocal
639 if (
present(blockrequired))
then
640 blockrequiredlocal = blockrequired
642 blockrequiredlocal = .true.
645 if (
present(supportopenclose))
then
646 supportoc = supportopenclose
652 call line_reader%rdcom(iin, iout, line, ierr)
654 if (blockrequiredlocal)
then
655 ermsg =
'Required block "'//trim(ctag)// &
656 '" not found. Found end of file instead.'
663 call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout)
664 if (line(istart:istop) ==
'BEGIN')
then
665 call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout)
666 if (line(istart:istop) == ctag)
then
670 call line_reader%rdcom(iin, iout, line2, ierr)
673 call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout)
674 if (line2(istart:istop) ==
'OPEN/CLOSE')
then
676 call urword(line2, lloc2, istart, istop, 0, ival, rval, iin, iout)
677 fname = line2(istart:istop)
680 call urword(line2, lloc2, istart, istop, 1, ival, rval, iin, iout)
681 if (line2(istart:istop) ==
'')
exit chk
682 if (line2(istart:istop) ==
'(BINARY)' .or. &
683 line2(istart:istop) ==
'SFAC')
then
684 call line_reader%bkspc(iin)
689 call openfile(iuext, iout, fname,
'OPEN/CLOSE')
691 call line_reader%bkspc(iin)
695 if (blockrequiredlocal)
then
696 ermsg =
'Error: Required block "'//trim(ctag)// &
697 '" not found. Found block "'//line(istart:istop)// &
702 call line_reader%bkspc(iin)
706 else if (line(istart:istop) ==
'END')
then
707 call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout)
708 if (line(istart:istop) == ctag)
then
709 ermsg =
'Error: Looking for BEGIN '//trim(ctag)// &
710 ' but found END '//line(istart:istop)// &
729 lloc, line, ctagfound, iuext)
733 integer(I4B),
intent(in) :: iin
734 integer(I4B),
intent(in) :: iout
735 logical,
intent(inout) :: isfound
736 integer(I4B),
intent(inout) :: lloc
737 character(len=:),
allocatable,
intent(inout) :: line
738 character(len=*),
intent(out) :: ctagfound
739 integer(I4B),
intent(inout) :: iuext
741 integer(I4B) :: ierr, istart, istop
742 integer(I4B) :: ival, lloc2
744 character(len=100) :: ermsg
745 character(len=:),
allocatable :: line2
746 character(len=LINELENGTH) :: fname
754 call line_reader%rdcom(iin, iout, line, ierr)
756 call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout)
757 if (line(istart:istop) ==
'BEGIN')
then
758 call urword(line, lloc, istart, istop, 1, ival, rval, iin, iout)
759 if (line(istart:istop) /=
'')
then
761 ctagfound = line(istart:istop)
762 call line_reader%rdcom(iin, iout, line2, ierr)
765 call urword(line2, lloc2, istart, istop, 1, ival, rval, iout, iin)
766 if (line2(istart:istop) ==
'OPEN/CLOSE')
then
768 call urword(line2, lloc2, istart, istop, 0, ival, rval, iout, iin)
769 fname = line2(istart:istop)
770 call openfile(iuext, iout, fname,
'OPEN/CLOSE')
772 call line_reader%bkspc(iin)
775 ermsg =
'Block name missing in file.'
795 integer(I4B),
intent(in) :: iin
796 integer(I4B),
intent(in) :: iout
797 character(len=*),
intent(in) :: key
798 character(len=*),
intent(in) :: ctag
799 integer(I4B),
intent(inout) :: lloc
800 character(len=*),
intent(inout) :: line
801 integer(I4B),
intent(inout) :: ierr
802 integer(I4B),
intent(inout) :: iuext
804 character(len=LENBIGLINE) :: ermsg
805 integer(I4B) :: istart
806 integer(I4B) :: istop
810 1
format(
'ERROR. "', a,
'" DETECTED WITHOUT "', a,
'". ',
'"END', 1x, a, &
811 '" MUST BE USED TO END ', a,
'.')
812 2
format(
'ERROR. "', a,
'" DETECTED BEFORE "END', 1x, a,
'". ',
'"END', 1x, a, &
813 '" MUST BE USED TO END ', a,
'.')
819 call urword(line, lloc, istart, istop, 1, ival, rval, iout, iin)
820 if (line(istart:istop) /= ctag)
then
821 write (ermsg, 1) trim(key), trim(ctag), trim(ctag), trim(ctag)
826 if (iuext /= iin)
then
833 write (ermsg, 2) trim(key), trim(ctag), trim(ctag), trim(ctag)
This module contains block parser methods.
subroutine trygetdouble(this, r, success)
subroutine getstring(this, string, convertToUpper)
@ brief Get a string
integer(i4b) function getlinesread(this)
@ brief Get the number of lines read
subroutine initialize(this, inunit, iout)
@ brief Initialize the block parser
integer(i4b) function getunit(this)
@ brief Get the unit number
subroutine, public uterminate_block(iin, iout, key, ctag, lloc, line, ierr, iuext)
Evaluate if the end of a block has been found.
integer(i4b) function getinteger(this)
@ brief Get a integer
subroutine, public uget_any_block(line_reader, iin, iout, isfound, lloc, line, ctagfound, iuext)
Find the next block in a file.
subroutine, public uget_block(line_reader, iin, iout, ctag, ierr, isfound, lloc, line, iuext, blockRequired, supportopenclose)
Find a block in a file.
subroutine readscalarerror(this, vartype)
@ brief Issue a read error
subroutine getnextline(this, endOfBlock)
@ brief Get the next line
subroutine getstringcaps(this, string)
@ brief Get an upper case string
subroutine clear(this)
@ brief Close the block parser
subroutine getremainingline(this, line)
@ brief Get the rest of a line
subroutine getcurrentline(this, line)
@ brief Get the current line
subroutine terminateblock(this)
@ brief Ensure that the block is closed
subroutine storeerrorunit(this, terminate)
@ brief Store the unit number
real(dp) function getdouble(this)
@ brief Get a double precision real
subroutine devopt(this)
@ brief Disable development option in release mode
subroutine getblock(this, blockName, isFound, ierr, supportOpenClose, blockRequired, blockNameFound)
@ brief Get block
subroutine getcellid(this, ndim, cellid, flag_string)
@ brief Get a cellid
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lenhugeline
maximum length of a huge line
integer(i4b), parameter lenbigline
maximum length of a big line
integer(i4b), parameter maxcharlen
maximum length of char string
Disable development features in release mode.
subroutine, public dev_feature(errmsg, iunit)
Terminate if in release mode (guard development features)
This module defines variable data types.
This module contains the LongLineReaderType.
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string