pro fits_open,filename,fcb,write=write,append=append,update=update, $
no_abort=no_abort,message=message,hprint=hprint,fpack=fpack
;+
; NAME:
; FITS_OPEN
;
; PURPOSE:
; Opens a FITS (Flexible Image Transport System) data file.
;
; EXPLANATION:
; Used by FITS_READ and FITS_WRITE
;
; CALLING SEQUENCE:
; FITS_OPEN, filename, fcb
;
; INPUTS:
; filename : name of the FITS file to open, scalar string
; FITS_OPEN can also open gzip compressed (.gz) file *for
; reading only*, although there is a performance penalty
; FPACK ( http://heasarc.gsfc.nasa.gov/fitsio/fpack/ )
; compressed FITS files can be read provided that the FPACK
; software is installed.
;*OUTPUTS:
; fcb : (FITS Control Block) a IDL structure containing information
; concerning the file. It is an input to FITS_READ, FITS_WRITE
; FITS_CLOSE and MODFITS.
; INPUT KEYWORD PARAMETERS:
; /APPEND: Set to append to an existing file.
; /FPACK - Signal that the file is compressed with the FPACK software.
; http://heasarc.gsfc.nasa.gov/fitsio/fpack/ ) By default,
; FITS_OPEN assumes that if the file name extension ends in
; .fz that it is fpack compressed. The FPACK software must
; be installed on the system
; /HPRINT - print headers with routine HPRINT as they are read.
; (useful for debugging a strange file)
; /NO_ABORT: Set to quietly return to calling program when an I/O error
; is encountered, and return a non-null string
; (containing the error message) in the keyword MESSAGE.
; If /NO_ABORT not set, then FITS_OPEN will display the error
; message and return to the calling program.
; /UPDATE Set this keyword to open an existing file for update
; /WRITE: Set this keyword to open a new file for writing.
;
; OUTPUT KEYWORD PARAMETERS:
; MESSAGE = value: Output error message. If the FITS file was opened
; successfully, then message = ''.
;
; NOTES:
; The output FCB should be passed to the other FITS routines (FITS_OPEN,
; FITS_READ, FITS_HELP, and FITS_WRITE). It has the following structure
; when FITS_OPEN is called without /WRITE or /APPEND keywords set.
;
; FCB.FILENAME - name of the input file
; .UNIT - unit number the file is opened to
; .FCOMPRESS - 1 if unit is a FPACK compressed file opened with
; a pipe to SPAWN
; .NEXTEND - number of extensions in the file.
; .XTENSION - string array giving the extension type for each
; extension.
; .EXTNAME - string array giving the extension name for each
; extension. (null string if not defined the extension)
; .EXTVER - vector of extension version numbers (0 if not
; defined)
; .EXTLEVEL - vector of extension levels (0 if not defined)
; .GCOUNT - vector with the number of groups in each extension.
; .PCOUNT - vector with parameter count for each group
; .BITPIX - BITPIX for each extension with values
; 8 byte data
; 16 short word integers
; 32 long word integers
; -32 IEEE floating point
; -64 IEEE double precision floating point
; .NAXIS - number of axes for each extension. (0 for null data
; units)
; .AXIS - 2-D array where axis(*,N) gives the size of each axes
; for extension N
; .START_HEADER - vector giving the starting byte in the file
; where each extension header begins
; .START_DATA - vector giving the starting byte in the file
; where the data for each extension begins
;
; .HMAIN - keyword parameters (less standard required FITS
; keywords) for the primary data unit.
; .OPEN_FOR_WRITE - flag (0= open for read, 1=open for write,
; 2=open for update)
; .LAST_EXTENSION - last extension number read.
; .RANDOM_GROUPS - 1 if the PDU is random groups format,
; 0 otherwise
; .NBYTES - total number of (uncompressed) bytes in the FITS file
;
; When FITS open is called with the /WRITE or /APPEND option, FCB
; contains:
;
; FCB.FILENAME - name of the input file
; .UNIT - unit number the file is opened to
; .NEXTEND - number of extensions in the file.
; .OPEN_FOR_WRITE - flag (1=open for write, 2=open for append
; 3=open for update)
;
;
; EXAMPLES:
; Open a FITS file for reading:
; FITS_OPEN,'myfile.fits',fcb
;
; Open a new FITS file for output:
; FITS_OPEN,'newfile.fits',fcb,/write
; PROCEDURES USED:
; GET_PIPE_FILESIZE (for Fcompress'ed files) HPRINT, SXDELPAR, SXPAR()
; HISTORY:
; Written by: D. Lindler August, 1995
; July, 1996 NICMOS Modified to allow open for overwrite
; to allow primary header to be modified
; DJL Oct. 15, 1996 corrected to properly extend AXIS when more
; than 100 extensions present
; Converted to IDL V5.0 W. Landsman September 1997
; Use Message = '' rather than !ERR =1 as preferred signal of normal
; operation W. Landsman November 2000
; Lindler, Dec, 2001, Modified to use 64 bit words for storing byte
; positions within the file to allow support for very large
; files
; Work with gzip compressed files W. Landsman January 2003
; Fix gzip compress for V5.4 and earlier W.Landsman/M.Fitzgerald Dec 2003
; Assume since V5.3 (STRSPLIT, OPENR,/COMPRESS) W. Landsman Feb 2004
; Treat FTZ extension as gzip compressed W. Landsman Sep 2004
; Assume since V5.4 fstat.compress available W. Landsman Apr 2006
; FCB.Filename now expands any wildcards W. Landsman July 2006
; Make ndata 64bit for very large files B. Garwood/W. Landsman Sep 2006
; Open with /SWAP_IF_LITTLE_ENDIAN, remove obsolete keywords to OPEN
; W. Landsman Sep 2006
; Warn that one cannot open a compressed file for update W.L. April 2007
; Use post-V6.0 notation W.L. October 2010
; Support FPACK compressed files, new .FCOMPRESS tag to FCB structure
; W.L. December 2010
; Read gzip'ed files even if gzip is not installed W.L. October 2012
;-
;--------------------------------------------------------------------
compile_opt idl2
; if no parameters supplied, print calling sequence
;
if N_params() LT 1 then begin
print,'Syntax - FITS_OPEN, filename, fcb'
print,' Input Keywords: /Append, /Hprint, /No_abort, /Update, /Write'
print,' Output Keyword: Message= '
return
endif
;
; set default keyword parameters
;
message = ''
open_for_read = 1
open_for_update = 0
open_for_write = 0
open_for_overwrite = 0
if keyword_set(write) then begin
open_for_read = 0
open_for_update = 0
open_for_write = 1
open_for_overwrite = 0
end
if keyword_set(append) then begin
open_for_read = 0
open_for_write = 0
open_for_update = 1
open_for_overwrite = 0
end
if keyword_set(update) then begin
open_for_read = 1
open_for_write = 0
open_for_update = 0
open_for_overwrite = 1
end
;
; on I/O errors goto statement ioerror:
;
on_ioerror,ioerror
;
; open file
;
ext = strlowcase(strmid(filename, 2, /rev))
docompress = (ext EQ '.gz') || (ext EQ 'ftz')
fcompress = keyword_set(fpack) || ( ext EQ '.fz')
if docompress && open_for_overwrite then begin
message = 'Compressed FITS files cannot be open for update'
if ~keyword_set(no_abort) then $
message,' ERROR: '+message,/CON
return
endif
;
; open file
;
if ~fcompress then get_lun,unit
if fcompress then $
spawn,'funpack -S ' + filename, unit=unit,/sh else $
if docompress then $
openr,unit,filename, /compress,/swap_if_little else begin
case 1 of
keyword_set(append): openu,unit,filename,/swap_if_little
keyword_set(update): openu,unit,filename,/swap_if_little
keyword_set(write) : openw,unit,filename,/swap_if_little
else : openr,unit,filename,/swap_if_little
endcase
endelse
file = fstat(unit)
fname = file.name ;In case the user input a wildcard
docompress = file.compress
; Need to spawn to "gzip -l" to get the number of uncompressed bytes in a gzip
; compressed file. If gzip doesn't work for some reason then use
; get_pipe_filesize.
if fcompress then begin
get_pipe_filesize,unit, nbytes_in_file
free_lun,unit
spawn,'funpack -S ' + filename, unit=unit,/sh
endif else if docompress then begin
if !VERSION.OS_FAMILY Eq 'Windows' then $
fname = file_search(fname,/fully_qualify)
spawn,'gzip -l ' + fname, output
output = strtrim(output,2)
g = where(strmid(output,0,8) EQ 'compress', Nfound)
if Nfound EQ 0 then begin
get_pipe_filesize, unit, nbytes_in_file
close,unit
openr,unit,filename, /compress,/swap_if_little
endif else $
nbytes_in_file = long64((strsplit(output[g[0]+1],/extract))[1])
endif else nbytes_in_file = file.size
;
; create vectors needed to store header information for each extension
;
n = 100
xtension = strarr(n)
extname = strarr(n)
extver = lonarr(n)
extlevel = lonarr(n)
gcount = lonarr(n)
pcount = lonarr(n)
bitpix = lonarr(n)
naxis = lonarr(n)
axis = lonarr(20,n)
start_header = lon64arr(n) ; starting byte in file for header
start_data = lon64arr(n) ; starting byte in file for data
position = 0ULL ; current byte position in file
skip = 0ULL ; Amount to skip from current position
;
; read and process each header in the file if open for read or update
;
extend_number = 0 ; current extension number being
; processed
if open_for_read || open_for_update then begin
main_header = 1 ; first header in file flag
h = bytarr(80,36,/nozero) ; read buffer
;
; loop on headers in the file
;
repeat begin
if skip GT 0 then if fcompress then mrd_skip,unit,skip else $
point_lun,unit,position
start = position
;
; loop on header blocks
;
first_block = 1 ; first block in header flag
repeat begin
if ~fcompress && position+2879 ge nbytes_in_file then begin
if extend_number eq 0 then begin
message = 'EOF encountered while reading header'
goto,error_exit
endif
print,'EOF encountered reading extension header'
print,'Only '+strtrim(extend_number-1,2) + $
' extensions processed'
goto,done_headers
endif
readu,unit,h
position = position + 2880
hdr = string(h>32b)
endline = where(strmid(hdr,0,8) eq 'END ',nend)
if nend gt 0 then hdr = hdr[0:endline[0]]
if first_block then begin
;
; check for valid header (SIMPLE keyword must be first for PDU and
; XTENSION keyword for the extensions.
;
header = hdr
keyword = strmid(header[0],0,8)
if (extend_number eq 0) && $
(keyword ne 'SIMPLE ') then begin
message = 'Invalid header, no SIMPLE keyword'
goto,error_exit
endif
if (extend_number gt 0) && $
(keyword ne 'XTENSION') then begin
print,'Invalid extension header encountered'
print,'XTENSION keyword missing'
print,'Only '+strtrim(extend_number-1,2) + $
' extensions processed'
goto,done_headers
endif
end else header = [header,hdr]
first_block = 0
end until (nend gt 0)
;
; print header if hprint set
;
if keyword_set(hprint) then hprint,header
;
; end of loop on header blocks
;
; Increase size of vectors if needed
;
if extend_number ge n then begin
xtension = [xtension,strarr(n)]
extname = [extname,strarr(n)]
extver = [extver,lonarr(n)]
extlevel = [extver,lonarr(n)]
gcount = [gcount,lonarr(n)]
pcount = [pcount,lonarr(n)]
bitpix = [bitpix,lonarr(n)]
naxis = [naxis,lonarr(n)]
old_axis = axis
axis = lonarr(20,n*2)
axis[0,0] = old_axis
start_header = [start_header,lonarr(n)]
start_data = [start_data,lonarr(n)]
n = n*2
end
;
; extract information from header
;
xtension[extend_number] = strtrim(sxpar(header,'xtension'))
st = sxpar(header,'extname', Count = N_extname)
if N_extname EQ 0 then st = ''
extname[extend_number] = strtrim(st,2)
extver[extend_number] = sxpar(header,'extver')
extlevel[extend_number] = sxpar(header,'extlevel')
gcount[extend_number] = sxpar(header,'gcount')
pcount[extend_number] = sxpar(header,'pcount')
bitpix[extend_number] = sxpar(header,'bitpix')
nax = sxpar(header,'naxis')
naxis[extend_number] = nax
if nax gt 0 then begin
naxisi = sxpar(header,'naxis*')
axis[0,extend_number] = naxisi
ndata = product(naxisi,/integer)
endif else ndata = 0
start_data[extend_number] = position
start_header[extend_number] = start
;
; if first header, save without FITS required keywords
;
if extend_number eq 0 then begin
hmain = header
random_groups = sxpar(header,'groups')
sxdelpar,hmain,['SIMPLE','BITPIX','NAXIS','NAXIS1', $
'NAXIS2','NAXIS3','NAXIS4','NAXIS5', $
'NAXIS6','NAXIS7','NAXIS8','EXTEND', $
'PCOUNT','GCOUNT','GROUPS','BSCALE', $
'BZERO','NPIX1','NPIX2','PIXVALUE']
if (pcount[0] gt 0) then for i=1,pcount[0] do $
sxdelpar,hmain,['ptype','pscal','pzero']+strtrim(i,2)
endif
;
; skip past data to go to next header
;
nbytes = (abs(bitpix[extend_number])/8) * $
(gcount[extend_number]>1)*(pcount[extend_number] + ndata)
skip = (nbytes + 2879)/2880*2880
position += skip
;
; end loop on headers
;
extend_number += 1
end until (position ge nbytes_in_file-2879)
end
;
; point at end of file in /extend
;
done_headers:
if open_for_update then point_lun,unit,nbytes_in_file
;
; number of extensions
;
if open_for_write then nextend = -1 $
else nextend = extend_number - 1
;
; set up blank hmain if open for write
;
if open_for_write then begin
hmain = strarr(1)
hmain[0] = 'END '
end
;
; create output structure for the file control block
;
if open_for_write or open_for_update then begin
fcb = {filename:fname,unit:unit,nextend:nextend, $
open_for_write:open_for_write + open_for_update*2}
end else begin
nx = nextend
fcb = {filename:fname,unit:unit,fcompress:fcompress, $
nextend:nextend, $
xtension:xtension[0:nx],extname:extname[0:nx], $
extver:extver[0:nx],extlevel:extlevel[0:nx], $
gcount:gcount[0:nx],pcount:pcount[0:nx], $
bitpix:bitpix[0:nx],naxis:naxis[0:nx], $
axis:axis[*,0:nx], $
start_header:start_header[0:nx], $
start_data:start_data[0:nx],hmain:hmain, $
open_for_write:open_for_overwrite*3,$
last_extension:-1, $
random_groups:random_groups, $
nbytes: nbytes_in_file }
end
if fcompress then begin
free_lun,unit
spawn,'funpack -S ' + filename, unit=unit,/sh
endif
!err = 1 ;For obsolete users still using !err
return
;
; error exit
;
ioerror:
message = !ERROR_STATE.msg
error_exit:
free_lun,unit
!err = -1
if keyword_set(no_abort) then return
message,' ERROR: '+message,/CON
return
end