function TBINPDS, filename, label, SILENT = silent
;+
; NAME:
;	TBINPDS (table - binary - pds)
; PURPOSE:
;	Read a PDS binary file into IDL structure containing the columns of 
;	the data table as elements.
;
; CALLING SEQUENCE:
;	Result=TBINPDS (Filename, Label [,/SILENT] )
;
; INPUTS:
;	FILENAME = Scalar string containing the name of the PDS file  
;		to be read.
;
;	Label = String array containing the "header" from the PDS file.
;
; OUTPUTS:
;	Result = PDS table structure constructed from designated file.
;
; OPTIONAL INPUT KEYWORDS:
;
;	SILENT - Normally, TBINPDS will display the size of the array at 
;		the terminal.  The SILENT keyword will suppress this
;
; EXAMPLE:
;	Read a PDS file TEST.PDS into an IDL structure containing the 
;	columns of the data table as elements.
;
;		IDL> tab = TBINPDS( 'TEST.PDS', lbl)
; WARNINGS:
;	This version of TBINPDS is intended to be used only on MSB 
;	architectures ('big-endian') or if the file being read was written
;	in IEEE standard; it has no conversion from MSB to other 
;	architectures, yet.
;
; PROCEDURES USED:
;	Functions: PDSPAR, STR2NUM, BTABVECT
;
; MODIFICATION HISTORY:
;	Adapted by John D. Koch from READFITS by Wayne Landsman,December,1994
;-

  On_error,2                    ;Return to user            
							
; Check for filename input

 if N_params() LT 2 then begin		
    print,'Syntax - result = TBINPDS( filename, lbl[,/SILENT])'
    return, -1
 endif

 silent = keyword_set( SILENT )
 fname = filename 
     

;	Read object to determine type of data in file

 object = pdspar(label,'OBJECT',COUNT=objects,INDEX=obj_ind)
 if !ERR EQ -1 then message, $
        'ERROR - '+fname+': missing required OBJECT keyword'
 pointer = pdspar(label,'TABLE')	
 if !ERR EQ -1 then pointer = pdspar(label,'SERIES')
 if !ERR EQ -1 then pointer = pdspar(label,'PALETTE')
 if !ERR EQ -1 then pointer = pdspar(label,'SPECTRUM')
 if !ERR EQ -1 then message, $
   'ERROR- '+fname+': missing valid file pointer'
 inform = pdspar( label, 'INTERCHANGE_FORMAT' )     
 if !ERR EQ -1 then begin
   message,'ERROR - '+fname+': missing required INTERCHANGE_FORMAT keyword'
 endif else begin
   inform = inform(0)
   infst =  strpos(inform,'"') 		; remove '"'s from inform 
   if infst GT -1 then $			
	inform = strmid(inform,infst+1,strpos(inform,'"',infst+1)-infst-1)
   if inform EQ "ASCII" then message, $
	'ERROR- '+fname+' is an ASCII table file; try TASCPDS.'
 endelse
 name = pdspar(label,'NAME',INDEX=nam_ind)
 if !ERR EQ -1 then message, $
       'ERROR - '+fname+' missing required NAME keywords'
 data_type = pdspar(label,'DATA_TYPE',COUNT= dcount,INDEX=typ_ind)
 if !ERR EQ -1 then message, $
       'ERROR - '+fname+' missing required DATA_TYPE keywords'
 length = pdspar(label,'BYTES',COUNT=bcount,INDEX=len_ind)
 if !ERR EQ -1 then message, $
       'ERROR - '+fname+' missing required BYTES keywords' 
 col_start = pdspar(label,'START_BYTE',COUNT=cols,INDEX=st_ind) - 1
 if !ERR EQ -1 then message, $
       'ERROR - '+fname+' missing required START_BYTE keywords' 
 columns = pdspar(label,'COLUMNS')
 if !ERR EQ -1 then begin
   message,'ERROR - '+fname+': missing required COLUMNS keyword'
 endif else columns = columns(0)
 cols = cols(0)

; 	Check to see if there may be an 'array-column' in the file

 arrays = 0
 items = pdspar(label,'ITEMS',COUNT=arrays,INDEX=is_ind)
 if !ERR GT -1 then begin
    item_bytes = pdspar(label,'ITEM_BYTES',COUNT=iarrays,INDEX=ib_ind)
    if !ERR GT -1 then begin
       if iarrays NE arrays then message,$
 	'ERROR - '+fname+': ITEMS count and ITEM_BYTES count discrepancy'
       length = [temporary(length),item_bytes]
       len_ind = [temporary(len_ind),ib_ind]
    endif    
    if dcount(0) LT cols then begin  
    	item_type = pdspar(label,'ITEM_TYPE',COUNT=iarrays,INDEX=it_ind)
        if !ERR EQ -1 then message,$
 	  'ERROR - '+fname+' missing required ITEM_TYPE keyword' else $
        if iarrays NE arrays then message,$
 	  'ERROR - '+fname+': ITEMS count and ITEM_TYPE count discrepancy' 
        data_type = [temporary(data_type),item_type]
        typ_ind = [temporary(typ_ind),it_ind]
    endif 
 endif 


;	If it exists, remove table name from array 'name'
 
 if nam_ind(0) LT obj_ind(1) then begin
    name = name(1:cols)
    nam_ind = nam_ind(1:cols)
 endif
 columns = strarr(cols+1)
 columns(0) = 'column_names'

;       Trim extraneous characters from column names and data_types

 arch = strarr(cols)
 for j = 0,cols-1 do begin
   nmst =  strpos(name(j),'"')+1                ; remove '"'s from names
   if nmst GT 0 then $
      name(j)=strmid(name(j),nmst,strpos(name(j),'"',nmst)-nmst)
   nmst =  strpos(name(j),"'")+1                ; remove "'"s from names
   if nmst GT 0 then $
      name(j)=strmid(name(j),nmst,strpos(name(j),"'",nmst)-nmst)   
   nmpar = strpos(name(j),'(')                  ; remove '()'s from names
   if nmpar GT 0 then name(j)= strmid(name(j),0,nmpar) 
   nmst = strpos(name(j),10b) 			; remove end-of-line controls
   if nmst LT 0 then nmst = strpos(name(j),13b) 
   if nmst GT 0 then name(j) = strmid(name(j),0,nmst-1)

   dtst =  strpos(data_type(j),'"')+1   ; remove '"'s from data types
   if dtst GT 0 then $
  data_type(j) = strmid(data_type(j),dtst,strpos(data_type(j),'"',dtst)-dtst)
   dtst =  strpos(data_type(j),"'")+1   ; remove "'"s from data types
   if dtst GT 0 then $
  data_type(j) = strmid(data_type(j),dtst,strpos(data_type(j),"'",dtst)-dtst)
   dtst = strpos(data_type(j),10b) 		; remove end-of-line controls
   if dtst LT 0 then dtst = strpos(data_type(j),13b) 
   if dtst GT 0 then data_type(j) = strmid(data_type(j),0,dtst-1) 
    spot = strpos(data_type(j),'_')+1
   if spot GT 0 then begin                 ; remove prefixes from data types
        arch(j)=strmid(data_type(j),0,spot(0)-1)  ; and store in 'arch'
        data_type(j)=strmid(data_type(j),spot,strlen(data_type(j))-spot+1)
   endif
 endfor
 name = strtrim(name,2)
 data_type = strtrim(data_type,2)
 columns(1:cols) = name

;	Read the table dimensions

 X = pdspar( label,'row_bytes')
 Y = pdspar( label,'rows')
 X = long(X(0))
 Y = long(Y(0))
  
; 	Read pointer to find location of the table data  

 point = pointer(0)		
 skip=0
 temp = str2num(point,TYPE=t)
 if t GT 6 then begin
    l = strlen(point)
    p = strpos(point,'"')
    p2 = strpos(point,'"',p+1)
    if p LT 0 then begin
	p = strpos(point,"'")
   	p2 =  strpos(point,"'",p+1)
    endif
    c = strpos(point,',')
    if (c GT -1) then skip = str2num(strtrim(strmid(point,c+1,L-c-1),2))-1
    if (p GT -1) then point=strmid(point,p+1,p2-p-1)
    d = strpos(fname,'/')		
    tail = d					
    dir = ''
    while d GT -1 do begin		; extract the path to the directory,
      	tail = d + 1
       	d = strpos(fname,'/',tail)
    endwhile
    dir = strmid(fname,0,tail)	
    fname = dir + strlowcase(point)	; add the new filename onto the path
    openr, unit, fname, ERROR = err, /GET_LUN, /BLOCK
    dir = strmid(fname,0,tail)
    fname = dir + strupcase(point)
    openr, unit, fname, ERROR = err, /GET_LUN, /BLOCK
    if err LT 0 then fname = dir + strlowcase(point)
    openr, unit, fname, ERROR = err, /GET_LUN, /BLOCK
    if err LT 0 then fname = dir + (point)
    openr, unit, fname, ERROR = err, /GET_LUN, /BLOCK
    if err LT 0 then message,'Error opening file ' + ' ' + fname
 endif else begin 
    skip = temp -1 
    openr, unit, fname, ERROR = err, /GET_LUN, /BLOCK
    if err LT 0 then message,'Error opening file ' + ' ' + fname
 endelse

; 	Inform user of program status if /SILENT not set

 if not (SILENT) then begin 
    st = (cols*Y)       
    text = strtrim(string(cols),2)+' Columns and '+strtrim(string(Y),2)+' Rows'
    if (st GT 0) then message,'Now reading table with '+text,/INFORM else $
    	message,fname+" has ROWS or COLUMNS = 0, no data read"
 endif
 
;	Read data into a byte array

 file = assoc(unit,bytarr(X,Y,/NOZERO),skip)
 table = file(0)
 free_lun, unit

; 	Interpret correct values from byte array table

 data = CREATE_STRUCT('column_names',columns)
 for k=0,cols-1 do begin
    if k LT cols-1 then begin
	st = where(st_ind GT nam_ind(k) AND st_ind LT nam_ind(k+1))
	dt = where(typ_ind GT nam_ind(k) AND typ_ind LT nam_ind(k+1)) 
        l = where(len_ind GT nam_ind(k) AND len_ind LT nam_ind(k+1),bitenum) 
	if arrays(0) GT 0 then $
           it = where(is_ind GT nam_ind(k) AND is_ind LT nam_ind(k+1))         
    endif else begin
	st = where(st_ind GT nam_ind(k))
	dt = where(typ_ind GT nam_ind(k))
        l = where(len_ind GT nam_ind(k),bitenum) 
	if arrays(0) GT 0 then $
	   it = where(is_ind GT nam_ind(k))         
    endelse
    st = st(0)
    dt = dt(0)
    elem = 1
    if arrays(0) GT 0 then if it(0) GT -1 then elem = fix(items(it(0)))

; 	If more than one 'l' find the one that is smallest

    least = l(0)
    for b = 0,bitenum-1 do $
	if str2num(length(l(b))) LT str2num(length(least)) then $
        least = l(b)
    l = least(0)
    if st LT 0 OR dt LT 0 then message,$
   	'ERROR - '+fname+': column parameters missing or out of order.'   
    CASE arch(dt) OF
                '': arch(dt) = 'MSB'			 
             'MSB': 
            'IEEE': arch(dt) = 'MSB'			
        'UNSIGNED': begin
			arch(dt) = 'MSB'
                        data_type(dt) = 'UNSIGNED_INTEGER'
		    end
             'VAX': arch(dt) = 'LSB'
            'VAXG': arch(dt) = 'LSB'
             'LSB': arch(dt) = 'LSB'
             'MAC': arch(dt) = 'MSB'	
             'SUN': arch(dt) = 'MSB'	
              'PC': if strpos(data_type(dt),'INTEGER') then arch(dt) = 'LSB'
	   'ASCII': begin
			data_type(dt) = 'CHARACTER'
			arch(dt) = 'MSB'
		    end
	      else: begin
			message,$
	arch(dt)+' not a recognized architecture! MSB assumed.',/INFORM
			arch(dt) = 'MSB'
		    end	
    ENDCASE
    column = 'column'+strtrim(string(k+1),2)
    vect=btabvect(table,col_start(st),str2num(length(l)),data_type(dt),elem)

;	Convert to host byte order, if necessary

    if arch(dt) EQ 'MSB' then ieee_to_host,vect else $
    if arch(dt) EQ 'LSB' then vect = conv_vax_unix(vect) else $ 
    if arch(dt) EQ 'PC' then message,$
    'PC_REAL data type not yet supported by TBINPDS. No conversion',/INFORM

;	Check that data type is of the right sign

    if strpos(data_type(dt),'UNSIGNED') GT -1 then vect = abs(vect)
    data = CREATE_STRUCT(data,column,vect) 
    vect = 0
 endfor
 if not (SILENT) then help, /STRUCTURE, data

; 	Return data table in IDL structure form

 return, data  

 end