function strnumber,st,val
;+
; NAME:
;   STRNUMBER
; PURPOSE:
;   Function to determine if a string is a valid numeric value.
; CALLING SEQUENCE:
;	result = strnumber( st, [val] )
; INPUTS:
;	st - string
; OUTPUTS:
;	1 is returned as the function value if the string st has a
;	valid numeric value, otherwise, 0 is returned.
; OPTIONAL OUTPUT:
;	val - (optional) value of the string.  real*8
; WARNING:
;    (1)   Note that (as of Version 2.2.2) a blank string (e.g. " ") is not
;          a valid numeric value, although an empty string ("") is.
;    (2)   As of V2.2.2 there is a bug in the IDL ON_IOERROR procedure that
;          will cause the following statement to hang up IDL
;
;            IDL> print,'' + string( strnumber('xxx') )
; HISTORY:
;	version 1  By D. Lindler Aug. 1987
;-
if N_params() EQ 0 then begin
     print,'Syntax - result = strnumber( st, [val] )
     return, 0
endif

On_IOerror,L1			;Go to L1 if conversion error occurs
val = double(st)
return, 1			;No conversion error
L1: return, 0			;Conversion error occured
end
;
FUNCTION REPCHR, OLD, C1, C2
;+NAME/ONE LINE DESCRIPTION: 
;    REPCHR replaces one character with another in a text string.
;
; PURPOSE: 
;   Replace all occurences of one character with another
;   in a text string.   (Use the procedure REPSTR to replace
;   more than one character.)
;
; CALLING SEQUENCE: 
;   NEW = REPCHR(OLD, C1, [C2])
;
; INPUTS:
;   OLD = text string to edit, scalar or vector
;   C1 = character to replace.
; OPTIONAL INPUTS:
;   C2 = character to insert (def = ' ' = space).
;
; OUTPUTS:
;   NEW = edited string.
;
; EXAMPLE:
;   If OLD = 'THIS_IS_THE_TEXT', C1 = '_'
;   then NEW = REPCHR(OLD,C1) ==> NEW = 'THIS IS THE TEXT'
; MODIFICATION HISTORY: 
;   R. Sterner.  28 Oct, 1986.
; Vidya Sagar (ARC) Aug 1991
; Improved Help documentation 
;
;.TITLE
;Routine REPCHR
;-
B = BYTE(OLD)			   ; convert string to a byte array.
CB1 = BYTE(C1)			   ; convert char 1 to byte.
W = WHERE(B EQ CB1(0),NFOUND)	   ; find occurrences of char 1.
IF NFOUND EQ 0 THEN RETURN, OLD	   ; if none, return old string.
IF N_PARAMS(0) LT 3 THEN C2 = ' '  ; default char 2 is space.
CB2 = BYTE(C2)			   ; convert char 2 to byte.
B(W) = CB2(0)			   ; replace char 1 by char 2.
RETURN, STRING(B)		   ; return new string.
END
;
pro remchar,st,char	;Remove character
;+
; NAME:
;    REMCHAR removes all appearances of a character from a string
;
; PURPOSE:
;    Remove all appearances of character (char) from string (st)
;
; CALLING SEQUENCE:
;    REMCHAR, ST, CHAR
;
; INPUTS:
;    ST  - String from which character will be removed.  
;    CHAR- Character to be removed from string. 
;
; EXAMPLE:
;    If a = 'a,b,c,d,e,f,g' then IDL> remchar,a, ','
;      will give a = 'abcdefg'
;
; REVISIONS HISTORY
;    Written D. Lindler October 1986
;    Test if empty string needs to be returned   W. Landsman  Feb 1991
;
;spr 10448
;.title
;Routine REMCHAR
;-
 bst = byte(st)                                 ;Convert string to byte

 bchar = byte(char) & bchar = bchar(0)          ;Convert character to byte

 good = where( bst NE bchar, Ngood)
 if Ngood GT 0 then st = string(bst(good)) else st = ''

 return
 end
;
FUNCTION GETTOK,ST,CHAR
;
;+NAME/ONE LINE DESCRIPTION OF ROUTINE:
;     GETTOK retrieves a segment of a character string.
;
;DESCRIPTION:
;     IDL function to retrieve the first part of a character string
;     until the character CHAR is encountered.
;
;CALLING SEQUENCE:
;     Y = GETTOK(ST,CHAR)
;
;ARGUMENTS (I = input, O = output, [] = optional):
;     Y             O   str        output character string which
;                                  terminates at CHAR.
;
;     ST            I   str        input character string
;
;     CHAR          I   str        character at which output character
;                                  string is to be terminated.
;
;WARNINGS:
;     NONE
;
;EXAMPLE:
;     ST='ABC=999'
;     Y=GETTOK(ST,'=')
;     PRINT,Y
;       ABC
;
;#
;COMMON BLOCKS:
;     NONE
;
;PROCEDURE (AND OTHER PROGRAMMING NOTES):
;     GETTOK uses the IDL function STRPOS to determine the position of
;     CHAR in the character string ST, and the IDL funtion STRMID to
;     extract the character string segment which occurs before CHAR.
;
;PERTINENT ALGORITHMS, LIBRARY CALLS, ETC.:
;     NONE
;
;MODIFICATION HISTORY
;     Written by D. Lindler, April 1986
;     Revised by Vidya Sagar, Applied Research Corp.   Aug 1991
;     Improved documentation
;
; SPR 9616
;.TITLE
;ROUTINE GETTOK
;
;-
; if char is a blank treat tabs as blanks
;
	tab='	'
	while strpos(st,tab) ge 0 do begin
		pos=strpos(st,tab)
		strput,st,' ',pos
	end

	;
	; find character in string
	;
	pos=strpos(st,char)
	if pos eq -1 then begin	;char not found?
		token=st
		st=''
		return,token
	endif

	;
	; extract token
	;
	token=strmid(st,0,pos)
	len=strlen(st)
	if pos eq (len-1) then st='' else st=strmid(st,pos+1,len-pos-1)

	;
	;  Return the result.
	;
	return,token
	end
;
PRO ZPARCHECK,PROGNAME,PARAMETER,PARNUM,TYPES,DIMENS,MESSAGE
;+NAME:
;     ZPARCHECK verifies data type of parameters in a procedure call.
;
; PURPOSE:
;	Routine to check user parameters to a procedure and prints
;       a message/returns if the parameters don't match
;
; CALLING SEQUENCE:
;	zparcheck,progname,parameter,parnum,types,dimens,message
;
; ARGUMENTS:
;	progname  I str name of     -  calling procedure
;	parameter I any-variable    -  parameter passed to the routine
;	parnum    I int             -  parameter number for error
;                                       message output
;	types     I int vec or sclr -  valid data types for parameter
;		 	1 - byte        2 - integer  3 - int*4
;			4 - real*4      5 - real*8   6 - complex
;			7 - string      8 - structure
;	ndimens   I int sclr or vec -  number of dimensions
;					of allowed dimensions.
;	message -[I] str            -  string message to be printed
;				      	if an error is found).
;
; WARNINGS:
;	Do not misuse government software.
; EXAMPLES:
;  ;;;In this example, the routine simply returns since
;  ;;;the number '10' is an integer scaler
;  UIDL> zparcheck,'DOGANDPONY',10,7,2,0,'Error you dummy'
;  UIDL>
;  ;;;Here we get an error since 10 is not a long scaler
;  UIDL> zparcheck,'DOGANDPONY',10,7,3,0,'Error you dummy'
;  Parameter 7 (Error you dummy)  of routine DOGANDPONY is an invalid
;                                                             data type
;  Valid dimensions are: scaler
;  Valid types are:  longword
;  UIDL>
;#
;
;       
; COMMON BLOCKS:
;        None
;
; PROCEDURES (AND OTHER PROGRAMMING NOTES):
;	If there is an error in the parameters then a
;	a RETALL issued
;
; PERTINENT ALGORITHMS, LIBRARY CALLS, ETC.:
;	None
;
; MODIFICATION HISTORY:
;
;	version 1  D. Lindler  Dec. 86
;	documentation updated.  M. Greason, May 1990.
;.TITLE
;Routine ZPARCHECK
;-
;
; convert types and ndimens to vectors if scalars supplied
;
vtypes=intarr(n_elements(types)) + types
vndims=intarr(n_elements(dimens)) + dimens
;
; get type and size of parameter
;
s=size(parameter)
ndim=s(0)
type=s(ndim+1)
;
; check if parameter defined.
;
if type eq 0 then begin
	err=' is undefined.'
	goto,abort
endif
;
; check for valid dimensions
;
valid=where(ndim eq vndims,nvalid)
if nvalid lt 1 then begin
	err='has wrong number of dimensions'
	goto,abort
endif
;
; check for valid type
;
valid=where(type eq vtypes,ngood)
if ngood lt 1 then begin
	err='is an invalid data type'
	goto,abort
endif
;
return
;
; bad parameter
;
abort:
mess=' '
if n_params(0) lt 6 then message=''
if message ne '' then mess=' ('+message+') '
print,string(7b) + 'Parameter '+strtrim(parnum,2)+mess,$
	' of routine ',strupcase(progname)+' ',err
sdim=' '
for i=0,n_elements(vndims)-1 do begin
	if vndims(i) eq 0 then sdim=sdim+'scalar' $
			  else sdim=sdim+string(vndims(i),'(i3)')
end
print,'Valid dimensions are:'+sdim
;
stype=' '
for i=0,n_elements(vtypes)-1 do begin
	case vtypes(i) of
		1: stype=stype+' byte'
		2: stype=stype+' integer'
		3: stype=stype+' longword'
		4: stype=stype+' real*4'
		5: stype=stype+' real*8'
		6: stype=stype+' complex'
		7: stype=stype+' string'
                8: stype=stype+' structure'
	endcase
endfor
print,'Valid types are:'+stype
;if !debug then stop
retall  ; zparcheck
end
;
pro fdecomp,filename,disk,dir,name,qual,version
;+ NAME/ONE LINE DESCRIPTION OF ROUTINE:
;      FDECOMP decomposes a file name into its components.
;
;  DESCRIPTION:
;      IDL procedure to decompose a file name into its
;      constituent components (disk, directory, file name,
;      file name extension, and version number).
;
;  CALLING SEQENCE:
;      FDECOMP,FILENAME,DISK,DIR,NAME,QUAL,VERSION
;
;  ARGUMENTS (I = input, O = output, [] = optional):
;      FILENAME       I      str      File name to be decomposed
;      DISK           O      str      Disk name
;      DIR            O      str      Directory name
;      NAME           O      str      File name
;      QUAL           O      str      File name extension
;      VERSION        O      str      Version number
;
;  WARNINGS:
;      None
;
;  EXAMPLE:
;      To decompose the file name
;      FIRCOADD:[FIRAS.SKYMAP]FCF_SKY_LLSS.ED_8934301_9026410;2:
;
;      filename =
;            'FIRCOADD:[FIRAS.SKYMAP]FCF_SKY_LLSS.ED_8934301_9026410;2'
;      fdecomp,filename,disk,dir,name,qual,ver
;
;      FDECOMP returns these strings for the file name components:
;            disk = 'fircoadd'
;            dir  = '[firas.skymap]'
;            name = 'fcf_sky_llss'
;            qual = 'ed_8934301_9026410'
;            ver  = '2'
;#
;  COMMON BLOCKS:
;      None
;
;  PROCEDURE (AND OTHER PROGRAMMING NOTES):
;      The input and output variables to this procedure are all string
;      arrays.
;
;  PERTINENT ALGORITHMS, LIBRARY CALLS, ETC.:
;      GETTOK
;
;  MODIFICATION HISTORY:
;      version 1  D. Lindler  Oct 1986
;
; SPR 9616
;.TITLE
;Routine FDECOMP
;-
;
st=filename
;
; get disk
;
if strpos(st,':') ge 0 then disk=gettok(st,':')+':' else disk=''
;
; get dir
;
if strpos(st,']') ge 0 then dir=gettok(st,']')+']' else dir=''
;
; get name
;
name=gettok(st,'.')
;
; get qualifier
;
qual=gettok(st,';')
;
; get version
;
version=st
return
end
;
;
;---------------------------------------------------------------------------
;   I deleted procedure findpro from here.  It was nothing but trouble.
;---------------------------------------------------------------------------
;
;----------------------------------------------------------------------------
; IDL Binary Search Routine
;
; Written By: BA Franz, Applied Research Corp., 12/92
;
;----------------------------------------------------------------------------
function binsrch,array,x

n = n_elements(array)
if (n eq 1) then return,0

found = 0
lo = long(0)
hi = long(n-1)

while (lo le hi) and (not found) do begin
    mid = long((lo+hi)/2)
    if (array(mid) eq x) then $
        found = 1             $
    else begin
        if (x lt array(mid)) then  $
             hi = mid-1            $
        else                       $
             lo = mid+1
    endelse 
endwhile

if (found) then   $
    return,mid    $
else              $
    return,-1

end



;------------------------------------------------------------------
; Function ANYWHERE
;
; IDL function which returns the indices of the elements of vector a
; which are also elements of vector b.
;
; i.e., if     indx = anywhere(a,b)
;              c = a(indx)  
;       then   c is the intersection of sets a and b
; 
; Written By: BA Franz, ARC, 6/93
;
;------------------------------------------------------------------
function anywhere,a,b

aa = a(*)
n = n_elements(aa)
index = lonarr(n)*0-1

bb = b(sort(b))
unique_list,bb,bb

j = 0L
for i=0L,n-1 do begin
    ipos = binsrch(bb,aa(i))
    if (ipos ne -1) then begin
        index(j) = i
        j = j+1
    endif
endfor

if (j gt 0) then return,index(0:j-1) else return,-1
end



;------------------------------------------------------------------
; Function NOWHERE
;
; IDL function which returns the indices of the elements of vector a
; which are not elements of vector b.
;
; i.e., if     indx = nowhere(a,b)
;              c = a(indx)  
;       then   c is the difference of sets a and b
; 
; Written By: BA Franz, ARC, 6/93
;
;------------------------------------------------------------------
function nowhere,a,b

n = n_elements(a)
index = lonarr(n)*0-1

bb = b(sort(b))

j = 0L
for i=0L,n-1 do begin
    ipos = binsrch(bb,a(i))
    if (ipos eq -1) then begin
        index(j) = i
        j = j+1
    endif
endfor

if (j gt 0) then return,index(0:j-1) else return,-1
end
;
;
;
pro readcol,name,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15, $
            FORMAT = fmt, DEBUG=debug, SILENT=silent, SKIPLINE = skipline, $
            NUMLINE = numline
;+
; NAME:
;    READCOL reads a free-format ASCII data file with columns of data.
;
; PURPOSE:
;    Read a free-format ASCII data file with columns of data into IDL variables.
;    Lines of data not meeting the specified format (e.g. comments) are
;    ignored.  Columns may be separated by commas or spaces.   Use READFMT
;    to read a fixed-format ASCII file.
;
; CALLING SEQUENCE:
;    readcol, name, v1, [ v2, v3, v4, v5,v6, v7, v8,v9,v10,v11,v12,v13,v14,v15
;             FORMAT = , DEBUG = , SILENT = , SKIPLINE = , NUMLINE = ]
; INPUTS:
;    NAME - Name of ASCII data file, scalar string.  In VMS, an extension of 
;          .DAT is assumed, if not supplied.
;
; OPTIONAL INPUT KEYWORDS:
;    FORMAT - scalar string containing a letter specifying an IDL type
;        for each column of data to be read.  Allowed letters are 
;        A - string data, B - byte, D - double precision, F- floating 
;        point, I - integer, L - longword, and X - skip a column.
;
;        Columns without a specified format are assumed to be floating 
;        point.  Examples of valid values of FMT are
;
;        'A,B,I'        ;First column to read as 6 character string, then 
;                        1 column of byte data, 1 column integer data
;        'L,L,L,L'       ;Four columns will be read as longword arrays.
;        ' '             ;All columns are floating point
;
;        If a FORMAT keyword string is not supplied, then all columns are 
;        assumed to be floating point.
;
;   SILENT - Normally, READCOL will display each line that it skips over.
;          If SILENT is set and non-zero then these messages will be suppressed.
;   DEBUG - If this keyword is non-zero, then additional information is printed
;          as READCOL attempts to read and interpret the file.
;   SKIPLINE - Scalar specifying number of lines to skip at the top of file
;          before reading.   Default is to start at the first line.
;   NUMLINE - Scalar specifying number of lines in the file to read.   Default
;             is to read the entire file
;
; OUTPUTS:
;    V1,V2,V3,...V15 - IDL vectors to contain columns of data.
;         Up to 15 columns may be read.  The type of the output vectors
;         are as specified by FORMAT.
;
; EXAMPLES:
;    Each row in a file POSITION.DAT contains a star name and 6 columns
;    of data giving an RA and Dec in sexigesimal format.   Read into IDL 
;    variables.     (NOTE: The star names must not contain internal spaces.)
;
;        IDL> FMT = 'A,I,I,F,I,I,F'
;        IDL> READCOL,'POSITION',F=FMT,name,hr,min,sec,deg,dmin,dsec  
;
;    The HR,MIN,DEG, and DMIN variables will be integer vectors.
;
;    Alternatively, all except the first column could be specified as
;    floating point.
;        IDL> READCOL,'POSITION',F='A',name,hr,min,sec,deg,dmin,dsec 
;
;    To read just the variables HR,MIN,SEC
;        IDL> READCOL,'POSITION',F='X,I,I,F',HR,MIN,SEC
;
; RESTRICTIONS:
;    This procedure is designed for generality and not for speed.
;    If a large ASCII file is to be read repeatedly, it may be worth
;    writing a specialized reader.
;
;    Columns to be read as strings must not contain spaces or commas, 
;    since these are interpreted as column delimiters.    Use READFMT
;    to read such files.
;
;    Numeric values are converted to specified format.  For example,
;    the value 0.13 read with an 'I' format will be converted to 0.
;
; PROCEDURES CALLED
;     GETTOK, SPEC_DIR, REPCHR, STRNUMBER
; REVISION HISTORY:
;    Written         W. Landsman                 November, 1988
;    Modified	     J. Bloch 			June, 1991
;	(Fixed problem with over allocation of logical units.)
;    Added SKIPLINE and NUMLINE keywords  W. Landsman    March 92
;
;spr 10448
;.title
;Routine READCOL
;-
  On_error,2                           ;Return to caller

  if N_params() lt 2 then begin
     print,'Syntax - readcol, name, v1, [ v2, v3,...v15, '
     print,'        FORMAT= ,SILENT = ,SKIPLINE =, NUMLINE = , /DEBUG]'
     return
  endif

  ncol = N_params() - 1           ;Number of columns of data expected
  vv = 'v' + strtrim( indgen(ncol)+1, 2)
  nskip = 0

  if N_elements(fmt) GT 0 then begin    ;FORMAT string supplied?

    zparcheck, 'READCOL', fmt, 2, 7, 0, 'FORMAT string'
;   Remove blanks from format string
    frmt = strupcase(strcompress(fmt,/REMOVE))   
    remchar, frmt, '('                  ;Remove parenthesis from format
    remchar, frmt, ')'           

;   Determine number of columns to skip ('X' format)
    pos = strpos(frmt, 'X', 0)

    while pos NE -1 do begin
        pos = strpos( frmt, 'X', pos+1)
        nskip = nskip + 1
    endwhile

  endif else begin                     ;Read everything as floating point

    frmt = 'F'
    if ncol GT 1 then for i = 1,ncol-1 do frmt = frmt + ',F'
    if not keyword_set( SILENT ) then message, $
      'Format keyword not supplied - All columns assumed floating point',/INF

  endelse

  nfmt = ncol + nskip
  idltype = intarr(nfmt)
  openr, lun, name, ERROR=err, /GET_LUN
  if err LT 0 then $ 
     message,'Unable to open file ' + spec_dir( name, 'DAT')

; Get number of lines in file

   nlines = 0L
   temp = ' '
   while not EOF(lun) do begin
      readf, lun, temp
      nlines = nlines+1
   endwhile

   if keyword_set(DEBUG) then $
      message,strupcase(name)+' contains ' + strtrim(nlines,2) + ' lines',/INF

   if not keyword_set( SKIPLINE ) then skipline = 0
   nlines = nlines - skipline
   if keyword_set( NUMLINE) then nlines = numline < nlines

; Create output arrays according to specified formats

   k = 0L                                     ;Loop over output columns
   for i = 0L, nfmt-1 do begin

       fmt1 = gettok( frmt, ',' )
       if fmt1 EQ '' then fmt1 = 'F'         ;Default is F format
       case strmid(fmt1,0,1) of 
          'A':  idltype(i) = 7          
          'D':  idltype(i) = 5
          'F':  idltype(i) = 4
          'I':  idltype(i) = 2
          'B':  idltype(i) = 1
          'L':  idltype(i) = 3
          'X':  idltype(i) = 0               ;IDL type of 0 ==> to skip column
         ELSE:  message,'Illegal format ' + fmt1 + ' in field ' + strtrim(i,2)
      endcase

; Define output arrays

      if idltype(i) NE 0 then begin
          st = vv(k) + '= make_array(nlines,TYPE = idltype(i) )'  
          tst = execute(st)
          k = k+1
      endif

   endfor

   free_lun,lun
   openr, lun, name, /get_lun
   ngood = 0L

   if skipline GT 0 then $
       for i = 0, skipline-1 do readf, lun, temp        ;Skip any lines

   for j = 0L, nlines-1 do begin

      readf, lun, temp
      if strlen(temp) LT ncol then begin    ;Need at least 1 chr per output line
          ngood = ngood-1
          if not keyword_set(SILENT) then $
                       message,'Skipping Line ' + strtrim(skipline+j+1,2),/INF
          goto, BADLINE 
       endif
    temp = repchr(temp,',','  ')        ;Replace comma delimiters by spaces
    k = 0

    for i = 0L,nfmt-1 do begin

       temp = strtrim(temp,1)                  ;Remove leading spaces
       var = gettok(temp,' ')                  ;Read next field
       if ( idltype(i) NE 0 ) then begin       ;Expecting data?

          if ( idltype(i) NE 7 ) then begin    ;Check for valid numeric data
             tst = strnumber(var,val)          ;Valid number?
             if tst EQ 0 then begin            ;If not, skip this line
                 if not keyword_set(SILENT) then $ 
                      message,'Skipping Line ' + strtrim(skipline+j+1,2),/INF 
                 ngood = ngood-1
                 goto, BADLINE 
             endif
          st = vv(k) + '(ngood) = val'     

         endif else $
           st = vv(k) + '(ngood) = strtrim(var,2)'

      tst = execute(st)
      k = k+1

    endif  

  endfor

BADLINE:  ngood = ngood+1

   endfor

  free_lun,lun
  if ngood EQ 0 then message,'ERROR - No valid lines found for specified format'

  if not keyword_set(SILENT) then $
        message,strtrim(ngood,2) + ' valid lines read', /INFORM  

; Compress arrays to match actual number of valid lines

  if ngood EQ 0 then return

  for i = 0,ncol-1 do begin 
      tst = execute(vv(i) + '='+ vv(i)+ '(0:ngood-1)')
  endfor

  return
  end