end c--------------------------------------------------------------------- subroutine freeread(line,rea,nrea) c--------------------------------------------------------------------- c c Reads a line input and breaks it into smaller segments. it will c transfer all the real and integers into the rea array in the same c sequence that they are, and ignore the character strings. in this c fashion it will allow for easier input than a simple(r) free-format c reader. c implicit double precision(a-h,o-z) character*(*) line character*80 form character*20 fmtstr integer pointer,nstring,i,is,ie,ief,irea dimension pointer(160),fmtstr(80) dimension rea(2) c c to clear the FORM string c i=1 do while (i.le.len(form)) form(i:i)=' ' i=i+1 end do c call segment(line,pointer,fmtstr,form,nstring) i=1 irea=1 do while (i.le.nstring) is=pointer(2*i-1) ie=pointer(2*i) call limits(fmtstr(i),isf,ief) if (form(i:i).eq.'f') then read (line(is:ie),fmt=fmtstr(i)) rea(irea) irea=irea+1 endif c if (form(i:i).eq.'i') then read (line(is:ie),fmt=fmtstr(i)) integ rea(irea)=real(integ) irea=irea+1 endif c i=i+1 end do nrea=irea+1 return end c---------------------------------------------------------------------- subroutine segment(line,pointer,fmtstr,form,nstring) c c This subroutine takes an input character string ("LINE"), and c partitions it in its natural segements as separated by blanks. c the string itself is the only necessary input, and its length c is determined when called. it returns the line itself, the c integer array "POINTER" which contains the positions of the c first and last non-blank characters of each segment, a character c string "FORM" which contains a one-letter descriptor of the c data type of each segment (a, i, or f) and "FMTSTR", a charcter c array containing the string-formats for each segment. the only c variables limited in its length are fmstr (10 characters for c each individual format) and "STRING", a temporary storage for c each individual segment (80 char's). c implicit double precision(a-h,o-z) character*(*) line,form character*80 string character*(*) fmtstr character*1 typ logical found,num,firstchar,decpoint,exponent integer iline,istring,nstring,eol,is,ie,ici,pointer dimension pointer(2),fmtstr(2) c call limits(line,iline,eol) nstring=0 100 if (iline.le.eol) then string=' ' istring = 1 found=.false. typ=' ' 200 if (line(iline:iline).ne.' ') then firstchar=.false. num=.false. found=.true. string(istring:istring)=line(iline:iline) if (typ.eq.' ') then pointer(2*nstring+1)=iline exponent=.false. decpoint=.false. firstchar=.true. ici=ichar(line(iline:iline)) if (ici.eq.46) decpoint=.true. num=(ici.le.57).and. + ((ici.ge.48).or.(ici.eq.43).or.(ici.eq.45)) if (num) then typ = 'i' else typ = 'a' endif if ((typ.eq.'a').and.decpoint) typ='f' endif c if ((typ.ne.'a').and.(.not.firstchar)) then ici=ichar(line(iline:iline)) num=(ici.le.57).and.(ici.ge.48) if ((typ.eq.'i').and.(num)) goto 300 if ((typ.eq.'f').and.(num)) goto 300 c if (ici.eq.46) then if (typ.eq.'i') then decpoint=.true. typ='f' goto 300 else if (decpoint) typ='a' endif endif c if ((ici.eq.69).or.(ici.eq.68)) then if (.not.exponent) then typ='f' exponent=.true. icn=ichar(line(iline+1:iline+1)) nxt=(((icn.eq.43).or.(icn.eq.45)) + .or.((icn.ge.48).and.(icn.le.57))) if (nxt) then istring=istring+1 iline=iline+1 string(istring:istring)=line( + iline:iline) goto 300 else typ='a' endif else typ='a' endif endif typ='a' endif c 300 iline=iline+1 istring=istring+1 goto 200 endif if (found) then pointer(2*nstring+2)=iline-1 is=pointer(2*nstring+1) ie=pointer(2*nstring+2) nstring = nstring + 1 form(nstring:nstring)=typ call findformat(line(is:ie),is,ie, + form(nstring:nstring),fmtstr(nstring)) endif iline=iline+1 goto 100 endif return end c------------------------------------------------------------------------- subroutine findformat(word,first,last,type,rtf) c c this subroutine finds the format needed to read a "word". the size c of this string is not numerically limited, but determined when the c subroutine is called. it needs as input "type", a one-character c string describing the type (a, i, or f), the string itself c ("word"), and its limits ("first" and "last"). it will return c the format ("rtf") as a string. c implicit double precision(a-h,o-z) character*1 type character*2 lstr,dstr character*(*) rtf character*(*) word integer first,last,len,dec len=last-first+1 write (lstr,'(i2)') len c if (type.ne.'f') then if (len.ge.10) then rtf='('//type//lstr(1:2)//')' else rtf='('//type//lstr(2:2)//')' endif endif c if (type.eq.'f') then dec=len-index(word,'.') if ((dec.eq.len).and.(index(word,'e').ne.0)) + dec=len-index(word,'e') write (dstr,'(i2)') dec if (len.ge.10) then if (dec.ge.10) then rtf='('//type//lstr(1:2)//'.'//dstr(1:2)//')' else rtf='('//type//lstr(1:2)//'.'//dstr(2:2)//')' endif else if (dec.ge.10) then rtf='('//type//lstr(2:2)//'.'//dstr(1:2)//')' else rtf='('//type//lstr(2:2)//'.'//dstr(2:2)//')' endif endif endif return end c --------------------------------------------------------------------- subroutine limits(str,first,last) c c this subroutine finds the "first" and the "last" non-blank c charcters in the string "str". the length of the string is not c numerically limited, but its length is determined when called. c "i" and "ib" are the forward and backward counters. c implicit double precision(a-h,o-z) character*(*) str integer first,last,i,ib first = 0 last=0 do 1 i=1,len(str) if (first.eq.0) then if (str(i:i).ne.' ') first = i endif c if (last.eq.0) then ib=len(str)-i if (str(ib:ib).ne.' ') last = ib endif 1 continue return end