| 1 |
pro fits_info, filename, SILENT=silent,TEXTOUT=textout, N_ext=n_ext, extname=extname |
| 2 |
;+ |
| 3 |
; NAME: |
| 4 |
; FITS_INFO |
| 5 |
; PURPOSE: |
| 6 |
; Provide information about the contents of a FITS file |
| 7 |
; EXPLANATION: |
| 8 |
; Information includes number of header records and size of data array. |
| 9 |
; Applies to primary header and all extensions. Information can be |
| 10 |
; printed at the terminal and/or stored in a common block |
| 11 |
; |
| 12 |
; This routine is mostly obsolete, and better results can be usually be |
| 13 |
; performed with FITS_HELP (for display) or FITS_OPEN (to read FITS |
| 14 |
; information into a structure) |
| 15 |
; |
| 16 |
; CALLING SEQUENCE: |
| 17 |
; FITS_INFO, Filename, [ /SILENT , TEXTOUT = , N_ext =, EXTNAME= ] |
| 18 |
; |
| 19 |
; INPUT: |
| 20 |
; Filename - Scalar string giving the name of the FITS file(s) |
| 21 |
; Can include wildcards such as '*.fits', or regular expressions |
| 22 |
; allowed by the FILE_SEARCH() function. One can also search |
| 23 |
; gzip compressed FITS files. |
| 24 |
; OPTIONAL INPUT KEYWORDS: |
| 25 |
; /SILENT - If set, then the display of the file description on the |
| 26 |
; terminal will be suppressed |
| 27 |
; |
| 28 |
; TEXTOUT - specifies output device. |
| 29 |
; textout=1 TERMINAL using /more option |
| 30 |
; textout=2 TERMINAL without /more option |
| 31 |
; textout=3 <program>.prt |
| 32 |
; textout=4 laser.tmp |
| 33 |
; textout=5 user must open file, see TEXTOPEN |
| 34 |
; textout=7 append to existing <program.prt> file |
| 35 |
; textout = filename (default extension of .prt) |
| 36 |
; |
| 37 |
; If TEXTOUT is not supplied, then !TEXTOUT is used |
| 38 |
; OPTIONAL OUTPUT KEYWORDS: |
| 39 |
; N_ext - Returns an integer scalar giving the number of extensions in |
| 40 |
; the FITS file |
| 41 |
; extname - returns a list containing the EXTNAME keywords for each |
| 42 |
; extension. |
| 43 |
; |
| 44 |
; COMMON BLOCKS |
| 45 |
; DESCRIPTOR = File descriptor string of the form N_hdrrec Naxis IDL_type |
| 46 |
; Naxis1 Naxis2 ... Naxisn [N_hdrrec table_type Naxis |
| 47 |
; IDL_type Naxis1 ... Naxisn] (repeated for each extension) |
| 48 |
; For example, the following descriptor |
| 49 |
; 167 2 4 3839 4 55 BINTABLE 2 1 89 5 |
| 50 |
; |
| 51 |
; indicates that the primary header containing 167 lines, and |
| 52 |
; the primary (2D) floating point image (IDL type 4) |
| 53 |
; is of size 3839 x 4. The first extension header contains |
| 54 |
; 55 lines, and the byte (IDL type 1) table array is of size |
| 55 |
; 89 x 5. |
| 56 |
; |
| 57 |
; The DESCRIPTOR is *only* computed if /SILENT is set. |
| 58 |
; EXAMPLE: |
| 59 |
; Display info about all FITS files of the form '*.fit' in the current |
| 60 |
; directory |
| 61 |
; |
| 62 |
; IDL> fits_info, '*.fit' |
| 63 |
; |
| 64 |
; Any time a *.fit file is found which is *not* in FITS format, an error |
| 65 |
; message is displayed at the terminal and the program continues |
| 66 |
; |
| 67 |
; PROCEDURES USED: |
| 68 |
; GETTOK(), MRD_SKIP, STRN(), SXPAR(), TEXTOPEN, TEXTCLOSE |
| 69 |
; |
| 70 |
; SYSTEM VARIABLES: |
| 71 |
; The non-standard system variables !TEXTOUT and !TEXTUNIT will be |
| 72 |
; created by FITS_INFO if they are not previously defined. |
| 73 |
; |
| 74 |
; DEFSYSV,'!TEXTOUT',1 |
| 75 |
; DEFSYSV,'!TEXTUNIT',0 |
| 76 |
; |
| 77 |
; See TEXTOPEN.PRO for more info |
| 78 |
; MODIFICATION HISTORY: |
| 79 |
; Written, K. Venkatakrishna, Hughes STX, May 1992 |
| 80 |
; Added N_ext keyword, and table_name info, G. Reichert |
| 81 |
; Work on *very* large FITS files October 92 |
| 82 |
; More checks to recognize corrupted FITS files February, 1993 |
| 83 |
; Proper check for END keyword December 1994 |
| 84 |
; Correctly size variable length binary tables WBL December 1994 |
| 85 |
; EXTNAME keyword can be anywhere in extension header WBL January 1998 |
| 86 |
; Correctly skip past extensions with no data WBL April 1998 |
| 87 |
; Converted to IDL V5.0, W. Landsman, April 1998 |
| 88 |
; No need for !TEXTOUT if /SILENT D.Finkbeiner February 2002 |
| 89 |
; Define !TEXTOUT if needed. R. Sterner, 2002 Aug 27 |
| 90 |
; Work on gzip compressed files for V5.3 or later W. Landsman 2003 Jan |
| 91 |
; Improve speed by only reading first 36 lines of header |
| 92 |
; Count headers with more than 32767 lines W. Landsman Feb. 2003 |
| 93 |
; Assume since V5.3 (OPENR,/COMPRESS) W. Landsman Feb 2004 |
| 94 |
; EXTNAME keyword can be anywhere in extension header again |
| 95 |
; WBL/S. Bansal Dec 2004 |
| 96 |
; Read more than 200 extensions WBL March 2005 |
| 97 |
; Work for FITS files with SIMPLE=F WBL July 2005 |
| 98 |
; Assume since V5.4, fstat.compress available WBL April 2006 |
| 99 |
; Added EXTNAME as an IDL keyword to return values. M. Perrin Dec 2007 |
| 100 |
; make Ndata a long64 to deal with large files. E. Hivon Mar 2008 |
| 101 |
;- |
| 102 |
compile_opt idl2 |
| 103 |
COMMON descriptor,fdescript |
| 104 |
|
| 105 |
if N_params() lt 1 then begin |
| 106 |
print,'Syntax - FITS_INFO, filename, [/SILENT, TEXTOUT=, N_ext=, EXTNAME=]' |
| 107 |
return |
| 108 |
endif |
| 109 |
|
| 110 |
defsysv,'!TEXTOUT',exists=ex ; Check if !TEXTOUT exists. |
| 111 |
if ex eq 0 then defsysv,'!TEXTOUT',1 ; If not define it. |
| 112 |
|
| 113 |
fil = file_search( filename, COUNT = nfiles) |
| 114 |
if nfiles EQ 0 then message,'No files found' |
| 115 |
|
| 116 |
silent = keyword_set( SILENT ) |
| 117 |
if not silent then begin |
| 118 |
if not keyword_set( TEXTOUT ) then textout = !TEXTOUT |
| 119 |
textopen, 'FITS_INFO', TEXTOUT=textout |
| 120 |
endif |
| 121 |
|
| 122 |
for nf = 0, nfiles-1 do begin |
| 123 |
|
| 124 |
file = fil[nf] |
| 125 |
|
| 126 |
openr, lun1, file, /GET_LUN, /compress |
| 127 |
|
| 128 |
compress = (fstat(lun1)).compress |
| 129 |
N_ext = -1 |
| 130 |
fdescript = '' |
| 131 |
nmax = 400 ; MDP was 100 |
| 132 |
extname = strarr(nmax) |
| 133 |
|
| 134 |
ptr = 0l |
| 135 |
START: |
| 136 |
ON_IOerror, BAD_FILE |
| 137 |
descript = '' |
| 138 |
|
| 139 |
test = bytarr(8) |
| 140 |
readu, lun1, test |
| 141 |
|
| 142 |
if N_ext EQ -1 then begin |
| 143 |
if string(test) NE 'SIMPLE ' then goto, BAD_FILE |
| 144 |
simple = 1 |
| 145 |
endif else begin |
| 146 |
if string(test) NE 'XTENSION' then goto, END_OF_FILE |
| 147 |
simple = 0 |
| 148 |
endelse |
| 149 |
point_lun, lun1, ptr |
| 150 |
|
| 151 |
; Read the header |
| 152 |
hdr = bytarr(80, 36, /NOZERO) |
| 153 |
N_hdrblock = 1 |
| 154 |
readu, lun1, hdr |
| 155 |
ptr = ptr + 2880 |
| 156 |
hd = string( hdr > 32b) |
| 157 |
|
| 158 |
; Get values of BITPIX, NAXIS etc. |
| 159 |
bitpix = sxpar(hd, 'BITPIX', Count = N_BITPIX) |
| 160 |
if N_BITPIX EQ 0 then $ |
| 161 |
message, 'WARNING - FITS header missing BITPIX keyword',/CON |
| 162 |
Naxis = sxpar( hd, 'NAXIS', Count = N_NAXIS) |
| 163 |
if N_NAXIS EQ 0 then message, $ |
| 164 |
'WARNING - FITS header missing NAXIS keyword',/CON |
| 165 |
|
| 166 |
exten = sxpar( hd, 'XTENSION') |
| 167 |
Ext_type = strmid( strtrim( exten ,2), 0, 8) ;Use only first 8 char |
| 168 |
gcount = sxpar( hd, 'GCOUNT') > 1 |
| 169 |
pcount = sxpar( hd, 'PCOUNT') |
| 170 |
|
| 171 |
if strn(Ext_type) NE '0' then begin |
| 172 |
if (gcount NE 1) or (pcount NE 0) then $ |
| 173 |
ext_type = 'VAR_' + ext_type |
| 174 |
descript = descript + ' ' + Ext_type |
| 175 |
endif |
| 176 |
|
| 177 |
descript = descript + ' ' + strn(Naxis) |
| 178 |
|
| 179 |
case BITPIX of |
| 180 |
8: IDL_type = 1 ; Byte |
| 181 |
16: IDL_type = 2 ; Integer*2 |
| 182 |
32: IDL_type = 3 ; Integer*4 |
| 183 |
-32: IDL_type = 4 ; Real*4 |
| 184 |
-64: IDL_type = 5 ; Real*8 |
| 185 |
ELSE: begin |
| 186 |
message, ' Illegal value of BITPIX = ' + strn(bitpix) + $ |
| 187 |
' in header',/CON |
| 188 |
goto, SKIP |
| 189 |
end |
| 190 |
endcase |
| 191 |
|
| 192 |
if Naxis GT 0 then begin |
| 193 |
descript = descript + ' ' + strn(IDL_type) |
| 194 |
Nax = sxpar( hd, 'NAXIS*') |
| 195 |
if N_elements(Nax) LT Naxis then begin |
| 196 |
message, $ |
| 197 |
'ERROR - Missing required NAXISi keyword in FITS header',/CON |
| 198 |
goto, SKIP |
| 199 |
endif |
| 200 |
for i = 1, Naxis do descript = descript + ' '+strn(Nax[i-1]) |
| 201 |
endif |
| 202 |
|
| 203 |
end_rec = where( strtrim(strmid(hd,0,8),2) EQ 'END') |
| 204 |
|
| 205 |
exname = sxpar(hd, 'extname', Count = N_extname) |
| 206 |
if N_extname GT 0 then extname[N_ext+1] = exname |
| 207 |
get_extname = (N_ext GE 0) and (N_extname EQ 0) and not keyword_set(SILENT) |
| 208 |
|
| 209 |
; Read header records, till end of header is reached |
| 210 |
|
| 211 |
hdr = bytarr(80, 36, /NOZERO) |
| 212 |
while (end_rec[0] EQ -1) and (not eof(lun1) ) do begin |
| 213 |
readu,lun1,hdr |
| 214 |
ptr = ptr + 2880L |
| 215 |
hd1 = string( hdr > 32b) |
| 216 |
end_rec = where( strtrim(strmid(hd1,0,8),2) EQ 'END') |
| 217 |
n_hdrblock = n_hdrblock + 1 |
| 218 |
if get_extname then begin |
| 219 |
exname = sxpar(hd1, 'extname', Count = N_extname) |
| 220 |
if N_extname GT 0 then begin |
| 221 |
extname[N_ext+1] = exname |
| 222 |
get_extname = 0 |
| 223 |
endif |
| 224 |
endif |
| 225 |
endwhile |
| 226 |
|
| 227 |
n_hdrec = 36L*(n_hdrblock-1) + end_rec[0] + 1L ; size of header |
| 228 |
descript = strn( n_hdrec ) + descript |
| 229 |
|
| 230 |
; If there is data associated with primary header, then find out the size |
| 231 |
|
| 232 |
if Naxis GT 0 then begin |
| 233 |
ndata = long64(Nax[0]) |
| 234 |
if naxis GT 1 then for i = 2, naxis do ndata=ndata*Nax[i-1] |
| 235 |
endif else ndata = 0 |
| 236 |
|
| 237 |
nbytes = (abs(bitpix)/8) * gcount * (pcount + ndata) |
| 238 |
nrec = long(( nbytes +2879)/ 2880) |
| 239 |
|
| 240 |
|
| 241 |
|
| 242 |
; Check if all headers have been read |
| 243 |
|
| 244 |
if ( simple EQ 0 ) AND ( strlen(strn(exten)) EQ 1) then goto, END_OF_FILE |
| 245 |
|
| 246 |
N_ext = N_ext + 1 |
| 247 |
if N_ext GT nmax then begin |
| 248 |
extname = [extname,strarr(nmax)] |
| 249 |
nmax = nmax*2 |
| 250 |
endif |
| 251 |
|
| 252 |
|
| 253 |
; Append information concerning the current extension to descriptor |
| 254 |
|
| 255 |
fdescript = fdescript + ' ' + descript |
| 256 |
|
| 257 |
; Check for EOF |
| 258 |
; Skip the headers and data records |
| 259 |
|
| 260 |
ptr = ptr + nrec*2880L |
| 261 |
if compress then mrd_skip,lun1,nrec*2880L else point_lun,lun1,ptr |
| 262 |
if not eof(lun1) then goto, START |
| 263 |
; |
| 264 |
END_OF_FILE: |
| 265 |
|
| 266 |
extname = extname[0:N_ext] ;strip off bogus first value |
| 267 |
;otherwise will end up with '' at end |
| 268 |
|
| 269 |
if not (SILENT) then begin |
| 270 |
printf,!textunit,file,' has ',strn(N_ext),' extensions' |
| 271 |
printf,!textunit,'Primary header: ',gettok(fdescript,' '),' records' |
| 272 |
|
| 273 |
Naxis = gettok( fdescript,' ' ) |
| 274 |
|
| 275 |
If Naxis NE '0' then begin |
| 276 |
|
| 277 |
case gettok(fdescript,' ') of |
| 278 |
|
| 279 |
'1': image_type = 'Byte' |
| 280 |
'2': image_type = 'Integer*2' |
| 281 |
'3': image_type = 'Integer*4' |
| 282 |
'4': image_type = 'Real*4' |
| 283 |
'5': image_type = 'Real*8' |
| 284 |
|
| 285 |
endcase |
| 286 |
|
| 287 |
image_desc = 'Image -- ' + image_type + ' array (' |
| 288 |
for i = 0,fix(Naxis)-1 do image_desc = image_desc + ' '+ gettok(fdescript,' ') |
| 289 |
image_desc = image_desc+' )' |
| 290 |
|
| 291 |
endif else image_desc = 'No data' |
| 292 |
printf,!textunit, format='(a)',image_desc |
| 293 |
|
| 294 |
if N_ext GT 0 then begin |
| 295 |
for i = 1,N_ext do begin |
| 296 |
|
| 297 |
printf, !TEXTUNIT, 'Extension ' + strn(i) + ' -- '+extname[i] |
| 298 |
|
| 299 |
header_desc = ' Header : '+gettok(fdescript,' ')+' records' |
| 300 |
printf, !textunit, format = '(a)',header_desc |
| 301 |
|
| 302 |
table_type = gettok(fdescript,' ') |
| 303 |
|
| 304 |
case table_type of |
| 305 |
'A3DTABLE' : table_desc = 'Binary Table' |
| 306 |
'BINTABLE' : table_desc = 'Binary Table' |
| 307 |
'VAR_BINTABLE': table_desc = 'Variable length Binary Table' |
| 308 |
'TABLE': table_desc = 'ASCII Table' |
| 309 |
ELSE: table_desc = table_type |
| 310 |
endcase |
| 311 |
|
| 312 |
table_desc = ' ' + table_desc + ' ( ' |
| 313 |
table_dim = fix( gettok( fdescript,' ') ) |
| 314 |
if table_dim GT 0 then begin |
| 315 |
table_type = gettok(fdescript,' ') |
| 316 |
for j = 0, table_dim-1 do $ |
| 317 |
table_desc = table_desc + gettok(fdescript,' ') + ' ' |
| 318 |
endif |
| 319 |
table_desc = table_desc + ')' |
| 320 |
|
| 321 |
printf,!textunit, format='(a)',table_desc |
| 322 |
endfor |
| 323 |
endif |
| 324 |
|
| 325 |
printf, !TEXTUNIT, ' ' |
| 326 |
endif |
| 327 |
SKIP: free_lun, lun1 |
| 328 |
endfor |
| 329 |
if not silent then textclose, TEXTOUT=textout |
| 330 |
return |
| 331 |
|
| 332 |
BAD_FILE: |
| 333 |
message, 'Error reading FITS file ' + file, /CON |
| 334 |
goto,SKIP |
| 335 |
end |
