getvals(3f) - [M_strings:TYPE] read arbitrary number of REAL values
from a character variable up to size of VALUES() array
(LICENSE:PD)
subroutine getvals(line,values,icount,ierr)
character(len=*),intent(in) :: line
class(*),intent(out) :: values(:)
integer,intent(out) :: icount
integer,intent(out),optional :: ierr
GETVALS(3f) reads a relatively arbitrary number of numeric values from a character variable into a REAL array using list-directed input.
NOTE: In this version null values are skipped instead of meaning to leave that value unchanged
1,,,,,,,2 / reads VALUES=[1.0,2.0]
Per list-directed rules when reading values, allowed delimiters are comma, semi-colon and space.
the slash separator can be used to add inline comments.
10.1, 20.43e-1 ; 11 / THIS IS TREATED AS A COMMENT
Repeat syntax can be used up to the size of the output array. These are equivalent input lines:
4*10.0
10.0, 10.0, 10.0, 10.0
LINE A character variable containing the characters representing a list of numbers
VALUES() array holding numbers read from string. May be of type INTEGER, REAL, DOUBLEPRECISION, or CHARACTER. If CHARACTER the strings are returned as simple words instead of numeric values. ICOUNT number of defined numbers in VALUES(). If ICOUNT reaches the size of the VALUES() array parsing stops. IERR zero if no error occurred in reading numbers. Optional. If not present and an error occurs the program is terminated.
Sample program:
program demo_getvals
use M_strings, only: getvals
implicit none
integer,parameter :: longest_line=256
character(len=longest_line) :: line
real :: values(longest_line/2+1)
integer :: ios,icount,ierr
INFINITE: do
read(*,'(a)',iostat=ios) line
if(ios /= 0)exit INFINITE
call getvals(line,values,icount,ierr)
write(*,'(4(g0,1x))')'VALUES=',values(:icount)
enddo INFINITE
end program demo_getvals
Sample input lines
10,20 30.4
1 2 3
1
3 4*2.5 8
32.3333 / comment 1
30e3;300, 30.0, 3
even 1 like this! 10
11,,,,22,,,,33
Expected output:
VALUES= 10.0000000 20.0000000 30.3999996
VALUES= 1.00000000 2.00000000 3.00000000
VALUES= 1.00000000
VALUES=
VALUES= 3.00000000 2.50000000 2.50000000
2.50000000 2.50000000 8.00000000
VALUES= 32.3333015
VALUES= 30000.0000 300.000000 30.0000000
3.00000000
*getvals* WARNING:[even] is not a number
*getvals* WARNING:[like] is not a number
*getvals* WARNING:[this!] is not a number
VALUES= 1.00000000 10.0000000
VALUES= 11.0000000 22.0000000 33.0000000
John S. Urban
Public Domain
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | line | |||
| class(*), | intent(out) | :: | values(:) | |||
| integer, | intent(out) | :: | icount | |||
| integer, | intent(out), | optional | :: | ierr |
subroutine getvals(line,values,icount,ierr)
! ident_62="@(#) M_strings getvals(3f) read arbitrary number of values from a character variable"
! JSU 20170831
character(len=*),intent(in) :: line
class(*),intent(out) :: values(:)
integer,intent(out) :: icount
integer,intent(out),optional :: ierr
character(len=:),allocatable :: buffer
character(len=len(line)) :: words(size(values))
integer :: ios, i, ierr_local,isize
isize=0
select type(values)
type is (integer); isize=size(values)
type is (real); isize=size(values)
type is (doubleprecision); isize=size(values)
type is (character(len=*)); isize=size(values)
end select
ierr_local=0
words=' ' ! make sure words() is initialized to null+blanks
buffer=trim(unquote(line))//"/" ! add a slash to the end so how the read behaves with missing values is clearly defined
read(buffer,*,iostat=ios) words ! undelimited strings are read into an array
icount=0
do i=1,isize ! loop thru array and convert non-blank words to numbers
if(words(i) == ' ')cycle
select type(values)
type is (integer); read(words(i),*,iostat=ios)values(icount+1)
type is (real); read(words(i),*,iostat=ios)values(icount+1)
type is (doubleprecision); read(words(i),*,iostat=ios)values(icount+1)
type is (character(len=*)); values(icount+1)=words(i)
end select
if(ios == 0)then
icount=icount+1
else
ierr_local=ios
write(ERROR_UNIT,*)'*getvals* WARNING:['//trim(words(i))//'] is not a number of specified type'
endif
enddo
if(present(ierr))then
ierr=ierr_local
elseif(ierr_local /= 0)then ! error occurred and not returning error to main program to print message and stop program
write(ERROR_UNIT,*)'*getval* error reading line ['//trim(line)//']'
stop 2
endif
end subroutine getvals