c c CHARSUBS.FOR c c Character manipulation library c c find_sp(line,pos) finds first blank or tab starting at pos in line c find_nw(line,pos) finds first non-blank or tab as above c trulen(string) find length of string less trailing white space c rjust(string) right justify string in itself c streq(s1,s2) return true if 2 strings same regardless of case c isalpha(char) return true if character os a letter (u/l case) c isdigit(char) return true if character is a digit c verify(str,pos,chars) verify that string contains only chars c locate(str,pos,chars) find first occurrence of any chars in str c integer function trulen(string) parameter TAB=' ',BLANK=' ', NULL = 0 character string*(*) c c returns length of string minus any trailing blanks c l=len(string) do while (l .gt. 0) if((string(l:l) .eq. BLANK.or.string(l:l) .eq. TAB 1 .or. ICHAR(string(l:l)) .eq. NULL)) THEN l=l-1 else trulen = l return endif end do trulen=0 return end c c subroutine rjust(string) parameter BLANK=' ' integer*4 trulen character string*(*) c c Right justifies character variable string. Will fail if called with c character constant or expression. c lt=trulen(string) if(lt.le.0)return le=len(string) string(le-lt+1:)=string(1:lt) if(lt.lt.le)string(1:le-lt)=BLANK return end integer function find_sp(line,pos) parameter BLANK=' ',TAB=' ' integer pos character line*(*) c l=len(line) do 100 n=pos,l if(line(n:n).eq.BLANK.or.line(n:n).eq.TAB)goto 200 100 continue find_sp=0 return 200 find_sp=n return end c c integer function find_nw(line,pos) parameter BLANK=' ',TAB=' ' integer pos character line*(*) c l=len(line) do 100 n=pos,l if(line(n:n).ne.BLANK.and.line(n:n).ne.TAB)goto 200 100 continue find_nw=0 return 200 find_nw=n return end c c logical*4 function streq(s1,s2) implicit integer*4 (a-z) parameter BLANK=' ',TAB=' ' character s1*(*),s2*(*),c1*1,c2*1 c len1=trulen(s1) len2=trulen(s2) streq=.false. if(len1.ne.len2)return do 100 i=1,len1 c1=s1(i:i) c2=s2(i:i) if(c1.eq.c2)goto 100 if(c1.eq.TAB.and.c2.eq.BLANK.or.c1.eq.BLANK.and.c2.eq.TAB) 4 goto 100 diff=abs(ichar(c1)-ichar(c2)) if(diff.ne.32)return 100 continue streq=.true. return end c c logical function isalpha(char) character char*1 c isalpha = (lge(char,'a').and.lle(char,'z')) .or. 4 (lge(char,'A').and.lle(char,'Z')) return end c c logical function isdigit(char) character char*1 c isdigit = lge(char,'0').and.lle(char,'9') return end c c integer*4 function verify(str,pos,chars) integer*4 pos character str*(*),chars*(*),c*1 c l_str = LEN(str) do i = pos,l_str c = str(i:i) iv = INDEX(chars,c) if(iv.eq.0)then verify = i return endif enddo verify = 0 return end c c integer*4 function locate(str,pos,chars) integer*4 pos character str*(*),chars*(*),c*1 c l_str = LEN(str) do i = pos,l_str c = str(i:i) l = INDEX(chars,c) if(l.gt.0)then locate = i return endif enddo locate = 0 return end