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 .prt ; textout=4 laser.tmp ; textout=5 user must open file ; textout=7 Append to existing .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 ; Converted to IDL V5.0 W. Landsman 2-Nov-1997 ;- 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 if !VERSION.OS NE "vms" then dir = dir + "/" fil = findfile( 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 if !VERSION.OS NE "vms" then begin byteorder,hdr,/sswap ; Perform byte swaps byteorder,hdr,/lswap endif 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 if !VERSION.OS NE "vms" then 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