Files
piscal/dataassim/math/othersupmath/charlineparser.f
T
2022-09-12 16:40:28 +00:00

109 lines
3.5 KiB
FortranFixed

subroutine charlineparser(longchar,nmax,charvars,n)
implicit none
!7 Sept 2013, revised version
!parse a long line of chars into char variables with the following assumptions:
!1. Each cell is separated by a separating character which can be either a ',', blank space(s) or anything
!with the ASCII code less than and including 032 or larger than and including 127
!2. Any separating characters at the end of the line are discarded, i.e.
! '1,2,3,4,a,b,c,,,,,,,,,, ,'='1,2,3,4,a,b,c'
!3. If there is no entry between two non-comma separating characters,these two separating characters are treated as one.
! i.e. '1 2 3 4 a b c'='1,2,3,4,a,b,c'
!4. If there is no entry between two commas that are not positioned in the end of the line, a missing value is assumed to
!exist between these two commas and this missing value is denoted with -9999, i.e.
! i.e. '1,,3,4,a,b,c'='1,-9999,3,4,a,b,c'
!5. Comma has priotity as a separating characer. E.g commas and blank spaces are not used simultaneously as
! separating characters in a single line. When both commas and blank spaces appear in the line, comma is
! the saparating character and blank spaces are repalced with '_'
integer nmax,n
character(*)::longchar
character charvars(nmax+100)*50
integer i,k,pos1,pos2,leng,posindex(0:nmax+100),itiscomma
!
leng=LEN_TRIM(longchar)
i=leng
5 k=ichar(longchar(i:i))
if(k.eq.44.or.k.le.32.or.k.ge.127)then
longchar(i:i)=char(32)
i=i-1
if(i.gt.1)goto 5
!empty line
n=0
return
endif
leng=i
itiscomma=0
do i=1,leng
if(ichar(longchar(i:i)).eq.44)itiscomma=itiscomma+1
enddo
if(itiscomma.ge.nmax)then
n=0
return
endif
if(itiscomma.gt.0)then
!If the line contains at least one comma, it is assumed a comma separated line
n=0
do i=1,leng
if(ichar(longchar(i:i)).eq.44)then
n=n+1
posindex(n)=i
endif
enddo
n=n+1
posindex(0)=0
posindex(n)=leng+1
do i=1,n
pos1=posindex(i-1)+1
pos2=posindex(i)-1
If(pos1.gt.pos2)goto 50
30 if(ichar(longchar(pos1:pos1)).ge.33.and.
&ichar(longchar(pos1:pos1)).le.126)goto 40
if(pos1.lt.pos2)then
pos1=pos1+1
goto 30
endif
!pos1=pos2 and missing entry
pos1=pos2+1
goto 50
40 if(ichar(longchar(pos2:pos2)).ge.33.and.
&ichar(longchar(pos2:pos2)).le.126)goto 50
if(pos2.gt.pos1)then
pos2=pos2-1
goto 40
endif
pos1=pos2+1
50 If(pos1.gt.pos2)then
charvars(i)='-9999'
else
do k=pos1+1,pos2-1
if(ichar(longchar(k:k)).le.32.or.
&ichar(longchar(k:k)).ge.127)longchar(k:k)='_'
enddo
charvars(i)=longchar(pos1:pos2)
endif
enddo
return
endif
!non-comma separated file
n=0
pos1=0
10 pos1=pos1+1
if(pos1.gt.leng)return
if(ichar(longchar(pos1:pos1)).le.32.or.
&ichar(longchar(pos1:pos1)).ge.127)goto 10
!pos1 is the first character in the character variable.
!now locate the end character
pos2=pos1
20 pos2=pos2+1
if(ichar(longchar(pos2:pos2)).ge.33.and.
&ichar(longchar(pos2:pos2)).le.126)then
if(pos2.le.leng)goto 20
endif
pos2=pos2-1
n=n+1
charvars(n)=longchar(pos1:pos2)
pos1=pos2
goto 10
return
end subroutine charlineparser