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