subroutine dat_tasmad
c	---------------------
	external dat_tasmad_desc
	external dat_tasmad_opts
	external dat_tasmad_read
	external dat_get_datanumber

	integer dtype/0/

	call dat_init_desc(dtype, dat_tasmad_desc)
	call dat_init_opts(dtype, dat_tasmad_opts)
	call dat_init_read(dtype, dat_tasmad_read)
	call dat_init_high(dtype, dat_get_datanumber)
	end


	subroutine dat_tasmad_desc(text)
c	--------------------------------
	character*(*) text  ! (out) description

	text='TASMAD  DrueChaL, TASP and ILL TAS'
	end

	subroutine dat_tasmad_opts
c	--------------------------
	print '(x,a)'
	1,'p1,p2:   polarisation'
	1,'x:       column to be used as x-axis *'
	1,'y:       column to be used as y-axis (default: CNTS)'
	1,'mon:     column to be used as Monitor (default: M1 or TIME)'
	end


	subroutine dat_tasmad_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
	integer mcol
	parameter (none=-8.7654e29, mcol=32)

	character line*160, preset*4, old*6, col2*8
	real values(mcol), r, f, s, y, ymon, tm, ts, td
	integer r1,r2
	integer i,j,l,ncol,ccol,pcol,xcol,tcol,pacol
	integer ip,ip1,ip2
	character word*32
	integer muco, mubgr
	real codemu
	real mucode(36)
		
	external dat_tasmad_val

! common
	real tt, tem, mon, tim, qe(4)
	character xaxis*8, yaxis*8, monam*8
	integer mode
	common /dat_tasmad_com/tt, tem, mon, tim, mode, xaxis, qe


	xaxis=' '
	preset=' '
	old=' '
	nread=0
	read(lun,'(a)',err=100,end=100) line
	if (line(1:16) .eq. 'RRRRRRRRRRRRRRRR') then
1	  read(lun,'(a)',err=100,end=100) line
	  if (line(1:16) .ne. 'VVVVVVVVVVVVVVVV') goto 1
	  read(lun,'(a)',err=100,end=100) line
	elseif (line(1:7) .ne. 'INSTR: ') then
	  if (forced .le. 0) goto 100
	endif
	tt=none
	tem=none
	mon=none
	tim=none
	mubgr=-1
	muco=0
	call dat_delimiters(',', '=', '''')
12	if (line(1:6) .eq. 'INSTR:') then
	  call dat_group(1, putval)
	  call putval('Instrument='//line(8:19), 0.0)
	elseif (line(1:6) .eq. 'USER_:') then
	  call dat_group(1, putval)
	  call putval('User='//line(8:80), 0.0)
	elseif (line(1:6) .eq. 'DATE_:') then
	  call dat_group(1, putval)
	  call putval('Date='//line(8:80), 0.0)
	elseif (line(1:6) .eq. 'TITLE:') then
	  call dat_group(1, putval)
	  call putval('Title='//line(8:80), 0.0)
	elseif (line(1:6) .eq. 'STEPS:' .or.
	1       line(1:6) .eq. 'POSQE:' .or.
	1       line(1:6) .eq. 'VARIA:' .or.
	1       line(1:6) .eq. 'ZEROS:' .or.
	1       line(1:6) .eq. 'PARAM:') then
	  call dat_group(2, putval)
	  old=line(1:6)
	  j=7
	  mode=index('SZ',line(1:1)) ! mode=0: normal, 1: steps, 2: zeros (see dat_tasmad_val)
	  call dat_intprt(line(7:), dat_tasmad_val, putval)

	elseif (line(1:6) .eq. 'DATA_:') then
	  goto 20
	elseif (line(1:6) .eq. 'EXPNO:' .or.
	1       line(1:6) .eq. 'LOCAL:' .or.
	1       line(1:6) .eq. 'COMND:') then
	  call dat_group(2, putval)
	  call str_trim(line, line, l)
	  if (l .ge. 8) call putval(line(1:5)//'='//line(8:l), 0.0)
	elseif (line(1:6) .eq. 'POLAN:') then
	  call str_trim(line, line, l)
	  if (l .lt. len(line)) l=l+1
	  if (muco .ge. 0) then
	    j=1
	    call str_get_elem(line(7:l), j, word)
	    if (word .ne. 'muco' .and. word .ne. '#muco') then
	      if (word .eq. '#signal') then
	        call dat_group(1, putval)
	        call putval('mukind=signal',0.0)
	        mubgr=0
	        goto 19
	      endif
	      if (word .eq. '#background') then
	        call dat_group(1, putval)
	        call putval('mukind=background',0.0)
	        mubgr=1
	        goto 19
	      endif
	      muco=-1
	      goto 19
	    endif
	    if (muco .eq. 0) then
	      if (mubgr .eq. -1) then
	        mubgr = 0
	        call dat_group(1, putval)
	        call putval('mukind=single', 0.0)
	      endif
	      do i=1,36
	        mucode(i) = 0
	      enddo
	    endif
	    muco=muco+1
	    if (muco .gt. 36) then
	      if (muco .eq. 37) then
	        print *,'DAT_TASMAD: too many POLAN muco lines'
	      endif
	      goto 19
	    endif
	    call str_get_elem(line(7:l), j, word)
	    if (word(1:1) .eq. '-') then
	      codemu=3.0
	      word=word(2:)
	    else
	      codemu=1.0
	    endif
	    i = index('x y z ', word(1:2))
	    if (i .eq. 0) then
	      print *,'DAT_TASMAD: 1st arg bad ',line(7:l)
	    endif
	    ! increase codemu by 0, 30 or 60 for x, y or z
	    codemu = codemu + (i - 1) * 15
	    call str_get_elem(line(7:l), j, word)
	    if (word(1:1) .eq. '-') then
	      codemu=codemu+1
	      word=word(2:)
	    endif
	    i = index('x y z ', word(1:2))
	    if (i .eq. 0) then
	      print *,'DAT_TASMAD: 2nd arg bad ',line(7:l)
	    endif
	    ! increase codemu by 10, 20 or 30 for x, y or z
	    mucode(muco) = codemu + mubgr * 0.1 + (i + 1) * 5
	    
c the coding for the x-value ip.b is:
c where i is 1..9 for xx, yx, yz, zy, yy, zy, xz, yz, zz
c       p is 1..4 for ++, +-, -+, --
c       b is 0 for signal and 1 for background
	    
	  endif
	elseif (line(1:6) .ne. 'FILE_:' .and. line(1:6) .ne. 'FORMT:'
	1       .and. line(1:6).ne.' ') then
!	  if (line(6:6) .ne. ':') goto 100
	  call str_trim(line, line, l)
	  print *,'DAT_TASMAD: superflous line: ',line(1:l)
	endif
19	continue
	read(lun,'(a)',err=99,end=99) line
	goto 12

20	continue
	call dat_group(1, putval)
	ymon=0
	if (mon .eq. none) then
	  if (tim .eq. none) then
	    print *,'DAT_TASMAD: neither TI nor MN present'
	    goto 100
	  endif
	  ymon=tim
	  preset='TIME'
	  call putval('Preset=TIME', 0.0)
	else
	  ymon=mon
	  preset='M1'
	  call putval('Preset=M1', 0.0)
	endif

!----- options ------
	yaxis=' '
	monam=' '
	call dat_start_options
	r1=0
	call dat_int_option('p1', r1)
	r2=0
	call dat_int_option('p2', r2)
	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)
!----- end options ------

	if (monam .eq. ' ') then
	  monam=preset
	elseif (preset .ne. monam) then
	  ymon=0
	endif

21	read(lun,'(a)',err=99,end=99) line
	if (line .eq. ' ') goto 21
	i=1
	line(len(line):len(line))=' '
	ncol=0
	ccol=0
	pcol=0
	xcol=0
	tcol=0
	pacol=0
	col2=' '
	if (yaxis .eq. ' ') yaxis='CNTS'
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. yaxis) ccol=ncol
	if (line(l:i) .eq. monam) pcol=ncol
	if (line(l:i) .eq. xaxis) xcol=ncol
	if (line(l:i) .eq. 'TEM') tcol=ncol
	if (line(l:i) .eq. 'TT' .and. tcol .eq. 0) tcol=ncol
	if (line(l:i) .eq. 'PAL') pacol=ncol
	goto 31

39	if (ccol .eq. 0) then
	  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

	if (pacol .ne. 0) then
	  if (r1 .gt. 9 .or. r2 .gt. 9) then
	    r1=0
	    print *,'DAT_TASMAD: illegal PAL index'
	  elseif (r1 .le. 0) then
	    r1=0
	  else
	    line(1:3)=char(ichar('0')+r1)
	    if (r2 .eq. r1) r2=0
	    if (r2 .ne. 0) then
	      line(2:3)=','//char(ichar('0')+r2)
	    endif
	    call putval('Range='//line(1:3),0.0)
	    call putval('Pal',0.1*r1+0.01*r2)
	  endif
	endif
	call putval('XAxis='//xaxis, 0.0)
	call putval('YAxis=Intensity', 0.0)
	call dat_group(1, putval)

	tm=0
	ts=0
	l=min(mcol,max(xcol,pcol,ccol,tcol))
	ip=0
	ip1=0
	ip2=0
40	read(lun,*,err=89,end=88) (values(j),j=1,l)
	if (pacol .ne. 0) then
	  if (r1 .eq. 0) then
	    ip=nint(values(pacol))
	  else
	    ip=0
	    if (abs(values(pacol)-r1) .gt. 1e-3 .and.
	1       abs(values(pacol)-r2) .gt. 1e-3) goto 40 ! do not read when PAL value does not match
	  endif
	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
	if (ip .ne. 0) then
	  ip1=ip1+1
	  if (ip .ne. ip1) then
	    if (ip2 .eq. 0) then
	      ip2=ip1-1
	    elseif (ip .ne. 1 .and. ip2 .ne. ip1-1) then
	      print *,'DAT_TASMAD: PAL code not in order'
	      ip2=1
	    endif
	    ip1=1
	  endif
	endif
	if (muco .ne. 0 .and. xcol .eq. pacol) then
	  xx(nread) = mucode(nint(values(pacol)))
	else
	  xx(nread)=values(xcol)
	endif
	yy(nread)=y*f
	ss(nread)=s*f
	ww(nread)=r
	if (tcol .ne. 0) then
	  tt=values(tcol)
	  td=(tt-tm)/nread
	  tm=tm+td                             ! mean temp.
	  ts=ts+(tt-tm)**2+td*td*(nread-1)        ! sum of (temp(i)-mean)**2
c	  print *,'temp',tt,tm,ts
	endif
	goto 40

88	close(lun)
	if (ip2 .ne. 0) then
	  call fit_dat_table(1, ip2, (nread+ip2-1)/ip2)
	endif
	call putval('Monitor', ymon)
	if (tcol .ne. 0) then
	  call putval('Temp', tm)
	  if (nread .gt. 1) call putval('dTemp', sqrt(ts/(nread-1)))
	  tm = tt
	elseif (tem .eq. none .and. tt .ne. none) then
	  call putval('Temp', tt)
	endif
	if (muco .ne. 0) then
	  call dat_group(3, putval)
	  if (mubgr .eq. 1) then
	    call putval('QH_B', qe(1))
	    call putval('QK_B', qe(2))
	    call putval('QL_B', qe(3))
	    call putval('EN_B', qe(4))
	    call putval('TEMP_B', tm)
	  else
	    call putval('QH_S', qe(1))
	    call putval('QK_S', qe(2))
	    call putval('QL_S', qe(3))
	    call putval('EN_S', qe(4))
	    call putval('TEMP_S', tm)
	  endif
	endif
	return

89	print *,'DAT_TASMAD: error at point ',nread
	goto 40
29	print *,'DAT_TASMAD: too many points'
	goto 100
99	print *,'DAT_TASMAD: error during read'
	rewind lun
	nread=-2
	return

100	rewind lun
	nread=-1
	end


	subroutine dat_tasmad_val(str, val, putval)

	character*(*) str
	real val
	external putval

	integer i

	real tt, tem, mon, tim, qe(4)
	character xaxis*8, zstr*8
	integer mode
	common /dat_tasmad_com/tt, tem, mon, tim, mode, xaxis, qe

	if (val .eq. 0) then
	  i=index(str, '=')
	else
	  i=0
	endif
	if (i .eq. 0) then ! numeric
	  if (mode .eq. 1) then  ! steps
	    if (val .ne. 0 .and. xaxis .eq. ' ') then ! get first step not zero
	      xaxis=str(2:)
	    endif
	  elseif (mode .eq. 2) then ! zeros
	    zstr(1:1)='Z'
	    zstr(2:)=str
	    call putval(zstr, val)
	    return
	  elseif (str .eq. 'TT') then
	    tt=val
	  elseif (str .eq. 'Temp') then
	    tem=val
	  elseif (str .eq. 'MN' .or. str .eq. 'mn') then
	    mon=val
	  elseif (str .eq. 'TI' .or. str .eq. 'ti') then
	    tim=val
	  elseif (str .eq. 'QH') then
	    qe(1)=val
	  elseif (str .eq. 'QK') then
	    qe(2)=val
	  elseif (str .eq. 'QL') then
	    qe(3)=val
	  elseif (str .eq. 'EN') then
	    qe(4)=val
	  endif
	endif
	call putval(str, val)
	end