CCL Home Page
Up Directory CCL simplex3.f
      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

Modified: Fri Dec 11 17:00:00 1992 GMT
Page accessed 4420 times since Sat Apr 17 22:01:38 1999 GMT