FUNCTION cdsheadfits, file_in, exten = exten On_error,2 if N_params() LT 1 then begin print,'Sytax - header = headfits( filename, [ EXTEN = ]) return, '' end ; ; check filename doesn't already have .Z or .gz appended ; case 1 of strpos(file_in,'.Z') ge 0: filename = strmid(file_in,0,strlen(file_in)-2) strpos(file_in,'.gz') ge 0: filename = strmid(file_in,0,strlen(file_in)-3) else: filename = file_in endcase ; ; pasted from READCDSFITS code ; use_file = find_with_def(filename,'$CDS_FITS_DATA','.fits',/reset) ;; Compressed files? if use_file EQ '' then BEGIN ;; If we have nowhere to write a decompressed file, skip looking for ;; compressed ones.. skip decompression for non-unix systems as well. write_dir = getenv("CDS_FITS_TEMP_W") IF os_family() NE 'unix' THEN BEGIN txt = "Can't find FITS file" print,txt return,-1 END ;; Check various compressed formats. In case the file name already ;; contains the .fits extension, don't add another one. On the other ;; hand, we won't disallow *other* extensions being supplied/used, nor ;; will we disallow a dot inside the file name, so we shouldn't ;; break_file and then assemble it with .fits... zips = ['.Z','.gz'] unzips = ['uncompress -c ','gunzip -c '] IF strpos(strupcase(filename),'.FITS') EQ -1 THEN BEGIN zips = ['.fits'+zips, zips] unzips = [unzips,unzips] END nzips = n_elements(zips) FOR zipno = 0,nzips-1 DO BEGIN print,'Cannot find, will check for filename + '+zips(zipno) use_file = find_with_def(filename,'$CDS_FITS_DATA',zips(zipno)) IF use_file EQ '' AND zipno EQ nzips-1 THEN BEGIN txt = 'No compressed file found either' print,txt IF usestatus THEN status = txt return,-1 END ELSE IF use_file NE '' THEN BEGIN ;; Found a compressed file - now figure out how to decompress it break_file,use_file,disk,dir,filnam,ext new_use_file = concat_dir(write_dir,filnam+".fits") unzip = unzips(zipno)+use_file+" > "+new_use_file print,unzip spawn,"umask 002 ; "+unzip IF NOT test_open(new_use_file) THEN BEGIN txt = 'Decompression of compressed fits file failed' IF usestatus THEN status = txt print,txt return,-1 END use_file = new_use_file PRINT,"Trying to read "+new_use_file IF write_dir EQ '' THEN delete_after_read = 1 GOTO,try_read END ENDFOR txt = "Can't find FITS file" IF usestatus THEN status = txt print,txt return,-1 ENDIF try_read: ; Open file and read header information openr,unit,use_file, /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 begin print,' No such extension, End of file reached' return,'' endif 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 print, $ 'ERROR - FITS header missing required "SIMPLE" in first 8 chars' return,'' 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 IF keyword_set(delete_after_read) THEN rm_file,use_file return, header(sort(header)) end