function NEW_TASCPDS, filename, label, SILENT = silent
;+
; NAME:
;	TASCPDS  (Table-Ascii-PDS)
; PURPOSE:
;	Read a PDS Ascii table file into IDL structure containing the 
;	columns of the data table as elements.
;
; CALLING SEQUENCE:
;	Result=TASCPDS (Filename,[ Label,/SILENT] )
;
; INPUTS:
;	FILENAME = Scalar string containing the name of the PDS file  
;		to be read.
;
; OUTPUTS:
;	Result = PDS table structure constructed from designated file.
;
; OPTIONAL OUTPUT:
;	Label = String array containing the "header" from the PDS file.
;
; OPTIONAL INPUT KEYWORDS:
;
;	SILENT - Normally, TASCPDS 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 = TASCPDS( 'TEST.PDS', lbl)
;
; PROCEDURES USED:
;	Functions: PDSPAR, STR2NUM
;
; MODIFICATION HISTORY:
;	Adapted by John D. Koch from READFITS by Wayne Landsman,December,1994
;-

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

 if N_params() LT 2 then begin		
    print,'Syntax - result = TASCPDS( 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)
   spot = strpos(inform,10b)			;remove line feeds from names
   if spot GT 0 then inform=strtrim(strmid(inform,0,spot-1),2)
   if inform EQ 'BINARY' then message, $
        'ERROR- '+fname+' is a BINARY table file; try TBINPDS.'
 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 = fix(pdspar(label,'BYTES',COUNT=bcount,INDEX=len_ind))
 if !ERR EQ -1 then message, $
       'ERROR - '+fname+' missing required BYTES keywords' 
 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)

;       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) = 'columns'

;	Trim extraneous characters from column names and data_types

 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 $                	; remove prefixes from data types
        data_type(j)=strmid(data_type(j),spot,strlen(data_type(j))-spot+1)
 endfor
 name = strtrim(name,2)
 data_type = strtrim(data_type,2)
 columns(1:cols(0)) = name

 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				
	tail = d + 1
	d = strpos(fname,'/',tail)
    endwhile
    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
    free_lun,unit
 endif  else begin
    skip = temp -1  
 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 1-dimensional byte array and check for
;	proper end-of-line characters and X dimension


 bad_line_term=0

 openr, unit, fname, ERROR = err, /GET_LUN, /BLOCK
 if err LT 0 then message,'Error opening file ' + ' ' + fname
 filestat=fstat(unit)
 XY = filestat.size
 file = assoc(unit,bytarr(XY,/NOZERO),skip)
 filedata = file(0)
 free_lun, unit
 cr=where(filedata eq 13b,ctcr)
 lf=where(filedata eq 10b,ctlf)
 if cr(0) LT 0 then $
   print,'ERROR IN TABLE: No carriage return characters found. Proceeding.'
 if lf(0) LT 0 then begin
   print,'ERROR IN TABLE: No line feed characters found. Proceeding.'
   goto, formatdata
 endif
; if lf(0) GT 0 and cr(0) GT 0 then $
 if not (ctcr EQ ctlf and total(lf-cr) EQ ctcr) then begin
   print,'ERROR IN TABLE: Carriage return + line feed should ' + $
          'terminate each line. Proceeding.'
   bad_line_term=1
 endif
; CASE lf(0)-cr(0) OF
;     1: if lf(0) ne X-1 then $
 if lf(0) ne X-1 then $
   begin
     if not bad_line_term then $
       print,'ERROR IN LABEL: row_bytes keyword incorrectly set to '+$
                 strcompress(X,/re)+'; correct value is '+ $
                 strcompress(lf(0)+1,/re)+'. Proceeding'
     X=lf(0)+1
     goto,formatdata
  endif
;    -1: begin
;         print,'WARNING: transposed line feed/carriage return characters' 
;         f(cr)=replicate(10b,ctcr)
;         f(lf)=replicate(13b,ctlf)
;        end       
;  else: print,'WARNING: misplaced line feed or carriage return characters'
; ENDCASE else $
;  if lf(0) ne X-1 then $
;        begin
;          print,'WARNING: row_bytes keyword incorrectly set to '+$
;                 strcompress(X,/re)+'; correct value is '+strcompress(lf(0)+1,/re)
;          X=lf(0)+1
;          goto,readata
;        end

;	format data array and convert to string array

formatdata:

 filedata=reform(filedata,X,Y)
 table = string(filedata)
 

;	Convert string array into structure of appropriate column vectors

 data = CREATE_STRUCT('column_names',columns)
 for k=0,cols-1 do begin
    column = 'column'+strtrim(string(k+1),2)
    if k LT cols-1 then begin
        st = where(st_ind GT nam_ind(k) AND st_ind LT nam_ind(k+1))
        d = 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)) 
    endif else begin
        st = where(st_ind GT nam_ind(k))
        d = where(typ_ind GT nam_ind(k))
        l = where(len_ind GT nam_ind(k)) 
    endelse
    strt = start(st)
    bytes = length(l)
    vect = strmid(table,strt(0),bytes(0))
;    print,k,vect
    type = data_type(d)
    if strmid(type(0),0,5) eq 'ASCII' then $
      type(0)=strmid(type(0),6,strlen(type(0))-6) 
    CASE type(0) OF
    	  	 'INTEGER': data = CREATE_STRUCT(data,column,long(vect)) 
   	'UNSIGNED_INTEGER': data = CREATE_STRUCT(data,column,long(vect)) 
       	     	    'REAL': data = CREATE_STRUCT(data,column,double(vect)) 
      	    	   'FLOAT': data = CREATE_STRUCT(data,column,double(vect)) 
  	       'CHARACTER': data = CREATE_STRUCT(data,column,vect) 
     	   	  'DOUBLE': data = CREATE_STRUCT(data,column,double(vect)) 
       	     	    'BYTE': data = CREATE_STRUCT(data,column,long(vect)) 
       	     	 'BOOLEAN': data = CREATE_STRUCT(data,column,long(vect)) 
       	     	    'TIME': data = CREATE_STRUCT(data,column,vect) 
       	     	    'DATE': data = CREATE_STRUCT(data,column,vect) 
               	      else: message,$
		type(0)+' not a recognized data type!'
    ENDCASE
    vect = 0
 endfor
 if not (SILENT) then help, /STRUCTURE, data

; 	Return table structure
	return, data  

 end