subroutine dat_table
c	--------------------

	external dat_table_desc
	external dat_table_opts
	external dat_table_read

	integer dtype/0/

	call dat_init_desc(dtype, dat_table_desc)
	call dat_init_opts(dtype, dat_table_opts)
	call dat_init_read(dtype, dat_table_read)
	end



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

	text='TABLE   table format (XY, XYS, XYSM ... see options)'
	end

	subroutine dat_table_opts
c	--------------------------
	print '(x,a)'
	1,'x: column to be used as x-axis'
	1,'y: column to be used as y-axis'
	1,'s: column to be used as sigma'
	1,'m: column to be used as monitor'
	1,'    any column may be specified as'
	1,'    - an integer (column number starting from 1)'
	1,'    - as a name (if a header is present)'
	1,'    - as a float (containing a decimal point)'
	1,'        for x, this is a step between equidistant x-values'
	1,'        else it is a constant value'
	1,'    - an asterisk (*) for a special meaning'
	1,'        for x, this is (1,2,3,....)'
	1,'        for y, this is 0.0'
	1,'        for s, this is sqrt(y)'
	1,'        for m, this is 1.0'
	1,'    the defaults are'
	1,'      x=*,y=1,s=*,m=*  for 1 column'
	1,'      x=1,y=2,s=*,m=*  for 2 columns'
	1,'      x=1,y=2,s=3,m=*  for 3 columns or more'
!	1,' '
!	1,'n: n=0   y and s are already normalized (default)'
!	1,'   n=1   y and s are not yet normalized by monitor'
	end


	subroutine dat_table_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
	integer mcol, rows
	parameter (mcol=64, rows=30)

	character header*1024, elem*64
	character line*1024
	character labx*80, laby*80, labs*80, labw*80
	real values(mcol), ymon
	integer i, j, pos
!	integer normalize
	integer nrows, njunk, n, ncol, lin, lin0, lin1, iostat
	integer ncolmax
	integer ncolx, ncoly, ncols, ncolw
	integer colx(mcol), coly(mcol), cols(mcol), colw(mcol)
	real valx, valy, vals, valw, x, y, s, w
	integer errcnt, errlin, errcol, s0cnt
	integer nset, lastcol

! a table block should appear before (rows=30) junk lines
! junk lines are lines that does contain something else than numbers,
! comment lines and empty lines not counted.
! if a the file does not contain more junk lines than the last table block,
! it is considered as a table file. The last table block is used, or the
! first block with at least (rows=30) lines.
! the column header line is the last line before the used table block
! this may also be a comment line

! check the above conditions
	nread=0
	lin=0
	lin0=0
	lin1=0
	ncol=0
	ncolmax=0
	nrows=0
	njunk=0
	ymon=0

1	read(lun,'(a)',err=98,end=19) line
	lin=lin+1
	if (line(1:1) .eq. '#') then
	  if (forced .lt. 0) goto 100
	  lin1=lin
	  goto 1
	endif
	if (line .eq. ' ') goto 1
	j=nread+1
	pos=1
	iostat=0
	n=0
	i=0
	do while (iostat .eq. 0)
	  call str_get_elem(line, pos, elem)
	  if (elem .eq. ' ') then
	    n=i
	    iostat=1
	  else if (line(1:1) .gt. '9') then
	    iostat=1
	  else
	    read(elem, *, iostat=iostat) valx
	    i=i+1
	  endif
	enddo
	if (n .eq. 0) then ! a junk line
	  if (forced .lt. 0) goto 100
	  if (nrows .gt. 3 .and. forced .le. 0) goto 100
	  njunk=njunk+nrows+1
	  if (njunk .gt. rows .and. forced .le. 0) goto 100
	  nrows=0
	  lin0=lin
	  lin1=0
	else
	  if (lin1 .ne. 0) then
	    lin0=lin1
	    lin1=0
	  endif
	  nrows=nrows+1
	  if (n .ne. ncol) then
	    if (ncol .ne. 0 .and. nrows .gt. 3 .and. forced .le. 0)
	1      goto 100
	    ncol=n
	  endif
	  if (nrows .gt. 3 .and. n .gt. ncolmax) ncolmax=n
	  if (nrows .gt. rows) goto 20
	endif
	goto 1

19	if (nrows .lt. njunk .and. forced .le. 0) goto 100

20	continue
	rewind lun

	if (ncolmax .eq. 0) then
	  ncolmax = n
	endif
	if (ncolmax .gt. mcol) then
	  print *,'DAT_TABLE: use only the first',mcol,' columns'
	  ncolmax=mcol
	endif
	do i=1,lin0
	  read(lun,'(a)',err=98,end=98) line
	enddo
	lin=lin0
	if (line(1:1) .eq. '#') then
	  line(1:1)=' '
	endif
	header=line

	call dat_start_options

	call dat_table_col_options(header
	1 , 'x', colx, mcol, ncolx, valx, labx)
	call dat_table_col_options(header
	1 , 'y', coly, mcol, ncoly, valy, laby)
	call dat_table_col_options(header
	1 , 's', cols, mcol, ncols, vals, labs)
	call dat_table_col_options(header
	1 , 'm', colw, mcol, ncolw, valw, labw)
	if (ncolx .lt. 0 .or. ncoly .lt. 0 .or.
	1   ncols .lt. 0 .or. ncolw .lt. 0) goto 99

!	normalize=0
!	call dat_int_option('n', normalize)

	if (ncolx .eq. 0) then
	  ncolx=1
	  if (ncolmax .eq. 1) then
	    colx(1)=-1
	    labx='linear'
	  else
	    colx(1)=1
	    labx='col1'
	  endif
	endif
	if (ncoly .eq. 0) then
	  ncoly=1
	  if (ncolmax .lt. 2) then
	    coly(1)=1
	    laby='col1'
	  else
	    coly(1)=2
	    laby='col2'
	  endif
	endif
	if (ncols .eq. 0) then
	  ncols=1
	  if (ncolmax .lt. 3) then
	    cols(1)=-1
	    labs='sqrt'
	  else
	    cols(1)=3
	    labs='col3'
	  endif
	endif
	if (ncolw .eq. 0) then
	  ncolw=1
	  colw(1)=-1 ! monitor 1.0
	  labw=' '
	endif

	lastcol=0
	do i=1,ncolx
	  lastcol=max(lastcol,colx(i))
	enddo
	do i=1,ncoly
	  lastcol=max(lastcol,coly(i))
	enddo
	do i=1,ncols
	  lastcol=max(lastcol,cols(i))
	enddo
	do i=1,ncolw
	  lastcol=max(lastcol,colw(i))
	enddo

	if (lastcol .gt. ncolmax) then
	  print *,'DAT_TABLE: column ',lastcol,' does not exist'
	  goto 99
	endif
	if (lastcol .eq. 0) then
	  print *,'DAT_TABLE: ignoring all columns'
	endif
	
	call putval('XAxis='//labx, 0.0)
	call putval('YAxis='//laby, 0.0)
	call putval('Sigma='//labs, 0.0)
	call putval('Weight='//labw, 0.0)
	nset=max(ncolx,ncoly,ncols,ncolw)
	do i=ncolx+1,nset
	  colx(i)=colx(ncolx)
	enddo
	do i=ncoly+1,nset
	  coly(i)=coly(ncoly)
	enddo
	do i=ncols+1,nset
	  cols(i)=cols(ncols)
	enddo
	do i=ncolw+1,nset
	  colw(i)=colw(ncolw)
	enddo

!	call dat_group(2, putval)
!	call putval('XAxis='//xaxis, 0.0)
!	call putval('YAxis='//yaxis, 0.0)
	call dat_group(1, putval)

	nrows=0
	errcnt=0
	s0cnt=0
4	continue
	read(lun,'(a)',err=99,end=90) line
	lin=lin+1
	if (line(1:1) .eq. '#') goto 4
	if (line .eq. ' ') goto 4
	pos=1
	do j=1,lastcol
	  call str_get_elem(line, pos, elem)
	  values(j)=0.0
	  read(elem, *, iostat=iostat) values(j)
	  if (iostat .ne. 0) then
	    if (errcnt .eq. 0) then
	      errlin=lin
	      errcol=j
	    endif
	    errcnt=errcnt+1
	  endif
	enddo
	nrows=nrows+1
	do i=1,nset

	  if (colx(i) .eq. -1) then ! linear starting from 1
	    x=nrows
	  else if (colx(i) .eq. 0) then
	    x=(nrows-1)*valx
	  else
	    x=values(colx(i))
	  endif

	  if (coly(i) .eq. -1) then ! not really useful: constant 0
	    y=0.0
	  else if (coly(i) .eq. 0) then
	    y=valy
	  else
	    y=values(coly(i))
	  endif
	  
	  if (cols(i) .eq. -1) then ! sqrt(y)
	    if (y .lt. 1.0) then
	      s=1.0
	    else
	      s=sqrt(y) ! statistical counting error
	    endif
	  else if (cols(i) .eq. 0) then
	    s=vals
	  else
	    s=values(cols(i))
	  endif
	  
	  if (colw(i) .eq. -1) then ! fixed weight
	    w=1.0
	  else if (colw(i) .eq. 0) then
	    w=valw
	  else
	    w=values(colw(i))
	  endif
	  if (w .le. 0) w=1.0
	  if (ymon .eq. 0) ymon=w

	  if (nread .ge. nmax) goto 29
	  if (s .le. 0) then
	    s0cnt=s0cnt+1
	  else
	    nread=nread+1
	    xx(nread)=x
	    yy(nread)=y*ymon/w
	    ss(nread)=s*ymon/w
	    ww(nread)=w
	  endif
	enddo
	goto 4

90	close(lun)
	if (s0cnt .gt. 0) then
	  print *,'DAT_TABLE: skipped',s0cnt
	1        ,' lines with sigma = 0'
	endif
	if (errcnt .gt. 0) then
	  print *,'DAT_TABLE: found',errcnt,'errors, first at line '
	1  ,errlin ,' column ', errcol
	endif
	call putval('Monitor', ymon)
	if (nset .gt. 1) then
	  call fit_dat_table(1, nset, nrows)
	endif
	return

29	print *,'DAT_TABLE: too many points'
	goto 100

98	if (forced .le. 0) goto 100
99	print *,'DAT_TABLE: error during read'
	rewind lun
	nread=-2
	return
100	nread=-1
	rewind lun
	end


	subroutine dat_table_col_options(header, name, cols, mcols, ncols
	1 , val, axlabel)

	integer mcols, ncols
	integer cols(mcols)
	character name*(*), header*(*), axlabel*(*)
	real val

	character colname*64, axname*64
	integer idx, l, iax, iostat, ll

	integer  str_find_elem
	external str_find_elem

	colname=' '
	ncols=0
	iax=0
	axlabel=' '
	ll=0
	call dat_str_option(name, colname)
	if (colname .eq. ' ') then
	  iax=1
	  write(axname, '(a,i1)') name, iax
	  call dat_str_option(axname, colname)
	endif
	do while (colname .ne. ' ')
	  call str_trim(colname, colname, l)
	  if (colname .eq. '*') then
	    ncols=ncols+1
	    cols(ncols)=-1 ! special meaning
	    if (name .eq. 'x') then
	      colname='linear'
	      l=6
	    else if (name .eq. 'y') then
	      colname='0.0'
	      l=3
	    else if (name .eq. 's') then
	      colname='sqrt(y)'
	      l=7
	    else if (name .eq. 'm') then
	      colname='1.0'
	      l=3 
	    endif
	    goto 10
	  endif
	  idx=0
	  if (index(colname, '.') .ne. 0) then
	    read(colname, *, iostat=iostat) val ! try to get colname as a real
	    if (iostat .eq. 0) then
	      ncols=ncols+1
	      cols(ncols)=0 ! special value
	      goto 10
	    endif
	  else
	    read(colname, *, iostat=iostat) idx ! try to get colname as an int
	  endif
	  if (iostat .ne. 0) then
	    idx=str_find_elem(header, colname)
	  else
	    colname='col'//colname(1:l)
	    l=l+3
	  endif
	  if (idx .eq. 0) then
	    print *,'DAT_TABLE: column ',colname(1:l),' not found'
	    goto 9
	  endif
	  ncols=ncols+1
	  cols(ncols)=idx
10	  continue
	  call str_append(axlabel, ll, colname(1:l)//',')
	  colname=' '
	  if (iax .ne. 0) then
	    iax=iax+1
	    if (iax .le. 9) then
	      write(axname, '(a,i1)') name, iax
	      call dat_str_option(axname, colname)
	    else if (iax .le. 99) then
	      write(axname, '(a,i2)') name, iax
	      call dat_str_option(axname, colname)
	    endif
	  endif
	enddo
	if (ll .gt. 1) then
	  axlabel(ll:ll)=' '
	endif
	RETURN

9	ncols=-1
	end