subroutine dat_oldtas
c	---------------------

	external dat_oldtas_desc
	external dat_oldtas_opts
	external dat_oldtas_read

	integer dtype/0/

	call dat_init_desc(dtype, dat_oldtas_desc)
	call dat_init_opts(dtype, dat_oldtas_opts)
	call dat_init_read(dtype, dat_oldtas_read)
	end


	subroutine dat_oldtas_desc(text)
!	--------------------------------
	character*(*) text  ! (out) description

!             type    description
!             ----------------------------------
	text='OLDTAS  old ILL TAS format (IN3)'
	end


	subroutine dat_oldtas_opts
!	--------------------------
	print '(x,a)'
	1,'x,y,mon: xaxis,yaxis,monitor to be choosen'
	end


	subroutine dat_oldtas_read
	1 (lun, forced, nread, putval, nmax, xx, yy, ss, ww)
!	----------------------------------------------------
	implicit none

	integer lun	! (in) logical unit number (file will be closed if successful)
	integer forced	! 0: read only if type is sure; 1: forced read
	integer nread	! (out) >=0: = number of points read, file closed
	                !       -1: not correct type, file rewinded
	                !       -2: correct type, but unreadable, file rewinded
	external putval ! (in) subroutine to put name/value pairs.
	                ! for numeric data:     call putval('name', value)   ! value must be real
			! for character data:   call putval('name=text', 0.0)
	integer nmax    ! max. number of points
	real xx(*)	! x-values
	real yy(*)	! y-values
	real ss(*)	! sigma
	real ww(*)	! weights  (original monitor)

! local
	real none
	parameter (none=-8.7654e29)

	character line*132, preset*4, xaxis*8, yaxis*8, monam*8, col2*8
	character pnt*8
	real values(15), r, f, s, y, ymon, qhkle(4)
	integer i,j,l,mondiv,ncol,ccol,pcol,xcol

	external dat_oldtas_val

! common
	real dqhkle(4)
	common/dat_oldtas_com/dqhkle

	nread=0
	read(lun,'(a)',err=100,end=100) line

	if (forced .le. 0) then
	  if (line(1:2).ne.'IN' .or. line(39:44).ne.'A00120') goto 100
	else
	  if (line(1:2).ne.'IN' .and. line(39:44).ne.'A00120') goto 100
	endif

	xaxis=' '
	yaxis=' '
	monam=' '

	call dat_start_options
	call dat_str_option('x', xaxis)
	call dat_str_option('y', yaxis)
	call dat_str_option('mon', monam)

	call str_upcase(xaxis, xaxis)
	call str_upcase(yaxis, yaxis)
	call str_upcase(monam,monam)

	call dat_group(1, putval)
	call putval('Instrument='//line(1:4),0.0)
	call putval('User='//line(11:20), 0.0)
	call putval('Date='//line(21:38), 0.0)

	if (line(1:4) .eq. 'IN3 ' .and.
	1  (line(24:31) .eq. 'FEB-1995' .or.
	1   line(24:31) .eq. 'MAR-1995'      ) ) then
	  mondiv=100
	else
	  mondiv=1
	endif
	call dat_delimiters(';', '=', '''')
	read(lun,'(a)',err=99,end=99) line
	if (line(32:35) .eq. 'HKLE') then
	  call putval('Title='//line(20:31), 0.0)
	  do i=1,4
	    qhkle(i)=none
	    dqhkle(i)=none
	  enddo
	  read(line(36:),*,err=11,end=11) qhkle, dqhkle
11	  continue
	  if (qhkle(4) .ne. none) call putval('EN',qhkle(4))
	  if (qhkle(3) .ne. none) then
	    call putval('QH', qhkle(1))
	    call putval('QK', qhkle(2))
	    call putval('QL', qhkle(3))
	  endif
	  if (dqhkle(4) .ne. none) call putval('DEN',dqhkle(4))
	  if (dqhkle(3) .ne. none) then
	    call putval('DQH', dqhkle(1))
	    call putval('DQK', dqhkle(2))
	    call putval('DQL', dqhkle(3))
	  endif

	  read(lun,*,err=99,end=99)
	  call dat_group(2, putval)
	  do i=1,4
	    read(lun, '(a)') line
	    call dat_intprt(line, dat_oldtas_val, putval)
	  enddo
	else
	  call putval('Title='//line(20:99), 0.0)
	  read(lun,*,err=99,end=99)
	  call dat_group(2, putval)
	  do i=1,5
	    read(lun, '(a)') line
	    call dat_intprt(line, dat_oldtas_val, putval)
	  enddo
	endif
	if (xaxis .eq. ' ') then
	  if (dqhkle(1) .ne. 0) then
	    xaxis='QH'
	  elseif (dqhkle(2) .ne. 0) then
	    xaxis='QK'
	  elseif (dqhkle(3) .ne. 0) then
	    xaxis='QL'
	  elseif (dqhkle(4) .ne. 0) then
	    xaxis='EN'
	  endif
	endif
	
1	read(lun,'(a)',err=99,end=99) line
	if (line(1:4) .eq. '!POS') then
	  read(line(5:),'(15F7.3)') values
ccc	  call sym_put_array('Angles', values, 12,0)
	  goto 1
	elseif (line(1:4) .eq. '!Z**') then
	  read(line(5:),'(15F7.3)') values
ccc	  call sym_put_array('Zeroes', values, 12,0)
	  goto 1
	else
	  if (line .ne. ' ') then
	    call str_trim(line, line, l)
	    print *,'DAT_OLDTAS: superflous text: ', line(1:l)
	    goto 1
	  endif
	endif
2	continue
	call dat_group(1, putval)
	read(lun,'(a,F12.0)',err=99,end=99) preset, ymon
	preset=preset(2:3)
	if (preset .eq. 'MN') then
	  preset='M1'
	  ymon=ymon*mondiv
	elseif (preset .eq. 'TI') then
	  preset='TIME'
	endif
	if (monam .eq. ' ') then
	  monam=preset
	elseif (preset .ne. monam) then
	  ymon=0
	endif

	call putval('Preset='//preset, 0.0)

3	read(lun,'(a)',err=99,end=99) line
	if (line .eq. ' ') goto 3
	i=1
	line(len(line):len(line))=' '
	ncol=0
	ccol=0
	pcol=0
	xcol=0
	col2=' '
31	do while (line(i:i) .eq. ' ')
	  i=i+1
	  if (i .gt. len(line)) goto 39
	enddo
	l=i
	do while (line(i:i) .ne. ' ')
	  i=i+1
	enddo
	ncol=ncol+1
	if (ncol .eq. 2) col2=line(l:i)	
	if (line(l:i) .eq. 'EN(MEV)') line(l:i)='EN'
	if (line(l:i) .eq. yaxis .or. yaxis .eq. ' ' .and.
	1   (line(l:i) .eq. 'CNTS' .or. line(l:i) .eq. 'D1')) ccol=ncol
	if (line(l:i) .eq. monam) pcol=ncol
	if (line(l:i) .eq. xaxis) xcol=ncol
	goto 31

39	if (ccol .eq. 0) then
	  if (yaxis .eq. ' ') yaxis='CNTS/D1'
	  print *,'no values found for ',yaxis
	  goto 99
	endif
	if (pcol .eq. 0) then
	  if (monam .eq. ' ') monam='Monitor'
	  print *,'no values found for ',monam
	  goto 99
	endif
	if (xcol .eq. 0) then
	  if (xaxis .ne. ' ') then
	    print *,'no values found for ',xaxis,', take ',col2
	  endif
	  xcol=2
	  xaxis=col2
	endif

	call putval('XAxis='//xaxis, 0.0)
	call putval('YAxis=Intensity', 0.0)
	call dat_group(1, putval)

	l=max(xcol,pcol,ccol)
	f=1.0
	values(1)=0

4	read(lun,'(a8,15f8.0)',err=19,end=9) pnt, (values(j),j=2,l)
	i=0
	read(pnt, *, err=5, end=5) i ! special treatment for FLEX, where there may be stars in the first column
5	if (i .eq. 0) then
	  values(1)=values(1)+1	! illegal value: add 1
	else
	  values(1)=i
	endif
	if (nread .ge. nmax) goto 29
	y=values(ccol)
	r=values(pcol)
	if (ymon .eq. 0) then
	  ymon=r
	  if (r .eq. 0) r=1.
	endif
	if (r .le. 0.0) r=ymon
	f=ymon/r
	if (f .le. 0.0) f=1.0
	if (y .gt. 0) then
	  s=sqrt(y)				! statistical error of detector
	else
	  s=1
	endif
	nread=nread+1
	xx(nread)=values(xcol)
	yy(nread)=y*f
	ss(nread)=s*f
	ww(nread)=r
	goto 4

9	close(lun)
	call putval('Monitor', ymon)
	return

19	print *,'DAT_OLDTAS: error at point ',nread
	goto 4
29	print *,'DAT_OLDTAS: too many points'
	goto 100
99	print *,'DAT_OLDTAS: error during read'
	rewind lun
	nread=-2
	return
100	nread=-1
	rewind lun
	end


	subroutine dat_oldtas_val(str, val, putval)

	character*(*) str
	real val
	external putval

	real dqhkle(4)
	common/dat_oldtas_com/dqhkle
	integer i, nq/0/, ndq/0/

c the names with include number sign (#) are for compatibility
c with an intermediate version of IN3 data files,
c where QHKL and DQHKL were stored as an array

	if (str .eq. ' ') then ! reset
	  ndq=0
	  nq=0
	  return
	endif
	if (val .eq. 0) then
	  i=index(str, '=')
	else
	  i=0
	endif
	if (i .eq. 0) then ! numeric
	  if (str .eq. 'DQHKL') then
	    ndq=ndq+1
	    if (ndq .le. 4) dqhkle(ndq)=val
	    if (ndq .eq. 1) then
	      call putval('DQH', val)
	    else if (ndq .eq. 2) then
	      call putval('DQK', val)
	    else if (ndq .eq. 3) then
	      call putval('DQL', val)
	    else if (ndq .eq. 4) then
	      call putval('DEN', val)
	    endif
	    return
	  endif
	  if (str .eq. 'QHKL') then
	    nq=nq+1
	    if (nq .eq. 1) then
	      call putval('QH', val)
	    else if (nq .eq. 2) then
	      call putval('QK', val)
	    else if (nq .eq. 3) then
	      call putval('QL', val)
	    else if (nq .eq. 4) then
	      call putval('EN', val)
	    endif
	    return
	  endif
	  if (str .eq. 'DQH') then
	    dqhkle(1)=val
	  elseif (str .eq. 'DQK') then
	    dqhkle(2)=val
	  elseif (str .eq. 'DQL') then
	    dqhkle(3)=val
	  elseif (str .eq. 'DEN') then
	    dqhkle(4)=val
	  endif
	endif
	call putval(str, val)
	end