program fit
c 
c          This program is a general purpose fitting utility.  It will prompt
c     the user for a valid FORTRAN equation, number of points, and input and
c     output files.  It will then use these data to write a program to fit
c     the data in the input file to the given equation using a SIMPLEX
c     algorithm. It will compile it, link it and run it.
c
c          The main advantages of this approach are :
c
c          - the user is not required to write, compile, link and run any
c            programs.
c          - the equations can be non-linear in either the parameters or
c            independent variables.
c          - no numerical or analytical differentiation is required
c
      character*999 inline,outline,tmpline
      character*132 infile,outfile
      character*80  eqn,answer
      character*24  today
      character*20  who
      character*4   revon,revoff
      character*1   ch1,bell
      integer       start,end
      logical       done,errora,errorx,fileOK
c
      parameter(maxlines=99)
c
      dimension eqn(maxlines)
c
      done      = .false.
      numlines  = 0
      revon     = char(27)//'[7m'
      revoff    = char(27)//'[0m'
      bell      = char(7)
      call fdate(today)
      call getlog(who)
      numargs = iargc()
c
c     header :
c
      write(*,1001) revon//'General Purpose Fitting Facility'//revoff,bell
      if (numargs .ge. 1) then
         call getarg (1,answer)
         if (answer(1:2).eq.'-h' .or. answer(1:2).eq.'-H') 
     &      call system('more /usr/local/src/splx/fitinstr.txt')
      endif
   10 write(*,1003)
      read(*,1004) inline
      call lowcase(inline)
      call limits(inline,start,end)
      if (end.eq.start)stop
      call check_sequence(inline,'a(',')',numpar,errora)
      call check_sequence(inline,'x(',')',numx,errorx)
      if (errora .or. errorx .or. (numpar.eq.0) .or. (numx.eq.0)) then
         write(*,*) ' error in equation'
         goto 10
      else
c
c        partition the line into the needed sub-lines
c
         outline='      '//inline(start:end)
   20    numlines=numlines+1
         call limits(outline,start,end)
         if (end.le.72) then
            eqn(numlines)=outline(1:72)
         else
            do 40 i=72,1,-1
               ch1=outline(i:i)
               if (ch1.eq.'(' .or. ch1.eq.')' .or. ch1.eq.'+'
     &                 .or. ch1.eq.'-' .or. ch1.eq.'*' .or.
     &                 ch1.eq.'/' .or. ch1.eq.' ') then
                   eqn(numlines)=outline(1:i)
                   tmpline='     &      '
                   do 30 j=1,(end-i+1)
                      tmpline(12+j:12+j)=outline(i+j:i+j)
   30              continue
                   outline=tmpline
                   goto 20
               endif
   40       continue
         endif
      endif
c
c     The equation seems to be OK, get the maximum number of points :
c
      write(*,1005)
      read(*,*) numpoints
c
c     now get the name of input and output files :
c
   50 write(*,1006)
      read(*,1007) infile
      call limits(infile,iib,iie)
      inquire(file=infile(iib:iie),exist=fileOK)
      if (.not.fileOK) then
           write(*,1008)
           goto 50
      endif
   60 write(*,1009)
      read(*,1007) outfile
      call limits(outfile,iob,ioe)
      inquire(file=outfile(iob:ioe),exist=fileOK)
      if (fileOK) then
           write(*,1010)
           goto 60
      endif
      open(4,file=outfile(iob:ioe),status='new')
      write(4,*) ' '
      write(4,*) ' '
      open(3,file='simplexfit.f',status='new')
      call limits(who,start,end)
      write(3,'(a)') '      program simplex_fit'
      write(3,'(a)') 'c'
      write(3,'(2a)') 'c     Generated by the FIT utility by '//who(
     &            start:end)//' at ',today
      write(3,'(a)') 'c'
      write(3,'(2a)') 'c     it will fit a set of data points to the ',
     &                              'equation :'
      write(4,*) '      fit of a set of data points to the ',
     &                              'equation :'
      write(3,'(a)') 'c'
      write(4,*) ' '
      do 70 i=1,numlines
         write(3,'(a)') 'c          '//eqn(i)(7:72)
         write(4,*) '           '//eqn(i)(7:72)
   70 continue
      write(3,'(a)') 'c'
      write(3,'(a,i,a)') '      parameter (maxpar    = ',numpar,')'
      write(3,'(a,i,a)') '      parameter (maxvar    = ',numx,')'
      write(3,'(a,i,a)') '      parameter (maxpoints = ',numpoints,')'
      write(3,'(a)') 'c'
      write(3,'(a)') "      include '/usr/local/src/splx/simplex1.f'"
      write(3,'(a)') 'c'
      write(3,'(a)') "      include '/usr/local/src/splx/simplex2.f'"
      write(3,'(a)') 'c'
      do 80 i=1,numlines
         write(3,'(a)') eqn(i)(1:72)
   80 continue
      write(3,'(a)') 'c'
      write(3,'(a)') "      include '/usr/local/src/splx/simplex3.f'"
      close(3)
      write(4,*) ' '
      write(4,*) '      Procedure executed by '//who(start:end)//' at ',
     &           today
      write(4,*) ' '
      write(4,*) '      input data comes from file: '//infile(iib:iie)
      write(4,*) ' '
      close(4)
      call system('f77 simplexfit.f -O -NC20099'//
     &            ' -o simplexfit 1> /usr/tmp/fitlog 2>&1')
c     &  'f77 simplexfit.f -NC200 -o simplexfit')
      inquire(file='simplexfit',exist=fileOK)
      if (.not.fileOK) then
           write(*,1011)
           call system('rm -f simplexfit.f '//outfile(iob:ioe))
           goto 10
      endif
      call system('rm /usr/tmp/fitlog')
      call system('simplexfit < '//infile(iib:iie)//' >> '//
     &                  outfile(iob:ioe))
      call system('more '//outfile(iob:ioe))
      call system('rm -f simplexfit simplexfit.f')
      stop
 1001 format(///,20x,a40,///,2x,a1)
 1002 format(a80)
 1003 format(/,2x,'Enter the equation : ',$)
 1004 format(a999)
 1005 format(2x,'Enter the maximum number of points: ',$)
 1006 format(2x,'Enter the name of the input file  : ',$)
 1007 format(a132)
 1008 format(/,2x,'file does not exist, wrong name?')
 1009 format(2x,'Enter the name of the output file : ',$)
 1010 format(/,2x,'file already exists, use other name?')
 1011 format(//,6x,'executable program could not be generated',/,
     &          6x,'check your equation and input again',/)
      end
c-----------------------------------------------------------------------
      subroutine check_sequence(line,left,right,number,error)
c-----------------------------------------------------------------------
c
c          Checks the "equation" for correctness of sequence of
c     parameters or variables as enclosed by the given substrings.
c     Its main purpose is to check the expressions used in the FIT
c     utility.  Typically, an input equation can be something like
c
c               ycalc = a(1) + a(2)*x(1) + a(3)*x(2)**2 ...
c
c     where both the "parameters" (a's) or "variables" (x's) have
c     to be in sequence.  The running indeces can be in perfect
c     increasing sequence or reference can be made to previously
c     defined values, i. e.
c
c               ycalc = a(1) + a(2)*x(1) + a(1)*a(3)*(x(2)/x(3)) ...
c
c     input  :
c
c              line   : character string containing the "equation"
c              left   : substring that marks the beginning of an
c                       index
c              right  : substring that marks the ending of an
c                       index
c              the preceeding strings are variable-dimensioned to
c              allow greater flexibility
c     output :
c
c              number : index of the highest variable or parameter in
c                       the sequence found
c              error  : logical variable, returned .TRUE. if an incorrect
c                       sequence was encountered.
c
      character*(*) line,left,right
      character*12  rtf,tmpstr
      integer       start,end,par_open,par_close,curr_par
      logical       error,finished
c
      error      = .false.
      next_par   = 1
      next_start = 1
      finished   = .false.
c
      call limits(line,start,end)
      do while (.not.finished .and. next_start.lt.end)
         par_open=index(line(next_start:end),left)+next_start-1
         if (par_open.gt.(next_start-1)) then
            par_close=index(line(par_open:end),right)+par_open-1
            if (par_close.gt.(par_open-1)) then
               tmpstr=line(par_open+2:par_close-1)
               lentmp=par_close-(par_open+2)
               call findformat(tmpstr,1,lentmp,'I',rtf)
               read(tmpstr,fmt=rtf,err=999) curr_par
               if (curr_par.eq.next_par) then
                  next_par=next_par+1
               else if (curr_par.gt.next_par .or. curr_par.lt.1) then
                  goto 999
               endif
               next_start=par_close
            else
               goto 999
            endif
         else
           finished=.true.
         endif
      enddo
      number=next_par-1
      return
  999 error=.true.
      return
      end