FUNCTION headfits, filename, exten = exten ;+ ; Project : SOHO - CDS ; ; Name : HEADFITS() ; ; Purpose : Read a FITS file header record ; ; Explanation : Reads a FITS file header record. ; ; Use : Result = headfits( filename ,[ EXTEN = ]) ; ; Example: Read the FITS header of a file 'test.fits' into a ; string variable, h ; ; IDL> h = headfits( 'test.fits') ; ; Inputs : FILENAME = String containing the name of the FITS file to be ; read. ; ; Opt. Inputs : None. ; ; Outputs : Result of function = FITS header, string array ; ; Opt. Outputs: None. ; ; Keywords : EXTEN = integer scalar, specifying which FITS extension to ; read. For example, to read the header of the first ; extension set EXTEN = 1. Default is to read the ; primary FITS header (EXTEN = 0). ; ; Calls : SXPAR ; ; Common : None. ; ; Restrictions: None. ; ; Side effects: None. ; ; Category : Utilities, FITS. ; ; Prev. Hist. : ; adapted by Frank Varosi from READFITS by Jim Wofford, January, 24 1989 ; Keyword EXTEN added, K.Venkatakrishna, May 1992 ; Make sure first 8 characters are 'SIMPLE' W. Landsman October 1993 ; ; Written : Frank Varosi, GSFC, 24 January 1989 ; ; Modified : Version 1, Liyun Wang, GSFC/ARC, September 19, 1994 ; Incorporated into CDS library ; Version 2, William Thompson, GSFC/ARC, 9 January 1995 ; Incorporated following change: ; Check PCOUNT and GCOUNT W. Landsman December 1994 ; ; Version 3, CDP, 17-nov-95 ; Search for file in standard CDS fits directory ; or current and stop it crashing if file not found. ; ; Version 4, CDP, 21-Nov-95 ; Make input file spec a scalar. ; ; Version : Version 4, 21 November 1995 ;- ; On_error,2 if N_params() LT 1 then begin print,'Sytax - header = headfits( filename, [ EXTEN = ]) return, -1 end ; ; add standard CDS FITS directory if nothing given ; break_file,filename,disk,dir,f,ext if dir eq '' then begin ffile = concat_dir('$CDS_FITS_DATA',filename) endif else begin ffile = filename endelse ; ; if not there, try current directory ; if not file_exist(ffile) then begin ffile = filename if not file_exist(ffile) then begin print,'Cannot find file in $CDS_FITS_DATA or current directory.' return,'' endif endif ; ; only allow one file at a time ; ffile = ffile(0) ; Open file and read header information openr,unit,ffile, /GET_LUN, /BLOCK file = fstat(unit) y = indgen(36*8) y2 = y - 8*(y/8) + 80*(y/8) offset = 0 extn = 0 START: r = 0 hdr = assoc(unit, bytarr(80,36), offset) ; Read header one record at a time nbytesleft = file.size - offset if nbytesleft LT 2880 then $ message,' No such extension, End of file reached' LOOP: x = hdr(r) nbytesleft = nbytesleft - 2880 name = string( x(y2) ) ;Get first 8 char of each line if (r EQ 0) and (extn EQ 0) then $ if strmid(name,0,8) NE 'SIMPLE ' then begin free_lun, unit ;Added Mar 94 message, $ 'ERROR - FITS header missing required "SIMPLE" in first 8 chars' endif pos = strpos( name, 'END ' ) if r EQ 0 then header = string(x) else header = [header,string(x)] if (pos lt 0) then begin r = r + 1 goto, LOOP endif lastline = 36*r + pos / 8 header = header(0:lastline) ; IF extension, get the size of the ; data. Find no of records to skip If keyword_set(EXTEN) then begin bitpix = sxpar( header, 'BITPIX') naxis = sxpar( header, 'NAXIS') gcount = sxpar( header, 'GCOUNT') if gcount EQ 0 then gcount = 1 pcount = sxpar( header, 'PCOUNT') if naxis GT 0 then begin Nax = sxpar( header, 'NAXIS*' ) ; Read NAXES ndata = nax(0) if naxis GT 1 then for i = 2, naxis do ndata = ndata*nax(i-1) endif else ndata = 0 nbytes = (abs(bitpix)/8) * gcount * (pcount + ndata) nrec = long(( nbytes +2879)/ 2880) point_lun, -unit, pointlun pointlun = pointlun + nrec*2880L point_lun,unit,pointlun offset = pointlun extn = extn + 1 if (extn LE EXTEN) then goto, START endif free_lun, unit return, header end