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