pro fitsrd,ifile,data,hdr
@fits_setup
;+
; NAME:
;	FITSRD
; PURPOSE:
;	READS FITS FORMAT DATA FROM A FILE
;	INTO HEADER AND DATA OUTPUT VARIABLES
; CATEGORY:
;	DATA INPUT/OUTPUT
; CALLING SEQUENCE:
;	FITSRD,ifile,DATA,HDR
; INPUTS:
;	Input file ifile must be present
; OPTIONAL INPUT PARAMETERS:
;
; KEYWORD PARAMETERS:
;
; OUTPUTS:
;	Data is the name of the output structure containing FITS
;	  data.  
; OPTIONAL OUTPUT PARAMETERS:
;	NONE
; COMMON BLOCKS:
;	NONE
; SIDE EFFECTS:
;	NONE
; RESTRICTIONS:
;	Data is assumed to be compatible with FITS formats for BYTE,
;	  INTEGER*2, and INTEGER*4 data types.  This has not yet been tested.
; PROCEDURE:
;	FITSRD,ifile,Data,Hdr
;	User is prompted for the name of the file to be read.  If the keyword
;	'SIMPLE =' with a value of 'T' or 'F' is not found, the message 'This
;	is not a FITS FORMAT File' is printed, and no values are returned.
;	If 'SIMPLE = F', a warning message is printed, but no automatic termin-
;	ation is applied (in deference to AAT FITS tapes which write out data
;	in REAL*4 format).
;	Degenerate (NAXIS=0) FITS files are supported.
; MODIFICATION HISTORY:
;	Modified Sep 1992 IZ. Modified for hdr to be bytarr & use getfitsval.
;	Modified Jan 1991 PNM. Fixed bug when 'END' appeard not at start of
;	line.
;	Modified Oct 1990, PNM.  Hack for 3D data. Hack for real data.
;	Modified Jan 1990, PNM.  Split interactive and non interactive
;	portions of FITSRD2.
;	Written JUNE 1988 EMH.  Uses function YESNO and procedure GET_KEYWORD.
;	Also uses function DECI-STR.
;-
if (n_params() eq 0) or (n_params() gt 3) then begin
	print,'Usage: fitsrd,ifile,data,hdr'
	return
	endif
ans='' & filename=''				;declare variables as strings
hdr=replicate(32b,80,36)			;create a blank hdr array
on_ioerror,finish
	openr,lun,ifile,/get_lun		;open file
	forrd,lun,hdr				;read hdr
	if (getfitsval(hdr,'simple') ne 'T') then begin
		if (getfitsval(hdr,'simple') eq 'F') then $
		 print,'WARNING: This is not a STANDARD FORMAT FITS tape' else $
	 	 begin
		   print,'THIS IS NOT A FITS TAPE'
		   goto,STOP
		   endelse
		 endif
; Modified 8 July 1988 to identify end of header with simple END in 1st 3 cols
	while (find_key(hdr,'END') lt 0) do begin ;continue to read hdr until END
	  hdr2=replicate(32b,80,36)
	  forrd,lun,hdr2
	  hdr=transpose([transpose(hdr),transpose(hdr2)]) ;concatenate subseq. hdr records
	endwhile
;--------------------------------------------------------------------------
	nx=getfitsval(hdr,'naxis1')
	ny=getfitsval(hdr,'naxis2')
	nz=getfitsval(hdr,'naxis3')
        if nz ne 0 then begin
	  case (getfitsval(hdr,'bitpix')) of 
		'8': data=bytarr(nx,ny,nz)
		'16': data=intarr(nx,ny,nz)
		'-32': data=fltarr(nx,ny,nz)
		'-64': data=dblarr(nx,ny,nz)
		endcase
	endif else begin
; Hack for 1D data
	if ny ne 0 then begin
	  case (getfitsval(hdr,'bitpix')) of 
		'8': data=bytarr(nx,ny)
		'16': data=intarr(nx,ny)
		'32': data=lonarr(nx,ny)
		'-32': data=fltarr(nx,ny)
		'-64': data=dblarr(nx,ny)
		endcase
	endif else begin
	  case (getfitsval(hdr,'bitpix')) of 
		'8': data=bytarr(nx)
		'16': data=intarr(nx)
		'32': data=lonarr(nx)
		'-32': data=fltarr(nx)
		'-64': data=dblarr(nx)
		endcase
	endelse
	endelse
	forrd,lun,data
;
; Correct fits format words to internal  format
	if fits_swap eq 1 then data=swabi(data)
;		check whether BSCALE or BZERO are present
	bsc=getfitsval(hdr,'BSCALE')
	if strlen(bsc) gt 0 then $
		if deci_str(bsc) then data=float(bsc)*data else $
			data=bsc*data
	bzr=getfitsval(hdr,'BZERO')
	if strlen(bzr) gt 0 then $
		if deci_str(bzr) then data=float(bzr)+data else $
			data=bzr + data
STOP:   free_lun,lun
	return
finish: print,'File not found or not fits format'

	return
	end

