subroutine dat_nexus
c	--------------------

	external dat_nexus_desc
	external dat_nexus_opts
	external dat_get_datanumber ! get number on first line
	external dat_nexus_read

	integer dtype/0/

	call dat_init_desc(dtype, dat_nexus_desc)
	call dat_init_opts(dtype, dat_nexus_opts)
	call dat_init_high(dtype, dat_get_datanumber)
	call dat_init_read(dtype, dat_nexus_read)
	end


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

!             type    description
!             ----------------------------------
	text='NEXUS   NeXus data format'
	end


	subroutine dat_nexus_opts
!	-------------------------
	implicit none
	character spec*16

	call sys_getenv('dat_defspec', spec)
	call str_upcase(spec, spec)
	if (spec .ne. ' ') then
	  print '(x,2a/)','valid only for instrument ',spec
	endif
	if (spec(1:5) .eq. 'FOCUS') then
	  print '(x,a)'
	1  ,'from,to:  detector range (default: averaged over all)'
	1  ,'bank:     detector bank, u,b,l,m (default: m=merged)'
	1  ,'axis:     time or theta'
	else if (spec(1:4) .eq. 'RITA') then
	  print '(x,a)'
	1  ,'from:     window number (default: middle window)'
	1  ,'from,to:  window range'
	1  ,'axis:     x-axis to be choosen'
	1  ,'y:        y-axis to be choosen (aux, mon)'
	else if (spec(1:5) .eq. 'CAMEA') then
	  print '(x,a)'
	1  ,'axis:     x-axis to be choosen'
	1  ,'y:        y-axis to be choosen (0 (summed_counts), 1, 8 (segment number), tot (total_counts), mon, aux)'
	else if (spec(1:5) .eq. 'TRICS') then
	  print '(x,a)'
	1  ,'from,to:  detector range'
	1  ,'axis:     x-axis to be choosen'
	1  ,'frame:    frame number (default: all frames)'
	1  ,'det:      detector number (default: 2)'
	else if (spec(1:3) .eq. 'DMC') then
	  print '(x,a)'
	1  ,'cal:      calibration file'
	1  ,'filter:   threshold for spike filter (default: 4)'
	else if (spec(1:4) .eq. 'HRPT') then
	  print '(x,a)'
	1  ,'from,to:  time channel range (default: averaged over all)'
	1  ,'cal:      calibration file'
	1  ,'filter:   threshold for spike filter (default: 4)'
	else if (spec(1:5) .eq. 'MARS') then
	  print '(x,a)'
	1  ,'bank:     detector bank, e,i,m1,m2'
	1  ,'                         (elastic, inelastic, mon1, mon2)'
	1  ,'from,to:  detector range (default: averaged over all)'
	else if (spec .eq. ' ') then
	  print '(x,a)'
	1  ,'from:     first or only dataset (default: 1, RITA: middle window)'
	1  ,'to:       last dataset (default: max. or single)'
	1  ,'bank:     on FOCUS: detector bank, u,b,l,m (default: m=merged)'
	1  ,'axis:     x-axis to be choosen'
	1  ,'frame:    on TRICS: frame number (default 0)'
	1  ,'det:      on TRICS: detector number (default: 1)'
	1  ,'cal:      calibration file'
	endif
	print '(x,a)'
	1  ,'mon:      monitor for normalisation (auto, smon, pmon, bmon, time)'
	end


	subroutine dat_nexus_read
	1 (lun, forced, nread, pv, 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 pv     ! (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
	include 'dat_nexus.inc'

	integer i,j
	character magic*4, filename*256
	integer li, lc, lm
	character cnt*64, mono*64, ins*64, axis2*64, signal*64
	character yaxis*64
	integer nsum, ngrp, nblk, xlen, nset
	real totcnts, sta, stp, weight
	integer from, to, lb, idet, icomp, iframe
	character bank*64, buf*16
	character monarray*64
	integer p_weight(2), p_monarray(2)
	integer istart
	integer n_monarray

	integer dat_comp
	external dat_comp, dat_nexus_putval


	if (forced .le. 0) then ! check for HDF-file
	  magic=' '
	  read(lun,'(a4)',err=9,end=9) magic
9	  if (magic .ne. char(14)//char(3)//char(19)//char(1) .and.
	1        magic(2:4) .ne. 'HDF') then
	    rewind lun
	    nread=-1
	    return
	  endif
	endif

c assume that we can open the HDF file, even when it is opened already by Fortran

	inquire(lun, name=filename)
	call NXswitchReport(0)
	status=NXopen(filename, NXacc_read, fileid)

	if (status .ne. NX_ok) then
	  rewind lun
	  call NXswitchReport(1)
	  nread=-1
	  return
	endif
	lp=1
	path='/'

	call dat_nexus_get('/instrument')
	if (type .ne. NX_char .or. status .ne. NX_OK) then
	  if (index(filename,'rita') .ne. 0) then
	    cdata = 'RITA2'
	  elseif (index(filename,'camea') .ne. 0) then
	    cdata = 'CAMEA'
	  else
	    goto 999 ! no instrument attribute
	  endif
	endif
	
	i=index(cdata, ' ')
	j=index(cdata, ',')
	if (j .eq. 0) j=len(cdata)
	i=min(i,j)-1
	if (i .lt. 1) goto 999 ! bad instrument attribute

	call dat_group(2, pv) ! importance level 2
	call pv('instrument='//cdata(1:i), 0.0)

	call str_upcase(instr, cdata(1:1)) ! take the first letter as code for the instrument

	call dat_start_options
	from=0
	to=0
	bank=' '
	xaxis=' '
	yaxis=' '
	iframe=-1
	idet=2
	if (instr .eq. 'F') then
	  call dat_int_option('from', from)
	  call dat_int_option('to',   to)
	  call dat_str_option('bank', bank)
	  call dat_str_option('axis', xaxis)
	elseif (instr .eq. 'R') then
	  call dat_int_option('from', from)
	  call dat_int_option('to',   to)
	  call dat_str_option('axis', xaxis)
	  call str_lowcase(xaxis, xaxis)
	  call dat_str_option('y', yaxis)
	  call str_lowcase(yaxis, yaxis)
	elseif (instr .eq. 'C') then
	  call dat_str_option('axis', xaxis)
	  call str_lowcase(xaxis, xaxis)
	  call dat_str_option('y', yaxis)
	  call str_lowcase(yaxis, yaxis)
	elseif (instr .eq. 'T') then
	  call dat_int_option('from', from)
	  call dat_int_option('to',   to)
	  call dat_int_option('det', idet)
	  call dat_str_option('axis', xaxis)
	  call dat_int_option('frame', iframe)
	elseif (instr .eq. 'H') then
	  call dat_int_option('from', from)
	  call dat_int_option('to',   to)
	elseif (instr .eq. 'M') then
	  call dat_str_option('bank', bank)
	  call dat_int_option('from', from)
	  call dat_int_option('to',   to)
	endif
	ymon=0
	monitor='auto'
	call dat_str_option('mon', monitor)
	icomp=0
	call dat_int_option('bin', icomp)
	nframes=0
	axis2=' '
	n_monarray=0
	if (yaxis .eq. ' ') yaxis='counts'

	if (instr .eq. 'D') then ! dmc
	  call str_trim(ins, '/nxentry/dmc/', li)
	  call str_trim(cnt, ins(1:li)//'nxpsd/', lc)
	  xaxis='two_theta'
	  axis1=cnt(1:lc)//'two_theta'
	  signal=cnt(1:lc)//'counts'
	else if (instr .eq. 'H') then ! hrpt
	  call str_trim(ins, '/nxentry/hrpt/', li)
	  call str_trim(cnt, ins(1:li)//'nxdetector/', lc)
	  xaxis='two_theta'
	  axis1=cnt(1:lc)//'two_theta'
	  signal=cnt(1:lc)//'counts'
	  axis2=cnt(1:lc)//'stroboscopic_time'
	  monarray='/nxentry/stroboscopic_monitor/data'
	  if (monitor .eq. 'auto' .or. monitor .eq. 'smon') then
	    n_monarray=-1
	  endif
	elseif (instr .eq. 'F') then ! focus
	  call str_trim(ins, '/nxentry/focus/', li)
	  call str_trim(cnt, ins(1:li)//'counter/', lc)
	  if (xaxis .eq. ' ') xaxis='time'
	  call str_lowcase(bank, bank)
	  if (bank(1:1) .eq. 't') then
	    call str_trim(bank, ins(1:li)//'tof_monitor/', lb)
	    axis1=ins(1:li)//'merged/time_binning'
	    signal=ins(1:li)//'tof_monitor'
	  else
	    if (bank(1:1) .eq. 'u') then
	      call str_trim(bank,'upperbank',lb)
	    elseif (bank(1:1) .eq. 'l') then
	      call str_trim(bank,'lowerbank',lb)
	    elseif (bank(1:1) .eq. 'b') then
	      call str_trim(bank,'bank1',lb)
	    else
	      call str_trim(bank,'merged',lb)
	    endif
	    call str_trim(bank, ins(1:li)//bank(1:lb)//'/', lb)
	    if (xaxis .eq. 'time') then
	      axis1=bank(1:lb)//'time_binning'
	      axis2=bank(1:lb)//'theta'
	    else
	      axis2=bank(1:lb)//'time_binning'
	      axis1=bank(1:lb)//'theta'
	    endif
	    signal=bank(1:lb)//'counts'
	  endif
	elseif (instr .eq. 'T') then ! trics
	  call str_trim(ins, '/frame0000/trics/', li)
	  if (iframe .ge. 0) write(ins(1:10), '(a,i4.4)') '/frame',iframe
	  call str_trim(cnt, ins(1:li)//'count_control/', lc)
	  if (xaxis .eq. ' ') xaxis='x'
	  if (idet .le. 0) idet=1
	  if (idet .gt. 3) idet=3
	  call str_trim(bank, ins(1:li)//'detector'//char(48+idet)//'/'
	1               , lb)
	  if (xaxis .eq. 'x') then
	    axis1=bank(1:lb)//'x'
	    axis2=bank(1:lb)//'y'
	  else
	    axis1=bank(1:lb)//'y'
	    axis2=bank(1:lb)//'x'
	  endif
	  signal=bank(1:lb)//'counts'
	  nframes=1
	elseif (instr .eq. 'C') then ! camea
	  call str_trim(ins, '/nxentry/CAMEA/', li)
	  call str_trim(cnt, ins(1:li)//'detector/', lc)
	  axis1=' '
	  if (yaxis .eq. 'aux') then
	    signal='/nxentry/aux_detector/data'
	  elseif (yaxis .eq. 'mon') then
	    signal='/nxentry/control/data'
	  elseif (yaxis .eq. 'tot') then
	    signal=cnt(1:lc)//'total_counts'
	  elseif (yaxis(2:) .eq. ' ' .and. yaxis(1:1) .ge. '0' .and. yaxis(1:1) .le. '9') then
            signal='/nxentry/CAMEA/segment_'//yaxis(1:1)//'/data'
	  else
	    signal='/nxentry/data/summed_counts'
	  endif
	  call dat_nexus_get('/nxentry/data/*')
	elseif (instr .eq. 'R') then ! rita
	  call str_trim(ins, '/nxentry/rita-2/', li)
	  call str_trim(cnt, ins(1:li)//'detector/', lc)
	  axis1=' '
	  if (yaxis .eq. 'aux') then
	    signal='/nxentry/aux_detector/data'
	  elseif (yaxis .eq. 'mon') then
	    signal='/nxentry/control/data'
	  else
	    axis2='w'
	    yaxis='counts'
	    signal=cnt(1:lc-1)//'windows/counts'
	  endif
	  if (from .gt. 0) then
	    if (to .lt. from) to=from
	  else if (from .eq. 0) then
	    from = 5
	    to = 5
	  endif
	  call dat_nexus_get('/nxentry/data/*')
	elseif (instr .eq. 'M') then
	  call str_lowcase(bank, bank)
	  if (bank(1:1) .eq. 'i') then
	    call str_trim(ins, '/inelastic/MARS/', li)
	    call str_trim(cnt, ins(1:li)//'inelastic_bank/', lc)
	    axis1=cnt(1:lc)//'time_binning'
	    axis2=cnt(1:lc)//'scattering_angle'
	  else
	    call str_trim(ins, '/elastic/MARS/', li)
	    if (bank .eq. 'm1') then
	      call str_trim(cnt, '/elastic/pre_sample_monitor/', lc)
	      axis1=cnt(1:lc)//'time_of_flight'
	    else if (bank .eq. 'm2') then
	      call str_trim(cnt, '/elastic/after_sample_monitor/', lc)
	      axis1=cnt(1:lc)//'time_of_flight'
	    else
	      call str_trim(cnt, ins(1:li)//'elastic_bank/', lc)
	      axis1=cnt(1:lc)//'time_binning'
	      axis2=cnt(1:lc)//'scattering_angle'
	    endif
	  endif
	  signal=cnt(1:lc)//'data'
	else ! any instrument
	  call str_trim(ins, '/nxentry/nxinstrument/', li)
	  call str_trim(cnt, ins(1:li)//'count_control/', lc)
	  axis1=' '
	  signal=cnt(1:lc)//'counts'
	endif
	call str_trim(mono, ins(1:li)//'monochromator/', lm)
	
	call dat_group(1, pv) ! importance level 1

	! the first column is a code (first letter of the instrument) saying that the item is present
	! a question mark is used for optional items

	call dat_nexus_r(pv,'DHFT M/owner')
	call dat_nexus_r(pv,'   T /nxentry/currentframenumber=frames')
	call dat_nexus_r(pv,'DHFTRCM/nxentry/title=Title')
	call dat_nexus_r(pv,'DHFTRCM/nxentry/start_time=Date')
	call dat_nexus_r(pv,'DHF   '//mono(1:lm)//'lambda')
	call dat_nexus_r(pv,'   T  '//mono(1:lm)//'wavelength')
	call dat_nexus_r(pv,'DH    /nxentry/sample/sample_name=sample')
	call dat_nexus_r(pv,'  FTRCM/nxentry/sample/name=sample')
	call dat_nexus_r(pv,'  FTRCM?/nxentry/sample/temperature=Temp')
	fvalue=0.0
	call dat_nexus_r(
	1  dat_nexus_putval,'DH    ?/nxentry/sample/temperature_mean=Temp')
	if (fvalue .ne. 0.0) then
	  call pv('Temp', fvalue)
	else
	  call dat_nexus_r(pv
	1               ,'DH TRC ?/nxentry/sample/sample_temperature=Temp')
	end if
	call dat_nexus_r(pv
	1               ,'DH  RC ?/nxentry/sample/temperature_stdDev=dTemp')
	call dat_nexus_r(pv,'DHFT  ?/nxentry/sample/magfield')
	call dat_nexus_r(pv,'    RC ?/nxentry/sample/magnetic_field')
	call dat_nexus_r(pv,'   T  /nxentry/sample/omega=om')
	call dat_nexus_r(pv,' H    ?/nxentry/sample/x_translation=stx')
	call dat_nexus_r(pv,' H    ?/nxentry/sample/y_translation=sty')
	call dat_nexus_r(pv,' H    ?/nxentry/sample/sample_stick_rotation=dom')
	call dat_nexus_r(pv,'DH    '//cnt(1:lc)//'two_theta_start=a4')

	call dat_group(2, pv) ! importance level 2

	call dat_nexus_r(pv,'D F   '//mono(1:lm)//'theta=a1')
	call dat_nexus_r(pv,'D FT  '//mono(1:lm)//'two_theta=a2')
	call dat_nexus_r(pv
	1             ,'DH   ?/nxentry/sample/sample_table_rotation=a3')
	call dat_nexus_r(pv,'DHFTRC ?/nxentry/sample/device_name')
	call dat_nexus_r(pv,'D     '//mono(1:lm)//'curvature=mcv')
	call dat_nexus_r(pv,'D     '//mono(1:lm)//'x_translation=mtx')
	call dat_nexus_r(pv,'D     '//mono(1:lm)//'y_translation=mty')
	call dat_nexus_r(pv,'D     '//mono(1:lm)//'phi=mgu')
	call dat_nexus_r(pv,'D     '//mono(1:lm)//'chi=mgl')
	call dat_nexus_r(pv,'DH    '//cnt(1:lc)//'countermode=Preset')
	call dat_nexus_r(pv,'  F   '//cnt(1:lc)//'count_mode=Preset')
	call dat_nexus_r(pv,'   T  '//cnt(1:lc)//'countmode=Preset')
	call dat_nexus_r(pv,'    RC /nxentry/control/mode=Preset')
	call dat_nexus_r(pv,'    RC /nxentry/control/preset=sMon')
	call dat_nexus_r(pv,'DHFT  ?'//cnt(1:lc)//'time')
	call dat_nexus_r(pv,'DHFT  '//cnt(1:lc)//'monitor=sMon')
	call dat_nexus_r(pv,'DHFT  '//cnt(1:lc)//'beam_monitor=bMon')
	call dat_nexus_r(pv,'D     '//cnt(1:lc)//'additional_monitor=aMon')
	call dat_nexus_r(pv,
	1  ' H    '//cnt(1:lc)//'radial_collimator_status=radcolstat')
	call dat_nexus_r(pv,
	1  ' H    '//cnt(1:lc)//'radial_collimator_type=radcol')
	call dat_nexus_r(pv,'DH    '//cnt(1:lc)//'proton_monitor=pMon')
	call dat_nexus_r(pv,'DH    /nxentry/sample/sample_mur=muR')
	call dat_nexus_r(pv,'   T  /nxentry/sample/chi')
	call dat_nexus_r(pv,'   T  /nxentry/sample/phi')
	call dat_nexus_r(pv,
	1  ' H    /nxentry/sample/sample_changer_position=chpos')
	call dat_nexus_r(pv,
	1  ' H    /nxentry/sample/sample_rotation_state=sarot')
	call dat_nexus_r(pv,'   T '//ins(1:li)//'detector2/two_theta=stt')
	call dat_nexus_r(pv,'   T ?'//ins(1:li)//'detector1/tilt=dg1')
	call dat_nexus_r(pv,'   T ?'//ins(1:li)//'detector2/tilt=dg2')
	call dat_nexus_r(pv,'   T ?'//ins(1:li)//'detector3/tilt=dg3')
	call dat_nexus_r(pv,'  F  /nxentry/end_time')
	call dat_nexus_r(pv
	1            ,' H    '//ins(1:li)//'Kollimator1/kollimator1=cex1')
	call dat_nexus_r(pv
	1            ,' H    '//ins(1:li)//'Kollimator1/kollimator2=cex2')
	call dat_nexus_r(pv
	1            ,' H    '//ins(1:li)//'exit_slit/width=d1w')
	call dat_nexus_r(pv
	1            ,' H    ?'//ins(1:li)//'beam_reduction/bottom=brbo')
	call dat_nexus_r(pv
	1            ,' H    ?'//ins(1:li)//'beam_reduction/left=brle')
	call dat_nexus_r(pv
	1            ,' H    ?'//ins(1:li)//'beam_reduction/right=brri')
	call dat_nexus_r(pv
	1            ,' H    ?'//ins(1:li)//'beam_reduction/top=brto')
	call dat_nexus_r(pv,' H    '//mono(1:lm)//'curvature_lower=mcvl')
	call dat_nexus_r(pv,' H    '//mono(1:lm)//'curvature_upper=mcvu')
	call dat_nexus_r(pv,' H    '//mono(1:lm)//'lift=mexz')
	call dat_nexus_r(pv,' H    '//mono(1:lm)//'omega_lower=moml')
	call dat_nexus_r(pv,' H    '//mono(1:lm)//'omega_upper=momu')
	call dat_nexus_r(pv,' H    '//mono(1:lm)//'vertical_tilt_upper=mgvu')
	call dat_nexus_r(pv,' H    '//mono(1:lm)//'paralell_tilt_upper=mgpu')

	call dat_group(3, pv) ! importance level 3
	call pv('Xaxis='//xaxis, 0.0)
	call pv('Yaxis='//yaxis, 0.0)

	if (axis1 .ne. ' ') then
	  call dat_nexus_get(axis1)
	  if (status .ne. NX_ok) then
	    print *,'axis ',axis1,' not found'
	    xlen=0
	  else
	    xlen=min(nmax,length)
	    if (icomp .gt. 1) then
	      stp=icomp
	      if (stp .lt. 1) stp = 1
	      xlen=dat_comp(0,0, p_array, xlen, 1, 1, 0.0
	1                   , stp, xlen/icomp,0)
	      call dat_copy2f(p_array, xx, xlen, 1)
	      do i=1,xlen
	        xx(i)=xx(i)/icomp
	      enddo
	    else
	      if (rank .eq. 2) then ! for rita: take 'from' window
	        if (sdate .gt. '2006-12-20') then ! new rita
	          if (from .ge. dim(1)) then
	            istart = 4
	          else
	            istart = (from - 1)
	          endif
	          xlen = dim(2)
	          call dat_extract(p_array, istart, dim(1), xx, xlen, 1)
	        else
	          if (from .ge. dim(2)) from = dim(2)
	          istart = dim(1) * (from - 1)
	          xlen = dim(1)
	          call dat_extract(p_array, istart, 1, xx, xlen, 1)
	        endif
	      else if (rank .eq. 1) then
	        call dat_copy2f(p_array, xx, xlen, 1)
	      else
	        xx(1)=0
	      endif
	    endif
	  endif
	else
	  xlen=0
	endif
	nread=0
	nset=0
70	if (n_monarray .ne. 0) then
	  call dat_nexus_get(monarray)
	  if (status .eq. NX_ok) then ! monitor array present
	    p_monarray(1)=p_array(1)
	    p_monarray(2)=p_array(2)
	    if (rank .eq. 1) then
	      n_monarray=dim(1)
	    else
	      print *,'illegal stroboscopic monitor dimension'
	      n_monarray=0
	    endif
	  endif
	endif        
	call dat_nexus_get(signal)
	if (status .ne. NX_ok) then
	  if (instr .eq. 'R') then
	    call dat_nexus_get('/nxentry/data/summed_counts')
	    axis2=' '
	  endif
	  if (status .ne. NX_ok) then
	    print *,'signal ',signal,' not found'
	    goto 999
	  endif
	endif
	if (rank .eq. 0) then
	  call dat_copy2p(p_array, fvalue)
	endif
	if (instr .eq. 'H') then
	  if (rank .ne. 2) then
	    axis2=' '
	    if (n_monarray .ne. 0) then
	      n_monarray=0
	    endif
	  endif
	endif
	if (axis2 .ne. ' ') then ! reduction axis
	  if (from .le. 0) then
	    if (to .eq. 0) to=999999
	    from=1
	  endif
	  if (to .lt. from) to=from
	  if (instr .eq. 'H' .or. xaxis .eq. 'x' .or. xaxis .eq. 'theta') then ! x on TriCS, theta on FOCUS
	    nsum=dim(1)
	    ngrp=1
	    nblk=dim(2)
	  else if (instr(1:1) .eq. 'R' .and. sdate .gt. '2006-12-20') then ! new rita
	    nsum=dim(1)
	    ngrp=1
	    nblk=dim(2)
	  else ! old rita or focus
	    nsum=dim(2)
	    ngrp=dim(1)
	    nblk=1
	  endif
	  if (from .gt. nsum) from=nsum
	  if (to .gt. nsum) to=nsum
	  if (from .eq. to) then
	    write(buf, '(9x,i7)') from
	  else
	    write(buf, '(i7,a,i7)') from,'..',to
	  endif
	  i=10
	  do while (buf(i:i) .eq. ' ')
	    i=i+1
	  enddo
	  buf(10:)=buf(i:)
	  i=1
	  do while (buf(i+1:i+1) .eq. ' ')
	    i=i+1
	  enddo
	  call pv('Range='//buf(i:), 0.0)
	  sta=(from+to)*0.5-1
          stp=to+1-from
	  length=dat_comp(2,0, p_array, nsum, ngrp, nblk
	1            , sta, stp, 1, p_weight)
	  if (n_monarray .gt. 0) then
	    i=dat_comp(0,0,p_monarray, nsum, ngrp, 1
	1         , sta, stp, 1, 0)
	    call dat_copy2f(p_monarray, weight, 1, 1)
	    if (ymon .ne. 0) then
	      weight = weight / ymon
	    endif
	  else
	    call dat_copy2f(p_weight, weight, 1, 1)
	  endif
	  if (icomp .gt. 1) then
	    stp=icomp
	    weight=weight*icomp
	    length=dat_comp(0,0, p_array, length,1,1,-0.5
	1	                ,stp,length/icomp,0)
	  endif
	else
	  weight=1
	endif
	if (nset .eq. 0) then
	  if (xlen .eq. 0) then
	    xlen=length
	    do i=1,length
	      xx(nread+i)=i
	    enddo
	  endif
	  if (length .ne. xlen) then
	    print *,'xaxis and signal length do not match', length, xlen
	  endif
	endif
	length=min(length,xlen)
	if (status .ne. NX_ok) then
	  print *,'signal ',signal,'not found'
	  goto 999
	endif
	if (length .gt. nmax) then
	  print *,'too large, data truncated from', length,' to',nmax
	  length=nmax
	endif
	call dat_copy2f(p_array, yy(nread+1), length, 1)
	if (ymon .eq. 0) ymon=1.
	totcnts=0.0
	ymon=ymon*weight
	do i=1,length
	  j=nread+i
	  totcnts=totcnts+yy(j)
	  ss(j)=sqrt(max(1.0,yy(j)))
	  ww(j)=ymon
	enddo
	if (nset .gt. 0) then
	  do i=1,length
	    xx(nread+i)=xx(i)
	  enddo
	endif
	nread=nread+length
	if (nframes .gt. 0 .and. iframe .le. 0) then
	  nset=nset+1
	  write(signal(1:10), '(a,i4.4)') '/frame',nset
	  if (nset .lt. nframes) goto 70
	  call fit_dat_table(1, 1, length)
	endif
	call dat_group(1, pv)
	call pv('Monitor', ymon)
	call pv('Counts', totcnts)
	i=NXclose(fileid)
	close(lun)
	call NXswitchReport(1)
!	call nxlistreport
	RETURN

999	i=NXclose(fileid)
	nread=-2
	call NXswitchReport(1)
!	call nxlistreport
	end


	subroutine dat_nexus_get(datapath)

	include 'dat_nexus.inc'

	character datapath*(*)
	
	character attr*64, nam*64, clss*64, low*64
	integer i, j, atype, l
	integer start0(32)/32*0/
        real*8 dvalue

	logical end_of_path
	byte idata(257)

	integer dat_nexus_getslab
	
	if (datapath(1:1) .ne. '/') then
	  status=NX_error
	  RETURN
	endif
	do while (path(1:lp) .ne. datapath(1:min(lp,len(datapath))))
	  ! go up in path
	  status=NXclosegroup(fileid)
	  lp=lp-1
	  do while (path(lp:lp) .ne. '/')
	    lp=lp-1
	    if (lp .lt. 1) then
	      lp=1
	      path='/'
	      status=NX_error
	      RETURN
	    endif
	  enddo
	enddo

	end_of_path=.false.
10	continue ! loop
	  i=index(datapath(lp+1:), '/')-1
	  if (i .lt. 0) then
	    if (lp .eq. 1) then ! get global attribute
	      ! assume global attributes are all of type char
	      type=NX_char
	      length=len(cdata)
	      axis_signal=0
	      units=' '
	      name=datapath(2:)
	      status=NXgetattr(fileid, name, idata, length, type)
	      if (status .ne. NX_ok) RETURN
	      type=NX_char
	      call replace_string(cdata, idata)
	      if (length .le. 0) then
	        cdata=' '
	        length=1
	      endif
	      call str_trim(cdata, cdata(1:length), length)
	      RETURN
	    endif
	    call str_trim(datapath(lp+1:), datapath(lp+1:), i)
	    end_of_path=.true.
	  endif
	  call str_lowcase(low, datapath(lp+1:lp+i))
	  status=NXinitgroupdir(fileid)
	  if (status .ne. NX_ok) RETURN
11	  status=NXgetnextentry(fileid, name, class, type)
	  do while (status .eq. NX_ok)
	    call str_lowcase(nam, name)
	    call str_lowcase(clss, class)
	    if (nam .eq. low .or. clss .eq. low) goto 12
	    if (low .eq. '*') then
	      if (nam .eq. xaxis) then
	        axis1=datapath(1:lp)//name
	        xaxis=name
	      else
	        status=NXopendata(fileid, name)
	        l=2
	        atype=NX_char
	        attr='axis'
	        status=NXgetattr(fileid, attr, axis_signal, l, atype)
	        if (status .eq. NX_ok
	1           .and. axis_signal .eq. ichar('1')
	1           .and. xaxis .eq. ' ') then
	          axis1=datapath(1:lp)//name
	          xaxis=name
	        endif
	      endif
	    endif
	    status=NXgetnextentry(fileid, name, class, type)
	  enddo
	  RETURN ! not found
12	  continue ! go down in path
	  if (end_of_path) goto 19
	  if (class .eq. 'SDS') goto 11 ! skip SDS when looking for groups
	  status=NXopengroup(fileid, name, class)
	  if (status .ne. NX_ok) RETURN
	  i=i+1
	  low(i:i)='/'
	  path(lp+1:)=low(1:i)
	  lp=lp+i
	  status=NXinitgroupdir(fileid)
	  i=index(datapath(lp+1:), '/')
	goto 10
19	continue ! open data
	status=NXopendata(fileid, name)
	if (status .ne. NX_ok) RETURN ! not found
	status=NXgetinfo(fileid, rank, dim, type)
	if (status .ne. NX_ok) goto 9
	if (rank .gt. 16) status=NX_error
	j=0
	length=1
	do i=1,rank
	  if (dim(i) .gt. 1) then
	    j=i
	    length=length*dim(i)
	  endif
	enddo
	rank0=rank
	if (j .eq. 0) then
	  dim(1)=1
	  rank=1
	else
	  rank=j
	endif
	if (rank .le. 1 .and. length .le. len(cdata) .and.
	1  (type .eq. nx_char .or.
	1   type .eq. nx_uint8 .or. type .eq. nx_int8)) then ! character (up to 256 chars)
	  type=nx_char
	  status=NXgetdata(fileid, idata)
	  if (status .ne. NX_ok) goto 9
	  call replace_string(cdata, idata)
	  call str_trim(cdata, cdata(1:length), length)
	elseif (rank .eq. 0) then ! scalar data
	  if (type .eq. nx_int32) then
	    status=NXgetdata(fileid, ivalue)
	    if (status .ne. NX_ok) goto 9
	    fvalue=ivalue
	  elseif (type .eq. nx_float32) then
	    status=NXgetdata(fileid, fvalue)
	    if (status .ne. NX_ok) goto 9
	  elseif (type .eq. nx_float64) then
	    dvalue = 0
	    status=NXgetdata(fileid, dvalue)
	    if (status .ne. NX_ok) goto 9
	    fvalue = dvalue
	  endif
	else
	  if (type .eq. nx_char) type=nx_uint8
	  status=dat_nexus_getslab(fileid, type, rank0, start0
	1                           , dim, p_array)
	  if (status .ne. NX_ok) goto 9
	endif
	status=NXgetnextattr(fileid, attr, l, atype)
	axis_signal=0
	units=' '
	do while (status .ne. NX_eod)
	  if (status .ne. NX_ok) goto 9
	  if (attr .eq. 'signal') then
	    axis_signal=-1
	  else if (attr .eq. 'axis') then
	    l=1
	    status=NXgetattr(fileid, attr, axis_signal, l, atype)
	  else if (attr .eq. 'units') then
	    l=len(units)
	    status=NXgetattr(fileid, attr, idata, l, atype)
	    call replace_string(cdata, idata)
	  endif	      
	  status=NXgetnextattr(fileid, attr, l, atype)
	enddo	    
	status=NXclosedata(fileid)
	RETURN

9	i=NXclosedata(fileid)
	end



	subroutine dat_nexus_r(pv, desc)

	include 'dat_nexus.inc'

	external pv
	character desc*(*)

	integer l,j,i
	character enam*64

	i=index(desc, '/')
	if (i .eq. 0) stop 'DAT_NEXUS_R: illegal descriptor'
	j=index(desc(1:i), instr)
	if (j .eq. 0) RETURN
	l=index(desc(i:), '=')
	if (l .eq. 0) then
	  call str_trim(desc, desc, l)
	  j=l
	  do while (desc(j:j) .ne. '/')
	    j=j-1
	  enddo
	  enam=desc(j+1:l)
	else
	  enam=desc(i+l:)
	  l=i+l-2
	endif
	call dat_nexus_get(desc(i:l))
	if (status .ne. NX_ok) then
	  ! optional items are marked with a question mark
	  if (index(desc(1:i), '?') .eq. 0) then
	    print *,'path ',desc(i:l),' not found'
	  endif
	else if (type .eq. nx_char) then
	  if (enam .eq. 'Date') then
	    sdate=cdata
	  endif
	  if (enam .eq. 'Preset') then
	    if (monitor .eq. 'auto') then
	      call str_lowcase(monitor, cdata)
	      if (monitor(1:1) .eq. 'm') then
	        monitor='smon'
	      else
	        monitor='time'
	      endif
	    endif
	  endif
	  call pv(enam//'='//cdata(1:length), 0.0)
	else if (type .eq. nx_int32 .or. type .eq. nx_float32 .or. type .eq. nx_float64) then
	  if (rank .gt. 0) call dat_nexus_average
	  if (enam .eq. 'frames' .and. nframes .gt. 0) then
	    nframes=nint(fvalue)
	  else
	    call pv(enam, fvalue)
	    call str_lowcase(enam, enam)
	    if (enam .eq. monitor) then
	      ymon=fvalue
	    endif
	  endif
	else
	  print *,enam,' has a strange type'
	  if (rank .gt. 0) then
	    call dat_copy2f(p_array, 0, 0, 1) ! free p_array
	  endif
	endif
	end

	subroutine dat_nexus_average

	include 'dat_nexus.inc'

	integer l
	integer dat_comp
	external dat_comp

	l=dat_comp(0,0,p_array,length,1,1,(length-1)*0.5,length*1.0,1,0)
	call dat_copy2f(p_array, fvalue, 1, 1)
	fvalue=fvalue/length
	end

	subroutine dat_nexus_putval(name, value)

	character name*(*)
	real value
	end