	subroutine fit_file(calstep, filename)
!	--------------------------------------

	implicit none
	include 'fit.inc'

	real calstep
	character filename*(*)

	real step, s, xx
	character fname*132
	integer l,i,jset,j,iostat

	real xm1, xm2, a1, a2

	real fifun, voigt ! function

	if (iscx .eq. 0) then
	  xm1=xval(nxmin)
	  xm2=xval(nxmax)
          do i=nxmin,nxmax
            if (xval(i) .lt. xm1) xm1=xval(i)
            if (xval(i) .gt. xm2) xm2=xval(i)
	  enddo
	  a2=0.5/(nxmax+2-nxmin)
	  a1=1+a2
	  xbeg=xm1*a1-xm2*a2
	  xend=xm2*a1-xm1*a2
	endif

	step=(xend-xbeg)/200.0

	if (filename .eq. ' ') then

	  write (isyswr,'(/X,A,$)') 'Output file name:'
	  read (isysrd, '(A)', end=999,err=999) fname
	  if (fname .eq. ' ') fname='out'

	  if (nu .gt. 0) then
	    write (isyswr,'(/X,A,F10.3,A,$)')
	1     'X-Step for calculated data (',abs(step),'):'
	    read (isysrd, '(F20.0)', err=999,end=999) s
	    if (s .ne. 0) step=sign(s,step)
	  endif

	else

	  fname=filename
	  if (calstep .ne. 0) then
	    step=sign(calstep,step)
	  endif

	endif

	call save_delimiter(char(9))
	do jset=1,nset
	  if (nu .eq. 0 .and. nset .le. 1) then ! no calculation, single dataset
	    call sys_parse(fname, l, fname, '.obs', 0)
	  else
	    call sys_parse(fname, l, '.obs', fname, 0)
	    if (nset .gt. 1 .and. l .lt. len(fname)) then
	      call cvt_real_str(fname(l+1:), j, float(jset), 0,0,6,3)
	      l=l+j
	    endif
	  endif
	  call sys_open(2, fname, 'w', iostat)
	  if (iostat .ne. 0) then
	    print *,'Cannot open ',fname(1:l)
	    return
	  endif

	  write(isyswr, '(/x,2a)') 'Observed data:   ', fname(1:l)
	
	  do i=nxmin,nxmax
	    if (iset(i) .eq. jset) then
	      call save_fill(xval(i))
	      call save_fill(YVAL(i))
	      call save_fill(sig(i))
	      call save_wrt(2)
	    endif
	  enddo
	  close(2)
	enddo

	if (nu .le. 0) return

	call sys_parse(fname, l, '.cal', fname, 0)

	call sys_open(2, fname, 'w', iostat)
	if (iostat .ne. 0) then
	  print *,'Can not open ',fname(1:l)
	  return
	endif

	write(isyswr, '(x,2a)') 'Calculated data: ', fname(1:l)
	
	xx=xbeg
	do while (xx .le. xend+step*1e-3)
	  call save_fill(xx)
	  actset=1
	  call save_fill(fifun(xx))
	  if (ififu .eq. 1) then
	    call save_fill(u(1)+u(2)*(xx-u(3)))		! Background
	    do i=3,nu,5
	      call save_fill(u(1)+u(2)*(xx-u(3))	! Peaks
	1                +voigt(xx-u(i), u(i+3), u(i+4))*u(i+2))
	    enddo
	  elseif (ififu .eq. 7 .and. nset .gt. 1) then
	    do actset=2,nset
	      call save_fill(fifun(xx))
	    enddo
	  endif
	  call save_wrt(2)
	  xx=xx+step
	enddo
	close(2)
	return
999	print *,'input error'
	end



	subroutine fit_save(filename)
!	-----------------------------

	implicit none
	include 'fit.inc'
	character filename*(*)
	integer lunit

	character fname*132/' '/, line*132, filtyp*8
	character utit*16, parname*16

	integer i,l,j,nx1,nx2,ispec,lun,iostat,nu_user
	real sbuf(32)
	
	integer fit_userini
	external fit_userini
	external fit_wrapper

	call save_delimiter(',')
	if (fname .le. ' ') then
	  fname='last.fit3'
	endif
	if (filename .ne. ' ') then
	  line=filename
	else
	  call sys_parse(fname, l, fname, '.FIT3', 0)
	  write(isyswr, '(/X,3A,$)') 'Filename [',fname(1:l),']: '
	  read(isysrd, '(a)', end=999,err=999) line
	endif

	call sys_parse(line, l, line, fname, 0)

	lun=2
	call sys_parse(line, l, line, ' ', 0)
	call sys_open(lun, line, 'w', iostat)
	if (iostat .ne. 0) then
	  print *,'can not open ',line(1:l)
	  return
	endif
	write(isyswr, '(/1x,2a)') 'Save parameters and data on '
	1 ,line(1:l)

	write(2,'(A)') 'FitSave 3.8'
	call save_fill(float(nu))
	call save_fill(float(ififu))
	call dat_gettyp(filtyp)
	call save_str(filtyp)
	call save_fill(float(nxmin))
	call save_fill(float(nxmax))
	if (iscx .eq. 0) then
	  xbeg=1
	  xend=1
	endif
	if (iscy .eq. 0) then
	  ybeg=1
	  yend=1
	endif
	call save_fill(xbeg)
	call save_fill(xend)
	call save_fill(ybeg)
	call save_fill(yend)
	if (nu .gt. 0) then
	  call save_fill(amin)
	else
          call save_fill(0.0)
	endif
	call save_wrt(lun)
	do i=1,nu
	  if (psho(i) .ne. ' ') then
	    call str_trim(psho(i),psho(i),l)
	    call save_str(psho(i)(1:l)//':'//pnam(i))
	  else
	    call save_str(pnam(i))
	  endif
	  call save_fill(u(i))
	  call save_fill(werr(i))
	  call save_fill(alim(i))
	  call save_fill(blim(i))
	  call save_fill(float(lcode(i)))
	  call save_fill(cfac(i))
	  call save_fill(coff(i))
	  call save_fill(float(icsw(i)))
	  call save_fill(float(icto(i)))
	  call save_fill(werrs(i))
	  call save_wrt(lun)
	enddo
	if (ififu .eq. 7) then
	  write(lun,'(a)') usertit
	endif

	call sym_put_real('Monitor', ymon)
	call sym_list(lun, 0, 3, ' ')
	do i=1,min(nstyl,32)
	  sbuf(i)=styl(i)
	enddo
	call save_array('Style', sbuf, nstyl)
	call save_wrt(lun)
	if (keepregion) then
	  call save_array('RegX1', regx1, nregion)
	  call save_wrt(lun)
	  call save_array('RegX2', regx2, nregion)
	  call save_wrt(lun)
	  call save_array('RegY1', regy1, nregion)
	  call save_wrt(lun)
	  call save_array('RegY2', regy2, nregion)
	  call save_wrt(lun)
	endif
	call str_trim(fillis, fillis, l)
	write(lun,'(3a)') 'Filelist=''',fillis(1:l),''''
	write(lun,*)
	do i=1,npkt
	  call save_fill(xval(i))
	  call save_fill(YVAL(i))
	  call save_fill(sig(i))
	  call save_fill(rmon(i))
	  call save_fill(float(iset(i)))
	  call save_wrt(lun)
	enddo
	close(lun)
	return

999	print *,'input error'
	return

	entry fit_load_nopn(lunit)
!	--------------------------

	lun=lunit
	rewind lun
	inquire(lun, name=line)
	call sys_parse(line, l, line, '.', 0)
	goto 20


	entry fit_load(filename)
!	------------------------

	call sys_parse(line, l, filename, '.FIT3', 0)

	lun=2
	call sys_open(lun, line(1:l), 'r', iostat)
	if (iostat .ne. 0) goto 29

20	write(isyswr, '(/x,2a)') 'Load parameters and data from '
	1 ,line(1:l)

	line=' '
	read(lun, '(A)',err=23,end=23) line
23	if (line(1:8) .ne. 'FitSave ') then
	  write(isyswr,*) 'Unknown file format'
	  close(lun)
	  return
	endif
	call sym_purge(1)
	line(1:1)=' '
	if (line(9:11) .gt. '1.0' .and. line(9:11) .lt. '3.4') then
	  read(lun, '(A)',err=23,end=23) filnam
	endif
	nu=0
	ififu=0
	xbeg=1
	xend=1
	ybeg=1
	yend=1
	filtyp=' '
	if (line(9:11) .lt. '3.2') then
	  read(lun, *, err=23,end=23) nu,ififu,ispec,nx1,nx2
	1,xbeg,xend,ybeg,yend
	  if (ispec .eq. 1) then
	    filtyp='IN3'
	  elseif (ispec .ne. 0) then
	    filtyp='LNS'
	  endif
	else
	  read(lun, *, err=23,end=23) nu,ififu,filtyp,nx1,nx2
	1   ,xbeg,xend,ybeg,yend
	endif
	if (filtyp .ne. ' ') call dat_settyp(filtyp)

	if (line(9:11) .lt. '3.0') then
	  ififu=ififu-1
	  if (ififu .le. 4 .or. ififu .eq. 9) then
	    write(isyswr,*) 'Incompatible version (older than 3.0)'
	    nu=0
	    ififu=8
	    close(lun)
	    return
	  endif
	endif

	do i=1,nu
	  u(i)=0
	  werr(i)=0
	  alim(i)=0
	  blim(i)=0
	  lcode(i)=0
	  cfac(i)=0
	  coff(i)=0.0
	  icsw(i)=0
	  icto(i)=0
	  werrs(i)=0
	  if (line(9:11) .ge. '3.8') then
	    read(lun,*,err=27,end=27) parname, u(i), werr(i)
	1  , alim(i), blim(i), lcode(i), cfac(i), coff(i)
	1  , icsw(i), icto(i), werrs(i)
	  else
	    read(lun,*,err=27,end=27) parname, u(i), werr(i)
	1  , alim(i), blim(i), lcode(i), cfac(i)
	1  , icsw(i), icto(i), werrs(i)
	  endif
	  j=index(parname,':')
	  pnam(i)=parname(j+1:)
	  if (j .gt. 1) then
	    psho(i)=parname(1:j-1)
	  else
	    psho(i)=' '
	  endif
	enddo

	if (ififu .eq. 7 .and. line(9:11) .ge. '3.5') then
	  read(lun,'(a)',err=23,end=23) utit
	  if (line(9:11) .lt. '3.7') read(lun,*,err=23,end=23)
	  if (usernp .lt. nu .or. utit .ne. usertit) goto 25
	  do i=1,nu
	    if (pnam(i) .ne. userpar(i)(1:8)) goto 25
	  enddo
	  goto 26
25	  do i=nu+1,usernp
	    pnam(i)=' '
	  enddo
	  do i=usernp+1,nu
	    userpar(i)=' '
	  enddo
	  write(isyswr,*)
	  write(isyswr,*) 'Present function  data file'
	  write(isyswr,*) '---------------------------'
	  write(isyswr,*) usertit,'  ',utit
	  write(isyswr,*)
	  do i=1,max(nu,usernp)
	    write(isyswr,'(x,a,10x,a)') userpar(i)(1:8),pnam(i)
	    pnam(i)=userpar(i)
	    psho(i)=usersho(i)
	  enddo
	  nu=usernp
	  write(isyswr,'(/x,a/)')
	1   'User function mismatch, check Parameters for validity'
26	  continue
	endif


	if (line(9:11) .lt. '3.3') then
	  close(lun)
	  if (filnam .eq. ' ') then
	    write(isyswr,*) 'No datafile'
	  else
	    load_state=3
	  endif
	else
	  if (line(9:11) .lt. '3.4') then
	    j=0
	    ymon=0
	    read(lun, *, err=27,end=27) j,ymon
	  else
	    call sym_read(lun, fit_wrapper)
	    call fit_get_real('Monitor', ymon)
	    keepregion=(nregion .ne. 0)
	    ymon0=ymon
	  endif

	  i=0
30	  i=i+1
	  if (i .gt. maxdat) then
	    print *,'too many data points --> truncated'
	    npkt=maxdat
	    goto 39
	  endif
31	  read(lun,'(a)',err=27,end=39) line
	  j=index(line,'/')		! for compatibility with versions 3.3 and older
	  if (j .gt. 0) line(j:)=' '	! "
!	  read(line,'(bn,4f20.0,i20)',err=37,end=37)
!	1      xval(i),YVAL(i),sig(i),rmon(i),j
	  read(line,*,err=37,end=37) xval(i),YVAL(i),sig(i),rmon(i),j
	  iset(i)=max(1,j)
	  npkt=i
	  goto 30

37	  print *,'error at point ',i
	  goto 31

39	  if (ymon .eq. 0) ymon=rmon(1)
	  close(lun)

	endif
	wavlen=0
	call sym_get_real('lambda', wavlen)
	temp=0
	call sym_get_real('Temp', temp)
	dtemp=0
	call sym_get_real('dTemp', dtemp)
	call sym_get_str('Title', l, itit)
	if (nx1 .lt. npkt .and. nx2 .le. npkt .and. nx2 .gt. nx1) then
	  nxmin=nx1
	  nxmax=nx2
	else
	  nxmin=1
	  nxmax=npkt
	endif
	nset=0
	do i=nxmin,nxmax
	  nset=max(iset(i),nset)
	enddo
	if (ififu .eq. 7) then
	  nu_user=fit_userini(7)
	endif
	nfcn=0
	call sym_list(isyswr, 1, 1, ' ')
	if (load_state .eq. 3) return
	call fit_set(0,0.0,0.0,0.0,0.0)
	call fit_print(1)
	call fit_scale(xbeg,xend,ybeg,yend)
	return

27	write(isyswr,*) 'Error in ',filename
	close(lun)
	return

29	write(isyswr, *) 'Can not open ',filename
	end



	subroutine save_fill(val)

	implicit none
	real val, values(*)
	integer lun, nsize
	character str*(*), delim*1

	character line*132
	integer i,j,l/0/,ll
	save line,delim,l,ll

	if (delim .eq. char(9)) then
	  ll=7
	else
	  ll=12
	endif
	if (l+ll .ge. len(line)) return
	call cvt_real_str(line(l+1:l+ll), j, val, 0,0,6,3)
	l=l+j
	line(l+1:l+1)=delim
	l=l+1
	return

	entry save_str(str)

	if (l+len(str)+3 .ge. len(line)) return
	line(l+1:l+1)=''''
	l=l+1
	call str_trim(line(l+1:l+len(str)), str, j)
	if (j .eq. 0) j=1
	l=l+j
	line(l+1:l+1)=''''
	l=l+1
	line(l+1:l+1)=delim
	l=l+1
	return

	entry save_array(str, values, nsize)

	if (l+len(str)+1 .ge. len(line)) goto 39
	call str_trim(line(l+1:l+len(str)), str, j)
	if (j .eq. 0) j=1
	l=l+j
	line(l+1:l+1)='='
	l=l+1
	do i=1,min(32,nsize)
	  if (l+9 .ge. len(line)) goto 39
	  call cvt_real_str(line(l+1:l+7), j, values(i), 0,0,6,3)
	  l=l+j
	  line(l+1:l+1)=' '
	  l=l+1
	enddo
	line(l:l)=delim
	return
39	print *,str,' truncated'
	return

	entry save_wrt(lun)
	l=l-1
	write(lun, '(a)') line(1:l)
	l=0
	return

	entry save_delimiter(str)
	delim=str
	end

	subroutine fit_wrapper(str, value, putval)

	include 'fit.inc'

	character str*(*)
	real value
	external putval

	integer ns/0/, nx1/0/, nx2/0/, ny1/0/, ny2/0/

	if (str .eq. ' ') then ! reset
	  ns=0
	  nx1=0
	  nx2=0
	  ny1=0
	  ny2=0
	  return
	endif
	if (str(1:min(len(str),9)) .eq. 'Filelist=') then
	  fillis=str(10:)
	  return
	endif
	if (str .eq. 'Style') then
	  if (ns .lt. maxset) then
	    ns=ns+1
	    styl(ns)=nint(value)
	  endif
	  nstyl=ns
	  return
	endif
	if (len(str) .eq. 5 .and. str(1:min(len(str),3)) .eq. 'Reg') then
	  if (str .eq. 'RegX1') then
            if (nx1 .lt. maxregion) then
	      nx1=nx1+1
	      regx1(nx1)=value
	    endif
	  else if (str .eq. 'RegX2') then
            if (nx2 .lt. maxregion) then
	      nx2=nx2+1
	      regx2(nx2)=value
	    endif
	  else if (str .eq. 'RegY1') then
            if (ny1 .lt. maxregion) then
	      ny1=ny1+1
	      regy1(ny1)=value
	    endif
	  else if (str .eq. 'RegY2') then
            if (ny2 .lt. maxregion) then
	      ny2=ny2+1
	      regy2(ny2)=value
	    endif
	  else
	    goto 9
	  endif
	  nregion=min(nx1,nx2,ny1,ny2)
	  return
	endif
9	call putval(str, value)
	end
