153 lines
4.2 KiB
Fortran
153 lines
4.2 KiB
Fortran
program autofit
|
|
c ---------------
|
|
|
|
implicit none
|
|
|
|
real par(200), err(200)
|
|
integer j, i, n, listflag, pos, iostat, ipar
|
|
character*8192 list
|
|
character*8192 line
|
|
integer l, lline
|
|
character*128 vars
|
|
character*128 outfile
|
|
character num*32
|
|
character var*32,upvar*32
|
|
real value
|
|
integer lun, k
|
|
real ymon
|
|
|
|
integer get_par_no
|
|
integer iret, fit_dat_opt
|
|
|
|
call sys_get_cmdpar(line, lline)
|
|
pos = 1
|
|
call str_get_word(line(1:lline), pos, vars)
|
|
call str_get_word(line(1:lline), pos, outfile)
|
|
call str_get_word(line(1:lline), pos, list)
|
|
if (outfile .eq. ' ') then
|
|
print *,' '
|
|
print *,'Usage:'
|
|
print *,' '
|
|
print *,'1) start the ordinary fit program with the first file'
|
|
print *,'2) select fit function, and setup fixed pars and correlations'
|
|
print *,'3) do a first fit'
|
|
print *,'4) use command "exit" to leave and save settings in last.fit3'
|
|
print *,'5) start autofit. Example:'
|
|
print *,' '
|
|
print *,' autofit mf,i1 out.dat 1964-2018'
|
|
print *,' '
|
|
print *,' fit datafiles with numbers 1964...2018'
|
|
print *,' plot using mf as x and fir parameter i1 as y'
|
|
print *,' '
|
|
print *,'6) plot results:'
|
|
print *,' '
|
|
print *,' fit -p out.dat'
|
|
print *,' '
|
|
print *,'7) if in doubt, check fit graphically:'
|
|
print *,' '
|
|
print *,' gv pgplot.ps'
|
|
print *,' '
|
|
print *,'Tips:'
|
|
print *,'- use "temp" for temperature'
|
|
print *,'- use "intexp" for experimental integrated intensity'
|
|
print *,'- more than one fit parameter might be specified,'
|
|
print *,' resulting in more than 3 columns'
|
|
print *,'- in step (2), use commands "win" and "keep y" in fit,'
|
|
print *,' if you want to make the fit only in a window'
|
|
print *,' '
|
|
goto 999
|
|
endif
|
|
|
|
call fit_init
|
|
call sys_setenv('CHOOSER_PAN','9') ! 9 plots per page
|
|
call sys_setenv('CHOOSER_POPT','A') ! all on one file
|
|
|
|
c read parameter file from last fit
|
|
|
|
call fit_load('last.fit3')
|
|
call sym_get_real('Monitor', ymon)
|
|
if (list .eq. ' ') then
|
|
call dat_ask_filelist(list,' ')
|
|
call str_trim(list, list, l)
|
|
call str_append(line, lline, ' ')
|
|
call str_append(line, lline, line(1:l))
|
|
endif
|
|
listflag=0
|
|
call sys_get_lun(lun)
|
|
call sys_open(lun, outfile, 'w', iostat)
|
|
if (iostat .ne. 0) then
|
|
print *,'cannot open ',outfile
|
|
goto 999
|
|
endif
|
|
write(lun,'(2a)') '# created with the following command:'
|
|
write(lun,'(2a)') '# autofit ', line(1:lline)
|
|
c write header
|
|
line = ' '
|
|
lline = 0
|
|
i=1
|
|
do while (.true.)
|
|
call str_get_elem(vars, i, var)
|
|
if (var .eq. ' ') exit
|
|
call str_trim(var, var, l)
|
|
if (lline .ne. 0) call str_append(line, lline, ' ')
|
|
do k=l,9
|
|
call str_append(line, lline, ' ')
|
|
enddo
|
|
call str_append(line, lline, var(1:l))
|
|
call str_upcase(upvar(1:l), var(1:l))
|
|
ipar = get_par_no(upvar(1:l))
|
|
if (ipar .gt. 0 .or. upvar(1:l) .eq. 'INTEXP') then
|
|
call str_append(line, lline, ' err')
|
|
endif
|
|
enddo
|
|
write(lun,'(a)') line(1:lline)
|
|
|
|
c treat no more than 9999 files
|
|
do j=1,9999
|
|
|
|
call fit_dat_next(list,listflag)
|
|
call fit_mon(ymon)
|
|
c exit loop when finished
|
|
if (listflag.eq.0) goto 101
|
|
|
|
call fit_fit(0)
|
|
|
|
c plot it to file
|
|
call fit_plot('y')
|
|
|
|
call fit_get_array('p', par, 100, n)
|
|
call fit_get_array('e', err, 100, n)
|
|
line = ' '
|
|
lline = 0
|
|
i = 1
|
|
do while (.true.)
|
|
call str_get_elem(vars, i, var)
|
|
if (var .eq. ' ') exit
|
|
if (lline .ne. 0) call str_append(line, lline, ' ')
|
|
call str_upcase(upvar, var)
|
|
if (upvar .eq. 'INTEXP') then
|
|
ipar = n
|
|
else
|
|
ipar = get_par_no(upvar)
|
|
endif
|
|
if (ipar .eq. 0) then
|
|
c it is a variable like 'temp' or 'mf'
|
|
call sym_get_real(var, value)
|
|
call cvt_real_str(num, l, value, 10, 0, 7, 1)
|
|
call str_append(line, lline, num(1:l))
|
|
else
|
|
c it is a parameter, we write also the error
|
|
call cvt_real_str(num, l, par(ipar), 10, 0, 7, 1)
|
|
call str_append(line, lline, num(1:l))
|
|
call str_append(line, lline, ' ')
|
|
call cvt_real_str(num, l, err(ipar), 10, 0, 7, 1)
|
|
call str_append(line, lline, num(1:l))
|
|
endif
|
|
enddo
|
|
write(lun,'(a)') line(1:lline)
|
|
enddo
|
|
close(lun)
|
|
101 write(*,*)
|
|
|
|
999 end
|