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