pro calfos_rd,name,h,data,gpar,eps,pattern,config
;+
;			calfos_rd
;
; Routine to read fos .d0h file
;
; CALLING SEQUENCE:
;	calfos_rd,name,h,data,gpar,eps,pattern,config
;
; INPUTS:
;	name - file name
;
; OUTPUTS:
;	h - FITS header
;	data - data array [ns x ysteps x (nreads*slices)]
;	gpar - group parameter blocks
;	eps - data quality array
;	pattern - vector of pattern keyword values
;	config - string vector of configuration parameters
; 
; HISTORY:
;	version 1.0  D. Lindler  Jan 1990
;	version 1.1  D. Neill	 Nov 1990 - added kludge to skip opening
;		*.q0h/*.q0d files if data quality corr not enabled.
;	version 1.2  D. Neill	 Aug 1991 - checks for binary search and
;		does not change YPOS group params in that case.
;	version 1.3  D. Neill	 Mar 1992 - reads only data from .d0h file
;-
;-------------------------------------------------------------
;
; open input files
;
	fname = strtrim(name,2)+'.d0h'		;data file
	sxopen,1,fname,h

;
; get sizes
;
	gcount = sxpar(h,'gcount',fname)
	psize = sxpar(h,'psize',fname)
	naxis = sxpar(h,'naxis',fname)
	naxis1 = sxpar(h,'naxis1',fname)
	if naxis eq 2 then naxis2 = sxpar(h,'naxis2',fname) else naxis2 = 1
	slices = sxpar(h,'slices',fname)
	ysteps = sxpar(h,'ysteps',fname)
	nxsteps = sxpar(h,'nxsteps',fname)
	overscan = sxpar(h,'overscan',fname)
	fchnl = sxpar(h,'fchnl',fname)
	nchnls = sxpar(h,'nchnls',fname)
	ybase = sxpar(h,'ybase',fname)
	if ybase gt 32767 then ybase = ybase - 65536	;TRW strikes again
	yrange = sxpar(h,'yrange',fname)
	ns_per_xstep = overscan-1+nchnls
	ns = ns_per_xstep*nxsteps
	detector = sxpar(h,'detector',fname)
	aper_id = sxpar(h,'aper_id',fname)
	polar_id = strtrim(sxpar(h,'polar_id',fname))
	fgwa_id = sxpar(h,'fgwa_id',fname)
	ystep1 = sxpar(h,'ystep1',fname)
	ystep2 = sxpar(h,'ystep2',fname)
	ystep3 = sxpar(h,'ystep3',fname)
;
; verify data size with pattern information
;
	if ((naxis eq 1) and (naxis1 ne ns*slices*ysteps)) or $
	   ((naxis eq 2) and (naxis1 ne ns) and (naxis2 ne ysteps)) or $
	   (naxis gt 2) then begin
		print,'Header AXIS information not compatible with pattern' + $
			' information'
		retall
	endif
;
; create output array
;
	sg=slices*gcount
	data = fltarr(ns,ysteps,sg)
	if n_params(0) gt 4 then eps = fltarr(ns,ysteps,sg)
	gpar = bytarr(psize/8,ysteps,sg)
;
; loop on groups
;
	for i=0,gcount-1 do begin
		d = float(sxread(1,i,par))
		for slice = 0,slices-1 do for ystep=0,ysteps-1 do $
			gpar(0,ystep,i>slice) = par
		data(0,0,i*slices) = float(d,0,ns,ysteps,slices) ; reformat

	end
;
; create pattern vector
;
	if n_params(0) gt 5 then begin
		pattern = intarr(11)
		pattern(0) = fchnl
		pattern(1) = nchnls
		pattern(2) = overscan
		pattern(3) = nxsteps
		pattern(4) = ybase
		pattern(5) = yrange
		pattern(6) = ysteps
		pattern(7) = ns_per_xstep
		pattern(8) = ns
		pattern(9) = slices
		pattern(10) = gcount
	endif
;
; create configuration vector
;
	if n_params(0) gt 6 then begin
		config = strarr(8)
		config(0) = detector
		config(1) = aper_id
		config(2) = polar_id
		config(3) = fgwa_id
		config(4) = ystep1
		config(5) = ystep2
		config(6) = ystep3
	
		for i=0,6 do config(i) = strupcase(config(i))
;
; is it a paired aperture
;
		paired = ['C-1','A-2','A-3','A-4']
		for i=0,3 do if strtrim(aper_id) eq paired(i) then $
				config(7)='PAIR'
	endif
;
; is it a binary search
;
	if total(sxgpar(h,gpar,'YPOS')) eq 0. $
		then not_binary_search = (1 eq 1) $
		else not_binary_search = (1 eq 0)
;
; fill in some of the group parameter info.
;
	par = gpar(*,0,0)
	v = sxgpar(h,par,'PASS_DIR',type1,sbyte1)
	if polar_id eq 'C' then passd = byte(0L,0,4) $
			   else passd = byte((ystep<1) + 1L,0,4)
	v = sxgpar(h,par,'YPOS',type2,sbyte2)
	v = sxgpar(h,par,'YTYPE',type3,sbyte3)
	paired = strtrim(config(7))
	if paired eq 'PAIR' then not_paired=0 else not_paired=1
	if not_paired then begin
		single = byte('SINGLE  ')
		v = sxgpar(h,par,'APER_POS',type4,sbyte4)
	end
	for i = 0,gcount-1 do begin
	  for slice = 0,slices-1 do begin
	    frame = i*slices+slice
	    for ystep = 0,ysteps-1 do begin
;
;	YTYPE
;
		if ysteps gt 3 then ytype = 'OBJ ' $
			       else ytype=strmid(config(4+ystep),0,4)
		gpar(sbyte3,ystep,frame) = byte(ytype)
;
;	YPOS
;
		if not_binary_search then gpar(sbyte2,ystep,frame) = $
			byte(yrange*32.0/ysteps*ystep + ybase,0,4)
;
;	PASS_DIR
;
		gpar(sbyte1,ystep,frame) = passd
;
; 	APER_POS
;
		if not_paired then gpar(sbyte4,ystep,frame) = single
	    endfor
	  endfor
	endfor
return
end