/usr/share/gnudatalanguage/astrolib/irafdir.pro is in gdl-astrolib 2018.02.16+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | pro irafdir,directory,TEXTOUT=textout
;+
; NAME:
; IRAFDIR
; PURPOSE:
; Provide a brief description of the IRAF images on a directory
; CALLING SEQUENCE:
; IRAFDIR, [ directory, TEXTOUT = ]
;
; OPTIONAL INPUT PARAMETERS:
; DIRECTORY - Scalar string giving file name, disk or directory to
; be searched
;
; OPTIONAL INPUT KEYWORD:
; TEXTOUT - specifies output device (see TEXTOPEN)
; textout=1 TERMINAL using /more option
; textout=2 TERMINAL without /more option
; textout=3 <program>.prt
; textout=4 laser.tmp
; textout=5 user must open file
; textout=7 Append to existing <program>.prt file
; textout = 'filename' (default extension of .prt)
;
; OUTPUT PARAMETERS:
; None
;
; PROCEDURE:
; FINDFILE is used to find all '.imh' files in the directory.
; The object name and image size (NAXIS1, NAXIS2) are extracted
; from the header. Each header is also searched for the parameters
; DATE-OBS (or TDATEOBS), TELESCOP (or OBSERVAT), EXPTIME.
;
; RESTRICTIONS:
; (1) Some fields may be truncated since IRAFDIR uses a fixed format
; output
; (2) No more than 2 dimension sizes are displayed
; SYSTEM VARIABLES:
; If 'textout' keyword is not specified to select an output device,
; !TEXTOUT will be the default. This non-standard system variable
; can be added using the procedure ASTROLIB.
;
; PROCEDURE CALLS:
; EXPAND_TILDE(), FDECOMP, REMCHAR, TEXTOPEN, TEXTCLOSE
; MODIFICATION HISTORY:
; Written, K. Venkatakrishna, ST Systems Corp, August 1991
; Work for IRAF V2.11 format W. Landsman November 1997
; Assume since V5.5 use file_search W. Landsman Sep 2006
;-
On_error,2 ;Return to caller
ext='*.imh'
defsysv,'!TEXTUNIT',exist=i
if i EQ 0 THEN astrolib
if keyword_set(directory) then begin
dir = strlowcase(directory)
if strpos(dir,'~') GE 0 then dir = expand_tilde(dir)
endif
if N_ELEMENTS(dir) eq 0 then cd,current = dir
dir = dir + path_sep()
fil = file_search( dir + ext, COUNT=nfiles)
if nfiles EQ 0 then begin
message,'No IRAF (*.imh) files found ',/CON
return
endif
; Set output device according to keyword TEXTOUT or system variable !TEXTOUT
if not keyword_set(textout) then textout=!textout
textopen,'irafdir',TEXTOUT=textout
; Print the title header
printf,!textunit,format='(a,/)','IRAF file directory '+strmid(systime(),4,20)
printf,!textunit,$
' NAME SIZE OBJECT DATE-OF-OBS TELESCOP EXP TIME'
get_lun,lun1
fmt = '(a15,1x,i5,1x,i5,2x,a10,4x,a8,7x,a8,5x,a8)'
dir2 = 'dummy'
for i=0,nfiles-1 do begin ;Loop over each .imh file
file1 = fil[i]
fdecomp,file1,disk,dir2,fname,qual ;Decompose into disk+filename
openr,lun1,file1,/stream ;open the file
irafver = bytarr(5)
readu,lun1,irafver
newformat = string(irafver) EQ 'imhv2'
point_lun,lun1,0
tmp = assoc(lun1,bytarr(32))
hdr = tmp[0]
exptim =' ? ' ;Set default values
telescop = ' ? '
date = ' ? '
if not newformat then begin
hdr2 = hdr ;Read the first 572 bytes
byteorder,hdr,/sswap ; Perform byte swaps
byteorder,hdr,/lswap
hdrlen = fix(hdr,12) ;Extract header length,
ndim = fix(hdr,20) ; number of dimensions,
naxis1 = long(hdr2,24) ; dimension vector
naxis2 = long(hdr2,28)
if hdrlen EQ 0 then begin
close,lun1
goto, PRINTER
endif
tmp1 = assoc(lun1,bytarr(hdrlen*4l,/NOZERO))
hdr = tmp1[0] ;Read the entire header
close,lun1
byteorder,hdr,/sswap ;
nfits = (hdrlen*4l-2054)/162 ; find the number of records
linelen = 162
index = 2052l + indgen(80)*2
endif else begin
hdrlen = fix(hdr,8) ;Extract header length,
ndim = fix(hdr,20) ; number of dimensions,
naxis1 = long(hdr,22) ; dimension vector
naxis2 = long(hdr,26)
tmp1 = assoc(lun1,bytarr(hdrlen*2l,/NOZERO))
hdr = tmp1[0] ;Read the entire header
close,lun1
nfits = (hdrlen*2l-2049)/81 ; find the number of records
linelen = 81
index = 2046l + indgen(80)
endelse
; Form the string 'hd',
; hd will be a FITS style header, that contains all the basic information
if nfits EQ 0 then goto, PRINTER
hd = strarr(nfits) ; to break the header into
for j = 0l,nfits-1 do hd[j] = string(hdr[linelen*j + index] )
keyword = strtrim( strmid(hd,0,8),2 )
value = strtrim( strmid(hd,10,20),2 )
l = where(keyword EQ 'TELESCOP',nfound) ;Search for OBSERVAT keyword
if nfound EQ 0 then l = where(keyword EQ 'OBSERVAT', nfound)
if nfound GT 0 then begin
telescop = value[l[0]]
remchar,telescop,"'"
endif
l = where(keyword EQ 'EXPTIME',nfound) ;Search for EXPTIME keyword
if nfound GT 0 then begin
exptim = float(value[l[0]])
if exptim EQ 0. then exptim = ' ? ' else $
exptim = string(exptim,format= '(f7.1)')
endif
l = where(keyword EQ 'DATE-OBS' ,nfound) ;Search for DATE-OBS keyword
if nfound EQ 0 then l = where(keyword EQ 'TDATEOBS', nfound)
if nfound GT 0 then begin
date=value[l[0]]
remchar,date,"'"
endif
;Extract object name
PRINTER:
if newformat then object = string( hdr[638 + indgen(8)]) else $
object = string( hdr[732 + indgen(8)*2])
if dir2 NE dir then begin ;Has directory changed?
if ( dir2 EQ '' ) then cd,current=dir else dir = dir2
printf,!textunit,format='(/a/)',disk+dir ;Print new directory
dir = dir2 ;Save new directory
endif
; original header
printf,!textunit,FORMAT=fmt,fname,naxis1,naxis2,object,date,telescop,exptim
if textout EQ 1 then if !ERR EQ 1 then return
endfor
textclose, TEXTOUT=textout
free_lun, lun1
return
end
|