Viewing contents of file '../idllib/ghrs/pro/aipsdir.pro'
pro aipsdir,usernum,dir
;+
; NAME:
;  AIPSDIR
; PURPOSE:
;  Print a listing of AIPS image files on a VAX directory
; CALLING SEQUENCE:
;  aipsdir,[usernum,dir]
; OPTIONAL INPUTS:
;  usernum - an AIPS user number, integer scalar.  AIPDIR will
;            only display images belonging to this user.  If not
;            supplied or set = -1, then AIPSDIR displays all images 
;            on the directory.
;  dir - string giving name of the directory containing the AIPS
;        catalog.  If not supplied, then the default AIPS directory
;        (currently CHAMP$USER5:[AIPS.DATA]) is used
; NOTES:
;  Finding the VAX directory that contains your AIPS images appears to
;  be as much of an art as a science.  Users on non-LASP systems will have
;  to modify line 1 of this program giving the default AIPS directory.
; SIDE EFFECTS:
;  AIPSDIR display the user number, slot number, date image was catalogued,
;  image name, and VAX directory name.
; METHOD:
;  The catalog directory ('CA') files are opened, and interpreted as per
;  GOING AIPS (15-APR-1987), p. 5-3
; REVISION HISTORY:
;  Written W. Landsman               March, 1986
;-
if n_elements(dir) eq 0 then  $     ;Default directory - site specific
             dir = 'champ$user5:[aips.data]'
mon = ['JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP', $
       'OCT','NOV','DEC']
ext ='*'                              ;Default is search all user numbers
if n_params(0) ge 1 then $                         ;User number supplied?
    if usernum gt 0 then ext = to_hex(usernum,3)   ;Convert user number to hex
f = findfile(dir+'ca*.'+ext, count = nfiles)
if nfiles eq 0 then message, $
               'No AIPS catalogue (CA*) files found on '+dir
print,'ID   SLOT    DATE       NAME        CLASS    TYPE    VAXNAME'
get_lun,lun
for j=0,n_elements(f)-1 do begin
    openr,lun,f(j)
    a =assoc(lun,intarr(512))
    t = a(0)
    slot = 0
    for i=0,t(2)-1 do begin
    t1=a(i)
    for k=0,9 do begin
    k1 = 16*k
    if i eq 0 then k1 = k1+256         ;First 256 bytes are header record
    b= t1(k1:k1+15)
    if b(0) eq -1 then goto,done else begin
       slot = slot+1
       yr = fix(byte(b(2),1))
       month = byte(b(2),0)
       day = fix(byte(b(3),1))
       date = strtrim(day,2) +'-' + mon(month-1) + '-19' + strtrim(yr,2)
       name = string(byte(b,12,12))
       class = string(byte(b,24,6))
       type = string(byte(b,30,2))
       fdecomp,f(j),disk,dir,fname,ext
       strput,fname,'B',1
       strput,fname,to_hex(slot,3),3
       strput,fname,'01',6
       print,form ='(1x,i3,i4,2x,A12,2x,a12,2x,a6,2x,a2,a14)',$
          b(0),slot,date,name,class,type,fname+'.'+ext
   endelse
   endfor
   endfor
done:
close,lun
endfor
free_lun,lun
return
end