	subroutine dat_init_desc(datype, handler)

	integer datype
	external handler

	include 'dat.inc'

	data desc_hdl/maxtypes*0/
	data high_hdl/maxtypes*0/
	data read_hdl/maxtypes*0/
	data opts_hdl/maxtypes*0/
	data last_type/0/, dtype/0/, year/0/
	integer sys_adr_c, sys_adr_iiieirrrr, sys_adr_ci, sys_adr_0

	call dat_init_handler(datype)
	desc_hdl(datype)=sys_adr_c(handler)
	return

	entry dat_init_read(datype, handler)

	call dat_init_handler(datype)
	read_hdl(datype)=sys_adr_iiieirrrr(handler)
	return

	entry dat_init_high(datype, handler)

	call dat_init_handler(datype)
	high_hdl(datype)=sys_adr_ci(handler)
	return

	entry dat_init_opts(datype, handler)

	call dat_init_handler(datype)
	opts_hdl(datype)=sys_adr_0(handler)
	return

	end


	subroutine dat_init_hdl
	end


	subroutine dat_desc(datype, text)
 
C get description (syntax: filetype, space(s), description)
 
	integer datype	! (in) data type code
	character text*(*)

	include 'dat.inc'

	call sys_call_c(desc_hdl(datype), text)
	end



	subroutine dat_high(datype, file, numor)
 
C get highest numor
 
	integer datype	! (in) data type code
	integer numor
	character file*(*)
 
	include 'dat.inc'

	call sys_call_ci(high_hdl(datype), file, numor)
	end



	subroutine dat_desc_opt(done, typ)

! print options description
	character typ*(*)  ! file type
 
	include 'dat.inc'

	integer done
 
	if (last_type .eq. 0) then
	  done=0
	else
	  print *,'Options for filetype ',typ,':'
	  print *
	  call sys_call_0(opts_hdl(last_type))
	endif
	end



	subroutine dat_read(datype, lun, forced, nread
	1 , putval, nmax, xx, yy, ss, ww)
C
	integer datype	! (in) data type code
	integer lun	! (in) logical unit number (file will be closed if successful)
	integer forced	! -1: read only if type is really sure
	                !  0: read only if type is quite sure
	                !  1: try to read anyway, as there is no alternative
	integer nread	! (out) >=0: = number of points read, file closed
	                !       -1: not correct type, file still open
	                !       -2: correct type, but unreadable, still open
	external putval ! (in) subroutine putval(str, val)
			!      character*(*) str
			!      real val
	integer nmax    ! max. number of points
	real xx(nmax)	! x-values
	real yy(nmax)	! y-values
	real ss(nmax)	! sigma
	real ww(nmax)	! weights

	include 'dat.inc'

	if (datype .ne. 0) last_type=datype
	if (last_type .eq. 0) then
	  print *,'DAT_READ: datype illegal'
	  nread=-1
	else
	  rewind lun
	  call sys_call_iiieirrrr(read_hdl(last_type), lun, forced, nread
	1, putval, nmax, xx, yy, ss, ww)
	endif
	end


	subroutine dat_init_handler(datype)
!
! datype = 0: return new type id in datype
! else: change handler for datype
!
	include 'dat.inc'
 
	integer datype

	integer i,j
	character system*32
	external dat_do_nothing
 
	if (ntypes .eq. 0) then
	  call sys_loadenv
	  spec=' '
	  call sys_getenv('dat_defyear', spec)
	  year=0
	  read(spec,*,iostat=i) year
	  if (year .eq. 0) call sys_date(year, i, j)
	  call sys_getenv('dat_defspec', spec)
	  call str_lowcase(spec, spec)
	  call sys_check_system(system)

	  if (system .eq. 'VMS') then
	    specin='/'
	    specout='/'
	  else
	    specin=':'
	    specout=':'
          endif
	endif

	if (datype .eq. 0) then
	  ntypes=ntypes+1
	  if (ntypes .gt. maxtypes)
	1    stop 'DAT_INIT_HANDLER: too many handlers'
	  datype=ntypes
	endif
	end
 

	subroutine dat_do_nothing
	end
 

	subroutine dat_open_next(listin, pin, listout, pout
	1 , putval, nmax, nread, xx, yy, ss, ww)
 
c  open next file from file-list LISTIN at position PIN,
c  put item on LISTOUT, position POUT
 
c  first call to DAT_OPEN_NEXT: POUT=0
c  between subsequent calls, LISTOUT and POUT must not be altered
 
	character listin*(*)	! (in) input file list
	integer pin		! (in/out) input list position
	character listout*(*)   ! (out) output file list
	integer pout		! (in/out) output list position
	external putval ! (in) subroutine to treat name value pairs
			! subroutine putval(str, val)
			! character*(*) str
			! real val
	integer nmax	! max number of points (if NMAX=0: check syntax only)
	integer nread	! (out) number of points read
	real xx(nmax)	! x-values
	real yy(nmax)	! y-values
	real ss(nmax)	! sigmas
	real ww(nmax)	! weights

! arguments for entries DAT_SETTYP, DAT_GETTYP, DAT_SETYEAR, DAT_GETHIGH:
 
	character spec_def*(*)	! default instrument specification
	integer year_def	! default year
	integer high_numor      ! highest numor
	character filnam*(*)	! full filename
	integer len_name	! length of filename
	logical silent
	
	integer undef_numor
	parameter (undef_numor=-2)
 
	integer i,l,m,n,ny,hyp,num1,num2,stat,tf,idx,lcf
	integer lf/0/
	integer np/0/
	integer namend,ityp,iname,ispec1,ispec2
	integer irange/0/,jrange/0/,krange/0/
	character delim*1
	logical spec_out, year_out, inq, ok, syntaxonly, nam_out
	logical range_out/.false./
 
	character filename*256/' '/
	character filtype*32, tmpfil*256
	character calspec*32, calfil*256, cyr*4
	character text*128, calast*256/' '/, caltxt*256
	integer numor/0/, lun/0/, iostat
	logical dirty/.false./, do_calib, log_it/.true./, hint/.true./
	logical log_filter
	real calib, filter, sigoff, s2, ymn, ymx
	integer spikecnt, lt
	character shortspec*32, filtertext*32
 
	include 'dat.inc'

	call dat_init
	
	if (specout .eq. ':') then
	  if (index(listin, ':') .eq. 0) then
            specin='/'
          else
            specin=':'
          endif
	endif
	
	if (nmax .eq. 0) then
	  syntaxonly=.true.
	else
	  syntaxonly=.false.
	  if (log_it) print *
	endif
 
	nread=0

5	if (pin .ge. len(listin)) goto 98
	if (listin(pin+1:pin+1) .le. ' ') then
	  pin=pin+1
	  goto 5
	endif
 
	if (lun .eq. 0) call sys_get_lun(lun)
	ny=-1
	iname=pin
	ispec1=0
	ispec2=0
	call dat_get_item(listin, pin, delim)
	if (delim .eq. specin) then                       ! separator found
	  num1=0
	  if (pin .gt. iname+1) then                      ! item is not empty
	    call dat_cvt_number(listin(iname+1:pin-1), ny)
	    if (ny .lt. 1900 .or. ny .gt. 2064) then      ! item is not year
	      if (ny .lt. 0) then
	        ispec1=iname                              ! first item is spec
	        ispec2=pin
	        ny = -1 ! no number
	      else
	        ny = -2 ! bad number
	      endif
	    endif
	  endif
	  n=pin
	  call dat_get_item(listin, pin, delim)
	  if (delim .eq. specin) then                     ! 2nd separator found
	    if (pin .gt. n+1) then                        ! 2nd item not empty and year is not yet given
	      if (ny .eq. -1) then                        ! year not yet given
	        call dat_cvt_number(listin(n+1:pin-1), ny)
	        if (ny .lt. 1900 .or. ny .gt. 2064) then    ! 2nd item is not year
	          ny = -2 ! bad year
	        endif
	      else
	        ispec1 = n                                ! 2nd item is spec
	        ispec2 = pin
	      endif
	    endif
	    n=pin
	    l=pin
	    call dat_get_item(listin, pin, delim)
	  endif
	else
	  n=iname
	endif
	if (pin .gt. n+1) then
	  if (listin(n+1:) .eq. ' ') then
	    num1=0
	  else
	    call dat_cvt_number(listin(n+1:pin-1), num1)
	  endif
	elseif (delim .eq. '-') then
	  num1=numor+1
	else
	  num1=numor
	endif
	if (delim .eq. '-') then
	  hyp=pin
	  call dat_get_item(listin, pin, delim)
	  if (pin .gt. hyp+1) then
	    call dat_cvt_number(listin(hyp+1:pin-1), num2)
	  else
	    num2=-1
	  endif
	else
	  hyp=0
	  num2=num1
	endif
10	if (delim .eq. '-' .or. delim .eq. specin) then
	  call dat_get_item(listin, pin, delim)
	  num1=-1  ! illegal syntax
	  goto 10
	endif
 
	namend=pin

	if (delim .eq. '(') then
	  ityp=pin
	  call dat_get_item(listin, pin, delim)
	  if (pin .gt. ityp+2) then
	    call str_upcase(filtype, listin(ityp+1:pin-2))
	    call dat_find_type(filtype, i)
	    if (i .ne. 0) then
	      dtype=i
	    else
	      filtype=' '
	    endif
	  endif
	  inq=.false.
	else
	  inq=.true.
	endif

	if (delim .eq. '[') then
	  irange=pin
	  call dat_get_item(listin, pin, delim)
	  jrange=pin-1
	  if (jrange .ge. len(listin))
	1    call str_trim(listin, listin, jrange)
	  if (.not. syntaxonly) then
	    if (jrange .gt. irange+1) then
	      call dat_set_options(listin(irange+1:jrange-1))
	    else
	      call dat_set_options(' ')
	    endif
	  endif
	  range_out=.true.
	  if (delim .ne. ',' .and. delim .ne. ' ') then
	    num1=-1
	    goto 10
	  endif
	else
	  jrange=irange
	  if (.not. syntaxonly) then
	    call dat_set_options(' ')
	  endif
	endif

	if (num1 .ge. 0 .and. num2 .ge. num1 .and. ny .ge. -1) then ! numor given
 
	  spec_out=.false.
	  if (ispec2 .gt. ispec1+1) then
	    if (listin(ispec1+1:ispec2-1) .ne. spec) then
	      call str_lowcase(spec,listin(ispec1+1:ispec2-1))
	      spec_out=.true.
	    endif
	  elseif (numor .eq. undef_numor) then
	    spec_out=.true.
	  endif
 
	  year_out=.false.
	  if (ny .ge. 0) then
	    if (ny .lt. 64) then
	      ny=2000+ny
	    elseif (ny .lt. 100) then
	      ny=1900+ny
	    endif
	    if (ny .ge. 1900 .and. ny .lt. 2100) then
	      if (ny .ne. year) then
	        year=ny
	        year_out=.true.
	      endif
	    else
	      call str_trim(filename, listin, lf)
	      goto 99
	    endif
	  elseif (numor .eq. undef_numor) then
	    year_out=.true.
	  endif
 
 	  i = index(spec, '/')
 	  if (i .gt. 1) then
 	    shortspec=spec(1:i-1)
 	  else
 	    shortspec=spec
 	  endif
	  call sys_getenv('dat_alias_'//shortspec, filtype)
	  if (filtype .ne. ' ') spec=filtype
	  call sys_getenv('dat_type_'//shortspec, filtype)
	  call str_upcase(filtype, filtype)
	  call dat_find_type(filtype, i)
	  if (i .ne. 0) dtype=i
 
	  if (syntaxonly) then
	    stat=1
	    if (ny .gt. 0) stat=2
	    call dat_open_raw(0,spec,num1,year,filename,stat)  ! syntax only
	  else
	    if (spec .eq. ' ' .and. hint) then
	      hint=.false.
	      print *,'run number(s) without instrument entered'
	      print '(x,a,$)','enter the instrument or project name: '
	      read(*,'(a)',end=19,err=19) spec
	      call str_lowcase(spec, spec)
	    endif
19	    stat=1
	    if (ny .gt. 0) stat=2
	    call dat_open_raw(lun,spec,num1,year,filename,stat)
	  endif
 	  if (spec .ne. ' ') then
	    write(cyr, '(i4.4)') year
	    call sys_setenv('dat_defyear', cyr)
	    call sys_setenv('dat_defspec', spec)
	    call sys_saveenv
	  endif

	  if (stat .eq. 0) then
	    lf=0
	    call dat_put_str(filename, lf, spec)
	    call dat_put_str(filename, lf, specout)
	    call dat_put_int(filename, lf, year)
	    call dat_put_str(filename, lf, specout)
	    call dat_put_int(filename, lf, num1)
	    print *,filename(1:lf),' not found'
	    filename=' '
 
	  else
	    if (.not. syntaxonly) then

	      if (dtype .ne. 0) then
	        call dat_read(dtype,lun,0,nread,putval,nmax,xx,yy,ss,ww)
	      else
	        nread=-1
	      endif
	      if (nread .eq. -1) then
	        do_calib=.false.
	        do i=1,ntypes
	          if (i .ne. dtype) then
	            call dat_read(i, lun, 0, nread, putval, nmax
	1			              , xx,yy,ss,ww)
	            if (nread .ne. -1) goto 20
	          endif
	        enddo
20	        continue
	      else
	        do_calib=.true.
	      endif

!	      call str_trim(filename, filename, lf)
	      call sys_parse(filename, lf, filename, ' ', 0)
	      if (nread .lt. 0) then
	        close(lun)
	        print *,filename(1:lf),' unreadable'
	        dirty=.true.
	        if (log_it) call dat_end_options
	        goto 29
	      endif
 
	      call dat_group(2, putval)
	      call putval('File='//filename(1:lf), 0.0)
	      call dat_group(1, putval)

	      text=' '
	      if (do_calib) then
	        calfil=' '
	        call dat_str_option('cal', calfil)
	        filter=-1
	        call dat_real_option('filter', filter)
	        log_filter=.true.
	        if (filter .lt. 0) then
	          log_filter=.false.
	          calspec='spikefilter_'//shortspec
	          call sys_getenv(calspec, filtertext)
	          filter=0
	          read(filtertext, '(f32.0)', iostat=iostat) filter
	        endif
	        if (calfil .eq. '0') then
	          text='(uncalibrated)'
	          call dat_group(2, putval)
	          call putval('calibration=0',0.0)
	          goto 230
	        endif
	        idx=0
	        
200	        continue ! try-again loop

	        if (idx .lt. 10) then
	          calspec='dat_calist_'//shortspec
	          call sys_getenv_idx(calspec, tmpfil, idx)
	        else
	          calspec='dat_calib_'//shortspec
	          call sys_getenv_idx(calspec, tmpfil, idx-10)
	        endif
	        if (tmpfil .eq. ' ') then
	          if (idx .ge. 10) goto 221 ! give up
	          ! end of dat_calist_xxx list, try dat_calib_xxx list
	          idx=10
	          goto 200
	        endif
	        idx=idx+1

	        call dat_insert_year(tmpfil, year, ok)
	        if (calfil .ne. ' ') then
	          call sys_parse(tmpfil, tf, calfil, tmpfil, 0)
	        else
	          call str_trim(tmpfil, tmpfil, tf)
	        endif
205	        call sys_open(lun,tmpfil(1:tf),'r',iostat) ! readonly
	        if (iostat .ne. 0) then
	          if (idx .lt. 100) goto 200 ! try again
	          goto 221 ! give up
	        endif
! calibration
	        read(lun, '(a)',end=227,err=227) text
	        if (text(1:6) .eq. 'calist') then
	          idx=100 ! do not try again
	          read(lun, '(i10,a)',end=227,err=227) i, text
	          if (i .ne. 1) then
	            print *,'first numor in CALIST must be 1'
	            goto 227
	          endif
210	          call str_trim(calfil, text, lcf)
	          read(lun, '(i10,a)',end=211,err=211) i, text
	          if (i .le. num1) goto 210
211	          close(lun)
	          if (calfil(1:lcf) .eq. ' ') goto 226
	          call str_first_nonblank(calfil(1:lcf), i)
	          call sys_parse(tmpfil, tf, calfil(i:lcf), tmpfil, 0)
	          goto 205
	        endif
	        if (text(1:1) .eq. '#') then
	          call str_trim(caltxt, text(2:), l)
220	          read(lun, '(a)',end=227,err=227) text
	          if (text(1:1) .eq. '#') goto 220
	        else
	          l=0
	        endif
	        if (tmpfil(1:tf) .ne. calast) then
	          calast=tmpfil(1:tf)
	          if (log_it) then
	            print '(x,2a)'
	1              ,'calibration file: ',tmpfil(1:tf)
	            if (l .gt. 0)
	1             print '(x,3a)'
	1               ,'                 (',caltxt(1:l),')'
	          endif
	        endif
	        read(text,*,err=227,end=227) n
	        if (n .ne. nread) then
	          write(text, '(a,2i5,a)')
	1	    'calibration file does not match file length '
	1           , n, nread, ' -> no calibration'
	          goto 230
	        endif
	        nread=0
	        do i=1,n
	          read(lun,*,end=227,err=227) calib
	          if (calib .gt. 0) then
	            nread=nread+1
	            xx(nread)=xx(i)
	            ss(nread)=ss(i)/calib
	            yy(nread)=yy(i)/calib
	            ww(nread)=ww(i)
	          endif
	        enddo
	        text='and calibrated'
	        if (filter .ne. 0 .and. nread .ge. 5) then
c	          -- spike filter
	          spikecnt=0
	          n=nread
	          nread=0
	          do i=1,n
	            s2=ss(i)**2
	            if (i .ge. 3) then
	              ymx=max(yy(i-1),2*yy(i-1)-yy(i-2))
	              ymn=min(yy(i-1),2*yy(i-1)-yy(i-2))
	              s2=s2+0.25*ss(i-1)**2
	            else
	              ymx=yy(i+1)
	              ymn=yy(i+1)
	              s2=s2+0.25*ss(i+1)**2
	            endif
	            if (i .le. n-2) then
	              ymx=max(ymx,yy(i+1),2*yy(i+1)-yy(i+2))
	              ymn=min(ymn,yy(i+1),2*yy(i+1)-yy(i+2))
	              s2=s2+0.25*ss(i+1)**2
	            else
	              s2=s2+0.25*ss(i-1)**2
	            endif
	            sigoff=0
	            if (s2 .gt. 0) then
	              if (yy(i) .gt. ymx) then
	                sigoff = (yy(i)-ymx) / sqrt(s2)
	              elseif (yy(i) .lt. ymn) then
	                sigoff = (ymn-yy(i)) / sqrt(s2)
	              endif
	            endif
	            if (yy(i) .eq. 0) then
	              if (log_filter) then
	                print '(i6,a,f7.2,a,i5,a)'
	1                 ,num1,': zero at',xx(i)
	1                 ,' (channel ',i,')'
	              endif
	              spikecnt=spikecnt+1
	            elseif (sigoff .gt. filter) then
	              if (log_filter) then
	                print '(i6,a,f7.2,a,i5,a,g8.2,a)'
	1                 ,num1,': spike at',xx(i)
	1                 ,' (channel ',i,',',sigoff, ' sigma)'
	              endif
	              spikecnt=spikecnt+1
	            else
	              nread=nread+1
	              xx(nread)=xx(i)
	              ss(nread)=ss(i)
	              yy(nread)=yy(i)
	              ww(nread)=ww(i)
	            endif
	          enddo
	          call str_trim(text, text, lt)
	          if (spikecnt .gt. 10) then
	            write(text(lt+1:), '(i5,a)') spikecnt, ' spikes'
	          elseif (spikecnt .gt. 0) then
	            write(text(lt+1:), '(i2,a)') spikecnt, ' spikes'
	          endif
	        endif
	        call dat_group(2, putval)
	        call putval('calibration='//caltxt(1:l),0.0)
	        goto 230

221	        if (tmpfil .eq. ' ') then
	          call sys_getenv_idx(calspec, tmpfil, 0)
	        endif
	        call sys_parse(tmpfil, tf, tmpfil, ' ', 3)
	        call str_trim(text, tmpfil,  tf)
	        if (text(1:tf) .ne. ' ') then
	          text(tf+1:)=' not found -> no calibration'
	        endif
	        calast=' '
	        goto 230
	        
226	        text='(uncalibrated)'
	        calast=' '
	        goto 230
	        
227	        text='error in '
	        call sys_parse(text(10:), tf, tmpfil, ' ', 3)
	        text(10+tf:)=' -> no calibration'
	        calast=' '
	        
230	        close(lun)
	      endif
	      if (log_it) call dat_end_options

	      call str_trim(text, text, l)
	      if (log_it) then
	        print *,filename(1:lf),' opened ',text(1:l)
	      endif
	      call dat_group(1, putval)
	      call putval('Numor', float(num1))

	    endif
 
	    if (pout .eq. 0) then
	      spec_out=.true.
	      year_out=.true.
	      krange=-1
	    endif
 
	    if (spec_out) then
	      call dat_put_str(listout, pout, spec)
	      call dat_put_str(listout, pout, specout)
	      numor=undef_numor
	    endif
	    if (stat .eq. 2 .and. year_out) then
	      call dat_put_int(listout, pout, year)
	      call dat_put_str(listout, pout, specout)
	    endif
 
	    if (num1 .ne. numor+1 .or. dirty .or. irange .ne. krange) then
	      if (num1 .ne. numor) call dat_put_int(listout, pout, num1)
	      np=pout
	      if (irange .lt. jrange) then
	        call dat_put_str(listout, pout, listin(irange:jrange))
	      endif
	      krange=irange
	      call dat_put_str(listout, pout, ',')
	    else
	      pout=np
	      call dat_put_str(listout, pout, '-')
	      call dat_put_int(listout, pout, num1)
	      if (irange .lt. jrange) then
	        call dat_put_str(listout, pout, listin(irange:jrange))
	      endif
	      krange=irange
	      call dat_put_str(listout, pout, ',')
	    endif

	  endif
 
	  dirty=.false.
29	  numor=num1
	  if (num1 .lt. num2) then
	    pin=hyp-1
	  endif
 
	  goto 98
	endif

	if (namend .gt. iname+1) then ! file name given

	  call sys_parse(filename, lf, listin(iname+1:namend-1), ' ', 0)
	  if (lf .eq. 0)
	1    call str_trim(filename,listin(iname+1:namend-1),lf)
	  nam_out=.true.
 
	elseif (irange .lt. jrange) then

	  nam_out=.false. ! take last filename

	else

	  goto 98 ! neither filename nor range given

	endif

	numor=undef_numor
	if (syntaxonly) goto 39
 
	call sys_open(lun,filename(1:lf),'r',iostat) ! readonly
	if (iostat .ne. 0) goto 99
 
	call dat_group(2, putval)
	call putval('File='//filename(1:lf), 0.0)
	call dat_group(1, putval)
	if (log_it) print *,filename(1:lf),' opened'
 
	if (dtype .ne. 0) then ! try first with default type
	  call dat_read(dtype, lun, -1, nread, putval, nmax, xx,yy,ss,ww)
	  if (nread .ne. -1) goto 39
	endif
 
	do i=1,ntypes
	  if (i .ne. dtype) then
	    call dat_read(i, lun, 0, nread, putval, nmax, xx, yy, ss, ww)
	    if (nread .ne. -1) goto 39
	  endif
	enddo
 
	if (dtype .ne. 0) then ! forced read with default type
	  call dat_read(dtype, lun, 1, nread, putval, nmax, xx,yy,ss,ww)
	  if (nread .ne. -1) goto 39
	endif
  
35	if (nread .ge. 0) goto 39
	if (inq) then
	  print *,'Select file type'
	  print *
	  do i=1,ntypes
	    call dat_desc(i, text)
	    call str_trim(text, text, l)
	    print '(i3,x,a)',i,text(1:l)
	  enddo
	  print *
	  print '(x,a,$)','Type:'
	  read(5,'(a)',end=37,err=37) filtype
	  if (filtype .eq. ' ') goto 37
	endif
 
	call str_upcase(filtype, filtype)
	call dat_find_type(filtype, i)
	if (i .ne. 0) then
	  dtype=i
	else
	  if (inq) then
	    read(filtype,*,err=35,end=35) dtype
	    if (dtype .le. 0 .or. dtype .gt. ntypes) goto 35
	  else
	    print *,'unknown file type: ',filtype
	  endif
	endif
 
	call dat_read(dtype, lun, 1, nread, putval, nmax, xx, yy, ss, ww)
	if (nread .lt. 0) then
	  print *,filename(1:lf),' unreadable'
	  goto 95
	endif
  
39	if (log_it) call dat_end_options
	if (pout .eq. 0) krange=-1
	if (nam_out .or. pout.eq.0) then
	  call dat_put_str(listout, pout, filename(1:lf))
	endif
	if (irange .lt. jrange .and. irange .ne. krange) then
	  call dat_put_str(listout, pout, listin(irange:jrange))
	  krange=irange
	endif
	call dat_put_str(listout, pout, ',')
	if (nmax .gt. 0) log_it=.true.
	goto 100
 
37	print *,'illegal type'
95	close(lun)
	goto 98
	
99	print *,filename(1:lf),' not found'
98	if (nmax .gt. 0) log_it=.true.
100	return
 

	entry dat_read_again(putval, nmax, nread, xx, yy, ss, ww)

	if (lf .gt. 0 .and. lun .ne. 0) then
	  call sys_open(lun,filename(1:lf),'r',iostat) ! readonly
	  if (iostat .ne. 0) goto 99
 
	  call dat_read(0, lun, 0, nread, putval, nmax, xx, yy, ss, ww)
	  if (nread .lt. 0) then
c	    print *,'error in ',filename(1:lf)
	    close(lun)
	  endif
	endif
	return


	entry dat_get_filename(filnam, len_name)

	call str_trim(filnam, filename, len_name)
	return


	entry dat_settyp(spec_def)
 
	call dat_init
	call dat_find_type(spec_def, i)
	if (i .ne. 0) dtype=i
	return
 
 
	entry dat_silent

	log_it=.false.
	return

	entry dat_get_silent(silent)
	
	silent=.not. log_it
	return

	entry dat_setyear(year_def)
 
	if (year_def .lt. 1900 .or. year_def .gt. 2200) then
	  print *,year_def
	  stop 'illegal year'
	endif
	call dat_init
	year=year_def
	return
 
 
	entry dat_getdef(spec_def)
 
	call dat_init
	if (spec .eq. ' ') then
	  spec_def=' '
	else
	  i=index(spec, '/')
	  if (i .le. 1) then
	    shortspec=spec
	  else
	    shortspec=spec(1:i-1)
	  endif
	  call sys_getenv_idx('dat_spec_'//shortspec, tmpfil, 0)
	  call str_trim(spec, spec, l)
	  if (index(tmpfil, '%%') .ne. 0) then
	    write(tmpfil, '(2a,i4.4,a)') spec(1:l), specout, year, specout
	    spec_def=tmpfil(1:l+6)
	  else
	    spec_def=spec(1:l)//specout
	  endif
	endif
	return
 
 
	entry dat_gettyp(spec_def)
 
	call dat_init
	if (last_type .eq. 0) last_type=dtype
	if (last_type .eq. 0) then
	  spec_def=' '
	else
	  call dat_desc(last_type, spec_def)
	  i=index(spec_def, ' ')
	  if (i .ne. 0) spec_def=spec_def(1:i)
	endif
	return
 
 
	entry dat_get_high(high_numor)
 
	high_numor=0 ! assume failure
	call dat_init
	i=index(spec, '/')
	if (i .le. 1) then
	  shortspec=spec
	else
	  shortspec=spec(1:i-1)
	endif
	call sys_getenv('dat_type_'//shortspec, filtype)
	call dat_find_type(filtype, i)
	if (i .eq. 0) return
	do m=0,32
	  call sys_getenv_idx('dat_high_'//shortspec, tmpfil, m)
	  if (tmpfil .eq. ' ') RETURN
	  call dat_insert_year(tmpfil, year, ok)
	  call dat_high(i, tmpfil, high_numor)
	  if (high_numor .ne. 0) RETURN
	enddo
	end
 
 
	subroutine dat_find_type(type, idx)
 
	character type*(*)
	integer idx
 
	include 'dat.inc'
 
	integer i, j
	character text*80
 
c  try first default type
	i=dtype
	if (i .gt. 0 .and. i .le. ntypes) then
	  call dat_desc(i, text)
	  j=index(text, ' ')
	  if (j .ne. 0 .and. type .eq. text(1:j)) then
	    idx=i
	    return
	  endif
	endif
 
c and then all the others
 
	do i=1,ntypes
	  if (i .ne. dtype) then
	    call dat_desc(i, text)
	    j=index(text, ' ')
	    if (j .ne. 0 .and. type .eq. text(1:j)) then
	      idx=i
	      return
	    endif
	  endif
	enddo
 
	idx=0
 
	end
 
 
	subroutine dat_cvt_number(str, number)
 
	implicit none
 
	character str*(*)
	integer number
 
	integer i
	logical valid
 
	number=0
	valid=.false.
	do i=1,len(str)
	  if (str(i:i) .eq. ' ') then
	    if (valid) then
	      if (str(i:) .ne. ' ') then ! trailing spaces
	        number=-1
	      endif
	      return
	    endif
	  elseif (str(i:i) .lt. '0' .or. str(i:i) .gt. '9') then
	    number=-1
	    return
	  endif
	  valid=.true.
	  number=number*10+ichar(str(i:i))-ichar('0')
	enddo
	if (.not. valid) number=-1
	end
 
 
	subroutine dat_get_item(listin, pos, delim)
 
	character listin*(*)
	character delim*1
	integer pos
 
	integer i,j
	include 'dat.inc'

	if (pos .gt. 0) then
	  if (listin(pos:pos) .eq. '[') then
	    pos=pos+index(listin(pos+1:), ']') ! skip what is between
	  endif
	  if (listin(pos:pos) .eq. '(') then
	    pos=pos+index(listin(pos+1:), ')') ! skip what is between
	  endif
	endif
	do i=pos+1,len(listin)
	  if (listin(i:i) .eq. ',') then
	    delim=','
	    pos=i
	    return
	  endif
	  if (listin(i:i) .eq. specin) then
	    delim=specin
	    pos=i
	    return
	  endif
	  if (listin(i:i) .eq. '-') then
	    delim='-'
	    pos=i
	    return
	  endif
	  if (listin(i:i) .eq. '(') then
	    delim='('
	    pos=i
	    return
	  endif
	  if (listin(i:i) .eq. '[') then
	    j=index(listin(i:),']')
	    if (j .gt. 0) then
	      j=i+j
	      if (j .gt. len(listin)) then ! ']' is at end
	        delim='['
	        pos=i
	        return
	      endif
	      if (listin(j:j) .eq. ',' .or. listin(j:j) .eq. ' ') then !  ']' is at end or before a ','
	        delim='['
	        pos=i
	        return
	      endif
	    endif
	  endif
	enddo
	delim=' '
	pos=len(listin)+1
	end
 
 
	subroutine dat_put_str(listout, pout, str)
 
	character listout*(*), str*(*)
	integer pout
 
	integer l
 
	if (pout .lt. len(listout)) then
	  call str_trim(listout(pout+1:), str, l)
	  pout=pout+l
	  if (pout .lt. len(listout)) return
	endif
	listout(len(listout)-2:)='...'
	end
 
 
	subroutine dat_put_int(listout, pout, ival)
	
	character listout*(*)
	integer pout, ival
 
	character str*12
	integer i
 
	write(str, '(i12)') ival
	do i=11,1,-1
	  if (str(i:i) .eq. ' ') then
	    call dat_put_str(listout, pout, str(i+1:))
	    return
	  endif
	enddo
	print *,ival
	stop 'DAT_PUT_INT: integer conversion error'
	end
 
 

	subroutine dat_open_raw(lun,instr,num,year,filename,status)
!	-----------------------------------------------------------
 
	integer lun		! (in) logical unit number (lun=0: sytax only)
	character instr*(*)	! (in) instrument name
	integer num		! (in) numor (0 if not used)
	integer year		! (in) year (0 if not used)
	character filename*(*)	! (out) filename
	integer status		! (out) 0: not found
				!       1: specification without year
				!       2: specification with year
				! (in)  1: year was not given
				! (in)  2: year was given
 
! create a raw data file name from instrument name, year, num
! and the environment variable dat_spec_INSTR
! dat_spec_INSTR may contain several paths separated with ","
! if only an extension is given, the preceding path is used
! with exchanged extension
! %%%% are replaced by year, ***** by numor, ### by thousands of numor
! if a numor does not fit into the space forseen, the filename
! will be lengthened. For the ### substitution, overflow digits are
! skipped.

	character numor*12, filnam*128, path*128, rawname*128, spec*128
	character tascomdir*80, dyear*4
	integer l,n,m,i,j,iraw,lr,idx, iostat
	logical ok, hint/.true./, slash
 
 	l=index(instr, '/')-1
 	if (l .le. 0) then
 	  call str_trim(spec, instr, l)
 	  slash = .false.
 	else
 	  spec=instr(1:l)
 	  slash = .true.
 	endif
	do idx=0,32
	  call sys_loadenv
	  call sys_getenv_idx('dat_spec_'//spec(1:l),path,idx)
	  if (path .eq. ' ') then
	    if (idx .ne. 0 .or. num .le. 0 .or. .not. hint
	1       .or. spec(1:l) .eq. ' ') goto 19
	    hint=.false.
	    print *,spec(1:l),' is unknown'
	    print *
	    print *
	1 ,'Reading many files with a number in the name is much simpler '
	1 ,'when the path is known to fit. You may define now how your '
	1 ,'filenames for '//spec(1:l)
	1 //' look like. Put asterisks at the place where the '
	1 ,'number should appear. '
	    print *
	    print *,'Example:'
	    print *,'path for ',spec(1:l),': iron***.dat'
	    print *
	1,'When you later enter: ',spec(1:l),'/98-100'
	    print *
	1,'the files iron098.dat,iron099.dat,iron100.dat will be read in.'
5	    print *
	    print '(x,3a,$)','path for ',spec(1:l),': '
	    read(*,'(a)',end=19,err=19) path
	    print *
	    if (path .eq. ' ') goto 19
	    if (index(path,'*') .eq. 0) then
	      print *
	1,'the path does not contain an asterisk (*), enter it again'
	      goto 5
	    endif
	    call sys_setenv('dat_spec_'//spec(1:l), path)
	    call sys_saveenv
	  endif
	  if (path(1:1) .eq. '.' .and. idx .gt. 0) then
	    do j=lr,1,-1
	      if (rawname(j:j) .eq. '.') then
	        lr=j-1
	        goto 9
	      endif
	    enddo
9	    continue
	    call str_trim(rawname, rawname(1:lr)//path, lr)
	  else
	    call str_trim(rawname, path, lr)
	  endif

c	print *,'raw:',rawname(1:lr),' num:',num
 
	  i=index(rawname, '%t') ! special case: tascom data
	  if (i .gt. 0 .and. .not. slash .and. status .eq. 1) then
	    print '(x,a,i4,a,$)', 'year [',year,']: '
	    n=0
	    read(*,'(i10)',iostat=iostat) n
	    if (n .ge. 1900 .and. n .le. 2064) then
	      year=n
	    endif
	    write(dyear, '(i4.4)') year
	    call sys_setenv('dat_defyear', dyear)
	    call sys_saveenv
	  endif
	  
	  status=1
	  call dat_insert_year(rawname(1:lr), year, ok)
	  if (ok) then
	    if (year .lt. 1900 .or. year .gt. 2200) then
	      print *,'illegal year: ', year
	      goto 19
	    endif
	    status=2
	  endif
 
	  if (i .gt. 0) then ! special case: tascom data
	    rawname(i:)=' '
	    if (.not. slash) then
	      call dat_tascom_datadir(rawname, tascomdir)
	      if (tascomdir .eq. '0') goto 18
	      if (tascomdir .eq. ' ') goto 19
	      if (l .gt. len(instr)-2) goto 19
	      instr(l+1:l+1)='/'
	      slash=.true.
	      instr(l+2:)=tascomdir
	      rawname(i:)=tascomdir
	    else
	      if (l .gt. len(instr)-2) goto 19
	      rawname(i:)=instr(l+2:)
	    endif
	    call str_trim(rawname, rawname, lr)
	    n=i
	    do j=i,lr
	      if (rawname(j:j) .eq. '/') then
	        n=j
	      endif
	    enddo
	    if (n+12 .lt. len(rawname)) then
	      do j=lr+1,n+8
	        rawname(j:j) = '*'
	      enddo
	      rawname(n+9:)='.dat'
	      lr=n+12
	    endif
	  endif
	  iraw=index(rawname(1:lr),'*')
	  if (iraw .eq. 0) then
	    call str_trim(filnam, rawname(1:lr), j)
	    if (num .gt. 0) then
	      print *,'path does not contain "*":',rawname(1:lr)
	      goto 19
	    endif
	  else
	    if (num .eq. 0) then
	      call str_trim(instr, instr, i)
	      if (status .eq. 2) then
	        print '(x,3a,i4,a,$)',
	1         'Numor for ',instr(1:i),' (',year,'): '
	      else
	        print '(x,3a,$)','Numor for ',instr(1:i),': '
	      endif
	      read(*,'(i10)', iostat=iostat) num
	    endif
	    if (num .le. 0) then
	      print *,'numor must be positive: ', num
	      goto 19
	    endif
	    if (iraw .gt. 1) filnam(1:iraw-1)=rawname(1:iraw-1)	! copy first part of filename
	    write(numor,'(X,I11)') num
	    n=13
	    m=10
	    do i=1,lr
	      if (rawname(i:i) .eq. '*') then
	        n=n-1				! count down position in string numor
	        if (numor(n:n) .lt.  '0') numor(n:n)='0'
	      else if (rawname(i:i) .eq. '#') then ! count down from thousand pos.
	        m=m-1
	      endif
	    enddo
	    i=n-1
	    do while (numor(i:i) .ge. '0')	! find head of number (space)
	      i=i-1
	    enddo
	    numor(1:i)='00000000000'
	    i=i+1
	    if (i .lt. n) then
	      filnam(iraw:iraw+n-i-1)=numor(i:n-1)	! insert head part of number
	      j=iraw+n-i
	    else
	      j=iraw
	    endif
	    do i=iraw,lr				! replace stars by number and copy rest of name
	      if (rawname(i:i) .eq. '*') then
	        filnam(j:j)=numor(n:n)
	        n=n+1
	      else
	        filnam(j:j)=rawname(i:i)
	      endif
	      j=j+1
	    enddo
	    j=j-1
	    do i=1,j
	      if (filnam(i:i) .eq. '#') then
	        filnam(i:i)=numor(m:m)
	        m=m+1
	      endif
	    enddo
 	  endif
	  filename=filnam(1:j)
	  if (lun .ne. 0) then
	    call sys_open(lun,filnam(1:j),'r',iostat) ! readonly
	    if (iostat .eq. 0) RETURN
	  else
	    RETURN
	  endif
18	  continue
	enddo
 
19	status=0
	filename=' '
	return	
	end
