;+
; NAME:
;   ANGUNITVEC
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Convert longitude and (co)latitude (RA/Dec) to unit vector
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   U = ANGUNITVEC(LON, LAT, [/DEC])
;
; DESCRIPTION:
;
;   The function ANGUNITVEC converts spherical polar angles into a
;   unit vector.
;
;   The inputs, LON and LAT, describes a point in spherical polar
;   coordinates on the unit sphere.  The output is that point as a
;   unit 3-vector.
;
;   LON is the longitude angle, measured in degrees from +X, with
;   positive angles rotating through +Y.  The range of LON is
;   0 (+X) through 90 (+Y) through 360.
;
;   If DEC=0, LAT represents a colatitude angle, measured in
;   degrees from +Z.  The range of LAT is 0 (+Z) through 
;   180 (-Z).
;
;   If DEC=1, LAT represents a latitude angle ("declination"
;   in astronomy), measured in degrees from the XY equator (positive
;   toward +Z).  The range of LAT is -90 (-Z) through +90 (+Z).
;
;   ANGUNITVEC and UNITVECANG are functional inverses.
;   UNITVECANG(ANGUNITVEC(LON,LAT)) should produce the same LONLAT
;   pairs.
;
; INPUTS:
;
;  LON - input longitude values, scalar or vector.  See above.
;  LAT - input (co)latitude, scalar or vector. See above.
;
; RETURNS:
;
;  The resulting unit vector, either a 3-vector or a 3xN array for N
;  unit vectors.
;
;
; KEYWORD PARAMETERS:
;
;   DEC - if set, then the input LONLAT(1,*) component is latitude;
;         if not set then LONLAT(1,*) is a colatitude.
;
; EXAMPLE:
;
;   print, angunitvec([157.65924,80.052155])
;     ==> [-9.1103345E-01,3.7439942E-01,1.7275169E-01]
;     (compare to example in UNITVECANG)
;
; SEE ALSO
;   UNITVECANG, ANGUNITVEC, CROSSP, QTNORMALIZE
;
; MODIFICATION HISTORY:
;   Written, 1999, CM
;   Documented, 2012-10-02, CM
;
;  $Id: angunitvec.pro,v 1.2 2012/10/02 12:28:13 cmarkwar Exp $
;
;-
; Copyright (C) 1999, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   ARG_PRESENT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Determine whether output parameter has been passed (IDL4 compatibility)
;
; CALLING SEQUENCE:
;   PRESENT = ARG_PRESENT(ARG)
;
; DESCRIPTION: 
;
;   ARG_PRESENT tests whether an argument to a function or procedure
;   can be used as an output parameter.  The behavior of this function
;   is identical to that of the built-in ARG_PRESENT function in IDL
;   version 5 or greater, and is meant to give the same functionality
;   to programs in IDL 4.
;
;   An IDL procedure or function can use ARG_PRESENT to decide whether
;   the value of a positional or keyword parameter will be returned to
;   the calling procedure.  Generally, if the caller did not pass the
;   parameter then there is no need to compute the value to be
;   returned.
;
;   To be a valid output parameter, the caller must have passed a
;   named variable into which the result is stored.  If the caller
;   passed the parameter by value (e.g., an expression or a
;   subscripted array) the value cannot be returned and ARG_PRESENT
;   returns 0.
;
; INPUTS:
;
;   ARG - the parameter to be tested.  It can be either a positional
;         or a keyword parameter.  Passing a normal local variable
;         (i.e., not a passed parameter) will cause ARG_PRESENT to
;         return zero.
;
; RETURNS:
;
;   Returns a value of 1 if ARG is a valid output parameter, and a
;   value of 0 otherwise.
;
;
; EXAMPLE:
;
;   Consider the following procedure:
;      PRO TESTARG, ARG1
;        print, ARG_PRESENT(ARG1)
;      END
;
;   This procedure will print 1 when an ARG1 can be used as an output
;   parameter.  Here are some examples of the results of TESTARG.
;
;      IDL> testarg
;             0
;      IDL> testarg, x      
;             1
;      IDL> testarg, findgen(10)
;             0
;   
;   In the first case, no argument is passed, so ARG1 cannot be a
;   return variable.  In the second case, X is undefined, but it is
;   still a legal named variable capable of receiving an output
;   parameter.  In the third case, FINDGEN(10) is an expression which
;   cannot receive an output parameter.
;
; SEE ALSO:
;
;   ARG_PRESENT in IDL version 5
;
; MODIFICATION HISTORY:
;   Written, CM, 13 May 2000
;   Small documentation and bug fixes, CM, 04 Jul 2000
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   ARRDELETE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Remove a portion of an existing array.
;
; CALLING SEQUENCE:
;   NEWARR = ARRDELETE(INIT, [AT=POSITION,] [LENGTH=NELEM])
;
; DESCRIPTION: 
;
;   ARRDELETE will remove or excise a portion of an existing array,
;   INIT, and return it as NEWARR.  The returned array will never be
;   larger than the initial array.
;
;   By using the keywords AT and LENGTH, which describe the position
;   and number of elements to be excised respectively, any segment of
;   interest can be removed.  By default the first element is removed.
;
; INPUTS:
;
;   INIT - the initial array, which will have a portion deleted.  Any
;          data type, including structures, is allowed.  Regardless of
;          the dimensions of INIT, it is treated as a one-dimensional
;          array.  If OVERWRITE is not set, then INIT itself is
;          unmodified.
;
; KEYWORDS:
;
;   AT - a long integer indicating the position of the sub-array to be
;        deleted.  If AT is non-negative, then the deleted portion
;        will be NEWARR[AT:AT+LENGTH-1].  If AT is negative, then it
;        represents an index counting from then *end* of INIT,
;        starting at -1L.
;        Default: 0L (deletion begins with first element).
;
;  LENGTH - a long integer indicating the number of elements to be
;           removed.  
;
;  OVERWRITE - if set, then INIT will be overwritten in the process of
;              generating the new array.  Upon return, INIT will be
;              undefined.
;
;  COUNT - upon return, the number of elements in the resulting array.
;          If all of INIT would have been deleted, then -1L is
;          returned and COUNT is set to zero.
;
;  EMPTY1 - if set, then INIT is assumed to be empty (i.e., to have
;           zero elements).  The actual value passed as INIT is
;           ignored.
;
; RETURNS:
;
;   The new array, which is always one-dimensional.  If COUNT is zero,
;   then the scalar -1L is returned.
;
; SEE ALSO:
;
;   STORE_ARRAY in IDL Astronomy Library
;
; MODIFICATION HISTORY:
;   Written, CM, 02 Mar 2000
;   Added OVERWRITE and EMPTY1 keyword, CM 04 Mar 2000
;
;  $Id: arrdelete.pro,v 1.2 2001/03/25 18:10:41 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   ARRINSERT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Insert one array into another
;
; CALLING SEQUENCE:
;   NEWARR = ARRINSERT(INIT, INSERT, [AT=POSITION] )
;
; DESCRIPTION: 
;
;   ARRINSERT inserts the contents of one array (INSERT) into
;   another (INIT), and returns the new array (NEWARR).
;
;   ARRINSERT will handle empty lists, which are represented as
;   undefined variables.  If both input arrays are empty, then the
;   scalar -1L is returned, and the keyword COUNT is set to 0L.
;
; INPUTS:
;
;   INIT - the initial array, into which INSERT will be inserted.  Any
;          data type, including structures, is allowed.  Regardless of
;          the dimensions of INIT, it is treated as a one-dimensional
;          array.  If OVERWRITE is not set, then INIT itself is
;          unmodified.
;
;   INSERT - the array to be inserted into INIT, which must be of the
;            same or similar type to INIT.  If INSERT is empty, then
;            INIT is returned unchanged.  Regardless of the dimensions
;            of INSERT, it is treated as a one-dimensional array.
;
; KEYWORDS:
;
;    AT - a long integer indicating the position of the newly inserted
;         sub-array.  If AT is non-negative, then INSERT will appear
;         at NEWARR[AT].  If AT is negative, then INSERT will appear
;         at NEWARR[AT + (N+1)] where N is the number of elements in
;         INIT, which is to say if AT is negative, it indexes from the
;         end side of the array rather than the beginning.  Thus,
;         setting AT=-1 will concatenate INIT and INSERT.
;
;         Default: 0L (INSERT appears at beginning of INIT)
;
;   OVERWRITE - if set, then the initial array INIT will be
;               overwritten by the new array.  Upon exit INIT becomes
;               undefined.
;
;   COUNT - upon return, the number of elements in the resulting
;           array.
;
;  EMPTY1, EMPTY2 - if set, then INIT (for EMPTY1) or INSERT (for
;                   EMPTY2) are assumed to be empty (i.e., to have
;                   zero elements).  The actual values passed as INIT
;                   or INSERT are then ignored.
;
; RETURNS:
;
;   The new array, which is always one-dimensional.  If COUNT is zero,
;   then the scalar -1L is returned.
;
; EXAMPLE:
;
;   X = [1, 2, 3]
;   Y = [4, 5, 6, 7]
;
;   ; Insert Y at the beginning of X
;   result = arrinsert(x, y, at=0)
;      --> result = [4, 5, 6, 7, 1, 2, 3]
;
;   ; Insert Y in the middle of X
;   result = arrinsert(x, y, at=1)
;     --> result = [1, 4, 5, 6, 7, 2, 3]
;
;   ; Append Y at the end of X
;   result = arrinsert(x, y, at=-1)
;     --> result = [1, 2, 3, 4, 5, 6, 7]
;
; SEE ALSO:
;
;   ARRDELETE, STORE_ARRAY in IDL Astronomy Library
;
; MODIFICATION HISTORY:
;   Written, CM, 02 Mar 2000
;   Added OVERWRITE and EMPTY keywords, CM, 04 Mar 2000
;   Improved internal docs, and AT keyword docs, CM, 28 Sep 2000
;   Doc clarifications, CM, 29 Sep 2001
;   Added examples to documentation, CM, 06 Apr 2008
;
;  $Id: arrinsert.pro,v 1.4 2008/07/08 20:24:59 craigm Exp $
;
;-
; Copyright (C) 2000,2001,2008, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CHEBCOEF
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Estimate Chebyshev polynomial coefficients of a function on an interval
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   p = CHEBCOEF(FUNC, PRIVATE, FUNCTARGS=functargs, /DOUBLE, /EXPRESSION, $
;                PRECISION=prec, ERROR=err, NMAX=nmax, INTERVAL=interval, $
;                REDUCE_ALGORITHM=, STATUS=)
;
; DESCRIPTION:
;
;   CHEBCOEF estimates the coefficients for a finite sum of Chebyshev
;   polynomials approximating the function FUNC(x) over an interval.
;   The user can choose the desired precision and maximum number of
;   chebyshev coefficients.
;
;   This routine is intended for functions which can be evaluated to
;   full machine precision at arbitrary abcissae, and which are smooth
;   enough to ensure that the coefficients are a decreasing sequence.
;   For already-tabulated or potentially noisy data, the routines
;   CHEBGRID or CHEBFIT should be used instead.
;
;   The function to be approximated may either be the name of an IDL
;   function (the default behavior), or an IDL expression (using the
;   /EXPRESSION keyword).
;
;   The procedure uses a modified form of the classic algorithm for
;   determining the coefficients, which relies the orthogonality
;   relation for Chebyshev polynomials.  The interval [a,b] is
;   subdivided successively into sets of subintervals of length
;   2^(-k)*(b-a),(k = 0,1,2...). After each subdivision the
;   orthogonality properties of the Chebyshev polynomials with respect
;   to summation over equally-spaced points are used to compute two
;   sets of approximate values of the coefficients cj, one set
;   computed using the end-points of the subintervals, and one set
;   using the mid-points.  Certain convergence requirements must be
;   met before terminating.  If the routine fails to converge with 64
;   coefficents, then the current best-fitting coefficients are
;   returned, along with an error estimate in the ERROR keyword.
;   CHEBCOEF never returns more than 64 coefficients.
;
;   The coefficients may be further refined.  If the keyword
;   REDUCE_ALGORITHM is set to a value of 1, then any high order
;   coefficients below a certain threshold are discarded.  If
;   REDUCE_ALGORITHM is set to 2 (the default), then all coefficients
;   below the threshold are discarded rather than just the high order
;   ones.  The threshold is determined by the PRECISION keyword.
;
; INPUTS:
;
;   FUNC - a scalar string, the name of the function to be
;          approximated, or an IDL string containing an expression to
;          be approximated (if /EXPRESSION is set).
;
;  PRIVATE - any optional variable to be passed on to the function to
;            be integrated.  For functions, PRIVATE is passed as the
;            second positional parameter; for expressions, PRIVATE can
;            be referenced by the variable 'P'.  CHEBCOEF does not
;            examine or alter PRIVATE.
;
; RETURNS:
;
;   An array of Chebyshev coefficients which can be passed to
;   CHEBEVAL.  NOTE: the convention employed here is such that the
;   constant term in the expansion is P(0)*T0(x) (i.e., the convention
;   of Luke), and not P(0)/2 * T0(x).
;
; KEYWORD PARAMETERS:
;
;   DOUBLE - if set, then computations are done in double precision
;            rather than single precision.
;
;   ERROR - upon return, this keyword contains an estimate of the
;           maximum absolute error in the approximation.
;
;   EXPRESSION - if set, then FUNC is an IDL expression to be
;                approximated, rather than the name of a function.
;
;   FUNCTARGS - A structure which contains the parameters to be passed
;               to the user-supplied function specified by FUNCT via
;               the _EXTRA mechanism.  This is the way you can pass
;               additional data to your user-supplied function without
;               using common blocks.  By default, no extra parameters
;               are passed to the user-supplied function.
;
;   INTERVAL - a 2-element vector describing the interval over which
;              the polynomial is to be evaluated.
;              Default: [-1, 1]
;
;   NMAX - a scalar, the maximum number of coefficients to be
;          estimated.   This number may not exceed 64. 
;          Default: 64
;
;   PRECISION - a scalar, the requested precision in the
;               approximation.  Any terms which do not contribute
;               significantly, as defined by this threshold, are
;               discarded.  If the function to be estimated is not
;               well-behaved, then the precision is not guaranteed to
;               reach the desired level.  Default: 1E-7
;
;   REDUCE_ALGORITHM - a scalar integer, describes how insignificant
;               terms are removed from the fit.  If 0, then all terms
;               are kept, and none are dicarded.  If 1, then only
;               trailing terms less than PRECISION are discarded.  If
;               2, then both trailing and intermediate terms less than
;               PRECISION are discarded.
;               Default: 2
;
;   STATUS - upon return, this keyword contains information about the
;            status of the approximation.  A value of -1 indicates bad
;            input values; a value of 0 indicates the required
;            accuracy was not obtained; a value of 1 indicates
;            success.
;
; EXAMPLE:
;
;   x = dindgen(1000)/100     ; Range of 0 to 10
;   p = chebcoef('COS(x)', /expr, interval=[0d, 10d])  ;; Compute coefs
;   y = chebeval(x, p, interval=[0d,10d])              ;; Eval Cheby poly
;   plot, x, y - cos(x)       ; Plot residuals
;
; REFERENCES:
;
;   Abramowitz, M. & Stegun, I., 1965, *Handbook of Mathematical
;     Functions*, 1965, U.S. Government Printing Office, Washington,
;     D.C. (Applied Mathematical Series 55)
;   CERN, 1995, CERN Program Library, Function E406
;   Luke, Y. L., *The Special Functions and Their Approximations*,
;     1969, Academic Press, New York
;
; MODIFICATION HISTORY:
;   Written and documented, CM, June 2001
;   Copyright license terms changed, CM, 30 Dec 2001
;   Added usage message, CM, 20 Mar 2002
;   Changed docs slightly, CM, 25 Mar 2002
;
;  $Id: chebcoef.pro,v 1.6 2002/05/03 18:40:27 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Evaluate a user-supplied expression
function chebcoef_eval, x, p, expression=expr, _EXTRA=extra
  y = 0
  cmd = 'Y = '+expr
  dummy = execute(cmd)
  return, y
end

function chebcoef, f0, priv, functargs=fa, double=double, error=err, $
                   nmax=nmax, interval=interval, precision=prec0, $
                   expression=expr, reduce_algorithm=redalg0, $
                   status=status, indices=igood

  if n_params() EQ 0 then begin
      message, 'USAGE:', /info
      message, 'P = CHEBCOEF(FUNCT, [PRIV,] INTERVAL=[a,b], NMAX=...)', /info
      return, !values.d_nan
  endif

  sz = size(f0)
  err = -1
  if sz(sz(0)+1) NE 7 OR n_elements(f0) NE 1 then begin
      NO_FUNCT:
      message, 'ERROR: FUNCT must be a scalar string', /info
      return, 0
  endif

  ;; Check for empty string
  f = strtrim(f0(0),2)
  if f EQ '' then goto, NO_FUNCT

  ;; Prepare for EXPRESSION if requested
  if keyword_set(expr) then begin
      f = 'CHEBCOEF_EVAL'
      fa = {expression: strtrim(f0(0),2)}
  endif else begin
      f = strtrim(f0(0),2)
  endelse

  ;; Handle error conditions gracefully
  if NOT keyword_set(nocatch) then begin
      catch, catcherror
      if catcherror NE 0 then begin
          catch, /cancel
          message, 'Error detected while approximating '+f, /info
          message, !err_string, /info

          errmsg = 0
          if NOT keyword_set(expr) then begin
              f1 = byte(strupcase(strtrim(f0(0),2)))
              ca = (byte('A'))(0) 
              cz = (byte('Z'))(0) 
              c0 = (byte('0'))(0) 
              c9 = (byte('9'))(0) 
              c_ = (byte('_'))(0) 
              wh = where((f1 GE ca AND f1 LE cz) EQ 0 AND f1 NE c_ $
                         AND (f1 GE c0 AND f1 LE c9) EQ 0, ct)
              if ct GT 0 OR (f1(0) GE c0 AND f1(0) LE c9) then begin
                  message, ('FUNCT appears to be an expression.  Did you '+$
                            'intend to pass the /EXPRESSION keyword?'), /info
                  errmsg = 1
              endif
          endif
          if errmsg EQ 0 then $
            message, ('Please verify that function works and conforms to '+$
                      'the documentation'), /info
          ier = -1L
          return, 0L
      endif
  endif

  if n_elements(prec0) EQ 0 then prec = 1e-7 else prec = prec0(0)
  zero = prec*0.
  if keyword_set(double) then zero = 0D
  if n_elements(interval) LT 2 then interval = zero + [-1., 1.]
  if n_elements(redalg0) EQ 0 then redalg = 2 else redalg = floor(redalg0(0))
  status = -1
  
  a = interval(0)
  b = interval(1)
  hf = zero + 0.5
  eps = prec
  z1 = zero + 1
  z2 = zero + 2
  sz = size(zero)
  if sz(sz(0)+1) EQ 5 then pi = !dpi else pi = !pi

  x0 = [a, b]
  if n_elements(priv) GT 0 then begin
      if n_elements(fa) GT 0 then fv = call_function(f, x0, priv, _EXTRA=fa) $
      else                        fv = call_function(f, x0, priv)
  endif else begin
      if n_elements(fa) GT 0 then fv = call_function(f, x0, _EXTRA=fa) $
      else                        fv = call_function(f, x0)
  endelse
  

  ALFA=HF*(B-A)
  BETA=HF*(B+A)
  C1=fv(0)
  C2=fv(1)
  AC = [C2+C1, C2-C1]
  BC = AC*0

  for i = 1, 7 do begin
      I1=2^(I-1)
      I2=I1-1
      I3=2*I1
      C1=Z2/I1
      C2=PI/I1

      jj = dindgen(i2+1)
      x = alfa*cos((jj+hf)*c2)+beta
      if n_elements(priv) GT 0 then begin
          if n_elements(fa) GT 0 then fv = call_function(f, x, priv, $
                                                         _EXTRA=fa) $
          else                        fv = call_function(f, x, priv)
      endif else begin
          if n_elements(fa) GT 0 then fv = call_function(f, x, _EXTRA=fa) $
          else                        fv = call_function(f, x)
      endelse
      c = fv

      ;; Compute B-coefficients
      for j = 0L, i2 do begin
          F1=J*C2
          F2=-HF*F1
      
          C3=2*COS(F1)
          A2=zero
          A1=zero
          A0=C(I2)

          for K = I2-1,0L,-1 do begin
              A2=A1
              A1=A0
              A0=C(K)+C3*A1-A2
          endfor
          BC(J)=C1*(A0*COS(F1+F2)-A1*COS(F2))
          BC(I1)=zero
      endfor

      c = hf*[ac(0:i1-1)+bc(0:i1-1), rotate(ac(0:i1)-bc(0:i1),2)]
      cc = abs(c)
      cmx = max(cc)
      
      if (CMX GT 0) THEN begin
          CMX=1/CMX
          CC(I3)=HF*CC(I3)
          A0=CC(I2)*CMX
          A1=CC(I1)*CMX
          for J = I1+2,I3 do begin
              A2=CC(J)*CMX
              IF(A0 LE EPS AND A1 LE EPS AND A2 LE EPS) THEN $
                goto, CHEB9
              A0=A1
              A1=A2
          endfor
      ENDIF

      ;; DOUBLE THE NUMBER OF COEFFICIENTS.      
      if i LT 7 then begin
          ac = c(0:i3)
          bc = ac*0
      endif
  endfor

  ;; REQUIRED ACCURACY NOT OBTAINED

  NC=64
  DELTA=total(abs(c(60:nc)))
  message, 'WARNING: Required accuracy not obtained', /info
  status = 0
  goto, CLEANUP

  CHEB9:
  ;; REQUIRED ACCURACY OBTAINED
  ;; SUM NEGLECTED TERMS IN EXPANSION

  status = 1
  DELTA=total(cc(j:i3))

  ;;  CHECK IF FURTHER REDUCTION OF COEFFICIENTS IS POSSIBLE.

  NC=J-1
  REST=EPS-DELTA
  IF (REST GT 0) AND redalg GT 0 THEN begin
      while (CC(NC) LT REST) do begin
          DELTA=DELTA+CC(NC)
          REST=REST-CC(NC)
          NC=NC-1
      endwhile
  ENDIF

  CLEANUP:
  C(0)=HF*C(0)
  p = c(0:nc)
  rest = eps - delta

  if redalg EQ 2 then begin
      wh = where(cc(0:nc) LT prec, ct)
      i = ct-1
      while (i GE 0) AND ((rest GT 0) OR (status EQ 1)) do begin
          delta = delta + cc(wh(i))
          rest  = rest - cc(wh(i))
          p(wh(i)) = 0
          i = i - 1
      endwhile
  endif

  DONE:
  igood = where(p NE 0)
  err = delta
  RETURN, p
end

;+
; NAME:
;   CHEBEVAL
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Evaluate a Chebyshev polynomial on an interval, given the coefficients
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   y = CHEBEVAL(X, P, INTERVAL=interval, DERIVATIVE=deriv)
;
; DESCRIPTION:
;
;   CHEBEVAL computes the values of a Chebyshev polynomial function at
;   specified abcissae, over the interval [a,b].  The user must supply
;   the abcissae and the polynomial coefficients.  The function is of
;   the form:
;
;               N
;       y(x) = Sum p_n T_n(x*)     x in [a,b]
;              i=0
;
;   Where T_n(x*) are the orthogonal Chebyshev polynomials of the
;   first kind, defined on the interval [-1,1] and p_n are the
;   coefficients.  The scaled variable x* is defined on the [-1,1]
;   interval such that (x*) = (2*x - a - b)/(b - a), and x is defined
;   on the [a,b] interval.
;
;   The derivative of the function may be computed simultaneously
;   using the DERIVATIVE keyword.  
;
;   The is some ambiguity about the definition of the first
;   coefficient, p_0, namely, the use of p_0 vs. the use of p_0/2.
;   The p_0 definition of Luke is used in this function.
;
; INPUTS:
;
;   X - a numerical scalar or vector, the abcissae at which to
;       evaluate the polynomial.  If INTERVAL is specified, then all
;       values of X must lie within the interval.
;
;   P - a vector, the Chebyshev polynomial coefficients, as returned
;       by CHEBFIT or CHEBCOEF.
;
; RETURNS:
;
;   An array of function values, evaluated at the abcissae.  The
;   numeric precision is the greater of X or P.
;
; KEYWORD PARAMETERS:
;
;   DERIVATIVE - upon return, a vector containing the derivative of
;                the function at each abcissa is returned in this
;                keyword.
;
;   INTERVAL - a 2-element vector describing the interval over which
;              the polynomial is to be evaluated.
;              Default: [-1, 1]
;
; EXAMPLE:
;
;   x = dindgen(1000)/100     ; Range of 0 to 10
;   p = chebcoef('COS(x)', /expr, interval=[0d, 10d])  ;; Compute coefs
;   y = chebeval(x, p, interval=[0d,10d])              ;; Eval Cheby poly
;   plot, x, y - cos(x)       ; Plot residuals
;
; REFERENCES:
;
;   Abramowitz, M. & Stegun, I., 1965, *Handbook of Mathematical
;     Functions*, 1965, U.S. Government Printing Office, Washington,
;     D.C. (Applied Mathematical Series 55)
;   CERN, 1995, CERN Program Library, Function E407
;   Luke, Y. L., *The Special Functions and Their Approximations*,
;     1969, Academic Press, New York
;
; MODIFICATION HISTORY:
;   Written and documented, CM, June 2001
;   Copyright license terms changed, CM, 30 Dec 2001
;   Added usage message, CM, 20 Mar 2002
;   Return a vector even when P has one element, CM, 22 Nov 2004
;   Fix bug in evaluation of derivatives, CM, 22 Nov 2004
;
;  $Id: chebeval.pro,v 1.6 2004/11/22 07:08:00 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, 2004, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CHEBFIT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Fit Chebyshev polynomial coefficients to a tabulated function
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   p = CHEBFIT(X, Y, ERR, INTERVAL=interval, NMAX=nmax,
;               PRECISION=prec, /EVEN, /ODD, REDUCE_ALGORITHM=)
;
; DESCRIPTION:
;
;   CHEBFIT fits a series of Chebyshev polynomials to a set of
;   tabulated and possibly noisy data points.  The functions MPFIT and
;   CHEBEVAL, available from the above web page, must also be in your
;   IDL path for this function to work properly.  The user can choose
;   the desired precision and maximum number of chebyshev
;   coefficients.
;
;   This function is intended for use on already-tabulated data which
;   are potentially noisy.  The user should never expect more than
;   NPOINTS terms, where NPOINTS is the number of (x,y) pairs.  For
;   functions which can be evaluated to full machine precision at
;   arbitrary abcissae, the routine CHEBCOEF should be used instead.
;   For exact data tabulated on a regular grid, the routine CHEBGRID
;   should be tried.
;
;   The user can also specify that the function is even or odd, using
;   the keywords EVEN or ODD.  This saves computation time because
;   certain terms in the expansion can be ignored.  For the purposes
;   of this function even and odd refer to the symmetry about the
;   center of the interval.
;
;   The algorithm is employed in three steps.  In the first step, the
;   coefficients are estimated at a crude level.  In the second step,
;   it is determined whether certain coefficients are deemed
;   "ignoreable", i.e., they do not contribute significantly to the
;   function and are discarded.  The operation of this step is
;   determined by the REDUCE_ALGORITHM keyword.  Finally, the
;   remaining "good" coefficients are re-fitted to achieve the best
;   fit.
;
; INPUTS:
;
;   X, Y - the x- and y- tabulated values to be fitted.
;
;   ERR - (optional) the y-error bar associated with each (x,y) pair.
;         Default: 1
;
; RETURNS:
;
;   An array of Chebyshev coefficients which can be passed to
;   CHEBEVAL.  NOTE: the convention employed here is such that the
;   constant term in the expansion is P(0)*T0(x) (i.e., the convention
;   of Luke), and not P(0)/2 * T0(x).
;
; KEYWORD PARAMETERS:
;
;   EVEN, ODD - if set, then the fitting routine assumes the function
;               is even or odd, about the center of the interval.
;
;   INTERVAL - a 2-element vector describing the interval over which
;              the polynomial is to be evaluated.
;              Default: [-1, 1]
;
;   NMAX - a scalar, the maximum number of polynomial terms to be
;          fitted at one time.
;          Default: 16
;
;   PRECISION - a scalar, the requested precision in the fit.  Any
;               terms which do not contribute significantly, as
;               defined by this threshold, are discarded.  If the
;               function to be fitted is not well-behaved, then the
;               precision is not guaranteed to reach the desired
;               level.
;               Default: 1E-7
;
;   REDUCE_ALGORITHM - a scalar integer, describes how insignificant
;               terms are removed from the fit.  If 0, then all terms
;               are kept, and none are dicarded.  If 1, then only
;               trailing terms less than PRECISION are discarded.  If
;               2, then both trailing and intermediate terms less than
;               PRECISION are discarded.
;               Default: 2
;
; EXAMPLE:
;
;   x = dindgen(1000)/100     ; Range of 0 to 10
;   y = cos(x) + randomn(seed,1000)*0.01  ; Function with some noise
;   p = chebfit(x, y, interval=[0d,10d])
;   plot, x, y - chebeval(x,p, interval=[0d,10d])
;
; REFERENCES:
;
;   Abramowitz, M. & Stegun, I., 1965, *Handbook of Mathematical
;     Functions*, 1965, U.S. Government Printing Office, Washington,
;     D.C. (Applied Mathematical Series 55)
;   CERN, 1995, CERN Program Library, Function E407
;   Luke, Y. L., *The Special Functions and Their Approximations*,
;     1969, Academic Press, New York
;
; MODIFICATION HISTORY:
;   Written and documented, CM, June 2001
;   Copyright license terms changed, CM, 30 Dec 2001
;   Added usage message, CM, 20 Mar 2002
;   Slight docs change, CM, 25 Mar 2002
;
;  $Id: chebfit.pro,v 1.7 2003/07/20 05:53:44 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Compute residuals for MPFIT
function chebfit_eval, p, interval=interval, nterms=nterms, igood=igood, $
                       _EXTRA=extra

  common chebfit_common, x, y, err

  if n_elements(igood) EQ 0 then begin
      p1 = p
  endif else begin
      p1 = replicate(p(0)*0, nterms)
      p1(igood) = p
  endelse

  ;; Compute the Chebyshev polynomial
  f = chebeval(x, p1, interval=interval)

  ;; Compute the deviates, applying either errors or weights
  if n_elements(err) GT 0 then begin
      result = (y-f)/err
  endif else if n_elements(wts) GT 0 then begin
      result = (y-f)*wts
  endif else begin
      result = (y-f)
  endelse
  
  ;; Make sure the returned result is one-dimensional.
  result = reform(result, n_elements(result), /overwrite)
  return, result
end

function chebfit, x, y, err, nmax=nterms0, interval=interval, $
                  precision=prec, even=even, odd=odd, quiet=quiet, $
                  initialize=init, reduce_algorithm=redalg0, $
                  indices=igood, nocatch=nocatch, $
                  yfit=yfit, perror=perror, bestnorm=bestnorm, dof=dof

  if n_params() EQ 0 then begin
      message, 'USAGE:', /info
      message, 'P = CHEBFIT(X, Y, ERR, INTERVAL=[a,b], NMAX=, ...)', /info
      return, !values.d_nan
  endif

  if n_elements(nterms0) EQ 0 then nterms = 16L $
  else                             nterms = floor(nterms0(0)) > 2L
  nterms = nterms < n_elements(x)
  if n_elements(interval) LT 2 then interval = [-1., 1.]
  if n_elements(prec) EQ 0 then prec = 1.e-7
  if n_elements(redalg0) EQ 0 then redalg = 2 else redalg = floor(redalg0(0))
  if n_elements(quiet) EQ 0 then quiet = 1

  ;; Handle error conditions gracefully
  if NOT keyword_set(nocatch) then begin
      catch, catcherror
      if catcherror NE 0 then begin
          catch, /cancel
          message, 'Error detected while fitting', /info
          message, !err_string, /info
          ier = -1L
          return, 0L
      endif
  endif

  if n_elements(p) LT nterms OR keyword_set(init) then begin
      p = replicate(x(0)*0 + 1, nterms) / (findgen(nterms)+1)^2
      p(0) = total(y)/n_elements(y)
      ;; If mean is *exactly* zero, then shift it off slightly
      if p(0) EQ 0 then p(0) = sqrt(total(y^2))/n_elements(y)/10
  endif
  p0 = p
  igood = lindgen(nterms)

  if keyword_set(even) OR keyword_set(odd) then $
    igood = lindgen(n_elements(p)/2)*2 + keyword_set(odd)
  nt = min([nterms, max(igood)+1])

  ;; Cancel out old common entries
  common chebfit_common, xc, yc, errc
  xc   = 0 & dummy = temporary(xc)
  yc   = 0 & dummy = temporary(yc)
  errc = 0 & dummy = temporary(errc)
  
  xc = x
  yc = y
  if n_elements(err) GT 0 then begin
      errc = err
  endif

  fa = {interval: interval, igood: igood, nterms: nt}
  p1 = mpfit('CHEBFIT_EVAL', p0(igood), functargs=fa, maxiter=5, quiet=quiet)
  p0(igood) = p1

  ;; Look for and remove the insignificant terms from the fit
  if redalg GT 0 then begin
      wh = where(abs(p1) GT prec(0), ct)
      if ct EQ 0 then begin
          ALL_ZERO:
          message, 'WARNING: no significant Chebyshev terms were detected', $
            /info
          p = p0*0
          return, 0L
      endif
      if max(wh) LT n_elements(igood)-1 then begin
          imax = max(wh)
          igood = igood(0:imax)
          p1 = p1(0:imax)
      endif

      if redalg EQ 2 then begin
          wh = where(abs(p1) GT 0.1*prec, ct)
          if ct EQ 0 then goto, ALL_ZERO
          igood = igood(wh)
          p1 = p1(wh)
      endif
  endif

  nt = min([nterms, max(igood)+1])
  fa = {interval: interval, igood: igood, nterms: nt}
  p2 = mpfit('CHEBFIT_EVAL', p1, functargs=fa, maxiter=10, quiet=quiet, $
             perror=dp2, bestnorm=bestnorm, dof=dof)

  xc = 0 & yc = 0 & errc = 0
  p = p0*0 
  perror = p
  p(igood) = p2
  perror(igood) = dp2

  if arg_present(yfit) then $
    yfit = chebeval(x, p, interval=interval)

  return, p
end
;+
; NAME:
;   CHEBGRID
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Estimate Chebyshev polynomial coefficients of a function on a grid
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   p = CHEBGRID(T, X, [ DXDT, NPOINTS=, NPOLY=, NGRANULE= , $
;                RMS=, DRMS=, RESIDUALS=, DRESIDUALS= , $
;                XMATRIX=, DXMATRIX=, RESET=, 
;                DERIV_WEIGHT= ] )
;
; DESCRIPTION:
;
;   CHEBGRID estimates the coefficients for a finite sum of Chebyshev
;   polynomials approximating a continuous tabulated function over an
;   interval.  The function (and optionally its derivative) must be
;   tabulated on a regularly sampled grid.  The implementation of this
;   function is taken from a method described by X. X. Newhall, used
;   in estimating coefficients for ephemerides in the solar system.
;
;   The tabulated function is assumed to be continuous over the entire
;   interval.  A Chebyshev series is fitted to the function over small
;   segments, called granules.  The size of each granule, the number
;   of points in each granule, and the number of Chebyshev polynomials
;   are all configurable.
;
;   Users may specify either the function alone, or the function and
;   its first derivative.  By also giving the tabulated derivative, a
;   more accurate Chebyshev polynomial can be developed.  Aside from
;   the constraints mentioned in the next paragraph, the polynomial
;   that is returned is the best-fit polynomial in a least-squares
;   sense.
;
;   Here is a definition of terms:
;
;      GRANULE - a single continuous fitted segment.  The length of the
;         granule, NGRANULE, is specified in units of the tabulated
;         grid size.  Because of the continuity requirements developed
;         below, granules will always overlap at their endpoints.
;         Thus, then length of a granule should be a factor of
;         N_ELEMENTS(X)-1.  For simple functions over short intervals,
;         the granule size can be equal to N_ELEMENTS(X)-1
;
;      NUMBER OF POINTS the number of points, NPOINTS, within a
;         granule to be fitted to the polynomial, not necessarily
;         equal to the granule size.  The greater the number of
;         points, the more computation time and storage is required.
;         This number *must* be a factor of NGRANULE.  Typically
;         NPOINTS is a number between 8 and 12.  Because of the
;         single-point overlap between granules (see below), the
;         actual number of points per fit is NPOINTS+1.
;
;      NUMBER OF POLYNOMIALS the number of Chebyshev polynomial terms,
;         NPOLYNOMIAL, to be fitted per granule.  The greater the
;         number of polynomial terms, the more computation time and
;         storage is required, but also the greater the approximating
;         precision of the fit.
;
;   The particular set of Chebyshev polynomial coefficients developed
;   by this function have some special properties.  If both the
;   function and its derivative are specified, then the value and
;   derivative of the interpolating polynomial at the granule
;   endpoints will be exactly equal to the tabulated endpoint values.
;   This feature allows many approximations to be strung together
;   piecewise, and the function value and first derivative will be
;   continuous across granule boundaries.
;
;   If only the function value is specified, then only the function
;   value will be continuous at the granule endpoints, and not the
;   derivative.
;
;   An extensive set of statistics are computed to assess the quality
;   of the Chebyshev polynomial fit.  The keywords RESIDUALS and
;   DRESIDUALS return the residuals of the fit after subtracting the
;   interpolation.  The RMS and DRMS keywords return the root mean
;   squared deviations between data and model.
;
;   If the user does not know how many granules, points, or polynomial
;   coefficients to use, then he or she should try several
;   combinations and see which minimizes the r.m.s. value with the
;   fewest number of coefficients.
;
;   If the XMATRIX and DXMATRIX keywords are passed, then CHEBGRID
;   attempts to avoid recomputing several of the matrices it uses in
;   estimating the coefficients.  If multiple calls to CHEBGRID are to
;   be made, some compution time savings can be made.  In the first
;   call CHEBGRID the required matrices are computed and returned.  In
;   subsequent calls, CHEBGRID detects the XMATRIX and DXMATRIX
;   keyword values and uses those values if it can.
;
;   The user can also estimate their own coefficients.  The matrices
;   returned are (NPOINTS+1)x(NPOLYNOMIAL).  The coefficients from a
;   NPOINTS+1 tabulation, X, are found by:
;
;      PCHEB = XMATRIX ## X  +  DXMATRIX ## DXDT
;
;   if derivative information is known, or
;
;      PCHEB = XMATRIX ## X
;
;   if no derivative information is known.  [ Note: the matrices are
;   different, depending on whether derivative information is known or
;   not. ]
;
;   
; INPUTS:
;
;   T - array of regularly sampled *independent* variables.  The number
;       of elements in T should be a multiple of NGRANULE, plus one.
;
;   X - array of regularly sampled *dependent* variables.  The number
;       of elements in X should be equal to the number of elements in
;       T.
;
;   DXDT - optionally, a tabulated array of first derivatives of X
;          with respect to T, at the same grid points.
;
; KEYWORD PARAMETERS:
;
;   NGRANULE - size of a "granule", in grid intervals.  NGRANULE must
;              be at least 2, and a factor of N_ELEMENTS(T)-1.
;              Default: 8
;
;   NPOINTS - number of points per granule that are fitted.  NPOINTS
;             must be at least 2, and a factor of NGRANULE. 
;             Default: NGRANULE
;
;   NPOLYNOMIAL - number of Chebyshev polynomial terms per fit.
;                 NPOLYNOMIAL must be at least 2 and less than
;                 2*(NPOINTS+1), when derivative information is
;                 specified; or less than NPOINTS+1, when no
;                 derivative information is specified.
;                 Default: 7
;
;  RESIDUALS - upon return, an array of size N_ELEMENTS(T), with
;              residuals of the tabulated function minus the
;              interpolated function.
;
;  DRESIDUALS - same as RESIDUALS, but for the function's first
;               derivative.
;
;  RMS - upon return, the root mean square of the function value
;        residuals.
;
;  DRMS - same as RMS, but for the function's first derivative.
;
;  XMATRIX - upon return, the matrix used to compute Chebyshev
;            polynomial coefficients from the function value.
;
;            Upon input, CHEBGRID determines if XMATRIX will apply to
;            the data, and if so, XMATRIX is reused rather than
;            computed.  If XMATRIX cannot be reused, then it is
;            computed afresh, and the new value is returned in the
;            XMATRIX keyword.
;
;            The user should not modify the contents of this array.
;
;  DXMATRIX - same as XMATRIX, but for the function's first
;             derivative.
;
;  RESET - if set, force a recomputation of XMATRIX and/or DXMATRIX.
;
;  DERIV_WEIGHT - amount of weight to give to function derivative,
;                 relative to the function value.
;                 Default: 0.16d
;
;
; RETURNS:
;
;   An array of coefficient values.  The dimensions of the array are
;   NPOLYNOMIALxNSEGS, where NSEGS is the number of granules in the
;   entire interval.
;
;
; EXAMPLE:
;
;   ;; Estimate Chebyshev coefficients for the function SIN(X), on the
;   ;; interval [-1,+1].  
;   xx = dindgen(9)/4d - 1d   ;; Regular grid from -1 to 1 (9 points)
;   yy = sin(xx)              ;; Function values, sin(x), ...
;   dy = cos(xx)              ;; ... and derivatives
;
;   ;; Estimate coefficients using CHEBGRID (single granule of 8 intervals)
;   p = chebgrid(xx, yy, dy, npoints=8, ngranule=8, npoly=10)
;
;   xxx = dindgen(1001)/500 - 1d   ;; New grid for testing
;   res = sin(xxx) - chebeval(xxx, p)
;   plot, xxx, res
;
;   ;; Same as example above, except extended range to [-1, +15],
;   using eight granules.
;   xx2 = dindgen(65)/4d - 1
;   yy2 = sin(xx2)
;   dy2 = cos(xx2)
;   p = chebgrid(xx2, yy2, dy2, ngranule=8, npoint=8, npoly=10)
;   help, p
;       P               DOUBLE    = Array[10, 8]
;   ;; (i.e., 10 polynomial coefficients over 8 granules)
;
;
; REFERENCES:
;
;   Abramowitz, M. & Stegun, I., 1965, *Handbook of Mathematical
;     Functions*, 1965, U.S. Government Printing Office, Washington,
;     D.C. (Applied Mathematical Series 55)
;   Newhall, X. X. 1989, Celestial Mechanics, 45, p. 305-310
;
; MODIFICATION HISTORY:
;   Written, CM, Feb 2002
;   Documented, CM, 24 Mar 2002
;   Corrected documentation, CM, 28 Apr 2002
;   Typo correction, CM, 10 Oct 2002
;
;  $Id: chebgrid.pro,v 1.5 2002/11/07 00:15:23 craigm Exp $
;
;-
; Copyright (C) 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Utility function: compute XMATRIX and DXMATRIX using Newhall approach
pro chebpcmat, npts, npoly, xmat, vmat, dweight=weight0

  ;; n0 is the number of intervals in Cheb approx.
  n0 = npts - 1
  if n_elements(weight0) EQ 0 then $
    weight = 0.16d $
  else $
    weight = weight0(0)

  tmat = dblarr(npoly, npts)
  tdot = tmat

  cj = dblarr(npoly)
  xj = 1d - 2d*dindgen(npts)/n0
  for i = 0, npoly-1 do begin
      cj(*) = 0 & cj(i) = 1
      tmat(i,*) = chebeval(xj, cj, deriv=v)
      tdot(i,*) = v
  endfor

  ;; Form matrix T*W
  tw = dblarr(2,npts,npoly)
  tw(0,*,*) = transpose(tmat)
  tw(1,*,*) = transpose(tdot) * weight

  ;; Form matrix T*WT
  twt = reform(tw(0,*,*),npts,npoly) ## tmat + $
    reform(tw(1,*,*),npts,npoly) ## tdot

  tw  = reform(tw, 2*npts, npoly, /overwrite)
  twt = reform(twt, npoly, npoly, /overwrite)

  ;; Augment matrix T*W to get matrix C2
  c2 = dblarr(2*npts,npoly+4)
  c2(*,0:npoly-1) = tw
  c2(0,npoly)          = 1 & c2(1,npoly+1)        = 1
  c2(2*npts-2,npoly+2) = 1 & c2(2*npts-1,npoly+3) = 1

  ;; Augment matrix T*WT to get the matrix C1
  c1 = dblarr(npoly+4,npoly+4)
  c1(0:npoly-1,0:npoly-1) = twt

  c1(0:npoly-1,npoly+0) = tmat(*,0)
  c1(0:npoly-1,npoly+1) = tdot(*,0)
  c1(0:npoly-1,npoly+2) = tmat(*,npts-1)
  c1(0:npoly-1,npoly+3) = tdot(*,npts-1)

  c1(npoly:*,0:npoly-1) = transpose(c1(0:npoly-1,npoly:*))

  ;; Compute matrix C1^(-1)
  c1inv = invert(c1)
  ;; Compute matrix C1^(-1) C2
  c1c2 = c1inv ## c2

  c1c2 = reform(c1c2, 2,npts,npoly+4)
  c1c2 = reverse(c1c2,2)
  c1c2 = reform(c1c2, 2*npts,npoly+4)

  ii = lindgen(npts)*2
  xmat = c1c2(ii,0:npoly-1)   ;; Split into terms multiplying Y and VY
  vmat = c1c2(ii+1,0:npoly-1)

  return
end

;; Utility function: compute XMATRIX only, using only the constraint
;; on the function values at the endpoints.
pro chebpcmat_xonly, npts, npoly, xmat

  ;; n0 is the number of points in Cheb approx.
  n0 = npts - 1
  
  tmat = dblarr(npoly, npts)

  cj = dblarr(npoly)
  xj = 1d - 2d*dindgen(npts)/n0
  for i = 0, npoly-1 do begin
      cj(*) = 0 & cj(i) = 1
      tmat(i,*) = chebeval(xj, cj, deriv=v)
  endfor

  ;; Augment matrix T to get matrix C2
  c2 = dblarr(npts,npoly+2)
  c2(*,0:npoly-1) = transpose(tmat)
  c2(0,npoly)     = 1
  c2(npts-1,npoly+1) = 1

  ;; Augment matrix T*WT to get the matrix C1
  c1 = dblarr(npoly+2,npoly+2)
  c1(0:npoly-1,0:npoly-1) = transpose(tmat) ## tmat

  c1(0:npoly-1,npoly+0) = tmat(*,0)
  c1(0:npoly-1,npoly+1) = tmat(*,npts-1)

  c1(npoly:*,0:npoly-1) = transpose(c1(0:npoly-1,npoly:*))

  ;; Compute matrix C1^(-1)
  c1inv = invert(c1)
  ;; Compute matrix C1^(-1) C2
  c1c2 = c1inv ## c2

  c1c2 = reform(c1c2, npts,npoly+2)
  c1c2 = reverse(c1c2,1)
  xmat = c1c2(*,0:npoly-1)

  return
end

function chebgrid, t, x, dxdt, ngranule=ngran0, npoints=npts0, $
                   npolynomial=npoly0, deriv_weight=dweight0, $
                   rms=rms, drms=drms, residuals=resid, dresiduals=dresid, $
                   xmatrix=xmatrix, dxmatrix=dxmatrix, reset=reset

  ;; Default processing
  if n_elements(ngran0) EQ 0 then ngran = 8 $
  else ngran = round(ngran0(0)) > 2

  if n_elements(npts0) EQ 0 then npts = ngran $
  else npts = round(npts0(0)) > 2

  if n_elements(npoly0) EQ 0 then npoly = 7 $
  else npoly = round(npoly0(0)) > 2

  ;; Error checking
  if ngran LT npts then begin
      message, 'ERROR: Granule size ('+strtrim(ngran,2)+') is too '+ $
        'small for number of samples ('+strtrim(npts,2)+')'
      return, !values.d_nan
  endif
  
  ;; Be sure NGRAN is a multiple of NPTS - or not.  Instead, a warning
  ;; message is printed in the loop.
;  if abs(double(ngran)/npts - round(ngran/npts)) GT 1d-5 then begin
;      message, 'ERROR: NPOINTS must be a multiple of NGRANULE'
;      return, !values.d_nan
;  endif
  
  ;; Be sure we are solving a least-squares problem.  If the number of
  ;; polynomials is too great then it becomes underconstrained, not
  ;; overconstrained.
  if n_elements(dxdt) GT 0 then begin
      if npoly GE 2*(npts+1) then $
        message, 'ERROR: NPOLYNOMIAL must be less than 2*(NPOINTS+1)'
  endif else begin
      if npoly GE npts+1 then $
        message, 'ERROR: NPOLYNOMIAL must be less than NPOINTS+1'
  endelse
  
  ;; Begin size checking of input matrices - we may be able to use the
  ;; previously computed version.
  szx = size(xmatrix)
  szv = size(dxmatrix)

  ;; Cases: recompute because existing X matrix is wrong size;
  ;;        recompute because existing V matrix is wrong size;
  ;;        recompute because a V matrix was passed, but no DXDT was
  redo_x = (szx(0) NE 2 OR szx(1) NE npts+1 OR szx(2) NE npoly)
  redo_v = (n_elements(dxdt) GT 0 AND $
            (szv(0) NE 2 OR szv(1) NE npts+1 OR szv(2) NE npoly))
  no_v = (n_elements(dxdt) EQ 0 AND n_elements(dxmatrix) GT 0)

  ;; Actual recomputation of matrices
  if redo_x OR redo_v OR no_v OR keyword_set(reset) then begin
      COMPUTE_CHEBMAT:
      xmatrix = 0 & dummy = temporary(xmatrix)
      dxmatrix = 0 & dummy = temporary(dxmatrix)

      if n_elements(dxdt) GT 0 then $
        chebpcmat, npts+1, npoly, xmatrix, dxmatrix, dweight=dweight0 $
      else $
        chebpcmat_xonly, npts+1, npoly, xmatrix
  endif

  rms = 0.*x(0)
  drms = rms
  chebm = dblarr(npoly, (n_elements(x)-1)/ngran)
  resid = x*0.
  dresid = resid

  ispan = lindgen(npts+1)*(ngran/npts)
  imax = max(ispan)
  ng = 0L
  for ibase = 0, n_elements(x)-1, ngran do begin
      if ibase EQ n_elements(x)-1 then goto, DONE
      if n_elements(x)-ibase LT ngran+1 then begin
          nlost = n_elements(x)-ibase
          message, 'WARNING: last '+strtrim(nlost,2)+' elements of X '+$
            'were discarded because they formed only a fractional granule.', $
            /info
          goto, DONE
      endif

      tspan  = [t(ibase), t(ibase+imax)]
      tgran = t(ibase:ibase+imax-1)-t(ibase)
      dt     = tspan(1) - tspan(0)
      tspan  = tspan - tspan(0)

      ;; Compute the X portion of the coefficients
      xgran  = x(ibase+ispan)
      chebi  = xmatrix ## xgran

      ;; Compute the DXDT portion if it is available
      if n_elements(dxdt) GT 0 then begin
          dxgran = dxdt(ibase+ispan) * dt/2.
          chebi = chebi + dxmatrix ## dxgran

          ;; Statistics - V first, then X comes later
          xmod = chebeval(tgran, chebi, interval=tspan, derivative=dxmod)

          ;; DXDT portion of statistics
          dresid(ibase:ibase+imax-1) = dxdt(ibase:ibase+imax-1) -  dxmod
          diff_dx = (dxdt(ibase:ibase+imax-1) - dxmod)^2
          drms = drms + total(diff_dx)

      endif else begin
          ;; Statistics - X only

          xmod = chebeval(tgran, chebi, interval=tspan)
      endelse

      ;; Finish statistics with X portion
      resid(ibase:ibase+imax-1) = x(ibase:ibase+imax-1) -  xmod
      diff_x  = (   x(ibase:ibase+imax-1) -  xmod)^2
      rms  =  rms + total(diff_x)

      ;; Append to existing coefficient list
      chebm(*,ng) = chebi(*)
      ng = ng + 1L
  endfor
  
  DONE:
  ;; Final adjustments to statistics
  rms  = sqrt( rms / ngran)
  if n_elements(dxdt) GT 0 then drms = sqrt(drms / ngran)

  return, chebm
end
;+
; NAME:
;   CMAPPLY
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Applies a function to specified dimensions of an array
;
; MAJOR TOPICS:
;   Arrays
;
; CALLING SEQUENCE:
;   XX = CMAPPLY(OP, ARRAY, DIMS, [/DOUBLE], [TYPE=TYPE])
;
; DESCRIPTION:
;   CMAPPLY will apply one of a few select functions to specified 
;   dimensions of an array.  Unlike some IDL functions, you *do* have
;   a choice of which dimensions that are to be "collapsed" by this
;   function.  Iterative loops are avoided where possible, for 
;   performance reasons.
;
;   The possible functions are:             (and number of loop iterations:)
;     +     - Performs a sum (as in TOTAL)       number of collapsed dimensions
;     AND   - Finds LOGICAL "AND" (not bitwise)  same
;     OR    - Finds LOGICAL "OR"  (not bitwise)  same
;     *     - Performs a product                 LOG_2[no. of collapsed elts.]
;
;     MIN   - Finds the minimum value            number of collapsed dimensions
;     MAX   - Finds the maximum value            same
;     MEDIAN- Finds the median  value            same
;
;     USER  - Applies user-defined function      no. of output elements
;
;
;   It is possible to perform user-defined operations arrays using
;   CMAPPLY.  The OP parameter is set to 'USER:FUNCTNAME', where
;   FUNCTNAME is the name of a user-defined function.  The user
;   defined function should be defined such that it accepts a single
;   parameter, a vector, and returns a single scalar value.  Here is a
;   prototype for the function definition:
;
;      FUNCTION FUNCTNAME, x, KEYWORD1=key1, ...
;         scalar = ... function of x or keywords ...
;         RETURN, scalar
;      END
;
;   The function may accept keywords.  Keyword values are passed in to
;   CMAPPLY through the FUNCTARGS keywords parameter, and passed to
;   the user function via the _EXTRA mechanism.  Thus, while the
;   definition of the user function is highly constrained in the
;   number of positional parameters, there is absolute freedom in
;   passing keyword parameters.
;
;   It's worth noting however, that the implementation of user-defined
;   functions is not particularly optimized for speed.  Users are
;   encouraged to implement their own array if the number of output
;   elements is large.
;
;
; INPUTS:
;
;   OP - The operation to perform, as a string.  May be upper or lower
;        case.
;
;        If a user-defined operation is to be passed, then OP is of
;        the form, 'USER:FUNCTNAME', where FUNCTNAME is the name of
;        the user-defined function.
;
;   ARRAY - An array of values to be operated on.  Must not be of type
;           STRING (7) or STRUCTURE (8).
;
; OPTIONAL INPUTS:
;
;   DIMS - An array of dimensions that are to be "collapsed", where
;          the the first dimension starts with 1 (ie, same convention
;          as IDL function TOTAL).  Whereas TOTAL only allows one
;          dimension to be added, you can specify multiple dimensions
;          to CMAPPLY.  Order does not matter, since all operations
;          are associative and transitive.  NOTE: the dimensions refer
;          to the *input* array, not the output array.  IDL allows a 
;          maximum of 8 dimensions.
;          DEFAULT: 1 (ie, first dimension)
;
; KEYWORDS:
;
;   DOUBLE - Set this if you wish the internal computations to be done
;            in double precision if necessary.  If ARRAY is double 
;            precision (real or complex) then DOUBLE=1 is implied.
;            DEFAULT: not set
;
;   TYPE - Set this to the IDL code of the desired output type (refer
;          to documentation of SIZE()).  Internal results will be
;          rounded to the nearest integer if the output type is an
;          integer type.
;          DEFAULT: same is input type
;
;   FUNCTARGS - If OP is 'USER:...', then the contents of this keyword
;               are passed to the user function using the _EXTRA
;               mechanism.  This way you can pass additional data to
;               your user-supplied function, via keywords, without
;               using common blocks.
;               DEFAULT: undefined (i.e., no keywords passed by _EXTRA)
;
; RETURN VALUE:
;
;   An array of the required TYPE, whose elements are the result of
;   the requested operation.  Depending on the operation and number of
;   elements in the input array, the result may be vulnerable to
;   overflow or underflow.
;
; EXAMPLES:
;   Shows how CMAPPLY can be used to total the second dimension of the
;   array called IN.  This is equivalent to OUT = TOTAL(IN, 2)
;
;   IDL> IN  = INDGEN(5,5)
;   IDL> OUT = CMAPPLY('+', IN, [2])
;   IDL> HELP, OUT
;   OUT             INT       = Array[5]
;
;   Second example.  Input is assumed to be an 5x100 array of 1's and
;   0's indicating the status of 5 detectors at 100 points in time.
;   The desired output is an array of 100 values, indicating whether
;   all 5 detectors are on (=1) at one time.  Use the logical AND
;   operation.
;
;   IDL> IN = detector_status             ; 5x100 array
;   IDL> OUT = CMAPPLY('AND', IN, [1])    ; collapses 1st dimension
;   IDL> HELP, OUT
;   OUT             BYTE      = Array[100]
;
;   (note that MIN could also have been used in this particular case,
;   although there would have been more loop iterations).
;
;   Third example.  Shows sum over first and third dimensions in an
;   array with dimensions 4x4x4:
;
;   IDL> IN = INDGEN(4,4,4)
;   IDL> OUT = CMAPPLY('+', IN, [1,3])
;   IDL> PRINT, OUT
;        408     472     536     600
;
;   Fourth example. A user-function (MEDIAN) is used:
;
;   IDL> IN = RANDOMN(SEED,10,10,5)
;   IDL> OUT = CMAPPLY('USER:MEDIAN', IN, 3)
;   IDL> HELP, OUT
;   OUT             FLOAT     = Array[10, 10]
;
;   (OUT(i,j) is the median value of IN(i,j,*))
;
; MODIFICATION HISTORY:
;   Mar 1998, Written, CM
;   Changed usage message to not bomb, 24 Mar 2000, CM
;   Signficant rewrite for *, MIN and MAX (inspired by Todd Clements
;     <Todd_Clements@alumni.hmc.edu>); FOR loop indices are now type
;     LONG; copying terms are liberalized, CM, 22, Aug 2000
;   More efficient MAX/MIN (inspired by Alex Schuster), CM, 25 Jan
;     2002
;   Make new MAX/MIN actually work with 3d arrays, CM, 08 Feb 2002
;   Add user-defined functions, ON_ERROR, CM, 09 Feb 2002
;   Correct bug in MAX/MIN initialization of RESULT, CM, 05 Dec 2002
;   Correct bug in CMAPPLY_PRODUCT implementation when there are an
;     odd number of values to combine, CM 26 Jul 2006
;   Add fast IDL versions of '*', 'MEDIAN', 'MIN' and 'MAX', where
;     IDL supports it, CM 26 Jul 2006
;
;  $Id: cmapply.pro,v 1.6 2006/07/26 19:34:24 craigm Exp $
;
;-
; Copyright (C) 1998, 2000, 2002, 2006, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Utility function, adapted from CMPRODUCT
function cmapply_product, x
  sz = size(x)
  n = sz(1)

  while n GT 1 do begin
      if (n mod 2) EQ 1 then x(0,*) = x(0,*) * x(n-1,*)
      n2 = floor(n/2)
      x = x(0:n2-1,*) * x(n2:n2*2-1,*)
      n = n2
  endwhile
  return, reform(x(0,*), /overwrite)
end

;; Utility function, used to collect collaped dimensions
pro cmapply_redim, newarr, dimapply, dimkeep, nkeep, totcol, totkeep
  sz = size(newarr)
  ;; First task: rearrange dimensions so that the dimensions
  ;; that are "kept" (ie, uncollapsed) are at the back
  dimkeep = where(histogram(dimapply,min=1,max=sz(0)) ne 1, nkeep)
  if nkeep EQ 0 then return

  newarr = transpose(temporary(newarr), [dimapply-1, dimkeep])
  ;; totcol is the total number of collapsed elements
  totcol = sz(dimapply(0))
  for i = 1, n_elements(dimapply)-1 do totcol = totcol * sz(dimapply(i))
  totkeep = sz(dimkeep(0)+1)
  for i = 1, n_elements(dimkeep)-1 do totkeep = totkeep * sz(dimkeep(i)+1)

  ;; this new array has two dimensions:
  ;;   * the first, all elements that will be collapsed
  ;;   * the second, all dimensions that will be preserved
  ;; (the ordering is so that all elements to be collapsed are
  ;;  adjacent in memory)
  newarr = reform(newarr, [totcol, totkeep], /overwrite)
end

;; Main function
function cmapply, op, array, dimapply, double=dbl, type=type, $
                  functargs=functargs, nocatch=nocatch

  if n_params() LT 2 then begin
      message, "USAGE: XX = CMAPPLY('OP',ARRAY,2)", /info
      message, '       where OP is +, *, AND, OR, MIN, MAX', /info
      return, -1L
  endif
  if NOT keyword_set(nocatch) then $
    on_error, 2 $
  else $
    on_error, 0

  version = double(!version.release)
;  version = 0
;  print, 'version = ',version

  ;; Parameter checking
  ;; 1) the dimensions of the array
  sz = size(array)
  if sz(0) EQ 0 then $
    message, 'ERROR: ARRAY must be an array!'

  ;; 2) The type of the array
  if sz(sz(0)+1) EQ 0 OR sz(sz(0)+1) EQ 7 OR sz(sz(0)+1) EQ 8 then $
    message, 'ERROR: Cannot apply to UNDEFINED, STRING, or STRUCTURE'
  if n_elements(type) EQ 0 then type = sz(sz(0)+1)

  ;; 3) The type of the operation
  szop = size(op)
  if szop(szop(0)+1) NE 7 then $
    message, 'ERROR: operation OP was not a string'

  ;; 4) The dimensions to apply (default is to apply to first dim)
  if n_params() EQ 2 then dimapply = 1
  dimapply = [ dimapply ]
  dimapply = dimapply(sort(dimapply))   ; Sort in ascending order
  napply = n_elements(dimapply)

  ;; 5) Use double precision if requested or if needed
  if n_elements(dbl) EQ 0 then begin
      dbl=0
      if type EQ 5 OR type EQ 9 then dbl=1
  endif

  newop = strupcase(op)
  newarr = array
  newarr = reform(newarr, sz(1:sz(0)), /overwrite)
  case 1 of

      ;; *** Addition
      (newop EQ '+'): begin
          for i = 0L, napply-1 do begin
              newarr = total(temporary(newarr), dimapply(i)-i, double=dbl)
          endfor
      end

      ;; *** Multiplication
      (newop EQ '*'): begin ;; Multiplication (by summation of logarithms)
          forward_function product

          cmapply_redim, newarr, dimapply, dimkeep, nkeep, totcol, totkeep
          if nkeep EQ 0 then begin
              newarr = reform(newarr, n_elements(newarr), 1, /overwrite)
              if version GT 5.55 then return, product(newarr)
              return, (cmapply_product(newarr))(0)
          endif

          if version GT 5.55 then begin
              result = product(newarr,1)
          endif else begin
              result = cmapply_product(newarr)
          endelse
          result = reform(result, sz(dimkeep+1), /overwrite)
          return, result
      end

      ;; *** LOGICAL AND or OR
      ((newop EQ 'AND') OR (newop EQ 'OR')): begin
          newarr = temporary(newarr) NE 0
          totelt = 1L
          for i = 0L, napply-1 do begin
              newarr = total(temporary(newarr), dimapply(i)-i)
              totelt = totelt * sz(dimapply(i))
          endfor
          if newop EQ 'AND' then return, (round(newarr) EQ totelt)
          if newop EQ 'OR'  then return, (round(newarr) NE 0)
      end

      ;; Operations requiring a little more attention over how to
      ;; iterate
      ((newop EQ 'MAX') OR (newop EQ 'MIN') OR (newop EQ 'MEDIAN')): begin
          cmapply_redim, newarr, dimapply, dimkeep, nkeep, totcol, totkeep
          if nkeep EQ 0 then begin
              if newop EQ 'MAX' then return, max(newarr)
              if newop EQ 'MIN' then return, min(newarr)
              if newop EQ 'MEDIAN' then return, median(newarr)
          endif

          ;; IDL 5.5 introduced the DIMENSION keyword to MAX() and MIN()
          if version GT 5.45 then begin
              extra = {dimension:1}
              if newop EQ 'MAX' then result = max(newarr, _EXTRA=extra)
              if newop EQ 'MIN' then result = min(newarr, _EXTRA=extra)
              if newop EQ 'MEDIAN' then result = median(newarr, _EXTRA=extra)
          endif else begin
              
              ;; Next task: create result array
              result = make_array(totkeep, type=type)
              
              ;; Now either iterate over the number of output elements, or
              ;; the number of collapsed elements, whichever is smaller.
              if (totcol LT totkeep) AND newop NE 'MEDIAN' then begin
                  ;; Iterate over the number of collapsed elements
                  result(0) = reform(newarr(0,*),totkeep,/overwrite)
                  case newop of 
                      'MAX': for i = 1L, totcol-1 do $
                        result(0) = result > newarr(i,*)
                      'MIN': for i = 1L, totcol-1 do $
                        result(0) = result < newarr(i,*)
                  endcase
              endif else begin
                  ;; Iterate over the number of output elements
                  case newop of 
                      'MAX': for i = 0L, totkeep-1 do result(i) = max(newarr(*,i))
                      'MIN': for i = 0L, totkeep-1 do result(i) = min(newarr(*,i))
                      'MEDIAN': for i = 0L, totkeep-1 do result(i) = median(newarr(*,i))
                  endcase
              endelse
          endelse

          result = reform(result, sz(dimkeep+1), /overwrite)
          return, result
      end

      ;; User function
      (strmid(newop,0,4) EQ 'USER'): begin
          functname = strmid(newop,5)
          if functname EQ '' then $
            message, 'ERROR: '+newop+' is not a valid operation'

          cmapply_redim, newarr, dimapply, dimkeep, nkeep, totcol, totkeep
          if nkeep EQ 0 then begin
              if n_elements(functargs) GT 0 then $
                return, call_function(functname, newarr, _EXTRA=functargs)
              return, call_function(functname, newarr)
          endif
          
          ;; Next task: create result array
          result = make_array(totkeep, type=type)
          
          ;; Iterate over the number of output elements
          if n_elements(functargs) GT 0 then begin
              for i = 0L, totkeep-1 do $
                result(i) = call_function(functname, newarr(*,i), _EXTRA=functargs)
          endif else begin
              for i = 0L, totkeep-1 do $
                result(i) = call_function(functname, newarr(*,i))
          endelse

          result = reform(result, sz(dimkeep+1), /overwrite)
          return, result
      end

              
  endcase

  newsz = size(newarr)
  if type EQ newsz(newsz(0)+1) then return, newarr

  ;; Cast the result into the desired type, if necessary
  castfns = ['UNDEF', 'BYTE', 'FIX', 'LONG', 'FLOAT', $
             'DOUBLE', 'COMPLEX', 'UNDEF', 'UNDEF', 'DCOMPLEX' ]
  if type GE 1 AND type LE 3 then $
    return, call_function(castfns(type), round(newarr)) $
  else $
    return, call_function(castfns(type), newarr)
end
  
;+
; NAME:
;   ARG_PRESENT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Determine whether output parameter has been passed (IDL4 compatibility)
;
; CALLING SEQUENCE:
;   PRESENT = ARG_PRESENT(ARG)
;
; DESCRIPTION: 
;
;   ARG_PRESENT tests whether an argument to a function or procedure
;   can be used as an output parameter.  The behavior of this function
;   is identical to that of the built-in ARG_PRESENT function in IDL
;   version 5 or greater, and is meant to give the same functionality
;   to programs in IDL 4.
;
;   An IDL procedure or function can use ARG_PRESENT to decide whether
;   the value of a positional or keyword parameter will be returned to
;   the calling procedure.  Generally, if the caller did not pass the
;   parameter then there is no need to compute the value to be
;   returned.
;
;   To be a valid output parameter, the caller must have passed a
;   named variable into which the result is stored.  If the caller
;   passed the parameter by value (e.g., an expression or a
;   subscripted array) the value cannot be returned and ARG_PRESENT
;   returns 0.
;
; INPUTS:
;
;   ARG - the parameter to be tested.  It can be either a positional
;         or a keyword parameter.  Passing a normal local variable
;         (i.e., not a passed parameter) will cause ARG_PRESENT to
;         return zero.
;
; RETURNS:
;
;   Returns a value of 1 if ARG is a valid output parameter, and a
;   value of 0 otherwise.
;
;
; EXAMPLE:
;
;   Consider the following procedure:
;      PRO TESTARG, ARG1
;        print, ARG_PRESENT(ARG1)
;      END
;
;   This procedure will print 1 when an ARG1 can be used as an output
;   parameter.  Here are some examples of the results of TESTARG.
;
;      IDL> testarg
;             0
;      IDL> testarg, x      
;             1
;      IDL> testarg, findgen(10)
;             0
;   
;   In the first case, no argument is passed, so ARG1 cannot be a
;   return variable.  In the second case, X is undefined, but it is
;   still a legal named variable capable of receiving an output
;   parameter.  In the third case, FINDGEN(10) is an expression which
;   cannot receive an output parameter.
;
; SEE ALSO:
;
;   ARG_PRESENT in IDL version 5
;
; MODIFICATION HISTORY:
;   Written, CM, 13 May 2000
;   Small documentation and bug fixes, CM, 04 Jul 2000
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; $Id: cmcongrid.pro,v 1.3 2007/03/29 13:52:20 craigm Exp $

;+
; NAME:
;	CMCONGRID
;
; PURPOSE:
;       Shrink or expand the size of an array by an arbitrary amount.
;       This IDL procedure simulates the action of the VAX/VMS
;       CONGRID/CONGRIDI function.
;
;	This function is similar to "REBIN" in that it can resize a
;       one, two, or three dimensional array.   "REBIN", however,
;       requires that the new array size must be an integer multiple
;       of the original size.   CONGRID will resize an array to any
;       arbitrary size (REBIN is somewhat faster, however).
;       REBIN averages multiple points when shrinking an array,
;       while CONGRID just resamples the array.
;
; CATEGORY:
;       Array Manipulation.
;
; CALLING SEQUENCE:
;	array = CONGRID(array, x, y, z)
;
; INPUTS:
;       array:  A 1, 2, or 3 dimensional array to resize.
;               Data Type : Any type except string or structure.
;
;       x:      The new X dimension of the resized array.
;               Data Type : Int or Long (greater than or equal to 2).
;
; OPTIONAL INPUTS:
;       y:      The new Y dimension of the resized array.   If the original
;               array has only 1 dimension then y is ignored.   If the
;               original array has 2 or 3 dimensions then y MUST be present.
;
;       z:      The new Z dimension of the resized array.   If the original
;               array has only 1 or 2 dimensions then z is ignored.   If the
;               original array has 3 dimensions then z MUST be present.
;
; KEYWORD PARAMETERS:
;       INTERP: If set, causes linear interpolation to be used.
;               Otherwise, the nearest-neighbor method is used.
;
;	CUBIC:	If set, uses "Cubic convolution" interpolation.  A more
;		accurate, but more time-consuming, form of interpolation.
;		CUBIC has no effect when used with 3 dimensional arrays.
;
;       MINUS_ONE:
;               If set, will prevent CONGRID from extrapolating one row or
;               column beyond the bounds of the input array.   For example,
;               If the input array has the dimensions (i, j) and the
;               output array has the dimensions (x, y), then by
;               default the array is resampled by a factor of (i/x)
;               in the X direction and (j/y) in the Y direction.
;               If MINUS_ONE is present (AND IS NON-ZERO) then the array
;               will be resampled by the factors (i-1)/(x-1) and
;               (j-1)/(y-1).
;
;       HALF_HALF:
;               If set, will tell CONGRID to extrapolate a *half* row
;               and column on either side, rather than the default of
;               one full row/column at the ends of the array.  If you
;               are interpolating images with few rows, then the
;               output will be more consistent with this technique.
;               This keyword is intended as a replacement for
;               MINUS_ONE, and both keywords probably should not be
;               used in the same call to CONGRID.
;
; OUTPUTS:
;	The returned array has the same number of dimensions as the original
;       array and is of the same data type.   The returned array will have
;       the dimensions (x), (x, y), or (x, y, z) depending on how many
;       dimensions the input array had.
;
; PROCEDURE:
;       IF the input array has three dimensions, or if INTERP is set,
;       then the IDL interpolate function is used to interpolate the
;       data values.
;       If the input array has two dimensions, and INTERP is NOT set,
;       then the IDL POLY_2D function is used for nearest neighbor sampling.
;       If the input array has one dimension, and INTERP is NOT set,
;       then nearest neighbor sampling is used.
;
; EXAMPLE:
;       ; vol is a 3-D array with the dimensions (80, 100, 57)
;       ; Resize vol to be a (90, 90, 80) array
;       vol = CONGRID(vol, 90, 90, 80)
;
; MODIFICATION HISTORY:
;       DMS, Sept. 1988.
;       DMS, Added the MINUS_ONE keyword, Sept. 1992.
; 	Daniel Carr. Re-wrote to handle one and three dimensional arrays
;                    using INTERPOLATE function.
; 	DMS, RSI, Nov, 1993.  Added CUBIC keyword.
;       Craig Markwardt, Dec, 1997.  Added halfhalf keyword to
;                        more evenly distribute "dead" pixel row
;       Use uniformly spaced grid points for half_half W. Landsman   Feb. 2000
;              (and slightly modified by C. Markwardt 14 Feb 2000)
;       Fix in case where INTERP=0 (nearest neighbor interp) and
;         expanding the image (thanks to Larry Bradley) 28 Mar 2007
;
;  $Id: cmcongrid.pro,v 1.3 2007/03/29 13:52:20 craigm Exp $
;-
;  Supply defaults = no interpolate, and no minus_one.
if n_elements(int) le 0 then int = 0 else int = keyword_set(int)
if n_elements(m1) le 0 then m1 = 0 else m1 = keyword_set(m1)

; Compute offsets pixel offsets for half_half
halfx = 0.0 & halfy = 0.0 & halfz = 0.0
if keyword_set(hh) then begin
    if s(0) GE 1 then halfx = -0.5 + (float(s(1))/x)
    if s(0) GE 2 then halfy = -0.5 + (float(s(2))/y)
    if s(0) GE 3 then halfz = -0.5 + (float(s(3))/z)
endif
cub = KEYWORD_SET(cubic)
if cub THEN int = 1	;Cubic implies interpolate
	

CASE s(0) OF
   1: BEGIN				; *** ONE DIMENSIONAL ARRAY
	srx = float(s(1) - m1)/(x-m1) * findgen(x) + halfx
      IF int THEN $
         RETURN, INTERPOLATE(arr, srx, CUBIC = cub) ELSE $
         RETURN, arr(ROUND(srx))
   ENDCASE
   2: BEGIN ; *** TWO DIMENSIONAL ARRAY
	IF int THEN BEGIN
	  srx = float(s(1) - m1) / (x-m1) * findgen(x) + halfx
	  sry = float(s(2) - m1) / (y-m1) * findgen(y) + halfy
          RETURN, INTERPOLATE(arr, srx, sry, /GRID, CUBIC=cub)
	ENDIF ELSE BEGIN
          ;; match IDL's CONGRID function
          expand = (x gt s[1])
          xm1 = (m1 or expand) ? x-1 : x
          RETURN, POLY_2D(arr, $
               [[0,0],[(s(1)-m1)/float(xm1),0]], $ ;Use poly_2d
               [[0,(s(2)-m1)/float(y-m1)],[0,0]],int,x,y)
        ENDELSE

   ENDCASE
   3: BEGIN ; *** THREE DIMENSIONAL ARRAY
	srx = float(s(1) - m1) / (x-m1) * findgen(x) + halfx
	sry = float(s(2) - m1) / (y-m1) * findgen(y) + halfy
	srz = float(s(3) - m1) / (z-m1) * findgen(z) + halfz
	RETURN, interpolate(arr, srx, sry, srz, /grid)
   ENDCASE
ENDCASE

RETURN, arr_r
END
;+
; NAME:
;   CMPRODUCT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   CMPRODUCT() is the multiplicative equivalent of TOTAL().
;
; CALLING SEQUENCE:
;   Result = CMPRODUCT(ARRAY)
;
; DESCRIPTION: 
;
;   Calculates the product of all the elements of an array.  Vector
;   multiplication in groups of powers of two make this operation
;   faster than a simple FOR loop.  The number of actual
;   multiplications is still N_ELEMENTS(ARRAY).  Double precision
;   should be used for the highest accuracy when multiplying many
;   numbers.
;
; INPUTS:
;
;   ARRAY - Array of elements to multiply together.  For instance,
;           ARRAY could contain the dimensions of another array--then
;           CMPRODUCT(ARRAY) would be the total number of elements of
;           that other array.
;
; RETURNS:
;  The result of the function is the total product of all the elements
;  of ARRAY.
;
; EXAMPLE:
;
; SEE ALSO:
;
;   TOTAL, PRODUCT (from Astronomy User's Library)
;
; MODIFICATION HISTORY:
;   Written, CM, 28 Mar 2000
;     (based on outline of PRODUCT by William Thompson)
;
;  $Id: cmproduct.pro,v 1.2 2001/03/25 18:10:42 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;
;  Check the number of parameters.
;
  IF N_PARAMS() NE 1 THEN MESSAGE,'Syntax:  Result = PRODUCT(ARRAY)'
;
;  Check the type of ARRAY.
;
  SZ = SIZE(ARRAY)
  TYPE = SZ(SZ(0)+1)
  IF TYPE EQ 0 THEN MESSAGE,'ARRAY not defined'
  IF TYPE EQ 7 THEN MESSAGE,'Operation illegal with string arrays'
  IF TYPE EQ 8 THEN MESSAGE,'Operation illegal with structures'
;
;  Calculate the product.
;
  X = ARRAY
  N = N_ELEMENTS(X)
  WHILE N GT 1 DO BEGIN
      IF (N MOD 2) EQ 1 THEN X(0) = X(0) * X(N-1)
      N2 = FLOOR(N/2)
      X = X(0:N2-1) * X(N2:*)
      N = N2
  ENDWHILE
;
  RETURN,X(0)
END
;+
; NAME:
;   CMPS_FORM
;
; PURPOSE:
;   This function puts up a form the user can configure a PostScript
;   device driver. The function result (if the user selects either the
;   ACCEPT or CREATE FILE buttons) can be sent directly to the DEVICE
;   procedure by means of its _Extra keyword.  User's predefined
;   configurations may be retrieved from a common block.
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   $Id: cmps_form.pro,v 1.5 2004/10/03 09:40:08 craigm Exp $
;
;   Based almost entirely on, but a totally revamped version of, CMPS_FORM by 
;   FANNING SOFTWARE CONSULTING (David Fanning Ph.D.) http://www.dfanning.com
;
; MAJOR TOPICS:
;   Device Drivers, Hardcopy Output, PostScript Output
;
; PROCEDURE:
;   This is a pop-up form widget. It is a modal or blocking widget.
;   Keywords appropriate for the PostScript DEVICE command are returned.
;
;   Use your LEFT mouse button to move the "Plot Window" around the page.
;   Use your RIGHT mouse button to draw your own "Plot Window" on the page.
;
; HELP:
;   formInfo = CMPS_FORM(/Help)
;
; CALLING SEQUENCE:
;    formInfo = CMPS_FORM(xoffset, yoffset, Cancel=cancelButton)
;
; OPTIONAL INPUTS:
;
;    XOFFSET -- Optional xoffset of the top-level base of cmps_form. Default is
;    to try to center the form on the display.
;
;    YOFFSET -- Optional yoffset of the top-level base of cmps_form. Default is
;    to try to center the form on the display.
;
; INPUT KEYWORD PARAMETERS:
;
;    BITS_PER_PIXEL -- The initial configuration of the bits per pixel button.
;
;    BLOCKING -- Set this keyword to make this a blocking widget under IDL 5.0.
;    (All widget programs block under IDL 4.0.)
;
;    COLOR -- The initial configuration of the color switch.
;
;    DEFAULTS -- A stucture variable of the same type and structure as the
;    RETURN VALUE of cmps_form. It will set initial conditions. This makes
;    it possible to start cmps_form up again with the same values it had the
;    last time it was called. For example:
;
;       mysetup = cmps_form()
;       newsetup = cmps_form(Defaults=mysetup)
;
;    ENCAPSULATED -- The initial configuration of the encapsulated switch.
;
;    FILENAME -- The initial filename to be used on the form.
;
;    HELP -- Prints a helpful message in the output log.
;
;    INCHES -- The initial configuration of the inches/cm switch.
;
;    INITIALIZE -- If this keyword is set, the program immediately returns the
;    "localdefaults" structure. This gives you the means to configue the
;    PostScript device without interrupting the user.
;
;    SELECT -- used only when INITIALIZE is set.  Set SELECT to a
;              string which identifies the predefined configuration to
;              be returned by cmps_form when INITIALIZE is set.  This is
;              a convenient way to select a predefined config
;              non-interactively.
;
;    LANDSCAPE -- The initial configuration of the landscape/portrait switch.
;
;    LOCALDEFAULTS -- A structure like the DEFAULTS structure. If specified,
;    then it is added as a predefined configuration entry called "Local".
;    See below for a further discussion of predefined configurations.
;
;    PREDEFINED -- An alternate way to specify predefined
;                  configurations.  Pass an array of structures to
;                  populate the "predefined" dropbox in the
;                  dialog. This array, if specified, overrides the the
;                  common block technique.
;
;    XOFFSET -- The initial XOffSet of the PostScript window.
;
;    YOFFSET -- The initial YOffSet of the PostScript window.
;
;    XSIZE -- The initial XSize of the PostScript window.
;
;    YSIZE -- The initial YSize of the PostScript window.
;
;    ASPECT -- The aspect ratio of the window (Y/X).  This keyword can
;              substitute for one of XSIZE or YSIZE.
; 
;    PRESERVE_ASPECT -- Set this keyword if you want to hold the
;                       aspect ratio constant.
;
;    PAPERSIZE -- If set, allows user to specify the size of the paper
;                 media to be printed on, as a scalar string.  NOTE:
;                 this specification cannot be passed to DEVICE, but
;                 can be selected for completeness's sake.  Default is
;                 'Letter'.
;
;    MARGINSIZE -- Size of the margins on all sides.  Default is 0.25 inches.
;                  When MARGINSIZE is non-zero, a graphic cannot directly
;                  abut the edge of the page.  This is normally a good thing,
;                  since there is often a  non-printable region which borders
;                  the page.
;
;   DEFAULTPAPER -- Default paper size to use, when it is unspecified
;                   in a predefined, "local", or "default"
;                   configuration.  This value also overrides any
;                   configuration from common blocks.  European users
;                   will probably set this to 'A4'.
;
;   PARENT -- if this widget is invoked by another widget program,
;             then this keyword parameter must be set to the top level
;             widget which is to serve as the group leader.  Failure
;             to do so will result in unexpected behavior.  IDL 4
;             programs do not need to pass this parameter.  Default:
;             NONE.
;
; OUTPUT KEYWORD PARAMETERS
;
;    CANCEL -- This is an OUTPUT keyword. It is used to check if the user
;    selected the "Cancel" button on the form. Check this variable rather
;    than the return value of the function, since the return value is designed
;    to be sent directly to the DEVICE procedure. The varible is set to 1 if
;    the user selected the "Cancel" button. Otherwise, it is set to 0.
;
;    CREATE -- This output keyword can be used to determine if the user
;    selected the 'Create File' button rather than the 'Accept' button.
;    The value is 1 if selected, and 0 otherwise.
;
;    PAPERSIZE -- If set to a named variable, any newly selected paper
;    size is returned in that variable.
;
;    XPAGESIZE -- Size of paper in "X" dimension, in units given by
;                 the returned config structure.
;
;    YPAGESIZE -- Size of paper in "Y" dimension, in units given by
;                 the returned config structure.
;
;    PAGEBOX -- specifies the page rectangle relative to the plot
;               window, in normalized units.  A 4-vector of the form
;               [XLL, YLL, XUR, YUR] is returned, giving the positions
;               of the lower left (LL) and upper right (UR) corners of
;               the page with respect to the plot window.  Thus, the
;               following command:
;
;                    PLOT, x, y, position=PAGEBOX
;
;               will construct a graphic whose plot region exactly
;               fills the page (with no margin around the edges).
;
;               Naturally, the page is usually larger than the
;               graphics window, so the normalized coordinates will
;               usually fall outside the range [0,1].
;
;               However, the bounding box constructed by the
;               Postscript driver includes only the graphics window.
;               Anything drawn outside of it may be clipped or
;               discarded.
;
; RETURN VALUE:
;
;     formInfo = { cmps_form_INFO, $
;                  xsize:0.0, $        ; The x size of the plot
;                  xoff:0.0, $         ; The x offset of the plot
;                  ysize:0.0, $        ; The y size of the plot
;                  yoff:0.0 $          ; The y offset of the plot
;                  filename:'', $      ; The name of the output file
;                  inches:0 $          ; Inches or centimeters?
;                  color:0, $          ; Color on or off?
;                  bits_per_pixel:0, $ ; How many bits per image pixel?
;                  encapsulated:0,$    ; Encapsulated or regular PostScript?
;                  isolatin1:0,$       ; Encoded with ISOLATIN1?
;                  landscape:0 }       ; Landscape or portrait mode?
;
; USAGE:
;
;  The calling procedure for this function in a widget program will
;  look something like this:
;
;     info.ps_config = cmps_form(/Initialize)
;
;     formInfo = cmps_form(Cancel=canceled, Create=create, $
;                          Defaults=info.ps_config)
;
;     IF NOT canceled THEN BEGIN
;        IF create THEN BEGIN
;           thisDevice = !D.Name
;           Set_Plot, "PS"
;           Device, _Extra=formInfo
;
;           Enter Your Graphics Commands Here!
;
;           Device, /Close
;           Set_Plot, thisDevice
;           info.ps_config = formInfo
;        ENDIF ELSE
;           info.ps_config = formInfo
;     ENDIF
;
; MAJOR FUNCTIONS and PROCEDURES:
;
;   None. Designed to work originally in conjunction with XWindow, a
;   resizable graphics window.  [ NOTE: this modified version of
;   cmps_form, by Craig Markwardt, is incompatible with the original
;   version of XWINDOW. ]
;
; MODIFICATION HISTORY:
;
;   Based on cmps_form of : David Fanning, RSI, March 1995.
;   Major rewrite by: Craig Markwardt, October 1997.
;     - Drawing and updating of form and sample box are now modular
;     - Option of storing more than one predefined postscript configuration
;     - Selection of paper size by name
;     - Access to predfined configurations through (optional) common
;       block
;   Several additions, CM, April 1998  VERSION CM2.0
;     - better integration of paper sizes throughout program.
;       Predefined configurations now also know about paper.
;     - allow passing predefined configurations instead of using
;       common block
;     - addition of ISOLATIN selection, and streamlining of dialog
;       appearance
;   Fixed bug in INITIALIZE w.r.t. paper sizes, CM, Nov 1998
;   Added SELECT keyword, CM, 09 Dec 1998
;   Added Parent keyword to allow modal widgets in IDL 5, 19 Jan 1999
;   Added "Choose" button for filename selection, 19 Sep 1999
;   Added ability to program different button names, 19 Sep 1999
;   Added ASPECT and PRESERVE_ASPECT, based on work by Aaron Barth, 18
;     Oct 1999
;   Removed NOCOMMON documentation and logic, 19 Oct 1999, CM
;   Added aspect to cmps_form_numevents (per Aaron Barth), 18 Oct 1999
;   Corrected small bug under Initialize keyword (inches), 18 Oct 1999
;   Made call to *_pscoord more consistent, 18 Oct 1999
;   Added XPAGESIZE, YPAGESIZE and PAGEBOX keywords, 19 Oct 1999
;   Small cosmetic cleanup, CM, 01 Feb 2000
;   Fix for IDL 5.5's handling of structures with arrays, CM, 11 Dec 2001
;   Replaced obsolete PICKFILE call with DIALOG_PICKFILE, Jeff Guerber,
;     24 Sep 2004
;   Transfer DEFAULTS and LOCALDEFAULTS values via STRUCT_ASSIGN,/NOZERO
;     instead of EXECUTE, Jeff Guerber, 24 Sep 2004.
;   Set CANCELBUTTON and CREATEBUTTON immediately on entry, so they're
;     defined even if user kills the window, Jeff Guerber, 24 Sep 2004.
;
; COMMON BLOCKS:
; 
;   The user may store frequently used or helpful configurations in a 
;   common block, and cmps_form() will attempt to access them.  This
;   provides a way for the user to have persistent, named,
;   configurations.
;
;   NOTE: this format has changed since the last version.  You may
;   have to quit your IDL session for the changes to take effect
;   properly.  If you have place a predefined configuration in your
;   startup file, you should review the new format.
;   
;     COMMON CMPS_FORM_CONFIGS, cmps_form_DEFAULT_PAPERSIZE, $
;                               cmps_form_STDCONFIGS
;
;        cmps_form_DEFAULT_PAPERSIZE - a string designating the default
;                                    paper size, when none is given.
;                                    The predefined configurations
;                                    offerred by this program will
;                                    respect the default value.  (See
;                                    also the DEFAULTPAPER keyword.)
;
;        cmps_form_STDCONFIGS - An array of cmps_form_CONFIG structures,
;                             each containing information about one
;                             predefined configuration, such as its
;                             name and size of paper.  Each "config"
;                             element is a cmps_form_INFO structure,
;                             which contains the actual postscript
;                             configuration.
;
;   See the IDL source code cmps_form_LOAD_CONFIGS for an example of how
;   to make a list of configurations.  One possibility would be to
;   declare and populate the common block from within the user's
;   start-up script, allowing the same configurations to appear in
;   every session.
;
;   cmps_form() takes its initial list of configurations from this
;   common block if it exists.  A default list is provided ala the
;   procedure cmps_form_LOAD_CONFIGS.  Any modifications that take place
;   during the cmps_form() widget session are not transferred back to
;   the common block upon return.  It might be useful to be able to do
;   this, through some form of 'save' procedure.
;
;   Also, if the PREDEFINED keyword is used, then the common block is
;   not consulted.
;
;  $Id: cmps_form.pro,v 1.5 2004/10/03 09:40:08 craigm Exp $
;
;-
; Copyright (C) 1996-1997, David Fanning
; Copyright (C) 1997-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; ***************************************************************
; Utility routines

forward_function filepath

; Convert from inches and centimeters to WIDGET_DRAW pixels 
pro cmps_form_Draw_Coords, drawpixperunit, xoff, yoff, xsize, ysize

  if n_elements(xoff) GT 0 then xoff   = xoff  * drawpixperunit + 1
  if n_elements(yoff) GT 0 then yoff   = yoff  * drawpixperunit + 1
  if n_elements(xsize) GT 0 then xsize = xsize * drawpixperunit
  if n_elements(ysize) GT 0 then ysize = ysize * drawpixperunit

  return
end

; Perform the opposite conversion of cmps_form_DRAW_COORDS
pro cmps_form_Real_Coords, drawpixperunit, xoff, yoff, xsize, ysize

  if n_elements(xoff) GT 0 then xoff   = (xoff-1) / drawpixperunit
  if n_elements(yoff) GT 0 then yoff   = (yoff-1) / drawpixperunit
  if n_elements(xsize) GT 0 then xsize = xsize / drawpixperunit
  if n_elements(ysize) GT 0 then ysize = ysize / drawpixperunit

  return
end

Pro cmps_form_Select_File, event

   ; Allows the user to select a filename for writing.

Widget_Control, event.top, Get_UValue=info, /No_Copy

   ; Start with the name in the filename widget.

Widget_Control, info.idfilename, Get_Value=initialFilename
initialFilename = initialFilename(0)
filename = Dialog_Pickfile(/Write, File=initialFilename)
IF filename NE '' THEN $
   Widget_Control, info.idfilename, Set_Value=filename
Widget_Control, event.top, Set_UValue=info, /No_Copy
END ;*******************************************************************

; Calculate a list of vertices to be plotted as a box in the 
; draw widget.
Function cmps_form_PlotBox_Coords, xsize, ysize, xoff, yoff, drawpixperunit

   ; This function converts sizes and offsets to appropriate
   ; Device coordinates for drawing the PLOT BOX on the PostScript
   ; page. The return value is a [2,5] array.

returnValue = IntArr(2,5)
xs = xsize
ys = ysize
xof = xoff
yof = yoff
cmps_form_draw_coords, drawpixperunit, xof, yof, xs, ys

; Add one because we do for the page outline
xcoords = Round([xof, xof+xs, xof+xs, xof, xof]) + 1
ycoords = Round([yof, yof, yof+ys, yof+ys, yof]) + 1

returnValue(0,*) = xcoords
returnValue(1,*) = ycoords

RETURN, returnValue
END ;*******************************************************************

; Convert between the IDL-form of PS coordinates (including the 
; strange definition of YOFFSET and XOFFSET) to a more
; "human-readable" form where the Xoffset and YOFFSET always refer to
; the lower-left hand corner of the output
pro cmps_form_conv_pscoord, info, xpagesize, ypagesize, $
      toidl=toidl, tohuman=tohuman

  if info.landscape EQ 1 then begin
      ixoff=info.xoff 
      iyoff=info.yoff
      if keyword_set(tohuman) then begin
          info.yoff = ixoff
          info.xoff = xpagesize - iyoff
      endif else if keyword_set(toidl) then begin
          info.xoff = iyoff
          info.yoff = xpagesize - ixoff
      endif
  endif
  return
end

; Return names of paper sizes
function cmps_form_papernames

  return, ['Letter','Legal','Tabloid','Ledger','Executive','Monarch', $
            'Statement','Folio','Quarto','C5','B4','B5','Dl','A0','A1', $
            'A2','A3','A4','A5','A6']
end

; Select a paper size based on number or string.  Returns x and 
; y page sizes, accouting for the units of measurement and the
; orientation of the page.
pro cmps_form_select_papersize, papertype, xpagesize, ypagesize, $
      inches=inches, landscape=landscape, index=index

;           Letter Legal Tabloid Ledger Executive Monarch Statement Folio
  xpaper = [612.,  612,  792,    792,   540,      279,    396,      612, $
$;          Quarto C5  B4  B5  Dl  A0   A1   A2   A3  A4  A5  A6
	    610,   459,729,516,312,2380,1684,1190,842,595,420,297]

;           Letter Legal Tabloid Ledger Executive Monarch Statement Folio
  ypaper = [792.,  1008, 1224,   1224,  720,      540,    612,      936, $
$;          Quarto C5  B4   B5  Dl  A0   A1   A2   A3   A4  A5  A6
	    780,   649,1032,729,624,3368,2380,1684,1190,842,595,421]
  names  = cmps_form_papernames()

  sz = size(papertype)
  tp = sz(sz(0) + 1)
  if tp GT 0 AND tp LT 6 then begin
      index = fix(papertype)
  endif else if tp EQ 7 then begin
      index = where(strupcase(papertype) EQ strupcase(names), ict)
      if ict EQ 0 then index = 0
  endif else $
    index = 0

  index = index(0)

  xpagesize = xpaper(index) / 72.  ; Convert to inches
  ypagesize = ypaper(index) / 72.
  xpagesize = xpagesize(0)
  ypagesize = ypagesize(0)
  if NOT keyword_set(inches) then begin
      xpagesize = xpagesize * 2.54
      ypagesize = ypagesize * 2.54
  endif
  if keyword_set(landscape) then begin
      temp = xpagesize
      xpagesize = ypagesize
      ypagesize = temp
  endif
  
  return
end

; cmps_form_LOAD_CONFIGS
;
; Loads a set of default configurations into the output variables,
;
;   CONFIGNAMES - array of names for configurations.
;
;   CONFIGS - array of cmps_form_INFO structures, each with a separate
;             configuration in it, and corresponding to the
;             configuration name.
;
; Intended as an intelligent default when no other is specified.
;
pro cmps_form_load_configs, defaultpaper, configs

  ; This is the default paper size, when none is given
  defaultpaper = 'Letter'

  ; Here is how the cmps_form_INFO structure is defined.  Refer to it
  ; when creating new structures.
  template = { cmps_form_INFO, $
               xsize:0.0, $     ; The x size of the plot
               xoff:0.0, $      ; The x offset of the plot
               ysize:0.0, $     ; The y size of the plot
               yoff:0.0, $       ; The y offset of the plot
               filename:'', $   ; The name of the output file
               inches:0, $       ; Inches or centimeters?
               color:0, $       ; Color on or off?
               bits_per_pixel:0, $ ; How many bits per image pixel?
               encapsulated:0,$ ; Encapsulated or regular PostScript?
	       isolatin1:0,$    ; Encoding is not ISOLATIN1
               landscape:0 }    ; Landscape or portrait mode?

  pctemplate = { cmps_form_CONFIG,  $
                 config:{cmps_form_INFO},  $
                 configname: '', $    ; Name of configuration
                 papersize: '' }      ; Size of paper for configuration
                 
  
  ; Set of default configurations (no ISOLATIN1 encoding)
  ;   1.  7x5    inch color plot region in portrait
  ;   2.  7.5x10 inch centered color plot region, covering almost whole
  ;                   portrait page (0.5 inch margins)
  ;   3.  10x7.5 inch centered color plot region, covering almost whole
  ;                   landscape page (0.5 inch margins)
  ;   4.  7x5    inch gray plot region in portrait (IDL default config)
  configs = [{cmps_form_CONFIG, config:$
              {cmps_form_INFO, 7.0, 0.75, 5.0, 5.0, 'idl.ps', 1, 1, 8, 0, 0, 0},$
              configname:'Half Portrait (color)', papersize:defaultpaper}, $
             {cmps_form_CONFIG, config:$
              {cmps_form_INFO, 7.5, 0.50, 10., 0.5, 'idl.ps', 1, 1, 8, 0, 0, 0},$
              configname:'Full Portrait (color)', papersize:defaultpaper}, $
             {cmps_form_CONFIG, config:$
              {cmps_form_INFO, 10., 0.50, 7.5, 10.5,'idl.ps', 1, 1, 8, 0, 0, 1},$
              configname:'Full Landscape (color)', papersize:defaultpaper}, $
             {cmps_form_CONFIG, config:$
              {cmps_form_INFO, 18., 1.5, 26.7, 1.5, 'idl.ps', 0, 1, 8, 0, 0, 0},$
              configname:'A4 Portrait (color)', papersize:'A4'}, $
             {cmps_form_CONFIG, config:$
              {cmps_form_INFO, 26.7, 1.5, 18.,28.2039,'idl.ps',0,1, 8, 0, 0, 1},$
              configname:'A4 Landscape (color)', papersize:'A4'}, $
             {cmps_form_CONFIG, config:$
              {cmps_form_INFO, 17.78,1.91,12.70,12.70,'idl.ps',0,1, 4, 0, 0, 0},$
              configname:'IDL Standard', papersize:defaultpaper} ]


  return
end

; 
; cmps_form_Update_Info
;
; This procedure modifies an "info" structure, according to new
; specifications about the PS configuration.  This is the central
; clearing house for self-consistent modification of the info structure.
;
; INPUTS
;   info    - info structure to be modified
;   keywords- IDL keywords are contain information is folded
;             into the "info" structure.
;             Valid keywords are:
;                XSIZE, YSIZE, 
;                XOFF, YOFF    - size and offset of plotting region in
;                                "human" coordinates.  This is the
;                                natural size as measured from the
;                                lower-left corner of the page in its
;                                proper orientation (not the IDL
;                                definition!).  These are the same
;                                values that are printed in the form's
;                                Size and Offset fields.
;                INCHES        - whether dimensions are in inches or
;                                centimeters (1=in, 0=cm)
;                COLOR         - whether output is color (1=y, 0=n)
;                BITS_PER_PIXEL- number of bits per pixel (2,4,8)
;                ENCAPSULATED  - whether output is EPS (1=EPS, 0=PS)
;                LANDSCAPE     - whether output is portrait or
;                                landscape (1=land, 0=port)
;                FILENAME      - output file name (with respect to
;                                current directory)
;
Pro cmps_form_Update_Info, info, set=set, _EXTRA=newdata

  if n_elements(newdata) GT 0 then $
    names = Tag_Names(newdata)
  set   = keyword_set(set)
  centerfactor = 1.0

  FOR j=0, N_Elements(names)-1 DO BEGIN
      
      case strupcase(names(j)) of
          'XSIZE':       info.devconfig.xsize    = float(newdata.xsize)
          'YSIZE':       info.devconfig.ysize    = float(newdata.ysize)
          'XOFF':        info.devconfig.xoff     = float(newdata.xoff)
          'YOFF':        info.devconfig.yoff     = float(newdata.yoff)
          'INCHES':      BEGIN
              inches   = fix(newdata.inches)
              if inches NE 0 then inches = 1
              if set NE 1 then begin
                  convfactor = 1.0
                  if info.devconfig.inches EQ 0 AND inches EQ 1 then $
                    convfactor = 1.0/2.54 $ ; centimeters to inches
                  else if info.devconfig.inches EQ 1 AND inches EQ 0 then $
                    convfactor = 2.54 ; inches to centimeters

                  info.devconfig.xsize = info.devconfig.xsize * convfactor
                  info.devconfig.ysize = info.devconfig.ysize * convfactor
                  info.devconfig.xoff  = info.devconfig.xoff  * convfactor
                  info.devconfig.yoff  = info.devconfig.yoff  * convfactor
                  info.xpagesize       = info.xpagesize       * convfactor
                  info.ypagesize       = info.ypagesize       * convfactor
                  info.marginsize      = info.marginsize      * convfactor
                  info.drawpixperunit  = info.drawpixperunit  / convfactor
                    
              endif
                  
              info.devconfig.inches = inches
          end
          
          'LANDSCAPE':   begin
              landscape= fix(newdata.landscape)
              if landscape NE 0 then landscape = 1
              
              if landscape NE info.devconfig.landscape AND $
                set NE 1 then begin
                  temp = info.xpagesize
                  info.xpagesize = info.ypagesize
                  info.ypagesize = temp
                  
                  ; Since the margins are bound to be way out of wack,
                  ; we could recenter here.
                  
                  xsize = info.devconfig.xsize
                  ysize = info.devconfig.ysize

                  centerfactor = 2.0
                  
                  ; We will have to redraw the reserve pixmap
                  info.pixredraw = 1
                  
              endif 
              
              info.devconfig.landscape = landscape
          end
          
          'COLOR':       begin
              info.devconfig.color    = fix(newdata.color)
              if info.devconfig.color        NE 0 then info.devconfig.color = 1
          end
          'ENCAPSULATED':  begin
              info.devconfig.encapsulated = fix(newdata.encapsulated)
              if info.devconfig.encapsulated NE 0 then $
                info.devconfig.encapsulated = 1
          end
          'ISOLATIN1': begin
              info.devconfig.isolatin1 = fix(newdata.isolatin1)
              if info.devconfig.isolatin1 NE 0 then $
                info.devconfig.isolatin1 = 1
          end
          'BITS_PER_PIXEL': begin
              bpp = fix(newdata.bits_per_pixel)
              if bpp LT 1              then bpp = 2
              if bpp GT 2 AND bpp LT 4 then bpp = 4
              if bpp GT 4 AND bpp LT 8 then bpp = 8
              if bpp GT 8              then bpp = 8
              info.devconfig.bits_per_pixel = bpp
          end
          'FILENAME': begin
              if string(newdata.filename) NE info.devconfig.filename then $
                info.filechanged = 1
              info.devconfig.filename = string(newdata.filename)
          end
      endcase
  endfor
  
  ; Now check the sizes and offsets, to be sure they are sane for the 
  ; particular landscape/portrait and inch/cm settings that have been
  ; chosen.
  pgwid = info.xpagesize
  pglen = info.ypagesize
  pgmar = info.marginsize

  if set NE 1 then begin
      info.devconfig.xsize = (pgmar) > info.devconfig.xsize < (pgwid-2.*pgmar)
      info.devconfig.ysize = (pgmar) > info.devconfig.ysize < (pglen-2.*pgmar)
      info.devconfig.xoff  = (pgmar) > info.devconfig.xoff  < (pgwid-info.devconfig.xsize - pgmar)
      info.devconfig.yoff  = (pgmar) > info.devconfig.yoff  < (pglen-info.devconfig.ysize - pgmar)
      if info.devconfig.xsize + info.devconfig.xoff GT (pgwid-pgmar) then $
        info.devconfig.xoff = (pgwid - info.devconfig.xsize) / centerfactor
      if info.devconfig.ysize + info.devconfig.yoff GT (pglen-pgmar) then $
        info.devconfig.yoff = (pglen - info.devconfig.ysize) / centerfactor
  endif

  ; Preserve aspect ratio if necessary
  if (info.preserve_aspect EQ 1) then begin
      sizeratio = info.aspect / (info.ypagesize / info.xpagesize)
      if (sizeratio GE 1) then $
        info.devconfig.xsize = info.devconfig.ysize / info.aspect $
      else $
        info.devconfig.ysize = info.devconfig.xsize * info.aspect
  endif

  return
end

; 
; PRO cmps_form_DRAW_BOX
;
; Draw the "sample" box in the draw widget.  If necessary, also
; redraws the backing reserve pixmap.
;
pro cmps_form_draw_box, xsize, ysize, xoff, yoff, info

  ; First order of business is to make a new reserve pixmap, if
  ; necessary.

  if info.pixredraw EQ 1 then begin
      
      ; Operate on the pixmap first
      wset, info.idpixwid
      erase
      ; Make background ...
      tv, replicate(info.bkgcolor, info.xpixwinsize, info.ypixwinsize)
      ; ... and page outline
      coords = cmps_form_plotbox_coords(info.xpagesize, info.ypagesize, $
                                      0.,0., info.drawpixperunit)
      plots, coords(0,*), coords(1,*), /device, color=info.pagecolor

      info.pixredraw = 0
  endif

  ; Now, we transfer the reserve pixmap to the screen

  wset, info.idwid
  device, copy=[0, 0, info.xpixwinsize, info.ypixwinsize, 0, 0, $
                info.idpixwid]

  ; Finally we overlay the plot region
  coords = cmps_form_plotbox_coords(xsize, ysize, xoff, yoff,info.drawpixperunit)
  plots, coords(0,*), coords(1,*), color=info.boxcolor, /device

  return
end

; 
; cmps_form_DRAW_FORM
;
; Update the widget elements of the cmps_form form, using the INFO structure.
;
; If the NOBOX keyword is set, then the draw widget is not updated.
;
pro cmps_form_draw_form, info, nobox=nobox

  ; Draw the DRAW widget if needed
  if NOT keyword_set(nobox) then $
    cmps_form_draw_box, info.devconfig.xsize, info.devconfig.ysize, $
    info.devconfig.xoff, info.devconfig.yoff, info

  ; Update the numeric text fields
  xsizestr = strtrim(string(info.devconfig.xsize, format='(F6.2)'), 2)
  ysizestr = strtrim(string(info.devconfig.ysize, format='(F6.2)'), 2)
  xoffstr  = strtrim(string(info.devconfig.xoff, format='(F6.2)'), 2)
  yoffstr  = strtrim(string(info.devconfig.yoff, format='(F6.2)'), 2)

  widget_control, info.idxsize, set_value=xsizestr
  widget_control, info.idysize, set_value=ysizestr
  widget_control, info.idxoff, set_value=xoffstr
  widget_control, info.idyoff, set_value=yoffstr

  widget_control, info.idaspect, set_button=(info.preserve_aspect EQ 1)

  ; Set EPS (encapsulated ps) buttons
  Widget_Control, info.idencap, Set_Button=(info.devconfig.encapsulated EQ 1)

   ; Set color buttons.
  Widget_Control, info.idcolor, Set_Button=(info.devconfig.color EQ 1)

  ; Set inch/cm buttons.
  Widget_Control, info.idinch, Set_Button=(info.devconfig.inches EQ 1)
  Widget_Control, info.idcm,   Set_Button=(info.devconfig.inches EQ 0)

  ; Set bits_per_pixel buttons.
  Widget_Control, info.idbit2, Set_Button=(info.devconfig.bits_per_pixel EQ 2)
  Widget_Control, info.idbit4, Set_Button=(info.devconfig.bits_per_pixel EQ 4)
  Widget_Control, info.idbit8, Set_Button=(info.devconfig.bits_per_pixel EQ 8)
  Widget_Control, info.idbitbase, Sensitive=(info.devconfig.color EQ 1)

  ; Set encoding button
  widget_control, info.idisolatin1, Set_Button=(info.devconfig.isolatin1 EQ 1)

  ; Set default filename.
  Widget_Control, info.idfilename, Get_Value=wfilename
  if string(wfilename(0)) NE info.devconfig.filename then begin
      Widget_Control, info.idfilename, Set_Value=info.devconfig.filename
      ; Put caret at end of pathname text so that filename itself is visible
      Widget_Control, info.idfilename, $
        Set_Text_Select=[ strlen(info.devconfig.filename), 0 ]
  endif

  ; Set protrait/landscape button.
  Widget_Control, info.idland, Set_Button=(info.devconfig.landscape EQ 1)
  Widget_Control, info.idport, Set_Button=(info.devconfig.landscape EQ 0)

  ; Set Paper
  pn = cmps_form_papernames()
  xp = strtrim(string(info.xpagesize, format='(F10.2)'),2)
  yp = strtrim(string(info.ypagesize, format='(F10.2)'),2)
  un = 'in'
  if NOT info.devconfig.inches then un = 'cm'

  paperlab = string(pn(info.paperindex), xp, un, yp, un, $
                      format='("   Paper: ",A0," (",A0,A0," x ",A0,A0,")   ")')
  Widget_Control, info.idpaperlabel, set_value=paperlab
  
  return
end

Pro cmps_form_Null_Events, event
END ;*******************************************************************

Function cmps_form_What_Button_Type, event

   ; Checks event.type to find out what kind of button
   ; was clicked in a draw widget. This is NOT an event handler.

type = ['DOWN', 'UP', 'MOTION', 'SCROLL']
Return, type(event.type)
END ;*******************************************************************

Function cmps_form_What_Button_Pressed, event

   ; Checks event.press to find out what kind of button
   ; was pressed in a draw widget.  This is NOT an event handler.

button = ['NONE', 'LEFT', 'MIDDLE', 'NONE', 'RIGHT']
Return, button(event.press)
END ;*******************************************************************

Function cmps_form_What_Button_Released, event

   ; Checks event.release to find out what kind of button
   ; was released in a draw widget.  This is NOT an event handler.

button = ['NONE', 'LEFT', 'MIDDLE', 'NONE', 'RIGHT']
Return, button(event.release)
END ;*******************************************************************



;
; cmps_form_NUMEVENTS
;
; Events sent to the numeric text field widgets are sent here.  We
; harvest the data values from the text field and update the screen.
;
Pro cmps_form_NumEvents, event

   ; If an event comes here, read the offsets and sizes from the
   ; form and draw the appropriately sized box in the draw widget.

Widget_Control, event.top, Get_UValue= info, /No_Copy

   ; Get current values for offset and sizes

Widget_Control, info.idxsize, Get_Value=xsize
Widget_Control, info.idysize, Get_Value=ysize
Widget_Control, info.idxoff, Get_Value=xoff
Widget_Control, info.idyoff, Get_Value=yoff

xsize = xsize(0)
ysize = ysize(0)
xoff = xoff(0)
yoff = yoff(0)

if info.preserve_aspect EQ 1 then begin
    if event.id EQ info.idysize then xsize = ysize / info.aspect $
    else                             ysize = xsize * info.aspect
endif

; Fold this information into the "info" structure
cmps_form_update_info, info, xsize=xsize, ysize=ysize, xoff=xoff, yoff=yoff

; Update form and redraw sample box
cmps_form_draw_form, info

; Put the info structure back into the top-level base

Widget_Control, event.top, Set_UValue=info, /No_Copy

END ;*******************************************************************


Pro cmps_form_Move_Box, event

   ; This is the event handler that allows the user to "move"
   ; the plot box around in the page window. It will set the
   ; event handler back to "cmps_form_Box_Events" when it senses an
   ; "UP" draw button event and it will also turn cmps_form_Draw_Motion_Events
   ; OFF.

   ; Get the info structure out of the top-level base.

  Widget_Control, event.top, Get_UValue=info, /No_Copy

  whatButtonType = cmps_form_What_Button_Type(event)

  dpu = info.drawpixperunit

  ixmin = 0.
  iymin = 0.
  ixsize = info.devconfig.xsize
  iysize = info.devconfig.ysize
  cmps_form_draw_coords, dpu, ixmin, iymin, ixsize, iysize
  ; Now ixmin,iymin have the minimum values of x and y, in pixels
  ; ixsize and iysize are the size of the box, in pixels

  ixmax = info.xpagesize
  iymax = info.ypagesize
  cmps_form_draw_coords, dpu, ixmax, iymax
  ; ixmax and iymax are the max values of x and y, in pixels

  ; info.ideltx/y contains the offset of the lower left corner of the box,
  ; with respect to the mouse's position
  ixoff = event.x + info.ideltx
  iyoff = event.y + info.idelty

  ; Keep box inside the page
  if ixoff LT ixmin then ixoff = ixmin
  if iyoff LT iymin then iyoff = iymin
  if (ixoff+ixsize) GT ixmax then ixoff = ixmax - ixsize
  if (iyoff+iysize) GT iymax then iyoff = iymax - iysize

  IF whatButtonType EQ 'UP' THEN Begin

      ; When the button is "up" the moving event is over.  We reset the
      ; event function and update the information about the box's position
      
      Widget_Control, info.iddraw, Draw_Motion_Events=0, $ ; Motion events off
        Event_Pro='cmps_form_Box_Events' ; Change to normal processing
      
      cmps_form_real_coords, dpu, ixoff, iyoff, ixsize, iysize
      
      ; Update the info structure
      cmps_form_update_info, info, xoff=ixoff, yoff=iyoff
      ; Draw it
      cmps_form_draw_form, info
      
      ; Put the info structure back in the top-level base and RETURN
      Widget_Control, event.top, Set_UValue=info, /No_Copy
      Return

  ENDIF

   ; You come to this section of the code for all events except
   ; an UP button event. Most of the action in this event handler
   ; occurs here.

  cmps_form_real_coords, dpu, ixoff, iyoff, ixsize, iysize

  ; Simply draw the new box
  cmps_form_draw_box, ixsize, iysize, ixoff, iyoff, info

  ; Put the info structure back into the top-level base.
  Widget_Control, event.top, Set_UValue=info, /No_Copy

END ;*******************************************************************


Pro cmps_form_Grow_Box, event

   ; This event handler is summoned when a RIGHT button is clicked
   ; in the draw widget. It allows the user to draw the outline of a
   ; box with the mouse. It will continue drawing the new box shape
   ; until an UP event is detected. Then it will set the event handler
   ; back to cmps_form_Box_Events and turn cmps_form_Draw_Motion_Events to OFF.

   ; Get the info structure out of the top-level base.

  Widget_Control, event.top, Get_UValue=info, /No_Copy

  whatButtonType = cmps_form_What_Button_Type(event)

  dpu = info.drawpixperunit

  ixmin = 0.
  iymin = 0.
  ixsize = info.devconfig.xsize
  iysize = info.devconfig.ysize
  cmps_form_draw_coords, dpu, ixmin, iymin, ixsize, iysize
  ; Now ixmin,iymin have the minimum values of x and y, in pixels
  ; ixsize and iysize are the size of the box, in pixels

  ixmax = info.xpagesize
  iymax = info.ypagesize
  cmps_form_draw_coords, dpu, ixmax, iymax
  ; ixmax and iymax are the max values of x and y, in pixels

  ; Keep box inside the page
  if event.x LT ixmin then event.x = ixmin
  if event.x GT ixmax then event.x = ixmax
  if event.y LT iymin then event.y = iymin
  if event.y GT iymax then event.y = iymax

  ; Decide on which corner is the lower left (it's arbitrary)
  ixoff  = min([info.imousex, event.x])
  iyoff  = min([info.imousey, event.y])
  ixsize = max([info.imousex, event.x]) - ixoff
  iysize = max([info.imousey, event.y]) - iyoff

  ;; Enforce the aspect ratio
  if info.preserve_aspect EQ 1 then begin
      sizeratio = info.aspect / (info.ypagesize / info.xpagesize)
      if (sizeratio GE 1) then ixsize = iysize / info.aspect $
      else iysize = ixsize * info.aspect
      if info.imousex GT event.x then ixoff = info.imousex - ixsize
      if info.imousey GT event.y then iyoff = info.imousey - iysize
  endif

  IF whatButtonType EQ 'UP' THEN Begin

      ; When the button is "up" the moving event is over.  We reset the
      ; event function and update the information about the box's position

      Widget_Control, info.iddraw, Draw_Motion_Events=0, $ ; Motion events off
        Event_Pro='cmps_form_Box_Events' ; Change to normal processing

      cmps_form_real_coords, dpu, ixoff, iyoff, ixsize, iysize

      ; Update the info structure
      cmps_form_update_info, info, xoff=ixoff, yoff=iyoff, $
        xsize=ixsize, ysize=iysize
      ; Draw it
      cmps_form_draw_form, info

      ; Put the info structure back in the top-level base and RETURN
      Widget_Control, event.top, Set_UValue=info, /No_Copy
      Return
      
  ENDIF

   ; This is the portion of the code that handles all events except for
   ; UP button events. The bulk of the work is done here. Basically,
   ; you need to erase the old box and draw a new box at the new
   ; location. Just keep doing this until you get an UP event.

  cmps_form_real_coords, dpu, ixoff, iyoff, ixsize, iysize

  ; Simply draw the new box
  cmps_form_draw_box, ixsize, iysize, ixoff, iyoff, info

  ; Put the info structure back in the top-level base.
  Widget_Control, event.top, Set_UValue=info, /No_Copy

END ;*******************************************************************



; 
; Buttondown events sent to this procedure at first.  This is sets up
; the initial move/drag elements and hands off the events to the more
; specialized procedures cmps_form_grow_box and cmps_form_move_box above.
;
Pro cmps_form_Box_Events, event

  whatButtonType = cmps_form_What_Button_Type(event)
  IF whatButtonType NE 'DOWN' THEN Return

  ; Get info structure out of TLB

  Widget_Control, event.top, Get_UValue=info, /No_Copy

  whatButtonPressed = cmps_form_What_Button_Pressed(event)

  dpu = info.drawpixperunit
  ixmin = 0.
  iymin = 0.
  ixsize = info.devconfig.xsize
  iysize = info.devconfig.ysize
  cmps_form_draw_coords, dpu, ixmin, iymin, ixsize, iysize
  ixmax = info.xpagesize
  iymax = info.ypagesize
  cmps_form_draw_coords, dpu, ixmax, iymax
  ixoff = info.devconfig.xoff
  iyoff = info.devconfig.yoff
  cmps_form_draw_coords, dpu, ixoff, iyoff

  if event.x LT ixmin OR event.x GT ixmax $
    OR event.y LT iymin OR event.y GT iymax then begin
      widget_control, event.top, set_uvalue=info, /no_copy
      return
  endif
  
  CASE whatButtonPressed OF
      
      'RIGHT': Begin
          
         ; Resize the plot box interactively. Change the event handler
         ; to cmps_form_Grow_Box. All subsequent events will be handled by
         ; cmps_form_Grow_Box until an UP event is detected. Then you will
         ; return to this event handler. Also, turn motion events ON.
          
          Widget_Control, event.id, Event_Pro='cmps_form_Grow_Box', $
            Draw_Motion_Events=1
          
          cmps_form_draw_box, 1./dpu, 1./dpu, ixoff, iyoff, info
          
          info.imousex = event.x
          info.imousey = event.y
          
      End
      
      'LEFT': Begin
          
         ; Resize the plot box interactively. Change the event handler
         ; to cmps_form_Move_Box. All subsequent events will be handled by
         ; cmps_form_Move_Box until an UP event is detected. Then you will
         ; return to this  event handler. Also, turn motion events ON.


         ; Only move the box if the cursor is inside the box.
         ;If it is NOT, then RETURN.

          if event.x LT ixoff OR event.x GT (ixoff+ixsize) OR $
            event.y LT iyoff OR event.y GT (iyoff+iysize) then begin 
              
              Widget_Control, event.top, Set_UValue=info, /No_Copy
              Return
          ENDIF
          
       ; Relocate the event handler and turn motion events ON.

          Widget_Control, event.id, Event_Pro='cmps_form_Move_Box', $
            Draw_Motion_Events=1
          
          ; ideltx and idelty contain the offset of the lower left 
          ; corner of the plot region with respect to the mouse.
          info.ideltx  = ixoff - event.x
          info.idelty  = iyoff - event.y
          
      End

      ELSE:                     ; Middle button ignored in this program

  ENDCASE

   ; Put the info structure back into the top-level base

  Widget_Control, event.top, Set_UValue=info, /No_Copy

END ;*******************************************************************

; 
; Handle events to the drop-list widgets, which contain predefined
; configurations.
;
pro cmps_form_predef_events, event

  name = tag_names(event, /structure_name)
  if strupcase(name) NE 'WIDGET_DROPLIST' then return

   ; Get the info structure out of the top-level base
  Widget_Control, event.top, Get_UValue=info, /No_Copy

  Widget_Control, event.id, Get_UValue=thislist

  ; Pre-read the values from the text fields
  Widget_Control, info.idfilename, Get_Value=filename
  cmps_form_update_info, info, filename=filename

  case thislist of
      'PAPER':  info.paperindex = event.index   ; Paper change 
      'PREDEF': begin
          old_filename = info.devconfig.filename         ; Keep old filename
          info.devconfig = info.predefined(event.index)  ; New config
          info.paperindex = info.papersizes(event.index) ; New paper too
          if info.filechanged then $
            info.devconfig.filename = old_filename $
          else begin
              cd, current=thisdir
              l = strlen(thisdir)
              if strmid(info.devconfig.filename, 0, l) NE thisdir then $
                info.devconfig.filename = old_filename $
              else $
                info.devconfig.filename = filepath(info.devconfig.filename, $
                                                   root_dir=thisdir)
          endelse
      end
  endcase

  ; Be sure to select a pristine set of paper
  cmps_form_select_papersize, info.paperindex, xpagesize, ypagesize, $
    landscape=info.devconfig.landscape, inches=info.devconfig.inches
  info.xpagesize = xpagesize
  info.ypagesize = ypagesize

  widget_control, info.idpaperlist, set_droplist_select=info.paperindex

  ; Reset the drawpixperunit value
  convfactor = 1.0
  if info.devconfig.inches EQ 0 then convfactor = convfactor * 2.54
  info.marginsize = 0.25 * convfactor

  ; The conversion between length and pixels cannot always be set precisely,
  ; depending on the size of the paper
  dpp = 10.0 / convfactor  ; Desire 10 pixels per inch
  if dpp * info.xpagesize GT info.xpixwinsize OR $
    dpp * info.ypagesize GT info.ypixwinsize then $
    dpp = min( [ float(info.xpixwinsize-2)/info.xpagesize, $
                 float(info.ypixwinsize-2)/info.ypagesize ])
  info.drawpixperunit = dpp
  info.pixredraw = 1

  ; Update the info structure and draw it
  cmps_form_update_info, info, xoff=info.devconfig.xoff
  cmps_form_draw_form, info

  Widget_Control, event.top, Set_UValue=info, /No_Copy
  return
end

;
; Handle events sent to any of the button elements of the form.
;
Pro cmps_form_Event, event

   ; This is the main event handler for cmps_form. It handles
   ; the exclusive buttons on the form. Other events on the form
   ; will have their own event handlers.

   ; Get the name of the event structure

  name = Tag_Names(event, /Structure_Name)

   ; Get the User Value of the Button
  Widget_Control, event.id, Get_UValue=thisButton

   ; If name is NOT "WIDGET_BUTTON" or this is not a button
   ; selection event, RETURN.
  nonexclusive = ( thisButton EQ 'ISOLATIN1' OR $
                   thisButton EQ 'COLOR' OR $
                   thisButton EQ 'ENCAPSULATED' OR $
                   thisButton EQ 'ASPECT' )

  IF name NE 'WIDGET_BUTTON' OR $
     (NOT nonexclusive AND event.select NE 1)  THEN Return

   ; Get the info structure out of the top-level base
  Widget_Control, event.top, Get_UValue=info, /No_Copy


  redraw_form = 0
  redraw_box = 0

  ; Pre-read the values from the text fields
  Widget_Control, info.idxsize, Get_Value=xsize
  Widget_Control, info.idysize, Get_Value=ysize
  Widget_Control, info.idxoff, Get_Value=xoff
  Widget_Control, info.idyoff, Get_Value=yoff
  Widget_Control, info.idfilename, Get_Value=filename
  cmps_form_update_info, info, filename=filename

   ; Respond appropriately to whatever button was selected
  CASE thisButton OF

      'INCHES': Begin
          cmps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          cmps_form_update_info, info, inches=1
          redraw_form = 1
      end
          
      'CENTIMETERS': Begin
          cmps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          cmps_form_update_info, info, inches=0
          redraw_form = 1
      End
      
      'COLOR': Begin
          cmps_form_update_info, info, color=(1-info.devconfig.color)
          redraw_form = 1
      End

      'BITS2': Begin
          cmps_form_update_info, info, bits_per_pixel=2
          redraw_form = 1
      End

      'BITS4': Begin
          cmps_form_update_info, info, bits_per_pixel=4
          redraw_form = 1
      End

      'BITS8': Begin
          cmps_form_update_info, info, bits_per_pixel=8
          redraw_form = 1
      End

      'ISOLATIN1': Begin
          cmps_form_update_info, info, isolatin1=(1-info.devconfig.isolatin1)
       End

      'ASPECT': begin
          if info.preserve_aspect EQ 0 then $
            info.aspect = info.devconfig.ysize / info.devconfig.xsize
          info.preserve_aspect = (1 - info.preserve_aspect)
      end

      'LANDSCAPE': Begin
          cmps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          cmps_form_update_info, info, landscape=1
          redraw_form = 1
          redraw_box = 1
      End

      'PORTRAIT': Begin
          cmps_form_update_info, info, landscape=0
          cmps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          redraw_form = 1
          redraw_box = 1
      End

      'ENCAPSULATED': Begin
          cmps_form_update_info, info, encapsulated=(1-info.devconfig.encapsulated)
      End

      'ACCEPT': Begin

         ; The user wants to accept the information in the form.
         ; The procedure is to gather all the information from the
         ; form and then fill out a formInfo structure variable
         ; with the information. The formInfo structure is stored
         ; in a pointer. The reason for this is that we want the
         ; information to exist even after the form is destroyed.

         ; Gather the information from the form

          Widget_Control, info.idfilename, Get_Value=filename
          cmps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          cmps_form_update_info, info, filename=filename
          widget_control, event.id, get_value=buttonname

          formInfo = { $
                       cancel:0, $            ; CANCEL flag
                       create:0, $            ; CREATE flag
                       buttonname: buttonname, $
                       xpagesize:info.xpagesize, $
                       ypagesize:info.ypagesize, $
                       paperindex:info.paperindex, $
                       result:info.devconfig $; Results are ready-made
                     }

          goto, FINISH_DESTROY
      End

      'CREATE': Begin

          Widget_Control, info.idfilename, Get_Value=filename
          cmps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          cmps_form_update_info, info, filename=filename

          formInfo = { $
                       cancel:0, $            ; CANCEL flag
                       create:1, $            ; CREATE flag
                       buttonname: 'Create File', $ 
                       xpagesize:info.xpagesize, $
                       ypagesize:info.ypagesize, $
                       paperindex:info.paperindex, $
                       result:info.devconfig $; Results are ready-made
                     }

          goto, FINISH_DESTROY

      End

      'CANCEL': Begin

         ; The user wants to cancel out of this form. We need a way to
         ; do that gracefully. Our method here is to set a "cancel"
         ; field in the formInfo structure.
          formInfo = {cancel:1, create:0}

          goto, FINISH_DESTROY
      End

  ENDCASE

  if redraw_form EQ 1 then $
    cmps_form_draw_form, info, nobox=(1-redraw_box)

   ; Put the info structure back into the top-level base if the
   ; base is still in existence.

  If Widget_Info(event.top, /Valid) THEN $
    Widget_Control, event.top, Set_UValue=info, /No_Copy
  return


  ; We only reach this stage if we are ending the cmps_form widget
  ; These commands store the results, restore colors, and destroy
  ; the form widget.
  FINISH_DESTROY:

         ; Put the formInfo structure into the location pointer
         ; to by the pointer
  Handle_Value, info.ptrresult, formInfo, /Set, /No_Copy

         ; Delete the pixmap window
  WDelete, info.idpixwid

         ; Restore the user's color table
  TVLct, info.red, info.green, info.blue

         ; Destroy the cmps_form widget program
  Widget_Control, event.top, /Destroy

  return

END ;*******************************************************************

Function cmps_form, xoffset, yoffset, Cancel=cancelButton, Help=help, $
     XSize=xsize, YSize=ysize, XOffset=xoff, YOffset=yoff, $
     Inches=inches, Color=color, Bits_Per_Pixel=bits_per_pixel, $
     Encapsulated=encapsulated, Landscape=landscape, Filename=filename, $
     Defaults=defaults, LocalDefaults=localDefaults, Initialize=initialize, $
     select=select, parent=parent, $
     Create=createButton, NoCommon=nocommon, PaperSize=paperSize, $
     button_names=buttons, button_sel=button_sel, $
     PreDefined=predefined, DefaultPaper=defaultpaper, $
     aspect=aspect, preserve_aspect=preserve_aspect, $
     xpagesize=xpagesize, ypagesize=ypagesize, pagebox=pagebox

   ; If the Help keyword is set, print some help information and return

  IF Keyword_Set(help) THEN BEGIN
      Doc_Library, 'cmps_form'
      RETURN, 0
  ENDIF

  ; Set cancelButton and createButton as if canceled, so will be defined
  ; (and with appropriate values) even if user kills the window instead of
  ; using the buttons.  Normal exit will reassign them later on.
  cancelButton = 1
  createButton = 0

  ; Load default setups via a common block, if they are available
  if n_elements(predefined) EQ 0 then begin
      common cmps_form_configs, cmps_form_default_papersize, $
        cmps_form_stdconfigs
      if n_elements(cmps_form_stdconfigs) GT 0 then $
        predefined = cmps_form_stdconfigs
  endif

  ; If the user has not set up a common block, then get some pre
  if n_elements(predefined) EQ 0 then $
    cmps_form_load_configs, cmps_form_default_papersize, predefined

  ; Transfer to local copies so that we don't overwrite
  confignames = predefined(*).configname
  configs     = predefined(*).config
  configs     = configs(*) ;; IDL 5.5 will make a 1xN array -- collapse it now
  papernames  = predefined(*).papersize
  if n_elements(defaultpaper) EQ 0 $
    AND n_elements(cmps_form_default_papersize) GT 0 then $
    defaultpaper = cmps_form_default_papersize
  if n_elements(defaultpaper) EQ 0 then $
    defaultpaper = 'Letter'

  papersizes = intarr(n_elements(papernames))

  ; If localdefaults exist, then enter them into a new first entry of 
  ; the configuration list
  if n_elements(localDefaults) NE 0 then begin
      configs     = [ configs(0), configs ]
      confignames = [ 'Local',    confignames ]
      papernames  = [defaultpaper, papernames ]
      papersizes  = [ 0,          papersizes ]

      tmpc = configs(0)
      struct_assign, localdefaults, tmpc, /nozero
      configs(0) = tmpc
  endif


  ; Generate a new entry at the beginning, which will be the initial, 
  ; default configuration.
  configs     = [ configs(0), configs ]
  confignames = [ 'Default',  confignames ]
  papernames  = [defaultpaper, papernames ]
  papersizes  = [ 0,          papersizes ]

  filechanged = 0
  defaultset = 0
  if n_elements(defaults) NE 0 then begin
      defaultset = 1
      tmpc = configs(0)
      struct_assign, defaults, tmpc, /nozero
      configs(0) = tmpc
      void = where( strupcase(Tag_Names(defaults)) EQ 'FILENAME', count )
      if (count NE 0) then filechanged = 1
  endif

  ; Next, enter in the keyword defaults
  IF NOT defaultset OR N_ELEMENTS(inches) GT 0 then begin
      if n_elements(inches) EQ 0 then inches = 1
      configs(0).inches    = keyword_set(inches)
  endif
  IF NOT defaultset OR n_elements(landscape) GT 0 then $
    configs(0).landscape = keyword_set(landscape)
  if NOT defaultset OR n_elements(color) GT 0 then $
    configs(0).color = keyword_set(color)
  if NOT defaultset OR n_elements(encapsulated) GT 0 then $
    configs(0).encapsulated = keyword_set(encapsulated)

  if NOT defaultset OR n_elements(bits_per_pixel) GT 0 then begin
      if n_elements(bits_per_pixel) EQ 0 then bpp = 8 else bpp = bits_per_pixel
      if bpp LT 1              then bpp = 2
      if bpp GT 2 AND bpp LT 4 then bpp = 4
      if bpp GT 4 AND bpp LT 8 then bpp = 8
      if bpp GT 8              then bpp = 8
      configs(0).bits_per_pixel = bpp
  endif
  
  IF N_ELements(filename) EQ 0 THEN BEGIN
      if NOT filechanged then begin
          CD, Current=thisDir
          filename = Filepath('idl.ps', Root_Dir=thisDir)
          filechanged = 0
          configs(0).filename = filename
      endif
  ENDIF else begin
      configs(0).filename = filename
      filechanged = 1
  endelse

  ; Get the size of the page, based on the papersize keyword
  if n_elements(paperSize) GT 1 then begin
      xpagesize = float(paperSize(0))
      ypagesize = float(paperSize(1))
      pind = 0
  endif else begin
      if n_elements(paperSize) EQ 0 then papersize = defaultpaper
      cmps_form_select_papersize, papersize, xpagesize, ypagesize, $
        landscape=configs(0).landscape, inches=configs(0).inches, index=pind
  endelse
  
  convfactor = 1.0
  if configs(0).inches EQ 0 then convfactor = convfactor * 2.54
  defmarginsize = 1.50 * convfactor   ; 1 1/2 inch margins default
  
  if N_Elements(marginsize) EQ 0 then $
    marginsize    = 0.25 * convfactor ; 1/4 inch margins "minimum"

  ; "Unconvert" the configuration xoff, yoff, etc. into human-readable format,
  ; which is also the format of the keywords xoff and yoff passed to cmps_form()

  nconfigs = n_elements(configs)
  for j = 0, nconfigs-1 do begin
      cmps_form_select_papersize, papernames(j), tmpxpg, tmpypg, $
        landscape=configs(j).landscape, inches=configs(j).inches, $
        index=pind

      papersizes(j) = pind
      tmpc = configs(j)
      cmps_form_conv_pscoord, tmpc, tmpxpg, tmpypg, /tohuman
      configs(j) = tmpc
  endfor

  if n_elements(aspect) GT 0 then aspect = aspect(0) > .001
  if n_elements(ysize) GT 0 then ysize = ysize(0)
  if n_elements(xsize) GT 0 then xsize = xsize(0)
  if n_elements(xsize) GT 0 AND n_elements(ysize) GT 0 then $
    aspect = ysize / (xsize > (ysize*0.001)) $
  else if n_elements(xsize) GT 0 AND n_elements(aspect) GT 0 then $
    ysize = xsize * aspect $
  else if n_elements(ysize) GT 0 AND n_elements(aspect) GT 0 then $
    xsize = ysize / aspect

  ; Compute an intelligent default X and Y size, if they aren't given
  pageaspect = xpagesize / ypagesize

  if NOT defaultset then begin 
    if n_elements(xsize) EQ 0 AND n_elements(ysize) EQ 0 then begin
        if n_elements(aspect) EQ 0 then begin
            IF !D.Window NE -1 THEN $
              aspect = Float(!D.X_VSize) / !D.Y_VSize $
            ELSE $
              aspect = 1.0
        endif

        if aspect GT 1.0 then BEGIN
            configs(0).xsize = xpagesize-2.0*marginsize
            configs(0).ysize = configs(0).xsize / aspect
        endif else begin
            configs(0).ysize = ypagesize-2.0*marginsize
            configs(0).xsize = configs(0).ysize * aspect
        endelse
    endif
    if n_elements(xsize) EQ 0 then $
      configs(0).xsize = 7.0 * convfactor
    if n_elements(ysize) EQ 0 then $
      configs(0).ysize = 5.0 * convfactor
    if n_elements(xoff)  EQ 0 then $
      configs(0).xoff  = (xpagesize-configs(0).xsize) / 2.0
    if n_elements(yoff)  EQ 0 then $
      configs(0).yoff  = (ypagesize-configs(0).ysize) / 2.0
  
    configs(0).xsize = marginsize>configs(0).xsize<(xpagesize-2.*marginsize)
    configs(0).ysize = marginsize>configs(0).ysize<(ypagesize-2.*marginsize)
    configs(0).xoff  = marginsize>configs(0).xoff <(xpagesize-configs(0).xsize)
    configs(0).yoff  = marginsize>configs(0).yoff <(ypagesize-configs(0).ysize)
  endif

  if keyword_set(preserve_aspect) then begin
      if n_elements(xsize) EQ 0 then xsize = configs(0).xsize
      if n_elements(ysize) EQ 0 then ysize = configs(0).ysize
      aspect = ysize / (xsize > (ysize*0.001))
  endif

  if n_elements(xsize) GT 0 then configs(0).xsize = xsize
  if n_elements(ysize) GT 0 then configs(0).ysize = ysize
  if n_elements(xoff)  GT 0 then configs(0).xoff  = xoff
  if n_elements(yoff)  GT 0 then configs(0).yoff  = yoff
  if n_elements(aspect) EQ 0 then aspect = configs(0).ysize / configs(0).xsize

  ; Return the initialized information, if that's all they were asking
  ; for.  Must convert back to "IDL" coordinates.
  IF Keyword_Set(initialize) THEN BEGIN
      sel = 0
      if n_elements(select) GT 0 then begin
          selen = strlen(select)
          wh = where(strupcase(strmid(confignames,0,selen)) EQ $
                     strupcase(select), ct)
          if ct GT 0 then sel = wh(0)
      endif
      cmps_form_select_papersize, papernames(sel), tmpxpg, tmpypg, $
        landscape=configs(sel).landscape, inches=configs(sel).inches
      tmpc = configs(sel)
      xpagesize = tmpxpg & ypagesize = tmpypg
      pagebox = [(0-tmpc.xoff)/tmpc.xsize, $
                 (0-tmpc.yoff)/tmpc.ysize, $
                 (xpagesize-tmpc.xoff)/tmpc.xsize, $
                 (ypagesize-tmpc.yoff)/tmpc.ysize ]
      cmps_form_conv_pscoord, tmpc, tmpxpg, tmpypg, /toidl
      cancelButton = 0
      createButton = 0
      return, tmpc
  endif

   ; This program cannot work if the graphics device is already set
   ; to PostScript. So if it is, set it to the native OS graphics device.
   ; Remember to set it back later.

  IF !D.Name EQ 'PS' THEN BEGIN

      oldName = 'PS'
      thisDevice = Byte(!Version.OS)
      thisDevice = StrUpCase( thisDevice(0:2) )
      IF thisDevice EQ 'MAC' OR thisDevice EQ 'WIN' THEN Set_Plot, thisDevice $
      ELSE Set_Plot, 'X'

  ENDIF ELSE oldName = !D.Name

   ; Check for optional offset parameters and give defaults if not passed

  Device, Get_Screen_Size=screenSize
  IF N_Elements(xoffset) EQ 0 THEN xoffset = (screenSize(0) - 600) / 2.
  IF N_Elements(yoffset) EQ 0 THEN yoffset = (screenSize(1) - 400) / 2.
  
  ; The draw widget will have the following dimensions
  xpixwinsize = 174
  ypixwinsize = 174    ; Hopefully will fit 11" x 17" sized paper

  ; The conversion between length and pixels cannot always be set precisely,
  ; depending on the size of the paper
  dpp = 10.0 / convfactor  ; Desire 10 pixels per inch
  if dpp * xpagesize GT xpixwinsize OR dpp * ypagesize GT ypixwinsize then $
    dpp = min( [ float(xpixwinsize-2)/xpagesize, $
                 float(ypixwinsize-2)/ypagesize ])

  ; Start building the widgets
  thisRelease = StrMid(!Version.Release, 0, 1)
  if thisRelease EQ '5' AND n_elements(parent) GT 0 THEN $
    extra_modal = {Modal:1, Group_Leader:parent(0) }
  tlb0 = Widget_Base(Title='Configure PostScript Parameters', Column=1, $
                     XOffset=xoffset, YOffset=yoffset, TLB_Frame_Attr=9, $
                     _EXTRA=extra_modal)

   ; Sub-bases for layout
  tlb = Widget_Base(tlb0, Column=1, Align_Center=1, frame=1)

  sizebase = Widget_Base(tlb, Row=1,  Align_Center=1)

  numbase = Widget_Base(sizebase, Column=1)

      numsub1 = Widget_Base(numbase, Row=1)

         junk = Widget_Label(numsub1, Value=' Units: ')
             junksub = Widget_Base(numsub1, Row=1, /Exclusive)
                inch = Widget_Button(junksub, Value='Inches', UValue='INCHES')
                cm = Widget_Button(junksub, Value='Centimeters', $
                   UValue='CENTIMETERS')

      numsub2 = Widget_Base(numbase, Row=1, Event_Pro='cmps_form_NumEvents')

         xbase = Widget_Base(numsub2, Column=1, Base_Align_Right=1)
           x1base = Widget_Base(xbase, Row=1)
             junk   = Widget_Label(x1base, Value='XSize: ')
             xsizew = Widget_Text(x1base, Scr_XSize=60, /Editable, $
                                  Value='')

           x2base = Widget_Base(xbase, Row=1)
             junk  = Widget_Label(x2base, Value='XOffset: ')
             xoffw = Widget_Text(x2base, Scr_XSize=60, /Editable, $
                                 Value='')

         ybase = Widget_Base(numsub2, Column=1, Base_Align_Right=1)
           y1base = Widget_Base(ybase, Row=1)
             junk   = Widget_Label(y1base, Value='YSize: ')
             ysizew = Widget_Text(y1base, Scr_XSize=60, /Editable, $
                      Value='')

           y2base = Widget_Base(ybase, Row=1)
             junk  = Widget_Label(y2base, Value='YOffset: ')
             yoffw = Widget_Text(y2base, Scr_XSize=60, /Editable, $
                                 Value='')

     paperw = Widget_Label(numbase, $
       Value='                                        ' )
     dummy = widget_base(numbase, column=1, /nonexclusive)
     aspectw = widget_button(dummy, value='Preserve Aspect', uvalue='ASPECT')

   drawbase = Widget_Base(sizebase, Row=1, frame=1)

   draw = Widget_Draw(drawbase, XSize=xpixwinsize, YSize=ypixwinsize, $
     Event_Pro='cmps_form_Box_Events', Button_Events=1)

   opttlb  = Widget_Base(tlb, Row=1, align_center=1, xpad=20)

   orientbase = Widget_Base(opttlb, Column=1, base_align_center=1)

   junk = Widget_Label(orientbase, Value='Orientation: ')
      junkbase = Widget_Base(orientbase, Column=1, /Frame, /Exclusive)
         land = Widget_Button(junkbase, Value='Landscape', UValue='LANDSCAPE')
         port = Widget_Button(junkbase, Value='Portrait', UValue='PORTRAIT')

   optbase = Widget_Base(opttlb, Column=1, /NonExclusive, frame=1)
     colorbut  = widget_button(optbase, Value='Color Output', $
                 uvalue='COLOR')
     encap     = Widget_Button(optbase, Value='Encapsulated (EPS)', $
                           uvalue='ENCAPSULATED')
     isolatin1 = widget_button(optbase, Value='ISOLatin1 Encoding', $
                 UValue='ISOLATIN1')

;   bitslabel = Widget_Label(opttlb, Value='   Color Bits:')

   bitsw = Widget_Base(opttlb, Column=1, /Exclusive, /frame)

      bit2 = Widget_Button(bitsw, Value='2 Bit Color', UValue='BITS2')
      bit4 = Widget_Button(bitsw, Value='4 Bit Color', UValue='BITS4')
      bit8 = Widget_Button(bitsw, Value='8 Bit Color', UValue='BITS8')

   filenamebase = Widget_Base(tlb, Column=1, Align_Center=1)
   fbase = Widget_Base(filenamebase, Row=1)
   textlabel = Widget_Label(fbase, Value='Filename: ')

       ; Set up text widget with an event handler that ignores any event.

   filenamew = Widget_Text(fbase, /Editable, Scr_XSize=300,  $
      Value='', Event_Pro='cmps_form_Null_Events')
   filenameb = widget_button(fbase, value='Choose...', $
                             event_pro='cmps_form_select_file')

   ; This is a base for selection of predefined configurations and paper sizes
   predefbase = Widget_Base(tlb0, row=1, /align_center, frame=1)
   junk = widget_label(predefbase, value='Predefined:')
   predlist = widget_droplist(predefbase, value=confignames, $
                          event_pro='cmps_form_predef_events', UValue='PREDEF')
   junk = widget_label(predefbase, value='    Paper Sizes:')
   paplist = widget_droplist(predefbase, value=cmps_form_papernames(),$
                          event_pro='cmps_form_predef_events', UValue='PAPER')
   
   actionbuttonbase = Widget_Base(tlb0, Row=1, /Align_Center)
   cancel = Widget_Button(actionbuttonbase, Value='Cancel', UValue='CANCEL')
   if n_elements(buttons) GT 0 then begin
       for i = 0, n_elements(buttons)-1 do begin
           but = widget_button(actionbuttonbase, value=buttons(i), $
                               uvalue='ACCEPT')
       endfor
   endif else begin
       create = Widget_Button(actionbuttonbase, Value='Create File', $
                              UValue='CREATE')
       accept = Widget_Button(actionbuttonbase, Value='Accept', $
                              UValue='ACCEPT')
   endelse


   ; Modify the color table 
   ; Get the colors in the current color table
   TVLct, r, g, b, /Get

   ; Modify color indices N_Colors-2, N_Colors-3 and N_Colors-4 for
   ; drawing colors

   ; The number of colors in the session can be less then the
   ; number of colors in the color vectors on PCs (and maybe other
   ; computers), so take the smaller value. (Bug fix?)
   ncol = !D.N_Colors < N_Elements(r)
   red = r
   green = g
   blue=b
   red(ncol-4:ncol-2) = [70B, 0B, 255B]
   green(ncol-4:ncol-2) = [70B, 255B, 255B]
   blue(ncol-4:ncol-2) = [70B, 0B, 0B]

   ; Load the newly modified colortable
   TVLct, red, green, blue

   ; Create a reserve pixmap for keeping backing store
   owin = !d.window
   Window, /Free, XSize=xpixwinsize, YSize=ypixwinsize, /Pixmap
   pixwid = !D.Window

   ; Create a handle.  This will hold the result after the widget finishes
   ptr = Handle_Create()

   info = { $
            devconfig: configs(0), $
            iddraw: draw, $
            idpixwid: pixwid, $
            idwid: pixwid, $
            idtlb: tlb0, $
            idxsize: xsizew, $
            idysize: ysizew, $
            idxoff: xoffw, $
            idyoff: yoffw, $
            idfilename: filenamew, $
            idinch: inch, $
            idcm: cm, $
            idcolor: colorbut, $
            idbitbase: bitsw, $
            idbit2: bit2, $
            idbit4: bit4, $
            idbit8: bit8, $
            idisolatin1: isolatin1, $
            idencap: encap, $
            idland: land, $
            idport: port, $
            idpaperlabel: paperw, $
            idaspect: aspectw, $
            idpaperlist: paplist, $
            xpagesize: xpagesize, $
            ypagesize: ypagesize, $
            paperindex: pind, $
            marginsize: marginsize, $
            xpixwinsize: xpixwinsize, $
            ypixwinsize: ypixwinsize, $
            drawpixperunit: dpp, $
            filechanged: filechanged, $
            pixredraw: 1, $
            imousex: 0.0, $
            imousey: 0.0, $
            ideltx: 0.0, $
            idelty: 0.0, $
            pagecolor: ncol-2, $
            boxcolor: ncol-3, $
            bkgcolor: ncol-4, $
            red: r, $
            green: g, $
            blue: b, $
            ptrresult: ptr, $
            predefined: configs, $
            papersizes: papersizes, $
            defaultpaper: defaultpaper, $
            aspect: aspect, $
            preserve_aspect: keyword_set(preserve_aspect) $
          }
   
   cmps_form_draw_form, info, /nobox
   Widget_Control, tlb0, /Realize
   Widget_Control, draw, Get_Value=wid
   info.idwid = wid

   ;; Make sure the current info is consistent
   cmps_form_update_info, info
   ; Draw the remaining widgets
   widget_control, paplist, Set_DropList_Select=pind
   cmps_form_draw_form, info

   ; Store the info structure in the top-level base

   Widget_Control, tlb0, Set_UValue=info, /No_Copy

   ; Set this widget program up as a modal or blocking widget. What this means
   ; is that you will return to the line after this XManager call when the
   ; widget is destroyed.

   thisRelease = StrMid(!Version.Release, 0, 1)
   if thisRelease EQ '4' then $
     xmanager_modal = {Modal:1}
   XManager, 'cmps_form', tlb0, _extra=xmanager_modal

   ; Get the formInfo structure from the pointer location.

   Handle_Value, ptr, formInfo, /No_Copy

   ; Make sure the user didn't click a close button.

   IF N_Elements(formInfo) EQ 0 THEN Begin
       Handle_Free, ptr
       RETURN, 0
   EndIF

   ; Strip the CANCEL field out of the formInfo structure so the
   ; cancelButton flag can be returned via the CANCEL keyword and the
   ; formInfo structure is suitable for passing directly to the DEVICE
   ; procedure through its _Extra keyword.

   cancelButton = formInfo.cancel
   createButton = formInfo.create
   IF NOT cancelButton THEN begin
       xpagesize = formInfo.xpagesize
       ypagesize = formInfo.ypagesize
       paperindex  = formInfo.paperindex
       if n_elements(buttons) GT 0 then $
         button_sel = forminfo.buttonname
       formInfo = formInfo.result 
       
       papersize = cmps_form_papernames()
       papersize = papersize(paperindex)
       pagebox = [(0-formInfo.xoff)/formInfo.xsize, $
                  (0-formInfo.yoff)/formInfo.ysize, $
                 (xpagesize-formInfo.xoff)/formInfo.xsize, $
                 (ypagesize-formInfo.yoff)/formInfo.ysize ]
       cmps_form_conv_pscoord, formInfo, xpagesize, ypagesize, /toidl
   endif else $
     formInfo = 0

   ; Free up the space allocated to the pointers and the data

   Handle_Free, ptr

   if owin GE 0 then wset, owin
   Set_Plot, oldname

   RETURN, formInfo
END ;*******************************************************************

;+
; NAME:
;   CMREPLICATE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Replicates an array or scalar into a larger array, as REPLICATE does.
;
; CALLING SEQUENCE:
;   ARRAY = CMREPLICATE(VALUE, DIMS)
;
; DESCRIPTION: 
;
;   The CMREPLICATE function constructs an array, which is filled with
;   the specified VALUE template.  CMREPLICATE is very similar to the
;   built-in IDL function REPLICATE.  However there are two
;   differences:
;
;      * the VALUE can be either scalar or an ARRAY.
;
;      * the dimensions are specified as a single vector rather than
;        individual function arguments.
;
;   For example, if VALUE is a 2x2 array, and DIMS is [3,4], then the
;   resulting array will be 2x2x3x4.
;
; INPUTS:
;
;   VALUE - a scalar or array template of any type, to be replicated.
;           NOTE: These two calls do not produce the same result:
;                  ARRAY = CMREPLICATE( 1,  DIMS)
;                  ARRAY = CMREPLICATE([1], DIMS)
;           In the first case the output dimensions will be DIMS and
;           in the second case the output dimensions will be 1xDIMS
;           (except for structures).  That is, a vector of length 1 is
;           considered to be different from a scalar.
;
;   DIMS - Dimensions of output array (which are combined with the
;          dimensions of the input VALUE template).  If DIMS is not
;          specified then VALUE is returned unchanged.
;
; RETURNS:
;   The resulting replicated array.  
;
; EXAMPLE:
;   x = [0,1,2]
;   help, cmreplicate(x, [2,2])
;     <Expression>    INT       = Array[3, 2, 2]
;   Explanation: The 3-vector x is replicated 2x2 times.
;
;   x = 5L
;   help, cmreplicate(x, [2,2])
;     <Expression>    LONG      = Array[2, 2]
;   Explanation: The scalar x is replicated 2x2 times.
;
; SEE ALSO:
;
;   REPLICATE
;
; MODIFICATION HISTORY:
;   Written, CM, 11 Feb 2000
;   Fixed case when ARRAY is array of structs, CM, 23 Feb 2000 
;   Apparently IDL 5.3 can't return from execute().  Fixed, CM, 24 Feb
;     2000
;   Corrected small typos in documentation, CM, 22 Jun 2000
;   Removed EXECUTE() call by using feature of REBIN() new in IDL 5.6,
;     (thanks to Dick Jackson) CM, 24 Apr 2009 
;   Remove some legacy code no longer needed after above change
;     (RETVAL variable no longer defined; thanks to A. van Engelen),
;     CM, 08 Jul 2009
;   Change to square bracket array index notation; there were reports
;     of funny business with parenthesis indexing (thanks Jenny Lovell),
;     CM, 2012-08-16
;
;-
; Copyright (C) 2000, 2009, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CMRESTORE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Restore variables from an IDL SAVE file.
;
; CALLING SEQUENCE: (various)
;   CMRESTORE, filename                           (implicit)
;   CMRESTORE, filename, var1, var2, ..., [, NAMES=names]
;   CMRESTORE, filename, DATA=pointers, NAMES=names, PASS_METHOD='POINTER'
;   CMRESTORE, filename, DATA=handles,  NAMES=names, PASS_METHOD='HANDLE'
;   CMRESTORE, filename, DATA=structure,             PASS_METHOD='STRUCT'
;   
; DESCRIPTION: 
;
;   CMRESTORE is a replacement for the built-in IDL procedure RESTORE.
;   It restores variables and data from an existing IDL SAVE file,
;   written either by SAVE or CMSAVE.  The CMSV utility library must
;   be installed in your IDL path to use CMSAVE and CMRESTORE.
;
;   The primary advantage to CMRESTORE is the ability to selectively
;   restore only certain variables from the input file (based on
;   name).  CMRESTORE provides a number of ways to pass the data
;   between routines, typically using a pointer or structure, which
;   avoids the unsafe practice of restoring variables in the caller's
;   namespace.  However, CMRESTORE can restore variables into the
;   caller's namespace, but users should be aware that this capacity
;   is somewhat limited in IDL versions 5.2 and below.
;
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; COMPATIBILITY:
;
;   -- File Format --
;
;   CMRESTORE should be able to read files written by SAVE and CMSAVE
;   from IDL version 4 to version 5.4.
;
;   CMRESTORE cannot restore objects, pointers, compressed files, or
;   data sets larger than 2 gigabytes.
;   
;   Data types available in newer versions of IDL, such as pointers
;   and long integers, will not be readable in older versions of IDL
;   which do not have those data types.
;
;   -- Calling Interface --
;
;   For the most part, all capabilities of CMRESTORE are available to
;   the user.  However, it should be noted that passing variables by
;   positional parameter is not available under IDL 4, unless NAMES is
;   used to name the variables explicitly.  Also, under IDL versions
;   5.2 and previous, it is not possible for CMRESTORE to restore
;   variables into the caller's name space if they are not yet
;   defined.
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
; INPUTS:
;
;   FILENAME - the name of the SAVE file.
;              Default: none, this parameter must be specified.
;
;   VAR{i} - The values to be restored.  By default the save name is
;            taken from the named variables that are passed.  These
;            default names can be overridden by using the NAMES
;            keyword.
;
;            If no variables are passed as positional parameters, they
;            can still be saved using the DATA keyword.  By invoking
;            CMRESTORE without positional parameters or DATA,
;            CMRESTORE automatically will attempt to restore the
;            variables to the calling routine's name space (the
;            "implicit" technique).
;
;               NOTE: in IDL 5.2 and below, user routines are not
;               allowed to *CREATE* new variables in the caller's name
;               space.  CMRESTORE may fail if the variable in
;               undefined in the caller.  Therefore you must define it
;               before calling CMRESTORE.  The safer practice is to
;               use the VAR{i} positional parameters, or the DATA
;               keyword.
;
; KEYWORDS:
;
;   FILENAME - the name of the SAVE file.  The positional FILENAME
;              parameter takes precedence over the keyword FILENAME
;              parameter.
;
;              NOTE that if you pass variables as positional
;              parameters, then the first parameter *must* be the file
;              name, and the FILENAME *keyword* will be ignored.
;
;   PASS_METHOD - a scalar string, describing the method of passing
;                 data between the caller and CMRESTORE.  The keyword
;                 can take the value 'ARGUMENT', 'POINTER', 'HANDLE'
;                 or 'STRUCT'.  A value of 'ARGUMENT' indicates that
;                 data values will be passed by command line argument,
;                 and is the default.  Other values are described
;                 below.
;
;   DATA - A list of data elements to be restored from the output
;          file.  The data elements can be one of the following,
;          depending on the value of PASS_METHOD.  The means of
;          extracting the data, and the method of naming each
;          variable, are also indicated.
;
;            * PASS_METHOD='POINTER': An array of pointers to the variables
;                    Data: pointed-to value     Name: from NAMES keyword
;            * PASS_METHOD='HANDLE':  An array of handles to the variables
;                    Data: pointed-to value     Name: from NAMES keyword
;            * PASS_METHOD='STRUCT':  A structure containing data to be saved
;                    Data: tag value            Name: tag name
;
;          Data values are restored one by one, using the appropriate
;          name.  Note that any variables passed as positional
;          parameters will cause the DATA keyword to be ignored.
;
;          CMRESTORE will allocate any pointer or handle resources.
;          The calling routine is responsible for deallocating any
;          pointer or handle resources.
;
;   NAMES - a string array, giving the names for each variable.  
;
;           If the data are passed by positional parameters, the names
;           are assigned according to the position of the parameter in
;           the procedure call.  
;
;           If the data are passed by an array of pointers or handles,
;           then the names are assigned according to the position of
;           the data in the array.  In this case there is no other way
;           to supply the variable name.  NAMES is required.
;
;           If the data are passed in a structure, then the names are
;           assigned according to the position of the data in the
;           structure.  The values specified in the names keyword
;           override the tag names.
;
;   STATUS - upon return, an integer indicating the status of the
;            operation.  A value of 1 indicates success, while 0
;            indicates failure.  A failure condition does not
;            necessarily indicate that an individual variable could
;            not be restored; use the VARSTATUS keyword to detect such
;            situations.
;
;   VARSTATUS - upon return, an integer array indicating the status of
;               the restore operation for each variable.  A value of 1
;               at position i in the array indicates success for the
;               ith variable, while a value of 0 indicates failure.
;
;   ERRMSG - upon return, a string indicating the status of the
;            operation.  The empty string indicates success, while a
;            non-empty string indicates failure and describes the
;            error condition.
;
;   QUIET - if set, then the error message is returned to the calling
;           routine.  By default an error condition causes execution
;           to stop and the message to be printed on the console.
;
;   VERBOSE - if set, then a short message is printed for each
;             variable.
;
; EXAMPLE:
;
;   CMSAVE, VAR1, VAR2, FILENAME='test.sav'
;   CMSAVE, VAR1, VAR2, FILENAME='test.sav', NAMES=['A','B']
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  In the
;     first case the saved variable names will be VAR1 and VAR2.  In
;     the second case the saved variable names will be A and B.
;
;   POINTERS = [ptr_new(VAR1), ptr_new(VAR2)]
;   CMSAVE, DATA=POINTERS, NAMES=['A','B'], FILENAME='test.sav'
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  The saved
;     variable names will be A and B.
;
;   STRUCTURE = {A: VAR1, B: VAR2}
;   CMSAVE, DATA=STRUCTURE, FILENAME='test.sav'
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  The saved
;     variable names will be A and B.
;
; SEE ALSO:
;
;   CMSAVE, SAVE, RESTORE
;
; MODIFICATION HISTORY:
;   Written, 14 May 2000
;   Documented, 22 Sep 2000
;   Restore into caller's name space now permitted, 11 Jan 2001
;   Documented "implicit" restore a little better, w/ errors, 01 Mar 2001
;   Make version checks with correct precision, 19 Jul 2001, CM
;   Restore with no args automatically does ALL, is this right?,
;     CM, 20 Aug 2001
;   Added notification about RSI License, 13 May 2002, CM
;   Handle the case of CMRESTORE, FILENAME, X properly, 03 Sep 2008, CM
;     (thanks to Sergey Koposov for reporting)
;   Report CMSVLIB version number when /VERBOSE is set, 22 Nov 2009,
;      CM
;   Change to accomodate lack of GDL functionality when restoring
;      all variables, 22 Nov 2009, CM
;
; $Id: cmrestore.pro,v 1.22 2009/11/22 23:31:00 craigm Exp $
;
;-
; Copyright (C) 2000-2001, 2008, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; This utility function is only called under IDL 4
function arg_present, x
  return, 0
end

pro cmrestore,   filename0, filename=filename1, $
                  p0,  p1,  p2,  p3,  p4,  p5,  p6,  p7,  p8,  p9, $
                 p10, p11, p12, p13, p14, p15, p16, p17, p18, p19, $
                 p20, p21, p22, p23, p24, p25, p26, p27, p28, p29, $
                 verbose=verbose, all=all, restored_objects=restobj, $
                 status=status, varstatus=colstatus, mtimes=mtimes, $
                 names=names, data=data, pass_method=method, $
                 errmsg=errmsg, quiet=quiet, nocatch=nocatch, $
                 relaxed_structure_assignment=relax, version=revision
                  
  forward_function routine_names, ptrarr, ptr_new, handle_create, arg_present

  status = 0
  errmsg = ''
  colstatus = 0 & dummy = temporary(colstatus)  ;; Void out the status

  cmsvlib_version = '<unknown>'
  catch, catcherr
  if catcherr EQ 0 then lib = cmsvlib(/query, version=cmsvlib_version) else lib = 0
  catch, /cancel
  if lib EQ 0 then $
    message, 'ERROR: The CMSVLIB library must be in your IDL path.'

  revision = '$Revision: 1.22 $'
  ;; Extract the version number
  revision = stregex(revision,'\$'+'Revision: *([0-9.]+) *'+'\$',/extract,/sub)
  revision = revision(1)

  if keyword_set(verbose) then begin
     message, /info, 'CMRESTORE version '+revision, traceback=0
     message, /info, 'CMSV Library version '+cmsvlib_version(0), traceback=0
  endif

  if NOT keyword_set(nocatch) then on_error, 2
  kall = 0                      ;; NOTE: Ignoring ALL keyword!!

  n_par = n_params()
  nnames = n_elements(names)
  ver = double(!version.release)
  if n_elements(filename0) EQ 0 AND n_elements(filename1) EQ 0 then begin
      message, 'USAGE: CMRESTORE, filename, VAR1, VAR2, ...', /info
      return
  end
  ;; Now n_par refers to the number of positional variables (ie,
  ;; filename excluded)
  n_par = n_par - 1

  ;; Default processing
  if n_elements(filename0) GT 0 then filename = strtrim(filename0(0),2) $
  else                               filename = strtrim(filename1(0),2)

  ;; Input method
  if n_elements(method) EQ 0 then begin
      if n_par GT 0 then meth = 'ARGUMENT' $
      else               meth = 'STORE'
  endif else begin
      meth = strupcase(strtrim(method(0),2))
  endelse
  ;; Trim it down so that people don't have to type too many characters
  meth = strmid(meth, 0, 3)

  ;; Error checking on input method, depending on IDL version
  if meth EQ 'ARG' AND ver LT 5D AND nnames EQ 0 then begin
      errmsg = ('ERROR: in IDL 4 you cannot pass variables by argument '+ $
                'to CMRESTORE.')
      goto, PRE_CLEANUP
  endif
  ;; Implicit restore of ALL, if no names are provided
  if nnames EQ 0 AND n_par EQ 0 then kall = 1
  ;; GDL is incapable of restoring all variables without them being named.
  DEFSYSV, '!gdl', exists=is_it_gdl
  if is_it_gdl then begin
      if nnames EQ 0 then kall = 1
  endif

  ;; Extract some information about the calling routine
  lev = routine_names(/level)
  vlev = lev - 1

  ;; Note: if the user specified "ALL" then we set NNAMES to zero,
  ;; indicating that the number of variables to be returned is unknown
  ;; at present.
  if kall then nnames = 0L

  if n_par LT 1 AND meth NE 'STO' AND arg_present(data) EQ 0 then begin
      if ver GE 5D OR meth EQ 'ARG' then begin
          errmsg = ('ERROR: A way to return data must be specified.  Pass by'+$
                    ' argument (IDL >= 5), or using the NAMES/DATA keywords.')
          goto, PRE_CLEANUP
      endif
  endif

  ;; ---------------- Establish I/O parameters -------------------
  ;; Upon exit from this block, at least the following variables must
  ;; be set: (a) nvar = number of named variables, (b) vnames = names
  ;; of variables in SAVE file to be restored.
  
  ;; Special case: if keyword ALL is set, then nvar EQ 0, and vnames
  ;; is undefined.  It will be filled in later then.
  if meth EQ 'ARG' then begin
      ;; Now processing that depends on the data passing method.  The
      ;; "argument" method is via positional arguments.

      ;; Extract variables from positional parameters
      if kall EQ 0 then nnames = n_par
      if (kall EQ 0 AND nnames EQ 0) $
        OR (kall AND n_par LE 0) then begin
          errmsg = 'ERROR: Returnable variables must be specified.'
          goto, PRE_CLEANUP
      endif
      lev1 = strtrim(lev-1,2)
      nvar = nnames
      if nvar GT 0 then vnames = strarr(nvar)
      if NOT kall AND ver GE 5D then begin
          for i = 0L, nvar-1 do $
            dummy = execute('vnames(i) = (routine_names(p'+strtrim(i,2)+ $
                            ',arg_name='+lev1+'))(0)')
      endif
  endif else if meth EQ 'STO' then begin
      ;; This information is used to determine whether the variable
      ;; already exists in the caller.  If it doesn't, and we are in
      ;; IDL 5.2 or earlier, then we can't save it.
      cnames = strupcase(strtrim(routine_names(variables=vlev),2))

      nvar = nnames
      if nvar GT 0 then vnames = strarr(nvar)
      
  endif else begin

      ;; Instead of passing the data via positional parameters, they
      ;; can be set through the DATA keyword, but even there this can
      ;; be accomplished with several means: via pointers, via
      ;; handles, or using a structure.
      
      ;; Clear DATA in preparation for restore operation
      data = 0 & dummy = temporary(data)
      nvar = nnames
      if nvar GT 0 then vnames = strarr(nvar)

      if meth EQ 'POI' then begin               ;; POINTER TYPE
          ;; Construct an array of null pointers to start with
          if nvar GT 0 then data = ptrarr(nvar)
      endif else if meth EQ 'HAN' then begin     ;; HANDLE TYPE
          ;; Construct an array of invalid handles to start with
          if nvar GT 0 then data = lonarr(nvar)-1L
      endif else if meth EQ 'STR' then begin
          ;; Do nothing
      endif else begin
          errmsg = 'ERROR: PASS_METHOD must be one of ARGUMENT, POINTER, '+$
            'HANDLE or STRUCT'
          PRE_CLEANUP:
          status = 0
          if NOT keyword_set(quiet) then message, errmsg, /info
          return
      endelse
  endelse

  if kall EQ 0 then begin
      if nvar LE 0 then begin
          errmsg = 'ERROR: no variable names were specified'
          goto, PRE_CLEANUP
      endif else begin
          colstatus = lonarr(nvar)
      endelse
  endif

  ;; User-renamed variables.  These names will override any names
  ;; specified in positional parameters.
  if n_elements(names) GT 0 AND NOT kall then begin
      sz = size(names)
      if sz(sz(0)+1) NE 7 then begin
          errmsg = 'ERROR: NAMES must be a string array'
          goto, PRE_CLEANUP
      endif
      vnames(0) = strtrim(strupcase(names(*)),2)
  endif

  ;; Open the save file
  get_lun, unit
  cmsv_open, unit, filename, pp, access='R', status=status, errmsg=errmsg
  if status EQ 0 then goto, CLEANUP
  if keyword_set(verbose) then $
    message, 'Portable (XDR) SAVE/RESTORE file.', /info, traceback=0

  pp0 = pp  ;; Block pointer
  ivar = 0L ;; Number of variables that have been read successfully
  if n_elements(vnames) GT 0 then $
    found = lonarr(n_elements(vnames))

  ptr_index   = [0L]
  ptr_offsets = [0L]
  if ver GE 5D then ptr_data = [ptr_new()] $
  else              ptr_data = [0L]

  ;; Now begin the processing
  repeat begin
      ;; Read block from SAVE file
      bn = ''
      point_lun, unit, pp
      block = 0 & dummy = temporary(block)
      cmsv_rrec, block, pp1, bdata, unit=unit, next_block=pnext, /init, $
        block_type=bt, block_name=bn, status=status, errmsg=errmsg, offset=pp,$
        promote64=promote64
      if status EQ 0 then goto, CLEANUP
      eb = (bn EQ 'END_MARKER')

      ;; Examine each block type  -----

      errmsg = ''
      jfind = -1L
      case bn of 

          ;; Promote record header to 64-bits (compatibility)
          'PROMOTE64': if keyword_set(verbose) then begin
              message, 'File contains 64-bit offsets.', /info, traceback=0
          endif

          ;; Read time stamp record
          'TIMESTAMP': if keyword_set(verbose) then begin
              stamp = bdata
              message, 'Save file written by '+stamp.save_user+'@'+ $
                stamp.save_host+', '+stamp.save_date, /info, traceback=0
          endif
          
          ;; Read version record
          'VERSION': if keyword_set(verbose) then begin
              vers = bdata
              message, ('IDL version '+vers.release+' ('+vers.os+ $
                        ', '+vers.arch+')'), /info, traceback=0
              message, 'File format revision: '+ $
                strtrim(vers.format_version,2), /info, traceback=0
          endif

          ;; Read heap index record
          'HEAP_INDEX': begin
              ii = bdata
              ptr_index   = [ptr_index, ii]
              ptr_offsets = [ptr_offsets, ii*0L]
              if ver GE 5D then $
                ptr_data    = [ptr_data, ptrarr(n_elements(ii))]
          end

          ;; Read heap data - just store a file pointer for later
          ;;                  referral
          'HEAP_DATA': begin
              p2 = pp1
              cmsv_rvtype, block, pp1, vindex, /heap, unit=unit, $
                status=st1, errmsg=errmsg
              if st1 EQ 0 then goto, NEXT_BLOCK

              ;; VINDEX will be the heap variable number.  Once we
              ;; know this we can put the file offset into
              vindex = floor(vindex(0))
              wh = where(ptr_index EQ vindex, ct)
              if ct EQ 0 then goto, NEXT_BLOCK
              ptr_offsets(wh(0)) = pp + p2  ;; block address + offset
          end              

          ;; Read variable data, and store for return to caller
          'VARIABLE': begin
              ;; Read variable type
              cmsv_rvtype, block, pp1, vn, sz1, unit=unit, status=st1, $
                template=tpp1, errmsg=err1
              if vn EQ '' OR st1 EQ 0 then goto, NEXT_BLOCK
              if kall EQ 0 then begin
                  jfind = (where(vn EQ vnames, ct))(0)
                  if ct EQ 0 then goto, NEXT_BLOCK
                  found(jfind) = 1
              endif
              
              ;; Read variable data
              cmsv_rdata, block, pp1, sz1, val, template=tpp1, status=st1, $
                unit=unit, errmsg=errmsg, ptr_offsets=ptr_offsets, $
                ptr_index=ptr_index, ptr_data=ptr_data
              if st1 EQ 0 then goto, NEXT_BLOCK
              if sz1(0) GT 0 then arr = 1 else arr = 0
              if arr then begin
                  ;; If an array then reform to be sure dimensions are right
                  dims = sz1(1:sz1(0))
                  val = reform(val, dims, /overwrite)
              endif
              
              if kall then begin
                  ;; With ALL, we extend the vector at each variable
                  jfind = ivar & ii = strtrim(jfind,2)
                  if ivar EQ 0 then begin
                      anames = [vn]
                      colstatus = [0L]
                  endif else begin
                      anames = [anames, vn]
                      colstatus = [colstatus, 0L]
                  endelse
              endif
              
              ;; Now send the data to output, depending on the method
              case meth of 
                  'ARG': begin
                      ;; Position dependent parameter
                      if jfind GE n_par then goto, NEXT_BLOCK
                      ii = strtrim(jfind,2)
                      if arr EQ 0 then begin
                          dummy = execute('p'+ii+' = temporary(val)') 
                      endif else begin
                          dummy = execute('p'+ii+' = reform(val, dims, '+ $
                                          '/overwrite)')
                      endelse
                      if dummy EQ 0 then goto, NEXT_BLOCK
                  end
                  'STO': begin
                      ;; Store the data in caller.  Check for IDL 5.3
                      ;; compatibility.
                      jfind1 = where(vn EQ cnames, ct1)
                      if ver LT 5.3D AND jfind1(0) EQ -1 then begin
                          if keyword_set(quiet) EQ 0 then begin
                              message, 'WARNING: could not create variable '+$
                                vn+' in calling routine.', /info, traceback=0
                          endif
                          goto, NEXT_BLOCK
                      endif
                      dummy = routine_names(vn, val, store=vlev)
                  end
                  'POI': begin
                      ;; Pointer to data
                      if kall then begin
                          if ivar EQ 0 then data = ptrarr(1) $
                          else data = [data, ptr_new()]
                      endif
                      data(jfind) = ptr_new(val)
                  end
                  'HAN': begin
                      ;; Handle to data
                      if kall then begin
                          if ivar EQ 0 then data = [-1L] $
                          else data = [data, -1L]
                      endif
                      data(jfind) = handle_create(value=val, /no_copy)
                  end
                  'STR': begin
                      ;; Add data to structure
                      if n_elements(sdata) EQ 0 then $
                        sdata = create_struct(vn, val) $
                      else $
                        sdata = create_struct(sdata, vn, val)
                  end
              endcase
              
              colstatus(jfind) = 1
              if kall then ivar = ivar + 1
          end


          ELSE: dummy = 1
      endcase

      NEXT_BLOCK:
      if NOT keyword_set(quiet) then begin
          if errmsg NE '' then $
            message, errmsg, /info
          if keyword_set(verbose) AND jfind GE 0 then begin
              if colstatus(jfind) EQ 1 then $
                message, 'Restored variable: '+vn+'.', /info, traceback=0 $
              else $
                message, 'Unable to restore variable: '+vn+'.', /info, $
                traceback=0
          endif
      endif
      ;; Advance to next block
      if pp NE pnext then begin
          pp = pnext 
      endif else begin
          status = 0
          errmsg = 'ERROR: internal inconsistency'
      endelse
  endrep until bn EQ 'END_MARKER' OR status EQ 0

  ;; Clean up
  free_lun, unit

  DONE_RESTORE:
  if meth EQ 'STR' then begin
      ;; Put new struct data on output
      data = 0 & dummy = temporary(data)
      if n_elements(sdata) GT 0 then data = temporary(sdata)
  endif
  if kall then begin
      names = 0 & dummy = temporary(names)
      if n_elements(anames) GT 0 then names = anames
  endif

  if n_elements(found) GT 0 then begin
      wh = where(found EQ 0, ct)
      fmt = '(A,'+strtrim(ct,2)+'(A,:," "),".")'
      if ct GT 0 then begin
          errmsg = string("WARNING: the following variables were not found: ",$
                          vnames(wh), format=fmt)+'.'
          if NOT keyword_set(quiet) OR keyword_set(verbose) then $
            message, errmsg, /info, traceback=0
      endif
  endif

  if total(colstatus) GT 0 then begin
      status = 1
  endif else begin
      status = 0
      errmsg = 'ERROR: No variables were restored.'
      if meth EQ 'STO' AND ver LT 5.3D then begin
          errmsg = errmsg + '  NOTE: In IDL 5.2 and earlier the variable '+$
            'must first be defined by the caller in order to use the '+$
            '"implicit" restore technique.'
          message, errmsg, /info, traceback=0
      endif
  endelse

  return

  ;; 
  ;; Error handling routine, outside the normal call flow
  CLEANUP:
  catch, /cancel
  if n_elements(unit) GT 0 then free_lun, unit
  status = 0
  if errmsg NE '' AND NOT keyword_set(quiet) then message, errmsg, /info

  return
end

;+
; NAME:
;   CMSAVE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Save IDL variables to a file.  (IDL v5 and greater)
;
; CALLING SEQUENCE: (various)
;   CMSAVE, var1, var2, ..., FILENAME=filename [, NAMES=names]
;   CMSAVE, DATA=pointers, NAMES=names, FILENAME=filename
;   CMSAVE, DATA=handles, NAMES=names,  FILENAME=filename
;   CMSAVE, DATA=structure,             FILENAME=filename
;   
; DESCRIPTION: 
;
;   CMSAVE is a replacement for the built-in IDL procedure SAVE, with
;   more flexibility and increased capabilities.
;
;   CMSAVE produces output files that are compatible with the standard
;   save format of IDL versions 4 and 5 (and perhaps greater).
;   Variables may be restored by using either the built-in procedure
;   RESTORE, or CMRESTORE.  The CMSV utility library must be installed
;   in your IDL path to use CMSAVE and CMRESTORE.
;
;   The primary advantages to CMSAVE are the ability to append
;   additional variables to an existing SAVE file, and several
;   flexible ways to pass the data and variable names to be saved.
;   CMSAVE also attempts to run on all IDL versions.
;
;   To append variables to an existing file, simply specify the APPEND
;   keyword, and the filename of an existing writable SAVE file.
;   Variables will be appended to the end of the file.  It is possible
;   to append a variable with the same name as an existing variable in
;   a file.  Both data values are stored in the file.  However the
;   results upon restore are undefined.  There is also a limitation
;   that only one series of heap values -- pointed-to data -- may be
;   saved in a file.
;
;   By the normal convention of the built-in SAVE command, both the
;   data and variable names to be saved are passed as parameters on
;   the command line.  Each parameter must be a named variable; both
;   the name and value are saved.
;
;   This convention may be used in invoking CMSAVE as well.  However,
;   in addition to passing the data by positional parameter, the user
;   can pass the data using the DATA keyword.  If the DATA keyword is
;   used, then an array of pointers or handles may be passed, or a
;   structure of values may be passed.  (see below)  If both are
;   passed, then the positional parameters take precedence.
;
;   It is also possible to explicitly rename the saved variables: the
;   saved name does not need to be the name of the named variable.
;   Use the NAMES keyword to override the default name.  By default
;   the name is drawn from any named variables, or from the structure
;   tag names if the DATA keyword is used with a structure.  The NAMES
;   keyword takes precedence over these values.  NOTE: Values passed
;   by pointer or handle are not named by default, and so will not be
;   saved unless the NAMES keyword is used.
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; COMPATIBILITY:
;
;   -- File Format --
;   Files written by CMSAVE should be readable with all known versions
;   of IDL at the time of this writing (version 4 - version 5.4).  It
;   is expected that this compatibility will persist.
;
;   CMSAVE cannot write objects, compressed files, or data sets larger
;   than 2 gigabytes.
;
;   Data types available in newer versions of IDL, such as pointers
;   and long integers, will not be readable in older versions of IDL
;   which do not have those data types.
;
;   -- Calling Interface --
;
;   For the most part, all capabilities of CMSAVE are available to the
;   user.  However, it should be noted that passing variables by
;   positional parameter is not available under IDL 4, unless NAMES is
;   used to name the variables explicitly.
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
; INPUTS:
;
;   VAR{i} - The variables to be saved.  By default the save name is
;            taken from the named variables that are passed.  These
;            default names can be overridden by using the NAMES
;            keyword.
;
;            Variables can also be specified by passing an array of
;            handles or pointers in the DATA keyword.
;
;            If no variables are passed as positional parameters or
;            using DATA, then CMSAVE will assume that *all* variables
;            at the caller's level should be saved (this is similar
;            behavior to the built-in SAVE routine).  Note that system
;            variables cannot be saved with CMSAVE.
;
; KEYWORDS:
;
;   ALL - for compatibility with the built-in SAVE routine.  Ignored.
;         Note that CMSAVE cannot save system variables.
;
;   FILENAME - the name of the output file.
;              Default: 'cmsave.sav'
;
;   DATA - A list of data elements to be saved to the output file.
;          The data elements can be one of the following.  The means
;          of extracting the data, and the method of naming each
;          variable, are also indicated.
;
;            * An array of pointers to the variables
;                    Data: pointed-to value     Name: from NAMES keyword
;            * An array of handles to the variables
;                    Data: pointed-to value     Name: from NAMES keyword
;            * A 1-element structure containing data to be saved.
;                    Data: tag value            Name: tag name
;
;          Data values are saved one by one, using the appropriate
;          name.  Note that any variables passed as positional
;          parameters will cause the DATA keyword to be ignored.
;
;          The calling routine is responsible for deallocating any
;          pointer or handle resources.
;
;   COMPATIBILITY - a string, which describes the format to be used in
;          the output file.  Possible values are:
;
;                  'IDL4' - format of IDL version 4;
;                  'IDL5' - format of IDL versions 5.0-5.3;
;                  'IDL6' - not supported yet, for versions 5.4-above;
;                  'RIVAL1' - same as 'IDL5', plus a directory entry is
;                            written to the file.
;           Note that files written in IDL5 format may still be
;           readable by IDL v.4.
;           Default: 'IDL5'
;
;   NAMES - a string array, giving the names for each variable.  
;
;           If the data are passed by positional parameters, the names
;           are assigned according to the position of the parameter in
;           the procedure call.  This can be especially useful to
;           rename local variables, and to give names to expressions.
;
;           If the data are passed by an array of pointers or handles,
;           then the names are assigned according to the position of
;           the data in the array.  In this case there is no other way
;           to supply the variable name.  NAMES is required.
;
;           If the data are passed in a structure, then the names are
;           assigned according to the position of the data in the
;           structure.  The NAMES keyword values override the tag
;           names.
;
;   APPEND - if set, then the specified variables are appended to an
;            existing file.  
;
;            Repeated variables will not cause an error, however they
;            may not be restored properly using the built-in RESTORE
;            procedure.  It may also not be permitted to append
;            variables that contain heap pointers, to a save file
;            which already contains heap data.
;
;   STATUS - upon return, an integer indicating the status of the
;            operation.  A value of 1 indicates success, while 0
;            indicates failure.  A failure condition does not
;            necessarily indicate that an individual variable could
;            not be written; use the VARSTATUS keyword to detect such
;            situations.
;
;   VARSTATUS - upon return, an integer array indicating the status of
;               the save operation for each variable.  A value of 1 at
;               position i in the array indicates success for the ith
;               variable, while a value of 0 indicates failure.
;
;   ERRMSG - upon return, a string indicating the status of the
;            operation.  The empty string indicates success, while a
;            non-empty string indicates failure and describes the
;            error condition.
;
;   QUIET - if set, then the error message is returned to the calling
;           routine.  By default an error condition causes execution
;           to stop and the message to be printed on the console.
;
;   VERBOSE - if set, then a short message is printed for each
;             variable.
;
;   XDR - for compatibility with the built-in SAVE routine.  Ignored.
;
; EXAMPLE:
;
;   CMSAVE, VAR1, VAR2, FILENAME='test.sav'
;   CMSAVE, VAR1, VAR2, FILENAME='test.sav', NAMES=['A','B']
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  In the
;     first case the saved variable names will be VAR1 and VAR2.  In
;     the second case the saved variable names will be A and B.
;
;   POINTERS = [ptr_new(VAR1), ptr_new(VAR2)]
;   CMSAVE, DATA=POINTERS, NAMES=['A','B'], FILENAME='test.sav'
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  The saved
;     variable names will be A and B.  Data are passed by pointer.
;
;   STRUCTURE = {A: VAR1, B: VAR2}
;   CMSAVE, DATA=STRUCTURE, FILENAME='test.sav'
;
;     Save the data in VAR1 and VAR2 to the file test.sav.  The saved
;     variable names will be A and B.  Data are passed by structure.
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 14 May 2000
;   Documented, 22 Sep 2000
;   Made "more" compatible with SAVE; additional documentation, 11 Jan
;     2001, CM
;   Make version checks with correct precision, 19 Jul 2001, CM
;   Added notification about RSI License, 13 May 2002, CM
;
; $Id: cmsave.pro,v 1.16 2009/11/22 23:26:19 craigm Exp $
;
;-
; Copyright (C) 2000-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Undocumented
;; MTIMES
;; PASS_METHOD
;; NOCATCH

pro cmsave,   p0,  p1,  p2,  p3,  p4,  p5,  p6,  p7,  p8,  p9, $
             p10, p11, p12, p13, p14, p15, p16, p17, p18, p19, $
             p20, p21, p22, p23, p24, p25, p26, p27, p28, p29, $
             filename=filename0, verbose=verbose, xdr=xdr, $
             compatible=compat0, append=append, all=all, $
             status=status, varstatus=colstatus, mtimes=mtimes, $
             names=names, data=data, pass_method=method, $
             errmsg=errmsg, quiet=quiet, nocatch=nocatch, useunit=useunit, $
             version=revision

  forward_function routine_names, ptr_valid, handle_info

  status = 0
  errmsg = ''
  colstatus = 0 & dummy = temporary(colstatus)  ;; Void out the status

  cmsvlib_version = '<unknown>'
  catch, catcherr
  if catcherr EQ 0 then lib = cmsvlib(/query, version=cmsvlib_version) else lib = 0
  catch, /cancel
  if lib EQ 0 then $
    message, 'ERROR: The CMSVLIB library must be in your IDL path.'

  revision = '$Revision: 1.16 $'
  ;; Extract the version number
  revision = stregex(revision,'\$'+'Revision: *([0-9.]+) *'+'\$',/extract,/sub)
  revision = revision(1)

  if keyword_set(verbose) then begin
     message, /info, 'CMSAVE version '+revision, traceback=0
     message, /info, 'CMSV Library version '+cmsvlib_version(0), traceback=0
  endif

  if NOT keyword_set(nocatch) then on_error, 2

  n_par = n_params()
  ver   = double(!version.release)
  kall  = 0                        ;; NOTE: Ignoring ALL keywod!!
  if n_elements(filename0) EQ 0 then filename0 = 'cmsave.sav'
  filename = strtrim(filename0(0),2)

  if n_elements(compat0) EQ 0 then compat0 = 'IDL5'
  compat = strupcase(strtrim(compat0(0),2))
  lev = routine_names(/level)
  szd = size(data)
  ndata = n_elements(data)
  nnames = n_elements(names)
  
  ;; By default, if no arguments are specified (and no data) then, then
  ;; all of the data in the caller is saved.
  if n_par EQ 0 AND ndata EQ 0 then kall = 1
  if n_par EQ 0 AND kall EQ 0 AND nnames EQ 0 AND ndata EQ 0 then begin
      NO_VARS:
      status = 1
      errmsg = 'WARNING: no variables were specified; '+filename+' not created'
      if NOT keyword_set(quiet) then message, errmsg, /info
      return
  endif

  if kall then begin
      ;; Extract variables from calling procedure
      vlev = lev - 1
      vnames = routine_names(variables=vlev)
      fnames = 'routine_names("'+vnames+'",fetch=vlev)'
      nvar = n_elements(vnames)
      atype = 'FETCH'

  endif else if n_par EQ 0 AND nnames GT 0 then begin
      ;; Extract named variables from the calling procedure
      vlev = lev - 1
      vnames = strtrim(names,2)
      fnames = 'routine_names("'+vnames+'",fetch=vlev)'
      nvar = nnames
      atype = 'FETCH'
      
  endif else if n_par GT 0 then begin
      ;; Extract variables from positional parameters
      vlev = lev
      lev1 = strtrim(lev-1,2)
      nvar = n_par
      fnames = 'p'+strtrim(indgen(nvar),2)
      vnames = strarr(nvar)
      if ver GE 5D then $
        for i = 0L, nvar-1 do $
        dummy = execute('vnames(i) = (routine_names('+fnames(i)+ $
                        ',arg_name='+lev1+'))(0)')
      atype = 'FETCH'

  endif else begin
      ;; Extract variables from DATA
      vlev = lev
      tp = szd(szd(0)+1)
      if tp EQ 10 then begin               ;; POINTER TYPE
          nvar = ndata
          fnames = strarr(nvar) & vnames = fnames
          wh = where(ptr_valid(data) EQ 1, ct)
          if ct GT 0 then fnames(wh) = '*(data['+strtrim(wh,2)+'])'
          atype = 'POINTER'
      endif else if tp EQ 3 then begin     ;; HANDLE TYPE
          nvar = ndata
          fnames = strarr(nvar) & vnames = fnames
          wh = where(handle_info(data) EQ 1, ct)
          if ct GT 0 then $
            fnames(wh) = 'cmsave_handle_value(data('+strtrim(wh,2)+'))'
          atype = 'HANDLE'
      endif else if tp EQ 8 then begin
          nvar = n_tags(data(0))
          stsize = tagsize(data(0), n_tags=nvar, tag_names=vnames)
          fnames = 'data(0).'+vnames
          atype = 'STRUCT'
      endif else begin
          errmsg = 'ERROR: keyword DATA must be a pointer array or structure'
          status = 0
          return
      endelse
  endelse

  if nvar LE 0 then goto, NO_VARS
  colstatus = lonarr(nvar)

  ;; User-renamed variables
  if n_elements(names) GT 0 then begin
      sz = size(names)
      if sz(sz(0)+1) NE 7 then begin
          errmsg = 'ERROR: NAMES must be a string array'
          status = 0
          return
      endif
      vnames(0) = strtrim(strupcase(names(*)),2)
  endif

  ;; Check for variables with missing names.  By default don't do
  ;; anything, unless all the variables do not have names, or if we
  ;; are using IDL 4, which cannot accept parameters from the command
  ;; line.
  wh = where(vnames EQ '', ct)
  if ct EQ nvar then begin
      errmsg = ('ERROR: no variables have names (are you using IDL 4 or' + $
                ' forget the NAMES keyword?)')
      status = 0
      return
  endif
  if ver LT 5D AND ct GT 0 then begin
      if keyword_set(verbose) then $
        message, ('WARNING: in IDL 4 you cannot pass variables by argument '+ $
                  'to CMSAVE.'), /info, traceback=0
  endif

  ;; Collect a summary of pointers
  if ver GE 5D then begin
      cmsv_ptrsum, null, /null
      pheap = null
      pind  = 0L
      
      catcherr = 0
      catch, catcherr
      if catcherr NE 0 then goto, DONE_PTR
      for i = 0L, nvar-1 do begin
          pheap1 = null
          if fnames(i) EQ '' OR $
            execute('cmsv_ptrsum, '+fnames(i)+', pheap1') EQ 0 then $
            goto, DONE_PTR
          if n_elements(pheap1) GT 1 then begin
              pheap = [pheap, pheap1]
              pheap = pheap(uniq(pheap, sort(pheap)))
          endif
          DONE_PTR:
      endfor
      catch, /cancel
  endif else pheap = 0L

  nheap = n_elements(pheap) - 1
  if nheap GT 0 AND compat EQ 'IDL4' then begin
      errmsg = 'ERROR: cannot store pointer data in IDL4 version file'
      status = 0
      return
  endif

  ;; Open output file
  if keyword_set(append) then access='RW' else access='W'
  cmsv_open, unit, filename, off0, access=access, /get_lun, status=status, $
    errmsg=errmsg, compat=compat
  if status EQ 0 then begin
      if keyword_set(quiet) EQ 0 then message, errmsg, traceback=0
      return
  endif
  pp = 0L

  has_heap = 0
  nauxvars = 0L
  if keyword_set(append) then begin
      ;; Scan through input file until we reach the end-of-file block
      bn = ''
      while status EQ 1 AND bn NE 'END_MARKER' do begin
          point_lun, unit, off0
          block = 0 & dummy = temporary(block)
          cmsv_rrec, block, pp, unit=unit, next_block=pnext, /init, $
            block_type=bt, block_name=bn, status=status, errmsg=errmsg, $
            promote64=promote64
          if status EQ 0 then goto, CLEANUP
          if bn EQ 'HEAP_INDEX' then has_heap = 1
          if bn EQ 'VARIABLE' AND status EQ 1 then begin
              cmsv_rvtype, block, pp, vn, sz1, unit=unit, status=st1, $
                template=tp1, errmsg=err1
              if strmid(vn,0,12) EQ '_CMSAVE_DIR_' then $
                nauxvars = nauxvars + 1
          endif
          if status EQ 1 AND bn NE 'END_MARKER' then off0 = pnext
      endwhile

      if bn NE 'END_MARKER' then goto, CLEANUP
      point_lun, unit, off0
      
  endif else begin
      ;; Create the file and append the start record blocks
      if keyword_set(verbose) then $
        message, 'Portable (XDR) SAVE/RESTORE file.', /info

      ;; both timestamp and version information
      cmsv_wrec, block, pp, block_name='TIMESTAMP', offset=off0, $
        status=status, errmsg=errmsg
      if (status NE 0) AND (compat NE 'IDL4') then $
        cmsv_wrec, block, pp, block_name='VERSION', offset=off0, $
        status=status, errmsg=errmsg, compat=compat
      if (status EQ 0) OR (pp EQ 0) then goto, CLEANUP

      writeu, unit, block(0:pp-1)
      off0 = off0 + pp
  endelse

  if nheap GT 0 AND keyword_set(append) AND has_heap AND $
    strmid(compat,0,3) EQ 'IDL' then begin
      errmsg = 'ERROR: cannot APPEND data containing POINTER type'
      goto, CLEANUP
  endif

  pp = 0L
  block = 0 & dummy = temporary(block)

  if nheap GT 0 then begin
      pind = lindgen(nheap) + 1
      pheap = pheap(1:nheap)
      cmsv_wrec, block, pp, pind, block_name='HEAP_INDEX', offset=off0, $
        status=status, errmsg=errmsg, unit=unit1
      if status NE 1 then goto, CLEANUP
  endif 
  if pp GT 0 then writeu, unit, block(0:pp-1)
  off0 = off0 + pp

  if keyword_set(useunit) then $
    unit1 = unit

  pp = 0L
  block = 0 & dummy = temporary(block)
  init = 1 & err1 = '' & saved = 0
  erri = strarr(nvar+nheap)

  catcherr = 0 & caught = 0
  if NOT keyword_set(nocatch) then catch, catcherr
  if catcherr NE 0 then begin
      caught = caught + 1
      goto, DONE_VAR
  endif

  for i = 0L, nheap+nvar-1 do begin
      saved = 0
      nelem = 0
      j = i - nheap

      if j LT 0 then begin
          ;; Extract heap value
          bn = 'HEAP_DATA'
          vname = long(pind(i))
          dummy = execute('sz = size(*pheap(i))')
          if sz(sz(0)+1) EQ 0 then goto, DONE_VAR
          dummy = execute('var = *pheap(i)')

      endif else begin
          ;; Extract variable value
          bn = 'VARIABLE'
          fname = fnames(j)
          vname = vnames(j)
          
          sz = 0 & var = 0 & dummy = temporary(var)
          if fname EQ '' then begin
              NO_NAME:
              err1 = 'WARNING: un-named expression(s) not written'
              goto, DONE_VAR
          endif

          if execute('sz = size('+fname+')') EQ 0 then goto, DONE_VAR
          if sz(sz(0)+1) EQ 0 OR sz(sz(0)+2) EQ 0 then goto, DONE_VAR
          if execute('var = '+fname) EQ 0         then goto, DONE_VAR

          ;; For data taken from the structure then we may need to
          ;; pull out a more accurate array type.
          if atype EQ 'STRUCT' then sz = stsize(*,j)
          sz = sz(0:sz(0)+2)
          
          nelem = n_elements(var)
          if nelem EQ 0  then goto, DONE_VAR
          if vname EQ '' then goto, DONE_VAR
      endelse

      ;; Stupid dimensions can be reformed just by assignment.  This
      ;; will catch and reform the variable.
      if (sz(0) GT 0) AND (n_elements(size(var)) NE n_elements(sz)) then $
        var = reform([var], sz(1:sz(0)), /overwrite)
      sz = size(var)
 
      ;; Write data to a block in memory
      off1 = pp
      cmsv_wrec, block, pp, var, vname, block_name=bn, offset=off0, $
        ptr_index=pind, ptr_data=pheap, init=init, unit=unit1, $
        status=status, errmsg=errmsg
      init = 0
      if status EQ 0 then goto, CLEANUP
      saved = 1

      DONE_VAR:
      ;; A tricky business, this error catching...
      if caught GT 1 then begin
          errmsg = 'ERROR: an internal error occurred'
          goto, CLEANUP
      endif
      if caught GT 0 then begin
          err1 = errmsg
      endif

      ;; If we have accumulated enough data, write to file
      if (pp GT 32768L) OR ((i EQ nheap+nvar-1) AND pp GT 0) then begin
          writeu, unit, block(0:pp-1)
          block = 0 & dummy = temporary(block)
          init = 1
          off0 = off0 + pp
          pp = 0L
      endif
      if keyword_set(useunit) AND pp EQ 0 then $
        point_lun, -unit, off0

      ;; Print some diagnostic messages
      if j GE 0 then begin
          colstatus(j) = saved
          if keyword_set(verbose) AND saved then $
            erri(i) = 'Saved variable: '+vname+'.'
          if saved EQ 0 then begin
              if err1 NE '' then $
                erri(i) = err1 $
              else if nelem EQ 0 then $
                erri(i) = 'Undefined item not saved: '+vnames(j)+'.' $
              else begin
                  erri(i) = ('Expression must be named variable: <'+$
                             helpform('', var, /short)+'>')
                  if ver LT 5D then $
                    erri(i) = erri(i) + ' - use NAMES keyword under IDL4'
              endelse
          endif
      endif else begin
          if keyword_set(verbose) AND saved then $
            erri(i) = ('Saved heap value: <'+ $
                       helpform('', var, /short)+'>')
      endelse

      caught = 0
  endfor
  catch, /cancel
  wh = where(erri NE '', ct)
  if ct GT 0 then begin
      if NOT keyword_set(quiet) then for i = 0L, ct-1 do $
        message, erri(wh(i)), /info
      fmt = '('+strtrim(ct,2)+'(A,:))'
      if ct GT 1 then erri(wh(1:*)) = erri(wh(1:*)) + ';'
      errmsg = string(erri(wh), format=fmt)
  endif

  if pp GT 0 then writeu, unit, (temporary(block))(0:pp-1)
  off0 = off0 + pp

  pp = 0L & off1 = 0L
  ;; Write a set of auxiliary directory information
  whgood = where(colstatus NE 0, ngoodvars)
  if ngoodvars GT 0 AND strmid(compat,0,5) EQ 'RIVAL' then begin
      ;; Construct a unique name for the auxiliary directory
      nauxvars = nauxvars + 1
      fname = filename
      i = (rstrpos(fname,'/') > rstrpos(fname,'\') > rstrpos(fname,':') > $
           rstrpos(fname,';') > 0L)
      fname = byte(strmid(fname, i, strlen(fname)))
      i = strpos(fname, '.')
      if i GT 0 then fname = strupcase(strmid(fname, 0, i))
      bb = byte(fname)
      wh = where(bb LT (byte('A'))(0) OR bb GT (byte('Z'))(0), ct)
      if ct GT 0 then bb(wh) = 32b
      fname = strcompress(string(bb), /remove_all)
      if strlen(fname) EQ 0 then fname = 'FILE'
      
      ;; Whew, we got a name!  Now create the data for the directory
      auxvname = string(fname,nauxvars, $
                        format='("_CMSAVE_DIR_",A0,"_",I2.2)')
      auxvdata = replicate({variable:'', mtime:systime(1)}, ngoodvars)
      auxvdata.variable = vnames(whgood)
      if n_elements(mtimes) GT 0 then $
        auxvdata.mtime(0) = double(mtimes(whgood(0:n_elements(mtimes)-1)))
      auxsz = size(auxvdata)

      ;; Write out directory data
      cmsv_wrec, block, pp, auxvdata, auxvname, block_name='VARIABLE', $
        offset=off0, status=status, errmsg=errmsg, unit=unit1
  endif
  ;; Write end marker
  cmsv_wrec, block, pp, block_name='END_MARKER', status=status, offset=off0
  if status EQ 1 AND pp GT 0 then writeu, unit, block(0:pp-1)
  free_lun, unit
  return

  ;; 
  ;; Error handling routine, outside the normal call flow
  CLEANUP:
  catch, /cancel
  free_lun, unit
  status = 0
  if errmsg NE '' AND NOT keyword_set(quiet) then message, errmsg, /info

  return
end
;+
; NAME:
;   CMSAVEDIR
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Display a directory of the variables in an IDL SAVE file.
;
; CALLING SEQUENCE:
;   CMSAVEDIR, filename [, /VERBOSE, /QUIET, ... ]
;   
; DESCRIPTION: 
;
;   CMSAVEDIR will display a listing of the variables and other
;   objects stored in an IDL SAVE file.
;
;   For command-line users the primary function of CMSAVEDIR will be
;   to find out what data is stored in a file and when it was saved.
;   For that, they simply need to type: CMSAVEDIR, 'myfile.sav'
;
;   CMSAVEDIR also offers a number of features for programmers.
;   CMSAVEDIR essentially interrogates the save file and discovers the
;   numbers, names and types of each of the variables stored in the
;   file.  Programmers can use that information to decide whether or
;   how to open a file using the other routines in the CMSVLIB.
;   Various keyword parameters are used return this information, as
;   documented below.
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; COMPATIBILITY:
;
;   -- File Format --
;
;   CMSAVEDIR cannot examine compressed save files, or files larger
;   than 2 gigabytes.
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
; INPUTS:
;
;   FILENAME - a scalar string, the name of the file to be examined.
;
; KEYWORDS:
;
;   VERBOSE - if set, print more detailed information about the input file.
;
;   QUIET - if set, then do not print any output.  Programmers can use
;           this keyword to allow CMSAVEDIR to return information
;           about the file silently.
;
;   STATUS - upon output, 1 for success, otherwise to indicate
;            failure.
;   ERRMSG - upon output, if a failure occurs, a message describing
;            the error condition.
;  
;   N_VARIABLES - upon output, the number of variables in the file.
;   VAR_NAMES - upon output, contains a string array of the names of
;               the variables stored in the file.
;   TYPES - upon output, an 11xN_VARIABLES array containing the SIZE
;           information of each variable in the file.
;
;   N_PRO - upon output, the number of procedures stored in the file.
;   PRO_NAMES - upon output, the names of the procedures stored in the
;               file, as a string array.
;
;   N_FUNCTION - upon output, the number of functions stored in the
;                 file.
;   FUNC_NAMES - upon output, the names of the functions stored in the
;                file, as a string array.
;
;   NAMED_STRUCTS - upon output, a string array listing any named
;                   structures which appear in the SAVE file.
;   NAMED_CLASSES - upon output, a string array listing any named
;                   class structures which appear in the SAVE file.
;
;   TIMESTAMP - upon output, contains the timestamp record information
;               in a structure.  The fields of the structure are:
;                    SAVE_DATE - string - date saved
;                    SAVE_USER - string - user who saved file
;                    SAVE_HOST - string - host name on which file
;                                         saved
;
;   VERSION - upon output, contains the version record information in
;             a structure.  The fields of the structure are:
;                    FORMAT_VERSION - integer - major format version
;                    ARCH    - string - saving host's !VERSION.ARCH
;                    OS      - string - saving host's !VERSION.OS
;                    RELEASE - string - saving host's !VERSION.RELEASE
;
;   NOTICE - upon output, contains any textual notice included within
;            the file.  The fields of the structure are:
;                    TEXT - string - text of the notice
;
;   FORCE - if set, will force CMSAVEDIR to open the file even if it
;           detects a potential incompatibility.
;
; EXAMPLE:
;
;   IDL> cmsavedir, 'int_str_intarr.sav'
;   ** int_str_intarr.sav
;   ** Sun Apr  9 20:28:25 2000 (craigm@beach.gsfc.nasa.gov)
;   ** IDL v5.2 (linux)
;     A               INT       =        0
;     B               STRING    = 'hello'
;     C               INT       = Array[3]
;   ** 3 variable(s), 0 heap value(s) and 0 procedure(s) in 1376 bytes
;
; SEE ALSO:
;
;   CMRESTORE, CMSAVE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Documented, 12 Jan 2001, CM
;   Added USAGE message, 09 Jun 2001, CM
;   Fixed bug in printing common variables, 17 Mar 2002, CM
;   Added notification about RSI License, 13 May 2002, CM
;   Added NOTICE record type, 09 Jun 2003, CM
;   
;
; $Id: cmsavedir.pro,v 1.17 2003/06/28 22:21:07 craigm Exp $
;
;-
; Copyright (C) 2000-2002, 2003, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CMSET_OP
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Performs an AND, OR, or XOR operation between two sets
;
; CALLING SEQUENCE:
;   SET      = CMSET_OP(A, OP, B)
;
; DESCRIPTION: 
;
;   SET_OP performs three common operations between two sets.  The
;   three supported functions of OP are:
;
;        OP          Meaning
;      'AND' - to find the intersection of A and B;
;      'OR'  - to find the union of A and B;
;      'XOR' - to find the those elements who are members of A or B 
;              but not both;
;
;   Sets as defined here are one dimensional arrays composed of
;   numeric or string types.  Comparisons of equality between elements
;   are done using the IDL EQ operator.
;
;   The complements of either set can be taken as well, by using the
;   NOT1 and NOT2 keywords.  For example, it may be desireable to find
;   the elements in A but not B, or B but not A (they are different!).
;   The following IDL expressions achieve each of those effects:
;
;      SET = CMSET_OP(A, 'AND', /NOT2, B)   ; A but not B
;      SET = CMSET_OP(/NOT1, A, 'AND', B)   ; B but not A
;
;   Note the distinction between NOT1 and NOT2.  NOT1 refers to the
;   first set (A) and NOT2 refers to the second (B).  Their ordered
;   placement in the calling sequence is entirely optional, but the
;   above ordering makes the logical meaning explicit.
;
;   NOT1 and NOT2 can only be set for the 'AND' operator, and never
;   simultaneously.  This is because the results of an operation with
;   'OR' or 'XOR' and any combination of NOTs -- or with 'AND' and
;   both NOTs -- formally cannot produce a defined result.
;
;   The implementation depends on the type of operands.  For integer
;   types, a fast technique using HISTOGRAM is used.  However, this
;   algorithm becomes inefficient when the dynamic range in the data
;   is large.  For those cases, and for other data types, a technique
;   based on SORT() is used.  Thus the compute time should scale
;   roughly as (A+B)*ALOG(A+B) or better, rather than (A*B) for the
;   brute force approach.  For large arrays this is a significant
;   benefit.
;
; INPUTS:
;
;   A, B - the two sets to be operated on.  A one dimensional array of
;          either numeric or string type.  A and B must be of the same
;          type.  Empty sets are permitted, and are either represented
;          as an undefined variable, or by setting EMPTY1 or EMPTY2.
;
;   OP - a string, the operation to be performed.  Must be one of
;        'AND', 'OR' or 'XOR' (lower or mixed case is permitted).
;        Other operations will cause an error message to be produced.
;
; KEYWORDS:
;
;   NOT1, NOT2 - if set and OP is 'AND', then the complement of A (for
;                NOT1) or B (for NOT2) will be used in the operation.
;                NOT1 and NOT2 cannot be set simultaneously.
;
;   EMPTY1, EMPTY2 - if set, then A (for EMPTY1) or B (for EMPTY2) are
;                    assumed to be the empty set.  The actual values
;                    passed as A or B are then ignored.
;
;   INDEX - if set, then return a list of indices instead of the array
;           values themselves.  The "slower" set operations are always
;           performed in this case.
;
;           The indices refer to the *combined* array [A,B].  To
;           clarify, in the following call: I = CMSET_OP(..., /INDEX);
;           returned values from 0 to NA-1 refer to A[I], and values
;           from NA to NA+NB-1 refer to B[I-NA].
;
;   COUNT - upon return, the number of elements in the result set.
;           This is only important when the result set is the empty
;           set, in which case COUNT is set to zero.
;
; RETURNS:
;
;   The resulting set as a one-dimensional array.  The set may be
;   represented by either an array of data values (default), or an
;   array of indices (if INDEX is set).  Duplicate elements, if any,
;   are removed, and element order may not be preserved.
;
;   The empty set is represented as a return value of -1L, and COUNT
;   is set to zero.  Note that the only way to recognize the empty set
;   is to examine COUNT.
;
; SEE ALSO:
;
;   SET_UTILS.PRO by RSI
;
; MODIFICATION HISTORY:
;   Written, CM, 23 Feb 2000
;   Added empty set capability, CM, 25 Feb 2000
;   Documentation clarification, CM 02 Mar 2000
;   Incompatible but more consistent reworking of EMPTY keywords, CM,
;     04 Mar 2000
;   Minor documentation clarifications, CM, 26 Mar 2000
;   Corrected bug in empty_arg special case, CM 06 Apr 2000
;   Add INDEX keyword, CM 31 Jul 2000
;   Clarify INDEX keyword documentation, CM 06 Sep 2000
;   Made INDEX keyword always force SLOW_SET_OP, CM 06 Sep 2000
;   Added CMSET_OP_UNIQ, and ability to select FIRST_UNIQUE or
;     LAST_UNIQUE values, CM, 18 Sep 2000
;   Removed FIRST_UNIQUE and LAST_UNIQUE, and streamlined
;     CMSET_OP_UNIQ until problems with SORT can be understood, CM, 20
;     Sep 2000 (thanks to Ben Tupper)
;   Still trying to get documentation of INDEX and NOT right, CM, 28
;     Sep 2000 (no code changes)
;   Correct bug for AND case, when input sets A and B each only have
;     one unique value, and the values are equal.  CM, 04 Mar 2004
;     (thanks to James B. jbattat at cfa dot harvard dot edu)
;   Add support for the cases where the input data types are mixed,
;      but still compatible; also, attempt to return the same data
;      type that was passed in; CM, 05 Feb 2005
;   Fix bug in type checking (thanks to "marit"), CM, 10 Dec 2005
;   Work around a stupidity in the built-in IDL HISTOGRAM routine,
;      which tries to "help" you by restricting the MIN/MAX to the
;      range of the input variable (thanks to Will Maddox), CM, 16 Jan 2006
;
;  $Id: cmset_op.pro,v 1.6 2006/01/16 19:45:22 craigm Exp $
;
;-
; Copyright (C) 2000, 2004, 2005, 2006, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Utility function, similar to UNIQ, but allowing choice of taking
;; first or last unique element, or non-unique elements.
;; Unfortunately this doesn't work because of implementation dependent
;; versions of the SORT() function.

; function cmset_op_uniq, a, first=first, non=non, count=ct, sort=sortit
;   if n_elements(a) LE 1 then return, 0L
;   sh = (2L*keyword_set(first)-1L)*(-2L*keyword_set(non)+1)
;
;   if keyword_set(sortit) then begin
;       ;; Sort it manually
;       ii = sort(a) & b = a(ii)
;       if keyword_set(non) then wh = where(b EQ shift(b, sh), ct) $
;       else                     wh = where(b NE shift(b, sh), ct)
;       if ct GT 0 then return, ii(wh)
;   endif else begin
;       ;; Use the user's values directly
;       if keyword_set(non) then wh = where(a EQ shift(a, sh), ct) $
;       else                     wh = where(a NE shift(a, sh), ct)
;       if ct GT 0 then return, wh
;   endelse
;
;   if keyword_set(first) then return, 0L else return, n_elements(a)-1
; end

;; Simplified version of CMSET_OP_UNIQ which sorts, and takes the
;; "first" value, whatever that may mean.
function cmset_op_uniq, a
  if n_elements(a) LE 1 then return, 0L

  ii = sort(a) & b = a(ii)
  wh = where(b NE shift(b, +1L), ct)
  if ct GT 0 then return, ii(wh)

  return, 0L
end

function cmset_op, a, op0, b, not1=not1, not2=not2, count=count, $
              empty1=empty1, empty2=empty2, maxarray=ma, index=index

  on_error, 2 ;; return on error
  count = 0L
  index0 = -1L
  ;; Histogram technique is used for array sizes < 32,000 elements
  if n_elements(ma) EQ 0 then ma = 32L*1024L

  ;; Check the number of arguments
  if n_params() LT 3 then begin
      ARG_ERR:
      message, 'USAGE: SET = CMSET_OP(A, OP, B [, COUNT=ct])', /info
      message, '  KEYWORDS: /NOT1, /NOT2, /EMPTY1, /EMPTY2, INDEX', /info
      return, -1L
  endif
  if n_elements(op0) EQ 0 then goto, ARG_ERR
  kind = keyword_set(index)
  fst = 1L
  if keyword_set(last) then fst = 0L
  if keyword_set(first) then fst = 1L

  ;; Check the operation
  sz = size(op0)
  if sz(sz(0)+1) NE 7 then begin
      OP_ERR:
      message, "ERROR: OP must be 'AND', 'OR' or 'XOR'"
      return, -1L
  endif
  op = strupcase(op0)
  if op NE 'AND' AND op NE 'OR' AND op NE 'XOR' then goto, OP_ERR

  ;; Check NOT1 and NOT2
  if keyword_set(not1) AND keyword_set(not2) then begin
      message, "ERROR: NOT1 and NOT2 cannot be set simultaneously"
      return, -1L
  endif
  if (keyword_set(not1) OR keyword_set(not2)) AND $
    (op EQ 'OR' OR op EQ 'XOR') then begin
      message, "ERROR: NOT1 and NOT2 cannot be set with 'OR' or 'XOR'"
      return, -1L
  endif

  ;; Special cases for empty set
  n1 = n_elements(a) & n2 = n_elements(b)
  if keyword_set(empty1) then n1 = 0L
  if keyword_set(empty2) then n2 = 0L
  if n1 EQ 0 OR n2 EQ 0 then begin
      ;; Eliminate duplicates
      if n1 GT 0 then a1 = cmset_op_uniq(a)
      if n2 GT 0 then b1 = cmset_op_uniq(b)
      n1 = n_elements(a1) < n1 & n2 = n_elements(b1) < n2
      case op of 
          'OR': if n1 EQ 0 then goto, RET_A1 else goto, RET_B1
         'XOR': if n1 EQ 0 then goto, RET_B1 else goto, RET_A1
         'AND': begin
             if keyword_set(not1) AND n1 EQ 0 then goto, RET_B1
             if keyword_set(not2) AND n2 EQ 0 then goto, RET_A1
             return, -1L
         end
     endcase
     return, -1L
     RET_A1:
     count = n1
     if kind then begin
         if count GT 0 then return, a1 else return, -1L
     endif
     if count GT 0 then return, a(a1) else return, -1L
     RET_B1:
     count = n2
     if kind then begin
         if count GT 0 then return, b1+n1 else return, -1L
     endif         
     if count GT 0 then return, b(b1) else return, -1L
 endif

  ;; Allow data to have different types, but they must be at least of
  ;; the same "base" type.  That is, you can't combine a number with a
  ;; string, etc.
  ;; basetype 0:undefined 1:real number 6:complex number 7:string
  ;;     8:structure 10:pointer 11:object

  ;;          0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15
  basetype = [0, 1, 1, 1, 1, 1, 6, 7, 8, 6,10,11, 1, 1, 1, 1]

  ;; Check types of operands
  sz1 = size(a) & tp1 = sz1(sz1(0)+1)
  sz2 = size(b) & tp2 = sz2(sz2(0)+1)
  if tp1 LT 0 OR tp1 GE 16 OR tp2 LT 0 OR tp2 GE 16 then begin
      message, 'ERROR: unrecognized data types for operands'
      return, -1
  endif
  if basetype(tp1) NE basetype(tp2) then begin
      TYPE1_ERR:
      message, 'ERROR: both A and B must be of the same type'
      return, -1L
  endif
  if tp1 EQ 8 OR tp1 EQ 10 OR tp1 EQ 11 then begin
      TYPE2_ERR:
      message, 'ERROR: operands must be a numeric or string type'
      return, -1L
  endif

  ;; Now use two different kinds of algorithms: a slower but more
  ;; general algorithm for generic types, and the histogram technique
  ;; for integer types.  Even for integer types, if there is too much
  ;; dynamic range, then the slow method is used.

  if tp1 GE 4 AND tp1 LE 9 then begin
      ;; String and real types, or large int arrays
      SLOW_SET_OP:
      case op of 
          'OR': begin
              uu = [a,b]    ;; OR is simple; just take unique values
              index0 = cmset_op_uniq(uu)
              count = n_elements(index0)
              if kind then return, index0
              return, uu(index0)
          end

          'XOR': begin
              ;; Make ordered list of set union
              ai = cmset_op_uniq(a) & na = n_elements(ai)
              bi = cmset_op_uniq(b) & nb = n_elements(bi)
              ui = [ai, bi+n1]
              uu = [a,b]    & uu = uu(ui) ;; Raw union...
              us = sort(uu) & uu = uu(us) ;; ...and sort
              if kind then ui = ui(temporary(us)) else ui = 0

              ;; Values in one set only will not have duplicates
              wh1 = where(uu NE shift(uu, -1), count1)
              if count1 EQ 0 then return, -1L
              wh = where(wh1(1:*)-wh1 EQ 1, count)
              if wh1(0) EQ 0 then begin
                  if count GT 0 then wh = [-1L, wh] else wh = [-1L]
                  count = n_elements(wh)
              endif
              if count EQ 0 then return, -1
              if kind then return, ui(wh1(wh+1))
              return, uu(wh1(wh+1))
          end

          'AND': begin
              ;; Make ordered list of set union
              ai = cmset_op_uniq(a) & na = n_elements(ai)
              bi = cmset_op_uniq(b) & nb = n_elements(bi)
              ui = [ai, bi+n1]
              uu = [a,b]    & uu = uu(ui)  ;; Raw union...
              us = sort(uu) & uu = uu(us)  ;; ...and sort
              if kind then ui = ui(us) else ui = 0

              if NOT keyword_set(not1) AND NOT keyword_set(not2) then begin

                  ;; Special case: if there are one in each set, and
                  ;; they are equal, then the SHIFT() technique below
                  ;; fails.  Do this one by hand.
                  if na EQ 1 AND nb EQ 1 AND uu(0) EQ uu(1) then begin
                      count = 1L
                      if kind then return, 0L
                      return, [uu(0)]
                  endif

                  ;; If neither "NOT" is set, then find duplicates
                  us = 0L  ;; Save memory
                  wh = where(uu EQ shift(uu, -1L), count) ;; Find non-unique
                  if count EQ 0 then return, -1L
                  ;; This should always select the element from A
                  ;; rather than B (the smaller of the two)
                  if kind then return, (ui(wh) < ui(wh+1))
                  return, uu(wh)
              endif

              ;; For "NOT" cases, we need to identify by set
              ii = make_array(na+nb, value=1b)
              if keyword_set(not1) then ii(0:na-1) = 0
              if keyword_set(not2) then ii(na:*)   = 0
              ii = ii(temporary(us))

              ;; Remove any duplicates
              wh1 = where(uu EQ shift(uu, -1L), count1) ;; Find non-unique
              if count1 GT 0 then ii([wh1, wh1+1]) = 0
              ;; Remainder is the desired set
              wh = where(ii, count)
              if count EQ 0 then return, -1L
              if kind then return, ui(wh)
              return, uu(wh)
          end

      endcase
      return, -1L  ;; DEFAULT CASE
  endif else begin

      ;; INDEX keyword forces the "slow" operation
      if kind then goto, SLOW_SET_OP

      ;; Integer types - use histogram technique if the data range
      ;; is small enough, otherwise use the "slow" technique above
      min1 = min(a, max=max1) & min2 = min(b, max=max2)
      minn = min1 < min2 & maxx = max1 > max2
      nbins = maxx-minn+1
      if (maxx-minn) GT floor(ma(0)) then goto, SLOW_SET_OP

      ;; Work around a stupidity in the built-in IDL HISTOGRAM routine
      if (tp1 EQ 2 OR tp2 EQ 2) AND (minn LT -32768 OR maxx GT 32767) then $
        goto, SLOW_SET_OP

      ;; Following operations create a histogram of the integer values.
      ha = histogram(a, min=minn, max=maxx) < 1
      hb = histogram(b, min=minn, max=maxx) < 1

      ;; Compute NOT cases
      if keyword_set(not1) then ha = 1b - ha  
      if keyword_set(not2) then hb = 1b - hb
      case op of 
          ;; Boolean operations
          'AND': mask = temporary(ha) AND temporary(hb) 
           'OR': mask = temporary(ha)  OR temporary(hb)
          'XOR': mask = temporary(ha) XOR temporary(hb)
      endcase

      wh = where(temporary(mask), count)
      if count EQ 0 then return, -1L
      
      result = temporary(wh+minn)
      if tp1 NE tp2 then return, result
      szr = size(result) & tpr = szr(szr(0)+1)

      ;; Cast to the original type if necessary
      if tpr NE tp1 then begin
          fresult = make_array(n_elements(result), type=tp1)
          fresult(0) = temporary(result)
          result = temporary(fresult)
      endif

      return, result

  endelse

  return, -1L  ;; DEFAULT CASE
end

;     Here is how I did the INDEX stuff with fast histogramming.  It
;     works, but is complicated, so I forced it to go to SLOW_SET_OP.
;     ha = histogram(a, min=minn, max=maxx, reverse=ra) < 1
;     rr = ra(0:nbins) & mask = rr NE rr(1:*) & ra = ra(rr)*mask-1L+mask
;     hb = histogram(b, min=minn, max=maxx, reverse=rb) < 1
;     rr = rb(0:nbins) & mask = rr NE rr(1:*) & rb = rb(rr)*mask-1L+mask
;     ...  AND/OR/XOR NOT masking here ...
;     ra = ra(wh) & rb = rb(wh)
;     return, ra*(ra GE 0) + (rb+n1)*(ra LT 0) ;; is last 'ra' right?

;+
; NAME:
;   CMSV_OPEN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Open IDL SAVE file for reading or writing
;
; CALLING SEQUENCE:
;   CMSV_OPEN, UNIT, FILENAME, OFFSET, $
;          ACCESS=ACCESS, /FORCE, /GET_LUN, /REOPEN, $
;          COMPATIBILITY=COMPATIBILITY, $
;          STATUS=STATUS, ERRMSG=ERRMSG
;   
; DESCRIPTION: 
;
;   CMSV_OPEN opens an IDL SAVE-formatted file for reading or writing.
;   The mode of operation is controlled by the ACCESS keyword, which
;   may be either 'R' for reading, 'W' for writing, or 'RW' for
;   read/write access.
;
;   'R': In the case of reading, the specified file is opened with
;   read-only access, and the first bytes are examined to verify that
;   it is indeed a valid IDL SAVE file.  
;
;   'W': In the case of writing, the specified file is opened with
;   write access, and the initial file signature is written.  
;
;   'RW': In the case of read-write access, the file must already
;   exist as a valid SAVE file.  Users are advised that every time
;   they switch between reading and writing operations, they must use
;   POINT_LUN to flush the file buffers.
;
;   The CMSVLIB routines do not support file sizes greater than 2 GB,
;   nor SAVE files created with the COMPRESS option.
;
;   Upon return, the file pointer is positioned at the start of the
;   first valid SAVE record.  The file offset is returned in OFFSET.
;   The user is responsible for reading or writing the remainder of
;   the file with other library routines.
;
;   The file unit is determined based on the following criteria.  This
;   behavior is similar to the OPEN family of procedures, except for
;   the REOPEN keyword.
;
;     * If REOPEN is set then it is assumed that UNIT is an
;       already-open file, and FILENAME is ignored.  
;
;     * If GET_LUN is set then a file unit is allocated with GET_LUN,
;       and upon success this unit is returned in UNIT.
;
;     * Otherwise it is asssumed that UNIT is a valid but unopened
;       file unit.  Upon successful return, UNIT is opened.
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
;
; INPUTS:
;
;   UNIT - a logical unit number (a scalar).  In the case of GET_LUN,
;          a file unit will be allocated and returned in UNIT.  In the
;          default case, or REOPEN, UNIT must be a valid file unit
;          upon input.  For REOPEN the corresponding file must be
;          seekable.
;
;   FILENAME - a scalar string specifying the filename path (ignored
;              for REOPEN).
;
;   OFFSET - upon return, the file offset of the next available SAVE
;            record.
;
;
; KEYWORDS:
;
;   ACCESS - a scalar string, case insensitive:
;               'R' - read-only access
;               'W' - write access (new file)
;               'RW' - read-write access (existing file)
;            Default: 'R' - read-only
;
;   GET_LUN - if set, the file unit is allocated using GET_LUN
;
;   FORCE - if set, then the file is opened despite a detected file
;           format inconsistency.
;
;   REOPEN - if set, then an already-opened file is manipulated.  The
;            valid file unit must be specified by UNIT, and FILENAME
;            is ignored.
;
;   COMPATIBILITY - a string, which describes the format to be used in
;          the output file.  Possible values are:
;
;                  'IDL4' - format of IDL version 4;
;                  'IDL5' - format of IDL versions 5.0-5.3;
;                  'IDL6' - not supported yet, for versions 5.4-above;
;                  'RIVAL1' - same as 'IDL5', plus a directory entry is
;                            written to the file.
;           Note that files written in IDL5 format may still be
;           readable by IDL v.4.
;           Default: 'IDL5'
;
;
;   STATUS - upon return, this keyword will contain 1 for success and
;            0 for failure.
;
;   ERRMSG - upon return with a failure, this keyword will contain the
;            error condition as a string.
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Change BLOCK to STREAM to support VMS properly, 14 Feb 2001, CM
;   Added notification about RSI License, 13 May 2002, CM
;   NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsv_open.pro,v 1.13 2009/11/22 22:50:49 craigm Exp $
;
;-
; Copyright (C) 2000-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CMSV_PTRSUM
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Construct an inventory of heap data accessible to a variable
;
; CALLING SEQUENCE:
;   CMSV_PTRSUM, VAR, LIST
;   
; DESCRIPTION: 
;
;   This procedure constructs an inventory of heap data that is
;   accessible to a single variable.  It searches all array elements,
;   recursively through structure tags, and by dereferencing pointers.
;   Users can use this procedure to determine all heap variables that
;   need to be saved to disk.
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt. 
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; INPUTS:
;
;   VAR - the variable to be examined
;
;   LIST - upon output, an array of pointers, each of which points to
;          a heap variable accessible to VAR.  If there are no heap
;          data pointed to by VAR, then LIST returns a NULL value.
;
; KEYWORDS:
;
;   NULL - if set, return the null value in LIST instead of the
;          pointer list.  VAR is ignored.
;
;   HAS_OBJECTS - upon return, the value is 1 if VAR contains or
;                 points to an object reference, and 0 if not.
;
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Make version checks with correct precision, 19 Jul 2001, CM
;   Added notification about RSI License, 13 May 2002, CM
;
; $Id: cmsv_ptrsum.pro,v 1.7 2002/05/13 06:41:10 craigm Exp $
;
;-
; Copyright (C) 2000-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CMSV_RDATA
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Read SAVE-formatted data variable record from input block or file unit
;
; CALLING SEQUENCE:
;   CMSV_RDATA, BLOCK, POINTER, SIZE, DATA, UNIT=UNIT, $
;          TEMPLATE=TEMPLATE, /TEMPORARY, PTR_INDEX=PTR_INDEX, $
;          PTR_CALLBACK=PTR_CALLBACK, PTR_OFFSETS=PTR_OFFSETS, $
;          OFFSET=OFFSET, STATUS=STATUS, ERRMSG=ERRMSG
;   
; DESCRIPTION: 
;
;   CMSV_RDATA reads the data portion of an IDL SAVE variable record.
;   An IDL variable is stored in two components: the type descriptor
;   which describes the name, type, and dimensions of the variable;
;   and the data record, which contains the raw data of the variable.
;   This procedure reads the raw data and returns it to the user.  The
;   initial type portion of the record must have already been read
;   using the CMSV_RVTYPE procedure.
;
;   CMSV_RDATA supports the following variable types:
;
;     BYTE(1),INT(2),LONG(3) - integer types
;     UINT(12),ULONG(13),LONG64(14),ULONG64(15) - integer types (IDL >5.2 only)
;     FLOAT(4),DOUBLE(5),COMPLEX(6),DCOMPLEX(9) - float types
;     STRING(7) - string type
;     STRUCT(8) - structure type
;     POINTER(10) - pointer type - SEE BELOW
;     NOT SUPPORTED - OBJ(11) - object reference type - NOT SUPPORTED
;
;   Arrays and structures containing any of the supported types are
;   supported (including structures within structures).
;
;   For scalars and arrays of numeric or string types, the caller must
;   only supply the SIZE parameter, which specifies the type and
;   dimensions of the variable to be read.  This information can be
;   obtained from the CMSV_RVTYPE routine. The data is returned in the
;   output parameter DATA.
;
;   For structure data, in addition to specifying the SIZE array, the
;   user must also supply a "template" describing the structure into
;   which the data will be read.  This template is simply a "blank"
;   form of the data structure, and is returned by CMSV_RVTYPE.
;
;   Thus, a simple way to read structure, numeric or string data is
;   the following code (with error checking removed)
;
;     CMSV_RVTYPE, block, pointer, name, size, template=template, unit=unit
;     CMSV_RDATA, block, pointer, size, data, template=template, unit=unit
;
;   [ This code assumes the record header has been read with
;   CMSV_RREC. ]
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; POINTER DATA
;
;   Pointer data stored in IDL SAVE files are particularly difficult
;   to manage, because the actual heap variables are stored in
;   separate records which *precede* the record of interest.  Thus, if
;   your application requires the reading of pointer data, you must
;   perform special processing in your own code in order to support
;   it.  In essence, you must maintain an inventory of heap variables
;   as they are encountered in the file.
;
;   If these procedures are not followed then pointer data will not be
;   read, and a LONG integer value appears in the pointers' places.
;   Under IDL 4, pointer data can never be read.
;
;   This is accomplished by placing some additional logic in your file
;   processing loop.  There are four separate components to this: (1)
;   loop initialization; (2) reading a HEAP_INDEX record; (3) parsing
;   a HEAP_DATA record; and (4) passing extra arguments to CMSV_RDATA.
;   The additional state information is maintained in two variables
;   named PTR_INDEX, which keeps track of the heap variable numbers,
;   and PTR_OFFSETS, which stores the file location of each variable.
;
;   (1) Loop initialization: is quite simple, use the following code:
;       ptr_index   = [0L]
;       ptr_offsets = [0L]
;       ptr_data    = [ptr_new()]
;
;   (2) Reading HEAP_INDEX, which is an array of values indicating
;       the heap variable numbers of each heap variables.  These
;       values are stored in PTR_INDEX:
;
;          CMSV_RHEAP, block, pointer, index, unit=unit
;          ptr_index   = [ptr_index, index]
;          ptr_offsets = [ptr_offsets, lonarr(n_elements(index))]
;          ptr_data    = [ptr_data, ptrarr(n_elements(index))]
;
;   (3) Parse the HEAP_DATA record.  Here were are interested in the
;       heap variable number, and the file offset.
;       
;       opointer = pointer
;       CMSV_RVTYPE, block, pointer, vindex, /heap, unit=unit
;       
;       vindex = floor(vindex(0))
;       wh = where(ptr_index EQ vindex)
;       ptr_offsets(wh(0)) = offset + opointer
;
;       Keep in mind that the file offset is OFFSET+POINTER.
;
;   (4) Pass extra parameters to CMSV_RDATA.  The user simply passes
;       these extra variables to the CMSV_RDATA procedure, which
;       automatically recognizes heap data and reads it from the
;       appropriate location.
;
;       CMSV_RVTYPE, block, pointer, name, size, unit=unit, template=tp
;       CMSV_RDATA, block, pointer, size, data, template=tp, $
;         unit=unit, ptr_offsets=ptr_offsets, $
;         ptr_index=ptr_index, ptr_data=ptr_data
;
;   If this technique is used properly, only those heap variables
;   which are needed are read.  Thus, there are never any lost or
;   dangling pointers.  Since each bit of heap data is stored in a
;   variable returned to the user, it is not necessary to
;   PTR_FREE(ptr_data); in fact, doing so would corrupt the input
;   data.
;
; BLOCK, POINTER, OFFSET
;
;   This procedure can read data from a byte array, a file unit, or
;   both.  In fact, this procedure is designed to implement "lazy"
;   reading from a file, which is to say, it normally reads from a
;   byte array of data.  However, if the requested data goes beyond
;   the end of the byte array, more data is read from the file on
;   demand.  This way the user gets the benefit of fast memory access
;   for small reads, but guaranteed file access for large reads.
;
;   The terminology is as follows: BLOCK is a byte array which
;   represents a portion of, or an entire, IDL SAVE file.  The block
;   may be a cached portion of an on-disk file, or an entire in-memory
;   SAVE file.  POINTER is the current file pointer within BLOCK
;   (i.e., the next byte to be read is BLOCK[POINTER]).  Hence, a
;   POINTER value of 0 refers to the start of the block.  OFFSET is
;   the file offset of the 0th byte of BLOCK; thus "POINT_LUN,
;   OFFSET+POINTER" should point to the same byte as BLOCK[POINTER].
;   The following diagram shows the meanings for BLOCK, POINTER and
;   OFFSET schematically:
;
;
;                 0 <-  OFFSET  -> |
;   FILE          |----------------|------*--------|--------->
;
;   BLOCK                          |------*--------|
;                                  0      ^ POINTER
;     
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
; INPUTS:
;
;   BLOCK - a byte array, a cache of the SAVE file.  Users will
;           usually not access this array directly.  Users are advised
;           to clear BLOCK after calling POINT_LUN.
;
;   POINTER - a long integer, a pointer to the next byte to be read
;             from BLOCK.  CMSVLIB routines will automatically
;             advance the pointer.
;
;   SIZE - an array of integers describing the type and dimensions of
;          the variable to be read, in the format returned by the
;          SIZE() routine.  This parameter is required.
;
;   DATA - upon output, the data variable.  If any heap data is read,
;          the user is ultimately responsible for freeing it.
;
;
; KEYWORDS:
;
;   UNIT - a file unit.  If a library routine reads to the end of
;          BLOCK, or if BLOCK is undefined, then this file UNIT will
;          be accessed for more data.  If undefined, then BLOCK must
;          contain the entire file in memory.
;
;   TEMPLATE - for structure data (data type 8), a "blank" structure
;              containing the fields and data values to be read in.
;              This structure is returned by CMSV_RVTYPE.
;              This keyword is mandatory for structure data.
;
;   TEMPORARY - if set, BLOCK becomes undefined upon return.
;
;   PTR_OFFSETS - array of file offsets, as described above.  Default:
;                 pointer data is converted to an integer.
;
;   PTR_INDEX - array of heap variable indices, as described above.
;               Default:  pointer data is converted to an integer.
;
;   PTR_DATA - array of pointers, as described above.  
;               Default:  pointer data is converted to an integer.
;
;   OFFSET - the file offset of byte zero of BLOCK.  Default: 0
;            (OFFSET is used by this routine)
;
;   STATUS - upon return, this keyword will contain 1 for success and
;            0 for failure.
;
;   ERRMSG - upon return with a failure, this keyword will contain the
;            error condition as a string.
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Added UNDEFINED data type for IDL >5.3, CM, 21 Apr 2001
;   Fixed bug for pointers within structures, CM, 21 Apr 2001
;   Add support for IDL 4 byte-compiled strings, CM, 22 Apr 2001
;   Make version checks with correct precision, 19 Jul 2001, CM
;   Added notification about RSI License, 13 May 2002, CM
;   Clarify and speed some of the code, 22 Nov 2009, CM
;   NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsv_rdata.pro,v 1.11 2009/11/22 23:04:43 craigm Exp $
;
;-
; Copyright (C) 2000-2001, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; ---------------- Convert from network to host order ------------------
pro cmsv_rconv, data

  ;; Inspired by IDL Astronomy Library routine IEEE_TO_HOST
  common cmsv_conv_common, lendian
  if n_elements(lendian) EQ 0 then begin
      ;; Little-endian?
      lendian = (long(['01'xb,'02'xb,'03'xb,'04'xb],0,1))(0) NE '01020304'xl
  endif

  sz = size(data)
  case sz(sz(0)+1) of 
      1:  return                    ;; Byte
      2:  byteorder, data, /NTOHS   ;; Integer
      3:  byteorder, data, /NTOHL   ;; Long
      4:  byteorder, data, /XDRTOF  ;; Float
      5:  byteorder, data, /XDRTOD  ;; Double
      6:  byteorder, data, /XDRTOF  ;; Complex
      9:  byteorder, data, /XDRTOD  ;; DComplex
      12: byteorder, data, /NTOHS   ;; UInt
      13: byteorder, data, /NTOHL   ;; ULong
      14: if lendian EQ 1 then byteorder, data, /L64SWAP ;; LONG64
      15: if lendian EQ 1 then byteorder, data, /L64SWAP ;; ULONG64
      ELSE: 
  endcase

end

; ---------------- Read heap data variable ---------------------------
pro cmsv_rhdata, block, pointer, data, index, offsets, pdata, unit=unit0, $
                 offset=offset0, status=status, errmsg=errmsg

  status = 0
  errmsg = ''
  if n_elements(offset0) EQ 0 then offset = 0L $
  else                             offset = floor(offset0(0))

  if n_elements(offsets) EQ 0 OR n_elements(index) EQ 0 then begin
      errmsg = 'ERROR: CMSV_RDATA: must specify INDEX and OFFSETS data'
      return
  endif

  if n_elements(offsets) NE n_elements(index) then begin
      errmsg = 'ERROR: CMSV_RDATA: dimensions of OFFSETS and '+ $
        'INDEX do not match'
      return
  endif
  
  if n_elements(unit0) EQ 0 then begin
      errmsg = 'ERROR: CMSV_RDATA: Must specify UNIT when reading heap data'
      return
  endif
  unit = floor(unit0(0))

  sz = size(data)
  odata = temporary(data)

  ;; Create the properly sized array.  Don't worry about getting the
  ;; dimensions right since it will be reformed.
  if sz(0) GT 0 then begin
      data = ptrarr(sz(sz(0)+2))
  endif else begin
      data = ptr_new()
  endelse

  blimits = offset + [0,n_elements(block)-1]

  point_lun, -unit, opos
  null = ptr_new()
  
  for i = 0, n_elements(odata)-1 do begin
      if odata(i) EQ 0 then goto, NEXT_HEAP

      wh = (where(odata(i) EQ index, ct))(0)
      if ct EQ 0 then goto, NEXT_HEAP

      if n_elements(pdata) GT wh then begin
          if pdata(wh) NE null then begin
              data(i) = pdata(wh)
              goto, NEXT_HEAP
          endif
      endif

      point_lun, unit, offsets(wh)

      block1 = 0 & dummy = temporary(block1)
      p1 = 0L
      cmsv_rvtype, block1, p1, varname, sz1, status=status, template=tp1, $
        unit=unit, errmsg=errmsg, structure_name=stname, /heap
      if status EQ 0 then return

      if floor(varname) NE odata(i) then begin
          errmsg = 'ERROR: CMSV_RDATA: heap index mismatch'
          status = 0
          return
      endif

      val = 0 & dummy = temporary(val)
      cmsv_rdata, block1, p1, sz1, val, template=tp1, status=st1, $
        ptr_offsets=offsets, ptr_index=index, ptr_data=pdata, $
        ptr_callback='DEFAULT', unit=unit, errmsg=errmsg
      if status EQ 0 then return

      ;; Deal with case of undefined heap var
      if n_elements(val) GT 0 then data(i) = ptr_new(temporary(val)) $
      else                         data(i) = ptr_new(/allocate_heap)
      if n_elements(pdata) GT wh then pdata(wh) = data(i)
      NEXT_HEAP:
  endfor

  point_lun, unit, opos
  status = 1
  return
end

; --------------------------- Main procedure ------------------------------
pro cmsv_rdata, block, pointer, sz, data, offset=offset, unit=unit, $
                template=template1, status=status, errmsg=errmsg, $
                start=start, temporary=temp, $
                bytelong=bytelong, bcstring40=bcstring, $
                ptr_offsets=pprivate, ptr_callback=callback0, $
                ptr_index=pindex, ptr_data=pdata

  ;; VAR_DATA
  ;;   LONG - START_DATA TOKEN - value 7
  ;;   for bytes - consecutive bytes
  ;;   for (u)ints - upcast to type long 
  ;;   for (u)longs - consecutive longs
  ;;   for pointers - consecutive longs, indices into saved heap data
  ;;   for strings - consecutive STRING's
  ;;   for structs - compacted versions of above
  forward_function fix, uint, complex, dcomplex, make_array

  data = 0 & dummy = temporary(data)
  if n_elements(start) EQ 0 then start = 1
  if n_elements(pointer) EQ 0 then pointer = 0L

  tp0 = sz(sz(0)+1)
  tp = tp0

  ;; =====================================
  if tp EQ 0 then begin     ;; UNDEFINED type
      data = 0
      dummy = temporary(data)
      return
  endif
  ;; =====================================
  if (tp EQ 11) then begin  ;; OBJECT type
      status = 0
      errmsg = 'ERROR: CMSV_RDATA: cannot read object data'
      return
  endif

  if keyword_set(start) then begin
      start_token = cmsv_rraw(/long, block, pointer, status=status, $
                               unit=unit, errmsg=errmsg)
      if start_token NE 7 then begin
          errmsg = 'ERROR: CMSV_RDATA: invalid or corrupted data'
          status = 0
      endif
      if status EQ 0 then return
  endif

  nelt = sz(sz(0)+2)
  ;; =====================================
  if (tp EQ 10) then tp = 3 ;; Pointer type -> LONG

  ;; =====================================
  if (tp EQ 8) then begin   ;; Structure type
      if n_elements(template1) EQ 0 then begin
          errmsg = 'ERROR: CMSV_RDATA: TEMPLATE must be passed for structures'
          status = 0
          return
      endif
      data = reform(replicate(template1(0), nelt), sz(1:sz(0)), /overwrite)
      tp1 = data(0)
      tn = tag_names(data(0)) & nt = n_elements(tn)
      ssz = lonarr(12, nt)
      for j = 0L, nt-1 do begin
          ssz(0, j) = size(data(0).(j))
      endfor
      for i = 0L, nelt-1 do begin
          for j = 0L, nt-1 do begin
              cmsv_rdata, block, pointer, ssz(*,j), dataij, start=0, $
                template=(tp1.(j))(0), $
                ptr_offsets=pprivate, ptr_index=pindex, ptr_data=pdata, $
                ptr_callback=callback0, $
                unit=unit, status=status, errmsg=errmsg
              data(i).(j) = dataij
              
              if status EQ 0 then return
          endfor
      endfor
      return
  endif

  ;; =====================================
  if tp EQ 7 then begin     ;; String type
      if sz(0) EQ 0 then data = '' $
      else data = reform(strarr(sz(sz(0)+2)), sz(1:sz(0)), /overwrite)
      for i = 0L, nelt-1 do begin
          len = cmsv_rraw(/long, block, pointer, status=status, $
                             unit=unit, errmsg=errmsg)
          if status EQ 0 then return
          if len GT 0 OR keyword_set(bcstring) then $
            data(i) = cmsv_rraw(/string, block, pointer, unit=unit, $
                                status=status, errmsg=errmsg)
          if status EQ 0 then return
      endfor
      if sz(0) EQ 0 then data = data(0)
      return
  endif
  
  ;; Sometimes the input data is stored as a different type
  common cmsv_datatypes, stype, sbyte, nbyte, selts
  if n_elements(stype) EQ 0 then begin
      ;;      0      1       2       3        4        5         6    7   8
      ;;          byte     int    long    float    double   complex str struct
      stype =['','BYTE', 'LONG', 'LONG', 'FLOAT', 'DOUBLE', 'FLOAT', '', '' ]
      sbyte =[0,     1,      4,      4,       4,        8,       4,   0,  0 ]
      selts =[0,     1,      1,      1,       1,        1,       2,   0,  0 ]

      ;;                  9     10   11     12       13        14
      ;;            dcomplex   ptr   obj   uint     ulong    long64   ulong64
      stype =[stype,'DOUBLE', 'LONG', '', 'ULONG', 'ULONG', 'LONG64','ULONG64']
      sbyte =[sbyte,      8,     4,   0,     4,       4,        8,        8, 0]
      selts =[selts,      2,     1,   0,     1,       1,        1,        1, 0]
  endif

  status = 0
  nb = sbyte(tp<16)
  if nb EQ 0 then begin
      errmsg = ('ERROR: CMSV_RDATA: cannot read specified type ('+ $
                strtrim(tp,2)+')')
      return
  endif
  nelt1 = nelt*selts(tp<16)     ;; Account for complex type
  nb  = nb*nelt1                ;; Number of total bytes
  nb1 = long(floor((nb+3)/4)*4) ;; Number of bytes, rounded to next long
  rt  = stype(tp<16)            ;; Read type, as opposed to output type

  ;; Error handler returns zero and error condition
  on_ioerror, READ_ERROR
  if 0 then begin
      READ_ERROR: CMSV_RDATA:
      errmsg = 'ERROR: CMSV_RDATA: a read error occurred'
      return
  end

  ;; =====================================
  ;; Byte values handled specially....    argghhh!
  if tp EQ 1 then begin
     if NOT keyword_set(bytelong) then begin
        ;; BYTELONG is NOT set
        nb1 = cmsv_rraw(/long, block, pointer, unit=unit, $
                        errmsg=errmsg, status=status)
        if status EQ 0 then return
        if nb1 NE nb then begin
           errmsg = 'ERROR: CMSV_RDATA: byte count and array size do not agree'
           status = 0
           return
        endif
        ;; Round up to the nearest 4-byte boundary
        nb1 = long(floor((nb+3)/4)*4)
     endif else begin
        ;; BYTELONG is set
        
        ;; Input data will be read as long... required when decoding
        ;; values in code blocks
        nb    = sbyte(3)
        nelt1 = nelt*selts(3)
        nb    = nb*nelt1
        nb1   = nb
        rt    = stype(3)
     endelse
  endif

  ;; =====================================
  ;; Perform default type conversions on the data
  pp = pointer
  if n_elements(block) GT 0 then begin
      if pointer+nb GT n_elements(block) then begin
          dummy = cmsv_rraw(block, pointer, nb, /byte, /buffer, unit=unit, $
                            status=status, errmsg=errmsg)
          if status EQ 0 then return
      endif

      if keyword_set(temp) then $
        data = call_function(rt, (temporary(block))(pp:pp+nb-1), 0, nelt1) $
      else $
        data = call_function(rt, block(pp:pp+nb-1), 0, nelt1)
  endif else begin
      sz1 = size(call_function(rt,0))
      data = make_array(type=sz1(sz1(0)+1), nelt1, /nozero)
      readu, unit(0), data
  endelse
  pointer = pointer + nb1
  cmsv_rconv, data

  ;; =====================================
  ;; Special conversions on certain data types
  case tp of
     2:  data = fix(temporary(data))              ;; 2 - int
     12: data = uint(temporary(data))             ;; 12 - uint
     6:  data = complex(temporary(data), 0, nelt) ;; 6 - complex (float)
     9:  data = dcomplex(temporary(data), 0, nelt);; 9 - dcomplex (double)
     else:
  endcase

  ;; Reset error handler
  on_ioerror, NULL

  ;; =====================================
  ;; Convert to pointer type
  if tp0 EQ 10 then if double(!version.release) GE 5D $
    AND n_elements(pprivate) GT 0 AND n_elements(pindex) GT 0 then begin

      ;; The data we have read is actually just an index number into
      ;; the heap.  We must read each heap variable separately.
      if n_elements(callback0) GT 0 then callback = strtrim(callback0(0),2) $
      else                               callback = 'DEFAULT'
      if callback EQ 'DEFAULT' then      callback = 'CMSV_RHDATA'

      if callback NE '' then begin
          call_procedure, callback, block, pointer, data, $
            pindex, pprivate, pdata,$
            unit=unit, offset=offset, status=status, errmsg=errmsg
          if status EQ 0 then return
      endif
  endif
      
  ;; =====================================
  ;; Make sure that the output array has the right dimensions
  if sz(0) GT 0 then data = reform(data, sz(1:sz(0)), /overwrite) $
  else data = data(0)

  status = 1
  return
end
;+
; NAME:
;   CMSV_RRAW
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Read raw SAVE data from input block or file unit
;
; CALLING SEQUENCE:
;   DATA = CMSV_RRAW( BLOCK, POINTER, NELT, UNIT=UNIT, $
;                     STRING=STRING, LONG=LONG, BYTE=BYTE, TYPE=TYPE, $
;                     OFFSET=OFFSET, STATUS=STATUS, ERRMSG=ERRMSG )
;   
; DESCRIPTION: 
;
;   This function reads raw integer or string data from an IDL SAVE
;   file.  This is the lowest level reading function in the library,
;   intended for developers who are investigating new and existing
;   SAVE file formats.
;
;   The primary use of this function will be to read raw integer and
;   string data from the input.  By default, a single value is read as
;   a scalar; however a vector of values can be read using the NELT
;   parameter.  Special keywords are provided for the common data
;   types STRING, LONG and BYTE.  Other integer types can be read
;   using the TYPE keyword.  Users who want to read the data from an
;   IDL variable should use CMSV_RDATA, which can handle
;   multidimensional data, as well as floating point and structure
;   data.
;
;   A secondary use of this function is to buffer the data in BLOCK.
;   This will ensure that BLOCK contains enough data to convert NELT
;   integers without reading from disk.  CMSV_RRAW itself does not
;   convert any values so the return value should be ignored.
;
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; BLOCK, POINTER, OFFSET
;
;   This procedure can read data from a byte array, a file unit, or
;   both.  In fact, this procedure is designed to implement "lazy"
;   reading from a file, which is to say, it normally reads from a
;   byte array of data.  However, if the requested data goes beyond
;   the end of the byte array, more data is read from the file on
;   demand.  This way the user gets the benefit of fast memory access
;   for small reads, but guaranteed file access for large reads.
;
;   The terminology is as follows: BLOCK is a byte array which
;   represents a portion of, or an entire, IDL SAVE file.  The block
;   may be a cached portion of an on-disk file, or an entire in-memory
;   SAVE file.  POINTER is the current file pointer within BLOCK
;   (i.e., the next byte to be read is BLOCK[POINTER]).  Hence, a
;   POINTER value of 0 refers to the start of the block.  OFFSET is
;   the file offset of the 0th byte of BLOCK; thus "POINT_LUN,
;   OFFSET+POINTER" should point to the same byte as BLOCK[POINTER].
;   The following diagram shows the meanings for BLOCK, POINTER and
;   OFFSET schematically:
;
;
;                 0 <-  OFFSET  -> |
;   FILE          |----------------|------*--------|--------->
;
;   BLOCK                          |------*--------|
;                                  0      ^ POINTER
;     
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
;
; INPUTS:
;
;   BLOCK - a byte array, a cache of the SAVE file.  Users will
;           usually not access this array directly.  Users are advised
;           to clear BLOCK after calling POINT_LUN.
;
;   POINTER - a long integer, a pointer to the next byte to be read
;             from BLOCK.  CMSVLIB routines will automatically
;             advance the pointer.
;
;   NELT - optional parameter specifying the number of values to read.
;          If unspecified, then a scalar value is read and returned.
;          If specified, then a vector of NELT values is read and
;          returned.
;
;
; KEYWORDS:
;
;   BUFFER - if set, CMSV_RRAW will ensure that BLOCK contains at
;            least NELT values without converting them.  The return
;            value should be ignored.  This keyword is ignored for
;            strings.
;
;   LONG - if set, the values are converted as LONG integers.
;
;   BYTE - if set, the values are converted as BYTEs.
;
;   STRING - if set, the values are converted as STRINGs.  Each string
;            may be of variable length.
;
;   TYPE - if none of the above keywords is set, then values of type
;          TYPE are read.  TYPE should be a string, one of 'BYTE',
;          'FIX', 'LONG', 'ULONG', 'LONG64', or 'ULONG64'.
;          If no type is specified then BYTEs are read.
;
;   UNIT - a file unit.  If a library routine reads to the end of
;          BLOCK, or if BLOCK is undefined, then this file UNIT will
;          be accessed for more data.  If undefined, then BLOCK must
;          contain the entire file in memory.
;
;   OFFSET - the file offset of byte zero of BLOCK.  Default: 0
;            (OFFSET is used by this routine)
;
;   STATUS - upon return, this keyword will contain 1 for success and
;            0 for failure.
;
;   ERRMSG - upon return with a failure, this keyword will contain the
;            error condition as a string.
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Added notification about RSI License, 13 May 2002, CM
;   NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsv_rraw.pro,v 1.7 2009/11/22 22:50:49 craigm Exp $
;
;-
; Copyright (C) 2000-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CMSV_RREC
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Read SAVE-formatted record header from input block or file unit
;
; CALLING SEQUENCE:
;   CMSV_RREC, BLOCK, POINTER, DATA, UNIT=UNIT, $
;        BLOCK_TYPE=BLOCK_TYPE, BLOCK_NAME=BLOCK_NAME, NEXT_BLOCK=NEXT_BLOCK, $
;        INITIALIZE=INITIALIZE, FULL=FULL, PROMOTE64=PROMOTE64, $
;        OFFSET=OFFSET, STATUS=STATUS, ERRMSG=ERRMSG
;   
; DESCRIPTION: 
;
;   This procedure reads the header of an IDL SAVE record.  The header
;   consists of four bytes at the beginning of each record which
;   indentifies the type and size of the record.  This procedure also
;   additionally reads many full records as noted below.
;
;   Users can determine the block type by examining the values
;   returned in the BLOCK_TYPE and BLOCK_NAME keywords.  The following
;   values are supported.  Some record types contain additional data.
;   CMSV_RREC reads some of these record types automatically (those
;   entries below marked with [this procedure]).  Other records do not
;   contain any additional data at all (those entries marked with an
;   [empty]), and thus require no further processing.
;
;    BLOCK_TYPE      BLOCK_TYPE         READ RECORD DATA WITH...
;
;       0         = 'START_MARKER'      [empty]
;       1         = 'COMMON_BLOCK'      [this procedure]
;       2         = 'VARIABLE'          CMSV_RVTYPE / CMSV_RDATA
;       3         = 'SYSTEM_VARIABLE'   CMSV_RVTYPE / CMSV_RDATA
;       6         = 'END_MARKER'        [empty]
;       10        = 'TIMESTAMP'         [this procedure]
;       12        = 'COMPILED'          no published procedure
;       13        = 'IDENTIFICATION'    [this procedure]
;       14        = 'VERSION'           [this procedure]
;       15        = 'HEAP_INDEX'        [this procedure]
;       16        = 'HEAP_DATA'         CMSV_RVTYPE
;       17        = 'PROMOTE64'         [empty]
;       19        = 'NOTICE'            [this procedure]
;
;   For records that contain variable data, the external procedures
;   CMSV_RVTYPE and CMSV_RDATA must be used, as noted above.
;   Otherwise CMSV_RREC will read and convert the appropriate data
;   automatically and return it in the DATA positional parameter.
;
;   The offset of the next record is returned in the NEXT_BLOCK
;   keyword.  For file input, the command, "POINT_LUN, UNIT,
;   NEXT_BLOCK" will position the file pointer to the next block.
;
;   Users should be aware that the SAVE files produced by IDL version
;   5.4 appear to have a different header format.  The new header size
;   is five bytes, and is incompatible with the older format.  In
;   order to activate the longer header size, the PROMOTE64 keyword
;   must be set.
;
;   By default the entire record is not read from the file at once.
;   Users that wish to operate on the entire record immediately should
;   set the FULL keyword.
;
;   After issuing a POINT_LUN the block cache in BLOCK must be reset
;   using the /INITIALIZE keyword.
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; SPECIFIC RECORD TYPES
;
;   CMSV_RREC reads certain specific record types automatically and
;   returns the data in the positional parameter data.  Users should
;   pass a named variable in this parameter to retrieve the return
;   value.
;
;   When a record of type 'VERSION' (14) is encountered, it is read,
;   and returned as a structure. The returned data are of the form:
;
;         { FORMAT_VERSION: 0L, $   ; Format version number of file
;           ARCH: '', $             ; !VERSION.ARCH of creating host
;           OS: '', $               ; !VERSION.OS of creating host
;           RELEASE: '' }           ; !VERSION.RELEASE of creating host
;
;   When a record of type 'TIMESTAMP' (10) is encountered, it is read,
;   and returned as a structure. The returned data are of the form:
;
;          { SAVE_DATE: '', $  ; Date the save file was created
;            SAVE_USER: '', $  ; User name who  created file
;            SAVE_HOST: '' }   ; Host name that created file
;
;   Save files created by IDL version 4 do not contain a timestamp
;   record.
;
;   When a record of type 'IDENTIFICATION' (13) is encountered, it is
;   read, and returned as a structure.  The returned data are of the
;   form:
;
;          { AUTHOR: '', $  ; Author of SAVE file
;            TITLE:  '', $  ; Title of SAVE file
;            IDCODE: '' }   ; Identifying code for SAVE file
;
;   It appears that this record is not used in IDL version 5 or later.
;
;   When a record of type 'COMMON_BLOCK' (1) is encountered, it is
;   read and returned.  A common block descriptor consists of an array
;   of strings whose first element is the common block name, and whose
;   remaining elements are the common block variable names.  No
;   variable data are stored with the common block definition.
;
;   When a record of type 'HEAP_INDEX' (15) is encountered, it is read
;   and returned in DATA.  The heap index specifies a list of which
;   heap variables are stored in the current save file.  These indices
;   are simply numbers which identify each heap variable (i.e.,
;   "<PtrHeapVar2>" would have an index of 2).  Users should note that
;   the heap index will not necessarily be sequentially increasing,
;   and may have gaps.
;
;   When a record of type 'NOTICE' (19) is encountered, it is read and
;   returned in DATA.  It is a structure with one field: {TEXT: ''},
;   where TEXT is the text content of the notice.
;
;   Users should consult CMSV_RDATA for instructions on how to read
;   heap data.
;   
;
; BLOCK, POINTER, OFFSET
;
;   This procedure can read data from a byte array, a file unit, or
;   both.  In fact, this procedure is designed to implement "lazy"
;   reading from a file, which is to say, it normally reads from a
;   byte array of data.  However, if the requested data goes beyond
;   the end of the byte array, more data is read from the file on
;   demand.  This way the user gets the benefit of fast memory access
;   for small reads, but guaranteed file access for large reads.
;
;   The terminology is as follows: BLOCK is a byte array which
;   represents a portion of, or an entire, IDL SAVE file.  The block
;   may be a cached portion of an on-disk file, or an entire in-memory
;   SAVE file.  POINTER is the current file pointer within BLOCK
;   (i.e., the next byte to be read is BLOCK[POINTER]).  Hence, a
;   POINTER value of 0 refers to the start of the block.  OFFSET is
;   the file offset of the 0th byte of BLOCK; thus "POINT_LUN,
;   OFFSET+POINTER" should point to the same byte as BLOCK[POINTER].
;   The following diagram shows the meanings for BLOCK, POINTER and
;   OFFSET schematically:
;
;
;                 0 <-  OFFSET  -> |
;   FILE          |----------------|------*--------|--------->
;
;   BLOCK                          |------*--------|
;                                  0      ^ POINTER
;     
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.  
;
;
; INPUTS:
;
;   BLOCK - a byte array, a cache of the SAVE file.  Users will
;           usually not access this array directly.  Users are advised
;           to clear BLOCK after calling POINT_LUN.
;
;   POINTER - a long integer, a pointer to the next byte to be read
;             from BLOCK.  CMSVLIB routines will automatically
;             advance the pointer.
;
;
; KEYWORDS:
;
;   UNIT - a file unit.  If a library routine reads to the end of
;          BLOCK, or if BLOCK is undefined, then this file UNIT will
;          be accessed for more data.  If undefined, then BLOCK must
;          contain the entire file in memory.
;
;   OFFSET - the file offset of byte zero of BLOCK.  Default: 0
;            (OFFSET is used by this routine)
;
;   BLOCK_TYPE - upon return, the numeric record type, as described
;                above.
;
;   BLOCK_NAME - upon return, a scalar string specifying the record
;                type, as specified above.
;
;   NEXT_BLOCK - upon return, file offset of the next record in the
;                file.
;
;   INITIALIZE - if set, then BLOCK and POINTER are initialized to a
;                pristine state.  All data in these two variables is
;                lost before reading the next record.
;
;   FULL - if set, then the entire record will be read into BLOCK.
;
;   STATUS - upon return, this keyword will contain 1 for success and
;            0 for failure.
;
;   ERRMSG - upon return with a failure, this keyword will contain the
;            error condition as a string.
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Fix typo for RHEAP call, CM, 21 Apr 2001
;   Added notification about RSI License, 13 May 2002, CM
;   Added NOTICE record type, 09 Jun 2003, CM
;   Read record header as ULONG, 26 Sep 2009, CM
;   Bug fix to previous change, 22 Nov 2009, CM
;   Support for newer IDL 64-bit files which use a 
;    "standard" record header size and a previously unused
;    field, 11 Jan 2010, CM
;   NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsv_rrec.pro,v 1.15 2010/01/11 08:58:13 craigm Exp $
;
;-
; Copyright (C) 2000-2001, 2003, 2009, 2010, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; ----------------- Read common block descriptor ----------------------

pro cmsv_rcomm, block, pointer, names, unit=unit, offset=offset, $
                status=status, errmsg=errmsg

  status = 0
  if n_elements(pointer) EQ 0 then pointer = 0L
  names = 0 & dummy = temporary(names)
  
  ncommon = cmsv_rraw(/long, block, pointer, unit=unit, $
                      status=status, errmsg=errmsg)
  if status EQ 0 then return
  if ncommon LE 0 then begin
      status = 0
      errmsg = 'ERROR: CMSV_RREC: invalid common record block'
      return
  endif

  names = cmsv_rraw(/string, block, pointer, ncommon+1, unit=unit, $
                    status=status, errmsg=errmsg)
  return
end


; ----------------- Read heap index ---------------------------------

pro cmsv_rheap, block, pointer, index, unit=unit, offset=offset, $
                status=status, errmsg=errmsg

  ;; HEAP_INDEX
  ;;   LONG - N_HEAP - number of heap values
  ;;   LONGxN_HEAP - heap indices

  if n_elements(pointer) EQ 0 then pointer = 0L
  index = 0 & dummy = temporary(index)

  n_heap = cmsv_rraw(/long, block, pointer, unit=unit, $
                     status=status, errmsg=errmsg)
  if status then $
    index = cmsv_rraw(/long, block, pointer, n_heap, unit=unit, $
                      status=status, errmsg=errmsg)

  return
end

; ------------------------ Read time stamp record -----------------------

pro cmsv_rstamp, block, pointer, tstamp, unit=unit, offset=offset, $
                 status=status, errmsg=errmsg

  ;; TIMESTAMP
  ;;   BYTEx400 - empty (?) legacy area
  ;;   STRING - save date (as a string)
  ;;   STRING - user name
  ;;   STRING - hostname
  status = 0
  if n_elements(pointer) EQ 0 then pointer = 0L
  pointer = pointer + '400'xl
  tstamp = 0 & dummy = temporary(tstamp)

  strings = cmsv_rraw(/string, block, pointer, 3, unit=unit, $
                      status=status, errmsg=errmsg)
  if status EQ 0 then return

  tstamp = {save_date: strings(0), save_user: strings(1), save_host:strings(2)}
  return
end


; ---------------------- Read Version Info ---------------------------

pro cmsv_rversion, block, pointer, vers, unit=unit, offset=offset, $
                   status=status, errmsg=errmsg
  ;; VERSION_STAMP
  ;;   LONG - Major version number
  ;;   STRING_DATA - Host architecture ( = !version.arch )
  ;;   STRING_DATA - Host OS ( = !version.os )
  ;;   STRING_DATA - IDL release ( = !version.release )

  if n_elements(pointer) EQ 0 then pointer = 0L
  major_release = 5
  vers = 0 & dummy = temporary(vers)

  arch = '' & os = '' & release = ''
  major_release = cmsv_rraw(/long, block, pointer, unit=unit, $
                            status=status, errmsg=errmsg)
  if status EQ 0 then return

  strings = cmsv_rraw(/string, block, pointer, 3L, status=status, $
                      unit=unit, errmsg=errmsg)
  if status EQ 0 then return
  status = 1
  
  vers = {format_version: major_release, arch: strings(0), $
          os: strings(1), release: strings(2)}
  return
end

; --------------------------- Read Identification --------------------

pro cmsv_rident, block, pointer, ident, unit=unit, offset=offset, $
                 status=status, errmsg=errmsg

  ;; IDENT
  ;;   STRING - author
  ;;   STRING - title
  ;;   STRING - idcode

  strings = cmsv_rraw(/string, block, pointer, 3, unit=unit, $
                      status=status, errmsg=errmsg)
  if status EQ 0 then return

  ident = {author: strings(0), title: strings(1), idcode:strings(2)}
  return
end

; --------------------------- Read Notice --------------------

pro cmsv_rnotice, block, pointer, notice, unit=unit, offset=offset, $
                  status=status, errmsg=errmsg

  ;; NOTICE
  ;;   STRING - notice text

  string = cmsv_rraw(/string, block, pointer, 1, unit=unit, $
                      status=status, errmsg=errmsg)
  if status EQ 0 then return

  notice = {text: string}
  return
end


; ---------------------------- Main Read Routine ---------------------

pro cmsv_rrec, block, pointer, data, unit=unit, offset=offset, $
               status=status, errmsg=errmsg, compressed=compressed, $
               block_type=blocktype, block_name=blockname, next_block=np, $
               initialize=init, full=full, promote64=prom, $
               qblocknames=qblock

  common cmsave_block_names, block_ntypenames, block_typenames
  if n_elements(block_ntypenames) EQ 0 then begin
      block_ntypenames    = 20
      block_typenames     = strarr(block_ntypenames+1)+'UNKNOWN'
      block_typenames(0)  = 'START_MARKER'
      block_typenames(1)  = 'COMMON_BLOCK'
      block_typenames(2)  = 'VARIABLE'
      block_typenames(3)  = 'SYSTEM_VARIABLE'
      block_typenames(6)  = 'END_MARKER'
      block_typenames(10) = 'TIMESTAMP'
      block_typenames(12) = 'COMPILED'
      block_typenames(13) = 'IDENTIFICATION'
      block_typenames(14) = 'VERSION'
      block_typenames(15) = 'HEAP_INDEX'
      block_typenames(16) = 'HEAP_DATA'
      block_typenames(17) = 'PROMOTE64'
      block_typenames(19) = 'NOTICE'
  endif

  if keyword_set(qblock) then begin
      data = block_typenames
      return
  end

  status = 0
  errmsg = ''

  if n_elements(pointer) EQ 0 then pointer = 0L
  pointer = floor(pointer(0))
  if keyword_set(init) then begin
      block = 0 & dummy = temporary(block)
      pointer = 0L
  endif

  pointer0 = pointer
  op = pointer0  ;; "OP" = old pointer - points to curr record
  if n_elements(offset) GT 0 then op = op + offset(0)

  nlongs = 4L
  if keyword_set(prom) then nlongs = 5 ;; Special case of PROMOTE64
  rechead = cmsv_rraw(block, pointer, nlongs, unit=unit(0), $
                      status=status, errmsg=errmsg, type='ULONG')
  if status EQ 0 then return
  
  blocktype = rechead(0)
  blockname = block_typenames(blocktype < block_ntypenames)

  ;; "NP" = next pointer - points to next record
  np = rechead(1)

  ;; We assume this is a 64-bit pointer for two possibilities:
  ;;    1. the next pointer (32-bit) is less than "old pointer"
  ;;    2. PROMOTE64 has been set
  if (np LT op) OR keyword_set(prom) then begin
     ;; Compute new offset by combining two long values
     np = rechead(1) + rechead(2)*'100000000'XULL
     ;; Promote OFFSET
     if n_elements(offset) NE 0 then offset = ulong64(offset)

     ;; Sanity check on PROMOTE64-style headers
     if keyword_set(prom) then if rechead(4) NE 0 then begin
          errmsg = 'ERROR: CMSV_RREC: inconsistent 64-bit header'
          status = 0
          return
     endif
  endif


  if keyword_set(doprom) then begin
      ;; If file offset is to be promoted to 64-bit then we compute it
      ;; here.  The additional logic is to preserve 32-bit offsets in
      ;; most cases, and promote only if absolutely needed.  Signal an
      ;; error in earlier versions of IDL that don't support 64-bit
      ;; numbers.
      np = rechead(2) + rechead(1)
      if rechead(1) NE 0 AND rechead(2) NE 0 then begin
          if double(!version.release) LT 5.2D then begin
              errmsg = ('ERROR: CMSV_RREC: file contains a 64-bit file '+ $
                        'offset which is unstorable by this version of IDL')
              status = 0
              return
          endif
          np = cmsv_rraw(/long, block, pointer-3L*4L, type='ULONG64', $
                         status=status, errmsg=errmsg)
          if status EQ 0 then return
      endif

      ;; A 64-bit header has an extra long in it.  Read that now.
      ;; It should be zero.
      val0 = cmsv_rraw(/long, block, pointer, status=status, errmsg=errmsg)
      if status EQ 0 then return
      if val0 NE 0 then begin
          errmsg = 'ERROR: CMSV_RREC: inconsistent 64-bit header'
          status = 0
          return
      endif

  endif

  ;; Activate 64-bit promotion.  Blocks after this current one will
  ;; have 64-bit file offsets rather than 32-bit ones.
  if blocktype EQ 17 then prom = 1

  if keyword_set(full) then begin
      if n_elements(offset) EQ 0 then offset = 0L
      nbytes = np - (pointer0 + floor(offset(0)))
      if nbytes GT 0 then begin
          dummy = cmsv_rraw(block, 0L, nbytes, /byte, /buffer, unit=unit, $
                            status=status, errmsg=errmsg)
          if status EQ 0 then return
          block = block(0:nbytes-1)
      endif
  endif

  ;; Can't read compressed data for the moment
  if keyword_set(compressed) then begin
      status = 1
      return
  endif

  case blockname of 
      'COMMON_BLOCK': cmsv_rcomm, block, pointer, data, unit=unit, $
        status=status, errmsg=errmsg
      'HEAP_INDEX': cmsv_rheap, block, pointer, data, unit=unit, $
        status=status, errmsg=errmsg
      'VERSION': cmsv_rversion, block, pointer, data, unit=unit, $
        status=status, errmsg=errmsg
      'TIMESTAMP': cmsv_rstamp, block, pointer, data, unit=unit, $
        status=status, errmsg=errmsg
      'IDENTIFICATION': cmsv_rident, block, pointer, data, unit=unit, $
        status=status, errmsg=errmsg
      'NOTICE': cmsv_rnotice, block, pointer, data, unit=unit, $
        status=status, errmsg=errmsg
      ELSE: status = 1
  end

  return
end
;+
; NAME:
;   CMSV_RVTYPE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Read variable type information from input block or file unit
;
; CALLING SEQUENCE:
;   CMSV_RVTYPE, BLOCK, POINTER, NAME, SIZE, UNIT=UNIT, $
;          TEMPLATE=TEMPLATE, SUFFIX=SUFFIX, $
;          /NO_CREATE, /NO_TYPE, /HEAP, /SYSTEM, $
;          STRUCTURE_NAME=STNAME, $
;          NAMED_STRUCTS=STRUCTS, NAMED_CLASSES=CLASSES, $
;          OFFSET=OFFSET, STATUS=STATUS, ERRMSG=ERRMSG
;   
; DESCRIPTION: 
;
;   CMSV_RVTYPE reads the type portion of an IDL SAVE variable record.
;   An IDL variable is stored in two components: the type descriptor
;   which describes the name, type, and dimensions of the variable;
;   and the data record, which contains the raw data of the variable.
;   This procedure reads the type descriptor returns it to the user.
;   This procedure can also determine the name of a variable; the heap
;   index number of a heap variable; and other important information.
;   Once the type of the data has been determined, the data portion
;   can be read using the CMSV_RDATA procedure.
;
;   CMSV_RVTYPE should recognize and correctly return type descriptor
;   information about all known IDL data types, as of this writing.
;   It should be noted that CMSV_RDATA will not necessarily be capable
;   of reading all of these data types, but the description of the
;   data should still be readable.  Users can then use this
;   information to print a summary of the file contents for example.
;
;   The type information are normally returned in the SIZE parameter,
;   which gives the IDL variable type, and the dimensions of the
;   variable just as the IDL built-in function SIZE() would do.
;   However, in the case of structures, there is much more information
;   to convey.  To assist the user a blank template structure is
;   returned in the keyword parameter TEMPLATE, which they can then
;   pass on to CMSV_RDATA.
;
;   Users should be aware of structure and class name clashes.  The
;   problem arises because CMSV_RVTYPE must actually instantiate any
;   named structures or classes in the file.  If these named
;   structures clash with the definitions of the structures on the
;   user's local computer, then an error will result.  To prevent
;   this, the user can use the SUFFIX keyword.  If the SUFFIX keyword
;   contains a string, then this string is appended to any structure
;   names discovered in the save file, before instantiation.  Thus, as
;   long as the suffix is a unique string, there will be no clashes
;   with local structure definitions.  Users are advised to pick a
;   different suffix for *each* save file that they open.
;
;   CMSV_RVTYPE also provides some diagnostic information about the
;   variable.  Users can pass the NAMED_STRUCTS and NAMED_CLASSES
;   keywords in order to discover what named structures, classes and
;   superclasses are stored in the save file (this is especially
;   useful with the NO_TYPE keyword).  Since the contents of
;   NAMED_STRUCTS and NAMED_CLASSES are not destroyed, but appended to
;   instead, users are advised to clear these variables when opening
;   each new file.
;   
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; BLOCK, POINTER, OFFSET
;
;   This procedure can read data from a byte array, a file unit, or
;   both.  In fact, this procedure is designed to implement "lazy"
;   reading from a file, which is to say, it normally reads from a
;   byte array of data.  However, if the requested data goes beyond
;   the end of the byte array, more data is read from the file on
;   demand.  This way the user gets the benefit of fast memory access
;   for small reads, but guaranteed file access for large reads.
;
;   The terminology is as follows: BLOCK is a byte array which
;   represents a portion of, or an entire, IDL SAVE file.  The block
;   may be a cached portion of an on-disk file, or an entire in-memory
;   SAVE file.  POINTER is the current file pointer within BLOCK
;   (i.e., the next byte to be read is BLOCK[POINTER]).  Hence, a
;   POINTER value of 0 refers to the start of the block.  OFFSET is
;   the file offset of the 0th byte of BLOCK; thus "POINT_LUN,
;   OFFSET+POINTER" should point to the same byte as BLOCK[POINTER].
;   The following diagram shows the meanings for BLOCK, POINTER and
;   OFFSET schematically:
;
;
;                 0 <-  OFFSET  -> |
;   FILE          |----------------|------*--------|--------->
;
;   BLOCK                          |------*--------|
;                                  0      ^ POINTER
;     
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.  
;
;
; INPUTS:
;
;   BLOCK - a byte array, a cache of the SAVE file.  Users will
;           usually not access this array directly.  Users are advised
;           to clear BLOCK after calling POINT_LUN.
;
;   POINTER - a long integer, a pointer to the next byte to be read
;             from BLOCK.  CMSVLIB routines will automatically
;             advance the pointer.
;
;   NAME - upon return, the identifier of the variable.  For named
;          variables, NAME is a string.  For heap variables, NAME is
;          an integer heap index.
;
;   SIZE - upon return, an integers array describing the variable type
;          and size, in the same format as returned by the built-in
;          function SIZE.
;
; KEYWORDS:
;
;   TEMPLATE - upon return, if the variable is a structure, TEMPLATE
;              will contain a single blank template structure, which
;              can be used in calls to CMSV_RDATA.
;
;   NO_CREATE - if set, then do not create any template structures
;               (saves execution time and structure name clashes).
;
;   NO_TYPE - if set, do not read type information.  CMSV_RVTYPE
;             returns only the variable NAME or heap index.
;
;   HEAP - if set, then read the variable type assuming it is a heap
;          variable (a HEAP_DATA record).
;
;   SYSTEM - if set, then read the variable type assuming it is a
;            system variable (a SYSTEM_VARIABLE record).
;
;   SUFFIX - a scalar string, the suffix to be appended to any
;            structure names to force them to be unique.
;
;   STRUCTURE_NAME - upon return, if the variable is a named
;                    structure, STRUCTURE_NAME will contain the name
;                    of the structure as a string.
;
;   NAMED_CLASSES /
;   NAMED_STRUCTS - upon input, this keyword should contain an
;                   undefined or a string array value.
;
;                   If the variable contains any named structure/class
;                   definitions, CMSV_RVTYPE will append those names
;                   upon return, including any enclosed structures or
;                   superclasses.
;
;   UNIT - a file unit.  If a library routine reads to the end of
;          BLOCK, or if BLOCK is undefined, then this file UNIT will
;          be accessed for more data.  If undefined, then BLOCK must
;          contain the entire file in memory.
;
;   OFFSET - the file offset of byte zero of BLOCK.  Default: 0
;            (OFFSET is not used by this routine at this time)
;
;   STATUS - upon return, this keyword will contain 1 for success and
;            0 for failure.
;
;   ERRMSG - upon return with a failure, this keyword will contain the
;            error condition as a string.
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Added notification about RSI License, 13 May 2002, CM
;   Avoid using reserved word INHERITS, 07 Mar 2006, CM
;   NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsv_rvtype.pro,v 1.13 2009/11/22 22:50:49 craigm Exp $
;
;-
; Copyright (C) 2000-2001, 2002, 2006, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CMSV_TEST
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Test the CMSVLIB library
;
; CALLING SEQUENCE:
;   CMSV_TEST, FILENAME, USER_VALUE=UVALUE
;   
; DESCRIPTION: 
;
;   CMSV_TEST performs a standard test of the CMSVLIB library.  It
;   reads and writes a save file using several different methods in an
;   attempt to test the different ways that the library can be used.
;   The test procedure can be used to verify that the library is
;   functioning properly.
;
;   By default, this procedure provides standard values to be written,
;   but the user can provide one of them with the USER_VALUE keyword.
;   If the user's data contains pointers, they must expect tests
;   listed under CMSVREAD and CMSVWRITE to fail.
;
;   By default the file is written in the current directory, but this
;   can be changed with the FILENAME parameter.
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; INPUTS:
;
;   FILENAME - a scalar string, the output path.  
;              Default: 'CMSVTEST.SAV' in current directory
;
; KEYWORDS:
;
;   USER_VALUE - any IDL variable to be saved, in place of variable
;                "C" in the test.
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Resolve all routines at start, and add VMS keyword, 14 Feb 2001, CM
;   Make version checks with correct precision, 19 Jul 2001, CM
;   Added notification about RSI License, 13 May 2002, CM
;   Changed test so that 'DEADBEEF'XL is not used, which apparently
;     causes problems on 'FL', 01 Aug 2009
;   Add test for strings >127 characters (v1.7), 2012-04-05, CM
;
; $Id: cmsv_test.pro,v 1.11 2012/04/05 20:43:09 cmarkwar Exp $
;
;-
; Copyright (C) 2000-2001, 2009, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; print, '/-------------'
  cmsavedir, filename, status=status, errmsg=errmsg, n_var=nvar, $
    var_names=vnames, types=vtypes, /quiet
; print, '\-------------'
  if status EQ 0 then begin
      print, '  ** Failed to read file.  Error message follows:'
      message, errmsg, /info
  endif else begin
      if nvar NE 5 then $
        message, '  ** Incorrect number of variables'
      if vnames(0) NE 'A' OR vnames(1) NE 'B' OR vnames(2) NE 'C' $
        OR vnames(3) NE 'D' OR vnames(4) NE 'E' then $
        message, '  ** Variable names not correct'
      if total(size(a) NE vtypes(*,0)) NE 0 then $
        message, '  ** Variable "A" type incorrect'
      if total(size(b) NE vtypes(*,1)) NE 0 then $
        message, '  ** Variable "B" type incorrect'
      if total(size(c) NE vtypes(*,2)) NE 0 then $
        message, '  ** Variable "C" type incorrect'
      if total(size(d) NE vtypes(*,3)) NE 0 then $
        message, '  ** Variable "D" type incorrect'
      if total(size(e) NE vtypes(*,4)) NE 0 then $
        message, '  ** Variable "E" type incorrect'
      print, '  ** CMSAVEDIR succeeded'
  endelse

  print, ''
  print, 'Testing CMRESTORE'

  cmsv_test_unset, a, b, c, d, e
  print, '  Using IMPLICIT method...', format='(A,$)'
  cmrestore, filename, status=status, errmsg=errmsg
  if status EQ 0 then begin
      print, 'FAILED'
      message, errmsg, /info
  endif else begin
      cmsv_test_comp, a, b, c, d, e, result, failed
      if result EQ 0 then print, 'FAILED test '+failed $
      else print, 'succeeded'
  endelse

  cmsv_test_unset, a, b, c, d, e
  print, '  Using ARG method...', format='(A,$)'
  cmrestore, filename, a, b, c, d, e, status=status, errmsg=errmsg, $
    /quiet
  if status EQ 0 then begin
      print, 'FAILED'
      message, errmsg, /info
  endif else begin
      cmsv_test_comp, a, b, c, d, e, result, failed
      if result EQ 0 then print, 'FAILED test '+failed $
      else print, 'succeeded'
  endelse

  if ver GE 5D then begin
      cmsv_test_unset, a, b, c, d, e
      print, '  Using POINTER method...', format='(A,$)'
      cmrestore, filename, names=['A','B','C','D','E'], $
        status=status, errmsg=errmsg, data=data, pass_meth='POINTER', /quiet
      if status EQ 0 then begin
          print, 'FAILED'
          message, errmsg, /info
      endif else begin
          cmd = ('cmsv_test_comp, *(data(0)), *(data(1)), *(data(2)), '+ $
                 '*(data(3)), *(data(4)), result, failed')
          dummy = execute(cmd)
          if result EQ 0 OR dummy EQ 0 then print, 'FAILED test '+failed $
          else print, 'succeeded'
      endelse
      if total(ptr_valid(data)) GT 0 then $
        ptr_free, data
      
      cmsv_test_unset, a, b, c, d, e
      print, '  Using POINTER method with reversed names...', format='(A,$)'
      cmrestore, filename, names=['E','D','C','B','A'], $
        status=status, errmsg=errmsg, data=data, pass_meth='POINTER', /quiet
      if status EQ 0 then begin
          print, 'FAILED'
          message, errmsg, /info
      endif else begin
          cmd = ('cmsv_test_comp, *(data(4)), *(data(3)), *(data(2)), '+ $
                 '*(data(1)), *(data(0)), result, failed')
          dummy = execute(cmd)
          if result EQ 0 OR dummy EQ 0 then print, 'FAILED test '+failed $
          else print, 'succeeded'
      endelse
      if total(ptr_valid(data)) GT 0 then $
        ptr_free, data
  endif


  cmsv_test_unset, a, b, c, d, e
  print, '  Using STRUCT method...', format='(A,$)'
  cmrestore, filename, names=['A','B','C','D','E'], $
    status=status, errmsg=errmsg, data=data, pass_meth='STRUCT', /quiet, $
    version=cmrestore_version
  if status EQ 0 then begin
      print, 'FAILED'
      message, errmsg, /info
  endif else begin
      cmsv_test_comp, data.(0), data.(1), data.(2), data.(3), data.(4), $
        result, failed
      if result EQ 0 then print, 'FAILED test '+failed $
      else print, 'succeeded'
      print, '  ... using version '+cmrestore_version
  endelse


  print, ''
  print, 'Testing CMSAVE'
  cmsv_test_set, a, b, c, d, e
  print, '  Using ARG method...', format='(A,$)'
  cmsave, a, b, c, d, e, file=filename, status=status, errmsg=errmsg, $
    /quiet, compat=compat, version=cmsave_version
  if status EQ 0 then begin
      print, 'FAILED'
      message, errmsg, /info
  endif else begin
      restore, filename
      cmsv_test_comp, a, b, c, d, e, result, failed
      if result EQ 0 then print, 'FAILED test '+failed $
      else print, 'succeeded'
      print, '  ... using version '+cmsave_version
  endelse

  if ver GE 5D then begin
      cmsv_test_set, a, b, c, d, e
      print, '  Using POINTER method...', format='(A,$)'
      pheap = [ptr_new(a), ptr_new(b), ptr_new(c), ptr_new(d), ptr_new(e)]
      
      cmsave, file=filename, data=pheap, names=['A','B','C','D','E'], $
        status=status, errmsg=errmsg, /nocatch
      if status EQ 0 then begin
          print, 'FAILED'
          message, errmsg, /info
      endif else begin
          restore, filename
          cmsv_test_comp, a, b, c, d, e, result, failed
          if result EQ 0 then print, 'FAILED test '+failed $
          else print, 'succeeded'
      endelse
      if total(ptr_valid(pheap)) GT 0 then $
        ptr_free, pheap
  endif

  cmsv_test_set, a, b, c, d, e
  print, '  Using UNIT method...', format='(A,$)'
  cmsave, a, b, c, d, e, file=filename, /useunit, $
    status=status, errmsg=errmsg, /quiet, compat=compat
  if status EQ 0 then begin
      print, 'FAILED'
      message, errmsg, /info
  endif else begin
      restore, filename
      cmsv_test_comp, a, b, c, d, e, result, failed
      if result EQ 0 then print, 'FAILED test '+failed $
      else print, 'succeeded'
  endelse

  cmsv_test_set, a, b, c, d, e
  print, '  Using STRUCT method...', format='(A,$)'
  pheap = {a:a, b:b, c:c, d:d, e:e}
  cmsave, file=filename, data=pheap, $
    status=status, errmsg=errmsg, /quiet, compat=compat
  if status EQ 0 then begin
      print, 'FAILED'
      message, errmsg, /info
  endif else begin
      restore, filename
      cmsv_test_comp, a, b, c, d, e, result, failed
      if result EQ 0 then print, 'FAILED test '+failed $
      else print, 'succeeded'
  endelse

  get_lun, unit

  print, ''
  print, 'Testing CMSVREAD'
  cmsv_test_set, a, b, c, d, e
  sz = size(c)
  if sz(sz(0)+1) EQ 10 then $
    print, '  WARNING: data of type POINTER was found; expect failures!!'
  print, '  Saving template file...', format='(A,$)'
  save, a, b, c, d, e, file=filename
  print, 'done'

  openr, unit, filename, error=err
  if err NE 0 then begin
      print, '  ERROR: could not open '+filename
      return
  endif
  
  print, '  Reading file with CMSVREAD...', format='(A,$)'
  cmsvread, unit, a, name='A', /quiet
  cmsvread, unit, b, name='B', /quiet
  cmsvread, unit, c, name='C', /quiet
  cmsvread, unit, d, name='D', /quiet
  cmsvread, unit, e, name='E', /quiet, status=status
  close, unit
  free_lun, unit
  if status NE 1 then print, 'FAILED' $
  else                print, 'done'

  print, '  Checking results...', format='(A,$)'
  cmsv_test_comp, a, b, c, d, e, result, failed
  if result EQ 0 then print, 'FAILED test '+failed $
  else print, 'succeeded'

  print, ''
  print, 'Testing CMSVWRITE'
  openw, unit, filename, error=err, /STREAM   ;; STREAM for VMS
  if err NE 0 then begin
      print, '  ERROR: could not open '+filename
      return
  endif
  print, '  Writing file...', format='(A,$)'
  cmsv_test_set, a, b, c, d, e
  cmsvwrite, unit, a, name='A', /quiet, compat=compat
  cmsvwrite, unit, b, name='B', /quiet, /NO_END  ;; Test this keyword
  cmsvwrite, unit, c, name='C', /quiet, /NO_END
  cmsvwrite, unit, d, name='D', /quiet
  cmsvwrite, unit, e, name='E', /quiet, status=status
  close, unit
  if status NE 1 then print, 'FAILED' $
  else                print, 'done'
  print, '  Checking results...', format='(A,$)'
  cmsv_test_unset, a, b, c, d, e
  restore, filename
  cmsv_test_comp, a, b, c, d, e, result, failed
  if result EQ 0 then print, 'FAILED test '+failed $
  else print, 'succeeded'

end
;+
; NAME:
;   CMSV_WDATA
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Write SAVE-formatted data variable record to output block or file
;
; CALLING SEQUENCE:
;   CMSV_WDATA, BLOCK, POINTER, DATA, UNIT=UNIT, TEMPORARY=TEMPORARY, $
;               PTR_INDEX=PTR_INDEX, PTR_DATA=PTR_DATA, $
;               OFFSET=OFFSET, STATUS=STATUS, ERRMSG=ERRMSG
;   
; DESCRIPTION: 
;
;   CMSV_WDATA writes the data portion of an IDL SAVE variable record.
;   An IDL variable is stored in two components: the type descriptor
;   which describes the name, type, and dimensions of the variable;
;   and the data record, which contains the raw data of the variable.
;   This procedure writes the raw data to the output.  The initial
;   type descriptor portion of the record must have already been
;   writtenusing the CMSV_WVTYPE procedure.
;
;   Under normal circumstances a user will write variable or heap data
;   using the CMSV_WREC procedure.
;
;   CMSV_WDATA supports the following variable types:
;
;     BYTE(1),INT(2),LONG(3) - integer types
;     UINT(12),ULONG(13),LONG64(14),ULONG64(15) - integer types (IDL >5.2 only)
;     FLOAT(4),DOUBLE(5),COMPLEX(6),DCOMPLEX(9) - float types
;     STRING(7) - string type
;     STRUCT(8) - structure type
;     POINTER(10) - pointer type - SEE BELOW
;     NOT SUPPORTED - OBJ(11) - object reference type - NOT SUPPORTED
;
;   Arrays and structures containing any of the supported types are
;   supported (including structures within structures).
;
;   The caller must specify in the DATA parameter, the data to be
;   written to output.  The variable passed as DATA must have the same
;   type and dimensions as passed to CMSV_WVTYPE.
;
;   Unlike most of the other output routines, this procedure is able
;   to send its output to a file rather than to the BLOCK buffer.  If
;   the UNIT keyword is specified then output is sent to that file
;   UNIT, after any pending BLOCK data is first sent.  Users should
;   note that after such operations, the BLOCK POINTER and OFFSET
;   parameters may be modified (ie reset to new values).
;
;   See CMSV_WREC for instructions on how to write heap data.
;
;   [ This code assumes the record header and type descriptor have
;   been written with CMSV_WREC and CMSV_WVTYPE. ]
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
;
; BLOCK, POINTER, OFFSET
;
;   This procedure writes data to a byte array or a file.  If the UNIT
;   keyword is specified then file is sent to the specified unit
;   number rather than to the buffer BLOCK.  However, the intent is
;   for users to accumulate a significant amount of data in a BLOCK
;   and then write it out with a single call to WRITEU.  Users should
;   be aware that the block can be larger than the buffered data, so
;   they should use something like the following:
;
;          WRITEU, UNIT, BLOCK(0:POINTER-1)
;
;   When library routines do indeed write buffered BLOCK data to disk,
;   they will appropriately reset the BLOCK and POINTER.  Namely,
;   BLOCK will be reset to empty, and POINTER will be reset to zero.
;   OFFSET will be advanced the according number of bytes.
;
;   The terminology is as follows: BLOCK is a byte array which
;   represents a portion of, or an entire, IDL SAVE file.  The block
;   may be a cached portion of an on-disk file, or an entire in-memory
;   SAVE file.  POINTER is the current file pointer within BLOCK
;   (i.e., the next byte to be read is BLOCK[POINTER]).  Hence, a
;   POINTER value of 0 refers to the start of the block.  OFFSET is
;   the file offset of the 0th byte of BLOCK; thus "POINT_LUN,
;   OFFSET+POINTER" should point to the same byte as BLOCK[POINTER].
;   The following diagram shows the meanings for BLOCK, POINTER and
;   OFFSET schematically:
;
;
;                 0 <-  OFFSET  -> |
;   FILE          |----------------|------*--------|--------->
;
;   BLOCK                          |------*--------|
;                                  0      ^ POINTER
;     
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.  
;
;
; INPUTS:
;
;   BLOCK - a byte array, a cache of the SAVE file.  Users will
;           usually not access this array directly.  Users are advised
;           to clear BLOCK after calling POINT_LUN or writing the
;           block to disk.
;
;   POINTER - a long integer, a pointer to the next byte to be read
;             from BLOCK.  CMSVLIB routines will automatically
;             advance the pointer.
;
;   DATA - the data to be written, of any save-able data type.
;
; KEYWORDS:
;
;   TEMPORARY - if set, then the input DATA are discarded after being
;               written, as a memory economy provision.
;
;   PTR_INDEX - a heap index array for the data being written, if any
;               heap data records have been written.
;               Default: no pointers are written
;
;   PTR_DATA - an array of pointers, pointing to the heap values being
;              written.
;              Default: no pointers are written
;
;   UNIT - a file unit.  If specified then data are directed to the
;          file unit rather than to the buffer BLOCK.
;
;   OFFSET - the file offset of byte zero of BLOCK.  
;            Upon output, if the file pointer is advanced, OFFSET will
;            also be changed.
;            (OFFSET is not currently used by this routine)
;            Default: 0
;
;   STATUS - upon return, this keyword will contain 1 for success and
;            0 for failure.
;
;   ERRMSG - upon return with a failure, this keyword will contain the
;            error condition as a string.
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Added notification about RSI License, 13 May 2002, CM
;   Added support for byte scalars and arrays (!), 27 Mar 2006, CM
;   Bug fix for multi-dimensional byte array, 2013-04-18, CM
;   NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsv_wdata.pro,v 1.11 2013/04/18 19:14:08 cmarkwar Exp $
;
;-
; Copyright (C) 2000-2001, 2006, 2013, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; ---------------- Convert from host to network order ------------------
pro cmsv_wconv, data

  ;; Inspired by IDL Astronomy Library routine HOST_TO_IEEE
  common cmsv_conv_common, lendian
  if n_elements(lendian) EQ 0 then begin
      ;; Little-endian?
      lendian = (long(['01'xb,'02'xb,'03'xb,'04'xb],0,1))(0) NE '01020304'xl
  endif

  sz = size(data)
  case sz(sz(0)+1) of 
      1:  return                    ;; Byte
      2:  byteorder, data, /HTONS   ;; Integer
      3:  byteorder, data, /HTONL   ;; Long
      4:  byteorder, data, /FTOXDR  ;; Float
      5:  byteorder, data, /DTOXDR  ;; Double
      6:  byteorder, data, /FTOXDR  ;; Complex
      9:  byteorder, data, /DTOXDR  ;; DComplex
      12: byteorder, data, /HTONS   ;; UInt
      13: byteorder, data, /HTONL   ;; ULong
      14: if lendian EQ 1 then byteorder, data, /L64SWAP ;; LONG64
      15: if lendian EQ 1 then byteorder, data, /L64SWAP ;; ULONG64
      ELSE: 
  endcase

end

pro cmsv_wdata, block, pointer, value, unit=unit, temporary=temp, $
                ptr_index=pi, ptr_data=pd, start=start, $
                status=status, errmsg=errmsg

  ;; VAR_DATA
  ;;   LONG - START_DATA TOKEN - value 7
  ;;   for bytes - consecutive bytes
  ;;   for (u)ints - upcast to type long 
  ;;   for (u)longs - consecutive longs
  ;;   for pointers - consecutive longs, indices into saved heap data
  ;;   for strings - consecutive STRING's
  ;;   for structs - compacted versions of above
  forward_function byte, long, ulong, float, double, ptr_new

  data = 0
  if n_elements(start) EQ 0 then start = 1
  if n_elements(pointer) EQ 0 then pointer = 0L

  if keyword_set(start) then begin
      cmsv_wraw, /long, block, pointer, 7L, unit=unit, $
        status=status, errmsg=errmsg
      if status EQ 0 then return
  endif
  sz = size(value)
  tp = sz(sz(0)+1)
  if (tp EQ 11) then begin
      status = 0
      errmsg = 'ERROR: CMSV_WDATA: cannot write object data'
      return
  endif
  nelt = sz(sz(0)+2)

  if (tp EQ 8) then begin   ;; Structure type
      tn = tag_names(value(0)) & nt = n_elements(tn)

      for i = 0L, nelt-1 do begin
          for j = 0L, nt-1 do begin
              cmsv_wdata, block, pointer, value(i).(j), start=0, $
                status=status, errmsg=errmsg
              if status EQ 0 then return
          endfor

          ;; Occasionally flush the data to disk
          if keyword_set(start) AND n_elements(unit) GT 0 then begin
              if (i EQ nelt-1) OR (pointer GT 65536L) then begin
                  writeu, unit(0), block(0:pointer-1)
                  pointer = 0L
                  block = 0 & dummy = temporary(block)
              endif
          endif
      endfor

      return
  endif

  if tp EQ 7 then begin     ;; String type
      cmsv_wraw, /string, block, pointer, value, /replen, $
        status=status, errmsg=errmsg
      if status EQ 0 then return

      if (n_elements(unit) GT 0 AND keyword_set(start) $
          AND pointer GT 0) then begin
          writeu, unit(0), block(0:pointer-1)
          pointer = 0L
          block = 0 & dummy = temporary(block)
      endif
      return
  endif

  ;; Sometimes the input data is stored as a different type
  common cmsv_datatypes, stype, sbyte, nbyte, selts
  if n_elements(stype) EQ 0 then begin
      ;;      0      1       2       3        4        5         6    7   8
      ;;          byte     int    long    float    double   complex str struct
      stype =['','BYTE', 'LONG', 'LONG', 'FLOAT', 'DOUBLE', 'FLOAT', '', '' ]
      sbyte =[0,     1,      4,      4,       4,        8,       4,   0,  0 ]
      selts =[0,     1,      1,      1,       1,        1,       2,   0,  0 ]

      ;;                  9     10   11     12       13        14
      ;;            dcomplex   ptr   obj   uint     ulong    long64   ulong64
      stype =[stype,'DOUBLE', 'LONG', '', 'ULONG', 'ULONG', 'LONG64','ULONG64']
      sbyte =[sbyte,      8,     4,   0,     4,       4,        8,        8, 0]
      selts =[selts,      2,     1,   0,     1,       1,        1,        1, 0]
  endif

  status = 0
  nb = sbyte(tp<16)
  if nb EQ 0 then begin
      errmsg = 'ERROR: CMSV_WDATA: cannot write specified type ('+strtrim(tp,2)+')'
      return
  endif
  nelt1 = nelt*selts(tp<16)     ;; Account for complex type
  nb = nb*nelt1                 ;; Number of total bytes

  if keyword_set(temp) then data = temporary(value) $
  else                      data = value
  if sz(0) GT 0 then data = reform(data, /overwrite)
  
  ;; Convert from pointer type to LONG
  psz = size(pd)
  if (tp EQ 10) then begin
      odata = temporary(data)
      null = ptr_new()
      ;; Initialize as null pointers
      if sz(0) GT 0 then data = lonarr(nelt) else data = 0L

      ;; Fill in the pointers if we know about it
      if (n_elements(pi) GT 0) AND (n_elements(pi) EQ n_elements(pd)) $
        AND (psz(psz(0)+1) EQ 10) then begin
          for i = 0L, nelt-1 do if odata(i) NE null then begin
              wh = where(odata(i) EQ pd, ct)
              if ct GT 0 then begin
                  data(i) = abs(pi(wh(0)))
                  pi(wh(0)) = -pi(wh(0))
              endif
          endif
      endif
      odata = 0
  endif

  ;; Error handler returns zero and error condition
  on_ioerror, WRITE_ERROR
  if 0 then begin
      WRITE_ERROR:
      errmsg = 'ERROR: CMSV_WDATA: a write error occurred'
      return
  end

  ;; Special conversions
  if (tp EQ 1)  then begin
      ;; BYTE data type: make a special header which 
      ;; contains the number of bytes;  also, round 
      ;; the number of storage bytes up to the next
      ;; 4-byte word boundary.
      data1 = long(nelt)
      cmsv_wconv, data1
      data = [byte(data1,0,4),reform(data,nelt,/overwrite)]

      if nb MOD 4 NE 0 then data = [temporary(data), bytarr(4-(nb MOD 4))]
      nb = n_elements(data)
  endif else begin
      if (tp EQ 2)  then data = long(temporary(data))
      if (tp EQ 12) then data = ulong(temporary(data))
      if (tp EQ 6)  then data = float(temporary(data), 0, nelt1)
      if (tp EQ 9)  then data = double(temporary(data), 0, nelt1)
      cmsv_wconv, data
  endelse

  if n_elements(unit) GT 0 then begin
      ;; Write data to file directly
      if n_elements(pointer) GT 0 then begin
          writeu, unit(0), block(0:pointer-1)
          pointer = 0L
          block = 0 & dummy = temporary(block)
      endif
      writeu, unit(0), data
  endif else begin
      ;; Write data to byte buffer

      cmsv_wraw, block, pointer, byte(temporary(data), 0, nb), /byte, $
        status=status, errmsg=errmsg
  endelse

  on_ioerror, NULL

  status = 1
  return
end
;+
; NAME:
;   CMSV_WRAW
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Write raw SAVE data to output block
;
; CALLING SEQUENCE:
;   CMSV_WRAW, BLOCK, POINTER, DATA, UNIT=UNIT, $
;              STRING=STRING, LONG=LONG, BYTE=BYTE, TYPE=TYPE, $
;              OFFSET=OFFSET, STATUS=STATUS, ERRMSG=ERRMSG
;   
; DESCRIPTION: 
;
;   This procedure writes raw integer or string data to an IDL SAVE
;   block in memory.  This is the lowest level writing function in the
;   library, intended for developers who are investigating new and
;   existing SAVE file formats.
;
;   The data to be written is specified by the DATA parameter.  The
;   data must be of type BYTE, LONG or STRING, and the type is
;   determined automatically from the data itself.  [ The mnemonic
;   STRING LONG and BYTE keywords are accepted for programming clarity
;   but ignored. ]
;
;   This procedure accepts but currently ignores the UNIT keyword.  It
;   is the caller's responsibility to write the BLOCK data to disk
;   when appropriate.
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
;
; BLOCK, POINTER, OFFSET
;
;   This procedure writes data to a byte array only.  The intent is
;   for users to accumulate a significant amount of data in a BLOCK
;   and then write it out with a single call to WRITEU.  Users should
;   be aware that the block can be larger than the buffered data, so
;   they should use something like the following:
;
;          WRITEU, UNIT, BLOCK(0:POINTER-1)
;
;   When library routines do indeed write buffered BLOCK data to disk,
;   they will appropriately reset the BLOCK and POINTER.  Namely,
;   BLOCK will be reset to empty, and POINTER will be reset to zero.
;   OFFSET will be advanced the according number of bytes.
;
;   The terminology is as follows: BLOCK is a byte array which
;   represents a portion of, or an entire, IDL SAVE file.  The block
;   may be a cached portion of an on-disk file, or an entire in-memory
;   SAVE file.  POINTER is the current file pointer within BLOCK
;   (i.e., the next byte to be written is BLOCK[POINTER]).  Hence, a
;   POINTER value of 0 refers to the start of the block.  OFFSET is
;   the file offset of the 0th byte of BLOCK; thus "POINT_LUN,
;   OFFSET+POINTER" should point to the same byte as BLOCK[POINTER].
;   The following diagram shows the meanings for BLOCK, POINTER and
;   OFFSET schematically:
;
;
;                 0 <-  OFFSET  -> |
;   FILE          |----------------|------*--------|--------->
;
;   BLOCK                          |------*--------|
;                                  0      ^ POINTER
;     
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.  
;
;
; INPUTS:
;
;   BLOCK - a byte array, a cache of the SAVE file.  Users will
;           usually not access this array directly.  Users are advised
;           to clear BLOCK after calling POINT_LUN or writing the
;           block to disk.
;
;   POINTER - a long integer, a pointer to the next byte to be written
;             from BLOCK.  CMSVLIB routines will automatically advance
;             the pointer.
;
;   DATA - the data to be written.  Must of type STRING, BYTE or LONG.
;
;
; KEYWORDS:
;
;   LONG - ignored (to be used for clarity)
;   BYTE - ignored (to be used for clarity)
;   STRING - ignored (to be used for clarity)
;
;   UNIT - a file unit.  Currently ignored.
;
;   OFFSET - the file offset of byte zero of BLOCK.  
;            Upon output, if the file pointer is advanced, OFFSET will
;            also be changed.
;            (OFFSET is not currently used by this routine)
;            Default: 0
;
;   STATUS - upon return, this keyword will contain 1 for success and
;            0 for failure.
;
;   ERRMSG - upon return with a failure, this keyword will contain the
;            error condition as a string.
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Added notification about RSI License, 13 May 2002, CM
;   Fixed bug in writing of empty strings, 28 Mar 2006, CM
;   Fixed bug when writing strings >128 characters, 2012-04-05, CM
;   NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsv_wraw.pro,v 1.9 2012/04/05 20:43:09 cmarkwar Exp $
;
;-
; Copyright (C) 2000-2001, 2006, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;     1: dummy = 1                                    ; byte
;     2: byteorder, value, /HTONS                     ; int 
      4: byteorder, value, /HTONL                     ; long
;     8: if lendian then byteorder, value, /L64SWAP   ; long64
      else:
  endcase

  block(pointer) = byte(temporary(value), 0, ntotbytes)

  pointer = pointer + ntotbytes
  status = 1
  return
end
;+
; NAME:
;   CMSV_WREC
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Write SAVE-formatted record header to output block or file
;
; CALLING SEQUENCE:
;   CMSV_WDATA, BLOCK, POINTER, DATA, IDENT, UNIT=UNIT, $
;               INITIALIZE=INITIALIZE, NO_DATA=NO_DATA, $
;               NO_TYPE=NO_TYPE, COMPATIBILITY=COMPAT, $
;               BLOCK_TYPE=BLOCK_TYPE, BLOCK_NAME=BLOCK_NAME,
;               NEXT_BLOCK=NEXT_BLOCK, $
;               [ ... EXTRA KEYWORDS ... ]
;               OFFSET=OFFSET, STATUS=STATUS, ERRMSG=ERRMSG
;   
; DESCRIPTION: 
;
;   This procedure writes most types of IDL SAVE record, including the
;   header and contents.  The header consists of four bytes at the
;   beginning of each record which indentifies the type and size of
;   the record.  This procedure also writes the contents of certain
;   records, as noted below.
;
;   Users can specify the block type by passing the BLOCK_TYPE or
;   BLOCK_NAME keywords.  The values listed in the following table are
;   supported.  CMSV_WREC writes the contents of essentially all
;   record types as well.  Some records do not contain any contents at
;   all (those entries marked with an [empty]) and thus require no
;   further processing.
;
;    BLOCK_TYPE      BLOCK_TYPE         WRITE RECORD CONTENTS WITH...
;
;       0         = 'START_MARKER'      [empty]
;       1         = 'COMMON_BLOCK'      [this procedure]
;       2         = 'VARIABLE'          [this procedure]
;       3         = 'SYSTEM_VARIABLE'   [this procedure]
;       6         = 'END_MARKER'        [empty]
;       10        = 'TIMESTAMP'         [this procedure]
;       12        = 'COMPILED'          no published procedure
;       13        = 'IDENTIFICATION'    [this procedure]
;       14        = 'VERSION'           [this procedure]
;       15        = 'HEAP_INDEX'        [this procedure]
;       16        = 'HEAP_DATA'         [this procedure]
;       17        = 'PROMOTE64'         [empty]
;       19        = 'NOTICE'            [this procedure]
;
;   For records that contain variable data, the external procedures
;   CMSV_WVTYPE and/or CMSV_WDATA may be used, however it is not
;   recommended, since the record header must finally be re-written by
;   the user.  Users can write the entire record with this procedure.
;
;   After issuing a POINT_LUN, or after writing the BLOCK to disk, the
;   block cache in BLOCK must be reset using the /INITIALIZE keyword.
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; SPECIFIC RECORD TYPES
;
;   CMSV_WREC reads certain specific record types automatically based
;   on data passed in the DATA parameter.  
;
;   Records of type 'VARIABLE' (2), 'SYSTEM_VARIABLE' (3) and
;   'HEAP_DATA' (16) require both the DATA and IDENT parameters.  For
;   the first two record types, the IDENT parameter is the name of the
;   variable, as a scalar string.  Variable names should be valid IDL
;   variable names, uppercase, and have no embedded spaces.  For the
;   'HEAP_DATA' record type, the IDENT parameter is the heap index
;   value, as described below.  The DATA itself can be any supported
;   IDL variable type (as described in CMSV_WVTYPE).
;
;   For records that accept data in the form of a structure, as listed
;   below, the listed structure tag entries are optional.  If the user
;   does not provide a value, then a suitable default will be computed
;   by this procedure (listed in parentheses).
;
;   A record of type 'VERSION' (14) has the following structure:
;
;         { FORMAT_VERSION: 0L, $   ; Format version number of file (5)
;           ARCH: '', $             ; !VERSION.ARCH of creating host
;           OS: '', $               ; !VERSION.OS of creating host
;           RELEASE: '' }           ; !VERSION.RELEASE of creating host
;
;   A record of type 'TIMESTAMP' (10) has the following structure:
;
;          { SAVE_DATE: '', $  ; Date the save file was created (SYSTIME(0))
;            SAVE_USER: '', $  ; User name who  created file ('UNKNOWN')
;            SAVE_HOST: '' }   ; Host name that created file ('UNKNOWN')
;
;   Save files created by IDL version 4 do not contain a timestamp
;   record.  Under Unix this procedure will attempt to discover the
;   user and host names automatically.
;
;   A record of type 'IDENTIFICATION' (13) has the following
;   structure:
;
;          { AUTHOR: '', $  ; Author of SAVE file ('')
;            TITLE:  '', $  ; Title of SAVE file  ('')
;            IDCODE: '' }   ; Identifying code for SAVE file ('')
;
;   It appears that this record is not used in IDL version 5 or later.
;
;   A record of type 'COMMON_BLOCK' (1) defines a named common block
;   and its variables.  A common block descriptor consists of an array
;   of strings whose first element is the common block name, and whose
;   remaining elements are the common block variable names.  Thus, a
;   common block descriptor must have at least two elements.  No
;   variable data are stored with the common block definition.
;
;   When a record of type 'NOTICE' (19) defines a notice to be
;   included in the save file.  It is a structure with one field:
;   {TEXT: ''}, where TEXT is the text content of the notice.
;
;   A record of type 'HEAP_INDEX' (15) defines the heap index in a
;   SAVE file.  The heap index specifies a list of which heap
;   variables are stored in the current save file.  These indices are
;   simply numbers which identify each heap variable (i.e.,
;   "<PtrHeapVar2>" would have an index of 2).  The heap index can use
;   any numbers to identify the heap data; however it is required that
;   all index entries have corresponding heap data values.
;
; WRITING HEAP DATA
;
;   If your data contains heap data and/or pointers, then users must
;   take special care in writing their data.  Writing heap data is
;   actually more straightforward than reading it.  There are several
;   steps involved which can be summarized as followed: (1) take
;   inventory of HEAP data; (2) write HEAP_INDEX record; (3) write one
;   HEAP_DATA record for each heap variable; and (4) write any other
;   variables using the heap index.
;
;   (1) Take inventory of heap data.  Before writing any data to the
;       SAVE file, use the CMSV_PTRSUM procedure to discover all
;       pointer variables in the data set, like so:
;
;          cmsv_ptrsum, var, ptrlist
;
;       PTRLIST contains an array of any heap variables pointed to by
;       VAR (including structures or pointed-to variables).  If
;       multiple variables are to be written, then the inventory must
;       contain the union of all heap variables.
;
;   (2) Write a HEAP_INDEX record.  The heap index is an array of long
;       integers which identify the heap variables.  In principle it
;       doesn't matter which integers are used, however there must be
;       a one-to-one correspondence between the entries in the heap
;       index and the heap identifiers used in the next step.  In this
;       example a simple LINDGEN is used:
;
;           index = lindgen(n_elements(ptrlist))
;           cmsv_wrec, block, pointer, index, block_name='HEAP_INDEX', $
;             offset=offset
;
;   (3) Write one HEAP_DATA record for each heap variable.  Issue one
;       CMSV_WREC call for each entry in PTRLIST, as follows for the
;       ith heap variable:
;
;           cmsv_wrec, block, pointer, ptrlist(i), block_name='HEAP_DATA', $
;             ptr_index=index, ptr_data=ptrlist, offset=offset
;
;       Note that the PTR_INDEX and PTR_DATA keywords are required
;       because heap data may itself contain pointers.  The PTR_INDEX
;       and PTR_DATA keywords enable the CMSV_WREC procedure to write
;       appropriate descriptors when it encounters pointers.
;
;   (4) Write remaining data.  For the ith variable, use:
;
;          cmsv_wrec, block, pointer, var(i), name(i), block_name='VARIABLE',$
;             ptr_index=index, ptr_data=ptrlist, offset=offset
;
;       As above, using the PTR_INDEX and PTR_DATA keywords will allow
;       the CMSV_WREC procedure to write the appropriate data.
;
;
; BLOCK, POINTER, OFFSET
;
;   This procedure writes data to a byte array or a file.  If the UNIT
;   keyword is specified then file is sent to the specified unit
;   number rather than to the buffer BLOCK.  However, the intent is
;   for users to accumulate a significant amount of data in a BLOCK
;   and then write it out with a single call to WRITEU.  Users should
;   be aware that the block can be larger than the buffered data, so
;   they should use something like the following:
;
;          WRITEU, UNIT, BLOCK(0:POINTER-1)
;
;   When library routines do indeed write buffered BLOCK data to disk,
;   they will appropriately reset the BLOCK and POINTER.  Namely,
;   BLOCK will be reset to empty, and POINTER will be reset to zero.
;   OFFSET will be advanced the according number of bytes.
;
;   The terminology is as follows: BLOCK is a byte array which
;   represents a portion of, or an entire, IDL SAVE file.  The block
;   may be a cached portion of an on-disk file, or an entire in-memory
;   SAVE file.  POINTER is the current file pointer within BLOCK
;   (i.e., the next byte to be read is BLOCK[POINTER]).  Hence, a
;   POINTER value of 0 refers to the start of the block.  OFFSET is
;   the file offset of the 0th byte of BLOCK; thus "POINT_LUN,
;   OFFSET+POINTER" should point to the same byte as BLOCK[POINTER].
;   The following diagram shows the meanings for BLOCK, POINTER and
;   OFFSET schematically:
;
;
;                 0 <-  OFFSET  -> |
;   FILE          |----------------|------*--------|--------->
;
;   BLOCK                          |------*--------|
;                                  0      ^ POINTER
;     
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.  
;
;
; INPUTS:
;
;   BLOCK - a byte array, a cache of the SAVE file.  Users will
;           usually not access this array directly.  Users are advised
;           to clear BLOCK after calling POINT_LUN or writing the
;           block to disk.
;
;   POINTER - a long integer, a pointer to the next byte to be read
;             from BLOCK.  CMSVLIB routines will automatically
;             advance the pointer.
;
;   DATA - the record contents to be written, as describe above.
;
;   IDENT - for record types 'VARIABLE' (2) and 'SYSTEM_VARIABLE' (3),
;           the name of the variable as a scalar string.  For record
;           type 'HEAP_DATA' (16), the heap index identifier as a
;           scalar long integer.
;
; KEYWORDS:
;
;   BLOCK_NAME - a scalar string specifying the record type, as
;                described above.  The BLOCK_TYPE keyword takes
;                precedence over BLOCK_NAME.
;
;   BLOCK_TYPE - a scalar integer specifying the record type, as
;                described above.
;
;   NEXT_BLOCK - if specified, the file offset of the next record
;                location.
;                Default: the offset will be computed automatically.
;
;   INITIALIZE - if the keyword is set, then the BLOCK is emptied and
;                the POINTER is reset before any new data is written.
;
;   NO_TYPE - if set, no type descriptor or data are written for
;             variable records.
;
;   NO_DATA - if set, no data are written for variable records.
;
;
;   TEMPORARY - if set, then the input DATA are discarded after being
;               written, as a memory economy provision.
;
;   PTR_INDEX - a heap index array for the data being written, if any
;               heap data records have been written.
;               Default: no pointers are written
;
;   PTR_DATA - an array of pointers, pointing to the heap values being
;              written.
;              Default: no pointers are written
;
;   UNIT - a file unit.  If specified then data are directed to the
;          file unit rather than to the buffer BLOCK.
;
;   OFFSET - the file offset of byte zero of BLOCK.  
;            Upon output, if the file pointer is advanced, OFFSET will
;            also be changed.
;            (OFFSET is not currently used by this routine)
;            Default: 0
;
;   COMPATIBILITY - a string, which describes the format to be used in
;          the output file.  Possible values are:
;
;                  'IDL4' - format of IDL version 4;
;                  'IDL5' - format of IDL versions 5.0-5.3;
;                  'IDL6' - not supported yet, for versions 5.4-above;
;                  'RIVAL1' - same as 'IDL5', plus a directory entry is
;                            written to the file.
;           Note that files written in IDL5 format may still be
;           readable by IDL v.4.
;           Default: 'IDL5'
;
;   STATUS - upon return, this keyword will contain 1 for success and
;            0 for failure.
;
;   ERRMSG - upon return with a failure, this keyword will contain the
;            error condition as a string.
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Added notification about RSI License, 13 May 2002, CM
;   Added NOTICE record type, 09 Jun 2003, CM
;   NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsv_wrec.pro,v 1.10 2009/11/22 22:50:49 craigm Exp $
;
;-
; Copyright (C) 2000-2001, 2003, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; --------------------------- Read Notice --------------------

pro cmsv_wnotice, block, pointer, status=status, errmsg=errmsg, $
                  text=text, _EXTRA=extra

  ;; NOTICE
  ;;   STRING - notice text

  if n_elements(text) EQ 0 then text = ''

  cmsv_wraw, /string, block, pointer, strtrim(text,2), $
    status=status, errmsg=errmsg

  return
end


pro cmsv_wrec, block, pointer, data, name, unit=unit, offset=offset0, $
               initialize=init, finish=finish, no_data=nodata, no_type=notype,$
               block_type=blocktype, block_name=blockname, next_block=np, $
               compatibility=compat, $
               status=status, errmsg=errmsg, _EXTRA=extra

  common cmsave_block_names, block_ntypenames, block_typenames
  if n_elements(block_ntypenames) EQ 0 then begin
      cmsv_rrec, /qblocknames
  endif

  if keyword_set(init) then begin
      pointer = 0L
      block = 0 & dummy = temporary(block)
  endif
  if n_elements(pointer) EQ 0 then pointer = 0L
  
  if n_elements(blocktype) EQ 0 then begin
      wh = where(strupcase(blockname(0)) EQ block_typenames, ct)
      if ct EQ 0 then begin
          errmsg = 'ERROR: CMSV_WREC: block type '+blockname(0)+' is unknown'
          status = 0
          return
      endif
      blocktype = wh(0)
  endif

  ;; Store position of file pointer at beginning of record
  p0 = pointer
  
  rechead = lonarr(4)
  rechead(0) = long(floor(blocktype(0)))
  if n_elements(offset0) EQ 0 then offset = 0L $
  else                             offset = floor(offset0(0))

  ;; Default pointer to next block assumes no data in record
  if n_elements(np) GT 0 then rechead(1) = floor(np(0)) $
  else                        rechead(1) = offset + p0 + 4*4

  cmsv_wraw, /long, block, pointer, rechead, $
    status=status, errmsg=errmsg

  if status EQ 0 OR keyword_set(finish) then return

  p1 = pointer

  blockname = block_typenames(blocktype(0) < block_ntypenames)

  vdata = (blockname EQ 'VARIABLE' OR blockname EQ 'SYSTEM_VARIABLE' OR $
           blockname EQ 'HEAP_DATA')

  if vdata AND keyword_set(notype) then return

  case blockname of
      'COMMON_BLOCK': cmsv_wcomm, block, pointer, data, $
        status=status, errmsg
      'TIMESTAMP': cmsv_wstamp, block, pointer, $
        status=status, errmsg=errmsg, _EXTRA=data
      'VERSION': cmsv_wversion, block, pointer, compatible=compat, $
        status=status, errmsg=errmsg, _EXTRA=data
      'IDENTIFICATION': cmsv_wident, block, pointer, $
        status=status, errmsg=errmsg, _EXTRA=data
      'HEAP_INDEX': cmsv_wheap, block, pointer, data, $
        status=status, errmsg=errmsg
      'VARIABLE': cmsv_wvtype, block, pointer, data, name, $
        status=status, errmsg=errmsg
      'SYSTEM_VARIABLE': cmsv_wvtype, block, pointer, data, name, $
        status=status, errmsg=errmsg, /system
      'HEAP_DATA': cmsv_wvtype, block, pointer, data, name, $
        status=status, errmsg=errmsg, /heap
      ELSE: dummy = 1
  endcase        

  if status EQ 0 then return
  
  ;; If UNIT is specified then we write out the accumulated BLOCK data
  ;; up to this point.  CMSV_WDATA will write out its own data.
  if n_elements(unit) GT 0 AND pointer GT 0 then begin
      offset1 = offset
      unit1 = floor(unit(0))

      writeu, unit1, block(0:pointer-1)

      ;; Reinitialize state
      if n_elements(block) GT 65536L then begin
          ;; Clear the block if it is too large
          block = 0 & dummy = temporary(block)
          if n_elements(block) GT 0 then block(*) = 0
      endif
      offset = offset + pointer
      pointer = 0L
  endif

  ;; Write the variable data if it exists
  if vdata AND NOT keyword_set(nodata) AND n_elements(data) GT 0 then begin
      cmsv_wdata, block, pointer, data, unit=unit, $
        status=status, errmsg=errmsg, _EXTRA=extra
      if status EQ 0 then return
      if n_elements(unit1) GT 0 then $
        point_lun, -unit1, offset
  endif

  ;; Rewrite the record header using the new header.
  if pointer NE p1 AND n_elements(np) EQ 0 then begin
      rechead(1) = offset + pointer

      if n_elements(unit1) GT 0 then begin
          ;; Be careful: we have already written the record header to
          ;; disk, so we need to seek backwards, write the new header,
          ;; and then seek forwards again.
          point_lun, -unit1, offset2
          cmsv_wraw, /long, block1, 0L, rechead, $
            status=status, errmsg=errmsg
          if status EQ 0 then return
          point_lun, unit1, offset1+p0
          writeu, unit1, block1(0:15)
          point_lun, unit1, offset2

      endif else begin
          ;; It's easy if the data has not been written yet
          cmsv_wraw, /long, block, (p0+0), rechead, $
            status=status, errmsg=errmsg
          if status EQ 0 then return
      endelse
  endif

  status = 1
  return
end
;+
; NAME:
;   CMSV_WVTYPE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Write variable type information to output block
;
; CALLING SEQUENCE:
;   CMSV_WVTYPE, BLOCK, DATA, IDENT, $
;                HEAP=HEAP, SYSTEM=SYSTEM, UNIT=UNIT, $
;                OFFSET=OFFSET, STATUS=STATUS, ERRMSG=ERRMSG
;   
; DESCRIPTION: 
;
;   CMSV_WVTYPE writes the type portion of an IDL SAVE variable
;   record.  An IDL variable is stored in two components: the type
;   descriptor which describes the name, type, and dimensions of the
;   variable; and the data record, which contains the raw data of the
;   variable.  This procedure writes the type descriptor based on a
;   variable passed by the user.  Once the type descriptor has been
;   written, the data portion can be written using the CMSV_WDATA
;   procedure.
;
;   CMSV_WVTYPE should recognize and correctly output type descriptors
;   for all currently known IDL data types, except for object
;   references.  Type information is inferred from the DATA parameter
;   passed by the user.  
;
;   Heap data is a special case, since the data itself are stored
;   separately from the pointer in the SAVE file.  Three steps must be
;   satisfied: a HEAP_INDEX record must be written; a valid HEAP_DATA
;   record must be written containing a type descriptor (written with
;   this procedure) and the heap data; and the named pointer itself
;   must be written.
;
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; BLOCK, POINTER, OFFSET
;
;   This procedure writes data to a byte array only.  The intent is
;   for users to accumulate a significant amount of data in a BLOCK
;   and then write it out with a single call to WRITEU.  Users should
;   be aware that the block can be larger than the buffered data, so
;   they should use something like the following:
;
;          WRITEU, UNIT, BLOCK(0:POINTER-1)
;
;   When library routines do indeed write buffered BLOCK data to disk,
;   they will appropriately reset the BLOCK and POINTER.  Namely,
;   BLOCK will be reset to empty, and POINTER will be reset to zero.
;   OFFSET will be advanced the according number of bytes.
;
;   The terminology is as follows: BLOCK is a byte array which
;   represents a portion of, or an entire, IDL SAVE file.  The block
;   may be a cached portion of an on-disk file, or an entire in-memory
;   SAVE file.  POINTER is the current file pointer within BLOCK
;   (i.e., the next byte to be written is BLOCK[POINTER]).  Hence, a
;   POINTER value of 0 refers to the start of the block.  OFFSET is
;   the file offset of the 0th byte of BLOCK; thus "POINT_LUN,
;   OFFSET+POINTER" should point to the same byte as BLOCK[POINTER].
;   The following diagram shows the meanings for BLOCK, POINTER and
;   OFFSET schematically:
;
;
;                 0 <-  OFFSET  -> |
;   FILE          |----------------|------*--------|--------->
;
;   BLOCK                          |------*--------|
;                                  0      ^ POINTER
;     
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.  
;
;
; INPUTS:
;
;   BLOCK - a byte array, a cache of the SAVE file.  Users will
;           usually not access this array directly.  Users are advised
;           to clear BLOCK after calling POINT_LUN or writing the
;           block to disk.
;
;   POINTER - a long integer, a pointer to the next byte to be written
;             from BLOCK.  CMSVLIB routines will automatically advance
;             the pointer.
;
;   DATA - the data to be written, of any save-able data type.
;
;   IDENT - for variables, the name of the variable as a string; for
;           heap data, the heap index as an integer.
;
; KEYWORDS:
;
;   HEAP - if set, the data is treated as heap data, and IDENT must be
;          an integer heap index.
;
;   SYSTEM - if set, the data is assumed to be a system variable.
;
;   UNIT - a file unit.  Currently ignored.
;
;   OFFSET - the file offset of byte zero of BLOCK.  
;            Upon output, if the file pointer is advanced, OFFSET will
;            also be changed.
;            (OFFSET is not currently used by this routine)
;            Default: 0
;
;   STATUS - upon return, this keyword will contain 1 for success and
;            0 for failure.
;
;   ERRMSG - upon return with a failure, this keyword will contain the
;            error condition as a string.
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Added notification about RSI License, 13 May 2002, CM
;   NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsv_wvtype.pro,v 1.14 2009/11/22 22:50:49 craigm Exp $
;
;-
; Copyright (C) 2000-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CMSVLIB
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Initialize the CMSVLIB save library
;
; CALLING SEQUENCE:
;   VALUE = CMSVLIB(/QUERY, VERSION=version)
;   
; DESCRIPTION: 
;
;   This function initializes the CMSVLIB library to read, write and
;   interrogate IDL save files.  Use the QUERY keyword to determine
;   whether the full CMSVLIB library is present.
;
;   The VERSION keyword allows the user to query the version number of
;   the CMSVLIB library.  The library version number will be returned
;   as a string of the form "X.Y" where X is the major version number
;   and Y is the minor version number.  Callers can use this version
;   number to decide whether this particular version of the library is
;   compatible with their usage.
;
;
;   The procedures in the library are:
;
;    High-level
;      CMSAVE - save variables to a save file
;      CMRESTORE - restore variables from a save file
;      CMSAVEDIR - list contents of a save file 
;      CMSVLIB (function) - this file
;
;    Mid-level  
;      CMSV_OPEN - open a save file for reading or writing
;      CMSVREAD - read non-pointer data from file
;      CMSVWRITE - write non-pointer data to file
;
;    Low-level
;      CMSV_RREC - read record from save file
;      CMSV_RVTYPE - read variable type information from file
;      CMSV_RDATA - read variable data from file
;      CMSV_WREC - write record to save file
;      CMSV_WVTYPE - write variable type information to file
;      CMSV_WDATA - write variable data to file
;
;    Utility
;      CMSV_RRAW (function) - read raw integer or string data from file
;      CMSV_WRAW - write raw integer or string data to file
;      CMSV_PTRSUM - create a heap data inventory
;      CMSV_TEST - test the library
;      TAGSIZE (function) - determine the types of all tags in a structure
;      HELPFORM (function) - create HELP-like string describing a variable
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.  
;
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; INPUTS:
;
;   None
;
; KEYWORDS:
;
;   QUERY - if set, determine whether the CMSVLIB library is
;           installed.  Function returns 1 upon success, 0 upon
;           failure.
;
;   VERSION - upon return, the VERSION keyword will be set to a string
;             describing the version number of the CMSVLIB library.
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   CMRESTORE, SAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000
;   Documented, 24 Jan 2001
;   Added notification about RSI License, 13 May 2002, CM
;   Documented the VERSION keyword, 22 Nov 2009, CM
;
; LIBRARY MODIFICATIONS
;   1.0 - initial release
;   1.1 - 2003-06-28 - CMSV_RREC - added NOTICE record type
;   1.2 - 2006-03-07 - CMSV_RVTYPE - avoid reserved word INHERITS
;   1.3 - 2006-03-27 - CMSV_WDATA - add support to write bytes & empty
;         strings
;   1.4 - 2009-11-16 - CMSV_RREC - NEXTREC field is ULONG
;   1.5 - 2009-11-22 - CMSV_RDATA - clarify & speed some code
;   1.6 - 2010-01-11 - CMSV_RREC - read 64-bit files
;   1.7 - 2012-04-05 - CMSV_WRAW - writing strings >128 fixed
;   1.8 - 2013-04-18 - CMSV_WDATA - bug fix multi-dimensional byte array
    version = '1.8'  ;; NOTE: modify this when incrementing version number
;
; $Id: cmsvlib.pro,v 1.8 2013/04/18 19:14:09 cmarkwar Exp $
;
;-
; Copyright (C) 2000-2001, 2009, 2010, 2012, 2013, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CMSVREAD
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Read a single variable from an open SAVE file
;
; CALLING SEQUENCE:
;
;   CMSVREAD, UNIT, DATA [, NAME=NAME, /NO_DATA, VERSION=VERSION,
;                           TIMESTAMP=TIMESTAMP ]
;   
; DESCRIPTION: 
;
;   CMSVREAD reads a single IDL variable from an open IDL SAVE file.
;   The file should already have been opened as a normal file using
;   OPENR.
;
;   CMSVREAD is a simplified version of the CMSVLIB package, and as
;   such is not capable of reading heap data (pointers) or object
;   data.  Strings, structures, and all array types are supported.
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; INPUTS:
;
;   UNIT - the open file unit.
;
;   DATA - a named variable, into which the new data is to be read.
;
; KEYWORDS:
;
;   NAME - upon output, the name of the saved variable is returned in
;          this keyword.  If a failure or end of file condition
;          occurs, name will be undefined upon return.
;
;   STRUCTURE_NAME - if the data to be read is a structure, upon
;                    output, this keyword will contain the name of the
;                    structure.  A value of '' indicates an anonymous
;                    structure.
;
;   SIZE - upon output, the SIZE type of the data is returned in this
;          keyword.
;
;   NO_DATA - if set, no data is read from the file, only the variable
;            name and type.
;
;   TIMESTAMP - after the first call to CMSVREAD on a newly opened
;               file, this keyword will contain the file timestamp
;               structure.
;
;   VERSION - after the first call to CMSVREAD on a newly opened file,
;             this keyword will contain the file version information,
;             if available.
;
;   QUIET - if set, error messages are not printed.
;           Default: an error causes errors to be printed with MESSAGE
;
;   STATUS - upon return, this keyword will contain 1 for success and
;            0 for failure.
;
;   ERRMSG - upon return with a failure, this keyword will contain the
;            error condition as a string.
;
; EXAMPLE:
;
;   Read all variables from a file, and print help on them.
;
;   openr, 50, 'test.sav'
;   name = ''
;   while n_elements(name) GT 0 do begin   ;; EOF signalled by NAME undefined
;      cmsvread, 50, data, name=name
;      help, name, data
;   end
;   close, 50
;
; SEE ALSO:
;
;   CMSVWRITE, CMRESTORE, CMSAVE, RESTORE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written and documented, 11 Jan 2001, CM
;   Added notification about RSI License, 13 May 2002, CM
;   Remove support for undocumented AUTOPROMOTE64 keyword, 
;      11 Jan 2010, CM
;   NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsvread.pro,v 1.9 2010/01/11 08:58:13 craigm Exp $
;
;-
; Copyright (C) 2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CMSVWRITE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Write a single variable to an open SAVE file
;
; CALLING SEQUENCE:
;
;   CMSVWRITE, UNIT, DATA [ , NAME=NAME, COMPATIBILITY=COMPAT ]
;   
; DESCRIPTION: 
;
;   CMSVWRITE writes a single IDL variable to an open IDL SAVE file.
;   The file should already have been opened for writing as a normal
;   file using OPENW or OPENU.
;
;   CMSVWRITE is a simplified version of the CMSVLIB package, and as
;   such is not capable of writing heap data (pointers) or object
;   data, or structures that contain them.  Strings, structures, and
;   all array types are supported.
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
; ==================================================================
;   Research Systems, Inc. has issued a separate license intended
;   to resolve any potential conflict between this software and the
;   IDL End User License Agreement. The text of that license
;   can be found in the file LICENSE.RSI, included with this
;   software library.
; ==================================================================
;
; INPUTS:
;
;   UNIT - the open file unit.
;
;   DATA - the data to be written.
;
; KEYWORDS:
;
;   NAME - the optional name of the variable to be written (must be a
;          valid variable name).
;          Default: CMSVWRITE automatically creates a valid name.
;  
;   COMPATIBILITY - a string, which describes the format to be used in
;          the output file.  Possible values are:
;
;                  'IDL4' - format of IDL version 4;
;                  'IDL5' - format of IDL versions 5.0-5.3;
;                  'IDL6' - not supported yet, for versions 5.4-above;
;                  'RIVAL1' - same as 'IDL5'
;           Note that files written in IDL5 format may still be
;           readable by IDL v.4.
;           Default: 'IDL5'
;
;   NO_END - a save file must terminate with an "end" record.  By
;            default, CMSVWRITE will append such a record after the
;            variable is written, and then rewind the file pointer.
;            The end record must be written after the last variable,
;            but is optional otherwise.  Set this keyword to disable
;            writing the end record (for performance reasons).
;
;   QUIET - if set, error messages are not printed.
;           Default: an error causes errors to be printed with MESSAGE
;
;   STATUS - upon return, this keyword will contain 1 for success and
;            0 for failure.
;
;   ERRMSG - upon return with a failure, this keyword will contain the
;            error condition as a string.
;
; EXAMPLE:
;
;   Write variables A, B, C and D to a file.
;
;   openw, 50, 'test.sav'       ;; Add /STREAM under VMS !
;   cmsvwrite, 50, a, name='a'
;   cmsvwrite, 50, b, name='b'
;   cmsvwrite, 50, c, name='c'
;   close, 50
;
; SEE ALSO:
;
;   CMSVREAD, CMRESTORE, CMSAVE, SAVE, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written and documented, 11 Jan 2001, CM
;   Make version checks with correct precision, 19 Jul 2001, CM
;   Added notification about RSI License, 13 May 2002, CM
;   NOTE: remember to modify CMSVLIB.PRO when changing library!
;
; $Id: cmsvwrite.pro,v 1.12 2009/11/22 22:50:49 craigm Exp $
;
;-
; Copyright (C) 2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CMSYSTIME
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Compute seconds since Jan 1, 1970 and (Modified) Julian Days
;
; CALLING SEQUENCE:
;   TIMEVAL1 = CMSYSTIME(TIMEVAL0, ...)
;
; DESCRIPTION: 
;
;   CMSYSTIME serves two functions.  It computes the current time in a
;   fashion similar to the built-in IDL system function SYSTIME().  It
;   also can convert between various time representations and systems,
;   including a textual format.
;
;   The current time can be obtained by invoking CMSYSTIME with the
;   /NOW keyword (which is entirely equivalent to SYSTIME(1)).
;
;   The most substantial part of CMSYSTIME, which distinguishes it
;   from SYSTIME, is its ability to convert between different time
;   formats.  CMSYSTIME recognizes can recognize and convert between
;   time in seconds (seconds since Jan 1, 1970 [ = SEC ]) and days
;   (Julian days [ = JDAY ] or "Modified" Julian days [ = MJD = JDAY -
;   2400000.5 ]).  It can also recognize and convert between local and
;   GM time.  
;
;   CMSYSTIME takes maximum care to preserve the full numerical
;   precision of the time values.  It converts all values to double
;   precision and may return days and seconds with fractional parts.
;
;   CMSYSTIME can also represent any time textually, not just the
;   current time.  The following textual formats are supported:
;        DOW MMM DD hh:mm:ss YYYY              - (Default - same as SYSTIME)
;        DOW MMM DD YYYY hh:mm:ss.uuuuuu TTTTT - (/EXTENDED)
;   where DOW and MMM are the abbreviated day of week and month in
;   English, DD is the day of the month, YYYY is the year, hh:mm:ss is
;   the time in 24 hr military time, uuuuuu are additional
;   microseconds, TTTTT is the timezone offset (in +hhmm
;   representation).
;
;   CMSYSTIME accepts one parameter, the input time to be converted.
;   Unlike SYSTIME, the *function* of CMSYSTIME is governed by various
;   keywords, as summarized in the following table:
;
;   Converting from                       Converting to
;   ---------------                       -------------
;   JDAY - /FROM_JULIAN                   JDAY - /JULIAN
;   MJD  - /FROM_MJD                      MJD  - /MJD
;   SEC  - (Default)                      SEC  - /SECONDS
;   Current time - /NOW                   TEXT - (Default or /EXTENDED)
;
;   Local time - /FROM_LOCAL              Local time - /LOCAL
;   GM time - (Default)                   GM time - (Default)
;   
;   If no argument is specified, the default is to report the current
;   time textually in the GM time zone.  CMSYSTIME automatically
;   determines the local time zone.
;
; INPUTS:
;
;   TIMEVAL0 - input time, in seconds or days, as described above.
;              This value is ignored if the NOW keyword is set.  Array
;              values are allowed.
;
; KEYWORDS:
;
;   NOW - If set, TIMEVAL0 is ignored and the current time is used as
;         input.
;
;   FROM_JULIAN - If set, TIMEVAL0 is in Julian days.
;   FROM_MJD    - If set, TIMEVAL0 is in Modified Julian days (MJD).
;   FROM_LOCAL  - If set, TIMEVAL0 is in the local time zone.
;                 If no FROM_ keywords are set, the input is assumed
;                 to be seconds from Jan 1, 1970.
;
;   JULIAN  - If set, the input is converted to Julian days upon output.
;   MJD     - If set, the input is converted to MJD upon output.
;   SECONDS - If set, the input is converted to seconds from Jan
;             1, 1970 upon output.
;   LOCAL   - If set, the input is converted to the local time zone.
;             If no "destination" keywords are set, the output is
;             converted to textual representation.
;
;   EXTENDED - Convert to a textual representation with additional
;              information, as noted above.
;
;   TIMEZONE - Upon output, the timezone offset is returned in this
;              keyword.  The offset is time difference in seconds
;              between GM time and the local time, such that LOCALTIME
;              = GMTIME + TIMEZONE
;
; RETURNS:
;   The resulting converted time(s), either as a double precision
;   number or a string.
;
; EXAMPLE:
;   
;   The equivalent to SYSTIME(0)
;     IDL> print, systime(0) & print, cmsystime(/now, /local)
;     Wed Jul  5 12:10:46 2000
;     Wed Jul  5 12:10:46 2000
;
;   The equivalent to SYSTIME(1)
;     IDL> print, systime(1) & print, cmsystime(/now,/seconds)
;        9.6277750e+08
;        9.6277750e+08
;
;   Comparison between local and GM time zones (I live in the Eastern
;    US, daylight savings)
;     IDL> print, cmsystime(/now,/extended)
;     Wed Jul  5 2000 16:13:15.659000 -0400
;     IDL> print, cmsystime(/now,/local,/extended)
;     Wed Jul  5 2000 12:13:15.664000 -0400
;    
;   What day of the week was it 200 days ago?  (Note, there are 86400
;    seconds in one day)
;     IDL> today = cmsystime(/now,/seconds)
;     IDL> print, cmsystime(today-86400L*200, /local)
;     Sat Dec 18 12:17:52 1999
;    
;
; SEE ALSO:
;
;   SYSTIME, JULDAY, CALDAT
;
; MODIFICATION HISTORY:
;   Written, CM, 05 Jul 2000
;   Printed time zone is zero when LOCAL=0, CM, 21 Aug 2000
;   Corrected behavior of /MJD (Thanks to Marshall Perrin), 03 Jun
;     2002
;   Corrected local vs. UTC problem caused by fractional UTC seconds,
;     (thanks to J. Wolfe) CM, 28 Dec 2005
;   Corrected problem with Julian day arrays, (thanks to W. Landsman),
;     CM, 29 Dec 2005
;
;  $Id: cmsystime.pro,v 1.5 2005/12/29 18:07:48 craigm Exp $
;
;-
; Copyright (C) 2000,2002,2005, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Comput X MOD M, ensuring positive remainder
function cmsystime_xmod, x, m
  return, (((x MOD m) + m) MOD m)
end

;; Convert from MJD to YR/MO/DAY
pro cmsystime_mjd2ymd, mjd, yr, mo, da
  offset = 2400000.5D
  offset_int = floor(offset)         ;; Integer part of offset
  offset_fra = offset - offset_int   ;; Fractional part of offset
  nn = offset_fra + mjd
  jd_fra = cmsystime_xmod(nn+0.5D, 1D) - 0.5D
  nn = nn + offset_int - jd_fra
  nn = nn + (floor(floor((nn - 4479.5D)/36524.25D) * 0.75D + 0.5D)-37.D)
  
  yr = long(floor(nn/365.25D) - 4712.D)
  dd = floor(cmsystime_xmod(nn-59.25D, 365.25D))
  
  mo = floor(cmsystime_xmod( floor((dd+0.5D)/30.6D) + 2.D, 12.D ) + 1.D)
  da = floor(cmsystime_xmod(dd+0.5D, 30.6D) + 1.D ) + 0.5D + jd_fra
end

function cmsystime, arg0, now=now, extended=extended, $
                    local=local, from_local=from_local, $
                    julian=jul, from_julian=from_julian, $
                    mjd=mjd, from_mjd=from_mjd, $
                    seconds=seconds, timezone=timezone

  common cmsystime_common, cmsystime_timezone, cmsystime_months, $
    cmsystime_dow

  ;; Precompute names of days in week and month
  if n_elements(cmsystime_months) EQ 0 then begin
      cmsystime_months = ['Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', $
                          'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec']
      cmsystime_dow = ['Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat']
  endif

  ;; Starting epoch, expressed in MJD and Julian days
  MJD_1970 = 40587D
  JD_1970  = MJD_1970 + 2400000.5D

  ;; Figure the time zone automatically, the first time around
  if n_elements(cmsystime_timezone) EQ 0 then begin
      ;; The GM time, converted to MDY
      gmtime = systime(1)
      cltime = systime(0)
      gmfrac = gmtime MOD 86400
      gm_mjd = floor(gmtime-gmfrac)/86400D + MJD_1970
      cmsystime_mjd2ymd, gm_mjd, gm_yr, gm_mo, gm_da
      gm_da = round(gm_da)

      ;; The local time
      ltime = strtrim(str_sep(strcompress(cltime),' '),2)
      da = floor(long(ltime(2)))
      ltimes = double(str_sep(ltime(3), ':'))
      lfrac = ltimes(2) + 60D*(ltimes(1) + 60D*ltimes(0))

      ;; The timezone difference...
      tz = lfrac - gmfrac
      ;; ... but we must account for day wrap-around
      if      gm_da EQ da - 1 then tz = tz + 86400 $
      else if gm_da EQ da + 1 then tz = tz - 86400 $
      else if gm_da LT da     then tz = tz - 86400 $  ;; ...and month roll-over
      else if gm_da GT da     then tz = tz + 86400    ;; ...and month roll-over

      ;; Store the new value
      cmsystime_timezone = round(tz/60)*60  ;; Round to nearest minute
  endif
  timezone = cmsystime_timezone

  ;; Compute the timezone offset, depending on which way the
  ;; conversion will go.
  offset = 0D
  if keyword_set(from_local) then offset = offset - timezone
  if keyword_set(local)      then offset = offset + timezone

  ;; Extract the time value either from the clock, or from the user
  ;; parameter
  if keyword_set(now) then begin
      ;; From clock (GMT)
      NOW_TIME:
      arg = systime(1)
      if keyword_set(from_local) then offset = 0D

  endif else begin
      ;; From user parameter
      if n_elements(arg0) EQ 0 then goto, NOW_TIME
      arg = double(arg0)

      if keyword_set(from_mjd) then begin
          ;; Convert from MJD ... avoid loss of numerical precision
          if keyword_set(mjd) then return, arg + offset
          if keyword_set(jul) then return, arg + offset + (JD_1970-MJD_1970)

          ;; Convert to seconds
          arg = (arg - MJD_1970) * 86400D

      endif else if keyword_set(from_julian) then begin
          ;; Convert from JD ... avoid loss of numerical precision if poss.
          if keyword_set(mjd) then return, arg + offset - (JD_1970-MJD_1970)
          if keyword_set(jul) then return, arg + offset

          ;; Convert to seconds
          arg = (arg - JD_1970)  * 86400D

      endif
  endelse

  ;; Add timezone offset
  if offset NE 0 then arg = arg + offset
  if keyword_set(seconds) then return, arg
  if keyword_set(jul)     then return, (arg / 86400D) +  JD_1970
  if keyword_set(mjd)     then return, (arg / 86400D) + MJD_1970

  ;; Convert to MJD, from there to MDY
  mjd = floor(arg/86400D) + MJD_1970
  dsecs = arg-floor(arg/86400D)*86400D
  hr = floor(dsecs / 3600) & dsecs = dsecs - hr*3600
  mi = floor(dsecs / 60)   & dsecs = dsecs - mi*60
  se = dsecs
  cmsystime_mjd2ymd, mjd, yr, mo, da

  ;; Day of week is simple to calculate, assumes 13 May 2000 was a Sunday
  dow = cmsystime_xmod((floor(mjd) - 51678L), 7L)

  ;; Compute the string values, unfortunately on an individual basis
  n = n_elements(yr)
  result = strarr(n)
  if keyword_set(extended) then begin
      for i = 0L, n-1 do begin
          sei = floor(se(i))
          sef = floor((se(i) - sei)*1000000D)
          result(i) = string(cmsystime_dow(dow(i)), cmsystime_months(mo(i)-1),$
                             da(i), yr(i), hr(i), mi(i), sei, sef, $
                             format=('(A3," ",A3," ",I2," ",I4.4," ",' + $
                                     'I2.2,":",I2.2,":",I2.2,".",I6.6)'))
      endfor

      ;; Extended string value includes time zone offset
      if keyword_set(local) then tzz = timezone else tzz = 0L
      tzabs = abs(tzz)
      tzhr = floor(tzabs/3600)
      tzstring = string(tzhr, floor(tzabs - tzhr*3600), $
                        format='(I2.2,I2.2)')
      if tzz LT 0 then tzstring = ' -'+tzstring $
      else             tzstring = ' +'+tzstring
      result = result + tzstring

  endif else begin
      for i = 0L, n-1 do begin
          result(i) = string(cmsystime_dow(dow(i)), cmsystime_months(mo(i)-1),$
                             da(i), hr(i), mi(i), floor(se(i)), yr(i), $
                             format=('(A3," ",A3," ",I2," ",' + $
                                     'I2.2,":",I2.2,":",I2.2," ",I4.4)'))
      endfor
  endelse

  return, result
end

;+
; NAME:
;   CMUNIQUE_ID
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Return a unique ID string
;
; CALLING SEQUENCE:
;   ID = CMUNIQUE_ID([STRINGVAL])
;
; DESCRIPTION: 
;
;   CMUNIQUE_ID returns a "unique" 8 character identifier.
;   Programmers can use this routine to derive unique strings which
;   can be used to write files, etc.
;
;   Identifiers are "unique" in the sense that it is unlikely that two
;   identifiers in a given IDL session will coincide.  Thus the
;   identifier is useful for constructing temporary filenames and
;   other hash values.  User routines are encouraged to append other
;   identifying information to this string, such as a session id, a
;   hostname, or a process id number.
;
;   The identifier is computed from various sources of random
;   information.  Users may supply additional information to be
;   scrambled into the identifier by passing the FODDER parameter.
;   CMUNIQUE_ID will return a different identifier upon each call,
;   with or without the FODDER keyword.  It maintains an internal
;   sequence counter, and and also scrambles in the system time.
;   These practices should ensure that successive identifiers are
;   different from one another.
;
; INPUTS:
;
;   FODDER - Any scalar string value.  These values are used to
;            additionally scramble the identifier.
;
; KEYWORDS:
;
;   NONE
;
; RETURNS:
;   The 8-character identifier string.
;
; EXAMPLE:
;   
;   Print two distinct identifiers.
;     IDL> print, cmunique_id(), ' ', cmunique_id()
;     29C47600 79061C57
;
; SEE ALSO:
;
;   NONE
;
; MODIFICATION HISTORY:
;   Written, CM, 11 Jan 2001
;
; $Id: cmunique_id.pro,v 1.2 2001/01/13 04:08:30 craigm Exp $
;
;-
; Copyright (C) 2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CROSSPN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   A version of CROSSP for efficient vector cross products
;
; CALLING SEQUENCE:
;   C = CROSSPN(A, B)
;
; DESCRIPTION: 
;
;   The function CROSSPN computes the vector cross product (outer
;   product).  The difference between CROSSPN and the IDL library
;   function CROSSP, is that CROSSPN allows more than one cross
;   product to be computed at one time (i.e., it is vectorized).
;
;   Thus, in the expression "C = CROSSPN(A, B)" the vector cross
;   product is computed as C = A x B.  Because CROSSPN is vectorized,
;   any of the following combinations are valid:
;
;       * A is a 3-vector, B is a 3-vector
;            ==> C is the vector cross product C = A x B
;
;       * A is a 3xN array, B is a 3-vector
;            ==> C(*,I) = A(*,I) x B    (each A is crossed with B)
;
;       * A is a 3-vector, B is a 3xN array
;            ==> C(*,I) = A x B(*,I)  (A is crossed with each B)
;
;       * A is a 3xN array, B is a 3xN array
;            ==> C(*,I) = A(*,I) x B(*,I)   (component-by-component)
;
;   If both A and B are arrays then they must have the same
;   dimensions.
;
; INPUTS:
;
;   A - a 3-vector or 3xN array.
;
;   B - a 3-vector or 3xN array.
;
;
; RETURNS:
;
;   The vector cross product A x B, either a 3-vector or a 3xN array
;   depending on A and B.
;
; SEE ALSO:
;
;   CROSSP
;
; MODIFICATION HISTORY:
;   Written, CM, 10 Mar 2002
;   Documented, CM, 22 Mar 2002
;
;  $Id: crosspn.pro,v 1.2 2002/03/22 22:02:02 craigm Exp $
;
;-
; Copyright (C) 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   CUBETERP
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Cubic spline interpolation with known derivatives
;
; MAJOR TOPICS:
;   Interpolation
;
; CALLING SEQUENCE:
;   CUBETERP, XTAB, YTAB, YPTAB, XINT, YINT, YPINT=, YPPINT=, EXTRAP_ORDER=
;
; DESCRIPTION:
;
;   CUBETERP performs cubic spline interpolation of a function.  This
;   routine is different from the many other spline interpolation
;   functions for IDL in that it allows you to choose the slope of the
;   spline at each control point.  I.e. it is not forced to be a
;   "natural" spline.
;
;   The user provides a tabulated set of data, whose (X,Y) positions
;   are (XTAB, YTAB), and whose derivatives are YPTAB.  The user also
;   provides a set of desired "X" abcissae for which interpolants are
;   requested.  The interpolated spline values are returned in YINT.
;   The interpolated curve will smoothly pass through the control
;   points, and have the requested slopes at those points.
;
;   The user may also optionally request the first and second
;   derivatives of the function with the YPINT and YPPINT keywords.
;
; INPUTS:
;
;   XTAB - tabulated X values.  Must be sorted in increasing order.
;
;   YTAB - tabulated Y values.
;
;   YPTAB - tabulated derivatives ( = dY/dX, evaluated at XTAB).
;
;   XINT - X values of desired interpolants.
;
; OUTPUTS:
;
;   YINT - Y values of desired interpolants.
;
; OPTIONAL KEYWORDS:
;
;   YPINT - upon return, the slope (first derivative) at the
;           interpolated positions.
;
;   YPPINT - upon return, the second derivative at the interpolated
;            positions.
;
;   EXTRAP_ORDER - technique used to extrapolate beyond the tabulated
;                  values.  Allowed values:
;                    -1 - extrapolated points are set to NaN (not a number)
;                     0 - constant extrapolation, equal to the value
;                         at the nearest tabulated point
;                     1 - linear extrapolation, based on slope at
;                         nearest tabulated value
;                     2 - quadratic extrapolation, based on slope and
;                         second derivative at nearest tabulated value
;                     3 - cubic extrapolation.
;                  DEFAULT: 2 (quadratic extrapolation)
;
;
; EXAMPLE:
;
;  ;; Set up some fake data
;  xtab = [0D,2,5,10]
;  ytab = [2D,4,-3,-5]
;  yptab = [-1D,0.5,2.3,-4]
;
;  ;; Interpolate to a finer grid
;  xint = dindgen(1001)/100
;  cubeterp, xtab, ytab, yptab, xint, yint
;
;  ;; Plot it
;  plot, xint, yint
;  oplot, xtab, ytab, psym=1, symsize=2
;  for i = 0, n_elements(xtab)-1 do $   ;; Also plot slopes
;    oplot, xtab(i)+[-0.5,0.5], ytab(i)+[-0.5,0.5]*yptab(i)
; 
;
; MODIFICATION HISTORY:
;   Written and documented, CM, July 2003
;   Added EXTRAP_ORDER = -1 option, CM, 15 May 2005
;   Syntax error fix, CM, 07 Mar 2007
;   Clarified documentation a bit, CM, 12 Nov 2007
;   Small documentation changes, CM, 16 Apr 2009
;
;  $Id: cubeterp.pro,v 1.8 2009/05/05 04:59:57 craigm Exp $
;
;-
; Copyright (C) 2003, 2005, 2007, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; Cubic interpolation with known slopes


pro cubeterp, xtab, ytab, yptab, xint, yint, $
              extrap_order=extr0, $
              ypint=ypint, yppint=yppint

  ntab = n_elements(xtab)
  if n_elements(extr0) EQ 0 then extr = 2 else extr = round(extr0(0))

  if n_elements(xtab) EQ 0 OR n_elements(ytab) EQ 0 then begin
      message, 'ERROR: XTAB and YTAB must be passed'
  endif
  if (n_elements(xtab) NE n_elements(ytab) OR $
      n_elements(xtab) NE n_elements(yptab)) then begin
      message, 'ERROR: Number of elements of XTAB, YTAB and YPTAB must agree'
  endif
  if n_elements(xint) EQ 0 then begin
      message, 'ERROR: XINT must be passed'
  endif

  ;; Locate previous tabulated value
  ii = value_locate(xtab, xint)

  ;; Here we make a safety check, in case the desired point(s) is
  ;; above or below the interior of the interpolation range.  In that
  ;; case, we will need to extrapolate, based on the next nearest
  ;; interval.
  iis = ii
  whll = where(ii LT 0, ctll)
  if ctll GT 0 then iis(whll) = iis(whll) + 1
  whgg = where(ii GE (ntab-1), ctgg)
  if ctgg GT 0 then iis(whgg) = iis(whgg) - 1

  ;; Distance from interpolated abcissae to previous tabulated abcissa
  dx = (xint - xtab(iis))
  
  ;; Distance between adjoining tabulated abcissae and ordinates
  xs = xtab(iis+1) - xtab(iis)
  ys = ytab(iis+1) - ytab(iis) 

  ;; Rescale or pull out quantities of interest
  dx = dx/xs               ;; Rescale DX
  y0 = ytab(iis)           ;; No rescaling of Y - start of interval
  y1 = ytab(iis+1)         ;; No rescaling of Y - end of interval
  yp0 = yptab(iis)*xs      ;; Rescale tabulated derivatives - start of interval
  yp1 = yptab(iis+1)*xs    ;; Rescale tabulated derivatives - end of interval

  ;; Compute polynomial coefficients
  a = y0
  b = yp0
  c = 3*ys - 2*yp0 - yp1
  d = yp0 + yp1 - 2*ys

  ;; Extrapolate only quadratically
  if extr EQ 2 then begin
      if ctll GT 0 then begin
          ;; Lower end of extrapolation
          d(whll) = 0
      endif
      if ctgg GT 0 then begin
          ;; Upper end of extrapolation
          dgg = d(whgg)
          a(whgg) = a(whgg) + dgg
          b(whgg) = b(whgg) - 3*dgg
          c(whgg) = c(whgg) + 3*dgg
          d(whgg) = 0
      endif
  endif

  ;; Extrapolate only linearly
  if extr EQ 1 then begin

      if ctll GT 0 then begin
          ;; Lower end of extrapolation
          c(whll) = 0
          d(whll) = 0
      endif
      if ctgg GT 0 then begin
          ;; Upper end of extrapolation
          dgg = d(whgg)
          cgg = c(whgg)
          a(whgg) = a(whgg) - cgg - 2*dgg
          b(whgg) = b(whgg) + 2*cgg + 3*dgg
          c(whgg) = 0
          d(whgg) = 0
      endif
  endif

  if extr EQ 0 then begin
      if ctll GT 0 then begin
          ;; Lower end of extrapolation
          b(whll) = 0
          c(whll) = 0
          d(whll) = 0
      endif
      if ctgg GT 0 then begin
          ;; Upper end of extrapolation
          a(whgg) = a(whgg) + b(whgg) + c(whgg) + d(whgg)
          b(whgg) = 0
          c(whgg) = 0
          d(whgg) = 0
      endif
  endif      

  if extr EQ -1 then begin
      sz = size(y0) & tp = sz(sz(0)+1)
      if sz EQ 4 OR sz EQ 6 then nanv = !values.f_nan $
      else nanv = !values.d_nan

      if ctll GT 0 then begin
          ;; Lower end of extrapolation
          a(whll) = nanv
      endif
      if ctgg GT 0 then begin
          ;; Upper end of extrapolation
          a(whgg) = nanv
      endif
  endif

  yint = a + dx*(b + dx*(c + dx*d))

  ;; Compute derivatives if requested
  if arg_present(ypint) then ypint = (b + dx*(2*c + dx*3*d))/xs
  if arg_present(yppint) then yppint = (2*c + 6*d*dx)/xs^2


  return
end
;+
; NAME:
;   DDEABM
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Integrate Ordinary Differential Equation with Adams-Bashforth-Moulton
;
; MAJOR TOPICS:
;   Numerical Analysis.
;
; CALLING SEQUENCE:
;   DDEABM, FUNCT, T0, F0, TOUT, [ PRIVATE, FUNCTARGS=, STATE= , ]
;     [ /INIT, /INTERMEDIATE, TSTOP=, EPSREL=, EPSABS=, ]
;     [ TGRID=, YGRID=, YPGRID=, NOUTGRID=, NGRID=, NFEV=, ]
;     [ TIMPULSE=, YIMPULSE=, ]
;     [ MAX_STEPSIZE=, /CONTROL, ]
;     [ STATUS=, ERRMSG= ]
;
; DESCRIPTION:
;
;  DDEABM performs integration of a system of one or more ordinary
;  differential equations using a Predictor-Corrector technique.  An
;  adaptive Adams-Bashforth-Moulton method of variable order between
;  one and twelve, adaptive stepsize, and error control, is used to
;  integrate equations of the form:
;
;     DF_DT = FUNCT(T, F)
;
;  T is the independent variable, F is the (possibly vector) function
;  value at T, and DF_DT is the derivative of F with respect to T,
;  evaluated at T.  FUNCT is a user function which returns the
;  derivative of one or more equations.  
;
;  DDEABM is based on the public domain procedure DDEABM.F written by
;  L. F. Shampine and M. K. Gordon, and available in the DEPAC package
;  of solvers within SLATEC library.
;
;  DDEABM is used primarily to solve non-stiff and mildly stiff
;  ordinary differential equations, where evaluation of the user
;  function is expensive, or high precision is demanded (close to the
;  machine precision).  A Runge-Kutta technique may be more
;  appropriate if lower precision is acceptable.  For stiff problems
;  neither Adams-Bashforth-Moulton nor Runge-Kutta techniques are
;  appropriate.  DDEABM has code which detects the stiffness of the
;  problem and reports it.
;
;  The user can operate DDEABM in three different modes:
;
;    * the user requests one output at a specific point (the default),
;      and maintains the integrator state using the STATE keyword;
;
;    * the user requests a grid of points (by passing an array to
;      TOUT), and optionally maintains the integrator state for
;      subsequent integrations using the STATE keyword;
;
;    * the user requests output at the natural adaptive stepsizes
;      using the /INTERMEDIATE keyword.
;
;  When the user requests explicit output points using TOUT, it is
;  likely that the output will be interpolated between two natural
;  stepsize points.
;
;  If the user requests a grid of outputs, and the integration fails
;  before reaching the requested endpoint, then control returns
;  immediately to the user with the appropriate STATUS code.
;
;  The initial conditions are given by F0, when T = T0.  The number of
;  equations is determined by the number of elements in F0.
;  Integration stops when the independent variable T reaches the final
;  value of TOUT.  If the user wants to continue the integration, it
;  can be restarted with a new call to DDEABM, and a new value of
;  TOUT.
;
; USER FUNCTION
;
;  The user function FUNCT must be of the following form:
;
;  FUNCTION FUNCT, T, F, PRIVATE, ...  [ CONTROL=CONTROL ] ...
;     ; ... compute derivatives ...
;     RETURN, DF_DT
;  END
;
;  The function must accept at least two, but optionally three,
;  parameters.  The first, 'T', is the scalar independent variable
;  where the derivatives are to be evaluated.  The second, 'F', is the
;  vector of function values.  The function must return an array of
;  same size as 'F'.  The third positional parameter, 'PRIVATE', is a
;  purely optional PRIVATE parameter.  FUNCT may accept more
;  positional parameters, but DDEABM will not use them.  Any number of
;  keyword parameters can be passed using the FUNCTARGS keyword.
;
;  The user function FUNCT must not modify either the independent
;  variable 'T' or the function values 'F'.
;
; PASSING 'CONTROL' MESSAGES TO THE USER FUNCTION
;
;  DDEABM may pass control information to the user function, other
;  than requests for function evaluation.  DDEABM will only do this if
;  the /CONTROL keyword is set when DDEABM was invoked.
;
;  When control information has been enabled, the user function *must*
;  accept a keyword named CONTROL.  A message may be passed in this
;  keyword.  If the user function is invoked with the CONTROL keyword
;  defined, the user function should not evaluate the function, but
;  rather it must respond to the message and return the appropriate
;  value.
;
;  The CONTROL message will be a structure of the form,
;     { MESSAGE: 'name', ... }
;  where the MESSAGE field indicates a control message.  Additional
;  fields may carry more information, depending on the message.
;
;  The following control messages are implemented:
;    * { MESSAGE: 'INITIALIZE' } - the integrator has been initialized
;      and the user function may also initialize any state variables,
;      load large data tables, etc.
;      RETURN: 0 for success, negative number to indicate failure.
;
;  If the user function does not recognize a message, a value of 0
;  should be returned.
;
;
; RESTARTING THE INTEGRATOR
;
;  When restarting the integrator, the STATE keyword can be used to
;  save some computation time.  Upon return from DDEABM the STATE
;  keyword will contain a structure which describes the state of the
;  integrator at the output point.  The user need merely pass this
;  variable back into the next call to continue integration.  The
;  value of T, and the function value F, must not be adjusted between
;  calls to DDEABM.
;
;  If T or F0 are to be adjusted, then the integrator must be
;  restarted afresh *without* the previous state.  This can be
;  achieved either by reseting STATE to undefined, or by setting the
;  /INIT keyword to DDEABM.
;
; ERROR CONTROL
;
;  Local error control is governed by two keywords, EPSABS and EPSREL.
;  The former governs the absolute error, while the latter governs the
;  relative or fractional error.  The error test at each iteration is:
;
;     ABS(ERROR)   LE   EPSREL*ABS(F) + EPSABS
;  
;  A scalar value indicates the same constraint should be applied to
;  every equation; a vector array indicates constraints should be
;  applied individually to each component.
;
;  Setting EPSABS=0.D0 results in a pure relative error test on that
;  component. Setting EPSREL=0. results in a pure absolute error test
;  on that component.  A mixed test with non-zero EPSREL and EPSABS
;  corresponds roughly to a relative error test when the solution
;  component is much bigger than EPSABS and to an absolute error test
;  when the solution component is smaller than the threshold EPSABS.
;  
;  Proper selection of the absolute error control parameters EPSABS
;  requires you to have some idea of the scale of the solution
;  components.  To acquire this information may mean that you will
;  have to solve the problem more than once. In the absence of scale
;  information, you should ask for some relative accuracy in all the
;  components (by setting EPSREL values non-zero) and perhaps impose
;  extremely small absolute error tolerances to protect against the
;  danger of a solution component becoming zero.
;  
;  The code will not attempt to compute a solution at an accuracy
;  unreasonable for the machine being used.  It will advise you if you
;  ask for too much accuracy and inform you as to the maximum accuracy
;  it believes possible.
;
; HARD LIMIT ON T
;
;  If for some reason there is a hard limit on the independent
;  variable T, then the user should specify TSTOP.  For efficiency
;  DDEABM may try to integrate *beyond* the requested point of
;  termination, TOUT, and then interpolate backwards to obtain the
;  function value at the requested point.  If this is not possible
;  because the function because the equation changes, or if there is a
;  discontinuity, then users should specify a value for TSTOP; the
;  integrator will not go past this point.
;
; DISCONTINUITIES
;
;  If the ODE or solution has discontinuities at known points, these
;  should be passed to DDEABM in order to aid the solution.  The
;  TIMPULSE and YIMPULSE keyword variables allow the user to identify
;  the positions of the discontinuities and their amplitudes.  As T
;  crosses TIMPULSE(i) the solution will change from Y to
;  Y+YIMPULSE(*,i) in a stepwise fashion.  
;
;  Discontinuities in the function to be integrated can also be
;  entered in this way.  Although DDEABM can adapt the integration
;  step size to accomodate changes in the user function, it may be
;  better to identify such discontinuities.  In that case TIMPULSE(i)
;  should still identify the position of discontinuity, and
;  YIMPULSE(*,i) should be 0.
;
;  Currently this functionality is implemented with restarts of the
;  integrator at the crossing points of the discontinuities.
;
;  This technique handles only discontinuities at explicitly known
;  values of T.  If the discontinuity condition is defined in terms of
;  Y  (or Y and T), then the condition is implicit.  DDEABM does not
;  handle that type of condition.
;
;  You may list the TIMPULSE points in the TOUT output grid.  If an
;  impulse point appears once in TOUT, the corresponding function
;  values reported in YGRID and YPGRID will be from *before* crossing
;  the discontinuity.  If the same TIMPULSE point appears *twice* in
;  TOUT, then the first and second values will correspond to before
;  and after crossing the discontinuity, respectively.
;
;
; INPUTS:
;
;  FUNCT - by default, a scalar string containing the name of an IDL
;          function to be integrated.  See above for the formal
;          definition of FUNCT.  (No default).
;
;  T0 - scalar number, upon input the starting value of the
;       independent variable T.  Upon output, the final value of T.
;
;  Y - vector.  Upon input the starting values of the function for T =
;      T0.  Upon output, the final (vector) value of the function.
;
;  TOUT - must be at least a scalar, but optionally a vector,
;         specifies the desired points of output.
;
;         If TOUT is a scalar and INTERMEDIATE is not set, then DDEABM
;         integrates up to TOUT.  A scalar value of the function at
;         TOUT is returned in F.
;
;         If TOUT is a scalar and /INTERMEDIATE is set, then DDEABM
;         computes a grid of function values at the optimal step
;         points of the solution.  The grid of values is returned in
;         TGRID, YGRID, and YPGRID.  The final function value,
;         evaluated at the last point in TOUT, is returned in F.
;
;         If TOUT is a vector, then DDEABM computes a grid of function
;         values at the requested points.  The grid of values is
;         returned in TGRID, YGRID and YPGRID.  The final function
;         value, evaluated at the last point in TOUT, is returned in
;         F.  If integrating forwards (TOUT greater than T0), TOUT
;         must be strictly increasing.  Generally speaking, TOUT
;         output points should not repeat, except for discontinuities
;         as noted above.
;
;         It is possible for TOUT to be less than T0, i.e., to
;         integrate backwards, in which case TOUT must be strictly
;         decreasing instead.
; 
;  PRIVATE - any optional variable to be passed on to the function to
;            be integrated.  For functions, PRIVATE is passed as the
;            second positional parameter.  DDEABM does not examine or
;            alter PRIVATE.
;
; KEYWORD PARAMETERS:
;
;   CONTROL - if set, then control messages will be set to the user
;             function as described above.  If not set, then no
;             control messages will be passed.
;
;   EPSABS - a scalar number, the absolute error tolerance requested
;            in the integral computation.  If less than or equal to
;            zero, then the value is ignored.
;            Default: 0
;
;   EPSREL - a scalar number, the relative (i.e., fractional) error
;            tolerance in the integral computation.  If less than or
;            equal to zero, then the value is ignored.
;            Default: 1e-4 for float, 1d-6 for double
;
;   ERRMSG - upon return, a descriptive error message.
;
;   FUNCTARGS - A structure which contains the parameters to be passed
;               to the user-supplied function specified by FUNCT via
;               the _EXTRA mechanism.  This is the way you can pass
;               additional data to your user-supplied function without
;               using common blocks.  By default, no extra parameters
;               are passed to the user-supplied function.
;
;   INIT - if set, indicates that the integrator is to be restarted
;          afresh.
;
;   INTERMEDIATE - if set, indicates that the integrator is to compute
;                  at the natural step points.
;
;   MAX_STEPSIZE - a positive scalar value, the maximum integration
;                  step size to take per iteration.  The lesser of the
;                  "natural" step size and MAX_STEPSIZE is used.  If
;                  MAX_STEPSIZE is not specified, there is no maximum.
;
;   NFEV - upon output, the scalar number of function evaluations.
;
;   NGRID - if /INTERMEDIATE is set, the requested number of points to
;           compute before returning.  DDEABM uses this value to
;           allocate storage for TGRID, YGRID, and YPGRID.  Note that
;           DDEABM may not actually calculate this many points.  The
;           user must use NOUTGRID upon return to determine how many
;           points are valid.
;           Default: 1
;
;   NOUTGRID - upon output, the number of grid points computed.  This
;              may be smaller than the requested number of grid points
;              (either via NGRID or TOUT) if an error occurs.
;
;   STATE - upon input and return, the integrator state.  Users should
;           not modify this structure.  If the integrator is to be
;           restarted afresh, then the /INIT keyword should be set, in
;           order to clear out the old state information.
;
;   STATUS - upon output, the integer status of the integration.
;
;           1 - A step was successfully taken in the
;               intermediate-output mode.  The code has not yet
;               reached TOUT.
; 
;           2 - The integration to TOUT was successfully completed
;               (T=TOUT) by stepping exactly to TOUT.
; 
;           3 - The integration to TOUT was successfully completed
;               (T=TOUT) by stepping past TOUT.  Y(*) is obtained by
;               interpolation.
; 
;                       *** Task Interrupted ***
;                 Reported by negative values of STATUS
; 
;           -1 - A large amount of work has been expended.  (500 steps
;                attempted)
; 
;           -2 - The error tolerances are too stringent.
; 
;           -3 - The local error test cannot be satisfied because you
;                specified a zero component in EPSABS and the
;                corresponding computed solution component is zero.
;                Thus, a pure relative error test is impossible for
;                this component.
; 
;           -4 - The problem appears to be stiff.
; 
;                       *** Task Terminated ***
; 
;           -33 - The code has encountered trouble from which it
;                 cannot recover.  A error message is printed
;                 explaining the trouble and control is returned to
;                 the calling program. For example, this occurs when
;                 invalid input is detected.
;
;           -16 - The user function returned a non-finite 
;
;   TGRID - upon output, the grid of values of T for which the
;           integration is provided.  Upon return, only values
;           TGRID(0:NOUTGRID-1) are valid.  The remaining values are
;           undefined.
;
;   TIMPULSE - array of values of T where discontinuities occur.  The
;              array should be in ascending order.  TIMPULSE must
;              match YIMPULSE.
;
;   TSTOP - a scalar, specifies a hard limit for T, beyond which the
;           integration must not proceed.
;           Default:  none, i.e., integration is allowed to
;                    "overshoot"
;
;   YGRID - upon output, the grid of function values for which the
;           integration is provided.  Upon return, only values
;           YGRID(*,0:NOUTGRID-1) are valid.  The remaining values are
;           undefined.
;
;   YIMPULSE - array of discontinuity offset values, of the form
;              DBLARR(NEQ,NIMPULSE), where NEQ is the size of Y and
;              NIMPULSE is the size of TIMPULSE.  YIMPULSE(*,I) is the
;              amount to *add* to Y when T crosses TIMPULSE(I) going
;              in the positive direction.
;
;   YPGRID - upon ouptut, the grid of function derivative values at
;            the points where the integration is provided.  Upon
;            return, only values YPGRID(*,0:NOUTGRID-1) are valid.
;            The remaining values are undefined.
;
; EXAMPLES:
;
;  This is a simple example showing how to computes orbits of a
;  satellite around the earth using Newton's law of gravity.  The
;  earth is assumed to be a central point mass, modeled by the
;  NEWTON_G function which follows.  We assume that the satellite is
;  orbiting at a radius of 7000 km.  The state vector F has six
;  elements consisting of the position and velocity of the satellite.
;
;           POSITION    VELOCITY
;     F = [ X, Y, Z,    VX, VY, VZ]
;
;  The function NEWTON_G below computes the derivative of F, that is,
;
;               VELOCITY       ACCELERATION
;     dF_dt = [ VX, VY, VZ,    AX, AY, AZ]
;
;  Where the acceleration vector [AX,AY,AZ] is computed using Newton's
;  laws.
;
;  GM = 3.986005d14 ; [MKS] - gravitational constant for earth
;  
;  a0 = 7000d3       ; [m] - initial radius
;  v0 = sqrt(GM/a0)  ; [m/s] - initial circular velocity
;  ;     POSITION  VELOCITY
;  f0 = [a0,0,0,   0,-v0,0] ; initial state vector
;
;  t0 = 100d ; [s] Initial time value, meaningless in this case
;
;  ; Initial output time grid (10000 seconds)
;  tout = dindgen(10000) + t0
;  
;  ; Integrate equations of motion, starting at T0, and proceeding to
;  ; the maximum time of TOUT.  Here the variable GM is passed using
;  ; the PRIVATE mechanism.
;  f = f0 & t = t0
;  ddeabm, 'newton_g', t, f, tout, GM, $
;    tgrid=tgrid, ygrid=ygrid, ypgrid=ypgrid, noutgrid=noutgrid, $
;    status=status, errmsg=errmsg
;
;  Now YGRID(0:2,*)  contains the 3D position of the satellite
;      YGRID(3:5,*)  contains the 3D velocity of the satellite
;      YPGRID(3:5,*) contains the 3D acceleration of the satellite
;
;  An alternate way to call DDEABM is to use its natural gridpoints
;  rather than requesting explicit gridpoints.  In that case, we need
;  to specify the maximum time value we are expecing with TOUT, and
;  a maximum number of output grid values using NGRID.
;
;  f = f0 & t = t0
;  tout = 10000d ;; Maximum requested time
;  ddeabm, 'newton_g', t, f, tout, GM, $
;    ngrid=3000, noutgrid=noutgrid, $
;    tgrid=tgrid, ygrid=ygrid, ypgrid=ypgrid, noutgrid=noutgrid, $
;    status=status, errmsg=errmsg
;
;  NOUTGRID contains the actual number of grid values returned by 
;  DDEABM.  If NOUTGRID is less than NGRID, then the remaining values
;  are to be ignored.
;
;  TGRID = TGRID(0:NOUTGRID-1)
;  YGRID = YGRID(*,0:NOUTGRID-1)
;  YPGRID = YPGRID(*,0:NOUTGRID-1)
;
;  The user can then plot these values are use them as desired.  The
;  result should be a circular orbit at radius 7000000d meters, with
;  constant speed given by V0.
;
;
;  ; WORK FUNCTION ----
;
;  ; The acceleration of Newtonian gravity by a central body
;  ; of mass M.
;  ;   T - time (not used)
;  ;   f - state vector
;  ;     f(0:2) = position vector
;  ;     f(3:5) = velocity vector
;  ;   GM - central body newtonian constant
; FUNCTION NEWTON_G, t, f, GM
;    r = f(0:2) ; Position vector
;    v = f(3:5) ; Velocity vector
;    rsq = total(r^2,1) ;; central body distance, squared
;    rr = sqrt(rsq)     ;; central body distance
;   
;    ;; Newtonian gravitational acceleration, three components
;    a = - GM/rsq * r/rr
;
;    ;; Assemble final differential vector
;    df_dt = [v, a]
;    return, df_dt
; end
;
;
; REFERENCES:
;
;   SAND79-2374 , DEPAC - Design of a User Oriented Package of ODE
;                         Solvers.
;
;   "Solving Ordinary Differential Equations with ODE, STEP, and INTRP",
;       by L. F. Shampine and M. K. Gordon, SLA-73-1060.
;
;    SLATEC Common Mathematical Library, Version 4.1, July 1993
;    a comprehensive software library containing over
;    1400 general purpose mathematical and statistical routines
;    written in Fortran 77.  (http://www.netlib.org/slatec/)
;
;
; MODIFICATION HISTORY:
;    Fix bug in TSTOP keyword, 09 May 2002, CM
;    Fix behavior of KSTEPS, which caused premature termination, 26
;      May 2002, CM
;    Fix two errors in the DDEABM_DINTP interpolation step, 04 Jul 2002, CM
;    Handle case of IMPULSES more correctly, 25 Sep 2002, CM
;    Handle case when INIT is not set (default to 1); detect
;      non-finite user function values and error out with STATUS code
;      -16; promote integer values to LONG integers; some internal 
;      function renaming, 28 Jun 2003, CM
;    Fixed bug in handling of DOIMPULSE and INTERMEDIATE, 08 Mar 2004, CM
;    Corrected interface error in usage of NGRID.  Now NGRID is
;      actually the number of INTERMEDIATE points to compute (and is
;      input only).  NOUTGRID is a new keyword, which provides the
;      number of output grid points upon return.  08 Mar 2004, CM
;    Early termination is possible for INTERMEDIATE case.  Handle it
;      properly , 08 Mar 2004, CM
;    Fix a bug in the handling of INIT (strangely the internal
;      code keeps two different INIT variables!); this really only 
;      had an effect when continuing a previous integration; handle
;      impulses properly when integrating in the negative direction; 
;      document the TIMPULSE/YIMPULSE keyword parameters; some other
;      small code cleanups;  16 Jul 2008, CM
;    Handle the case when TOUT EQ TIMPULSE, 05 Sep 2008, CM
;    Further work on TOUT EQ TIMPULSE, also allowing reporting of
;      function values on either side of a discontinuity, 07 Sep 2008, CM
;    Add the MAX_STEPSIZE keyword, 01 Oct 2008, CM
;    Make sure new impulse checks work when integrating in reverse
;      direction, 09 Oct 2008, CM
;    New interface requirement: user function must be able to handle 
;      control messages from DDEABM; first one is INITIALIZE,
;      20 Oct 2008, CM
;    Change the control message interface so that it is
;      backward-compatible; the user must now set the /CONTROL keyword
;      to enable control messages; they are passed to the user
;      function via the CONTROL keyword, 08 Nov 2008, CM
;   Update the documentation; the largest change is the inclusion of
;      a new example, 16 Jan 2010, CM
;   Update documentation with correct spelling of Bashforth,
;      2012-12-18, CM
;
;  $Id: ddeabm.pro,v 1.33 2012/12/19 01:16:44 cmarkwar Exp $
;-
; Portions Copyright (C) 2002, 2003, 2004, 2008, 2010, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; *DECK DDEABM
; C***BEGIN PROLOGUE  DDEABM
; C***PURPOSE  Solve an initial value problem in ordinary differential
; C            equations using an Adams-Bashforth method.
; C***LIBRARY   SLATEC (DEPAC)
; C***CATEGORY  I1A1B
; C***TYPE      DOUBLE PRECISION (DEABM-S, DDEABM-D)
; C***KEYWORDS  ADAMS-BASHFORTH METHOD, DEPAC, INITIAL VALUE PROBLEMS,
; C             ODE, ORDINARY DIFFERENTIAL EQUATIONS, PREDICTOR-CORRECTOR
; C***AUTHOR  Shampine, L. F., (SNLA)
; C           Watts, H. A., (SNLA)
; C***DESCRIPTION
; C
; C   This is the Adams code in the package of differential equation
; C   solvers DEPAC, consisting of the codes DDERKF, DDEABM, and DDEBDF.
; C   Design of the package was by L. F. Shampine and H. A. Watts.
; C   It is documented in
; C        SAND79-2374 , DEPAC - Design of a User Oriented Package of ODE
; C                              Solvers.
; C   DDEABM is a driver for a modification of the code ODE written by
; C             L. F. Shampine and M. K. Gordon
; C             Sandia Laboratories
; C             Albuquerque, New Mexico 87185
;
;   $Id: ddeabm.pro,v 1.33 2012/12/19 01:16:44 cmarkwar Exp $
;
; C
; C **********************************************************************
; C * ABSTRACT *
; C ************
; C
; C   Subroutine DDEABM uses the Adams-Bashforth-Moulton
; C   Predictor-Corrector formulas of orders one through twelve to
; C   integrate a system of NEQ first order ordinary differential
; C   equations of the form
; C                         DU/DX = DF(X,U)
; C   when the vector Y(*) of initial values for U(*) at X=T is given.
; C   The subroutine integrates from T to TOUT. It is easy to continue the
; C   integration to get results at additional TOUT.  This is the interval
; C   mode of operation.  It is also easy for the routine to return with
; C   the solution at each intermediate step on the way to TOUT.  This is
; C   the intermediate-output mode of operation.
; C
; C   DDEABM uses subprograms DDEABM_DDES, DDEABM_DSTEPS, DDEABM_DINTP, DHSTRT, DHVNRM,
; C   D1MACH, and the error handling routine XERMSG.  The only machine
; C   dependent parameters to be assigned appear in D1MACH.
; C
; C **********************************************************************
; C * Description of The Arguments To DDEABM (An Overview) *
; C **********************************************************************
; C
; C   The Parameters are
; C
; C      DF -- This is the name of a subroutine which you provide to
; C             define the differential equations.
; C
; C      NEQ -- This is the number of (first order) differential
; C             equations to be integrated.
; C
; C      T -- This is a DOUBLE PRECISION value of the independent
; C           variable.
; C
; C      Y(*) -- This DOUBLE PRECISION array contains the solution
; C              components at T.
; C
; C      TOUT -- This is a DOUBLE PRECISION point at which a solution is
; C              desired.
; C
; C      INFO(*) -- The basic task of the code is to integrate the
; C             differential equations from T to TOUT and return an
; C             answer at TOUT.  INFO(*) is an INTEGER array which is used
; C             to communicate exactly how you want this task to be
; C             carried out.
; C
; C      RTOL, ATOL -- These DOUBLE PRECISION quantities represent
; C                    relative and absolute error tolerances which you
; C                    provide to indicate how accurately you wish the
; C                    solution to be computed.  You may choose them to be
; C                    both scalars or else both vectors.
; C
; C      IDID -- This scalar quantity is an indicator reporting what
; C             the code did.  You must monitor this INTEGER variable to
; C             decide what action to take next.
; C
; C      RWORK(*), LRW -- RWORK(*) is a DOUBLE PRECISION work array of
; C             length LRW which provides the code with needed storage
; C             space.
; C
; C      IWORK(*), LIW -- IWORK(*) is an INTEGER work array of length LIW
; C             which provides the code with needed storage space and an
; C             across call flag.
; C
; C      RPAR, IPAR -- These are DOUBLE PRECISION and INTEGER parameter
; C             arrays which you can use for communication between your
; C             calling program and the DF subroutine.
; C
; C  Quantities which are used as input items are
; C             NEQ, T, Y(*), TOUT, INFO(*),
; C             RTOL, ATOL, RWORK(1), LRW and LIW.
; C
; C  Quantities which may be altered by the code are
; C             T, Y(*), INFO(1), RTOL, ATOL,
; C             IDID, RWORK(*) and IWORK(*).
; C
; C **********************************************************************
; C * INPUT -- What To Do On The First Call To DDEABM *
; C **********************************************************************
; C
; C   The first call of the code is defined to be the start of each new
; C   problem.  Read through the descriptions of all the following items,
; C   provide sufficient storage space for designated arrays, set
; C   appropriate variables for the initialization of the problem, and
; C   give information about how you want the problem to be solved.
; C
; C
; C      DF -- Provide a subroutine of the form
; C                               DF(X,U,UPRIME,PAR,IPAR)
; C             to define the system of first order differential equations
; C             which is to be solved.  For the given values of X and the
; C             vector  U(*)=(U(1),U(2),...,U(NEQ)) , the subroutine must
; C             evaluate the NEQ components of the system of differential
; C             equations  DU/DX=DF(X,U)  and store the derivatives in the
; C             array UPRIME(*), that is,  UPRIME(I) = * DU(I)/DX *  for
; C             equations I=1,...,NEQ.
; C
; C             Subroutine DF must NOT alter X or U(*).  You must declare
; C             the name df in an external statement in your program that
; C             calls DDEABM.  You must dimension U and UPRIME in DF.
; C
; C             RPAR and IPAR are DOUBLE PRECISION and INTEGER parameter
; C             arrays which you can use for communication between your
; C             calling program and subroutine DF. They are not used or
; C             altered by DDEABM.  If you do not need RPAR or IPAR,
; C             ignore these parameters by treating them as dummy
; C             arguments. If you do choose to use them, dimension them in
; C             your calling program and in DF as arrays of appropriate
; C             length.
; C
; C      NEQ -- Set it to the number of differential equations.
; C             (NEQ .GE. 1)
; C
; C      T -- Set it to the initial point of the integration.
; C             You must use a program variable for T because the code
; C             changes its value.
; C
; C      Y(*) -- Set this vector to the initial values of the NEQ solution
; C             components at the initial point.  You must dimension Y at
; C             least NEQ in your calling program.
; C
; C      TOUT -- Set it to the first point at which a solution
; C             is desired.  You can take TOUT = T, in which case the code
; C             will evaluate the derivative of the solution at T and
; C             return. Integration either forward in T  (TOUT .GT. T)  or
; C             backward in T  (TOUT .LT. T)  is permitted.
; C
; C             The code advances the solution from T to TOUT using
; C             step sizes which are automatically selected so as to
; C             achieve the desired accuracy.  If you wish, the code will
; C             return with the solution and its derivative following
; C             each intermediate step (intermediate-output mode) so that
; C             you can monitor them, but you still must provide TOUT in
; C             accord with the basic aim of the code.
; C
; C             The first step taken by the code is a critical one
; C             because it must reflect how fast the solution changes near
; C             the initial point.  The code automatically selects an
; C             initial step size which is practically always suitable for
; C             the problem. By using the fact that the code will not step
; C             past TOUT in the first step, you could, if necessary,
; C             restrict the length of the initial step size.
; C
; C             For some problems it may not be permissible to integrate
; C             past a point TSTOP because a discontinuity occurs there
; C             or the solution or its derivative is not defined beyond
; C             TSTOP.  When you have declared a TSTOP point (see INFO(4)
; C             and RWORK(1)), you have told the code not to integrate
; C             past TSTOP.  In this case any TOUT beyond TSTOP is invalid
; C             input.
; C
; C      INFO(*) -- Use the INFO array to give the code more details about
; C             how you want your problem solved.  This array should be
; C             dimensioned of length 15 to accommodate other members of
; C             DEPAC or possible future extensions, though DDEABM uses
; C             only the first four entries.  You must respond to all of
; C             the following items which are arranged as questions.  The
; C             simplest use of the code corresponds to answering all
; C             questions as YES ,i.e. setting ALL entries of INFO to 0.
; C
; C        INFO(1) -- This parameter enables the code to initialize
; C               itself.  You must set it to indicate the start of every
; C               new problem.
; C
; C            **** Is this the first call for this problem ...
; C                  YES -- set INFO(1) = 0
; C                   NO -- not applicable here.
; C                         See below for continuation calls.  ****
; C
; C        INFO(2) -- How much accuracy you want of your solution
; C               is specified by the error tolerances RTOL and ATOL.
; C               The simplest use is to take them both to be scalars.
; C               To obtain more flexibility, they can both be vectors.
; C               The code must be told your choice.
; C
; C            **** Are both error tolerances RTOL, ATOL scalars ...
; C                  YES -- set INFO(2) = 0
; C                         and input scalars for both RTOL and ATOL
; C                   NO -- set INFO(2) = 1
; C                         and input arrays for both RTOL and ATOL ****
; C
; C        INFO(3) -- The code integrates from T in the direction
; C               of TOUT by steps.  If you wish, it will return the
; C               computed solution and derivative at the next
; C               intermediate step (the intermediate-output mode) or
; C               TOUT, whichever comes first.  This is a good way to
; C               proceed if you want to see the behavior of the solution.
; C               If you must have solutions at a great many specific
; C               TOUT points, this code will compute them efficiently.
; C
; C            **** Do you want the solution only at
; C                 TOUT (and not at the next intermediate step) ...
; C                  YES -- set INFO(3) = 0
; C                   NO -- set INFO(3) = 1 ****
; C
; C        INFO(4) -- To handle solutions at a great many specific
; C               values TOUT efficiently, this code may integrate past
; C               TOUT and interpolate to obtain the result at TOUT.
; C               Sometimes it is not possible to integrate beyond some
; C               point TSTOP because the equation changes there or it is
; C               not defined past TSTOP.  Then you must tell the code
; C               not to go past.
; C
; C            **** Can the integration be carried out without any
; C                 Restrictions on the independent variable T ...
; C                  YES -- set INFO(4)=0
; C                   NO -- set INFO(4)=1
; C                         and define the stopping point TSTOP by
; C                         setting RWORK(1)=TSTOP ****
; C
; C      RTOL, ATOL -- You must assign relative (RTOL) and absolute (ATOL)
; C             error tolerances to tell the code how accurately you want
; C             the solution to be computed.  They must be defined as
; C             program variables because the code may change them.  You
; C             have two choices --
; C                  Both RTOL and ATOL are scalars. (INFO(2)=0)
; C                  Both RTOL and ATOL are vectors. (INFO(2)=1)
; C             In either case all components must be non-negative.
; C
; C             The tolerances are used by the code in a local error test
; C             at each step which requires roughly that
; C                     ABS(LOCAL ERROR) .LE. RTOL*ABS(Y)+ATOL
; C             for each vector component.
; C             (More specifically, a Euclidean norm is used to measure
; C             the size of vectors, and the error test uses the magnitude
; C             of the solution at the beginning of the step.)
; C
; C             The true (global) error is the difference between the true
; C             solution of the initial value problem and the computed
; C             approximation.  Practically all present day codes,
; C             including this one, control the local error at each step
; C             and do not even attempt to control the global error
; C             directly.  Roughly speaking, they produce a solution Y(T)
; C             which satisfies the differential equations with a
; C             residual R(T),    DY(T)/DT = DF(T,Y(T)) + R(T)   ,
; C             and, almost always, R(T) is bounded by the error
; C             tolerances.  Usually, but not always, the true accuracy of
; C             the computed Y is comparable to the error tolerances. This
; C             code will usually, but not always, deliver a more accurate
; C             solution if you reduce the tolerances and integrate again.
; C             By comparing two such solutions you can get a fairly
; C             reliable idea of the true error in the solution at the
; C             bigger tolerances.
; C
; C             Setting ATOL=0.D0 results in a pure relative error test on
; C             that component. Setting RTOL=0. results in a pure absolute
; C             error test on that component.  A mixed test with non-zero
; C             RTOL and ATOL corresponds roughly to a relative error
; C             test when the solution component is much bigger than ATOL
; C             and to an absolute error test when the solution component
; C             is smaller than the threshold ATOL.
; C
; C             Proper selection of the absolute error control parameters
; C             ATOL  requires you to have some idea of the scale of the
; C             solution components.  To acquire this information may mean
; C             that you will have to solve the problem more than once. In
; C             the absence of scale information, you should ask for some
; C             relative accuracy in all the components (by setting  RTOL
; C             values non-zero) and perhaps impose extremely small
; C             absolute error tolerances to protect against the danger of
; C             a solution component becoming zero.
; C
; C             The code will not attempt to compute a solution at an
; C             accuracy unreasonable for the machine being used.  It will
; C             advise you if you ask for too much accuracy and inform
; C             you as to the maximum accuracy it believes possible.
; C
; C      RWORK(*) -- Dimension this DOUBLE PRECISION work array of length
; C             LRW in your calling program.
; C
; C      RWORK(1) -- If you have set INFO(4)=0, you can ignore this
; C             optional input parameter.  Otherwise you must define a
; C             stopping point TSTOP by setting   RWORK(1) = TSTOP.
; C             (for some problems it may not be permissible to integrate
; C             past a point TSTOP because a discontinuity occurs there
; C             or the solution or its derivative is not defined beyond
; C             TSTOP.)
; C
; C      LRW -- Set it to the declared length of the RWORK array.
; C             You must have  LRW .GE. 130+21*NEQ
; C
; C      IWORK(*) -- Dimension this INTEGER work array of length LIW in
; C             your calling program.
; C
; C      LIW -- Set it to the declared length of the IWORK array.
; C             You must have  LIW .GE. 51
; C
; C      RPAR, IPAR -- These are parameter arrays, of DOUBLE PRECISION and
; C             INTEGER type, respectively.  You can use them for
; C             communication between your program that calls DDEABM and
; C             the  DF subroutine.  They are not used or altered by
; C             DDEABM.  If you do not need RPAR or IPAR, ignore these
; C             parameters by treating them as dummy arguments.  If you do
; C             choose to use them, dimension them in your calling program
; C             and in DF as arrays of appropriate length.
; C
; C **********************************************************************
; C * OUTPUT -- After Any Return From DDEABM *
; C **********************************************************************
; C
; C   The principal aim of the code is to return a computed solution at
; C   TOUT, although it is also possible to obtain intermediate results
; C   along the way.  To find out whether the code achieved its goal
; C   or if the integration process was interrupted before the task was
; C   completed, you must check the IDID parameter.
; C
; C
; C      T -- The solution was successfully advanced to the
; C             output value of T.
; C
; C      Y(*) -- Contains the computed solution approximation at T.
; C             You may also be interested in the approximate derivative
; C             of the solution at T.  It is contained in
; C             RWORK(21),...,RWORK(20+NEQ).
; C
; C      IDID -- Reports what the code did
; C
; C                         *** Task Completed ***
; C                   Reported by positive values of IDID
; C
; C             IDID = 1 -- A step was successfully taken in the
; C                       intermediate-output mode.  The code has not
; C                       yet reached TOUT.
; C
; C             IDID = 2 -- The integration to TOUT was successfully
; C                       completed (T=TOUT) by stepping exactly to TOUT.
; C
; C             IDID = 3 -- The integration to TOUT was successfully
; C                       completed (T=TOUT) by stepping past TOUT.
; C                       Y(*) is obtained by interpolation.
; C
; C                         *** Task Interrupted ***
; C                   Reported by negative values of IDID
; C
; C             IDID = -1 -- A large amount of work has been expended.
; C                       (500 steps attempted)
; C
; C             IDID = -2 -- The error tolerances are too stringent.
; C
; C             IDID = -3 -- The local error test cannot be satisfied
; C                       because you specified a zero component in ATOL
; C                       and the corresponding computed solution
; C                       component is zero.  Thus, a pure relative error
; C                       test is impossible for this component.
; C
; C             IDID = -4 -- The problem appears to be stiff.
; C
; C             IDID = -5,-6,-7,..,-32  -- Not applicable for this code
; C                       but used by other members of DEPAC or possible
; C                       future extensions.
; C
; C                         *** Task Terminated ***
; C                   Reported by the value of IDID=-33
; C
; C             IDID = -33 -- The code has encountered trouble from which
; C                       it cannot recover.  A message is printed
; C                       explaining the trouble and control is returned
; C                       to the calling program. For example, this occurs
; C                       when invalid input is detected.
; C
; C      RTOL, ATOL -- These quantities remain unchanged except when
; C             IDID = -2.  In this case, the error tolerances have been
; C             increased by the code to values which are estimated to be
; C             appropriate for continuing the integration.  However, the
; C             reported solution at T was obtained using the input values
; C             of RTOL and ATOL.
; C
; C      RWORK, IWORK -- Contain information which is usually of no
; C             interest to the user but necessary for subsequent calls.
; C             However, you may find use for
; C
; C             RWORK(11)--which contains the step size H to be
; C                        attempted on the next step.
; C
; C             RWORK(12)--if the tolerances have been increased by the
; C                        code (IDID = -2) , they were multiplied by the
; C                        value in RWORK(12).
; C
; C             RWORK(13)--Which contains the current value of the
; C                        independent variable, i.e. the farthest point
; C                        integration has reached. This will be different
; C                        from T only when interpolation has been
; C                        performed (IDID=3).
; C
; C             RWORK(20+I)--Which contains the approximate derivative
; C                        of the solution component Y(I).  In DDEABM, it
; C                        is obtained by calling subroutine DF to
; C                        evaluate the differential equation using T and
; C                        Y(*) when IDID=1 or 2, and by interpolation
; C                        when IDID=3.
; C
; C **********************************************************************
; C * INPUT -- What To Do To Continue The Integration *
; C *             (calls after the first)             *
; C **********************************************************************
; C
; C        This code is organized so that subsequent calls to continue the
; C        integration involve little (if any) additional effort on your
; C        part. You must monitor the IDID parameter in order to determine
; C        what to do next.
; C
; C        Recalling that the principal task of the code is to integrate
; C        from T to TOUT (the interval mode), usually all you will need
; C        to do is specify a new TOUT upon reaching the current TOUT.
; C
; C        Do not alter any quantity not specifically permitted below,
; C        in particular do not alter NEQ, T, Y(*), RWORK(*), IWORK(*) or
; C        the differential equation in subroutine DF. Any such alteration
; C        constitutes a new problem and must be treated as such, i.e.
; C        you must start afresh.
; C
; C        You cannot change from vector to scalar error control or vice
; C        versa (INFO(2)) but you can change the size of the entries of
; C        RTOL, ATOL.  Increasing a tolerance makes the equation easier
; C        to integrate.  Decreasing a tolerance will make the equation
; C        harder to integrate and should generally be avoided.
; C
; C        You can switch from the intermediate-output mode to the
; C        interval mode (INFO(3)) or vice versa at any time.
; C
; C        If it has been necessary to prevent the integration from going
; C        past a point TSTOP (INFO(4), RWORK(1)), keep in mind that the
; C        code will not integrate to any TOUT beyond the currently
; C        specified TSTOP.  Once TSTOP has been reached you must change
; C        the value of TSTOP or set INFO(4)=0.  You may change INFO(4)
; C        or TSTOP at any time but you must supply the value of TSTOP in
; C        RWORK(1) whenever you set INFO(4)=1.
; C
; C        The parameter INFO(1) is used by the code to indicate the
; C        beginning of a new problem and to indicate whether integration
; C        is to be continued.  You must input the value  INFO(1) = 0
; C        when starting a new problem.  You must input the value
; C        INFO(1) = 1  if you wish to continue after an interrupted task.
; C        Do not set  INFO(1) = 0  on a continuation call unless you
; C        want the code to restart at the current T.
; C
; C                         *** Following A Completed Task ***
; C         If
; C             IDID = 1, call the code again to continue the integration
; C                     another step in the direction of TOUT.
; C
; C             IDID = 2 or 3, define a new TOUT and call the code again.
; C                     TOUT must be different from T. You cannot change
; C                     the direction of integration without restarting.
; C
; C                         *** Following An Interrupted Task ***
; C                     To show the code that you realize the task was
; C                     interrupted and that you want to continue, you
; C                     must take appropriate action and reset INFO(1) = 1
; C         If
; C             IDID = -1, the code has attempted 500 steps.
; C                     If you want to continue, set INFO(1) = 1 and
; C                     call the code again. An additional 500 steps
; C                     will be allowed.
; C
; C             IDID = -2, the error tolerances RTOL, ATOL have been
; C                     increased to values the code estimates appropriate
; C                     for continuing.  You may want to change them
; C                     yourself.  If you are sure you want to continue
; C                     with relaxed error tolerances, set INFO(1)=1 and
; C                     call the code again.
; C
; C             IDID = -3, a solution component is zero and you set the
; C                     corresponding component of ATOL to zero.  If you
; C                     are sure you want to continue, you must first
; C                     alter the error criterion to use positive values
; C                     for those components of ATOL corresponding to zero
; C                     solution components, then set INFO(1)=1 and call
; C                     the code again.
; C
; C             IDID = -4, the problem appears to be stiff.  It is very
; C                     inefficient to solve such problems with DDEABM.
; C                     The code DDEBDF in DEPAC handles this task
; C                     efficiently.  If you are absolutely sure you want
; C                     to continue with DDEABM, set INFO(1)=1 and call
; C                     the code again.
; C
; C             IDID = -5,-6,-7,..,-32  --- cannot occur with this code
; C                     but used by other members of DEPAC or possible
; C                     future extensions.
; C
; C                         *** Following A Terminated Task ***
; C         If
; C             IDID = -33, you cannot continue the solution of this
; C                     problem.  An attempt to do so will result in your
; C                     run being terminated.
; C
; C **********************************************************************
; C *Long Description:
; C
; C **********************************************************************
; C *             DEPAC Package Overview           *
; C **********************************************************************
; C
; C ....   You have a choice of three differential equation solvers from
; C ....   DEPAC. The following brief descriptions are meant to aid you in
; C ....   choosing the most appropriate code for your problem.
; C
; C ....   DDERKF is a fifth order Runge-Kutta code. It is the simplest of
; C ....   the three choices, both algorithmically and in the use of the
; C ....   code. DDERKF is primarily designed to solve non-stiff and
; C ....   mildly stiff differential equations when derivative evaluations
; C ....   are not expensive. It should generally not be used to get high
; C ....   accuracy results nor answers at a great many specific points.
; C ....   Because DDERKF has very low overhead costs, it will usually
; C ....   result in the least expensive integration when solving
; C ....   problems requiring a modest amount of accuracy and having
; C ....   equations that are not costly to evaluate. DDERKF attempts to
; C ....   discover when it is not suitable for the task posed.
; C
; C ....   DDEABM is a variable order (one through twelve) Adams code.
; C ....   Its complexity lies somewhere between that of DDERKF and
; C ....   DDEBDF.  DDEABM is primarily designed to solve non-stiff and
; C ....   mildly stiff differential equations when derivative evaluations
; C ....   are expensive, high accuracy results are needed or answers at
; C ....   many specific points are required. DDEABM attempts to discover
; C ....   when it is not suitable for the task posed.
; C
; C ....   DDEBDF is a variable order (one through five) backward
; C ....   differentiation formula code. it is the most complicated of
; C ....   the three choices. DDEBDF is primarily designed to solve stiff
; C ....   differential equations at crude to moderate tolerances.
; C ....   If the problem is very stiff at all, DDERKF and DDEABM will be
; C ....   quite inefficient compared to DDEBDF. However, DDEBDF will be
; C ....   inefficient compared to DDERKF and DDEABM on non-stiff problems
; C ....   because it uses much more storage, has a much larger overhead,
; C ....   and the low order formulas will not give high accuracies
; C ....   efficiently.
; C
; C ....   The concept of stiffness cannot be described in a few words.
; C ....   If you do not know the problem to be stiff, try either DDERKF
; C ....   or DDEABM. Both of these codes will inform you of stiffness
; C ....   when the cost of solving such problems becomes important.
; C
; C *********************************************************************
; C
; C***REFERENCES  L. F. Shampine and H. A. Watts, DEPAC - design of a user
; C                 oriented package of ODE solvers, Report SAND79-2374,
; C                 Sandia Laboratories, 1979.
; C***ROUTINES CALLED  DDEABM_DDES, XERMSG
; C***REVISION HISTORY  (YYMMDD)
; C   820301  DATE WRITTEN
; C   890531  Changed all specific intrinsics to generic.  (WRB)
; C   890831  Modified array declarations.  (WRB)
; C   891006  Cosmetic changes to prologue.  (WRB)
; C   891024  Changed references from DVNORM to DHVNRM.  (WRB)
; C   891024  REVISION DATE from Version 3.2
; C   891214  Prologue converted to Version 4.0 format.  (BAB)
; C   900510  Convert XERRWV calls to XERMSG calls.  (RWC)
; C   920501  Reformatted the REFERENCES section.  (WRB)
; C***END PROLOGUE  DDEABM
; C
;       INTEGER IALPHA, IBETA, IDELSN, IDID, IFOURU, IG, IHOLD,
;      1      INFO, IP, IPAR, IPHI, IPSI, ISIG, ITOLD, ITSTAR, ITWOU,
;      2      IV, IW, IWORK, IWT, IYP, IYPOUT, IYY, LIW, LRW, NEQ
;       DOUBLE PRECISION ATOL, RPAR, RTOL, RWORK, T, TOUT, Y
;       LOGICAL START,PHASE1,NORND,STIFF,INTOUT
; C
;       DIMENSION Y(*),INFO(15),RTOL(*),ATOL(*),RWORK(*),IWORK(*),
;      1          RPAR(*),IPAR(*)
; C
;       CHARACTER*8 XERN1
;       CHARACTER*16 XERN3
; C
;       EXTERNAL DF
; C
; C     CHECK FOR AN APPARENT INFINITE LOOP
; C

;; -----------  SOI start of IDL code ----------

pro ddeabm_dummy
  common ddeabm_func_common, ddeabm_nfev, ddeabm_funcerror
end

function ddeabm_func0n, func, a, y, private, _extra=fa
  common ddeabm_func_common, nfev, error
  nfev = nfev + 1
  dydx = call_function(func, a, y)
  if min(finite(dydx)) EQ 0 then error = -16
  return, dydx
end

function ddeabm_func1n, func, a, y, private, _extra=fa
  common ddeabm_func_common, nfev, error
  nfev = nfev + 1
  dydx = call_function(func, a, y, private)
  if min(finite(dydx)) EQ 0 then error = -16
  return, dydx
end

function ddeabm_func0e, func, a, y, private, _extra=fa
  common ddeabm_func_common, nfev, error
  nfev = nfev + 1
  dydx = call_function(func, a, y, _extra=fa)
  if min(finite(dydx)) EQ 0 then error = -16
  return, dydx
end

function ddeabm_func1e, func, a, y, private, _extra=fa
  common ddeabm_func_common, nfev, error
  nfev = nfev + 1
  dydx = call_function(func, a, y, private, _extra=fa)
  if min(finite(dydx)) EQ 0 then error = -16
  return, dydx
end

; *DECK DDEABM_DHSTRT
pro ddeabm_dhstrt, DF, NEQ, A, B, Y, YPRIME, ETOL, MORDER, SMALL, $
          BIG, SPY, PV, YP, SF, PRIVATE, FA, H, DFNAME
; C***BEGIN PROLOGUE  DDEABM_DHSTRT
; C***SUBSIDIARY
; C***PURPOSE  Subsidiary to DDEABM, DDEBDF and DDERKF
; C***LIBRARY   SLATEC
; C***TYPE      DOUBLE PRECISION (HSTART-S, DHSTRT-D)
; C***AUTHOR  Watts, H. A., (SNLA)
; C***DESCRIPTION
; C
; C   DDEABM_DHSTRT computes a starting step size to be used in solving initial
; C   value problems in ordinary differential equations.
; C
; C **********************************************************************
; C  ABSTRACT
; C
; C     Subroutine DDEABM_DHSTRT computes a starting step size to be used by an
; C     initial value method in solving ordinary differential equations.
; C     It is based on an estimate of the local Lipschitz constant for the
; C     differential equation   (lower bound on a norm of the Jacobian) ,
; C     a bound on the differential equation  (first derivative) , and
; C     a bound on the partial derivative of the equation with respect to
; C     the independent variable.
; C     (all approximated near the initial point A)
; C
; C     Subroutine DDEABM_DHSTRT uses a function subprogram DHVNRM for computing
; C     a vector norm. The maximum norm is presently utilized though it
; C     can easily be replaced by any other vector norm. It is presumed
; C     that any replacement norm routine would be carefully coded to
; C     prevent unnecessary underflows or overflows from occurring, and
; C     also, would not alter the vector or number of components.
; C
; C **********************************************************************
; C  On input you must provide the following
; C
; C      DF -- This is a subroutine of the form
; C                               DF(X,U,UPRIME,RPAR,IPAR)
; C             which defines the system of first order differential
; C             equations to be solved. For the given values of X and the
; C             vector  U(*)=(U(1),U(2),...,U(NEQ)) , the subroutine must
; C             evaluate the NEQ components of the system of differential
; C             equations  DU/DX=DF(X,U)  and store the derivatives in the
; C             array UPRIME(*), that is,  UPRIME(I) = * DU(I)/DX *  for
; C             equations I=1,...,NEQ.
; C
; C             Subroutine DF must not alter X or U(*). You must declare
; C             the name DF in an external statement in your program that
; C             calls DDEABM_DHSTRT. You must dimension U and UPRIME in DF.
; C
; C             RPAR and IPAR are DOUBLE PRECISION and INTEGER parameter
; C             arrays which you can use for communication between your
; C             program and subroutine DF. They are not used or altered by
; C             DDEABM_DHSTRT. If you do not need RPAR or IPAR, ignore these
; C             parameters by treating them as dummy arguments. If you do
; C             choose to use them, dimension them in your program and in
; C             DF as arrays of appropriate length.
; C
; C      NEQ -- This is the number of (first order) differential equations
; C             to be integrated.
; C
; C      A -- This is the initial point of integration.
; C
; C      B -- This is a value of the independent variable used to define
; C             the direction of integration. A reasonable choice is to
; C             set  B  to the first point at which a solution is desired.
; C             You can also use  B, if necessary, to restrict the length
; C             of the first integration step because the algorithm will
; C             not compute a starting step length which is bigger than
; C             ABS(B-A), unless  B  has been chosen too close to  A.
; C             (it is presumed that DDEABM_DHSTRT has been called with  B
; C             different from  A  on the machine being used. Also see the
; C             discussion about the parameter  SMALL.)
; C
; C      Y(*) -- This is the vector of initial values of the NEQ solution
; C             components at the initial point  A.
; C
; C      YPRIME(*) -- This is the vector of derivatives of the NEQ
; C             solution components at the initial point  A.
; C             (defined by the differential equations in subroutine DF)
; C
; C      ETOL -- This is the vector of error tolerances corresponding to
; C             the NEQ solution components. It is assumed that all
; C             elements are positive. Following the first integration
; C             step, the tolerances are expected to be used by the
; C             integrator in an error test which roughly requires that
; C                        ABS(LOCAL ERROR)  .LE.  ETOL
; C             for each vector component.
; C
; C      MORDER -- This is the order of the formula which will be used by
; C             the initial value method for taking the first integration
; C             step.
; C
; C      SMALL -- This is a small positive machine dependent constant
; C             which is used for protecting against computations with
; C             numbers which are too small relative to the precision of
; C             floating point arithmetic.  SMALL  should be set to
; C             (approximately) the smallest positive DOUBLE PRECISION
; C             number such that  (1.+SMALL) .GT. 1.  on the machine being
; C             used. The quantity  SMALL**(3/8)  is used in computing
; C             increments of variables for approximating derivatives by
; C             differences.  Also the algorithm will not compute a
; C             starting step length which is smaller than
; C             100*SMALL*ABS(A).
; C
; C      BIG -- This is a large positive machine dependent constant which
; C             is used for preventing machine overflows. A reasonable
; C             choice is to set big to (approximately) the square root of
; C             the largest DOUBLE PRECISION number which can be held in
; C             the machine.
; C
; C      SPY(*),PV(*),YP(*),SF(*) -- These are DOUBLE PRECISION work
; C             arrays of length NEQ which provide the routine with needed
; C             storage space.
; C
; C      RPAR,IPAR -- These are parameter arrays, of DOUBLE PRECISION and
; C             INTEGER type, respectively, which can be used for
; C             communication between your program and the DF subroutine.
; C             They are not used or altered by DDEABM_DHSTRT.
; C
; C **********************************************************************
; C  On Output  (after the return from DDEABM_DHSTRT),
; C
; C      H -- is an appropriate starting step size to be attempted by the
; C             differential equation method.
; C
; C           All parameters in the call list remain unchanged except for
; C           the working arrays SPY(*),PV(*),YP(*), and SF(*).
; C
; C **********************************************************************
; C
; C***SEE ALSO  DDEABM, DDEBDF, DDERKF
; C***ROUTINES CALLED  DHVNRM
; C***REVISION HISTORY  (YYMMDD)
; C   820301  DATE WRITTEN
; C   890531  Changed all specific intrinsics to generic.  (WRB)
; C   890831  Modified array declarations.  (WRB)
; C   890911  Removed unnecessary intrinsics.  (WRB)
; C   891024  Changed references from DVNORM to DHVNRM.  (WRB)
; C   891214  Prologue converted to Version 4.0 format.  (BAB)
; C   900328  Added TYPE section.  (WRB)
; C   910722  Updated AUTHOR section.  (ALS)
; C***END PROLOGUE  DDEABM_DHSTRT
; C
;       INTEGER IPAR, J, K, LK, MORDER, NEQ
;       DOUBLE PRECISION A, ABSDX, B, BIG, DA, DELF, DELY,
;      1      DFDUB, DFDXB, DHVNRM,
;      2      DX, DY, ETOL, FBND, H, PV, RELPER, RPAR, SF, SMALL, SPY,
;      3      SRYDPB, TOLEXP, TOLMIN, TOLP, TOLSUM, Y, YDPB, YP, YPRIME
;       DIMENSION Y(*),YPRIME(*),ETOL(*),SPY(*),PV(*),YP(*),
;      1          SF(*),RPAR(*),IPAR(*)
;       EXTERNAL DF
; C
; C     ..................................................................
; C
; C     BEGIN BLOCK PERMITTING ...EXITS TO 160
; C***FIRST EXECUTABLE STATEMENT  DDEABM_DHSTRT
         common ddeabm_func_common
         DX = B - A
         ABSDX = ABS(DX)
         RELPER = SMALL^0.375D0
; C
; C        ...............................................................
; C
; C             COMPUTE AN APPROXIMATE BOUND (DFDXB) ON THE PARTIAL
; C             DERIVATIVE OF THE EQUATION WITH RESPECT TO THE
; C             INDEPENDENT VARIABLE. PROTECT AGAINST AN OVERFLOW.
; C             ALSO COMPUTE A BOUND (FBND) ON THE FIRST DERIVATIVE
; C             LOCALLY.
; C
         DA = MAX([MIN([RELPER*ABS(A),ABSDX]), 100.0D0*SMALL*ABS(A)])
         DA = (DX GE 0)?(+DA):(-DA)
         IF (DA EQ 0.0D0) THEN DA = RELPER*DX

         SF = CALL_FUNCTION(DFNAME, DF, A+DA, Y, PRIVATE, _EXTRA=FA)
         if ddeabm_funcerror NE 0 then return

         YP = SF - YPRIME
         DELF = max(abs(YP))
         DFDXB = BIG
         IF (DELF LT BIG*ABS(DA)) THEN DFDXB = DELF/ABS(DA)
         FBND = max(abs(SF))
; C
; C        ...............................................................
; C
; C             COMPUTE AN ESTIMATE (DFDUB) OF THE LOCAL LIPSCHITZ
; C             CONSTANT FOR THE SYSTEM OF DIFFERENTIAL EQUATIONS. THIS
; C             ALSO REPRESENTS AN ESTIMATE OF THE NORM OF THE JACOBIAN
; C             LOCALLY.  THREE ITERATIONS (TWO WHEN NEQ=1) ARE USED TO
; C             ESTIMATE THE LIPSCHITZ CONSTANT BY NUMERICAL DIFFERENCES.
; C             THE FIRST PERTURBATION VECTOR IS BASED ON THE INITIAL
; C             DERIVATIVES AND DIRECTION OF INTEGRATION. THE SECOND
; C             PERTURBATION VECTOR IS FORMED USING ANOTHER EVALUATION OF
; C             THE DIFFERENTIAL EQUATION.  THE THIRD PERTURBATION VECTOR
; C             IS FORMED USING PERTURBATIONS BASED ONLY ON THE INITIAL
; C             VALUES. COMPONENTS THAT ARE ZERO ARE ALWAYS CHANGED TO
; C             NON-ZERO VALUES (EXCEPT ON THE FIRST ITERATION). WHEN
; C             INFORMATION IS AVAILABLE, CARE IS TAKEN TO ENSURE THAT
; C             COMPONENTS OF THE PERTURBATION VECTOR HAVE SIGNS WHICH ARE
; C             CONSISTENT WITH THE SLOPES OF LOCAL SOLUTION CURVES.
; C             ALSO CHOOSE THE LARGEST BOUND (FBND) FOR THE FIRST
; C             DERIVATIVE.
; C
; C                               PERTURBATION VECTOR SIZE IS HELD
; C                               CONSTANT FOR ALL ITERATIONS. COMPUTE
; C                               THIS CHANGE FROM THE
; C                                       SIZE OF THE VECTOR OF INITIAL
; C                                       VALUES.
         DELY = RELPER*max(abs(y))
         IF (DELY EQ 0.0D0) THEN DELY = RELPER
         DELY = (DX GE 0)?(+DELY):(-DELY)
         DELF = max(abs(YPRIME))
         FBND = MAX([FBND,DELF])
         IF (DELF NE 0.0D0) THEN BEGIN
; C           USE INITIAL DERIVATIVES FOR FIRST PERTURBATION
             SPY = YPRIME
             YP = YPRIME
         ENDIF ELSE BEGIN
; C           CANNOT HAVE A NULL PERTURBATION VECTOR
             SPY(*) = 0
             YP(*) = 1
             DELF = max(abs(yp))
         ENDELSE
; C
         DFDUB = 0.0D0
         LK = MIN([NEQ+1,3])
         FOR K = 1L, LK DO BEGIN

; C           DEFINE PERTURBED VECTOR OF INITIAL VALUES
             PV = Y + DELY*(YP/DELF)
             IF (K NE 2) THEN BEGIN
; C              EVALUATE DERIVATIVES ASSOCIATED WITH PERTURBED
; C              VECTOR  AND  COMPUTE CORRESPONDING DIFFERENCES

                 YP = CALL_FUNCTION(DFNAME, DF, A, PV, PRIVATE, _EXTRA=FA)
                 if ddeabm_funcerror NE 0 then return
                 PV = YP - YPRIME
            ENDIF ELSE BEGIN
; C              USE A SHIFTED VALUE OF THE INDEPENDENT VARIABLE
; C                                    IN COMPUTING ONE ESTIMATE

                YP = CALL_FUNCTION(DFNAME, DF, A+DA, PV, PRIVATE, _EXTRA=FA)
                if ddeabm_funcerror NE 0 then return
                PV = YP - SF
            ENDELSE
; C           CHOOSE LARGEST BOUNDS ON THE FIRST DERIVATIVE
; C                          AND A LOCAL LIPSCHITZ CONSTANT
            FBND = MAX([FBND,max(abs(yp))])
            DELF = max(abs(pv))
; C        ...EXIT
            IF (DELF GE BIG*ABS(DELY)) THEN GOTO, DHSTRT_150
            DFDUB = MAX([DFDUB,DELF/ABS(DELY)])
; C     ......EXIT
            IF (K EQ LK) THEN GOTO, DHSTRT_160
; C           CHOOSE NEXT PERTURBATION VECTOR
            IF (DELF EQ 0.0D0) THEN DELF = 1.0D0
            IF (K NE 2) THEN BEGIN
                DY = ABS(PV)
                wh = where(dy EQ 0, ct)
                if ct GT 0 then dy(wh) = DELF
            endif else begin
                DY = Y
                wh = where(dy EQ 0, ct)
                if ct GT 0 then dy(wh) = DELY/RELPER
            endelse
            wh = where(spy EQ 0, ct)
            if ct GT 0 then spy(wh) = yp(wh)
            wh = where(spy LT 0, ct)
            if ct GT 0 then dy(wh) = -dy(wh)
            yp(*) = dy
            DELF = max(abs(YP))
        ENDFOR
        DHSTRT_150:
; C
; C        PROTECT AGAINST AN OVERFLOW
        DFDUB = BIG
        DHSTRT_160:
; C
; C     ..................................................................
; C
; C          COMPUTE A BOUND (YDPB) ON THE NORM OF THE SECOND DERIVATIVE
; C
      YDPB = DFDXB + DFDUB*FBND
; C
; C     ..................................................................
; C
; C          DEFINE THE TOLERANCE PARAMETER UPON WHICH THE STARTING STEP
; C          SIZE IS TO BE BASED.  A VALUE IN THE MIDDLE OF THE ERROR
; C          TOLERANCE RANGE IS SELECTED.
; C
      TOLEXP = ALOG10(ETOL)
      TOLMIN = MIN(TOLEXP)
      TOLSUM = TOTAL(TOLEXP)
      TOLP = 10.0D0^(0.5D0*(TOLSUM/NEQ + TOLMIN)/(MORDER+1))
; C
; C     ..................................................................
; C
; C          COMPUTE A STARTING STEP SIZE BASED ON THE ABOVE FIRST AND
; C          SECOND DERIVATIVE INFORMATION
; C
; C                            RESTRICT THE STEP LENGTH TO BE NOT BIGGER
; C                            THAN ABS(B-A).   (UNLESS  B  IS TOO CLOSE
; C                            TO  A)
      H = ABSDX
; C
      IF (YDPB EQ 0.0D0 AND FBND EQ 0.0D0) THEN BEGIN
; GO TO 180
; C
; C        BOTH FIRST DERIVATIVE TERM (FBND) AND SECOND
; C                     DERIVATIVE TERM (YDPB) ARE ZERO
         IF (TOLP LT 1.0D0) THEN H = ABSDX*TOLP
     ENDIF ELSE IF (YDPB EQ 0.0D0) THEN BEGIN
; C        ONLY SECOND DERIVATIVE TERM (YDPB) IS ZERO
         IF (TOLP LT FBND*ABSDX) THEN H = TOLP/FBND
     ENDIF ELSE BEGIN
; C        SECOND DERIVATIVE TERM (YDPB) IS NON-ZERO
         SRYDPB = SQRT(0.5D0*YDPB)
         IF (TOLP LT SRYDPB*ABSDX) THEN H = TOLP/SRYDPB
     ENDELSE

; C     FURTHER RESTRICT THE STEP LENGTH TO BE NOT
; C                               BIGGER THAN  1/DFDUB
      IF (H*DFDUB GT 1.0D0) THEN H = 1.0D0/DFDUB

; C     FINALLY, RESTRICT THE STEP LENGTH TO BE NOT
; C     SMALLER THAN  100*SMALL*ABS(A).  HOWEVER, IF
; C     A=0. AND THE COMPUTED H UNDERFLOWED TO ZERO,
; C     THE ALGORITHM RETURNS  SMALL*ABS(B)  FOR THE
; C                                     STEP LENGTH.
      H = MAX([H,100.0D0*SMALL*ABS(A)])
      IF (H EQ 0.0D0) THEN H = SMALL*ABS(B)

; C     NOW SET DIRECTION OF INTEGRATION
      H = (DX GE 0)?(+H):(-H)

      RETURN
  END





; *DECK DDEABM_DDES

      pro ddeabm_ddes, DF, NEQ, T, Y, TOUT, INFO, RTOL, ATOL, IDID, $
        YPOUT, YP, YY, WT, P, PHI, ALPHA, BETA, PSI, V, W, SIG, G, GI, $
        H, EPS, X, XOLD, HOLD, TOLD, DELSGN, TSTOP, TWOU, FOURU, START, $
        PHASE1, NORND, STIFF, INTOUT, NS, KORD, KOLD, INIT, KSTEPS, $
        KLE4, IQUIT, KPREV, IVC, IV, KGI, PRIVATE, FA, dfname, $
                errmsg=errmsg, max_stepsize=max_stepsize
; C***BEGIN PROLOGUE  DDEABM_DDES
; C***SUBSIDIARY
; C***PURPOSE  Subsidiary to DDEABM
; C***LIBRARY   SLATEC
; C***TYPE      DOUBLE PRECISION (DES-S, DDES-D)
; C***AUTHOR  Watts, H. A., (SNLA)
; C***DESCRIPTION
; C
; C   DDEABM merely allocates storage for DDEABM_DDES to relieve the user of the
; C   inconvenience of a long call list.  Consequently  DDEABM_DDES  is used as
; C   described in the comments for  DDEABM .
; C
; C***SEE ALSO  DDEABM
; C***ROUTINES CALLED  D1MACH, DDEABM_DINTP, DDEABM_DSTEPS, XERMSG
; C***REVISION HISTORY  (YYMMDD)
; C   820301  DATE WRITTEN
; C   890531  Changed all specific intrinsics to generic.  (WRB)
; C   890831  Modified array declarations.  (WRB)
; C   891214  Prologue converted to Version 4.0 format.  (BAB)
; C   900328  Added TYPE section.  (WRB)
; C   900510  Convert XERRWV calls to XERMSG calls, cvt GOTOs to
; C           IF-THEN-ELSE.  (RWC)
; C   910722  Updated AUTHOR section.  (ALS)
; C***END PROLOGUE  DDEABM_DDES
; C
;       INTEGER IDID, INFO, INIT, IPAR, IQUIT, IV, IVC, K, KGI, KLE4,
;      1      KOLD, KORD, KPREV, KSTEPS, L, LTOL, MAXNUM, NATOLP, NEQ,
;      2      NRTOLP, NS
;       DOUBLE PRECISION A, ABSDEL, ALPHA, ATOL, BETA, D1MACH,
;      1      DEL, DELSGN, DT, EPS, FOURU, G, GI, H,
;      2      HA, HOLD, P, PHI, PSI, RPAR, RTOL, SIG, T, TOLD, TOUT,
;      3      TSTOP, TWOU, U, V, W, WT, X, XOLD, Y, YP, YPOUT, YY
;       LOGICAL STIFF,CRASH,START,PHASE1,NORND,INTOUT
; C
;      DIMENSION Y(*),YY(*),WT(*),PHI(NEQ,16),P(*),YP(*),
;     1  YPOUT(*),PSI(12),ALPHA(12),BETA(12),SIG(13),V(12),W(12),G(13),
;     2  GI(11),IV(10),INFO(15),RTOL(*),ATOL(*),RPAR(*),IPAR(*)
;      CHARACTER*8 XERN1
;      CHARACTER*16 XERN3, XERN4
; C
;       EXTERNAL DF
; C
; C.......................................................................
; C
; C  THE EXPENSE OF SOLVING THE PROBLEM IS MONITORED BY COUNTING THE
; C  NUMBER OF  STEPS ATTEMPTED. WHEN THIS EXCEEDS  MAXNUM, THE COUNTER
; C  IS RESET TO ZERO AND THE USER IS INFORMED ABOUT POSSIBLE EXCESSIVE
; C  WORK.
; C
      MAXNUM = 500L
; C
; C.......................................................................
; C
; C***FIRST EXECUTABLE STATEMENT  DDEABM_DDES
      common ddeabm_func_common
      IF (INFO(1-1) EQ 0) THEN BEGIN
; C
; C ON THE FIRST CALL , PERFORM INITIALIZATION --
; C        DEFINE THE MACHINE UNIT ROUNDOFF QUANTITY  U  BY CALLING THE
; C        FUNCTION ROUTINE  D1MACH. THE USER MUST MAKE SURE THAT THE
; C        VALUES SET IN D1MACH ARE RELEVANT TO THE COMPUTER BEING USED.
; C
         U=(machar(/double)).eps  ;; XXX
; C                       -- SET ASSOCIATED MACHINE DEPENDENT PARAMETERS
         TWOU=2.D0*U
         FOURU=4.D0*U
; C                       -- SET TERMINATION FLAG
         IQUIT=0L
; C                       -- SET INITIALIZATION INDICATOR
         INIT=0L
; C                       -- SET COUNTER FOR ATTEMPTED STEPS
         KSTEPS=0L
; C                       -- SET INDICATOR FOR INTERMEDIATE-OUTPUT
         INTOUT= 0L
; C                       -- SET INDICATOR FOR STIFFNESS DETECTION
         STIFF= 0L
; C                       -- SET STEP COUNTER FOR STIFFNESS DETECTION
         KLE4=0L
; C                       -- SET INDICATORS FOR STEPS CODE
         START= 1L
         PHASE1= 1L
         NORND= 1L
; C                       -- RESET INFO(1) FOR SUBSEQUENT CALLS
         INFO(1-1)=1L
      ENDIF
; C
; C.......................................................................
; C
; C      CHECK VALIDITY OF INPUT PARAMETERS ON EACH ENTRY
; C
      IF (INFO(1-1) NE 0  AND  INFO(1-1) NE 1) THEN BEGIN
          errmsg = 'IN DDEABM, INFO(1-1) MUST BE '+ $
            'SET TO 0 FOR THE START OF A NEW PROBLEM, AND MUST BE '+ $
            'SET TO 1 FOLLOWING AN INTERRUPTED TASK.  YOU ARE '+ $
            'ATTEMPTING TO CONTINUE THE INTEGRATION ILLEGALLY BY '+ $
            'CALLING THE CODE WITH INFO(1-1) = ' + strtrim(info(1-1),2)
          IDID=-33L
      ENDIF

      IF (INFO(2-1) NE 0  AND  INFO(2-1) NE 1) THEN BEGIN
          errmsg = 'IN DDEABM, INFO(2-1) MUST BE '+ $
            '0 OR 1 INDICATING SCALAR AND VECTOR ERROR TOLERANCES, '+ $
            'RESPECTIVELY.  YOU HAVE CALLED THE CODE WITH INFO(2-1) = '+ $
            strtrim(info(2-1),2)
         IDID=-33L
      ENDIF

      IF (INFO(3-1) NE 0  AND  INFO(3-1) NE 1) THEN BEGIN
          errmsg = 'IN DDEABM, INFO(3-1) MUST BE '+ $
            '0 OR 1 INDICATING THE INTERVAL OR INTERMEDIATE-OUTPUT '+ $
            'MODE OF INTEGRATION, RESPECTIVELY.  YOU HAVE CALLED '+ $
            'THE CODE WITH  INFO(3-1) = '+strtrim(info(3-1),2)
         IDID=-33L
      ENDIF

      IF (INFO(4-1) NE 0  AND  INFO(4-1) NE 1) THEN BEGIN
         errmsg = 'IN DDEABM, INFO(4-1) MUST BE '+ $
           '0 OR 1 INDICATING WHETHER OR NOT THE INTEGRATION '+ $
           'INTERVAL IS TO BE RESTRICTED BY A POINT TSTOP.  YOU '+ $
           'HAVE CALLED THE CODE WITH INFO(4-1) = '+strtrim(info(4-1),2)
         IDID=-33L
      ENDIF

      IF (NEQ LT 1) THEN BEGIN
         errmsg = 'IN DDEABM,  THE NUMBER OF '+ $
           'EQUATIONS NEQ MUST BE A POSITIVE INTEGER.  YOU HAVE '+ $
           'CALLED THE CODE WITH  NEQ = '+strtrim(neq,2)
         IDID=-33L
      ENDIF

      whr = where(rtol LT 0, nrtolp)
      wha = where(atol LT 0, natolp)

      NRTOLP = total( (RTOL LT 0) ) NE 0
      NATOLP = total( (ATOL LT 0) ) NE 0

      if nrtolp NE 0 then begin
          errmsg = 'IN DDEABM, THE RELATIVE '+ $
            'ERROR TOLERANCES RTOL MUST BE NON-NEGATIVE.  YOU '+ $
            'HAVE CALLED THE CODE WITH  RTOL('+strtrim(whr(0),2)+') = '+ $
            strtrim(rtol(whr(0)),2)+ $
            '. IN THE CASE OF VECTOR ERROR TOLERANCES, '+$
            'NO FURTHER CHECKING OF RTOL COMPONENTS IS DONE.'
          IDID = -33L
      endif else if natolp NE 0 then begin
          errmsg = 'IN DDEABM, THE ABSOLUTE '+ $
            'ERROR TOLERANCES ATOL MUST BE NON-NEGATIVE.  YOU '+ $
            'HAVE CALLED THE CODE WITH  ATOL('+strtrim(wha(0),2)+'-1) = '+ $
            strtrim(atol(wha(0)),2)+ $
            '.  IN THE CASE OF VECTOR ERROR TOLERANCES, '+ $
            'NO FURTHER CHECKING OF ATOL COMPONENTS IS DONE.'
          IDID = -33L
      ENDIF

     DDES_100:
     IF (INFO(4-1) EQ 1) THEN BEGIN
         IF ( (TOUT-T)*(TSTOP-T) LT 0 $
              OR ABS(TOUT-T) GT ABS(TSTOP-T)) THEN BEGIN
            errmsg = 'IN DDEABM, YOU HAVE '+ $
              'CALLED THE CODE WITH  TOUT = '+strtrim(tout,2)+' BUT '+ $
              'YOU HAVE ALSO TOLD THE CODE (INFO(4-1) = 1) NOT TO '+ $
              'INTEGRATE PAST THE POINT TSTOP = '+strtrim(tstop,2)+ $
              ' THESE INSTRUCTIONS CONFLICT.'
            IDID=-33L
         ENDIF
      ENDIF
; C
; C     CHECK SOME CONTINUATION POSSIBILITIES
; C
      IF (INIT NE 0) THEN BEGIN
         IF (T EQ TOUT) THEN BEGIN
            errmsg = 'IN DDEABM, YOU HAVE '+ $
              'CALLED THE CODE WITH  T = TOUT = '+strtrim(T,2)+ $
              '.  THIS IS NOT ALLOWED ON CONTINUATION CALLS.'
            IDID=-33L
         ENDIF

         IF (T NE TOLD) THEN BEGIN
            errmsg = 'IN DDEABM, YOU HAVE '+ $
              'CHANGED THE VALUE OF T FROM '+strtrim(told,2)+' TO '+ $
              strtrim(t,2)+'  THIS IS NOT ALLOWED ON CONTINUATION CALLS.'
            IDID=-33L
         ENDIF

         IF (INIT NE 1) THEN BEGIN
            IF (DELSGN*(TOUT-T) LT 0.D0) THEN BEGIN
               errmsg = 'IN DDEABM, BY '+ $
                 'CALLING THE CODE WITH TOUT = '+strtrim(tout,2)+ $
                 ' YOU ARE ATTEMPTING TO CHANGE THE DIRECTION OF '+ $
                 'INTEGRATION.  THIS IS NOT ALLOWED WITHOUT '+ $
                 'RESTARTING.'
               IDID=-33L
            ENDIF
         ENDIF
      ENDIF
; C
; C     INVALID INPUT DETECTED
; C
      IF (IDID EQ (-33)) THEN BEGIN
         IF (IQUIT NE (-33)) THEN BEGIN
            IQUIT = -33L
            INFO(1-1) = -1L
         ENDIF ELSE BEGIN
             errmsg = 'IN DDEABM, INVALID '+ $
               'INPUT WAS DETECTED ON SUCCESSIVE ENTRIES.  IT IS '+ $
               'IMPOSSIBLE TO PROCEED BECAUSE YOU HAVE NOT '+ $
               'CORRECTED THE PROBLEM, SO EXECUTION IS BEING '+ $
               'TERMINATED.'
         ENDELSE
         RETURN
      ENDIF
; C
; C.......................................................................
; C
; C     RTOL = ATOL = 0. IS ALLOWED AS VALID INPUT AND INTERPRETED AS
; C     ASKING FOR THE MOST ACCURATE SOLUTION POSSIBLE. IN THIS CASE,
; C     THE RELATIVE ERROR TOLERANCE RTOL IS RESET TO THE SMALLEST VALUE
; C     FOURU WHICH IS LIKELY TO BE REASONABLE FOR THIS METHOD AND MACHINE
; C
      wh = where(rtol+atol EQ 0, ct)
      if ct GT 0 then begin
          ;; Expand RTOL if necessary to be per-vector
          if n_elements(rtol) LT n_elements(atol) then $
            rtol = rtol + atol*0
          rtol(wh) = fouru
          IDID = -2L
      endif

      DDES_190:
      IF (IDID EQ (-2)) THEN BEGIN
; C                       RTOL=ATOL=0 ON INPUT, SO RTOL IS CHANGED TO A
; C                                                SMALL POSITIVE VALUE
          INFO(1-1)=-1
          RETURN
      ENDIF
; C
; C     BRANCH ON STATUS OF INITIALIZATION INDICATOR
; C            INIT=0 MEANS INITIAL DERIVATIVES AND NOMINAL STEP SIZE
; C                   AND DIRECTION NOT YET SET
; C            INIT=1 MEANS NOMINAL STEP SIZE AND DIRECTION NOT YET SET
; C            INIT=2 MEANS NO FURTHER INITIALIZATION REQUIRED
; C
      IF (INIT EQ 0) THEN GOTO, DDES_210
      IF (INIT EQ 1) THEN GOTO, DDES_220
      GOTO, DDES_240
; C
; C.......................................................................
; C
; C     MORE INITIALIZATION --
; C                         -- EVALUATE INITIAL DERIVATIVES
; C
      DDES_210:
      INIT=1L
      A=T
      YP = CALL_FUNCTION(DFNAME, DF, A, Y, PRIVATE, _EXTRA=FA)
      if ddeabm_funcerror NE 0 then return
      

      IF (T EQ TOUT) THEN BEGIN
          IDID=2L
          YPOUT = YP
          TOLD=T
          RETURN
      ENDIF
; C
; C                         -- SET INDEPENDENT AND DEPENDENT VARIABLES
; C                                              X AND YY(*) FOR STEPS
; C                         -- SET SIGN OF INTEGRATION DIRECTION
; C                         -- INITIALIZE THE STEP SIZE
; C
      DDES_220:
      INIT = 2L
      X = T
      YY = Y
      DELSGN = (TOUT GE T)?(+1):(-1)
      DELSGNX = (TOUT GE X)?(+1):(-1)
      H = MAX([FOURU*ABS(X),ABS(TOUT-X)])
      if n_elements(max_stepsize) GT 0 then h = h < max_stepsize(0)
      H = H * DELSGNX
; C
; C.......................................................................
; C
; C   ON EACH CALL SET INFORMATION WHICH DETERMINES THE ALLOWED INTERVAL
; C   OF INTEGRATION BEFORE RETURNING WITH AN ANSWER AT TOUT
; C
      DDES_240:
      DEL = TOUT - T
      ABSDEL = ABS(DEL)
; C
; C.......................................................................
; C
; C   IF ALREADY PAST OUTPUT POINT, INTERPOLATE AND RETURN
; C
      DDES_250:
      IF (ABS(X-T) GE ABSDEL) THEN BEGIN
          DDEABM_DINTP, X,YY,TOUT,Y,YPOUT,NEQ,KOLD,PHI,IVC,IV,KGI,GI, $
                                             ALPHA,G,W,XOLD,P
          IDID = 3L
          IF (X EQ TOUT) THEN BEGIN
              IDID = 2L
              INTOUT = 0L
          ENDIF
          T = TOUT
          TOLD = T
          RETURN
      ENDIF
; C
; C   IF CANNOT GO PAST TSTOP AND SUFFICIENTLY CLOSE,
; C   EXTRAPOLATE AND RETURN
; C
      IF ((INFO(4-1) EQ 1) AND $
          (ABS(TSTOP-X) LT FOURU*ABS(X))) THEN BEGIN
          DT = TOUT - X
          Y = YY + DT*YP

          YPOUT = CALL_FUNCTION(DFNAME, DF, TOUT, Y, PRIVATE, _EXTRA=FA)
          if ddeabm_funcerror NE 0 then return
          IDID = 3L
          T = TOUT
          TOLD = T
          RETURN
      ENDIF

      IF (INFO(3-1) EQ 0  OR  INTOUT EQ 0) EQ 0 THEN BEGIN
; C
; C   INTERMEDIATE-OUTPUT MODE
; C
          IDID = 1L
          Y = YY
          YPOUT = YP
          T = X
          TOLD = T
          INTOUT = 0L
          RETURN
      ENDIF
; C
; C.......................................................................
; C
; C     MONITOR NUMBER OF STEPS ATTEMPTED
; C
      IF (KSTEPS GT MAXNUM) THEN BEGIN
; C
; C                       A SIGNIFICANT AMOUNT OF WORK HAS BEEN EXPENDED
          IDID=-1L
          KSTEPS=0L
          IF (STIFF) THEN BEGIN
; C
; C                       PROBLEM APPEARS TO BE STIFF
              IDID=-4L
              STIFF= 0L
              KLE4=0L
          ENDIF

          Y = YY
          YPOUT = YP
          T = X
          TOLD = T
          INFO(1-1) = -1
          INTOUT = 0L
          RETURN
      ENDIF
; C
; C.......................................................................
; C
; C   LIMIT STEP SIZE, SET WEIGHT VECTOR AND TAKE A STEP
; C
      HA = ABS(H)
      IF (INFO(4-1) EQ 1) THEN BEGIN
          HA = MIN([HA,ABS(TSTOP-X)])
      ENDIF
      H = (H GE 0)?(HA):(-HA)
      EPS = 1.0D0
      LTOL = 1L

      wt = rtol*abs(yy) + atol
      wh = where(wt LE 0, ct)

; C
; C                       RELATIVE ERROR CRITERION INAPPROPRIATE
      if ct GT 0 then begin
          IDID = -3L
          Y = YY
          YPOUT = YP
          T = X
          TOLD = T
          INFO(1-1) = -1L
          INTOUT = 0L
          RETURN
      endif

      DDES_380:
      DDEABM_DSTEPS, DF,NEQ,YY,X,H,EPS,WT,START,HOLD,KORD,KOLD,CRASH,PHI,P, $
                YP,PSI,ALPHA,BETA,SIG,V,W,G,PHASE1,NS,NORND,KSTEPS, $
                TWOU,FOURU,XOLD,KPREV,IVC,IV,KGI,GI,PRIVATE,FA, DFNAME, $
                max_stepsize=max_stepsize
      if ddeabm_funcerror NE 0 then return

; C
; C.......................................................................
; C
      IF (CRASH) THEN BEGIN
; C
; C                       TOLERANCES TOO SMALL
          IDID = -2L
          RTOL = EPS*RTOL
          ATOL = EPS*ATOL
          Y = YY
          YPOUT = YP
          T = X
          TOLD = T
          INFO(1-1) = -1L
          INTOUT = 0L
          RETURN
      ENDIF
; C
; C   (STIFFNESS TEST) COUNT NUMBER OF CONSECUTIVE STEPS TAKEN WITH THE
; C   ORDER OF THE METHOD BEING LESS OR EQUAL TO FOUR
; C
  DDES_420:
      KLE4 = KLE4 + 1
      IF(KOLD GT 4) THEN KLE4 = 0L
      IF(KLE4 GE 50) THEN STIFF = 1L
      INTOUT = 1L
      GOTO, DDES_250
    END


; *DECK DDEABM_DINTP
pro DDEABM_DINTP, X, Y, XOUT, YOUT, YPOUT, NEQN, KOLD, PHI, IVC, $
       IV, KGI, GI, ALPHA, OG, OW, OX, OY
; C***BEGIN PROLOGUE  DDEABM_DINTP
; C***PURPOSE  Approximate the solution at XOUT by evaluating the
; C            polynomial computed in DDEABM_DSTEPS at XOUT.  Must be used in
; C            conjunction with DDEABM_DSTEPS.
; C***LIBRARY   SLATEC (DEPAC)
; C***CATEGORY  I1A1B
; C***TYPE      DOUBLE PRECISION (SINTRP-S, DINTP-D)
; C***KEYWORDS  ADAMS METHOD, DEPAC, INITIAL VALUE PROBLEMS, ODE,
; C             ORDINARY DIFFERENTIAL EQUATIONS, PREDICTOR-CORRECTOR,
; C             SMOOTH INTERPOLANT
; C***AUTHOR  Watts, H. A., (SNLA)
; C***DESCRIPTION
; C
; C   The methods in subroutine  DDEABM_DSTEPS  approximate the solution near  X
; C   by a polynomial.  Subroutine  DDEABM_DINTP  approximates the solution at
; C   XOUT  by evaluating the polynomial there.  Information defining this
; C   polynomial is passed from  DDEABM_DSTEPS  so  DDEABM_DINTP  cannot be used alone.
; C
; C   Subroutine DDEABM_DSTEPS is completely explained and documented in the text
; C   "Computer Solution of Ordinary Differential Equations, the Initial
; C   Value Problem"  by L. F. Shampine and M. K. Gordon.
; C
; C   Input to DDEABM_DINTP --
; C
; C   The user provides storage in the calling program for the arrays in
; C   the call list
; C      DIMENSION Y(NEQN),YOUT(NEQN),YPOUT(NEQN),PHI(NEQN,16),OY(NEQN)
; C                AND ALPHA(12),OG(13),OW(12),GI(11),IV(10)
; C   and defines
; C      XOUT -- point at which solution is desired.
; C   The remaining parameters are defined in  DDEABM_DSTEPS  and passed to
; C   DDEABM_DINTP  from that subroutine
; C
; C   Output from  DDEABM_DINTP --
; C
; C      YOUT(*) -- solution at  XOUT
; C      YPOUT(*) -- derivative of solution at  XOUT
; C   The remaining parameters are returned unaltered from their input
; C   values.  Integration with  DDEABM_DSTEPS  may be continued.
; C
; C***REFERENCES  H. A. Watts, A smoother interpolant for DE/STEP, INTRP
; C                 II, Report SAND84-0293, Sandia Laboratories, 1984.
; C***ROUTINES CALLED  (NONE)
; C***REVISION HISTORY  (YYMMDD)
; C   840201  DATE WRITTEN
; C   890831  Modified array declarations.  (WRB)
; C   890831  REVISION DATE from Version 3.2
; C   891214  Prologue converted to Version 4.0 format.  (BAB)
; C   920501  Reformatted the REFERENCES section.  (WRB)
; C***END PROLOGUE  DDEABM_DINTP
; C
;       INTEGER I, IQ, IV, IVC, IW, J, JQ, KGI, KOLD, KP1, KP2,
;      1        L, M, NEQN
;       DOUBLE PRECISION ALP, ALPHA, C, G, GDI, GDIF, GI, GAMMA, H, HI,
;      1       HMU, OG, OW, OX, OY, PHI, RMU, SIGMA, TEMP1, TEMP2, TEMP3,
;      2       W, X, XI, XIM1, XIQ, XOUT, Y, YOUT, YPOUT
; C
;       DIMENSION Y(*),YOUT(*),YPOUT(*),PHI(NEQN,16),OY(*)
;       DIMENSION G(13),C(13),W(13),OG(13),OW(12),ALPHA(12),GI(11),IV(10)
; C
; C***FIRST EXECUTABLE STATEMENT  DDEABM_DINTP
      KP1 = KOLD + 1
      KP2 = KOLD + 2

      HI = XOUT - OX
      H = X - OX
      XI = HI/H
      XIM1 = XI - 1.D0

      G = DBLARR(13) & C = G & W = G
; C
; C   INITIALIZE W(*) FOR COMPUTING G(*)
; C
      XIQ = XI
      IQ = dindgen(kp1)+1
      XIQ = XI^(IQ+1)
      W(0:KP1-1) = XIQ/(IQ*(IQ+1))

; C
; C   COMPUTE THE DOUBLE INTEGRAL TERM GDI
; C
      IF (KOLD LE KGI) THEN BEGIN
          GDI = GI(KOLD-1)
          GOTO, DINTP_60
      ENDIF
          
      IF (IVC LE 0) THEN BEGIN
          GDI = 1.0D0/(KP1*(KP1+1))
          M = 2L
      ENDIF ELSE BEGIN
          IW = IV(IVC-1)
          GDI = OW(IW-1)
          M = KOLD - IW + 3
      ENDELSE

      IF (M LE KOLD) THEN BEGIN
;;        XXX:    (M>1) is a kludge
          FOR I = (M>1), KOLD DO $
            GDI = OW(KP2-I-1) - ALPHA(I-1)*GDI
      ENDIF

; C
; C   COMPUTE G(*) AND C(*)
; C
      DINTP_60:
      G(0:1) = [XI, XI^2/2]
      C(0:1) = [1d, XI]
      IF (KOLD GE 2) THEN BEGIN
          FOR I = 2L, KOLD DO BEGIN
              ALP = ALPHA(I-1)
              GAMMA = 1.0D0 + XIM1*ALP
              L = KP2 - I
              W(0:L-1) = GAMMA*W(0:L-1) - ALP*W(1:L)
              G(I) = W(0)
              C(I) = GAMMA*C(I-1)
          ENDFOR
      ENDIF
; C
; C   DEFINE INTERPOLATION PARAMETERS
; C
      SIGMA = (W(1) - XIM1*W(0))/GDI
      RMU = XIM1*C(KOLD)/GDI  ;; *** NOTE: KP1-1 is KOLD
      HMU = RMU/H

; C   INTERPOLATE FOR THE SOLUTION -- YOUT
; C   AND FOR THE DERIVATIVE OF THE SOLUTION -- YPOUT

      YOUT(*) = 0
      YPOUT(*) = 0
      J = lindgen(KOLD)+1
      I = KP2 - J - 1 ;; *** NOTE: -1 is here
      GDIF = OG(I) - OG(I-1)
      TEMP2 = (G(I) - G(I-1)) - SIGMA*GDIF
      TEMP3 = (C(I) - C(I-1)) + RMU*GDIF

      FOR J = 0L, KOLD-1 DO BEGIN
        YOUT  = YOUT  + TEMP2(j)*PHI(*,I(j))
        YPOUT = YPOUT + TEMP3(j)*PHI(*,I(j))
      ENDFOR

      YOUT = ( ((1.0D0 - SIGMA)*OY + SIGMA*Y) + $
               H*(YOUT + (G(0) - SIGMA*OG(0))*PHI(*,0)) )
      YPOUT = ( HMU*(OY - Y) + $
                (YPOUT + (C(0) + RMU*OG(0))*PHI(*,0)) )

      RETURN
  END

; *DECK DDEABM_DSTEPS
  pro DDEABM_DSTEPS, DF, NEQN, Y, X, H, EPS, WT, START, HOLD, K, $
              KOLD, CRASH, PHI, P, YP, PSI, ALPHA, BETA, SIG, V, W, G, $
              PHASE1, NS, NORND, KSTEPS, TWOU, FOURU, XOLD, KPREV, IVC, IV, $
              KGI, GI, PRIVATE, FA, dfname, max_stepsize=max_stepsize
; C***BEGIN PROLOGUE  DDEABM_DSTEPS
; C***PURPOSE  Integrate a system of first order ordinary differential
; C            equations one step.
; C***LIBRARY   SLATEC (DEPAC)
; C***CATEGORY  I1A1B
; C***TYPE      DOUBLE PRECISION (STEPS-S, DSTEPS-D)
; C***KEYWORDS  ADAMS METHOD, DEPAC, INITIAL VALUE PROBLEMS, ODE,
; C             ORDINARY DIFFERENTIAL EQUATIONS, PREDICTOR-CORRECTOR
; C***AUTHOR  Shampine, L. F., (SNLA)
; C           Gordon, M. K., (SNLA)
; C             MODIFIED BY H.A. WATTS
; C***DESCRIPTION
; C
; C   Written by L. F. Shampine and M. K. Gordon
; C
; C   Abstract
; C
; C   Subroutine  DDEABM_DSTEPS  is normally used indirectly through subroutine
; C   DDEABM .  Because  DDEABM  suffices for most problems and is much
; C   easier to use, using it should be considered before using  DDEABM_DSTEPS
; C   alone.
; C
; C   Subroutine DDEABM_DSTEPS integrates a system of  NEQN  first order ordinary
; C   differential equations one step, normally from X to X+H, using a
; C   modified divided difference form of the Adams Pece formulas.  Local
; C   extrapolation is used to improve absolute stability and accuracy.
; C   The code adjusts its order and step size to control the local error
; C   per unit step in a generalized sense.  Special devices are included
; C   to control roundoff error and to detect when the user is requesting
; C   too much accuracy.
; C
; C   This code is completely explained and documented in the text,
; C   Computer Solution of Ordinary Differential Equations, The Initial
; C   Value Problem  by L. F. Shampine and M. K. Gordon.
; C   Further details on use of this code are available in "Solving
; C   Ordinary Differential Equations with ODE, STEP, and INTRP",
; C   by L. F. Shampine and M. K. Gordon, SLA-73-1060.
; C
; C
; C   The parameters represent --
; C      DF -- subroutine to evaluate derivatives
; C      NEQN -- number of equations to be integrated
; C      Y(*) -- solution vector at X
; C      X -- independent variable
; C      H -- appropriate step size for next step.  Normally determined by
; C           code
; C      EPS -- local error tolerance
; C      WT(*) -- vector of weights for error criterion
; C      START -- logical variable set .TRUE. for first step,  .FALSE.
; C           otherwise
; C      HOLD -- step size used for last successful step
; C      K -- appropriate order for next step (determined by code)
; C      KOLD -- order used for last successful step
; C      CRASH -- logical variable set .TRUE. when no step can be taken,
; C           .FALSE. otherwise.
; C      YP(*) -- derivative of solution vector at  X  after successful
; C           step
; C      KSTEPS -- counter on attempted steps
; C      TWOU -- 2.*U where U is machine unit roundoff quantity
; C      FOURU -- 4.*U where U is machine unit roundoff quantity
; C      RPAR,IPAR -- parameter arrays which you may choose to use
; C            for communication between your program and subroutine F.
; C            They are not altered or used by DDEABM_DSTEPS.
; C   The variables X,XOLD,KOLD,KGI and IVC and the arrays Y,PHI,ALPHA,G,
; C   W,P,IV and GI are required for the interpolation subroutine SINTRP.
; C   The remaining variables and arrays are included in the call list
; C   only to eliminate local retention of variables between calls.
; C
; C   Input to DDEABM_DSTEPS
; C
; C      First call --
; C
; C   The user must provide storage in his calling program for all arrays
; C   in the call list, namely
; C
; C     DIMENSION Y(NEQN),WT(NEQN),PHI(NEQN,16),P(NEQN),YP(NEQN),PSI(12),
; C    1  ALPHA(12),BETA(12),SIG(13),V(12),W(12),G(13),GI(11),IV(10),
; C    2  RPAR(*),IPAR(*)
; C
; C    **Note**
; C
; C   The user must also declare  START ,  CRASH ,  PHASE1  and  NORND
; C   logical variables and  DF  an EXTERNAL subroutine, supply the
; C   subroutine  DF(X,Y,YP)  to evaluate
; C      DY(I)/DX = YP(I) = DF(X,Y(1),Y(2),...,Y(NEQN))
; C   and initialize only the following parameters.
; C      NEQN -- number of equations to be integrated
; C      Y(*) -- vector of initial values of dependent variables
; C      X -- initial value of the independent variable
; C      H -- nominal step size indicating direction of integration
; C           and maximum size of step.  Must be variable
; C      EPS -- local error tolerance per step.  Must be variable
; C      WT(*) -- vector of non-zero weights for error criterion
; C      START -- .TRUE.
; C      YP(*) -- vector of initial derivative values
; C      KSTEPS -- set KSTEPS to zero
; C      TWOU -- 2.*U where U is machine unit roundoff quantity
; C      FOURU -- 4.*U where U is machine unit roundoff quantity
; C   Define U to be the machine unit roundoff quantity by calling
; C   the function routine  D1MACH,  U = D1MACH(4), or by
; C   computing U so that U is the smallest positive number such
; C   that 1.0+U .GT. 1.0.
; C
; C   DDEABM_DSTEPS  requires that the L2 norm of the vector with components
; C   LOCAL ERROR(L)/WT(L)  be less than  EPS  for a successful step.  The
; C   array  WT  allows the user to specify an error test appropriate
; C   for his problem.  For example,
; C      WT(L) = 1.0  specifies absolute error,
; C            = ABS(Y(L))  error relative to the most recent value of the
; C                 L-th component of the solution,
; C            = ABS(YP(L))  error relative to the most recent value of
; C                 the L-th component of the derivative,
; C            = MAX(WT(L),ABS(Y(L)))  error relative to the largest
; C                 magnitude of L-th component obtained so far,
; C            = ABS(Y(L))*RELERR/EPS + ABSERR/EPS  specifies a mixed
; C                 relative-absolute test where  RELERR  is relative
; C                 error,  ABSERR  is absolute error and  EPS =
; C                 MAX(RELERR,ABSERR) .
; C
; C      Subsequent calls --
; C
; C   Subroutine  DDEABM_DSTEPS  is designed so that all information needed to
; C   continue the integration, including the step size  H  and the order
; C   K , is returned with each step.  With the exception of the step
; C   size, the error tolerance, and the weights, none of the parameters
; C   should be altered.  The array  WT  must be updated after each step
; C   to maintain relative error tests like those above.  Normally the
; C   integration is continued just beyond the desired endpoint and the
; C   solution interpolated there with subroutine  SINTRP .  If it is
; C   impossible to integrate beyond the endpoint, the step size may be
; C   reduced to hit the endpoint since the code will not take a step
; C   larger than the  H  input.  Changing the direction of integration,
; C   i.e., the sign of  H , requires the user set  START = .TRUE. before
; C   calling  DDEABM_DSTEPS  again.  This is the only situation in which  START
; C   should be altered.
; C
; C   Output from DDEABM_DSTEPS
; C
; C      Successful Step --
; C
; C   The subroutine returns after each successful step with  START  and
; C   CRASH  set .FALSE. .  X  represents the independent variable
; C   advanced one step of length  HOLD  from its value on input and  Y
; C   the solution vector at the new value of  X .  All other parameters
; C   represent information corresponding to the new  X  needed to
; C   continue the integration.
; C
; C      Unsuccessful Step --
; C
; C   When the error tolerance is too small for the machine precision,
; C   the subroutine returns without taking a step and  CRASH = .TRUE. .
; C   An appropriate step size and error tolerance for continuing are
; C   estimated and all other information is restored as upon input
; C   before returning.  To continue with the larger tolerance, the user
; C   just calls the code again.  A restart is neither required nor
; C   desirable.
; C
; C***REFERENCES  L. F. Shampine and M. K. Gordon, Solving ordinary
; C                 differential equations with ODE, STEP, and INTRP,
; C                 Report SLA-73-1060, Sandia Laboratories, 1973.
; C***ROUTINES CALLED  D1MACH, DDEABM_DHSTRT
; C***REVISION HISTORY  (YYMMDD)
; C   740101  DATE WRITTEN
; C   890531  Changed all specific intrinsics to generic.  (WRB)
; C   890831  Modified array declarations.  (WRB)
; C   890831  REVISION DATE from Version 3.2
; C   891214  Prologue converted to Version 4.0 format.  (BAB)
; C   920501  Reformatted the REFERENCES section.  (WRB)
; C***END PROLOGUE  DDEABM_DSTEPS
; C
;       INTEGER I, IFAIL, IM1, IP1, IPAR, IQ, J, K, KM1, KM2, KNEW,
;      1      KOLD, KP1, KP2, KSTEPS, L, LIMIT1, LIMIT2, NEQN, NS, NSM2,
;      2      NSP1, NSP2
;       DOUBLE PRECISION ABSH, ALPHA, BETA, BIG, D1MACH,
;      1      EPS, ERK, ERKM1, ERKM2, ERKP1, ERR,
;      2      FOURU, G, GI, GSTR, H, HNEW, HOLD, P, P5EPS, PHI, PSI, R,
;      3      REALI, REALNS, RHO, ROUND, RPAR, SIG, TAU, TEMP1,
;      4      TEMP2, TEMP3, TEMP4, TEMP5, TEMP6, TWO, TWOU, U, V, W, WT,
;      5      X, XOLD, Y, YP
;       LOGICAL START,CRASH,PHASE1,NORND
;       DIMENSION Y(*),WT(*),PHI(NEQN,16),P(*),YP(*),PSI(12),
;      1  ALPHA(12),BETA(12),SIG(13),V(12),W(12),G(13),GI(11),IV(10),
;      2  RPAR(*),IPAR(*)
;       DIMENSION TWO(13),GSTR(13)
;       EXTERNAL DF
;       SAVE TWO, GSTR

;       DATA TWO(1),TWO(2),TWO(3),TWO(4),TWO(5),TWO(6),TWO(7),TWO(8),
;      1     TWO(9),TWO(10),TWO(11),TWO(12),TWO(13)
;      2     /2.0D0,4.0D0,8.0D0,16.0D0,32.0D0,64.0D0,128.0D0,256.0D0,
;      3      512.0D0,1024.0D0,2048.0D0,4096.0D0,8192.0D0/
;       DATA GSTR(1),GSTR(2),GSTR(3),GSTR(4),GSTR(5),GSTR(6),GSTR(7),
;      1     GSTR(8),GSTR(9),GSTR(10),GSTR(11),GSTR(12),GSTR(13)
;      2     /0.5D0,0.0833D0,0.0417D0,0.0264D0,0.0188D0,0.0143D0,0.0114D0,
;      3      0.00936D0,0.00789D0,0.00679D0,0.00592D0,0.00524D0,0.00468D0/

    common ddeabm_func_common
    TWO = 2d^(dindgen(13)+1)
    GSTR = [ 0.5D0,0.0833D0,0.0417D0,0.0264D0,0.0188D0,0.0143D0,0.0114D0, $
             0.00936D0,0.00789D0,0.00679D0,0.00592D0,0.00524D0,0.00468D0 ]

; C
; C       ***     BEGIN BLOCK 0     ***
; C   CHECK IF STEP SIZE OR ERROR TOLERANCE IS TOO SMALL FOR MACHINE
; C   PRECISION.  IF FIRST STEP, INITIALIZE PHI ARRAY AND ESTIMATE A
; C   STARTING STEP SIZE.
; C                   ***
; C
; C   IF STEP SIZE IS TOO SMALL, DETERMINE AN ACCEPTABLE ONE
; C
; C***FIRST EXECUTABLE STATEMENT  DDEABM_DSTEPS
      CRASH = 1L
      IF (ABS(H) LT FOURU*ABS(X)) THEN BEGIN
          H = (FOURU*ABS(X)) * ( (H GE 0)?(+1):(-1) )
          RETURN
      ENDIF

      P5EPS = 0.5D0*EPS
; C
; C   IF ERROR TOLERANCE IS TOO SMALL, INCREASE IT TO AN ACCEPTABLE VALUE
; C
      ROUND = TOTAL( (Y/WT)^2 )
      ROUND = TWOU*SQRT(ROUND)

      IF (P5EPS LT ROUND) THEN BEGIN
          EPS = 2.0D0*ROUND*(1.0D0 + FOURU)
          RETURN
      ENDIF

      CRASH = 0L
      G(0) = 1.0D0
      G(1) = 0.5D0
      SIG(0) = 1.0D0
      IF (NOT START) THEN GOTO, DSTEPS_99
; C
; C   INITIALIZE.  COMPUTE APPROPRIATE STEP SIZE FOR FIRST STEP
; C
; C     CALL DF(X,Y,YP,RPAR,IPAR)
; C     SUM = 0.0
      PHI(*,0) = YP
      PHI(*,1) = 0
; C20     SUM = SUM + (YP(L-1)/WT(L-1))**2
; C     SUM = SQRT(SUM)
; C     ABSH = ABS(H)
; C     IF(EPS .LT. 16.0*SUM*H*H) ABSH = 0.25*SQRT(EPS/SUM)
; C     H = SIGN(MAX(ABSH,FOURU*ABS(X)),H)
; C
      U = (machar(/double)).eps          ;; XXX
      BIG = SQRT((machar(/double)).xmax) ;; XXX


      ;; Save and restore values from PHI
      phi3 = phi(*,2) & phi4 = phi(*,3)
      phi5 = phi(*,4) & phi6 = phi(*,5)
      DDEABM_DHSTRT, DF,NEQN,X,X+H,Y,YP,WT,1,U,BIG, $
        phi3, phi4, phi5, phi6, private, fa, h, dfname
      phi(*,2) = phi3 & phi(*,3) = phi4 
      phi(*,4) = phi5 & phi(*,5) = phi6
      if ddeabm_funcerror NE 0 then return

      HOLD = 0.0D0
      K = 1L
      KOLD = 0L
      KPREV = 0L
      START = 0L
      PHASE1 = 1L
      NORND = 1L
      IF (P5EPS LE 100.0D0*ROUND) THEN BEGIN
          NORND = 0L
          PHI(*,14) = 0
      ENDIF

      DSTEPS_99:
      IFAIL = 0L
; C       ***     END BLOCK 0     ***
; C
; C       ***     BEGIN BLOCK 1     ***
; C   COMPUTE COEFFICIENTS OF FORMULAS FOR THIS STEP.  AVOID COMPUTING
; C   THOSE QUANTITIES NOT CHANGED WHEN STEP SIZE IS NOT CHANGED.
; C                   ***
; C
      DSTEPS_100:
      KP1 = K+1
      KP2 = K+2
      KM1 = K-1
      KM2 = K-2
; C
; C   NS IS THE NUMBER OF DSTEPS TAKEN WITH SIZE H, INCLUDING THE CURRENT
; C   ONE.  WHEN K.LT.NS, NO COEFFICIENTS CHANGE
; C
      IF (H NE HOLD) THEN NS = 0L
      IF (NS LE KOLD) THEN NS = NS+1
      NSP1 = NS+1
      IF (K LT NS) THEN GOTO, DSTEPS_199
; C
; C   COMPUTE THOSE COMPONENTS OF ALPHA(*),BETA(*),PSI(*),SIG(*) WHICH
; C   ARE CHANGED
; C
      BETA(NS-1) = 1.0D0
      ALPHA(NS-1) = 1.0D0/NS
      TEMP1 = H*NS
      SIG(NSP1-1) = 1.0D0
      IF (K GE NSP1) THEN BEGIN
          FOR I = NSP1, K DO BEGIN
              IM1 = I-1-1  ;; *** Note IM1-1 here!
              II = I-1
              TEMP2 = PSI(IM1)
              PSI(IM1) = TEMP1
              BETA(II) = BETA(IM1)*PSI(IM1)/TEMP2
              TEMP1 = TEMP2 + H
              ALPHA(II) = H/TEMP1
              SIG(I) = I*ALPHA(II)*SIG(II)
          ENDFOR
      ENDIF
      PSI(K-1) = TEMP1
; C
; C   COMPUTE COEFFICIENTS G(*)
; C
; C   INITIALIZE V(*) AND SET W(*).
; C
      IF (NS LE 1) THEN BEGIN
          KK = dindgen(K)+1
          V(0:K-1) = 1.0D0/(KK*(KK+1))
          W(0:K-1) = V(0:K-1)
          IVC = 0L
          KGI = 0L
          IF (K EQ 1) THEN GOTO, DSTEPS_140
          KGI = 1L
          GI(0) = W(1)
          GOTO, DSTEPS_140
      ENDIF
; C
; C   IF ORDER WAS RAISED, UPDATE DIAGONAL PART OF V(*)
; C
      IF (K LE KPREV) THEN GOTO, DSTEPS_130
      IF (IVC NE 0) THEN BEGIN 
          JV = KP1 - IV(IVC-1)
          IVC = IVC - 1
      ENDIF ELSE BEGIN
          JV = 1L
          TEMP4 = K*KP1
          V(K-1) = 1.0D0/TEMP4
          W(K-1) = V(K-1)
          IF (K EQ 2) THEN BEGIN
              KGI = 1L
              GI(0) = W(1)
          ENDIF
      ENDELSE
      NSM2 = NS-2
      IF (NSM2 GE JV) THEN BEGIN
          
          FOR J = JV, NSM2 DO BEGIN
              I = K-J-1  ;; *** NOTE: I-1 here!
              V(I) = V(I) - ALPHA(J)*V(I+1)
              W(I) = V(I)
          ENDFOR

          IF (I EQ 2) THEN BEGIN
              KGI = NS - 1
              GI(KGI-1) = W(1)
          ENDIF
      ENDIF
; C
; C   UPDATE V(*) AND SET W(*)
; C
      DSTEPS_130:
      LIMIT1 = KP1 - NS
      TEMP5 = ALPHA(NS-1)
      V(0:LIMIT1-1) = V(0:LIMIT1-1) - TEMP5*V(1:LIMIT1)
      W(0:LIMIT1-1) = V(0:LIMIT1-1)
      G(NSP1-1) = W(0)
      IF (LIMIT1 NE 1) THEN BEGIN
          KGI = NS
          GI(KGI-1) = W(1)
      ENDIF
      W(LIMIT1) = V(LIMIT1)
      IF (K LT KOLD) THEN BEGIN 
          IVC = IVC + 1
          IV(IVC-1) = LIMIT1 + 2
      ENDIF
; C
; C   COMPUTE THE G(*) IN THE WORK VECTOR W(*)
; C
      DSTEPS_140:
      NSP2 = NS + 2
      KPREV = K
      IF (KP1 GE NSP2) THEN BEGIN
          FOR I = NSP2, KP1 DO BEGIN
              LIMIT2 = KP2 - I
              TEMP6 = ALPHA(I-2)
              W(0:LIMIT2-1) = W(0:LIMIT2-1) - TEMP6*W(1:LIMIT2)
              G(I-1) = W(0)
          ENDFOR
      ENDIF

      DSTEPS_199:
; C       ***     END BLOCK 1     ***
; C
; C       ***     BEGIN BLOCK 2     ***
; C   PREDICT A SOLUTION P(*), EVALUATE DERIVATIVES USING PREDICTED
; C   SOLUTION, ESTIMATE LOCAL ERROR AT ORDER K AND ERRORS AT ORDERS K,
; C   K-1, K-2 AS IF CONSTANT STEP SIZE WERE USED.
; C                   ***
; C
; C   INCREMENT COUNTER ON ATTEMPTED DSTEPS
; C
      KSTEPS = KSTEPS + 1
; C
; C   CHANGE PHI TO PHI STAR
; C
      IF (K GE NSP1) THEN BEGIN
          FOR I = NSP1, K DO BEGIN
              TEMP1 = BETA(I-1)
              PHI(*,I-1) = TEMP1*PHI(*,I-1)
          ENDFOR
      ENDIF
; C
; C   PREDICT SOLUTION AND DIFFERENCES
; C
      PHI(*,KP2-1) = PHI(*,KP1-1)
      PHI(*,KP1-1) = 0
      P(*) = 0
      FOR J = 1L, K DO BEGIN
        I = KP1 - J - 1 ;; *** NOTE: I-1 here!
        TEMP2 = G(I)
        P = P + TEMP2*PHI(*,I)
        PHI(*,I) = PHI(*,I) + PHI(*,I+1)
      ENDFOR
      IF NOT (NORND) THEN BEGIN
          TAU = H*P - PHI(*,14)
          P = Y + TAU
          PHI(*,15) = (P - Y) - TAU
      ENDIF ELSE BEGIN
          P = Y + H*P
      ENDELSE
      XOLD = X

      X = X + H
      ABSH = ABS(H)

      YP = CALL_FUNCTION(DFNAME, DF, X, P, PRIVATE, _EXTRA=FA)
      if ddeabm_funcerror NE 0 then return

; C
; C   ESTIMATE ERRORS AT ORDERS K,K-1,K-2
; C
      ERKM2 = 0.0D0
      ERKM1 = 0.0D0
      TEMP3 = 1.0D0/WT
      TEMP4 = YP - PHI(*,0)
      ERK = total((temp4*temp3)^2)
      IF (KM2 GT 0) THEN $
        ERKM2 = TOTAL( ((PHI(*,KM1-1)+TEMP4)*TEMP3)^2 )
      IF (KM2 GE 0) THEN $
        ERKM1 = TOTAL( ((PHI(*,K-1)+TEMP4)*TEMP3)^2 )

      IF (KM2 GT 0) THEN $
        ERKM2 = ABSH*SIG(KM1-1)*GSTR(KM2-1)*SQRT(ERKM2)
      IF (KM2 GE 0) THEN $
        ERKM1 = ABSH*SIG(K-1)*GSTR(KM1-1)*SQRT(ERKM1)
      TEMP5 = ABSH*SQRT(ERK)
      ERR = TEMP5*(G(K-1)-G(KP1-1))
      ERK = TEMP5*SIG(KP1-1)*GSTR(K-1)
      KNEW = K
; C
; C   TEST IF ORDER SHOULD BE LOWERED
; C
      IF (KM2 GT 0) THEN BEGIN
          IF(MAX([ERKM1,ERKM2]) LE ERK) THEN KNEW = KM1
      ENDIF ELSE IF (KM2 EQ 0) THEN BEGIN
          IF(ERKM1 LE 0.5D0*ERK) THEN KNEW = KM1
      ENDIF
; C
; C   TEST IF STEP SUCCESSFUL
; C
      IF (ERR LE EPS) THEN GOTO, DSTEPS_400
; C       ***     END BLOCK 2     ***
; C
; C       ***     BEGIN BLOCK 3     ***
; C   THE STEP IS UNSUCCESSFUL.  RESTORE  X, PHI(*,*), PSI(*) .
; C   IF THIRD CONSECUTIVE FAILURE, SET ORDER TO ONE.  IF STEP FAILS MORE
; C   THAN THREE TIMES, CONSIDER AN OPTIMAL STEP SIZE.  DOUBLE ERROR
; C   TOLERANCE AND RETURN IF ESTIMATED STEP SIZE IS TOO SMALL FOR MACHINE
; C   PRECISION.
; C                   ***
; C
; C   RESTORE X, PHI(*,*) AND PSI(*)
; C
      PHASE1 = 0L
      X = XOLD
      FOR I = 0L, K-1 DO BEGIN
        PHI(*,I) = (PHI(*,I) - PHI(*,I+1))/BETA(I)
      ENDFOR
      IF (K GE 2) THEN BEGIN 
          PSI(0:K-2) = PSI(1:K-1) - H
      ENDIF

; C
; C   ON THIRD FAILURE, SET ORDER TO ONE.  THEREAFTER, USE OPTIMAL STEP
; C   SIZE
; C
      IFAIL = IFAIL + 1
      TEMP2 = 0.5D0
      IF (IFAIL - 3 GT 0) THEN BEGIN
          IF (P5EPS LT 0.25D0*ERK) THEN TEMP2 = SQRT(P5EPS/ERK)
      ENDIF
      IF (IFAIL - 3 GE 0) THEN KNEW = 1L
      H = TEMP2*H
      K = KNEW
      NS = 0L
      IF (ABS(H) LT FOURU*ABS(X)) THEN BEGIN
          CRASH = 1L
          H = (FOURU*ABS(X))*( (H GE 0)?(+1):(-1) )
          EPS = EPS + EPS
          RETURN
      ENDIF

      GOTO, DSTEPS_100
; C       ***     END BLOCK 3     ***
; C
; C       ***     BEGIN BLOCK 4     ***
; C   THE STEP IS SUCCESSFUL.  CORRECT THE PREDICTED SOLUTION, EVALUATE
; C   THE DERIVATIVES USING THE CORRECTED SOLUTION AND UPDATE THE
; C   DIFFERENCES.  DETERMINE BEST ORDER AND STEP SIZE FOR NEXT STEP.
; C                   ***
      DSTEPS_400:
      KOLD = K
      HOLD = H
; C
; C   CORRECT AND EVALUATE
; C
      TEMP1 = H*G(KP1-1)
      IF NOT (NORND) THEN BEGIN
          
          TEMP3 = Y
          RHO = TEMP1*(YP - PHI(*,0)) - PHI(*,15)
          Y = P + RHO
          PHI(*,14) = (Y - P) - RHO
          P = TEMP3
      ENDIF ELSE BEGIN
          TEMP3 = Y
          Y = P + TEMP1*(YP - PHI(*,0))
          P = TEMP3
      ENDELSE

      YP = CALL_FUNCTION(DFNAME, DF, X, Y, PRIVATE, _EXTRA=FA)
      if ddeabm_funcerror NE 0 then return


; C
; C   UPDATE DIFFERENCES FOR NEXT STEP
; C
      PHI(*,KP1-1) = YP - PHI(*,0)
      PHI(*,KP2-1) = PHI(*,KP1-1) - PHI(*,KP2-1)
      FOR I = 0L, K-1 DO BEGIN
          PHI(*,I) = PHI(*,I) + PHI(*,KP1-1)
      ENDFOR
; C
; C   ESTIMATE ERROR AT ORDER K+1 UNLESS:
; C     IN FIRST PHASE WHEN ALWAYS RAISE ORDER,
; C     ALREADY DECIDED TO LOWER ORDER,
; C     STEP SIZE NOT CONSTANT SO ESTIMATE UNRELIABLE
; C
      ERKP1 = 0.0D0
      IF (KNEW EQ KM1  OR  K EQ 12) THEN PHASE1 = 0L
      IF (PHASE1) THEN GOTO, DSTEPS_450
      IF (KNEW EQ KM1) THEN GOTO, DSTEPS_455
      IF (KP1 GT NS) THEN GOTO, DSTEPS_460
      ERKP1 = TOTAL( (PHI(*,KP2-1)/WT)^2 )
      ERKP1 = ABSH*GSTR(KP1-1)*SQRT(ERKP1)
; C
; C   USING ESTIMATED ERROR AT ORDER K+1, DETERMINE APPROPRIATE ORDER
; C   FOR NEXT STEP
; C
      IF (K LE 1) THEN BEGIN
          IF (ERKP1 GE 0.5D0*ERK) THEN GOTO, DSTEPS_460
      ENDIF ELSE BEGIN
          IF (ERKM1 LE MIN([ERK,ERKP1])) THEN GOTO, DSTEPS_455
          IF (ERKP1 GE ERK  OR  K EQ 12) THEN GOTO, DSTEPS_460
      ENDELSE
; C
; C   HERE ERKP1 .LT. ERK .LT. MAX(ERKM1,ERKM2) ELSE ORDER WOULD HAVE
; C   BEEN LOWERED IN BLOCK 2.  THUS ORDER IS TO BE RAISED
; C
; C   RAISE ORDER
; C
      DSTEPS_450:
      K = KP1
      ERK = ERKP1
      GOTO, DSTEPS_460
; C
; C   LOWER ORDER
; C
      DSTEPS_455:
      K = KM1
      ERK = ERKM1
; C
; C   WITH NEW ORDER DETERMINE APPROPRIATE STEP SIZE FOR NEXT STEP
; C
      DSTEPS_460:
      HNEW = H + H
      IF NOT ( (PHASE1) OR $
               (P5EPS GE ERK*TWO(K)) ) THEN BEGIN
          HNEW = H
          IF (P5EPS LT ERK) THEN BEGIN
              TEMP2 = K+1
              R = (P5EPS/ERK)^(1.0D0/TEMP2)
              HNEW = ABSH*MAX([0.5D0,MIN([0.9D0,R])])
              HNEW = MAX([HNEW,FOURU*ABS(X)])
              HNEW = (H GE 0)?(+HNEW):(-HNEW)
          ENDIF
      ENDIF

      if n_elements(max_stepsize) GT 0 then begin
          HNEW = HNEW < max_stepsize(0) > (-max_stepsize(0))
      endif

      H = HNEW
      RETURN
; C       ***     END BLOCK 4     ***
  END


; ------------------------------------------------------------------------

pro DDEABM, DF, T, Y, TOUT0, PRIVATE, FUNCTARGS=fa, STATE=state, $
            CONTROL=control, $
            init=init0, intermediate=intermediate, tstop=TSTOP0, $
            epsrel=RTOL, epsabs=ATOL, status=IDID, $
            TGRID=tgrid, YGRID=ygrid, YPGRID=ypgrid, $
            NGRID=ngrid0, NOUTGRID=nsamp, $
            TIMPULSE=timpulse, YIMPULSE=yimpulse, $
            MAX_STEPSIZE=max_stepsize, $
            NFEV=nfev, errmsg=errmsg, dostatusline=dostatusline

      common ddeabm_func_common, ddeabm_nfev, ddeabm_funcerror

      IDID = -33
      errmsg = ''
      if n_params() EQ 0 then begin
          message, 'USAGE:', /info
          message, '  DDEABM, FUNCNAME, T0, Y0, TOUT, STATE, PRIVATE, '+$
            'FUNCTARGS=fa, INIT=init, [EPSREL=epsrel, EPSABS=epsabs, '+$
            'STATUS=status, /INTERMEDIATE, ...]', /info
          return
      endif

; C***FIRST EXECUTABLE STATEMENT  DDEABM
      NEQ = N_ELEMENTS(Y)

      IF NEQ LT 1 THEN BEGIN
          errmsg = 'The number of equations, NEQ, must be greater than '+$
            'or equal to 1'
          idid = -33L
          RETURN
      ENDIF

      ;; Initialize the number of function evaluations
      ddeabm_nfev = 0L
      nfev = 0L

      ;; Construct the wrapper function to be used
      dfname = 'ddeabm_func'
      dfname = dfname + ((n_elements(private) GT 0)?'1':'0')
      dfname = dfname + ((n_elements(fa) GT 0     )?'e':'n')
      
      ;; If either of the tolerances are undefined, then define with
      ;; default tolerances and with the same number of elements
      if n_elements(rtol) EQ 0 AND n_elements(atol) EQ 0 then begin
          rtol = 1d-4
          atol = 1d-6
      endif else if n_elements(rtol) GT 0 AND n_elements(atol) EQ 0 then begin
          atol = rtol*0d
      endif else if n_elements(atol) GT 0 AND n_elements(rtol) EQ 0 then begin
          rtol = atol*0D
      endif

      ;; Compare to be sure the same number 
      if n_elements(rtol) NE n_elements(atol) $
        OR (n_elements(y) NE n_elements(rtol) AND n_elements(rtol) NE 1) $
        then begin
          errmsg = 'The number of absolute and relative tolerance values '+ $
            'must match the number of equations being solved.'
          idid = -33L
      endif

      ;; Be sure to initialize if there is no state variable
      ;; NOTE: DDEABM uses INIT=0 to mean initialize; INIT=1 means
      ;;       don't initialize, which is the opposite sense from the
      ;;       input keyword.
      userinit = 1-keyword_set(init0)
      if n_elements(state) EQ 0 then userinit = 0L

      ;; Construct the INFO array from keywords
      INFO = [ userinit, n_elements(rtol) GT 1, $
               keyword_set(intermediate), n_elements(tstop0) GT 0]

      ;; Construct the STATE array if this is the first pass
      IF ( INFO(1-1) EQ 0 ) OR N_ELEMENTS(STATE) EQ 0 THEN BEGIN
          STATE = {YPOUT: dblarr(neq), TSTAR: 0D, YP: dblarr(NEQ), $
                   YY: dblarr(NEQ), WT: dblarr(NEQ), P: dblarr(NEQ), $
                   PHI: dblarr(NEQ,16), ALPHA: dblarr(12), BETA: dblarr(12), $
                   PSI: dblarr(12), V: dblarr(12), W: dblarr(12), $
                   SIG: dblarr(13), G: dblarr(13), GI: dblarr(11), $
                   XOLD: 0D, HOLD: 0D, TOLD: 0D, DELSN: 0D, TWOU: 0D, $
                   FOURU: 0D, H: 0D, EPS: 0D, X: 0D, TSTOP: 0D, $
                   START: 0L, PHASE1: 0L, NORND: 0L, STIFF: 0L, $
                   INTOUT: 0L, NS: 0L, KORD: 0L, KOLD: 0L, INTERNAL_INIT: 0L, $
                   KSTEPS: 0L, KLE4: 0L, IQUIT: 0L, KPREV: 0L, IVC: 0L, $
                   IV: lonarr(10), KGI: 0L, NEQ: NEQ, COUNT: 0L}
      ENDIF

      if n_elements(tstop0) GT 0 then $
        state.tstop = tstop0(0)

      IF (STATE.COUNT GE 5) THEN BEGIN
         IF (T EQ STATE.TSTAR) THEN BEGIN
             errmsg = 'AN APPARENT INFINITE LOOP HAS BEEN DETECTED.  '+ $
               'YOU HAVE MADE REPEATED CALLS AT T = '+strtrim(t,2)+ $
               ' AND THE INTEGRATION HAS NOT ADVANCED.  CHECK THE '+ $
               'WAY YOU HAVE SET PARAMETERS FOR THE CALL TO THE '+ $
               'CODE, PARTICULARLY INFO(1-1).'
             RETURN
         ENDIF
     ENDIF

     IF NEQ NE STATE.NEQ THEN BEGIN
         errmsg = 'You have initialized DDEABM with a different number '+$
           'of equations, NEQ, than this call has provided.'
         RETURN
     ENDIF
; C
; C     CHECK LRW AND LIW FOR SUFFICIENT STORAGE ALLOCATION
; C
      IDID=0L
; C
; C     COMPUTE THE INDICES FOR THE ARRAYS TO BE STORED IN THE WORK ARRAY
; C
     YPOUT = STATE.YPOUT
     TSTAR = STATE.TSTAR
     YP    = STATE.YP   
     YY    = STATE.YY   
     WT    = STATE.WT   
     P     = STATE.P    
     PHI   = STATE.PHI  
     ALPHA = STATE.ALPHA
     BETA  = STATE.BETA 
     PSI   = STATE.PSI  
     V     = STATE.V    
     W     = STATE.W    
     SIG   = STATE.SIG  
     G     = STATE.G    
     GI    = STATE.GI   
     XOLD  = STATE.XOLD 
     HOLD  = STATE.HOLD 
     TOLD  = STATE.TOLD 
     DELSN = STATE.DELSN
     TWOU  = STATE.TWOU 
     FOURU = STATE.FOURU

     H     = STATE.H
     EPS   = STATE.EPS
     X     = STATE.X
     TSTOP = STATE.TSTOP


     STATE.TSTAR = T

      IF (INFO(1-1) NE 0) THEN BEGIN
          START = STATE.START
          PHASE1 = STATE.PHASE1
          NORND = STATE.NORND
          STIFF = STATE.STIFF
          INTOUT = STATE.INTOUT
      ENDIF
      
     NS     = STATE.NS
     KORD   = STATE.KORD
     KOLD   = STATE.KOLD
     INTERNAL_INIT   = STATE.INTERNAL_INIT
     KSTEPS = STATE.KSTEPS
     KLE4   = STATE.KLE4
     IQUIT  = STATE.IQUIT
     KPREV  = STATE.KPREV
     IVC    = STATE.IVC
     IV     = STATE.IV
     KGI    = STATE.KGI

     if n_elements(ngrid0) GT 0 then begin
         if NOT keyword_set(intermediate) then begin
             errmsg = 'ERROR: NGRID and /INTERMEDIATE must be specified '+$
               'together'
             return
         endif
         ngrid = round(ngrid0(0))
     endif else begin
         ngrid = n_elements(tout0)
     endelse

     tgrid = dblarr(ngrid)
     ygrid = dblarr(neq, ngrid)
     ypgrid = dblarr(neq, ngrid)
     forward = tout0(0) GT t     ;; 1=FORWARD; 0=BACKWARD

     ki = 1L
     nimpulse = n_elements(timpulse)
     if nimpulse GT 0 then begin
         if nimpulse NE n_elements(yimpulse)/neq then begin
             errmsg = 'ERROR: TIMPULSE and YIMPULSE must have the same '+$
               'number of samples'
             return
         endif

         if forward then begin
             wh = where(timpulse GT tout0(0), ct)
             if ct EQ 0 then ki = nimpulse else ki = min(wh)
         endif else begin
             wh = where(timpulse LT tout0(0), ct)
             if ct EQ 0 then ki = 0L else ki = max(wh)
         endelse

     endif

     ;; Initialize the user function
     if info(1-1) EQ 0 AND keyword_set(control) then begin
         ddeabm_funcerror = call_function(dfname, df, t, $
                                          CONTROL={message: 'INITIALIZE'}, $
                                          y, private, _EXTRA=fa)
         if ddeabm_funcerror LT 0 then begin
             errmsg = 'ERROR: user function failed to initialize'
             goto, FINISH_INTEGRATION
         endif
     endif


     i = 0L   ;; Output grid position counter
     nsamp = 0L
     while (i LT ngrid) do begin
         if keyword_set(dostatusline) then $
           statusline, string(i, ngrid, format='(I8,"/",I8)'), 0, /left
         doimpulse = 0  ;; Signal to process an impulse (0=no; 1=yes; 2=both)
         if keyword_set(intermediate) then begin
             TOUT = TOUT0(0)
         endif else begin
             TOUT = TOUT0(i)

             if (ki GE 0) AND (ki LT nimpulse) then begin
                 if abs(timpulse(ki)-t) LE abs(tout-t) then begin
                     doimpulse = 1
                     if TIMPULSE(ki) EQ TOUT then doimpulse = 2
                     TOUT = TIMPULSE(ki)
                 endif
             endif
         endelse

         ddeabm_funcerror = 0
         DDEABM_DDES, DF,NEQ,T,Y,TOUT,INFO,RTOL,ATOL,IDID,YPOUT, $
           YP,YY,WT,P,PHI, $
           ALPHA,BETA,PSI,V, $
           W,SIG,G,GI,H, $
           EPS,X,XOLD,HOLD, $
           TOLD,DELSN,TSTOP,TWOU, $
           FOURU,START,PHASE1,NORND,STIFF,INTOUT, NS, KORD, KOLD, INTERNAL_INIT, $
           KSTEPS, KLE4, IQUIT, KPREV, IVC, IV, KGI, PRIVATE, FA, dfname, $
           ERRMSG=errmsg, max_stepsize=max_stepsize

         if ddeabm_funcerror NE 0 then begin
             case ddeabm_funcerror of
                 -16:  errmsg = 'ERROR: user function returned non-finite values'
                 else: errmsg = 'ERROR: unknown internal error occurred'
             endcase
             goto, FINISH_INTEGRATION
         endif

         if IDID GT 0 then begin

             ;; === Store the result
             if (doimpulse EQ 0) OR (doimpulse EQ 2) then begin
                 ;; This was not an impulse-only stopping point...
                 ;; Store the result
                 tgrid(i) = T
                 ygrid(*,i) = Y
                 ypgrid(*,i) = YPOUT
                 nsamp = nsamp + 1
                 i = i + 1
             endif

             ;; === Handle any impulse changes
             if (doimpulse GT 0) then begin    
                 ;; Apply an impulse
                 if forward then begin
                     Y = Y + YIMPULSE(*,ki)
                     ki = ki + 1
                 endif else begin
                     Y = Y - YIMPULSE(*,ki)
                     ki = ki - 1
                 endelse

                 ;; Special case: the same TOUT can be listed twice
                 ;;   for before and after an impulse.  In that case
                 ;;   store the same values after we have incremented.
                 if (doimpulse EQ 2) then if (TOUT0(i) EQ TOUT0(i-1)) then begin
                     tgrid(i) = T
                     ygrid(*,i) = Y
                     ;; We have to re-call the function since we
                     ;; crossed the discontinuity.
                     ypgrid(*,i) = call_function(dfname,df, t, y, private,_EXTRA=fa)
                     nsamp = nsamp + 1
                     i = i + 1
                 endif

                 doimpulse = 0
                 info(1-1) = 0L  ;; NOTE that INIT=0 means initialize!!!
             endif

             ;; Reset KSTEPS since we successfully integrated this step
             ksteps = 0L

             ;; End if we reach the stopping point early
             if keyword_set(intermediate) then begin
                 if idid EQ 2 OR idid EQ 3 OR t EQ tout(0) then $
                   goto, FINISH_INTEGRATION
             endif

         endif else begin
             goto, FINISH_INTEGRATION
         endelse

     endwhile

     FINISH_INTEGRATION:

     STATE.YPOUT = YPOUT
     STATE.YP    = YP   
     STATE.YY    = YY   
     STATE.WT    = WT   
     STATE.P     = P    
     STATE.PHI   = PHI  
     STATE.ALPHA = ALPHA
     STATE.BETA  = BETA 
     STATE.PSI   = PSI  
     STATE.V     = V    
     STATE.W     = W    
     STATE.SIG   = SIG  
     STATE.G     = G    
     STATE.GI    = GI   
     STATE.XOLD  = XOLD 
     STATE.HOLD  = HOLD 
     STATE.TOLD  = TOLD 
     STATE.DELSN = DELSN
     STATE.TWOU  = TWOU 
     STATE.FOURU = FOURU
      
     STATE.H     = H
     STATE.EPS   = EPS
     STATE.X     = X
     STATE.TSTOP = TSTOP

     STATE.NS     = NS
     STATE.KORD   = KORD
     STATE.KOLD   = KOLD
     STATE.INTERNAL_INIT   = INTERNAL_INIT
     STATE.KSTEPS = KSTEPS
     STATE.KLE4   = KLE4
     STATE.IQUIT  = IQUIT
     STATE.KPREV  = KPREV
     STATE.IVC    = IVC
     STATE.IV     = IV
     STATE.KGI    = KGI

     STATE.START  = START
     STATE.PHASE1 = PHASE1
     STATE.NORND  = NORND
     STATE.STIFF  = STIFF
     STATE.INTOUT = INTOUT
     NFEV = DDEABM_NFEV

     ;; Pass back INIT to user, and remember to invert the sense
     ;; between the internal variable and the external variable.
     INIT0 = (info(0) EQ 0)
     TSTOP0 = STATE.TSTOP
     ;; XXX what to do about interrupted case where INFO(1-1) is
     ;; negative, and the user must reset it?
     ;; Answer: Add RESUME keyword, and enforce the behavior that
     ;; RESUME must only be set after an interruption.  Must save one
     ;; more variable in STATE with the previous INFO(1-1) value.

      IF (IDID NE (-2)) THEN STATE.COUNT = STATE.COUNT + 1L
      IF (T NE STATE.TSTAR) THEN STATE.COUNT = 0L

      if keyword_set(dostatusline) then begin
          statusline, /close
      endif

      RETURN
      END
;+
; NAME:
;   DEFSUBCELL
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Returns a default subcell suitable for plotting in.
;
; CALLING SEQUENCE:
;   sub = defsubcell( [default] )
;
; DESCRIPTION: 
;
;   DEFSUBCELL returns a "nice" subcell, useful for plotting in.  It
;   gives 8% margins on the left and bottom, and 5% margins on the
;   right and top.
;
;   A set of user-defined default values can be passed in.  Any that
;   are negative are replaced by this function's.
;
; INPUTS:
;
;   DEFAULT - a "default" subcell.  Any elements that are negative are
;             replaced by DEFSUBCELL's notion of the proper margins.
;             This feature is used, for example, by SUBCELLARRAY to
;             make subcells that have special margins on certain sides
;             and default ones on other sides.
;
; OPTIONAL INPUTS:
;   NONE
;
; INPUT KEYWORD PARAMETERS:
;
;   NONE
;
; RETURNS:
;   The new subcell.
;
; PROCEDURE:
;
; EXAMPLE:
;
; SEE ALSO:
;
;   DEFSUBCELL, SUBCELLARRAY
;
; EXTERNAL SUBROUTINES:
;
; MODIFICATION HISTORY:
;   Written, CM, 1997
;
;-
;+
; NAME:
;   DXBREAK
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Sets an IDL breakpoint
;
; CALLING SEQUENCE:
;   DXBREAK, LINE                        ; current procedure (OR)"
;   DXBREAK, 'PROCNAME', LINE            ; named procedure (OR)"
;   DXBREAK, 'path/procname.pro', LINE   ; procedure path (OR)"
;   DXBREAK, PROCNAME, LINE              ; without quotes"
;
; DESCRIPTION: 
;
;   DXBREAK is a convenience routine for setting IDL breakpoints.
;
;   The benefits over the built-in IDL procedure BREAKPOINT are:
;     * fewer characters to type;
;     * full pathname not required, just a procedure name; and
;     * for breakpoints within the current procedure, the file name 
;       is not needed.
;
;   To clear breakpoints, use either DXCLEAR or BREAKPOINT, /CLEAR.
;
; INPUTS:
;
;   LINE - the line number where the breakpoint is to be set.  This
;          value is required.
;
;   PROCNAME - the procedure name in which the breakpoint is to be
;              set.  Note that IDL requires that a procedure be
;              compiled on disk -- console-compiled or .RUN files
;              cannot have breakpoints set.
;
;              The name is one of:
;                * the procedure or function name;
;                * the full path to the procedure or function; OR
;                * an unquoted procedure or function name.
;
;              DXBREAK will search your path to find the correct
;              procedure.  The first file found will be used.
;
;
; KEYWORDS:
;
;   ONCE - if set, then the breakpoint will only occur once.  The same
;          as the ONCE keyword to BREAKPOINT.
;
;   IS_FUNCTION - if set, and there is an ambiguity between whether
;                 PROCNAME is a procedure or a function, then DXBREAK
;                 will assume that it is a function.
;
; EXAMPLE:
;
;   dxbreak, 'myfunc', 50
;
;   Set breakpoint in MYFUNC at line 50.
;
; SEE ALSO:
;
;   BREAKPOINT, DXCLEAR
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;   Addition of NOCATCH keyword for internal testing, 21 Sep 2000, CM
;   Made mostly compatible with IDL v4, 21 Sep 2000, CM
;   Added AFTER keyword, 13 Dec 2000, CM
;   Removed AFTER, use _EXTRA instead, 08 Apr 2001, CM
;
;  $Id: dxbreak.pro,v 1.4 2001/04/08 16:59:55 craigm Exp $
;
;-
; Copyright (C) 2000-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   DXCLEAR
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Clears an IDL breakpoint
;
; CALLING SEQUENCE:
;   DXCLEAR, INDEX
;
; DESCRIPTION: 
;
;   DXBREAK is a convenience routine for clearing IDL breakpoints.
;   Its primary benefits are that it is symmetric with DXBREAK, and it
;   requires fewer characters to type.
;
; INPUTS:
;
;   INDEX - the breakpoint number, as listed by HELP, /BREAKPOINT.
;
;
; EXAMPLE:
;
;   dxclear, 0
;
;   Clear breakpoint number 0
;
; SEE ALSO:
;
;   BREAKPOINT, DXBREAK
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;
;
;  $Id: dxclear.pro,v 1.2 2001/02/09 04:57:15 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   DXCOMMON
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Defines DEBUG_LEVEL common block (INTERNAL)
;
; DESCRIPTION: 
;
;   This code fragment defines the DEBUG_LEVEL common block.  This
;   common is internal to the debugging procedures.
;
;  $Id: dxcommon.pro,v 1.2 2001/02/09 04:57:15 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;
; Define function names just to be sure
;
forward_function routine_names, routine_info

;
; Define DEBUG_LEVEL common block
;
common debug_level, dblevel, dbtraceback

;
; Set common block values 
;
if n_elements(dblevel) EQ 0 then begin
  dblevel = 0L
  dbtraceback = ['']
endif
;+
; NAME:
;   DXDOWN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Move the debugging focus deeper down the IDL call stack
;
; CALLING SEQUENCE:
;   DXDOWN [ , NLEVELS ]
;
; DESCRIPTION: 
;
;   DXDOWN moves the debugging "focus" deeper down the IDL call stack.
;   By using this procedure and DXUP, one can navigate up and down an
;   existing call stack, and examine and set variables at various
;   levels.
;
;   While IDL always keeps the command line at the deepest call level
;   (i.e., where the breakpoint occurred), DXDOWN and its related
;   debugging procedures maintain a separate notion of which part of
;   the call stack they are examining -- the debugging "focus."
;
;   DXDOWN moves the debugging focus deeper by at least one level, but
;   never beyond the deepest level.
;
; INPUTS:
;
;   NLEVELS - option number of levels to move.  Default (and minimum)
;             value is 1.
;
; EXAMPLE:
;
;   dxdown
;
;   Move the debugging focus down one level.
;
; SEE ALSO:
;
;   DXUP, DXDOWN, DXGET, DXSET
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;
;  $Id: dxdown.pro,v 1.2 2001/02/09 04:57:16 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   DXFINISH
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Sets an IDL breakpoint to stop upon return of the current procedure
;
; CALLING SEQUENCE:
;   DXFINISH [ , NLEVELS ]
;
; DESCRIPTION: 
;
;   DXFINISH is a convenience routine for setting IDL breakpoints.
;
;   DXFINISH sets a breakpoint so that when the current procedure
;   finishes, execution will stop.  Often when debugging one wants to
;   let the current procedure complete but stop at the next level.
;   DXFINISH does exactly that.
;
;   DXFINISH examines the state of the current IDL call stack,
;   determines at what point the current procedure will return, and
;   sets a breakpoint there.  Note that the procedure in which the
;   breakpoint is set must be compiled and on disk.
;
;   By default the breakpoint is set with the ONCE keyword.
;
; INPUTS:
;
;   NLEVELS - Number of call levels up to set breakpoint.  Default is
;             1.
;
; KEYWORDS:
;
;   ONCE - if set, then the breakpoint will only occur once.  Default
;          value is SET, so ONCE=0 must be passed explicitly to
;          disable this function.
;
; EXAMPLE:
;
;   dxfinish
;
;   Set breakpoint in calling procedure.
;
; SEE ALSO:
;
;   BREAKPOINT, DXBREAK, DXCLEAR
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;
;  $Id: dxfinish.pro,v 1.2 2001/02/09 04:57:16 craigm Exp $
;  
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   DXGET
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Gets IDL variable from a different IDL call level
;
; CALLING SEQUENCE:
;   RESULT = DXGET('NAME')  ; quoted variable name (OR)
;   RESULT = DXGET(NAME)    ; unquoted variable name
;
; DESCRIPTION: 
;
;   DXGET retrieves a variable value from any point in the IDL call
;   stack.  The DXGET and DXSET routines allow any variable at any
;   level to be examined and changed.
;
;   The call level to be examined is determined by the current
;   debugging "focus."  By default this is the deepest level in the
;   call stack -- where the breakpoint occurred.  However, this level
;   can be changed by using the DXUP and DXDOWN procedures.
;
;   If the variable doesn't exist, then an error message is reported.
;
; INPUTS:
;
;   NAME - the name of the variable, either quoted or unquoted.
;
; KEYWORDS:
;
;   LEVEL - the call level to be examined, if not the current
;           debugging focus.
;
; EXAMPLE:
;
;   value = dxget('a')
;
;   Retrieve the value of the variable A from the debugged call level.
;
; SEE ALSO:
;
;   DXGET, DXSET, DXUP, DXDOWN
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;
;  $Id: dxget.pro,v 1.2 2001/02/09 04:57:16 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   DXHELP
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Perform HELP equivalent at any point in IDL call stack
;
; CALLING SEQUENCE:
;   DXHELP, X0, X1, ..., [ LEVEL=LEVEL ]
;
; DESCRIPTION: 
;
;   DXHELP performs the equivalent of HELP for the variables at any
;   level in the IDL call stack.
;
;   The call level to be examined is determined by the current
;   debugging "focus."  By default this is the deepest level in the
;   call stack -- where the breakpoint occurred.  However, this level
;   can be changed by using the DXUP and DXDOWN procedures.
;
;   If the ALL keyword is set, then all variables are examined.
;
; INPUTS:
;
;   Xi - variables to be examined, either quoted or unquoted.
;        Non-string expressions are diagnosed, but of course refer to
;        the deepest call level.  If the ALL keyword is set then the
;        Xi parameters are ignored.
;
; KEYWORDS:
;
;   LEVEL - the call level to be examined, if not the current
;           debugging focus.
;
;   ALL - if set, then all variables at the current focus level are
;         examined.
;
;
; EXAMPLE:
;
;   dxhelp
;
;   Print all variables at current debugging focus level
;
; SEE ALSO:
;
;   DXUP, DXDOWN, DXHELP, DXPRINT
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;   Added ALL keyword; changed N_PARAMS() EQ 0 behavior, CM 17 Apr
;     2000
;   DXHELP_VALUE now prints correct string and byte values, CM 23 Apr
;     2000
;   Add support for printing structures with FULL_STRUCT, CM 08 Feb
;     2001
;   Added forward_function for DXHELPFORM, CM 08 Apr 2001
;   Print more info about POINTER type, CM 30 Apr 2001
;   
;
;   $Id: dxhelp.pro,v 1.5 2001/04/30 15:26:53 craigm Exp $
;-
; Copyright (C) 2000-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; INCLUDED FROM HELPFORM.PRO
forward_function dxhelpform
function dxhelpform, name0, value, single=single, shortform=short, $
                     width=width0, tagform=tagform, structure=struct, $
                     _EXTRA=extra

  ;; Names of all the known IDL types, as of IDL 5.2
  typenames = ['UNDEFINED', 'BYTE', 'INT', 'LONG', 'FLOAT', 'DOUBLE', $
               'COMPLEX', 'STRING', 'STRUCT', 'DCOMPLEX', 'POINTER', $
               'OBJREF', 'UINT', 'ULONG', $
               'LONG64', 'ULONG64', 'UNKNOWN']
  blanks = string(replicate(32b,80))
  if n_elements(sz) LT 3 then sz = size(value)
  tp = sz(sz(0)+1) < 16

  if n_elements(name0) EQ 0 then name0 = ''
  name = strtrim(name0(0),2)

  nlen = 15  ;; Length of name
  tlen = 9   ;; Length of type name

  if n_elements(width0) EQ 0 then width0 = 80
  width = floor(width0(0))

  if tp EQ 8 AND keyword_set(struct) then begin
      sz1 = size(value)
      if sz1(sz1(0)+1) NE 8 then goto, NOT_STRUCT
      nt = n_tags(value)
      len = n_tags(value, /length)
      tn = tag_names(value)
      sn = tag_names(value, /structure_name)
      
      if sn EQ '' then sn = '<Anonymous>'

      a = string(sn, nt, len, $
             format='("** Structure ",A0,", ",I0," tags, length=",I0,":")')

      for i = 0, nt-1 do begin
          a = [a, '   '+dxhelpform(tn(i), value(0).(i), /tagform)]
      endfor

      return, a
  endif
  NOT_STRUCT:

  if NOT keyword_set(short) then begin
      ;; Pad the name out, or else put the name on a line by itself
      if strlen(name) GT nlen then begin
          if keyword_set(single) then begin
              a1 = name+' '
          endif else begin
              a0 = name
              a1 = strmid(blanks,0,nlen)+' '
          endelse
      endif else begin
          a1 = strmid(name+blanks,0,nlen)+' '
      endelse
      
      a1 = a1 + strmid(typenames(tp)+blanks,0,tlen)
      if NOT keyword_set(tagform) then $
        a1 = a1 +' = '        
  endif else begin
      a1 = strmid(typenames(tp)+blanks,0,tlen)
  endelse

  ndims = sz(0)
  if ndims GT 0 then begin
      ;; It is an array, compose the dimensions
      dims = sz(1:ndims)  
      v = 'Array['
      for i = 0L, ndims-1 do begin
          v = v + strtrim(dims(i),2)
          if i LT ndims-1 then v = v + ', '
      endfor
      v = v + ']'

      ;; If it is a structure, add the structure name (structures are
      ;; never scalars)
      if NOT keyword_set(short) AND tp EQ 8 then begin
          ;; Protect against empty value
          if n_elements(stname) EQ 0 then begin
              if n_elements(value) GT 0 then v0 = value(0) else v0 = {dummy:0}
              sn = tag_names(v0, /structure_name)
              sn = sn(0)
          endif else begin
              sn = strtrim(stname(0),2)
          endelse
          if sn EQ '' then sn = '<Anonymous>'
          v = '-> '+sn+' ' + v 
      endif
  endif else begin
      ;; It is a scalar

      ;; Protect against empty or vector value
      if n_elements(value) GT 0 then begin
          v0 = value(0) 
      endif else begin
          if tp NE 10 AND tp NE 11 then tp = 0
      endelse

      case tp < 16 of 
          0:  v = '<Undefined>'
          1:  v = string(v0, format='(I4)')
          7:  begin
              w = (width - 35) > 5
              if strlen(v0) GT w then $
                v = "'"+strmid(v0,0,w)+"'..." $
              else $
                v = "'"+v0+"'"
          end
          10: begin
              sz = size(v0)
              if sz(sz(0)+1) EQ 10 then v = string(v0(0), /print) $
              else                      v = '<PtrHeapVar>'
          end
          11: begin
              if n_elements(stname) EQ 0 then begin
                  forward_function obj_class
                  sz = size(v0)
                  if sz(sz(0)+1) EQ 11 then sn = '('+obj_class(v0)+')' $
                  else                      sn = ''
              endif else begin
                  sn = '('+strupcase(strtrim(stname(0),2))+')'
              endelse
              v = '<ObjHeapVar'+sn+'>'
          end
          16: v = ''
          else: v = string(v0)
      endcase
  endelse

  if keyword_set(short) then return, a1 + '('+v+')'

  a1 = a1 + v
  if n_elements(a0) GT 0 then return, [a0, a1] else return, a1
end
; END INCLUDE

pro dxhelp, x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, level=level0, all=all, $
            _EXTRA=extra
@dxcommon.pro

  dxlreset
  if n_elements(level0) EQ 0 then level0=dblevel
  level = floor(level0(0))

  ;; Print the current debugging levels
  dxplevel, level=level, current=keyword_set(all)

  ;; Two different behaviors, depending on whether parameters are passed.
  if keyword_set(all) then begin
      
      ;; ALL was set... we extract the names of the variables from the
      ;; procedure itself.
      vars = routine_names(variables=level)
      if n_elements(vars) EQ 1 then $
        if vars(0) EQ '' then return

      for i = 0L, n_elements(vars)-1 do begin
          ;; Retrieve the variable's value, but make sure it is not
          ;; undefined
          name = vars(i)
          val = 0
          if name EQ '' then name = '<Expression>'
          sz = size(routine_names(vars(i), fetch=level))
          dummy = temporary(val)
          if sz(sz(0)+1) NE 0 then val = routine_names(vars(i), fetch=level)
          print, dxhelpform(name, val, _EXTRA=extra), format='(A)'
      endfor
  endif else begin

      ;; ALL was not set, so we examine individual arguments
      if n_params() EQ 0 then return

      thislev = routine_names(/level)
      for i = 0L, n_params()-1 do begin

          ;; First, extract the parameter name using ROUTINE_NAMES magic
          name = ''
          ii = strtrim(i,2)
          cmd = 'name = routine_names(x'+ii+',arg_name=thislev-1)'
          if execute(cmd) NE 1 then goto, NEXT_PARM
          if n_elements(name) LT 1 then goto, NEXT_PARM
          name0 = name(0)
          name = name0
          if name0 EQ '' then begin
              ;; The value might be a quoted string... see if it is!
              cmd = 'val = x'+ii
              if execute(cmd) NE 1 then goto, NEXT_PARM

              sz = size(val)
              if sz(sz(0)+1) EQ 7 then begin
                  ;; It was a string!
                  name0 = val
                  goto, GET_VAL
              endif
              name = '<Expression>'
              val = 0
          endif else begin
              GET_VAL:
              ;; Retrieve the value, again guarding against undefined values
              sz = size(routine_names(name0, fetch=level))
              val = 0
              dummy = temporary(val)
              if sz(sz(0)+1) NE 0 then val = routine_names(name0, fetch=level)
          endelse

          ;; Print it
          print, dxhelpform(name, val, _EXTRA=extra), format='(A)'
          NEXT_PARM:
      endfor
  endelse

end
;+
; NAME:
;   DXLRESET
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Reset the current debugging focus level (INTERNAL)
;
; CALLING SEQUENCE:
;   DXLRESET
;
; DESCRIPTION: 
;
;   DXLRESET resets the current debugging focus level, if it has
;   changed.  This routine is internal to the debugging procedures.
;
; SEE ALSO:
;
;   DXUP, DXDOWN, DXGET, DXSET
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;
;  $Id: dxlreset.pro,v 1.2 2001/02/09 04:57:16 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   DXPLEVEL
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Print the current call stack (INTERNAL)
;
; CALLING SEQUENCE:
;   DXPLEVEL
;
; DESCRIPTION: 
;
;   DXLRESET prints the current call stack, and highlights the
;   debugging focus level.This routine is internal to the debugging
;   procedures.
;
; SEE ALSO:
;
;   DXUP, DXDOWN, DXGET, DXSET
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;
;  $Id: dxplevel.pro,v 1.2 2001/02/09 04:57:17 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   DXPRINT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Perform HELP equivalent at any point in IDL call stack
;
; CALLING SEQUENCE:
;   DXPRINT, X0, X1, ... [, LEVEL=LEVEL, FORMAT=FORMAT ]
;
; DESCRIPTION: 
;
;   DXPRINT prints the values of variables from any level in the IDL
;   call stack.
;
;   The call level to be examined is determined by the current
;   debugging "focus."  By default this is the deepest level in the
;   call stack -- where the breakpoint occurred.  However, this level
;   can be changed by using the DXUP and DXDOWN procedures.
;
; INPUTS:
;
;   Xi - variables to be printed, unquoted.  Non-string expressions
;        are printed, but of course refer to the deepest call level.
;
; KEYWORDS:
;
;   LEVEL - the call level to be examined, if not the current
;           debugging focus.
;
;   FORMAT - format string to be applied to data values.
;
;
; EXAMPLE:
;
;   dxprint, a, b
;
;   Print A and B from the current debugging focus level
;
; SEE ALSO:
;
;   DXUP, DXDOWN, DXHELP, DXPRINT
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;   Corrected FORMAT statement, 30 Jun 2001
;
;  $Id: dxprint.pro,v 1.3 2001/06/30 19:56:04 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   DXPTRACE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Parse the current call stack (INTERNAL)
;
; CALLING SEQUENCE:
;   RESULT = DXPTRACE(STRING)
;
; DESCRIPTION: 
;
;   DXPTRACE is a function which parses the call stack, as returned by
;   HELP, /CALL.  It is internal to the debugging routines.
;
; SEE ALSO:
;
;   DXUP, DXDOWN, DXGET, DXSET
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;
;  $Id: dxptrace.pro,v 1.2 2001/02/09 04:57:17 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   DXSET
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Sets IDL variable in a different IDL call level
;
; CALLING SEQUENCE:
;   DXSET, 'NAME', VALUE    ; quoted variable name (OR)
;   DXSET,  NAME,  VALUE    ; unquoted variable name
;
; DESCRIPTION: 
;
;   DXSET sets a variable value at any point in the IDL call stack.
;   The DXGET and DXSET routines allow any variable at any level to be
;   examined and changed.
;
;   The call level to be examined is determined by the current
;   debugging "focus."  By default this is the deepest level in the
;   call stack -- where the breakpoint occurred.  However, this level
;   can be changed by using the DXUP and DXDOWN procedures.
;
;   If the variable doesn't exist, then an error message is reported,
;   and the variable is not set.
;
; INPUTS:
;
;   NAME - the name of the variable, either quoted or unquoted.
;
;   VALUE - the new value of the variable.
;
; KEYWORDS:
;
;   LEVEL - the call level to be examined, if not the current
;           debugging focus.
;
; EXAMPLE:
;
;   dxset, 'a', 5
;
;   Set the value of the variable A to 5 in the currently debugged
;   call level.
;
; SEE ALSO:
;
;   DXGET, DXSET, DXUP, DXDOWN
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;
;  $Id: dxset.pro,v 1.2 2001/02/09 04:57:18 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   DXUP
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Move the debugging focus higher up the IDL call stack
;
; CALLING SEQUENCE:
;   DXUP [ , NLEVELS ]
;
; DESCRIPTION: 
;
;   DXUP moves the debugging "focus" higher up the IDL call stack.  By
;   using this procedure and DXDOWN, one can navigate up and down an
;   existing call stack, and examine and set variables at various
;   levels.
;
;   While IDL always keeps the command line at the deepest call level
;   (i.e., where the breakpoint occurred), DXUP and its related
;   debugging procedures maintain a separate notion of which part of
;   the call stack they are examining -- the debugging "focus."
;
;   DXUP moves the debugging focus higher by at least one level, but
;   never beyond the "root" $MAIN$ level.
;
; INPUTS:
;
;   NLEVELS - option number of levels to move.  Default (and minimum)
;             value is 1.
;
; EXAMPLE:
;
;   dxup
;
;   Move the debugging focus up one level.
;
; SEE ALSO:
;
;   DXUP, DXDOWN, DXGET, DXSET
;
; MODIFICATION HISTORY:
;   Written, 15 Apr 2000
;
;  $Id: dxup.pro,v 1.2 2001/02/09 04:57:18 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   EOPDATA
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Read and interpolate tabulated earth orientation parameters
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   EOPDATA, JDUTC, PMX, PMY, UT1_UTC, DPSI, DEPS, $
;        /RESET, FILENAME=, ANGUNITS=, TBASE=
;
; DESCRIPTION:
;
;  The procedure EOPDATA reads, interpolates and returns Earth
;  orientation parameters used for precision earth-base astronomy
;  applications.
;
;  ** NOTE: The user is responsible for downloading and maintaining an
;  up-to-date file of earth orientation parameters from the
;  International Earth Rotation Service.  See below. **
;
;  This interface is somewhat provisional.  See OPEN QUESTIONS below.
;
;  The values returned are described below.  These descriptions are
;  taken from the Explanatory Supplement to IERS Bulletins A and B.
;
;    * PMX and PMY, the coordinates of the Celestial Ephemeris Pole
;      (CEP) relative to the earth-fixed International Reference Pole
;      (IRP).  The x-axis is in the direction of the IERS Reference
;      Meridian (IRM), the y-axis is in the direction 90 degrees West
;      longitude.  The time series of PMX and PMY is referred to as
;      "polar motion."
;
;      These are the coordinates of the earth rotation pole, as seen
;      in an *earth-fixed* coordinate system.  A station whose
;      coordinates are given in earth-fixed coordinates referred to
;      the ITRS can be transformed to the earth-fixed coordinates
;      referred to the true rotation pole of date using the following
;      matrix transformation:
;            
;             R_TRUE = RX(PMY) ## RY(PMX) ## R_ITRS
;
;      where the matrices RX and RY are defined below.
;
;    * UT1, the the rotation angle about the pole. It is related to
;      the Greenwich mean sidereal time (GMST) by a conventional
;      relationship (Aoki et al., 1982).  It gives access to the
;      direction of the International Reference Meridian IRM in the
;      ICRS, reckoned around the CEP axis. It is expressed as the
;      difference UT1-UTC.  Thus, the value of UT1 is computed as:
;
;          UT1 = UT1_UTC + UTC
;
;      where UTC is the UTC time, expressed in seconds.
;
;    * DPSI and DEPS are the offsets in longitude and obliquity of the
;      celestial pole with respect to its direction defined using the
;      conventional IAU precession/nutation theory.  An a priori
;      correction model is available in the IERS Conventions (1996),
;      (McCarthy, 1996).  The expressions to compute the nutation
;      angles are:
;
;          DEPS_TRUE = DEPS_1980 + DEPS    ;; Nutation in obliquity
;          DPSI_TRUE = DPSI_1980 + DPSI    ;; Nutation in longitude
;
;      where DPSI_1980 and DEPS_1980 are the nutation values
;      determined from the IAU 1980 Nutation Theory; and DPSI_TRUE and
;      DEPS_TRUE are the nutations to be used as arguments to further
;      precession and nutation computations.
;
;  For requested times which are between tabular values, a linear
;  interpolation is performed.  This is not exactly the correct
;  procedure, and can result in errors of +/- 0.1 mas in the earth
;  polar motion and 1 usec in UT1 (see McCarthy & Gambis 1997).
;
;
; DATA FILES and MAINTENANCE
;
;   The user is responsible for downloading and maintaining the earth
;   orientation parameters file as supplied by the IERS.  The format
;   of the files is the "Final" EOP data ASCII format.  They can be
;   downloaded here:
;
;      ftp://maia.usno.navy.mil/ser7/finals.all   ;; from May 1976-present
;      ftp://maia.usno.navy.mil/ser7/finals.data  ;; from Jan 1992-present
;   
;   The user must place this file in a known location, and in *at
;   least the first call*, this filename must be passed using the
;   FILENAME keyword.
;
;   EOPDATA will load the data once on the first call, and keep a
;   cached copy for subsequent calls.  On a daily basis the file will
;   be reloaded in case the quantities have been updated from the
;   server.  A reload of data can be forced using the RESET keyword.
;
; ROTATION MATRICES
;
;   The rotation matrices RX(T) and RY(T) mentioned above in relation
;   to polar motion are:
;
;      RX(T) =EQ= [[1,0,0], [0,cos(T),sin(T)], [0,-sin(T),cos(T)]]
;      RY(T) =EQ= [[cos(T),0,-sin(T)], [0,1,0], [sin(T),0,cos(T)]]
;      RZ(T) =EQ= [[cos(T),sin(T),0], [-sin(T),cos(T),0], [0,0,1]]
;
;   and are meant to be applied to a vector R as, RX(T) ## R.
;
;
; OPEN QUESTIONS
;
;   How will the transition to a new IERS EOP series be accomplished?
;   Using a keyword?
;
;   Should there be a quality flag?  The EOP file contains a
;   "predicted" flag, and also there are rows which contain no value
;   at all.  These should probably be flagged somehow.
;
;
; INPUTS:
;
;   JDUTC - a vector or scalar, the UTC time for which earth
;           orientation parameters are requested, expressed in Julian
;           Days.  The value of the keyword TBASE is added to this
;           quantity to arrive at the actual Julian date.
;
; OUTPUTS:
;
;   PMX, PMY - the earth-fixed angular coordinates of the celestial
;              ephemeris pole, measured in ANGUNITS units.
;
;   UT1_UTC - the value of UT1 - UTC, expressed in seconds.
;
;   DPSI, DEPS - the corrections to the IAU 1980 theory of Nutation,
;                for nutation in longitude and obliquity, expressed in
;                ANGUNITS units.
;
; KEYWORD PARAMETERS:
;
;   FILENAME - scalar string, on the first call, the name of the file
;              from which earth orientation parameters will be read.
;              Default value: (none)
;
;   TBASE - a fixed epoch time (Julian days) to be added to each value
;           of JDUTC.  Since subtraction of large numbers occurs with
;           TBASE first, the greatest precision is achieved when TBASE
;           is expressed as a nearby julian epoch, JDUTC is expressed
;           as a small offset from the fixed epoch.
;           Default: 0
;
;   ANGUNITS - scalar string, output units of angular parameters.
;              Possible values are 'ARCSEC' or 'RADIAN'.
;              Default value: 'RADIAN'
;
;   RESET - if set, forces EOP file to be re-read.
;
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   HPRNUTANG, TAI_UTC (Markwardt Library)
;   PRECESS, PREMAT, JPRECESS, BPRECESS (IDL Astronomy Library)
;
;
; REFERENCES:
;
;   Aoki, S., Guinot, B., Kaplan, G.H., Kinoshita, H., McCarthy, D.D.,
;     Seidelmann, P.K., 1982: Astron. Astrophys., 105, 359-361.
;
;   McCarthy, D. D. (ed.) 1996: IERS Conventions, IERS T.N. 21.
;     http://maia.usno.navy.mil/conventions.html
;
;   McCarthy, D. \& Gambis, D. 1997, "Interpolating the IERS Earth
;     Orientation Data," IERS Gazette No. 13, 
;     http://maia.usno.navy.mil/iers-gaz13
;     Instructions for high precision EOP data interpolation, not done
;     in this procedure.
;
;   Ray, J. & Gambis, D. 2001, "Explanatory Supplement to IERS
;     Bulletins A and B,"
;     http://hpiers.obspm.fr/iers/bul/bulb/explanatory.html
;
;     Explains meanings of earth orientation parameters used and
;     returned by this procedure.
;
;   Definition of Final EOP data format
;     ftp://maia.usno.navy.mil/ser7/readme.finals
;
; MODIFICATION HISTORY:
;   Written, 30 Jan 2002, CM
;   Documented, 14 Feb 2002, CM
;   Add default message, 01 Mar 2002, CM
;   More robust handling of input file, 10 Mar 2002, CM
;   Fix bug in interpolation of nutation and polar motion adjustments,
;     thanks to Tim Lister, 2014-10-09, CM
;
;  $Id: eopdata.pro,v 1.7 2014/10/20 21:36:16 cmarkwar Exp $
;
;-
; Copyright (C) 2002, 2014, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   FILE_COMPILE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20771
;   Craig.Markwardt@nasa.gov
;
; PURPOSE:
;   Compile an arbitrary procedure
;
; CALLING SEQUENCE:
;   FILE_COMPILE, pathname, ERROR=error, ERRMSG=errmsg
;
; DESCRIPTION: 
;
;   FILE_COMPILE compiles a file containing an IDL procedure or
;   function.  After compilation the user may call the procedure or
;   function.
;
;   If compilation is successful, then ERROR is set to 0.  If the
;   compilation fails, then, ERROR is set to a non-zero error code,
;   and ERRMSG is set to a descriptive error message.
;
; INPUTS:
;
;   PATHNAME - scalar string, path name of file containing IDL
;              procedure or function.  PATHNAME must end in '.pro'.
;              The directory containing the file must be readable and
;              it must be possible to change to that directory as a
;              working directory using CD.
;
; KEYWORDS:
;
;   ERROR - upon return, a scalar integer giving status of
;           compilation, either 0 for success or non-zero for failure.
;
;   ERRMSG - upon return, a scalar string giving a descriptive error
;            message.
;
;   PRO_NAME - upon return, the name of the procedure, with path name
;              and '.pro' suffix removed.
;
; SEE ALSO:
;
;   RESOLVE_ROUTINE
;
; MODIFICATION HISTORY:
;   Documented, CM, Jun 2009
;   Small documentation changes, CM, 2012-10-09
;
;  $Id: file_compile.pro,v 1.2 2012/10/17 23:53:58 cmarkwar Exp $
;
;-
; Copyright (C) 2009, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   FLORMAT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   Craig.Markwardt@nasa.gov
;
; PURPOSE:
;   Format a string with named format variables
;
; CALLING SEQUENCE:
;   RESULT = FLORMAT(FORMAT, [ struct ], [x=x, y=y, ...], [_EXTRA=struct])
;
; DESCRIPTION: 
;
;  The function FLORMAT is used to easily insert a set of named
;  parameters into a string using simple format codes.  The key point
;  is that format strings use *named* parameters instead of the
;  position in the string.
;
;  FLORMAT makes it easy to make maintainable and understandable
;  format codes.  FLORMAT is a convenience routine, which will be most
;  suitable for formatting tabular output, but can be used for any
;  complicated string formatting job where the positional parameters
;  of STRING() become hard to manage.  Users of Python will recognize
;  FLORMAT as implementing "string interpolation."
;
;  The user passes a format string similar to the IDL printf-style
;  format string (i.e. using modified "%" notation), and a set of
;  named fields either by passing a structure, keywords, or both.  The
;  output strings are composed by inserting the named fields into the
;  format string with any requested formatting.
;
;  The function FLORMAT is equivalent to the STRING(...,FORMAT=fmt)
;  method of formatting a string, where the format string is allowed
;  to have the name of the variable. 
;
;  Let us consider an example of formatting a time with hours, minutes
;  and seconds into a string as HH:MM:SS.  One could use FLORMAT()
;  like this,
;
;     result = flormat('%(hour)02d:%(min)02d:%(sec)02d', $
;                      hour=hour, min=min, sec=sec)
;
;  The variables HOUR, MIN and SEC are allowed to be scalars or
;  vectors.  The key point here is that the format string contains the
;  *named* keyword variables (or structure entries).  Unlike STRING(),
;  the actual variables can be passed in any order, since the format
;  string itself describes in what order the values will be assembled.
;  This is similar to string interpolation in Python.
;
;  The same variable can appear multiple times in the format string,
;  but the user only need to specify that variable once.  For example,
;
;     result = flormat('<A="%(href)s">Download %(href)s</A>', $
;                      href='filename.txt')
;
;  Note that HREF appears twice in the format string.
;
; INPUT VARIABLES:
;
;  FLORMAT() allows you to pass in the values as named keywords as
;  shown above, where the keyword values are arrays, or by passing in
;  an array of structures.  A similar example to the one above is,
;  
;     S = replicate({hour: 0, min: 0, sec: 0}, 100)
;     ;   ... fill the structure S with 100 time values ...
;     result = flormat('%(hour)02d:%(min)02d:%(sec)02d', s)
;  
;  In this case S is an array of structures, and the result will be an
;  array of strings with the same number of elements as S.
;
;  Compare this with standard IDL where a FOR-loop is required, no
;  repetition is permitted, and it is difficult to see which format
;  code corresponds to which variable.  For example,
;   
;     for i = 0, n_elements(hour)-1 do begin
;       result(i) = string(hour(i), min(i), sec(i), $
;                          format='(%"%02d:%02d:%02d")')
;
;   The input structure STRUCT may be an array of structures or a
;   structure of arrays.  It is also possible pass *both* a structure
;   STRUCT and keywords.  The important thing is that the each keyword
;   and each STRUCT.FIELD must evaluate to the same number of
;   elements.  If they don't, then the smallest number of elements is
;   used.
;
; PRINTF-STYLE FORMAT CODES
;
;  FLORMAT() uses format codes in either C printf-style format codes
;  (the default), or a new "$" shell-style syntax if /SHELL_STYLE$ is
;  set.
;
;  FLORMAT() assumes that by default the C printf-style format codes
;  are passed.  FLORMAT() uses a slightly short-hand notation for
;  print-style format codes which saves some space and is more
;  flexible.
;
;  Standard printf-style format codes are of the form,
;      FORMAT='(%"...format here...")'     ;; Standard IDL
;  The FLORMAT printf-style format codes simply dispense with the
;  redundant parentheses and percent symbol,
;      FORMAT='...format here...'          ;; FLORMAT notation
;  This notation improves the readability of the format string, since
;  only the actual format string needs to be present.  Also, this
;  notation does not embed one set of quotation marks within another,
;  as the standard IDL notation does, so format strings with quotation
;  marks will be easier to compose.
;
;  Standard IDL format codes look like this,
;        %s - string
;        %d - integer
;        %04d - integer zero-padded to 4 spaces, etc
;
;  The new FLORMAT format strings look like this,
;
;        %(name)s - string based on variable named NAME
;        %(value)d - integer based on variable named VALUE
;        %(index)04d - integer based on variable named INDEX, 
;                      zero-padded to 4 spaces
;
;  As you can see, the only difference is the addition of the variable
;  name in parenthesis.  These names are looked up in the input 
;  keywords and/or structure passed to FLORMAT().
;
; SHELL-STYLE FORMAT CODES
;
;  Shell style "$" is a convenience notation when strict formatting is
;  less important.  Shell-style "$" format strings will be signaled by
;  setting the SHELL_STYLE$ keyword.  Note the trailing dollar-sign
;  '$'.  The format coes will look like this,
;
;       $name   - variable named NAME will be placed here
;       $value  - variable named VALUE will be placed here, etc.
;
;  This is exactly how Unix shell string interpolation works.
;  Variables are substituted into place using their "natural" format
;  code, based on the variable type.
;
;     result = flormat('<A=\"$href\">Download $href</A>', /shell_style$, $
;                      href='filename.txt')
;
;  Note that quotation marks still need to be escaped as \", just the
;  same as calling STRING() or PRINT with a %-style format string.
;
; CAVEATS:
;
;  FLORMAT() is a convenience routine meant mostly to improve the
;  readability and maintainability of format codes. FLORMAT() is not
;  meant for high performance applications.  It spends time parsing
;  the input format string.  It also spends memory building up a
;  temporary output structure.  However, for most applications such as
;  constructing tables of up to thousands of entries, FLORMAT() should
;  be perfectly adequate.
;
;  The name "FLORMAT" is a play on the words "floor-mat" and "format."
;  The "L" in FLORMAT can be thought of standing for "long-form" IDL
;  format codes.
;
; PARAMETERS:
;
;   FORMAT - format string used to 
;
;   STRUCT - input structure containing named entries.  This should
;            either be an array of structures, with each field
;            containing a scalar; or, a structure where each field
;            contains an array with the same number of elements.
;
; RETURNS:
;
;   The resulting formatted strings.  The return value will be an
;   array of strings containing the same number of elements as passed
;   as input.
;
; KEYWORD PARAMETERS:
;
;   SHELL_STYLE$ - if set, then the format string is a shell-style
;                  string.
;
;   All named keywords are available to be used as named formats in
;   your format code.  Values may be either scalar, or vector.
;   Vectors dimensions must match the dimensions of STRUCT (if
;   STRUCT is passed).
;
; EXAMPLE:
;
;  
;  ; Additional examples appear above.
;
; SEE ALSO:
;
;   STRING, Format codes, C print-style format codes
;
; MODIFICATION HISTORY:
;   Written, CM, 14 Sep 2009
;   Finalized and documented, CM, 08 Dec 2011
;
;  $Id: flormat.pro,v 1.9 2013/03/16 23:29:40 cmarkwar Exp $
;
;-
; Copyright (C) 2011, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;;  ;; Replace '"' by '\"' (poor man's REPSTR)
;;  ofmts = strsplit(ofmt, '"', /preserve_null, /extract)
;;  nquote = n_elements(ofmts)-1
;;  if nquote GT 0 then begin
;;      ofmts[0:nquote-1] = ofmts[0:nquote-1] + '\"'
;;      ofmt = strjoin(ofmts)
;;  endif

  ofmt1 = '(%"'+ofmt+'")'
  return, string(outs, format=ofmt1, $
                 am_pm=am_pm, days_of_week=days_of_week, months=months)

end
; COMMON FXFILTER
;  * Defines mapping between normal IDL I/O and FILTER I/O
;  FILTERFLAG - for each LUN, = 1*FILTERED + 2*PIPE + 4*DISK_STORE
;                               FILTERED - use FXG library? 1=yes 0=no
;                               PIPE     - is a pipe?       1=yes 0=no
;                               DISK_STORE - backing store on disk=1 mem=0
;  SEEK_CMD   - for each LUN, procedure to execute when performing POINT_LUN
;  READ_CMD   - for each LUN, procedure to execute when performing READU
;  WRITE_CMD  - for each LUN, procedure to execute when performing WRITEU     
;  CLOSE_CMD  - for each LUN, procedure to execute when performing CLOSE
;
; MODIFICATION HISTORY
;   2000-12-28 Initial revision, CM
;   2007-09-01 Document new values of FILTERFLAG; add MEMCACHE_MAX, add
;     third field to filter suffixes for flags, CM
;   2009-02-12 Interoperability with Windows (scratch dir); handle
;     multiple flags; allow user to set flags, CM
;   2012-04-17 Promote file position pointers to LONG64, CM
; 
;  $Id: fxfilter.pro,v 1.5 2012/04/17 18:31:38 cmarkwar Exp $
;-
; Copyright (C) 1999-2000, 2007, 2009, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; COMMON FXFILTER_CONFIG
;  * Defines general configuration of the filter package
;  * Can be manipulated by FXMAKEMAP
;  SCRATCH_DIR - directory where cache files are stored   (string)
;  BUFFER_MAX  - maximum buffer size (in bytes) of a pipe read (long)
;  BUFFER_GRAN - buffer size granularity (in bytes), should be a large
;                power of 2, probably >= 512 (long)
;  RM_COMMAND  - unix command to use to remove a file (string)
;  CACHE_MAX   - maximum in-memory cache of a filtered file
;
        COMMON FXFILTER_CONFIG, SCRATCH_DIR, BUFFER_MAX, BUFFER_GRAN, $
          RM_COMMAND, MEMCACHE_MAX
        IF N_ELEMENTS(SCRATCH_DIR) EQ 0 THEN BEGIN
            SCRATCH_DIR = GETENV('IDL_TMPDIR')
            BUFFER_GRAN = 4096L
            BUFFER_MAX  = 8L*BUFFER_GRAN
            RM_COMMAND  = '/bin/rm'
            MEMCACHE_MAX   = 10L*1024L*1024LL
        ENDIF

; COMMON FXFILTER_FILTERS
;  * Defines mapping between suffixes and commands used to read them.
;  * Can be manipulated by FXMAKEMAP
;  FILTERS - an array of pairs.  The first of the pair gives the 
;            filename suffix to be mapped (without leading '.'), and
;            the second of the pair gives command to be executed when
;            the suffix is encountered.  The command should be in the
;            form of an IDL format statement which transfers the
;            filename into the command.
;
        COMMON FXFILTER_FILTERS, FILTERS
        IF N_ELEMENTS(FILTERS) EQ 0 THEN BEGIN
            ;            SUFF     FORMAT_COMMAND     FLAGS
            FILTERS = [ $
                        [ 'gz', '("gzip -dc ",A0)', 'COMPRESS' ], $
                        [ 'Z',  '("zcat ",A0)',     ''         ]  $
                      ]
        ENDIF
;+
; NAME:
;   FXGCLOSE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Closes a generic resource
;
; MAJOR TOPICS:
;   File I/O, Pipes, URLs, FITS
;
; CALLING SEQUENCE:
;   FXGCLOSE, UNIT
;
; DESCRIPTION:
;
;   FXGCLOSE closes a generic resource originally opened by FXGOPEN.
;   All associated system resources are freed.
;
;   You must use the specialized 'FXG' style functions to read, write
;   and seek on file units opened with FXGOPEN:
;
;     FXGOPEN  - open resource
;     FXGCLOSE - close resource
;     FXGREAD  - read from resource
;     FXGWRITE - write to resource
;     FXGSEEK  - seek on resource (i.e., perform POINT_LUN)
;
;     FXGFILTERED - determine if resource is a normal file.
;
; INPUTS:
;
;   UNIT - the unit number of the currently open resource.  The unit
;          must have been previously opened by FXGOPEN.
;
; MODIFICATION HISTORY:
;   Written, 1999, CM
;   Documented, 02 Oct 1999, CM
;   Changed copyright notice, 21 Sep 2000, CM
;
;  $Id: fxgclose.pro,v 1.3 2007/09/01 23:03:23 craigm Exp $
;
;-
; Copyright (C) 1999-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   FXGFILTERED
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Determine if a unit has been opened by FXGOPEN.
;
; MAJOR TOPICS:
;   File I/O, Pipes, URLs, FITS
;
; CALLING SEQUENCE:
;   Q = FXGFILTERED(UNIT)
;
; DESCRIPTION:
;
;   FXGFILTERED is a function which determines whether a UNIT has been
;   opened by FXGOPEN and requires special handling.
;
;   In principle, only 'FXG' procedures should be used to access file
;   units returned by FXGOPEN.  However, if the unit turns out to be a
;   normal file then special treatment is not required.  User programs
;   can use the FXGFILTERED function to find out this information.
;
;   If FXGFILTERED returns 0, then normal file-access procedures (such
;   as READU, WRITEU, CLOSE, and POINT_LUN) can be used.  Otherwise,
;   the 'FXG' routines must be used.
;
; INPUTS:
;
;   UNIT - Any file LUN.
;
; RETURNS:
;   0 - resource is a normal file.
;   1 - resource is not a normal file.
;
; EXAMPLE:
;
;  if fxgfiltered(unit) EQ 0 then begin  
;    ;; If zero then can use standard IDL routines
;    point_lun, unit, position
;    readu, unit, buffer
;    close, unit
;  endif
;
; MODIFICATION HISTORY:
;   Written, 1999, CM
;   Documented, 02 Oct 1999, CM
;   Changed copyright notice, 21 Sep 2000, CM
;
; TODO:
;   * Add more protocols
;   * Make more windows friendly
;
;  $Id: fxgfiltered.pro,v 1.3 2007/09/01 23:03:23 craigm Exp $
;
;-
; Copyright (C) 1999-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   FXGOPEN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Open generic resource as a seekable file.
;
; MAJOR TOPICS:
;   File I/O, Pipes, URLs, FITS
;
; CALLING SEQUENCE:
;   FXGOPEN, UNIT, RESOURCE, ACCESS=ACCESS, ERRMSG=ERRMSG
;
; DESCRIPTION:
;
;   FXGOPEN opens a generic "resource" for reading or writing.  A
;   "resource" can be a file or a Unix pipe, or a standard network
;   URL for the http, https, or ftp protocols.  Networked URLs are
;   handled using the Unix command-line program called 'curl'.
;
;   Readable resources are fully random access.  You are permitted to
;   perform seek operations on both files and streams such as Unix
;   pipes.  In the case of a stream, the stream is read upon demand
;   and saved to an on-disk cache.
;
;   FXGOPEN also automatically recognizes some standard Unix file
;   extensions and operates on them.  For example, files ending with
;   '.gz' are recognized as being compressed with gzip, and are passed
;   through gzcat to uncompress them.  You can display existing
;   filename extension mappings and add new ones using the FXMAKEMAP
;   procedure.  This feature also worked with files retrieved over the
;   network, as long as the processing command declared with FXMAKEMAP
;   is able to accept '-' to indicate the data is supplied via
;   standard input.
;
;   The UNIT number is allocated using GET_LUN; however, the internal
;   implementation may allocate more LUNs.  Therefore you must use
;   FXGCLOSE to close the LUN and be sure that all resources are
;   deallocated.
;
;   You must use the specialized 'FXG' style functions to read, write
;   and seek on the resulting unit number:
;
;     FXGOPEN  - open resource
;     FXGCLOSE - close resource
;     FXGREAD  - read from resource
;     FXGWRITE - write to resource
;     FXGSEEK  - seek on resource (i.e., perform POINT_LUN)
;
;     FXGFILTERED - determine if resource is a normal file.
;
; INPUTS:
;
;   UNIT - FXGOPEN will return a LUN in this variable.  It should be
;          subsequently read and written with FXGREAD, FXGWRITE, and
;          closed with FXGCLOSE.
;
;   RESOURCE - a string, describing the resource to be opened.
;              FXGOPEN will automatically determine how to open it
;              according to:
;
;              * If a filename the suffix may be mapped according to
;              FXMAKEMAP.  In that case the appropriate pipe command
;              is opened as a Unix pipe with FXPOPENR.
;
;              * If a string beginning with "|" then the remaining
;              part of the string is interpretted as a Unix pipe
;              command, to be opened with FXPOPENR.
;
;              * If a URL (uniform resource locator), then it is
;              accessed.  Currently supported protocols are:
;
;                file - a local file
;                http - a file served by a web (HTTP) server
;                ftp - a file served an FTP server
;
;              I would like to add some sort of in-memory files,
;              probably with a "mem" protocol.
;
;
; KEYWORD PARAMETERS:
;
;   ACCESS - a string, set to the access privileges of the resource.
;            Possible values are:
; 
;              'R'  - read-only
;              'W'  - write/create
;              'RW' - write/update
;
;            Not all protocols support writing (for example, none of
;            the "pipe" or network protocols supports writing).
;            DEFAULT: 'R'
;
;   ERRMSG - If a named variable is passed with this keyword, an error
;            message is returned: the empty string indicates success;
;            a non-empty string indicates failure.  If a named
;            variable is not passed, and the ERROR keyword is not
;            used, then execution is stopped upon an error.
;
;   ERROR - If a named variable is passed with this keyword, the error
;           status is returned: a zero indicates success; non-zero
;           indicates failure.  If a named variable is not passed, and
;           the ERRMSG keyword is not used, then execution is stopped
;           upon an error.
;
;   SUFFIX - Force a particular file type by specifying the suffix.
;            Default is to extract the suffix from the file name
;            itself.
;
; EXAMPLE:
;
;   fxgopen, unit, 'myfile.gz', errmsg=errmsg
;   if errmsg NE '' then do_error_message
;   bb = bytarr(1000)  ;; Read 1000 bytes
;   fxgread, unit, bb
;   fxgclose, unit
;
;   This example opens the file myfile.gz using FXGOPEN.  It is
;   automatically gunzip'ed on demand as the request for a 1000-byte
;   read is made.
;
; MODIFICATION HISTORY:
;   Written, 1999, CM
;   Documented, 02 Oct 1999, CM
;   Added correct ERROR keyword behavior, 04 Oct 1999, CM
;   Changed copyright notice, 21 Sep 2000, CM
;   Modified to use ARG_PRESENT for ERRMSG and ERROR, 21 Sep 2000, CM
;   Added SUFFIX keyword, 31 Oct 2000, CM
;   Added the HTTP and FTP protocols using curl, 22 Oct 2006, CM
;
; TODO:
;   * Make more windows friendly
;
;  $Id: fxgopen.pro,v 1.5 2009/02/12 02:32:50 craigm Exp $
;
;-
; Copyright (C) 1999-2000,2006 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Utility routine: open a network resource using the 'curl' command
pro fxgopen_curl, unit, resource, suffix, errmsg=errmsg, error=error, _EXTRA=extra
  ;; The curl command automatically redirects to stdout
  cmd = string(resource(0), format='("curl -s ''",A0,"''")')
@fxfilter
  wh = where(suffix EQ filters(0,*), ct)
  ;; Handle the case where the remote file is gzipped, compressed, etc
  ;; XXX: this assumes that the command can take '-' to mean 'stdin'
  if ct GT 0 then cmd = cmd + ' | '+string('-',format=filters(1,wh(0)))
  fxpopenr, unit, cmd, errmsg=errmsg, error=error, _EXTRA=extra
  return
end


PRO FXGOPEN, UNIT, RESOURCE, ACCESS=ACCESS0, errmsg=errmsg, $
             ERROR=error, SUFFIX=suffix0, _EXTRA=extra

  on_error, 2
  error = -1
  errmsg = ''

  ;; Default the parameters
  IF N_ELEMENTS(ACCESS0) EQ 0 THEN ACCESS0='R'
  ACCESS=STRUPCASE(ACCESS0)
  IF ACCESS NE 'R' AND ACCESS NE 'W' AND ACCESS NE 'RW' THEN begin
      MESSAGE = 'ERROR: ACCESS must be R, W, or RW.'
      goto, ERR_RETURN
  endif

  ;; Check that the resource is at least a string.
  sz = size(resource)
  if sz(sz(0)+1) NE 7 then begin
      message = 'ERROR: RESOURCE must be a string.'
      goto, ERR_RETURN
  endif

  ;; Separate the protocol component of a URL
  len = strlen(resource)
  i = 0L
  while i LT len AND strmid(resource, i, 1) NE ':' $
    AND strmid(resource, i, 1) NE '/' do i = i + 1
  if i EQ len OR (i LT len AND strmid(resource, i, 1) EQ '/') then begin
      protocol = 'file'
      location = resource
  endif else begin
      if i EQ 0 OR i EQ len-1 then begin
          message = 'ERROR: incorrect resource name format'
          goto, ERR_RETURN
      endif
      protocol = strmid(resource, 0, i)
      location = strmid(resource, i+1, strlen(resource)-i-1)
  endelse
  
  ;; An ode to DOS: single-letter protocols are probably disk drives
  if strlen(protocol) EQ 1 then begin
      protocol = 'file'
      location = resource
  endif

  ;; Separate the server component
  len = strlen(location)
  i = 0L
  while i LT len AND strmid(location, i, 1) EQ '/' do i = i + 1
  if i EQ 0 OR i EQ 1 then begin ;; No slash, or a single slash -- a local file

      if i EQ len then begin
          message = 'ERROR: incorrect resource name format'
          goto, ERR_RETURN
      endif
      server = ''
      path   = location
  endif else if i EQ 3 then begin ;; Three slashes -- a local file
      server = ''
      path = strmid(location, 2, len-2)
  endif else if i GT 3 then begin ;; Too many slashes
      message = 'ERROR: incorrect resource name format'
      goto, ERR_RETURN
  endif else begin               ;; Format proto://server[/path]
      path = strmid(location, 2, len-2)
      slash = strpos(path, '/')
      if slash EQ -1 then begin  ;; No path
          server = path
          path   = ''
      endif else begin           ;; Server and path
          server = strmid(path, 0, slash)
          path   = strmid(path, slash, strlen(path)-slash)
      endelse
  endelse

  ;; Determine the suffix of the path
  components = str_sep(path, '.')
  len = n_elements(components)
  if len GT 1 then suffix = components(len-1) else suffix = ''
  if n_elements(suffix0) GT 0 then $
    suffix = strtrim(suffix0(0),2)

  ;; Find out if this is a pipe
  if strmid(path, 0, 1) EQ '|' then begin
      if access NE 'R' then begin
          message = 'ERROR: pipes may only be opened with READ access.'
          goto, ERR_RETURN
      endif
      fxpopenr, unit, path, errmsg=errmsg, error=error, _EXTRA=extra
      return
  endif

@fxfilter
  case strlowcase(protocol) of

      ;; FILE access is the only supported protocol currently.
      'file': begin
          wh = where(suffix EQ filters(0,*), ct)
          if ct GT 0 then begin  ;; A filtered file must spawn a pipe

              ;; This file suffix is associated with a PIPE
              if access NE 'R' then begin
                  message = 'ERROR: pipes may only be opened with READ access.'
                  goto, ERR_RETURN
              endif

              ;; Check that the file itself is read-openable.
              openr, unit, path, /get_lun, error=error
              if error NE 0 then goto, OPEN_ERROR
              free_lun, unit

              ;; If it is, then open a pipe on it.
              fmt   = filters(1,wh(0))
              flags = filters(2,wh(0))
              flags = strtrim(strcompress(strupcase(flags)),2)
              compress = 0
              if flags EQ '' then begin
                  cmd = string(path, format=fmt)
              endif else begin
                  case 1 of
                      (strpos(flags,'COMPRESS') GE 0): compress = 1
                  endcase

                  cmd = path
              endelse

              fxpopenr, unit, cmd, compress=compress, $
                errmsg=errmsg, error=error, _EXTRA=extra
              return
          endif else begin

              ;; General file access is achieved through trusty
              ;; OPEN[RWU]

              case access of
                  'R':  openr, unit, path, /block, /get_lun, error=error
                  'W':  openw, unit, path, /block, /get_lun, error=error
                  'RW': openu, unit, path, /block, /get_lun, error=error
              end
              if error NE 0 then begin
                  OPEN_ERROR:
                  ;; Deal with the error condition
                  message = 'ERROR: could not open file "'+path+'"'
                  goto, ERR_RETURN
              endif

              ;; Make sure the FXFILTER entry is zeroed.  We don't
              ;; want trouble!
              filterflag(unit) = 0
              seek_cmd(unit)   = ''
              read_cmd(unit)   = ''
              write_cmd(unit)  = ''
              close_cmd(unit)  = ''
              return
          endelse
      end
      'http':  fxgopen_curl, unit, resource, suffix, errmsg=errmsg, error=error, _EXTRA=extra
      'https': fxgopen_curl, unit, resource, suffix, errmsg=errmsg, error=error, _EXTRA=extra
      'ftp':   fxgopen_curl, unit, resource, suffix, errmsg=errmsg, error=error, _EXTRA=extra
      else: begin

          ;; Sorry... we need more protocols here, but probably with
          ;; an external program such as CURL
          message = 'ERROR: protocol "'+protocol+'" is not supported'
          goto, ERR_RETURN
      end
  endcase

  return

  ERR_RETURN:
  forward_function arg_present  ;; For IDL versions before 5

  if arg_present(errmsg) OR arg_present(error) then begin
      errmsg = message
      return
  endif

  if double(!version.release) LT 5 then begin
      if n_elements(errmsg) NE 0 then begin
          errmsg = message
          return
      endif
  endif
  message, message
end


  
;+
; NAME:
;   FXGREAD
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Perform an unformatted read on a generic resource.
;
; MAJOR TOPICS:
;   File I/O, Pipes, URLs, FITS
;
; CALLING SEQUENCE:
;   FXGREAD, UNIT, BUFFER, TRANSFER_COUNT=TC
;
; DESCRIPTION:
;
;   FXGREAD performs an unformatted read on the unit UNIT.  The UNIT
;   must have previously been opened by FXGOPEN.
;
;   Currently only unformatted reads are permitted because the precise
;   number of bytes to read must be known ahead of time.
;
;   In other respects, this procedure is similar to the READU built-in
;   IDL procedure.
;
;   You must use the specialized 'FXG' style functions to read, write
;   and seek on file units opened with FXGOPEN:
;
;     FXGOPEN  - open resource
;     FXGCLOSE - close resource
;     FXGREAD  - read from resource
;     FXGWRITE - write to resource
;     FXGSEEK  - seek on resource (i.e., perform POINT_LUN)
;
;     FXGFILTERED - determine if resource is a normal file.
;
; INPUTS:
;
;   UNIT - the unit number to operate on.  The unit must have been
;          previously opened by FXGOPEN.
;
;   BUFFER - an array of the desired type and size is passed upon
;            input to FXGREAD.  Only basic types are permitted.  Upon
;            output, the array will have been filled with data from
;            the resource.  The full extent of the transfer can be
;            determined by examining the TRANSFER_COUNT.
;
;
; KEYWORD PARAMETERS:
;
;   TRANSFER_COUNT - upon output, contains the number of elements
;                    transferred to BUFFER.
;
; MODIFICATION HISTORY:
;   Written, 1999, CM
;   Documented, 02 Oct 1999, CM
;   Changed copyright notice, 21 Sep 2000, CM
;
;  $Id: fxgread.pro,v 1.3 2007/09/01 23:03:23 craigm Exp $
;
;-
; Copyright (C) 1999-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   FXGSEEK
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Perform a seek operation on a generic resource.
;
; MAJOR TOPICS:
;   File I/O, Pipes, URLs, FITS
;
; CALLING SEQUENCE:
;   FXGSEEK,  UNIT, POSITION   ;; Sets the current file position
;   FXGSEEK, -UNIT, POSITION   ;; Queries the current file position
;
; DESCRIPTION:
;
;   FXGSEEK performs a seek on the selected resource.  Depending on
;   the sign of UNIT, the current file position is either queried or
;   set, in much the same manner as the built-in IDL procedure
;   POINT_LUN.
;
;   If the resource is a stream, the seek operation does not
;   necessarily force a read until FXGREAD is called (i.e., reads are
;   "lazy").
;
;   You must use the specialized 'FXG' style functions to read, write
;   and seek on file units opened with FXGOPEN:
;
;     FXGOPEN  - open resource
;     FXGCLOSE - close resource
;     FXGREAD  - read from resource
;     FXGWRITE - write to resource
;     FXGSEEK  - seek on resource (i.e., perform POINT_LUN)
;
;     FXGFILTERED - determine if resource is a normal file.
;
; INPUTS:
;
;   UNIT - the unit number to operate on.  The unit must have been
;          previously opened by FXGOPEN.  The operation of FXGSEEK
;          depends on the sign of UNIT.  If UNIT is positive, then the
;          current file position of file UNIT is set to POSITION.  If
;          UNIT is negative, then the current file position of file
;          |UNIT| is placed in the variable POSITION.
;
;   POSITION - Depending on the sign of UNIT, the behavior is
;              different.  When UNIT is positive, POSITION is an input
;              variable containing the new file position.  When UNIT
;              is negative, POSITION is an output variable to contain
;              the file's current file position.
;
; MODIFICATION HISTORY:
;   Written, 1999, CM
;   Documented, 02 Oct 1999, CM
;   Changed copyright notice, 21 Sep 2000, CM
;
;  $Id: fxgseek.pro,v 1.3 2007/09/01 23:03:23 craigm Exp $
;
;-
; Copyright (C) 1999-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   FXGWRITE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Perform an unformatted write to a generic resource.
;
; MAJOR TOPICS:
;   File I/O, Pipes, URLs, FITS
;
; CALLING SEQUENCE:
;   FXWRITE, UNIT, BUFFER, TRANSFER_COUNT=TC
;
; DESCRIPTION:
;
;   FXGWRITE performs an unformatted write to the unit UNIT.  The UNIT
;   must have previously been opened by FXGOPEN with write access.
;
;   Currently only unformatted reads are permitted because the precise
;   number of bytes to written must be known ahead of time.
;
;   In other respects, this procedure is similar to the WRITEU
;   built-in IDL procedure.
;
;   You must use the specialized 'FXG' style functions to read, write
;   and seek on file units opened with FXGOPEN:
;
;     FXGOPEN  - open resource
;     FXGCLOSE - close resource
;     FXGREAD  - read from resource
;     FXGWRITE - write to resource
;     FXGSEEK  - seek on resource (i.e., perform POINT_LUN)
;
;     FXGFILTERED - determine if resource is a normal file.
;
; INPUTS:
;
;   UNIT - the unit number to operate on.  The unit must have been
;          previously opened by FXGOPEN.
;
;   BUFFER - the array to be written. Only basic types are permitted.
;            The actual number of bytes transferred can be determined
;            by examining the TRANSFER_COUNT.
;
;
; KEYWORD PARAMETERS:
;
;   TRANSFER_COUNT - upon output, contains the number of elements
;                    transferred from BUFFER.
;
; MODIFICATION HISTORY:
;   Written, 1999, CM
;   Documented, 02 Oct 1999, CM
;   Changed copyright notice, 21 Sep 2000, CM
;
;  $Id: fxgwrite.pro,v 1.3 2007/09/01 23:03:23 craigm Exp $
;
;-
; Copyright (C) 1999-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   FXMAKEMAP
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Change configuration of FXG - FXFILTER'ed behavior
;
; MAJOR TOPICS:
;   File I/O, Pipes, URLs, FITS
;
; CALLING SEQUENCE:
;   FXMAKEMAP, SUFFIX, COMMAND              or
;   FXMAKEMAP, /INFO                        or
;   FXMAKEMAP, [SCRATCH_DIR=scratch,] [BUFFER_MAX=bufmax,] 
;     [BUFFER_GRAN=bufgran,] [RM_COMMAND=rmcommand,] [/GET]
;
; DESCRIPTION:
;
;   FXMAKEMAP queries or sets the behavior of the FXFILTER family of
;   functions (FXGOPEN, FXGREAD, FXGWRITE, FXGSEEK, and FXGCLOSE).
;
;   To add a new file extension mapping, which associates a filename
;   suffix with a particular Unix pipe command, use the first form of
;   the command.
;
;   To print the current settings, including the file extension maps,
;   use the /INFO form of the command.
;
;   To set an individual parameter, call FXMAKEMAP with the
;   appropriate keyword argument.
;
;   To query an individual parameter, call FXMAKEMAP with /GET and the
;   appropriate keyword argument.
;
; INPUTS:
;
;   SUFFIX - the trailing suffix of the filename to be associated,
;            *without* the period.  For example, for a gzipped file,
;            the suffix is 'gz'
;
;   COMMAND - an IDL-style format command which specifies how the
;             filename should be converted into a Unix pipe command.
;             The actual command is constructed by passing the
;             filename to STRING() with this format string.  For
;             example, to convert a gzip file the proper format string
;             is, '("gzip -dc ",A0)'.
;
; KEYWORD PARAMETERS:
;
;   INFO - print the current settings and return.
;  
;   GET - if this keyword is set, then the following keyword commands
;         cause the current setting to be returned in the specified
;         keyword.  Otherwise the default is to assert a new setting.
;
;   BUFFER_GRAN - the buffer granularity in bytes.  I/O operations on
;                 pipes and streams are performed in multiples of this
;                 size.  Default: 4096 bytes.
;
;   BUFFER_MAX - the maximum allowed buffer size in bytes.  I/O
;                operations on pipes and streams are performed with at
;                most this many bytes.  Default: 32 kbytes.
;
;   RM_COMMAND - the Unix command used to delete files.  
;                Default:  '/bin/rm'
;
;   SCRATCH_DIR - the scratch directory where cache files are stored.
;                 When operations on Unix pipes or streams are
;                 performed, the data are stored in individual files
;                 in this directory.
;
; MODIFICATION HISTORY:
;   Written, 1999, CM
;   Documented, 02 Oct 1999, CM
;   Changed copyright notice, 21 Sep 2000, CM
;   2012-04-17 Promote file position pointers to LONG64, CM
;
;  $Id: fxmakemap.pro,v 1.6 2012/04/17 18:31:38 cmarkwar Exp $
;
;-
; Copyright (C) 1999-2000, 2012 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   FXPBUFFR
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Internal routine to read data from the pipe and store it in a
;            cache file.
;
; DESCRIPTION:
;
;   See the following procedures for appropriate documentation.
;
;     FXGOPEN  - open resource
;     FXGCLOSE - close resource
;     FXGREAD  - read from resource
;     FXGWRITE - write to resource
;     FXGSEEK  - seek on resource (i.e., perform POINT_LUN)
;
;     FXGFILTERED - determine if resource is a normal file.
;
; PARAMETERS
;   unit - LUN of the pipe, *not* the cache file.
;
;   newlen - the new desired length of the file.  After a successful
;            call to FXPBUFFR, the length of the cache file will be at
;            least this long.
;
; Side Effects
;
;  The pipe is read and the cache increases in size.
;
; MODIFICATION HISTORY:
;   Changed copyright notice, 21 Sep 2000, CM
;
;  $Id: fxpbuffr.pro,v 1.3 2007/09/01 23:05:31 craigm Exp $
;
;-
; Copyright (C) 1999-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   FXPCLOSE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Internal routine to close a pipe file.
;
; DESCRIPTION:
;
;   See the following procedures for appropriate documentation.
;
;     FXGOPEN  - open resource
;     FXGCLOSE - close resource
;     FXGREAD  - read from resource
;     FXGWRITE - write to resource
;     FXGSEEK  - seek on resource (i.e., perform POINT_LUN)
;
;     FXGFILTERED - determine if resource is a normal file.
;
; PARAMETERS
;   unit - LUN of the pipe, *not* the cache file.
;
; Side effects
;   The pipe is closed.
;   The cache file is closed and deleted.
;
; MODIFICATION HISTORY:
;   Changed copyright notice, 21 Sep 2000, CM
;
;  $Id: fxpclose.pro,v 1.5 2009/02/12 02:32:50 craigm Exp $
;
;-
; Copyright (C) 1999-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;
; FXPIPE_COMMON - information related to pipes in the FXFILTER package.
;
;  POINTER     - for each LUN, the current file pointer (a long integer)
;  CACHE_UNIT  - for each pipe LUN, the LUN of the cache file.
;  CACHE_LEN   - for each cache LUN, the number of cached bytes.
;  CACHE_MAX   - for each cache LUN, the maximum size of the cache.
;  CACHE_FILE  - for each pipe LUN, the name of the cache file. (a string)
;  EOF_REACHED - for each pipe LUN, a flag indicating whether the end
;                of the pipe has been reached.
;  PROCESS_ID  - for each pipe LUN, the process ID of the pipe
;                command.
;  BYTELENS    - the length in bytes of each IDL data type.
;
; MODIFICATION HISTORY:
;   2000-09-21 Changed copyright notice
;   2007-09-01 Add CACHE_MAX in anticipation of in-memory caching
;   2012-04-17 Promote file position pointers to LONG64, CM
;
;  $Id: fxpcommn.pro,v 1.4 2012/04/17 18:31:38 cmarkwar Exp $
;
;-
; Copyright (C) 1999-2000, 2007, 2012 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;                         0   1   2   3   4   5   6   7   8   9  10  11  12
            BYTELENS = [-1L,  1,  2,  4,  4,  8, 16, -1, -1, 16, $
                        -1,  -1,  2,  4,  8,  8, -1 ]
        ENDIF
;+
; NAME:
;   FXPOPENR
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Internal routine to open a Unix pipe command for read access.
;
; DESCRIPTION:
;
;   See the following procedures for appropriate documentation.
;
;     FXGOPEN  - open resource
;     FXGCLOSE - close resource
;     FXGREAD  - read from resource
;     FXGWRITE - write to resource
;     FXGSEEK  - seek on resource (i.e., perform POINT_LUN)
;
;     FXGFILTERED - determine if resource is a normal file.
;
; Usage: FXPOPENR, UNIT, COMMAND, ERRMSG=ERRMSG
;
; PARAMETERS
;
;   unit - FXPOPENR returns the pipe LUN, created by GET_LUN in this
;          parameter.  The LUN should not be "pre-opened".
;          Unformatted reads on this LUN should be performed with
;          FXPREAD.
;
;   command - a scalar string, the pipe command to execute.  The
;             standard output of the command is redirected into UNIT.
;             Standard error is not redirected.
;
;             A failure of the command can only be discovered upon
;            trying to read from the LUN with FXPREAD.
;
; Keywords
; 
;   errmsg - If set to defined value upon input, an error message is
;            returned upon output.  If no error occurs then ERRMSG is
;            not changed.  If an error occurs and ERRMSG is not
;            defined, then FXPOPENR issues a MESSAGE.
;
; Side Effects
;
;   The pipe command is opened with SPAWN, and an additional cache file
;   is opened with read/write access.
;
;   The FXFILTER family of commons is updated.
;
; MODIFICATION HISTORY:
;   Changed copyright notice, 21 Sep 2000, CM
;   Added the OPEN,/DELETE keyword, so that tmp-files are
;     automatically deleted when closed, 18 Feb 2006, CM
;   Added quotation marks to the list of characters which are
;     protected, while making a tmpfile name, 22 Oct 2006, CM
;   2012-04-17 Promote file position pointers to LONG64, CM
;
;  $Id: fxpopenr.pro,v 1.8 2012/04/17 18:31:38 cmarkwar Exp $
;
;-
; Copyright (C) 1999-2000,2006 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;  Utility program to protect the pipe command
PRO FXPOPENR_WRAP_CMD, CMD, SHELL
  
;  SHELL = '/bin/sh -c '

  WHILE STRMID(CMD, 0, 1) EQ '|' OR STRMID(CMD, 0, 1) EQ ' ' DO $
    CMD = STRMID(CMD, 1, STRLEN(CMD)-1)
;  CMD = SHELL + '"' + CMD + ' 2>/dev/null"'
  CMD = CMD + ' 2>/dev/null'

  RETURN
END

; Utility program to generate a name for the cache file.  It is
; uniquely generated based on the time, the command string, and the
; current call number.
; 
FUNCTION FXPOPENR_TMPNAME, CMD
@fxfilter
  COMMON FXPOPEN_TMPNAME, RANDOM_SEED, SEQ_COUNTER
  IF N_ELEMENTS(RANDOM_SEED) EQ 0 THEN BEGIN
      RANDOM_VAL  = LONG(SYSTIME(1))
      RANDOM_SEED = LONG(RANDOMU(RANDOM_VAL)*DOUBLE(ISHFT(1L,31)))
      SEQ_COUNTER = 0L
  ENDIF

  ;; Take the first fifteen and  characters of the command
  TMPNAME = STRCOMPRESS(CMD, /REMOVE_ALL)

  ;; Build a unique hash name based on the command, the current time,
  ;; and a session-specific seed.  Possible problem here: if several
  ;; sessions are started at the same time with the same command, and
  ;; the commands are executed at the same second, then the temporary
  ;; name will be the same.  I judge the likelihood of all of these
  ;; events to be small.
  
  B = BYTE(CMD) & N = N_ELEMENTS(B)
  ;; Construct a semi-unique hash value for the command string
  HASH = 0L
  FOR I = 0L, N-1 DO HASH = ISHFT(HASH, 2) XOR B(I)
  HASH = HASH XOR LONG(SYSTIME(1)) XOR RANDOM_SEED XOR ISHFT(SEQ_COUNTER,16)
  SEQ_COUNTER = SEQ_COUNTER + 1

  IF STRLEN(TMPNAME) GT 20 THEN BEGIN
      TMPNAME = STRMID(TMPNAME, 0, 15) + STRMID(TMPNAME, N-6, 5)
      N = 20L
  ENDIF
  NEWNAME = ''
  ;; Strip away any non-alpha characters
  FOR I = 0L, N-1 DO BEGIN
      CC = STRMID(TMPNAME, I, 1)
      IF NOT (CC EQ ' ' OR CC EQ '>' OR CC EQ '&' OR CC EQ '|' OR $
              CC EQ '/' OR CC EQ '*' OR CC EQ '?' OR CC EQ '<' OR $
              CC EQ '\' OR $
              CC EQ '"' OR CC EQ "'") THEN $
        NEWNAME = NEWNAME + CC
  ENDFOR
  IF NEWNAME EQ '' THEN NEWNAME = 'fxp'

  RETURN, SCRATCH_DIR + NEWNAME + STRING(ABS(HASH), FORMAT='(Z8.8)')
END

;; Main entry
PRO FXPOPENR, UNIT, CMD, ERRMSG=ERRMSG, ERROR=error, COMPRESS=compress

;; Access the general FXFILTER family of commons, and the
;; FXPIPE_COMMON, which has pipe-specific info.
  ERROR = -1
@fxfilter
@fxpcommn

  IF N_PARAMS() LT 2 THEN BEGIN
      MESSAGE = 'Syntax:  FXPOPEN, UNIT, COMMAND'
      GOTO, ERR_RETURN
  ENDIF

  ;; Initialize filter flags
  FFLAGS = 1L

  if NOT keyword_set(compress) then begin

      ;; Sorry, useful pipes are only available under Unix.
      IF STRUPCASE(!VERSION.OS_FAMILY) NE 'UNIX' THEN BEGIN
          MESSAGE = 'ERROR: FXPOPENR ONLY FUNCTIONS ON UNIX SYSTEMS.'
          GOTO, ERR_RETURN
      ENDIF

      ;; --------- Begin pipe section
      ;; Wrap the command to make sure it is safe
      NEWCMD = CMD
      FXPOPENR_WRAP_CMD, NEWCMD, SHELL
      
      ;; Run the program
      OLDSHELL = GETENV('SHELL')
      ON_IOERROR, SPAWN_FAILED
      IF OLDSHELL NE '/bin/sh' THEN SETENV, 'SHELL=/bin/sh'
      SPAWN, NEWCMD, UNIT=UNIT, PID=PID
      ON_IOERROR, NULL
      SETENV, 'SHELL='+OLDSHELL(0)
      
      ;; Check for error conditions
      IF UNIT LT 1L OR UNIT GT 128L THEN BEGIN
          SPAWN_FAILED:
          SETENV, 'SHELL='+OLDSHELL(0)
          MESSAGE = 'ERROR: SPAWN of "'+NEWCMD+'" FAILED'
          GOTO, ERR_RETURN
      ENDIF

      FFLAGS = FFLAGS OR 2  ;; This is a pipe
      ;; ---- End pipe section
  endif else begin
      
      ;; Compressed data - no PID
      PID = 0L

      OPENR, UNIT, CMD, /get_lun, /compress, error=error
      if error NE 0 then begin
          MESSAGE = 'ERROR: OPEN of compressed file "'+CMD+'" FAILED'
          GOTO, ERR_RETURN
      endif

      ;; FFLAGS (unchanged since it is not a pipe)

  endelse

  ;; Prepare the FXFILTER dispatch table for function calls
  FILTERFLAG(UNIT)  = 1            ;; Flags: XXX will be updated below!
  SEEK_CMD(UNIT)    = 'FXPSEEK'
  READ_CMD(UNIT)    = 'FXPREAD'
  WRITE_CMD(UNIT)   = '-'          ;; This pipe is not writable
  CLOSE_CMD(UNIT)   = 'FXPCLOSE'

  ;; Start filling in the FXPIPE_COMMON
  POINTER(UNIT)    = 0LL           ;; Start of pipe
  PROCESS_ID(UNIT) = PID           ;; Save process ID of pipe
  
  ;; Build a unique cache name
  CACHE_FILENAME = FXPOPENR_TMPNAME(CMD)

  ;; Open the output cache file, retrieving a LUN
  ON_IOERROR, OPEN_ERROR
  OPENW, CACHE, CACHE_FILENAME, /GET_LUN, /DELETE
  ON_IOERROR, NULL

  FFLAGS = FFLAGS OR 4             ;; On-disk backing store

  ;; Error condition on the cache file
  IF CACHE LT 1 OR CACHE GT 128 THEN BEGIN
      OPEN_ERROR:

      ;; Reset to default behavior
      FILTERFLAG(UNIT)  = 0
      SEEK_CMD(UNIT)    = ''
      READ_CMD(UNIT)    = ''
      WRITE_CMD(UNIT)   = ''
      CLOSE_CMD(UNIT)   = ''
      FREE_LUN, UNIT

      MESSAGE = 'ERROR: Unable to open cache file ' + STRTRIM(CACHE_FILENAME,2)
      GOTO, ERR_RETURN
  ENDIF

  ;; Finish filling the pipe information
  CACHE_UNIT(UNIT)  = CACHE
  CACHE_FILE(UNIT)  = CACHE_FILENAME
  POINTER(UNIT)     = 0  ;; At beginning of pipe
  CACHE_LEN(UNIT)   = 0  ;; Currently no data cached
  CACHE_MAX(UNIT)   = 0  ;; Currently no storage allocated for cache
  EOF_REACHED(UNIT) = 0  ;; Not known to be at end-of-file

  ;; Update filter flags
  FILTERFLAG(UNIT)  = FFLAGS        

  GOOD_RETURN:
  ERROR = 0
  RETURN

  ERR_RETURN:
  IF N_ELEMENTS(ERRMSG) NE 0 THEN BEGIN
      ERRMSG = MESSAGE
      RETURN
  ENDIF ELSE MESSAGE, MESSAGE
  RETURN
  
END
;+
; NAME:
;   FXPREAD
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Internal routine to read from a Unix pipe.
;
; DESCRIPTION:
;
;   See the following procedures for appropriate documentation.
;
;     FXGOPEN  - open resource
;     FXGCLOSE - close resource
;     FXGREAD  - read from resource
;     FXGWRITE - write to resource
;     FXGSEEK  - seek on resource (i.e., perform POINT_LUN)
;
;     FXGFILTERED - determine if resource is a normal file.
;
; PARAMETERS
;
;   unit - LUN of the pipe command, *not* the cache file.
;
;   buffer - the buffer to accept the data.  Data is read in
;            *unformatted*.
;
; Side Effects
; 
;   The pipe is read as needed and the cache is populated.
;   The file pointer advances.
;
; MODIFICATIONS
;   Corrected error message, 21 Sep 2000, CM
;   Changed copyright notice, 21 Sep 2000, CM
;
;  $Id: fxpread.pro,v 1.2 2001/03/25 18:10:46 craigm Exp $
;
;-
; Copyright (C) 1999-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   FXPSEEK
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Internal routine to perform seek on a Unix Pipe.
;
; DESCRIPTION:
;
;   See the following procedures for appropriate documentation.
;
;     FXGOPEN  - open resource
;     FXGCLOSE - close resource
;     FXGREAD  - read from resource
;     FXGWRITE - write to resource
;     FXGSEEK  - seek on resource (i.e., perform POINT_LUN)
;
;     FXGFILTERED - determine if resource is a normal file.
;
; PARAMETERS
;
;   unit - the pipe LUN.  If positive, then the file pointer is moved
;          to POSITION in the pipe output.  [ In reality the file
;          pointer is moved in the cache file. ]  If negative, then
;          the file pointer of the file unit -LUN is returned in
;          POSITION.
;
;   position - the file pointer, either passed or returned as defined
;              by UNIT.
;
; Side Effects
;
;   The file pointer may be updated.
;   Actual file accesses are postponed until needed (ie, when FXPREAD
;   is called).
;
; MODIFICATION HISTORY:
;   Changed copyright notice, 21 Sep 2000, CM
;
;  $Id: fxpseek.pro,v 1.2 2001/03/25 18:10:47 craigm Exp $
;
;-
; Copyright (C) 1999-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   GAPNAN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 661, Greenbelt, MD 20770
;   Craig.Markwardt@nasa.gov
;
; PURPOSE:
;   Insert NANs in time series gaps to facilitate plotting
;
; MAJOR TOPICS:
;   Time series
;
; CALLING SEQUENCE:
;   GAPNAN, TT, Y1, [Y2,] [Y3,] [Y4,] [Y5], MAXGAP=, GTI=
;
; DESCRIPTION:
;   This procedure is an covenience procedure for plotting time series
;   which may have gaps.  In other words, a time series where there
;   will be time segments of data, and periods of no data which are
;   considered "gaps."  Sometimes it is desireable to plot the data
;   with lines connecting the data, but no lines across gaps.
;
;   GAPNAN will insert NAN values in time series between gaps.
;   Because an IDL line plot will not connect points with NAN values
;   between them, inserting a NAN value is an effective way of
;   suppressing connecting lines between gaps.
;
;   The user can specify gaps in one of two ways, using either the
;   MAXGAP or the GTI keyword.  The user must specify one of these
;   keywords, but not both.  
;
;   The user can specify the maximum allowable gap size between time
;   series samples using the MAXGAP keyword.  If the time step between
;   samples is larger than MAXGAP then a gap is declared.  (This
;   functionality uses the Markwardt library routine GTISEG.)
;
;   The GTI keyword explicitly designates "good" time intervals.  The
;   user should pass a 2xn array using the GTI keyword, which indicate
;   the start/stop time of each good-time.   If the time samples cross
;   between good time intervals (or if a time sample is noth within a
;   good interval at all), then a gap is declared.  (This
;   functionality uses the Markwardt library routine GTIWHERE.)
;
;   The values Y1, Y2, etc. are the dependent variables.  Up to five
;   dependent variables can be adjusted in one call.
;
; INPUTS:
;   TIME - time variable, used to find gaps.  Upon return, TIME will
;          be modified in-place.  Whereever gaps occur, a new time
;          value will be inserted with the value of NAN.
;
; OPTIONAL INPUTS:
;   Y1, Y2, Y3, Y4, Y5 - the optional dependent variable.  Must have
;          the same number of elements as TIME.  Wherever NANs were
;          inserted in the TIME array, NANs will also be inserted at
;          the corresponding positions of Y1, Y2, etc.  Upon return,
;          these parameters will be modified in-place.  The user may
;          pass up to five dependent variables in one call.
; 
; INPUT KEYWORD PARAMETERS:
;   MAXGAP - maximum gap size between segments, in the same units as
;            the TIME variable.   The user must specify either MAXGAP
;            or GTI, but not both.
;
;   GTI - a 2xN array, in the same units as the TIME variable,
;         indicating "good" time intervals.  The user must specify
;         either MAXGAP or GTI, but not both.
;
; EXAMPLE:
;   ;; Sample data with gap between 3 and 10
;   tt = [1,2,3,    10, 11, 12d]
;   yy = [1,1,1,    2,  2,  2d ]
;   gapnan, tt, yy  maxgap=5

;   ;; Note that a NaN is inserted between 3 and 10, since the actual gap of
;   ;; 7 is larger than the maximum of 5.
;
;
;   ;; Sample data with gap between 3 and 10
;   tt = [1,2,3,    10, 11, 12d]
;   yy = [1,1,1,    2,  2,  2d ]
;
;   ;; Good times from 0.5-2.5 and 10.5-13.0
;   gti = [[0.5,2.5], [10.5,13]]
;   gapnan, tt, yy, gti=gti
;
;   ;; Note that a Nan is inserted between 2 and 3 because the good
;   ;; interval stops at 2.5; a Nan is inserted between 3 and 10, and
;   ;; 10 and 11 because neither 3 nor 10 are within a good interval.
;
;
; MODIFICATION HISTORY:
;   Written and documented, 2010-04-27 CM
;   Added MAXGAP and GTI keywords, 2010-11-13 CM
;   Square bracket array notation, 2011-12-21 CM
;   Bug fix for more than one input array (was ignored), 2012-02-20 CM
;   Bug fix when input GTI is set; defend against array bounds error;
;     add USAGE message, 2013-03-16 CM
;
;-
;+
; NAME:
;   GAUSS1
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Compute Gaussian curve given the mean, sigma and area.
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   YVALS = GAUSS1(XVALS, [MEAN, SIGMA, AREA], SKEW=skew)
;
; DESCRIPTION:
;
;  This routine computes the values of a Gaussian function whose
;  X-values, mean, sigma, and total area are given.  It is meant to be
;  a demonstration for curve-fitting.
;
;  XVALS can be an array of X-values, in which case the returned
;  Y-values are an array as well.  The second parameter to GAUSS1
;  should be an array containing the MEAN, SIGMA, and total AREA, in
;  that order.
;
; INPUTS:
;   X - Array of X-values.
;
;   [MEAN, SIGMA, AREA] - the mean, sigma and total area of the 
;                         desired Gaussian curve.
;
; INPUT KEYWORD PARAMETERS:
;
;   SKEW - You may specify a skew value.  Default is no skew.
;
;   PEAK - if set then AREA is interpreted as the peak value rather
;          than the area under the peak.
;
; RETURNS:
;
;   Returns the array of Y-values.
;
; EXAMPLE:
;
;   p = [2.2D, 1.4D, 3000.D]
;   x = dindgen(200)*0.1 - 10.
;   y = gauss1(x, p)
;
;   Computes the values of the Gaussian at equispaced intervals
;   (spacing is 0.1).  The gaussian has a mean of 2.2, standard
;   deviation of 1.4, and total area of 3000.
;
; REFERENCES:
;
; MODIFICATION HISTORY:
;   Written, Jul 1998, CM
;   Correct bug in normalization, CM, 01 Nov 1999
;   Optimized for speed, CM, 02 Nov 1999
;   Added copyright notice, 25 Mar 2001, CM
;   Added PEAK keyword, 30 Sep 2001, CM
;
;  $Id: gauss1.pro,v 1.4 2001/10/13 17:41:48 craigm Exp $
;
;-
; Copyright (C) 1998,1999,2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   GAUSS1P
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Compute Gaussian curve given the mean, sigma and area (procedure).
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   GAUSS1, XVALS, [MEAN, SIGMA, AREA], YVALS, SKEW=skew
;
; DESCRIPTION:
;
;  This routine computes the values of a Gaussian function whose
;  X-values, mean, sigma, and total area are given.  It is meant to be
;  a demonstration for curve-fitting.
;
;  XVALS can be an array of X-values, in which case the returned
;  Y-values are an array as well.  The second parameter to GAUSS1
;  should be an array containing the MEAN, SIGMA, and total AREA, in
;  that order.
;
; INPUTS:
;   X - Array of X-values.
;
;   [MEAN, SIGMA, AREA] - the mean, sigma and total area of the 
;                         desired Gaussian curve.
;
;   YVALS - returns the array of Y-values.
;
;
; KEYWORD PARAMETERS:
;
;   SKEW - You may specify a skew value.  Default is no skew.
;
; EXAMPLE:
;
;   p = [2.2D, 1.4D, 3000.D]
;   x = dindgen(200)*0.1 - 10.
;   gauss1p, x, p, y
;
;   Computes the values of the Gaussian at equispaced intervals
;   (spacing is 0.1).  The gaussian has a mean of 2.2, standard
;   deviation of 1.4, and total area of 3000.
;
; REFERENCES:
;
; MODIFICATION HISTORY:
;   Transcribed from GAUSS1, 13 Dec 1999, CM
;   Added copyright notice, 25 Mar 2001, CM
;
;  $Id: gauss1p.pro,v 1.2 2001/03/25 18:55:12 craigm Exp $
;
;-
; Copyright (C) 1999,2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   GAUSS2
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Compute Gaussian curve given the mean, sigma and area.
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   YVALS = GAUSS2(X, Y, [XCENT, YCENT, SIGMA, PEAK])
;
; DESCRIPTION:
;
;  This routine computes the values of a Gaussian function whose
;  X-values, mean, sigma, and total area are given.  It is meant to be
;  a demonstration for curve-fitting.
;
;  XVALS can be an array of X-values, in which case the returned
;  Y-values are an array as well.  The second parameter to GAUSS1
;  should be an array containing the MEAN, SIGMA, and total AREA, in
;  that order.
;
; INPUTS:
;   X - 2-dimensional array of "X"-values.
;   Y - 2-dimensional array of "Y"-values.
;
;   XCENT - X-position of gaussian centroid.
;   YCENT - Y-position of gaussian centroid.
;
;   SIGMA - sigma of the curve (X and Y widths are the same).
;
;   PEAK - the peak value of the gaussian function.
;
; RETURNS:
;
;   Returns the array of Y-values.
;
; EXAMPLE:
;
;   p = [2.2D, -0.7D, 1.4D, 3000.D]
;   x = (dindgen(200)*0.1 - 10.) # (dblarr(200) + 1)
;   y = (dblarr(200) + 1) # (dindgen(200)*0.1 - 10.)
;   z = gauss2(x, y, p)
;
;   Computes the values of the Gaussian at equispaced intervals in X
;   and Y (spacing is 0.1).  The gaussian has a centroid position of
;   (2.2, -0.7), standard deviation of 1.4, and peak value of 3000.
;
; REFERENCES:
;
; MODIFICATION HISTORY:
;   Written, 02 Oct 1999, CM
;   Added copyright notice, 25 Mar 2001, CM
;
;  $Id: gauss2.pro,v 1.2 2001/03/25 18:55:13 craigm Exp $
;
;-
; Copyright (C) 1999,2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   GEOGRAV
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Estimate gravitational potential and acceleration by harmonic expansion
;
; MAJOR TOPICS:
;   Physics, Gravity, Geodesy, Spacecraft Navigation
;
; CALLING SEQUENCE:
;   GEOGRAV, GEOGMOD, R, PHI, A [, NMAX=NMAX, MMAX=MMAX, UNITS=UNITS]
;
; DESCRIPTION:
;
;   GEOGRAV estimates the gravitational potential and acceleration due
;   to a non-point central body such as the Earth.  The computation is
;   based on an expansion of the potential spherical harmonics.  The
;   coefficients of the expansion, the Cnm and Snm, are assumed to be
;   known, and available in the GEOGMOD structure (see GEOGREAD).
;   Various gravity solutions are available.
;
;   The user specifies the geocentric position of interest, referred
;   to the earth-fixed coordinates.  The result is the *inertial*
;   gravitational potential and acceleration, expressed in earth-fixed
;   coordinates (i.e., no fictitious potentials or accelerations are
;   applied).  Users should normally rotate the acceleration into
;   inertial coordinates.
;
;   Users can restrict the degree and order of the potential
;   evaluation using the NMAX (order) and MMAX (degree) keywords.
;
;   Input *and* output units are specified using the UNITS keyword,
;   which is an integer value between 1 and 3. The allowed values are:
;
;      UNITS        Accel.       Pot.      Position
;        1  (cgs)   cm/s^2      (cm/s)^2      cm
;        2  (mks)   m/s^2       (m/s)^2        m
;        3  (km)    km/s^2      (km/s)^2      km
;   Note that the input coordinate units must match the desired output
;   units.
;
; INPUTS:
;
;   GEOGMOD - gravity model structure, as returned by GEOGREAD.
;
;   R - earth-fixed position(s) of interest.  Either a 3-vector, for a
;       single evaluation, or a 3xN array, for evaluations of N
;       vectors.
;
;   PHI - upon return, the potential(s). Either a scalar or an
;         N-vector, depending on R.
;
;   A - upon return, the acceleration(s).  Either a 3-vector or a 3xN
;       array, depending on R.
;
;
; KEYWORD PARAMETERS:
;
;   NMAX - maximum spherical harmonic order to evaluate
;
;   MMAX - maximum spherical harmonic degree to evaluate
;
;   UNITS - specifies input and output physical units (see above).
;
;
; IMPLEMENTATION NOTE:
;
;   The computations in this routine are based on recursion relations
;   for fully-normalized associated Legendre polynomials.  They should
;   be stable (and avoid underflow) for evaluations of high order
;   expansions.
;
; EXAMPLE:
;   GEOGREAD, 'egm96', egm96
;   GEOGRAV, egm96, r, phi, a
;
;   Read the gravity model "EGM96" and evaluate it at position "R" in
;   body coordinates.  The potential and acceleration are returned in
;   PHI and A.
;
; REFERENCES:
;
;   Holmes, S. A. & Featherstone, W. E. 2002, "A unified approach to
;     the Clenshaw summation and the recursive computation of very
;     high degree and order normalised associated Legendre functions,"
;     J. Geodesy, 76, 279
;
;   McCarthy, D. D. (ed.) 1996: IERS Conventions, IERS T.N. 21.
;     http://maia.usno.navy.mil/conventions.html
;
;   Pines, S. 1973, "Uniform Representation of the Gravitational
;     Potential and its Derivatives," AIAA J., 11, 1508
;
;   Roithmayr, C. 1996, "Contributions of Spherical Harmonics to
;     Magnetic and Gravitational Fields," NASA Memo, NASA Johnson
;     Space Center, Houston, Texas, USA, 23 Jan 1996
;     (Republished as: NASA/TM2004213007, March 2004
;      URL: http://nssdcftp.gsfc.nasa.gov/models/geomagnetic/igrf/old_matlab_igrf/Contributions.pdf )
;
;   Seidelmann, P.K. 1992, *Explanatory Supplement to the Astronomical
;     Almanac*, ISBN 0-935702-68-7
;
;
; MODIFICATION HISTORY:
;   Written and documented, 05 Jan 2004, CM
;   Documentation additions, CM, 26 Sep 2004
;   Add missing UNITIZE function, CM, 19 Nov 2004
;   Allow MMAX=0 case, CM, 2011-06-26
;
; TODO:
;   Allow perturbations of the main coefficients, because of tides.
;
;  $Id: geograv.pro,v 1.9 2012/02/19 22:44:40 cmarkwar Exp $
;
;-
; Copyright (C) 2004, 2011, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; Utility routine to compute unit vector for each vector
function geograv_unitize, u
  uu = sqrt(total(u^2,1))
  nu = n_elements(uu)
  if nu EQ 1 then return, u/uu(0)
  
  return, u / rebin(reform(uu,1,nu),3,nu)
end

; Main routine to compute gravity for one position
pro geograv_one, geogmod, r, phi, a, $
                 nmax=nmax, mmax=mmax, $
                 unitfact=unitfact, C=C, S=S

  ;; Units        Accel.       Pot.      Position
  ;;  1 - cgs,    cm/s^2      (cm/s)^2      cm
  ;;  2 - mks,    m/s^2       (m/s)^2        m
  ;;  3 - km,     km/s^2      (km/s)^2      km

  rmean = geogmod.a   ;; Mean equatorial radius, in meters always
  mu    = geogmod.mu  ;; GM, in m^3/s^2 always

  rhat = geograv_unitize(r)
  rr = sqrt(total(r^2,1)) / unitfact
  u = rhat(2)

  rho = rmean/rr
  zero = rho*0.

  ;; Pines r_m, i_m.  Uninitialized array, plus the first two
  ;; components to start the recursion relation
  rm = fltarr(mmax+3) + zero & im = rm
  rm(0) = 1 & rm(1) = rhat(0)
  im(0) = 0 & im(1) = rhat(1)

  ;; NORMALIZED Pines Anm matrix.  We only keep one column at a time,
  ;; and the previous one.  Initialize as if we were doing n=1
  Anm = rm*0   & An_1m = Anm
  Anm(0:1) = [u,1]*sqrt(3d)
  An_1m(0) = 1

  ;; Index counters
  nn = lindgen(nmax+2)
  mm = lindgen(mmax+2)

  ;; rho_(n+1) - is overall radial scale factor.  NOTE: (mu/rr) term
  ;;             comes at the end.  We start at n = 1
  rho_n1 = (rmean/rr)^2
  rho_n  = (rmean/rr)

  ;; n = 0 term of Pines eqns (30)
  ax = 0d & ay = 0d & az = 0d

  ;; Pines eqns (30b) -- dominant spherical term (NOTE again, -mu/rr
  ;;                     term comes at the end)
  ar = - C(0,0) / rr  ;; radial accel
  phi = C(0,0)        ;; potential

  ;; Note: start at n = 1
  n = 1L
  while (n LE nmax) do begin
      ;; Extract normalized Cnm and Snm coefficients
      mmax1 = n < mmax
      Cnm = reform(C(n,0:mmax1)) & Snm = reform(S(n,0:mmax1))

      ;; Also the rm and im coefficients
      rmm = rm(0:mmax1)  & imm = im(0:mmax1)
      if mmax1 GT 0 then begin
         rm1 = [0,rm(0:mmax1-1)] & im1 = [0,im(0:mmax1-1)]
      endif else begin
         rm1 = [0]               & im1 = [0]
      endelse

      ;; Pines eqns (27), multipliers for potential and gradient
      Dnm = Cnm*rmm + Snm*imm
      Enm = Cnm*rm1 + Snm*im1
      Fnm = Snm*rm1 - Cnm*im1

      ;; This is the derivative of Anm with respect to u, NORMALIZED
      if mmax GE 1 then begin
         Apnm = [Anm(1:mmax), 0]
      endif else begin
         Apnm = [0]
      endelse
      Apnm = Apnm * sqrt((n+mm+1d)*(n-mm)>0d)
      Apnm(0) = Apnm(0) / sqrt(2d)  ;; Special normalization for m=0

      ;; Compute accelerations for this order.
      ;; Pines eqns (30) - NOTE: Anm is NORMALIZED
      ;; Note the sum over m
      ax = ax + (rho_n1/rmean) * total(Enm*Anm*mm)
      ay = ay + (rho_n1/rmean) * total(Fnm*Anm*mm)
      az = az + (rho_n1/rmean) * total(Dnm*Apnm)

      ;; Compute radial accel, Pines eqn (30a).  Note, can't use eqn
      ;; (30b) because of normalization issues.
      ar = ar - (rho_n1/rmean) * total(Dnm*((n+1d +mm)*Anm + u*Apnm))

      ;; Potential, Pines eqn (11)
      phi = phi + rho_n * total(Dnm*Anm)


      ;; =================
      ;; Increment to next value of n
      n = n + 1
      if n GT nmax then goto, END_N_LOOP

      ;; ----- Find next values of important matrices 
      tn = 2d*n & tnm1 = 2d*n-1d & tnp1 = 2d*n+1d
          
      ;; === Anm
      An_2m = An_1m ;; Move "n-1" column to "n-2" column 
      An_1m = Anm   ;; Move "n"   column to "n-1" column 
      
      ;; Initialize the recurrence (Pines eqns 23) - NORMALIZED
      ;; note: keeping these sqrt()'s distinct improves precision
      Anm(n) = sqrt(tnp1)/sqrt(tn)*An_1m(n-1)

      ;; Holmes & Featherstone eqns (12) - NORMALIZED
      ;; note: keeping these sqrt()'s distinct improves precision
      mmm = mm(0:n-1)
      xm = sqrt(tnm1*tnp1)/sqrt(double((n-mmm)*(n+mmm)))
      ym = sqrt(tnp1*(n+mmm-1d)*(n-mmm-1d))/sqrt((n-mmm)*(n+mmm)*(2d*n-3d))

      ;; Holmes & Featherstone eqn (11) - NORMALIZED
      Anm(0:n-1) = xm*u*An_1m(0:n-1) - ym*An_2m(0:n-1)

      ;; == rm and im, next terms in recurrence
      rm(n) = rm(1) * rm(n-1) - im(1) * im(n-1)
      im(n) = im(1) * rm(n-1) + rm(1) * im(n-1)

      ;; == rho_n1 ... simple geometric sequence
      rho_n1 = rho_n1 * (rmean/rr)
      rho_n  = rho_n  * (rmean/rr)
      
  endwhile

END_N_LOOP:
  ;; NOTE: now must normalize by (mu/rr)
  phi = phi * (-mu/rr) * unitfact^2

  ;; Compose the cartesian and radial components of the acceleration
  a = [ax,ay,az] + ar*rhat
  a = a * (mu/rr) * unitfact

  return
end

pro geograv, geogmod, r, phi, a, nmax=nmax0, mmax=mmax0, units=units0

  sz = size(geogmod)
  if sz(sz(0)+1) NE 8 then begin
      GEOGMOD_ERROR:
      message, 'ERROR: GEOGMOD must be a gravity model structure', /info
      return
  endif

  ;; Be sure it is a gravity structure
  isgrav = 0
  catch, catcherr
  if catcherr EQ 0 then isgrav = (geogmod.type EQ 'GRAVITY')
  catch, /cancel
  if isgrav EQ 0 then goto, GEOGMOD_ERROR

  if n_elements(nmax0) EQ 0 then nmax = geogmod.nmax else nmax = floor(nmax0(0))
  if n_elements(mmax0) EQ 0 then mmax = geogmod.mmax else mmax = floor(mmax0(0))
  nmax = nmax < geogmod.nmax
  mmax = mmax < geogmod.mmax < nmax

  if n_elements(units0) EQ 0 then begin
      units = 2
  endif else begin
      units = floor(units0(0))
  endelse
  case units of 
      1: unitfact = 100d
      2: unitfact = 1d
      3: unitfact = 0.001d
      else: begin
          message, 'ERROR: UNITS must be one of 1, 2, or 3', /info
          return
      end
  endcase

  ;; Retrieve the normalized coefficients
  C = *(geogmod.Cnm)
  S = *(geogmod.Snm)

  nv = n_elements(r)/3
  a   = fltarr(3,nv) + r(0)*0
  phi = fltarr(nv) + r(0)*0   & if nv EQ 1 then phi = phi(0)
  for i = 0L, nv-1 do begin
      geograv_one, geogmod, r(*,i), phi1, a1, C=C, S=S, $
        nmax=nmax, mmax=mmax, unitfact=unitfact
      
      a(*,i) = a1
      phi(i) = phi1
  endfor

  return
end
;+
; NAME:
;   GEOGREAD
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Read gravity model from disk file
;
; MAJOR TOPICS:
;   Physics, Gravity, Geodesy, Spacecraft Navigation
;
; CALLING SEQUENCE:
;   GEOGREAD, ROOTFILE, MODEL [, STATUS=STATUS, ERRMSG=ERRMSG,
;                               /COEFF_ERR]
;
; DESCRIPTION:
;
;   GEOGREAD reads a gravity model from a disk file.  The gravity
;   model must have already been prepared.  There are a number of
;   freely available models.
;
;   Each model must have a "description" file which describes, in IDL
;   syntax, the name, content and format of the model file.  The
;   ROOTFILE parameter is the name of this description file.  The
;   description must provide the name of the model file (the FILENAME
;   field), which must reside in the same directory.
;
; FILE FORMAT:
;
;   The format of the description file (and hence also the format of
;   the structure returned in GEOGMOD), is as follows, an example
;   modified from egm96.desc:
;
; { $
;   name: 'EGM96', $              ;; Title of the model
;   type: 'GRAVITY', $            ;; Type of model 'GRAVITY' or 'BFIELD'
;   filename: 'EGM96.GEO', $      ;; Model coefficient file name (same dir)
;   reference: 'Lemoine, ...'     ;; Complete literature reference
;   url: 'ftp://ftp.csr.utexas.edu/pub/grav/EGM96.GEO.Z', $   ;; Source URL
;   nmax: 360L, $                 ;; Maximum order (inclusive)
;   mmax: 360L, $                 ;; Maximum degree (inclusive)
;   normalized: 1, $              ;; Coefficients are normalized (1=yes, 0=no)
;   mu: 398600.44150D+09, $       ;; GM for central body [m^3/s^2]
;   a: 6378136.30d, $             ;; Mean equatorial radius [m]
;   tide: 'ZERO', $               ;; Tide system (ZERO, FREE, or MEAN)
;   epoch: 1986.0d, $             ;; Epoch of model coefficients (Julian year)
;   C21: -.1869876359548955D-09,$ ;; C21 coefficient (if not in Cnm table)
;   S21:  .1195280120306540D-08,$ ;; S21 coefficient (if not in Cnm table)
;   C20_dot: 1.16275534D-11,$     ;; C20 rate (unitless; yr^-1)
;   C21_dot: -0.32d-11, $         ;; C21 rate (unitless; yr^-1)
;   S21_dot: +1.62d-11, $         ;; S21 rate (unitless; yr^-1)
;   rowstart: 4L, $               ;; Coefficient starting row (first row = 0)
;   nrows: 65338L, $              ;; Number of coefficient rows in file
;   ncolrange: [6,8], $           ;; Column range for degree (first col = 0)
;   mcolrange: [9,11], $          ;;    "     "    "  order 
;   Ccolrange: [12,30], $         ;;    "     "    "  C coefficients
;   Scolrange: [31,49], $         ;;    "     "    "  S coefficients
;   dCcolrange: [50,62], $        ;;    "     "    "  C std deviation
;   dScolrange: [63,75] $         ;;    "     "    "  S std deviation
; }
;
;   The xCOLRANGE fields describe which character columns in the model
;   file, inclusive, contain the quantity of interest.  You can use a
;   text editor which reports the column number to find these values.
;   Exclude any character columns that contain field delimiters such
;   as commas.
;
;   Since the C21 and S21 coefficients are commonly not included in
;   the table itself, their values are allowed to be specified in the
;   description file.  If the coefficients *are* in the table, then
;   they must be set to zero in the description file to avoid double
;   computations.  The coefficient rates can be used to extrapolate to
;   different epochs from the reference epoch (specified by EPOCH).
; 
;
; INPUTS:
;
;   ROOTFILE - scalar string, the name of the model description file.
;
;   GEOGMOD - upon return, an IDL structure containing the model
;             information.  In addition to the fields listed above,
;             other fields are appended which contain (pointers to)
;             the coefficient data, etc.
;
; KEYWORD PARAMETERS:
;
;   STATUS - upon return, a status indicator.  A value of 1 is OK, 0
;            indicates an error condition.
;
;   ERRMSG - upon return, an error message, if any.  If no error
;            occurred, then ERRMSG is set to ''.
;
;   CEOFF_ERR - if set, then coefficient standard deviations are also
;               read in.q
;
;
; EXAMPLE:
;   GEOGREAD, 'egm96', egm96
;   GEOGRAV, egm96, r, phi, a
;
;   Read the gravity model "EGM96" and evaluate it at position "R" in
;   body coordinates.  The potential and acceleration are returned in
;   PHI and A.
;
; MODIFICATION HISTORY:
;   Documentation additions, CM, 26 Sep 2004
;
;  $Id: geogread.pro,v 1.3 2004/09/26 14:58:19 craigm Exp $
;
;-
; Copyright (C) 2004, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   GTI2MASK
;   
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Convert Good Time Interval (GTI) to evenly sampled mask array
;
; CALLING SEQUENCE:
;   MASK = GTI2MASK(GTI, [TIME, TLIMITS=, TIMEDEL=, NTBINS=,
;                   GOOD=, BAD=, /FILL, /INVERT])
;
; DESCRIPTION: 
;
;   The function GTI2MASK converts an existing valid Good Time
;   Interval (GTI) array to a mask array.  By definition a GTI
;   indicates an array of intervals which are not on an evenly sampled
;   array.  This routine either accepts a time grid from the user, or
;   the grid must be described by the TLIMITS and TIMEDEL keywords.
;
;   The output mask array describes whether each grid point lies
;   within a good interval or not.  There is full control over the
;   values of the good and bad values.
;
;   This routine is the inverse of MASK2GTI.
;
;   It should be noted that this function is not constrained to
;   operation only on time arrays.  It should work on any
;   one-dimensional quantity with intervals.
;
; INPUTS:
;
;   GTI - a 2xNINTERVAL array where NINTERVAL is the number of
;         intervals.  GTI(*,i) represent the start and stop times of
;         interval number i.  The intervals must be non-overlapping
;         and time-ordered (use GTITRIM to achieve this).
;
;         A scalar value of zero indicates that the GTI is empty, ie,
;         there are no good intervals.
;
;   TIME - optional time array that specifies the time grid for the
;          mask array.  If TIME is not specified then the user must
;          give the TLIMITS and TIMEDEL keywords to fully describe the
;          grid spacing.  The TIME array is overwritten if the FILL
;          keyword is used.
;
; KEYWORDS:
;
;   TLIMITS - a 2-element array giving the start and stop limits over
;             which the mask array is to be generated.  The TLIMITS
;             and TIMEDEL keywords are required if the TIME parameter
;             is not given.
;
;   TIMEDEL - a scalar specifying the interval between grid points.
;             The TLIMITS and TIMEDEL keywords are required if the
;             TIME parameter is not given.
;
;   NTBINS - upon return, this keyword contains the number of time
;            samples created.
;
;   GOOD - the value of "good" in the output mask array.
;          Default: 1b
;
;   BAD - the value of "bad" in the output mask array.
;         Default: 0b
;
;   INVERT - if set, the array GTI is treated as a "bad" time
;            interval, ie, the GOOD and BAD values are swapped.
;
;   FILL - if set, the array TIME is filled with values determined
;          from the TLIMITS and TIMEDEL keyword.
;
; RETURNS:
;
;   A mask array, either sampled at the points specified by TIME, or
;   by the grid specified by TLIMITS and TIMEDEL.  The "good" value
;   indicates that the point lies within the good interval, while a
;   "bad" value indicates the point was outside.
;
; SEE ALSO:
;
;   MASK2GTI, GTITRIM, GTIMERGE
;
; MODIFICATION HISTORY:
;   Written, CM, 1997-2001
;   Documented, CM, Apr 2001
;   Add internal OVERLAP and MINFRACEXP keywords, CM, 03 Feb 2007
;   Refine and simplify the OVERLAP processing, CM, 14 Feb 2007
;   Handle case of /OVERLAP when there is no intersection, CM, 22 Aug 2007
;   Use VALUE_LOCATE for performance (in non-OVERLAP case), CM, 04 May 2008
;   Defend against array having one element, CM 2013-04-29
;
;  $Id: gti2mask.pro,v 1.8 2013/04/29 22:42:17 cmarkwar Exp $
;
;-
; Copyright (C) 1997-2001, 2007, 2008, 2013, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   GTIENLARGE
;   
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Enlarge (or shrink) each Good Time Interval (GTI) by fixed amounts
;
; CALLING SEQUENCE:
;   NEWGTI = GTIENLARGE(GTI, COUNT=COUNT, PRE=PRE, POST=POST)
;
; DESCRIPTION: 
;
;   The function GTIENLARGE accepts an existing valid Good Time
;   Interval (GTI) array and creates a new GTI array in which the
;   intervals have been enlarged (or shrunken) by a fixed amount.
;
;   The keywords PRE and POST are used to specify the enlargement.
;   Given an existing good interval such as this one:
;
;                  100                 200              GTI=[[100,200]]
;      <------------|===================|------------->
;
;   a positive value of PRE will enlarge the lead edge of the interval
;   and a positive value of POST will enlarge the trailing edge of the
;   interval.  Thus PRE=10 and POST=20 will create a new interval from
;   the above example:
;
;               90<--                   --->220      NEWGTI=[[ 90,220]]
;      <---------|==.===================.====|-------->
;             PRE=10                   POST=20
;
;   Negative values of PRE and POST are allowed, which will shrink the
;   interval from the leading and trailing edges respectively.
;
;   Users should be aware that the number of intervals may shrink
;   under this operation, since it is possible either for two
;   intervals to be merged if they are enlarged and overlap, or if
;   they are shrunken to a size of zero.
;
;   It should be noted that this function is not constrained to
;   operation only on time arrays.  It should work on any
;   one-dimensional quantity with intervals.
;
; INPUTS:
;
;   GTI - a 2xNINTERVAL array where NINTERVAL is the number of
;         intervals.  GTI(*,i) represents the start and stop times of
;         interval number i.  The intervals must be non-overlapping
;         and time-ordered (use GTITRIM to achieve this).
;
;         A scalar value of zero indicates that the GTI is empty, ie,
;         there are no good intervals.
;
; KEYWORDS:
;
;   PRE - the amount each interval should be enlarged from its leading
;         edge.  A negative value indicates the interval should
;         shrink.
;         Default: 0
;
;   POST - the amount each interval should be enlarged from its
;          trailing edge.  A negative value indicates the interval
;          should shrink. 
;          Default: 0
;
;   COUNT - upon return, the number of resulting intervals.  A value
;           of zero indicates no good time intervals.
;
; RETURNS:
;
;   A new GTI array containing the enlarged or shrunken intervals.
;   The array is 2xCOUNT where COUNT is the number of resulting
;   intervals.  GTI(*,i) represents the start and stop times of
;   interval number i.  The intervals are non-overlapping and
;   time-ordered. 
;
;   If COUNT is zero then the returned array is a scalar value of
;   zero, indicating no good intervals were found.
;
;
; SEE ALSO:
;
;   GTITRIM, GTIENLARGE
;
; MODIFICATION HISTORY:
;   Written, CM, 1997-2001
;   Documented, CM, Apr 2001
;
;  $Id: gtienlarge.pro,v 1.3 2001/04/30 16:03:03 craigm Exp $
;
;-
; Copyright (C) 1997-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   GTIMERGE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Merge two Good Time Interval (GTIs) arrays into a single array
;
; CALLING SEQUENCE:
;   NEWGTI = GTIMERGE(GTI1, GTI2, COUNT=COUNT, [/INTERSECT, /UNION,
;                     /INVERT1, /INVERT2, TTOLERANCE=])
;
; DESCRIPTION: 
;
;   The function GTIMERGE accepts two existing valid Good Time
;   Interval (GTI) arrays and merges them into a single array.  Either
;   the intersection or the union of the two GTIs are returned.
;
;   The intersection refers to the set of intervals which lie in both
;   intervals.  The union refers to the set of intervals which lie in
;   at least one but not necessarily both.  Here is an example of both
;   kinds of operations.  Let us start with two intervals here:
;
;        0              50              100                  170   GTI1
;   <----|==============|----------------|====================|------>
;
;                 30                         120                   GTI2
;   <--------------|==========================|---------------------->
;
;   These intervals would be represented by GTI1=[[0,50],[100,170]]
;   and GTI2=[[30,120]]. The intersection of the two sets of intervals
;   are the points which lie in both, ie [[30,50],[100,120]]:
;
;                 30   50               100  120              INTERSECT
;   <--------------|====|----------------|====|---------------------->
;
;   The union is the combination of both intervals, ie [[0,170]]:
;
;        0                                                   170  UNION
;   <----|====================================================|------>
;
;   It is also possible to treat either one of the input arrays as
;   "bad" intervals using the INVERT1 and/or INVERT2 keywords.  When
;   an interval is inverted, then the output is composed only of areas
;   *outside* the specified intervals.
;
;   It should be noted that this function is not constrained to
;   operation only on time arrays.  It should work on any
;   one-dimensional quantity with intervals.
;
;
; PERFORMANCE:  Combining many intervals
;
;   Users who wish to combine many intervals in sequence will find a
;   performance degradation.  The problem is that each GTIMERGE
;   operation is order N^2 execution time where N is the number of
;   intervals.  Thus, if N mostly distinct GTIs are merged, then the
;   running time will be order N^3.  This is unacceptable, but there
;   is a workaround.
;
;   Users can accumulate "sub" GTIs by merging subsets of the full
;   number of intervals to be merged, and then occasionally merging
;   into the final output GTI.  As an example, here first is a simple
;   merging of 1000 different GTIs:
;
;     totgti = 0L                   ;; Empty GTI
;     FOR i = 0, 999 DO BEGIN
;         gti = ...                
;         totgti = gtimerge(totgti, gti, /union)
;     ENDFOR
;
;   This computation may take a long time.  Instead the merging can be
;   broken into chunks.
;
;     totgti = 0L
;     chgti  = 0L      ;; "Chunk" GTI
;     FOR i = 0, 999 DO BEGIN
;         gti = ...
;         chgti = gtimerge(chgti, gti, /union)
;         if (n_elements(chgti) GT 100) OR (i EQ 999) then begin
;             ;; Merge "chunk" gti into final one, and reset
;             totgti = gtimerge(totgti, chgti, /union)
;             chgti = 0L
;         endif
;     ENDFOR
;
;   Note that the final merge is guaranteed because of the (i EQ 999)
;   comparison.
;
; INPUTS:
;
;   GTI1, GTI2 - the two input GTI arrays.
;
;         Each array is a 2xNINTERVAL array where NINTERVAL is the
;         number of intervals, which can be different for each array.
;         GTI(*,i) represents the start and stop times of interval
;         number i.  The intervals must be non-overlapping and
;         time-ordered (use GTITRIM to achieve this).
;
;         A scalar value of zero indicates that the GTI is empty, ie,
;         there are no good intervals.
;
; KEYWORDS:
;
;   INTERSECT - if set, then the resulting GTI contains only those
;               intervals that are in both input sets.
;
;   UNION - if set, then the resulting GTI contains those intervals
;           that are in either input set.
;
;   COUNT - upon return, the number of resulting intervals.  A value
;           of zero indicates no good time intervals.
;
;   INVERT1 - if set, then GTI1 is considered to be inverted, ie, a
;             set of "bad" intervals rather than good.
;
;   INVERT2 - if set, then GTI2 is considered to be inverted, ie, a
;             set of "bad" intervals rather than good.
;
;   TTOLERANCE - a scalar value indicating the tolerance for
;                determining whether values are equal.  This number
;                can be important for intervals that do not match
;                precisely.
;                Default: Machine precision
;
; RETURNS:
;
;   A new GTI array containing the merged intervals.  The array is
;   2xCOUNT where COUNT is the number of resulting intervals.
;   GTI(*,i) represents the start and stop times of interval number i.
;   The intervals are non-overlapping and time-ordered.
;
;   If COUNT is zero then the returned array is a scalar value of
;   zero, indicating no good intervals were found.
;
; SEE ALSO:
;
;   GTITRIM, GTIENLARGE
;
; MODIFICATION HISTORY:
;   Written, CM, 1997-2001
;   Documented, CM, Apr 2001
;   Handle case of zero-time GTIs, CM, 02 Aug 2001
;   Handle "fractured" GTIs correctly, though worriedly, CM, 15 Oct
;     2001
;   Handle case where both inputs are empty, but /INVERT1 and/or
;     /INVERT2 are set, CM, 08 Aug 2006
;
;  $Id: gtimerge.pro,v 1.7 2006/10/22 09:49:53 craigm Exp $
;
;-
; Copyright (C) 1997-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;      print, '  ', o1(uu(j):uu(j+1)-1), format='(A0,100(D4.0," ",:),$)'
;      print, ' --> ', oo1
;      print, '  ', o2(uu(j):uu(j+1)-1), format='(A0,100(D4.0," ",:),$)'
;      print, ' --> ', oo2

      ;; yes1 and yes2 are updated here, if there is a change in gti state
      if oo1 GE 0 then yes1 = (oo1 EQ 1)
      if oo2 GE 0 then yes2 = (oo2 EQ 1)

      ;; Here are the conditions for starting a new GTI entry
      if (NOT within AND (yes1 OR  yes2) AND keyword_set(union)) OR $
        ( NOT within AND (yes1 AND yes2) AND keyword_set(intersect)) then $
        begin
          tstart = tt(i)
          within = 1
      endif
      if dbl1 AND yes1 then yes1 = 0
      if dbl2 AND yes2 then yes1 = 0

      ;; And the conditions for ending it.
      if (within AND (NOT yes1 AND NOT yes2) AND keyword_set(union)) OR $
        ( within AND (NOT yes1 OR  NOT yes2) AND keyword_set(intersect)) then $
        begin
          if numgti EQ 0 then $
            newgti = [ tstart, tt(i) ] $
          else $
            newgti = [ newgti, tstart, tt(i) ]
          numgti   = numgti + 1
          within   = 0

          if dbl1 OR dbl2 then begin
              ;; Now restart the GTI if desired
              tstart = tt(i)
              within = 1
              dbl1 = 0 & dbl2 = 0
          endif
      endif

      LOOPCONT:
  endfor

  ;; I think this clause is activated only if the INVERT1 or INVERT2
  ;; keywords are activated.  This should be tested.  Boundary
  ;; conditions can be wierd.
  if within then begin
      if numgti EQ 0 then $
        newgti = [ tstart, max(tt) ] $
      else $
        newgti = [ newgti, tstart, max(tt) ]
      numgti   = numgti + 1
      within   = 0
  endif
  
  ;; Empty GTI is a special case.  Here I have opted to *not* take the
  ;; lame HEASARC route.  Instead, I define a single element GTI array
  ;; to mean no good times.
  if numgti EQ 0 then begin
      EMPTY_GTI:
      count = 0L
      return, 0L
  endif

  ;; Reconstitute the new GTI array
  count    = numgti
  newgti   = reform(newgti, 2, numgti, /overwrite)

  ;; Now do some clean-up, removing zero-time GTIs and GTIs that
  ;; adjoin.  This really should not be necessary, since by definition
  ;; the above technique should not create buggy GTIs.
  if numgti GT 0 then begin
      ocount = count
      newgti = gtitrim(newgti, maxgap=ttol, count=count)
  endif

  return, newgti
end
;+
; NAME:
;   GTISEG
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Convert a list of times to a set of Good Time Intervals (GTIs)
;
; CALLING SEQUENCE:
;   GTI = GTISEG(TIMES, COUNT=COUNT, INDICES=INDICES, $
;                MAXGAP=MAXGAP, MINGTI=MINGTI)
;
; DESCRIPTION: 
;
;   The function GTISEG accepts an array of times and converts
;   adjacent data into good time intervals (GTIs).
;
;   Elements of the array are clustered into intervals based on the
;   gaps between times.  If the gaps are small enough then the times
;   are grouped into a single interval.  If a gap exceeds MAXGAP, then
;   an interruption occurs and at least two intervals are formed.
;   Thus, the keyword parameter MAXGAP essentially determines how many
;   and where the intervals will be formed.
;
;   If the time samples are regularly spaced -- aside from gaps --
;   then MAXGAP should be set to a number slightly larger than the
;   spacing to prevent roundoff errors.  By default MAXGAP is set to
;   the difference between the first and second samples.
;
;   For GTISEG, the samples do not need to be regularly spaced, but
;   they *must* be given in ascending order.  Arrays can be sorted
;   with the SORT function.  The primary difference between GTISEG and
;   MASK2GTI is that MASK2GTI assumes the time samples are regularly
;   spaced while GTISEG does not.  Also, MASK2GTI allows intervals to
;   be enlarged or shrunk.
;
;   It should be noted that this function is not constrained to
;   operation only on time arrays.  It should work on any
;   one-dimensional quantity with intervals.
;
; INPUTS:
;
;   TIME - an array of times in ascending order.
;
;
; KEYWORDS:
;
;   MAXGAP - a scalar, the maximum gap between time samples before a
;            new interval is created.  Samples with gaps smaller than
;            this value are grouped into a single GTI.
;            Default: TIME(1) - TIME(0)
;
;   MINGTI - the smallest possible GTI.  Any interval smaller than
;            MINGTI is discarded.
;            Default: 0   (all intervals are accepted)
;
;   COUNT - upon return, the number of resulting intervals.  A value
;           of zero indicates no good time intervals.
;
;   INDICES - upon return, a 2xCOUNT array of integers which give the
;             indices of samples which lie within each interval.  The
;             times TIME(INDICES(0,i) : INDICES(1,i)) fall within the
;             ith interval.
;
; RETURNS:
;
;   A new GTI array containing the enlarged or shrunken intervals.
;   The array is 2xCOUNT where COUNT is the number of resulting
;   intervals.  GTI(*,i) represents the start and stop times of
;   interval number i.  The intervals are non-overlapping and
;   time-ordered. 
;
;   If COUNT is zero then the returned array is a scalar value of
;   zero, indicating no good intervals were found.
;
; SEE ALSO:
;
;   MASK2GTI, GTITRIM, GTIMERGE, GTIWHERE
;
; MODIFICATION HISTORY:
;   Written, CM, 1999-2001
;   Documented, CM, Apr 2001
;   MINGTI now works as documented, in that segments *equal* to MINGTI
;     are now accepted, CM, 30 Oct 2007
;   MINGTI now also affects INDICES, CM, 03 Mar 2008
;   Handle case of scalar input, CM, 2016-04-15
;
;  $Id: gtiseg.pro,v 1.8 2016/05/19 16:12:02 cmarkwar Exp $
;
;-
; Copyright (C) 1999-2001, 2007, 2008, 2016, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   GTITRIM
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Normalize a Good Time Interval (GTI) - no overlapping and adjoining
;
; CALLING SEQUENCE:
;   NEWGTI = GTITRIM(GTI, COUNT=, MAXGAP=, MINGTI=)
;
; DESCRIPTION: 
;
;   A good time interval is by definition a list of intervals which
;   represent "good" or acceptable portions of the real number line.
;   In this library a GTI is a 2xNINTERVAL array where NINTERVAL is
;   the number of intervals.
;
;   The numbers in the array represent the start and stop times of
;   each interval.  Thus, the array [[0,10],[20,30],[40,50]] represent
;   intervals ranging from 0-10, 20-30 and 40-50.  Formally, this
;   example GTI represents times which would satisfy the following
;   expression, for each time T and interval number i:
;       T GE GTI(0,i) AND T LT GTI(1,i)
;   Note that the endpoint is closed on the left but open on the
;   right.
;
;   However, not every 2xNINTERVAL array is a valid or "normalized"
;   GTI as used by this library.  The array must satisfy several
;   conditions:
;      * time ordered (ascending)
;      * no overlapping intervals
;      * no adjoining intervals (intervals that start and stop at the
;        same point; e.g. the point 10 in this array [[0,10],[10,20]])
;
;   A user who desires to create his or her own GTI array can proceed
;   as follows.
;
;   First, the array is placed in time order.  This can be
;   accomplished simply using the built-in function SORT.  This
;   statement sorts the array by start times.
;
;       GTI = GTI(*, SORT(GTI(0,*)))
;
;   Second, the GTITRIM function is used to fully normalize the set of
;   intervals:
;
;       GTI = GTITRIM(GTI)
;
;   After these two procedures the GTI is considered valid and can be
;   passed to the other routines of the library.  Of course if the
;   user can guarantee the above requirements without using GTITRIM
;   then this is acceptable as well.
;
;   It should be noted that this function is not constrained to
;   operation only on time arrays.  It should work on any
;   one-dimensional quantity with intervals.
;
; INPUTS:
;
;   GTI - a 2xNINTERVAL array where NINTERVAL is the number of
;         intervals.  GTI(*,i) represents the start and stop times of
;         interval number i.  The intervals must be non-overlapping
;         and time-ordered (use GTITRIM to achieve this).
;
;         A scalar value of zero indicates that the GTI is empty, ie,
;         there are no good intervals.
;
; KEYWORDS:
;
;   MAXGAP - Maximum allowable gap for merging existing good time
;            intervals.  Intervals with gaps smaller than MAXGAP will
;            be combined into a single interval.
;            Default: 0   (any gap keeps intervals separate)
;
;   MINGTI - Minimum size interval.  If any interval is smaller than
;            MINGTI then it is discarded.
;            Default: 0   (all intervals are preserved)
;
;   COUNT - upon return, the number of resulting intervals.  A value
;           of zero indicates no good time intervals.
;
;
; RETURNS:
;
;   A new GTI array containing the normalized intervals.  The array is
;   2xCOUNT where COUNT is the number of resulting intervals.
;   GTI(*,i) represents the start and stop times of interval number i.
;   The intervals are non-overlapping and time-ordered.
;
;   If COUNT is zero then the returned array is a scalar value of
;   zero, indicating no good intervals were found.
;
; SEE ALSO:
;
;   GTIMERGE
;
; MODIFICATION HISTORY:
;   Written, CM, 1997-2001
;   Documented, CM, Apr 2001
;   Corrected bug which bypassed MIN/MAXGTI, CM, 20 Jul 2003
;
;  $Id: gtitrim.pro,v 1.7 2006/10/22 09:50:09 craigm Exp $
;
;-
; Copyright (C) 1997-2001, 2003, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   GTIWHERE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Locate a list of times within a Good Time Interval (GTI) array
;
; CALLING SEQUENCE:
;   WH = GTIWHERE(TIME, GTI, COUNT=, INTERVALS=, /INVERT, /INCLUDE)
;
; DESCRIPTION: 
;
;   The function GTIWHERE is an efficient method to determine which
;   good time interval (GTI) a particular time sample falls into, if
;   any.  The user passes an array of one or more times in the TIME
;   parameter, and GTIWHERE determines which of these times are in a
;   good interval.  The INTERVALS keyword returns an identification of
;   which interval the time fell into.
;
;   It should be noted that this function is not constrained to
;   operation only on time arrays.  It should work on any
;   one-dimensional quantity with intervals.
;
;   The definition of "inside" a good-time interval is
;      TIME GE GTI(0,i) AND TIME LT GTI(1,i)     (INCLUDE=0)
;      TIME GE GTI(0,i) AND TIME LE GTI(1,i)     (INCLUDE=1)
;   where GTI(*,i) is the i'th interval.
;
;   When using /INVERT, the definition of "outside" a bad-time
;   interval is
;      TIME LT GTI(0,i) OR TIME GE GTI(1,i)    (INCLUDE=0)
;      TIME LT GTI(0,i) OR TIME GT GTI(1,i)    (INCLUDE=0)
;
; INPUTS:
;
;   TIME - an array of times, in no particular order.
;
;   GTI - a 2xNINTERVAL array where NINTERVAL is the number of
;         intervals.  GTI(*,i) represents the start and stop times of
;         interval number i.  The intervals must be non-overlapping
;         and time-ordered (use GTITRIM to achieve this).
;
;         A scalar value of zero indicates that the GTI is empty, ie,
;         there are no good intervals.
;
; KEYWORDS:
;
;   COUNT - upon return, the number of resulting intervals.  A value
;           of zero indicates no good time intervals.
;
;   INTERVALS - upon return, an array of integers specifying the
;               interval number each time falls into.  The number of
;               elements of INTERVALS is COUNT (ie, there is one
;               INTERVAL for each returned index).
;
;   INCLUDE - if set then the endpoints are considered closed at both
;             ends; by convention the endpoints are normally treated
;             as closed at the left and open at the right.
;
;   INVERT - if set, the array GTI is treated as a "bad" time
;            interval.  Only times *outside* of the GTI are selected.
;            In this case there are NGTI+1 possible intervals, where
;            NGTI is the number of time intervals passed in GTI.  The
;            indices returned in the INTERVALS keyword start from the
;            "left."
;
; RETURNS:
;
;   An array of integer indices indicating which elements of TIME are
;   within the "good" intervals.  The number of selected elements is
;   COUNT.  If COUNT is zero, then a scalar value of -1L is returned,
;   indicating no selected values.
;
;
; SEE ALSO:
;
;   GTISEG, GTIMERGE, GTIENLARGE
;
; MODIFICATION HISTORY:
;   Written, CM, 1997-2001
;   Documented, CM, Apr 2001
;   Added usage message, CM, 2006 Aug 18
;   Handle the case if /INVERT and /INCLUDE, which changes the
;     boundary conditions slightly, CM, 2007 Dec 15
;   Handle case of empty input GTI and /INVERT; also handle 
;     INVERT in case where MIN(TIME) touches MIN(GTI), CM, 2008 Jul 08
;   Return -1L for no interval found, instead of 0L, CM, 2011 Jan 05
;
;  $Id: gtiwhere.pro,v 1.7 2011/02/09 03:22:48 cmarkwar Exp $
;
;-
; Copyright (C) 1997-2001, 2006, 2007, 2008, 2011 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; CLASS_NAME:
;	HASHTABLE
;
; PURPOSE:
;	A hash table class which associates key strings with arbitrary values
;
; CATEGORY:
;	Data Structures
;
; SUPERCLASSES:
;       None.
;
; SUBCLASSES:
;       This class has no subclasses.
;
; CREATION:
;       See HASHTABLE::INIT
;
; DESCRIPTION:
;
;       This is a hash table class.  With this data structure, users
;       can associate arbitrary values (scalars, arrays, structures,
;       objects, etc) with a scalar string "key."  The hash table is a
;       collection of (key,value) associations.  Users may dynamically
;       add and remove entries.
;
;       Upon initialization, users may choose the size of the hash
;       table.  This size should be larger than the expected number of
;       entries in the table.  Regardless of the size of the table, an
;       essentially unlimited number of entries may be stored.
;
;       Duplicate keys may be allowed or disallowed, depending on the
;       NO_DUPLICATES keyword to the initialization method.
;
;
; METHODS:
;       Intrinsic Methods
;       This class has the following methods:
;
;       HASHTABLE::CLEANUP removes an existing hash table object
;       HASHTABLE::INIT    initializes a new hash table object
;       HASHTABLE::ADD     adds a new entry to an existing hash table object
;       HASHTABLE::COUNT   returns the number of entries in a hash table
;       HASHTABLE::REMOVE  removes an entry from an existing hash table
;       HASHTABLE::ISCONTAINED is a KEYNAME contained within a hash table?
;       HASHTABLE::GET     returns value associated with KEYNAME in hash table
;       HASHTABLE::KEYS    returns all the keys in an existing hash table
;       HASHTABLE::STRUCT  returns hash table, converted to a structure
;
;
; EXAMPLE:
;
;       ;; Create hash table object
;       ht = obj_new('hashtable')
;       
;       ;; Add some entries
;       ht->add, 'one', 1     ;; Add the scalar number 1
;       ht->add, 'two', [1,2] ;; Add a vector [1,2]
;       ht->add, 'struct', {alpha: 1, beta: 2} ;; Add a structure
;       ht->add, 'hash', obj_new('hashtable')  ;; Add another hash table!
;
;       ht->add, 'one', 10    ;; Adding a duplicate entry!!
;       ;; NOTE: if you do not wish to allow multiple entries with the
;       ;; same key, then add entries like this:
;       ht->add, 'one', 10, /replace
;       ;; in which case 10 would replace 1.
;
;       ;; Number of entries stored
;       print, ht->count()
;        ---> 5
;       
;       ;; Retreive some entries
;       print, ht->get('two')
;        ---> [1,2]
;
;       ;; How multiple entries are retrieved
;       print, ht->get('one', position=0)  ;; Returns first entry of this key
;        ---> 10
;       print, ht->get('one', position=1)  ;; Returns second entry of this key
;        ---> 1
;       
;       ;; Show number of keys in table
;       print, ht->keys()
;        ---> ['two','one','one','struct', 'hash']
;
;       ;; Destroy hash table
;       obj_destroy, ht
;       
;
; MODIFICATION HISTORY:
; 	Written and documented, Nov 2003, CM
;       Adjusted ::STRHASHVAL to accomodate possible overflow
;         exceptions, Apr 2004, CM
;       Enhanced ::STRHASHVAL to accept empty strings, 03 Jul 2006, CM
;         (thanks to William Dieckmann)
;       "Fixed" the empty-string problem yet again, 23 Oct 2006, CM
;         (thanks again to William Dieckmann)
;       Decrement COUNT variable after deleting keys, 09 Mar 2007, CM
;       Make ::REMOVE more efficient by using WHERE(COMPLEMENT=), 
;         12 Jun 2007, CM
;       Change array notation to square brackets and enforce with
;         compiler option, 15 Jun 2007, CM
;       Add user-defined "null" value for missing elements, 
;         15 Jun 2007, CM
;       Convert to [] array index notation, 20 Jun 2007, CM
;       Change the two WHERE's in ::REMOVE to a single WHERE
;         with COMPLEMENT, 20 Jun 2007, CM
;       Fix glaring bug in ::REMOVE when an entry still exists,
;         in a bucket, 27 Jun 2007, CM
;       Clean up the new NULL_VALUE pointer when destroying object,
;         (thanks to I. Zimine) 30 Jul 2007, CM
;       Fix case where user stores many identical keys (more than
;         LENGTH), 09 Aug 2007, CM
;       Add POSITION keyword to ::REMOVE, 12 Nov 2008, CM
;       Document the REPLACE keyword; correct COUNT() when replacing an
;        entry, 28 Jun 2009, CM
;       Add example documentation, 28 Jun 2009, CM
; 
;  $Id: hashtable__define.pro,v 1.13 2009/07/01 16:00:05 craigm Exp $
;-
; Copyright (C) 2003, 2004, 2006, 2007, 2008, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; =============================================================
;
; METHODNAME:
;       HASHTABLE::INIT
;
; PURPOSE:
;       Creates a hash table object.
;
; CALLING SEQUENCE:
;
;       result = obj_new('hashtable', [LENGTH=length,] [NULL_VALUE=null])
;
; DESCRIPTION:
;
;       The INIT method creates a new hash table object and
;       initializes it.  The user can chose the initial size of the
;       hashtable, which should be comparable to the number of entries
;       expected.
;
; OPTIONAL INPUTS:
;
;       None.
;
; KEYWORD PARAMETERS:
;
;       LENGTH - The number of "buckets" in the hash table, i.e. then
;                number of unique hash values.  This size is fixed
;                once the table is created, however since a bucket can
;                contain more than one entry, this is not a
;                fundamental limitation.
;
;       NO_DUPLICATES - If set, then duplicate entries are not allowed
;                       in the hash table.
;
;       NULL_VALUE - a custom "null" value which is returned when
;                    GET() does not find an entry.
;                    Default: 0L
;
; RETURNS:
;       A new hash table object.
;
; EXAMPLE:
;       ht = obj_new('hashtable')
;
; MODIFICATION HISTORY:
;       Written and documented, Nov 2003, CM
; 	
;-
;+
; =============================================================
;
; METHODNAME:
;       HASHTABLE::CLEANUP
;
; PURPOSE:
;       De-allocates storage and cleans up a hash table object.
;
; CALLING SEQUENCE:
;
;       OBJ_DESTROY, ht
;       
; DESCRIPTION:
;
;       This procedure performs all clean-up required to remove the
;       object.  All hash table entries are freed.  However, if any of
;       the contained objects are heap data or objects, the user is
;       responsible for freeing those pointers or objects.
;
; OPTIONAL INPUTS:
;       None.
;       
;
; KEYWORD PARAMETERS:
;       None.
;       
;
; EXAMPLE:
;       OBJ_DESTROY, ht
;       
;
; MODIFICATION HISTORY:
;       Written and documented, Nov 2003, CM
; 	
;-
;+
; =============================================================
;
; METHODNAME:
;       HASHTABLE::ADD
;
; PURPOSE:
;       Add an entry to a hash table.
;
; CALLING SEQUENCE:
;       HT->ADD, KEYNAME, VALUE, HASHVAL=HASHVAL, REPLACE=REPLACE
;         
;       
; DESCRIPTION:
;
;       This method adds a new hash association to an existing hash
;       table.  The hash table associates VALUE with the scalar string
;       KEYNAME.
;
; INPUTS:
;
;       KEYNAME - a scalar string which identifies the value.
;
; KEYWORD PARAMETERS:
;
;       HASHVAL - Use for performance.  If defined upon input,
;                 specifies the hash value for this KEYNAME.  If not
;                 defined upon input, the hash value is computed
;                 internally.  Upon output, the hash value used is
;                 returned in this variable.
;       REPLACE - If set, and if an entry with key KEYNAME already
;                 exists in the table, then replace it with VALUE.
;
; EXAMPLE:
;
;       HT->ADD, 'X', 1
;       HT->ADD, 'Y', 2
;       struct = {psym: 3, xtitle: 'Time', ytitle: 'Value'}
;       HT->ADD, 'extra', struct
;
;       Adds the ('X',1), ('Y',2) and ('extra', STRUCT) pairs to the
;       HT hash table.
;       
;
; MODIFICATION HISTORY:
;       Written and documented, Nov 2003, CM
;       Document the REPLACE keyword, 28 Jun 2009, CM
; 	
;-
;+
; =============================================================
;
; METHODNAME:
;       HASHTABLE::COUNT
;
; PURPOSE:
;       Returns number of entries in the hash table.
;       
;
; CALLING SEQUENCE:
;       CT = HT->COUNT()
;
; KEYWORD PARAMETERS:
;       None.
;
; RETURNS:
;       The number of entries.
;
; EXAMPLE:
;       CT = HT->COUNT()
;
; MODIFICATION HISTORY:
;       Written and documented, Nov 2003, CM
; 	
;-
;+
; =============================================================
;
; METHODNAME:
;       HASHTABLE::REMOVE
;
; PURPOSE:
;       Removes a hash table entry from an existing hash table object.
;
; CALLING SEQUENCE:
;       HT->REMOVE, KEYNAME
;
; DESCRIPTION:
;
;       This method removes one or more hash entries from an existing
;       hash table.  Entries whose key matches KEYNAME are removed.
;
;       If KEYNAME does not exist, then REMOVE returns silently.
;
;       If multiple entries with the same KEYNAME exist, then they are
;       all deleted by default, unless the POSITION keyword is set.
;       After deleting some entries, positions of the remaining
;       entries may shift.
;
; INPUTS:
;       KEYNAME - a scalar string to be removed from the hash table.
;
; KEYWORD PARAMETERS:
;
;       HASHVAL - Use for performance.  If defined upon input,
;                 specifies the hash value for this KEYNAME.  If not
;                 defined upon input, the hash value is computed
;                 internally.  Upon output, the hash value used is
;                 returned in this variable.
;
;       COUNT - The number of hash entries removed.
;
;       POSITION - if more than one entry was found, then POSITION is
;                  a list of indices to delete (indices start at 0).
;                  IMPORTANT NOTE: out of bounds values are allowed,
;                  and will be rounded to in-bounds values.
;
; EXAMPLE:
;       HT->REMOVE, 'X'
;
; MODIFICATION HISTORY:
;       Written and documented, Nov 2003, CM
; 	
;-
;+
; =============================================================
;
; METHODNAME:
;       HASHTABLE::ISCONTAINED
;
; PURPOSE:
;       Is a hash entry KEYNAME is contained by the hash table?
;
; CALLING SEQUENCE:
;       INSIDE = HT->ISCONTAINED(KEYNAME, COUNT=count, HASHVAL=HASHVAL,
;                                VALUE=value, POSITION=position)
;       
; DESCRIPTION:
;
;      This method determines whether a key is contained within the
;      hash table.  A return value of 1 indicates YES, 0 indicates NO.
;
;      If the key is found, then the value associated with that key
;      can be returned in the VALUE keyword.  If more than one entry
;      with the same key are found, then POSITION determines which
;      value is returned.
;      
; INPUTS:
;       KEYNAME - a scalar string, the key name to be searched for.
;
; KEYWORD PARAMETERS:
;
;       COUNT - upon return, the number of hash entries which match
;               KEYNAME.
;
;       VALUE - upon return, if KEYNAME was found, the value
;               associated with that key.  If more than one keys
;               match, then by default the first entry is returned,
;               unless POSITION is specified.  If the key is not
;               found, then VALUE is undefined.
;
;       POSITION - if KEYNAME was found, and more than one entry was
;                  found, then the POSITION'th entry is returned in
;                  VALUE (the index starts at 0).
;
;       HASHVAL - Use for performance.  If defined upon input,
;                 specifies the hash value for this KEYNAME.  If not
;                 defined upon input, the hash value is computed
;                 internally.  Upon output, the hash value used is
;                 returned in this variable.
;
; RETURNS:
;       Is the key contained within the table?  (Scalar integer:
;          1=YES, 0=NO)
;       
; EXAMPLE:
;       if HT->ISCONTAINED('X') EQ 1 then print, 'X found'
;
;       if HT->ISCONTAINED('X', VALUE=xvalue) then begin
;           oplot, xvalue
;       endif
;
; MODIFICATION HISTORY:
;       Written and documented, Nov 2003, CM
; 	
;-
;+
; =============================================================
;
; METHODNAME:
;       HASHTABLE::GET
;
; PURPOSE:
;       Retrieves a value associated with a key from the hash table.
;       
;
; CALLING SEQUENCE:
;       VALUE = HT->GET('X', COUNT=count, POSITION=position, HASHVAL=hashval)
;       
; DESCRIPTION:
;
;       This method searches for the requested key in the hash table,
;       and returns the value associated with that key.
;
;       If more than one entry with the same key are found, then
;       POSITION determines which value is returned.
;
;       If the key is not found, then COUNT is set to zero, and the
;       returned value is undefined.
;
;
; KEYWORD PARAMETERS:
;
;       COUNT - upon return, the number of hash entries which match
;               KEYNAME.
;
;       POSITION - if KEYNAME was found, and more than one entry was
;                  found, then the POSITION'th entry is returned in
;                  VALUE (the index starts at 0).
;
;                  WARNING: if the hash table has been changed using
;                  ADD or REMOVE, then the order of elements in the
;                  table may shift.
;
;       HASHVAL - Use for performance.  If defined upon input,
;                 specifies the hash value for this KEYNAME.  If not
;                 defined upon input, the hash value is computed
;                 internally.  Upon output, the hash value used is
;                 returned in this variable.
;
; OUTPUTS:
;
;       The value associated with KEYNAME is returned.  If KEYNAME was
;       not found, then COUNT is zero and the return value is
;       set to the "null" value (see ::INIT).
;       
;
; EXAMPLE:
;
;       X = HT->GET('X')
;       
;
; MODIFICATION HISTORY:
;       Written and documented, Nov 2003, CM
; 	
;-
;+
; =============================================================
;
; METHODNAME:
;       HASHTABLE::KEYS
;
; PURPOSE:
;       Retrieves all the keys of the hash tables
;       
;
; CALLING SEQUENCE:
;       KEYS = HT->KEYS()
;       
; DESCRIPTION:
;
;       This method returns all of the keys in the hash table.  If
;       duplicate hash entries are present, then a key may appear more
;       than once.
;
;       The order of the keys is undefined.
;
; KEYWORD PARAMETERS:
;       None.
;
; RETURNS:
;
;       A string array containing the keys of this hash table.
;       If the table is empty, then COUNT will be set to zero,
;       and a scalar string '' is returned.
;
; EXAMPLE:
;
;       KEYS = HT->KEYS()
;       for i = 0, n_elements(keys)-1 do print, ht->get(keys(i))
;       
;
; MODIFICATION HISTORY:
;       Written and documented, Nov 2003, CM
; 	
;-
;+
; =============================================================
;
; METHODNAME:
;       HASHTABLE::STRUCT
;
; PURPOSE:
;       Converts the hash table to an equivalent IDL structure
;       
;
; CALLING SEQUENCE:
;       STRUCT = HT->STRUCT()
;       
; DESCRIPTION:
;
;       This method converts the hash table into an equivalent IDL
;       structure.  One structure tag appears for each hash entry.
;
;       WARNING: (1) the hash keys must be valid IDL structure names;
;       (2) there must be no duplicate keys in the hash table.
;
;       The order of the keys is undefined.
;
; KEYWORD PARAMETERS:
;       None.
;
; RETURNS:
;
;       A structure.
;
; EXAMPLE:
;
;       HTSTRUCT = HT->STRUCT()
;       help, keys, htstruct
;       
;
; MODIFICATION HISTORY:
;       Written and documented, Nov 2003, CM
; 	
;-
; =============================================================
; METHODNAME: HASHTABLE__DEFINE
;  internal method: defines hash table data structure
pro hashtable__define

  COMPILE_OPT strictarr
  struct = {hashtable, $
            table: ptr_new(), $  ;; Table of HASHENT structures
            length: 0L, $        ;; Number of buckets in table
            count: 0L, $         ;; Number of entries in table
            flags: 0L, $         ;; Flags
            free_keys: 0L, $
            free_values: 0L, $
            null_value: ptr_new() $
           }
  return
end


;+
; NAME:
;   HELPFORM
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Generate a descriptive string in IDL HELP format
;
; CALLING SEQUENCE:
;   STRINGS = HELPFORM(NAME, VALUE, [/SHORTFORM,] [/SINGLE,] [WIDTH=width])
;
; DESCRIPTION: 
;
;   The HELPFORM function converts an IDL data value into a
;   representation very similar to the format produced by the built-in
;   command HELP.  Programmers can thus present data types and values
;   to users in a format they are familiar with.
;
;   For example, if the variable A is defined in the following manner,
;   and HELP is called, then the following transcript will result:
;
;     IDL> a = [1,2]
;     IDL> help, a
;     A               INT       = Array[2]
;
;   The same result can be achieved with the HELPFORM function:
;
;     IDL> print, helpform('A', a)
;     A               INT       = Array[2]
;
;   The benefit is that the output of HELPFORM is a string that can be
;   outputted or reformatted.  This capability is not available in all
;   versions of IDL.
;
;   HELPFORM actually produces *two* forms of output.  The above
;   output is considered the "long" form, as it appears in the IDL
;   HELP command, and is the default.  A "short" form can also be
;   produced, and is very similar to the information that appears in
;   certain terse IDL error messages.  It is activated by setting the
;   SHORTFORM keyword.
;
;   If the variable name is too long, the HELPFORM may be forced to be
;   two lines long to have consistent formatting.  In that case a
;   two-element string is returned.  If a single line is desired, use
;   the SINGLE keyword, but this comes at the expense of consistent
;   output formatting.
;
; INPUTS:
;
;   NAME - A scalar string containing the name of the IDL variable.
;          An empty string is permitted.  The name is ignored if the
;          SHORTFORM keyword is set.
;
;   VALUE - Any IDL value to be examined.  VALUE is optional if the
;           SIZE keyword is passed and uniquely describes the data.
;           VALUE should be passed for scalars and structures, since
;           the help form for these values requires additional
;           information beyond the SIZE.
;
; KEYWORDS:
;
;   SIZE - the IDL SIZE descriptor for the value to be printed.
;          Default: information is taken from VALUE.
;
;   SINGLE - if set, then output which would normally
;            appear on two lines for consistent formatting, appears on
;            one single line instead.
;
;   FULL_STRUCT - if set, then a detailed output is printed for
;                 structures, similar to HELP, VALUE, /STRUCTURE.
;

;   RECURSIVE_STRUCT - if both this keyword and FULL_STRUCT are set,
;                      and if VALUE itself has sub-structures, then
;                      print the full contents of those sub-structures
;                      as well.  The contents will be slightly indented.
;
;   SHORTFORM - set this keyword for a shorter output format that can
;               be used in error messages.
;
;   WIDTH - the width of the terminal in characters (used for
;           formatting).
;           Default: 80
;
; RETURNS:
;
;   An array of strings containing the HELPFORM output, which may have
;   more than one element depending on the length of NAME, SHORTFORM
;   and SINGLE.  The helpforms of pointer- and object-typed values
;   does not include the sequence number, but are otherwise correct.
;
; EXAMPLE:
;
;     IDL> print, helpform('A', size=[1,2,1,2])
;     A               BYTE      = Array[2]
;     ;; Do not pass VALUE and instead use SIZE to specify the type
;
;     IDL> print, helpform('A', size=[1,2,1,2], /shortform)
;     BYTE     (Array[2])
;     ;; Compare to the short form, which is meant to be placed in
;     ;; error messages
;
;     IDL> print, helpform('fjsldkfjsldfkjslkdfjslkdfjslkdfjsldkfjk',a)
;     fjsldkfjsldfkjslkdfjslkdfjslkdfjsldkfjk
;                      INT       = Array[2]
;     IDL> print, helpform('fjsldkfjsldfkjslkdfjslkdfjslkdfjsldkfjk',a,/single)
;     fjsldkfjsldfkjslkdfjslkdfjslkdfjsldkfjk INT       = Array[2]
;     ;; Compare the long and short forms
;
;
; SEE ALSO:
;
;   INPUTFORM, HELP
;
; MODIFICATION HISTORY:
;   Written, CM, 13 May 2000
;   Documented, 04 Jul 2000
;   Improved output for objects, CM, 11 Jan 2001
;   Added support for full structure output, CM 08 Feb 2001
;   Added forward_function declaration for safety, CM 08 Apr 2001
;   Print more info about POINTER type, CM 08 Apr 2001
;   Add the RECURSIVE_STRUCT keyword, CM 04 Jan 2009
;
; $Id: helpform.pro,v 1.6 2009/01/04 09:18:18 craigm Exp $
;
;-
; Copyright (C) 2000-2001, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   HPRNUTANG
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute high precision earth precession, nutation and orientation angles
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   HPRNUTANG, JDTT, ZETA, THETA, Z, DPSI, DEPS, $
;              POLAR_X=PMX, POLAR_Y=PMY, JD_UT1=JD_UT1, /USE_EOPDATA, $
;              TBASE=, FIXED_EPOCH=, FIXED_BASE=, $
;              /JPL, /NO_UT1, $
;              MEAN_OBLIQUITY=EPS0, TRUE_OBLIQUITY=EPS, $
;              GMS_TIME=GMST, GAS_TIME=GAST, EQ_EQUINOX=EQEQ
;              
;
; DESCRIPTION:
;
;  The procedure HPRNUTANG computes values of the earth
;  orientation-related angles, including precession and nutation,
;  which are used for high precision earth-based astronomy
;  applications.  
;
;  It is the goal of this procedure to provide all angles relevant in
;  determining the position of an earth station, as measured in an
;  earth-fixed coordinate system, and converting to space-fixed
;  coordinates.  This is useful in applications where observations by
;  a station in the earth-fixed frame are taken of an astrophysical
;  object which is in the non-rotating space-fixed frame.
;
;  This routine potentially depends on the following external
;  procedures, which also themselves depend on external data files:
;
;      EOPDATA - estimates Earth orientation parameters (if
;                USE_EOPDATA keyword is set), depends on earth
;                orientation data file.
;      TAI_UTC - computes time difference TAI - UTC (leap seconds),
;                depends on leap seconds file.
;
;  This interface is somewhat provisional.  See OPEN QUESTIONS below.
;
;  The user requests the quantities for a particular set of epoch
;  times, as measured in Julian days, in the system of Terrestrial
;  Dynamical Time ( = TDT = TT ).  
;
;  HPRNUTANG returns several quantities.  It is not possible to
;  describe each of these quantities in full detail in this
;  documentation.  The user is referred to the Explanatory Supplement
;  to the Astronomical Almanac (Sec 3.2) for more complete
;  descriptions.  The quantities are:
;
;    * ZETA, THETA, Z, which are euler angles representing the
;      precession of the mean celestial ephemeris pole with respect to
;      the space-fixed coordinate system defined by the FIXED epoch.
;      For a vector R_MEAN_OFDATE, whose space-fixed coordinates are
;      referred to the mean pole of date, the transformation to
;      space-fixed coordinates referred to the mean pole of the fixed
;      epoch is:
;
;        R_FIXED = qtvrot(R_MEAN_OFDATE, $
;                        qteuler(['z','y','z'], -zeta, +theta, -z))
;
;      By default the "fixed" epoch is J2000.0.  [ See below for
;      definitions of QTVROT and QTEULER. ]
;
;    * DPSI, DEPS, which are the angles representing the nutation in
;      longitude and obliquity of the true of-date celestial ephemeris
;      pole with respect to the mean pole of date.  For a vector
;      R_TRUE_OFDATE, whose space-fixed coordinates are referred to
;      the true pole of date, the transformation to space-fixed
;      coordinates referred to the mean pole of date is:
;
;        R_MEAN_OFDATE = qtvrot(R_TRUE_OFDATE, $
;                              qteuler(['x','z','x'], $
;                                      +eps0, -dpsi, -eps0-deps)
;
;      where EPS and EPS0 are defined below.
;
;    * EPS0, which is the mean obliquity of the ecliptic plane,
;      referred to the mean equator of date, at the requested epoch.
;      For a vector, R_ECL_OFDATE, whose space-fixed coordinates are
;      referred to the mean ecliptic and equinox of date, the
;      transformation to space-fixed coordinates referred to the mean
;      equator and equinox of date is:
;
;        R_MEAN_OFDATE = qtvrot(R_ECL_OFDATE, $
;                               qteuler(['x'], eps0)
;
;    * EPS, which is the true obliquity of the ecliptic plane,
;      referred to the mean equator of date, at the requested epoch.
;
;    * GMST, GAST, which are the mean and apparent Greenwich Sidereal
;      Times at the requested epoch.  For a vector R_TRUE_EARTHFIXED,
;      whose earth-fixed coordinates are referred to the true pole of
;      date, the transformation to space-fixed coordinates referred to
;      the true pole of date are:
;
;        R_TRUE_OFDATE = qtvrot(R_TRUE_EARTHFIXED, $
;                              qteuler(['z'], +gast))
;
;    * EQEQ, the equation of the equinoxes at the requested epoch.
;      This quantity may be more commonly known as the "precession of
;      the equinox."
;
;    * PMX, PMY, the coordinates of the celestial ephemeris pole as
;      measured in the earth-fixed coordinate system (set to zero if
;      the USE_EOPDATA keyword is not set).  For a vector
;      R_MEAN_EARTHFIXED, whose earth-fixed coordinates are referred
;      to the International Reference Pole, the transformation to
;      earth-fixed coordinates referred to the true pole of date are:
;
;        R_TRUE_EARTHFIXED = qtvrot(R_MEAN_EARTHFIXED, $
;                                  qteuler(['x','y'], -pmy, -pmx))
;
;      The vector R_MEAN_EARTHFIXED, could be for example, the
;      cartesian coordinates of a station on the earth, as determined
;      from its geodetic/geocentric latitude and longitude.
;
;    * JD_UT1, the UT1 time (expressed in Julian days) (set to UTC if
;      the USE_EOPDATA keyword is not set or if NO_UT1 is set).
;
;  Users may select different techniques to compute some of these
;  quantities.  See keywords JPL and USE_EOPDATA.
;
;
; OPEN QUESTIONS
;
;   How will the transition to a new IERS EOP series be accomplished?
;   Using a keyword?  How can users select different nutation series?
;   How can users select different fundamental arguments for the
;   planets.
;
;
; VERIFICATION
;
;   The precession and nutation quantities were compared against those
;   produced by the SLALIB telescope pointing library.  
;
;   For the epoch JD 2450449 (TT), the precession quantities of
;   HPRNUTANG agree numerically with SLALIB SLA_PREC to within 0.1
;   microarcseconds, and the nutation quantities agree SLALIB SLA_NUTC
;   to within 6 microarcseconds (and 54 microarcseconds in the mean
;   obliquity).  The GMST values agree with SLALIB SLA_GMSTA to better
;   than 1 nanosecond.  Of course this says nothing about the accuracy
;   of the IAU 1976/1980 precession and nutation models with respect
;   to the true precession and nutations.
;
;   The precession and nutation quantities computed in this procedure
;   -- ZETA, THETA, Z, DPSI and DEPS -- were also used to compute the
;   space-fixed coordinates of the Goldstone DSS-63 deep space network
;   tracking station.  These values were compared against values
;   produced by JPL Horizons ephemeris generator.  Agreement was found
;   at the 60 cm level.  Accuracy at that level is probably limited by
;   the JPL DE406 earth ephemeris used by Horizons.
;
;   Polar motion values were estimated at the same epoch using
;   EOPDATA, and applied to three orthogonal unit vectors.  The above
;   quaternion transformation produces the same coordinate values,
;   when compared against SLALIB_POLMO.
;
;
; QTEULER and QTVROT
;
;   The functions QTEULER and QTVROT are functions from the Markwardt
;   quaternion library.  QTEULER composes a chain of Euler-like
;   rotations into a single quaternion.  QTVROT applies a quaternion
;   rotation to a 3-vector.
;
;   The user need not use these functions.  Any function which
;   constructs a set of Euler-like rotations, and then applies them to
;   3-vectors will work fine.
;
;
; INPUTS:
;
;   JDTT - a vector or scalar, the TT epoch time(s) for which high
;          precision values are to be computed.
;
;          For reference, JDTT = JDTAI + 32.184/86400d, where JDTAI is
;          the international atomic time measured in days.  The value
;          of the keyword TBASE is added to JDTT to arrive at the
;          actual Julian date.
;
; OUTPUTS:
;
;   ZETA, THETA, Z - Euler angles of precession of the mean celestial
;                    ephemeris pole, expressed in ANGUNITS units.
;
;   DPSI, DEPS - the nutation angles in longitude and obliquity of the
;                true pole with respect to the mean pole, expressed in
;                ANGUNITS units.  By default the values are based on
;                the IAU 1980 theory of nutation.  The user can select
;                JPL to interpolate the JPL nutation ephemerides.
;
;                When USE_EOPDATA is set, the nutation angles are
;                augmented by the offset correction terms supplied in
;                the EOP file.
;
; KEYWORD PARAMETERS:
;
;   TBASE - scalar or vector, a fixed epoch time (Julian days) to be
;           added to each value of JDTT.  Since subtraction of large
;           numbers occurs with TBASE first, the greatest precision is
;           achieved when TBASE is expressed as a nearby julian epoch,
;           JDTT is expressed as a small offset from the fixed epoch.
;           Default: 0
;
;   FIXED_EPOCH - a scalar or vector number, the fixed epoch (in TT
;                 Julian Days) against which the precession angles of
;                 the mean pole are referred.  
;                 Default: JD 2451545.0 TT ( = J2000.0 )
;
;   FIXED_BASE - scalar or vector, a fixed epoch time to be added to
;                FIXED_EPOCH, in much the same way that TBASE is added
;                to JDTT.  Default: 0
;
;   POLAR_X, POLAR_Y - upon return, the quantities PMX and PMY, in
;                      ANGUNITS units, if USE_EOPDATA is set.  If
;                      USE_EOPDATA is not set then zero is returned
;                      for both PMX and PMY.
;
;   JD_UT1 - upon return, the time in the UT1 system at the requested
;            epoch, if the USE_EOPDATA keyword is set.  If the
;            USE_EOPDATA keyword is not set, or if NO_UT1 is set, then
;            the time in UTC is returned (which is guaranteed to be
;            within +/- 0.9 seconds of UT1).
;
;   MEAN_OBLIQUITY - upon return, the quantity EPS0, in ANGUNITS
;                    units.
;
;   TRUE_OBLIQUITY - upon return, the quantity EPS, in ANGUNITS units.
;
;   GMS_TIME - upon return, the quantity GMST in radians.
;
;   GAS_TIME - upon return, the quantity GAST in radians.
;
;   EQ_EQUINOX - upon return, the quantity EQEQ in ANGUNITS units.
;
;   ANGUNITS - scalar string, output units of angular parameters.
;              Possible values are 'ARCSEC' or 'RADIAN'.
;              Default value: 'RADIAN'
;
;   JPL - a scalar integer or string.  If JPL is defined, then the routine
;         attempts to use the JPL nutation ephemeris to determine the
;         nutation angle quantities.  If JPL is a scalar string, then
;         it is interpreted as the FITS file name to use (see
;         JPLEPHREAD).  If JPL=1, the JPL ephemeris FITS file must be
;         present in
;             $ASTRO_DATA/JPLEPH.405
;         where ASTRO_DATA is the standard environment variable for
;         data used by the IDL Astronomy Library.  
;         Default: not set (i.e. do not use JPL ephemeris nutation quantities)
;
;   NO_UT1 - if set, then do not compute UT1, but use UTC instead.
;
;   USE_EOPDATA - if set, use the EOPDATA procedure to determine earth
;                 orientation parameters at the requested epoch.
;                 These include polar motion values, corrections to
;                 the 1980 IAU nutation theory, and the UT1
;                 correction.
;
;
; EXAMPLE:
;
;   Need an example converting topocentric to/from J2000.0
;
;   Need an example converting station position earth-fixed
;   coordinates to/from space-fixed coordinates.
;
;
;
; SEE ALSO:
;
;   HPRNUTANG, TAI_UTC (Markwardt Library)
;   PRECESS, NUTATE, PREMAT, JPRECESS, BPRECESS (IDL Astronomy Library)
;
;
; REFERENCES:
;
;   Aoki, S., Guinot, B., Kaplan, G.H., Kinoshita, H., McCarthy, D.D.,
;     Seidelmann, P.K., 1982: Astron. Astrophys., 105, 359-361.
;
;   HORIZONS, JPL Web-based ephemeris calculator (Ephemeris DE406)
;      http://ssd.jpl.nasa.gov/horizons.html
;
;   McCarthy, D. D. (ed.) 1996: IERS Conventions, IERS T.N. 21.
;     http://maia.usno.navy.mil/conventions.html
;
;   Seidelmann, P.K. 1992, *Explanatory Supplement to the Astronomical
;     Almanac*, ISBN 0-935702-68-7
;
;
; MODIFICATION HISTORY:
;   Written, 30 Jan 2002, CM
;   Documented, 15 Feb 2002, CM
;   Added docs about ecliptic; added default of 'RADIAN' to code; 01
;     Mar 2002, CM
;   Corrected equation of equinoxes (had DPSI*COS(EPS0), when it
;     should be DPSI*COS(EPS)), 01 Mar 2002, CM
;   Added default message, 04 Mar 2002, CM
;   Added more logic to detect JPL ephemeris file, 17 Mar 2002, CM
;   Corrected discussion of geodetic coordinates, 26 May 2002, CM
;   Documentation tweaks, 05 Jan 2004, CM
;   Some modifications to conserve memory, 22 Dec 2008, CM
;   Allow TBASE/FBASE to be a vector, 01 Jan 2009, CM
;   Documentation of the JPL parameter, 02 Dec 2009, CM
;
;  $Id: hprnutang.pro,v 1.18 2013/07/18 03:29:44 cmarkwar Exp $
;
;-
; Copyright (C) 2002, 2004, 2008, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; IAU 1980 Nutation Model
;   * taken from http://hpiers.obspm.fr/eop-pc/models/nut_iau1980
iau_1980_nut_strs = [ $
;  # Fortran format : (5I3,8X,6F10.1) 
;  #  Delaunay Arg. period(days)  
;  # lm ls F  D Om            psisin     t sin    eps cos     t cos
;   0    .    10   .    20        30        40        50         60     
   '  0  0  0  0  1 -6798.4 -171996.0    -174.2   92025.0       8.9     ', $
   '  0  0  2 -2  2   182.6  -13187.0      -1.6    5736.0      -3.1     ', $
   '  0  0  2  0  2    13.7   -2274.0      -0.2     977.0      -0.5     ', $
   '  0  0  0  0  2 -3399.2    2062.0       0.2    -895.0       0.5     ', $
   '  0 -1  0  0  0  -365.3   -1426.0       3.4      54.0      -0.1     ', $
   '  1  0  0  0  0    27.6     712.0       0.1      -7.0       0.0     ', $
   '  0  1  2 -2  2   121.7    -517.0       1.2     224.0      -0.6     ', $
   '  0  0  2  0  1    13.6    -386.0      -0.4     200.0       0.0     ', $
   '  1  0  2  0  2     9.1    -301.0       0.0     129.0      -0.1     ', $
   '  0 -1  2 -2  2   365.2     217.0      -0.5     -95.0       0.3     ', $
   ' -1  0  0  2  0    31.8     158.0       0.0      -1.0       0.0     ', $
   '  0  0  2 -2  1   177.8     129.0       0.1     -70.0       0.0     ', $
   ' -1  0  2  0  2    27.1     123.0       0.0     -53.0       0.0     ', $
   '  1  0  0  0  1    27.7      63.0       0.1     -33.0       0.0     ', $
   '  0  0  0  2  0    14.8      63.0       0.0      -2.0       0.0     ', $
   ' -1  0  2  2  2     9.6     -59.0       0.0      26.0       0.0     ', $
   ' -1  0  0  0  1   -27.4     -58.0      -0.1      32.0       0.0     ', $
   '  1  0  2  0  1     9.1     -51.0       0.0      27.0       0.0     ', $
   ' -2  0  0  2  0  -205.9     -48.0       0.0       1.0       0.0     ', $
   ' -2  0  2  0  1  1305.5      46.0       0.0     -24.0       0.0     ', $
   '  0  0  2  2  2     7.1     -38.0       0.0      16.0       0.0     ', $
   '  2  0  2  0  2     6.9     -31.0       0.0      13.0       0.0     ', $
   '  2  0  0  0  0    13.8      29.0       0.0      -1.0       0.0     ', $
   '  1  0  2 -2  2    23.9      29.0       0.0     -12.0       0.0     ', $
   '  0  0  2  0  0    13.6      26.0       0.0      -1.0       0.0     ', $
   '  0  0  2 -2  0   173.3     -22.0       0.0       0.0       0.0     ', $
   ' -1  0  2  0  1    27.0      21.0       0.0     -10.0       0.0     ', $
   '  0  2  0  0  0   182.6      17.0      -0.1       0.0       0.0     ', $
   '  0  2  2 -2  2    91.3     -16.0       0.1       7.0       0.0     ', $
   ' -1  0  0  2  1    32.0      16.0       0.0      -8.0       0.0     ', $
   '  0  1  0  0  1   386.0     -15.0       0.0       9.0       0.0     ', $
   '  1  0  0 -2  1   -31.7     -13.0       0.0       7.0       0.0     ', $
   '  0 -1  0  0  1  -346.6     -12.0       0.0       6.0       0.0     ', $
   '  2  0 -2  0  0 -1095.2      11.0       0.0       0.0       0.0     ', $
   ' -1  0  2  2  1     9.5     -10.0       0.0       5.0       0.0     '  ]
iau_1980_nut_strs = [ iau_1980_nut_strs, $
   '  1  0  2  2  2     5.6      -8.0       0.0       3.0       0.0     ', $
   '  0 -1  2  0  2    14.2      -7.0       0.0       3.0       0.0     ', $
   '  0  0  2  2  1     7.1      -7.0       0.0       3.0       0.0     ', $
   '  1  1  0 -2  0   -34.8      -7.0       0.0       0.0       0.0     ', $
   '  0  1  2  0  2    13.2       7.0       0.0      -3.0       0.0     ', $
   ' -2  0  0  2  1  -199.8      -6.0       0.0       3.0       0.0     ', $
   '  0  0  0  2  1    14.8      -6.0       0.0       3.0       0.0     ', $
   '  2  0  2 -2  2    12.8       6.0       0.0      -3.0       0.0     ', $
   '  1  0  0  2  0     9.6       6.0       0.0       0.0       0.0     ', $
   '  1  0  2 -2  1    23.9       6.0       0.0      -3.0       0.0     ', $
   '  0  0  0 -2  1   -14.7      -5.0       0.0       3.0       0.0     ', $
   '  0 -1  2 -2  1   346.6      -5.0       0.0       3.0       0.0     ', $
   '  2  0  2  0  1     6.9      -5.0       0.0       3.0       0.0     ', $
   '  1 -1  0  0  0    29.8       5.0       0.0       0.0       0.0     ', $
   '  1  0  0 -1  0   411.8      -4.0       0.0       0.0       0.0     ', $
   '  0  0  0  1  0    29.5      -4.0       0.0       0.0       0.0     ', $
   '  0  1  0 -2  0   -15.4      -4.0       0.0       0.0       0.0     ', $
   '  1  0 -2  0  0   -26.9       4.0       0.0       0.0       0.0     ', $
   '  2  0  0 -2  1   212.3       4.0       0.0      -2.0       0.0     ', $
   '  0  1  2 -2  1   119.6       4.0       0.0      -2.0       0.0     ', $
   '  1  1  0  0  0    25.6      -3.0       0.0       0.0       0.0     ', $
   '  1 -1  0 -1  0 -3232.9      -3.0       0.0       0.0       0.0     ', $
   ' -1 -1  2  2  2     9.8      -3.0       0.0       1.0       0.0     ', $
   '  0 -1  2  2  2     7.2      -3.0       0.0       1.0       0.0     ', $
   '  1 -1  2  0  2     9.4      -3.0       0.0       1.0       0.0     ', $
   '  3  0  2  0  2     5.5      -3.0       0.0       1.0       0.0     ', $
   ' -2  0  2  0  2  1615.7      -3.0       0.0       1.0       0.0     ', $
   '  1  0  2  0  0     9.1       3.0       0.0       0.0       0.0     ', $
   ' -1  0  2  4  2     5.8      -2.0       0.0       1.0       0.0     ', $
   '  1  0  0  0  2    27.8      -2.0       0.0       1.0       0.0     ', $
   ' -1  0  2 -2  1   -32.6      -2.0       0.0       1.0       0.0     ', $
   '  0 -2  2 -2  1  6786.3      -2.0       0.0       1.0       0.0     ', $
   ' -2  0  0  0  1   -13.7      -2.0       0.0       1.0       0.0     ', $
   '  2  0  0  0  1    13.8       2.0       0.0      -1.0       0.0     ', $
   '  3  0  0  0  0     9.2       2.0       0.0       0.0       0.0     ', $
   '  1  1  2  0  2     8.9       2.0       0.0      -1.0       0.0     ', $
   '  0  0  2  1  2     9.3       2.0       0.0      -1.0       0.0     ', $
   '  1  0  0  2  1     9.6      -1.0       0.0       0.0       0.0     ', $
   '  1  0  2  2  1     5.6      -1.0       0.0       1.0       0.0     ', $
   '  1  1  0 -2  1   -34.7      -1.0       0.0       0.0       0.0     ', $
   '  0  1  0  2  0    14.2      -1.0       0.0       0.0       0.0     ', $
   '  0  1  2 -2  0   117.5      -1.0       0.0       0.0       0.0     ', $
   '  0  1 -2  2  0  -329.8      -1.0       0.0       0.0       0.0     ', $
   '  1  0 -2  2  0    23.8      -1.0       0.0       0.0       0.0     ', $
   '  1  0 -2 -2  0    -9.5      -1.0       0.0       0.0       0.0     ', $
   '  1  0  2 -2  0    32.8      -1.0       0.0       0.0       0.0     ', $
   '  1  0  0 -4  0   -10.1      -1.0       0.0       0.0       0.0     ', $
   '  2  0  0 -4  0   -15.9      -1.0       0.0       0.0       0.0     ', $
   '  0  0  2  4  2     4.8      -1.0       0.0       0.0       0.0     ', $
   '  0  0  2 -1  2    25.4      -1.0       0.0       0.0       0.0     ', $
   ' -2  0  2  4  2     7.3      -1.0       0.0       1.0       0.0     ', $
   '  2  0  2  2  2     4.7      -1.0       0.0       0.0       0.0     ', $
   '  0 -1  2  0  1    14.2      -1.0       0.0       0.0       0.0     ', $
   '  0  0 -2  0  1   -13.6      -1.0       0.0       0.0       0.0     ', $
   '  0  0  4 -2  2    12.7       1.0       0.0       0.0       0.0     ', $
   '  0  1  0  0  2   409.2       1.0       0.0       0.0       0.0     ', $
   '  1  1  2 -2  2    22.5       1.0       0.0      -1.0       0.0     ', $
   '  3  0  2 -2  2     8.7       1.0       0.0       0.0       0.0     ', $
   ' -2  0  2  2  2    14.6       1.0       0.0      -1.0       0.0     ', $
   ' -1  0  0  0  2   -27.3       1.0       0.0      -1.0       0.0     ', $
   '  0  0 -2  2  1  -169.0       1.0       0.0       0.0       0.0     ', $
   '  0  1  2  0  1    13.1       1.0       0.0       0.0       0.0     ', $
   ' -1  0  4  0  2     9.1       1.0       0.0       0.0       0.0     ', $
   '  2  1  0 -2  0   131.7       1.0       0.0       0.0       0.0     ', $
   '  2  0  0  2  0     7.1       1.0       0.0       0.0       0.0     ', $
   '  2  0  2 -2  1    12.8       1.0       0.0      -1.0       0.0     ', $
   '  2  0 -2  0  1  -943.2       1.0       0.0       0.0       0.0     ', $
   '  1 -1  0 -2  0   -29.3       1.0       0.0       0.0       0.0     ', $
   ' -1  0  0  1  1  -388.3       1.0       0.0       0.0       0.0     ', $
   ' -1 -1  0  2  1    35.0       1.0       0.0       0.0       0.0     ', $
   '  0  1  0  1  0    27.3       1.0       0.0       0.0       0.0     ' ]

  n80 = n_elements(iau_1980_nut_strs)

  argfacts = fltarr(5,n80)
  str = strmid(iau_1980_nut_strs,0,16)
  reads, str, argfacts
  argfacts = transpose(argfacts)

  psiamps = dblarr(2,n80)
  str = strmid(iau_1980_nut_strs,23,21)
  reads, str, psiamps
  psiamps = transpose(psiamps)

  epsamps = fltarr(2,n80)
  str = strmid(iau_1980_nut_strs,43,20)
  reads, str, epsamps
  epsamps = transpose(epsamps)

  return
end

pro hprnutang_init_iau1980_args, args
  ;; c1 = mean anomaly of Moon
  ;; c2 = mean anomaly of Sun
  ;; c3 = mean longitude of the Moon minus the mean longitude of Moon's node
  ;; c4 = mean elongation of Moon from Sun
  ;; c5 = mean longitude of ascending node of the Moon
  ;; c6 = mean anomaly of Mercury
  ;; c7 = mean anomaly of Venus
  ;; c8 = mean anomaly of Earth
  ;; c9 = mean anomaly of Mars
  ;; ca = mean anomaly of Jupiter
  ;; cb = mean anomaly of Saturn

  c1 = [134.96298139d*3600d, 1717915922.6330d,  31.310d,   0.064d]
  c2 = [357.52772333d*3600d,  129596581.2240d,  -0.577d,  -0.012d]
  c3 = [ 93.27191028d*3600d, 1739527263.1370d, -13.257d,   0.011d]
  c4 = [297.85036306d*3600d, 1602961601.3280d,  -6.891d,   0.019d]
  c5 = [125.04452222d*3600d,   -6962890.5390d,   7.455d,   0.008d]
  c6 = [252.3d       *3600d,     149472.7d,      0d,       0d    ]
  c7 = [179.9d       *3600d,      58517.8d,      0d,       0d    ]
  c8 = [ 98.4d       *3600d,      35999.4d,      0d,       0d    ]
  c9 = [353.3d       *3600d,      19140.3d,      0d,       0d    ]
  ca = [ 32.3        *3600d,       3034.9d,      0d,       0d    ]
  cb = [ 48.0        *3600d,       1222.1d,      0d,       0d    ]

  args = [[c1],[c2],[c3],[c4],[c5],[c6],[c7],[c8],[c9],[ca],[cb]]
  args = args * !dpi / 180d / 3600d

  return
end

pro hprnutang_init_iau1996_args, args
  ;; c1 = mean anomaly of Moon
  ;; c2 = mean anomaly of Sun
  ;; c3 = mean longitude of the Moon minus the mean longitude of Moon's node
  ;; c4 = mean elongation of Moon from Sun
  ;; c5 = mean longitude of ascending node of the Moon
  ;; c6 = mean anomaly of Mercury
  ;; c7 = mean anomaly of Venus
  ;; c8 = mean anomaly of Earth
  ;; c9 = mean anomaly of Mars
  ;; ca = mean anomaly of Jupiter
  ;; cb = mean anomaly of Saturn
  ;; cc = accumulated general precession
  
  c1= [134.96340251d*3600d, 1717915923.2178d,  31.8792d,  5.1635d-2, 2.4470d-4]
  c2= [357.52910918d*3600d,  129596581.0481d,  -0.5532d,  1.36d-4,  -1.149d-5]
  c3= [ 93.27209062d*3600d, 1739527262.8478d, -12.7512d, -1.037d-3,  4.17d-6]
  c4= [297.85019547d*3600d, 1602961601.2090d,  -6.3706d,  6.593d-3, -3.169d-5]
  c5= [125.04455501d*3600d,   -6962890.2665d,   7.4722d,  7.702d-3, -5.939d-5]
  c6= [  0d,                     0d,                 0d,  0d,        0d      ]
  c7= [181.979800853d*3600d, 58517.8156748d*3600d,   0d,  0d,        0d      ]
  c8= [100.466448494d*3600d, 35999.3728521d*3600d,   0d,  0d,        0d      ]
  c9= [355.433274605d*3600d, 19140.299314d *3600d,   0d,  0d,        0d      ]
  ca= [ 34.351483900d*3600d,  3034.90567464d*3600d,  0d,  0d,        0d      ]
  cb= [ 50.0774713998d*3600d, 1222.11379404d*3600d,  0d,  0d,        0d      ]
  cc= [  0d,                  1.39697137214d*3600d,  3.086d-4, 0d,  0d       ]

  args = [[c1],[c2],[c3],[c4],[c5],[c6],[c7],[c8],[c9],[ca],[cb],[cc]]
  args = args * !dpi / 180d / 3600d

  return
end

pro hprnutang, jdtt, zeta, theta, z, dpsi, deps, jpl=jpl, $
               tbase=tbase0, polar_x=pmx, polar_y=pmy, $
               fixed_epoch=fepoch0, fixed_base=fbase0, $
               jd_ut1=jdut1, mean_obliquity=eps0, true_obliquity=eps, $
               gms_time=gmst, gas_time=gast, eq_equinox=eqeq, $
               use_eopdata=useeop, no_ut1=no_ut1, no_nutation=no_nut1

  common hprnutang_iau80_coeffs, arg80, psi80, eps80
  common hprnutang_iau80_args,   farg80
  common hprnutang_iau96_args,   farg96

  if n_params() EQ 0 then begin
      message, 'USAGE:', /info
      message, 'HPRNUTANG, JDTT, ZETA, THETA, Z, DPSI, DEPS, '+ $
        '[ TBASE=, /JPL, /USE_EOPDATA, /NO_UT1, FIXED_EPOCH=, FIXED_BASE=, '+ $
        'POLAR_X=, POLAR_Y=, JD_UT1=, MEAN_OBLIQUITY=, TRUE_OBLIQUITY=, '+$
        'GMS_TIME=, GAS_TIME=, EQ_EQUINOX= ]', /info
      return
  endif

  if n_elements(arg80) EQ 0 then begin
      hprnutang_init_iau1980, arg80, psi80, eps80 ;; IAU 1980 Nutation theory
      hprnutang_init_iau1980_args, farg80 ;; Fund. args of 1980 theory
      hprnutang_init_iau1996_args, farg96 ;; Fund. args of 1996 theory
  endif

; if keyword_set(arg96) then farg = farg96 else farg = farg80
  farg = farg80

  ;; Default angular units
  if n_elements(angunits0) EQ 0 then $
    angunits = 'RADIAN' $
  else $
    angunits = strtrim(strupcase(strcompress(angunits0(0))),2)

  ;; Default time bases
  if n_elements(tbase0) EQ 0 then tbase = 0d $
  else                            tbase = double(tbase0)

  if n_elements(fbase0) EQ 0 then fbase = 0d $
  else                            fbase = double(fbase0)
  
  ;; "Fixed" epoch, which is the epoch of equinox that coordinates are
  ;; precessed *to*, default 2000
  if n_elements(tfixed0) EQ 0 then fepoch = 2451545.0D - fbase $
  else                             fepoch = double(fepoch0(*))

  ;; Form epoch of date in centuries from J2000.0
  t = (jdtt(*) + (tbase - 2451545.0d))/36525d

  ;; Angular conversion factors
  TWOPI = 2d*!dpi
  AS2R  = !dpi/3600d/180d         ;; 1   arcsec to radians
  MAS2R = !dpi*0.0001d/3600d/180d ;; 0.1 milliarcsec to radians

  ;; Interpolate the JPL ephemerides of nutations if requested
  if keyword_set(jpl) then begin
      ;; Markwardt-specific function
      forward_function get_xtecal

      sz = size(jpl)
      if sz(sz(0)+1) EQ 7 then efile = strtrim(jpl(0),2) $
      else efile = find_with_def('JPLEPH.405','ASTRO_DATA')

      if efile EQ '' then begin
          catch, catcherr
          if catcherr EQ 0 then efile = get_xtecal()+'clock/JPLEPH.200'
          catch, /cancel
          if efile EQ '' then $
            message, 'ERROR: could not find JPL ephemeris'
      endif

      jdlimits = [min(jdtt+tbase)-1, max(jdtt+tbase)+1]

      jplephread, efile, info, raw, jdlimits, status=st, errmsg=ee
      if st EQ 0 then message, ee
      jplephinterp, info, raw, jdtt, dpsi, deps, $
        object='NUTATIONS', tbase=tbase

      goto, PRECESS_ANGLES
  endif

  ;; Do this equation in chunks, in case of a large input time array
  dpsi = t*0 & deps = dpsi

  nt = n_elements(t)
  ns = 1000L
  if NOT keyword_set(nonut1) then for i = 0L, nt-1, ns do begin

      ;; Compute indices of input and output arrays
      imax = (i+ns-1)<(nt-1)
      ti = t(i:imax)
      if n_elements(one) NE n_elements(ti) then $
        one = ti*0 + 1

      ;; Compute the fundamental arguments: mean anom of Moon; mean anom
      ;; of Sun; long. of Moon minus long. of Moon's node; mean elongation
      ;; betw. Moon & Sun; mean long. of asc. node of Moon
      ;; ESAA Table 3.222.2
      fundargs = [[poly(ti, farg(*,0))], [poly(ti, farg(*,1))], $
                  [poly(ti, farg(*,2))], [poly(ti, farg(*,3))], $
                  [poly(ti, farg(*,4))]] MOD TWOPI

      ;; ESAA Eqn 3.222-6 (lower equation)
      arg = arg80 # transpose(temporary(fundargs))

      ;; IAU 1980 Nutation in longitude and obliquity (radians)
      ;; ESAA Eqn 3.222-6 (upper equations) and Table 3.222.1
      dpsi(i:imax) = total( (psi80(*,0)#one + psi80(*,1)#ti) * sin(arg), 1)
      deps(i:imax) = total( (eps80(*,0)#one + eps80(*,1)#ti) * cos(arg), 1)
      arg = 0
  endfor

  ;; Above quantities are in mas, convert to radians
  dpsi = dpsi * MAS2R
  deps = deps * MAS2R

  PRECESS_ANGLES:
  ;; Precession from epoch of date to "fixed" epoch
  ;; ESAA Eqn 3.211-2
  t0 = ((fbase-2451545d0) + fepoch)       / 36525d0
  td = ((tbase-fbase) + (jdtt(*)-fepoch)) / 36525d0

  ;; Arguments of ZETA, Z and THETA (part of ESAA Table 3.211.1)
  ;; Symbology note:  ESAA's T is my t0;    ESAA's t is my td
  w1 = poly(t0, [2306.2181d,  1.39656d, -0.000139d])
  w2 = poly(t0, [2004.3109d, -0.85330d, -0.000217d])
  
  ;; IAU 1976 Precession quantities (arcsec)
  ;; Remainder of ESAA Table 3.211.1
  zeta  = (w1 + (( 0.30188D0 - 0.000344D0 * t0 ) + 0.017998D0 * td ) * td )*td
  z     = (w1 + (( 1.09468D0 + 0.000066D0 * t0 ) + 0.018203D0 * td ) * td )*td
  theta = (w2 + ((-0.42665D0 - 0.000217D0 * t0 ) - 0.041833D0 * td ) * td )*td
  ;; ABOVE QUANTITIES ARE IN ARCSEC!
  w1 = 0 & w2 = 0 & td = 0 & t0 = 0  ;; Memory

  ;; Get earth orientation parameters, UT1-UTC
  ;; Convert TT to UT1
  jdtai = jdtt(*) - 32.184d/86400d
  jdutc = jdtai + tai_utc(jdtai + tbase, /invert)/86400d

  ;; Query the EOP database, or set the values to zero
  if keyword_set(useeop) then begin
      eopdata, jdutc, pmx, pmy, ut1_utc, dpsi1, deps1, tbase=tbase

      ;; Adjust the values of the nutation in longitude and obliquity
      deps = deps + deps1
      dpsi = dpsi + dpsi1

      deps1 = 0 & dpsi1 = 0 ;; Memory
  endif else begin
      pmx = 0 & pmy = 0 & ut1_utc = 0 
  endelse
  if keyword_set(no_ut1) then ut1_utc = 0

  ;; Mean obliquity of ecliptic at epoch of date (arcsec)
  ;; ESAA Eqn 3.222-1
  eps0 = poly(t, [84381.448D0, -46.8150D0, -0.00059D0, +0.001813D0]) * AS2R

  ;; True obliquity of ecliptic at epoch of date
  ;; ESAA Eqn 3.222-2
  eps = eps0 + deps

  ;; Greenwich Mean Sidereal Time
  jdut1 = jdutc + ut1_utc/86400d
  jdutc = 0 & jdtai = 0 & & ut1_utc = 0 ;; Memory
  t1 = ((tbase-2451545D) + jdut1) / 36525d

  ;; ESAA Eqn 2.24-1
  gmst1 = poly(t1, [24110.54841d, 8640184.812866d, 0.093104d, -6.2D-6])/86400d
  gmst = (gmst1 MOD 1d) + (jdut1 MOD 1d) + (tbase MOD 1d) + 3.5d
  gmst = TWOPI*( gmst MOD 1d )
  t1 = 0 & gmst1 = 0 ;; Memory

  ;; Equation of the equinoxes - includes two terms depending on the
  ;; mean longitude of the ascending node of the moon.
  ;; ESAA Sec. 3.223 and (IERS Conventions 1996)
  om = poly(t, farg(*,4)) MOD TWOPI
  eqeq = dpsi * cos(eps) + AS2R * (2.64d-3*sin(om) + 6.3d-5*sin(2d*om))
  om = 0 ;; Memory
  
  ;; Greenwich Apparent Sidereal Time
  ;; ESAA Sec. 3.223
  gast = gmst + eqeq

  ;; Units conversions
  case angunits of 
      'ARCSEC': begin
          R2AS = 1d/AS2R ;; Radian to arcsec

          dpsi = dpsi * R2AS
          deps = deps * R2AS
          eps  = eps  * R2AS
          eps0 = eps0 * R2AS
          eqeq = eqeq * R2AS
          pmx  = pmx  * R2AS
          pmy  = pmy  * R2AS
      end
      
      'RADIAN': begin   ;; Arcsec to radians
          zeta = zeta * AS2R 
          z    = z    * AS2R
          theta= theta* AS2R
      end

      ;; Also convert to degrees?

      else: begin
          message, 'ERROR: angular unit '+angunits+$
            ' was not recognized'
      end
  end

  return
end
;+
; NAME:
;   HPRSTATN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute high precision earth station positions in inertial coordinates
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   HPRSTATN, JDTT, R_ITRF, R_ECI, V_ECI, $
;             [ /JPL, /USE_EOP, /NO_UT1, TBASE= ]
;
; DESCRIPTION:
;
;  The procedure HPRSTATN computes the coordinates and velocities of
;  an earth station in J2000 equatorial earth-centered inertial
;  coordinates (ECI).  This may be useful in any application where an
;  earthbound observatory is used to collect data on a non-terrestrial
;  phenomenon.
;
;  The user must have the following routines involved: HPRNUTANG;
;  Markwardt Quaternion Library; JPLEPHREAD and JPLEPHINTERP (if JPL
;  keyword is used); EOPDATA (if USE_EOP keyword is set); and TAI_UTC.
;  Also, the appropriate data files for TAI-UTC and Earth Orientation
;  Parameters must be installed.
;
;  The user must specify the position of the earth station in
;  earth-centered, earth-fixed, cartesian coordinates of the ITRF.
;  The Z-axis points to terrestrial north, the X-axis lies in the
;  terrestrial equator pointing towards the Greenwich meridian, and
;  the Y-axis forms the right handed coordinate system.  Any
;  positional units may be specified.
;
;  For the highest precision, the preferred method is to know the
;  coordinates from a direct IRTF reduction, i.e., via VLBI.  If you
;  have geodetic longitude/latitude, a procedure is given below which
;  can covert geodetic coordinates referred to WGS84 to ITRF cartesian
;  coordinates.
;
;  The values returned are the earth-centered inertial J2000
;  coordinates and velocities of the station.  All the effects of
;  earth rotation, precession, nutation, and polar motion can be
;  included.  The user has a choice of the kinds of transformations
;  that are included (see JPL, USE_EOP and NO_UT1 keywords).
;
;  The returned positional units are the same as the input units.  The
;  returned velocity units are (units of input) PER SECOND.
;
;  It is possible specify more than one time, or more than one station
;  position, or both.  If both more than one time and position are
;  specified, then there must be an equal quantity of both.
;
;
; CARTESIAN COORDINATES FROM GEODETIC COORDINATES
;
;  For a station whose geodetic latitude LAT, longitude LON (where
;  positive is east) and elevation H specified relative to the
;  ellipsoid, the cartesian coordinates are:
;
;         R_ITRF = [ (A*C + H)*COS(LAT)*COS(LON), $
;                    (A*C + H)*COS(LAT)*SIN(LON), $
;                    (A*S + H)*SIN(LAT) ]
;
;  where for the WGS84 reference ellipsoid, the equatorial radius is
;  set to A = 6378.137 km, and the flattening factor F =
;  1/298.257223563, and
;
;      C = 1.0/SQRT(COS(LAT)^2 + (1 - F)^2*SIN(LAT)^2)
;      S = (1 - F)^2 * C
;
;  Reference: Explanatory Supplement to the Astronomical Almanac,
;  eqns. 3.351-1 and 3.352-2.
;
;
; INPUTS:
;
;   JDTT - a scalar or N-vector, the TT epoch time(s) for which
;          station coordinates are to be computed.
;
;          For reference, JDTT = JDTAI + 32.184/86400d, where JDTAI is
;          the international atomic time measured in days.  The value
;          of the keyword TBASE is added to JDTT to arrive at the
;          actual Julian date.
;
;   R_ITRF - cartesian coordinates of earth station.  Either a
;            3-vector, or a 3xN array.  Units can be any positional
;            units.
;
;
; OUTPUTS:
;
;   R_ECI - upon output, the coordinates of the station at the given
;           time(s), referred to the earth-centered J2000 coordinate
;           system.  Either a 3-vector or 3xN array depending on the
;           input.  Units are the same as for R_ITRF.
;
;   V_ECI - upon output, the velocities of the station at the given
;           time(s), referred to the earth-centered J2000 coordinate
;           system.  Either a 3-vector or 3xN array depending on the
;           input.  Units are (units of R_ITRF) PER SECOND.
;
;
; KEYWORD PARAMETERS:
;
;   TBASE - a fixed epoch time (Julian days) to be added to each value
;           of JDTT.  Since subtraction of large numbers occurs with
;           TBASE first, the greatest precision is achieved when TBASE
;           is expressed as a nearby julian epoch, JDTT is expressed
;           as a small offset from the fixed epoch.  
;           Default: 0
;
;   JPL - if set, then the JPL ephemeris is used to compute nutation
;         angles.  Otherwise the series representation of HPRNUTANG is
;         used.
;
;   USE_EOP - if set, then use earth orientation parameters, returned
;             by EOPDATA, to further refine the station coordinates.
;             Otherwise, only precession and nutation are used.
;
;   NO_UT1 - if set, then do not use the UT1-UTC conversion.
;   NO_PRECESSION - disable precession calculation.
;   NO_NUTATION - disable nutation calculation.
;   NO_POLAR_MOTION - disable polar motion calculation.
;
;
; EXAMPLE:
;
;   ;; ITRF coordinates of Deep Space Network Antenna 63 (METERS)
;   R_DSN63 = [+4849092.647d, -0360180.569d, +4115109.113d]
;
;   ;; Time: 2000/01/01 01:30 TT
;   JDTT = jday(2000d,1,1) + 1.5/24
;
;   ;; Compute position of antenna in J2000 coordinate system using
;   ;; full Earth Orientation Parameters.
;   HPRSTATN, JDTT, R_DSN63, R_ECI, V_ECI, /USE_EOP
;
;
; SEE ALSO:
;
;   HPRNUTANG, TAI_UTC (Markwardt Library)
;   EOPDATA, JPLEPHREAD, JPLEPHINTERP
;
;
; REFERENCES:
;
;   McCarthy, D. D. (ed.) 1996: IERS Conventions, IERS T.N. 21.
;     http://maia.usno.navy.mil/conventions.html
;
;   Seidelmann, P.K. 1992, *Explanatory Supplement to the Astronomical
;     Almanac*, ISBN 0-935702-68-7
;
;
; MODIFICATION HISTORY:
;   Written, 6 May 2002, CM
;   Documented, 12 May 2002, CM
;   Corrected discussion of geodetic coordinates, 26 May 2002, CM
;   Add NO_POLAR_MOTION keyword; only compute V_ECI if the variable
;    is passed, 07 Mar 2007, CM
;   Save some memory by deleting variables that are no longer used,
;    19 Dec 2008, CM
;   Some small documentation improvements, 16 Jan 2010, CM
;   Correct error in calculation of conversion from geodetic lat/lon
;     to cartesian, and add references, 2010-05-12, CM
;
;  $Id: hprstatn.pro,v 1.8 2010/05/12 22:17:32 craigm Exp $
;
;-
; Copyright (C) 2002, 2007, 2008, 2010, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   INPUTFORM
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Generates expression string from an IDL value
;
; CALLING SEQUENCE:
;   STRING = INPUTFORM(VALUE, ERRMSG=ERRMSG, STATUS=STATUS, ...)
;
; DESCRIPTION: 
;
;   The INPUTFORM function converts an IDL data value into its string
;   representation, suitable for execution at the IDL command line or
;   with EXECUTE().  This is similar to the "InForm" output
;   representation of Mathematica, which formats output so that it can
;   be entered again on the command line.  INPUTFORM() is a
;   specialized form of STRING().
;
;   For example, the value DBLARR(2,2) has the default representation
;
;      '[[0D,0],[0D,0]]'
;
;   The formal goal of INPUTFORM is for the resulting textual
;   expression to be an exact representation of the original data.
;   Several other output options can be selected by using the /ZERO or
;   /ARRAY_NOTATION keywords.
;
;   Therefore, given the original value VARIABLE, then after executing
;
;      R = EXECUTE( 'variable1 = '+INPUTFORM(variable) )
;
;   The value, type, and dimension of VARIABLE1 and VARIABLE will be
;   the same.  
;
;   Such behavior might useful in several circumstances:
;
;      * for printing values meant to be "pasted" back into the
;        command line by the user;
;      * for constructing command arguments to be EXECUTE()'d;
;      * for saving values in ASCII format for later execution.
;
; OUTPUT OPTIONS:
;
;   The output of INPUTFORM can be controlled in the following ways.
;   See the EXAMPLES section for examples of each kind of behavior.
;
;      * By default, the output will replicate the exact values of the
;        input;
;      * If the /ZERO keyword parameter is set, then the output will
;        match the type and structure of the input, but all values
;        will be zero or blank, including IDL strings and structures.
;        This is useful if one wants to make a "blank template" from
;        an existing IDL data structure.
;      * If the /ARRAY_NOTATION keyword parameter is set, then any
;        input arrays are converted to INTARR(), DBLARR(), STRARR().
;        Scalars appear as in the input.  Obviously the contents of
;        arrays will be zero/blank in this case.  The combination of
;        /ZERO and /ARRAY_NOTATION produces a nice short-hand
;        blank template.
;
; LIMITATIONS:
;   
;   It should be noted that the IDL parser is not perfect.
;   While IDL has many data types, not all expressions are
;   representable as a textual string.  Pointers and objects can be
;   represented.  Examples of the parser limitation include,
;
;      * array expressions can have no more than 90 elements;
;      * bracketed array notation cannot be nested too deeply;
;      * anonymous structure arrays have no textual representation;
;
;   Given these limitations, the user of this routine must be prepared
;   for failure and have contingency plans.  Error messages and status
;   indicators are provided to facilitate this.  INPUTFORM() does not
;   call MESSAGE, so it should never intentionally crash.
;
;   Also, consider that the textual representation can never really be
;   suitable for very large arrays.  The internal algorithm is thus
;   not optimized for speed as heavily numeric routines might be, and
;   instead tries to make the output slightly more readable.
;
; INPUTS:
;
;   VALUE - the IDL value to be converted.  Any value which has a
;           legal textual representation is permitted.
;
; KEYWORDS:
;
;   ARRAY_NOTATION - if set, then any arrays in the input will be
;            replaced by their xxxARR() equivalent.
;
;   STATUS - upon return, a status indicator.  A value of zero
;            indicates failure; one indicates success.
;
;   ERRMSG - upon return, a string message indicating the reason for a
;            failure, if any.  The empty string ('') indicates
;            success.
;
;   MAX_DIMENSIONS - maximum number of array dimensions permitted in
;                    VALUE.  The conversion fails if the maximum is
;                    exceeded.
;                    Default: any number of dimensions is permitted.
;
;                    NOTE: IDL does not permit deep nesting, for
;                    dimensions greater than three.
;
;   MAX_ELEMENTS - maximum number of elements permitted in VALUE.  The
;                  conversion fails if the maximum is exceeded.
;                  Default: any number of elements is permitted.
;
;                  NOTE: the conversion may still fail if any array
;                  dimension exceeds 90.
;
;   MAX_LEN - approximate maximum length of returned string.  If large
;             string expressions exceed this size as they are being
;             composed internally, they will be terminated by a '...'
;             ellipsis and returned.  This value is to be used as a
;             guideline by INPUTFORM(); the precise limit may not be
;             adhered to.
;             Default: 16384L
;
;   MAX_TAGS - maximum number of structure tags permitted in VALUE.
;              The conversion fails if the maximum is exceeded.
;              Default: any number of tags is permitted.
;
;   N_FLOAT - for floating point numerical values, N_FLOAT gives the
;             number of decimal digits to print.  By definition,
;             setting this keyword will involve the loss of some
;             precision compared to the original value.
;             Default: full precision is printed.
;
;   ZERO - if set, then the output command will have zero values for
;          all fields, regardless of the contents of the input data.
;
;            
; RETURNS:
;   The resulting converted string, if successful.  Upon failure,
;   STATUS is set to zero and the empty string ('') is returned.
;
; EXAMPLE:
;   
;   Convert a double array to text using the default output option,
;     IDL> x = [[1,2],[3,4]]
;     IDL> print, inputform(x)
;     --->   [[1,2],[3,4]]
;
;   The same input, but using the /ZERO and /ARRAY_NOTATION options,
;     IDL> print, inputform(x, /zero)
;     --->   [[0,0],[0,0]]
;     IDL> print, inputform(x, /array_notation)
;     --->   INTARR(2L,2L)
;
;   Convert a structure,
;     IDL> y = create_struct('s1',5,'s2','strvalue','s3',[1,2,3])
;     IDL> print, inputform(y)
;     --->   [{S1:5,S2:'strvalue',S3:[1,2,3]}]
;
;   Also with /ZERO and /ARRAY_NOTATION options,
;     IDL> print, inputform(y, /zero)
;     --->   {S1:0,S2:'',S3:[0,0,0]}
;     IDL> print, inputform(y, /array_notation)
;     --->   {S1:5,S2:'strvalue',S3:INTARR(3L)}
;     (Note that in the final case with /ARRAY_NOTATION alone, S3 is
;      replaced by INTARR(), but that the scalars are left unchanged.)
;     IDL> print, inputform(y, /zero, /array_notation)
;     --->   {S1:0,S2:'',S3:INTARR(3L)}
;     (With /ZERO and /ARRAY_NOTATION combined, then all fields are
;      zero or blank).
;
; SEE ALSO:
;
;   STRING, PRINT, HELP, HELPFORM
;
; MODIFICATION HISTORY:
;   Written, CM, 10 Apr 2000
;   Added HELPFORM to SEE ALSO, CM, 04 Jul 2000
;   Corrected case of scalar float value, CM, 13 Jul 2000
;   Put a space after float types like 1E or 1D to ease parsing, CM,
;     18 Jul 2000
;   Add ability to print INPUTFORM of pointers, CM, 09 Dec 2002
;   Add ability to print INPUTFORM of object pointers, CM, 01 Oct 2003
;   Bug fix: actually obey MAX_ELEMENTS (was being ignored), CM, 22
;     Oct 2006
;   Change to square-bracket array syntax, CM, 27 Feb 2007
;   Add the ZERO and ARRAY_NOTATION keywords; handle NAN and INFINITY
;     values properly, CM, 02 Jun 2009
;   Add N_FLOAT keyword, CM, 13 Nov 2010
;   
;
;  $Id: inputform.pro,v 1.8 2010/11/13 09:27:36 cmarkwar Exp $
;
;-
; Copyright (C) 2000,2001,2002,2003,2006,2007,2009,2010 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Forward declarations of functions, for goodness's sake
forward_function inputform_int, inputform_float, inputform_string, $
  inputform_struct, inputform_basic, inputform

;; Convert an integer style value to a string
function inputform_int, x, format, zero=zero
  COMPILE_OPT strictarr
  n = n_elements(x)
  if keyword_set(zero) then x[*] = 0
  ;; Construct format like (N(format,:,","))
  fmt = '('+strtrim(n,2)+'('+format+',:,","))'
  return, string(x, format=fmt)
end

;; Convert a floating style value to a string.  Note the conversion
;; happens twice, once as a E and once as a G.  The shortest correct
;; version of the two is used.
function inputform_float, x, format, dconvert=dcon, zero=zero, $
                          nfloat=nfloat
  COMPILE_OPT strictarr
  n = n_elements(x)
  sz = size(x) & tp = sz[sz[0]+1]

  gfmt = 'G0'
  if n_elements(nfloat) GT 0 then gfmt = gfmt+'.'+strtrim(nfloat,2)
  gfmt = '('+gfmt+')'

  if keyword_set(zero) then begin
      x[*] = 0
      str = string(x, format=gfmt)
  endif else begin

      str = string(x[*], format=format)

      ;; Sorry, there appears to be no other way to make nice looking
      ;; floating point numbers.
      str1 = string(x[*], format=gfmt)
      if n_elements(nfloat) EQ 0 then begin
          if tp EQ 4 then x1 = float(str1)
          if tp EQ 5 then x1 = double(str1)
          wh = where(x-x1 EQ 0, ct)
          if ct GT 0 then str[wh] = str1[wh]
          str1 = 0
      endif else begin
          str = temporary(str1)
      endelse
  endelse
  str = strtrim(str,2)

  p = strpos(str[0], 'E')  ;; Make sure at least one element is float-type
  ;; Note, the space is needed in case the string is placed inside
  ;; another expression down the line.
  if p LT 0 then begin
      if keyword_set(dcon) then str[0] = str[0] + 'D' $
      else str[0] = str[0] + 'E'
  endif
  if keyword_set(dcon) then begin
      ;; Convert from floating to double
      p = strpos(str, 'E')
      wh = where(p GE 0, ct)
      for i = 0L, ct-1 do begin
          str1 = str[wh[i]]
          strput, str1, 'D', p[wh[i]]
          str[wh[i]] = str1
      endfor
  endif

  if NOT keyword_set(zero) then begin
      ;; Handle NAN
      wh = where(x NE x, ct)
      if ct GT 0 then begin
          str[wh] = (keyword_set(dcon)) ? ('!VALUES.D_NAN') : ('!VALUES.F_NAN')
      endif
      
      ;; Handle infinities
      ;; ... plus infinity ...
      wh = where(x EQ !values.d_infinity, ct)
      if ct GT 0 then begin
          str[wh] = (keyword_set(dcon)) ? ('!VALUES.D_INFINITY') : ('!VALUES.F_INFINITY')
      endif
      ;; ... minus infinity ...
      wh = where(x EQ -!values.d_infinity, ct)
      if ct GT 0 then begin
          str[wh] = (keyword_set(dcon)) ? ('-!VALUES.D_INFINITY') : ('-!VALUES.F_INFINITY')
      endif
  endif

  ;; Construct format like (N(A,:,","))
  fmt = '('+strtrim(n,2)+'(A,:,","))'
  return, string(str, format=fmt)
end

;; Convert a string to a string.  This means protecting against stray
;; quotation marks.
function inputform_string, x, zero=zero
  COMPILE_OPT strictarr
  n = n_elements(x)

  if keyword_set(zero) then begin
      x1 = strarr(n)
  endif else begin
      x1 = x
      ;; Strings must be protected against having quotation marks within
      ;; themselves
      wh = where(strpos(x1, "'") GE 0, ct)
      if ct GT 0 then begin
          for i = 0L, ct-1 do begin
              x2 = x1[wh[i]]
              ;; Find each quotation mark and replace it
              p = strpos(x2, "'")
              while p GE 0 do begin
                  l = strlen(x2)
                  if p GE 0 then x2 = strmid(x2, 0, p)+"'"+strmid(x2, p, l-p)
                  p = strpos(x2, "'", p+2)
              endwhile
              x1[wh[i]] = x2
          endfor
      endif
  endelse

  ;; Now protected, the strings can be joined
  fmt = '('+strtrim(n,2)+'("''",A,"''",:,","))'
  return, string(x1, format=fmt)
end

;; Convert a structure type.  Recursive calls to inputform() are
;; performed to convert the internal tag values.
function inputform_struct, data, status=status, errmsg=errmsg, zero=zero, $
                           array_notation=arrnot, nocatch=nocatch, $
                           nfloat=nfl
  COMPILE_OPT strictarr
  n = n_elements(data)
  s0 = ''
  tn = tag_names(data)
  sn = tag_names(data, /structure_name)
  for i = 0L, n-1 do begin
      s = '{'
      ;; Open braces and add structure name if possible
      if sn NE '' then s = s + sn + ','
      comma = ''
      for j = 0L, n_elements(tn)-1 do begin
          ;; Add each tag
          status = 0
          s = s + comma + tn[j] + ':' + $
            inputform(data[i].(j), status=status, errmsg=errmsg, max_dim=2, $
                      zero=zero, array_notation=arrnot, $
                      n_float_digits=nfloat, $
                      nocatch=nocatch)
          if status NE 1 then return, ''
          comma = ','
      endfor
      s = s + '}'
      if i NE n-1 then s = s + ','
      s0 = s0 + s
  endfor
  status = 1
  return, s0
end

;; Convert pointer
function inputform_ptr, x, tp, zero=zero
  COMPILE_OPT strictarr
  nel = n_elements(x)

  if tp EQ 10 then fun = 'PTR' else fun = 'OBJ'
  if keyword_set(zero) then begin
      if nel EQ 1 then return, fun+'_NEW()'
      return, string(fun, nel, format='(A0,"_ARR(",I0,")")')
  endif

  ;; Convert to string representation, then fish out the integers
  strep = string(x, /print)
  stb = byte(strep)
  st0 = stb*0b + 32b
  ;; Fish out the integers...
  wh = where(stb GE (byte('0'))[0] AND stb LE (byte('9'))[0], ct)
  if ct GT 0 then st0[wh] = stb[wh]
  
  ;; .. but also replace Nulls with 0 and '>' with commas
  wh = where(stb EQ (byte('>'))[0], ct)
  if ct GT 0 then st0[wh] = (byte(','))[0]
  wh = where(stb EQ (byte('N'))[0], ct)
  if ct GT 0 then st0[wh] = (byte('0'))[0]

  sti = strcompress(string(st0),/remove_all)
  dummy = execute('ind = [0L,'+sti+'0L]')
  ind = ind[1:nel]

  ;; Convert to a list of pointers using PTR_VALID and /CAST
  format = '('+strtrim(nel,2)+'("'+fun+'_valid(",I0,",/cast)",:,","))'
  stf = string(ind, format=format)

  return, stf
end

;; Convert basic types
function inputform_basic, x, status=status, errmsg=errmsg, si=si, zero=z, $
                          array_notation=arrnot, nocatch=nocatch, $
                          nfloat=nfl
  COMPILE_OPT strictarr

  s = ''
  si = ''
  status = 1
  sz = size(x)
  tp = sz[sz[0]+1]
  case (tp) of 
      1:  s = inputform_int(x, '(I0,"B")', zero=z)      ;; BYTE
      2:  s = inputform_int(x, '(I0)', zero=z)          ;; INTEGER
      3:  s = inputform_int(x, '(I0,"L")', zero=z)      ;; LONG
      4:  s = inputform_float(x, '(E)', zero=z,nfl=nfl) ;; FLOAT
      5:  s = inputform_float(x, '(E)', /dconv, zero=z,nfl=nfl) ;; DOUBLE
      7:  s = inputform_string(x, zero=z)               ;; STRING
      10: s = inputform_ptr(x,10, zero=z)               ;; POINTER
      11: s = inputform_ptr(x,11, zero=z)               ;; OBJPTR
      12: s = inputform_int(x, '(I0,"U")', zero=z)      ;; UNSIGNED INTEGER
      13: s = inputform_int(x, '(I0,"UL")', zero=z)     ;; UNSIGNED LONG
      14: s = inputform_int(x, '(I0,"LL")', zero=z)     ;; LONG64
      15: s = inputform_int(x, '(I0,"ULL")', zero=z)    ;; UNSIGNED LONG64  
      
      6: begin ;; COMPLEX
          s  = inputform_float(float(x), '(E)', zero=z, nfl=nfl)
          si = inputform_float(imaginary(x), '(E)', zero=z, nfl=nfl)
      end
      9: begin ;; DCOMPLEX
          s  = inputform_float(double(x), '(E)', /dconv, zero=z, nfl=nfl)
          si = inputform_float(imaginary(x), '(E)', /dconv, zero=z, nfl=nfl)
      end
      
      8: begin ;; STRUCTURE
          s = inputform_struct(x, status=status, errmsg=errmsg, zero=z, $
                               array_notation=arrnot, nocatch=nocatch, nfl=nfl)
          if status EQ 0 then return, ''
      end

      else: return, ''
  end

  return, s
end


function inputform_array1, type, dims
  COMPILE_OPT strictarr
  return, type+'('+inputform_int(dims, '(I0,"L")')+')'
end

function inputform_array, x, status=status, errmsg=errmsg, si=si
  COMPILE_OPT strictarr

  s = ''
  si = ''
  sz = size(x)
  tp = sz[sz[0]+1]
  ndim = sz[0]
  dims = sz[1:ndim]

  status = 0

  case (tp) of 
      1:  s = inputform_array1('BYTARR',dims)       ;; BYTE             
      2:  s = inputform_array1('INTARR',dims)       ;; INTEGER          
      3:  s = inputform_array1('LONARR',dims)       ;; LONG             
      4:  s = inputform_array1('FLTARR',dims)       ;; FLOAT            
      5:  s = inputform_array1('DBLARR',dims)       ;; DOUBLE           
      6:  s = inputform_array1('COMPLEXARR',dims)   ;; COMPLEX
      7:  s = inputform_array1('STRARR',dims)       ;; STRING           
      9:  s = inputform_array1('DCOMPLEXARR',dims)  ;; DCOMPLEX
      10: s = inputform_array1('PTRARR',dims)       ;; POINTER          
      11: s = inputform_array1('OBJARR',dims)       ;; OBJPTR           
      12: s = inputform_array1('UINTARR',dims)      ;; UNSIGNED INTEGER 
      13: s = inputform_array1('ULONARR',dims)      ;; UNSIGNED LONG    
      14: s = inputform_array1('LON64ARR',dims)     ;; LONG64           
      15: s = inputform_array1('ULON64ARR',dims)    ;; UNSIGNED LONG64  
      
      else: begin
          errmsg = 'Cannot make ARRAY notation for type '+strtrim(tp,2)
          return, ''
      end
  end

  status = 1
  return, s
end


function inputform_brackets, s, l, r, si=si, status=status, errmsg=errmsg
  COMPILE_OPT strictarr

  if status EQ 0 then return, s

  for i = 0, l-1 do begin
      s  = '[' + s
      if n_elements(si) GT 0 then if si NE '' then si = '[' + si
  endfor
  for i = 0, r-1 do begin
      s  = s + ']'
      if n_elements(si) GT 0 then if si NE '' then si = si + ']'
  endfor

  return, s
end



;; Main routine
function inputform, data, errmsg=errmsg, status=status, max_elements=nmax, $
                    max_dimensions=nmaxd, max_tags=nmaxt, max_len=nmaxl, $
                    array_notation=arrnot, zero=z, $
                    n_float_digits=nfl, $
                    nocatch=nocatch

  COMPILE_OPT strictarr
  status = 0
  expr = ''
  errmsg = ''

  ;; General error catching, in case we didn't get everything
  catcherr = 0
  if NOT keyword_set(nocatch) then catch, catcherr
  if catcherr NE 0 then begin
      catch, /cancel
      status = 0
      expr = ''
      if errmsg EQ '' then errmsg = 'An unknown conversion error occurred'
      return, expr
  endif

  sz = size(data)
  typenames = ['UNDEFINED', 'BYTE', 'INTEGER', 'LONG', 'FLOAT', 'DOUBLE', $
               'COMPLEX', 'STRING', 'STRUCTURE', 'DCOMPLEX', 'POINTER', $
               'OBJECT', 'UNSIGNED INTEGER', 'UNSIGNED LONG', $
               'LONG64', 'UNSIGNED LONG64', 'UNKNOWN']

  ;; Certain types have *no* representation
  ndims = sz[0]
  tp = sz[ndims+1]
  if (tp EQ 0) OR (tp GT 15) then begin
      errmsg = 'Type '+typenames[tp<16]+' has no input representation'
      return, expr
  endif

  ;; Don't convert arrays that are too large
  ndata = n_elements(data)
  if n_elements(nmax) EQ 0 then nmax = ndata
  if ndata GT nmax[0] then begin
      errmsg = 'DATA array has too many elements'
      return, expr
  endif

  ;; Arrays cannot be too big, or have anonymous structures
  MAXLEN = nmax
  if ndims GT 0 then begin
      if max(sz[1:ndims]) GT MAXLEN then begin
          errmsg = string(MAXLEN, $
            format='("Array type is too large (>",I0," elements per dim)")')
          return, expr
      endif
      ;; Structure cannot be anonymous
      if ndata GT 1 AND tp EQ 8 then begin
          if tag_names(data[0], /structure) EQ '' then begin
              errmsg = 'Arrays of anonymous structures are not permitted'
              return, expr
          endif
      endif
  endif

  odims = 1L     ;; "OUTER" dimensions 
  fdims = sz[1]  ;; "INNER" dimensions
  if ndims EQ 0 then fdims = 1L
  if ndims GE 2 then for i = 2, ndims do odims = odims * sz[i]

  if ndims GT 0 then begin
      dims = sz[1:ndims]
  endif else begin
      dims = [0L]
  endelse

  ;; Look for the maximum number of dimensions or structure tags
  if n_elements(nmaxd) GT 0 then if ndims GT nmaxd[0] then begin
      errmsg = 'Array has too many dimensions'
      return, expr
  endif
  if tp EQ 8 AND n_elements(nmaxt) GT 0 then $
    if n_elements(tag_names(data[0])) GT nmaxt[0] then begin
      errmsg = 'Structure has too many tags'
      return, expr
  endif

  ;; Create a nicer array to work with
  ss  = '' & ssi = ''
  x = reform([data], fdims, odims)

  case 1 of 
      (NDIMS EQ 0): begin    ;;; =========== SCALAR
          ss = inputform_basic(data, si=ssi, status=status, errmsg=errmsg, zero=z, nfl=nfl)
      END

      ((NDIMS EQ 1) AND (TP EQ 8) AND (NDATA EQ 1)): begin ;; ====== SCALAR STRUCT
          ss = inputform_basic(data, si=ssi, status=status, errmsg=errmsg, zero=z, $
                               nocatch=nocatch, array_notation=arrnot, nfl=nfl)
      END

      (keyword_set(arrnot) AND (TP NE 8)): begin
          ss = inputform_array(data, status=status, errmsg=errmsg)
      end
          
      (NDIMS EQ 1): begin    ;;; =========== 1-D ARRAY
          ss = inputform_basic(data, si=ssi, status=status, errmsg=errmsg, zero=z, nfl=nfl)
          ss = inputform_brackets(ss, 1, 1, si=si, status=status, errmsg=errmsg)
      end
          
      else: begin    ;; ========== Higher dimensional arrays
          xdims = dims[1:*]
          for i = 1, ndims-2 do xdims[i] = xdims[i]*xdims[i-1]
  
          comma = ''
          
          for i = 0L, odims-1 do begin
              
              xx = x[*,i]
              
              ;; Opening and closing brackets depends on whether we
              ;; are at the end of a multiple of the array dimensions.
              wh = where((i MOD xdims) EQ 0,     nleft)  & nleft  = nleft  + 1
              wh = where(((i+1) MOD xdims) EQ 0, nright) & nright = nright + 1

              ;; Representation with brackets
              s = inputform_brackets(inputform_basic(xx, si=si, zero=z, nfl=nfl, $
                                                     errmsg=errmsg, status=status), $
                                     nleft, nright, si=si, $
                                     errmsg=errmsg, status=status)

              ;; Accumulate with previous values
              ss  = ss  + comma + s
              ssi = ssi + comma + si 

              if status EQ 0 then break

              comma = ','
              if n_elements(nmaxl) GT 0 then $
                if strlen(ss)+strlen(ssi) GT nmaxl[0] then begin
                  ss = ss + '...'
                  ssi = ssi + '...'
                  break
              endif

          endfor
      end
  endcase

  ;; If we had an error condition above, do not continue
  if status EQ 0 then return, expr

  ;; Merge real and imaginary parts together
  if NOT keyword_set(arrnot) then begin
      if tp EQ 6 then ss =  'COMPLEX('+ss+','+ssi+')'
      if tp EQ 9 then ss = 'DCOMPLEX('+ss+','+ssi+')'
  endif
  s = ''
  ;; Final dimensions can be lost if they are not reformed
  if ndims GT 1 then begin
      for j = ndims-1, 0, -1 do begin
          if dims[j] NE 1 then goto, DONE_DCHECK
      endfor
      DONE_DCHECK:
      if j NE ndims-1 then $
        ss = 'REFORM('+ss+','+inputform(dims)+')'
  endif

  ;; Return
  expr = ss
  status = 1
  return, expr
end
;+
; NAME:
;   JBEPOCH
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Compute Julian Day to/from Julian or Besselian Epoch
;
; CALLING SEQUENCE:
;   EPOCH = JBEPOCH(/B, JDAY)   ;; Julian Day to Besselian Epoch
;   EPOCH = JBEPOCH(/J, JDAY)   ;; Julian Day to Julian Epoch
;
;   JDAY  = JBEPOCH(/B, EPOCH, /TO_DAY)  ;; Besselian Epoch to Julian Day
;   JDAY  = JBEPOCH(/J, EPOCH, /TO_DAY)  ;; Julian Epoch to Julian Day
;
; DESCRIPTION: 
;
;   The function JBEPOCH computes the Julian or Besselian Epoch year
;   number from a given Julian day number.  Epochs of this form are
;   often given in the astronomical literature as B1950.0 or J2000.0,
;   but they can be different.
;
;   Besselian year numbers are measured in tropical years of about
;   365.2422 days.  Julian year numbers are measured in years whose
;   lengths are exactly 365.25 days of 86400 second lengths.  The "/J"
;   or "/B" keywords identify which year numbering system is being
;   used.
;
;   JBEPOCH also computes the inverse transformation, from Julian or
;   Besselian epoch to Julian Day, by specifying the /TO_DAY keyword.
;
;   The computational logic is inspired by STARLINK (P.T. Wallace).
;
;
; INPUTS:
;
;   EPOCH or JDAY - If TO_DAY is set, Besselian or Julian year number.
;                   If TO_DAY is not set, the Julian day number.
;
; KEYWORDS:
;
;   B - if set, then year numbers (input/output) are expressed in
;       Besselian years.
;
;   J - if set, then year numbers (input/output) are expressed in
;       Julian years.
;
;   TO_DAY - if set, then convert EJ (assumed to be year number) into
;            Julian day number.
;
;   MJD - if set, then Julian days are expressed as "modified" Julian
;         Days, or Julian days minus 2400000.5d.
;
;
; RETURNS:
;
;   If TO_DAY is set, then returns Julian Days.
;
;   If TO_DAY is not set, then returns year number.
;   
;
; REFERENCES:
;
;   Lieske, J. H. 1979, Astron & Astrophysics, 73, 282
;
;   Wallace, P. T. 1999, SLALIB Software Library (STARLINK)
;     http://star-www.st-and.ac.uk/starlink/
;     (Routines sla_EPB2D, sla_EPJ2D, sla_EPB and sla_EPJ)
;
; SEE ALSO:
;
;   JULDAY, CALDAT
;
; MODIFICATION HISTORY:
;   Written, CM, 04 Mar 2002
;   Documented, CM, 22 Mar 2002
;
;  $Id: jbepoch.pro,v 1.3 2002/03/22 22:02:02 craigm Exp $
;
;-
; Copyright (C) 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   JPLEPHINTERP
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Interpolate position and motion of planetary bodies (JPL Ephemeris)
;
; MAJOR TOPICS:
;   Planetary Orbits, Interpolation
;
; CALLING SEQUENCE:
;   JPLEPHINTERP, INFO, RAWDATA, T, X, Y, Z, [VX, VY, VZ, /EARTH, /SUN,
;         OBJECTNAME=, CENTER=, TBASE=, POSUNITS=, VELUNITS= ]
;
; DESCRIPTION:
;
;   JPLEPHINTERP interpolates the JPL DE200 or DE405 planetary
;   ephemeris to find the positions and motions of planetary bodies.
;
;   This routine is the second stage of a two-stage process to
;   interpolate the JPL ephemeris.  In this first stage, the file is
;   opened using JPLEPHREAD, and the relevant portions of the table
;   are read and stored into the two variables INFO and RAWDATA.  In
;   the second stage, the user actually interpolates the ephemeris for
;   the desired bodies and to the desired ephemeris time using
;   JPLEPHINTERP.
;
;   The only independent variable which must be specified is T, the
;   ephemeris time.  For low to moderate accuracy applications, T is
;   simply the conventional calendar date, expressed in Julian days.
;   See below for high precision applications.
;
;   Upon output, the position components of the desired body are
;   returned in parameters X, Y and Z, and if requested velocity
;   components are returned in parameters VX, VY and VZ.  Coordinates
;   are referred to the ephemeris's coordinate system: FK5 for
;   JPL-DE200 and ICRS for JPL-DE405.  By default, the origin of
;   coordinates is the solar system barycenter (SSB), unless another
;   origin is selected using the CENTER keyword.
;
;   Users must set the VELOCITY keyword to generate body velocities.
;   By default they are not generated.
;
;   Users can select the desired body by using either the EARTH or SUN
;   keywords, or the OBJECTNAME keyword.
;
;   By default, positions are returned in units of KM and velocities
;   in units of KM/DAY.  However, the output units are selectable by
;   setting the POSUNITS and VELUNITS keywords.
;
; High Precision Applications
;
;   If the required precision is finer than a few hundred meters, the
;   user must be aware that the formal definition of the ephemeris
;   time is the coordinate time of a clock placed at the solar system
;   barycenter (SSB).  If the user's time is measured by a clock
;   positioned elsewhere, then various corrections must be applied.
;   Usually, the most significant correction is that from the
;   geocenter to the SSB (see Fairhead & Bretagnon 1990; Fukushima
;   1995).  Not applying this correction creates an error with
;   amplitude ~170 nano-light-seconds ( = 50 m) on the earth's
;   position.  (see TDB2TDT)
;
;   For high precision, the user should also specify the TBASE
;   keyword.  TBASE should be considered a fixed epoch with respect to
;   which T is measured; T should be small compared to TBASE.
;   Internally, subtraction of large numbers occurs with TBASE first,
;   so truncation error is minimized by specifying TBASE.
;
; Nutations and Librations
;
;   This routine also provides information about earth nutations and
;   lunar librations, which are stored in the JPL ephemeris tables.
;   The POSUNITS and VELUNITS keywords do not affect these
;   computations.
;
;   Lunar librations in the form of three Euler angles are returned in
;   X, Y, Z, in units of radians, and their time derivatives are
;   returned in VX, VY, and VZ in units of radians per day.
;
;   The earth nutation angles psi (nutation in longitude) and epsilon
;   (nutation in obliquity) are returned in X and Y, in units of
;   radians.  Their time derivatives are returned in VX and VY
;   respectively.  The quantities returned in Z and VZ are undefined.
;
; Verification
;
;   The precision routine has been verified using JPLEPHTEST, which is
;   similar to the original JPL program EPHTEST.  For years 1950 to
;   2050, JPLEPHINTERP reproduces the original JPL ephemeris to within
;   1 centimeter.
;
; Custom Ephemerides
;
;   It is possible to make custom ephemerides using JPLEPHMAKE, or to
;   augmented an existing ephemeris with additional data.  In the
;   former case JPLEPHINTERP should automatically choose the correct
;   object from the table and interpolate it appropriately.
;
;   For augmented ephemerides, the object can be specified by name,
;   which works as expected, or by number, which has a special
;   behavior.  For augmented files only, the new objects begin at
;   number 100.
;
;
; PARAMETERS: 
;
;   INFO - structure returned by JPLEPHREAD.  Users should not modify
;          this structure.
;
;   RAWDATA - raw data array returned by JPLEPHREAD.  Users should not
;             modify this data array.
;
;   T - ephemeris time(s) of interest, relative to TBASE (i.e. the
;       actual interpolation time is (T+TBASE)).  May be a scalar or
;       vector.
;
;   X, Y, Z - upon return, the x-, y- and z-components of the body
;             position are returned in these parameters.  For
;             nutations and librations see above.
;
;   VX, VY, VZ - upon return, the x-, y- and z-components of the body
;                velocity are returned in these parameters, if the
;                VELOCITY keyword is set.  For nutations and
;                librations see above.
;
;
; KEYWORD PARAMETERS:
;
;   EARTH, SUN - set one of these keywords if the desired body is the
;                earth or the sun.  One of EARTH, SUN or OBJECTNAME
;                must be specified.
;
;   OBJECTNAME - a scalar string or integer, specifies the planetary
;                body of interest.  May take any one of the following
;                integer or string values.
;
;                   1 - 'MERCURY'     9 - 'PLUTO'
;                   2 - 'VENUS'      10 - 'MOON'  (earth's moon)
;                   3 - 'EARTH'      11 - 'SUN'
;                   4 - 'MARS'       12 - 'SOLARBARY' or 'SSB' (solar system barycenter)
;                   5 - 'JUPITER'    13 - 'EARTHBARY' or 'EMB' (earth-moon barycenter)
;                   6 - 'SATURN'     14 - 'NUTATIONS' (see above)
;                   7 - 'URANUS'     15 - 'LIBRATIONS' (see above)
;                   8 - 'NEPTUNE' 
;
;                For custom ephemerides, the user should specify the
;                object name or number.
;
;                For augmented ephemerides, the user should specify
;                the name.  If the number is specified, then numbers
;                1-15 have the above meanings, and new objects are
;                numbered starting at 100.
;
;   CENTER - a scalar string or integer, specifies the origin of
;            coordinates.  See OBJECTNAME for allowed values.
;            Default: 12 (Solar system barycenter)
;
;   VELOCITY - if set, body velocities are generated and returned in
;              VX, VY and VZ.
;              Default: unset (no velocities)
;
;   POSUNITS - a scalar string specifying the desired units for X, Y,
;              and Z.  Allowed values:
;                 'KM' - kilometers  (default)
;                 'CM' - centimeters
;                 'AU' - astronomical units
;                 'LT-S' - light seconds
;               If angles are requested, this keyword is ignored and
;               the units are always 'RADIANS'.
;
;   VELUNITS - a scalar string specifying the desired units for VX, VY
;              and VZ.  Allowed values:
;                 'KM/DAY' - kilometers per day  (default)
;                 'KM/S' - kilometers per second
;                 'CM/S' - centimeters per second
;                 'LT-S/S' or 'V/C' - light seconds per second or
;                     unitless ratio with speed of light, V/C
;                 'AU/DAY' - astronomical units per day
;
;   TBASE - a scalar or vector, specifies a fixed epoch against wich T
;           is measured.  The ephemeris time will be (T+TBASE).  Use
;           this keyword for maximum precision.
;
;
; EXAMPLE:
;
;   Find position of earth at ephemeris time 2451544.5 JD.  Units are
;   in Astronomical Units.
;
;   JPLEPHREAD, 'JPLEPH.200', pinfo, pdata, [2451544D, 2451545D]
;
;   JPLEPHINTERP, pinfo, pdata, 2451544.5D, xearth, yearth, zearth, $
;                 /EARTH, posunits='AU'
;     
;
; REFERENCES:
;
;   AXBARY, Arnold Rots.
;      ftp://heasarc.gsfc.nasa.gov/xte/calib_data/clock/bary/
;
;   HORIZONS, JPL Web-based ephermis calculator (Ephemeris DE406)
;      http://ssd.jpl.nasa.gov/horizons.html
;   
;   Fairhead, L. & Bretagnon, P. 1990, A&A, 229, 240
;
;   Fukushima, T. 1995, A&A, 294, 895
;
;   Standish, E.M. 1982, "Orientation of the JPL Ephemerides,
;      DE200/LE200, to the Dynamical Equinox of J2000", Astronomy &
;      Astrophysics, vol. 114, pp. 297-302.
;
;   Standish, E.M.: 1990, "The Observational Basis for JPL's DE200,
;      the planetary ephemeris of the Astronomical Almanac", Astronomy
;      & Astrophysics, vol. 233, pp. 252-271.    
;
; SEE ALSO
;   JPLEPHREAD, JPLEPHINTERP, JPLEPHTEST, TDB2TDT, JPLEPHMAKE
;   
; MODIFICATION HISTORY:
;   Written and Documented, CM, Jun 2001
;   Corrected bug in name conversion of NUTATIONS and LIBRATIONS, 18
;     Oct 2001, CM
;   Added code to handle custom-built ephemerides, 04 Mar 2002, CM
;   Fix bug in evaluation of velocity (only appears in highest order
;     polynomial term); JPLEPHTEST verification tests still pass;
;     change is of order < 0.5 cm in position, 22 Nov 2004, CM
;   Perform more validity checking on inputs; and more informative
;     outputs, 09 Oct 2008, CM
;   Allow SSB and EMB as shortcuts for solar system and earth-moon
;     bary center, 15 Oct 2008, CM
;   TBASE now allowed to be a vector or scalar, 01 Jan 2009, CM
;   VELFAC keyword gives scale factor between POSUNITS and VELUNITS, 
;     12 Jan 2009, CM
;   Add option VELUNITS='V/C' for unitless ratio with speed of light,
;     2012-10-02, CM
;
;  $Id: jplephinterp.pro,v 1.19 2012/10/02 11:32:59 cmarkwar Exp $
;
;-
; Copyright (C) 2001, 2002, 2004, 2008, 2009, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-
;+
; NAME:
;   JPLEPHMAKE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Make a new ephemeris suitable for interpolation by JPLEPHINTERP
;
; MAJOR TOPICS:
;   Planetary Orbits, Interpolation
;
; CALLING SEQUENCE:
;   JPLEPHREAD, INFO, RAW, OBJ, T, CX, CY, CZ, $
;               [ POSUNITS=, AUTHOR=, DATE=, OBJECTNAME=, ]
;               [ KEYWORDS=, KEYVALUES=, /RESET ]
;
; DESCRIPTION:
;
;   JPLEPHMAKE is a utility routine which forms an ephemeris table
;   suitable for interpolation with JPLEPHINTERP.  This is a way for
;   users to make or augment an ephemeris of solar system bodies not
;   already present in the JPL planetary ephemeris.  This routine only
;   creates new ephemerides in memory.  No facility is provided to
;   write to disk.
;
;   The user must have already estimated the Chebyshev polynomial
;   coefficients for the body of interest.  One way to do this is with
;   CHEBGRID from the Markwardt library.  
;
;   The two options are either to create a new ephemeris or to augment
;   an existing one.  Augmentation merely means that new columns are
;   added to an existing ephemeris table.  The JPL ephemeris itself
;   can be augmented.
;
;   Even when creating a new ephemeris from scratch, passing an
;   existing INFO structure based on another epehemeris is strongly
;   recommended, because the structure usually contains planetary
;   masses, physical constants, etc. which are relevant.
;
;
;
; PARAMETERS: 
;
;
;   INFO - upon input, an existing INFO structure based on a known
;          ephemeris.  Upon output, a modified INFO structure.
;
;          If INFO is undefined upon input, or the RESET keyword is
;          set, then the returned INFO is set to a generic header.
;
;   RAW - upon input, an existing set of Chebyshev coefficients.  Upon
;         output, the new or augmented set of coefficients.
;
;         If RAW is undefined upon input, or if the RESET keyword is
;         set, then the returned RAW variable is initialized to a new
;         set of keywords.
;
;   OBJ - scalar string, name of the object.
;
;   T - array of times, in Julian Days (TDB), which refer to the
;       *start* epoch of each granule.  [ In the terminology of the
;       JPL ephemeris and CHEBGRID, a "granule" is a single
;       subinterval over which a Chebyshev polynomial is fitted. ] If
;       an existing ephemeris is to be augmented, then T must overlap
;       exactly.
;
;   CX, CY, CZ - arrays of Chebyshev polynomial coefficients.
;
;
;
; KEYWORD PARAMETERS:
;
;   POSUNITS - a scalar string, the units of position as fitted by CX,
;              CY, and CZ.  Allowed values:
;                 'KM' - kilometers  (default)
;                 'CM' - centimeters
;                 'AU' - astronomical units
;                 'LT-S' - light seconds
;
;   NSUBINTERVALS - Number of granules per time sample.
;                   Default: 1
;
;   RESET - if set, then a new ephemeris table is created.  Any
;           Chebyshev coefficients in RAW are overwritten.
;
;   AUTHOR - a scalar string, an identifier giving the author of the
;            new ephemeris.
;            Default: ''
;
;   DATE - a scalar string, the creation date of the ephemeris.
;          Default: SYSTIME(0)
;
;   KEYWORDS - an optional string array, giving any header keywords to
;              be added to the ephemeris (in conjunction with
;              KEYVALUES).
;              Default: (none)
;
;   KEYVALUES - an optional double array, giving any header values for
;               the keywords specified by KEYWORDS.
;
;               Default: (none)
;
;
; EXAMPLE:
;
;
; REFERENCES:
;
;   JPL Export Ephmeris FTP Site
;      ftp://navigator.jpl.nasa.gov/pub/ephem/export/
;      (ephemeris files are available here, however, they must be
;      converted to FITS format using the "bin2eph" utility found in
;      AXBARY)
;
;
; SEE ALSO
;   JPLEPHREAD, JPLEPHINTERP, JPLEPHTEST
;   
; MODIFICATION HISTORY:
;   Written and Documented, CM, Mar 2002
;   Corrected way that ephemerides are merged, also
;     way that AUTHOR field is filled, 29 May 2002, CM
;
;  $Id: jplephmake.pro,v 1.4 2002/05/29 20:07:41 craigm Exp $
;
;-
; Copyright (C) 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-
;+
; NAME:
;   JPLEPHREAD
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Open and read JPL DE200 or DE405 Ephemeride FITS File
;
; MAJOR TOPICS:
;   Planetary Orbits, Interpolation
;
; CALLING SEQUENCE:
;   JPLEPHREAD, FILENAME, INFO, RAWDATA, JDLIMITS, STATUS=, ERRMSG=
;
; DESCRIPTION:
;
;   JPLEPHREAD opens and reads the JPL DE200 or DE405 planetary
;   ephemerides, as available in FITS format.  The user must have the
;   IDL Astronomy Library installed to use this routine.
;
;   This routine is the initialization stage of a two-stage process to
;   interpolate the JPL ephemeris.  In this first stage, the file is
;   opened, and the relevant portions of the table are read and stored
;   into the two variables INFO and RAWDATA.  In the second stage, the
;   user actually interpolates the ephemeris for the desired bodies
;   and to the desired ephemeris time using JPLEPHINTERP.
;
;   Users must decide ahead of time the approximate dates of interest,
;   and pass this range in the JDLIMITS parameter.  Any date covered
;   by the ephemeris is valid.
;
;   JPLEPHREAD is able to read files of the following format:
;     DE200 - Chebyshev - FITS format - Note 1
;     DE405 - Chebyshev - FITS format - Note 1
;     DE200 - Taylor    - FITS format - Note 2
;
;   Note 1 - Chebyshev formatted FITS files are available in the
;            AXBARY package by Arnold Rots, found here:
;              ftp://heasarc.gsfc.nasa.gov/xte/calib_data/clock/bary/
;            or at the Markwardt FTP site:
;              ftp://cow.physics.wisc.edu/pub/craigm/bary/
;
;   Note 2 - Taylor-series based ephemerides have been available for
;            years in the FTOOLS / LHEASOFT package produced by NASA's
;            Goddard Space Flight Center.  The original file is
;            de200_new.fits, which covers the years 1959-2000,
;            inclusive.  A newer file is named
;            de200_1950-2050_v2.fits, and covers the years 1959-2050.
;            See Markwardt FTP site for these files.
;
; PARAMETERS: 
;
;   FILENAME - name of ephemeris file (scalar string).
;
;   INFO - upon completion, information about the ephemeris data is
;          returned in this parameter in the form of a structure.
;          Users must not modify INFO, although several fields are
;          useful and may be accessed read-only:
;              TSTART/TSTOP (start and stop time of data in Julian
;                            days);
;              C (speed of light in m/s);
;              DENUM (development ephemeris number [200 or 405])
;              AU (1 astronomical unit, in units of light-seconds)
;
;   RAWDATA - upon completion, raw ephemeris data is returned in this
;             parameter.  Users are not meant to access this data
;             directly, but rather to pass it to JPLEPHINTERP.
;
;   JDLIMITS - a two-element vector (optional), describing the desired
;              time range of interest.  The vector should have the
;              form [TSTART, TSTOP], where TSTART and TSTOP are the
;              beginning and ending times of the range, expressed in
;              Julian days.
;              Default: entire table is read (note, this can be
;              several megabytes)
;
;
; KEYWORD PARAMETERS:
;
;   STATUS - upon completion, a value of 1 indicates success, and 0
;            indicates failure.
;
;   ERRMSG - upon completion, an error message is returned in this
;            keyword.  If there were no errors, then the returned
;            value is the empty string, ''.
;
;
; EXAMPLE:
;
;   Find position of earth at ephemeris time 2451544.5 JD.  Units are
;   in Astronomical Units.
;
;   JPLEPHREAD, 'JPLEPH.200', pinfo, pdata, [2451544D, 2451545D]
;
;   JPLEPHINTERP, pinfo, pdata, 2451544.5D, xearth, yearth, zearth, $
;                 /EARTH, posunits='AU'
;     
;
; REFERENCES:
;
;   AXBARY, Arnold Rots.
;      ftp://heasarc.gsfc.nasa.gov/xte/calib_data/clock/bary/
;
;   HORIZONS, JPL Web-based ephermis calculator (Ephemeris DE406)
;      http://ssd.jpl.nasa.gov/horizons.html
;   
;   JPL Export Ephmeris FTP Site
;      ftp://navigator.jpl.nasa.gov/pub/ephem/export/
;      (ephemeris files are available here, however, they must be
;      converted to FITS format using the "bin2eph" utility found in
;      AXBARY)
;
;   JPL Export Ephemeris CD-ROM - Ordering Information
;      http://www.willbell.com/software/jpl.htm
;
;   Standish, E.M. 1982, "Orientation of the JPL Ephemerides,
;      DE200/LE200, to the Dynamical Equinox of J2000", Astronomy &
;      Astrophysics, vol. 114, pp. 297-302.
;
;   Standish, E.M.: 1990, "The Observational Basis for JPL's DE200,
;      the planetary ephemeris of the Astronomical Almanac", Astronomy
;      & Astrophysics, vol. 233, pp. 252-271.    
;
; SEE ALSO
;   JPLEPHREAD, JPLEPHINTERP, JPLEPHTEST
;   
; MODIFICATION HISTORY:
;   Written and Documented, CM, Jun 2001
;   Incorporated changes by W. Landsman, for error handling more
;     consistent with IDL Astronomy Library, Oct 2001, WL
;   Add ephemeris file keywords to INFO, Jan 2002, CM
;   Add fields to INFO to be consistent with JPLEPHMAKE, 04 Mar 2002, CM
;   Correction of units for INFO.C (Thanks Mike Bernhardt), 2011-04-11, CM
;
;  $Id: jplephread.pro,v 1.10 2011/06/27 18:44:44 cmarkwar Exp $
;
;-
; Copyright (C) 2001, 2002, 2011, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-
;  if n_elements(jdlimits) LT 2 then begin
;      errmsg = 'ERROR: You must specify JDLIMITS'
;      return
;  endif

  fxbopen, unit, filename, 1, ephhead, errmsg=errmsg
  if errmsg NE '' then $
            if printerror then message,errmsg else return

  extname = strtrim(fxpar(ephhead, 'EXTNAME'),2)
  ttype1  = strtrim(fxpar(ephhead, 'TTYPE1'),2)

  if (extname EQ 'EPHEM' AND ttype1 EQ 'EARTH') then begin
      ;; This is the DE200_NEW format (standard FTOOLS)

      nrows  = fxpar(ephhead, 'NAXIS2')
      tstart = fxpar(ephhead, 'TSTART')
      tstop  = fxpar(ephhead, 'TSTOP')
      timedel = jplephpar(ephhead, 'TIMEDEL', default=1D) ;; 1-day default

      ;; Constants from XTEBARYCEN.F
      C=2.99792458D+8
      TWOPI=6.28318530717958648D0
      DAYSEC=1.D0/86400.D0
      AULTSC=499.004782D0
      GAUSS=0.01720209895D0
      RSCHW=(GAUSS^2)*(AULTSC^3)*(DAYSEC^2)
      SUNRAD=2.315D0

      if n_elements(jdlimits) GE 2 then begin
          if (min(jdlimits) LT tstart OR $
              max(jdlimits) GT tstop) then begin
              errmsg = 'ERROR: '+filename+$
                ' does not cover the time of interest'
              fxbclose, unit
              return
          endif
          ;; Expand by one row either side
          rowlimits = floor((jdlimits-tstart)/timedel) + [-2,2]
          rowlimits = rowlimits > 1 < nrows
      endif else begin
          jdlimits  = [tstart, tstop]
          rowlimits = [1L, nrows]
      endelse

      ;; Read raw data
      fxbread, unit, cearth, 'EARTH', rowlimits, errmsg=errmsg
      if errmsg EQ '' then $
        fxbread, unit, csun, 'SUN', rowlimits, errmsg=errmsg
      if errmsg EQ '' then $
        fxbread, unit, ctdb2tdt, 'TIMEDIFF', rowlimits, errmsg=errmsg
      fxbclose, unit
      if errmsg NE '' then $
         if printerror then message,errmsg else return

      nr = rowlimits(1)-rowlimits(0)+1
      t0 = dindgen(nr)*timedel - (jdlimits(1)-jdlimits(0))/2D
      dtt = spl_init(t0, ctdb2tdt)
      raw = reform(dblarr(18, nr), 18, nr, /overwrite)
      raw(0 :11,*) = cearth * c/1000D  ;; units of lt-s
      raw(12:14,*) = csun * c/1000D    ;; units of lt-s/day
      raw(15,   *) = t0
      raw(16   ,*) = ctdb2tdt
      raw(17   ,*) = dtt

      jdlimits1 = (rowlimits+[-1,0])*timedel + tstart

      info = {filename: filename, edited: 0L, $
              creation_date: '', author: '', $
              nrows: nrows, tstart: tstart, tstop: tstop, $
              timedel: timedel, format: 'DENEW', $
              denum: 200L, c: c, emrat: 0.012150586D, $
              au: aultsc, msol: rschw, sunrad: sunrad, $
              jdlimits: jdlimits1, jdrows: nr }

  endif else if (extname EQ 'DE1' AND ttype1 EQ 'Cname') then begin
      ;; This is the BINEPH2FITS format (either DE200 or DE405)

      ;; ---------------------------------------------
      ;; First extension contains parameter data
      fxbread, unit, cname, 'Cname'
      fxbread, unit, cvalue, 'Cvalue'
      cname = strtrim(cname,2)

      denum = 0L & clight = 0D & emrat = 0D & au = 0D
      msol = 0D & radsol = 0D

      denum  = round(jplephval(cname, cvalue, 'DENUM', /fatal))
      clight = jplephval(cname, cvalue, 'CLIGHT', /fatal)    ; km/s
      emrat  = jplephval(cname, cvalue, 'EMRAT',  /fatal)
      au     = jplephval(cname, cvalue, 'AU',     /fatal)    ; km
      msol   = jplephval(cname, cvalue, 'GMS',    /fatal)    ; AU^3/day^2
      radsol = jplephval(cname, cvalue, 'RADS', default=-1D) ; km
      if radsol EQ -1D then $
        radsol = jplephval(cname, cvalue, 'ASUN', default=-1D)

      emrat = 1D / (1D + emrat)
        
      if clight EQ 0 then begin
          errmsg = 'ERROR: Could not load physical constants from '+filename
          fxbclose, unit
          return
      endif

      x = au / clight                     ;; AU (lt sec)
      msol = msol * x * x * x / 86400D^2  ;; GM_sun (in lt sec)
      radsol = radsol / clight            ;; Solar radius (lt sec)
      clight = clight * 1000              ;; Speed of light (m/s)
      
      fxbclose, unit

      ;; ---------------------------------------------
      ;; Second extension contains accounting data
      fxbopen, unit, filename, 2, ephhead, errmsg=errmsg
      if errmsg NE '' then $
            if printerror then message,errmsg else return

      extname = strtrim(fxpar(ephhead, 'EXTNAME'),2)
      if extname NE 'DE2' then begin
          errmsg = 'ERROR: '+filename+' is not a JPL ephemeris file'
          fxbclose, unit
          return
      endif

      fxbread, unit, ephobj, 'Object', errmsg=errmsg
      if errmsg EQ '' then $
        fxbread, unit, ephptr, 'Pointer', errmsg=errmsg
      if errmsg EQ '' then $
        fxbread, unit, ephncoeff, 'NumCoeff', errmsg=errmsg
      if errmsg EQ '' then $
        fxbread, unit, ephnsub, 'NumSubIntv', errmsg=errmsg
      fxbclose, unit
      if errmsg NE '' then begin
          errmsg = 'ERROR: could not read '+filename+' extension 2'
          if printerror then message,errmsg else return
      endif

      ;; Trim each object name to first word only
      for i = 0, n_elements(ephobj)-1 do begin
          ephobj(i) = strupcase((str_sep(ephobj(i), ' '))(0))
      endfor
      
      ;; ---------------------------------------------
      ;; Third extension contains Chebyshev coefficients
      fxbopen, unit, filename, 3, ephhead, errmsg=errmsg
      if errmsg NE '' then return
      extname = strtrim(fxpar(ephhead, 'EXTNAME'),2)
      if extname NE 'DE3' then begin
          errmsg = 'ERROR: '+filename+' is not a JPL ephemeris file'
          fxbclose, unit
          if printerror then message,errmsg else return
      endif
      
      nrows  = fxpar(ephhead, 'NAXIS2')
      tstart = fxpar(ephhead, 'TSTART')
      tstop  = fxpar(ephhead, 'TSTOP')
      timedel = jplephpar(ephhead, 'TIMEDEL', default=32D) ;; 32-day default

      if floor((tstop-tstart + 0.5)/timedel) NE nrows then begin
          errmsg = 'ERROR: Incorrect number of rows in '+filename
          fxbclose, unit
          if printerror then message,errmsg else return
      endif

      if n_elements(jdlimits) GE 2 then begin
          if (min(jdlimits) LT tstart OR $
              max(jdlimits) GT tstop) then begin
              errmsg = 'ERROR: '+filename+$
                ' does not cover the time of interest'
              fxbclose, unit
              if printerror then message,errmsg else return
          endif
          ;; Expand by two rows either side
          rowlimits = floor((jdlimits-tstart)/timedel) + [-2,2]
          rowlimits = rowlimits > 1 < nrows
      endif else begin
          jdlimits  = [tstart, tstop]
          rowlimits = [1L, nrows]
      endelse

      ;; Read raw data
      dims = fxbdimen(unit, 'ChebCoeffs')
      fxbread, unit, coeffs, 'ChebCoeffs', rowlimits, errmsg=errmsg
      fxbclose, unit
      if errmsg NE '' then $
         if printerror then message,errmsg else return

      raw = reform(coeffs, [dims, rowlimits(1)-rowlimits(0)+1], /overwrite)

      jdlimits1 = (rowlimits+[-1,0])*timedel + tstart
      if (abs(min(raw(0,*)) - jdlimits1(0)) GT 1d-6 OR $
          abs(max(raw(1,*)) - jdlimits1(1)) GT 1d-6) then begin
          errmsg = 'ERROR: JDLIMITS and time column do not match'
          if printerror then message,errmsg else return
      endif

      nr = rowlimits(1)-rowlimits(0)+1
      info = {filename: filename, edited: 0L, $
              creation_date: '', author: '', $
              nrows: nrows, tstart: tstart, tstop: tstop, $
              timedel: timedel, format: 'BINEPH2FITS', $
              denum: denum, c: clight, emrat: emrat, $
              au: au*1000/clight, msol: msol, sunrad: radsol, $
              jdlimits: jdlimits1, jdrows: nr, $
              objname: ephobj, ptr: ephptr, ncoeff: ephncoeff, $
              nsub: ephnsub, keywords: cname, keyvalues: cvalue}
;                 aufac: 1D/clight, velfac: 2D/(timedel*86400D), $

  endif else begin
      errmsg = 'ERROR: '+filename+' was not in a recognized format'
      fxbclose, unit
      if printerror then message,errmsg else return
  endelse

  errmsg = ''
  status = 1
  return
end
;+
; NAME:
;   JPLEPHTEST
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Test JPLEPHTEST with JPL test data set
;
; MAJOR TOPICS:
;   Planetary Orbits, Interpolation
;
; CALLING SEQUENCE:
;   JPLEPHTEST, EPHFILE, TESTFILE
;
; DESCRIPTION:
;
;   JPLEPHTEST tests the JPLEPHINTERP procedure for precision.  In
;   order to function, you must have the JPLEPHREAD and JPLEPHINTERP
;   procedures, as well as the IDL Astronomy Libary for reading FITS
;   files.  In addition, you must have a JPL ephemeris test data set,
;   which is available by FTP.
;
;   The procedure opens and reads the test set, which contains
;   precomputed data.  Every tenth value is printed on the screen.
;   Any deviations that exceed 1.5d-13 AU = 1.5 cm are reported.
;
;   The columns are labelled according to the input file, except for
;   the final column, which is the deviation between the input file
;   and the computed value.
;
;
; PARAMETERS: 
;
;   EPHFILE - a scalar string, specifies the name of the ephemeris
;             file, in FITS format.
;
;   TESTFILE - a scalar string, specifies JPL test data set to compare
;              against.
;
;   THRESHOLD - threshold (cm) above which deviations are reported as
;               too large.
;
;
; EXAMPLE:
;
;   Test JPL DE200 and DE405 ephemerides.  Assumes files are in the
;   current directory.
;
;   JPLEPHTEST, 'JPLEPH.200', 'testpo.200'
;   JPLEPHTEST, 'JPLEPH.405', 'testpo.405'
;     
;
; REFERENCES:
;
;   JPL Export Ephmeris FTP Site
;      ftp://navigator.jpl.nasa.gov/pub/ephem/export/
;      (see test-data/ for test data sets)
;   
;   HORIZONS, JPL Web-based ephermis calculator (Ephemeris DE406)
;      http://ssd.jpl.nasa.gov/horizons.html
;
;
; SEE ALSO
;   JPLEPHREAD, JPLEPHINTERP, JPLEPHTEST
;   
; MODIFICATION HISTORY:
;   Written and Documented, CM, Jun 2001
;   Removed TRANSREAD, improved output, improved docs, CM, 9 Jul 2001
;   Add THRESHOLD keyword, CM, 30 Jan 2005
;
;  $Id: jplephtest.pro,v 1.5 2005/01/31 04:20:50 craigm Exp $
;
;-
; Copyright (C) 2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-
;+
; NAME:
;   LEGCHEB
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute Legendre polynomial coefficents from Chebyshev coefficients
;
; MAJOR TOPICS:
;   Curve and Surface Fitting, Special Functions
;
; CALLING SEQUENCE:
;   b = LEGCHEB(a)
;
; DESCRIPTION:
;
;   This routine computes the coefficients of a Legendre polynomial
;   expansion when the Chebyshev expansion is known.
;
;   Users can determine the Chebyshev expansion coefficients using a
;   routine like CHEBFIT, CHEBCOEF or CHEBGRID.  Then, if the Legendre
;   expansion is needed instead, this conversion routine should be
;   used.  Evaluation of the Legendre series can be performed using
;   the POLYLEG function in the IDL Astronomy Library.
;
;   Internally, the computational precision is double precision.
;   This routine relies upon the algorithm of Piessens (1974).
;
; INPUTS:
;
;   A - a vector, the coefficients of the Chebyshev series of the
;       desired function.
;
; RETURNS:
;
;   The vector B, which contains the coefficients of the Legendre
;   polynomial expansion.  Both A and B will have the same number of
;   elements and data type.
;
; KEYWORD PARAMETERS:
;
;   NONE
;
; EXAMPLE:
;
;   ;; Compute the Chebyshev series coefficients of 1/(2-X) on [-1,1]
;   A = CHEBCOEF('1d/(2d - X)', /expr)
;
;   ;; Convert to Legendre series coefficients
;   B = LEGCHEB(A)
;
; REFERENCES:
;
;   Abramowitz, M. & Stegun, I., 1965, *Handbook of Mathematical
;     Functions*, 1965, U.S. Government Printing Office, Washington,
;     D.C. (Applied Mathematical Series 55)
;   Piessens, R. 1974, Comm. ACM, v. 17, p. 25 (TOMS 473)
;
; MODIFICATION HISTORY:
;   Written and documented, CM, 25 Sep 2002
;
;  $Id: legcheb.pro,v 1.1 2002/09/25 21:12:35 craigm Exp $
;
;-
; Copyright (C) 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   LINFITEX
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Model function for fitting line with errors in X and Y
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   parms = MPFIT('LINFITEX', start_parms, $
;             FUNCTARGS={X: X, Y: Y, SIGMA_X: SIGMA_X, SIGMA_Y: SIGMA_Y}, $
;             ...)
;
; DESCRIPTION:
;
;  LINFITEX is a model function to be used with MPFIT in order to 
;  fit a line to data with errors in both "X" and "Y" directions.  
;  LINFITEX follows the methodology of Numerical Recipes, in the
;  section entitled, "Straight-Line Data with Errors in Both
;  Coordinates."
;
;  The user is not meant to call LINFITEX directly.  Rather, the
;  should pass LINFITEX as a user function to MPFIT, and MPFIT will in
;  turn call LINFITEX.
;
;  Each data point will have an X and Y position, as well as an error
;  in X and Y, denoted SIGMA_X and SIGMA_Y.  The user should pass
;  these values using the FUNCTARGS convention, as shown above.  I.e.
;  the FUNCTARGS keyword should be set to a single structure
;  containing the fields "X", "Y", "SIGMA_X" and "SIGMA_Y".  Each
;  field should have a vector of the same length.
;
;  Upon return from MPFIT, the best fit parameters will be,
;      P[0] - Y-intercept of line on the X=0 axis.
;      P[1] - slope of the line
;
;  NOTE that LINFITEX requires that AUTODERIVATIVE=1, i.e. MPFIT
;  should compute the derivatives associated with each parameter
;  numerically.
;
; INPUTS:
;   P - parameters of the linear model, as described above.
;
; KEYWORD INPUTS:
;   (as described above, these quantities should be placed in
;    a FUNCTARGS structure)
;   X - vector, X position of each data point
;   Y - vector, Y position of each data point
;   SIGMA_X - vector, X uncertainty of each data point
;   SIGMA_Y - vector, Y uncertainty of each data point
;
; RETURNS:
;   Returns a vector of residuals, of the same size as X.
;
; EXAMPLE:
;   
;   ; X and Y values
;   XS = [2.9359964E-01,1.0125043E+00,2.5900450E+00,2.6647639E+00,3.7756164E+00,4.0297413E+00,4.9227958E+00,6.4959011E+00]
;   YS = [6.0932738E-01,1.3339731E+00,1.3525699E+00,1.4060204E+00,2.8321848E+00,2.7798350E+00,2.0494456E+00,3.3113062E+00]
;   
;   ; X and Y errors
;   XE = [1.8218818E-01,3.3440986E-01,3.7536234E-01,4.5585755E-01,7.3387712E-01,8.0054945E-01,6.2370265E-01,6.7048335E-01]
;   YE = [8.9751285E-01,6.4095122E-01,1.1858428E+00,1.4673588E+00,1.0045623E+00,7.8527629E-01,1.2574003E+00,1.0080348E+00]
;
;   ; Best fit line
;   p = mpfit('LINFITEX', [1d, 1d], $
;                FUNCTARGS={X: XS, Y: YS, SIGMA_X: XE, SIGMA_Y: YE}, $
;                perror=dp, bestnorm=chi2)
;   yfit = p[0] + p[1]*XS
;
;
; REFERENCES:
;
;   Press, W. H. 1992, *Numerical Recipes in C*, 2nd Ed., Cambridge
;      University Press
;
; MODIFICATION HISTORY:
;   Written, Feb 2009
;   Documented, 14 Apr 2009, CM
;  $Id: linfitex.pro,v 1.3 2009/04/15 04:17:52 craigm Exp $
;
;-
; Copyright (C) 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;

function linfitex, p, $
                   x=x, y=y, sigma_x=sigma_x, sigma_y=sigma_y, $
                   _EXTRA=extra

  a = p[0]   ;; Intercept
  b = p[1]   ;; Slope

  f = a + b*x

  resid = (y - f)/sqrt(sigma_y^2 + (b*sigma_x)^2)

  return, resid
end
;+
; NAME:
;   LITMSOL
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Solve the light-time equation between two moving bodies
;
; MAJOR TOPICS:
;   Geometry, Physics
;
; CALLING SEQUENCE:
;   LITMSOL, T1, X1, Y1, Z1, T2, INFO2, RAW2, OBJ2, INFOSUN, RAWSUN, $
;            /RECEIVER, TBASE=, TOLERANCE=, POSUNITS=, MAXITER=, $
;            /NO_SHAPIRO
;
; DESCRIPTION:
;
;  The procedure LITMSOL solves the light time equation between two
;  moving bodies in the solar system.  Given the time and position of
;  reception or transmission of a photon, this equation determines the
;  time of transmission or reception at the other solar system body.
;  Since both bodies may be moving, the equation must be solved
;  iteratively.
;
;  The trajectories of solar system bodies must be described by either
;  a JPL ephemeris, or by a JPL-like ephemeris generated by
;  JPLEPHMAKE.  This routine calls JPLEPHINTERP.
;
;  The user specifies the known time and position of interaction as
;  T1, X1, Y1 and Z1, in units of POSUNITS.  The time of interaction
;  at the other body -- the solution to the light time equation -- is
;  returned as T2.  If the photon was *received* at time T1, then the
;  RECEIVER keyword should be set (in which case the transmission must
;  have occurred in the past).
;
;  Since the solution is iterative, the user may specify a solution
;  tolerance, and a maximum number of iterations.
;
;  If users wish to include the Shapiro time delay, which has a
;  maximum amplitude of approximately 250 usec, they must specify the
;  ephemeris of the Sun (INFOSUN, RAWSUN).  The Shapiro delay is the
;  extra general relativistic delay caused by the Sun's potential.
;
;
; INPUTS:
;
;   T1 - epoch of interaction, in Julian days, in the TDB timescale.
;        (scalar or vector)
;
;   X1, Y1, Z1 - coordinates of interaction, referred to the solar
;                system barycenter, in J2000 coordinates.  Units are
;                described by POSUNITS. (scalar or vector)
;
;   INFO2, RAW2 - ephemeris of other solar system body, returned by
;                 JPLEPHREAD or JPLEPHMAKE.
;
;   INFOSUN, RAWSUN - ephemeris of at least the Sun, as returned by
;                     JPLEPHREAD.  Only used of NO_SHAPIRO is not set.
;
;
; OUTPUTS:
;
;   T2 - upon output, epoch of interaction at the second solar system
;        body, in Julian days, in the TDB timescale.
;
;
; KEYWORD PARAMETERS:
;
;   RECEIVER - if set, then the epoch T1 is a reception of a photon.
;              Otherwise T1 is the epoch of transmission of a photon.
;
;   VX1, VY1, VZ1 - upon input, the body velocity at time T1, in
;                   VELUNITS units.  This information is required only
;                   if the SHAPIRO_DERIV is required.
;
;   X2, Y2, Z2 - upon return, the body position at time T2, in
;                POSUNITS units.
;   VX2, VY2, VZ2 - upon return, the body velocity at time T2, in
;                VELUNITS units.
;
;   TBASE - a fixed epoch time (Julian days) to be added to each value
;           of T1.  Since subtraction of large numbers occurs with
;           TBASE first, the greatest precision is achieved when TBASE
;           is expressed as a nearby julian epoch, T1 is expressed
;           as a small offset from the fixed epoch.  
;           Default: 0
;
;   POSUNITS - the units for positions, one of 'CM', 'KM', 'LT-S' or
;              'AU'.
;              Default: 'CM'
;   VELUNITS - the units for velocities (and Shapiro derivative).
;              Default: POSUNITS+'/S'
;
;   TOLERANCE - the solution tolerance, expressed in POSUNITS.
;               Default: 1000 CM
;
;   ERROR - upon return, a vector giving the estimated error in the
;           solution for each point, expressed in POSUNITS.  This
;           quantity should be less than TOLERANCE unless the number
;           of iterations exceeded MAXITER.
;
;   MAXITER - maximum number of solution iterations to be taken.
;             Default: 5
;   NITER - upon return, contains the actual number of iterations used.
;
;   SHAPIRO_CALC - method of calculating Shapiro delay, a string with
;                  one value of 'NONE', 'DELAY' or 'BOTH'.  NONE means
;                  do not calculate any Shapiro delay values.  DELAY
;                  means calculate Shapiro delay only.  BOTH means
;                  calculate the delay *and* its derivative with
;                  respect to time.  If SHAPIRO_CALC is set to
;                  DELAY or BOTH, then INFOSUN and RAWSUN must be
;                  specified.  If BOTH, then VX1, VY1 and VZ1 must
;                  also be specified. This keyword overrides
;                  NO_SHAPIRO.
;   NO_SHAPIRO - if set, then the Shapiro delay will not be accounted
;                for.  Use SHAPIRO_CALC instead.
;   SHAPIRO_DELAY - upon return, contains the Shapiro delay in
;                   seconds, if SHAPIRO_CALC is set to 'DELAY' or
;                   'BOTH'.
;   SHAPIRO_DERIV - upon return, contains the derivative of the
;                   Shapiro delay, in light seconds per time unit of
;                   velocity (SHAPIRO_CALC must be set to 'BOTH' to
;                   enable this calculation).  Note that you must
;                   supply VX1, VY1 and VZ1 to get the derivative
;                   value.
;
;
; EXAMPLE:
;
;
;
; SEE ALSO:
;
;   JPLEPHREAD, JPLEPHINTERP
;
;
; MODIFICATION HISTORY:
;   Written, 6 May 2002, CM
;   Documented, 12 May 2002, CM
;   Added TGUESS keyword, 29 May 2002, CM
;   Added ERROR and X/Y/ZOFF keywords, 25 Sep 2002, CM
;   Extensive revisions: addition of SHAPIRO_{CALC,DELAY,DERIV}
;     values; input VX1, VY1 and VZ1; output X2, Y2, Z2 and VX2 VY2
;     and VZ2; and VELUNITS keyword, 07 Mar 2007, CM
;   Allow user specified function to interpolate INFO2/RAW2 via
;     INTERP_FUNC keyword, 09 Oct 2008, CM
;
;  $Id: litmsol.pro,v 1.7 2008/10/10 00:50:19 craigm Exp $
;
;-
; Copyright (C) 2002, 2007, 2008, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   LITMSOL2
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Solve the light-time equation between two moving bodies
;
; MAJOR TOPICS:
;   Geometry, Physics, Dynamics
;
; CALLING SEQUENCE:
;   LITMSOL2, T1, X1, Y1, Z1, T2, $
;            FUNC2, INFO2, RAW2, FUNCTARGS=, FUNCTSAVE=, $
;            /RECEIVER, TBASE=, TOLERANCE=, POSUNITS=, MAXITER=, $
;            LIGHT_TIME=, TGUESS=, ERROR=, NITER=, $
;            VX1=, VY1=, VZ1=, $
;            X2=, Y2=, Z2=, VX2=, VY2=, VZ2=, $
;            METHOD=, $
;            DELAY_FUNCTION=, DELAY_ARG1=, DELAY_ARG2=, $
;            DELAY_FUNCTARGS=
;
; DESCRIPTION:
;
;  The procedure LITMSOL2 solves the light time equation between two
;  moving bodies, A and B, in the solar system.  Given the time and
;  position of reception or transmission of a photon at A, this
;  equation determines the time of transmission or reception at the
;  other solar system body B.  Since both bodies may be moving, the
;  equation must be solved iteratively.
;
;  The user must know the "A" endpoint of the ray, with time T1 and
;  position X1,Y1,Z1.  LITMSOL2 solves for the "B" endpoint time and
;  position T2 and X2,Y2,Z2 by propagating a light ray from one to the
;  other.
;
;  The position of the "B" body must be described as an interpolatable
;  function.  The user function FUNC2 must calculate the position (and
;  velocity) of the body at any applicable time T2, in the requested
;  units.
;
;  By default the body "A" is considered the transmitter and LITMSOL2
;  calculates the time at which body "B" receives the ray.   However,
;  if /RECEIVER is set, then body "A" is considered the receiver, and
;  LITMSOL2 calculates the time T2 in the past at which the ray must
;  have been transmitted by body "B" in order to be received by "A" at
;  time T1.
;
;  LITMSOL2 is able to estimate the T2 knowing only the time and
;  position at body "A".  However, convergence may be faster if the
;  TGUESS, METHOD and/or VX1,VY1,VZ1 keywords are used.  By default,
;  the initial guess for T2 is simply the same as T1.  A better
;  estimate can be passed in the TGUESS keyword.
;
;  If velocity information is available, then LITMSOL2 can use a
;  simple linear corrector method in order to speed convergence
;  (i.e. Newton's method).  The user should pass the velocity
;  at time T1 in the VX1,VY1,VZ1 keywords, and METHOD='CORRECTOR'.
; 
;  The user may also specify a "delay" function which estimates any
;  additional light propagation delays along the path based on the
;  current estimates of the two ray endpoints.  One such delay might
;  be the "Shapiro" delay due to general relativity.
;
;  Since the solution is iterative, the user may specify a solution
;  tolerance, and a maximum number of iterations.  An estimate of the
;  solution error is returned in the ERROR keyword.
;
; USER FUNCTIONS
;
;  The user must supply a function to interpolate the position of the
;  body at time T, which is passed in parameter FUNC2.  FUNC2, a
;  scalar string, is the name of subroutine to call which must compute
;  position of body at time T2.  The calling convention is the same as
;  JPLEPHINTERP, namely,
;
;     PRO FUNC2, INFO2, RAW2, T2, X2, Y2, Z2, VX2, VY2, VZ2, $
;       VELOCITY=, POSUNITS=, VELUNITS=, SAVE=, ...
;
;  The variables INFO2 and RAW2 are described below.  The variable T2
;  is the requested time (TDB), and the position and velocity must be
;  returned in X2,Y2,Z2, VX2,VY2,VZ2, with the requested units.  The
;  SAVE keyword can designate one keyword whose value will be returned
;  to the calling routine.  Any other keywords can be passed using the
;  _EXTRA calling convention using the FUNCTARGS keyword.
;
;  The user may also supply an optional function to compute an
;  additional delay.  The delay may be a function of the time and
;  position of both points "A" and "B".  For example, the "Shapiro
;  delay" of photons in the solar potential is one such kind of delay.
;  The calling convention is, 
;
;    DELAY = DELAY_FUNCTION(DELAY_ARG1, DELAY_ARG2, $
;               T1, X1, Y1, Z1, T2, X2, Y2, Z2, $
;               POSUNITS=, TBASE=, ...)
;
;  The returned delay must be in seconds, with the sense that a
;  positive value of DELAY indicates that the actual light travel time
;  is *longer* than the classical geometric travel time.
;
;     DELAY_ARG1, DELAY_ARG2 - can be any user-desired variables
;     T1 - same as T1 passed to LITMSOL2
;     X1,Y1,Z1 - same as passed to LITMSOL2
;     T2 - trial T2 interaction time in TDB Julian days
;     X2,Y2,Z2 - trial T2 interaction position, in POSUNITS
;     POSUNITS, TBASE - same as passed to LITMSOL2
;        ... additional keywords - passed via DELAY_FUNCTARGS
;            
; INPUTS:
;
;   T1 - epoch of interaction, in Julian days, in the TDB timescale.
;        (scalar or vector)
;
;   X1, Y1, Z1 - coordinates of interaction, referred to the solar
;                system barycenter, in J2000 coordinates.  Units are
;                described by POSUNITS. (scalar or vector)
;
;   FUNC2 - a scalar string, is the name of subroutine to call which
;           must compute position of body at time T2.
;
;   INFO2, RAW2 - arguments to the FUNC2 interpolation function.  At
;                 the very minimum, the INFO2 variable must be a
;                 structure of the form,
;                        INFO2 = {C: (speed of light in m/s), $
;                                 AU: (1 AU in light-seconds), $
;                                 ... other fields ... }
;                 The AU field is only required if POSUNITS EQ 'AU'.
;
; OUTPUTS:
;
;   T2 - upon output, epoch of interaction at the second solar system
;        body, in Julian days, in the TDB timescale.
;
; KEYWORD PARAMETERS:
;
;   DELAY_FUNCTION - user function to compute extra delay factors
;           based on the photon trajectory.  
;            
;   DELAY_ARG1,DELAY_ARG2 - arguments to the DELAY_FUNCTION.  These
;           variables are not touched by LITMSOL2, but merely passed
;           directly to DELAY_FUNCTION.
;
;   DELAY_FUNCTARGS - a single structure containing additional keyword
;           arguments passed to DELAY_FUNCTION using the _EXTRA method.
;
;   ERROR - upon return, a vector giving the estimated error in the
;           solution for each point, expressed in POSUNITS.  This
;           quantity should be less than TOLERANCE unless the number
;           of iterations exceeded MAXITER.
;
;   FUNCTARGS - a single structure containing additional keyword
;               arguments passed to FUNC2 using the _EXTRA method.
;
;   FUNCTSAVE - a named variable which will contain the results of
;               the SAVE keyword when calling FUNC2 upon return.
;
;   LIGHT_TIME - upon return, LIGHT_TIME is an array containing the
;                estimated light time for each requested time.
;
;   MAXITER - maximum number of solution iterations to be taken.
;             Default: 5
;
;   METHOD - solution method used, one of 'CONSTANT' or 'CORRECTOR'
;            The 'CONSTANT' method uses simple iteration.  The
;            'CORRECTOR' method uses a linear corrector to accelerate
;            convergence by accounting for the line of sight velocity,
;            but requires VX1, VY1, VZ1 to be passed.
;            Default: 'CONSTANT'
;
;   NITER - upon return, contains the actual number of iterations used.
;
;   POSUNITS - the units for positions, one of 'CM', 'KM', 'LT-S' or
;              'AU'.
;              Default: 'CM'
;
;   RECEIVER - if set, then the epoch T1 is a reception of a photon.
;              Otherwise T1 is the epoch of transmission of a photon.
;
;   TGUESS - a vector of the same size as T1, containing an initial
;            estimate of T2.
;            Default: LITMSOL2 uses its own estimate based on T1.
;
;   TOLERANCE - the solution tolerance, expressed in POSUNITS.
;               Default: 1000 CM
;
;   VX1, VY1, VZ1 - upon input, the body velocity at time T1, in
;                   VELUNITS units.  This information is required only
;                   if the CORRECTOR method is used.
;
;   VELUNITS - the units for velocities (and Shapiro derivative).
;              Default: POSUNITS+'/S'
;
;   X2, Y2, Z2, VX2, VY2, VZ2 - upon return, the body position and 
;            velocity at time T2, in units of POSUNITS and VELUNITS.
;
; EXAMPLE:
;
; SEE ALSO:
;
;   JPLEPHREAD, JPLEPHINTERP, SHAPDEL
;
;
; MODIFICATION HISTORY:
;   Major modifications, based on LITMSOL, 2009-01-05, CM
;   Documented, 2009-05-12, CM
;
;  $Id: litmsol2.pro,v 1.5 2010/05/04 21:01:52 craigm Exp $
;
;-
; Copyright (C) 2002, 2007, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   MASK2GTI
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Convert a gridded set of times to a set of Good Time Intervals (GTIs)
;
; CALLING SEQUENCE:
;   GTI = MASK2GTI(TIME, MASK, COUNT, INDICES=INDICES, $
;                  TIMEDEL=, GOOD=, BAD=, PRE=, POST=)
;
; DESCRIPTION: 
;
;   The function MASK2GTI accepts an array of times and mask, and
;   converts valid data into corresponding good time intervals (GTIs).
;
;   Elements of the MASK array are clustered together according to
;   whether they are "good" or not.  Contiguous segments of good
;   elements are converted to single good time intervals.  Time
;   elements are considered to be regularly spaced, so any breaks in
;   the MASK values are considered to be discontinuities.
;
;   The time array *must* be evenly spaced and sorted in ascending
;   order.  Each element of MASK must correspond to the same element
;   of TIME.  The primary difference between GTISEG and MASK2GTI is
;   that GTI2SEG allows time values to be irregularly sampled and no
;   mask is passed.  Also, MASK2GTI allows intervals to be enlarged or
;   shrunk.
;
;   It should be noted that this function is not constrained to
;   operation only on time arrays.  It should work on any
;   one-dimensional quantity with intervals.
;
; INPUTS:
;
;   TIME - an array of evenly spaced, ascending order, times.
;
;   MASK - an array of values matched to TIME.
;
;   COUNT - upon return, the number of resulting intervals.  A value
;           of zero indicates no good time intervals.
;
; KEYWORDS:
;
;   INDICES - upon return, a 2xCOUNT array of integers which give the
;             indices of samples which lie within each interval.  The
;             times TIME(INDICES(0,i) : INDICES(1,i)) fall within the
;             ith interval.
;
;   TIMEDEL - a scalar value giving the time spacing of the array.
;             Default: TIME(1)-TIME(0)
;
;   PRE - the amount each interval should be enlarged from its leading
;         edge.  A negative value indicates the interval should
;         shrink.
;         Default: 0
;
;   POST - the amount each interval should be enlarged from its
;          trailing edge.  A negative value indicates the interval
;          should shrink. 
;          Default: 0
;   
;   GOOD - the value of "good" in the input mask array.
;          Default: 1b
;
;   BAD - the value of "bad" in the input mask array.
;         Default: 0b
;
;
; RETURNS:
;
;   A new GTI array containing the enlarged or shrunken intervals.
;   The array is 2xCOUNT where COUNT is the number of resulting
;   intervals.  GTI(*,i) represents the start and stop times of
;   interval number i.  The intervals are non-overlapping and
;   time-ordered. 
;
;   If COUNT is zero then the returned array is a scalar value of
;   zero, indicating no good intervals were found.
;
; SEE ALSO:
;
;   GTI2MASK, GTITRIM, GTIMERGE, GTIWHERE
;
; MODIFICATION HISTORY:
;   Written, CM, 1997-2001
;   Documented, CM, Apr 2001
;
;  $Id: mask2gti.pro,v 1.4 2007/01/15 05:06:01 craigm Exp $
;
;-
; Copyright (C) 1997-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   MCHOLDC
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Modified Cholesky Factorization of a Symmetric Matrix
;
; MAJOR TOPICS:
;   Linear Systems
;
; CALLING SEQUENCE:
;   MCHOLDC, A, D, E [, /OUTFULL, /SPARSE, /PIVOT, TAU=TAU, $
;                      PERMUTE=PERMUTE, INVPERMUTE=INVPERMUTE ]
;
; DESCRIPTION:
;
;  Given a symmetric matrix A, the MCHOLDC procedure computes the
;  factorization:
;
;     A + E   =   TRANSPOSE(U) ## D ## U
;
;  where A is the original matrix (optionally permuted if the PIVOT
;  keyword is set), U is an upper triangular matrix, D is a diagonal
;  matrix, and E is a diagonal error matrix.
;
;  The standard Cholesky factorization is only defined for a positive
;  definite symmetric matrix.  If the input matrix is positive
;  definite then the error term E will be zero upon output.  The user
;  may in fact test the positive-definiteness of their matrix by
;  factoring it and testing that all terms in E are zero.
;
;  If A is *not* positive definite, then the standard Cholesky
;  factorization is undefined.  In that case we adopt the "modified"
;  factorization strategy of Gill, Murray and Wright (p. 108), which
;  involves adding a diagonal error term to A in order to enforce
;  positive-definiteness.  The approach is optimal in the sense that
;  it attempts to minimize E, and thus disturbing A as little as
;  possible.  For optimization problems, this approximate
;  factorization can be used to find a direction of descent even when
;  the curvature is not positive definite.
;
;  The upper triangle of A is modified in place.  By default, the
;  lower triangle is left unchanged, and the matrices D and E are
;  actually returned as vectors containing only the diagonal terms.
;  However, if the keyword OUTFULL is set then full matrices are
;  returned.  This is useful when matrix multiplication will be
;  performed at the next step.
;
;  The modified Cholesky factorization is most stable when pivoting is
;  performed.  If the keyword PIVOT is set, then pivoting is performed
;  to place the diagonal terms with the largest amplitude in the next
;  row.  The permutation vectors returned in PERMUTE and INVPERMUTE
;  can be used to apply and reverse the pivoting.
;    [ i.e.,  (U(PP,*))(*,PP) applies the permutation and
;             (U(IPP,*))(*,IPP) reverses it, where PP and IPP are the
;             permutation and inverse permutation vectors. ]
;
;  If the matrix to be factored is very sparse, then setting the
;  SPARSE keyword may improve the speed of the computations.  SPARSE
;  is more costly on a dense matrix, but only grows as N^2, where as
;  the standard computation grows as N^3, where N is the rank of the
;  matrix.
;
;  If the CHOLSOL keyword is set, then the output is slightly
;  modified.  The returned matrix A that is returned is structured so
;  that it is compatible with the CHOLSOL built-in IDL routine.  This
;  involves converting A to being upper to lower triangular, and
;  multiplying by SQRT(D).  Users must be sure to check that all
;  elements of E are zero before using CHOLSOL.
;
; PARAMETERS:
;
;   A - upon input, a symmetric NxN matrix to be factored.
;       Upon output, the upper triangle of the matrix is modified to
;       contain the factorization.
;
;   D - upon output, the diagonal matrix D.
;
;   E - upon output, the diagonal error matrix E.
;
; KEYWORD PARAMETERS:
;
;   OUTFULL - if set, then A, D and E will be modified to be full IDL
;             matrices than can be matrix-multiplied.  By default,
;             only the upper triangle of A is modified, and D and E
;             are returned as vectors.
;
;   PIVOT - if set, then diagonal elements of A are pivoted into place
;           and operated on, in decrease order of their amplitude.
;           The permutation vectors are returned in the PERMUTE and
;           INVPERMUTE keywords.
;
;   PERMUTE - upon return, the permutation vector which converts a
;             vector into permuted form.
;
;   INVPERMUTE - upon return, the inverse permutation vector which
;                converts a vector from permuted form back into
;                standard form.
;
;   SPARSE - if set, then operations optimized for sparse matrices are
;            employed.  For large but very sparse matrices, this can
;            save a significant amount of computation time.
;
;   CHOLSOL - if set, then A and D are returned, suitable for input to
;             the built-in IDL routine CHOLSOL.  CHOLSOL is mutually
;             exclusive with the FULL keyword.
;
;   TAU - if set, then use the Tau factor as described in the
;         "unconventional" modified Cholesky factorization, as
;         described by Xie & Schlick.
;         Default: the unconventional technique is not used.
;
; EXAMPLE:
;
;   Example 1
;   ---------
;   a = randomn(seed, 5,5)    ;; Generate a random matrix
;   a = 0.5*(transpose(a)+a)  ;; Symmetrize it
;
;   a1 = a                    ;; Make a copy
;   mcholdc, a1, d, e, /full  ;; Factorize it
;   print, max(abs(e))        ;; This matrix is not positive definite
;
;   diff = transpose(a1) ## d ## a1 - e - a
;                             ;; Test the factorization by inverting
;                             ;; it and subtracting A
;   print, max(abs(diff))     ;; Differences are small
;
;   Example 2
;   ---------
;   Solving a problem with MCHOLDC and CHOLSOL
;
;   a = [[6E,15,55],[15E,55,225],[55E,225,979]]
;   b = [9.5E,50,237]
;
;   mcholdc, a, d, e, /cholsol  ;; Factorize matrix, compatible w/ CHOLSOL
;   if total(abs(e)) NE 0 then $
;      message, 'ERROR: Matrix A is not positive definite'
;
;   x = cholsol(a, d, b)        ;; Solve with CHOLSOL
;   print, x
;        -0.500001    -0.999999     0.500000
;   which is within 1e-6 of the true solution.
;
;
; REFERENCES:
;
;   Gill, P. E., Murray, W., & Wright, M. H. 1981
;     *Practical Optimization*, Academic Press
;   Schlick, T. & Fogelson, A., "TNPACK - A Truncated Newton
;     Minimization Package for Large- Scale Problems: I. Algorithm and
;     Usage," 1992, ACM TOMS, v. 18, p. 46-70.  (Alg. 702)
;   Xie, D. & Schlick, T., "Remark on Algorithm 702 - The Updated
;     Truncated Newton Minimization Package," 1999, ACM TOMS, v. 25,
;     p. 108-122.
;
; MODIFICATION HISTORY:
;   Written, CM, Apr 2001
;   Added CHOLSOL keyword, CM, 15 Feb 2002
;   Fix bug when computing final correction factor (thanks to Aaron
;     Adcock), CM, 13 Nov 2010
;
;  $Id: mcholdc.pro,v 1.6 2010/11/13 09:45:55 cmarkwar Exp $
;
;-
; Copyright (C) 2001, 2002, 2010, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   MPCHILIM
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute confidence limits for chi-square statistic
;
; MAJOR TOPICS:
;   Curve and Surface Fitting, Statistics
;
; CALLING SEQUENCE:
;   DELCHI = MPCHILIM(PROB, DOF, [/SIGMA, /CLEVEL, /SLEVEL ])
;
; DESCRIPTION:
;
;  The function MPCHILIM() computes confidence limits of the
;  chi-square statistic for a desired probability level.  The returned
;  values, DELCHI, are the limiting chi-squared values: a chi-squared
;  value of greater than DELCHI will occur by chance with probability
;  PROB:
;
;    P_CHI(CHI > DELCHI; DOF) = PROB
;
;  In specifying the probability level the user has three choices:
;
;    * give the confidence level (default);
;
;    * give the significance level (i.e., 1 - confidence level) and
;      pass the /SLEVEL keyword; OR
;
;    * give the "sigma" of the probability (i.e., compute the
;      probability based on the normal distribution) and pass the
;      /SIGMA keyword.
;
;  Note that /SLEVEL, /CLEVEL and /SIGMA are mutually exclusive.
;
; INPUTS:
;
;   PROB - scalar or vector number, giving the desired probability
;          level as described above.
;
;   DOF - scalar or vector number, giving the number of degrees of
;         freedom in the chi-square distribution.
;
; RETURNS:
;
;  Returns a scalar or vector of chi-square confidence limits.
;
; KEYWORD PARAMETERS:
;
;   SLEVEL - if set, then PROB describes the significance level.
;
;   CLEVEL - if set, then PROB describes the confidence level
;            (default).
;
;   SIGMA - if set, then PROB is the number of "sigma" away from the
;           mean in the normal distribution.
;
; EXAMPLES:
;
;   print, mpchilim(0.99d, 2d, /clevel)
;
;   Print the 99% confidence limit for a chi-squared of 2 degrees of
;   freedom.
;
;   print, mpchilim(5d, 2d, /sigma)
;
;   Print the "5 sigma" confidence limit for a chi-squared of 2
;   degrees of freedom.  Here "5 sigma" indicates the gaussian
;   probability of a 5 sigma event or greater. 
;       P_GAUSS(5D) = 1D - 5.7330314e-07
;
; REFERENCES:
;
;   Algorithms taken from CEPHES special function library, by Stephen
;   Moshier. (http://www.netlib.org/cephes/)
;
; MODIFICATION HISTORY:
;   Completed, 1999, CM
;   Documented, 16 Nov 2001, CM
;   Reduced obtrusiveness of common block and math error handling, 18
;     Nov 2001, CM
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9
;     Oct 2006
;   Add usage message, 24 Nov 2006, CM
;   Usage message with /CONTINUE, 23 Sep 2009, CM
;
;  $Id: mpchilim.pro,v 1.8 2009/09/23 20:12:46 craigm Exp $
;-
; Copyright (C) 1997-2001, 2006, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Set machine constants, once for this session.  Double precision
;; only.
pro cephes_setmachar
  COMPILE_OPT strictarr
  common cephes_machar, cephes_machar_vals
  if n_elements(cephes_machar_vals) GT 0 then return

  if (!version.release) LT 5 then dummy = check_math(1, 1)

  mch = machar(/double)
  machep = mch.eps
  maxnum = mch.xmax
  minnum = mch.xmin
  maxlog = alog(mch.xmax)
  minlog = alog(mch.xmin)
  maxgam = 171.624376956302725D

  cephes_machar_vals = {machep: machep, maxnum: maxnum, minnum: minnum, $
                        maxlog: maxlog, minlog: minlog, maxgam: maxgam}

  if (!version.release) LT 5 then dummy = check_math(0, 0)
  return
end

function cephes_polevl, x, coef
  COMPILE_OPT strictarr
  ans = coef[0]
  nc  = n_elements(coef)
  for i = 1L, nc-1 do ans = ans * x + coef[i]
  return, ans
end

function cephes_ndtri, y0
;   
;   	Inverse of Normal distribution function
;   
;   
;   
;    SYNOPSIS:
;   
;    double x, y, ndtri();
;   
;    x = ndtri( y );
;   
;   
;   
;    DESCRIPTION:
;   
;    Returns the argument, x, for which the area under the
;    Gaussian probability density function (integrated from
;    minus infinity to x) is equal to y.
;   
;   
;    For small arguments 0 < y < exp(-2), the program computes
;    z = sqrt( -2.0 * log(y) );  then the approximation is
;    x = z - log(z)/z  - (1/z) P(1/z) / Q(1/z).
;    There are two rational functions P/Q, one for 0 < y < exp(-32)
;    and the other for y up to exp(-2).  For larger arguments,
;    w = y - 0.5, and  x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)).
;   
;   
;    ACCURACY:
;   
;                         Relative error:
;    arithmetic   domain        # trials      peak         rms
;       DEC      0.125, 1         5500       9.5e-17     2.1e-17
;       DEC      6e-39, 0.135     3500       5.7e-17     1.3e-17
;       IEEE     0.125, 1        20000       7.2e-16     1.3e-16
;       IEEE     3e-308, 0.135   50000       4.6e-16     9.8e-17
;   
;   
;    ERROR MESSAGES:
;   
;      message         condition    value returned
;    ndtri domain       x <= 0        -MAXNUM
;    ndtri domain       x >= 1         MAXNUM
  COMPILE_OPT strictarr
  common cephes_ndtri_data, s2pi, p0, q0, p1, q1, p2, q2

  if n_elements(s2pi) EQ 0 then begin
      s2pi = sqrt(2.D*!dpi)
      p0 = [ -5.99633501014107895267D1,  9.80010754185999661536D1, $
             -5.66762857469070293439D1,  1.39312609387279679503D1, $
             -1.23916583867381258016D0 ]
      q0 = [ 1.D, $
             1.95448858338141759834D0,   4.67627912898881538453D0, $
             8.63602421390890590575D1,  -2.25462687854119370527D2, $
             2.00260212380060660359D2,  -8.20372256168333339912D1, $
             1.59056225126211695515D1,  -1.18331621121330003142D0  ]
      p1 = [ 4.05544892305962419923D0,   3.15251094599893866154D1, $
             5.71628192246421288162D1,   4.40805073893200834700D1, $
             1.46849561928858024014D1,   2.18663306850790267539D0, $
             -1.40256079171354495875D-1,-3.50424626827848203418D-2,$
             -8.57456785154685413611D-4  ]
      q1 = [ 1.D, $
             1.57799883256466749731D1,   4.53907635128879210584D1, $
             4.13172038254672030440D1,   1.50425385692907503408D1, $
             2.50464946208309415979D0,  -1.42182922854787788574D-1,$
             -3.80806407691578277194D-2,-9.33259480895457427372D-4 ]
      p2 = [  3.23774891776946035970D0,  6.91522889068984211695D0, $
              3.93881025292474443415D0,  1.33303460815807542389D0, $
              2.01485389549179081538D-1, 1.23716634817820021358D-2,$
              3.01581553508235416007D-4, 2.65806974686737550832D-6,$
              6.23974539184983293730D-9 ]
      q2 = [  1.D, $
              6.02427039364742014255D0,  3.67983563856160859403D0, $
              1.37702099489081330271D0,  2.16236993594496635890D-1,$
              1.34204006088543189037D-2, 3.28014464682127739104D-4,$
              2.89247864745380683936D-6, 6.79019408009981274425D-9]
  endif

  common cephes_machar, machvals
  MAXNUM = machvals.maxnum

  if y0 LE 0 then begin
      message, 'ERROR: domain', /info
      return, -MAXNUM
  endif
  if y0 GE 1 then begin
      message, 'ERROR: domain', /info
      return, MAXNUM
  endif

  code = 1
  y = y0
  exp2 = exp(-2.D)
  if y GT (1.D - exp2) then begin
      y = 1.D - y
      code = 0
  endif
  if y GT exp2 then begin
      y = y - 0.5
      y2 = y * y
      x = y + y * y2 * cephes_polevl(y2, p0) / cephes_polevl(y2, q0)
      x = x * s2pi
      return, x
  endif
  
  x = sqrt( -2.D * alog(y))
  x0 = x - alog(x)/x
  z = 1.D/x
  if x LT 8. then $
    x1 = z * cephes_polevl(z, p1) / cephes_polevl(z, q1) $
  else $
    x1 = z * cephes_polevl(z, p2) / cephes_polevl(z, q2)

  x = x0 - x1
  if code NE 0 then x = -x
  return, x
end

function cephes_igam, a, x
;   
;   	Incomplete gamma integral
;   
;   
;   
;    SYNOPSIS:
;   
;    double a, x, y, igam();
;   
;    y = igam( a, x );
;   
;    DESCRIPTION:
;   
;    The function is defined by
;   
;                              x
;                               -
;                      1       | |  -t  a-1
;     igam(a,x)  =   -----     |   e   t   dt.
;                     -      | |
;                    | (a)    -
;                              0
;   
;   
;    In this implementation both arguments must be positive.
;    The integral is evaluated by either a power series or
;    continued fraction expansion, depending on the relative
;    values of a and x.
;   
;    ACCURACY:
;   
;                         Relative error:
;    arithmetic   domain     # trials      peak         rms
;       IEEE      0,30       200000       3.6e-14     2.9e-15
;       IEEE      0,100      300000       9.9e-14     1.5e-14
  COMPILE_OPT strictarr
  common cephes_machar, machvals
  MAXLOG = machvals.maxlog
  MACHEP = machvals.machep

  if x LE 0 OR a LE 0 then return, 0.D
  if x GT 1. AND x GT a then return, 1.D - cephes_igamc(a, x)
  
  ax = a * alog(x) - x - lngamma(a)
  if ax LT -MAXLOG then begin
;      message, 'WARNING: underflow', /info
      return, 0.D
  endif
  ax = exp(ax)
  r = a
  c = 1.D
  ans = 1.D
  
  repeat begin
      r = r + 1
      c = c * x/r
      ans = ans + c
  endrep until (c/ans LE MACHEP)

  return, ans*ax/a
end

function cephes_igamc, a, x
;   
;   	Complemented incomplete gamma integral
;   
;   
;   
;    SYNOPSIS:
;   
;    double a, x, y, igamc();
;   
;    y = igamc( a, x );
;   
;    DESCRIPTION:
;   
;    The function is defined by
;   
;   
;     igamc(a,x)   =   1 - igam(a,x)
;   
;                               inf.
;                                 -
;                        1       | |  -t  a-1
;                  =   -----     |   e   t   dt.
;                       -      | |
;                      | (a)    -
;                                x
;   
;   
;    In this implementation both arguments must be positive.
;    The integral is evaluated by either a power series or
;    continued fraction expansion, depending on the relative
;    values of a and x.
;   
;    ACCURACY:
;   
;    Tested at random a, x.
;                   a         x                      Relative error:
;    arithmetic   domain   domain     # trials      peak         rms
;       IEEE     0.5,100   0,100      200000       1.9e-14     1.7e-15
;       IEEE     0.01,0.5  0,100      200000       1.4e-13     1.6e-15

  COMPILE_OPT strictarr
  common cephes_machar, machvals
  MAXLOG = machvals.maxlog
  MACHEP = machvals.machep

  big = 4.503599627370496D15
  biginv = 2.22044604925031308085D-16

  if x LE 0 OR a LE 0 then return, 1.D
  if x LT 1. OR x LT a then return, 1.D - cephes_igam(a, x)
  ax = a * alog(x) - x - lngamma(a)

  if ax LT -MAXLOG then begin
;      message, 'ERROR: underflow', /info
      return, 0.D
  endif
  
  ax = exp(ax)
  y = 1.D - a
  z = x + y + 1.D
  c = 0.D
  pkm2 = 1.D
  qkm2 = x
  pkm1 = x + 1.D
  qkm1 = z * x
  ans = pkm1 / qkm1

  repeat begin
      c = c + 1.D
      y = y + 1.D
      z = z + 2.D
      yc = y * c
      pk = pkm1 * z - pkm2 * yc
      qk = qkm1 * z - qkm2 * yc
      if qk NE 0 then begin
          r = pk/qk
          t = abs( (ans-r)/r )
          ans = r
      endif else begin
          t = 1.D
      endelse
      pkm2 = pkm1
      pkm1 = pk
      qkm2 = qkm1
      qkm1 = qk
      if abs(pk) GT big then begin
          pkm2 = pkm2 * biginv
          pkm1 = pkm1 * biginv
          qkm2 = qkm2 * biginv
          qkm1 = qkm1 * biginv
      endif
  endrep until t LE MACHEP

  return, ans * ax
end
  
function cephes_igami, a, y0
;  
;        Inverse of complemented imcomplete gamma integral
;  
;  
;  
;   SYNOPSIS:
;  
;   double a, x, p, igami();
;  
;   x = igami( a, p );
;  
;   DESCRIPTION:
;  
;   Given p, the function finds x such that
;  
;    igamc( a, x ) = p.
;  
;   Starting with the approximate value
;  
;           3
;    x = a t
;  
;    where
;  
;    t = 1 - d - ndtri(p) sqrt(d)
;   
;   and
;  
;    d = 1/9a,
;  
;   the routine performs up to 10 Newton iterations to find the
;   root of igamc(a,x) - p = 0.
;  
;   ACCURACY:
;  
;   Tested at random a, p in the intervals indicated.
;  
;                  a        p                      Relative error:
;   arithmetic   domain   domain     # trials      peak         rms
;      IEEE     0.5,100   0,0.5       100000       1.0e-14     1.7e-15
;      IEEE     0.01,0.5  0,0.5       100000       9.0e-14     3.4e-15
;      IEEE    0.5,10000  0,0.5        20000       2.3e-13     3.8e-14

  COMPILE_OPT strictarr
  common cephes_machar, machvals
  MAXNUM = machvals.maxnum
  MAXLOG = machvals.maxlog
  MACHEP = machvals.machep

  x0 = MAXNUM
  yl = 0.D
  x1 = 0.D
  yh = 1.D
  dithresh = 5.D * MACHEP

  d = 1.D/(9.D*a)
  y = (1.D - d - cephes_ndtri(y0) * sqrt(d))
  x = a * y * y * y
 
  lgm = lngamma(a)

  for i=0, 9 do begin
      if x GT x0 OR x LT x1 then goto, ihalve
      y = cephes_igamc(a, x)
      if y LT yl OR y GT yh then goto, ihalve
      if y LT y0 then begin
          x0 = x
          yl = y
      endif else begin
          x1 = x
          yh = y
      endelse
      
      d = (a-1.D) * alog(x) - x - lgm
      if d LT -MAXLOG then goto, ihalve
      d = -exp(d)
      d = (y - y0)/d
      if abs(d/x) LT MACHEP then goto, done
      x = x - d
  endfor

; Resort to interval halving if Newton iteration did not converge 
IHALVE:
  d = 0.0625D
  if x0 EQ MAXNUM then begin
      if x LE 0 then x = 1.D
      while x0 EQ MAXNUM do begin
          x = (1.D + d) * x
          y = cephes_igamc(a, x)
          if y LT y0 then begin
              x0 = x
              yl = y
              goto, DONELOOP1
          endif
          d = d + d
      endwhile
      DONELOOP1:
  endif

  d = 0.5
  dir = 0L
  for i=0, 399 do begin
      x = x1 + d * (x0-x1)
      y = cephes_igamc(a, x)
      lgm = (x0 - x1)/(x1 + x0)
      if abs(lgm) LT dithresh then goto, DONELOOP2
      lgm = (y - y0)/y0
      if abs(lgm) LT dithresh then goto, DONELOOP2
      if x LT 0 then goto, DONELOOP2
      if y GE y0 then begin
          x1 = x
          yh = y
          if dir LT 0 then begin
              dir = 0
              d = 0.5D
          endif else if dir GT 1 then begin
              d = 0.5 * d + 0.5
          endif else begin
              d = (y0 - yl)/(yh - yl)
          endelse
          dir = dir + 1
      endif else begin
          x0 = x
          yl = y
          if dir GT 0 then begin
              dir = 0
              d = 0.5
          endif else if dir LT -1 then begin
              d = 0.5 * d
          endif else begin
              d = (y0 - yl)/(yh - yl)
          endelse
          dir = dir - 1
      endelse
  endfor
  DONELOOP2:
  
  if x EQ 0 then begin
;      message, 'WARNING: underflow', /info
  endif

  DONE:
  return, x
end


function mpchilim, p, dof, sigma=sigma, clevel=clevel, slevel=slevel

  COMPILE_OPT strictarr

  if n_params() EQ 0 then begin
      message, 'USAGE: DELCHI = MPCHILIM(PROB, DOF, [/SIGMA, /CLEVEL, /SLEVEL ])', /cont
      return, !values.d_nan
  endif

  cephes_setmachar   ;; Set machine constants
  if n_elements(dof) EQ 0 then dof = 1.

  ;; Confidence level is the default
  if n_elements(clevel) EQ 0 then clevel = 1
  if keyword_set(sigma) then begin  ;; Significance in terms of SIGMA
      slev = 1D - errorf(p/sqrt(2.))
  endif else if keyword_set(slevel) then begin ;; in terms of SIGNIFICANCE LEVEL
      slev = p
  endif else if keyword_set(clevel) then begin ;; in terms of CONFIDENCE LEVEL
      slev = 1.D - double(p)        
  endif else begin
      message, 'ERROR: must specify one of SIGMA, CLEVEL, SLEVEL'
  endelse

  ;; Output will have same type as input
  y = p*0

  ;; Loop through, computing the inverse, incomplete gamma function
  ;; slev is the significance level
  for i = 0L, n_elements(p)-1 do begin
      y[i] = 2.D * cephes_igami(0.5D*double(dof), slev[i])
  end

  return, y
end
;+
; NAME:
;   MPCHITEST
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute the probability of a given chi-squared value
;
; MAJOR TOPICS:
;   Curve and Surface Fitting, Statistics
;
; CALLING SEQUENCE:
;   PROB = MPCHITEST(CHI, DOF, [/SIGMA, /CLEVEL, /SLEVEL ])
;
; DESCRIPTION:
;
;  The function MPCHITEST() computes the probability for a value drawn
;  from the chi-square distribution to equal or exceed the given value
;  CHI.  This can be used for confidence testing of a measured value
;  obeying the chi-squared distribution.
;
;    P_CHI(X > CHI; DOF) = PROB
;
;  In specifying the returned probability level the user has three
;  choices:
;
;    * return the confidence level when the /CLEVEL keyword is passed;
;      OR
;
;    * return the significance level (i.e., 1 - confidence level) when
;      the /SLEVEL keyword is passed (default); OR
;
;    * return the "sigma" of the probability (i.e., compute the
;      probability based on the normal distribution) when the /SIGMA
;      keyword is passed.
;
;  Note that /SLEVEL, /CLEVEL and /SIGMA are mutually exclusive.
;
; INPUTS:
;
;   CHI - chi-squared value to be tested.
;
;   DOF - scalar or vector number, giving the number of degrees of
;         freedom in the chi-square distribution.
;
; RETURNS:
;
;  Returns a scalar or vector of probabilities, as described above,
;  and according to the /SLEVEL, /CLEVEL and /SIGMA keywords.
;
; KEYWORD PARAMETERS:
;
;   SLEVEL - if set, then PROB describes the significance level
;            (default).
;
;   CLEVEL - if set, then PROB describes the confidence level.
;
;   SIGMA - if set, then PROB is the number of "sigma" away from the
;           mean in the normal distribution.
;
; EXAMPLES:
;
;   print, mpchitest(1300d,1252d)
;
;   Print the probability for a chi-squared value with 1252 degrees of
;   freedom to exceed a value of 1300, as a confidence level.
;
; REFERENCES:
;
;   Algorithms taken from CEPHES special function library, by Stephen
;   Moshier. (http://www.netlib.org/cephes/)
;
; MODIFICATION HISTORY:
;   Completed, 1999, CM
;   Documented, 16 Nov 2001, CM
;   Reduced obtrusiveness of common block and math error handling, 18
;     Nov 2001, CM
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9 Oct 2006
;   Add usage message, 24 Nov 2006, CM
;   Really add usage message, with /CONTINUE, 23 Sep 2009, CM
;
;  $Id: mpchitest.pro,v 1.10 2009/10/05 16:22:44 craigm Exp $
;-
; Copyright (C) 1997-2001, 2006, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Set machine constants, once for this session.  Double precision
;; only.
pro cephes_setmachar
  COMPILE_OPT strictarr
  common cephes_machar, cephes_machar_vals
  if n_elements(cephes_machar_vals) GT 0 then return

  if (!version.release) LT 5 then dummy = check_math(1, 1)

  mch = machar(/double)
  machep = mch.eps
  maxnum = mch.xmax
  minnum = mch.xmin
  maxlog = alog(mch.xmax)
  minlog = alog(mch.xmin)
  maxgam = 171.624376956302725D

  cephes_machar_vals = {machep: machep, maxnum: maxnum, minnum: minnum, $
                        maxlog: maxlog, minlog: minlog, maxgam: maxgam}

  if (!version.release) LT 5 then dummy = check_math(0, 0)
  return
end

function cephes_igam, a, x
;   
;   	Incomplete gamma integral
;   
;   
;   
;    SYNOPSIS:
;   
;    double a, x, y, igam();
;   
;    y = igam( a, x );
;   
;    DESCRIPTION:
;   
;    The function is defined by
;   
;                              x
;                               -
;                      1       | |  -t  a-1
;     igam(a,x)  =   -----     |   e   t   dt.
;                     -      | |
;                    | (a)    -
;                              0
;   
;   
;    In this implementation both arguments must be positive.
;    The integral is evaluated by either a power series or
;    continued fraction expansion, depending on the relative
;    values of a and x.
;   
;    ACCURACY:
;   
;                         Relative error:
;    arithmetic   domain     # trials      peak         rms
;       IEEE      0,30       200000       3.6e-14     2.9e-15
;       IEEE      0,100      300000       9.9e-14     1.5e-14
  COMPILE_OPT strictarr
  common cephes_machar, machvals
  MAXLOG = machvals.maxlog
  MACHEP = machvals.machep

  if x LE 0 OR a LE 0 then return, 0.D
  if x GT 1. AND x GT a then return, 1.D - cephes_igamc(a, x)
  
  ax = a * alog(x) - x - lngamma(a)
  if ax LT -MAXLOG then begin
;      message, 'WARNING: underflow', /info
      return, 0.D
  endif
  ax = exp(ax)
  r = a
  c = 1.D
  ans = 1.D
  
  repeat begin
      r = r + 1
      c = c * x/r
      ans = ans + c
  endrep until (c/ans LE MACHEP)

  return, ans*ax/a
end

function cephes_igamc, a, x
;   
;   	Complemented incomplete gamma integral
;   
;   
;   
;    SYNOPSIS:
;   
;    double a, x, y, igamc();
;   
;    y = igamc( a, x );
;   
;    DESCRIPTION:
;   
;    The function is defined by
;   
;   
;     igamc(a,x)   =   1 - igam(a,x)
;   
;                               inf.
;                                 -
;                        1       | |  -t  a-1
;                  =   -----     |   e   t   dt.
;                       -      | |
;                      | (a)    -
;                                x
;   
;   
;    In this implementation both arguments must be positive.
;    The integral is evaluated by either a power series or
;    continued fraction expansion, depending on the relative
;    values of a and x.
;   
;    ACCURACY:
;   
;    Tested at random a, x.
;                   a         x                      Relative error:
;    arithmetic   domain   domain     # trials      peak         rms
;       IEEE     0.5,100   0,100      200000       1.9e-14     1.7e-15
;       IEEE     0.01,0.5  0,100      200000       1.4e-13     1.6e-15

  COMPILE_OPT strictarr

  if n_params() EQ 0 then begin
      message, 'USAGE: PROB = MPCHITEST(CHI, DOF, [/SIGMA, /CLEVEL, /SLEVEL ])', /info
      return, !values.d_nan
  endif


  common cephes_machar, machvals
  MAXLOG = machvals.maxlog
  MACHEP = machvals.machep

  big = 4.503599627370496D15
  biginv = 2.22044604925031308085D-16

  if x LE 0 OR a LE 0 then return, 1.D
  if x LT 1. OR x LT a then return, 1.D - cephes_igam(a, x)
  ax = a * alog(x) - x - lngamma(a)

  if ax LT -MAXLOG then begin
;      message, 'ERROR: underflow', /info
      return, 0.D
  endif
  
  ax = exp(ax)
  y = 1.D - a
  z = x + y + 1.D
  c = 0.D
  pkm2 = 1.D
  qkm2 = x
  pkm1 = x + 1.D
  qkm1 = z * x
  ans = pkm1 / qkm1

  repeat begin
      c = c + 1.D
      y = y + 1.D
      z = z + 2.D
      yc = y * c
      pk = pkm1 * z - pkm2 * yc
      qk = qkm1 * z - qkm2 * yc
      if qk NE 0 then begin
          r = pk/qk
          t = abs( (ans-r)/r )
          ans = r
      endif else begin
          t = 1.D
      endelse
      pkm2 = pkm1
      pkm1 = pk
      qkm2 = qkm1
      qkm1 = qk
      if abs(pk) GT big then begin
          pkm2 = pkm2 * biginv
          pkm1 = pkm1 * biginv
          qkm2 = qkm2 * biginv
          qkm1 = qkm1 * biginv
      endif
  endrep until t LE MACHEP

  return, ans * ax
end

; MPCHITEST
;  compute the probability for a chi-squared value to exceed x give
;  the number of degrees of freedom dof.
function mpchitest, x, dof, slevel=slevel, clevel=clevel, sigma=sigma
  COMPILE_OPT strictarr

  if n_params() LT 2 then begin
      message, 'USAGE: PROB = MPCHITEST(CHI, DOF, [/SIGMA, /CLEVEL, /SLEVEL ])', /cont
      return, !values.d_nan
  endif

  cephes_setmachar   ;; Set machine constants
  
  p = double(x) * 0
  for i = 0, n_elements(x)-1 do begin
      p[i] = cephes_igamc(0.5D * dof, 0.5D * double(x[i]))
  endfor
  if keyword_set(clevel) then return, 1D - double(p)
  if keyword_set(sigma) then return, mpnormlim(p, /slevel)

  return, p
end

  
  
;+
; NAME:
;   MPCURVEFIT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Perform Levenberg-Marquardt least-squares fit (replaces CURVEFIT)
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   YFIT = MPCURVEFIT(X, Y, WEIGHTS, P, [SIGMA,] FUNCTION_NAME=FUNC, 
;                     ITER=iter, ITMAX=itmax, 
;                     CHISQ=chisq, NFREE=nfree, DOF=dof, 
;                     NFEV=nfev, COVAR=covar, [/NOCOVAR, ] [/NODERIVATIVE, ]
;                     FUNCTARGS=functargs, PARINFO=parinfo,
;                     FTOL=ftol, XTOL=xtol, GTOL=gtol, TOL=tol,
;                     ITERPROC=iterproc, ITERARGS=iterargs,
;                     NPRINT=nprint, QUIET=quiet, 
;                     ERRMSG=errmsg, STATUS=status)
;
; DESCRIPTION:
;
;  MPCURVEFIT fits a user-supplied model -- in the form of an IDL
;  function -- to a set of user-supplied data.  MPCURVEFIT calls
;  MPFIT, the MINPACK-1 least-squares minimizer, to do the main
;  work.
;
;  Given the data and their uncertainties, MPCURVEFIT finds the best
;  set of model parameters which match the data (in a least-squares
;  sense) and returns them in the parameter P.  
;
;  MPCURVEFIT returns the best fit function.
;  
;  The user must supply the following items:
;   - An array of independent variable values ("X").
;   - An array of "measured" *dependent* variable values ("Y").
;   - An array of weighting values ("WEIGHTS").
;   - The name of an IDL function which computes Y given X ("FUNC").
;   - Starting guesses for all of the parameters ("P").
;
;  There are very few restrictions placed on X, Y or FUNCT.  Simply
;  put, FUNCT must map the "X" values into "Y" values given the
;  model parameters.  The "X" values may represent any independent
;  variable (not just Cartesian X), and indeed may be multidimensional
;  themselves.  For example, in the application of image fitting, X
;  may be a 2xN array of image positions.
;
;  MPCURVEFIT carefully avoids passing large arrays where possible to
;  improve performance.
;
;  See below for an example of usage.
;   
; USER FUNCTION
;
;  The user must define a function which returns the model value.  For
;  applications which use finite-difference derivatives -- the default
;  -- the user function should be declared in the following way:
;
;    ; MYFUNCT - example user function
;    ;   X - input independent variable (vector same size as data)
;    ;   P - input parameter values (N-element array)
;    ;   YMOD - upon return, user function values
;    ;   DP - upon return, the user function must return
;    ;          an ARRAY(M,N) of derivatives in this parameter
;    ;
;    PRO MYFUNCT, x, p, ymod, dp
;     ymod = F(x, p)         ;; Model function
;     
;     if n_params() GE 4  then begin
;       ; Create derivative and compute derivative array
;       dp = make_array(n_elements(x), n_elements(p), value=x[0]*0)
;
;       ; Compute derivative if requested by caller
;       for i = 0, n_elements(p)-1 do dp(*,i) = FGRAD(x, p, i)
;     endif
;    END
;
;  where FGRAD(x, p, i) is a model function which computes the
;  derivative of the model F(x,p) with respect to parameter P(i) at X.
;  The returned array YMOD must have the same dimensions and type as
;  the "measured" Y values.  The returned array DP[i,j] is the
;  derivative of the ith function value with respect to the jth
;  parameter.
;
;  User functions may also indicate a fatal error condition
;  using the ERROR_CODE common block variable, as described
;  below under the MPFIT_ERROR common block definition.
; 
;  If NODERIVATIVE=1, then MPCURVEFIT will never request explicit
;  derivatives from the user function, and instead will user numerical
;  estimates (i.e. by calling the user function multiple times).
;
; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD
;
;  The behavior of MPFIT can be modified with respect to each
;  parameter to be fitted.  A parameter value can be fixed; simple
;  boundary constraints can be imposed; limitations on the parameter
;  changes can be imposed; properties of the automatic derivative can
;  be modified; and parameters can be tied to one another.
;
;  These properties are governed by the PARINFO structure, which is
;  passed as a keyword parameter to MPFIT.
;
;  PARINFO should be an array of structures, one for each parameter.
;  Each parameter is associated with one element of the array, in
;  numerical order.  The structure can have the following entries
;  (none are required):
;  
;     .VALUE - the starting parameter value (but see the START_PARAMS
;              parameter for more information).
;  
;     .FIXED - a boolean value, whether the parameter is to be held
;              fixed or not.  Fixed parameters are not varied by
;              MPFIT, but are passed on to MYFUNCT for evaluation.
;  
;     .LIMITED - a two-element boolean array.  If the first/second
;                element is set, then the parameter is bounded on the
;                lower/upper side.  A parameter can be bounded on both
;                sides.  Both LIMITED and LIMITS must be given
;                together.
;  
;     .LIMITS - a two-element float or double array.  Gives the
;               parameter limits on the lower and upper sides,
;               respectively.  Zero, one or two of these values can be
;               set, depending on the values of LIMITED.  Both LIMITED
;               and LIMITS must be given together.
;  
;     .PARNAME - a string, giving the name of the parameter.  The
;                fitting code of MPFIT does not use this tag in any
;                way.  However, the default ITERPROC will print the
;                parameter name if available.
;  
;     .STEP - the step size to be used in calculating the numerical
;             derivatives.  If set to zero, then the step size is
;             computed automatically.  Ignored when AUTODERIVATIVE=0.
;             This value is superceded by the RELSTEP value.
;
;     .RELSTEP - the *relative* step size to be used in calculating
;                the numerical derivatives.  This number is the
;                fractional size of the step, compared to the
;                parameter value.  This value supercedes the STEP
;                setting.  If the parameter is zero, then a default
;                step size is chosen.
;
;     .MPSIDE - the sidedness of the finite difference when computing
;               numerical derivatives.  This field can take four
;               values:
;
;                  0 - one-sided derivative computed automatically
;                  1 - one-sided derivative (f(x+h) - f(x)  )/h
;                 -1 - one-sided derivative (f(x)   - f(x-h))/h
;                  2 - two-sided derivative (f(x+h) - f(x-h))/(2*h)
;
;              Where H is the STEP parameter described above.  The
;              "automatic" one-sided derivative method will chose a
;              direction for the finite difference which does not
;              violate any constraints.  The other methods do not
;              perform this check.  The two-sided method is in
;              principle more precise, but requires twice as many
;              function evaluations.  Default: 0.
;
;     .MPMAXSTEP - the maximum change to be made in the parameter
;                  value.  During the fitting process, the parameter
;                  will never be changed by more than this value in
;                  one iteration.
;
;                  A value of 0 indicates no maximum.  Default: 0.
;  
;     .TIED - a string expression which "ties" the parameter to other
;             free or fixed parameters.  Any expression involving
;             constants and the parameter array P are permitted.
;             Example: if parameter 2 is always to be twice parameter
;             1 then use the following: parinfo(2).tied = '2 * P(1)'.
;             Since they are totally constrained, tied parameters are
;             considered to be fixed; no errors are computed for them.
;             [ NOTE: the PARNAME can't be used in expressions. ]
;
;     .MPPRINT - if set to 1, then the default ITERPROC will print the
;                parameter value.  If set to 0, the parameter value
;                will not be printed.  This tag can be used to
;                selectively print only a few parameter values out of
;                many.  Default: 1 (all parameters printed)
;
;  
;  Future modifications to the PARINFO structure, if any, will involve
;  adding structure tags beginning with the two letters "MP".
;  Therefore programmers are urged to avoid using tags starting with
;  the same letters; otherwise they are free to include their own
;  fields within the PARINFO structure, and they will be ignored.
;  
;  PARINFO Example:
;  parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $
;                       limits:[0.D,0]}, 5)
;  parinfo(0).fixed = 1
;  parinfo(4).limited(0) = 1
;  parinfo(4).limits(0)  = 50.D
;  parinfo(*).value = [5.7D, 2.2, 500., 1.5, 2000.]
;  
;  A total of 5 parameters, with starting values of 5.7,
;  2.2, 500, 1.5, and 2000 are given.  The first parameter
;  is fixed at a value of 5.7, and the last parameter is
;  constrained to be above 50.
;
; INPUTS:
;   X - Array of independent variable values.
;
;   Y - Array of "measured" dependent variable values.  Y should have
;       the same data type as X.  The function FUNCT should map
;       X->Y.
;
;   WEIGHTS - Array of weights to be used in calculating the
;             chi-squared value.  If WEIGHTS is specified then the ERR
;             parameter is ignored.  The chi-squared value is computed
;             as follows:
;
;                CHISQ = TOTAL( (Y-FUNCT(X,P))^2 * ABS(WEIGHTS) )
;
;             Here are common values of WEIGHTS:
;
;                1D/ERR^2 - Normal weighting (ERR is the measurement error)
;                1D/Y     - Poisson weighting (counting statistics)
;                1D       - Unweighted
;
;   P - An array of starting values for each of the parameters of the
;       model.  The number of parameters should be fewer than the
;       number of measurements.  Also, the parameters should have the
;       same data type as the measurements (double is preferred).
;
;       Upon successful completion the new parameter values are
;       returned in P.
;
;       If both START_PARAMS and PARINFO are passed, then the starting
;       *value* is taken from START_PARAMS, but the *constraints* are
;       taken from PARINFO.
; 
;   SIGMA - The formal 1-sigma errors in each parameter, computed from
;           the covariance matrix.  If a parameter is held fixed, or
;           if it touches a boundary, then the error is reported as
;           zero.
;
;           If the fit is unweighted (i.e. no errors were given, or
;           the weights were uniformly set to unity), then SIGMA will
;           probably not represent the true parameter uncertainties.
;
;           *If* you can assume that the true reduced chi-squared
;           value is unity -- meaning that the fit is implicitly
;           assumed to be of good quality -- then the estimated
;           parameter uncertainties can be computed by scaling SIGMA
;           by the measured chi-squared value.
;
;              DOF     = N_ELEMENTS(X) - N_ELEMENTS(P) ; deg of freedom
;              CSIGMA  = SIGMA * SQRT(CHISQ / DOF)     ; scaled uncertainties
;
; RETURNS:
;
;   Returns the array containing the best-fitting function.
;
; KEYWORD PARAMETERS:
;
;   CHISQ - the value of the summed, squared, weighted residuals for
;           the returned parameter values, i.e. the chi-square value.
;
;   COVAR - the covariance matrix for the set of parameters returned
;           by MPFIT.  The matrix is NxN where N is the number of
;           parameters.  The square root of the diagonal elements
;           gives the formal 1-sigma statistical errors on the
;           parameters IF errors were treated "properly" in MYFUNC.
;           Parameter errors are also returned in PERROR.
;
;           To compute the correlation matrix, PCOR, use this:
;           IDL> PCOR = COV * 0
;           IDL> FOR i = 0, n-1 DO FOR j = 0, n-1 DO $
;                PCOR(i,j) = COV(i,j)/sqrt(COV(i,i)*COV(j,j))
;
;           If NOCOVAR is set or MPFIT terminated abnormally, then
;           COVAR is set to a scalar with value !VALUES.D_NAN.
;
;   DOF - number of degrees of freedom, computed as
;             DOF = N_ELEMENTS(DEVIATES) - NFREE
;         Note that this doesn't account for pegged parameters (see
;         NPEGGED).
;
;   ERRMSG - a string error or warning message is returned.
;
;   FTOL - a nonnegative input variable. Termination occurs when both
;          the actual and predicted relative reductions in the sum of
;          squares are at most FTOL (and STATUS is accordingly set to
;          1 or 3).  Therefore, FTOL measures the relative error
;          desired in the sum of squares.  Default: 1D-10
;
;   FUNCTION_NAME - a scalar string containing the name of an IDL
;                   procedure to compute the user model values, as
;                   described above in the "USER MODEL" section.
;
;   FUNCTARGS - A structure which contains the parameters to be passed
;               to the user-supplied function specified by FUNCT via
;               the _EXTRA mechanism.  This is the way you can pass
;               additional data to your user-supplied function without
;               using common blocks.
;
;               By default, no extra parameters are passed to the
;               user-supplied function.
;
;   GTOL - a nonnegative input variable. Termination occurs when the
;          cosine of the angle between fvec and any column of the
;          jacobian is at most GTOL in absolute value (and STATUS is
;          accordingly set to 4). Therefore, GTOL measures the
;          orthogonality desired between the function vector and the
;          columns of the jacobian.  Default: 1D-10
;
;   ITER - the number of iterations completed.
;
;   ITERARGS - The keyword arguments to be passed to ITERPROC via the
;              _EXTRA mechanism.  This should be a structure, and is
;              similar in operation to FUNCTARGS.
;              Default: no arguments are passed.
;
;   ITERPROC - The name of a procedure to be called upon each NPRINT
;              iteration of the MPFIT routine.  It should be declared
;              in the following way:
;
;              PRO ITERPROC, FUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $
;                PARINFO=parinfo, QUIET=quiet, ...
;                ; perform custom iteration update
;              END
;         
;              ITERPROC must either accept all three keyword
;              parameters (FUNCTARGS, PARINFO and QUIET), or at least
;              accept them via the _EXTRA keyword.
;          
;              FUNCT is the user-supplied function to be minimized,
;              P is the current set of model parameters, ITER is the
;              iteration number, and FUNCTARGS are the arguments to be
;              passed to FUNCT.  FNORM should be the
;              chi-squared value.  QUIET is set when no textual output
;              should be printed.  See below for documentation of
;              PARINFO.
;
;              In implementation, ITERPROC can perform updates to the
;              terminal or graphical user interface, to provide
;              feedback while the fit proceeds.  If the fit is to be
;              stopped for any reason, then ITERPROC should set the
;              common block variable ERROR_CODE to negative value (see
;              MPFIT_ERROR common block below).  In principle,
;              ITERPROC should probably not modify the parameter
;              values, because it may interfere with the algorithm's
;              stability.  In practice it is allowed.
;
;              Default: an internal routine is used to print the
;                       parameter values.
;
;   ITMAX - The maximum number of iterations to perform.  If the
;             number is exceeded, then the STATUS value is set to 5
;             and MPFIT returns.
;             Default: 200 iterations
;
;   NFEV - the number of FUNCT function evaluations performed.
;
;   NFREE - the number of free parameters in the fit.  This includes
;           parameters which are not FIXED and not TIED, but it does
;           include parameters which are pegged at LIMITS.
;
;   NOCOVAR - set this keyword to prevent the calculation of the
;             covariance matrix before returning (see COVAR)
;
;   NODERIVATIVE - if set, then the user function will not be queried
;                  for analytical derivatives, and instead the
;                  derivatives will be computed by finite differences
;                  (and according to the PARINFO derivative settings;
;                  see above for a description).
;
;   NPRINT - The frequency with which ITERPROC is called.  A value of
;            1 indicates that ITERPROC is called with every iteration,
;            while 2 indicates every other iteration, etc.  Note that
;            several Levenberg-Marquardt attempts can be made in a
;            single iteration.
;            Default value: 1
;
;   PARINFO - Provides a mechanism for more sophisticated constraints
;             to be placed on parameter values.  When PARINFO is not
;             passed, then it is assumed that all parameters are free
;             and unconstrained.  Values in PARINFO are never 
;             modified during a call to MPFIT.
;
;             See description above for the structure of PARINFO.
;
;             Default value:  all parameters are free and unconstrained.
;
;   QUIET - set this keyword when no textual output should be printed
;           by MPFIT
;
;   STATUS - an integer status code is returned.  All values greater
;            than zero can represent success (however STATUS EQ 5 may
;            indicate failure to converge).  It can have one of the
;            following values:
;
;	   0  improper input parameters.
;         
;	   1  both actual and predicted relative reductions
;	      in the sum of squares are at most FTOL.
;         
;	   2  relative error between two consecutive iterates
;	      is at most XTOL
;         
;	   3  conditions for STATUS = 1 and STATUS = 2 both hold.
;         
;	   4  the cosine of the angle between fvec and any
;	      column of the jacobian is at most GTOL in
;	      absolute value.
;         
;	   5  the maximum number of iterations has been reached
;         
;	   6  FTOL is too small. no further reduction in
;	      the sum of squares is possible.
;         
;	   7  XTOL is too small. no further improvement in
;	      the approximate solution x is possible.
;         
;	   8  GTOL is too small. fvec is orthogonal to the
;	      columns of the jacobian to machine precision.
;
;   TOL - synonym for FTOL.  Use FTOL instead.
;
;   XTOL - a nonnegative input variable. Termination occurs when the
;          relative error between two consecutive iterates is at most
;          XTOL (and STATUS is accordingly set to 2 or 3).  Therefore,
;          XTOL measures the relative error desired in the approximate
;          solution.  Default: 1D-10
;
;   YERROR - upon return, the root-mean-square variance of the
;            residuals.
;
;
; EXAMPLE:
;
;   ; First, generate some synthetic data
;   npts = 200
;   x  = dindgen(npts) * 0.1 - 10.                  ; Independent variable 
;   yi = gauss1(x, [2.2D, 1.4, 3000.])              ; "Ideal" Y variable
;   y  = yi + randomn(seed, npts) * sqrt(1000. + yi); Measured, w/ noise
;   sy = sqrt(1000.D + y)                           ; Poisson errors
;
;   ; Now fit a Gaussian to see how well we can recover
;   p0 = [1.D, 1., 1000.]                           ; Initial guess
;   yfit = mpcurvefit(x, y, 1/sy^2, p0, $           ; Fit a function
;                     FUNCTION_NAME='GAUSS1P',/autoderivative)
;   print, p
;
;   Generates a synthetic data set with a Gaussian peak, and Poisson
;   statistical uncertainty.  Then the same function is fitted to the
;   data to see how close we can get.  GAUSS1 and GAUSS1P are
;   available from the same web page.
;
;
; COMMON BLOCKS:
;
;   COMMON MPFIT_ERROR, ERROR_CODE
;
;     User routines may stop the fitting process at any time by
;     setting an error condition.  This condition may be set in either
;     the user's model computation routine (MYFUNCT), or in the
;     iteration procedure (ITERPROC).
;
;     To stop the fitting, the above common block must be declared,
;     and ERROR_CODE must be set to a negative number.  After the user
;     procedure or function returns, MPFIT checks the value of this
;     common block variable and exits immediately if the error
;     condition has been set.  By default the value of ERROR_CODE is
;     zero, indicating a successful function/procedure call.
;
; REFERENCES:
;
;   MINPACK-1, Jorge More', available from netlib (www.netlib.org).
;   "Optimization Software Guide," Jorge More' and Stephen Wright, 
;     SIAM, *Frontiers in Applied Mathematics*, Number 14.
;
; MODIFICATION HISTORY:
;   Translated from MPFITFUN, 25 Sep 1999, CM
;   Alphabetized documented keywords, 02 Oct 1999, CM
;   Added QUERY keyword and query checking of MPFIT, 29 Oct 1999, CM
;   Check to be sure that X and Y are present, 02 Nov 1999, CM
;   Documented SIGMA for unweighted fits, 03 Nov 1999, CM
;   Changed to ERROR_CODE for error condition, 28 Jan 2000, CM
;   Copying permission terms have been liberalized, 26 Mar 2000, CM
;   Propagated improvements from MPFIT, 17 Dec 2000, CM
;   Corrected behavior of NODERIVATIVE, 13 May 2002, CM
;   Documented RELSTEP field of PARINFO (!!), CM, 25 Oct 2002
;   Make more consistent with comparable IDL routines, 30 Jun 2003, CM
;   Minor documentation adjustment, 03 Feb 2004, CM
;   Fix error in documentation, 26 Aug 2005, CM
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9 Oct 2006
;   Fix bug in handling of explicit derivatives with errors/weights
;     (the weights were not being applied), CM, 2012-07-22
;   Add more documentation on calling interface for user function and
;     parameter derivatives, CM, 2012-07-22
;   Better documentation for STATUS, CM, 2016-04-29
;
;  $Id: mpcurvefit.pro,v 1.12 2016/05/19 16:08:49 cmarkwar Exp $
;-
; Copyright (C) 1997-2000, 2002, 2003, 2004, 2005, 2012, 2016 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; This is the call-back function for MPFIT.  It evaluates the
; function, subtracts the data, and returns the residuals.
function mpcurvefit_eval, p, dp, _EXTRA=extra

  COMPILE_OPT strictarr
  common mpcurvefit_common, fcn, x, y, wts, f, fcnargs

  ;; The function is evaluated here.  There are four choices,
  ;; depending on whether (a) FUNCTARGS was passed to MPCURVEFIT, which
  ;; is passed to this function as "hf"; or (b) the derivative
  ;; parameter "dp" is passed, meaning that derivatives should be
  ;; calculated analytically by the function itself.
  if n_elements(fcnargs) GT 0 then begin
      if n_params() GT 1 then call_procedure, fcn, x, p, f, dp,_EXTRA=fcnargs $
      else                    call_procedure, fcn, x, p, f,    _EXTRA=fcnargs
  endif else begin
      if n_params() GT 1 then call_procedure, fcn, x, p, f, dp $
      else                    call_procedure, fcn, x, p, f
  endelse

  ;; Compute the deviates, applying the weights
  result = (y-f)*wts
  
  ;; Apply weights to derivative quantities                                     
  if n_params() GT 1 then begin
      np = n_elements(p)
      nf = n_elements(f)
      for j = 0L, np-1 do dp[j*nf] = dp[j*nf:j*nf+nf-1] * wts
  endif
      
  ;; Make sure the returned result is one-dimensional.
  result = reform(result, n_elements(result), /overwrite)
  return, result
  
end

function mpcurvefit, x, y, wts, p, perror, function_name=fcn, $
                     iter=iter, itmax=maxiter, $
                     chisq=bestnorm, nfree=nfree, dof=dof, $
                     nfev=nfev, covar=covar, nocovar=nocovar, yerror=yerror, $
                     noderivative=noderivative, tol=tol, ftol=ftol, $
                     FUNCTARGS=fa, parinfo=parinfo, $
                     errmsg=errmsg, STATUS=status, QUIET=quiet, $
                     query=query, _EXTRA=extra

  COMPILE_OPT strictarr
  status = 0L
  errmsg = ''

  ;; Detect MPFIT and crash if it was not found
  catch, catcherror
  if catcherror NE 0 then begin
      MPFIT_NOTFOUND:
      catch, /cancel
      message, 'ERROR: the required function MPFIT must be in your IDL path', /info
      return, !values.d_nan
  endif
  if mpfit(/query) NE 1 then goto, MPFIT_NOTFOUND
  catch, /cancel
  if keyword_set(query) then return, 1

  if n_params() EQ 0 then begin
      message, "USAGE: YFIT = MPCURVEFIT(X, Y, WTS, P, DP)", /info
      return, !values.d_nan
  endif
  if n_elements(x) EQ 0 OR n_elements(y) EQ 0 then begin
      message, 'ERROR: X and Y must be defined', /info
      return, !values.d_nan
  endif
  if n_elements(fcn) EQ 0 then fcn = 'funct'
  if n_elements(noderivative) EQ 0 then noderivative = 0

  common mpcurvefit_common, fc, xc, yc, wc, mc, ac
  fc = fcn & xc = x & yc = y & wc = sqrt(abs(wts)) & mc = 0L
  ac = 0 & dummy = size(temporary(ac))
  if n_elements(fa) GT 0 then ac = fa

  if n_elements(tol) GT 0 then ftol = tol

  result = mpfit('mpcurvefit_eval', p, maxiter=maxiter, $
                 autoderivative=noderivative, ftol=ftol, $
                 parinfo=parinfo, STATUS=status, nfev=nfev, BESTNORM=bestnorm,$
                 covar=covar, perror=perror, niter=iter, nfree=nfree, dof=dof,$
                 ERRMSG=errmsg, quiet=quiet, _EXTRA=extra)

  ;; Retrieve the fit value
  yfit = temporary(mc)
  ;; Now do some clean-up
  xc = 0 & yc = 0 & wc = 0 & mc = 0 & ac = 0

  if NOT keyword_set(quiet) AND errmsg NE '' then $
    message, errmsg, /info $
  else $
    p = result

  yerror = p[0]*0
  if n_elements(dof) GT 0 AND dof[0] GT 0 then begin
      yerror[0] = sqrt( total( (y-yfit)^2 ) / dof[0] )
  endif

  return, yfit
end
;+
; NAME:
;   MPFIT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Perform Levenberg-Marquardt least-squares minimization (MINPACK-1)
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   parms = MPFIT(MYFUNCT, start_parms, FUNCTARGS=fcnargs, NFEV=nfev,
;                 MAXITER=maxiter, ERRMSG=errmsg, NPRINT=nprint, QUIET=quiet, 
;                 FTOL=ftol, XTOL=xtol, GTOL=gtol, NITER=niter, 
;                 STATUS=status, ITERPROC=iterproc, ITERARGS=iterargs,
;                 COVAR=covar, PERROR=perror, BESTNORM=bestnorm,
;                 PARINFO=parinfo)
;
; DESCRIPTION:
;
;  MPFIT uses the Levenberg-Marquardt technique to solve the
;  least-squares problem.  In its typical use, MPFIT will be used to
;  fit a user-supplied function (the "model") to user-supplied data
;  points (the "data") by adjusting a set of parameters.  MPFIT is
;  based upon MINPACK-1 (LMDIF.F) by More' and collaborators.
;
;  For example, a researcher may think that a set of observed data
;  points is best modelled with a Gaussian curve.  A Gaussian curve is
;  parameterized by its mean, standard deviation and normalization.
;  MPFIT will, within certain constraints, find the set of parameters
;  which best fits the data.  The fit is "best" in the least-squares
;  sense; that is, the sum of the weighted squared differences between
;  the model and data is minimized.
;
;  The Levenberg-Marquardt technique is a particular strategy for
;  iteratively searching for the best fit.  This particular
;  implementation is drawn from MINPACK-1 (see NETLIB), and seems to
;  be more robust than routines provided with IDL.  This version
;  allows upper and lower bounding constraints to be placed on each
;  parameter, or the parameter can be held fixed.
;
;  The IDL user-supplied function should return an array of weighted
;  deviations between model and data.  In a typical scientific problem
;  the residuals should be weighted so that each deviate has a
;  gaussian sigma of 1.0.  If X represents values of the independent
;  variable, Y represents a measurement for each value of X, and ERR
;  represents the error in the measurements, then the deviates could
;  be calculated as follows:
;
;    DEVIATES = (Y - F(X)) / ERR
;
;  where F is the function representing the model.  You are
;  recommended to use the convenience functions MPFITFUN and
;  MPFITEXPR, which are driver functions that calculate the deviates
;  for you.  If ERR are the 1-sigma uncertainties in Y, then
;
;    TOTAL( DEVIATES^2 ) 
;
;  will be the total chi-squared value.  MPFIT will minimize the
;  chi-square value.  The values of X, Y and ERR are passed through
;  MPFIT to the user-supplied function via the FUNCTARGS keyword.
;
;  Simple constraints can be placed on parameter values by using the
;  PARINFO keyword to MPFIT.  See below for a description of this
;  keyword.
;
;  MPFIT does not perform more general optimization tasks.  See TNMIN
;  instead.  MPFIT is customized, based on MINPACK-1, to the
;  least-squares minimization problem.
;
; USER FUNCTION
;
;  The user must define a function which returns the appropriate
;  values as specified above.  The function should return the weighted
;  deviations between the model and the data.  For applications which
;  use finite-difference derivatives -- the default -- the user
;  function should be declared in the following way:
;
;    FUNCTION MYFUNCT, p, X=x, Y=y, ERR=err
;     ; Parameter values are passed in "p"
;     model = F(x, p)
;     return, (y-model)/err
;    END
;
;  See below for applications with explicit derivatives.
;
;  The keyword parameters X, Y, and ERR in the example above are
;  suggestive but not required.  Any parameters can be passed to
;  MYFUNCT by using the FUNCTARGS keyword to MPFIT.  Use MPFITFUN and
;  MPFITEXPR if you need ideas on how to do that.  The function *must*
;  accept a parameter list, P.
;  
;  In general there are no restrictions on the number of dimensions in
;  X, Y or ERR.  However the deviates *must* be returned in a
;  one-dimensional array, and must have the same type (float or
;  double) as the input arrays.
;
;  See below for error reporting mechanisms.
;
;
; CHECKING STATUS AND HANNDLING ERRORS
;
;  Upon return, MPFIT will report the status of the fitting operation
;  in the STATUS and ERRMSG keywords.  The STATUS keyword will contain
;  a numerical code which indicates the success or failure status.
;  Generally speaking, any value 1 or greater indicates success, while
;  a value of 0 or less indicates a possible failure.  The ERRMSG
;  keyword will contain a text string which should describe the error
;  condition more fully.
;
;  By default, MPFIT will trap fatal errors and report them to the
;  caller gracefully.  However, during the debugging process, it is
;  often useful to halt execution where the error occurred.  When you
;  set the NOCATCH keyword, MPFIT will not do any special error
;  trapping, and execution will stop whereever the error occurred.
;
;  MPFIT does not explicitly change the !ERROR_STATE variable
;  (although it may be changed implicitly if MPFIT calls MESSAGE).  It
;  is the caller's responsibility to call MESSAGE, /RESET to ensure
;  that the error state is initialized before calling MPFIT.
;
;  User functions may also indicate non-fatal error conditions using
;  the ERROR_CODE common block variable, as described below under the
;  MPFIT_ERROR common block definition (by setting ERROR_CODE to a
;  number between -15 and -1).  When the user function sets an error
;  condition via ERROR_CODE, MPFIT will gracefully exit immediately
;  and report this condition to the caller.  The ERROR_CODE is
;  returned in the STATUS keyword in that case.
;
;
; EXPLICIT DERIVATIVES
; 
;  In the search for the best-fit solution, MPFIT by default
;  calculates derivatives numerically via a finite difference
;  approximation.  The user-supplied function need not calculate the
;  derivatives explicitly.  However, the user function *may* calculate
;  the derivatives if desired, but only if the model function is
;  declared with an additional position parameter, DP, as described
;  below.  If the user function does not accept this additional
;  parameter, MPFIT will report an error.  As a practical matter, it
;  is often sufficient and even faster to allow MPFIT to calculate the
;  derivatives numerically, but this option is available for users who
;  wish more control over the fitting process.
;
;  There are two ways to enable explicit derivatives.  First, the user
;  can set the keyword AUTODERIVATIVE=0, which is a global switch for
;  all parameters.  In this case, MPFIT will request explicit
;  derivatives for every free parameter.  
;
;  Second, the user may request explicit derivatives for specifically
;  selected parameters using the PARINFO.MPSIDE=3 (see "CONSTRAINING
;  PARAMETER VALUES WITH THE PARINFO KEYWORD" below).  In this
;  strategy, the user picks and chooses which parameter derivatives
;  are computed explicitly versus numerically.  When PARINFO[i].MPSIDE
;  EQ 3, then the ith parameter derivative is computed explicitly.
;
;  The keyword setting AUTODERIVATIVE=0 always globally overrides the
;  individual values of PARINFO.MPSIDE.  Setting AUTODERIVATIVE=0 is
;  equivalent to resetting PARINFO.MPSIDE=3 for all parameters.
;
;  Even if the user requests explicit derivatives for some or all
;  parameters, MPFIT will not always request explicit derivatives on
;  every user function call.
;
; EXPLICIT DERIVATIVES - CALLING INTERFACE
;
;  When AUTODERIVATIVE=0, the user function is responsible for
;  calculating the derivatives of the *residuals* with respect to each
;  parameter.  The user function should be declared as follows:
;
;    ;
;    ; MYFUNCT - example user function
;    ;   P - input parameter values (N-element array)
;    ;   DP - upon input, an N-vector indicating which parameters
;    ;          to compute derivatives for; 
;    ;        upon output, the user function must return
;    ;          an ARRAY(M,N) of derivatives in this keyword
;    ;   (keywords) - any other keywords specified by FUNCTARGS
;    ; RETURNS - residual values
;    ;
;    FUNCTION MYFUNCT, p, dp, X=x, Y=y, ERR=err
;     model = F(x, p)         ;; Model function
;     resid = (y - model)/err ;; Residual calculation (for example)
;     
;     if n_params() GT 1 then begin
;       ; Create derivative and compute derivative array
;       requested = dp   ; Save original value of DP
;       dp = make_array(n_elements(x), n_elements(p), value=x[0]*0)
;
;       ; Compute derivative if requested by caller
;       for i = 0, n_elements(p)-1 do if requested(i) NE 0 then $
;         dp(*,i) = FGRAD(x, p, i) / err
;     endif
;    
;     return, resid
;    END
;
;  where FGRAD(x, p, i) is a model function which computes the
;  derivative of the model F(x,p) with respect to parameter P(i) at X.
;
;  A quirk in the implementation leaves a stray negative sign in the
;  definition of DP.  The derivative of the *residual* should be
;  "-FGRAD(x,p,i) / err" because of how the residual is defined
;  ("resid = (data - model) / err").  **HOWEVER** because of the
;  implementation quirk, MPFIT expects FGRAD(x,p,i)/err instead,
;  i.e. the opposite sign of the gradient of RESID.
;
;  Derivatives should be returned in the DP array. DP should be an
;  ARRAY(m,n) array, where m is the number of data points and n is the
;  number of parameters.  -DP[i,j] is the derivative of the ith
;  residual with respect to the jth parameter (note the minus sign
;  due to the quirk described above).
;
;  As noted above, MPFIT may not always request derivatives from the
;  user function.  In those cases, the parameter DP is not passed.
;  Therefore functions can use N_PARAMS() to indicate whether they
;  must compute the derivatives or not.
;  
;  The derivatives with respect to fixed parameters are ignored; zero
;  is an appropriate value to insert for those derivatives.  Upon
;  input to the user function, DP is set to a vector with the same
;  length as P, with a value of 1 for a parameter which is free, and a
;  value of zero for a parameter which is fixed (and hence no
;  derivative needs to be calculated).  This input vector may be
;  overwritten as needed.  In the example above, the original DP
;  vector is saved to a variable called REQUESTED, and used as a mask
;  to calculate only those derivatives that are required.
;
;  If the data is higher than one dimensional, then the *last*
;  dimension should be the parameter dimension.  Example: fitting a
;  50x50 image, "dp" should be 50x50xNPAR.
;
; EXPLICIT DERIVATIVES - TESTING and DEBUGGING
;
;  For reasonably complicated user functions, the calculation of
;  explicit derivatives of the correct sign and magnitude can be
;  difficult to get right.  A simple sign error can cause MPFIT to be
;  confused.  MPFIT has a derivative debugging mode which will compute
;  the derivatives *both* numerically and explicitly, and compare the
;  results.
;
;  It is expected that during production usage, derivative debugging
;  should be disabled for all parameters.
;
;  In order to enable derivative debugging mode, set the following
;  PARINFO members for the ith parameter.
;      PARINFO[i].MPSIDE = 3          ; Enable explicit derivatives
;      PARINFO[i].MPDERIV_DEBUG = 1   ; Enable derivative debugging mode
;      PARINFO[i].MPDERIV_RELTOL = ?? ; Relative tolerance for comparison
;      PARINFO[i].MPDERIV_ABSTOL = ?? ; Absolute tolerance for comparison
;  Note that these settings are maintained on a parameter-by-parameter
;  basis using PARINFO, so the user can choose which parameters
;  derivatives will be tested.
;
;  When .MPDERIV_DEBUG is set, then MPFIT first computes the
;  derivative explicitly by requesting them from the user function.
;  Then, it computes the derivatives numerically via finite
;  differencing, and compares the two values.  If the difference
;  exceeds a tolerance threshold, then the values are printed out to 
;  alert the user.  The tolerance level threshold contains both a
;  relative and an absolute component, and is expressed as,
;
;     ABS(DERIV_U - DERIV_N) GE (ABSTOL + RELTOL*ABS(DERIV_U))
;
;  where DERIV_U and DERIV_N are the derivatives computed explicitly
;  and numerically, respectively.  Appropriate values
;  for most users will be: 
;
;      PARINFO[i].MPDERIV_RELTOL = 1d-3 ;; Suggested relative tolerance 
;      PARINFO[i].MPDERIV_ABSTOL = 1d-7 ;; Suggested absolute tolerance
;
;  although these thresholds may have to be adjusted for a particular
;  problem.  When the threshold is exceeded, users can expect to see a
;  tabular report like this one:
;
;    FJAC DEBUG BEGIN
;    #        IPNT       FUNC    DERIV_U    DERIV_N   DIFF_ABS   DIFF_REL
;    FJAC PARM 2
;               80    -0.7308    0.04233    0.04233 -5.543E-07 -1.309E-05
;               99      1.370    0.01417    0.01417 -5.518E-07 -3.895E-05
;              118    0.07187   -0.01400   -0.01400 -5.566E-07  3.977E-05
;              137      1.844   -0.04216   -0.04216 -5.589E-07  1.326E-05
;    FJAC DEBUG END
;
;  The report will be bracketed by FJAC DEBUG BEGIN/END statements.
;  Each parameter will be delimited by the statement FJAC PARM n,
;  where n is the parameter number.  The columns are,
;
;      IPNT - data point number  (0 ... M-1)
;      FUNC - function value at that point
;      DERIV_U - explicit derivative value at that point
;      DERIV_N - numerical derivative estimate at that point
;      DIFF_ABS - absolute difference = (DERIV_U - DERIV_N)
;      DIFF_REL - relative difference = (DIFF_ABS)/(DERIV_U)
;
;  When prints appear in this report, it is most important to check
;  that the derivatives computed in two different ways have the same
;  numerical sign and the same order of magnitude, since these are the
;  most common programming mistakes.
;
;  A line of this form may also appear 
;
;   # FJAC_MASK = 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 
;
;  This line indicates for which parameters explicit derivatives are
;  expected.  A list of all-1s indicates all explicit derivatives for
;  all parameters are requested from the user function.
;    
;  
; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD
;
;  The behavior of MPFIT can be modified with respect to each
;  parameter to be fitted.  A parameter value can be fixed; simple
;  boundary constraints can be imposed; limitations on the parameter
;  changes can be imposed; properties of the automatic derivative can
;  be modified; and parameters can be tied to one another.
;
;  These properties are governed by the PARINFO structure, which is
;  passed as a keyword parameter to MPFIT.
;
;  PARINFO should be an array of structures, one for each parameter.
;  Each parameter is associated with one element of the array, in
;  numerical order.  The structure can have the following entries
;  (none are required):
;  
;     .VALUE - the starting parameter value (but see the START_PARAMS
;              parameter for more information).
;  
;     .FIXED - a boolean value, whether the parameter is to be held
;              fixed or not.  Fixed parameters are not varied by
;              MPFIT, but are passed on to MYFUNCT for evaluation.
;  
;     .LIMITED - a two-element boolean array.  If the first/second
;                element is set, then the parameter is bounded on the
;                lower/upper side.  A parameter can be bounded on both
;                sides.  Both LIMITED and LIMITS must be given
;                together.
;  
;     .LIMITS - a two-element float or double array.  Gives the
;               parameter limits on the lower and upper sides,
;               respectively.  Zero, one or two of these values can be
;               set, depending on the values of LIMITED.  Both LIMITED
;               and LIMITS must be given together.
;  
;     .PARNAME - a string, giving the name of the parameter.  The
;                fitting code of MPFIT does not use this tag in any
;                way.  However, the default ITERPROC will print the
;                parameter name if available.
;  
;     .STEP - the step size to be used in calculating the numerical
;             derivatives.  If set to zero, then the step size is
;             computed automatically.  Ignored when AUTODERIVATIVE=0.
;             This value is superceded by the RELSTEP value.
;
;     .RELSTEP - the *relative* step size to be used in calculating
;                the numerical derivatives.  This number is the
;                fractional size of the step, compared to the
;                parameter value.  This value supercedes the STEP
;                setting.  If the parameter is zero, then a default
;                step size is chosen.
;
;     .MPSIDE - selector for type of derivative calculation. This
;               field can take one of five possible values:
;
;                  0 - one-sided derivative computed automatically
;                  1 - one-sided derivative (f(x+h) - f(x)  )/h
;                 -1 - one-sided derivative (f(x)   - f(x-h))/h
;                  2 - two-sided derivative (f(x+h) - f(x-h))/(2*h)
;                  3 - explicit derivative used for this parameter
;
;              In the first four cases, the derivative is approximated
;              numerically by finite difference, with step size
;              H=STEP, where the STEP parameter is defined above.  The
;              last case, MPSIDE=3, indicates to allow the user
;              function to compute the derivative explicitly (see
;              section on "EXPLICIT DERIVATIVES").  AUTODERIVATIVE=0
;              overrides this setting for all parameters, and is
;              equivalent to MPSIDE=3 for all parameters.  For
;              MPSIDE=0, the "automatic" one-sided derivative method
;              will chose a direction for the finite difference which
;              does not violate any constraints.  The other methods
;              (MPSIDE=-1 or MPSIDE=1) do not perform this check.  The
;              two-sided method is in principle more precise, but
;              requires twice as many function evaluations.  Default:
;              0.
;
;     .MPDERIV_DEBUG - set this value to 1 to enable debugging of
;              user-supplied explicit derivatives (see "TESTING and
;              DEBUGGING" section above).  In addition, the
;              user must enable calculation of explicit derivatives by
;              either setting AUTODERIVATIVE=0, or MPSIDE=3 for the
;              desired parameters.  When this option is enabled, a
;              report may be printed to the console, depending on the
;              MPDERIV_ABSTOL and MPDERIV_RELTOL settings.
;              Default: 0 (no debugging)
;
;     
;     .MPDERIV_ABSTOL, .MPDERIV_RELTOL - tolerance settings for
;              print-out of debugging information, for each parameter
;              where debugging is enabled.  See "TESTING and
;              DEBUGGING" section above for the meanings of these two
;              fields.
;
;
;     .MPMAXSTEP - the maximum change to be made in the parameter
;                  value.  During the fitting process, the parameter
;                  will never be changed by more than this value in
;                  one iteration.
;
;                  A value of 0 indicates no maximum.  Default: 0.
;  
;     .TIED - a string expression which "ties" the parameter to other
;             free or fixed parameters as an equality constraint.  Any
;             expression involving constants and the parameter array P
;             are permitted.
;             Example: if parameter 2 is always to be twice parameter
;             1 then use the following: parinfo[2].tied = '2 * P[1]'.
;             Since they are totally constrained, tied parameters are
;             considered to be fixed; no errors are computed for them,
;             and any LIMITS are not obeyed.
;             [ NOTE: the PARNAME can't be used in a TIED expression. ]
;
;     .MPPRINT - if set to 1, then the default ITERPROC will print the
;                parameter value.  If set to 0, the parameter value
;                will not be printed.  This tag can be used to
;                selectively print only a few parameter values out of
;                many.  Default: 1 (all parameters printed)
;
;     .MPFORMAT - IDL format string to print the parameter within
;                 ITERPROC.  Default: '(G20.6)'  (An empty string will
;                 also use the default.)
;
;  Future modifications to the PARINFO structure, if any, will involve
;  adding structure tags beginning with the two letters "MP".
;  Therefore programmers are urged to avoid using tags starting with
;  "MP", but otherwise they are free to include their own fields
;  within the PARINFO structure, which will be ignored by MPFIT.
;  
;  PARINFO Example:
;  parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $
;                       limits:[0.D,0]}, 5)
;  parinfo[0].fixed = 1
;  parinfo[4].limited[0] = 1
;  parinfo[4].limits[0]  = 50.D
;  parinfo[*].value = [5.7D, 2.2, 500., 1.5, 2000.]
;  
;  A total of 5 parameters, with starting values of 5.7,
;  2.2, 500, 1.5, and 2000 are given.  The first parameter
;  is fixed at a value of 5.7, and the last parameter is
;  constrained to be above 50.
;
;
; RECURSION
;
;  Generally, recursion is not allowed.  As of version 1.77, MPFIT has
;  recursion protection which does not allow a model function to
;  itself call MPFIT.  Users who wish to perform multi-level
;  optimization should investigate the 'EXTERNAL' function evaluation
;  methods described below for hard-to-evaluate functions.  That
;  method places more control in the user's hands.  The user can
;  design a "recursive" application by taking care.
;
;  In most cases the recursion protection should be well-behaved.
;  However, if the user is doing debugging, it is possible for the
;  protection system to get "stuck."  In order to reset it, run the
;  procedure:
;     MPFIT_RESET_RECURSION
;  and the protection system should get "unstuck."  It is save to call
;  this procedure at any time.
;
;
; COMPATIBILITY
;
;  This function is designed to work with IDL 5.0 or greater.
;  
;  Because TIED parameters and the "(EXTERNAL)" user-model feature use
;  the EXECUTE() function, they cannot be used with the free version
;  of the IDL Virtual Machine.
;
;
; DETERMINING THE VERSION OF MPFIT
;
;  MPFIT is a changing library.  Users of MPFIT may also depend on a
;  specific version of the library being present.  As of version 1.70
;  of MPFIT, a VERSION keyword has been added which allows the user to
;  query which version is present.  The keyword works like this:
;
;    RESULT = MPFIT(/query, VERSION=version)
;
;  This call uses the /QUERY keyword to query the version number
;  without performing any computations.  Users of MPFIT can call this
;  method to determine which version is in the IDL path before
;  actually using MPFIT to do any numerical work.  Upon return, the
;  VERSION keyword contains the version number of MPFIT, expressed as
;  a string of the form 'X.Y' where X and Y are integers.
;
;  Users can perform their own version checking, or use the built-in
;  error checking of MPFIT.  The MIN_VERSION keyword enforces the
;  requested minimum version number.  For example,
;
;    RESULT = MPFIT(/query, VERSION=version, MIN_VERSION='1.70')
;
;  will check whether the accessed version is 1.70 or greater, without
;  performing any numerical processing.
;
;  The VERSION and MIN_VERSION keywords were added in MPFIT
;  version 1.70 and later.  If the caller attempts to use the VERSION
;  or MIN_VERSION keywords, and an *older* version of the code is
;  present in the caller's path, then IDL will throw an 'unknown
;  keyword' error.  Therefore, in order to be robust, the caller, must
;  use exception handling.  Here is an example demanding at least
;  version 1.70.
;
;    MPFIT_OK = 0  & VERSION = '<unknown>'
;    CATCH, CATCHERR
;    IF CATCHERR EQ 0 THEN MPFIT_OK = MPFIT(/query, VERSION=version, $
;                                         MIN_VERSION='1.70')
;    CATCH, /CANCEL
;
;    IF NOT MPFIT_OK THEN $
;      MESSAGE, 'ERROR: you must have MPFIT version 1.70 or higher in '+$
;             'your path (found version '+version+')'
;
;  Of course, the caller can also do its own version number
;  requirements checking.
;
;
; HARD-TO-COMPUTE FUNCTIONS: "EXTERNAL" EVALUATION
;
;  The normal mode of operation for MPFIT is for the user to pass a
;  function name, and MPFIT will call the user function multiple times
;  as it iterates toward a solution.
;
;  Some user functions are particularly hard to compute using the
;  standard model of MPFIT.  Usually these are functions that depend
;  on a large amount of external data, and so it is not feasible, or
;  at least highly impractical, to have MPFIT call it.  In those cases
;  it may be possible to use the "(EXTERNAL)" evaluation option.
;
;  In this case the user is responsible for making all function *and
;  derivative* evaluations.  The function and Jacobian data are passed
;  in through the EXTERNAL_FVEC and EXTERNAL_FJAC keywords,
;  respectively.  The user indicates the selection of this option by
;  specifying a function name (MYFUNCT) of "(EXTERNAL)".  No
;  user-function calls are made when EXTERNAL evaluation is being
;  used.
;
;  ** SPECIAL NOTE ** For the "(EXTERNAL)" case, the quirk noted above
;     does not apply.  The gradient matrix, EXTERNAL_FJAC, should be
;     comparable to "-FGRAD(x,p)/err", which is the *opposite* sign of
;     the DP matrix described above.  In other words, EXTERNAL_FJAC
;     has the same sign as the derivative of EXTERNAL_FVEC, and the
;     opposite sign of FGRAD.
;
;  At the end of each iteration, control returns to the user, who must
;  reevaluate the function at its new parameter values.  Users should
;  check the return value of the STATUS keyword, where a value of 9
;  indicates the user should supply more data for the next iteration,
;  and re-call MPFIT.  The user may refrain from calling MPFIT
;  further; as usual, STATUS will indicate when the solution has
;  converged and no more iterations are required.
;
;  Because MPFIT must maintain its own data structures between calls,
;  the user must also pass a named variable to the EXTERNAL_STATE
;  keyword.  This variable must be maintained by the user, but not
;  changed, throughout the fitting process.  When no more iterations
;  are desired, the named variable may be discarded.
;
;
; INPUTS:
;   MYFUNCT - a string variable containing the name of the function to
;             be minimized.  The function should return the weighted
;             deviations between the model and the data, as described
;             above.
;
;             For EXTERNAL evaluation of functions, this parameter
;             should be set to a value of "(EXTERNAL)".
;
;   START_PARAMS - An one-dimensional array of starting values for each of the
;                  parameters of the model.  The number of parameters
;                  should be fewer than the number of measurements.
;                  Also, the parameters should have the same data type
;                  as the measurements (double is preferred).
;
;                  This parameter is optional if the PARINFO keyword
;                  is used (but see PARINFO).  The PARINFO keyword
;                  provides a mechanism to fix or constrain individual
;                  parameters.  If both START_PARAMS and PARINFO are
;                  passed, then the starting *value* is taken from
;                  START_PARAMS, but the *constraints* are taken from
;                  PARINFO.
; 
; RETURNS:
;
;   Returns the array of best-fit parameters.
;   Exceptions: 
;      * if /QUERY is set (see QUERY).
;
;
; KEYWORD PARAMETERS:
;
;   AUTODERIVATIVE - If this is set, derivatives of the function will
;                    be computed automatically via a finite
;                    differencing procedure.  If not set, then MYFUNCT
;                    must provide the explicit derivatives.
;                    Default: set (=1) 
;                    NOTE: to supply your own explicit derivatives,
;                      explicitly pass AUTODERIVATIVE=0
;
;   BESTNORM - upon return, the value of the summed squared weighted
;              residuals for the returned parameter values,
;              i.e. TOTAL(DEVIATES^2).
;
;   BEST_FJAC - upon return, BEST_FJAC contains the Jacobian, or
;               partial derivative, matrix for the best-fit model.
;               The values are an array,
;               ARRAY(N_ELEMENTS(DEVIATES),NFREE) where NFREE is the
;               number of free parameters.  This array is only
;               computed if /CALC_FJAC is set, otherwise BEST_FJAC is
;               undefined.
;
;               The returned array is such that BEST_FJAC[I,J] is the
;               partial derivative of DEVIATES[I] with respect to
;               parameter PARMS[PFREE_INDEX[J]].  Note that since
;               deviates are (data-model)*weight, the Jacobian of the
;               *deviates* will have the opposite sign from the
;               Jacobian of the *model*, and may be scaled by a
;               factor.
;
;   BEST_RESID - upon return, an array of best-fit deviates.
;
;   CALC_FJAC - if set, then calculate the Jacobian and return it in
;               BEST_FJAC.  If not set, then the return value of
;               BEST_FJAC is undefined.
;
;   COVAR - the covariance matrix for the set of parameters returned
;           by MPFIT.  The matrix is NxN where N is the number of
;           parameters.  The square root of the diagonal elements
;           gives the formal 1-sigma statistical errors on the
;           parameters IF errors were treated "properly" in MYFUNC.
;           Parameter errors are also returned in PERROR.
;
;           To compute the correlation matrix, PCOR, use this example:
;                  PCOR = COV * 0
;                  FOR i = 0, n-1 DO FOR j = 0, n-1 DO $
;                    PCOR[i,j] = COV[i,j]/sqrt(COV[i,i]*COV[j,j])
;           or equivalently, in vector notation,
;                  PCOR = COV / (PERROR # PERROR)
;
;           If NOCOVAR is set or MPFIT terminated abnormally, then
;           COVAR is set to a scalar with value !VALUES.D_NAN.
;
;   DOF - number of degrees of freedom, computed as
;             DOF = N_ELEMENTS(DEVIATES) - NFREE
;         Note that this doesn't account for pegged parameters (see
;         NPEGGED).  It also does not account for data points which
;         are assigned zero weight by the user function.
;
;   ERRMSG - a string error or warning message is returned.
;
;   EXTERNAL_FVEC - upon input, the function values, evaluated at
;                   START_PARAMS.  This should be an M-vector, where M
;                   is the number of data points.
;
;   EXTERNAL_FJAC - upon input, the Jacobian array of partial
;                   derivative values.  This should be a M x N array,
;                   where M is the number of data points and N is the
;                   number of parameters.  NOTE: that all FIXED or
;                   TIED parameters must *not* be included in this
;                   array.
;
;   EXTERNAL_STATE - a named variable to store MPFIT-related state
;                    information between iterations (used in input and
;                    output to MPFIT).  The user must not manipulate
;                    or discard this data until the final iteration is
;                    performed.
;
;   FASTNORM - set this keyword to select a faster algorithm to
;              compute sum-of-square values internally.  For systems
;              with large numbers of data points, the standard
;              algorithm can become prohibitively slow because it
;              cannot be vectorized well.  By setting this keyword,
;              MPFIT will run faster, but it will be more prone to
;              floating point overflows and underflows.  Thus, setting
;              this keyword may sacrifice some stability in the
;              fitting process.
;              
;   FTOL - a nonnegative input variable. Termination occurs when both
;          the actual and predicted relative reductions in the sum of
;          squares are at most FTOL (and STATUS is accordingly set to
;          1 or 3).  Therefore, FTOL measures the relative error
;          desired in the sum of squares.  Default: 1D-10
;
;   FUNCTARGS - A structure which contains the parameters to be passed
;               to the user-supplied function specified by MYFUNCT via
;               the _EXTRA mechanism.  This is the way you can pass
;               additional data to your user-supplied function without
;               using common blocks.
;
;               Consider the following example:
;                if FUNCTARGS = { XVAL:[1.D,2,3], YVAL:[1.D,4,9],
;                                 ERRVAL:[1.D,1,1] }
;                then the user supplied function should be declared
;                like this:
;                FUNCTION MYFUNCT, P, XVAL=x, YVAL=y, ERRVAL=err
;
;               By default, no extra parameters are passed to the
;               user-supplied function, but your function should
;               accept *at least* one keyword parameter.  [ This is to
;               accomodate a limitation in IDL's _EXTRA
;               parameter-passing mechanism. ]
;
;   GTOL - a nonnegative input variable. Termination occurs when the
;          cosine of the angle between fvec and any column of the
;          jacobian is at most GTOL in absolute value (and STATUS is
;          accordingly set to 4). Therefore, GTOL measures the
;          orthogonality desired between the function vector and the
;          columns of the jacobian.  Default: 1D-10
;
;   ITERARGS - The keyword arguments to be passed to ITERPROC via the
;              _EXTRA mechanism.  This should be a structure, and is
;              similar in operation to FUNCTARGS.
;              Default: no arguments are passed.
;
;   ITERPRINT - The name of an IDL procedure, equivalent to PRINT,
;               that ITERPROC will use to render output.  ITERPRINT
;               should be able to accept at least four positional
;               arguments.  In addition, it should be able to accept
;               the standard FORMAT keyword for output formatting; and
;               the UNIT keyword, to redirect output to a logical file
;               unit (default should be UNIT=1, standard output).
;               These keywords are passed using the ITERARGS keyword
;               above.  The ITERPRINT procedure must accept the _EXTRA
;               keyword.  
;               NOTE: that much formatting can be handled with the 
;                     MPPRINT and MPFORMAT tags.
;               Default: 'MPFIT_DEFPRINT' (default internal formatter)
;
;   ITERPROC - The name of a procedure to be called upon each NPRINT
;              iteration of the MPFIT routine.  ITERPROC is always
;              called in the final iteration.  It should be declared
;              in the following way:
;
;              PRO ITERPROC, MYFUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $
;                PARINFO=parinfo, QUIET=quiet, DOF=dof, PFORMAT=pformat, $
;                UNIT=unit, ...
;                ; perform custom iteration update
;              END
;         
;              ITERPROC must either accept all three keyword
;              parameters (FUNCTARGS, PARINFO and QUIET), or at least
;              accept them via the _EXTRA keyword.
;          
;              MYFUNCT is the user-supplied function to be minimized,
;              P is the current set of model parameters, ITER is the
;              iteration number, and FUNCTARGS are the arguments to be
;              passed to MYFUNCT.  FNORM should be the chi-squared
;              value.  QUIET is set when no textual output should be
;              printed.  DOF is the number of degrees of freedom,
;              normally the number of points less the number of free
;              parameters.  See below for documentation of PARINFO.
;              PFORMAT is the default parameter value format.  UNIT is
;              passed on to the ITERPRINT procedure, and should
;              indicate the file unit where log output will be sent
;              (default: standard output).
;
;              In implementation, ITERPROC can perform updates to the
;              terminal or graphical user interface, to provide
;              feedback while the fit proceeds.  If the fit is to be
;              stopped for any reason, then ITERPROC should set the
;              common block variable ERROR_CODE to negative value
;              between -15 and -1 (see MPFIT_ERROR common block
;              below).  In principle, ITERPROC should probably not
;              modify the parameter values, because it may interfere
;              with the algorithm's stability.  In practice it is
;              allowed.
;
;              Default: an internal routine is used to print the
;                       parameter values.
;
;   ITERSTOP - Set this keyword if you wish to be able to stop the
;              fitting by hitting the predefined ITERKEYSTOP key on
;              the keyboard.  This only works if you use the default
;              ITERPROC.
;
;   ITERKEYSTOP - A keyboard key which will halt the fit (and if
;                 ITERSTOP is set and the default ITERPROC is used).
;                 ITERSTOPKEY may either be a one-character string
;                 with the desired key, or a scalar integer giving the
;                 ASCII code of the desired key.  
;                 Default: 7b (control-g)
;
;                 NOTE: the default value of ASCI 7 (control-G) cannot
;                 be read in some windowing environments, so you must
;                 change to a printable character like 'q'.
;
;   MAXITER - The maximum number of iterations to perform.  If the
;             number of calculation iterations exceeds MAXITER, then
;             the STATUS value is set to 5 and MPFIT returns.  
;
;             If MAXITER EQ 0, then MPFIT does not iterate to adjust
;             parameter values; however, the user function is evaluated
;             and parameter errors/covariance/Jacobian are estimated
;             before returning.
;             Default: 200 iterations
;
;   MIN_VERSION - The minimum requested version number.  This must be
;                 a scalar string of the form returned by the VERSION
;                 keyword.  If the current version of MPFIT does not
;                 satisfy the minimum requested version number, then,
;                    MPFIT(/query, min_version='...') returns 0
;                    MPFIT(...) returns NAN
;                 Default: no version number check
;                 NOTE: MIN_VERSION was added in MPFIT version 1.70
;
;   NFEV - the number of MYFUNCT function evaluations performed.
;
;   NFREE - the number of free parameters in the fit.  This includes
;           parameters which are not FIXED and not TIED, but it does
;           include parameters which are pegged at LIMITS.
;
;   NITER - the number of iterations completed.
;
;   NOCATCH - if set, then MPFIT will not perform any error trapping.
;             By default (not set), MPFIT will trap errors and report
;             them to the caller.  This keyword will typically be used
;             for debugging.
;
;   NOCOVAR - set this keyword to prevent the calculation of the
;             covariance matrix before returning (see COVAR)
;
;   NPEGGED - the number of free parameters which are pegged at a
;             LIMIT.
;
;   NPRINT - The frequency with which ITERPROC is called.  A value of
;            1 indicates that ITERPROC is called with every iteration,
;            while 2 indicates every other iteration, etc.  Be aware
;            that several Levenberg-Marquardt attempts can be made in
;            a single iteration.  Also, the ITERPROC is *always*
;            called for the final iteration, regardless of the
;            iteration number.
;            Default value: 1
;
;   PARINFO - A one-dimensional array of structures.
;             Provides a mechanism for more sophisticated constraints
;             to be placed on parameter values.  When PARINFO is not
;             passed, then it is assumed that all parameters are free
;             and unconstrained.  Values in PARINFO are never 
;             modified during a call to MPFIT.
;
;             See description above for the structure of PARINFO.
;
;             Default value:  all parameters are free and unconstrained.
;
;   PERROR - The formal 1-sigma errors in each parameter, computed
;            from the covariance matrix.  If a parameter is held
;            fixed, or if it touches a boundary, then the error is
;            reported as zero.
;
;            If the fit is unweighted (i.e. no errors were given, or
;            the weights were uniformly set to unity), then PERROR
;            will probably not represent the true parameter
;            uncertainties.  
;
;            *If* you can assume that the true reduced chi-squared
;            value is unity -- meaning that the fit is implicitly
;            assumed to be of good quality -- then the estimated
;            parameter uncertainties can be computed by scaling PERROR
;            by the measured chi-squared value.
;
;              DOF     = N_ELEMENTS(X) - N_ELEMENTS(PARMS) ; deg of freedom
;              PCERROR = PERROR * SQRT(BESTNORM / DOF)   ; scaled uncertainties
;
;   PFREE_INDEX - upon return, PFREE_INDEX contains an index array
;                 which indicates which parameter were allowed to
;                 vary.  I.e. of all the parameters PARMS, only
;                 PARMS[PFREE_INDEX] were varied.
;
;   QUERY - if set, then MPFIT() will return immediately with one of
;           the following values:
;                 1 - if MIN_VERSION is not set
;                 1 - if MIN_VERSION is set and MPFIT satisfies the minimum
;                 0 - if MIN_VERSION is set and MPFIT does not satisfy it
;           The VERSION output keyword is always set upon return.
;           Default: not set.
;
;   QUIET - set this keyword when no textual output should be printed
;           by MPFIT
;
;   RESDAMP - a scalar number, indicating the cut-off value of
;             residuals where "damping" will occur.  Residuals with
;             magnitudes greater than this number will be replaced by
;             their logarithm.  This partially mitigates the so-called
;             large residual problem inherent in least-squares solvers
;             (as for the test problem CURVI, http://www.maxthis.com/-
;             curviex.htm).  A value of 0 indicates no damping.
;             Default: 0
;
;             Note: RESDAMP doesn't work with AUTODERIV=0
;
;   STATUS - an integer status code is returned.  All values greater
;            than zero can represent success (however STATUS EQ 5 may
;            indicate failure to converge).  It can have one of the
;            following values:
;
;        -18  a fatal execution error has occurred.  More information
;             may be available in the ERRMSG string.
;
;        -16  a parameter or function value has become infinite or an
;             undefined number.  This is usually a consequence of
;             numerical overflow in the user's model function, which
;             must be avoided.
;
;        -15 to -1 
;             these are error codes that either MYFUNCT or ITERPROC
;             may return to terminate the fitting process (see
;             description of MPFIT_ERROR common below).  If either
;             MYFUNCT or ITERPROC set ERROR_CODE to a negative number,
;             then that number is returned in STATUS.  Values from -15
;             to -1 are reserved for the user functions and will not
;             clash with MPFIT.
;
;	   0  improper input parameters.
;         
;	   1  both actual and predicted relative reductions
;	      in the sum of squares are at most FTOL.
;         
;	   2  relative error between two consecutive iterates
;	      is at most XTOL
;         
;	   3  conditions for STATUS = 1 and STATUS = 2 both hold.
;         
;	   4  the cosine of the angle between fvec and any
;	      column of the jacobian is at most GTOL in
;	      absolute value.
;         
;	   5  the maximum number of iterations has been reached
;         
;	   6  FTOL is too small. no further reduction in
;	      the sum of squares is possible.
;         
;	   7  XTOL is too small. no further improvement in
;	      the approximate solution x is possible.
;         
;	   8  GTOL is too small. fvec is orthogonal to the
;	      columns of the jacobian to machine precision.
;
;          9  A successful single iteration has been completed, and
;             the user must supply another "EXTERNAL" evaluation of
;             the function and its derivatives.  This status indicator
;             is neither an error nor a convergence indicator.
;
;   VERSION - upon return, VERSION will be set to the MPFIT internal
;             version number.  The version number will be a string of
;             the form "X.Y" where X is a major revision number and Y
;             is a minor revision number.
;             NOTE: the VERSION keyword was not present before 
;               MPFIT version number 1.70, therefore, callers must 
;               use exception handling when using this keyword.
;
;   XTOL - a nonnegative input variable. Termination occurs when the
;          relative error between two consecutive iterates is at most
;          XTOL (and STATUS is accordingly set to 2 or 3).  Therefore,
;          XTOL measures the relative error desired in the approximate
;          solution.  Default: 1D-10
;
;
; EXAMPLE:
;
;   p0 = [5.7D, 2.2, 500., 1.5, 2000.]
;   fa = {X:x, Y:y, ERR:err}
;   p = mpfit('MYFUNCT', p0, functargs=fa)
;
;   Minimizes sum of squares of MYFUNCT.  MYFUNCT is called with the X,
;   Y, and ERR keyword parameters that are given by FUNCTARGS.  The
;   resulting parameter values are returned in p.
;
;
; COMMON BLOCKS:
;
;   COMMON MPFIT_ERROR, ERROR_CODE
;
;     User routines may stop the fitting process at any time by
;     setting an error condition.  This condition may be set in either
;     the user's model computation routine (MYFUNCT), or in the
;     iteration procedure (ITERPROC).
;
;     To stop the fitting, the above common block must be declared,
;     and ERROR_CODE must be set to a negative number.  After the user
;     procedure or function returns, MPFIT checks the value of this
;     common block variable and exits immediately if the error
;     condition has been set.  This value is also returned in the
;     STATUS keyword: values of -1 through -15 are reserved error
;     codes for the user routines.  By default the value of ERROR_CODE
;     is zero, indicating a successful function/procedure call.
;
;   COMMON MPFIT_PROFILE
;   COMMON MPFIT_MACHAR
;   COMMON MPFIT_CONFIG
;
;     These are undocumented common blocks are used internally by
;     MPFIT and may change in future implementations.
;
; THEORY OF OPERATION:
;
;   There are many specific strategies for function minimization.  One
;   very popular technique is to use function gradient information to
;   realize the local structure of the function.  Near a local minimum
;   the function value can be taylor expanded about x0 as follows:
;
;      f(x) = f(x0) + f'(x0) . (x-x0) + (1/2) (x-x0) . f''(x0) . (x-x0)
;             -----   ---------------   -------------------------------  (1)
;     Order    0th          1st                      2nd
;
;   Here f'(x) is the gradient vector of f at x, and f''(x) is the
;   Hessian matrix of second derivatives of f at x.  The vector x is
;   the set of function parameters, not the measured data vector.  One
;   can find the minimum of f, f(xm) using Newton's method, and
;   arrives at the following linear equation:
;
;      f''(x0) . (xm-x0) = - f'(x0)                            (2)
;
;   If an inverse can be found for f''(x0) then one can solve for
;   (xm-x0), the step vector from the current position x0 to the new
;   projected minimum.  Here the problem has been linearized (ie, the
;   gradient information is known to first order).  f''(x0) is
;   symmetric n x n matrix, and should be positive definite.
;
;   The Levenberg - Marquardt technique is a variation on this theme.
;   It adds an additional diagonal term to the equation which may aid the
;   convergence properties:
;
;      (f''(x0) + nu I) . (xm-x0) = -f'(x0)                  (2a)
;
;   where I is the identity matrix.  When nu is large, the overall
;   matrix is diagonally dominant, and the iterations follow steepest
;   descent.  When nu is small, the iterations are quadratically
;   convergent.
;
;   In principle, if f''(x0) and f'(x0) are known then xm-x0 can be
;   determined.  However the Hessian matrix is often difficult or
;   impossible to compute.  The gradient f'(x0) may be easier to
;   compute, if even by finite difference techniques.  So-called
;   quasi-Newton techniques attempt to successively estimate f''(x0)
;   by building up gradient information as the iterations proceed.
;
;   In the least squares problem there are further simplifications
;   which assist in solving eqn (2).  The function to be minimized is
;   a sum of squares:
;
;       f = Sum(hi^2)                                         (3)
;
;   where hi is the ith residual out of m residuals as described
;   above.  This can be substituted back into eqn (2) after computing
;   the derivatives:
;
;       f'  = 2 Sum(hi  hi')     
;       f'' = 2 Sum(hi' hj') + 2 Sum(hi hi'')                (4)
;
;   If one assumes that the parameters are already close enough to a
;   minimum, then one typically finds that the second term in f'' is
;   negligible [or, in any case, is too difficult to compute].  Thus,
;   equation (2) can be solved, at least approximately, using only
;   gradient information.
;
;   In matrix notation, the combination of eqns (2) and (4) becomes:
;
;        hT' . h' . dx = - hT' . h                          (5)
;
;   Where h is the residual vector (length m), hT is its transpose, h'
;   is the Jacobian matrix (dimensions n x m), and dx is (xm-x0).  The
;   user function supplies the residual vector h, and in some cases h'
;   when it is not found by finite differences (see MPFIT_FDJAC2,
;   which finds h and hT').  Even if dx is not the best absolute step
;   to take, it does provide a good estimate of the best *direction*,
;   so often a line minimization will occur along the dx vector
;   direction.
;
;   The method of solution employed by MINPACK is to form the Q . R
;   factorization of h', where Q is an orthogonal matrix such that QT .
;   Q = I, and R is upper right triangular.  Using h' = Q . R and the
;   ortogonality of Q, eqn (5) becomes
;
;        (RT . QT) . (Q . R) . dx = - (RT . QT) . h
;                     RT . R . dx = - RT . QT . h         (6)
;                          R . dx = - QT . h
;
;   where the last statement follows because R is upper triangular.
;   Here, R, QT and h are known so this is a matter of solving for dx.
;   The routine MPFIT_QRFAC provides the QR factorization of h, with
;   pivoting, and MPFIT_QRSOL;V provides the solution for dx.
;   
; REFERENCES:
;
;   Markwardt, C. B. 2008, "Non-Linear Least Squares Fitting in IDL
;     with MPFIT," in proc. Astronomical Data Analysis Software and
;     Systems XVIII, Quebec, Canada, ASP Conference Series, Vol. XXX, eds.
;     D. Bohlender, P. Dowler & D. Durand (Astronomical Society of the
;     Pacific: San Francisco), p. 251-254 (ISBN: 978-1-58381-702-5)
;       http://arxiv.org/abs/0902.2850
;       Link to NASA ADS: http://adsabs.harvard.edu/abs/2009ASPC..411..251M
;       Link to ASP: http://aspbooks.org/a/volumes/table_of_contents/411
;
;   Refer to the MPFIT website as:
;       http://purl.com/net/mpfit
;
;   MINPACK-1 software, by Jorge More' et al, available from netlib.
;     http://www.netlib.org/
;
;   "Optimization Software Guide," Jorge More' and Stephen Wright, 
;     SIAM, *Frontiers in Applied Mathematics*, Number 14.
;     (ISBN: 978-0-898713-22-0)
;
;   More', J. 1978, "The Levenberg-Marquardt Algorithm: Implementation
;     and Theory," in Numerical Analysis, vol. 630, ed. G. A. Watson
;     (Springer-Verlag: Berlin), p. 105 (DOI: 10.1007/BFb0067690 )
;
; MODIFICATION HISTORY:
;   Translated from MINPACK-1 in FORTRAN, Apr-Jul 1998, CM
;   Fixed bug in parameter limits (x vs xnew), 04 Aug 1998, CM
;   Added PERROR keyword, 04 Aug 1998, CM
;   Added COVAR keyword, 20 Aug 1998, CM
;   Added NITER output keyword, 05 Oct 1998
;      D.L Windt, Bell Labs, windt@bell-labs.com;
;   Made each PARINFO component optional, 05 Oct 1998 CM
;   Analytical derivatives allowed via AUTODERIVATIVE keyword, 09 Nov 1998
;   Parameter values can be tied to others, 09 Nov 1998
;   Fixed small bugs (Wayne Landsman), 24 Nov 1998
;   Added better exception error reporting, 24 Nov 1998 CM
;   Cosmetic documentation changes, 02 Jan 1999 CM
;   Changed definition of ITERPROC to be consistent with TNMIN, 19 Jan 1999 CM
;   Fixed bug when AUTDERIVATIVE=0.  Incorrect sign, 02 Feb 1999 CM
;   Added keyboard stop to MPFIT_DEFITER, 28 Feb 1999 CM
;   Cosmetic documentation changes, 14 May 1999 CM
;   IDL optimizations for speed & FASTNORM keyword, 15 May 1999 CM
;   Tried a faster version of mpfit_enorm, 30 May 1999 CM
;   Changed web address to cow.physics.wisc.edu, 14 Jun 1999 CM
;   Found malformation of FDJAC in MPFIT for 1 parm, 03 Aug 1999 CM
;   Factored out user-function call into MPFIT_CALL.  It is possible,
;     but currently disabled, to call procedures.  The calling format
;     is similar to CURVEFIT, 25 Sep 1999, CM
;   Slightly changed mpfit_tie to be less intrusive, 25 Sep 1999, CM
;   Fixed some bugs associated with tied parameters in mpfit_fdjac, 25
;     Sep 1999, CM
;   Reordered documentation; now alphabetical, 02 Oct 1999, CM
;   Added QUERY keyword for more robust error detection in drivers, 29
;     Oct 1999, CM
;   Documented PERROR for unweighted fits, 03 Nov 1999, CM
;   Split out MPFIT_RESETPROF to aid in profiling, 03 Nov 1999, CM
;   Some profiling and speed optimization, 03 Nov 1999, CM
;     Worst offenders, in order: fdjac2, qrfac, qrsolv, enorm.
;     fdjac2 depends on user function, qrfac and enorm seem to be
;     fully optimized.  qrsolv probably could be tweaked a little, but
;     is still <10% of total compute time.
;   Made sure that !err was set to 0 in MPFIT_DEFITER, 10 Jan 2000, CM
;   Fixed small inconsistency in setting of QANYLIM, 28 Jan 2000, CM
;   Added PARINFO field RELSTEP, 28 Jan 2000, CM
;   Converted to MPFIT_ERROR common block for indicating error
;     conditions, 28 Jan 2000, CM
;   Corrected scope of MPFIT_ERROR common block, CM, 07 Mar 2000
;   Minor speed improvement in MPFIT_ENORM, CM 26 Mar 2000
;   Corrected case where ITERPROC changed parameter values and
;     parameter values were TIED, CM 26 Mar 2000
;   Changed MPFIT_CALL to modify NFEV automatically, and to support
;     user procedures more, CM 26 Mar 2000
;   Copying permission terms have been liberalized, 26 Mar 2000, CM
;   Catch zero value of zero a(j,lj) in MPFIT_QRFAC, 20 Jul 2000, CM
;      (thanks to David Schlegel <schlegel@astro.princeton.edu>)
;   MPFIT_SETMACHAR is called only once at init; only one common block
;     is created (MPFIT_MACHAR); it is now a structure; removed almost
;     all CHECK_MATH calls for compatibility with IDL5 and !EXCEPT;
;     profiling data is now in a structure too; noted some
;     mathematical discrepancies in Linux IDL5.0, 17 Nov 2000, CM
;   Some significant changes.  New PARINFO fields: MPSIDE, MPMINSTEP,
;     MPMAXSTEP.  Improved documentation.  Now PTIED constraints are
;     maintained in the MPCONFIG common block.  A new procedure to
;     parse PARINFO fields.  FDJAC2 now computes a larger variety of
;     one-sided and two-sided finite difference derivatives.  NFEV is
;     stored in the MPCONFIG common now.  17 Dec 2000, CM
;   Added check that PARINFO and XALL have same size, 29 Dec 2000 CM
;   Don't call function in TERMINATE when there is an error, 05 Jan
;     2000
;   Check for float vs. double discrepancies; corrected implementation
;     of MIN/MAXSTEP, which I still am not sure of, but now at least
;     the correct behavior occurs *without* it, CM 08 Jan 2001
;   Added SCALE_FCN keyword, to allow for scaling, as for the CASH
;     statistic; added documentation about the theory of operation,
;     and under the QR factorization; slowly I'm beginning to
;     understand the bowels of this algorithm, CM 10 Jan 2001
;   Remove MPMINSTEP field of PARINFO, for now at least, CM 11 Jan
;     2001
;   Added RESDAMP keyword, CM, 14 Jan 2001
;   Tried to improve the DAMP handling a little, CM, 13 Mar 2001
;   Corrected .PARNAME behavior in _DEFITER, CM, 19 Mar 2001
;   Added checks for parameter and function overflow; a new STATUS
;     value to reflect this; STATUS values of -15 to -1 are reserved
;     for user function errors, CM, 03 Apr 2001
;   DAMP keyword is now a TANH, CM, 03 Apr 2001
;   Added more error checking of float vs. double, CM, 07 Apr 2001
;   Fixed bug in handling of parameter lower limits; moved overflow
;     checking to end of loop, CM, 20 Apr 2001
;   Failure using GOTO, TERMINATE more graceful if FNORM1 not defined,
;     CM, 13 Aug 2001
;   Add MPPRINT tag to PARINFO, CM, 19 Nov 2001
;   Add DOF keyword to DEFITER procedure, and print degrees of
;     freedom, CM, 28 Nov 2001
;   Add check to be sure MYFUNCT is a scalar string, CM, 14 Jan 2002
;   Addition of EXTERNAL_FJAC, EXTERNAL_FVEC keywords; ability to save
;     fitter's state from one call to the next; allow '(EXTERNAL)'
;     function name, which implies that user will supply function and
;     Jacobian at each iteration, CM, 10 Mar 2002
;   Documented EXTERNAL evaluation code, CM, 10 Mar 2002
;   Corrected signficant bug in the way that the STEP parameter, and
;     FIXED parameters interacted (Thanks Andrew Steffl), CM, 02 Apr
;     2002
;   Allow COVAR and PERROR keywords to be computed, even in case of
;     '(EXTERNAL)' function, 26 May 2002
;   Add NFREE and NPEGGED keywords; compute NPEGGED; compute DOF using
;     NFREE instead of n_elements(X), thanks to Kristian Kjaer, CM 11
;     Sep 2002
;   Hopefully PERROR is all positive now, CM 13 Sep 2002
;   Documented RELSTEP field of PARINFO (!!), CM, 25 Oct 2002
;   Error checking to detect missing start pars, CM 12 Apr 2003
;   Add DOF keyword to return degrees of freedom, CM, 30 June 2003
;   Always call ITERPROC in the final iteration; add ITERKEYSTOP
;     keyword, CM, 30 June 2003
;   Correct bug in MPFIT_LMPAR of singularity handling, which might
;     likely be fatal for one-parameter fits, CM, 21 Nov 2003
;     (with thanks to Peter Tuthill for the proper test case)
;   Minor documentation adjustment, 03 Feb 2004, CM
;   Correct small error in QR factorization when pivoting; document
;     the return values of QRFAC when pivoting, 21 May 2004, CM
;   Add MPFORMAT field to PARINFO, and correct behavior of interaction
;     between MPPRINT and PARNAME in MPFIT_DEFITERPROC (thanks to Tim
;     Robishaw), 23 May 2004, CM
;   Add the ITERPRINT keyword to allow redirecting output, 26 Sep
;     2004, CM
;   Correct MAXSTEP behavior in case of a negative parameter, 26 Sep
;     2004, CM
;   Fix bug in the parsing of MINSTEP/MAXSTEP, 10 Apr 2005, CM
;   Fix bug in the handling of upper/lower limits when the limit was
;     negative (the fitting code would never "stick" to the lower
;     limit), 29 Jun 2005, CM
;   Small documentation update for the TIED field, 05 Sep 2005, CM
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   If MAXITER equals zero, then do the basic parameter checking and
;     uncertainty analysis, but do not adjust the parameters, 15 Aug
;     2006, CM
;   Added documentation, 18 Sep 2006, CM
;   A few more IDL 5 array syntax changes, 25 Sep 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9 Oct 2006
;   Bug fix for case of MPMAXSTEP and fixed parameters, thanks
;     to Huib Intema (who found it from the Python translation!), 05 Feb 2007
;   Similar fix for MPFIT_FDJAC2 and the MPSIDE sidedness of
;     derivatives, also thanks to Huib Intema, 07 Feb 2007
;   Clarify documentation on user-function, derivatives, and PARINFO,
;     27 May 2007
;   Change the wording of "Analytic Derivatives" to "Explicit 
;     Derivatives" in the documentation, CM, 03 Sep 2007
;   Further documentation tweaks, CM, 13 Dec 2007
;   Add COMPATIBILITY section and add credits to copyright, CM, 13 Dec
;      2007
;   Document and enforce that START_PARMS and PARINFO are 1-d arrays,
;      CM, 29 Mar 2008
;   Previous change for 1-D arrays wasn't correct for
;      PARINFO.LIMITED/.LIMITS; now fixed, CM, 03 May 2008
;   Documentation adjustments, CM, 20 Aug 2008
;   Change some minor FOR-loop variables to type-long, CM, 03 Sep 2008
;   Change error handling slightly, document NOCATCH keyword,
;      document error handling in general, CM, 01 Oct 2008
;   Special case: when either LIMITS is zero, and a parameter pushes
;      against that limit, the coded that 'pegged' it there would not
;      work since it was a relative condition; now zero is handled
;      properly, CM, 08 Nov 2008
;   Documentation of how TIED interacts with LIMITS, CM, 21 Dec 2008
;   Better documentation of references, CM, 27 Feb 2009
;   If MAXITER=0, then be sure to set STATUS=5, which permits the
;      the covariance matrix to be computed, CM, 14 Apr 2009
;   Avoid numerical underflow while solving for the LM parameter,
;      (thanks to Sergey Koposov) CM, 14 Apr 2009
;   Use individual functions for all possible MPFIT_CALL permutations,
;      (and make sure the syntax is right) CM, 01 Sep 2009
;   Correct behavior of MPMAXSTEP when some parameters are frozen,
;      thanks to Josh Destree, CM, 22 Nov 2009
;   Update the references section, CM, 22 Nov 2009
;   1.70 - Add the VERSION and MIN_VERSION keywords, CM, 22 Nov 2009
;   1.71 - Store pre-calculated revision in common, CM, 23 Nov 2009
;   1.72-1.74 - Documented alternate method to compute correlation matrix,
;          CM, 05 Feb 2010
;   1.75 - Enforce TIED constraints when preparing to terminate the
;          routine, CM, 2010-06-22
;   1.76 - Documented input keywords now are not modified upon output,
;          CM, 2010-07-13
;   1.77 - Upon user request (/CALC_FJAC), compute Jacobian matrix and
;          return in BEST_FJAC; also return best residuals in
;          BEST_RESID; also return an index list of free parameters as
;          PFREE_INDEX; add a fencepost to prevent recursion
;          CM, 2010-10-27
;   1.79 - Documentation corrections.  CM, 2011-08-26
;   1.81 - Fix bug in interaction of AUTODERIVATIVE=0 and .MPSIDE=3;
;          Document FJAC_MASK. CM, 2012-05-08
;   1.83 - Trap more overflow conditions (ref. Nirmal Iyer), CM 2013-12-23
;   1.84 - More robust handling of FNORM, CM 2016-05-19
;   1.85 - Add MPFORMAT_PARNAME for explicit formatting of printed
;          parms, CM, 2017-01-03
;
;  $Id: mpfit.pro,v 1.85 2017/01/03 19:08:14 cmarkwar Exp $
;-
; Original MINPACK by More' Garbow and Hillstrom, translated with permission
; Modifications and enhancements are:
; Copyright (C) 1997-2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2017 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Reset profiling registers for another run.  By default, and when
;; uncommented, the profiling registers simply accumulate.

pro mpfit_resetprof
  COMPILE_OPT strictarr
  common mpfit_profile, mpfit_profile_vals

  mpfit_profile_vals = { status: 1L, fdjac2: 0D, lmpar: 0D, mpfit: 0D, $
                         qrfac: 0D,  qrsolv: 0D, enorm: 0D}
  return
end

;; Following are machine constants that can be loaded once.  I have
;; found that bizarre underflow messages can be produced in each call
;; to MACHAR(), so this structure minimizes the number of calls to
;; one.

pro mpfit_setmachar, double=isdouble
  COMPILE_OPT strictarr
  common mpfit_profile, profvals
  if n_elements(profvals) EQ 0 then mpfit_resetprof

  common mpfit_machar, mpfit_machar_vals

  ;; In earlier versions of IDL, MACHAR itself could produce a load of
  ;; error messages.  We try to mask some of that out here.
  if (!version.release) LT 5 then dummy = check_math(1, 1)

  mch = 0.
  mch = machar(double=keyword_set(isdouble))
  dmachep = mch.eps
  dmaxnum = mch.xmax
  dminnum = mch.xmin
  dmaxlog = alog(mch.xmax)
  dminlog = alog(mch.xmin)
  if keyword_set(isdouble) then $
    dmaxgam = 171.624376956302725D $
  else $
    dmaxgam = 171.624376956302725
  drdwarf = sqrt(dminnum*1.5) * 10
  drgiant = sqrt(dmaxnum) * 0.1

  mpfit_machar_vals = {machep: dmachep, maxnum: dmaxnum, minnum: dminnum, $
                       maxlog: dmaxlog, minlog: dminlog, maxgam: dmaxgam, $
                       rdwarf: drdwarf, rgiant: drgiant}

  if (!version.release) LT 5 then dummy = check_math(0, 0)

  return
end


; Call user function with no _EXTRA parameters
function mpfit_call_func_noextra, fcn, x, fjac, _EXTRA=extra
  if n_params() EQ 2 then begin
     return, call_function(fcn, x)
  endif else begin
     return, call_function(fcn, x, fjac)
  endelse
end

; Call user function with _EXTRA parameters
function mpfit_call_func_extra, fcn, x, fjac, _EXTRA=extra
  if n_params() EQ 2 then begin
     return, call_function(fcn, x, _EXTRA=extra)
  endif else begin
     return, call_function(fcn, x, fjac, _EXTRA=extra)
  endelse
end

; Call user procedure with no _EXTRA parameters
function mpfit_call_pro_noextra, fcn, x, fjac, _EXTRA=extra
  if n_params() EQ 2 then begin
     call_procedure, fcn, x, f
  endif else begin
     call_procedure, fcn, x, f, fjac
  endelse
  return, f
end

; Call user procedure with _EXTRA parameters
function mpfit_call_pro_extra, fcn, x, fjac, _EXTRA=extra
  if n_params() EQ 2 then begin
     call_procedure, fcn, x, f, _EXTRA=extra
  endif else begin
     call_procedure, fcn, x, f, fjac, _EXTRA=extra
  endelse
  return, f
end


;; Call user function or procedure, with _EXTRA or not, with
;; derivatives or not.
function mpfit_call, fcn, x, fjac, _EXTRA=extra

  COMPILE_OPT strictarr
  common mpfit_config, mpconfig

  if keyword_set(mpconfig.qanytied) then mpfit_tie, x, mpconfig.ptied

  ;; Decide whether we are calling a procedure or function, and 
  ;; with/without FUNCTARGS
  proname = 'MPFIT_CALL'
  proname = proname + ((mpconfig.proc) ? '_PRO' : '_FUNC')
  proname = proname + ((n_elements(extra) GT 0) ? '_EXTRA' : '_NOEXTRA')

  if n_params() EQ 2 then begin
     f = call_function(proname, fcn, x, _EXTRA=extra)
  endif else begin
     f = call_function(proname, fcn, x, fjac, _EXTRA=extra)
  endelse
  mpconfig.nfev = mpconfig.nfev + 1

  if n_params() EQ 2 AND mpconfig.damp GT 0 then begin
      damp = mpconfig.damp[0]
      
      ;; Apply the damping if requested.  This replaces the residuals
      ;; with their hyperbolic tangent.  Thus residuals larger than
      ;; DAMP are essentially clipped.
      f = tanh(f/damp)
  endif

  return, f
end

function mpfit_fdjac2, fcn, x, fvec, step, ulimited, ulimit, dside, $
                 iflag=iflag, epsfcn=epsfcn, autoderiv=autoderiv, $
                 FUNCTARGS=fcnargs, xall=xall, ifree=ifree, dstep=dstep, $
                 deriv_debug=ddebug, deriv_reltol=ddrtol, deriv_abstol=ddatol

  COMPILE_OPT strictarr
  common mpfit_machar, machvals
  common mpfit_profile, profvals
  common mpfit_error, mperr

;  prof_start = systime(1)
  MACHEP0 = machvals.machep
  DWARF   = machvals.minnum

  if n_elements(epsfcn) EQ 0 then epsfcn = MACHEP0
  if n_elements(xall)   EQ 0 then xall = x
  if n_elements(ifree)  EQ 0 then ifree = lindgen(n_elements(xall))
  if n_elements(step)   EQ 0 then step = x * 0.
  if n_elements(ddebug) EQ 0 then ddebug = intarr(n_elements(xall))
  if n_elements(ddrtol) EQ 0 then ddrtol = x * 0.
  if n_elements(ddatol) EQ 0 then ddatol = x * 0.
  has_debug_deriv = max(ddebug)

  if keyword_set(has_debug_deriv) then begin
      ;; Header for debugging
      print, 'FJAC DEBUG BEGIN'
      print, "IPNT", "FUNC", "DERIV_U", "DERIV_N", "DIFF_ABS", "DIFF_REL", $
        format='("#  ",A10," ",A10," ",A10," ",A10," ",A10," ",A10)'
  endif

  nall = n_elements(xall)

  eps = sqrt(max([epsfcn, MACHEP0]));
  m = n_elements(fvec)
  n = n_elements(x)

  ;; Compute analytical derivative if requested
  ;; Two ways to enable computation of explicit derivatives:
  ;;   1. AUTODERIVATIVE=0
  ;;   2. AUTODERIVATIVE=1, but P[i].MPSIDE EQ 3

  if keyword_set(autoderiv) EQ 0 OR max(dside[ifree] EQ 3) EQ 1 then begin
      fjac_mask = intarr(nall)
      ;; Specify which parameters need derivatives
      ;;                  ---- Case 2 ------     ----- Case 1 -----
      fjac_mask[ifree] = (dside[ifree] EQ 3) OR (keyword_set(autoderiv) EQ 0)
      if has_debug_deriv then $
        print, fjac_mask, format='("# FJAC_MASK = ",100000(I0," ",:))'

      fjac = fjac_mask  ;; Pass the mask to the calling function as FJAC
      mperr = 0
      fp = mpfit_call(fcn, xall, fjac, _EXTRA=fcnargs)
      iflag = mperr

      if n_elements(fjac) NE m*nall then begin
          message, /cont, 'ERROR: Derivative matrix was not computed properly.'
          iflag = 1
;          profvals.fdjac2 = profvals.fdjac2 + (systime(1) - prof_start)
          return, 0
      endif

      ;; This definition is consistent with CURVEFIT (WRONG, see below)
      ;; Sign error found (thanks Jesus Fernandez <fernande@irm.chu-caen.fr>)

      ;; ... and now I regret doing this sign flip since it's not
      ;; strictly correct.  The definition should be RESID =
      ;; (Y-F)/SIGMA, so d(RESID)/dP should be -dF/dP.  My response to
      ;; Fernandez was unfounded because he was trying to supply
      ;; dF/dP.  Sigh. (CM 31 Aug 2007)

      fjac = reform(-temporary(fjac), m, nall, /overwrite)

      ;; Select only the free parameters
      if n_elements(ifree) LT nall then $
        fjac = reform(fjac[*,ifree], m, n, /overwrite)
      
      ;; Are we done computing derivatives?  The answer is, YES, if we
      ;; computed explicit derivatives for all free parameters, EXCEPT
      ;; when we are going on to compute debugging derivatives.
      if min(fjac_mask[ifree]) EQ 1 AND NOT has_debug_deriv then begin
          return, fjac
      endif
  endif

  ;; Final output array, if it was not already created above
  if n_elements(fjac) EQ 0 then begin
      fjac = make_array(m, n, value=fvec[0]*0.)
      fjac = reform(fjac, m, n, /overwrite)
  endif

  h = eps * abs(x)

  ;; if STEP is given, use that
  ;; STEP includes the fixed parameters
  if n_elements(step) GT 0 then begin
      stepi = step[ifree]
      wh = where(stepi GT 0, ct)
      if ct GT 0 then h[wh] = stepi[wh]
  endif

  ;; if relative step is given, use that
  ;; DSTEP includes the fixed parameters
  if n_elements(dstep) GT 0 then begin
      dstepi = dstep[ifree]
      wh = where(dstepi GT 0, ct)
      if ct GT 0 then h[wh] = abs(dstepi[wh]*x[wh])
  endif

  ;; In case any of the step values are zero
  wh = where(h EQ 0, ct)
  if ct GT 0 then h[wh] = eps

  ;; Reverse the sign of the step if we are up against the parameter
  ;; limit, or if the user requested it.
  ;; DSIDE includes the fixed parameters (ULIMITED/ULIMIT have only
  ;; varying ones)
  mask = dside[ifree] EQ -1
  if n_elements(ulimited) GT 0 AND n_elements(ulimit) GT 0 then $
    mask = mask OR (ulimited AND (x GT ulimit-h))
  wh = where(mask, ct)
  if ct GT 0 then h[wh] = -h[wh]

  ;; Loop through parameters, computing the derivative for each
  for j=0L, n-1 do begin
      dsidej = dside[ifree[j]]
      ddebugj = ddebug[ifree[j]]

      ;; Skip this parameter if we already computed its derivative
      ;; explicitly, and we are not debugging.
      if (dsidej EQ 3) AND (ddebugj EQ 0) then continue
      if (dsidej EQ 3) AND (ddebugj EQ 1) then $
        print, ifree[j], format='("FJAC PARM ",I0)'

      xp = xall
      xp[ifree[j]] = xp[ifree[j]] + h[j]
      
      mperr = 0
      fp = mpfit_call(fcn, xp, _EXTRA=fcnargs)
      
      iflag = mperr
      if iflag LT 0 then return, !values.d_nan

      if ((dsidej GE -1) AND (dsidej LE 1)) OR (dsidej EQ 3) then begin
          ;; COMPUTE THE ONE-SIDED DERIVATIVE
          ;; Note optimization fjac(0:*,j)
          fjacj = (fp-fvec)/h[j]

      endif else begin
          ;; COMPUTE THE TWO-SIDED DERIVATIVE
          xp[ifree[j]] = xall[ifree[j]] - h[j]

          mperr = 0
          fm = mpfit_call(fcn, xp, _EXTRA=fcnargs)
          
          iflag = mperr
          if iflag LT 0 then return, !values.d_nan
          
          ;; Note optimization fjac(0:*,j)
          fjacj = (fp-fm)/(2*h[j])
      endelse          
      
      ;; Debugging of explicit derivatives
      if (dsidej EQ 3) AND (ddebugj EQ 1) then begin
          ;; Relative and absolute tolerances
          dr = ddrtol[ifree[j]] & da = ddatol[ifree[j]]

          ;; Explicitly calculated
          fjaco = fjac[*,j]
          
          ;; If tolerances are zero, then any value for deriv triggers print...
          if (da EQ 0 AND dr EQ 0) then $
            diffj = (fjaco NE 0 OR fjacj NE 0)
          ;; ... otherwise the difference must be a greater than tolerance
          if (da NE 0 OR dr NE 0) then $
            diffj = (abs(fjaco-fjacj) GT (da+abs(fjaco)*dr))

          for k = 0L, m-1 do if diffj[k] then begin
              print, k, fvec[k], fjaco[k], fjacj[k], fjaco[k]-fjacj[k], $
                (fjaco[k] EQ 0)?(0):((fjaco[k]-fjacj[k])/fjaco[k]), $
                format='("   ",I10," ",G10.4," ",G10.4," ",G10.4," ",G10.4," ",G10.4)'
          endif
      endif

      ;; Store final results in output array
      fjac[0,j] = fjacj
          
  endfor

  if has_debug_deriv then print, 'FJAC DEBUG END'

;  profvals.fdjac2 = profvals.fdjac2 + (systime(1) - prof_start)
  return, fjac
end

function mpfit_enorm, vec

  COMPILE_OPT strictarr
  ;; NOTE: it turns out that, for systems that have a lot of data
  ;; points, this routine is a big computing bottleneck.  The extended
  ;; computations that need to be done cannot be effectively
  ;; vectorized.  The introduction of the FASTNORM configuration
  ;; parameter allows the user to select a faster routine, which is 
  ;; based on TOTAL() alone.
  common mpfit_profile, profvals
;  prof_start = systime(1)

  common mpfit_config, mpconfig
; Very simple-minded sum-of-squares
  if n_elements(mpconfig) GT 0 then if mpconfig.fastnorm then begin
      ans = sqrt(total(vec^2))
      goto, TERMINATE
  endif

  common mpfit_machar, machvals

  agiant = machvals.rgiant / n_elements(vec)
  adwarf = machvals.rdwarf * n_elements(vec)

  ;; This is hopefully a compromise between speed and robustness.
  ;; Need to do this because of the possibility of over- or underflow.
  mx = max(vec, min=mn)
  mx = max(abs([mx,mn]))
  if mx EQ 0 then return, vec[0]*0.

  if mx GT agiant OR mx LT adwarf then ans = mx * sqrt(total((vec/mx)^2))$
  else                                 ans = sqrt( total(vec^2) )

  TERMINATE:
;  profvals.enorm = profvals.enorm + (systime(1) - prof_start)
  return, ans
end

;     **********
;
;     subroutine qrfac
;
;     this subroutine uses householder transformations with column
;     pivoting (optional) to compute a qr factorization of the
;     m by n matrix a. that is, qrfac determines an orthogonal
;     matrix q, a permutation matrix p, and an upper trapezoidal
;     matrix r with diagonal elements of nonincreasing magnitude,
;     such that a*p = q*r. the householder transformation for
;     column k, k = 1,2,...,min(m,n), is of the form
;
;			    t
;	    i - (1/u(k))*u*u
;
;     where u has zeros in the first k-1 positions. the form of
;     this transformation and the method of pivoting first
;     appeared in the corresponding linpack subroutine.
;
;     the subroutine statement is
;
;	subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa)
;
;     where
;
;	m is a positive integer input variable set to the number
;	  of rows of a.
;
;	n is a positive integer input variable set to the number
;	  of columns of a.
;
;	a is an m by n array. on input a contains the matrix for
;	  which the qr factorization is to be computed. on output
;	  the strict upper trapezoidal part of a contains the strict
;	  upper trapezoidal part of r, and the lower trapezoidal
;	  part of a contains a factored form of q (the non-trivial
;	  elements of the u vectors described above).
;
;	lda is a positive integer input variable not less than m
;	  which specifies the leading dimension of the array a.
;
;	pivot is a logical input variable. if pivot is set true,
;	  then column pivoting is enforced. if pivot is set false,
;	  then no column pivoting is done.
;
;	ipvt is an integer output array of length lipvt. ipvt
;	  defines the permutation matrix p such that a*p = q*r.
;	  column j of p is column ipvt(j) of the identity matrix.
;	  if pivot is false, ipvt is not referenced.
;
;	lipvt is a positive integer input variable. if pivot is false,
;	  then lipvt may be as small as 1. if pivot is true, then
;	  lipvt must be at least n.
;
;	rdiag is an output array of length n which contains the
;	  diagonal elements of r.
;
;	acnorm is an output array of length n which contains the
;	  norms of the corresponding columns of the input matrix a.
;	  if this information is not needed, then acnorm can coincide
;	  with rdiag.
;
;	wa is a work array of length n. if pivot is false, then wa
;	  can coincide with rdiag.
;
;     subprograms called
;
;	minpack-supplied ... dpmpar,enorm
;
;	fortran-supplied ... dmax1,dsqrt,min0
;
;     argonne national laboratory. minpack project. march 1980.
;     burton s. garbow, kenneth e. hillstrom, jorge j. more
;
;     **********
;
; PIVOTING / PERMUTING:
;
; Upon return, A(*,*) is in standard parameter order, A(*,IPVT) is in
; permuted order.
;
; RDIAG is in permuted order.
;
; ACNORM is in standard parameter order.
;
; NOTE: in IDL the factors appear slightly differently than described
; above.  The matrix A is still m x n where m >= n.  
;
; The "upper" triangular matrix R is actually stored in the strict
; lower left triangle of A under the standard notation of IDL.
;
; The reflectors that generate Q are in the upper trapezoid of A upon
; output.
;
;  EXAMPLE:  decompose the matrix [[9.,2.,6.],[4.,8.,7.]]
;    aa = [[9.,2.,6.],[4.,8.,7.]]
;    mpfit_qrfac, aa, aapvt, rdiag, aanorm
;     IDL> print, aa
;          1.81818*     0.181818*     0.545455*
;         -8.54545+      1.90160*     0.432573*
;     IDL> print, rdiag
;         -11.0000+     -7.48166+
;
; The components marked with a * are the components of the
; reflectors, and those marked with a + are components of R.
;
; To reconstruct Q and R we proceed as follows.  First R.
;    r = fltarr(m, n)
;    for i = 0, n-1 do r(0:i,i) = aa(0:i,i)  ; fill in lower diag
;    r(lindgen(n)*(m+1)) = rdiag
;
; Next, Q, which are composed from the reflectors.  Each reflector v
; is taken from the upper trapezoid of aa, and converted to a matrix
; via (I - 2 vT . v / (v . vT)).
;
;   hh = ident                                    ;; identity matrix
;   for i = 0, n-1 do begin
;    v = aa(*,i) & if i GT 0 then v(0:i-1) = 0    ;; extract reflector
;    hh = hh ## (ident - 2*(v # v)/total(v * v))  ;; generate matrix
;   endfor
;
; Test the result:
;    IDL> print, hh ## transpose(r)
;          9.00000      4.00000
;          2.00000      8.00000
;          6.00000      7.00000
;
; Note that it is usually never necessary to form the Q matrix
; explicitly, and MPFIT does not.

pro mpfit_qrfac, a, ipvt, rdiag, acnorm, pivot=pivot

  COMPILE_OPT strictarr
  sz = size(a)
  m = sz[1]
  n = sz[2]

  common mpfit_machar, machvals
  common mpfit_profile, profvals
;  prof_start = systime(1)

  MACHEP0 = machvals.machep
  DWARF   = machvals.minnum
  
  ;; Compute the initial column norms and initialize arrays
  acnorm = make_array(n, value=a[0]*0.)
  for j = 0L, n-1 do $
    acnorm[j] = mpfit_enorm(a[*,j])
  rdiag = acnorm
  wa = rdiag
  ipvt = lindgen(n)

  ;; Reduce a to r with householder transformations
  minmn = min([m,n])
  for j = 0L, minmn-1 do begin
      if NOT keyword_set(pivot) then goto, HOUSE1
      
      ;; Bring the column of largest norm into the pivot position
      rmax = max(rdiag[j:*])
      kmax = where(rdiag[j:*] EQ rmax, ct) + j
      if ct LE 0 then goto, HOUSE1
      kmax = kmax[0]
      
      ;; Exchange rows via the pivot only.  Avoid actually exchanging
      ;; the rows, in case there is lots of memory transfer.  The
      ;; exchange occurs later, within the body of MPFIT, after the
      ;; extraneous columns of the matrix have been shed.
      if kmax NE j then begin
          temp     = ipvt[j]   & ipvt[j]    = ipvt[kmax] & ipvt[kmax]  = temp
          rdiag[kmax] = rdiag[j]
          wa[kmax]    = wa[j]
      endif
      
      HOUSE1:

      ;; Compute the householder transformation to reduce the jth
      ;; column of A to a multiple of the jth unit vector
      lj     = ipvt[j]
      ajj    = a[j:*,lj]
      ajnorm = mpfit_enorm(ajj)
      if ajnorm EQ 0 then goto, NEXT_ROW
      if a[j,lj] LT 0 then ajnorm = -ajnorm
      
      ajj     = ajj / ajnorm
      ajj[0]  = ajj[0] + 1
      ;; *** Note optimization a(j:*,j)
      a[j,lj] = ajj
      
      ;; Apply the transformation to the remaining columns
      ;; and update the norms

      ;; NOTE to SELF: tried to optimize this by removing the loop,
      ;; but it actually got slower.  Reverted to "for" loop to keep
      ;; it simple.
      if j+1 LT n then begin
          for k=j+1, n-1 do begin
              lk = ipvt[k]
              ajk = a[j:*,lk]
              ;; *** Note optimization a(j:*,lk) 
              ;; (corrected 20 Jul 2000)
              if a[j,lj] NE 0 then $
                a[j,lk] = ajk - ajj * total(ajk*ajj)/a[j,lj]

              if keyword_set(pivot) AND rdiag[k] NE 0 then begin
                  temp = a[j,lk]/rdiag[k]
                  rdiag[k] = rdiag[k] * sqrt((1.-temp^2) > 0)
                  temp = rdiag[k]/wa[k]
                  if 0.05D*temp*temp LE MACHEP0 then begin
                      rdiag[k] = mpfit_enorm(a[j+1:*,lk])
                      wa[k] = rdiag[k]
                  endif
              endif
          endfor
      endif

      NEXT_ROW:
      rdiag[j] = -ajnorm
  endfor

;  profvals.qrfac = profvals.qrfac + (systime(1) - prof_start)
  return
end

;     **********
;
;     subroutine qrsolv
;
;     given an m by n matrix a, an n by n diagonal matrix d,
;     and an m-vector b, the problem is to determine an x which
;     solves the system
;
;           a*x = b ,     d*x = 0 ,
;
;     in the least squares sense.
;
;     this subroutine completes the solution of the problem
;     if it is provided with the necessary information from the
;     qr factorization, with column pivoting, of a. that is, if
;     a*p = q*r, where p is a permutation matrix, q has orthogonal
;     columns, and r is an upper triangular matrix with diagonal
;     elements of nonincreasing magnitude, then qrsolv expects
;     the full upper triangle of r, the permutation matrix p,
;     and the first n components of (q transpose)*b. the system
;     a*x = b, d*x = 0, is then equivalent to
;
;                  t       t
;           r*z = q *b ,  p *d*p*z = 0 ,
;
;     where x = p*z. if this system does not have full rank,
;     then a least squares solution is obtained. on output qrsolv
;     also provides an upper triangular matrix s such that
;
;            t   t               t
;           p *(a *a + d*d)*p = s *s .
;
;     s is computed within qrsolv and may be of separate interest.
;
;     the subroutine statement is
;
;       subroutine qrsolv(n,r,ldr,ipvt,diag,qtb,x,sdiag,wa)
;
;     where
;
;       n is a positive integer input variable set to the order of r.
;
;       r is an n by n array. on input the full upper triangle
;         must contain the full upper triangle of the matrix r.
;         on output the full upper triangle is unaltered, and the
;         strict lower triangle contains the strict upper triangle
;         (transposed) of the upper triangular matrix s.
;
;       ldr is a positive integer input variable not less than n
;         which specifies the leading dimension of the array r.
;
;       ipvt is an integer input array of length n which defines the
;         permutation matrix p such that a*p = q*r. column j of p
;         is column ipvt(j) of the identity matrix.
;
;       diag is an input array of length n which must contain the
;         diagonal elements of the matrix d.
;
;       qtb is an input array of length n which must contain the first
;         n elements of the vector (q transpose)*b.
;
;       x is an output array of length n which contains the least
;         squares solution of the system a*x = b, d*x = 0.
;
;       sdiag is an output array of length n which contains the
;         diagonal elements of the upper triangular matrix s.
;
;       wa is a work array of length n.
;
;     subprograms called
;
;       fortran-supplied ... dabs,dsqrt
;
;     argonne national laboratory. minpack project. march 1980.
;     burton s. garbow, kenneth e. hillstrom, jorge j. more
;
pro mpfit_qrsolv, r, ipvt, diag, qtb, x, sdiag

  COMPILE_OPT strictarr
  sz = size(r)
  m = sz[1]
  n = sz[2]
  delm = lindgen(n) * (m+1) ;; Diagonal elements of r

  common mpfit_profile, profvals
;  prof_start = systime(1)

  ;; copy r and (q transpose)*b to preserve input and initialize s.
  ;; in particular, save the diagonal elements of r in x.

  for j = 0L, n-1 do $
    r[j:n-1,j] = r[j,j:n-1]
  x = r[delm]
  wa = qtb
  ;; Below may look strange, but it's so we can keep the right precision
  zero = qtb[0]*0.
  half = zero + 0.5
  quart = zero + 0.25

  ;; Eliminate the diagonal matrix d using a givens rotation
  for j = 0L, n-1 do begin
      l = ipvt[j]
      if diag[l] EQ 0 then goto, STORE_RESTORE
      sdiag[j:*] = 0
      sdiag[j] = diag[l]

      ;; The transformations to eliminate the row of d modify only a
      ;; single element of (q transpose)*b beyond the first n, which
      ;; is initially zero.

      qtbpj = zero
      for k = j, n-1 do begin
          if sdiag[k] EQ 0 then goto, ELIM_NEXT_LOOP
          if abs(r[k,k]) LT abs(sdiag[k]) then begin
              cotan  = r[k,k]/sdiag[k]
              sine   = half/sqrt(quart + quart*cotan*cotan)
              cosine = sine*cotan
          endif else begin
              tang   = sdiag[k]/r[k,k]
              cosine = half/sqrt(quart + quart*tang*tang)
              sine   = cosine*tang
          endelse
          
          ;; Compute the modified diagonal element of r and the
          ;; modified element of ((q transpose)*b,0).
          r[k,k] = cosine*r[k,k] + sine*sdiag[k]
          temp = cosine*wa[k] + sine*qtbpj
          qtbpj = -sine*wa[k] + cosine*qtbpj
          wa[k] = temp

          ;; Accumulate the transformation in the row of s
          if n GT k+1 then begin
              temp = cosine*r[k+1:n-1,k] + sine*sdiag[k+1:n-1]
              sdiag[k+1:n-1] = -sine*r[k+1:n-1,k] + cosine*sdiag[k+1:n-1]
              r[k+1:n-1,k] = temp
          endif
ELIM_NEXT_LOOP:
      endfor

STORE_RESTORE:
      sdiag[j] = r[j,j]
      r[j,j] = x[j]
  endfor

  ;; Solve the triangular system for z.  If the system is singular
  ;; then obtain a least squares solution
  nsing = n
  wh = where(sdiag EQ 0, ct)
  if ct GT 0 then begin
      nsing = wh[0]
      wa[nsing:*] = 0
  endif

  if nsing GE 1 then begin
      wa[nsing-1] = wa[nsing-1]/sdiag[nsing-1] ;; Degenerate case
      ;; *** Reverse loop ***
      for j=nsing-2,0,-1 do begin  
          sum = total(r[j+1:nsing-1,j]*wa[j+1:nsing-1])
          wa[j] = (wa[j]-sum)/sdiag[j]
      endfor
  endif

  ;; Permute the components of z back to components of x
  x[ipvt] = wa

;  profvals.qrsolv = profvals.qrsolv + (systime(1) - prof_start)
  return
end
      
  
;
;     subroutine lmpar
;
;     given an m by n matrix a, an n by n nonsingular diagonal
;     matrix d, an m-vector b, and a positive number delta,
;     the problem is to determine a value for the parameter
;     par such that if x solves the system
;
;	    a*x = b ,	  sqrt(par)*d*x = 0 ,
;
;     in the least squares sense, and dxnorm is the euclidean
;     norm of d*x, then either par is zero and
;
;	    (dxnorm-delta) .le. 0.1*delta ,
;
;     or par is positive and
;
;	    abs(dxnorm-delta) .le. 0.1*delta .
;
;     this subroutine completes the solution of the problem
;     if it is provided with the necessary information from the
;     qr factorization, with column pivoting, of a. that is, if
;     a*p = q*r, where p is a permutation matrix, q has orthogonal
;     columns, and r is an upper triangular matrix with diagonal
;     elements of nonincreasing magnitude, then lmpar expects
;     the full upper triangle of r, the permutation matrix p,
;     and the first n components of (q transpose)*b. on output
;     lmpar also provides an upper triangular matrix s such that
;
;	     t	 t		     t
;	    p *(a *a + par*d*d)*p = s *s .
;
;     s is employed within lmpar and may be of separate interest.
;
;     only a few iterations are generally needed for convergence
;     of the algorithm. if, however, the limit of 10 iterations
;     is reached, then the output par will contain the best
;     value obtained so far.
;
;     the subroutine statement is
;
;	subroutine lmpar(n,r,ldr,ipvt,diag,qtb,delta,par,x,sdiag,
;			 wa1,wa2)
;
;     where
;
;	n is a positive integer input variable set to the order of r.
;
;	r is an n by n array. on input the full upper triangle
;	  must contain the full upper triangle of the matrix r.
;	  on output the full upper triangle is unaltered, and the
;	  strict lower triangle contains the strict upper triangle
;	  (transposed) of the upper triangular matrix s.
;
;	ldr is a positive integer input variable not less than n
;	  which specifies the leading dimension of the array r.
;
;	ipvt is an integer input array of length n which defines the
;	  permutation matrix p such that a*p = q*r. column j of p
;	  is column ipvt(j) of the identity matrix.
;
;	diag is an input array of length n which must contain the
;	  diagonal elements of the matrix d.
;
;	qtb is an input array of length n which must contain the first
;	  n elements of the vector (q transpose)*b.
;
;	delta is a positive input variable which specifies an upper
;	  bound on the euclidean norm of d*x.
;
;	par is a nonnegative variable. on input par contains an
;	  initial estimate of the levenberg-marquardt parameter.
;	  on output par contains the final estimate.
;
;	x is an output array of length n which contains the least
;	  squares solution of the system a*x = b, sqrt(par)*d*x = 0,
;	  for the output par.
;
;	sdiag is an output array of length n which contains the
;	  diagonal elements of the upper triangular matrix s.
;
;	wa1 and wa2 are work arrays of length n.
;
;     subprograms called
;
;	minpack-supplied ... dpmpar,enorm,qrsolv
;
;	fortran-supplied ... dabs,dmax1,dmin1,dsqrt
;
;     argonne national laboratory. minpack project. march 1980.
;     burton s. garbow, kenneth e. hillstrom, jorge j. more
;
function mpfit_lmpar, r, ipvt, diag, qtb, delta, x, sdiag, par=par

  COMPILE_OPT strictarr
  common mpfit_machar, machvals
  common mpfit_profile, profvals
;  prof_start = systime(1)

  MACHEP0 = machvals.machep
  DWARF   = machvals.minnum

  sz = size(r)
  m = sz[1]
  n = sz[2]
  delm = lindgen(n) * (m+1) ;; Diagonal elements of r

  ;; Compute and store in x the gauss-newton direction.  If the
  ;; jacobian is rank-deficient, obtain a least-squares solution
  nsing = n
  wa1 = qtb
  rthresh = max(abs(r[delm]))*MACHEP0
  wh = where(abs(r[delm]) LT rthresh, ct)
  if ct GT 0 then begin
      nsing = wh[0]
      wa1[wh[0]:*] = 0
  endif

  if nsing GE 1 then begin
      ;; *** Reverse loop ***
      for j=nsing-1,0,-1 do begin  
          wa1[j] = wa1[j]/r[j,j]
          if (j-1 GE 0) then $
            wa1[0:(j-1)] = wa1[0:(j-1)] - r[0:(j-1),j]*wa1[j]
      endfor
  endif

  ;; Note: ipvt here is a permutation array
  x[ipvt] = wa1

  ;; Initialize the iteration counter.  Evaluate the function at the
  ;; origin, and test for acceptance of the gauss-newton direction
  iter = 0L
  wa2 = diag * x
  dxnorm = mpfit_enorm(wa2)
  fp = dxnorm - delta
  if fp LE 0.1*delta then goto, TERMINATE

  ;; If the jacobian is not rank deficient, the newton step provides a
  ;; lower bound, parl, for the zero of the function.  Otherwise set
  ;; this bound to zero.
  
  zero = wa2[0]*0.
  parl = zero
  if nsing GE n then begin
      wa1 = diag[ipvt]*wa2[ipvt]/dxnorm

      wa1[0] = wa1[0] / r[0,0] ;; Degenerate case 
      for j=1L, n-1 do begin   ;; Note "1" here, not zero
          sum = total(r[0:(j-1),j]*wa1[0:(j-1)])
          wa1[j] = (wa1[j] - sum)/r[j,j]
      endfor

      temp = mpfit_enorm(wa1)
      parl = ((fp/delta)/temp)/temp
  endif

  ;; Calculate an upper bound, paru, for the zero of the function
  for j=0L, n-1 do begin
      sum = total(r[0:j,j]*qtb[0:j])
      wa1[j] = sum/diag[ipvt[j]]
  endfor
  gnorm = mpfit_enorm(wa1)
  paru  = gnorm/delta
  if paru EQ 0 then paru = DWARF/min([delta,0.1])

  ;; If the input par lies outside of the interval (parl,paru), set
  ;; par to the closer endpoint

  par = max([par,parl])
  par = min([par,paru])
  if par EQ 0 then par = gnorm/dxnorm

  ;; Beginning of an interation
  ITERATION:
  iter = iter + 1
  
  ;; Evaluate the function at the current value of par
  if par EQ 0 then par = max([DWARF, paru*0.001])
  temp = sqrt(par)
  wa1 = temp * diag
  mpfit_qrsolv, r, ipvt, wa1, qtb, x, sdiag
  wa2 = diag*x
  dxnorm = mpfit_enorm(wa2)
  temp = fp
  fp = dxnorm - delta

  if (abs(fp) LE 0.1D*delta) $
    OR ((parl EQ 0) AND (fp LE temp) AND (temp LT 0)) $
    OR (iter EQ 10) then goto, TERMINATE

  ;; Compute the newton correction
  wa1 = diag[ipvt]*wa2[ipvt]/dxnorm

  for j=0L,n-2 do begin
      wa1[j] = wa1[j]/sdiag[j]
      wa1[j+1:n-1] = wa1[j+1:n-1] - r[j+1:n-1,j]*wa1[j]
  endfor
  wa1[n-1] = wa1[n-1]/sdiag[n-1] ;; Degenerate case

  temp = mpfit_enorm(wa1)
  parc = ((fp/delta)/temp)/temp

  ;; Depending on the sign of the function, update parl or paru
  if fp GT 0 then parl = max([parl,par])
  if fp LT 0 then paru = min([paru,par])

  ;; Compute an improved estimate for par
  par = max([parl, par+parc])

  ;; End of an iteration
  goto, ITERATION
  
TERMINATE:
  ;; Termination
;  profvals.lmpar = profvals.lmpar + (systime(1) - prof_start)
  if iter EQ 0 then return, par[0]*0.
  return, par
end

;; Procedure to tie one parameter to another.
pro mpfit_tie, p, _ptied
  COMPILE_OPT strictarr
  if n_elements(_ptied) EQ 0 then return
  if n_elements(_ptied) EQ 1 then if _ptied[0] EQ '' then return
  for _i = 0L, n_elements(_ptied)-1 do begin
      if _ptied[_i] EQ '' then goto, NEXT_TIE
      _cmd = 'p['+strtrim(_i,2)+'] = '+_ptied[_i]
      _err = execute(_cmd)
      if _err EQ 0 then begin
          message, 'ERROR: Tied expression "'+_cmd+'" failed.'
          return
      endif
      NEXT_TIE:
  endfor
end

;; Default print procedure
pro mpfit_defprint, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, $
                    p11, p12, p13, p14, p15, p16, p17, p18, $
                    format=format, unit=unit0, _EXTRA=extra

  COMPILE_OPT strictarr
  if n_elements(unit0) EQ 0 then unit = -1 else unit = round(unit0[0])
  if n_params() EQ 0 then printf, unit, '' $
  else if n_params() EQ 1 then printf, unit, p1, format=format $
  else if n_params() EQ 2 then printf, unit, p1, p2, format=format $
  else if n_params() EQ 3 then printf, unit, p1, p2, p3, format=format $
  else if n_params() EQ 4 then printf, unit, p1, p2, p4, format=format 

  return
end


;; Default procedure to be called every iteration.  It simply prints
;; the parameter values.
pro mpfit_defiter, fcn, x, iter, fnorm, FUNCTARGS=fcnargs, $
                   quiet=quiet, iterstop=iterstop, iterkeybyte=iterkeybyte, $
                   parinfo=parinfo, iterprint=iterprint0, $
                   format=fmt, pformat=pformat, dof=dof0, $
                   iterparnameformat=iterparnameformat0, $
                   _EXTRA=iterargs

  COMPILE_OPT strictarr
  common mpfit_error, mperr
  mperr = 0

  if keyword_set(quiet) then goto, DO_ITERSTOP
  if n_params() EQ 3 then begin
      fvec = mpfit_call(fcn, x, _EXTRA=fcnargs)
      fnorm = mpfit_enorm(fvec)^2
  endif

  ;; Determine which parameters to print
  nprint = n_elements(x)
  iprint = lindgen(nprint)

  if n_elements(iterprint0) EQ 0 then iterprint = 'MPFIT_DEFPRINT' $
  else iterprint = strtrim(iterprint0[0],2)
  if n_elements(iterparnameformat0) EQ 0 then iterparnameformat = 'A25' $
  else iterparnameformat = iterparnameformat0

  if n_elements(dof0) EQ 0 then dof = 1L else dof = floor(dof0[0])
  call_procedure, iterprint, iter, fnorm, dof, $
    format='("Iter ",I6,"   CHI-SQUARE = ",G15.8,"          DOF = ",I0)', $
    _EXTRA=iterargs
  if n_elements(fmt) GT 0 then begin
      call_procedure, iterprint, x, format=fmt, _EXTRA=iterargs
  endif else begin
      if n_elements(pformat) EQ 0 then pformat = '(G20.6)'
      parname = 'P('+strtrim(iprint,2)+')'
      parnamefmt = strarr(nprint) + iterparnameformat
      pformats = strarr(nprint) + pformat
      pardesc = strarr(nprint)

      if n_elements(parinfo) GT 0 then begin
          parinfo_tags = tag_names(parinfo)
          wh = where(parinfo_tags EQ 'PARNAME', ct)
          if ct EQ 1 then begin
              wh = where(parinfo.parname NE '', ct)
              if ct GT 0 then $
                parname[wh] = parinfo[wh].parname
          endif
          wh = where(parinfo_tags EQ 'MPPRINT', ct)
          if ct EQ 1 then begin
              iprint = where(parinfo.mpprint EQ 1, nprint)
              if nprint EQ 0 then goto, DO_ITERSTOP
          endif
          wh = where(parinfo_tags EQ 'MPFORMAT', ct)
          if ct EQ 1 then begin
              wh = where(parinfo.mpformat NE '', ct)
              if ct GT 0 then pformats[wh] = parinfo[wh].mpformat
          endif
          wh = where(parinfo_tags EQ 'MPFORMAT_PARNAME', ct)
          if ct EQ 1 then begin
              wh = where(parinfo.mpformat_parname NE '', ct)
              if ct GT 0 then parnamefmt[wh] = parinfo[wh].mpformat_parname
          endif
      endif

      for i = 0L, nprint-1 do begin
          call_procedure, iterprint, parname[iprint[i]], x[iprint[i]], $
            format='("    ",'+parnamefmt[i]+'," = ",'+pformats[iprint[i]]+')', $
            _EXTRA=iterargs
      endfor
  endelse

  DO_ITERSTOP:
  if n_elements(iterkeybyte) EQ 0 then iterkeybyte = 7b
  if keyword_set(iterstop) then begin
      k = get_kbrd(0)
      if k EQ string(iterkeybyte[0]) then begin
          message, 'WARNING: minimization not complete', /info
          print, 'Do you want to terminate this procedure? (y/n)', $
            format='(A,$)'
          k = ''
          read, k
          if strupcase(strmid(k,0,1)) EQ 'Y' then begin
              message, 'WARNING: Procedure is terminating.', /info
              mperr = -1
          endif
      endif
  endif

  return
end

;; Procedure to parse the parameter values in PARINFO
pro mpfit_parinfo, parinfo, tnames, tag, values, default=def, status=status, $
                   n_param=n

  COMPILE_OPT strictarr
  status = 0
  if n_elements(n) EQ 0 then n = n_elements(parinfo)

  if n EQ 0 then begin
      if n_elements(def) EQ 0 then return
      values = def
      status = 1
      return
  endif

  if n_elements(parinfo) EQ 0 then goto, DO_DEFAULT
  if n_elements(tnames) EQ 0 then tnames = tag_names(parinfo)
  wh = where(tnames EQ tag, ct)

  if ct EQ 0 then begin
      DO_DEFAULT:
      if n_elements(def) EQ 0 then return
      values = make_array(n, value=def[0])
      values[0] = def
  endif else begin
      values = parinfo.(wh[0])
      np = n_elements(parinfo)
      nv = n_elements(values)
      values = reform(values[*], nv/np, np)
  endelse

  status = 1
  return
end


;     **********
;
;     subroutine covar
;
;     given an m by n matrix a, the problem is to determine
;     the covariance matrix corresponding to a, defined as
;
;                    t
;           inverse(a *a) .
;
;     this subroutine completes the solution of the problem
;     if it is provided with the necessary information from the
;     qr factorization, with column pivoting, of a. that is, if
;     a*p = q*r, where p is a permutation matrix, q has orthogonal
;     columns, and r is an upper triangular matrix with diagonal
;     elements of nonincreasing magnitude, then covar expects
;     the full upper triangle of r and the permutation matrix p.
;     the covariance matrix is then computed as
;
;                      t     t
;           p*inverse(r *r)*p  .
;
;     if a is nearly rank deficient, it may be desirable to compute
;     the covariance matrix corresponding to the linearly independent
;     columns of a. to define the numerical rank of a, covar uses
;     the tolerance tol. if l is the largest integer such that
;
;           abs(r(l,l)) .gt. tol*abs(r(1,1)) ,
;
;     then covar computes the covariance matrix corresponding to
;     the first l columns of r. for k greater than l, column
;     and row ipvt(k) of the covariance matrix are set to zero.
;
;     the subroutine statement is
;
;       subroutine covar(n,r,ldr,ipvt,tol,wa)
;
;     where
;
;       n is a positive integer input variable set to the order of r.
;
;       r is an n by n array. on input the full upper triangle must
;         contain the full upper triangle of the matrix r. on output
;         r contains the square symmetric covariance matrix.
;
;       ldr is a positive integer input variable not less than n
;         which specifies the leading dimension of the array r.
;
;       ipvt is an integer input array of length n which defines the
;         permutation matrix p such that a*p = q*r. column j of p
;         is column ipvt(j) of the identity matrix.
;
;       tol is a nonnegative input variable used to define the
;         numerical rank of a in the manner described above.
;
;       wa is a work array of length n.
;
;     subprograms called
;
;       fortran-supplied ... dabs
;
;     argonne national laboratory. minpack project. august 1980.
;     burton s. garbow, kenneth e. hillstrom, jorge j. more
;
;     **********
function mpfit_covar, rr, ipvt, tol=tol

  COMPILE_OPT strictarr
  sz = size(rr)
  if sz[0] NE 2 then begin
      message, 'ERROR: r must be a two-dimensional matrix'
      return, -1L
  endif
  n = sz[1]
  if n NE sz[2] then begin
      message, 'ERROR: r must be a square matrix'
      return, -1L
  endif

  zero = rr[0] * 0.
  one  = zero  + 1.
  if n_elements(ipvt) EQ 0 then ipvt = lindgen(n)
  r = rr
  r = reform(rr, n, n, /overwrite)
  
  ;; Form the inverse of r in the full upper triangle of r
  l = -1L
  if n_elements(tol) EQ 0 then tol = one*1.E-14
  tolr = tol * abs(r[0,0])
  for k = 0L, n-1 do begin
      if abs(r[k,k]) LE tolr then goto, INV_END_LOOP
      r[k,k] = one/r[k,k]
      for j = 0L, k-1 do begin
          temp = r[k,k] * r[j,k]
          r[j,k] = zero
          r[0,k] = r[0:j,k] - temp*r[0:j,j]
      endfor
      l = k
  endfor
  INV_END_LOOP:

  ;; Form the full upper triangle of the inverse of (r transpose)*r
  ;; in the full upper triangle of r
  if l GE 0 then $
    for k = 0L, l do begin
      for j = 0L, k-1 do begin
          temp = r[j,k]
          r[0,j] = r[0:j,j] + temp*r[0:j,k]
      endfor
      temp = r[k,k]
      r[0,k] = temp * r[0:k,k]
  endfor

  ;; Form the full lower triangle of the covariance matrix
  ;; in the strict lower triangle of r and in wa
  wa = replicate(r[0,0], n)
  for j = 0L, n-1 do begin
      jj = ipvt[j]
      sing = j GT l
      for i = 0L, j do begin
          if sing then r[i,j] = zero
          ii = ipvt[i]
          if ii GT jj then r[ii,jj] = r[i,j]
          if ii LT jj then r[jj,ii] = r[i,j]
      endfor
      wa[jj] = r[j,j]
  endfor

  ;; Symmetrize the covariance matrix in r
  for j = 0L, n-1 do begin
      r[0:j,j] = r[j,0:j]
      r[j,j] = wa[j]
  endfor

  return, r
end

;; Parse the RCSID revision number
function mpfit_revision
  ;; NOTE: this string is changed every time an RCS check-in occurs
  revision = '$Revision: 1.85 $'

  ;; Parse just the version number portion
  revision = stregex(revision,'\$'+'Revision: *([0-9.]+) *'+'\$',/extract,/sub)
  revision = revision[1]
  return, revision
end

;; Parse version numbers of the form 'X.Y'
function mpfit_parse_version, version
  sz = size(version)
  if sz[sz[0]+1] NE 7 then return, 0

  s = stregex(version[0], '^([0-9]+)\.([0-9]+)$', /extract,/sub) 
  if s[0] NE version[0] then return, 0
  return, long(s[1:2])
end

;; Enforce a minimum version number
function mpfit_min_version, version, min_version
  mv = mpfit_parse_version(min_version)
  if mv[0] EQ 0 then return, 0
  v  = mpfit_parse_version(version)

  ;; Compare version components
  if v[0] LT mv[0] then return, 0
  if v[1] LT mv[1] then return, 0
  return, 1
end

; Manually reset recursion fencepost if the user gets in trouble
pro mpfit_reset_recursion
  common mpfit_fencepost, mpfit_fencepost_active
  mpfit_fencepost_active = 0
end

;     **********
;
;     subroutine lmdif
;
;     the purpose of lmdif is to minimize the sum of the squares of
;     m nonlinear functions in n variables by a modification of
;     the levenberg-marquardt algorithm. the user must provide a
;     subroutine which calculates the functions. the jacobian is
;     then calculated by a forward-difference approximation.
;
;     the subroutine statement is
;
;	subroutine lmdif(fcn,m,n,x,fvec,ftol,xtol,gtol,maxfev,epsfcn,
;			 diag,mode,factor,nprint,info,nfev,fjac,
;			 ldfjac,ipvt,qtf,wa1,wa2,wa3,wa4)
;
;     where
;
;	fcn is the name of the user-supplied subroutine which
;	  calculates the functions. fcn must be declared
;	  in an external statement in the user calling
;	  program, and should be written as follows.
;
;	  subroutine fcn(m,n,x,fvec,iflag)
;	  integer m,n,iflag
;	  double precision x(n),fvec(m)
;	  ----------
;	  calculate the functions at x and
;	  return this vector in fvec.
;	  ----------
;	  return
;	  end
;
;	  the value of iflag should not be changed by fcn unless
;	  the user wants to terminate execution of lmdif.
;	  in this case set iflag to a negative integer.
;
;	m is a positive integer input variable set to the number
;	  of functions.
;
;	n is a positive integer input variable set to the number
;	  of variables. n must not exceed m.
;
;	x is an array of length n. on input x must contain
;	  an initial estimate of the solution vector. on output x
;	  contains the final estimate of the solution vector.
;
;	fvec is an output array of length m which contains
;	  the functions evaluated at the output x.
;
;	ftol is a nonnegative input variable. termination
;	  occurs when both the actual and predicted relative
;	  reductions in the sum of squares are at most ftol.
;	  therefore, ftol measures the relative error desired
;	  in the sum of squares.
;
;	xtol is a nonnegative input variable. termination
;	  occurs when the relative error between two consecutive
;	  iterates is at most xtol. therefore, xtol measures the
;	  relative error desired in the approximate solution.
;
;	gtol is a nonnegative input variable. termination
;	  occurs when the cosine of the angle between fvec and
;	  any column of the jacobian is at most gtol in absolute
;	  value. therefore, gtol measures the orthogonality
;	  desired between the function vector and the columns
;	  of the jacobian.
;
;	maxfev is a positive integer input variable. termination
;	  occurs when the number of calls to fcn is at least
;	  maxfev by the end of an iteration.
;
;	epsfcn is an input variable used in determining a suitable
;	  step length for the forward-difference approximation. this
;	  approximation assumes that the relative errors in the
;	  functions are of the order of epsfcn. if epsfcn is less
;	  than the machine precision, it is assumed that the relative
;	  errors in the functions are of the order of the machine
;	  precision.
;
;	diag is an array of length n. if mode = 1 (see
;	  below), diag is internally set. if mode = 2, diag
;	  must contain positive entries that serve as
;	  multiplicative scale factors for the variables.
;
;	mode is an integer input variable. if mode = 1, the
;	  variables will be scaled internally. if mode = 2,
;	  the scaling is specified by the input diag. other
;	  values of mode are equivalent to mode = 1.
;
;	factor is a positive input variable used in determining the
;	  initial step bound. this bound is set to the product of
;	  factor and the euclidean norm of diag*x if nonzero, or else
;	  to factor itself. in most cases factor should lie in the
;	  interval (.1,100.). 100. is a generally recommended value.
;
;	nprint is an integer input variable that enables controlled
;	  printing of iterates if it is positive. in this case,
;	  fcn is called with iflag = 0 at the beginning of the first
;	  iteration and every nprint iterations thereafter and
;	  immediately prior to return, with x and fvec available
;	  for printing. if nprint is not positive, no special calls
;	  of fcn with iflag = 0 are made.
;
;	info is an integer output variable. if the user has
;	  terminated execution, info is set to the (negative)
;	  value of iflag. see description of fcn. otherwise,
;	  info is set as follows.
;
;	  info = 0  improper input parameters.
;
;	  info = 1  both actual and predicted relative reductions
;		    in the sum of squares are at most ftol.
;
;	  info = 2  relative error between two consecutive iterates
;		    is at most xtol.
;
;	  info = 3  conditions for info = 1 and info = 2 both hold.
;
;	  info = 4  the cosine of the angle between fvec and any
;		    column of the jacobian is at most gtol in
;		    absolute value.
;
;	  info = 5  number of calls to fcn has reached or
;		    exceeded maxfev.
;
;	  info = 6  ftol is too small. no further reduction in
;		    the sum of squares is possible.
;
;	  info = 7  xtol is too small. no further improvement in
;		    the approximate solution x is possible.
;
;	  info = 8  gtol is too small. fvec is orthogonal to the
;		    columns of the jacobian to machine precision.
;
;	nfev is an integer output variable set to the number of
;	  calls to fcn.
;
;	fjac is an output m by n array. the upper n by n submatrix
;	  of fjac contains an upper triangular matrix r with
;	  diagonal elements of nonincreasing magnitude such that
;
;		 t     t	   t
;		p *(jac *jac)*p = r *r,
;
;	  where p is a permutation matrix and jac is the final
;	  calculated jacobian. column j of p is column ipvt(j)
;	  (see below) of the identity matrix. the lower trapezoidal
;	  part of fjac contains information generated during
;	  the computation of r.
;
;	ldfjac is a positive integer input variable not less than m
;	  which specifies the leading dimension of the array fjac.
;
;	ipvt is an integer output array of length n. ipvt
;	  defines a permutation matrix p such that jac*p = q*r,
;	  where jac is the final calculated jacobian, q is
;	  orthogonal (not stored), and r is upper triangular
;	  with diagonal elements of nonincreasing magnitude.
;	  column j of p is column ipvt(j) of the identity matrix.
;
;	qtf is an output array of length n which contains
;	  the first n elements of the vector (q transpose)*fvec.
;
;	wa1, wa2, and wa3 are work arrays of length n.
;
;	wa4 is a work array of length m.
;
;     subprograms called
;
;	user-supplied ...... fcn
;
;	minpack-supplied ... dpmpar,enorm,fdjac2,lmpar,qrfac
;
;	fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod
;
;     argonne national laboratory. minpack project. march 1980.
;     burton s. garbow, kenneth e. hillstrom, jorge j. more
;
;     **********
function mpfit, fcn, xall, FUNCTARGS=fcnargs, SCALE_FCN=scalfcn, $
                ftol=ftol0, xtol=xtol0, gtol=gtol0, epsfcn=epsfcn, $
                resdamp=damp0, $
                nfev=nfev, maxiter=maxiter, errmsg=errmsg, $
                factor=factor0, nprint=nprint0, STATUS=info, $
                iterproc=iterproc0, iterargs=iterargs, iterstop=ss,$
                iterkeystop=iterkeystop, $
                niter=iter, nfree=nfree, npegged=npegged, dof=dof, $
                diag=diag, rescale=rescale, autoderivative=autoderiv0, $
                pfree_index=ifree, $
                perror=perror, covar=covar, nocovar=nocovar, $
                bestnorm=fnorm, best_resid=fvec, $
                best_fjac=output_fjac, calc_fjac=calc_fjac, $
                parinfo=parinfo, quiet=quiet, nocatch=nocatch, $
                fastnorm=fastnorm0, proc=proc, query=query, $
                external_state=state, external_init=extinit, $
                external_fvec=efvec, external_fjac=efjac, $
                version=version, min_version=min_version0

  COMPILE_OPT strictarr
  info = 0L
  errmsg = ''

  ;; Compute the revision number, to be returned in the VERSION and
  ;; QUERY keywords.
  common mpfit_revision_common, mpfit_revision_str
  if n_elements(mpfit_revision_str) EQ 0 then $
     mpfit_revision_str = mpfit_revision()
  version = mpfit_revision_str

  if keyword_set(query) then begin
     if n_elements(min_version0) GT 0 then $
        if mpfit_min_version(version, min_version0[0]) EQ 0 then $
           return, 0
     return, 1
  endif

  if n_elements(min_version0) GT 0 then $
     if mpfit_min_version(version, min_version0[0]) EQ 0 then begin
     message, 'ERROR: minimum required version '+min_version0[0]+' not satisfied', /info
     return, !values.d_nan
  endif

  if n_params() EQ 0 then begin
      message, "USAGE: PARMS = MPFIT('MYFUNCT', START_PARAMS, ... )", /info
      return, !values.d_nan
  endif
  
  ;; Use of double here not a problem since f/x/gtol are all only used
  ;; in comparisons
  if n_elements(ftol0) EQ 0 then ftol = 1.D-10 else ftol = ftol0[0]
  if n_elements(xtol0) EQ 0 then xtol = 1.D-10 else xtol = xtol0[0]
  if n_elements(gtol0) EQ 0 then gtol = 1.D-10 else gtol = gtol0[0]
  if n_elements(factor0) EQ 0 then factor = 100. else factor = factor0[0]
  if n_elements(nprint0) EQ 0 then nprint = 1 else nprint = nprint0[0]
  if n_elements(iterproc0) EQ 0 then iterproc = 'MPFIT_DEFITER' else iterproc = iterproc0[0]
  if n_elements(autoderiv0) EQ 0 then autoderiv = 1 else autoderiv = autoderiv0[0]
  if n_elements(fastnorm0) EQ 0 then fastnorm = 0 else fastnorm = fastnorm0[0]
  if n_elements(damp0) EQ 0 then damp = 0 else damp = damp0[0]

  ;; These are special configuration parameters that can't be easily
  ;; passed by MPFIT directly.
  ;;  FASTNORM - decide on which sum-of-squares technique to use (1)
  ;;             is fast, (0) is slower
  ;;  PROC - user routine is a procedure (1) or function (0)
  ;;  QANYTIED - set to 1 if any parameters are TIED, zero if none
  ;;  PTIED - array of strings, one for each parameter
  common mpfit_config, mpconfig
  mpconfig = {fastnorm: keyword_set(fastnorm), proc: 0, nfev: 0L, damp: damp}
  common mpfit_machar, machvals

  iflag = 0L
  catch_msg = 'in MPFIT'
  nfree = 0L
  npegged = 0L
  dof = 0L
  output_fjac = 0L

  ;; Set up a persistent fencepost that prevents recursive calls
  common mpfit_fencepost, mpfit_fencepost_active
  if n_elements(mpfit_fencepost_active) EQ 0 then mpfit_fencepost_active = 0
  if mpfit_fencepost_active then begin
      errmsg = 'ERROR: recursion detected; you cannot run MPFIT recursively'
      goto, TERMINATE
  endif
  ;; Only activate the fencepost if we are not in debugging mode
  if NOT keyword_set(nocatch) then mpfit_fencepost_active = 1


  ;; Parameter damping doesn't work when user is providing their own
  ;; gradients.
  if damp NE 0 AND NOT keyword_set(autoderiv) then begin
      errmsg = 'ERROR: keywords DAMP and AUTODERIV are mutually exclusive'
      goto, TERMINATE
  endif      
  
  ;; Process the ITERSTOP and ITERKEYSTOP keywords, and turn this into
  ;; a set of keywords to pass to MPFIT_DEFITER.
  if strupcase(iterproc) EQ 'MPFIT_DEFITER' AND n_elements(iterargs) EQ 0 $
    AND keyword_set(ss) then begin
      if n_elements(iterkeystop) GT 0 then begin
          sz = size(iterkeystop)
          tp = sz[sz[0]+1]
          if tp EQ 7 then begin
              ;; String - convert first char to byte
              iterkeybyte = (byte(iterkeystop[0]))[0]
          endif
          if (tp GE 1 AND tp LE 3) OR (tp GE 12 AND tp LE 15) then begin
              ;; Integer - convert to byte
              iterkeybyte = byte(iterkeystop[0])
          endif
          if n_elements(iterkeybyte) EQ 0 then begin
              errmsg = 'ERROR: ITERKEYSTOP must be either a BYTE or STRING'
              goto, TERMINATE
          endif

          iterargs = {iterstop: 1, iterkeybyte: iterkeybyte}
      endif else begin
          iterargs = {iterstop: 1, iterkeybyte: 7b}
      endelse
  endif


  ;; Handle error conditions gracefully
  if NOT keyword_set(nocatch) then begin
      catch, catcherror
      if catcherror NE 0 then begin  ;; An error occurred!!!
          catch, /cancel
          mpfit_fencepost_active = 0
          err_string = ''+!error_state.msg
          message, /cont, 'Error detected while '+catch_msg+':'
          message, /cont,    err_string
          message, /cont, 'Error condition detected. Returning to MAIN level.'
          if errmsg EQ '' then $
            errmsg = 'Error detected while '+catch_msg+': '+err_string
          if info EQ 0 then info = -18
          return, !values.d_nan
      endif
  endif
  mpconfig = create_struct(mpconfig, 'NOCATCH', keyword_set(nocatch))

  ;; Parse FCN function name - be sure it is a scalar string
  sz = size(fcn)
  if sz[0] NE 0 then begin
      FCN_NAME:
      errmsg = 'ERROR: MYFUNCT must be a scalar string'
      goto, TERMINATE
  endif
  if sz[sz[0]+1] NE 7 then goto, FCN_NAME

  isext = 0
  if fcn EQ '(EXTERNAL)' then begin
      if n_elements(efvec) EQ 0 OR n_elements(efjac) EQ 0 then begin
          errmsg = 'ERROR: when using EXTERNAL function, EXTERNAL_FVEC '+$
            'and EXTERNAL_FJAC must be defined'
          goto, TERMINATE
      endif
      nv = n_elements(efvec)
      nj = n_elements(efjac)
      if (nj MOD nv) NE 0 then begin
          errmsg = 'ERROR: the number of values in EXTERNAL_FJAC must be '+ $
            'a multiple of the number of values in EXTERNAL_FVEC'
          goto, TERMINATE
      endif
      isext = 1
  endif

  ;; Parinfo:
  ;; --------------- STARTING/CONFIG INFO (passed in to routine, not changed)
  ;; .value   - starting value for parameter
  ;; .fixed   - parameter is fixed
  ;; .limited - a two-element array, if parameter is bounded on
  ;;            lower/upper side
  ;; .limits - a two-element array, lower/upper parameter bounds, if
  ;;           limited vale is set
  ;; .step   - step size in Jacobian calc, if greater than zero

  catch_msg = 'parsing input parameters'
  ;; Parameters can either be stored in parinfo, or x.  Parinfo takes
  ;; precedence if it exists.
  if n_elements(xall) EQ 0 AND n_elements(parinfo) EQ 0 then begin
      errmsg = 'ERROR: must pass parameters in P or PARINFO'
      goto, TERMINATE
  endif

  ;; Be sure that PARINFO is of the right type
  if n_elements(parinfo) GT 0 then begin
      ;; Make sure the array is 1-D
      parinfo = parinfo[*]
      parinfo_size = size(parinfo)
      if parinfo_size[parinfo_size[0]+1] NE 8 then begin
          errmsg = 'ERROR: PARINFO must be a structure.'
          goto, TERMINATE
      endif
      if n_elements(xall) GT 0 AND n_elements(xall) NE n_elements(parinfo) $
        then begin
          errmsg = 'ERROR: number of elements in PARINFO and P must agree'
          goto, TERMINATE
      endif
  endif

  ;; If the parameters were not specified at the command line, then
  ;; extract them from PARINFO
  if n_elements(xall) EQ 0 then begin
      mpfit_parinfo, parinfo, tagnames, 'VALUE', xall, status=status
      if status EQ 0 then begin
          errmsg = 'ERROR: either P or PARINFO[*].VALUE must be supplied.'
          goto, TERMINATE
      endif

      sz = size(xall)
      ;; Convert to double if parameters are not float or double
      if sz[sz[0]+1] NE 4 AND sz[sz[0]+1] NE 5 then $
        xall = double(xall)
  endif
  xall = xall[*]   ;; Make sure the array is 1-D
  npar = n_elements(xall)
  zero = xall[0] * 0.
  one  = zero    + 1.
  fnorm  = -one
  fnorm1 = -one

  ;; TIED parameters?
  mpfit_parinfo, parinfo, tagnames, 'TIED', ptied, default='', n=npar
  ptied = strtrim(ptied, 2)
  wh = where(ptied NE '', qanytied) 
  qanytied = qanytied GT 0
  mpconfig = create_struct(mpconfig, 'QANYTIED', qanytied, 'PTIED', ptied)

  ;; FIXED parameters ?
  mpfit_parinfo, parinfo, tagnames, 'FIXED', pfixed, default=0, n=npar
  pfixed = pfixed EQ 1
  pfixed = pfixed OR (ptied NE '');; Tied parameters are also effectively fixed
  
  ;; Finite differencing step, absolute and relative, and sidedness of deriv.
  mpfit_parinfo, parinfo, tagnames, 'STEP',     step, default=zero, n=npar
  mpfit_parinfo, parinfo, tagnames, 'RELSTEP', dstep, default=zero, n=npar
  mpfit_parinfo, parinfo, tagnames, 'MPSIDE',  dside, default=0,    n=npar
  ;; Debugging parameters
  mpfit_parinfo, parinfo, tagnames, 'MPDERIV_DEBUG',  ddebug, default=0, n=npar
  mpfit_parinfo, parinfo, tagnames, 'MPDERIV_RELTOL', ddrtol, default=zero, n=npar
  mpfit_parinfo, parinfo, tagnames, 'MPDERIV_ABSTOL', ddatol, default=zero, n=npar

  ;; Maximum and minimum steps allowed to be taken in one iteration
  mpfit_parinfo, parinfo, tagnames, 'MPMAXSTEP', maxstep, default=zero, n=npar
  mpfit_parinfo, parinfo, tagnames, 'MPMINSTEP', minstep, default=zero, n=npar
  qmin = minstep *  0  ;; Remove minstep for now!!
  qmax = maxstep NE 0
  wh = where(qmin AND qmax AND maxstep LT minstep, ct)
  if ct GT 0 then begin
      errmsg = 'ERROR: MPMINSTEP is greater than MPMAXSTEP'
      goto, TERMINATE
  endif

  ;; Finish up the free parameters
  ifree = where(pfixed NE 1, nfree)
  if nfree EQ 0 then begin
      errmsg = 'ERROR: no free parameters'
      goto, TERMINATE
  endif

  ;; An external Jacobian must be checked against the number of
  ;; parameters
  if isext then begin
      if (nj/nv) NE nfree then begin
          errmsg = string(nv, nfree, nfree, $
           format=('("ERROR: EXTERNAL_FJAC must be a ",I0," x ",I0,' + $
                   '" array, where ",I0," is the number of free parameters")'))
          goto, TERMINATE
      endif
  endif

  ;; Compose only VARYING parameters
  xnew = xall      ;; xnew is the set of parameters to be returned
  x = xnew[ifree]  ;; x is the set of free parameters
  ; Same for min/max step diagnostics
  qmin = qmin[ifree]  & minstep = minstep[ifree]
  qmax = qmax[ifree]  & maxstep = maxstep[ifree]
  wh = where(qmin OR qmax, ct)
  qminmax = ct GT 0


  ;; LIMITED parameters ?
  mpfit_parinfo, parinfo, tagnames, 'LIMITED', limited, status=st1
  mpfit_parinfo, parinfo, tagnames, 'LIMITS',  limits,  status=st2
  if st1 EQ 1 AND st2 EQ 1 then begin

      ;; Error checking on limits in parinfo
      wh = where((limited[0,*] AND xall LT limits[0,*]) OR $
                 (limited[1,*] AND xall GT limits[1,*]), ct)
      if ct GT 0 then begin
          errmsg = 'ERROR: parameters are not within PARINFO limits'
          goto, TERMINATE
      endif
      wh = where(limited[0,*] AND limited[1,*] AND $
                 limits[0,*] GE limits[1,*] AND $
                 pfixed EQ 0, ct)
      if ct GT 0 then begin
          errmsg = 'ERROR: PARINFO parameter limits are not consistent'
          goto, TERMINATE
      endif
      

      ;; Transfer structure values to local variables
      qulim = limited[1, ifree]
      ulim  = limits [1, ifree]
      qllim = limited[0, ifree]
      llim  = limits [0, ifree]

      wh = where(qulim OR qllim, ct)
      if ct GT 0 then qanylim = 1 else qanylim = 0

  endif else begin

      ;; Fill in local variables with dummy values
      qulim = lonarr(nfree)
      ulim  = x * 0.
      qllim = qulim
      llim  = x * 0.
      qanylim = 0

  endelse

  ;; Initialize the number of parameters pegged at a hard limit value
  wh = where((qulim AND (x EQ ulim)) OR (qllim AND (x EQ llim)), npegged)

  n = n_elements(x)
  if n_elements(maxiter) EQ 0 then maxiter = 200L

  ;; Check input parameters for errors
  if (n LE 0) OR (ftol LE 0) OR (xtol LE 0) OR (gtol LE 0) $
    OR (maxiter LT 0) OR (factor LE 0) then begin
      errmsg = 'ERROR: input keywords are inconsistent'
      goto, TERMINATE
  endif

  if keyword_set(rescale) then begin
      errmsg = 'ERROR: DIAG parameter scales are inconsistent'
      if n_elements(diag) LT n then goto, TERMINATE
      wh = where(diag LE 0, ct)
      if ct GT 0 then goto, TERMINATE
      errmsg = ''
  endif

  if n_elements(state) NE 0 AND NOT keyword_set(extinit) then begin
      szst = size(state)
      if szst[szst[0]+1] NE 8  then begin
          errmsg = 'EXTERNAL_STATE keyword was not preserved'
          status = 0
          goto, TERMINATE
      endif
      if nfree NE n_elements(state.ifree) then begin
          BAD_IFREE:
          errmsg = 'Number of free parameters must not change from one '+$
            'external iteration to the next'
          status = 0
          goto, TERMINATE
      endif
      wh = where(ifree NE state.ifree, ct)
      if ct GT 0 then goto, BAD_IFREE

      tnames = tag_names(state)
      for i = 0L, n_elements(tnames)-1 do begin
          dummy = execute(tnames[i]+' = state.'+tnames[i])
      endfor
      wa4 = reform(efvec, n_elements(efvec))

      goto, RESUME_FIT
  endif

  common mpfit_error, mperr

  if NOT isext then begin
      mperr = 0
      catch_msg = 'calling '+fcn
      fvec = mpfit_call(fcn, xnew, _EXTRA=fcnargs)
      iflag = mperr
      if iflag LT 0 then begin
          errmsg = 'ERROR: first call to "'+fcn+'" failed'
          goto, TERMINATE
      endif
  endif else begin
      fvec = reform(efvec, n_elements(efvec))
  endelse

  catch_msg = 'calling MPFIT_SETMACHAR'
  sz = size(fvec[0])
  isdouble = (sz[sz[0]+1] EQ 5)
  
  mpfit_setmachar, double=isdouble

  common mpfit_profile, profvals
;  prof_start = systime(1)

  MACHEP0 = machvals.machep
  DWARF   = machvals.minnum

  szx = size(x)
  ;; The parameters and the squared deviations should have the same
  ;; type.  Otherwise the MACHAR-based evaluation will fail.
  catch_msg = 'checking parameter data'
  tp = szx[szx[0]+1]
  if tp NE 4 AND tp NE 5 then begin
      if NOT keyword_set(quiet) then begin
          message, 'WARNING: input parameters must be at least FLOAT', /info
          message, '         (converting parameters to FLOAT)', /info
      endif
      x = float(x)
      xnew = float(x)
      szx = size(x)
  endif
  if isdouble AND tp NE 5 then begin
      if NOT keyword_set(quiet) then begin
          message, 'WARNING: data is DOUBLE but parameters are FLOAT', /info
          message, '         (converting parameters to DOUBLE)', /info
      endif
      x = double(x)
      xnew = double(xnew)
  endif

  m = n_elements(fvec)
  if (m LT n) then begin
      errmsg = 'ERROR: number of parameters must not exceed data'
      goto, TERMINATE
  endif

  fnorm = mpfit_enorm(fvec)
  if finite(fnorm) EQ 0 then goto, FAIL_OVERFLOW

  ;; Initialize Levelberg-Marquardt parameter and iteration counter

  par = zero
  iter = 1L
  qtf = x * 0.

  ;; Beginning of the outer loop
  
  OUTER_LOOP:

  ;; If requested, call fcn to enable printing of iterates
  xnew[ifree] = x
  if qanytied then mpfit_tie, xnew, ptied
  dof = (n_elements(fvec) - nfree) > 1L

  if nprint GT 0 AND iterproc NE '' then begin
      catch_msg = 'calling '+iterproc
      iflag = 0L
      if (iter-1) MOD nprint EQ 0 then begin
          mperr = 0
          xnew0 = xnew

          call_procedure, iterproc, fcn, xnew, iter, fnorm^2, $
            FUNCTARGS=fcnargs, parinfo=parinfo, quiet=quiet, $
            dof=dof, _EXTRA=iterargs
          iflag = mperr

          ;; Check for user termination
          if iflag LT 0 then begin  
              errmsg = 'WARNING: premature termination by "'+iterproc+'"'
              goto, TERMINATE
          endif

          ;; If parameters were changed (grrr..) then re-tie
          if max(abs(xnew0-xnew)) GT 0 then begin
              if qanytied then mpfit_tie, xnew, ptied
              x = xnew[ifree]
          endif

      endif
  endif

  ;; Calculate the jacobian matrix
  iflag = 2
  if NOT isext then begin
      catch_msg = 'calling MPFIT_FDJAC2'
      ;; NOTE!  If you change this call then change the one during
      ;; clean-up as well!
      fjac = mpfit_fdjac2(fcn, x, fvec, step, qulim, ulim, dside, $
                          iflag=iflag, epsfcn=epsfcn, $
                          autoderiv=autoderiv, dstep=dstep, $
                          FUNCTARGS=fcnargs, ifree=ifree, xall=xnew, $
                          deriv_debug=ddebug, deriv_reltol=ddrtol, deriv_abstol=ddatol)
      if iflag LT 0 then begin
          errmsg = 'WARNING: premature termination by FDJAC2'
          goto, TERMINATE
      endif
  endif else begin
      fjac = reform(efjac,n_elements(fvec),npar, /overwrite)
  endelse

  ;; Rescale the residuals and gradient, for use with "alternative"
  ;; statistics such as the Cash statistic.
  catch_msg = 'prescaling residuals and gradient'
  if n_elements(scalfcn) GT 0 then begin
      call_procedure, strtrim(scalfcn[0],2), fvec, fjac
  endif

  ;; Determine if any of the parameters are pegged at the limits
  npegged = 0L
  if qanylim then begin
      catch_msg = 'zeroing derivatives of pegged parameters'
      whlpeg = where(qllim AND (x EQ llim), nlpeg)
      whupeg = where(qulim AND (x EQ ulim), nupeg)
      npegged = nlpeg + nupeg
      
      ;; See if any "pegged" values should keep their derivatives
      if (nlpeg GT 0) then begin
          ;; Total derivative of sum wrt lower pegged parameters
          ;;   Note: total(fvec*fjac[*,i]) is d(CHI^2)/dX[i]
          for i = 0L, nlpeg-1 do begin
              sum = total(fvec * fjac[*,whlpeg[i]])
              if sum GT 0 then fjac[*,whlpeg[i]] = 0
          endfor
      endif
      if (nupeg GT 0) then begin
          ;; Total derivative of sum wrt upper pegged parameters
          for i = 0L, nupeg-1 do begin
              sum = total(fvec * fjac[*,whupeg[i]])
              if sum LT 0 then fjac[*,whupeg[i]] = 0
          endfor
      endif
  endif

  ;; Save a copy of the Jacobian if the user requests it...
  if keyword_set(calc_fjac) then output_fjac = fjac

  ;; =====================
  ;; Compute the QR factorization of the jacobian
  catch_msg = 'calling MPFIT_QRFAC'
  ;;  IN:      Jacobian        
  ;; OUT:      Hh Vects  Permutation  RDIAG  ACNORM
  mpfit_qrfac, fjac,     ipvt,        wa1,   wa2, /pivot
  ;; Jacobian - jacobian matrix computed by mpfit_fdjac2
  ;; Hh vects - house holder vectors from QR factorization & R matrix
  ;; Permutation - permutation vector for pivoting
  ;; RDIAG - diagonal elements of R matrix
  ;; ACNORM - norms of input Jacobian matrix before factoring

  ;; =====================
  ;; On the first iteration if "diag" is unspecified, scale
  ;; according to the norms of the columns of the initial jacobian
  catch_msg = 'rescaling diagonal elements'
  if (iter EQ 1) then begin
      ;; Input: WA2 = root sum of squares of original Jacobian matrix
      ;;        DIAG = user-requested diagonal (not documented!)
      ;;        FACTOR = user-requested norm factor (not documented!)
      ;; Output: DIAG = Diagonal scaling values
      ;;         XNORM = sum of squared scaled residuals
      ;;         DELTA = rescaled XNORM

      if NOT keyword_set(rescale) OR (n_elements(diag) LT n) then begin
          diag = wa2 ;; Calculated from original Jacobian
          wh = where (diag EQ 0, ct) ;; Handle zero values
          if ct GT 0 then diag[wh] = one
      endif
      
      ;; On the first iteration, calculate the norm of the scaled x
      ;; and initialize the step bound delta 
      wa3 = diag * x           ;; WA3 is temp variable
      xnorm = mpfit_enorm(wa3)
      delta = factor*xnorm
      if delta EQ zero then delta = zero + factor
  endif

  ;; Form (q transpose)*fvec and store the first n components in qtf
  catch_msg = 'forming (q transpose)*fvec'
  wa4 = fvec
  for j=0L, n-1 do begin
      lj = ipvt[j]
      temp3 = fjac[j,lj]
      if temp3 NE 0 then begin
          fj = fjac[j:*,lj]
          wj = wa4[j:*]
          ;; *** optimization wa4(j:*)
          wa4[j] = wj - fj * total(fj*wj) / temp3  
      endif
      fjac[j,lj] = wa1[j]
      qtf[j] = wa4[j]
  endfor
  ;; From this point on, only the square matrix, consisting of the
  ;; triangle of R, is needed.
  fjac = fjac[0:n-1, 0:n-1]
  fjac = reform(fjac, n, n, /overwrite)
  fjac = fjac[*, ipvt]                    ;; Convert to permuted order
  fjac = reform(fjac, n, n, /overwrite)

  ;; Check for overflow.  This should be a cheap test here since FJAC
  ;; has been reduced to a (small) square matrix, and the test is
  ;; O(N^2).
  wh = where(finite(fjac) EQ 0, ct)
  if ct GT 0 then goto, FAIL_OVERFLOW

  ;; Compute the norm of the scaled gradient
  catch_msg = 'computing the scaled gradient'
  gnorm = zero
  if fnorm NE 0 then begin
      for j=0L, n-1 do begin
          l = ipvt[j]
          if wa2[l] NE 0 then begin
              sum = total(fjac[0:j,j]*qtf[0:j])/fnorm
              gnorm = max([gnorm,abs(sum/wa2[l])])
          endif
      endfor
  endif

  ;; Test for convergence of the gradient norm
  if gnorm LE gtol then info = 4
  if info NE 0 then goto, TERMINATE
  if maxiter EQ 0 then begin
     info = 5
     goto, TERMINATE
  endif

  ;; Rescale if necessary
  if NOT keyword_set(rescale) then $
    diag = diag > wa2

  ;; Beginning of the inner loop
  INNER_LOOP:
  
  ;; Determine the levenberg-marquardt parameter
  catch_msg = 'calculating LM parameter (MPFIT_LMPAR)'
  par = mpfit_lmpar(fjac, ipvt, diag, qtf, delta, wa1, wa2, par=par)

  ;; Store the direction p and x+p. Calculate the norm of p
  wa1 = -wa1

  if qanylim EQ 0 AND qminmax EQ 0 then begin
      ;; No parameter limits, so just move to new position WA2
      alpha = one
      wa2 = x + wa1

  endif else begin
      
      ;; Respect the limits.  If a step were to go out of bounds, then
      ;; we should take a step in the same direction but shorter distance.
      ;; The step should take us right to the limit in that case.
      alpha = one

      if qanylim EQ 1 then begin
          ;; Do not allow any steps out of bounds
          catch_msg = 'checking for a step out of bounds'
          if nlpeg GT 0 then wa1[whlpeg] = wa1[whlpeg] > 0
          if nupeg GT 0 then wa1[whupeg] = wa1[whupeg] < 0

          dwa1 = abs(wa1) GT MACHEP0
          whl = where(dwa1 AND qllim AND (x + wa1 LT llim), lct)
          if lct GT 0 then $
            alpha = min([alpha, (llim[whl]-x[whl])/wa1[whl]])
          whu = where(dwa1 AND qulim AND (x + wa1 GT ulim), uct)
          if uct GT 0 then $
            alpha = min([alpha, (ulim[whu]-x[whu])/wa1[whu]])
      endif

      ;; Obey any max step values.

      if qminmax EQ 1 then begin
          nwa1 = wa1 * alpha
          whmax = where(qmax AND maxstep GT 0, ct)
          if ct GT 0 then begin
              mrat = max(abs(nwa1[whmax])/abs(maxstep[whmax]))
              if mrat GT 1 then alpha = alpha / mrat
          endif
      endif          

      ;; Scale the resulting vector
      wa1 = wa1 * alpha
      wa2 = x + wa1

      ;; Adjust the final output values.  If the step put us exactly
      ;; on a boundary, make sure we peg it there.
      sgnu = (ulim GE 0)*2d - 1d
      sgnl = (llim GE 0)*2d - 1d

      ;; Handles case of 
      ;;      ... nonzero *LIM ...     ... zero *LIM ...
      ulim1 = ulim*(1-sgnu*MACHEP0) - (ulim EQ 0)*MACHEP0
      llim1 = llim*(1+sgnl*MACHEP0) + (llim EQ 0)*MACHEP0

      wh = where(qulim AND (wa2 GE ulim1), ct)
      if ct GT 0 then wa2[wh] = ulim[wh]

      wh = where(qllim AND (wa2 LE llim1), ct)
      if ct GT 0 then wa2[wh] = llim[wh]
  endelse

  wa3 = diag * wa1
  pnorm = mpfit_enorm(wa3)

  ;; On the first iteration, adjust the initial step bound
  if iter EQ 1 then delta = min([delta,pnorm])

  xnew[ifree] = wa2
  if isext then goto, SAVE_STATE

  ;; Evaluate the function at x+p and calculate its norm
  mperr = 0
  catch_msg = 'calling '+fcn
  wa4 = mpfit_call(fcn, xnew, _EXTRA=fcnargs)
  iflag = mperr
  if iflag LT 0 then begin
      errmsg = 'WARNING: premature termination by "'+fcn+'"'
      goto, TERMINATE
  endif
  RESUME_FIT:
  fnorm1 = mpfit_enorm(wa4)
  if finite(fnorm1) EQ 0 then goto, FAIL_OVERFLOW
  
  ;; Compute the scaled actual reduction
  catch_msg = 'computing convergence criteria'
  actred = -one
  if 0.1D * fnorm1 LT fnorm then actred = - (fnorm1/fnorm)^2 + 1.

  ;; Compute the scaled predicted reduction and the scaled directional
  ;; derivative
  for j = 0L, n-1 do begin
      wa3[j] = 0
      wa3[0:j] = wa3[0:j] + fjac[0:j,j]*wa1[ipvt[j]]
  endfor

  ;; Remember, alpha is the fraction of the full LM step actually
  ;; taken
  temp1 = mpfit_enorm(alpha*wa3)/fnorm
  temp2 = (sqrt(alpha*par)*pnorm)/fnorm
  half  = zero + 0.5
  prered = temp1*temp1 + (temp2*temp2)/half
  dirder = -(temp1*temp1 + temp2*temp2)

  ;; Compute the ratio of the actual to the predicted reduction.
  ratio = zero
  tenth = zero + 0.1
  if prered NE 0 then ratio = actred/prered

  ;; Update the step bound
  if ratio LE 0.25D then begin
      if actred GE 0 then temp = half $
      else temp = half*dirder/(dirder + half*actred)
      if ((0.1D*fnorm1) GE fnorm) OR (temp LT 0.1D) then temp = tenth
      delta = temp*min([delta,pnorm/tenth])
      par = par/temp
  endif else begin
      if (par EQ 0) OR (ratio GE 0.75) then begin
          delta = pnorm/half
          par = half*par
      endif
  endelse

  ;; Test for successful iteration
  if ratio GE 0.0001 then begin
      ;; Successful iteration.  Update x, fvec, and their norms
      x = wa2
      wa2 = diag * x

      fvec = wa4
      xnorm = mpfit_enorm(wa2)
      fnorm = fnorm1
      iter = iter + 1
  endif

  ;; Tests for convergence
  if (abs(actred) LE ftol) AND (prered LE ftol) $
    AND  (0.5D * ratio LE 1) then info = 1
  if delta LE xtol*xnorm then info = 2
  if (abs(actred) LE ftol) AND (prered LE ftol) $
    AND (0.5D * ratio LE 1) AND (info EQ 2) then info = 3
  if info NE 0 then goto, TERMINATE

  ;; Tests for termination and stringent tolerances
  if iter GE maxiter then info = 5
  if (abs(actred) LE MACHEP0) AND (prered LE MACHEP0) $
    AND (0.5*ratio LE 1) then info = 6
  if delta LE MACHEP0*xnorm then info = 7
  if gnorm LE MACHEP0 then info = 8
  if info NE 0 then goto, TERMINATE

  ;; End of inner loop. Repeat if iteration unsuccessful
  if ratio LT 0.0001 then begin
      goto, INNER_LOOP
  endif

  ;; Check for over/underflow
  wh = where(finite(wa1) EQ 0 OR finite(wa2) EQ 0 OR finite(x) EQ 0, ct)
  if ct GT 0 OR finite(ratio) EQ 0 then begin
      FAIL_OVERFLOW:
      errmsg = ('ERROR: parameter or function value(s) have become '+$
                'infinite; check model function for over- '+$
                'and underflow')
      info = -16
      goto, TERMINATE
  endif

  ;; End of outer loop.
  goto, OUTER_LOOP

TERMINATE:
  catch_msg = 'in the termination phase'
  ;; Termination, either normal or user imposed.
  if iflag LT 0 then info = iflag
  iflag = 0
  if n_elements(xnew) EQ 0 then goto, FINAL_RETURN
  if nfree EQ 0 then xnew = xall else xnew[ifree] = x
  if n_elements(qanytied) GT 0 then if qanytied then mpfit_tie, xnew, ptied
  dof = n_elements(fvec) - nfree


  ;; Call the ITERPROC at the end of the fit, if the fit status is
  ;; okay.  Don't call it if the fit failed for some reason.
  if info GT 0 then begin
      
      mperr = 0
      xnew0 = xnew
      
      call_procedure, iterproc, fcn, xnew, iter, fnorm^2, $
        FUNCTARGS=fcnargs, parinfo=parinfo, quiet=quiet, $
        dof=dof, _EXTRA=iterargs
      iflag = mperr

      if iflag LT 0 then begin  
          errmsg = 'WARNING: premature termination by "'+iterproc+'"'
      endif else begin
          ;; If parameters were changed (grrr..) then re-tie
          if max(abs(xnew0-xnew)) GT 0 then begin
              if qanytied then mpfit_tie, xnew, ptied
              x = xnew[ifree]
          endif
      endelse

  endif

  ;; Initialize the number of parameters pegged at a hard limit value
  npegged = 0L
  if n_elements(qanylim) GT 0 then if qanylim then begin
      wh = where((qulim AND (x EQ ulim)) OR $
                 (qllim AND (x EQ llim)), npegged)
  endif

  ;; Calculate final function value (FNORM) and residuals (FVEC)
  if isext EQ 0 AND nprint GT 0 AND info GT 0 then begin
      catch_msg = 'calling '+fcn
      fvec = mpfit_call(fcn, xnew, _EXTRA=fcnargs)
      catch_msg = 'in the termination phase'
      fnorm = mpfit_enorm(fvec)
  endif

  if n_elements(fnorm) EQ 0 AND n_elements(fnorm1) GT 0 then fnorm = fnorm1
  if n_elements(fnorm) GT 0 then fnorm = fnorm^2.

  covar = !values.d_nan
  ;; (very carefully) set the covariance matrix COVAR
  if info GT 0 AND NOT keyword_set(nocovar) $
    AND n_elements(n) GT 0 $
    AND n_elements(fjac) GT 0 AND n_elements(ipvt) GT 0 then begin
      sz = size(fjac)
      if n GT 0 AND sz[0] GT 1 AND sz[1] GE n AND sz[2] GE n $
        AND n_elements(ipvt) GE n then begin
          catch_msg = 'computing the covariance matrix'
          if n EQ 1 then $
            cv = mpfit_covar(reform([fjac[0,0]],1,1), ipvt[0]) $
          else $
            cv = mpfit_covar(fjac[0:n-1,0:n-1], ipvt[0:n-1])
          cv = reform(cv, n, n, /overwrite)
          nn = n_elements(xall)
          
          ;; Fill in actual covariance matrix, accounting for fixed
          ;; parameters.
          covar = replicate(zero, nn, nn)
          for i = 0L, n-1 do begin
              covar[ifree, ifree[i]] = cv[*,i]
          end
          
          ;; Compute errors in parameters
          catch_msg = 'computing parameter errors'
          i = lindgen(nn)
          perror = replicate(abs(covar[0])*0., nn)
          wh = where(covar[i,i] GE 0, ct)
          if ct GT 0 then $
            perror[wh] = sqrt(covar[wh, wh])
      endif
  endif

;  catch_msg = 'returning the result'
;  profvals.mpfit = profvals.mpfit + (systime(1) - prof_start)

  FINAL_RETURN:
  mpfit_fencepost_active = 0
  nfev = mpconfig.nfev
  if n_elements(xnew) EQ 0 then return, !values.d_nan
  return, xnew

  
  ;; ------------------------------------------------------------------
  ;; Alternate ending if the user supplies the function and gradients
  ;; externally
  ;; ------------------------------------------------------------------

  SAVE_STATE:

  catch_msg = 'saving MPFIT state'

  ;; Names of variables to save
  varlist = ['alpha', 'delta', 'diag', 'dwarf', 'factor', 'fnorm', $
             'fjac', 'gnorm', 'nfree', 'ifree', 'ipvt', 'iter', $
             'm', 'n', 'machvals', 'machep0', 'npegged', $
             'whlpeg', 'whupeg', 'nlpeg', 'nupeg', $
             'mpconfig', 'par', 'pnorm', 'qtf', $
             'wa1', 'wa2', 'wa3', 'xnorm', 'x', 'xnew']
  cmd = ''

  ;; Construct an expression that will save them
  for i = 0L, n_elements(varlist)-1 do begin
      ival = 0
      dummy = execute('ival = n_elements('+varlist[i]+')')
      if ival GT 0 then begin
          cmd = cmd + ',' + varlist[i]+':'+varlist[i]
      endif
  endfor
  cmd = 'state = create_struct({'+strmid(cmd,1)+'})'
  state = 0

  if execute(cmd) NE 1 then $
    message, 'ERROR: could not save MPFIT state'

  ;; Set STATUS keyword to prepare for next iteration, and reset init
  ;; so we do not init the next time
  info = 9
  extinit = 0

  return, xnew

end

;+
; NAME:
;   MPFIT2DFUN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Perform Levenberg-Marquardt least-squares fit to a 2-D IDL function
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   parms = MPFIT2DFUN(MYFUNCT, X, Y, Z, ERR, start_parms, ...)
;
; DESCRIPTION:
;
;  MPFIT2DFUN fits a user-supplied model -- in the form of an IDL
;  function -- to a set of user-supplied data.  MPFIT2DFUN calls
;  MPFIT, the MINPACK-1 least-squares minimizer, to do the main
;  work.  MPFIT2DFUN is a specialized version for two-dimensional 
;  data.
;
;  Given the data and their uncertainties, MPFIT2DFUN finds the best set
;  of model parameters which match the data (in a least-squares
;  sense) and returns them in an array.
;  
;  The user must supply the following items:
;   - Two arrays of independent variable values ("X", "Y").
;   - An array of "measured" *dependent* variable values ("Z").
;   - An array of "measured" 1-sigma uncertainty values ("ERR").
;   - The name of an IDL function which computes Z given (X,Y) ("MYFUNCT").
;   - Starting guesses for all of the parameters ("START_PARAMS").
;
;  There are very few restrictions placed on X, Y, Z, or MYFUNCT.
;  Simply put, MYFUNCT must map the (X,Y) values into Z values given
;  the model parameters.  The (X,Y) values are usually the independent
;  X and Y coordinate positions in the two dimensional plane, but need
;  not be.
;
;  MPFIT2DFUN carefully avoids passing large arrays where possible to
;  improve performance.
;
;  See below for an example of usage.
;   
; USER FUNCTION
;
;  The user must define a function which returns the model value.  For
;  applications which use finite-difference derivatives -- the default
;  -- the user function should be declared in the following way:
;
;    FUNCTION MYFUNCT, X, Y, P
;     ; The independent variables are X and Y
;     ; Parameter values are passed in "P"
;     ZMOD = ... computed model values at (X,Y) ...
;     return, ZMOD
;    END
;
;  The returned array YMOD must have the same dimensions and type as
;  the "measured" Z values.
;
;  User functions may also indicate a fatal error condition
;  using the ERROR_CODE common block variable, as described
;  below under the MPFIT_ERROR common block definition.
;
;  See the discussion under "ANALYTIC DERIVATIVES" and AUTODERIVATIVE
;  in MPFIT.PRO if you wish to compute the derivatives for yourself.
;  AUTODERIVATIVE is accepted and passed directly to MPFIT.  The user
;  function must accept one additional parameter, DP, which contains
;  the derivative of the user function with respect to each parameter
;  at each data point, as described in MPFIT.PRO.
;
; CREATING APPROPRIATELY DIMENSIONED INDEPENDENT VARIABLES
;
;  The user must supply appropriate independent variables to
;  MPFIT2DFUN.  For image fitting applications, this variable should
;  be two-dimensional *arrays* describing the X and Y positions of
;  every *pixel*.  [ Thus any two dimensional sampling is permitted,
;  including irregular sampling. ]
;  
;  If the sampling is regular, then the x coordinates are the same for
;  each row, and the y coordinates are the same for each column.  Call
;  the x-row and y-column coordinates XR and YC respectively.  You can
;  then compute X and Y as follows:
;  
;      X = XR # (YC*0 + 1)             eqn. 1
;      Y = (XR*0 + 1) # YC             eqn. 2
;  
;  For example, if XR and YC have the following values:
;  
;    XR = [  1, 2, 3, 4, 5,]  ;; X positions of one row of pixels
;    YC = [ 15,16,17 ]        ;; Y positions of one column of
;                                pixels
;  
;  Then using equations 1 and 2 above will give these values to X and
;  Y:
;  
;     X :  1  2  3  4  5       ;; X positions of all pixels
;          1  2  3  4  5
;          1  2  3  4  5
;  
;     Y : 15 15 15 15 15       ;; Y positions of all pixels
;         16 16 16 16 16
;         17 17 17 17 17
;  
;  Using the above technique is suggested, but *not* required.  You
;  can do anything you wish with the X and Y values.  This technique
;  only makes it easier to compute your model function values.
;
; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD
;
;  The behavior of MPFIT can be modified with respect to each
;  parameter to be fitted.  A parameter value can be fixed; simple
;  boundary constraints can be imposed; limitations on the parameter
;  changes can be imposed; properties of the automatic derivative can
;  be modified; and parameters can be tied to one another.
;
;  These properties are governed by the PARINFO structure, which is
;  passed as a keyword parameter to MPFIT.
;
;  PARINFO should be an array of structures, one for each parameter.
;  Each parameter is associated with one element of the array, in
;  numerical order.  The structure can have the following entries
;  (none are required):
;  
;     .VALUE - the starting parameter value (but see the START_PARAMS
;              parameter for more information).
;  
;     .FIXED - a boolean value, whether the parameter is to be held
;              fixed or not.  Fixed parameters are not varied by
;              MPFIT, but are passed on to MYFUNCT for evaluation.
;  
;     .LIMITED - a two-element boolean array.  If the first/second
;                element is set, then the parameter is bounded on the
;                lower/upper side.  A parameter can be bounded on both
;                sides.  Both LIMITED and LIMITS must be given
;                together.
;  
;     .LIMITS - a two-element float or double array.  Gives the
;               parameter limits on the lower and upper sides,
;               respectively.  Zero, one or two of these values can be
;               set, depending on the values of LIMITED.  Both LIMITED
;               and LIMITS must be given together.
;  
;     .PARNAME - a string, giving the name of the parameter.  The
;                fitting code of MPFIT does not use this tag in any
;                way.  However, the default ITERPROC will print the
;                parameter name if available.
;  
;     .STEP - the step size to be used in calculating the numerical
;             derivatives.  If set to zero, then the step size is
;             computed automatically.  Ignored when AUTODERIVATIVE=0.
;             This value is superceded by the RELSTEP value.
;
;     .RELSTEP - the *relative* step size to be used in calculating
;                the numerical derivatives.  This number is the
;                fractional size of the step, compared to the
;                parameter value.  This value supercedes the STEP
;                setting.  If the parameter is zero, then a default
;                step size is chosen.
;
;     .MPSIDE - the sidedness of the finite difference when computing
;               numerical derivatives.  This field can take four
;               values:
;
;                  0 - one-sided derivative computed automatically
;                  1 - one-sided derivative (f(x+h) - f(x)  )/h
;                 -1 - one-sided derivative (f(x)   - f(x-h))/h
;                  2 - two-sided derivative (f(x+h) - f(x-h))/(2*h)
;
;              Where H is the STEP parameter described above.  The
;              "automatic" one-sided derivative method will chose a
;              direction for the finite difference which does not
;              violate any constraints.  The other methods do not
;              perform this check.  The two-sided method is in
;              principle more precise, but requires twice as many
;              function evaluations.  Default: 0.
;
;     .MPMINSTEP - the minimum change to be made in the parameter
;                  value.  During the fitting process, the parameter
;                  will be changed by multiples of this value.  The
;                  actual step is computed as:
;
;                     DELTA1 = MPMINSTEP*ROUND(DELTA0/MPMINSTEP)
;
;                  where DELTA0 and DELTA1 are the estimated parameter
;                  changes before and after this constraint is
;                  applied.  Note that this constraint should be used
;                  with care since it may cause non-converging,
;                  oscillating solutions.
;
;                  A value of 0 indicates no minimum.  Default: 0.
;
;     .MPMAXSTEP - the maximum change to be made in the parameter
;                  value.  During the fitting process, the parameter
;                  will never be changed by more than this value.
;
;                  A value of 0 indicates no maximum.  Default: 0.
;  
;     .TIED - a string expression which "ties" the parameter to other
;             free or fixed parameters.  Any expression involving
;             constants and the parameter array P are permitted.
;             Example: if parameter 2 is always to be twice parameter
;             1 then use the following: parinfo[2].tied = '2 * P[1]'.
;             Since they are totally constrained, tied parameters are
;             considered to be fixed; no errors are computed for them.
;             [ NOTE: the PARNAME can't be used in expressions. ]
;  
;  Future modifications to the PARINFO structure, if any, will involve
;  adding structure tags beginning with the two letters "MP".
;  Therefore programmers are urged to avoid using tags starting with
;  the same letters; otherwise they are free to include their own
;  fields within the PARINFO structure, and they will be ignored.
;  
;  PARINFO Example:
;  parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $
;                       limits:[0.D,0]}, 5)
;  parinfo[0].fixed = 1
;  parinfo[4].limited(0) = 1
;  parinfo[4].limits(0)  = 50.D
;  parinfo[*].value = [5.7D, 2.2, 500., 1.5, 2000.]
;  
;  A total of 5 parameters, with starting values of 5.7,
;  2.2, 500, 1.5, and 2000 are given.  The first parameter
;  is fixed at a value of 5.7, and the last parameter is
;  constrained to be above 50.
;
;
; COMPATIBILITY
;
;  This function is designed to work with IDL 5.0 or greater.
;  
;  Because TIED parameters rely on the EXECUTE() function, they cannot
;  be used with the free version of the IDL Virtual Machine.
;
;
; INPUTS:
;   MYFUNCT - a string variable containing the name of an IDL
;             function.  This function computes the "model" Z values
;             given the X,Y values and model parameters, as described above.
;
;   X - Array of "X" independent variable values, as described above.
;       These values are passed directly to the fitting function
;       unmodified.
;
;   Y - Array of "Y" independent variable values, as described
;       above. X and Y should have the same data type.
;
;   Z - Array of "measured" dependent variable values.  Z should have
;       the same data type as X and Y.  The function MYFUNCT should
;       map (X,Y)->Z.
;
;   ERR - Array of "measured" 1-sigma uncertainties.  ERR should have
;         the same data type as Z.  ERR is ignored if the WEIGHTS
;         keyword is specified.
;
;   START_PARAMS - An array of starting values for each of the
;                  parameters of the model.  The number of parameters
;                  should be fewer than the number of measurements.
;                  Also, the parameters should have the same data type
;                  as the measurements (double is preferred).
;
;                  This parameter is optional if the PARINFO keyword
;                  is used (see MPFIT).  The PARINFO keyword provides
;                  a mechanism to fix or constrain individual
;                  parameters.  If both START_PARAMS and PARINFO are
;                  passed, then the starting *value* is taken from
;                  START_PARAMS, but the *constraints* are taken from
;                  PARINFO.
; 
; RETURNS:
;
;   Returns the array of best-fit parameters.
;
; KEYWORD PARAMETERS:
;
;   BESTNORM - the value of the summed, squared, weighted residuals
;              for the returned parameter values, i.e. the chi-square value.
;
;   BEST_FJAC - upon return, BEST_FJAC contains the Jacobian, or
;               partial derivative, matrix for the best-fit model.
;               The values are an array,
;               ARRAY(N_ELEMENTS(DEVIATES),NFREE) where NFREE is the
;               number of free parameters.  This array is only
;               computed if /CALC_FJAC is set, otherwise BEST_FJAC is
;               undefined.
;
;               The returned array is such that BEST_FJAC[I,J] is the
;               partial derivative of the model with respect to
;               parameter PARMS[PFREE_INDEX[J]].
;
;   BEST_RESID - upon return, an array of best-fit deviates,
;                normalized by the weights or errors.
;
;   COVAR - the covariance matrix for the set of parameters returned
;           by MPFIT.  The matrix is NxN where N is the number of
;           parameters.  The square root of the diagonal elements
;           gives the formal 1-sigma statistical errors on the
;           parameters IF errors were treated "properly" in MYFUNC.
;           Parameter errors are also returned in PERROR.
;
;           To compute the correlation matrix, PCOR, use this example:
;                  PCOR = COV * 0
;                  FOR i = 0, n-1 DO FOR j = 0, n-1 DO $
;                    PCOR[i,j] = COV[i,j]/sqrt(COV[i,i]*COV[j,j])
;           or equivalently, in vector notation,
;                  PCOR = COV / (PERROR # PERROR)
;
;           If NOCOVAR is set or MPFIT terminated abnormally, then
;           COVAR is set to a scalar with value !VALUES.D_NAN.
;
;   DOF - number of degrees of freedom, computed as
;             DOF = N_ELEMENTS(DEVIATES) - NFREE
;         Note that this doesn't account for pegged parameters (see
;         NPEGGED).
;
;   ERRMSG - a string error or warning message is returned.
;
;   FTOL - a nonnegative input variable. Termination occurs when both
;          the actual and predicted relative reductions in the sum of
;          squares are at most FTOL (and STATUS is accordingly set to
;          1 or 3).  Therefore, FTOL measures the relative error
;          desired in the sum of squares.  Default: 1D-10
;
;   FUNCTARGS - A structure which contains the parameters to be passed
;               to the user-supplied function specified by MYFUNCT via
;               the _EXTRA mechanism.  This is the way you can pass
;               additional data to your user-supplied function without
;               using common blocks.
;
;               By default, no extra parameters are passed to the
;               user-supplied function.
;
;   GTOL - a nonnegative input variable. Termination occurs when the
;          cosine of the angle between fvec and any column of the
;          jacobian is at most GTOL in absolute value (and STATUS is
;          accordingly set to 4). Therefore, GTOL measures the
;          orthogonality desired between the function vector and the
;          columns of the jacobian.  Default: 1D-10
;
;   ITERARGS - The keyword arguments to be passed to ITERPROC via the
;              _EXTRA mechanism.  This should be a structure, and is
;              similar in operation to FUNCTARGS.
;              Default: no arguments are passed.
;
;   ITERPROC - The name of a procedure to be called upon each NPRINT
;              iteration of the MPFIT routine.  It should be declared
;              in the following way:
;
;              PRO ITERPROC, MYFUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $
;                PARINFO=parinfo, QUIET=quiet, ...
;                ; perform custom iteration update
;              END
;         
;              ITERPROC must either accept all three keyword
;              parameters (FUNCTARGS, PARINFO and QUIET), or at least
;              accept them via the _EXTRA keyword.
;          
;              MYFUNCT is the user-supplied function to be minimized,
;              P is the current set of model parameters, ITER is the
;              iteration number, and FUNCTARGS are the arguments to be
;              passed to MYFUNCT.  FNORM should be the
;              chi-squared value.  QUIET is set when no textual output
;              should be printed.  See below for documentation of
;              PARINFO.
;
;              In implementation, ITERPROC can perform updates to the
;              terminal or graphical user interface, to provide
;              feedback while the fit proceeds.  If the fit is to be
;              stopped for any reason, then ITERPROC should set the
;              common block variable ERROR_CODE to negative value (see
;              MPFIT_ERROR common block below).  In principle,
;              ITERPROC should probably not modify the parameter
;              values, because it may interfere with the algorithm's
;              stability.  In practice it is allowed.
;
;              Default: an internal routine is used to print the
;                       parameter values.
;
;   MAXITER - The maximum number of iterations to perform.  If the
;             number is exceeded, then the STATUS value is set to 5
;             and MPFIT returns.
;             Default: 200 iterations
;
;   NFEV - the number of MYFUNCT function evaluations performed.
;
;   NITER - the number of iterations completed.
;
;   NOCOVAR - set this keyword to prevent the calculation of the
;             covariance matrix before returning (see COVAR)
;
;   NPRINT - The frequency with which ITERPROC is called.  A value of
;            1 indicates that ITERPROC is called with every iteration,
;            while 2 indicates every other iteration, etc.  Note that
;            several Levenberg-Marquardt attempts can be made in a
;            single iteration.
;            Default value: 1
;
;   PARINFO - Provides a mechanism for more sophisticated constraints
;             to be placed on parameter values.  When PARINFO is not
;             passed, then it is assumed that all parameters are free
;             and unconstrained.  Values in PARINFO are never 
;             modified during a call to MPFIT.
;
;             See description above for the structure of PARINFO.
;
;             Default value:  all parameters are free and unconstrained.
;
;   PERROR - The formal 1-sigma errors in each parameter, computed
;            from the covariance matrix.  If a parameter is held
;            fixed, or if it touches a boundary, then the error is
;            reported as zero.
;
;            If the fit is unweighted (i.e. no errors were given, or
;            the weights were uniformly set to unity), then PERROR
;            will probably not represent the true parameter
;            uncertainties.  *If* you can assume that the true reduced
;            chi-squared value is unity -- meaning that the fit is
;            implicitly assumed to be of good quality -- then the
;            estimated parameter uncertainties can be computed by
;            scaling PERROR by the measured chi-squared value.
;
;              DOF     = N_ELEMENTS(Z) - N_ELEMENTS(PARMS) ; deg of freedom
;              PCERROR = PERROR * SQRT(BESTNORM / DOF)   ; scaled uncertainties
;
;   PFREE_INDEX - upon return, PFREE_INDEX contains an index array
;                 which indicates which parameter were allowed to
;                 vary.  I.e. of all the parameters PARMS, only
;                 PARMS[PFREE_INDEX] were varied.
;
;   QUIET - set this keyword when no textual output should be printed
;           by MPFIT
;
;   STATUS - an integer status code is returned.  All values greater
;            than zero can represent success (however STATUS EQ 5 may
;            indicate failure to converge).  It can have one of the
;            following values:
;
;	   0  improper input parameters.
;         
;	   1  both actual and predicted relative reductions
;	      in the sum of squares are at most FTOL.
;         
;	   2  relative error between two consecutive iterates
;	      is at most XTOL
;         
;	   3  conditions for STATUS = 1 and STATUS = 2 both hold.
;         
;	   4  the cosine of the angle between fvec and any
;	      column of the jacobian is at most GTOL in
;	      absolute value.
;         
;	   5  the maximum number of iterations has been reached
;         
;	   6  FTOL is too small. no further reduction in
;	      the sum of squares is possible.
;         
;	   7  XTOL is too small. no further improvement in
;	      the approximate solution x is possible.
;         
;	   8  GTOL is too small. fvec is orthogonal to the
;	      columns of the jacobian to machine precision.
;
;   WEIGHTS - Array of weights to be used in calculating the
;             chi-squared value.  If WEIGHTS is specified then the ERR
;             parameter is ignored.  The chi-squared value is computed
;             as follows:
;
;                CHISQ = TOTAL( (Z-MYFUNCT(X,Y,P))^2 * ABS(WEIGHTS) )
;
;             Here are common values of WEIGHTS:
;
;                1D/ERR^2 - Normal weighting (ERR is the measurement error)
;                1D/Z     - Poisson weighting (counting statistics)
;                1D       - Unweighted
;
;   XTOL - a nonnegative input variable. Termination occurs when the
;          relative error between two consecutive iterates is at most
;          XTOL (and STATUS is accordingly set to 2 or 3).  Therefore,
;          XTOL measures the relative error desired in the approximate
;          solution.  Default: 1D-10
;
;   YFIT - the best-fit model function, as returned by MYFUNCT.
;
; EXAMPLE:
;
;   p  = [2.2D, -0.7D, 1.4D, 3000.D]
;   x  = (dindgen(200)*0.1 - 10.) # (dblarr(200) + 1)
;   y  = (dblarr(200) + 1) # (dindgen(200)*0.1 - 10.)
;   zi = gauss2(x, y, p)
;   sz = sqrt(zi>1)
;   z  = zi + randomn(seed, 200, 200) * sz
;
;   p0 = [0D, 0D, 1D, 10D]
;   p = mpfit2dfun('GAUSS2', x, y, z, sz, p0)
;   
;   Generates a synthetic data set with a Gaussian peak, and Poisson
;   statistical uncertainty.  Then the same function (but different
;   starting parameters) is fitted to the data to see how close we can
;   get.
;
;   It is especially worthy to notice that the X and Y values are
;   created as full images, so that a coordinate is attached to each
;   pixel independently.  This is the format that GAUSS2 accepts, and
;   the easiest for you to use in your own functions.
;
;
; COMMON BLOCKS:
;
;   COMMON MPFIT_ERROR, ERROR_CODE
;
;     User routines may stop the fitting process at any time by
;     setting an error condition.  This condition may be set in either
;     the user's model computation routine (MYFUNCT), or in the
;     iteration procedure (ITERPROC).
;
;     To stop the fitting, the above common block must be declared,
;     and ERROR_CODE must be set to a negative number.  After the user
;     procedure or function returns, MPFIT checks the value of this
;     common block variable and exits immediately if the error
;     condition has been set.  By default the value of ERROR_CODE is
;     zero, indicating a successful function/procedure call.
;
;
; REFERENCES:
;
;   MINPACK-1, Jorge More', available from netlib (www.netlib.org).
;   "Optimization Software Guide," Jorge More' and Stephen Wright, 
;     SIAM, *Frontiers in Applied Mathematics*, Number 14.
;
; MODIFICATION HISTORY:
;   Written, transformed from MPFITFUN, 26 Sep 1999, CM
;   Alphabetized documented keywords, 02 Oct 1999, CM
;   Added example, 02 Oct 1999, CM
;   Tried to clarify definitions of X and Y, 29 Oct 1999, CM
;   Added QUERY keyword and query checking of MPFIT, 29 Oct 1999, CM
;   Check to be sure that X, Y and Z are present, 02 Nov 1999, CM
;   Documented PERROR for unweighted fits, 03 Nov 1999, CM
;   Changed to ERROR_CODE for error condition, 28 Jan 2000, CM
;   Copying permission terms have been liberalized, 26 Mar 2000, CM
;   Propagated improvements from MPFIT, 17 Dec 2000, CM
;   Documented RELSTEP field of PARINFO (!!), CM, 25 Oct 2002
;   Add DOF keyword to return degrees of freedom, CM, 23 June 2003
;   Minor documentation adjustment, 03 Feb 2004, CM
;   Fix the example to prevent zero errorbars, 28 Mar 2005, CM
;   Defend against users supplying strangely dimensioned X and Y, 29
;     Jun 2005, CM
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9 Oct 2006
;   Add COMPATIBILITY section, CM, 13 Dec 2007
;   Add keywords BEST_RESIDS, CALC_FJAC, BEST_FJAC, PFREE_INDEX;
;     update some documentation that had become stale, CM, 2010-10-28
;   Better documentation for STATUS, CM, 2016-04-29
;
;  $Id: mpfit2dfun.pro,v 1.13 2016/05/19 16:08:49 cmarkwar Exp $
;-
; Copyright (C) 1997-2000, 2002, 2003, 2004, 2005, 2013, 2016 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; This is the call-back function for MPFIT.  It evaluates the
; function, subtracts the data, and returns the residuals.
function mpfit2dfun_eval, p, dp, _EXTRA=extra

  COMPILE_OPT strictarr
  common mpfit2dfun_common, fcn, x, y, z, err, wts, f, fcnargs

  ;; The function is evaluated here.  There are four choices,
  ;; depending on whether (a) FUNCTARGS was passed to MPFIT2DFUN, which
  ;; is passed to this function as "hf"; or (b) the derivative
  ;; parameter "dp" is passed, meaning that derivatives should be
  ;; calculated analytically by the function itself.
  if n_elements(fcnargs) GT 0 then begin
      if n_params() GT 1 then f = call_function(fcn,x,y,p, dp, _EXTRA=fcnargs)$
      else                    f = call_function(fcn,x,y,p,     _EXTRA=fcnargs)
  endif else begin
      if n_params() GT 1 then f = call_function(fcn,x,y,p, dp) $
      else                    f = call_function(fcn,x,y,p)
  endelse

  ;; Compute the deviates, applying either errors or weights
  if n_elements(err) GT 0 then begin
      result = (z-f)/err
  endif else if n_elements(wts) GT 0 then begin
      result = (z-f)*wts
  endif else begin
      result = (z-f)
  endelse
      
  ;; Make sure the returned result is one-dimensional.
  result = reform(result, n_elements(result), /overwrite)
  return, result
  
end

function mpfit2dfun, fcn, x, y, z, err, p, WEIGHTS=wts, FUNCTARGS=fa, $
                   BESTNORM=bestnorm, nfev=nfev, STATUS=status, $
                   best_resid=best_resid, pfree_index=ifree, $
                   calc_fjac=calc_fjac, best_fjac=best_fjac, $
                   parinfo=parinfo, query=query, $
                   npegged=npegged, nfree=nfree, dof=dof, $
                   covar=covar, perror=perror, niter=iter, yfit=yfit, $
                   quiet=quiet, ERRMSG=errmsg, _EXTRA=extra

  COMPILE_OPT strictarr
  status = 0L
  errmsg = ''

  ;; Detect MPFIT and crash if it was not found
  catch, catcherror
  if catcherror NE 0 then begin
      MPFIT_NOTFOUND:
      catch, /cancel
      message, 'ERROR: the required function MPFIT must be in your IDL path', /info
      return, !values.d_nan
  endif
  if mpfit(/query) NE 1 then goto, MPFIT_NOTFOUND
  catch, /cancel
  if keyword_set(query) then return, 1

  if n_params() EQ 0 then begin
      message, "USAGE: PARMS = MPFIT2DFUN('MYFUNCT', X, Y, ERR, "+ $
        "START_PARAMS, ... )", /info
      return, !values.d_nan
  endif
  if n_elements(x) EQ 0 OR n_elements(y) EQ 0 OR n_elements(z) EQ 0 then begin
      message, 'ERROR: X, Y and Z must be defined', /info
      return, !values.d_nan
  endif

  ;; Use common block to pass data back and forth
  common mpfit2dfun_common, fc, xc, yc, zc, ec, wc, mc, ac
  fc = fcn & xc = x & yc = y & zc = z & mc = 0L
  ;; These optional parameters must be undefined first
  ac = 0 & dummy = size(temporary(ac))
  ec = 0 & dummy = size(temporary(ec))
  wc = 0 & dummy = size(temporary(wc))

  if n_elements(fa) GT 0 then ac = fa
  if n_elements(wts) GT 0 then begin
      wc = sqrt(abs(wts))
  endif else if n_elements(err) GT 0 then begin
      wh = where(err EQ 0, ct)
      if ct GT 0 then begin
          message, 'ERROR: ERROR value must not be zero.  Use WEIGHTS.', $
            /info
          return, !values.d_nan
      endif
      ec = err
  endif

  result = mpfit('mpfit2dfun_eval', p, $
                 parinfo=parinfo, STATUS=status, nfev=nfev, BESTNORM=bestnorm,$
                 covar=covar, perror=perror, niter=iter, $
                 best_resid=best_resid, pfree_index=ifree, $
                 calc_fjac=calc_fjac, best_fjac=best_fjac, $
                 nfree=nfree, npegged=npegged, dof=dof, $
                 ERRMSG=errmsg, quiet=quiet, _EXTRA=extra)

  ;; Retrieve the fit value
  yfit = temporary(mc)
  ;; Some cleanup
  xc = 0 & yc = 0 & zc = 0 & wc = 0 & ec = 0 & mc = 0 & ac = 0

  ;; Print error message if there is one.
  if NOT keyword_set(quiet) AND errmsg NE '' then $
    message, errmsg, /info

  return, result
end
;+
; NAME:
;   MPFIT2DPEAK
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Fit a gaussian, lorentzian or Moffat model to data
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   yfit = MPFIT2DPEAK(Z, A [, X, Y, /TILT ...] )
;
; DESCRIPTION:
;
;   MPFIT2DPEAK fits a gaussian, lorentzian or Moffat model using the
;   non-linear least squares fitter MPFIT.  MPFIT2DPEAK is meant to be
;   a drop-in replacement for IDL's GAUSS2DFIT function (and requires
;   MPFIT and MPFIT2DFUN).
;
;   The choice of the fitting function is determined by the keywords
;   GAUSSIAN, LORENTZIAN and MOFFAT.  By default the gaussian model
;   function is used.  [ The Moffat function is a modified Lorentzian
;   with variable power law index. ]  The two-dimensional peak has
;   independent semimajor and semiminor axes, with an optional
;   rotation term activated by setting the TILT keyword.  The baseline
;   is assumed to be a constant.
;
;      GAUSSIAN      A[0] + A[1]*exp(-0.5*u)
;      LORENTZIAN    A[0] + A[1]/(u + 1)
;      MOFFAT        A[0] + A[1]/(u + 1)^A[7]
;
;      u = ( (x-A[4])/A[2] )^2 + ( (y-A[5])/A[3] )^2
;
;         where x and y are cartesian coordinates in rotated
;         coordinate system if TILT keyword is set.
;
;   The returned parameter array elements have the following meanings:
;
;      A[0]   Constant baseline level
;      A[1]   Peak value
;      A[2]   Peak half-width (x) -- gaussian sigma or half-width at half-max
;      A[3]   Peak half-width (y) -- gaussian sigma or half-width at half-max
;      A[4]   Peak centroid (x)
;      A[5]   Peak centroid (y)
;      A[6]   Rotation angle (radians) if TILT keyword set
;      A[7]   Moffat power law index if MOFFAT keyword set
;
;   By default the initial starting values for the parameters A are
;   estimated from the data.  However, explicit starting values can be
;   supplied using the ESTIMATES keyword.  Also, error or weighting
;   values can optionally be provided; otherwise the fit is
;   unweighted.
;
; RESTRICTIONS:
;
;   If no starting parameter ESTIMATES are provided, then MPFIT2DPEAK
;   attempts to estimate them from the data.  This is not a perfect
;   science; however, the author believes that the technique
;   implemented here is more robust than the one used in IDL's
;   GAUSS2DFIT.  The author has tested cases of strong peaks, noisy
;   peaks and broad peaks, all with success.
;
;   Note that if PARINFO is supplied, PARINFO(*).VALUES is ignored.
;   If you wish to supply starting values, use the ESTIMATES keyword.
;
;   MPFIT2DPEAK works in two steps.  First, it computes initial
;   ESTIMATES if none are provided, not using MPFIT.  Second, it uses
;   the initial ESTIMATES to fit a refined solution using MPFIT.  The
;   first step, initial estimates, is not required to match any
;   constraints supplied with the PARINFO keyword parameter.  Thus, if
;   you don't supply ESTIMATES but do supply PARINFO, it is possible
;   for MPFIT to fail with an error that parameters exceed their
;   PARINFO limits.  To avoid this situation, call MPFIT2DPEAK with
;   ESTIMATES explicitly.
;
; COMPATIBILITY
;
;  This function is designed to work with IDL 5.0 or greater.
;  
;  Because TIED parameters rely on the EXECUTE() function, they cannot
;  be used with the free version of the IDL Virtual Machine.
;
;
; INPUTS:
;
;   Z - Two dimensional array of "measured" dependent variable values.
;       Z should be of the same type and dimension as (X # Y).
;
;   X - Optional vector of x positions for a single row of Z.
;
;          X[i] should provide the x position of Z[i,*]
;
;       Default: X values are integer increments from 0 to NX-1
;
;   Y - Optional vector of y positions for a single column of Z.
;
;          Y[j] should provide the y position of Z[*,j]
;
;       Default: Y values are integer increments from 0 to NY-1
;
; OUTPUTS:
;   A - Upon return, an array of best fit parameter values.  See the
;       table above for the meanings of each parameter element.
;
;
; RETURNS:
;
;   Returns the best fitting model function as a 2D array.
;
; KEYWORDS:
;
;   ** NOTE ** Additional keywords such as PARINFO, BESTNORM, and
;              STATUS are accepted by MPFIT2DPEAK but not documented
;              here.  Please see the documentation for MPFIT for the
;              description of these advanced options.
;
;   CHISQ - the value of the summed squared residuals for the
;           returned parameter values.
;
;   CIRCULAR - if set, then the peak profile is assumed to be
;              azimuthally symmetric.  When set, the parameters A[2)
;              and A[3) will be identical and the TILT keyword will
;              have no effect.
;
;   DOF - number of degrees of freedom, computed as
;             DOF = N_ELEMENTS(DEVIATES) - NFREE
;         Note that this doesn't account for pegged parameters (see
;         NPEGGED).
;
;   ERROR - upon input, the measured 1-sigma uncertainties in the "Z"
;           values.  If no ERROR or WEIGHTS are given, then the fit is
;           unweighted.
;
;   ESTIMATES - Array of starting values for each parameter of the
;               model.  If ESTIMATES is not set, then the starting
;               values are estimated from the data directly, before
;               fitting.  (This also means that PARINFO.VALUES is
;               ignored.)
;               Default: not set - parameter values are estimated from data.
;
;   GAUSSIAN - if set, fit a gaussian model function.  The Default.
;   LORENTZIAN - if set, fit a lorentzian model function.
;   MOFFAT - if set, fit a Moffat model function.
;
;   MEASURE_ERRORS - synonym for ERRORS, for consistency with built-in
;                    IDL fitting routines.
;
;   NEGATIVE - if set, and ESTIMATES is not provided, then MPFIT2DPEAK
;              will assume that a negative peak is present -- a
;              valley.  Specifying this keyword is not normally
;              required, since MPFIT2DPEAK can determine this
;              automatically.
;
;   NFREE - the number of free parameters in the fit.  This includes
;           parameters which are not FIXED and not TIED, but it does
;           include parameters which are pegged at LIMITS.
;
;   PERROR - upon return, the 1-sigma uncertainties of the parameter
;            values A.  These values are only meaningful if the ERRORS
;            or WEIGHTS keywords are specified properly.
;
;            If the fit is unweighted (i.e. no errors were given, or
;            the weights were uniformly set to unity), then PERROR
;            will probably not represent the true parameter
;            uncertainties.  
;
;            *If* you can assume that the true reduced chi-squared
;            value is unity -- meaning that the fit is implicitly
;            assumed to be of good quality -- then the estimated
;            parameter uncertainties can be computed by scaling PERROR
;            by the measured chi-squared value.
;
;              DOF     = N_ELEMENTS(Z) - N_ELEMENTS(A)   ; deg of freedom
;              PCERROR = PERROR * SQRT(BESTNORM / DOF)   ; scaled uncertainties
;
;   QUIET - if set then diagnostic fitting messages are suppressed.
;           Default: QUIET=1 (i.e., no diagnostics)
;
;   SIGMA - synonym for PERROR (1-sigma parameter uncertainties), for
;           compatibility with GAUSSFIT.  Do not confuse this with the
;           Gaussian "sigma" width parameter.
;
;   TILT - if set, then the major and minor axes of the peak profile
;          are allowed to rotate with respect to the image axes.
;          Parameter A[6] will be set to the clockwise rotation angle
;          of the A[2] axis in radians.
;
;   WEIGHTS - Array of weights to be used in calculating the
;             chi-squared value.  If WEIGHTS is specified then the ERR
;             parameter is ignored.  The chi-squared value is computed
;             as follows:
;
;                CHISQ = TOTAL( (Z-MYFUNCT(X,Y,P))^2 * ABS(WEIGHTS) )
;
;             Here are common values of WEIGHTS:
;
;                1D/ERR^2 - Normal weighting (ERR is the measurement error)
;                1D/Y     - Poisson weighting (counting statistics)
;                1D       - Unweighted
;
;             The ERROR keyword takes precedence over any WEIGHTS
;             keyword values.  If no ERROR or WEIGHTS are given, then
;             the fit is unweighted.
;
;
; EXAMPLE:
;
; ; Construct a sample gaussian surface in range [-5,5] centered at [2,-3]
;   x = findgen(100)*0.1 - 5. & y = x
;   xx = x # (y*0 + 1)
;   yy = (x*0 + 1) # y
;   rr = sqrt((xx-2.)^2 + (yy+3.)^2)
;
; ; Gaussian surface with sigma=0.5, peak value of 3, noise with sigma=0.2
;   z = 3.*exp(-(rr/0.5)^2) + randomn(seed,100,100)*.2
;
; ; Fit gaussian parameters A
;   zfit = mpfit2dpeak(z, a, x, y)
;
; REFERENCES:
;
;   MINPACK-1, Jorge More', available from netlib (www.netlib.org).
;   "Optimization Software Guide," Jorge More' and Stephen Wright, 
;     SIAM, *Frontiers in Applied Mathematics*, Number 14.
;
; MODIFICATION HISTORY:
;
;   New algorithm for estimating starting values, CM, 31 Oct 1999
;   Documented, 02 Nov 1999
;   Small documentation fixes, 02 Nov 1999
;   Documented PERROR for unweighted fits, 03 Nov 1999, CM
;   Copying permission terms have been liberalized, 26 Mar 2000, CM
;   Small cosmetic changes, 21 Sep 2000, CM
;   Corrected bug introduced by cosmetic changes, 11 Oct 2000, CM :-)
;   Added POSITIVE keyword, 17 Nov 2000, CM
;   Removed TILT in common, in favor of FUNCTARGS approach, 23 Nov
;     2000, CM
;   Added SYMMETRIC keyword, documentation for TILT, and an example,
;     24 Nov 2000, CM
;   Changed SYMMETRIC to CIRCULAR, 17 Dec 2000, CM
;   Really change SYMMETRIC to CIRCULAR!, 13 Sep 2002, CM
;   Add error messages for SYMMETRIC and CIRCLE, 08 Nov 2002, CM
;   Make more consistent with comparable IDL routines, 30 Jun 2003, CM
;   Defend against users supplying strangely dimensioned X and Y, 29
;     Jun 2005, CM
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9 Oct 2006
;   Add COMPATIBILITY section, CM, 13 Dec 2007
;   Clarify documentation regarding what happens when ESTIMATES is not
;     set, CM, 14 Dec 2008
;   Add more documentation about the interaction of ESTIMATES and
;     PARINFO, CM, 2013-05-28
;
;  $Id: mpfit2dpeak.pro,v 1.11 2013/07/18 03:25:40 cmarkwar Exp $
;-
; Copyright (C) 1997-2000, 2002, 2003, 2005, 2006, 2007, 2008, 2013 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; Compute the "u" value = (x/a)^2 + (y/b)^2 with optional rotation
function mpfit2dpeak_u, x, y, p, tilt=tilt, symmetric=sym
  COMPILE_OPT strictarr
  widx  = abs(p[2]) > 1e-20 & widy  = abs(p[3]) > 1e-20 
  if keyword_set(sym) then widy = widx
  xp    = x-p[4]            & yp    = y-p[5]
  theta = p[6]
  if keyword_set(tilt) AND theta NE 0 then begin
      c  = cos(theta) & s  = sin(theta)
      return, ( (xp * (c/widx) - yp * (s/widx))^2 + $
                (xp * (s/widy) + yp * (c/widy))^2 )
  endif else begin
      return, (xp/widx)^2 + (yp/widy)^2
  endelse

end

; Gaussian Function
function mpfit2dpeak_gauss, x, y, p, tilt=tilt, symmetric=sym, _extra=extra
  COMPILE_OPT strictarr
  sz = size(x)
  if sz[sz[0]+1] EQ 5 then smax = 26D else smax = 13.

  u = mpfit2dpeak_u(x, y, p, tilt=keyword_set(tilt), symmetric=keyword_set(sym))
  mask = u LT (smax^2)  ;; Prevents floating underflow
  return, p[0] + p[1] * mask * exp(-0.5 * u * mask)
end

; Lorentzian Function
function mpfit2dpeak_lorentz, x, y, p, tilt=tilt, symmetric=sym, _extra=extra
  COMPILE_OPT strictarr
  u = mpfit2dpeak_u(x, y, p, tilt=keyword_set(tilt), symmetric=keyword_set(sym))
  return, p[0] + p[1] / (u + 1)
end

; Moffat Function
function mpfit2dpeak_moffat, x, y, p, tilt=tilt, symmetric=sym, _extra=extra
  COMPILE_OPT strictarr
  u = mpfit2dpeak_u(x, y, p, tilt=keyword_set(tilt), symmetric=keyword_set(sym))
  return, p[0] + p[1] / (u + 1)^p[7]
end

function mpfit2dpeak, z, a, x, y, estimates=est, tilt=tilt, $
                      gaussian=gauss, lorentzian=lorentz, moffat=moffat, $
                      perror=perror, sigma=sigma, zerror=zerror, $
                      chisq=chisq, bestnorm=bestnorm, niter=iter, nfev=nfev, $
                      error=dz, weights=weights, measure_errors=dzm, $
                      nfree=nfree, dof=dof, $
                      negative=neg, parinfo=parinfo, $
                      circular=sym, circle=badcircle1, symmetric=badcircle2, $
                      errmsg=errmsg, status=status, $
                      query=query, quiet=quiet, _extra=extra

  COMPILE_OPT strictarr
  status = 0L
  errmsg = ''

  ;; Detect MPFIT and crash if it was not found
  catch, catcherror
  if catcherror NE 0 then begin
      MPFIT_NOTFOUND:
      catch, /cancel
      message, 'ERROR: the required functions MPFIT and MPFIT2DFUN ' + $
        'must be in your IDL path', /info
      return, !values.d_nan
  endif
  if mpfit(/query)      NE 1 then goto, MPFIT_NOTFOUND
  if mpfit2dfun(/query) NE 1 then goto, MPFIT_NOTFOUND
  catch, /cancel
  if keyword_set(query) then return, 1

  if keyword_set(badcircle1) OR keyword_set(badcircle2) then $
    message, 'ERROR: do not use the CIRCLE or SYMMETRIC keywords.  ' +$
    'Use CIRCULAR instead.'

  ;; Reject too few data
  if n_elements(z) LT 8 then begin
      message, 'ERROR: array must have at least eight elements', /info
      return, !values.d_nan
  endif

  sz = size(z)
  if sz[0] LT 2 then begin
      message, 'ERROR: array must be 2-dimensional', /info
      return, !values.d_nan
  endif
  nx = sz[1]
  ny = sz[2]
  
  ;; Fill in the X and Y values if needed -- note clever promotion to
  ;;                                         double if needed
  if n_elements(x) EQ 0 then x = findgen(nx)*(z[0]*0+1)
  if n_elements(y) EQ 0 then y = findgen(ny)*(z[0]*0+1)
  if n_elements(x) LT nx then begin
      message, 'ERROR: X array was not large enough', /info
      return, !values.d_nan
  endif
  if n_elements(y) LT ny then begin
      message, 'ERROR: Y array was not large enough', /info
      return, !values.d_nan
  endif

  ;; Make 2D arrays of X and Y values -- if the user hasn't done it
  if n_elements(x) NE n_elements(z) then   xx = x[*] # (y[*]*0 + 1)   else xx = x
  if n_elements(y) NE n_elements(z) then   yy = (x[*]*0 + 1) # y[*]   else yy = y

  ;; Compute the weighting factors to use
  if (n_elements(dz) EQ 0 AND n_elements(weights) EQ 0 AND $
      n_elements(dzm) EQ 0) then begin
      weights = z*0+1        ;; Unweighted by default
  endif else if n_elements(dz) GT 0 then begin
      weights = dz * 0   ;; Avoid division by zero
      wh = where(dz NE 0, ct)
      if ct GT 0 then weights[wh] = 1./dz[wh]^2
  endif else if n_elements(dzm) GT 0 then begin
      weights = dzm * 0   ;; Avoid division by zero
      wh = where(dzm NE 0, ct)
      if ct GT 0 then weights[wh] = 1./dzm[wh]^2
  endif

  if n_elements(est) EQ 0 then begin
      ;; Here is the secret - the width is estimated based on the volume
      ;; above/below the average.  Thus, as the signal becomes more
      ;; noisy the width automatically broadens as it should.

      maxx = max(x, min=minx) & maxy = max(y, min=miny)
      maxz = max(z, whmax)    & minz = min(z, whmin)
      nx = n_elements(x)
      dx = 0.5 * [x[1]-x[0], x[2:*] - x, x[nx-1] - x[nx-2]]
      ny = n_elements(y)
      dy = 0.5 * [y[1]-y[0], y[2:*] - y, y[ny-1] - y[ny-2]]
      ;; Compute cell areas
      da = dx # dy

      totvol = total(da*z)               ;; Total volume under curve
      av = totvol/(total(dx)*total(dy))  ;; Average height

      ;; Compute the spread in values above and below average... we
      ;; take the narrowest one as the one with the peak
      wh   = where(z GE av, ct1)
      sdx1 = total(xx[wh]^2)/ct1 - (total(xx[wh])/ct1)^2
      sdy1 = total(yy[wh]^2)/ct1 - (total(yy[wh])/ct1)^2
      wh   = where(z LE av, ct2)
      sdx2 = total(xx[wh]^2)/ct2 - (total(xx[wh])/ct2)^2
      sdy2 = total(yy[wh]^2)/ct2 - (total(yy[wh])/ct2)^2
      wh   = 0  ;; conserve memory

      if keyword_set(pos) then goto, POS_PEAK
      if keyword_set(neg) then goto, NEG_PEAK

      ;; Compute volume above/below average
      if (sdx1 LT sdx2 AND sdy1 LT sdy2) then begin 
          ;; Positive peak
          POS_PEAK:
          centx = xx[whmax]
          centy = yy[whmax]
          peakz = maxz - av
      endif else if (sdx1 GT sdx2 AND sdy1 GT sdy2) then begin 
          ;; Negative peak
          NEG_PEAK:
          centx = xx[whmin]
          centy = yy[whmin]
          peakz = minz - av
      endif else begin
          ;; Ambiguous case
          if abs(maxz - av) GT (minz - av) then goto, POS_PEAK $
          else                                  goto, NEG_PEAK
      endelse
      peakvol = totvol - total(da*(z<av))
      width   = sqrt(peakvol / (6*abs(peakz)))

      est = [av, peakz, width, width, centx, centy, 0, 1]
      guess = 1
  endif

  ;; Check the number of parameter estimates
  if n_elements(quiet) EQ 0 then quiet=1

  np = 7
  ;; Parameter checking for individual function types
  if keyword_set(moffat) then begin               ;; MOFFAT
      fun = 'mpfit2dpeak_moffat'
      np = 8
  endif else if keyword_set(lorentz) then begin  ;; LORENTZIAN
      fun = 'mpfit2dpeak_lorentz'
  endif else begin                               ;; GAUSSIAN
      fun = 'mpfit2dpeak_gauss'
  endelse
  if n_elements(est) LT np then begin
      message, 'ERROR: parameter ESTIMATES must have at least '+strtrim(np,2)+$
        ' elements', /info
      return, !values.d_nan
  endif
  p0 = replicate(est[0]*0, np > n_elements(est))
  p0[0] = est

  ;; Function call
  fargs = {tilt: keyword_set(tilt), symmetric: keyword_set(sym)}
  a = mpfit2dfun(fun, xx, yy, z, 0, p0[0:np-1], weights=weights, $
                 bestnorm=bestnorm, nfev=nfev, status=status, $
                 parinfo=parinfo, perror=perror, niter=iter, yfit=yfit, $
                 quiet=quiet, errmsg=errmsg, nfree=nfree, dof=dof, $
                 functargs=fargs, _EXTRA=extra)

  ;; Print error message if there is one.
  if NOT keyword_set(quiet) AND errmsg NE '' then $
    message, errmsg, /info

  ;; Make sure the parameters are sane
  if status NE 0 then begin
      ;; Width is positive
      a[2] = abs(a[2])
      a[3] = abs(a[3])
      if keyword_set(sym) then a[3] = a[2]
      ;; Make sure that theta is in the range [0,pi]
      a[6] = ((a[6] MOD !dpi) + 2*!dpi) MOD !dpi
      a = a[0:np-1]

      if n_elements(perror)   GT 0 then sigma = perror
      if n_elements(bestnorm) GT 0 then chisq = bestnorm

      if n_elements(yfit) EQ nx*ny then begin
          yfit = reform(yfit, nx, ny, /overwrite)
      endif

      zerror = a[0]*0
      if n_elements(dof) GT 0 AND dof[0] GT 0 then begin
          zerror[0] = sqrt( total( (z-yfit)^2 ) / dof[0] )
      endif

      return, yfit
  endif

  return, !values.d_nan
end

;+
; NAME:
;   MPFITELLIPSE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Approximate fit to points forming an ellipse
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   parms = MPFITELLIPSE(X, Y, start_parms, [/TILT, WEIGHTS=wts, ...])
;
; DESCRIPTION:
;
;   MPFITELLIPSE fits a closed elliptical or circular curve to a two
;   dimensional set of data points.  The user specifies the X and Y
;   positions of the points, and an optional set of weights.  The
;   ellipse may also be tilted at an arbitrary angle.
;
;   IMPORTANT NOTE: this fitting program performs simple ellipse
;   fitting.  It will not work well for ellipse data with high
;   eccentricity.  More robust answers can usually be obtained with
;   "orthogonal distance regression."  (See FORTRAN package ODRPACK on
;   netlib.org for more information).
;
;   The best fitting ellipse parameters are returned from by
;   MPFITELLIPSE as a vector, whose values are:
;
;      P[0]   Ellipse semi axis 1
;      P[1]   Ellipse semi axis 2   ( = P[0] if CIRCLE keyword set)
;      P[2]   Ellipse center - x value
;      P[3]   Ellipse center - y value
;      P[4]   Ellipse rotation angle (radians) if TILT keyword set
;
;   If the TILT keyword is set, then the P[0] is meant to be the
;   semi-major axis, and P[1] is the semi-minor axis, and P[4]
;   represents the tilt of the semi-major axis with respect to the X
;   axis.  If the TILT keyword is not set, the P[0] and P[1] represent
;   the ellipse semi-axes in the X and Y directions, respectively.
;   The returned semi-axis lengths should always be positive.
;
;   The user may specify an initial set of trial parameters, but by
;   default MPFITELLIPSE will estimate the parameters automatically.
;
;   Users should be aware that in the presence of large amounts of
;   noise, namely when the measurement error becomes significant
;   compared to the ellipse axis length, then the estimated parameters
;   become unreliable.  Generally speaking the computed axes will
;   overestimate the true axes.  For example when (SIGMA_R/R) becomes
;   0.5, the radius of the ellipse is overestimated by about 40%.
;
;   This unreliability is also pronounced if the ellipse has high
;   eccentricity, as noted above.
;
;   Users can weight their data as they see appropriate.  However, the
;   following prescription for the weighting may serve as a good
;   starting point, and appeared to produce results comparable to the
;   typical chi-squared value.
;
;     WEIGHTS = 0.75/(SIGMA_X^2 + SIGMA_Y^2)
;
;   where SIGMA_X and SIGMA_Y are the measurement error vectors in the
;   X and Y directions respectively.  However, this has not been
;   robustly tested, and it should be pointed out that this weighting
;   may only be appropriate for a set of points whose measurement
;   errors are comparable.  If a more robust estimation of the
;   parameter values is needed, the so-called orthogonal distance
;   regression package should be used (ODRPACK, available in FORTRAN
;   at www.netlib.org).
;
; INPUTS:
;
;   X - measured X positions of the points in the ellipse.
;   Y - measured Y positions of the points in the ellipse.
;
;   START_PARAMS - an array of starting values for the ellipse
;                  parameters, as described above.  This parameter is
;                  optional; if not specified by the user, then the
;                  ellipse parameters are estimated automatically from
;                  the properties of the data.
;
; RETURNS:
;
;   Returns the best fitting model ellipse parameters.  Returned
;   values are undefined if STATUS indicates an error condition.
;
; KEYWORDS:
;
;   ** NOTE ** Additional keywords such as PARINFO, BESTNORM, and
;              STATUS are accepted by MPFITELLIPSE but not documented
;              here.  Please see the documentation for MPFIT for the
;              description of these advanced options.
;
;   CIRCULAR - if set, then the curve is assumed to be a circle
;              instead of ellipse.  When set, the parameters P[0] and
;              P[1] will be identical and the TILT keyword will have
;              no effect.
;
;   PERROR - upon return, the 1-sigma uncertainties of the returned
;            ellipse parameter values.  These values are only
;            meaningful if the WEIGHTS keyword is specified properly.
;
;            If the fit is unweighted (i.e. no errors were given, or
;            the weights were uniformly set to unity), then PERROR
;            will probably not represent the true parameter
;            uncertainties.
;
;            If STATUS indicates an error condition, then PERROR is
;            undefined.
;
;   QUIET - if set then diagnostic fitting messages are suppressed.
;           Default: QUIET=1 (i.e., no diagnostics]
;
;   STATUS - an integer status code is returned.  All values greater
;            than zero can represent success (however STATUS EQ 5 may
;            indicate failure to converge).  Please see MPFIT for
;            the definitions of status codes.
;
;   TILT - if set, then the major and minor axes of the ellipse
;          are allowed to rotate with respect to the data axes.
;          Parameter P[4] will be set to the clockwise rotation angle
;          of the P[0] axis in radians, as measured from the +X axis.
;          P[4] should be in the range 0 to !dpi.
;
;   WEIGHTS - Array of weights to be used in calculating the
;             chi-squared value.  The chi-squared value is computed
;             as follows:
;
;                CHISQ = TOTAL( (Z-MYFUNCT(X,Y,P))^2 * ABS(WEIGHTS)^2 )
;
;             Users may wish to follow the guidelines for WEIGHTS
;             described above.
;
;
; EXAMPLE:
;
; ; Construct a set of points on an ellipse, with some noise
;   ph0 = 2*!pi*randomu(seed,50)
;   x =  50. + 32.*cos(ph0) + 4.0*randomn(seed, 50)
;   y = -75. + 65.*sin(ph0) + 0.1*randomn(seed, 50)
;
; ; Compute weights function
;   weights = 0.75/(4.0^2 + 0.1^2)
;
; ; Fit ellipse and plot result
;   p = mpfitellipse(x, y)
;   phi = dindgen(101)*2D*!dpi/100
;   plot, x, y, psym=1
;   oplot, p[2]+p[0]*cos(phi), p[3]+p[1]*sin(phi), color='ff'xl
;
; ; Fit ellipse and plot result - WITH TILT
;   p = mpfitellipse(x, y, /tilt)
;   phi = dindgen(101)*2D*!dpi/100
;   ; New parameter P[4] gives tilt of ellipse w.r.t. coordinate axes
;   ; We must rotate a standard ellipse to this new orientation
;   xm = p[2] + p[0]*cos(phi)*cos(p[4]) + p[1]*sin(phi)*sin(p[4])
;   ym = p[3] - p[0]*cos(phi)*sin(p[4]) + p[1]*sin(phi)*cos(p[4])
;
;   plot, x, y, psym=1
;   oplot, xm, ym, color='ff'xl
;
; REFERENCES:
;
;   MINPACK-1, Jorge More', available from netlib (www.netlib.org).
;   "Optimization Software Guide," Jorge More' and Stephen Wright, 
;     SIAM, *Frontiers in Applied Mathematics*, Number 14.
;
; MODIFICATION HISTORY:
;
;   Ported from MPFIT2DPEAK, 17 Dec 2000, CM
;   More documentation, 11 Jan 2001, CM
;   Example corrected, 18 Nov 2001, CM
;   Change CIRCLE keyword to the correct CIRCULAR keyword, 13 Sep
;      2002, CM
;   Add error messages for SYMMETRIC and CIRCLE, 08 Nov 2002, CM
;   Found small error in computation of _EVAL (when CIRCULAR) was set;
;      sanity check when CIRCULAR is set, 21 Jan 2003, CM
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9
;     Oct 2006
;   Add disclaimer about the suitability of this program for fitting
;     ellipses, 17 Sep 2007, CM
;   Clarify documentation of TILT angle; make sure output contains
;    semi-major axis first, followed by semi-minor; make sure that
;    semi-axes are always positive (and can handle negative inputs)
;      17 Sep 2007, CM
;   Output tilt angle is now in range 0 to !DPI, 20 Sep 2007, CM
;   Some documentation clarifications, including to remove reference
;     to the "ERR" keyword, which does not exist, 17 Jan 2008, CM
;   Swapping of P[0] and P[1] only occurs if /TILT is set, 06 Nov
;     2009, CM
;   Document an example of how to plot a tilted ellipse, 09 Nov 2009, CM
;   Check for MPFIT error conditions and return immediately, 23 Jan 2010, CM
;
;  $Id: mpfitellipse.pro,v 1.14 2010/01/25 03:38:03 craigm Exp $
;-
; Copyright (C) 1997-2000,2002,2003,2007,2008,2009,2010 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; Compute the "u" value = (x/a)^2 + (y/b)^2 with optional rotation
function mpfitellipse_u, x, y, p, tilt=tilt, circle=circle
  COMPILE_OPT strictarr
  widx  = abs(p[0]) > 1e-20 & widy  = abs(p[1]) > 1e-20 
  if keyword_set(circle) then widy  = widx
  xp    = x-p[2]            & yp    = y-p[3]
  theta = p[4]

  if keyword_set(tilt) AND theta NE 0 then begin
      c  = cos(theta) & s  = sin(theta)
      return, ( (xp * (c/widx) - yp * (s/widx))^2 + $
                (xp * (s/widy) + yp * (c/widy))^2 )
  endif else begin
      return, (xp/widx)^2 + (yp/widy)^2
  endelse

end

; This is the call-back function for MPFIT.  It evaluates the
; function, subtracts the data, and returns the residuals.
function mpfitellipse_eval, p, tilt=tilt, circle=circle, _EXTRA=extra

  COMPILE_OPT strictarr
  common mpfitellipse_common, xy, wc

  tilt = keyword_set(tilt) 
  circle = keyword_set(circle)
  u2 = mpfitellipse_u(xy[*,0], xy[*,1], p, tilt=tilt, circle=circle) - 1.

  if n_elements(wc) GT 0 then begin
      if circle then u2 = sqrt(abs(p[0]*p[0]*wc))*u2 $
      else           u2 = sqrt(abs(p[0]*p[1]*wc))*u2 
  endif

  return, u2
end

function mpfitellipse, x, y, p0, WEIGHTS=wts, $
                       BESTNORM=bestnorm, nfev=nfev, STATUS=status, $
                       tilt=tilt, circular=circle, $
                       circle=badcircle1, symmetric=badcircle2, $
                       parinfo=parinfo, query=query, $
                       covar=covar, perror=perror, niter=iter, $
                       quiet=quiet, ERRMSG=errmsg, _EXTRA=extra

  COMPILE_OPT strictarr
  status = 0L
  errmsg = ''

  ;; Detect MPFIT and crash if it was not found
  catch, catcherror
  if catcherror NE 0 then begin
      MPFIT_NOTFOUND:
      catch, /cancel
      message, 'ERROR: the required function MPFIT must be in your IDL path', /info
      return, !values.d_nan
  endif
  if mpfit(/query) NE 1 then goto, MPFIT_NOTFOUND
  catch, /cancel
  if keyword_set(query) then return, 1

  if n_params() EQ 0 then begin
      message, "USAGE: PARMS = MPFITELLIPSE(X, Y, START_PARAMS, ... )", $
        /info
      return, !values.d_nan
  endif
  nx = n_elements(x) & ny = n_elements(y)
  if (nx EQ 0) OR (ny EQ 0) OR (nx NE ny) then begin
      message, 'ERROR: X and Y must have the same number of elements', /info
      return, !values.d_nan
  endif

  if keyword_set(badcircle1) OR keyword_set(badcircle2) then $
    message, 'ERROR: do not use the CIRCLE or SYMMETRIC keywords.  ' +$
    'Use CIRCULAR instead.'

  p = make_array(5, value=x[0]*0)

  if n_elements(p0) GT 0 then begin
      p[0] = p0
      if keyword_set(circle) then p[1] = p[0]
  endif else begin
      mx = moment(x)
      my = moment(y)
      p[0] = [sqrt(mx[1]), sqrt(my[1]), mx[0], my[0], 0]
      if keyword_set(circle) then $
        p[0:1] = sqrt(mx[1]+my[1])
  endelse

  common mpfitellipse_common, xy, wc
  if n_elements(wts) GT 0 then begin
      wc = abs(wts)
  endif else begin
      wc = 0 & dummy = temporary(wc)
  endelse

  xy = [[x],[y]]

  nfev = 0L & dummy = temporary(nfev)
  covar = 0 & dummy = temporary(covar)
  perror = 0 & dummy = temporary(perror)
  status = 0
  result = mpfit('mpfitellipse_eval', p, $
                 parinfo=parinfo, STATUS=status, nfev=nfev, BESTNORM=bestnorm,$
                 covar=covar, perror=perror, niter=iter, $
                 functargs={circle:keyword_set(circle), tilt:keyword_set(tilt)},$
                 ERRMSG=errmsg, quiet=quiet, _EXTRA=extra)

  ;; Print error message if there is one.
  if NOT keyword_set(quiet) AND errmsg NE '' then $
    message, errmsg, /info
  ;; Return if there is an error condition
  if status LE 0 then return, result

  ;; Sanity check on resulting parameters
  if keyword_set(circle) then begin
      result[1] = result[0]
      perror[1] = perror[0]
  endif
  if NOT keyword_set(tilt) then begin
      result[4] = 0
      perror[4] = 0
  endif

  ;; Make sure the axis lengths are positive, and the semi-major axis
  ;; is listed first
  result[0:1] = abs(result[0:1])
  if abs(result[0]) LT abs(result[1]) AND keyword_set(tilt) then begin
      tmp = result[0] & result[0] = result[1] & result[1] = tmp
      tmp = perror[0] & perror[0] = perror[1] & perror[1] = tmp
      result[4] = result[4] - !dpi/2d
  endif

  if keyword_set(tilt) then begin
      ;; Put tilt in the range 0 to +Pi
      result[4] = result[4] - !dpi * floor(result[4]/!dpi)
  endif

  return, result
end

;+
; NAME:
;   MPFITEXPR
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Perform Levenberg-Marquardt least-squares fit to arbitrary expression
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   MYFUNCT = 'X*(1-X)+3'
;   parms = MPFITEXPR(MYFUNCT, XVAL, YVAL, ERR, start_parms, ...)
;
; DESCRIPTION:
;
;  MPFITEXPR fits a user-supplied model -- in the form of an arbitrary IDL
;  expression -- to a set of user-supplied data.  MPFITEXPR calls
;  MPFIT, the MINPACK-1 least-squares minimizer, to do the main
;  work.
;
;  Given the data and their uncertainties, MPFITEXPR finds the best set
;  of model parameters which match the data (in a least-squares
;  sense) and returns them in an array.
;  
;  The user must supply the following items:
;   - An array of independent variable values ("X").
;   - An array of "measured" *dependent* variable values ("Y").
;   - An array of "measured" 1-sigma uncertainty values ("ERR").
;   - A text IDL expression which computes Y given X.
;   - Starting guesses for all of the parameters ("START_PARAMS").
;
;  There are very few restrictions placed on X, Y or the expression of
;  the model.  Simply put, the expression must map the "X" values into
;  "Y" values given the model parameters.  The "X" values may
;  represent any independent variable (not just Cartesian X), and
;  indeed may be multidimensional themselves.  For example, in the
;  application of image fitting, X may be a 2xN array of image
;  positions.
;
;  Some rules must be obeyed in constructing the expression.  First,
;  the independent variable name *MUST* be "X" in the expression,
;  regardless of the name of the variable being passed to MPFITEXPR.
;  This is demonstrated in the above calling sequence, where the X
;  variable passed in is called "XVAL" but the expression still refers
;  to "X".  Second, parameter values must be referred to as an array
;  named "P".
;
;  If you do not pass in starting values for the model parameters,
;  MPFITEXPR will attempt to determine the number of parameters you
;  intend to have (it does this by looking for references to the array
;  variable named "P").  When no starting values are passed in, the
;  values are assumed to start at zero.
;
;  MPFITEXPR carefully avoids passing large arrays where possible to
;  improve performance.
;
;  See below for an example of usage.
;
; EVALUATING EXPRESSIONS
;
;  This source module also provides a function called MPEVALEXPR.  You
;  can use this function to evaluate your expression, given a list of
;  parameters.  This is one of the easier ways to compute the model
;  once the best-fit parameters have been found.  Here is an example:
;
;       YMOD = MPEVALEXPR(MYFUNCT, XVAL, PARMS)
;
;  where MYFUNCT is the expression (see MYFUNCT below), XVAL is the
;  list of "X" values, and PARMS is an array of parameters.  The
;  returned array YMOD contains the expression MYFUNCT evaluated at
;  each point in XVAL.
;
; PASSING PRIVATE DATA TO AN EXPRESSION
;
;  The most complicated optimization problems typically involve other
;  external parameters, in addition to the fitted parameters.  While
;  it is extremely easy to rewrite an expression dynamically, in case
;  one of the external parameters changes, the other possibility is to
;  use the PRIVATE data structure.
;
;  The user merely passes a structure to the FUNCTARGS keyword.  The
;  user expression receives this value as the variable PRIVATE.
;  MPFITEXPR nevers accesses this variable so it can contain any
;  desired values.  Usually it would be an IDL structure so that any
;  named external parameters can be passed to the expression.
;
;
; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD
;
;  The behavior of MPFIT can be modified with respect to each
;  parameter to be fitted.  A parameter value can be fixed; simple
;  boundary constraints can be imposed; limitations on the parameter
;  changes can be imposed; properties of the automatic derivative can
;  be modified; and parameters can be tied to one another.
;
;  These properties are governed by the PARINFO structure, which is
;  passed as a keyword parameter to MPFIT.
;
;  PARINFO should be an array of structures, one for each parameter.
;  Each parameter is associated with one element of the array, in
;  numerical order.  The structure can have the following entries
;  (none are required):
;  
;     .VALUE - the starting parameter value (but see the START_PARAMS
;              parameter for more information).
;  
;     .FIXED - a boolean value, whether the parameter is to be held
;              fixed or not.  Fixed parameters are not varied by
;              MPFIT, but are passed on to MYFUNCT for evaluation.
;  
;     .LIMITED - a two-element boolean array.  If the first/second
;                element is set, then the parameter is bounded on the
;                lower/upper side.  A parameter can be bounded on both
;                sides.  Both LIMITED and LIMITS must be given
;                together.
;  
;     .LIMITS - a two-element float or double array.  Gives the
;               parameter limits on the lower and upper sides,
;               respectively.  Zero, one or two of these values can be
;               set, depending on the values of LIMITED.  Both LIMITED
;               and LIMITS must be given together.
;  
;     .PARNAME - a string, giving the name of the parameter.  The
;                fitting code of MPFIT does not use this tag in any
;                way.  However, the default ITERPROC will print the
;                parameter name if available.
;  
;     .STEP - the step size to be used in calculating the numerical
;             derivatives.  If set to zero, then the step size is
;             computed automatically.  Ignored when AUTODERIVATIVE=0.
;             This value is superceded by the RELSTEP value.
;
;     .RELSTEP - the *relative* step size to be used in calculating
;                the numerical derivatives.  This number is the
;                fractional size of the step, compared to the
;                parameter value.  This value supercedes the STEP
;                setting.  If the parameter is zero, then a default
;                step size is chosen.
;
;     .MPSIDE - the sidedness of the finite difference when computing
;               numerical derivatives.  This field can take four
;               values:
;
;                  0 - one-sided derivative computed automatically
;                  1 - one-sided derivative (f(x+h) - f(x)  )/h
;                 -1 - one-sided derivative (f(x)   - f(x-h))/h
;                  2 - two-sided derivative (f(x+h) - f(x-h))/(2*h)
;
;              Where H is the STEP parameter described above.  The
;              "automatic" one-sided derivative method will chose a
;              direction for the finite difference which does not
;              violate any constraints.  The other methods do not
;              perform this check.  The two-sided method is in
;              principle more precise, but requires twice as many
;              function evaluations.  Default: 0.
;
;     .MPMAXSTEP - the maximum change to be made in the parameter
;                  value.  During the fitting process, the parameter
;                  will never be changed by more than this value in
;                  one iteration.
;
;                  A value of 0 indicates no maximum.  Default: 0.
;  
;     .TIED - a string expression which "ties" the parameter to other
;             free or fixed parameters as an equality constraint.  Any
;             expression involving constants and the parameter array P
;             are permitted.
;             Example: if parameter 2 is always to be twice parameter
;             1 then use the following: parinfo[2].tied = '2 * P[1]'.
;             Since they are totally constrained, tied parameters are
;             considered to be fixed; no errors are computed for them.
;             [ NOTE: the PARNAME can't be used in a TIED expression. ]
;
;     .MPPRINT - if set to 1, then the default ITERPROC will print the
;                parameter value.  If set to 0, the parameter value
;                will not be printed.  This tag can be used to
;                selectively print only a few parameter values out of
;                many.  Default: 1 (all parameters printed)
;
;     .MPFORMAT - IDL format string to print the parameter within
;                 ITERPROC.  Default: '(G20.6)'  (An empty string will
;                 also use the default.)
;
;  Future modifications to the PARINFO structure, if any, will involve
;  adding structure tags beginning with the two letters "MP".
;  Therefore programmers are urged to avoid using tags starting with
;  "MP", but otherwise they are free to include their own fields
;  within the PARINFO structure, which will be ignored by MPFIT.
;  
;  PARINFO Example:
;  parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $
;                       limits:[0.D,0]}, 5)
;  parinfo[0].fixed = 1
;  parinfo[4].limited[0] = 1
;  parinfo[4].limits[0]  = 50.D
;  parinfo[*].value = [5.7D, 2.2, 500., 1.5, 2000.]
;  
;  A total of 5 parameters, with starting values of 5.7,
;  2.2, 500, 1.5, and 2000 are given.  The first parameter
;  is fixed at a value of 5.7, and the last parameter is
;  constrained to be above 50.
;
;
; COMPATIBILITY
;
;  This function is designed to work with IDL 5.0 or greater.  Because
;  this function uses the IDL EXECUTE() function, it will not work
;  with the free version of the IDL Virtual machine.
;  
;
; INPUTS:
;   MYFUNCT - a string variable containing an IDL expression.  The
;             only restriction is that the independent variable *must*
;             be referred to as "X" and model parameters *must* be
;             referred to as an array called "P".  Do not use symbol
;             names beginning with the underscore, "_".
;
;             The expression should calculate "model" Y values given
;             the X values and model parameters.  Using the vector
;             notation of IDL, this can be quite easy to do.  If your
;             expression gets complicated, you may wish to make an IDL
;             function which will improve performance and readibility.
;
;             The resulting array should be of the same size and
;             dimensions as the "measured" Y values.
;
;   X - Array of independent variable values.
;
;   Y - Array of "measured" dependent variable values.  Y should have
;       the same data type as X.  The function MYFUNCT should map
;       X->Y.
;
;   ERR - Array of "measured" 1-sigma uncertainties.  ERR should have
;         the same data type as Y.  ERR is ignored if the WEIGHTS
;         keyword is specified.
;
;   START_PARAMS - An array of starting values for each of the
;                  parameters of the model.  The number of parameters
;                  should be fewer than the number of measurements.
;                  Also, the parameters should have the same data type
;                  as the measurements (double is preferred).
;
;                  This parameter is optional if the PARINFO keyword
;                  is used (see MPFIT).  The PARINFO keyword provides
;                  a mechanism to fix or constrain individual
;                  parameters.  If both START_PARAMS and PARINFO are
;                  passed, then the starting *value* is taken from
;                  START_PARAMS, but the *constraints* are taken from
;                  PARINFO.
;
;                  If no parameters are given, then MPFITEXPR attempts
;                  to determine the number of parameters by scanning
;                  the expression.  Parameters determined this way are
;                  initialized to zero.  This technique is not fully
;                  reliable, so users are advised to pass explicit
;                  parameter starting values.
; 
;
; RETURNS:
;
;   Returns the array of best-fit parameters.
;
;
; KEYWORD PARAMETERS:
;
;   BESTNORM - the value of the summed, squared, weighted residuals
;              for the returned parameter values, i.e. the chi-square value.
;
;   COVAR - the covariance matrix for the set of parameters returned
;           by MPFIT.  The matrix is NxN where N is the number of
;           parameters.  The square root of the diagonal elements
;           gives the formal 1-sigma statistical errors on the
;           parameters IF errors were treated "properly" in MYFUNC.
;           Parameter errors are also returned in PERROR.
;
;           To compute the correlation matrix, PCOR, use this:
;           IDL> PCOR = COV * 0
;           IDL> FOR i = 0, n-1 DO FOR j = 0, n-1 DO $
;                PCOR[i,j] = COV[i,j]/sqrt(COV[i,i]*COV[j,j])
;
;           If NOCOVAR is set or MPFIT terminated abnormally, then
;           COVAR is set to a scalar with value !VALUES.D_NAN.
;
;   DOF - number of degrees of freedom, computed as
;             DOF = N_ELEMENTS(DEVIATES) - NFREE
;         Note that this doesn't account for pegged parameters (see
;         NPEGGED).
;
;   ERRMSG - a string error or warning message is returned.
;
;   FTOL - a nonnegative input variable. Termination occurs when both
;          the actual and predicted relative reductions in the sum of
;          squares are at most FTOL (and STATUS is accordingly set to
;          1 or 3).  Therefore, FTOL measures the relative error
;          desired in the sum of squares.  Default: 1D-10
;
;   FUNCTARGS - passed directly to the expression as the variable
;               PRIVATE.  Any user-private data can be communicated to
;               the user expression using this keyword.
;               Default: PRIVATE is undefined in user expression
;
;   GTOL - a nonnegative input variable. Termination occurs when the
;          cosine of the angle between fvec and any column of the
;          jacobian is at most GTOL in absolute value (and STATUS is
;          accordingly set to 4). Therefore, GTOL measures the
;          orthogonality desired between the function vector and the
;          columns of the jacobian.  Default: 1D-10
;
;   ITERARGS - The keyword arguments to be passed to ITERPROC via the
;              _EXTRA mechanism.  This should be a structure, and is
;              similar in operation to FUNCTARGS.
;              Default: no arguments are passed.
;
;   ITERPROC - The name of a procedure to be called upon each NPRINT
;              iteration of the MPFIT routine.  It should be declared
;              in the following way:
;
;              PRO ITERPROC, MYFUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $
;                PARINFO=parinfo, QUIET=quiet, ...
;                ; perform custom iteration update
;              END
;         
;              ITERPROC must either accept all three keyword
;              parameters (FUNCTARGS, PARINFO and QUIET), or at least
;              accept them via the _EXTRA keyword.
;          
;              MYFUNCT is the user-supplied function to be minimized,
;              P is the current set of model parameters, ITER is the
;              iteration number, and FUNCTARGS are the arguments to be
;              passed to MYFUNCT.  FNORM should be the
;              chi-squared value.  QUIET is set when no textual output
;              should be printed.  See below for documentation of
;              PARINFO.
;
;              In implementation, ITERPROC can perform updates to the
;              terminal or graphical user interface, to provide
;              feedback while the fit proceeds.  If the fit is to be
;              stopped for any reason, then ITERPROC should set the
;              common block variable ERROR_CODE to negative value (see
;              MPFIT_ERROR common block below).  In principle,
;              ITERPROC should probably not modify the parameter
;              values, because it may interfere with the algorithm's
;              stability.  In practice it is allowed.
;
;              Default: an internal routine is used to print the
;                       parameter values.
;
;   MAXITER - The maximum number of iterations to perform.  If the
;             number is exceeded, then the STATUS value is set to 5
;             and MPFIT returns.
;             Default: 200 iterations
;
;   NFEV - the number of MYFUNCT function evaluations performed.
;
;   NFREE - the number of free parameters in the fit.  This includes
;           parameters which are not FIXED and not TIED, but it does
;           include parameters which are pegged at LIMITS.
;
;   NITER - the number of iterations completed.
;
;   NOCOVAR - set this keyword to prevent the calculation of the
;             covariance matrix before returning (see COVAR)
;
;   NPEGGED - the number of free parameters which are pegged at a
;             LIMIT.
;
;   NPRINT - The frequency with which ITERPROC is called.  A value of
;            1 indicates that ITERPROC is called with every iteration,
;            while 2 indicates every other iteration, etc.  Note that
;            several Levenberg-Marquardt attempts can be made in a
;            single iteration.
;            Default value: 1
;
;   PARINFO - Provides a mechanism for more sophisticated constraints
;             to be placed on parameter values.  When PARINFO is not
;             passed, then it is assumed that all parameters are free
;             and unconstrained.  Values in PARINFO are never 
;             modified during a call to MPFIT.
;
;             See description above for the structure of PARINFO.
;
;             Default value:  all parameters are free and unconstrained.
;
;   PERROR - The formal 1-sigma errors in each parameter, computed
;            from the covariance matrix.  If a parameter is held
;            fixed, or if it touches a boundary, then the error is
;            reported as zero.
;
;            If the fit is unweighted (i.e. no errors were given, or
;            the weights were uniformly set to unity), then PERROR
;            will probably not represent the true parameter
;            uncertainties.  
;
;            *If* you can assume that the true reduced chi-squared
;            value is unity -- meaning that the fit is implicitly
;            assumed to be of good quality -- then the estimated
;            parameter uncertainties can be computed by scaling PERROR
;            by the measured chi-squared value.
;
;              DOF     = N_ELEMENTS(X) - N_ELEMENTS(PARMS) ; deg of freedom
;              PCERROR = PERROR * SQRT(BESTNORM / DOF)   ; scaled uncertainties
;
;   QUIET - set this keyword when no textual output should be printed
;           by MPFIT
;
;   STATUS - an integer status code is returned.  All values greater
;            than zero can represent success (however STATUS EQ 5 may
;            indicate failure to converge).  It can have one of the
;            following values:
;
;	   0  improper input parameters.
;         
;	   1  both actual and predicted relative reductions
;	      in the sum of squares are at most FTOL.
;         
;	   2  relative error between two consecutive iterates
;	      is at most XTOL
;         
;	   3  conditions for STATUS = 1 and STATUS = 2 both hold.
;         
;	   4  the cosine of the angle between fvec and any
;	      column of the jacobian is at most GTOL in
;	      absolute value.
;         
;	   5  the maximum number of iterations has been reached
;         
;	   6  FTOL is too small. no further reduction in
;	      the sum of squares is possible.
;         
;	   7  XTOL is too small. no further improvement in
;	      the approximate solution x is possible.
;         
;	   8  GTOL is too small. fvec is orthogonal to the
;	      columns of the jacobian to machine precision.
;
;   WEIGHTS - Array of weights to be used in calculating the
;             chi-squared value.  If WEIGHTS is specified then the ERR
;             parameter is ignored.  The chi-squared value is computed
;             as follows:
;
;                CHISQ = TOTAL( (Y-MYFUNCT(X,P))^2 * ABS(WEIGHTS) )
;
;             Here are common values of WEIGHTS:
;
;                1D/ERR^2 - Normal weighting (ERR is the measurement error)
;                1D/Y     - Poisson weighting (counting statistics)
;                1D       - Unweighted
;
;   XTOL - a nonnegative input variable. Termination occurs when the
;          relative error between two consecutive iterates is at most
;          XTOL (and STATUS is accordingly set to 2 or 3).  Therefore,
;          XTOL measures the relative error desired in the approximate
;          solution.  Default: 1D-10
;
;   YFIT - the best-fit model function, as returned by MYFUNCT.
;
;
; EXAMPLE:
;
;   ; First, generate some synthetic data
;   x  = dindgen(200) * 0.1 - 10.                   ; Independent variable 
;   yi = gauss1(x, [2.2D, 1.4, 3000.]) + 1000       ; "Ideal" Y variable
;   y  = yi + randomn(seed, 200) * sqrt(yi)         ; Measured, w/ noise
;   sy = sqrt(y)                                    ; Poisson errors
;
;   ; Now fit a Gaussian to see how well we can recover
;   expr = 'P[0] + GAUSS1(X, P[1:3])'               ; fitting function
;   p0 = [800.D, 1.D, 1., 500.]                     ; Initial guess
;   p = mpfitexpr(expr, x, y, sy, p0)               ; Fit the expression
;   print, p
;
;   plot, x, y                                      ; Plot data
;   oplot, x, mpevalexpr(expr, x, p)                ; Plot model
;
;   Generates a synthetic data set with a Gaussian peak, and Poisson
;   statistical uncertainty.  Then a model consisting of a constant
;   plus Gaussian is fit to the data.
;
;
; COMMON BLOCKS:
;
;   COMMON MPFIT_ERROR, ERROR_CODE
;
;     User routines may stop the fitting process at any time by
;     setting an error condition.  This condition may be set in either
;     the user's model computation routine (MYFUNCT), or in the
;     iteration procedure (ITERPROC).
;
;     To stop the fitting, the above common block must be declared,
;     and ERROR_CODE must be set to a negative number.  After the user
;     procedure or function returns, MPFIT checks the value of this
;     common block variable and exits immediately if the error
;     condition has been set.  By default the value of ERROR_CODE is
;     zero, indicating a successful function/procedure call.
;
;
; REFERENCES:
;
;   MINPACK-1, Jorge More', available from netlib (www.netlib.org).
;   "Optimization Software Guide," Jorge More' and Stephen Wright, 
;     SIAM, *Frontiers in Applied Mathematics*, Number 14.
;
; MODIFICATION HISTORY:
;   Written, Apr-Jul 1998, CM
;   Added PERROR keyword, 04 Aug 1998, CM
;   Added COVAR keyword, 20 Aug 1998, CM
;   Added NITER output keyword, 05 Oct 1998
;      D.L Windt, Bell Labs, windt@bell-labs.com;
;   Added ability to return model function in YFIT, 09 Nov 1998
;   Parameter values can be tied to others, 09 Nov 1998
;   Added MPEVALEXPR utility function, 09 Dec 1998
;   Cosmetic documentation updates, 16 Apr 1999, CM
;   More cosmetic documentation updates, 14 May 1999, CM
;   Made sure to update STATUS value, 25 Sep 1999, CM
;   Added WEIGHTS keyword, 25 Sep 1999, CM
;   Changed from handles to common blocks, 25 Sep 1999, CM
;     - commons seem much cleaner and more logical in this case.
;   Alphabetized documented keywords, 02 Oct 1999, CM
;   Added QUERY keyword and query checking of MPFIT, 29 Oct 1999, CM
;   Check to be sure that X and Y are present, 02 Nov 1999, CM
;   Documented PERROR for unweighted fits, 03 Nov 1999, CM
;   Removed ITERPROC='' when quiet EQ 1, 10 Jan 2000, CM
;   Changed to ERROR_CODE for error condition, 28 Jan 2000, CM
;   Updated the EXAMPLE, 26 Mar 2000, CM
;   Copying permission terms have been liberalized, 26 Mar 2000, CM
;   Propagated improvements from MPFIT, 17 Dec 2000, CM
;   Correct reference to _WTS in MPFITEXPR_EVAL, 25 May 2001, CM
;      (thanks to Mark Fardal)
;   Added useful FUNCTARGS behavior (as yet undocumented), 04 Jul
;      2002, CM
;   Documented FUNCTARGS/PRIVATE behavior, 22 Jul 2002, CM
;   Added NFREE and NPEGGED keywords, 13 Sep 2002, CM
;   Documented RELSTEP field of PARINFO (!!), CM, 25 Oct 2002
;   Add DOF keyword, CM, 31 Jul 2003
;   Add FUNCTARGS keyword to MPEVALEXPR, CM 08 Aug 2003
;   Minor documentation adjustment, 03 Feb 2004, CM
;   Move STRICTARR compile option inside each function/procedure, 9 Oct 2006
;   Clarify documentation on user-function, derivatives, and PARINFO,
;     27 May 2007
;   Add COMPATIBILITY section, CM, 13 Dec 2007
;   Remove obsolete STR_SEP in favor of STRSPLIT, CM, 2015-03-18
;   Better documentation for STATUS, CM, 2016-04-29
;
;  $Id: mpfitexpr.pro,v 1.16 2016/05/19 16:08:49 cmarkwar Exp $
;-
; Copyright (C) 1997-2001, 2002, 2003, 2004, 2007, 2015, 2016 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; Utility function which simply returns the value of the expression,
; evaluated at each point in x, using the parameters p.
function mpevalexpr, _expr, x, p, functargs=private

  COMPILE_OPT strictarr
  _cmd = '_f = '+_expr
  _err = execute(_cmd)
  return, _f
end

; This is the call-back function for MPFIT.  It evaluates the
; expression, subtracts the data, and returns the residuals.
function mpfitexpr_eval, p, _EXTRA=private

  COMPILE_OPT strictarr
  common mpfitexpr_common, _expr, x, y, err, _wts, _f

  ;; Compute the model value by executing the expression
  _f = 0.D
  _cmd = '_f = '+_expr
  _xxx = execute(_cmd)
  if _xxx EQ 0 then message, 'ERROR: command execution failed.'

  ;; Compute the deviates, applying either errors or weights
  if n_elements(err) GT 0 then begin
      result = (y-_f)/err
  endif else if n_elements(_wts) GT 0 then begin
      result = (y-_f)*_wts
  endif else begin
      result = (y-_f)
  endelse

  ;; The returned result should be one-dimensional
  result = reform(result, n_elements(result), /overwrite)
  return, result
end

;; This is the main entry point for this module
function mpfitexpr, expr, x, y, err, p, WEIGHTS=wts, $
                    BESTNORM=bestnorm, STATUS=status, nfev=nfev, $
                    parinfo=parinfo, query=query, functargs=fcnargs, $
                    covar=covar, perror=perror, yfit=yfit, $
                    niter=niter, nfree=nfree, npegged=npegged, dof=dof, $
                    quiet=quiet, _EXTRA=extra, errmsg=errmsg

  COMPILE_OPT strictarr
  status = 0L
  errmsg = ''

  ;; Detect MPFIT and crash if it was not found
  catch, catcherror
  if catcherror NE 0 then begin
      MPFIT_NOTFOUND:
      catch, /cancel
      message, 'ERROR: the required function MPFIT must be in your IDL path', /info
      return, !values.d_nan
  endif
  if mpfit(/query) NE 1 then goto, MPFIT_NOTFOUND
  catch, /cancel
  if keyword_set(query) then return, 1

  if n_params() EQ 0 then begin
      message, "USAGE: PARMS = MPFITEXPR('EXPR', X, Y, ERR, "+ $
        "START_PARAMS, ... )", /info
      return, !values.d_nan
  endif
  if n_elements(x) EQ 0 OR n_elements(y) EQ 0 then begin
      message, 'ERROR: X and Y must be defined', /info
      return, !values.d_nan
  endif

  ;; If no parameters are given, then parse the input expression,
  ;; and determine the number of parameters automatically.
  if (n_elements(parinfo) GT 0) AND (n_elements(p) EQ 0) then $
    p = parinfo[*].value
  if (n_elements(p) EQ 0) then begin
      pos = 0L
      nparams = 0L
      ee = strupcase(expr)
      ;; These are character constants representing the boundaries of
      ;; variable names.
      ca = (byte('A'))[0]
      cz = (byte('Z'))[0]
      c0 = (byte('0'))[0]
      c9 = (byte('9'))[0]
      c_ = (byte('_'))[0]  ;; Underscore can be in a variable name
      ll = strlen(ee)
      pnames = ['']

      ;; Now step through, looking for variables looking like p[0], etc.
      repeat begin
          i = [strpos(ee, 'P(', pos), strpos(ee, 'P[', pos)]
          wh = where(i GE 0, ct)
          if ct LE 0 then goto, DONE_PARAMS
          i = min(i[wh])

          ;; None found, finished
          if i LT 0 then goto, DONE_PARAMS
          ;; Too close to the end of the string
          if i GT ll-4 then goto, DONE_PARAMS

          ;; Have to be careful here, to be sure that this isn't just
          ;; a variable name ending in "p"
          maybe = 0
          ;; If this is the first character
          if i EQ 0 then maybe = 1 $
          else begin
              ;; Or if the preceding character is a non-variable character
              c = (byte(strmid(ee, i-1, 1)))[0]
              if NOT ( (c GE ca AND c LE cz) OR (c GE c0 AND c LE c9) $
                       OR c EQ c_ ) then maybe = 1
          endelse
          if maybe then begin
              ;; If we found one, then strip out the value inside the
              ;; parentheses.
              rest = strmid(ee, i+2, ll-i-2)
              next = strtrim(strsplit(rest,')',/extract),2)
              next = next[0]
              pnames = [pnames, next]
          endif
          pos = i+1
      endrep until pos GE ll

      DONE_PARAMS:
      if n_elements(pnames) EQ 1 then begin
          message, 'ERROR: no parameters to fit', /info
          return, !values.d_nan
      endif

      ;; Finally, we take the maximum parameter number
      pnames = pnames[1:*]
      nparams = max(long(pnames)) + 1
      if NOT keyword_set(quiet) then $
        message, '  Number of parameters: '+strtrim(nparams,2) $
        + ' (initialized to zero)', /info

      ;; Create a parameter vector, starting at zero
      p = dblarr(nparams)
  endif

  ;; Use common block to pass data back and forth
  common mpfitexpr_common, fc, xc, yc, ec, wc, mc
  fc = expr & xc = x & yc = y & mc = 0L
  ;; These optional parameters must be undefined first
  ec = 0 & dummy = size(temporary(ec))
  wc = 0 & dummy = size(temporary(wc))

  if n_elements(wts) GT 0 then begin
      wc = sqrt(abs(wts))
  endif else if n_elements(err) GT 0 then begin
      wh = where(err EQ 0, ct)
      if ct GT 0 then begin
          message, 'ERROR: ERROR value must not be zero.  Use WEIGHTS.', $
            /info
          return, !values.d_nan
      endif
      ec = err
  endif

  ;; Test out the function, as mpfit would call it, to see if it works
  ;; okay.  There is no sense in calling the fitter if the function
  ;; itself doesn't work.
  catch, catcherror
  if catcherror NE 0 then begin
      CATCH_ERROR:
      catch, /cancel
      message, 'ERROR: execution of "'+expr+'" failed.', /info
      message, '       check syntax and parameter usage', /info
      xc = 0 & yc = 0 & ec = 0 & wc = 0 & ac = 0
      return, !values.d_nan
  endif

  ;; Initialize.  Function that is actually called is mpfitexpr_eval,
  ;; which is a wrapper that sets up the expression evaluation.
  fcn = 'mpfitexpr_eval'

  ;; FCNARGS are passed by MPFIT directly to MPFITEXPR_EVAL.  These
  ;; actually contain the data, the expression, and a slot to return
  ;; the model function.
  fvec = call_function(fcn, p, _EXTRA=fcnargs)
  if n_elements(fvec) EQ 1 then $
    if NOT finite(fvec[0]) then goto, CATCH_ERROR
  ;; No errors caught if reached this stage
  catch, /cancel

  ;; Call MPFIT
  result = mpfit(fcn, p, $
                 parinfo=parinfo, STATUS=status, nfev=nfev, BESTNORM=bestnorm,$
                 covar=covar, perror=perror, functargs=fcnargs, $
                 niter=niter, nfree=nfree, npegged=npegged, dof=dof, $
                 ERRMSG=errmsg, quiet=quiet, _EXTRA=extra)

  ;; Retrieve the fit value
  yfit = temporary(mc)
  ;; Some cleanup
  xc = 0 & yc = 0 & wc = 0 & ec = 0 & mc = 0 & ac = 0

  ;; Print error message if there is one.
  if NOT keyword_set(quiet) AND errmsg NE '' then $
    message, errmsg, /info

  return, result
end
;+
; NAME:
;   MPFITFUN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Perform Levenberg-Marquardt least-squares fit to IDL function
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   parms = MPFITFUN(MYFUNCT, X, Y, ERR, start_params, ...)
;
; DESCRIPTION:
;
;  MPFITFUN fits a user-supplied model -- in the form of an IDL
;  function -- to a set of user-supplied data.  MPFITFUN calls
;  MPFIT, the MINPACK-1 least-squares minimizer, to do the main
;  work.
;
;  Given the data and their uncertainties, MPFITFUN finds the best set
;  of model parameters which match the data (in a least-squares
;  sense) and returns them in an array.
;  
;  The user must supply the following items:
;   - An array of independent variable values ("X").
;   - An array of "measured" *dependent* variable values ("Y").
;   - An array of "measured" 1-sigma uncertainty values ("ERR").
;   - The name of an IDL function which computes Y given X ("MYFUNCT").
;   - Starting guesses for all of the parameters ("START_PARAMS").
;
;  There are very few restrictions placed on X, Y or MYFUNCT.  Simply
;  put, MYFUNCT must map the "X" values into "Y" values given the
;  model parameters.  The "X" values may represent any independent
;  variable (not just Cartesian X), and indeed may be multidimensional
;  themselves.  For example, in the application of image fitting, X
;  may be a 2xN array of image positions.
;
;  Data values of NaN or Infinity for "Y", "ERR" or "WEIGHTS" will be
;  ignored as missing data if the NAN keyword is set.  Otherwise, they
;  may cause the fitting loop to halt with an error message.  Note
;  that the fit will still halt if the model function, or its
;  derivatives, produces infinite or NaN values.
;
;  MPFITFUN carefully avoids passing large arrays where possible to
;  improve performance.
;
;  See below for an example of usage.
;
; USER FUNCTION
;
;  The user must define a function which returns the model value.  For
;  applications which use finite-difference derivatives -- the default
;  -- the user function should be declared in the following way:
;
;    FUNCTION MYFUNCT, X, P
;     ; The independent variable is X
;     ; Parameter values are passed in "P"
;     YMOD = ... computed model values at X ...
;     return, YMOD
;    END
;
;  The returned array YMOD must have the same dimensions and type as
;  the "measured" Y values.
;
;  User functions may also indicate a fatal error condition
;  using the ERROR_CODE common block variable, as described
;  below under the MPFIT_ERROR common block definition.
;
;  MPFIT by default calculates derivatives numerically via a finite
;  difference approximation.  However, the user function *may*
;  calculate the derivatives if desired, but only if the model
;  function is declared with an additional position parameter, DP, as
;  described below.
;
;  To enable explicit derivatives for all parameters, set
;  AUTODERIVATIVE=0.
;
;  When AUTODERIVATIVE=0, the user function is responsible for
;  calculating the derivatives of the user function with respect to
;  each parameter.  The user function should be declared as follows:
;
;    ;
;    ; MYFUNCT - example user function
;    ;   P - input parameter values (N-element array)
;    ;   DP - upon input, an N-vector indicating which parameters
;    ;          to compute derivatives for; 
;    ;        upon output, the user function must return
;    ;          an ARRAY(M,N) of derivatives in this keyword
;    ;   (keywords) - any other keywords specified by FUNCTARGS
;    ; RETURNS - function values
;    ;
;    FUNCTION MYFUNCT, x, p, dp [, (additional keywords if desired)]
;     model = F(x, p)         ;; Model function
;     
;     if n_params() GT 2 then begin
;       ; Create derivative and compute derivative array
;       requested = dp   ; Save original value of DP
;       dp = make_array(n_elements(x), n_elements(p), value=x[0]*0)
;
;       ; Compute derivative if requested by caller
;       for i = 0, n_elements(p)-1 do if requested(i) NE 0 then $
;         dp(*,i) = FGRAD(x, p, i)
;     endif
;    
;     return, resid
;    END
;
;  where FGRAD(x, p, i) is a model function which computes the
;  derivative of the model F(x,p) with respect to parameter P(i) at X.
;
;  Derivatives should be returned in the DP array. DP should be an
;  ARRAY(m,n) array, where m is the number of data points and n is the
;  number of parameters.  DP[i,j] is the derivative of the ith
;  function value with respect to the jth parameter.
;
;  MPFIT may not always request derivatives from the user function.
;  In those cases, the parameter DP is not passed.  Therefore
;  functions can use N_PARAMS() to indicate whether they must compute
;  the derivatives or not.
;
;  For additional information about explicit derivatives, including
;  additional settings and debugging options, see the discussion under
;  "EXPLICIT DERIVATIVES" and AUTODERIVATIVE in MPFIT.PRO.
;
; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD
;
;  The behavior of MPFIT can be modified with respect to each
;  parameter to be fitted.  A parameter value can be fixed; simple
;  boundary constraints can be imposed; limitations on the parameter
;  changes can be imposed; properties of the automatic derivative can
;  be modified; and parameters can be tied to one another.
;
;  These properties are governed by the PARINFO structure, which is
;  passed as a keyword parameter to MPFIT.
;
;  PARINFO should be an array of structures, one for each parameter.
;  Each parameter is associated with one element of the array, in
;  numerical order.  The structure can have the following entries
;  (none are required):
;  
;     .VALUE - the starting parameter value (but see the START_PARAMS
;              parameter for more information).
;  
;     .FIXED - a boolean value, whether the parameter is to be held
;              fixed or not.  Fixed parameters are not varied by
;              MPFIT, but are passed on to MYFUNCT for evaluation.
;  
;     .LIMITED - a two-element boolean array.  If the first/second
;                element is set, then the parameter is bounded on the
;                lower/upper side.  A parameter can be bounded on both
;                sides.  Both LIMITED and LIMITS must be given
;                together.
;  
;     .LIMITS - a two-element float or double array.  Gives the
;               parameter limits on the lower and upper sides,
;               respectively.  Zero, one or two of these values can be
;               set, depending on the values of LIMITED.  Both LIMITED
;               and LIMITS must be given together.
;  
;     .PARNAME - a string, giving the name of the parameter.  The
;                fitting code of MPFIT does not use this tag in any
;                way.  However, the default ITERPROC will print the
;                parameter name if available.
;  
;     .STEP - the step size to be used in calculating the numerical
;             derivatives.  If set to zero, then the step size is
;             computed automatically.  Ignored when AUTODERIVATIVE=0.
;             This value is superceded by the RELSTEP value.
;
;     .RELSTEP - the *relative* step size to be used in calculating
;                the numerical derivatives.  This number is the
;                fractional size of the step, compared to the
;                parameter value.  This value supercedes the STEP
;                setting.  If the parameter is zero, then a default
;                step size is chosen.
;
;     .MPSIDE - the sidedness of the finite difference when computing
;               numerical derivatives.  This field can take four
;               values:
;
;                  0 - one-sided derivative computed automatically
;                  1 - one-sided derivative (f(x+h) - f(x)  )/h
;                 -1 - one-sided derivative (f(x)   - f(x-h))/h
;                  2 - two-sided derivative (f(x+h) - f(x-h))/(2*h)
;
;              Where H is the STEP parameter described above.  The
;              "automatic" one-sided derivative method will chose a
;              direction for the finite difference which does not
;              violate any constraints.  The other methods do not
;              perform this check.  The two-sided method is in
;              principle more precise, but requires twice as many
;              function evaluations.  Default: 0.
;
;     .MPMAXSTEP - the maximum change to be made in the parameter
;                  value.  During the fitting process, the parameter
;                  will never be changed by more than this value in
;                  one iteration.
;
;                  A value of 0 indicates no maximum.  Default: 0.
;  
;     .TIED - a string expression which "ties" the parameter to other
;             free or fixed parameters as an equality constraint.  Any
;             expression involving constants and the parameter array P
;             are permitted.
;             Example: if parameter 2 is always to be twice parameter
;             1 then use the following: parinfo[2].tied = '2 * P[1]'.
;             Since they are totally constrained, tied parameters are
;             considered to be fixed; no errors are computed for them.
;             [ NOTE: the PARNAME can't be used in a TIED expression. ]
;
;     .MPPRINT - if set to 1, then the default ITERPROC will print the
;                parameter value.  If set to 0, the parameter value
;                will not be printed.  This tag can be used to
;                selectively print only a few parameter values out of
;                many.  Default: 1 (all parameters printed)
;
;     .MPFORMAT - IDL format string to print the parameter within
;                 ITERPROC.  Default: '(G20.6)'  (An empty string will
;                 also use the default.)
;
;  Future modifications to the PARINFO structure, if any, will involve
;  adding structure tags beginning with the two letters "MP".
;  Therefore programmers are urged to avoid using tags starting with
;  "MP", but otherwise they are free to include their own fields
;  within the PARINFO structure, which will be ignored by MPFIT.
;  
;  PARINFO Example:
;  parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $
;                       limits:[0.D,0]}, 5)
;  parinfo[0].fixed = 1
;  parinfo[4].limited[0] = 1
;  parinfo[4].limits[0]  = 50.D
;  parinfo[*].value = [5.7D, 2.2, 500., 1.5, 2000.]
;  
;  A total of 5 parameters, with starting values of 5.7,
;  2.2, 500, 1.5, and 2000 are given.  The first parameter
;  is fixed at a value of 5.7, and the last parameter is
;  constrained to be above 50.
;
; COMPATIBILITY
;
;  This function is designed to work with IDL 5.0 or greater.
;  
;  Because TIED parameters rely on the EXECUTE() function, they cannot
;  be used with the free version of the IDL Virtual Machine.
;
;
; INPUTS:
;   MYFUNCT - a string variable containing the name of an IDL function.
;             This function computes the "model" Y values given the
;             X values and model parameters, as desribed above.
;
;   X - Array of independent variable values.
;
;   Y - Array of "measured" dependent variable values.  Y should have
;       the same data type as X.  The function MYFUNCT should map
;       X->Y.
;         NOTE: the following special cases apply:
;                * if Y is NaN or Infinite, and the NAN keyword is
;                  set, then the corresponding data point is ignored
;
;   ERR - Array of "measured" 1-sigma uncertainties.  ERR should have
;         the same data type as Y.  ERR is ignored if the WEIGHTS
;         keyword is specified.
;         NOTE: the following special cases apply:
;                * if ERR is zero, then the corresponding data point
;                  is ignored
;                * if ERR is NaN or Infinite, and the NAN keyword is
;                  set, then the corresponding data point is ignored
;                * if ERR is negative, then the absolute value of 
;                  ERR is used.
;
;   START_PARAMS - An array of starting values for each of the
;                  parameters of the model.  The number of parameters
;                  should be fewer than the number of measurements.
;                  Also, the parameters should have the same data type
;                  as the measurements (double is preferred).
;
;                  This parameter is optional if the PARINFO keyword
;                  is used (see MPFIT).  The PARINFO keyword provides
;                  a mechanism to fix or constrain individual
;                  parameters.  If both START_PARAMS and PARINFO are
;                  passed, then the starting *value* is taken from
;                  START_PARAMS, but the *constraints* are taken from
;                  PARINFO.
; 
;
; RETURNS:
;
;   Returns the array of best-fit parameters.
;
;
; KEYWORD PARAMETERS:
;
;   BESTNORM - the value of the summed squared residuals for the
;              returned parameter values.
;
;   BEST_FJAC - upon return, BEST_FJAC contains the Jacobian, or
;               partial derivative, matrix for the best-fit model.
;               The values are an array,
;               ARRAY(N_ELEMENTS(DEVIATES),NFREE) where NFREE is the
;               number of free parameters.  This array is only
;               computed if /CALC_FJAC is set, otherwise BEST_FJAC is
;               undefined.
;
;               The returned array is such that BEST_FJAC[I,J] is the
;               partial derivative of the model with respect to
;               parameter PARMS[PFREE_INDEX[J]].
;
;   BEST_RESID - upon return, an array of best-fit deviates,
;                normalized by the weights or errors.
;
;   COVAR - the covariance matrix for the set of parameters returned
;           by MPFIT.  The matrix is NxN where N is the number of
;           parameters.  The square root of the diagonal elements
;           gives the formal 1-sigma statistical errors on the
;           parameters IF errors were treated "properly" in MYFUNC.
;           Parameter errors are also returned in PERROR.
;
;           To compute the correlation matrix, PCOR, use this example:
;                  PCOR = COV * 0
;                  FOR i = 0, n-1 DO FOR j = 0, n-1 DO $
;                    PCOR[i,j] = COV[i,j]/sqrt(COV[i,i]*COV[j,j])
;           or equivalently, in vector notation,
;                  PCOR = COV / (PERROR # PERROR)
;
;           If NOCOVAR is set or MPFIT terminated abnormally, then
;           COVAR is set to a scalar with value !VALUES.D_NAN.
;
;   CASH - when set, the fit statistic is changed to a derivative of
;          the CASH statistic.  The model function must be strictly
;          positive. WARNING: this option is incomplete and untested.
;
;   DOF - number of degrees of freedom, computed as
;             DOF = N_ELEMENTS(DEVIATES) - NFREE
;         Note that this doesn't account for pegged parameters (see
;         NPEGGED).  It also does not account for data points which
;         are assigned zero weight, for example if :
;           * WEIGHTS[i] EQ 0, or
;           * ERR[i] EQ infinity, or 
;           * any of the values is "undefined" and /NAN is set.
;
;   ERRMSG - a string error or warning message is returned.
;
;   FTOL - a nonnegative input variable. Termination occurs when both
;          the actual and predicted relative reductions in the sum of
;          squares are at most FTOL (and STATUS is accordingly set to
;          1 or 3).  Therefore, FTOL measures the relative error
;          desired in the sum of squares.  Default: 1D-10
;
;   FUNCTARGS - A structure which contains the parameters to be passed
;               to the user-supplied function specified by MYFUNCT via
;               the _EXTRA mechanism.  This is the way you can pass
;               additional data to your user-supplied function without
;               using common blocks.
;
;               By default, no extra parameters are passed to the
;               user-supplied function.
;
;   GTOL - a nonnegative input variable. Termination occurs when the
;          cosine of the angle between fvec and any column of the
;          jacobian is at most GTOL in absolute value (and STATUS is
;          accordingly set to 4). Therefore, GTOL measures the
;          orthogonality desired between the function vector and the
;          columns of the jacobian.  Default: 1D-10
;
;   ITERARGS - The keyword arguments to be passed to ITERPROC via the
;              _EXTRA mechanism.  This should be a structure, and is
;              similar in operation to FUNCTARGS.
;              Default: no arguments are passed.
;
;   ITERPROC - The name of a procedure to be called upon each NPRINT
;              iteration of the MPFIT routine.  It should be declared
;              in the following way:
;
;              PRO ITERPROC, MYFUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $
;                PARINFO=parinfo, QUIET=quiet, ...
;                ; perform custom iteration update
;              END
;         
;              ITERPROC must either accept all three keyword
;              parameters (FUNCTARGS, PARINFO and QUIET), or at least
;              accept them via the _EXTRA keyword.
;          
;              MYFUNCT is the user-supplied function to be minimized,
;              P is the current set of model parameters, ITER is the
;              iteration number, and FUNCTARGS are the arguments to be
;              passed to MYFUNCT.  FNORM should be the
;              chi-squared value.  QUIET is set when no textual output
;              should be printed.  See below for documentation of
;              PARINFO.
;
;              In implementation, ITERPROC can perform updates to the
;              terminal or graphical user interface, to provide
;              feedback while the fit proceeds.  If the fit is to be
;              stopped for any reason, then ITERPROC should set the
;              common block variable ERROR_CODE to negative value (see
;              MPFIT_ERROR common block below).  In principle,
;              ITERPROC should probably not modify the parameter
;              values, because it may interfere with the algorithm's
;              stability.  In practice it is allowed.
;
;              Default: an internal routine is used to print the
;                       parameter values.
;
;   MAXITER - The maximum number of iterations to perform.  If the
;             number of calculation iterations exceeds MAXITER, then
;             the STATUS value is set to 5 and MPFIT returns.  
;
;             If MAXITER EQ 0, then MPFIT does not iterate to adjust
;             parameter values; however, the user function is evaluated
;             and parameter errors/covariance/Jacobian are estimated
;             before returning.
;             Default: 200 iterations
;
;   NAN - ignore infinite or NaN values in the Y, ERR or WEIGHTS
;         parameters.  These values will be treated as missing data.
;         However, the fit will still halt with an error condition
;         if the model function becomes infinite.
;
;   NFEV - the number of MYFUNCT function evaluations performed.
;
;   NFREE - the number of free parameters in the fit.  This includes
;           parameters which are not FIXED and not TIED, but it does
;           include parameters which are pegged at LIMITS.
;
;   NITER - the number of iterations completed.
;
;   NOCOVAR - set this keyword to prevent the calculation of the
;             covariance matrix before returning (see COVAR)
;
;   NPEGGED - the number of free parameters which are pegged at a
;             LIMIT.
;
;   NPRINT - The frequency with which ITERPROC is called.  A value of
;            1 indicates that ITERPROC is called with every iteration,
;            while 2 indicates every other iteration, etc.  Be aware
;            that several Levenberg-Marquardt attempts can be made in
;            a single iteration.  Also, the ITERPROC is *always*
;            called for the final iteration, regardless of the
;            iteration number.
;            Default value: 1
;
;   PARINFO - A one-dimensional array of structures.
;             Provides a mechanism for more sophisticated constraints
;             to be placed on parameter values.  When PARINFO is not
;             passed, then it is assumed that all parameters are free
;             and unconstrained.  Values in PARINFO are never 
;             modified during a call to MPFIT.
;
;             See description above for the structure of PARINFO.
;
;             Default value:  all parameters are free and unconstrained.
;
;   PERROR - The formal 1-sigma errors in each parameter, computed
;            from the covariance matrix.  If a parameter is held
;            fixed, or if it touches a boundary, then the error is
;            reported as zero.
;
;            If the fit is unweighted (i.e. no errors were given, or
;            the weights were uniformly set to unity), then PERROR
;            will probably not represent the true parameter
;            uncertainties.  
;
;            *If* you can assume that the true reduced chi-squared
;            value is unity -- meaning that the fit is implicitly
;            assumed to be of good quality -- then the estimated
;            parameter uncertainties can be computed by scaling PERROR
;            by the measured chi-squared value.
;
;              DOF     = N_ELEMENTS(X) - N_ELEMENTS(PARMS) ; deg of freedom
;              PCERROR = PERROR * SQRT(BESTNORM / DOF)   ; scaled uncertainties
;
;   PFREE_INDEX - upon return, PFREE_INDEX contains an index array
;                 which indicates which parameter were allowed to
;                 vary.  I.e. of all the parameters PARMS, only
;                 PARMS[PFREE_INDEX] were varied.
;
;   QUERY - if set, then MPFIT() will return immediately with one of
;           the following values:
;                 1 - if MIN_VERSION is not set
;                 1 - if MIN_VERSION is set and MPFIT satisfies the minimum
;                 0 - if MIN_VERSION is set and MPFIT does not satisfy it
;           Default: not set.
;
;   QUIET - set this keyword when no textual output should be printed
;           by MPFIT
;
;   STATUS - an integer status code is returned.  All values greater
;            than zero can represent success (however STATUS EQ 5 may
;            indicate failure to converge).  It can have one of the
;            following values:
;
;        -18  a fatal execution error has occurred.  More information
;             may be available in the ERRMSG string.
;
;        -16  a parameter or function value has become infinite or an
;             undefined number.  This is usually a consequence of
;             numerical overflow in the user's model function, which
;             must be avoided.
;
;        -15 to -1 
;             these are error codes that either MYFUNCT or ITERPROC
;             may return to terminate the fitting process (see
;             description of MPFIT_ERROR common below).  If either
;             MYFUNCT or ITERPROC set ERROR_CODE to a negative number,
;             then that number is returned in STATUS.  Values from -15
;             to -1 are reserved for the user functions and will not
;             clash with MPFIT.
;
;	   0  improper input parameters.
;         
;	   1  both actual and predicted relative reductions
;	      in the sum of squares are at most FTOL.
;         
;	   2  relative error between two consecutive iterates
;	      is at most XTOL
;         
;	   3  conditions for STATUS = 1 and STATUS = 2 both hold.
;         
;	   4  the cosine of the angle between fvec and any
;	      column of the jacobian is at most GTOL in
;	      absolute value.
;         
;	   5  the maximum number of iterations has been reached
;         
;	   6  FTOL is too small. no further reduction in
;	      the sum of squares is possible.
;         
;	   7  XTOL is too small. no further improvement in
;	      the approximate solution x is possible.
;         
;	   8  GTOL is too small. fvec is orthogonal to the
;	      columns of the jacobian to machine precision.
;
;   WEIGHTS - Array of weights to be used in calculating the
;             chi-squared value.  If WEIGHTS is specified then the ERR
;             parameter is ignored.  The chi-squared value is computed
;             as follows:
;
;                CHISQ = TOTAL( (Y-MYFUNCT(X,P))^2 * ABS(WEIGHTS) )
;
;             Here are common values of WEIGHTS for standard weightings:
;
;                1D/ERR^2 - Normal weighting (ERR is the measurement error)
;                1D/Y     - Poisson weighting (counting statistics)
;                1D       - Unweighted
;
;         NOTE: the following special cases apply:
;                * if WEIGHTS is zero, then the corresponding data point
;                  is ignored
;                * if WEIGHTS is NaN or Infinite, and the NAN keyword is
;                  set, then the corresponding data point is ignored
;                * if WEIGHTS is negative, then the absolute value of 
;                  WEIGHTS is used.
;
;   XTOL - a nonnegative input variable. Termination occurs when the
;          relative error between two consecutive iterates is at most
;          XTOL (and STATUS is accordingly set to 2 or 3).  Therefore,
;          XTOL measures the relative error desired in the approximate
;          solution.  Default: 1D-10
;
;   YFIT - the best-fit model function, as returned by MYFUNCT.
;
;   
; EXAMPLE:
;
;   ; First, generate some synthetic data
;   npts = 200
;   x  = dindgen(npts) * 0.1 - 10.                  ; Independent variable 
;   yi = gauss1(x, [2.2D, 1.4, 3000.])              ; "Ideal" Y variable
;   y  = yi + randomn(seed, npts) * sqrt(1000. + yi); Measured, w/ noise
;   sy = sqrt(1000.D + y)                           ; Poisson errors
;
;   ; Now fit a Gaussian to see how well we can recover
;   p0 = [1.D, 1., 1000.]                   ; Initial guess (cent, width, area)
;   p = mpfitfun('GAUSS1', x, y, sy, p0)    ; Fit a function
;   print, p
;
;   Generates a synthetic data set with a Gaussian peak, and Poisson
;   statistical uncertainty.  Then the same function is fitted to the
;   data (with different starting parameters) to see how close we can
;   get.
;
;
; COMMON BLOCKS:
;
;   COMMON MPFIT_ERROR, ERROR_CODE
;
;     User routines may stop the fitting process at any time by
;     setting an error condition.  This condition may be set in either
;     the user's model computation routine (MYFUNCT), or in the
;     iteration procedure (ITERPROC).
;
;     To stop the fitting, the above common block must be declared,
;     and ERROR_CODE must be set to a negative number.  After the user
;     procedure or function returns, MPFIT checks the value of this
;     common block variable and exits immediately if the error
;     condition has been set.  By default the value of ERROR_CODE is
;     zero, indicating a successful function/procedure call.
;
; REFERENCES:
;
;   MINPACK-1, Jorge More', available from netlib (www.netlib.org).
;   "Optimization Software Guide," Jorge More' and Stephen Wright, 
;     SIAM, *Frontiers in Applied Mathematics*, Number 14.
;
; MODIFICATION HISTORY:
;   Written, Apr-Jul 1998, CM
;   Added PERROR keyword, 04 Aug 1998, CM
;   Added COVAR keyword, 20 Aug 1998, CM
;   Added ITER output keyword, 05 Oct 1998
;      D.L Windt, Bell Labs, windt@bell-labs.com;
;   Added ability to return model function in YFIT, 09 Nov 1998
;   Analytical derivatives allowed via AUTODERIVATIVE keyword, 09 Nov 1998
;   Parameter values can be tied to others, 09 Nov 1998
;   Cosmetic documentation updates, 16 Apr 1999, CM
;   More cosmetic documentation updates, 14 May 1999, CM
;   Made sure to update STATUS, 25 Sep 1999, CM
;   Added WEIGHTS keyword, 25 Sep 1999, CM
;   Changed from handles to common blocks, 25 Sep 1999, CM
;     - commons seem much cleaner and more logical in this case.
;   Alphabetized documented keywords, 02 Oct 1999, CM
;   Added QUERY keyword and query checking of MPFIT, 29 Oct 1999, CM
;   Corrected EXAMPLE (offset of 1000), 30 Oct 1999, CM
;   Check to be sure that X and Y are present, 02 Nov 1999, CM
;   Documented PERROR for unweighted fits, 03 Nov 1999, CM
;   Changed to ERROR_CODE for error condition, 28 Jan 2000, CM
;   Corrected errors in EXAMPLE, 26 Mar 2000, CM
;   Copying permission terms have been liberalized, 26 Mar 2000, CM
;   Propagated improvements from MPFIT, 17 Dec 2000, CM
;   Added CASH statistic, 10 Jan 2001
;   Added NFREE and NPEGGED keywords, 11 Sep 2002, CM
;   Documented RELSTEP field of PARINFO (!!), CM, 25 Oct 2002
;   Add DOF keyword to return degrees of freedom, CM, 23 June 2003
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9
;     Oct 2006
;   Add NAN keyword, to ignore non-finite data values, 28 Oct 2006, CM
;   Clarify documentation on user-function, derivatives, and PARINFO,
;     27 May 2007
;   Fix bug in handling of explicit derivatives with errors/weights
;     (the weights were not being applied), CM, 03 Sep 2007
;   Add COMPATIBILITY section, CM, 13 Dec 2007
;   Add documentation about NAN behavior, CM, 30 Mar 2009
;   Add keywords BEST_RESIDS, CALC_FJAC, BEST_FJAC, PFREE_INDEX;
;     update some documentation that had become stale, CM, 2010-10-28
;   Documentation corrections, CM, 2011-08-26
;   Additional documentation about explicit derivatives, CM, 2012-07-23
;
;  $Id: mpfitfun.pro,v 1.19 2012/09/27 23:59:31 cmarkwar Exp $
;-
; Copyright (C) 1997-2002, 2003, 2006, 2007, 2009, 2010, 2011, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; This is the call-back function for MPFIT.  It evaluates the
; function, subtracts the data, and returns the residuals.
function mpfitfun_eval, p, dp, _EXTRA=extra

  COMPILE_OPT strictarr
  common mpfitfun_common, fcn, x, y, err, wts, f, fcnargs

  ;; Save the original DP matrix for later use
  if n_params() GT 1 then if n_elements(dp) GT 0 then dp0 = dp

  ;; The function is evaluated here.  There are four choices,
  ;; depending on whether (a) FUNCTARGS was passed to MPFITFUN, which
  ;; is passed to this function as "hf"; or (b) the derivative
  ;; parameter "dp" is passed, meaning that derivatives should be
  ;; calculated analytically by the function itself.
  if n_elements(fcnargs) GT 0 then begin
      if n_params() GT 1 then f = call_function(fcn, x, p, dp, _EXTRA=fcnargs)$
      else                    f = call_function(fcn, x, p, _EXTRA=fcnargs)
  endif else begin
      if n_params() GT 1 then f = call_function(fcn, x, p, dp) $
      else                    f = call_function(fcn, x, p)
  endelse

  np = n_elements(p)
  nf = n_elements(f)

  ;; Compute the deviates, applying either errors or weights
  if n_elements(wts) GT 0 then begin
      result = (y-f)*wts
      if n_elements(dp0) GT 0 AND n_elements(dp) EQ np*nf then begin
          for j = 0L, np-1 do dp[j*nf] = dp[j*nf:j*nf+nf-1] * wts
      endif
  endif else if n_elements(err) GT 0 then begin
      result = (y-f)/err
      if n_elements(dp0) GT 0 AND n_elements(dp) EQ np*nf then begin
          for j = 0L, np-1 do dp[j*nf] = dp[j*nf:j*nf+nf-1] / err
      endif
  endif else begin
      result = (y-f)
  endelse
      
  ;; Make sure the returned result is one-dimensional.
  result = reform(result, n_elements(result), /overwrite)
  return, result
  
end

;; Implement residual and gradient scaling according to the
;; prescription of Cash (ApJ, 228, 939)
pro mpfitfun_cash, resid, dresid
  COMPILE_OPT strictarr
  common mpfitfun_common, fcn, x, y, err, wts, f, fcnargs

  sz = size(dresid)
  m = sz[1]
  n = sz[2]

  ;; Do rudimentary dimensions checks, so we don't do something stupid
  if n_elements(y) NE m OR n_elements(f) NE m OR n_elements(resid) NE m then begin
      DIM_ERROR:
      message, 'ERROR: dimensions of Y, F, RESID or DRESID are not consistent'
  endif

  ;; Scale gradient by sqrt(y)/f
  gfact = temporary(dresid) * rebin(reform(sqrt(y)/f,m,1),m,n)
  dresid = reform(dresid, m, n, /overwrite)
  
  ;; Scale residuals by 1/sqrt(y)
  resid = temporary(resid)/sqrt(y)

  return
end

function mpfitfun, fcn, x, y, err, p, WEIGHTS=wts, FUNCTARGS=fa, $
                   BESTNORM=bestnorm, nfev=nfev, STATUS=status, $
                   best_resid=best_resid, pfree_index=ifree, $
                   calc_fjac=calc_fjac, best_fjac=best_fjac, $
                   parinfo=parinfo, query=query, CASH=cash, $
                   covar=covar, perror=perror, yfit=yfit, $
                   niter=niter, nfree=nfree, npegged=npegged, dof=dof, $
                   quiet=quiet, ERRMSG=errmsg, NAN=NAN, _EXTRA=extra

  COMPILE_OPT strictarr
  status = 0L
  errmsg = ''

  ;; Detect MPFIT and crash if it was not found
  catch, catcherror
  if catcherror NE 0 then begin
      MPFIT_NOTFOUND:
      catch, /cancel
      message, 'ERROR: the required function MPFIT must be in your IDL path', /info
      return, !values.d_nan
  endif
  if mpfit(/query) NE 1 then goto, MPFIT_NOTFOUND
  catch, /cancel
  if keyword_set(query) then return, 1

  if n_params() EQ 0 then begin
      message, "USAGE: PARMS = MPFITFUN('MYFUNCT', X, Y, ERR, "+ $
        "START_PARAMS, ... )", /info
      return, !values.d_nan
  endif
  if n_elements(x) EQ 0 OR n_elements(y) EQ 0 then begin
      message, 'ERROR: X and Y must be defined', /info
      return, !values.d_nan
  endif

  if n_elements(err) GT 0 OR n_elements(wts) GT 0 AND keyword_set(cash) then begin
      message, 'ERROR: WEIGHTS or ERROR cannot be specified with CASH', /info
      return, !values.d_nan
  endif
  if keyword_set(cash) then begin
      scalfcn = 'mpfitfun_cash'
  endif

  ;; Use common block to pass data back and forth
  common mpfitfun_common, fc, xc, yc, ec, wc, mc, ac
  fc = fcn & xc = x & yc = y & mc = 0L
  ;; These optional parameters must be undefined first
  ac = 0 & dummy = size(temporary(ac))
  ec = 0 & dummy = size(temporary(ec))
  wc = 0 & dummy = size(temporary(wc))

  ;; FUNCTARGS
  if n_elements(fa) GT 0 then ac = fa

  ;; WEIGHTS or ERROR
  if n_elements(wts) GT 0 then begin
      wc = sqrt(abs(wts))
  endif else if n_elements(err) GT 0 then begin
      wh = where(err EQ 0, ct)
      if ct GT 0 then begin
          errmsg = 'ERROR: ERROR value must not be zero.  Use WEIGHTS instead.'
          message, errmsg, /info
          return, !values.d_nan
      endif
      ;; Appropriate weight for gaussian errors
      wc = 1/abs(err)
  endif

  ;; Check for weights/errors which do not match the dimension
  ;; of the data points
  if n_elements(wc) GT 0 AND $
    n_elements(wc) NE 1 AND $
    n_elements(wc) NE n_elements(yc) then begin
      errmsg = 'ERROR: ERROR/WEIGHTS must either be a scalar or match the number of Y values'
      message, errmsg, /info
      return, !values.d_nan
  endif

  ;; If the weights/errors are a scalar value, and not finite, then 
  ;; the fit will surely fail
  if n_elements(wc) EQ 1 then begin
      if finite(wc[0]) EQ 0 then begin
          errmsg = 'ERROR: the supplied scalar WEIGHT/ERROR value was not finite'
          message, errmsg, /info
          return, !values.d_nan
      endif
  endif

  ;; Handle the cases of non-finite data points or weights
  if keyword_set(nan) then begin
      ;; Non-finite data points
      wh = where(finite(yc) EQ 0, ct)
      if ct GT 0 then begin
          yc[wh] = 0
          ;; Careful: handle case when weights were a scalar...
          ;;   ... promote to a vector
          if n_elements(wc) EQ 1 then wc = replicate(wc[0], n_elements(yc))
          wc[wh] = 0
      endif

      ;; Non-finite weights
      wh = where(finite(wc) EQ 0, ct)
      if ct GT 0 then wc[wh] = 0
  endif

  result = mpfit('mpfitfun_eval', p, SCALE_FCN=scalfcn, $
                 parinfo=parinfo, STATUS=status, nfev=nfev, BESTNORM=bestnorm,$
                 covar=covar, perror=perror, $
                 best_resid=best_resid, pfree_index=ifree, $
                 calc_fjac=calc_fjac, best_fjac=best_fjac, $
                 niter=niter, nfree=nfree, npegged=npegged, dof=dof, $
                 ERRMSG=errmsg, quiet=quiet, _EXTRA=extra)

  ;; Retrieve the fit value
  yfit = temporary(mc)

  ;; Rescale the Jacobian according to parameter uncertainties
  if keyword_set(calc_fjac) AND nfree GT 0 AND status GT 0 then begin
      ec = 1/wc  ;; Per-data-point errors (could be INF or NAN!)
      for i = 0, nfree-1 do best_fjac[*,i] = - best_fjac[*,i] * ec
  endif

  ;; Some cleanup
  xc = 0 & yc = 0 & wc = 0 & ec = 0 & mc = 0 & ac = 0

  ;; Print error message if there is one.
  if NOT keyword_set(quiet) AND errmsg NE '' then $
    message, errmsg, /info

  return, result
end
;+
; NAME:
;   MPFITPEAK
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Fit a gaussian, lorentzian or Moffat model to data
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   yfit = MPFITPEAK(X, Y, A, NTERMS=nterms, ...)
;
; DESCRIPTION:
;
;   MPFITPEAK fits a gaussian, lorentzian or Moffat model using the
;   non-linear least squares fitter MPFIT.  MPFITPEAK is meant to be a
;   drop-in replacement for IDL's GAUSSFIT function (and requires
;   MPFIT and MPFITFUN).
;
;   The choice of the fitting function is determined by the keywords
;   GAUSSIAN, LORENTZIAN and MOFFAT.  By default the gaussian model
;   function is used.  [ The Moffat function is a modified Lorentzian
;   with variable power law index. (Moffat, A. F. J. 1969, Astronomy &
;   Astrophysics, v. 3, p. 455-461) ]
;
;   The functional form of the baseline is determined by NTERMS and
;   the function to be fitted.  NTERMS represents the total number of
;   parameters, A, to be fitted.  The functional forms and the
;   meanings of the parameters are described in this table:
;
;                 GAUSSIAN#          Lorentzian#         Moffat#
;
;   Model     A[0]*exp(-0.5*u^2)   A[0]/(u^2 + 1)   A[0]/(u^2 + 1)^A[3]
;
;   A[0]         Peak Value          Peak Value        Peak Value
;   A[1]        Peak Centroid       Peak Centroid     Peak Centroid
;   A[2]       Gaussian Sigma           HWHM%             HWHM%
;   A[3]         + A[3]    *          + A[3]   *      Moffat Index
;   A[4]         + A[4]*x  *          + A[4]*x *         + A[4]   *
;   A[5]                                                 + A[5]*x *
;
;   Notes: # u = (x - A[1])/A[2]
;          % Half-width at half maximum
;          * Optional depending on NTERMS
;
;   By default the initial starting values for the parameters A are
;   estimated from the data.  However, explicit starting values can be
;   supplied using the ESTIMATES keyword.  Also, error or weighting
;   values can optionally be provided; otherwise the fit is
;   unweighted.
;
;   MPFITPEAK fits the peak value of the curve.  The area under a
;   gaussian peak is A[0]*A[2]*SQRT(2*!DPI); the area under a
;   lorentzian peak is A[0]*A[2]*!DPI.
;
;  Data values of NaN or Infinity for "Y", "ERROR" or "WEIGHTS" will
;  be ignored as missing data if the NAN keyword is set.  Otherwise,
;  they may cause the fitting loop to halt with an error message.
;  Note that the fit will still halt if the model function, or its
;  derivatives, produces infinite or NaN values, or if an "X" value is
;  missing.
;
; RESTRICTIONS:
;
;   If no starting parameter ESTIMATES are provided, then MPFITPEAK
;   attempts to estimate them from the data.  This is not a perfect
;   science; however, the author believes that the technique
;   implemented here is more robust than the one used in IDL's
;   GAUSSFIT.  The author has tested cases of strong peaks, noisy
;   peaks and broad peaks, all with success.
;
;   Users should be aware that if the baseline term contains a strong
;   linear component then the automatic estimation may fail.  For
;   automatic estimation to work the peak amplitude should dominate
;   over the the maximum baseline.
;
; COMPATIBILITY
;
;  This function is designed to work with IDL 5.0 or greater.
;  
;  Because TIED parameters rely on the EXECUTE() function, they cannot
;  be used with the free version of the IDL Virtual Machine.
;
;
; INPUTS:
;   X - Array of independent variable values, whose values should
;       monotonically increase.
;
;   Y - Array of "measured" dependent variable values.  Y should have
;       the same data type and dimension as X.
;         NOTE: the following special cases apply:
;                * if Y is NaN or Infinite, and the NAN keyword is
;                  set, then the corresponding data point is ignored
;
; OUTPUTS:
;   A - Upon return, an array of NTERMS best fit parameter values.
;       See the table above for the meanings of each parameter
;       element.
;
;
; RETURNS:
;
;   Returns the best fitting model function.
;
; KEYWORDS:
;
;   ** NOTE ** Additional keywords such as PARINFO, BESTNORM, and
;              STATUS are accepted by MPFITPEAK but not documented
;              here.  Please see the documentation for MPFIT for the
;              description of these advanced options.
;
;   AUTODERIV - Set to 1 to have MPFIT compute the derivatives numerically.
;          Default is 0 -  derivatives are computed analytically, which is 
;              generally faster.    (Prior to Jan 2011, the default was 1)
;
;   CHISQ - the value of the summed squared residuals for the
;           returned parameter values.
;
;   DOF - number of degrees of freedom, computed as
;             DOF = N_ELEMENTS(DEVIATES) - NFREE
;         Note that this doesn't account for pegged parameters (see
;         NPEGGED).
;
;   ERROR - upon input, the measured 1-sigma uncertainties in the "Y"
;           values.  If no ERROR or WEIGHTS are given, then the fit is
;           unweighted.
;         NOTE: the following special cases apply:
;                * if ERROR is zero, then the corresponding data point
;                  is ignored
;                * if ERROR is NaN or Infinite, and the NAN keyword is
;                  set, then the corresponding data point is ignored
;                * if ERROR is negative, then the absolute value of 
;                  ERROR is used.
;
;   ESTIMATES - Array of starting values for each parameter of the
;               model.  The number of parameters should at least be
;               three (four for Moffat), and if less than NTERMS, will
;               be extended with zeroes.  If ESTIMATES is not set,
;               then the starting values are estimated from the data
;               directly, before fitting.  (This also means that
;               PARINFO.VALUES is ignored.)
;               Default: not set - parameter values are estimated from data.
;
;   GAUSSIAN - if set, fit a gaussian model function.  The Default.
;   LORENTZIAN - if set, fit a lorentzian model function.
;   MOFFAT - if set, fit a Moffat model function.
;
;   MEASURE_ERRORS - synonym for ERRORS, for consistency with built-in
;                    IDL fitting routines.
;
;   NAN - ignore infinite or NaN values in the Y, ERR or WEIGHTS
;         parameters.  These values will be treated as missing data.
;         However, the fit will still halt with an error condition if
;         the model function becomes infinite, or if X has missing
;         values.
;
;   NEGATIVE / POSITIVE - if set, and ESTIMATES is not provided, then
;                         MPFITPEAK will assume that a
;                         negative/positive peak is present.
;                         Default: determined automatically
;
;   NFREE - the number of free parameters in the fit.  This includes
;           parameters which are not FIXED and not TIED, but it does
;           include parameters which are pegged at LIMITS.
;
;   NO_FIT - if set, then return only the initial estimates without
;            fitting.  Useful to find out what the estimates the
;            automatic guessing algorithm produced.  If NO_FIT is set,
;            then SIGMA and CHISQ values are not produced.  The
;            routine returns, NAN, and STATUS=5.
;
;   NTERMS - An integer describing the number of fitting terms.
;            NTERMS must have a minimum value, but can optionally be
;            larger depending on the desired baseline.  
;
;            For gaussian and lorentzian models, NTERMS must be three
;            (zero baseline), four (constant baseline) or five (linear
;            baseline).  Default: 4
;
;            For the Moffat model, NTERMS must be four (zero
;            baseline), five (constant baseline), or six (linear
;            baseline).  Default: 5
;
;   PERROR - upon return, the 1-sigma uncertainties of the parameter
;            values A.  These values are only meaningful if the ERRORS
;            or WEIGHTS keywords are specified properly.
;
;            If the fit is unweighted (i.e. no errors were given, or
;            the weights were uniformly set to unity), then PERROR
;            will probably not represent the true parameter
;            uncertainties.  
;
;            *If* you can assume that the true reduced chi-squared
;            value is unity -- meaning that the fit is implicitly
;            assumed to be of good quality -- then the estimated
;            parameter uncertainties can be computed by scaling PERROR
;            by the measured chi-squared value.
;
;              DOF     = N_ELEMENTS(X) - N_ELEMENTS(PARMS) ; deg of freedom
;              PCERROR = PERROR * SQRT(BESTNORM / DOF)   ; scaled uncertainties
;
;   QUIET - if set then diagnostic fitting messages are suppressed.
;           Default: QUIET=1 (i.e., no diagnostics)
;
;   SIGMA - synonym for PERROR (1-sigma parameter uncertainties), for
;           compatibility with GAUSSFIT.  Do not confuse this with the
;           Gaussian "sigma" width parameter.
;
;   WEIGHTS - Array of weights to be used in calculating the
;             chi-squared value.  If WEIGHTS is specified then the ERROR
;             keyword is ignored.  The chi-squared value is computed
;             as follows:
;
;                CHISQ = TOTAL( (Y-MYFUNCT(X,P))^2 * ABS(WEIGHTS) )
;
;             Here are common values of WEIGHTS:
;
;                1D/ERR^2 - Normal weighting (ERR is the measurement error)
;                1D/Y     - Poisson weighting (counting statistics)
;                1D       - Unweighted
;
;             The ERROR keyword takes precedence over any WEIGHTS
;             keyword values.  If no ERROR or WEIGHTS are given, then
;             the fit is unweighted.
;         NOTE: the following special cases apply:
;                * if WEIGHTS is zero, then the corresponding data point
;                  is ignored
;                * if WEIGHTS is NaN or Infinite, and the NAN keyword is
;                  set, then the corresponding data point is ignored
;                * if WEIGHTS is negative, then the absolute value of 
;                  WEIGHTS is used.
;
;   YERROR - upon return, the root-mean-square variance of the
;            residuals.
;
;
; EXAMPLE:
;
;   ; First, generate some synthetic data
;   npts = 200
;   x  = dindgen(npts) * 0.1 - 10.                  ; Independent variable 
;   yi = gauss1(x, [2.2D, 1.4, 3000.]) + 1000       ; "Ideal" Y variable
;   y  = yi + randomn(seed, npts) * sqrt(1000. + yi); Measured, w/ noise
;   sy = sqrt(1000.D + y)                           ; Poisson errors
;
;   ; Now fit a Gaussian to see how well we can recover the original
;   yfit = mpfitpeak(x, y, a, error=sy)
;   print, p
;
;   Generates a synthetic data set with a Gaussian peak, and Poisson
;   statistical uncertainty.  Then the same function is fitted to the
;   data.
;
; REFERENCES:
;
;   MINPACK-1, Jorge More', available from netlib (www.netlib.org).
;   "Optimization Software Guide," Jorge More' and Stephen Wright, 
;     SIAM, *Frontiers in Applied Mathematics*, Number 14.
;
; MODIFICATION HISTORY:
;
;   New algorithm for estimating starting values, CM, 31 Oct 1999
;   Documented, 02 Nov 1999
;   Small documentation fixes, 02 Nov 1999
;   Slight correction to calculation of dx, CM, 02 Nov 1999
;   Documented PERROR for unweighted fits, 03 Nov 1999, CM
;   Copying permission terms have been liberalized, 26 Mar 2000, CM
;   Change requirements on # elements in X and Y, 20 Jul 2000, CM
;      (thanks to David Schlegel <schlegel@astro.princeton.edu>)
;   Added documentation on area under curve, 29 Aug 2000, CM
;   Added POSITIVE and NEGATIVE keywords, 17 Nov 2000, CM
;   Added reference to Moffat paper, 10 Jan 2001, CM
;   Added usage message, 26 Jul 2001, CM
;   Documentation clarification, 05 Sep 2001, CM
;   Make more consistent with comparable IDL routines, 30 Jun 2003, CM
;   Assumption of sorted data was removed, CM, 06 Sep 2003, CM
;   Add some defensive code against divide by zero, 30 Nov 2005, CM
;   Add some defensive code against all Y values equal to each other,
;     17 Apr 2005, CM
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9 Oct 2006
;   Add COMPATIBILITY section, CM, 13 Dec 2007
;   Missed some old IDL 4 () array syntax, now corrected, 13 Jun 2008
;   Slightly more error checking for pathalogical case, CM, 11 Nov 2008
;   Clarify documentation regarding what happens when ESTIMATES is not
;     set, CM, 14 Dec 2008
;   Add the NAN keyword, document how NAN, WEIGHTS and ERROR interact,
;     CM, 30 Mar 2009
;   Correct one case of old IDL 4 () array syntax (thanks to I. Urra),
;     CM, 25 Jan 2010
;  Improve performance by analytic derivative computation, added AUTODERIV 
;      keyword, W. Landsman, 2011-01-21
;  Move estimation code to its own function; allow the user to compute
;    only the estimate and return immediately without fitting,
;    C. Markwardt, 2011-07-12
;
;  $Id: mpfitpeak.pro,v 1.19 2011/12/08 17:51:33 cmarkwar Exp $
;-
; Copyright (C) 1997-2001, 2003, 2005, 2007, 2008, 2009, 2010, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; Gaussian Function
function mpfitpeak_gauss, x, p, pder, _extra=extra
  COMPILE_OPT strictarr,hidden
  sz = size(x,/type)
  if sz EQ 5 then smax = 26D else smax = 13.
  u = mpfitpeak_u(x, p)
  mask = abs(u) LT smax  ;; Prevents floating underflow
  Np = N_elements(p)
  if Np GE 4 then f = p[3] else f = 0
  if Np GE 5 then f = f + p[4]*x
  uz = mask*exp(-0.5 * u^2 * mask)
  if N_params() GT 2 then begin    ;; Compute derivatives if asked
      pder = make_array(N_elements(x), Np,type= size(p,/type) )
      pder[*,0] = uz      
      if p[2] NE 0 then pder[*,1] = p[0]*uz*u/p[2]
      pder[*,2] = pder[*,1]*u
      if Np GE 4 then pder[*,3] = 1.
      if Np GE 5 then pder[*,4] = x
      endif
  return,  f + p[0] * uz
end

; Lorentzian Function
function mpfitpeak_lorentz, x, p, pder, _extra=extra
  COMPILE_OPT strictarr,hidden
  u = mpfitpeak_u(x, p)
  Np = N_elements(p)
  if Np GE 4 then f = p[3] else f = 0
  if Np GE 5 then f = f + p[4]*x
  denom = 1/(u^2 + 1)
  if N_params() GT 2 then begin   ;; Compute derivatives if asked
      pder = make_array(N_elements(x), Np,type= size(p,/type) )
      pder[*,0] = denom
      if p[2] NE 0 then pder[*,1] = 2*p[0]*u*denom*denom/p[2]    
      pder[*,2] = pder[*,1]*u
      if Np GE 4 then pder[*,3] = 1.
      if Np GE 5 then pder[*,4] = x
    endif
    return, f + p[0] *denom
end

; Moffat Function
function mpfitpeak_moffat, x, p, pder,_extra=extra
  COMPILE_OPT strictarr
  u = mpfitpeak_u(x, p)
  Np = N_elements(p)
  if Np GE 5 then f = p[4] else f = 0
  if Np GE 6 then f = f + p[5]*x
  denom0 =   (u^2 +1)
  denom = denom0^(-p[3])
  if N_params() GT 2 then begin      ;; Compute derivatives if asked
      pder = make_array(N_elements(x), Np,type= size(p,/type) )
      pder[*,0] = denom
      if p[2] NE 0 then pder[*,1] = 2*p[3]*p[0]*u*denom/p[2]/denom0    
      pder[*,2] = pder[*,1]*u
      pder[*,3] = -alog(denom0)*p[0]*denom
      if Np GE 5 then pder[*,4] = 1.
      if Np GE 6 then pder[*,5] = x
    endif
  return, f + p[0]* denom
end

;
; Utility function to estimate peak parameters from an X,Y dataset
;
; X - independent variable
; Y - dependent variable (possibly noisy)
; NAN - if set, then ignore NAN values
; POSITIVE_PEAK - if set, search for positive peak
; NEGATIVE_PEAK - if set, search for negative peak
; (if neither POSITIVE_PEAK nor NEGATIVE_PEAK is set, then search
; for the largest magnitude peak)
; ERRMSG - upon return, set to an error code if an error occurred
;
function mpfitpeak_est, x, y, nan=nan, $
                          positive_peak=pos, negative_peak=neg, $
                          errmsg=errmsg

  ;; Here is the secret - the width is estimated based on the area
  ;; above/below the average.  Thus, as the signal becomes more
  ;; noisy the width automatically broadens as it should.

  nx = n_elements(x)

  is = sort(x)
  xs = x[is] & ys = y[is]
  maxx = max(xs, min=minx) & maxy = max(ys, min=miny, nan=nan)
  dx = 0.5 * [xs[1]-xs[0], xs[2:*] - xs, xs[nx-1] - xs[nx-2]]
  totarea = total(dx*ys, nan=nan)       ;; Total area under curve
  av = totarea/(maxx - minx)  ;; Average height

  ;; Degenerate case: all flat with no noise
  if miny EQ maxy then begin
      est = ys[0]*0.0 + [0,xs[nx/2],(xs[nx-1]-xs[0])/2, ys[0]]
      guess = 1
      return, est
  endif

  ;; Compute the spread in values above and below average... we
  ;; take the narrowest one as the one with the peak
  wh1 = where(y GE av, ct1)
  wh2 = where(y LE av, ct2)
  if ct1 EQ 0 OR ct2 EQ 0 then begin
      errmsg = 'ERROR: average Y value should fall within the range of Y data values but does not'
      return, !values.d_nan
  endif
  sd1 = total(x[wh1]^2)/ct1 - (total(x[wh1])/ct1)^2
  sd2 = total(x[wh2]^2)/ct2 - (total(x[wh2])/ct2)^2
      
  ;; Compute area above/below average

  if keyword_set(pos) then goto, POS_PEAK
  if keyword_set(neg) then goto, NEG_PEAK
  if sd1 LT sd2 then begin  ;; This is a positive peak
      POS_PEAK:
      cent  = x[where(y EQ maxy)] & cent = cent[0]
      peak  = maxy - av
  endif else begin          ;; This is a negative peak
      NEG_PEAK:
      cent  = x[where(y EQ miny)] & cent = cent[0]
      peak  = miny - av
  endelse
  peakarea = totarea - total(dx*(ys<av), nan=nan)
  if peak EQ 0 then peak = 0.5*peakarea
  width = peakarea / (2*abs(peak))
  if width EQ 0 OR finite(width) EQ 0 then width = median(dx)

  est = [peak, cent, width, av]
  return, est
end


function mpfitpeak, x, y, a, estimates=est, nterms=nterms, $
                    gaussian=gauss, lorentzian=lorentz, moffat=moffat, $
                    perror=perror, sigma=sigma, yerror=yerror, $
                    chisq=chisq, bestnorm=bestnorm, niter=iter, nfev=nfev, $
                    error=dy, weights=weights, measure_errors=dym, $
                    nfree=nfree, dof=dof, nan=nan, $
                    no_fit=no_fit, $
                    negative=neg, positive=pos, parinfo=parinfo, $
                    best_fjac=best_fjac, pfree_index=pfree_index, covar=covar,$
                    errmsg=errmsg, status=status, autoderiv=autoderiv0, $
                    query=query, quiet=quiet, _extra=extra

  COMPILE_OPT strictarr
  status = 0L
  errmsg = ''

  if n_params() EQ 0 then begin
      message, 'USAGE: yfit = MPFITPEAK(X, Y, A, ...)', /info
      return, !values.d_nan
  endif

  ;; Detect MPFIT and crash if it was not found
  catch, catcherror
  if catcherror NE 0 then begin
      MPFIT_NOTFOUND:
      catch, /cancel
      message, 'ERROR: the required functions MPFIT and MPFITFUN ' + $
        'must be in your IDL path', /info
      return, !values.d_nan
  endif
  if mpfit(/query)    NE 1 then goto, MPFIT_NOTFOUND
  if mpfitfun(/query) NE 1 then goto, MPFIT_NOTFOUND
  catch, /cancel
  if keyword_set(query) then return, 1

  ;; Check the number of parameter estimates
  if n_elements(quiet) EQ 0 then quiet = 1
  if n_elements(nterms) EQ 0 then nterms = 4
  if n_elements(autoderiv0) EQ 0 then autoderiv = 0 else autoderiv = keyword_set(autoderiv0)

  ;; Reject data vectors that are too simple
  if n_elements(x) LT nterms OR n_elements(y) LT nterms then begin
      errmsg = 'ERROR: X and Y must have at least NTERMS elements'
      message, errmsg, /cont
      status = 0
      return, !values.d_nan
  endif

  ;; Compute the weighting factors to use
  if (n_elements(dy) EQ 0 AND n_elements(weights) EQ 0 AND $
      n_elements(dym) EQ 0) then begin
      weights = x*0+1        ;; Unweighted by default
  endif else if n_elements(dy) GT 0 then begin
      weights = dy * 0   ;; Avoid division by zero
      wh = where(dy NE 0, ct)
      if ct GT 0 then weights[wh] = 1./dy[wh]^2
  endif else if n_elements(dym) GT 0 then begin
      weights = dym * 0   ;; Avoid division by zero
      wh = where(dym NE 0, ct)
      if ct GT 0 then weights[wh] = 1./dym[wh]^2
  endif

  ;; If the user did not supply an estimate of the parameter values,
  ;; then try to guestimate them.
  if n_elements(est) EQ 0 then begin
      guess = 1
      est = mpfitpeak_est(x, y, nan=nan, pos=pos, neg=neg, $
                          errmsg=errmsg)

      if errmsg NE '' then begin
          message, errmsg, /cont
          status = 0
      endif
  endif

  ;; Parameter checking for individual function types
  np = 3
  if keyword_set(moffat) then begin               ;; MOFFAT
      fun = 'mpfitpeak_moffat'
      if keyword_set(guess) then est = [est[0:2], 1, est[3:*]]
      np = 4
  endif else if keyword_set(lorentz) then begin  ;; LORENTZIAN
      fun = 'mpfitpeak_lorentz'
  endif else begin                               ;; GAUSSIAN
      fun = 'mpfitpeak_gauss'
  endelse
  if n_elements(est) LT np then begin
      errmsg = 'ERROR: parameter ESTIMATES must have at least '+strtrim(np,2)+$
        ' elements'
      message, errmsg, /cont
      return, !values.d_nan
  endif
  if nterms[0] LT np then begin
      errmsg = 'ERROR: NTERMS must be at least '+strtrim(np,2)
      message, errmsg, /cont
      return, !values.d_nan
  endif
  p0 = replicate(est[0]*0, nterms[0] > n_elements(est))
  p0[0] = est

  ;; If the user wanted only to get an estimate, then return here
  if keyword_set(no_fit) then begin
      status = 5
      a = est
      return, !values.d_nan
  endif

  ;; Function call
  a = mpfitfun(fun, x, y, 0, p0[0:nterms[0]-1], weights=weights, $
               bestnorm=bestnorm, nfev=nfev, status=status, $
               nfree=nfree, dof=dof, nan=nan, $
               parinfo=parinfo, perror=perror, niter=iter, yfit=yfit, $
               best_fjac=best_fjac, pfree_index=pfree_index, covar=covar, $
               quiet=quiet, errmsg=errmsg, autoderiv=autoderiv, _EXTRA=extra)

  ;; Print error message if there is one.
  if NOT keyword_set(quiet) AND errmsg NE '' then $
    message, errmsg, /cont

  if status NE 0 then begin
      ;; Make sure the width is positive
      a[2] = abs(a[2])

      ;; For compatibility with GAUSSFIT
      if n_elements(perror)   GT 0 then sigma = perror
      if n_elements(bestnorm) GT 0 then chisq = bestnorm

      ;; Root mean squared of residuals
      yerror = a[0]*0
      if n_elements(dof) GT 0 AND dof[0] GT 0 then begin
          yerror[0] = sqrt( total( (y-yfit)^2, nan=nan ) / dof[0])
      endif

      return, yfit
  endif

  return, !values.d_nan
end

;+
; NAME:
;   MPFTEST
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute the probability of a given F value
;
; MAJOR TOPICS:
;   Curve and Surface Fitting, Statistics
;
; CALLING SEQUENCE:
;   PROB = MPFTEST(F, DOF1, DOF2, [/SIGMA, /CLEVEL, /SLEVEL ])
;
; DESCRIPTION:
;
;  The function MPFTEST() computes the probability for a value drawn
;  from the F-distribution to equal or exceed the given value of F.
;  This can be used for confidence testing of a measured value obeying
;  the F-distribution (i.e., for testing the ratio of variances, or
;  equivalently for the addition of parameters to a fitted model).
;
;    P_F(X > F; DOF1, DOF2) = PROB
;
;  In specifying the returned probability level the user has three
;  choices:
;
;    * return the confidence level when the /CLEVEL keyword is passed;
;      OR
;
;    * return the significance level (i.e., 1 - confidence level) when
;      the /SLEVEL keyword is passed (default); OR
;
;    * return the "sigma" of the probability (i.e., compute the
;      probability based on the normal distribution) when the /SIGMA
;      keyword is passed.
;
;  Note that /SLEVEL, /CLEVEL and /SIGMA are mutually exclusive.
;
;  For the ratio of variance test, the two variances, VAR1 and VAR2,
;  should be distributed according to the chi-squared distribution
;  with degrees of freedom DOF1 and DOF2 respectively.  The F-value is
;  computed as:
;
;     F = (VAR1/DOF1) / (VAR2/DOF2)
;
;  and then the probability is computed as:
;
;     PROB = MPFTEST(F, DOF1, DOF2, ... )
;
;
;  For the test of additional parameters in least squares fitting, the
;  user should perform two separate fits, and have two chi-squared
;  values.  One fit should be the "original" fit with no additional
;  parameters, and one fit should be the "new" fit with M additional
;  parameters.
;
;    CHI1 - chi-squared value for original fit
;
;    DOF1 - number of degrees of freedom of CHI1 (number of data
;           points minus number of original parameters)
;
;    CHI2 - chi-squared value for new fit
;
;    DOF2 - number of degrees of freedom of CHI2
;
;  Note that according to this formalism, the number of degrees of
;  freedom in the "new" fit, DOF2, should be less than the number of
;  degrees of freedom in the "original" fit, DOF1 (DOF2 < DOF1); and
;  also CHI2 < CHI1.
;
;  With the above definition, the F value is computed as:
;
;    F = ( (CHI1-CHI2)/(DOF1-DOF2) )   /  (CHI2/DOF2)
;
;  where DOF1-DOF2 is equal to M, and then the F-test probability is
;  computed as:
;
;     PROB = MPFTEST(F, DOF1-DOF2, DOF2, ... )
;
;  Note that this formalism assumes that the addition of the M
;  parameters is a small peturbation to the overall fit.  If the
;  additional parameters dramatically changes the character of the
;  model, then the first "ratio of variance" test is more appropriate,
;  where F = (CHI1/DOF1) / (CHI2/DOF2).
;
; INPUTS:
;
;   F - ratio of variances as defined above.
;
;   DOF1 - number of degrees of freedom in first variance component.
;
;   DOF2 - number of degrees of freedom in second variance component.
;
;
; RETURNS:
;
;  Returns a scalar or vector of probabilities, as described above,
;  and according to the /SLEVEL, /CLEVEL and /SIGMA keywords.
;
; KEYWORD PARAMETERS:
;
;   SLEVEL - if set, then PROB describes the significance level
;            (default).
;
;   CLEVEL - if set, then PROB describes the confidence level.
;
;   SIGMA - if set, then PROB is the number of "sigma" away from the
;           mean in the normal distribution.
;
; EXAMPLE:
;
;   chi1 = 62.3D & dof1 = 42d
;   chi2 = 54.6D & dof2 = 40d
;
;   f = ((chi1-chi2)/(dof1-dof2)) / (chi2/dof2)
;   print, mpftest(f, dof1-dof2, dof2)
;
;   This is a test for addition of parameters.  The "original"
;   chi-squared value was 62.3 with 42 degrees of freedom, and the
;   "new" chi-squared value was 54.6 with 40 degrees of freedom.
;   These values reflect the addition of 2 parameters and the
;   reduction of the chi-squared value by 7.7.  The significance of
;   this set of circumstances is 0.071464757.
;
; REFERENCES:
;
;   Algorithms taken from CEPHES special function library, by Stephen
;   Moshier. (http://www.netlib.org/cephes/)
;
; MODIFICATION HISTORY:
;   Completed, 1999, CM
;   Documented, 16 Nov 2001, CM
;   Reduced obtrusiveness of common block and math error handling, 18
;     Nov 2001, CM
;   Added documentation, 30 Dec 2001, CM
;   Documentation corrections (thanks W. Landsman), 17 Jan 2002, CM
;   Example docs were corrected (Thanks M. Perez-Torres), 17 Feb 2002,
;     CM
;   Example corrected again (sigh...), 13 Feb 2003, CM
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9 Oct 2006
;   Usage message with /CONTINUE, 23 Sep 2009, CM
;
;  $Id: mpftest.pro,v 1.10 2009/09/23 20:12:46 craigm Exp $
;-
; Copyright (C) 1999,2001,2002,2003,2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Set machine constants, once for this session.  Double precision
;; only.
pro cephes_setmachar
  COMPILE_OPT strictarr
  common cephes_machar, cephes_machar_vals
  if n_elements(cephes_machar_vals) GT 0 then return

  if (!version.release) LT 5 then dummy = check_math(1, 1)

  mch = machar(/double)
  machep = mch.eps
  maxnum = mch.xmax
  minnum = mch.xmin
  maxlog = alog(mch.xmax)
  minlog = alog(mch.xmin)
  maxgam = 171.624376956302725D

  cephes_machar_vals = {machep: machep, maxnum: maxnum, minnum: minnum, $
                        maxlog: maxlog, minlog: minlog, maxgam: maxgam}

  if (!version.release) LT 5 then dummy = check_math(0, 0)
  return
end

;							incbet.c
;   
;   	Incomplete beta integral
;   
;   
;    SYNOPSIS:
;   
;    double a, b, x, y, incbet();
;   
;    y = incbet( a, b, x );
;   
;   
;    DESCRIPTION:
;   
;    Returns incomplete beta integral of the arguments, evaluated
;    from zero to x.  The function is defined as
;   
;                     x
;        -            -
;       | (a+b)      | |  a-1     b-1
;     -----------    |   t   (1-t)   dt.
;      -     -     | |
;     | (a) | (b)   -
;                    0
;   
;    The domain of definition is 0 <= x <= 1.  In this
;    implementation a and b are restricted to positive values.
;    The integral from x to 1 may be obtained by the symmetry
;    relation
;   
;       1 - incbet( a, b, x )  =  incbet( b, a, 1-x ).
;   
;    The integral is evaluated by a continued fraction expansion
;    or, when b*x is small, by a power series.
;   
;    ACCURACY:
;   
;    Tested at uniformly distributed random points (a,b,x) with a and b
;    in "domain" and x between 0 and 1.
;                                           Relative error
;    arithmetic   domain     # trials      peak         rms
;       IEEE      0,5         10000       6.9e-15     4.5e-16
;       IEEE      0,85       250000       2.2e-13     1.7e-14
;       IEEE      0,1000      30000       5.3e-12     6.3e-13
;       IEEE      0,10000    250000       9.3e-11     7.1e-12
;       IEEE      0,100000    10000       8.7e-10     4.8e-11
;    Outputs smaller than the IEEE gradual underflow threshold
;    were excluded from these statistics.
;   
;    ERROR MESSAGES:
;      message         condition      value returned
;    incbet domain      x<0, x>1          0.0
;    incbet underflow                     0.0
function cephes_incbet, aa, bb, xx

  COMPILE_OPT strictarr
  forward_function cephes_incbcf, cephes_incbd, cephes_pseries

  common cephes_machar, machvals
  MINLOG = machvals.minlog
  MAXLOG = machvals.maxlog
  MAXGAM = machvals.maxgam
  MACHEP = machvals.machep

  if aa LE 0. OR bb LE 0. then goto, DOMERR

  if xx LE 0. OR xx GE 1. then begin
      if xx EQ 0 then return, 0.D
      if xx EQ 1. then return, 1.D
      DOMERR:
      message, 'ERROR: domain', /info
      return, 0.D
  endif

  flag = 0
  if bb * xx LE 1. AND xx LE 0.95 then begin
      t = cephes_pseries(aa, bb, xx)
      goto, DONE
  endif

  w = 1.D - xx

  if xx GT aa/(aa+bb) then begin
      flag = 1
      a = bb
      b = aa
      xc = xx
      x = w
  endif else begin
      a = aa
      b = bb
      xc = w
      x = xx
  endelse

  if flag EQ 1 AND b*x LE 1. AND x LE 0.95 then begin
      t = cephes_pseries(a, b, x)
      goto, DONE
  endif

  ;; Choose expansion for better convergence
  y = x * (a+b-2.) - (a-1.)
  if y LT 0. then w = cephes_incbcf(a, b, x) $
  else            w = cephes_incbd(a, b, x) / xc

  ;; Multiply w by the factor
  ;;    a      b   _             _     _
  ;;   x  (1-x)   | (a+b) / ( a | (a) | (b) ) .   */
  y = a * alog(x)
  t = b * alog(xc)
  if (a+b) LT MAXGAM AND abs(y) LT MAXLOG AND abs(t) LT MAXLOG then begin
      t = ((xc^b) * (x^a)) * w * gamma(a+b) / ( a * gamma(a) * gamma(b) )
      goto, DONE
  endif

  ;; Resort to logarithms
  y = y + t + lngamma(a+b) - lngamma(a) - lngamma(b)
  y = y + alog(w/a)
  if y LT MINLOG then t = 0.D $
  else                t = exp(y)
  
  DONE:
  if flag EQ 1 then begin
      if t LE MACHEP then t = 1.D - MACHEP $
      else                t = 1.D - t
  endif
  
  return, t
end

;; Continued fraction expasion #1 for incomplete beta integral
function cephes_incbcf, a, b, x

  COMPILE_OPT strictarr
  common cephes_machar, machvals
  MACHEP = machvals.machep
  
  big = 4.503599627370496D15
  biginv = 2.22044604925031308085D-16

  k1 = a
  k2 = a + b
  k3 = a
  k4 = a + 1.
  k5 = 1.
  k6 = b - 1.
  k7 = k4
  k8 = a + 2.

  pkm2 = 0.D
  qkm2 = 1.D
  pkm1 = 1.D
  qkm1 = 1.D
  ans = 1.D
  r = 1.D
  n = 0L
  thresh = 3.D * MACHEP
  
  repeat begin
      xk = - (x * k1 * k2 ) / (k3 * k4)
      pk = pkm1 + pkm2 * xk
      qk = qkm1 + qkm2 * xk
      pkm2 = pkm1
      pkm1 = pk
      qkm2 = qkm1
      qkm1 = qk

      xk = ( x * k5 * k6 ) / ( k7 * k8)
      pk = pkm1 + pkm2 * xk
      qk = qkm1 + qkm2 * xk
      pkm2 = pkm1
      pkm1 = pk
      qkm2 = qkm1
      qkm1 = qk

      if qk NE 0 then r = pk/qk
      if r NE 0 then begin
          t = abs( (ans-r)/r )
          ans = r
      endif else begin
          t = 1.D
      endelse

      if t LT thresh then goto, CDONE
      k1 = k1 + 1.
      k2 = k2 + 1.
      k3 = k3 + 2.
      k4 = k4 + 2.
      k5 = k5 + 1.
      k6 = k6 - 1.
      k7 = k7 + 2.
      k8 = k8 + 2.

      if abs(qk) + abs(pk) GT big then begin
          pkm2 = pkm2 * biginv
          pkm1 = pkm1 * biginv
          qkm2 = qkm2 * biginv
          qkm1 = qkm1 * biginv
      endif
      if abs(qk) LT biginv OR abs(pk) LT biginv then begin
          pkm2 = pkm2 * big
          pkm1 = pkm1 * big
          qkm2 = qkm2 * big
          qkm1 = qkm1 * big
      endif
      
      n = n + 1
  endrep until n GE 300

  CDONE:
  return, ans
end

;; Continued fraction expansion #2 for incomplete beta integral
function cephes_incbd, a, b, x

  COMPILE_OPT strictarr
  common cephes_machar, machvals
  MACHEP = machvals.machep

  big = 4.503599627370496D15
  biginv = 2.22044604925031308085D-16

  k1 = a
  k2 = b - 1.
  k3 = a
  k4 = a + 1.
  k5 = 1.
  k6 = a + b
  k7 = a + 1.
  k8 = a + 2.
  
  pkm2 = 0.D
  qkm2 = 1.D
  pkm1 = 1.D
  qkm1 = 1.D
  z = x / (1.D - x)
  ans = 1.D
  r = 1.D
  n = 0L
  thresh = 3.D * MACHEP
  
  repeat begin
      xk = -(z * k1 * k2) / (k3 * k4)
      pk = pkm1 + pkm2 * xk
      qk = qkm1 + qkm2 * xk
      pkm2 = pkm1
      pkm1 = pk
      qkm2 = qkm1
      qkm1 = qk
      
      xk = (z * k5 * k6) / (k7 * k8)
      pk = pkm1 + pkm2 * xk
      qk = qkm1 + qkm2 * xk
      pkm2 = pkm1
      pkm1 = pk
      qkm2 = qkm1
      qkm1 = qk
      
      if qk NE 0 then r = pk/qk
      if r NE 0 then begin
          t = abs( (ans-r)/r )
          ans = r
      endif else begin
          t = 1.D
      endelse

      if t LT thresh then goto, CDONE
      
      k1 = k1 + 1.
      k2 = k2 - 1.
      k3 = k3 + 2.
      k4 = k4 + 2.
      k5 = k5 + 1.
      k6 = k6 + 1.
      k7 = k7 + 2.
      k8 = k8 + 2.

      if abs(qk) + abs(pk) GT big then begin
          pkm2 = pkm2 * biginv
          pkm1 = pkm1 * biginv
          qkm2 = qkm2 * biginv
          qkm1 = qkm1 * biginv
      endif
      if abs(qk) LT biginv OR abs(pk) LT biginv then begin
          pkm2 = pkm2 * big
          pkm1 = pkm1 * big
          qkm2 = qkm2 * big
          qkm1 = qkm1 * big
      endif
      
      n = n + 1
  endrep until n GE 300

  CDONE:
  return, ans
end

;; Power series for incomplete beta integral.
;; Use when b*x is small and x not too close to 1
function cephes_pseries, a, b, x

  COMPILE_OPT strictarr
  common cephes_machar, machvals
  MINLOG = machvals.minlog
  MAXLOG = machvals.maxlog
  MAXGAM = machvals.maxgam
  MACHEP = machvals.machep

  ai = 1.D/a
  u = (1.D - b) * x
  v = u / (a + 1.D)
  t1 = v
  t = u
  n = 2.D
  s = 0.D
  z = MACHEP * ai

  while abs(v) GT z do begin
      u = (n-b) * x / n
      t = t * u
      v = t / (a+n)
      s = s + v
      n = n + 1.D
  endwhile
  s = s + t1 + ai

  u = a * alog(x)
  if (a+b) LT MAXGAM AND abs(u) LT MAXLOG then begin
      t = gamma(a+b)/(gamma(a)*gamma(b))
      s = s * t * x^a
  endif else begin
      t = lngamma(a+b) - lngamma(a) - lngamma(b) + u + alog(s)
      if t LT MINLOG then s = 0.D else s = exp(t)
  endelse

  return, s
end

; MPFTEST
;  Returns the significance level of a particular F-statistic.
;     P(x; nu1, nu2)  is probability for F to exceed x 
;  x - the F-ratio
;    For ratio of variance test:
;      x = (chi1sq/nu1) / (chi2sq/nu2)
;      p = mpftest(x, nu1, nu2)
;    For additional parameter test:
;      x = [ (chi1sq-chi2sq)/(nu1-nu2) ] / (chi2sq/nu2)
;      p = mpftest(x, nu1-nu2, nu2)
;
;  nu1 - number of DOF in chi1sq
;  nu2 - number of DOF in chi2sq   nu2 < nu1

function mpftest, x, nu1, nu2, slevel=slevel, clevel=clevel, sigma=sigma

  COMPILE_OPT strictarr

  if n_params() LT 3 then begin
      message, 'USAGE: PROB = MPFTEST(F, DOF1, DOF2, [/SIGMA, /CLEVEL, /SLEVEL ])', /cont
      return, !values.d_nan
  endif

  cephes_setmachar   ;; Set machine constants

  if nu1 LT 1 OR nu2 LT 1 OR x LT 0. then begin
      message, 'ERROR: domain', /info
      return, 0.D
  endif

  w = double(nu2) / (double(nu2) + double(nu1)*double(x))
  
  s = cephes_incbet(0.5D * nu2, 0.5D * nu1, w)
  ;; Return confidence level if requested
  if keyword_set(clevel) then return, 1D - s
  if keyword_set(sigma)  then return, mpnormlim(s, /slevel)

  ;; Return significance level otherwise.
  return, s
  
end

      
;+
; NAME:
;   MPNORMLIM
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute confidence limits for normally distributed variable
;
; MAJOR TOPICS:
;   Curve and Surface Fitting, Statistics
;
; CALLING SEQUENCE:
;   Z = MPNORMLIM(PROB, [/CLEVEL, /SLEVEL ])
;
; DESCRIPTION:
;
;  The function MPNORMLIM() computes confidence limits of a normally
;  distributed variable (with zero mean and unit variance), for a
;  desired probability level.  The returned values, Z, are the
;  limiting values: a the magnitude of a normally distributed value
;  is greater than Z by chance with a probability PROB:
;
;    P_NORM(ABS(X) > Z) = PROB
;
;  In specifying the probability level the user has two choices:
;
;    * give the confidence level (default);
;
;    * give the significance level (i.e., 1 - confidence level) and
;      pass the /SLEVEL keyword; OR
;
;  Note that /SLEVEL and /CLEVEL are mutually exclusive.
;
; INPUTS:
;
;   PROB - scalar or vector number, giving the desired probability
;          level as described above.
;
; RETURNS:
;
;  Returns a scalar or vector of normal confidence limits.
;
; KEYWORD PARAMETERS:
;
;   SLEVEL - if set, then PROB describes the significance level.
;
;   CLEVEL - if set, then PROB describes the confidence level
;            (default).
;
; EXAMPLE:
;
;   print, mpnormlim(0.99d, /clevel)
;
;   Print the 99% confidence limit for a normally distributed
;   variable.  In this case it is about 2.58 sigma.
;
; REFERENCES:
;
;   Algorithms taken from CEPHES special function library, by Stephen
;   Moshier. (http://www.netlib.org/cephes/)
;
; MODIFICATION HISTORY:
;   Completed, 1999, CM
;   Documented, 16 Nov 2001, CM
;   Reduced obtrusiveness of common block and math error handling, 18
;     Nov 2001, CM
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9 Oct 2006
;   Add usage message, 24 Nov 2006, CM
;
;  $Id: mpnormlim.pro,v 1.6 2006/11/25 01:44:13 craigm Exp $
;-
; Copyright (C) 1997-2001, 2006, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Set machine constants, once for this session.  Double precision
;; only.
pro cephes_setmachar
  COMPILE_OPT strictarr
  common cephes_machar, cephes_machar_vals
  if n_elements(cephes_machar_vals) GT 0 then return

  if (!version.release) LT 5 then dummy = check_math(1, 1)

  mch = machar(/double)
  machep = mch.eps
  maxnum = mch.xmax
  minnum = mch.xmin
  maxlog = alog(mch.xmax)
  minlog = alog(mch.xmin)
  maxgam = 171.624376956302725D

  cephes_machar_vals = {machep: machep, maxnum: maxnum, minnum: minnum, $
                        maxlog: maxlog, minlog: minlog, maxgam: maxgam}

  if (!version.release) LT 5 then dummy = check_math(0, 0)
  return
end

function cephes_polevl, x, coef
  COMPILE_OPT strictarr
  ans = coef[0]
  nc  = n_elements(coef)
  for i = 1L, nc-1 do ans = ans * x + coef[i]
  return, ans
end

function cephes_ndtri, y0
;   
;   	Inverse of Normal distribution function
;   
;   
;   
;    SYNOPSIS:
;   
;    double x, y, ndtri();
;   
;    x = ndtri( y );
;   
;   
;   
;    DESCRIPTION:
;   
;    Returns the argument, x, for which the area under the
;    Gaussian probability density function (integrated from
;    minus infinity to x) is equal to y.
;   
;   
;    For small arguments 0 < y < exp(-2), the program computes
;    z = sqrt( -2.0 * log(y) );  then the approximation is
;    x = z - log(z)/z  - (1/z) P(1/z) / Q(1/z).
;    There are two rational functions P/Q, one for 0 < y < exp(-32)
;    and the other for y up to exp(-2).  For larger arguments,
;    w = y - 0.5, and  x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)).
;   
;   
;    ACCURACY:
;   
;                         Relative error:
;    arithmetic   domain        # trials      peak         rms
;       DEC      0.125, 1         5500       9.5e-17     2.1e-17
;       DEC      6e-39, 0.135     3500       5.7e-17     1.3e-17
;       IEEE     0.125, 1        20000       7.2e-16     1.3e-16
;       IEEE     3e-308, 0.135   50000       4.6e-16     9.8e-17
;   
;   
;    ERROR MESSAGES:
;   
;      message         condition    value returned
;    ndtri domain       x <= 0        -MAXNUM
;    ndtri domain       x >= 1         MAXNUM
  COMPILE_OPT strictarr
  common cephes_ndtri_data, s2pi, p0, q0, p1, q1, p2, q2

  if n_elements(s2pi) EQ 0 then begin
      s2pi = sqrt(2.D*!dpi)
      p0 = [ -5.99633501014107895267D1,  9.80010754185999661536D1, $
             -5.66762857469070293439D1,  1.39312609387279679503D1, $
             -1.23916583867381258016D0 ]
      q0 = [ 1.D, $
             1.95448858338141759834D0,   4.67627912898881538453D0, $
             8.63602421390890590575D1,  -2.25462687854119370527D2, $
             2.00260212380060660359D2,  -8.20372256168333339912D1, $
             1.59056225126211695515D1,  -1.18331621121330003142D0  ]
      p1 = [ 4.05544892305962419923D0,   3.15251094599893866154D1, $
             5.71628192246421288162D1,   4.40805073893200834700D1, $
             1.46849561928858024014D1,   2.18663306850790267539D0, $
             -1.40256079171354495875D-1,-3.50424626827848203418D-2,$
             -8.57456785154685413611D-4  ]
      q1 = [ 1.D, $
             1.57799883256466749731D1,   4.53907635128879210584D1, $
             4.13172038254672030440D1,   1.50425385692907503408D1, $
             2.50464946208309415979D0,  -1.42182922854787788574D-1,$
             -3.80806407691578277194D-2,-9.33259480895457427372D-4 ]
      p2 = [  3.23774891776946035970D0,  6.91522889068984211695D0, $
              3.93881025292474443415D0,  1.33303460815807542389D0, $
              2.01485389549179081538D-1, 1.23716634817820021358D-2,$
              3.01581553508235416007D-4, 2.65806974686737550832D-6,$
              6.23974539184983293730D-9 ]
      q2 = [  1.D, $
              6.02427039364742014255D0,  3.67983563856160859403D0, $
              1.37702099489081330271D0,  2.16236993594496635890D-1,$
              1.34204006088543189037D-2, 3.28014464682127739104D-4,$
              2.89247864745380683936D-6, 6.79019408009981274425D-9]
  endif

  common cephes_machar, machvals
  MAXNUM = machvals.maxnum

  if y0 LE 0 then begin
      message, 'ERROR: domain', /info
      return, -MAXNUM
  endif
  if y0 GE 1 then begin
      message, 'ERROR: domain', /info
      return, MAXNUM
  endif

  code = 1
  y = y0
  exp2 = exp(-2.D)
  if y GT (1.D - exp2) then begin
      y = 1.D - y
      code = 0
  endif
  if y GT exp2 then begin
      y = y - 0.5
      y2 = y * y
      x = y + y * y2 * cephes_polevl(y2, p0) / cephes_polevl(y2, q0)
      x = x * s2pi
      return, x
  endif
  
  x = sqrt( -2.D * alog(y))
  x0 = x - alog(x)/x
  z = 1.D/x
  if x LT 8. then $
    x1 = z * cephes_polevl(z, p1) / cephes_polevl(z, q1) $
  else $
    x1 = z * cephes_polevl(z, p2) / cephes_polevl(z, q2)

  x = x0 - x1
  if code NE 0 then x = -x
  return, x
end

; MPNORMLIM - given a probability level, return the corresponding
;             "sigma" level.
;
;  p - Either the significance level (if SLEVEL is set) or the
;      confidence level (if CLEVEL is set).  This should be the
;      two-tailed level, ie:
;
;         * SLEVEL:   p = Prob(|z| > z0)
;         * CLEVEL:   p = Prob(|z| < z0)
;

function mpnormlim, p, clevel=clevel, slevel=slevel

  COMPILE_OPT strictarr

  if n_params() EQ 0 then begin
      message, 'USAGE: Z = MPNORMLIM(PROB, [/CLEVEL, /SLEVEL ])', /info
      return, !values.d_nan
  endif

  cephes_setmachar   ;; Set machine constants

  ;; Default is to assume the confidence level
  if n_elements(clevel) EQ 0 then clevel = 1
  y = 0 * p

  ;; cephes_ndtri accepts the integrated probability from negative
  ;; infinity to z, so we have to compute.
  if keyword_set(slevel) then begin
      p1 = 0.5D * p    ;; Take only one of the two tails
      for i = 0L, n_elements(y)-1 do begin
          y[i] = - cephes_ndtri(p1[i])
      endfor
  endif else if keyword_set(clevel) then begin
      p1 = 0.5D + 0.5D * p  ;; On binary computers this computation is 
      ;; exact (to the machine precision), so don't worry about it.
      ;; This computation shaves off the top half of the confidence
      ;; region, and then adds the "negative infinity to zero part.
      for i = 0L, n_elements(y)-1 do begin
          y[i] = cephes_ndtri(p1[i])
      endfor
  endif else begin
      message, 'ERROR: must specify one of CLEVEL or SLEVEL'
  endelse


  return, y
end
;+
; NAME:
;   MPNORMTEST
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute the probability of a given normally distributed Z value
;
; MAJOR TOPICS:
;   Curve and Surface Fitting, Statistics
;
; CALLING SEQUENCE:
;   PROB = MPNORMTEST(Z, [/CLEVEL, /SLEVEL ])
;
; DESCRIPTION:
;
;  The function MPNORMTEST() computes the probability for the
;  magnitude of a value drawn from the normal distribution to equal or
;  exceed the given value Z.  This can be used for confidence testing
;  of a measured value obeying the normal distribution.
;
;    P_NORM(ABS(X) > Z) = PROB
;
;  In specifying the returned probability level the user has two
;  choices:
;
;    * return the confidence level when the /CLEVEL keyword is passed;
;      OR
;
;    * return the significance level (i.e., 1 - confidence level) when
;      the /SLEVEL keyword is passed (default).
;
;  Note that /SLEVEL and /CLEVEL are mutually exclusive.
;
; INPUTS:
;
;   Z - the value to best tested.  Z should be drawn from a normal
;       distribution with zero mean and unit variance.  If a given
;       quantity Y has mean MU and standard deviation STD, then Z can
;       be computed as Z = (Y-MU)/STD.
;
; RETURNS:
;
;  Returns a scalar or vector of probabilities, as described above,
;  and according to the /SLEVEL and /CLEVEL keywords.
;
; KEYWORD PARAMETERS:
;
;   SLEVEL - if set, then PROB describes the significance level
;            (default).
;
;   CLEVEL - if set, then PROB describes the confidence level.
;
; EXAMPLES:
;
;   print, mpnormtest(5d, /slevel)
;
;   Print the probability for the magnitude of a randomly distributed
;   variable with zero mean and unit variance to exceed 5, as a
;   significance level.
;
; REFERENCES:
;
;   Algorithms taken from CEPHES special function library, by Stephen
;   Moshier. (http://www.netlib.org/cephes/)
;
; MODIFICATION HISTORY:
;   Completed, 1999, CM
;   Documented, 16 Nov 2001, CM
;   Reduced obtrusiveness of common block and math error handling, 18
;     Nov 2001, CM
;   Corrected error in handling of CLEVEL keyword, 05 Sep 2003
;   Convert to IDL 5 array syntax (!), 16 Jul 2006, CM
;   Move STRICTARR compile option inside each function/procedure, 9 Oct 2006
;   Add usage message, 24 Nov 2006, CM
;   Usage message with /CONTINUE, 23 Sep 2009, CM
;
;  $Id: mpnormtest.pro,v 1.9 2009/09/23 20:12:46 craigm Exp $
;-
; Copyright (C) 1997-2001, 2003, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Set machine constants, once for this session.  Double precision
;; only.
pro cephes_setmachar
  COMPILE_OPT strictarr
  common cephes_machar, cephes_machar_vals
  if n_elements(cephes_machar_vals) GT 0 then return

  if (!version.release) LT 5 then dummy = check_math(1, 1)

  mch = machar(/double)
  machep = mch.eps
  maxnum = mch.xmax
  minnum = mch.xmin
  maxlog = alog(mch.xmax)
  minlog = alog(mch.xmin)
  maxgam = 171.624376956302725D

  cephes_machar_vals = {machep: machep, maxnum: maxnum, minnum: minnum, $
                        maxlog: maxlog, minlog: minlog, maxgam: maxgam}

  if (!version.release) LT 5 then dummy = check_math(0, 0)
  return
end

function cephes_polevl, x, coef
  COMPILE_OPT strictarr
  ans = coef[0]
  nc  = n_elements(coef)
  for i = 1L, nc-1 do ans = ans * x + coef[i]
  return, ans
end

pro cephes_set_erf_common
  COMPILE_OPT strictarr
  common cephes_erf_data, pp, qq, rr, ss, tt, uu, uthresh

  pp = [ 2.46196981473530512524D-10, 5.64189564831068821977D-1, $
         7.46321056442269912687D0,   4.86371970985681366614D1,  $
         1.96520832956077098242D2,   5.26445194995477358631D2,  $
         9.34528527171957607540D2,   1.02755188689515710272D3,  $
         5.57535335369399327526D2 ]

  qq = [ 1.00000000000000000000D0,   1.32281951154744992508D1,  $
         8.67072140885989742329D1,   3.54937778887819891062D2,  $
         9.75708501743205489753D2,   1.82390916687909736289D3,  $
         2.24633760818710981792D3,   1.65666309194161350182D3,  $
         5.57535340817727675546D2 ]
  
  rr = [ 5.64189583547755073984D-1,  1.27536670759978104416D0,  $
         5.01905042251180477414D0,   6.16021097993053585195D0,  $
         7.40974269950448939160D0,   2.97886665372100240670D0   ]

  ss = [ 1.00000000000000000000D0,   2.26052863220117276590D0,  $
         9.39603524938001434673D0,   1.20489539808096656605D1,  $
         1.70814450747565897222D1,   9.60896809063285878198D0,  $
         3.36907645100081516050D0 ]

  tt = [ 9.60497373987051638749D0,   9.00260197203842689217D1,  $
         2.23200534594684319226D3,   7.00332514112805075473D3,  $
         5.55923013010394962768D4 ]

  uu = [ 1.00000000000000000000D0,   3.35617141647503099647D1,  $
         5.21357949780152679795D2,   4.59432382970980127987D3,  $
         2.26290000613890934246D4,   4.92673942608635921086D4   ]

  uthresh = 37.519379347D
  return
end

;							erfc.c
;   
;   	Complementary error function
;   
;   
;   
;    SYNOPSIS:
;   
;    double x, y, erfc();
;   
;    y = erfc( x );
;   
;   
;   
;    DESCRIPTION:
;   
;   
;     1 - erf(x) =
;   
;                              inf. 
;                                -
;                     2         | |          2
;      erfc(x)  =  --------     |    exp( - t  ) dt
;                  sqrt(pi)   | |
;                              -
;                               x
;   
;   
;    For small x, erfc(x) = 1 - erf(x); otherwise rational
;    approximations are computed.
;   
;   
;   
;    ACCURACY:
;   
;                         Relative error:
;    arithmetic   domain     # trials      peak         rms
;       DEC       0, 9.2319   12000       5.1e-16     1.2e-16
;       IEEE      0,26.6417   30000       5.7e-14     1.5e-14
;   
;   
;    ERROR MESSAGES:
;   
;      message         condition              value returned
;    erfc underflow    x > 9.231948545 (DEC)       0.0
;   
;   
;   /
function cephes_erfc, a

  COMPILE_OPT strictarr
  common cephes_erf_data
  if n_elements(p) EQ 0 then cephes_set_erf_common

  common cephes_machar, machvals
  MAXLOG = machvals.maxlog

  if a LT 0 then x = -a else x = a
  if x LT 1. then return, 1.D - cephes_erf(a)
  
  z = -a * a
  if z LT -MAXLOG then begin
      under:
;      message, 'ERROR: underflow', /info
      if a LT 0 then return, 2.D else return, 0.D
  endif

  z = exp(z)
  if x LT 8. then begin
      p = cephes_polevl(x, pp)
      q = cephes_polevl(x, qq)
  endif else begin
      p = cephes_polevl(x, rr)
      q = cephes_polevl(x, ss)
  endelse

  y = (z*p)/q
  if a LT 0 then y = 2.D - y
  if y EQ 0 then goto, under

  return, y
end

;							erf.c
;   
;   	Error function
;   
;   
;   
;    SYNOPSIS:
;   
;    double x, y, erf();
;   
;    y = erf( x );
;   
;   
;   
;    DESCRIPTION:
;   
;    The integral is
;   
;                              x 
;                               -
;                    2         | |          2
;      erf(x)  =  --------     |    exp( - t  ) dt.
;                 sqrt(pi)   | |
;                             -
;                              0
;   
;    The magnitude of x is limited to 9.231948545 for DEC
;    arithmetic; 1 or -1 is returned outside this range.
;   
;    For 0 <= |x| < 1, erf(x) = x * P4(x**2)/Q5(x**2); otherwise
;    erf(x) = 1 - erfc(x).
;   
;   
;   
;    ACCURACY:
;   
;                         Relative error:
;    arithmetic   domain     # trials      peak         rms
;       DEC       0,1         14000       4.7e-17     1.5e-17
;       IEEE      0,1         30000       3.7e-16     1.0e-16
;   
;   
function cephes_erf, x
  COMPILE_OPT strictarr
  common cephes_erf_data
  if abs(x) GT 1. then return, 1.D - cephes_erfc(x)
  if n_elements(p) EQ 0 then cephes_set_erf_common
  z = x * x
  y = x * cephes_polevl(z, tt) / cephes_polevl(z, uu)
  return, y
end

function mpnormtest, a, clevel=clevel, slevel=slevel

  COMPILE_OPT strictarr

  if n_params() EQ 0 then begin
      message, 'USAGE: PROB = MPNORMTEST(Z, [/CLEVEL, /SLEVEL ])', /cont
      return, !values.d_nan
  endif

  cephes_setmachar   ;; Set machine constants

  y = a*0
  sqrth = sqrt(2.D)/2.D
  x = a * sqrth

  ;; Default is to return the significance level
  if n_elements(slevel) EQ 0 AND n_elements(clevel) EQ 0 then slevel = 1
  if keyword_set(slevel) then begin
      for i = 0L, n_elements(y)-1 do begin
          if abs(x[i]) LT sqrth then y[i] = 1.D - cephes_erf(abs(x[i])) $
          else                       y[i] = cephes_erfc(abs(x[i]))
      endfor
  endif else if keyword_set(clevel) then begin
      for i = 0L, n_elements(y)-1 do begin
          if abs(x[i]) LT sqrth then y[i] = cephes_erf(abs(x[i])) $
          else                       y[i] = 1.D - cephes_erfc(x[i])
      endfor
  endif else begin
      message, 'ERROR: must specify one of CLEVEL, SLEVEL'
  endelse

  return, y
end
;+
; NAME:
;   MPPROPERR
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Propagate fitted model uncertainties to measured data points
;
; MAJOR TOPICS:
;   Curve and Surface Fitting
;
; CALLING SEQUENCE:
;   YCOVAR = MPPROPERR(BEST_FJAC, PCOVAR, PFREE_INDEX, [/DIAGONAL])
;
; DESCRIPTION:
;
;   MPPROPERR propagates the parameter uncertainties of a fitted
;   model to provide estimates of the model uncertainty at each 
;   measurement point.
;
;   When fitting a model to data with uncertainties, the parameters
;   will have estimated uncertainties.  In fact, the parameter
;   variance-covariance matrix indicates the estimated uncertainties
;   and correlations between parameters.  These uncertainties and
;   correlations can, in turn, be used to estimate the "error in the
;   model" for each measurement point.  In a sense, this quantity also
;   reflects the sensitivity of the model to each data point.
;
;   The algorithm used by MPPROPERR uses standard propagation of error
;   techniques, assuming that errors are small.  The input values of
;   MPPROPERR should be found from the output keywords of MPFIT or
;   MPFITFUN, as documented below.
;
;   The user has a choice whether to compute the *full*
;   variance-covariance matrix or not, depending on the setting of the
;   DIAGONAL keyword.  The full matrix is large, and indicates the
;   correlation the sampled model function between each measurement
;   point and every other point.  The variance terms lie on the
;   diagonal, and the covariance terms are on the off-diagonal.
;   
;   Usually however, the user will want to set /DIAGONAL, which only
;   returns the "diagonal" or variance terms, which represent the
;   model "uncertainty" at each measurement point.  The /DIAGONAL
;   setting only controls the amount of data returned to the user.
;   the full *parameter* covariance matrix is always used to compute
;   the output regardless of the setting for /DIAGONAL.
;
;   When using MPPROPERR, keep in mind the following dimensions of
;   the problem:
;     NPOINTS - number of measurement points
;     NPAR    - total number of fit parameters
;     NFREE   - number of *free* fit parameters
;
;   The inputs to this function are:
;     BEST_FJAC - the partial derivative matrix, or Jacobian matrix,
;                 as estimated by MPFIT or MPFITFUN (see below),
;                 which has dimensions of ARRAY(NPOINTS,NFREE).
;     PCOVAR - the parameter covariance matrix, as estimated by MPFIT
;              or MPFITFUN (see below), which has dimensions of
;              ARRAY(NPAR,NPAR).
;     PFREE_INDEX - an index array which describes which of the
;                   parameter set were variable, as returned by MPFIT
;                   or MPFITFUN.  Of the total parameter set PARMS,
;                   only PARMS[PFREE_INDEX] were varied by MPFIT.
;
;   There are special considerations about the values returned by
;   MPPROPERR.  First, if a parameter is touching a boundary
;   limit when the fit is complete, then it will be marked as having
;   variance and covariance of zero.  To avoid this situation, one can
;   re-run MPFIT or MPFITFUN with MAXITER=0 and boundary limits
;   disabled.  This will permit MPFIT to estimate variance and
;   covariance for all parameters, without allowing them to actually
;   vary during the fit.
;
;   Also, it is important to have a quality parameter covariance
;   matrix PCOVAR.  If the matrix is singular or nearly singular, then
;   the measurement variances and covariances will not be meaningful.
;   It helps to parameterize the problem to minimize parameter
;   covariances.  Also, consider fitting with double precision
;   quantities instead of single precision to minimize the chances of
;   round-off error creating a singular covariance matrix.
;
;   IMPORTANT NOTE: the quantities returned by this function are the
;   *VARIANCE* and covariance.  If the user wishes to compute
;   estimated standard deviation, then one should compute
;   SQRT(VARIANCE).  (see example below)
;
; INPUTS:
;
;   BEST_FJAC - the Jacobian matrix, as estimated by MPFIT/MPFITFUN
;               (returned in keyword BEST_FJAC).  This should be an
;               array ARRAY(NPOINTS,NFREE) where NFREE is the number
;               of free parameters.
;
;   PCOVAR - the full parameter covariance matrix, as returned in the
;            COVAR keyword of MPFIT/MPFITFUN.  This should be an array
;            ARRAY(NPAR,NPAR) where NPAR is the *total* number of
;            parameters.
;
; RETURNS:
;
;   The estimated uncertainty at each measurement point, due to
;   propagation of errors.  The dimensions depend on the value of the
;   DIAGONAL keyword.
;     DIAGONAL=1: returned value is ARRAY(NPOINTS)
;                 corresponding to the *VARIANCE* of the model
;                 function sampled at each measurment point
;                 **NOTE**: the propagated standard deviation would
;                 then be SQRT(RESULT).
;
;     DIAGONAL=0: returned value is ARRAY(NPOINTS,NPOINTS)
;                 corresponding to the variance-covariance matrix of
;                 the model function, sampled at the measurement
;                 points.
;
;
; KEYWORD PARAMETERS:
;
;   DIAGONAL - if set, then compute only the "diagonal" (variance)
;              terms.  If not set, then propagate the full covariance
;              matrix for each measurement point.
;
;   NAN - if set, then ignore NAN values in BEST_FJAC or PCOVAR
;         matrices (they would be set to zero).
;
;   PFREE_INDEX - index list of free parameters, as returned in the
;                 PFREE_INDEX keyword of MPFIT/MPFITFUN.  This should
;                 be an integer array ARRAY(NFREE), such that
;                 parameters PARMS[PFREE_INDEX] were freely varied during
;                 the fit, and the remaining parameters were not.
;                 Thus it should also be the case that PFREE_INDEX
;                 indicates the rows and columns of the parameter
;                 covariance matrix which were allowed to vary freely.
;                 Default: All parameters will be considered free.
;
;   
; EXAMPLE:
;
;   ; First, generate some synthetic data
;   npts = 200
;   x  = dindgen(npts) * 0.1 - 10.                  ; Independent variable 
;   yi = gauss1(x, [2.2D, 1.4, 3000.])              ; "Ideal" Y variable
;   y  = yi + randomn(seed, npts) * sqrt(1000. + yi); Measured, w/ noise
;   sy = sqrt(1000.D + y)                           ; Poisson errors
;
;   ; Now fit a Gaussian to see how well we can recover
;   p0 = [1.D, 1., 1000.]                   ; Initial guess (cent, width, area)
;   p = mpfitfun('GAUSS1', x, y, sy, p0, $  ; Fit a function
;                 best_fjac=best_fjac, pfree_index=pfree_index, /calc_fjac, $
;                 covar=pcovar)
;   ; Above statement calculates best Jacobian and parameter
;   ; covariance matrix
;
;   ; Propagate errors from parameter covariance matrix to estimated
;   ; measurement uncertainty.  The /DIAG call returns only the
;   ; "diagonal" (variance) term for each measurement.
;   ycovar = mpproperr(best_fjac, pcovar, pfree_index=pfree_index, /diagonal)
;
;   sy_prop = sqrt(ycovar)  ; Estimated sigma 
;   
;
; REFERENCES:
;
;   MINPACK-1, Jorge More', available from netlib (www.netlib.org).
;   "Optimization Software Guide," Jorge More' and Stephen Wright, 
;     SIAM, *Frontiers in Applied Mathematics*, Number 14.
;
; MODIFICATION HISTORY:
;   Written, 2010-10-27, CM
;   Updated documentation, 2011-06-26, CM
;
;  $Id: mpproperr.pro,v 1.5 2011/12/22 02:08:22 cmarkwar Exp $
;-
; Copyright (C) 2011, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   MULTISORT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Perform a sorting operation with multiple sort keys
;
; CALLING SEQUENCE:
;   INDICES = MULTISORT(KEY1, KEY2, ..., [/L64, ], [ORDER=order])
;
; DESCRIPTION: 
;
;   The function MULTISORT performs a sorting operation with multiple
;   sort keys.  Unlike the IDL built-in SORT() function, which can
;   only sort a single key, MULTISORT can accept multiple keys.  In
;   cases where the primary key is equal, the sort order is based on
;   any secondary keys provided.  The return value is an array of
;   indices which will place the key arrays into sorted order.
;
;   MULTISORT works by building an internal sort key string which can
;   be sorted in a single pass.  Because MULTISORT is not a built-in
;   function, and because it must build these auxiliary strings, it
;   cannot be as fast or memory-efficient as the built-in function.
;   Users will need several times more memory than the memory used
;   to store just the input keys.
;
;   MULTISORT() allows the user to choose the sort order for each key
;   separately.  The ORDER keyword is an N-vector, one order for each
;   input key.  ORDER[i] is +1 to sort KEYi ascending, and ORDER[i] is
;   -1 to sort KEYi descending.
;
; INPUTS:
;
;   KEY1, KEY2, ... KEY9 - input sort keys.  Any integer, floating
;                          point or string value is allowed.  The
;                          number of values must be the same for each
;                          key.
;
;
;
; KEYWORDS:
;
;   ORDER - an N-vector, giving the sort order for each key (see
;           documentation above).
;           Default: REPLICATE(+1,N_PARAMS())  (all keys ascending)
;
;   L64 - if set, then return a LONG64 index instead of LONG.
;
; RETURNS:
;
;   An array of indices which will place the keys into sorted order.
;   I.e., KEYS1[INDICES],  KEYS2[INDICES] ... will be in order.
;
; SEE ALSO:
;
;   SORT
;
; MODIFICATION HISTORY:
;   Written, CM, Jun 2007
;   Document the encoding format, and make some floating point
;     operations more efficient, CM, Jan 2008
;   Correct several bugs in the handling of floating point numbers
;     in the range -1.0 to 1.0, made more efficient, (thanks to Eric
;     Jensen);  I also saved some test cases; CM, Jul 2008
;
;
;  $Id: multisort.pro,v 1.3 2008/07/08 20:21:18 craigm Exp $
;
;-
; Copyright (C) 2007, 2008, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; ========================================================
; Utility function to transform an integer into a string key
;  Integers are coded in hexidecimal, with a prefix of
;  'A' for negative and 'B' for positive.
function multisort_intkey, x, len, unsigned=u, order=order
  COMPILE_OPT strictarr
  n = n_elements(x)
  if order LT 0 then x1 = NOT temporary(x) $ ;; Reverse order
  else x1 = temporary(x)

  ;; v = [-2L^31L,-32768,-2000,-20,-1,0,1,20,2000,32767,(-2L^31L)-1]

  slen = strtrim(len,2)
  fmt = '(Z'+slen+'.'+slen+')'  ;; (In.n)  - zero-padded
  if NOT keyword_set(u) then begin
      prestr = strarr(n)+'B' ;; Prefix to indicate positive values
      wh = where(x1 LT 0, ct)
      if ct GT 0 then prestr[wh] = 'A'

      bmask = ishft((x1[0] AND 0b) + 1b,4*len)-1
      if bmask LE 1 then bmask = NOT (x1[0] AND 0b)
      x1 = x1 AND bmask

      return, temporary(prestr)+string(x1,format=fmt)
  endif else begin
      return,                   string(x1,format=fmt)
  endelse

end

; ========================================================
; Utility function to transform a float into a string key
; Floating point numbers are converted to IEEE format,
; and then examined as integers, allowing MULTISORT_INTKEY
; to be used.
;
function multisort_fltkey, x1, type, order=order
  COMPILE_OPT strictarr
  n = n_elements(x1)

  if type EQ 4 then begin
      ;; Floating point data (4 bytes)

      ;; Test case
      ;; v = [-!values.f_infinity,-2000.,-20,-1.5,-1.0,-0.5,0,0.5,1.0,1.5,20,2000,!values.f_infinity,!values.f_nan]
      byteorder, x1, /ftoxdr
      x1 = long(temporary(x1),0,n)
      byteorder, x1, /ntohl
      wh = where(x1 LT 0, ct)
      if ct GT 0 then x1[wh] = x1[wh] XOR '7fffffff'xl

      return, multisort_intkey(x1,8,order=order)

  endif else begin
      ;; Double precision data

      ;; Test case
      ;; v = [-!values.d_infinity,-2000d,-20,-1.5,-1.0,-0.5,0,0.5,1.0,1.5,20,2000,!values.d_infinity,!values.d_nan]
      byteorder, x1, /dtoxdr
      x1 = long64(temporary(x1),0,n)
      byteorder, x1, /l64swap, /swap_if_little
      wh = where(x1 LT 0, ct)
      if ct GT 0 then x1[wh] = x1[wh] XOR '7fffffffffffffff'xll

      return, multisort_intkey(x1,16,order=order)

  endelse

end

; ========================================================
; Utility function to transform a string into a string key
function multisort_strkey, x, order=order
  COMPILE_OPT strictarr
  len = strlen(x)
  maxlen = max(len, min=minlen)
  if maxlen GT minlen then begin
      ;; Pad out to the maximum string length (i.e. left-align the strings)
      pad = string(bytarr(maxlen-minlen)+32b)
      key = strmid(x+pad,0,maxlen)
  endif else begin
      key = x
  endelse

  ;; Reverse order if requested
  if order LT 0 then begin
      key = string( (255b - byte(temporary(key))) > 1b )
  endif

  return, key
end


; ========================================================
; MAIN ROUTINE
; ========================================================
function multisort, x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, L64=L64, $
                    keys=keys0, order=order0, no_builtin=nobuiltin

  COMPILE_OPT strictarr

  nkeys = n_params()
  if nkeys EQ 0 then begin
      message, 'USAGE: INDICES = MULTISORT(KEY1[,KEY2,KEY3,...])', /info
      return, -1L
  endif

  order = intarr(nkeys) + 1
  if n_elements(order0) GT 0 then order[0] = round(order0)

  ;; Special case: only one term, no need to do complicate sort key
  ;; manipulations.
  if nkeys EQ 1 AND order[0] EQ +1 AND NOT keyword_set(nobuiltin) then begin
      return, sort(x0, L64=L64)
  endif

  ;; Master key
  mkey = ''
  for i = 0, nkeys-1 do begin
      xi = 0 & dummy = temporary(xi)
      case i of
          0: xi = x0
          1: xi = x1
          2: xi = x2
          3: xi = x3
          4: xi = x4
          5: xi = x5
          6: xi = x6
          7: xi = x7
          8: xi = x8
          9: xi = x9
      endcase
      if n_elements(xi) EQ 0 then begin
          message, string(i,format='("ERROR: no data was in parameter X",I0)')
          return, -1L
      endif

      sz = size(xi)
      tp = sz[sz[0]+1]
      o = order[i]
      case tp of 
          1:  mkey = temporary(mkey) + multisort_intkey(temporary(xi),2,/u,o=o)  ;; BYTE
          2:  mkey = temporary(mkey) + multisort_intkey(temporary(xi),4,o=o)     ;; INT
          3:  mkey = temporary(mkey) + multisort_intkey(temporary(xi),8,o=o)     ;; LONG
          4:  mkey = temporary(mkey) + multisort_fltkey(temporary(xi),4,o=o)     ;; FLOAT
          5:  mkey = temporary(mkey) + multisort_fltkey(temporary(xi),5,o=o)     ;; DOUBLE
          7:  mkey = temporary(mkey) + multisort_strkey(temporary(xi),o=o)       ;; STRING
          12: mkey = temporary(mkey) + multisort_intkey(temporary(xi),4,/u,o=o)  ;; UINT
          13: mkey = temporary(mkey) + multisort_intkey(temporary(xi),8,/u,o=o)  ;; ULONG
          14: mkey = temporary(mkey) + multisort_intkey(temporary(xi),16,o=o)    ;; LONG64
          15: mkey = temporary(mkey) + multisort_intkey(temporary(xi),16,/u,o=o) ;; ULONG64
          else: begin
              message, string(tp, i, $
                format='("ERROR: data type ",I0," for parameter X,",I0," is not sortable")')
              return, -1L
          end
      endcase

      xi = 0
  endfor

  return, sort(mkey, L64=L64)
end

                    
;+
; NAME:
;   NORMPATH
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Construct an absolute file/directory path from a relative path
;
; MAJOR TOPICS:
;   Files, I/O
;
; CALLING SEQUENCE:
;   NORMPATH, FROM, NORMALIZED
;
; DESCRIPTION:
;
;   NORMPATH constructs a "normalized" filename or directory path from
;   a specified relative path.  The relative path may contain path
;   components which move up and/or down the hierarchy of the file
;   system.  The returned path will be the most absolute path that can
;   be specified.
;
;   If the user specifies the CURRENT keyword, then relative paths are
;   assumed to originate in the CURRENT directory.  If CURRENT is not
;   specified, then it is possible for the returned path to have
;   path components relative to the current directory.
;
;   NORMPATH should be platform independent.  Note that the paths do
;   not necessarily need to exist on the file system.
;
;
; INPUTS:
;
;   FROM - scalar string, gives the relative path.
;
;   NORMALIZED - upon return, the normalized form of FROM.
;
;
; KEYWORDS:

;   CURRENT - if specified, must be a scalar string which gives the
;             path to the current directory used in forming the
;             normalized path.  If not specified, then the returned
;             path may have some relative components.
;
; EXAMPLES:
;
;   NORMPATH, '/x/y/z', path & print, path
;     '/x/y/z'
;   The specified path is already normalized, so there is no action
;
;   NORMPATH, '/x/y/../w/z', path & print, path
;     '/x/w/z'
;   The specified path had relative components which were removed.
;
;   NORMPATH, '../x/y/../w/z', path & print, path
;     '../x/w/z'
;   The specified path had relative components which could not be
;   removed.
;
;   NORMPATH, '../x/y/../w/z', path, current='/root' & print, path
;     '/x/w/z'
;   The absolute path of the current directory was given (and then the
;   relative path moved outside of /root).
;
; MODIFICATION HISTORY:
;   Written and documented, 12 Mar 2004 CM
;   Usage message, 23 Mar 2008 CM
;   Handle case of 'a//b', which should be 'a/b', 23 Mar 2008 CM
;
;  $Id: normpath.pro,v 1.2 2008/03/23 18:15:14 craigm Exp $
;
;-
; Copyright (C) 2004, 2008, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   PLOTBIN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Overlays a plot in histogram style on the current graphics viewport.
;
; CALLING SEQUENCE:
;   OPLOTBIN, x, y, WIDTH=width, PIXCENTER=pixcenter, LOGCLIP=logclip, ...
;
; DESCRIPTION: 
;
;   OPLOTBIN overlays an unfilled histogram plot on an existing
;   graphics window.  The width of each histogram bin can be specified
;   individually, and the alignment of the bin centers can be given
;   explicitly.
;
;   OPLOTBIN accepts several specialized keyword parameters of its
;   own, but passes any other keywords to the built-in IDL OPLOT
;   procedure.  Thus, any keywords accepted by OPLOT can be passed to
;   OPLOTBIN.
;
; INPUTS:
;
;   X, Y - Two arrays which give the "X" and "Y" position of each bin.
;          If only the Y values are given, then the X values will be
;          the bin numbers.
;
; OPTIONAL INPUTS:
;   NONE
;
; INPUT KEYWORD PARAMETERS:
;
;   WIDTH - The width of each histogram bin.  If a scalar, then the
;           width is assumed to be the same for all histogram bins.
;           If a vector, then WIDTH should have the same number of
;           elements as X and Y, and specify the width of each
;           individual bin.
;           Default value: width is the separation between the first
;                          two X values.
;
;   PIXCENTER - Describes the alignment of "X" values with respect to
;               the histogram bin centers:
;                   PIXCENTER = 0.0  -- "X" values are left edges of bins
;                             = 0.5  -- "X" values are bin centers
;                             = 1.0  -- "X" values are right edges of bins
;               Intermediate values are also permitted.
;               Default value: 0.5 ("X" values are bin centers)
;
;   MIDPOINT - if set, then ignore the WIDTH and PIXCENTER keyword
;              values, and instead construct bin edges which lie at
;              the midpoints between data points.  This is usually the
;              most straightforward way to connect irregularly sampled
;              points "like a histogram," although at the expense of
;              not having a direct relation between X and the bin
;              centers.
;
;   EDGE - if set, then the X values will be taken to be the bin edges
;          rather than the bin midpoints.  In this case, the number of
;          X values should be one more than the number of Y values.
;
;   PLOTVERT - plot "vertically", that is, X is vertical and Y is
;              horizontal.
;
;   LOGCLIP - If set, then Y values are clipped to the current data
;             viewport.  On a logarithmic scale, this may help some
;             negative bins be seen.  
;             Default: not set.
;
; OUTPUTS:
;   NONE
;
; EXAMPLE:
;
; MODIFICATION HISTORY:
;   Written, CM, 1997
;   Documented, CM, July 1999
;   Added MIDPOINT keyword, 21 Feb 2000
;   Added EDGE keyword, 21 Apr 2000
;   Corrected way that PIXCENTER works, same as PLOTBIN, just one year
;     later (Thanks to J. Guerber), CM, 17 Mar 2003
;   Changed _EXTRA handling to use EXECUTE internally.  Unfortunately
;     makes it incompatible with VM version of IDL, 03 Aug 2003, CM
;   Remove EXECUTE function, move to CALL_PROCEDURE, 23 Nov 2003, CM
;   Add PLOTVERT keyword, 19 Apr 2004, CM
;
;  $Id: oplotbin.pro,v 1.7 2004/04/19 09:09:10 craigm Exp $
;
;-
; Copyright (C) 1997-2000, 2003, 2004, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   OPLOTIMAGE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Overlays an image on an existing plot.
;
; CALLING SEQUENCE:
;   OPLOTIMAGE, img
;
; DESCRIPTION: 
;
;   OPLOTIMAGE overlays an image on an already-existing set of plot
;   axes.  It should not matter what plot elements have already be
;   displayed, but at least one command is needed to set up the plot
;   axes.
;
;   Only the IMGXRANGE and IMGYRANGE keywords, specifying the extent
;   of the image, can be given in a call to OPLOTIMAGE.
;
;   See PLOTIMAGE for more detailed information.
;
; INPUTS:
;
;   IMG - A byte array to be displayed.  An image declared as
;         ARRAY(M,N) will be M pixels in the x-direction and N pixels
;         in the y-direction.  The image is resampled via
;         interpolation to fill the desired display region.
; 
; OPTIONAL INPUTS:
;   NONE
;
; INPUT KEYWORD PARAMETERS:
;
;   IMGXRANGE, IMGYRANGE - Each is a two component vector that
;                          describes the X and Y position of the first
;                          and last pixels.
;                          Default: the size of the image in pixels
;
; OUTPUTS:
;   NONE
;
; PROCEDURE:
;
; EXAMPLE:
;
;   This example first constructs an image whose values are found by
;       z(x,y) = cos(x) * sin(y)
;   and x and y are in the range [-2,2] and [4,8], respectively.
;   The image is then plotted in the range [-10, 10] in both x and
;   y directions.
;   
;   x = findgen(20)/5. - 2.
;   y = findgen(20)/5. + 4.
;   zz = cos(x) # sin(y)
;   imgxrange = [min(x), max(x)]
;   imgyrange = [min(y), max(y)]
;   xr=[-10.,10]
;   yr=[-10.,10]
;   plotimage, bytscl(zz), imgxrange=imgxrange, imgyrange=imgyrange
;
;   Now for the overlay.  A new image is created in the ranges between
;   -10 and 0:
;      z(x,y) = x y
;
;   x = findgen(20)/2 - 10.
;   y = findgen(20)/2 - 10.
;   imgxrange = [min(x), max(x)]
;   imgyrange = [min(y), max(y)]
;   zz = x # y
;   oplotimage, bytscl(zz), imgxrange=imgxrange, imgyrange=imgyrange
;
; SEE ALSO:
;
;   PLOTIMAGE, BYTSCL
;
; EXTERNAL SUBROUTINES:
;
;   SUBCELL, DEFSUBCELL, TVIMAGE
;
; MODIFICATION HISTORY:
;   Written, CM, 1997
;   Removed BYTE requirement, added ON_ERROR, CM 19 Apr 2000
;   Added copyright notice, CM 25 Mar 2001
;
;   $Id: oplotimage.pro,v 1.2 2001/03/25 18:10:44 craigm Exp $
;
;-
; Copyright (C) 1997-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   PHUNWRAP
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Unwrap phase jumps to recover cycle counts
;
; MAJOR TOPICS:
;   Mathematics
;
; CALLING SEQUENCE:
;   CYCLES = PHUNWRAP(PHASE, TOLERANCE=, MAXVAL=)
;
; DESCRIPTION:
;
;   PHUNWRAP unwraps a sequence of phases to produce a new series of
;   cycle counts.  Phase jumps due to crossing over the PHASE=0
;   boundary are removed by adding an integral number of cycles.  The
;   algorithm is based on the MATLAB "unwrap" function.
;
;   NOTE: the unwrapping process can be ambiguous if there is a phase
;   jump of more than a half cycle in the series.  For example, if the
;   phase changes by ~0.5 cycles, it is not possible to distinguish
;   whether there wasa +0.5 cycle or -0.5 cycle jump.  The most
;   accurate unwrapping can be performed if the PHASE series is nearly
;   continuous and does not have rapid phase changes.
;
;   Users can select the tolerance used to determine the phase jump.
;   Users can also select the definition of "1 cycle" by changing
;   MAXVAL.  By default, MAXVAL is 2*!DPI, which correspondes to 1
;   cycle = 2*!DPI radians, but other values of 1 (cycle), or 360
;   (degrees) are possible.
;
; INPUTS:
;
;   PHASE - phase series to be unwrapped.  Values should range from 0
;           to MAXVAL.  The ordering of the series is important.
;
; RETURNS:
;
;   A new series, expressed in cycles, with cycle jumps larger than
;   TOLERANCE removed.
;
; OPTIONAL KEYWORDS:
;
;   TOLERANCE - phase jump tolerance.  If the phase from one sample to
;               the next changes by more than TOLERANCE, then a single
;               cycle jump is assumed to have occurred.
;               DEFAULT: 0.5*MAXVAL
;
;   MAXVAL - Maximum value for phase. Common values are: 2*!DPI
;            (radians; DEFAULT); 1 (cycle); 360 (degrees), but any
;            positive value may be used.
;
; EXAMPLE:
;
;  ;; Set up some fake data
;  x = dindgen(100)/10d
;  y = x/2
;  ph = y MOD 1.0    ;; Mock phases
;
;  cycles = phunwrap(ph, maxval=1)
;
; MODIFICATION HISTORY:
;   Written and documented, CM, July 2003
;   Handle the case of unsigned integer input, CM, Feb 2006
;
;  $Id: phunwrap.pro,v 1.3 2006/03/28 14:19:53 craigm Exp $
;
;-
; Copyright (C) 2003, 2006, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   PLOTBIN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Makes a plot in a histogram style.
;
; CALLING SEQUENCE:
;   PLOTBIN, x, y, WIDTH=width, PIXCENTER=pixcenter, ...
;
; DESCRIPTION: 
;
;   PLOTBIN makes an unfilled histogram plot.  The width of each
;   histogram bin can be specified individually, and the alignment of
;   the bin centers can be given explicitly.
;
;   PLOTBIN accepts several specialized keyword parameters of its own,
;   but passes any other keywords to the built-in IDL PLOT procedure.
;   Thus, any keywords accepted by PLOT can be passed to PLOTBIN.
;
;   PLOTBIN uses the PANEL/SUBPANEL system to partition the viewport.
;
; INPUTS:
;
;   X, Y - Two arrays which give the "X" and "Y" position of each bin.
;          If only the Y values are given, then the X values will be
;          the bin numbers.
;
; OPTIONAL INPUTS:
;   NONE
;
; INPUT KEYWORD PARAMETERS:
;
;   PANEL, SUBPANEL - An alternate way to more precisely specify the
;                     plot and annotation positions.  See SUBCELL.
;                     Default is full-screen.  Overridden by POSITION.
;
;   WIDTH - The width of each histogram bin.  If a scalar, then the
;           width is assumed to be the same for all histogram bins.
;           If a vector, then WIDTH should have the same number of
;           elements as X and Y, and specify the width of each
;           individual bin.
;           Default value: width is the separation between the first
;                          two X values.
;
;   PIXCENTER - Describes the alignment of "X" values with respect to
;               the histogram bin centers:
;                   PIXCENTER = 0.0  -- "X" values are left edges of bins
;                             = 0.5  -- "X" values are bin centers
;                             = 1.0  -- "X" values are right edges of bins
;               Intermediate values are also permitted.
;               Default value: 0.5 ("X" values are bin centers)
;
;   MIDPOINT - if set, then ignore the WIDTH and PIXCENTER keyword
;              values, and instead construct bin edges which lie at
;              the midpoints between data points.  This is usually the
;              most straightforward way to connect irregularly sampled
;              points "like a histogram," although at the expense of
;              not having a direct relation between X and the bin
;              centers.
;
;   EDGE - if set, then the X values will be taken to be the bin edges
;          rather than the bin midpoints.  In this case, the number of
;          X values should be one more than the number of Y values.
;
;   PLOTVERT - plot "vertically", that is, X is vertical and Y is
;              horizontal.
;
;   Other options are passed along to the PLOT command directly.
;
; OUTPUTS:
;   NONE
;
; PROCEDURE:
;
; EXAMPLE:
;
; SEE ALSO:
;
;   SUBCELL, DEFSUBCELL, SUBCELLARRAY
;
; EXTERNAL SUBROUTINES:
;
;   PLOT, SUBCELL
;
; MODIFICATION HISTORY:
;   Written, CM, 1997
;   Documented, CM, July 1999
;   Added MIDPOINT keyword, 21 Feb 2000
;   Added EDGE keyword, 21 Apr 2000
;   Corrected way that PIXCENTER works (Thanks to 
;     J. Guerber), CM, 28 Mar 2002
;   Changed _EXTRA handling to use EXECUTE internally.  Unfortunately
;     makes it incompatible with VM version of IDL, 03 Aug 2003, CM
;   Remove EXECUTE function, move to CALL_PROCEDURE, 23 Nov 2003, CM
;   Add PLOTVERT keyword, 19 Apr 2004, CM
;
;  $Id: plotbin.pro,v 1.7 2004/04/19 09:09:10 craigm Exp $
;
;-
; Copyright (C) 1997-2000, 2002, 2003, 2004, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-
;%insert HERE
;%include subcell.pro
pro plotbin, x0, y0, width=width, pixcenter=pixcenter, plotvert=plotvert, $
             subpanel=subpanel, panel=panel, midpoint=midpoint, edge=edge, $
             _EXTRA=extra

  ;; Account for a single "Y" value
  if n_params() EQ 1 then begin
      x = dindgen(n_elements(x0))
      y = x0
  endif else begin
      x = x0
      y = y0
  endelse

  numx = n_elements(x)
  numy = n_elements(y)
  nump = numx < numy
  xtop = fltarr(2, nump)
  if numx LE 0 OR numy LE 0 then begin
      message, 'ERROR: X and Y must contain at least one data point'
      return
  endif
  if keyword_set(midpoint) then begin
      if n_elements(width) EQ 0 then width = 1
      if nump EQ 1 then xtop(*) = x(0)+width(0)*[-0.5,0.5] $
      else begin
          xtop(0,1:*) = 0.5*(x(1:nump-1)+x(0:nump-2))
          xtop(1,0:nump-2) = xtop(0,1:*)
          xtop(0,0)      = 2*x(0)      - xtop(1,0)
          xtop(1,nump-1) = 2*x(nump-1) - xtop(0,nump-1)
      endelse
  endif else if keyword_set(edge) then begin
      if n_elements(x) NE numy+1 then begin
          message, 'ERROR: X must contain one more element than Y'
          return
      endif
      xtop(0,*) = x(0:nump-1)
      xtop(1,*) = x(1:nump)
  endif else begin
      if n_elements(x) EQ 1 AND n_elements(width) EQ 0 then width = x(0)*0+1
      if n_elements(width) EQ 0 then width = (x(1)-x(0))
      if n_elements(width) EQ 1 then width = width(0)
      if n_elements(width) GT 1 AND n_elements(width) LT nump then begin
          message, 'ERROR: WIDTH must be the same size as X & Y (or be scalar)'
          return
      endif
      if n_elements(pixcenter) EQ 0 then pixcenter = 0.5
      xtop(0,*) = x(0:nump-1) - width*pixcenter
      xtop(1,*) = x(0:nump-1) + width*(1.-pixcenter)
  endelse

  ytop = rebin(reform(y(0:nump-1),1,nump),2,nump)

  ;; Vertical plot: swap X/Y
  if keyword_set(plotvert) then begin
      temp = temporary(xtop)
      xtop = temporary(ytop)
      ytop = temporary(temp)
  endif

  ;; Default is full-screen
  if n_elements(panel) EQ 0 AND n_elements(subpanel) EQ 0 then begin
      call_procedure, 'plot', xtop, ytop, _EXTRA=extra
  endif else begin
      if n_elements(panel) EQ 0 then panel=[0.0,0.0,1.0,1.0]
      call_procedure, 'plot', xtop, ytop, /NORMAL, $
        position=subcell(subpanel, panel, /marg), _EXTRA=extra
  endelse

  return
end

;+
; NAME:
;   PLOTCOLORFILL
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Plots colorful bar charts
;
; CALLING SEQUENCE:
;   PLOTCOLORFILL, x, y, COLOR=col, BOTTOM=bot, WIDTH=wid, ...
;
; DESCRIPTION: 
;
;   PLOTCOLORFILL plots a colorful vertical bar chart.  This may be
;   useful in cases where two dimensions of information need to be
;   conveyed in one plot.  [ I use it to show total intensity as a
;   function of time on the vertical axis, and temperature is coded
;   with color. ]
;
;   Most aspects of the bars are configurable.  The color is specified
;   by an array of colors, one for each bar.  [ Alternatively, a
;   single color for the entire plot can be given. ] Also, one color
;   can be designated as transparent.
;
;   Stacked bar charts can be constructed using two calls to
;   PLOTCOLORFILL.  See the example.
;
; INPUTS:
;
;   X, Y - Two arrays which give the X and Y position of the points.
;          In this style of plot, the x values should be monotonically
;          increasing, but not necessarily monospaced (see WIDTH).
;
; OPTIONAL INPUTS:
;   NONE
;
; INPUT KEYWORD PARAMETERS:
;
;   COLOR - an array giving the color of each bar, or alternatively a
;           scalar color for all of the bars.  The current color table
;           is not changed.  Default is color "1"
;
;   BOTTOM - normally the bottom of the bars is set to be zero.  You
;            may either specify a scalar bottom value for all of the
;            bars, or an array giving the bottom of each bar
;            individually.  See the example to see how stacked bar
;            charts can be constructed with this keyword.
;
;   WIDTH - sets the width of each bar, globally or individually.
;           Bars are centered on the "X" value, and extend 0.5 * WIDTH
;           to either side.  Default is to assume monospacing, using
;           the separation between the first two x values.  If only
;           one data value is present, then a width of 1 is used.
;
;   MIDPOINT - if set, then ignore the WIDTH keyword value, and
;              instead construct bin edges which lie at the midpoints
;              between data points.  This is usually the most
;              straightforward way to connect irregularly sampled
;              points "like a histogram," although at the expense of
;              not having a direct relation between X and the bin
;              centers.
;
;   NOERASE - if set, do not erase an existing plot before rendering
;             colored histogram.  The effect is comparable to "OPLOT",
;             or the OVER keyword to CONTOUR.
;
;   NOTRACE - if set, do not draw a linear trace at the top of the
;             histogram.
;
;   TRANSPARENT - designates a color which is "transparent".  Any bars
;                 with this color are simply not rendered.  Default is
;                 no transparent color.
;
;   PANEL, SUBPANEL - An alternate way to more precisely specify the
;                     plot and annotation positions.  See SUBCELL.
;                     Default is full-screen.
;
;   POSITION - Position of the bar chart in normal coordinates.
;              Overrides position given by PANEL/SUBPANEL.
;
;   Other keywords are passed to the plot command directly.
;           
; OUTPUTS:
;   NONE
;
; PROCEDURE:
;
; EXAMPLE:
;
;   Stacked barcharts can be constructed by first making one chart
;   with a flat bottom, and then a second chart whose bottom is top of
;   the first.
;
;   x = findgen(30)
;   y1 = x^2
;   y2 = 400.-x
;   c1 = bindgen(30)*3+1b
;   c2 = 100b-bindgen(30)*3+1b
;   plotcolorfill, x, y1,    color=c1, bottom=0.
;   plotcolorfill, x, y1+y2, color=c2, bottom=y1, /noerase
;
; SEE ALSO:
;
;   PLOTPAN
;
; EXTERNAL SUBROUTINES:
;
;   SUBCELL, DEFSUBCELL, PLOTPAN
;
; MODIFICATION HISTORY:
;   Written, CM, 1997
;   Added NOERASE, NOTRACE and MIDPOINT keywords, CM 11 Feb 2000
;   Logarithmic plots now work; so does the THICK keyword, CM 02 Apr
;     2001
;   Optimize drawing when the bin is zero, CM 04 Apr 2001
;   Try to handle YRANGE more properly, since there seem to be some
;     cases where the overlayed axes were erroneous, CM 15 Mar 2002
;   This time YRANGE tweaking with PANELs, CM 13 Jun 2002
;
;  $Id: plotcolorfill.pro,v 1.8 2003/09/06 16:36:19 craigm Exp $
;
;-
; Copyright (C) 1997-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;%insert HERE
;%include defsubcell.pro
;%include plotpan.pro
pro plotcolorfill, x0, y0, color=col, bottom=bot, width=width, $
                   transparent=transparent, edge=edge, thick=thick, $
                   subpanel=subpanel, panel=panel, xlog=xlog, ylog=ylog, $
                   position=position, xstyle=xstyle, ystyle=ystyle, $
                   noerase=over, midpoint=midpoint, notrace=notrace, $
                   _EXTRA=extra


  if n_params() EQ 0 then begin
      message, 'USAGE: PLOTCOLORFILL, X, Y, WIDTH=, BOTTOM=', /info
      return
  endif

  ;; Account for a single "Y" value
  if n_params() EQ 1 then begin
      x = dindgen(n_elements(x0))
      y = x0
  endif else begin
      x = x0
      y = y0
  endelse

  ;; Set default values
  if n_elements(col) EQ 0 then col = byte(y)*0b+1b
  if n_elements(col) EQ 1 then col = byte(y)*0b+col(0)
  if n_elements(xstyle) EQ 0 then xstyle = 0
  if n_elements(ystyle) EQ 0 then ystyle = 0
  if n_elements(transparent) EQ 0 then transparent = -1L

  numx = n_elements(x)
  numy = n_elements(y)
  nump = numx < numy
  xtop = fltarr(2, nump)
  if numx LE 0 OR numy LE 0 then begin
      message, 'ERROR: X and Y must contain at least one data point'
      return
  endif
  if keyword_set(midpoint) then begin
      if n_elements(width) EQ 0 then width = 1
      if nump EQ 1 then xtop(*) = x(0)+width(0)*[-0.5,0.5] $
      else begin
          xtop(0,1:*) = 0.5*(x(1:nump-1)+x(0:nump-2))
          xtop(1,0:nump-2) = xtop(0,1:*)
          xtop(0,0)      = 2*x(0)      - xtop(1,0)
          xtop(1,nump-1) = 2*x(nump-1) - xtop(0,nump-1)
      endelse
  endif else if keyword_set(edge) then begin
      if n_elements(x) NE numy+1 then begin
          message, 'ERROR: X must contain one more element than Y'
          return
      endif
      xtop(0,*) = x(0:nump-1)
      xtop(1,*) = x(1:nump)
  endif else begin
      if n_elements(x) EQ 1 AND n_elements(width) EQ 0 then width = x(0)*0+1
      if n_elements(width) EQ 0 then width = (x(1)-x(0))
      if n_elements(width) EQ 1 then width = width(0)
      if n_elements(width) GT 1 AND n_elements(width) LT nump then begin
          message, 'ERROR: WIDTH must be the same size as X & Y (or be scalar)'
          return
      endif
      if n_elements(pixcenter) EQ 0 then pixcenter = 0.5
      xtop(0,*) = x(0:nump-1) - width*pixcenter
      xtop(1,*) = x(0:nump-1) + width*pixcenter
  endelse

  ;; Plot coordinate grid first
  xrange1 = [min(x), max(x)]
  yrange1 = [min(y), max(y)]
  if NOT keyword_set(over) then begin
  if n_elements(panel) EQ 0 AND n_elements(subpanel) EQ 0 then begin
      if n_elements(position) GT 0 then $
        extra = create_struct(extra, 'POSITION', position)
      plot, xrange1, yrange1, /nodata, xrange=xrange1, yrange=yrange1, $
        xstyle=xstyle(0) OR 4, ystyle=ystyle(0) OR 4, $
        xlog=xlog, ylog=ylog, _EXTRA=extra
  endif else begin
      ;; Set panel size
      if n_elements(panel) EQ 0 then panel=[0.0,0.0,1.0,1.0]
      if n_elements(subpanel) EQ 0 then subpanel = [-1., -1., -1., -1. ]
      subpanel = defsubcell(subpanel)
      plotpan, xrange1, yrange1, xrange=xrange1, yrange=yrange1, /nodata, $
        panel=panel, subpanel=subpanel, xlog=xlog, ylog=ylog, $
        xstyle=xstyle(0) OR 4, ystyle=ystyle(0) OR 4, _EXTRA=extra
  endelse
  endif

  xrange = !x.crange
  yrange = !y.crange
  if keyword_set(xlog) then xrange = 10d^xrange
  if keyword_set(ylog) then yrange = 10d^yrange

  if n_elements(bot) EQ 0 then bot = y * 0. + yrange(0)
  if n_elements(bot) EQ 1 then bot = y * 0. + bot(0)
  ytop = rebin(reform(y(0:nump-1),1,nump),2,nump)

  minc = min(col, max=maxc)
  if minc EQ maxc then begin
      ;; Optimize for case of all the same color
      bbot = rebin(reform(bot(0:nump-1),1,nump),2,nump)
      polyfill, [xtop(*), reverse(xtop(*))], [ytop(*), reverse(bbot(*))], $
        color=col(0), /data, noclip=0
  endif else begin        
      ;; Loop through and draw filled rectangles
      for i = 0, nump-1 do begin
          ;; The vertical size is given by "bot" and "y"
          if xtop(1,i) GE xrange(0) AND xtop(0,i) LE xrange(1) $
            AND y(i) NE bot(i) AND long(col(i)) NE transparent then begin
              polyfill, [xtop(0,i), xtop(1,i), xtop(1,i), xtop(0,i)], $
                [bot(i), bot(i), y(i), y(i)] , $
                color=col(i), /data, noclip=0
          endif
      endfor
  endelse

  ;; Overlay the coordinate grid again in case it got partially wiped.
  if NOT keyword_set(over) then begin
      xwindow = !x.window & ywindow = !y.window
      position = [xwindow(0), ywindow(0), xwindow(1), ywindow(1)]
      xrange2 = !x.crange & yrange2 = !y.crange
      plot, xrange2, yrange2, /nodata, /noerase, $
        xrange=xrange2, yrange=yrange2, position=position, $
        xstyle=xstyle(0) OR 1, ystyle=ystyle(0) OR 1, $
        xlog=xlog, ylog=ylog, _EXTRA=extra
  endif

  ;; Finally, overlay the trace at the top of the curve.
  if NOT keyword_set(notrace) then begin
      oplot, xtop, ytop, thick=thick
  endif

  return
end


;+
; NAME:
;   PLOTCUBE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Plots a three dimensional data that can be printed and made into a cube
;
; CALLING SEQUENCE:
;   PLOTCUBE, x, y, z
;
; DESCRIPTION: 
;
;   PLOTCUBE plots a three dimensional data set so that it can be
;   printed on paper, cut out, and folded together to make a real-life
;   three dimensional cube.  This may be useful in visualization
;   applications.  The six faces of the cube contain a projection of
;   the data onto that face.
;
;   The output consists of a flat matrix of six plots, which are
;   joined together at the proper edges of the cube.  Your task,
;   should you choose to accept it, is to cut out the cube and
;   assemble it.
;
;   Before folding the cube together, it will look like the diagram
;   below.  You need to match together edges labelled with the same
;   letter.
;
;                            A
;                          +----+
;                         B|    |G
;                      B   |    |   G
;                     +----+----+----+
;                     |    |    |    |
;                    C|    |    |    |E
;                     +----+----+----+
;                      D   |    |   F
;                         D|    |F
;                          +----+
;                          |    |
;                         C|    |E
;                          +----+
;                            A
;
;   HINT 1: When printing, be sure that the XSIZE and YSIZE are given
;           in the ratio of 3 to 4.  A size of 6 in by 8 in is
;           suitable.
;
;   HINT 2: As a practical matter for assembling the cube once it has
;           been printed, you should leave some extra paper tabs so
;           that adhesive can be applied.
;
; INPUTS:
;
;   X, Y, Z - Three arrays which specify position in three dimensional
;             space.  All three arrays should be of the same length.
;
; OPTIONAL INPUTS:
;   NONE
;
; INPUT KEYWORD PARAMETERS:
;
;   PANEL, SUBPANEL - An alternate way to more precisely specify the
;                     plot and annotation positions.  See SUBCELL.
;                     Default is full-screen.
;
;   XRANGE, YRANGE, ZRANGE - gives plot range for each dimension, as
;                            for other plot commands.  Default is
;                            range of data.
;
;   XTITLE, YTITLE, ZTITLE - gives title for each axis.  The title
;                            labels each face of the cube where
;                            possible.
;
;   NOERASE - If set, the display is not erased before graphics
;             operations.
;
;   Other options are passed along to the PLOT command directly.
;
; OUTPUTS:
;   NONE
;
; PROCEDURE:
;
; EXAMPLE:
;
;   This example takes some synthetic data and makes a cube out of it.
;   Visualizing the trace of the curve is more convenient when it can
;   be projected on the cube in each dimension.
;
;   t = findgen(200)/20. - 10.
;   x = cos(t)
;   y = sin(t) + 0.05*t
;   z = exp(t) + 0.05*randomn(seed, 200)
;   plotcube, x, y, z, xrange=[-1.5,1.5], yrange=[-1.5,1.5], zrange=[-1.5,1.5]
;
; SEE ALSO:
;
;   DEFSUBCELL, SUBCELLARRAY
;
; EXTERNAL SUBROUTINES:
;
;   SUBCELL, DEFSUBCELL, PLOTPAN
;
; MODIFICATION HISTORY:
;   Written, CM, 1997
;   Modified to include SUBCELL, DEFSUBCELL and PLOTPAN when
;     distributed, CM, late 1999
;
;  $Id: plotcube.pro,v 1.2 2001/03/25 18:10:44 craigm Exp $
;
;-
; Copyright (C) 1997-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;%insert HERE
;%include subcell.pro
;%include defsubcell.pro
;%include plotpan.pro
pro plotcube, x, y, z, $
              xrange=xrange, yrange=yrange, zrange=zrange, $
              xtitle=xtitle, ytitle=ytitle, ztitle=ztitle, $
              panel=panel, subpanel=subpanel, $
              noerase=noerase, $
              _EXTRA=extra

  ;; Default is full-panel
  if n_elements(panel) EQ 0 then panel=[0.0,0.0,1.0,1.0]
  if n_elements(subpanel) EQ 0 then subpanel=[-1.,-1,-1,-1]
  if n_elements(noerase) EQ 0 then noerase=0

  if n_elements(xrange) EQ 0 then xrange = [ min(x), max(x) ]
  if n_elements(yrange) EQ 0 then yrange = [ min(y), max(y) ]
  if n_elements(zrange) EQ 0 then zrange = [ min(z), max(z) ]

  if n_elements(xtitle) EQ 0 then xtitle = 'X'
  if n_elements(ytitle) EQ 0 then ytitle = 'Y'
  if n_elements(ztitle) EQ 0 then ztitle = 'Z'

  subcellarray, [1,1,1], [1,1,1,1], newpan, newsub, $
    panel=panel, subpanel=subpanel

  plotpan, x, z, /xstyle, /ystyle, noerase=noerase, $
    xtickformat='(A1)', ytitle=ztitle, $
    xrange=xrange, yrange=zrange, $
    panel=newpan(1,3,*), subpanel=newsub(1,3,*), _EXTRA=extra

  plotpan, z, y, /xstyle, /ystyle, /noerase, $
    xtitle=ztitle, ytitle=ytitle, $
    xrange=[zrange(1),zrange(0)], yrange=yrange, $
    panel=newpan(0,2,*), subpanel=newsub(0,2,*), _EXTRA=extra

  plotpan, x, y, /xstyle, /ystyle, /noerase, $
    xtickformat='(A1)', ytickformat='(A1)', $
    xrange=xrange, yrange=yrange, $
    panel=newpan(1,2,*), subpanel=newsub(1,2,*), _EXTRA=extra

  plotpan, z, y, /xstyle, /ystyle, /noerase, $
    ytickformat='(A1)', xtitle=ztitle, $
    xrange=zrange, yrange=yrange, $
    panel=newpan(2,2,*), subpanel=newsub(2,2,*), _EXTRA=extra

  plotpan, x, z, /xstyle, /ystyle, /noerase, $
    xtickformat='(A1)', ytitle=ztitle, $
    xrange=xrange, yrange=[zrange(1),zrange(0)], $
    panel=newpan(1,1,*), subpanel=newsub(1,1,*), _EXTRA=extra

  plotpan, x, y, /xstyle, /ystyle, /noerase, $
    xtitle=xtitle, ytitle=ytitle, $
    xrange=xrange, yrange=[yrange(1), yrange(0)], $
    panel=newpan(1,0,*), subpanel=newsub(1,0,*), _EXTRA=extra

  return
end

    
;+
; NAME:
;   PLOTIMAGE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Displays an image via a "PLOT"-like interface.
;
; CALLING SEQUENCE:
;   PLOTIMAGE, img, [xrange=xrange,] [yrange=yrange,] ...
;
; DESCRIPTION:
;
;   PLOTIMAGE displays an image (or slice of an image) on the current
;   graphics device.  The syntax is very similar to the PLOT command,
;   in the sense that an XRANGE and YRANGE for the plot can be
;   specified.  
;
;   PLOTIMAGE keeps separate the notions of the image coordinate
;   system and the displayed coordinate system, which allows any input
;   image to be "cropped," "zoomed," or "flipped."
;
;   PLOTIMAGE allows the user to express image extents in physical
;   units rather than pixel units.
;
;   The image coordinate system specifies the physical coordinates of
;   original image data, IMG.  The image is considered to be a 2D
;   array (IMG = ARRAY(NX,NY)), where the values are attached to the
;   midpoint of each geometric pixel.  The image has NX columns and NY
;   rows.  Physical coordinates are attached to each pixel by using
;   the IMGXRANGE and IMGYRANGE keywords.  The IMGXRANGE keyword is a
;   two-element array specifying the "left" and "right" boundaries of
;   the image pixels in physical units; the IMGYRANGE keyword
;   specifies the "top" and "bottom" boundaries of the image.  This is
;   illustrated in Figure 1 for a simplified case.
;
;                                   ___
;         +-----------+-----------+  ^  IMGYRANGE[1]
;         |           |           |  |
;         | IMG[0,1]  | IMG[1,1]  |  |
;         |     +     |     +     |  |
;         |           |           |  |
;         |           |           |  |
;         +-----------+-----------+  |
;         |           |           |  |
;         | IMG[0,0]  | IMG[1,0]  |  |
;         |     +     |     +     |  |
;         |           |           |  |
;         |           |           |  v
;         +-----------+-----------+ ___ IMGYRANGE[0]
;        |                         |
;        |<----------------------->|
;        IMGXRANGE[0]   IMGXRANGE[1]
;
;      Figure 1.  Simplified example of a 2x2 input image,
;      demonstrating that IMG[*,*] values refer to the pixel
;      mid-points, and that IMGXRANGE and IMGYRANGE ranges specify the
;      physical coordinates of the outer edges of the image extent in
;      X and Y, respectively.
; 
;
;   The displayed plot coordinate system is entirely independent of
;   the native image coordinates.  Users can set up the plot scale
;   using any combination of {X,Y}RANGE, {X,Y}STYLE and/or {X,Y}LOG,
;   as they would for any IDL plot, using physical units.  The input
;   image will then be overlayed on this coordinate system.
;
;   If the displayed plot coordinates are narrower than the native
;   image coordinates, then the displayed portion of the image will be
;   cropped to fit.  If the displayed coordinates are wider than the
;   native image coordinates, then the image will be displayed with
;   blank spaces on either side (see Figure 2).  A mirror "flip" is
;   also possible in X and/or Y, if XRANGE or YRANGE are specified in
;   reverse order.
;                                                 ___
;      +---------------------------------------+   ^
;      |            ___                        |   |
;      |             ^  +---------------+      |   |
;      |             |  |               |      |   |
;      |             |  |               |      |   |
;      |    IMGYRANGE|  |     IMG       |      |   | YRANGE
;      |             |  |               |      |   |
;      |             v  |               |      |   |
;      |            ___ +---------------+      |   |
;      |               |<-- IMGXRANGE -->|     |   |
;      |                                       |   v
;      +---------------------------------------+  ___
;     |<-------------   XRANGE   -------------->|
;
;     Figure 2.  Example of an image whose native image coordinates
;     are embedded in a wider plot display range.
;
;   The standard [XY]STYLE keywords can be used to style either axis.
;   However at the very least [XY]STYLE=1 is always implied, i.e. the
;   plot limits exactly obey the [XY]RANGE keyword values.
;
;   If XLOG or YLOG are set, then the image is assumed to be sampled
;   on a logarithmic grid, and logarithmic axes are displayed
;   accordingly.  PLOTIMAGE does not attempt to resample the image
;   from linear scale to logarithmic scale, or reverse.
;
;   Psuedocolor images may be of any type, but must rescaled to a byte
;   range by using the RANGE keyword.  By default the color range used
;   in the rescaling operation is 0 to !D.N_COLORS - 3B.  The extra
;   two color values are reserved for the background and default pen
;   colors.  This behavior can be adjusted by specifying the BOTTOM
;   and/or NCOLORS keywords.
;
;   Truecolor images must always be of type BYTE and one of their
;   dimensions must have 3 elements, corresponding to the three color
;   planes of the image.
;
;
; INPUTS:
;
;   IMG - Array to be displayed.  For single-plane images (i.e.,
;         pseudocolor), the image must be two dimensional and of any
;         real numeric type.  For images that are not of BYTE type,
;         the RANGE keyword must be supplied, and then PLOTIMAGE will
;         rescale the image values to a byte range.
;
;         An image declared as ARRAY(NX,NY) will be NX pixels in the
;         x-direction and NY pixels in the y-direction.  The image is
;         resampled to fill the desired display region (and optionally
;         smoothed).
;
;         For three-plane images (i.e., truecolor) the image must be
;         of type BYTE.  One of the dimensions of the array must have
;         three elements.  Hence it must be one of BYTARR(NX, NY, 3),
;         BYTARR(NX, 3, NY) or BYTARR(3, NX, NY).  The 3-element
;         dimension is recognized automatically.
;
; OPTIONAL INPUTS:
;   NONE
;
; INPUT KEYWORD PARAMETERS:
;
;   IMGXRANGE, IMGYRANGE - Each is a two component vector that
;                          describes the X and Y position of the outer
;                          edges of the first and last pixels.
;                          Default: IMGXRANGE = [0,NX]
;                                   IMGYRANGE = [0,NY]
;
;   XRANGE, YRANGE - Each is a two component vector that specifies the
;                    X and Y plot ranges, respectively.  These values
;                    are not required to coincide with IMG[XY]RANGE.
;                    Default: XRANGE=IMGXRANGE
;                             YRANGE=IMGYRANGE
;
;   POSITION - Position of the inner plot window in the standard
;              graphics keyword format.  Overrides PANEL and SUBPANEL.
;
;   INTERP - if set, interpolate (smooth) the image before displaying.
;            This keyword applies to the screen displays.  For printed
;            images that are coarser than MIN_DPI, the image is
;            implicitly interpolated regardless of INTERP.
;
;   PRESERVE_ASPECT - if set, preserve the aspect ratio of the
;                     original image (in pixels).  The result will be
;                     the largest image that fits in the display
;                     region while maintaining approximately square
;                     pixels.  However, PIXEL_ASPECT_RATIO overrides
;                     PRESERVE_ASPECT.  The POSITION keyword will be
;                     reset upon output to the ultimate image
;                     position.
;                     DEFAULT: not set (image will fill POSITION rectangle)
;
;   PIXEL_ASPECT_RATIO - The ratio of width to height for each pixel.
;                        If specified, then the image will be scaled
;                        so that each pixel has the specified aspect
;                        ratio.  If not specified, then the image will
;                        be scaled independently in X and Y in order
;                        to fill the POSITION rectangle.  NOTE: If you
;                        want to change the overall image aspect
;                        ratio, then use the POSITION keyword.
;                  DEFAULT: undefined (image will fill POSITION rectangle)
;
;   MIN_DPI - if printing, the minimum dot-per-inch pixel resolution
;             for the resulting image.  Output images that would be
;             coarser than this value are resampled to have a
;             resolution of at least MIN_DPI, and smoothed.  Some
;             common resolutions are: screen, 90 dpi; dot matrix, 72
;             dpi; laser printer 300-600 dpi.  Note that large values
;             of MIN_DPI will produce very large output files.
;             Default: 0 (i.e., the output image will not be smoothed)
;
;   RANGE - a two element vector.  If the image is single plane (i.e.,
;           pseudocolor) the input image can be of any real numeric
;           type, and then must be rescaled into byte range with this
;           keyword.  In contrast, truecolor images must always be of
;           type BYTE.  Values are scaled into byte range with the
;           following statement:
;              RESULT = BYTSCL(INPUT, MIN=RANGE(0), MAX=RANGE(1), $
;                              TOP=NCOLORS-1) + BOTTOM
;           so that pixels with an intensity RANGE(0) are set to
;           BOTTOM; those with RANGE(1) are set to the maximum color.
;           Default: no range scaling occurs (and the image must hence
;                    be of type BYTE -- otherwise an error occurs)
;
;   NCOLORS - number of color table values be used in the byte
;             rescaling operation.
;             Default: !D.N_COLORS - BOTTOM - 1 (for default pen color)
;
;   BOTTOM - bottom-most value of the color table to be used in the
;            byte rescaling operation.
;            Default: 1 (for default background color)
;
;   NOERASE - If set, the display is not erased before graphics
;             operations.
;
;   NODATA - If set, the image is not actually displayed, but
;            coordinate axes may be drawn.
;
;   NOAXES - An attempt is made to render the image without coordinate
;            axes.  However, it's usually more straightforward to set 
;            XSTYLE=4 or YSTYLE=4, which is the standard IDL way to
;            disable coordinate axes.
;
;   ORDER - same interpretation as the !ORDER system variable; 
;           if ORDER=0, then the first pixel is drawn in the lower
;           left corner; if ORDER=1, then the first pixel is drawn in
;           the upper left corner.
;           Default: 0
;
;
;   PANEL, SUBPANEL - An alternate way to more precisely specify the
;                     plot and annotation positions.  See SUBCELL.
;
;   PLOTIMAGE will pass other keywords directly to the PLOT command
;   used for generating the plot axes.  XSTYLE=1 and YSTYLE=1 are
;   enforced.
;
; OUTPUTS:
;   NONE
;
; PROCEDURE:
;
; EXAMPLE:
;
;   This example constructs an image whose values are found by
;       z(x,y) = cos(x) * sin(y)
;   and x and y are in the range [-2,2] and [4,8], respectively.
;   The image is then plotted, with appropriate axes.
;
;   x = findgen(20)/5. - 2. + .1   ; 0.1 = half-pixel
;   y = findgen(20)/5. + 4. + .1
;   zz = cos(x) # sin(y)
;   imgxrange = [-2.,2.]           ; extend to pixel edges
;   imgyrange = [4.,8.]
;   plotimage, bytscl(zz), imgxrange=imgxrange, imgyrange=imgyrange
;
;   This second example plots the same image, but with a plot range
;   much larger than the image's.
;
;   xr=[-10.,10]
;   yr=[-10.,10]
;   plotimage, bytscl(zz), imgxrange=imgxrange, imgyrange=imgyrange, $
;      xrange=xr, yrange=yr
;
; SEE ALSO:
;
;   OPLOTIMAGE, BYTSCL
;
; EXTERNAL SUBROUTINES:
;
;   SUBCELL, DEFSUBCELL
;
; MODIFICATION HISTORY:
;   Written, CM, 1997
;   Correct various one-off problems, 02 Feb 1999, CM
;   Made self-contained with some pre-processing, 17 Oct 1999, CM
;   Corrected bug in newly introduced CONGRID functions, 18 Oct 1999, CM
;   Correct behavior with no POSITION keyword, 17 Nov 1999, CM
;   Simplified axis plotting, 17 Nov 1999, CM
;   Use _EXTRA keyword in first PLOT, but with blank TITLEs, 11 Jan
;     2000, CM
;   Correct implementation of X/YSTYLE in first PLOT, 11 Feb 2000, CM
;   Correct CONGRID implementation (small effect when enlarging most
;     images), 14 Feb 2000, CM
;   Major changes: 19 Apr 2000
;      - now handle decomposed color, automatic color mapping via
;        RANGE, and 24-bit multiplane images
;      - new PRESERVE_ASPECT keyword to keep square pixels
;      - removed legacy TVIMAGE code
;      - smoothing is more configurable, esp. for printers, but is not
;        done by default; more printers are supported
;   Corrected INTERPOLATE behavior (thanks to Liam Gumley
;     <Liam.Gumley@ssec.wisc.edu>), other minor tweaks, CM 20 Apr 2000
;   Added ability to use PRESERVE_ASPECT with POSITION, PANEL or
;     SUBPANEL keywords CM 20 Oct 2000
;   Oops, a typo is now fixed, CM 23 Oct 2000
;   Add fix for MacIntoshes and DECOMPOSED color, Tupper, 02 Aug 2001
;   Better behavior with fractional pixels (ie, when the image pixels
;     are very large compared to the screen), 23 Aug 2001
;   Add support for Z buffer, CM, 20 Oct 2002
;   Memory conservation: use REVERSE() to reverse IMG; rewrote
;     PLOTIMAGE_RESAMP to rescale entire image instead of each color plane
;     separately.  Jeff Guerber, 30 July 2003
;   Add PIXEL_ASPECT_RATIO keyword, 22-25 Nov 2005
;   Check for the case of an 1xNXxNY 3D image and treat it as a 2D
;     image.  The "1" dimension can be anywhere, CM, 03 Sep 2006
;   Add the ORDER keyword parameter, CM, 20 Mar 2007
;   Enable XLOG and YLOG keywords, for logarithmic axes;
;     doesn't actually resample the image from linear<->log, CM
;     21 Jan 2009
;   Documentation, CM, 21 Jan 2009
;   Allow reverse color scale, CM, 13 Nov 2010
;   Add checking for decomposed state of Z buffer, thanks David
;     Palmer, 2013-08-12
;
;   $Id: plotimage.pro,v 1.16 2013/09/30 02:22:49 cmarkwar Exp $
;
;-
; Copyright (C) 1997-2001,2003,2005,2006,2007,2009,2010,2013 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;%insert HERE
;%include subcell.pro
;%include defsubcell.pro

; Utility routine to resample an image
;
;  IMAGE - image data ARRAY(NX,NY,BDEPTH)
;  NX,NY - original X,Y image size
;  BDEPTH- original image depth
;  NEWX, NEWY- desired X,Y image size
;  INTERP - if set, then use bilinear interpolation, otherwise nearest neighbor
function plotimage_resamp, image, nx, ny, bdepth, newx, newy, interp=interp

  ;; Sometimes the final dimension is lost.  Put it back
  image = reform(image, nx, ny, bdepth, /overwrite)

  ;; Correct interpolation
  srx = float(nx)/newx * findgen(newx) - 0.5 + 0.5*(float(nx)/newx)
  sry = float(ny)/newy * findgen(newy) - 0.5 + 0.5*(float(ny)/newy)
  srz = indgen(bdepth)
  if keyword_set(interp) then $
    return, interpolate(image, srx, sry, srz, /grid)

  ;; Simple nearest neighbor interpolation
  return, interpolate(image, round(srx), round(sry), srz, /grid)
end

pro plotimage_pos, xrange0, imgxrange0, imgxsize, xreverse, srcxpix, imgxpanel, $
                   logscale=logscale, $
                   quiet=quiet, status=status, pixtolerance=pixtolerance

  if keyword_set(logscale) then begin
     if min(xrange0) LE 0 OR min(imgxrange0) LE 0 then $
        message, ('ERROR: if XLOG or YLOG is set, then the image boundary cannot '+$
                  'cross or touch zero.  Did you forget to set IMGXRANGE or IMGYRANGE?')
     xrange    = alog10(xrange0)
     imgxrange = alog10(imgxrange0)
  endif else begin
     xrange    = xrange0
     imgxrange = imgxrange0
  endelse

  if n_elements(pixtolerance) EQ 0 then pixtolerance = 1.e-2
  status = 0
  ;; Decide if image must be reversed
  xreverse = 0
  if double(xrange(1)-xrange(0))*(imgxrange(1)-imgxrange(0)) LT 0 then begin
      xreverse = 1
      imgxrange = [imgxrange(1), imgxrange(0)]
  endif

  srcxpix  = [ 0L, imgxsize-1 ]
  ;; Size of one x pix
  dx = double(imgxrange(1) - imgxrange(0)) / imgxsize

  if min(xrange) GE max(imgxrange) OR max(xrange) LE min(imgxrange) then begin
      message, 'WARNING: No image data in specified plot RANGE.', /info, $
        noprint=keyword_set(quiet)
      return
  endif

  ;; Case where xrange cuts off image at left
  if (xrange(0) - imgxrange(0))/dx GT 0 then begin
      offset = double(xrange(0)-imgxrange(0))/dx
      if abs(offset-round(offset)) LT pixtolerance then $
        offset = round(offset)
      srcxpix(0) = floor(offset)
      froffset = offset - floor(offset)
      if abs(froffset) GT pixtolerance then begin
          xrange = double(xrange)
          xrange(0) = imgxrange(0) +dx*srcxpix(0)
      endif
  endif

  ;; Case where xrange cuts off image at right
  if (xrange(1) - imgxrange(1))/dx LT 0 then begin
      offset = double(xrange(1)-imgxrange(0))/dx
      if abs(offset-round(offset)) LT pixtolerance then $
        offset = round(offset)
      srcxpix(1) = ceil(offset) - 1
      froffset = offset - ceil(offset)
      if abs(froffset) GT pixtolerance then begin
          xrange = double(xrange)
          srcxpix(1) = srcxpix(1) < (imgxsize-1)
          xrange(1) = imgxrange(0) + dx*(srcxpix(1)+1)
      endif
  endif

  imgxpanel = [0., 1.]
  if (xrange(0) - imgxrange(0))/dx LT 0 then $
    imgxpanel(0) = (imgxrange(0) - xrange(0))/(xrange(1)-xrange(0))
  if (xrange(1) - imgxrange(1))/dx GT 0 then $
    imgxpanel(1) = (imgxrange(1) - xrange(0))/(xrange(1)-xrange(0))

  status = 1
  return
end

;; Main program
pro plotimage, img0, xrange=xrange0, yrange=yrange0, $
               imgxrange=imgxrange0, imgyrange=imgyrange0, $
               xlog=xlog, ylog=ylog, $
               position=position, panel=panel, subpanel=subpanel, $
               xstyle=xstyle, ystyle=ystyle, title=title, $
               interp=interp0, quiet=quiet, dither=dither, $
               preserve_aspect=paspect, pixel_aspect_ratio=asprat, $
               min_dpi=min_dpi, order=order, $
               ncolors=ncolors0, bottom=bottom0, range=range, $
               noerase=noerase0, nodata=nodata, noaxes=noaxes, $
               pixtolerance=pixtolerance, _EXTRA=extra

  ;; Return to user when an error is encountered
  on_error, 2

  ;; Usage message
  if n_params() EQ 0 then begin
      message, 'PLOTIMAGE, image, xrange=, yrange=, imgxrange=, imgyrange=,..', $
               /info
      return
  endif

  ;; Must have a byte-scaled image already
  imgsize  = size(img0)

  ;; Make sure windowing exists (borrowed from IMDISP)
  if ((!d.flags and 256) ne 0) and (!d.window lt 0) then begin
      window, /free, /pixmap
      wdelete, !d.window
  endif

  ;; Parameter checking
  if n_elements(ystyle) EQ 0 then ystyle = 0L
  if n_elements(xstyle) EQ 0 then xstyle = 0L
  if keyword_set(nodata) then mynodata = 1 else mynodata = 0
  if n_elements(pixtolerance) EQ 0 then pixtolerance = 1.e-2
  if n_elements(title) EQ 0 then title = ''
  if n_elements(min_dpi) EQ 0 then min_dpi = 0
  interp = keyword_set(interp0)
  noerase = keyword_set(noerase0)
  imgpanel = [0., 0., 1., 1.]

  ;; Default handling of color table stuff
  if n_elements(bottom0) EQ 0 then bottom0 = 1B
  bottom = byte(bottom0(0)) < 255B
  dncolors = min([!d.n_colors, !d.table_size, 256])
  if n_elements(ncolors0) EQ 0 then ncolors0 = dncolors - 1 - bottom
  ;; Make sure color table values are in bounds
  ncolors = floor(ncolors0(0)) < 256
  if bottom + ncolors GT 256 then ncolors = 256 - bottom

  ;; Image size and dimensions
  nimgdims  = imgsize(0)
  imgtype   = imgsize(nimgdims+1)
  if nimgdims LT 2 OR nimgdims GT 3 then begin
      message, 'ERROR: image must have 2 or 3 dimensions'
  endif

  if nimgdims EQ 2 then begin
      ;; Two dimensional image is pseudo color
      img = img0

      ONE_CHANNEL_IMAGE:
      imgxsize = imgsize(1)
      imgysize = imgsize(2)
      bdepth = 1

      if imgtype NE 1 then begin
          if n_elements(range) LT 2 then $
            message, 'ERROR: non-byte image must be scaled with RANGE keyword'
          if range(0) LE range(1) then begin
              img = bytscl(img, min=range(0), max=range(1), top=ncolors-1B) $
                + bottom
          endif else begin
              ;; Reverse color scheme
              img = bytscl(img, min=range(1), max=range(0), top=ncolors-1B)
              img = ncolors-1B-img + bottom
          endelse
      endif
      img = reform(img, imgxsize, imgysize, bdepth, /overwrite)
  endif else begin
      wh = where(imgsize(1:3) EQ 1, ct)
      if ct GT 0 then begin
          imgxsize = 1
          imgysize = 1
          j = 0
          for i = 1, 3 do if imgsize(i) NE 1 then begin
              if j EQ 0 then imgxsize = imgsize(i) else imgysize = imgsize(i)
              j = j + 1
          endif
          img = reform(img0, imgxsize, imgysize)
          imgsize = size(img)

          goto, ONE_CHANNEL_IMAGE
      endif else begin
          ;; Three dimensional image has three planes
          wh = where(imgsize(1:3) EQ 3, ct)
          if imgtype NE 1 then $
            message, 'ERROR: true color image must of type byte'
          if ct EQ 0 then $
            message, ('ERROR: True color image must have 3 elements '+$
                      'in one of its dimensions')
          truedim = wh(0)
          
          ;; Shuffle the data so planes are interleaved ...
          case truedim of
              0: img = transpose(img0, [1,2,0]) ;; ... from pixels interleaved
              1: img = transpose(img0, [0,2,1]) ;; ... from rows interleaved
              2: img = img0                 ;; ... by straight copying
          end

          imgsize = size(img)
          imgxsize = imgsize(1)
          imgysize = imgsize(2)
          bdepth = imgsize(3)

      endelse

  endelse

  ;; By default, we have no info about the image, and display the
  ;; whole thing
  if n_elements(imgxrange0) LT 2 then imgxrange = [ 0., imgxsize ] $
  else imgxrange = 0. + imgxrange0(0:1)
  if n_elements(xrange0) LT 2 then xrange = imgxrange $
  else xrange = 0. + xrange0(0:1)

  status = 0
  plotimage_pos, xrange, imgxrange, imgxsize, xreverse, srcxpix, imgxpanel, $
    quiet=keyword_set(quiet), status=status, pixtolerance=pixtolerance, $
    logscale=xlog
  if status EQ 0 then mynodata = 1 $
  else imgpanel([0,2]) = imgxpanel

  ;; By default, we have no info about the image, and display the
  ;; whole thing
  if n_elements(imgyrange0) LT 2 then imgyrange = [ 0., imgysize ] $
  else imgyrange = 0. + imgyrange0(0:1)
  if n_elements(yrange0) LT 2 then yrange = imgyrange $
  else yrange = 0. + yrange0(0:1)
  if keyword_set(order) then yrange = [yrange(1), yrange(0)]

  status = 0
  plotimage_pos, yrange, imgyrange, imgysize, yreverse, srcypix, imgypanel, $
    quiet=keyword_set(quiet), status=status, pixtolerance=pixtolerance, $
    logscale=ylog
  if status EQ 0 then mynodata = 1 $
  else imgpanel([1,3]) = imgypanel

  ;; Dimensions of output image in pixels
  nx = srcxpix(1)-srcxpix(0)+1
  ny = srcypix(1)-srcypix(0)+1

  ;; Create a coordinate system by plotting with no data or axes
  if n_elements(position) EQ 0 AND n_elements(panel) EQ 0 AND $
    n_elements(subpanel) EQ 0 then begin

      ;; If PANEL/SUBPANEL is not given, then plot once to set up
      ;; axes, despite NOAXES
      plot, xrange, yrange, noerase=noerase, /nodata, $
        xstyle=xstyle OR 5, ystyle=xstyle OR 5, xlog=xlog, ylog=ylog, $
        xrange=xrange, yrange=yrange, xtitle='', ytitle='', title='', $
        _EXTRA=extra

      ;; Retrieve axis settings
      xwindow = !x.window
      ywindow = !y.window

      subpanel1 = [xwindow(0), ywindow(0), xwindow(1), ywindow(1)]
      imgposition = subcell(imgpanel, subpanel1)
      position = subpanel1

  endif else begin

      ;; Construct the plot size from panel info.  Default is full-screen
      if NOT keyword_set(noerase) then erase
      if n_elements(position) GE 4 then begin
          imgposition = subcell(imgpanel, position)
      endif else begin
          if n_elements(panel) LT 4 then panel = [0.0,0.0,1.0,1.0]
          if n_elements(subpanel) LT 4 then subpanel = [-1., -1, -1, -1]
          subpanel = defsubcell(subpanel)

          imgposition = subcell(subcell(imgpanel, subpanel), panel)
          position = subcell(subpanel, panel)
      endelse

      xwindow = position([0,2])
      ywindow = position([1,3])

  endelse

  ;; If the aspect is to be preserved then we need to recompute the
  ;; position after considering the image size.  Since we have already
  ;; computed the outer envelope of the image from either the POSITION
  ;; or PANEL, or from the plot window itself, we can now go to the
  ;; logic which estimates the aspect-corrected size.

  if (keyword_set(paspect) OR n_elements(asprat) GT 0) AND $
    nx GT 0 AND ny GT 0 then begin

      if n_elements(asprat) EQ 0 then asprat1 = 1.0 $
      else asprat1 = asprat(0) + 0.

      ;; If we are preserving the aspect, then re-plot after scaling
      ;; the POSITION

      imgaspect = float(ny)/float(nx)/asprat1
      dispaspect = (ywindow(1)-ywindow(0))*!d.y_vsize $
        / ((xwindow(1)-xwindow(0))*!d.x_vsize)

      ;; Compute the new image dimensions
      if imgaspect GT dispaspect then begin
          x0 = total(xwindow)/2
          dx = (ywindow(1)-ywindow(0))*!d.y_vsize/(imgaspect*!d.x_vsize)
          xwindow = x0 + dx*[-0.5,0.5]
      endif else begin
          y0 = total(ywindow)/2
          dy = (xwindow(1)-xwindow(0))*!d.x_vsize*imgaspect/!d.y_vsize
          ywindow = y0 + dy*[-0.5,0.5]
      endelse

      subpanel1 = [xwindow(0), ywindow(0), xwindow(1), ywindow(1)]
      imgposition = subcell(imgpanel, subpanel1)
      position = subpanel1

      ;; Replot to regain coordinate system
      plot, xrange, yrange, /noerase, /nodata, $
        xstyle=xstyle OR 5, ystyle=xstyle OR 5, xlog=xlog, ylog=ylog, $
        xrange=xrange, yrange=yrange, xtitle='', ytitle='', title='', $
        position=position, _EXTRA=extra

  endif

  ;; Draw the image data
  if NOT keyword_set(mynodata) then begin

      ;; Reverse X- or Y- directions if necessary
      if xreverse then $
        srcxpix = imgxsize - 1 - [srcxpix(1), srcxpix(0)]
      if yreverse then $
        srcypix = imgysize - 1 - [srcypix(1), srcypix(0)]

      ;; Extract relevant image elements
      img = (temporary(img))(srcxpix(0):srcxpix(1), srcypix(0):srcypix(1),*)
      img = reform(img, nx, ny, bdepth, /overwrite)

      ;; Complete the extraction, if reversed
      if xreverse then begin
          img = reverse(img, 1, /overwrite)
          img = reform(img, nx, ny, bdepth, /overwrite)
      endif
      if yreverse then begin
          img = reverse(img, 2, /overwrite)
          img = reform(img, nx, ny, bdepth, /overwrite)
      endif

      ;; Compute the image position on screen in pixels
      x0 = round(imgposition(0) * !d.x_vsize)
      y0 = round(imgposition(1) * !d.y_vsize)
      dx = round((imgposition(2) - imgposition(0)) * !d.x_vsize) > 1
      dy = round((imgposition(3) - imgposition(1)) * !d.y_vsize) > 1

      ;; Decide which output type
      windowing = (!d.name EQ 'WIN') OR (!d.name EQ 'MAC') OR (!d.name EQ 'X')
      printing = (!d.name EQ 'PRINTER') OR (!d.flags AND 1) NE 0

      ;; Decide whether to resample the image
      rescaling = (windowing OR (!d.name EQ 'Z')) $
        AND ((dx NE nx) OR (dy NE ny))

      ;; If printing, and the printed resolution of the image will be
      ;; too coarse, then we should resample and interpolate
      dpi = min([nx*!d.x_px_cm/dx, ny*!d.y_px_cm/dy]*2.54) ; d.p.i. of image
      dxsize = dx & dysize = dy
      if printing AND (dpi LT min_dpi(0)) then begin
          dx = round(min_dpi(0)*dx/(2.54*!d.x_px_cm)) > nx
          dy = round(min_dpi(0)*dy/(2.54*!d.y_px_cm)) > ny
          interp = 1
          rescaling = 1
      endif

      ;; Rescale the image if needed
      if rescaling then begin
          img = plotimage_resamp(temporary(img), nx, ny, bdepth, $
            dx, dy, interp=interp)
          img = reform(img, dx, dy, bdepth, /overwrite)
      endif

      ;; Generic printer device
      if !d.name EQ 'PRINTER' then begin
          if bdepth EQ 3 then begin
              device, /true_color
              tv, img, x0, y0, xsize=dxsize, ysize=dysize, true=3
          endif else begin
              device, /index_color
              tv, img, x0, y0, xsize=dxsize, ysize=dysize
          endelse
          goto, DONE_IMG
      endif

      ;; Devices with scalable pixels
      if (!d.flags AND 1) NE 0 then begin
          if bdepth EQ 3 then begin
              tvlct, r, g, b, /get
              loadct, 0, /silent
              tv, img, x0, y0, xsize=dxsize, ysize=dysize, true=3
              tvlct, r, g, b
          endif else begin
              tv, img, x0, y0, xsize=dxsize, ysize=dysize
          endelse
          goto, DONE_IMG
      endif

      ;; Get visual depth (in bytes) and decomposed state
      decomposed0 = 0
      vdepth = 1
      version = float(!version.release)
      if windowing then begin

          ;; Visual depth
          if version GE 5.1 then begin
              device, get_visual_depth=vdepth
              vdepth = vdepth / 8
          endif else begin
              if !d.n_colors GT 256 then vdepth = 3
          endelse

          ;; Decomposed state
          if vdepth GT 1 then begin
              if version GE 5.2 then device, get_decomposed=decomposed0
              if bdepth EQ 3 then    device, decomposed=1 $
              else                   device, decomposed=0
          endif
      endif else if !d.name EQ 'Z' then begin
          if !d.n_colors GT 256 then vdepth = 3
      endif

      ;; If visual is 8-bit but image is 24-bit, then quantize
      if vdepth LE 1 AND bdepth EQ 3 then begin
          img = color_quan(temporary(img), 3, r, g, b, colors=ncolors-1, $
                           dither=keyword_set(dither)) + bottom
          tvlct, r, g, b, bottom
          bdepth = 1
      endif

      ;; Put the image
      if bdepth EQ 3 then tv, img, x0, y0, true=3 $
      else                tv, img, x0, y0

      ;; Restore the decomposed state
      if windowing then begin
          if vdepth GT 1 then device, decomposed=decomposed0
          ;; Tupper supplies following work-around for MacIntoshes
          if (!d.name EQ 'MAC') then tv, [0], -1, -1
      endif
  endif

  ;; Plot the axes if requested
  DONE_IMG:
  if NOT keyword_set(noaxes) then begin
      if n_elements(xrange) EQ 0 then begin
          if n_elements(imgxrange) GT 1 then xrange=imgxrange $
          else xrange = [0L, imgxsize]
      endif
      if n_elements(yrange) EQ 0 then begin
          if n_elements(imgyrange) GT 1 then yrange=imgyrange $
          else yrange = [0L, imgysize]
      endif

      plot, xrange, yrange, /noerase, /nodata, /normal, $
        xrange=xrange, yrange=yrange, xlog=xlog, ylog=ylog, $
        xstyle=xstyle OR 1, ystyle=ystyle OR 1, title=title, $
        position=position, _EXTRA=extra
  endif

  return
end

;+
; NAME:
;   PLOTPAN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Same as PLOT command, but respects PANEL and SUBPANEL
;
; CALLING SEQUENCE:
;   PLOTPAN, x, y, ...
;
; DESCRIPTION: 
;
;   PLOTPAN is almost identical to PLOT, except that it accounts for
;   panels and subpanels in the display.  In fact, after a short
;   calculation, PLOTPAN calls PLOT to do its dirty work.
;
;   Once the coordinate grid has been set up by PLOTPAN, other plots
;   can be overlaid by calling OPLOT.
;
; INPUTS:
;
;   X, Y - Two arrays which give the x and y position of each point.
;
; OPTIONAL INPUTS:
;   NONE
;
; INPUT KEYWORD PARAMETERS:
;
;   PANEL, SUBPANEL - An alternate way to more precisely specify the
;                     plot and annotation positions.  See SUBCELL.
;                     Default is full-screen.  Overridden by POSITION.
;
;   Other options are passed along to the PLOT command directly.
;
; OUTPUTS:
;   NONE
;
; PROCEDURE:
;
; EXAMPLE:
;
; SEE ALSO:
;
;   SUBCELL, DEFSUBCELL, SUBCELLARRAY
;
; EXTERNAL SUBROUTINES:
;
;   PLOT, SUBCELL
;
; MODIFICATION HISTORY:
;   Written, CM, 1997
;   Added copyright notice, 25 Mar 2001, CM
;
;  $Id: plotpan.pro,v 1.2 2001/03/25 18:54:31 craigm Exp $
;
;-
; Copyright (C) 1997,2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   PRINTLOG
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Captures transcript of console output
;
; CALLING SEQUENCE:
;   PRINTLOG, d1, d2, ..., FORMAT=, LOG=LOG, /ONLYLOG, UNIT=UNIT
;
; DESCRIPTION: 
;
;   The PRINTLOG procedure provides the ability to print an arbitrary
;   expression to the console or an open file UNIT, and also to
;   capture the text in a "log" or archive.  This archive can be used
;   as a verbatim record of console output, which is especially useful
;   when transactional history records must be maintained.
;
;   The log itself is stored as an array of strings which is passed
;   via the LOG keyword.  PRINTLOG simply adds the current output to
;   the existing array and returns.  When the transaction is complete,
;   the resulting array may be saved or printed as appropriate.  For
;   example, the following set of commands will accumulate a log which
;   can be saved later:
;
;     IDL> x = 0 & y = 1 & u = -17. & v = 12.    ;;; CREATE A LOG
;     IDL> PRINTLOG, X, Y, LOG=LOG
;            0       1
;     IDL> PRINTLOG, U, V, LOG=LOG
;          -17.0000      12.0000
;     IDL> PRINTLOG, 'Computation done.', LOG=LOG
;     Computation done.
;
;     IDL> print, log, format='(A)'              ;;; PRINT THE LOG
;            0       1
;          -17.0000      12.0000
;     Computation done.
;     
;
;   NOTE: Output to the console can be disabled and re-enabled using
;   the DEFAULT_PRINT keyword.  The DEFAULT_PRINT keyword affects the
;   permanent state of PRINTLOG.  When it is set to 0, then *all*
;   subsequent console output will be disabled until DEFAULT_PRINT is
;   reset to 1.  Output will always be logged to the LOG;
;   DEFAULT_PRINT only controls the console output.  This can be
;   useful to have a global switch which determines the governs the
;   console activity of an application.  However, only *one* global
;   control variable is available.
;
; INPUTS:
;
;   d1, d2, ... - the variables or expressions to be printed, as in
;                 the PRINT or PRINTF commands.  A maximum of twenty
;                 parameters are allowed.
;
; KEYWORDS:
;
;   LOG - input/output keyword, containing the accumulated transaction
;         log.  Upon input, LOG should be an array of strings
;         containing previously accumulated log.  Upon return, LOG
;         will have any new output appended.  If, upon input, LOG is
;         undefined, or contains a single element (-1L or ''), then
;         LOG will be initialized.
;
;   FORMAT - a standard format statement, as used by STRING, PRINT or
;            PRINTF.
;            Default: default output formatting is used.
;
;   UNIT - a file unit to be used for output.  If UNIT is undefined or
;          0, then output is made to the console.
;          Default: undefined (console output).
;
;   ONLYLOG - if set, then output will not be made to the screen, but
;             it will still be archived to LOG.  This may useful to
;             record archane but important dianostic information that
;             normally would not appear to the user.
;
;   DEFAULT_PRINT - Change default behavior of PRINTLOG.  If
;                   DEFAULT_PRINT is 0 then all subsequent printlog's
;                   will *not* be printed to the console, until
;                   DEFAULT_PRINT is reset.  If DEFAULT_PRINT is 1
;                   then all subsequent printlog's will be printed to
;                   the console.
;
;                   Initial default: 1 (print to console)
;                   Default: none (user must explicitly set)
;
; EXAMPLE:
;   See above.
;
; SEE ALSO:
;   PRINT, PRINTF, STRING
;   STATUSLINE - To print temporary status messages to console
;
; MODIFICATION HISTORY:
;   Written, CM, June 1999
;   Documented, CM, 25 Feb 2000
;   Added STATUSLINE to "SEE ALSO," CM, 22 Jun 2000
;   Be more intelligent about growing log if PRINTLOG will be called
;     many times (secret NLOGLINES keyword parameter), CM, Feb 2003
;   Corrected bug if N_PARAMS was larger than 10, (H. Krimm) CM, 13
;     Feb 2003
;   Added DEFAULT_PRINT keyword, CM, 10 Oct 2003
;
; TODO:
;   Have a way to internally store the log, rather than the LOG
;   keyword.
;
;  $Id: printlog.pro,v 1.5 2003/11/24 00:08:23 craigm Exp $
;
;-
; Copyright (C) 2000, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;  if NOT keyword_set(nocatch) then on_error, 2
  if np GT 20 then $
    message, 'ERROR: number of parameters to PRINTLOG cannot exceed 20'
  cmd = string(lindgen(np)+1, $
               format='("str = string(",50("D",I0,:,","))')
  if n_elements(format) GT 0 then cmd = cmd + ",format=format(0))" $
  else cmd = cmd + ")"

  if n_elements(nloglines) LT 1 then begin
      nloglines = n_elements(log)
  endif else begin
      nloglines = nloglines(0)
  endelse
  if nloglines GT n_elements(log) then $
    nloglines = n_elements(log)

  str = ''
  result = execute(cmd)
  if result NE 1 then return
  if n_elements(unit) EQ 0 then unit = 0

  ;; Whether or not to print to the screen... governed by evil secret
  ;; common block.
  logonly = NOT default_print
  if n_elements(logonly0) GT 0 then logonly = keyword_set(logonly0)

  if NOT logonly then begin
      if unit ne 0 then printf, unit, str, format='(A)' $
      else              print, str, format='(A)'
  endif

  first = 0
  if nloglines EQ 0 then first = 1
  sz = size(log)
  if nloglines EQ 1 then if sz(sz(0)+1) NE 7 then $
    if long(log(0)) EQ -1 then first = 1
  if nloglines EQ 1 then if sz(sz(0)+1) EQ 7 then $
    if log(0) EQ '' then first = 1

  if first then begin
      log = [str]
      nloglines = n_elements(log)
  endif else begin
      ;; Add elements to an existing list
      nneeded = nloglines + n_elements(str)
      if nneeded GT n_elements(log) then begin
          ;; Number of entries to add, plus some sanity checking
          nadd = n_elements(log) > 64L < 2048L
          nadd = nadd > (nneeded-n_elements(log))
          if arg_present(nloglines) EQ 0 then $
            nadd = nneeded - n_elements(log)
          olog = temporary(log)
          log = strarr(n_elements(olog)+nadd)
          log(0) = temporary(olog)
      endif

      ;; Insert the items into the array
      log(nloglines) = str
      nloglines = nloglines + n_elements(str)
  endelse

  return
end
;+
; NAME:
;   PROFREE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Free the pointers associated with an PRODIS abstract syntax tree
;
; CALLING SEQUENCE:
;   PROFREE, TREE
;   
; DESCRIPTION: 
;
;   PROFREE frees the memory and pointers associated with an abstract
;   syntax tree, as returned by PRODIS.  Users should use this
;   procedure when they are finished with an abstract syntax tree and
;   want to release its resources.  The procedure frees all pointers
;   in the tree recursively.
;
; INPUTS:
;
;   TREE - the abstract syntax tree to be freed.  Upon return the
;          contents of TREE will be undefined.
;  
;
; SEE ALSO:
;
;   PRODIS, PROREND, CMSAVEDIR, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000-2002, CM
;   Documented, 19 Mar 2002, CM
;   
;
; $Id: profree.pro,v 1.3 2002/03/19 21:45:02 craigm Exp $
;
;-
; Copyright (C) 2000-2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   PROREND
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Render a PRODIS abstract syntax tree into IDL Language Text
;
; CALLING SEQUENCE:
;   PROREND, TREE, TEXT, [ /INIT ]
;
; DESCRIPTION: 
;
;   PROREND converts an abstract syntax tree as returned by PRODIS,
;   into a human-readable form, written in the IDL programming
;   language.  The abstract syntax tree format is a set of linked data
;   structures, and is derived from the raw data on disk.  The human
;   readable form is returned as an array of strings that can be
;   printed to the console or a file.
;
;   The abstract syntax tree is generated by PRODIS, an external
;   procedure in the same library.  The standard approach is to use
;   the following steps:
;
;       1. Use PRODIS to convert raw bytes to abstract syntax tree
;       2. Use PROREND to convert abstract syntax tree to IDL language
;
;   The external routine PROTRANS does the end-to-end conversion steps
;   of both PRODIS and PROREND for you.
;
;   At the moment there is relatively little flexibility in how the
;   IDL code is rendered to text.  For example, all reserved keywords
;   and variables appear in upper-case letters, and array indexing
;   syntax is expressed with round ()'s instead of square []'s.
;   Suggestions on how to achieve this are solicited.
;
;   PROREND does not free the TREE structure.  The user is responsible
;   to do this using the PROFREE procedure.
;   
;
; COMPATIBILITY:
;
;   -- File Format --
;
;   PROREND accepts any tree provided by PRODIS.  PRODIS cannot
;   examine compressed save files.  It is able to read and translate
;   SAVE files produced by IDL 4, and IDL versions 5.0 through 5.5.
;   The output of PROREND should be compatible with IDL 4 and 5.
;
;   This procedure is part of the CMSVLIB SAVE library for IDL by
;   Craig Markwardt.  You must have the full CMSVLIB core package
;   installed in order for this procedure to function properly.
;
; INPUTS:
;
;   TREE - the abstract syntax tree, as returned by PRODIS.  This
;          structure is unmodified by PROREND.
;
;   TEXT - upon output, the IDL code is placed in as an array of
;          strings in TEXT.  By default, any new IDL code will be
;          *appended* to TEXT.  Use the /INIT keyword to overwrite the
;          existing contents of TEXT.
;
;
; KEYWORDS:
;
;   INIT - if set, then overwrite the TEXT array with the new IDL
;          code.  By default (INIT not set), any new IDL code is
;          *appended* to TEXT.
;  
; EXAMPLE:
;
;   This example compiles a test function, saves it to a file called
;   test_pro.sav, and then disassembles the save file into a syntax
;   tree using PRODIS.  Finally, the syntax tree is converted to IDL
;   text, which is printed to the console.
;
;     IDL> .comp 
;     - pro test_pro, x
;     -   x = x + 1
;     -   return
;     - end
;     % Compiled module: TEST_PRO.
;     IDL> save, 'test_pro', /routine, file='test_pro.sav'
;     IDL> prodis, 'test_pro.sav', prodecl, tree
;     IDL> prorend, tree, text
;     IDL> print, text, format='(A)'
;     PRO TEST_PRO, X
;       ;; Beginning of code
;       X = X+1
;       RETURN
;     END
;
;
; SEE ALSO:
;
;   PRODIS, PROREND, CMSAVEDIR, CMSVLIB
;
; MODIFICATION HISTORY:
;   Written, 2000-2002, CM
;   Documented, 19 Mar 2002, CM
;   Added PRN_STRCAT, to avoid an internal library function, 22 Mar
;     2002, CM
;   
;
; $Id: prorend.pro,v 1.13 2002/03/22 22:01:11 craigm Exp $
;
;-
; Copyright (C) 2000-2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Utility function: concatenate string array
function prn_strcat, strings, joinstring=joinstring

  if n_elements(strings) EQ 0 then return, ''
  if n_elements(strings) EQ 1 then return, strings(0)

  n_strings = n_elements(strings)
  
  fmt = '('+strtrim(n_strings,2)+'(A,:))'
  mystrings = strings
  if n_strings GT 1 AND n_elements(joinstring) EQ 1 then $
    mystrings(0:n_strings-2) = mystrings(0:n_strings-2) + joinstring(0)

  return, (string(mystrings, format=fmt))(0)
end

;; Utility function: push a value onto the stack
pro prn_push, stack, val, nstack=nstack, template=node0
  nvals = n_elements(val)
  if n_elements(nstack) EQ 0 then nstack = n_elements(stack)
  if n_elements(val) EQ 0 then return

  n2 = nvals + nstack
  if n_elements(stack) LT n2 then begin
      if n_elements(node0) EQ 0 then node0 = ''
      if n_elements(stack) EQ 0 then begin
          stack = replicate(node0(0), (n_elements(val)*2) > 10)
      endif else begin
          stack = [stack, replicate(node0(0),((n2-nstack)*5) > 10) ]
      endelse
  endif
  
  stack(nstack) = val
  nstack = n2
  return
end

;; Utility function: extract operand from tree
function prn_opn, prodecl, ptr, type=type, embed=embed, last_operation=lastop

  if n_elements(ptr) EQ 0 then return, ''

  sz = size(ptr)
  if sz(sz(0)+1) EQ 10 then begin
      if ptr_valid(ptr(0)) EQ 0 then return, ''
      x = *ptr
  endif else if sz(sz(0)+1) EQ 8 then begin
      x = ptr
  endif else begin
      return, ''
  endelse

  ntext1 = 0L
  prn_parse, prodecl, x, text1, nstack=ntext1, last_operation=lastop

  type = x(0).type
  op = text1(ntext1-1)

  if keyword_set(embed) then begin
      if (type AND 7) EQ 0 then op = '('+op+')'
  endif
    
  return, op
end

;; NODE: 'RETURN'
function prn_return, prodecl, tree

  str = 'RETURN'

  if ptr_valid(tree(0).operands(0)) then $
    str = str + ', ' + prn_opn(prodecl, tree(0).operands(0))
  
  return, str
end

;; NODE: 'UNOP' or 'BINOP'
function prn_ubop, prodecl, tree, binop=binop, unop=unop

  opn0 = prn_opn(prodecl, tree(0).operands(0), type=type0, /embed)
  op = tree(0).value

  ;; Spaces between operands and operation
  sp = ''
  b = (byte(op(0)))(0)
  ;; For alpha op, add space
  if b GE '41'xb AND b LE '7a'xb then sp = ' ' 

  if keyword_set(binop) then begin
      opn1 = prn_opn(prodecl, tree(0).operands(1), type=type1, /embed)

      if sp EQ '' AND (op EQ '+' OR op EQ '-') then begin
          l = strmid(opn0, strlen(opn0)-1, 1)
          ;; Trailing D or E must not be confused with coming + or -
          if l EQ 'D' OR l EQ 'E' then sp = ' '
      endif

      return, opn0+sp+op+sp+opn1
  endif else if keyword_set(unop) then begin
      return, op+sp+opn0
  endif

  return, ''
end

;; NODE: 'ASSIGN'
pro prn_assign, prodecl, tree, text, nstack=ntext, prefix=prefix
  if n_elements(prefix) EQ 0 then prefix = ''
  if (tree(0).type AND 8) NE 0 then pf = prefix else pf = ''

  opn0 = prn_opn(prodecl, tree(0).operands(0), type=type0)
  opn1 = prn_opn(prodecl, tree(0).operands(1), type=type1)

  ;; Nested assignments must be protected
  if (type1 AND 8) NE 0 then $
    opn1 = '('+opn1+')'

  prn_push, text, pf+opn0+' = '+opn1, nstack=ntext
  return
end

;; NODE: 'SUBSCRIPT' (subscripted variable)
function prn_subscript, prodecl, tree, text, nstack=ntext
  lval = prn_opn(prodecl, tree(0).operands(0), type=type0, /embed)
  ;; Protect against functions being subscripted
  if (type0 AND 4) NE 0 then lval = '('+lval+')'

  ndims = long(tree(0).value)
  dims = *(tree(0).operands(1))

  dimstr = strarr(ndims)

  for i = 0, ndims-1 do begin
      v = dims(i).value
      case dims(i).op of
          'SUB': begin      ;; Single value '*'
              if v EQ 'ALL' then dimstr(i) = '*'
          end
          'SUBRANGE': begin ;; Range of values, either A:B or A:*
              opn1 = prn_opn(prodecl, dims(i).operands(0))
              if (*dims(i).operands(1)).value EQ 'END' then $
                opn2 = '*' $
              else $
                opn2 = prn_opn(prodecl, dims(i).operands(1))
              dimstr(i) = opn1+':'+opn2
          end
          ELSE: begin       ;; Single value A
              dimstr(i) = prn_opn(prodecl, dims(i))
          end
      endcase
  endfor

  ;; Compose lval with dimensions
  return, lval+'('+prn_strcat(dimstr, join=',')+')'
end

;; NODE: 'PROCALL' or 'METHCALL'
pro prn_procall, prodecl, tree, text, nstack=ntext, prefix=prefix, $
                 method=meth, funct=funct, statement=stmt

  if n_elements(prefix) EQ 0 then prefix = ''

  ;; Basics about the function or procedure
  proname = tree(0).value
  protype = tree(0).type
  funct = (protype AND 4) NE 0
  stmt = (funct EQ 0)

  ;; Handle case of a class method
  if keyword_set(meth) then begin
      dest = prn_opn(prodecl, tree(0).operands(0), type=dtype)
      if (dtype AND 3) EQ 0 then dest = '('+dest+')'
      proname = dest + '->' + proname
      args = tree(0).operands(1)
  endif else begin
      args = tree(0).operands(0)
  endelse

  ;; Append arguments, both positional and keyword ones
  argstr = ''
  nargs = n_elements(*(args))
  if nargs GT 0 then begin
      args = *(args)
      argstr = strarr(nargs)
      for i = 0, nargs-1 do begin
          if args(i).op EQ 'KEYWORD' then begin
              kword = args(i).value
              argstr(i) = kword+'='+prn_opn(prodecl, args(i).operands(0))
          endif else begin
              argstr(i) = prn_opn(prodecl, args(i))
          endelse
      endfor
      argstr = prn_strcat(argstr, join=', ')
  endif

  ;; Express as the form as a function or a procedure
  if funct then begin
      proval = proname+'('+argstr+')'
  endif else begin
      if argstr EQ '' then $
        proval = proname $
      else $
        proval = proname+', '+argstr
  endelse

  if stmt then proval = prefix+proval
  prn_push, text, proval, nstack=ntext
end

;; NODE: 'ARRAY'  (square-brackets style array)
function prn_array, prodecl, tree
  elts = tree(0).operands(0)
  if n_elements(*elts) EQ 0 then return, '[]'
  nelts = n_elements(*elts)
  elts = *elts
  eltstr = strarr(nelts)
  
  for i = 0, nelts-1 do begin
      eltstr(i) = prn_opn(prodecl, elts(i))
  endfor

  return, '['+prn_strcat(eltstr,join=', ')+']'
end

;; NODE: 'PDEREF' (pointer dereference)
function prn_pderef, prodecl, tree
  opn = prn_opn(prodecl, tree(0).operands(0), type=type0)
  if (type0 AND 2) EQ 0 then opn = '('+opn+')'
  return, '*'+opn
end

;; NODE: 'FOR' (for-loop construct)
pro prn_for, prodecl, tree, text, nstack=ntext, prefix=prefix
  if n_elements(prefix) EQ 0 then prefix = ''
  
  lval = prn_opn(prodecl, tree(0).operands(0))

  ;; Parse START, STOP, STEP range values
  rng  = *(tree(0).operands(1))
  nrng = n_elements(rng)
  rngstr = strarr(nrng)
  for i = 0, nrng-1 do $
    rngstr(i) = prn_opn(prodecl, rng(i))
  rngstr = prn_strcat(rngstr, join=', ')

  ;; Parse body of FOR loop
  body = *(tree(0).operands(2))
  prn_parse, prodecl, body, bodytext, nstack=nbodytext, prefix=''

  ;; Choose long or short form for FOR loop
  if nbodytext EQ 1 then begin
      prn_push, text, nstack=ntext, $
        prefix+'FOR '+lval+' = '+rngstr+' DO '+bodytext(0)
  endif else begin
      prn_push, text, nstack=ntext, $
        prefix+'FOR '+lval+' = '+rngstr+' DO BEGIN'
      if nbodytext GT 0 then $
        prn_push, text, nstack=ntext, $
        prefix+'    '+bodytext(0:nbodytext-1)
      prn_push, text, nstack=ntext, $
        prefix+'ENDFOR'
  endelse
      
  return
end

;; NODE: 'IF' (if-then-else construct)
pro prn_if, prodecl, tree, text, nstack=ntext, prefix=prefix
  if n_elements(prefix) EQ 0 then prefix = ''
  expr = prn_opn(prodecl, tree(0).operands(0))

  ;; Extract body of the IF clause
  if ptr_valid(tree(0).operands(1)) GT 0 then begin
      if n_elements(*(tree(0).operands(1))) EQ 0 then $
        goto, NOIFBODY
      ifbody = *(tree(0).operands(1))
      prn_parse, prodecl, ifbody, ifbodytext, nstack=nifbodytext, prefix=''
  endif else begin
      NOIFBODY:
      ifbodytext = ''
      nifbodytext = 0L
  endelse

  ;; Extract body of the ELSE clause
  if ptr_valid(tree(0).operands(2)) GT 0 then begin
      if n_elements(*(tree(0).operands(2))) EQ 0 then $
        goto, NOELBODY
      elbody = *(tree(0).operands(2))
      prn_parse, prodecl, elbody, elbodytext, nstack=nelbodytext, prefix=''
  endif else begin
      NOELBODY:
      elbodytext = ''
      nelbodytext = 0L
  endelse

  if nifbodytext EQ 1 AND nelbodytext LE 1 then begin
      ;; Case of "IF expr THEN stmt ELSE stmt"
      ifstr = 'IF '+expr+' THEN '+ifbodytext(0)
      if nelbodytext GT 0 then $
        ifstr = ifstr + '   ELSE   '+elbodytext(0)
      prn_push, text, nstack=ntext, $
        prefix+ifstr
  endif else begin
      ;; Case of "IF epxr THEN BEGIN & stmts & ENDIF ..."
      prn_push, text, nstack=ntext, $
        prefix+'IF '+expr+' THEN BEGIN'
      if nifbodytext GT 0 then $
        prn_push, text, nstack=ntext, $
        prefix+'    '+ifbodytext(0:nifbodytext-1)
      if nelbodytext EQ 0 then begin
          prn_push, text, nstack=ntext, $
            prefix+'ENDIF'
      endif else begin
          ;; "... ELSE BEGIN & stmts & ENDELSE"
          prn_push, text, nstack=ntext, $
            prefix+'ENDIF ELSE BEGIN'
          prn_push, text, nstack=ntext, $
            prefix+'    '+elbodytext(0:nelbodytext-1)
          prn_push, text, nstack=ntext, $
            prefix+'ENDELSE'
      endelse
  endelse          

  return
end

;; NODE: 'WHILE' (while-loop construct)
pro prn_while, prodecl, tree, text, nstack=ntext, prefix=prefix
  if n_elements(prefix) EQ 0 then prefix = ''
  expr = prn_opn(prodecl, tree(0).operands(0))

  ;; Parse body of WHILE loop
  body = *(tree(0).operands(1))
  prn_parse, prodecl, body, bodytext, nstack=nbodytext, prefix=''

  ;; Choose either long or short form for the WHILE loop
  if nbodytext EQ 1 then begin
      prn_push, text, nstack=ntext, $
        prefix+'WHILE '+expr+' DO '+bodytext(0)
  endif else begin
      prn_push, text, nstack=ntext, $
        prefix+'WHILE '+expr+' DO BEGIN'
      if nbodytext GT 0 then $
        prn_push, text, nstack=ntext, $
        prefix+'    '+bodytext(0:nbodytext-1)
      prn_push, text, nstack=ntext, $
        prefix+'ENDWHILE'
  endelse

  return
end

;; NODE: 'TRICOND' (triple condition of the form TEST ? A : B)
function prn_tricond, prodecl, tree
  expr   = prn_opn(prodecl, tree(0).operands(0), type=type0, /embed)
  ifstmt = prn_opn(prodecl, tree(0).operands(1), type=type1, /embed)
  elstmt = prn_opn(prodecl, tree(0).operands(2), type=type2, /embed)

  return, expr+'?'+ifstmt+':'+elstmt
end

;; NODE: 'ON_IOERROR'
function prn_onioerror, prodecl, tree
  mark = 'MARK$'+strtrim(tree(0).value)
  if tree(0).value EQ '0' then mark = 'NULL'
  return, 'ON_IOERROR, '+mark
end

;; NODE: 'STRUCTREF' (reference to a structure
function prn_structref, prodecl, tree
  lval = prn_opn(prodecl, tree(0).operands(0), type=type0, /embed)
  ;; Protect against functions being structref'd
  if (type0 AND 4) NE 0 then lval = '('+lval+')'

  ;; Error checking
  tags = tree(0).operands(1)
  if ptr_valid(tags) EQ 0 then return, lval
  if n_elements(*tags) EQ 0 then return, lval

  ;; Chain the structure references together, using PRN_OPN to
  ;; recurse.
  ntags = long(tree(0).value)
  tags = *tags
  tagstr = strarr(ntags)
  for i = 0, ntags-1 do begin
      tag = tags(i)
      tagval = prn_opn(prodecl, tags(i), last_op=lastop)
      if lastop NE 'TAGNAME' AND lastop NE 'TAGSUBSCRIPT' then $
        tagval = '('+tagval+')'

      tagstr(i) = tagval
  endfor

  return, prn_strcat([lval, tagstr], join='.')
end

;; NODE: 'STRUCT' (structure definition)
function prn_struct, prodecl, tree

  ;; Extract the tree associated with this structure definition
  if ptr_valid(tree(0).operands(0)) then $
    if n_elements(*tree(0).operands(0)) GT 0 then begin
      tagvals = *tree(0).operands(0)
      ntags = n_elements(tagvals)

      ;; Scan through the branches of the tree, looking for the three
      ;; kinds.
      sstr = strarr(ntags)
      for i = 0, ntags-1 do begin
          case tagvals(i).op of
              'TAGNAME': sstr(i) = tagvals(i).value+':'
              'TAGVAL': begin
                  if tagvals(i).value NE '' then $
                    sstr(i) = tagvals(i).value+': '
                  sstr(i) = sstr(i) + prn_opn(prodecl, tagvals(i).operands(0))
              end
              'INHERITS': sstr(i) = 'INHERITS '+tagvals(i).value
          endcase
      endfor
  endif

  ;; Add the structure name if it is not an anonymous structure
  if tree(0).value NE '' then begin
      if n_elements(sstr) GT 0 then begin
          sstr = [tree(0).value, sstr]
      endif else begin
          sstr = [tree(0).value]
      endelse
  endif
  if n_elements(sstr) EQ 0 then sstr = ''

  return, '{'+prn_strcat(sstr, join=', ')+'}'
end

;; NODE: 'CASE' (case-of construct)
pro prn_case, prodecl, tree, text, nstack=ntext, prefix=prefix
  if n_elements(prefix) EQ 0 then prefix = ''

  ;; Extract test expression
  expr = prn_opn(prodecl, tree(0).operands(0), /embed)
  prn_push, text, nstack=ntext, $
    prefix+'CASE '+expr+' OF'

  ;; Scan through possible branches of the CASE statement
  ncases = long(tree(0).value)
  if ncases GT 0 AND ptr_valid(tree(0).operands(1)) EQ 1 then begin
      cases = *(tree(0).operands(1))
      for i = 0, ncases-1 do begin

          nbodytext = 0L
          ibody = 1L
          if cases(i).op EQ 'CASEVAL' then begin
              ;; Standard branch
              caseval  = prn_opn(prodecl, cases(i).operands(0), /embed)
          endif else if cases(i).op EQ 'CASEELSE' then begin
              ;; The ELSE (default) branch
              caseval = 'ELSE'
              ibody = 0
          endif else begin
              caseval = ''
          endelse

          ;; Extract the block of code associated with this branch
          if ptr_valid(cases(i).operands(ibody)) then $
            if n_elements(*cases(i).operands(ibody)) GT 0 then $
            prn_parse, prodecl, *cases(i).operands(ibody), $
            bodytext, nstack=nbodytext, prefix=''
          if nbodytext EQ 0 then bodytext = ''

          ;; Render the text
          if nbodytext GT 1 then begin
              prn_push, text, nstack=ntext, $
                prefix+'  '+caseval+': BEGIN'
              prn_push, text, nstack=ntext, $
                prefix+'    '+bodytext(0:nbodytext-1)
              prn_push, text, nstack=ntext, $
                prefix+'  END'
          endif else begin
              prn_push, text, nstack=ntext, $
                prefix+'  '+caseval+': '+bodytext(0)
          endelse
      endfor
  endif

  prn_push, text, nstack=ntext, $
    prefix+'ENDCASE'

  return              
end

;; Main parse loop of PROREND (called recursively!)
pro prn_parse, prodecl, tree, text, nstack=ntext, prefix=prefix, $
               last_operation=lastop
  if n_elements(prefix) EQ 0 then prefix = ''

  lastop = ''
  for i = 0L, n_elements(tree)-1 do begin
      case tree(i).op of
          'ARRAY': prn_push, text, nstack=ntext, $
            prn_array(prodecl, tree(i))
          'ASSIGN': prn_assign, prodecl, tree(i), text, nstack=ntext, $
            prefix=prefix
          'BINOP': prn_push, text, nstack=ntext, $
            prn_ubop(prodecl, tree(i), /binop)
          'CASE': prn_case, prodecl, tree(i), text, nstack=ntext, prefix=prefix
          'FOR': prn_for, prodecl, tree(i), text, nstack=ntext, prefix=prefix
          'GOTO': prn_push, text, nstack=ntext, $
            prefix+'GOTO, MARK$'+strtrim(tree(i).value)
          'IF': prn_if, prodecl, tree(i), text, nstack=ntext, prefix=prefix
          'IMM': prn_push, text, tree(i).value, nstack=ntext
          'LINE': 
          'LVAL': prn_push, text, tree(i).value, nstack=ntext
          'MARK': prn_push, text, nstack=ntext, $
            strmid(prefix,0,strlen(prefix)-1)+'MARK$'+tree(i).value+':'
          'METHCALL': prn_procall, prodecl, tree(i), text, nstack=ntext, $
            prefix=prefix, /method
          'ON_IOERROR': prn_push, text, nstack=ntext, $
            prefix+prn_onioerror(prodecl, tree(i))
          'PDEREF': prn_push, text, nstack=ntext, $
            prn_pderef(prodecl, tree(i))
          'PROCALL': prn_procall, prodecl, tree(i), text, nstack=ntext, $
            prefix=prefix
          'RETURN': prn_push, text, nstack=ntext, $
            prefix+prn_return(prodecl, tree(i))
          'STOP': prn_push, text, prefix+'STOP', nstack=ntext
          'STRUCT': prn_push, text, nstack=ntext, $
            prn_struct(prodecl, tree(i))
          'STRUCTREF': prn_push, text, nstack=ntext, $
            prn_structref(prodecl, tree(i))
          'SUBSCRIPT': prn_push, text, nstack=ntext, $
            prn_subscript(prodecl, tree(i))
          'TAGNAME': prn_push, text, tree(i).value, nstack=ntext
          'TAGSUBSCRIPT': prn_push, text, nstack=ntext, $
            prn_subscript(prodecl, tree(i))
          'TRICOND': prn_push, text, nstack=ntext, $
            prn_tricond(prodecl, tree(i))
          'UNOP': prn_push, text, nstack=ntext, $
            prn_ubop(prodecl, tree(i), /unop)
          'WHILE': prn_while, prodecl, tree(i), text, nstack=ntext, $
            prefix=prefix
          ELSE: print, 'WARNING: unknown type '+tree(i).op
      endcase
      lastop = tree(i).op
  endfor
end

;; Entry point for PROREND
pro prorend, tree0, text, init=init, mangle=mangle
  if n_params() EQ 0 then begin
      message, 'USAGE:', /info
      message, '  PROREND, TREE, TEXT, /INIT', /info
      return
  endif

  if keyword_set(init) then begin
      text = 0 & dummy = temporary(text)
  endif

  ;; Error checking
  if tag_names(tree0, /structure_name) NE 'PDS_NODE' then begin
      message, 'ERROR: TREE must be an abstract syntax tree'
      return
  endif

  if tree0.op NE 'PRODEF' then begin
      message, 'ERROR: head of TREE must be PRODEF node'
      return
  endif

  pnode = *(tree0.operands(0))
  if pnode.op NE 'PRODECL' then begin
      NO_PRODECL:
      message, 'ERROR: TREE has no PRODECL node'
      return
  endif

  if ptr_valid(pnode.operands(0)) then $
    if n_elements(*(pnode.operands(0))) GT 0 then $
    prodecl = *(pnode.operands(0))
  if n_elements(prodecl) EQ 0 then goto, NO_PRODECL

  ;; Assume everything is hunky-dorey from here on out
  tree = *(tree0.operands(1))

  ntext = n_elements(text)
  n_symbols = prodecl.n_syms
  n_args = prodecl.n_args

  if n_symbols GT 0 then symbols = prodecl.symbols

  ;; Generate the declaration of the procedure
  if keyword_set(mangle) then mang_str = '_' else mang_str = ''
  decl = prodecl.type + mang_str + ' ' + prodecl.proname
  if n_args GT 0 then begin
      args = prodecl.args
      
      ;; Positional arguments
      wh = where(args EQ '', n_pos)
      if n_pos GT 0 AND prodecl.is_method AND $
        symbols(wh(0)>0).name EQ 'SELF' then begin
          ;; Methods have a hidden argument named SELF
          n_pos = n_pos - 1
          if n_pos GT 0 then wh = wh(1:*)
      endif
      if n_pos GT 0 then begin
          decl = decl + ', '
          fmt = '('+strtrim(n_pos,2)+'(A,:,", "))'
          decl = decl + string(symbols(wh).name, format=fmt)
      endif

      ;; Keyword arguments
      wh = where(args NE '', n_key)
      if n_key GT 0 then begin
          decl = decl + ', '
          fmt = '('+strtrim(n_key,2)+'(A,:,", "))'
          decl = decl + string(args(wh)+'='+symbols(wh).name, format=fmt)
      endif
  endif
  prn_push, text, decl, nstack=ntext

  ;; Declare any common blocks to be used
  if prodecl.n_commons GT 0 then begin
      comstr = strarr(prodecl.n_commons)
      for i = 0L, prodecl.n_commons-1 do begin
          wh = where(symbols.values(0) EQ (i+1),ct)
          if ct GT 0 then begin
              ss = sort(symbols(wh).values(2))
              cnames = symbols(wh(ss)).name
              comstr(i) = '  COMMON ' + prodecl.commons(i).name + ', ' + $
                prn_strcat(cnames, join=',')
          endif
      endfor
      comstr = ['','  ;; Declaration of common blocks',comstr,'']
  endif

  prn_push, text, comstr, nstack=ntext
  prn_push, text, '  ;; Beginning of code', nstack=ntext
  prn_parse, prodecl, tree, text, nstack=ntext, prefix='  '
  prn_push, text, 'END', nstack=ntext

  text = text(0:ntext-1)
  return
end
;+
; NAME:
;   PS_FORM
;
; PURPOSE:
;   This function puts up a form the user can configure a PostScript
;   device driver. The function result (if the user selects either the
;   ACCEPT or CREATE FILE buttons) can be sent directly to the DEVICE
;   procedure by means of its _Extra keyword.  User's predefined
;   configurations may be retrieved from a common block.
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   $Id: ps_form.pro,v 1.5 2004/10/03 09:40:08 craigm Exp $
;
;   Based almost entirely on, but a totally revamped version of, PS_FORM by 
;   FANNING SOFTWARE CONSULTING (David Fanning Ph.D.) http://www.dfanning.com
;
; MAJOR TOPICS:
;   Device Drivers, Hardcopy Output, PostScript Output
;
; PROCEDURE:
;   This is a pop-up form widget. It is a modal or blocking widget.
;   Keywords appropriate for the PostScript DEVICE command are returned.
;
;   Use your LEFT mouse button to move the "Plot Window" around the page.
;   Use your RIGHT mouse button to draw your own "Plot Window" on the page.
;
; HELP:
;   formInfo = PS_FORM(/Help)
;
; CALLING SEQUENCE:
;    formInfo = PS_FORM(xoffset, yoffset, Cancel=cancelButton)
;
; OPTIONAL INPUTS:
;
;    XOFFSET -- Optional xoffset of the top-level base of ps_form. Default is
;    to try to center the form on the display.
;
;    YOFFSET -- Optional yoffset of the top-level base of ps_form. Default is
;    to try to center the form on the display.
;
; INPUT KEYWORD PARAMETERS:
;
;    BITS_PER_PIXEL -- The initial configuration of the bits per pixel button.
;
;    BLOCKING -- Set this keyword to make this a blocking widget under IDL 5.0.
;    (All widget programs block under IDL 4.0.)
;
;    COLOR -- The initial configuration of the color switch.
;
;    DEFAULTS -- A stucture variable of the same type and structure as the
;    RETURN VALUE of ps_form. It will set initial conditions. This makes
;    it possible to start ps_form up again with the same values it had the
;    last time it was called. For example:
;
;       mysetup = ps_form()
;       newsetup = ps_form(Defaults=mysetup)
;
;    ENCAPSULATED -- The initial configuration of the encapsulated switch.
;
;    FILENAME -- The initial filename to be used on the form.
;
;    HELP -- Prints a helpful message in the output log.
;
;    INCHES -- The initial configuration of the inches/cm switch.
;
;    INITIALIZE -- If this keyword is set, the program immediately returns the
;    "localdefaults" structure. This gives you the means to configue the
;    PostScript device without interrupting the user.
;
;    SELECT -- used only when INITIALIZE is set.  Set SELECT to a
;              string which identifies the predefined configuration to
;              be returned by ps_form when INITIALIZE is set.  This is
;              a convenient way to select a predefined config
;              non-interactively.
;
;    LANDSCAPE -- The initial configuration of the landscape/portrait switch.
;
;    LOCALDEFAULTS -- A structure like the DEFAULTS structure. If specified,
;    then it is added as a predefined configuration entry called "Local".
;    See below for a further discussion of predefined configurations.
;
;    PREDEFINED -- An alternate way to specify predefined
;                  configurations.  Pass an array of structures to
;                  populate the "predefined" dropbox in the
;                  dialog. This array, if specified, overrides the the
;                  common block technique.
;
;    XOFFSET -- The initial XOffSet of the PostScript window.
;
;    YOFFSET -- The initial YOffSet of the PostScript window.
;
;    XSIZE -- The initial XSize of the PostScript window.
;
;    YSIZE -- The initial YSize of the PostScript window.
;
;    ASPECT -- The aspect ratio of the window (Y/X).  This keyword can
;              substitute for one of XSIZE or YSIZE.
; 
;    PRESERVE_ASPECT -- Set this keyword if you want to hold the
;                       aspect ratio constant.
;
;    PAPERSIZE -- If set, allows user to specify the size of the paper
;                 media to be printed on, as a scalar string.  NOTE:
;                 this specification cannot be passed to DEVICE, but
;                 can be selected for completeness's sake.  Default is
;                 'Letter'.
;
;    MARGINSIZE -- Size of the margins on all sides.  Default is 0.25 inches.
;                  When MARGINSIZE is non-zero, a graphic cannot directly
;                  abut the edge of the page.  This is normally a good thing,
;                  since there is often a  non-printable region which borders
;                  the page.
;
;   DEFAULTPAPER -- Default paper size to use, when it is unspecified
;                   in a predefined, "local", or "default"
;                   configuration.  This value also overrides any
;                   configuration from common blocks.  European users
;                   will probably set this to 'A4'.
;
;   PARENT -- if this widget is invoked by another widget program,
;             then this keyword parameter must be set to the top level
;             widget which is to serve as the group leader.  Failure
;             to do so will result in unexpected behavior.  IDL 4
;             programs do not need to pass this parameter.  Default:
;             NONE.
;
; OUTPUT KEYWORD PARAMETERS
;
;    CANCEL -- This is an OUTPUT keyword. It is used to check if the user
;    selected the "Cancel" button on the form. Check this variable rather
;    than the return value of the function, since the return value is designed
;    to be sent directly to the DEVICE procedure. The varible is set to 1 if
;    the user selected the "Cancel" button. Otherwise, it is set to 0.
;
;    CREATE -- This output keyword can be used to determine if the user
;    selected the 'Create File' button rather than the 'Accept' button.
;    The value is 1 if selected, and 0 otherwise.
;
;    PAPERSIZE -- If set to a named variable, any newly selected paper
;    size is returned in that variable.
;
;    XPAGESIZE -- Size of paper in "X" dimension, in units given by
;                 the returned config structure.
;
;    YPAGESIZE -- Size of paper in "Y" dimension, in units given by
;                 the returned config structure.
;
;    PAGEBOX -- specifies the page rectangle relative to the plot
;               window, in normalized units.  A 4-vector of the form
;               [XLL, YLL, XUR, YUR] is returned, giving the positions
;               of the lower left (LL) and upper right (UR) corners of
;               the page with respect to the plot window.  Thus, the
;               following command:
;
;                    PLOT, x, y, position=PAGEBOX
;
;               will construct a graphic whose plot region exactly
;               fills the page (with no margin around the edges).
;
;               Naturally, the page is usually larger than the
;               graphics window, so the normalized coordinates will
;               usually fall outside the range [0,1].
;
;               However, the bounding box constructed by the
;               Postscript driver includes only the graphics window.
;               Anything drawn outside of it may be clipped or
;               discarded.
;
; RETURN VALUE:
;
;     formInfo = { ps_form_INFO, $
;                  xsize:0.0, $        ; The x size of the plot
;                  xoff:0.0, $         ; The x offset of the plot
;                  ysize:0.0, $        ; The y size of the plot
;                  yoff:0.0 $          ; The y offset of the plot
;                  filename:'', $      ; The name of the output file
;                  inches:0 $          ; Inches or centimeters?
;                  color:0, $          ; Color on or off?
;                  bits_per_pixel:0, $ ; How many bits per image pixel?
;                  encapsulated:0,$    ; Encapsulated or regular PostScript?
;                  isolatin1:0,$       ; Encoded with ISOLATIN1?
;                  landscape:0 }       ; Landscape or portrait mode?
;
; USAGE:
;
;  The calling procedure for this function in a widget program will
;  look something like this:
;
;     info.ps_config = ps_form(/Initialize)
;
;     formInfo = ps_form(Cancel=canceled, Create=create, $
;                          Defaults=info.ps_config)
;
;     IF NOT canceled THEN BEGIN
;        IF create THEN BEGIN
;           thisDevice = !D.Name
;           Set_Plot, "PS"
;           Device, _Extra=formInfo
;
;           Enter Your Graphics Commands Here!
;
;           Device, /Close
;           Set_Plot, thisDevice
;           info.ps_config = formInfo
;        ENDIF ELSE
;           info.ps_config = formInfo
;     ENDIF
;
; MAJOR FUNCTIONS and PROCEDURES:
;
;   None. Designed to work originally in conjunction with XWindow, a
;   resizable graphics window.  [ NOTE: this modified version of
;   ps_form, by Craig Markwardt, is incompatible with the original
;   version of XWINDOW. ]
;
; MODIFICATION HISTORY:
;
;   Based on ps_form of : David Fanning, RSI, March 1995.
;   Major rewrite by: Craig Markwardt, October 1997.
;     - Drawing and updating of form and sample box are now modular
;     - Option of storing more than one predefined postscript configuration
;     - Selection of paper size by name
;     - Access to predfined configurations through (optional) common
;       block
;   Several additions, CM, April 1998  VERSION CM2.0
;     - better integration of paper sizes throughout program.
;       Predefined configurations now also know about paper.
;     - allow passing predefined configurations instead of using
;       common block
;     - addition of ISOLATIN selection, and streamlining of dialog
;       appearance
;   Fixed bug in INITIALIZE w.r.t. paper sizes, CM, Nov 1998
;   Added SELECT keyword, CM, 09 Dec 1998
;   Added Parent keyword to allow modal widgets in IDL 5, 19 Jan 1999
;   Added "Choose" button for filename selection, 19 Sep 1999
;   Added ability to program different button names, 19 Sep 1999
;   Added ASPECT and PRESERVE_ASPECT, based on work by Aaron Barth, 18
;     Oct 1999
;   Removed NOCOMMON documentation and logic, 19 Oct 1999, CM
;   Added aspect to ps_form_numevents (per Aaron Barth), 18 Oct 1999
;   Corrected small bug under Initialize keyword (inches), 18 Oct 1999
;   Made call to *_pscoord more consistent, 18 Oct 1999
;   Added XPAGESIZE, YPAGESIZE and PAGEBOX keywords, 19 Oct 1999
;   Small cosmetic cleanup, CM, 01 Feb 2000
;   Fix for IDL 5.5's handling of structures with arrays, CM, 11 Dec 2001
;   Replaced obsolete PICKFILE call with DIALOG_PICKFILE, Jeff Guerber,
;     24 Sep 2004
;   Transfer DEFAULTS and LOCALDEFAULTS values via STRUCT_ASSIGN,/NOZERO
;     instead of EXECUTE, Jeff Guerber, 24 Sep 2004.
;   Set CANCELBUTTON and CREATEBUTTON immediately on entry, so they're
;     defined even if user kills the window, Jeff Guerber, 24 Sep 2004.
;
; COMMON BLOCKS:
; 
;   The user may store frequently used or helpful configurations in a 
;   common block, and ps_form() will attempt to access them.  This
;   provides a way for the user to have persistent, named,
;   configurations.
;
;   NOTE: this format has changed since the last version.  You may
;   have to quit your IDL session for the changes to take effect
;   properly.  If you have place a predefined configuration in your
;   startup file, you should review the new format.
;   
;     COMMON PS_FORM_CONFIGS, ps_form_DEFAULT_PAPERSIZE, $
;                               ps_form_STDCONFIGS
;
;        ps_form_DEFAULT_PAPERSIZE - a string designating the default
;                                    paper size, when none is given.
;                                    The predefined configurations
;                                    offerred by this program will
;                                    respect the default value.  (See
;                                    also the DEFAULTPAPER keyword.)
;
;        ps_form_STDCONFIGS - An array of ps_form_CONFIG structures,
;                             each containing information about one
;                             predefined configuration, such as its
;                             name and size of paper.  Each "config"
;                             element is a ps_form_INFO structure,
;                             which contains the actual postscript
;                             configuration.
;
;   See the IDL source code ps_form_LOAD_CONFIGS for an example of how
;   to make a list of configurations.  One possibility would be to
;   declare and populate the common block from within the user's
;   start-up script, allowing the same configurations to appear in
;   every session.
;
;   ps_form() takes its initial list of configurations from this
;   common block if it exists.  A default list is provided ala the
;   procedure ps_form_LOAD_CONFIGS.  Any modifications that take place
;   during the ps_form() widget session are not transferred back to
;   the common block upon return.  It might be useful to be able to do
;   this, through some form of 'save' procedure.
;
;   Also, if the PREDEFINED keyword is used, then the common block is
;   not consulted.
;
;  $Id: ps_form.pro,v 1.5 2004/10/03 09:40:08 craigm Exp $
;
;-
; Copyright (C) 1996-1997, David Fanning
; Copyright (C) 1997-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; ***************************************************************
; Utility routines

forward_function filepath

; Convert from inches and centimeters to WIDGET_DRAW pixels 
pro ps_form_Draw_Coords, drawpixperunit, xoff, yoff, xsize, ysize

  if n_elements(xoff) GT 0 then xoff   = xoff  * drawpixperunit + 1
  if n_elements(yoff) GT 0 then yoff   = yoff  * drawpixperunit + 1
  if n_elements(xsize) GT 0 then xsize = xsize * drawpixperunit
  if n_elements(ysize) GT 0 then ysize = ysize * drawpixperunit

  return
end

; Perform the opposite conversion of ps_form_DRAW_COORDS
pro ps_form_Real_Coords, drawpixperunit, xoff, yoff, xsize, ysize

  if n_elements(xoff) GT 0 then xoff   = (xoff-1) / drawpixperunit
  if n_elements(yoff) GT 0 then yoff   = (yoff-1) / drawpixperunit
  if n_elements(xsize) GT 0 then xsize = xsize / drawpixperunit
  if n_elements(ysize) GT 0 then ysize = ysize / drawpixperunit

  return
end

Pro ps_form_Select_File, event

   ; Allows the user to select a filename for writing.

Widget_Control, event.top, Get_UValue=info, /No_Copy

   ; Start with the name in the filename widget.

Widget_Control, info.idfilename, Get_Value=initialFilename
initialFilename = initialFilename(0)
filename = Dialog_Pickfile(/Write, File=initialFilename)
IF filename NE '' THEN $
   Widget_Control, info.idfilename, Set_Value=filename
Widget_Control, event.top, Set_UValue=info, /No_Copy
END ;*******************************************************************

; Calculate a list of vertices to be plotted as a box in the 
; draw widget.
Function ps_form_PlotBox_Coords, xsize, ysize, xoff, yoff, drawpixperunit

   ; This function converts sizes and offsets to appropriate
   ; Device coordinates for drawing the PLOT BOX on the PostScript
   ; page. The return value is a [2,5] array.

returnValue = IntArr(2,5)
xs = xsize
ys = ysize
xof = xoff
yof = yoff
ps_form_draw_coords, drawpixperunit, xof, yof, xs, ys

; Add one because we do for the page outline
xcoords = Round([xof, xof+xs, xof+xs, xof, xof]) + 1
ycoords = Round([yof, yof, yof+ys, yof+ys, yof]) + 1

returnValue(0,*) = xcoords
returnValue(1,*) = ycoords

RETURN, returnValue
END ;*******************************************************************

; Convert between the IDL-form of PS coordinates (including the 
; strange definition of YOFFSET and XOFFSET) to a more
; "human-readable" form where the Xoffset and YOFFSET always refer to
; the lower-left hand corner of the output
pro ps_form_conv_pscoord, info, xpagesize, ypagesize, $
      toidl=toidl, tohuman=tohuman

  if info.landscape EQ 1 then begin
      ixoff=info.xoff 
      iyoff=info.yoff
      if keyword_set(tohuman) then begin
          info.yoff = ixoff
          info.xoff = xpagesize - iyoff
      endif else if keyword_set(toidl) then begin
          info.xoff = iyoff
          info.yoff = xpagesize - ixoff
      endif
  endif
  return
end

; Return names of paper sizes
function ps_form_papernames

  return, ['Letter','Legal','Tabloid','Ledger','Executive','Monarch', $
            'Statement','Folio','Quarto','C5','B4','B5','Dl','A0','A1', $
            'A2','A3','A4','A5','A6']
end

; Select a paper size based on number or string.  Returns x and 
; y page sizes, accouting for the units of measurement and the
; orientation of the page.
pro ps_form_select_papersize, papertype, xpagesize, ypagesize, $
      inches=inches, landscape=landscape, index=index

;           Letter Legal Tabloid Ledger Executive Monarch Statement Folio
  xpaper = [612.,  612,  792,    792,   540,      279,    396,      612, $
$;          Quarto C5  B4  B5  Dl  A0   A1   A2   A3  A4  A5  A6
	    610,   459,729,516,312,2380,1684,1190,842,595,420,297]

;           Letter Legal Tabloid Ledger Executive Monarch Statement Folio
  ypaper = [792.,  1008, 1224,   1224,  720,      540,    612,      936, $
$;          Quarto C5  B4   B5  Dl  A0   A1   A2   A3   A4  A5  A6
	    780,   649,1032,729,624,3368,2380,1684,1190,842,595,421]
  names  = ps_form_papernames()

  sz = size(papertype)
  tp = sz(sz(0) + 1)
  if tp GT 0 AND tp LT 6 then begin
      index = fix(papertype)
  endif else if tp EQ 7 then begin
      index = where(strupcase(papertype) EQ strupcase(names), ict)
      if ict EQ 0 then index = 0
  endif else $
    index = 0

  index = index(0)

  xpagesize = xpaper(index) / 72.  ; Convert to inches
  ypagesize = ypaper(index) / 72.
  xpagesize = xpagesize(0)
  ypagesize = ypagesize(0)
  if NOT keyword_set(inches) then begin
      xpagesize = xpagesize * 2.54
      ypagesize = ypagesize * 2.54
  endif
  if keyword_set(landscape) then begin
      temp = xpagesize
      xpagesize = ypagesize
      ypagesize = temp
  endif
  
  return
end

; ps_form_LOAD_CONFIGS
;
; Loads a set of default configurations into the output variables,
;
;   CONFIGNAMES - array of names for configurations.
;
;   CONFIGS - array of ps_form_INFO structures, each with a separate
;             configuration in it, and corresponding to the
;             configuration name.
;
; Intended as an intelligent default when no other is specified.
;
pro ps_form_load_configs, defaultpaper, configs

  ; This is the default paper size, when none is given
  defaultpaper = 'Letter'

  ; Here is how the ps_form_INFO structure is defined.  Refer to it
  ; when creating new structures.
  template = { ps_form_INFO, $
               xsize:0.0, $     ; The x size of the plot
               xoff:0.0, $      ; The x offset of the plot
               ysize:0.0, $     ; The y size of the plot
               yoff:0.0, $       ; The y offset of the plot
               filename:'', $   ; The name of the output file
               inches:0, $       ; Inches or centimeters?
               color:0, $       ; Color on or off?
               bits_per_pixel:0, $ ; How many bits per image pixel?
               encapsulated:0,$ ; Encapsulated or regular PostScript?
	       isolatin1:0,$    ; Encoding is not ISOLATIN1
               landscape:0 }    ; Landscape or portrait mode?

  pctemplate = { ps_form_CONFIG,  $
                 config:{ps_form_INFO},  $
                 configname: '', $    ; Name of configuration
                 papersize: '' }      ; Size of paper for configuration
                 
  
  ; Set of default configurations (no ISOLATIN1 encoding)
  ;   1.  7x5    inch color plot region in portrait
  ;   2.  7.5x10 inch centered color plot region, covering almost whole
  ;                   portrait page (0.5 inch margins)
  ;   3.  10x7.5 inch centered color plot region, covering almost whole
  ;                   landscape page (0.5 inch margins)
  ;   4.  7x5    inch gray plot region in portrait (IDL default config)
  configs = [{ps_form_CONFIG, config:$
              {ps_form_INFO, 7.0, 0.75, 5.0, 5.0, 'idl.ps', 1, 1, 8, 0, 0, 0},$
              configname:'Half Portrait (color)', papersize:defaultpaper}, $
             {ps_form_CONFIG, config:$
              {ps_form_INFO, 7.5, 0.50, 10., 0.5, 'idl.ps', 1, 1, 8, 0, 0, 0},$
              configname:'Full Portrait (color)', papersize:defaultpaper}, $
             {ps_form_CONFIG, config:$
              {ps_form_INFO, 10., 0.50, 7.5, 10.5,'idl.ps', 1, 1, 8, 0, 0, 1},$
              configname:'Full Landscape (color)', papersize:defaultpaper}, $
             {ps_form_CONFIG, config:$
              {ps_form_INFO, 18., 1.5, 26.7, 1.5, 'idl.ps', 0, 1, 8, 0, 0, 0},$
              configname:'A4 Portrait (color)', papersize:'A4'}, $
             {ps_form_CONFIG, config:$
              {ps_form_INFO, 26.7, 1.5, 18.,28.2039,'idl.ps',0,1, 8, 0, 0, 1},$
              configname:'A4 Landscape (color)', papersize:'A4'}, $
             {ps_form_CONFIG, config:$
              {ps_form_INFO, 17.78,1.91,12.70,12.70,'idl.ps',0,1, 4, 0, 0, 0},$
              configname:'IDL Standard', papersize:defaultpaper} ]


  return
end

; 
; ps_form_Update_Info
;
; This procedure modifies an "info" structure, according to new
; specifications about the PS configuration.  This is the central
; clearing house for self-consistent modification of the info structure.
;
; INPUTS
;   info    - info structure to be modified
;   keywords- IDL keywords are contain information is folded
;             into the "info" structure.
;             Valid keywords are:
;                XSIZE, YSIZE, 
;                XOFF, YOFF    - size and offset of plotting region in
;                                "human" coordinates.  This is the
;                                natural size as measured from the
;                                lower-left corner of the page in its
;                                proper orientation (not the IDL
;                                definition!).  These are the same
;                                values that are printed in the form's
;                                Size and Offset fields.
;                INCHES        - whether dimensions are in inches or
;                                centimeters (1=in, 0=cm)
;                COLOR         - whether output is color (1=y, 0=n)
;                BITS_PER_PIXEL- number of bits per pixel (2,4,8)
;                ENCAPSULATED  - whether output is EPS (1=EPS, 0=PS)
;                LANDSCAPE     - whether output is portrait or
;                                landscape (1=land, 0=port)
;                FILENAME      - output file name (with respect to
;                                current directory)
;
Pro ps_form_Update_Info, info, set=set, _EXTRA=newdata

  if n_elements(newdata) GT 0 then $
    names = Tag_Names(newdata)
  set   = keyword_set(set)
  centerfactor = 1.0

  FOR j=0, N_Elements(names)-1 DO BEGIN
      
      case strupcase(names(j)) of
          'XSIZE':       info.devconfig.xsize    = float(newdata.xsize)
          'YSIZE':       info.devconfig.ysize    = float(newdata.ysize)
          'XOFF':        info.devconfig.xoff     = float(newdata.xoff)
          'YOFF':        info.devconfig.yoff     = float(newdata.yoff)
          'INCHES':      BEGIN
              inches   = fix(newdata.inches)
              if inches NE 0 then inches = 1
              if set NE 1 then begin
                  convfactor = 1.0
                  if info.devconfig.inches EQ 0 AND inches EQ 1 then $
                    convfactor = 1.0/2.54 $ ; centimeters to inches
                  else if info.devconfig.inches EQ 1 AND inches EQ 0 then $
                    convfactor = 2.54 ; inches to centimeters

                  info.devconfig.xsize = info.devconfig.xsize * convfactor
                  info.devconfig.ysize = info.devconfig.ysize * convfactor
                  info.devconfig.xoff  = info.devconfig.xoff  * convfactor
                  info.devconfig.yoff  = info.devconfig.yoff  * convfactor
                  info.xpagesize       = info.xpagesize       * convfactor
                  info.ypagesize       = info.ypagesize       * convfactor
                  info.marginsize      = info.marginsize      * convfactor
                  info.drawpixperunit  = info.drawpixperunit  / convfactor
                    
              endif
                  
              info.devconfig.inches = inches
          end
          
          'LANDSCAPE':   begin
              landscape= fix(newdata.landscape)
              if landscape NE 0 then landscape = 1
              
              if landscape NE info.devconfig.landscape AND $
                set NE 1 then begin
                  temp = info.xpagesize
                  info.xpagesize = info.ypagesize
                  info.ypagesize = temp
                  
                  ; Since the margins are bound to be way out of wack,
                  ; we could recenter here.
                  
                  xsize = info.devconfig.xsize
                  ysize = info.devconfig.ysize

                  centerfactor = 2.0
                  
                  ; We will have to redraw the reserve pixmap
                  info.pixredraw = 1
                  
              endif 
              
              info.devconfig.landscape = landscape
          end
          
          'COLOR':       begin
              info.devconfig.color    = fix(newdata.color)
              if info.devconfig.color        NE 0 then info.devconfig.color = 1
          end
          'ENCAPSULATED':  begin
              info.devconfig.encapsulated = fix(newdata.encapsulated)
              if info.devconfig.encapsulated NE 0 then $
                info.devconfig.encapsulated = 1
          end
          'ISOLATIN1': begin
              info.devconfig.isolatin1 = fix(newdata.isolatin1)
              if info.devconfig.isolatin1 NE 0 then $
                info.devconfig.isolatin1 = 1
          end
          'BITS_PER_PIXEL': begin
              bpp = fix(newdata.bits_per_pixel)
              if bpp LT 1              then bpp = 2
              if bpp GT 2 AND bpp LT 4 then bpp = 4
              if bpp GT 4 AND bpp LT 8 then bpp = 8
              if bpp GT 8              then bpp = 8
              info.devconfig.bits_per_pixel = bpp
          end
          'FILENAME': begin
              if string(newdata.filename) NE info.devconfig.filename then $
                info.filechanged = 1
              info.devconfig.filename = string(newdata.filename)
          end
      endcase
  endfor
  
  ; Now check the sizes and offsets, to be sure they are sane for the 
  ; particular landscape/portrait and inch/cm settings that have been
  ; chosen.
  pgwid = info.xpagesize
  pglen = info.ypagesize
  pgmar = info.marginsize

  if set NE 1 then begin
      info.devconfig.xsize = (pgmar) > info.devconfig.xsize < (pgwid-2.*pgmar)
      info.devconfig.ysize = (pgmar) > info.devconfig.ysize < (pglen-2.*pgmar)
      info.devconfig.xoff  = (pgmar) > info.devconfig.xoff  < (pgwid-info.devconfig.xsize - pgmar)
      info.devconfig.yoff  = (pgmar) > info.devconfig.yoff  < (pglen-info.devconfig.ysize - pgmar)
      if info.devconfig.xsize + info.devconfig.xoff GT (pgwid-pgmar) then $
        info.devconfig.xoff = (pgwid - info.devconfig.xsize) / centerfactor
      if info.devconfig.ysize + info.devconfig.yoff GT (pglen-pgmar) then $
        info.devconfig.yoff = (pglen - info.devconfig.ysize) / centerfactor
  endif

  ; Preserve aspect ratio if necessary
  if (info.preserve_aspect EQ 1) then begin
      sizeratio = info.aspect / (info.ypagesize / info.xpagesize)
      if (sizeratio GE 1) then $
        info.devconfig.xsize = info.devconfig.ysize / info.aspect $
      else $
        info.devconfig.ysize = info.devconfig.xsize * info.aspect
  endif

  return
end

; 
; PRO ps_form_DRAW_BOX
;
; Draw the "sample" box in the draw widget.  If necessary, also
; redraws the backing reserve pixmap.
;
pro ps_form_draw_box, xsize, ysize, xoff, yoff, info

  ; First order of business is to make a new reserve pixmap, if
  ; necessary.

  if info.pixredraw EQ 1 then begin
      
      ; Operate on the pixmap first
      wset, info.idpixwid
      erase
      ; Make background ...
      tv, replicate(info.bkgcolor, info.xpixwinsize, info.ypixwinsize)
      ; ... and page outline
      coords = ps_form_plotbox_coords(info.xpagesize, info.ypagesize, $
                                      0.,0., info.drawpixperunit)
      plots, coords(0,*), coords(1,*), /device, color=info.pagecolor

      info.pixredraw = 0
  endif

  ; Now, we transfer the reserve pixmap to the screen

  wset, info.idwid
  device, copy=[0, 0, info.xpixwinsize, info.ypixwinsize, 0, 0, $
                info.idpixwid]

  ; Finally we overlay the plot region
  coords = ps_form_plotbox_coords(xsize, ysize, xoff, yoff,info.drawpixperunit)
  plots, coords(0,*), coords(1,*), color=info.boxcolor, /device

  return
end

; 
; ps_form_DRAW_FORM
;
; Update the widget elements of the ps_form form, using the INFO structure.
;
; If the NOBOX keyword is set, then the draw widget is not updated.
;
pro ps_form_draw_form, info, nobox=nobox

  ; Draw the DRAW widget if needed
  if NOT keyword_set(nobox) then $
    ps_form_draw_box, info.devconfig.xsize, info.devconfig.ysize, $
    info.devconfig.xoff, info.devconfig.yoff, info

  ; Update the numeric text fields
  xsizestr = strtrim(string(info.devconfig.xsize, format='(F6.2)'), 2)
  ysizestr = strtrim(string(info.devconfig.ysize, format='(F6.2)'), 2)
  xoffstr  = strtrim(string(info.devconfig.xoff, format='(F6.2)'), 2)
  yoffstr  = strtrim(string(info.devconfig.yoff, format='(F6.2)'), 2)

  widget_control, info.idxsize, set_value=xsizestr
  widget_control, info.idysize, set_value=ysizestr
  widget_control, info.idxoff, set_value=xoffstr
  widget_control, info.idyoff, set_value=yoffstr

  widget_control, info.idaspect, set_button=(info.preserve_aspect EQ 1)

  ; Set EPS (encapsulated ps) buttons
  Widget_Control, info.idencap, Set_Button=(info.devconfig.encapsulated EQ 1)

   ; Set color buttons.
  Widget_Control, info.idcolor, Set_Button=(info.devconfig.color EQ 1)

  ; Set inch/cm buttons.
  Widget_Control, info.idinch, Set_Button=(info.devconfig.inches EQ 1)
  Widget_Control, info.idcm,   Set_Button=(info.devconfig.inches EQ 0)

  ; Set bits_per_pixel buttons.
  Widget_Control, info.idbit2, Set_Button=(info.devconfig.bits_per_pixel EQ 2)
  Widget_Control, info.idbit4, Set_Button=(info.devconfig.bits_per_pixel EQ 4)
  Widget_Control, info.idbit8, Set_Button=(info.devconfig.bits_per_pixel EQ 8)
  Widget_Control, info.idbitbase, Sensitive=(info.devconfig.color EQ 1)

  ; Set encoding button
  widget_control, info.idisolatin1, Set_Button=(info.devconfig.isolatin1 EQ 1)

  ; Set default filename.
  Widget_Control, info.idfilename, Get_Value=wfilename
  if string(wfilename(0)) NE info.devconfig.filename then begin
      Widget_Control, info.idfilename, Set_Value=info.devconfig.filename
      ; Put caret at end of pathname text so that filename itself is visible
      Widget_Control, info.idfilename, $
        Set_Text_Select=[ strlen(info.devconfig.filename), 0 ]
  endif

  ; Set protrait/landscape button.
  Widget_Control, info.idland, Set_Button=(info.devconfig.landscape EQ 1)
  Widget_Control, info.idport, Set_Button=(info.devconfig.landscape EQ 0)

  ; Set Paper
  pn = ps_form_papernames()
  xp = strtrim(string(info.xpagesize, format='(F10.2)'),2)
  yp = strtrim(string(info.ypagesize, format='(F10.2)'),2)
  un = 'in'
  if NOT info.devconfig.inches then un = 'cm'

  paperlab = string(pn(info.paperindex), xp, un, yp, un, $
                      format='("   Paper: ",A0," (",A0,A0," x ",A0,A0,")   ")')
  Widget_Control, info.idpaperlabel, set_value=paperlab
  
  return
end

Pro ps_form_Null_Events, event
END ;*******************************************************************

Function ps_form_What_Button_Type, event

   ; Checks event.type to find out what kind of button
   ; was clicked in a draw widget. This is NOT an event handler.

type = ['DOWN', 'UP', 'MOTION', 'SCROLL']
Return, type(event.type)
END ;*******************************************************************

Function ps_form_What_Button_Pressed, event

   ; Checks event.press to find out what kind of button
   ; was pressed in a draw widget.  This is NOT an event handler.

button = ['NONE', 'LEFT', 'MIDDLE', 'NONE', 'RIGHT']
Return, button(event.press)
END ;*******************************************************************

Function ps_form_What_Button_Released, event

   ; Checks event.release to find out what kind of button
   ; was released in a draw widget.  This is NOT an event handler.

button = ['NONE', 'LEFT', 'MIDDLE', 'NONE', 'RIGHT']
Return, button(event.release)
END ;*******************************************************************



;
; ps_form_NUMEVENTS
;
; Events sent to the numeric text field widgets are sent here.  We
; harvest the data values from the text field and update the screen.
;
Pro ps_form_NumEvents, event

   ; If an event comes here, read the offsets and sizes from the
   ; form and draw the appropriately sized box in the draw widget.

Widget_Control, event.top, Get_UValue= info, /No_Copy

   ; Get current values for offset and sizes

Widget_Control, info.idxsize, Get_Value=xsize
Widget_Control, info.idysize, Get_Value=ysize
Widget_Control, info.idxoff, Get_Value=xoff
Widget_Control, info.idyoff, Get_Value=yoff

xsize = xsize(0)
ysize = ysize(0)
xoff = xoff(0)
yoff = yoff(0)

if info.preserve_aspect EQ 1 then begin
    if event.id EQ info.idysize then xsize = ysize / info.aspect $
    else                             ysize = xsize * info.aspect
endif

; Fold this information into the "info" structure
ps_form_update_info, info, xsize=xsize, ysize=ysize, xoff=xoff, yoff=yoff

; Update form and redraw sample box
ps_form_draw_form, info

; Put the info structure back into the top-level base

Widget_Control, event.top, Set_UValue=info, /No_Copy

END ;*******************************************************************


Pro ps_form_Move_Box, event

   ; This is the event handler that allows the user to "move"
   ; the plot box around in the page window. It will set the
   ; event handler back to "ps_form_Box_Events" when it senses an
   ; "UP" draw button event and it will also turn ps_form_Draw_Motion_Events
   ; OFF.

   ; Get the info structure out of the top-level base.

  Widget_Control, event.top, Get_UValue=info, /No_Copy

  whatButtonType = ps_form_What_Button_Type(event)

  dpu = info.drawpixperunit

  ixmin = 0.
  iymin = 0.
  ixsize = info.devconfig.xsize
  iysize = info.devconfig.ysize
  ps_form_draw_coords, dpu, ixmin, iymin, ixsize, iysize
  ; Now ixmin,iymin have the minimum values of x and y, in pixels
  ; ixsize and iysize are the size of the box, in pixels

  ixmax = info.xpagesize
  iymax = info.ypagesize
  ps_form_draw_coords, dpu, ixmax, iymax
  ; ixmax and iymax are the max values of x and y, in pixels

  ; info.ideltx/y contains the offset of the lower left corner of the box,
  ; with respect to the mouse's position
  ixoff = event.x + info.ideltx
  iyoff = event.y + info.idelty

  ; Keep box inside the page
  if ixoff LT ixmin then ixoff = ixmin
  if iyoff LT iymin then iyoff = iymin
  if (ixoff+ixsize) GT ixmax then ixoff = ixmax - ixsize
  if (iyoff+iysize) GT iymax then iyoff = iymax - iysize

  IF whatButtonType EQ 'UP' THEN Begin

      ; When the button is "up" the moving event is over.  We reset the
      ; event function and update the information about the box's position
      
      Widget_Control, info.iddraw, Draw_Motion_Events=0, $ ; Motion events off
        Event_Pro='ps_form_Box_Events' ; Change to normal processing
      
      ps_form_real_coords, dpu, ixoff, iyoff, ixsize, iysize
      
      ; Update the info structure
      ps_form_update_info, info, xoff=ixoff, yoff=iyoff
      ; Draw it
      ps_form_draw_form, info
      
      ; Put the info structure back in the top-level base and RETURN
      Widget_Control, event.top, Set_UValue=info, /No_Copy
      Return

  ENDIF

   ; You come to this section of the code for all events except
   ; an UP button event. Most of the action in this event handler
   ; occurs here.

  ps_form_real_coords, dpu, ixoff, iyoff, ixsize, iysize

  ; Simply draw the new box
  ps_form_draw_box, ixsize, iysize, ixoff, iyoff, info

  ; Put the info structure back into the top-level base.
  Widget_Control, event.top, Set_UValue=info, /No_Copy

END ;*******************************************************************


Pro ps_form_Grow_Box, event

   ; This event handler is summoned when a RIGHT button is clicked
   ; in the draw widget. It allows the user to draw the outline of a
   ; box with the mouse. It will continue drawing the new box shape
   ; until an UP event is detected. Then it will set the event handler
   ; back to ps_form_Box_Events and turn ps_form_Draw_Motion_Events to OFF.

   ; Get the info structure out of the top-level base.

  Widget_Control, event.top, Get_UValue=info, /No_Copy

  whatButtonType = ps_form_What_Button_Type(event)

  dpu = info.drawpixperunit

  ixmin = 0.
  iymin = 0.
  ixsize = info.devconfig.xsize
  iysize = info.devconfig.ysize
  ps_form_draw_coords, dpu, ixmin, iymin, ixsize, iysize
  ; Now ixmin,iymin have the minimum values of x and y, in pixels
  ; ixsize and iysize are the size of the box, in pixels

  ixmax = info.xpagesize
  iymax = info.ypagesize
  ps_form_draw_coords, dpu, ixmax, iymax
  ; ixmax and iymax are the max values of x and y, in pixels

  ; Keep box inside the page
  if event.x LT ixmin then event.x = ixmin
  if event.x GT ixmax then event.x = ixmax
  if event.y LT iymin then event.y = iymin
  if event.y GT iymax then event.y = iymax

  ; Decide on which corner is the lower left (it's arbitrary)
  ixoff  = min([info.imousex, event.x])
  iyoff  = min([info.imousey, event.y])
  ixsize = max([info.imousex, event.x]) - ixoff
  iysize = max([info.imousey, event.y]) - iyoff

  ;; Enforce the aspect ratio
  if info.preserve_aspect EQ 1 then begin
      sizeratio = info.aspect / (info.ypagesize / info.xpagesize)
      if (sizeratio GE 1) then ixsize = iysize / info.aspect $
      else iysize = ixsize * info.aspect
      if info.imousex GT event.x then ixoff = info.imousex - ixsize
      if info.imousey GT event.y then iyoff = info.imousey - iysize
  endif

  IF whatButtonType EQ 'UP' THEN Begin

      ; When the button is "up" the moving event is over.  We reset the
      ; event function and update the information about the box's position

      Widget_Control, info.iddraw, Draw_Motion_Events=0, $ ; Motion events off
        Event_Pro='ps_form_Box_Events' ; Change to normal processing

      ps_form_real_coords, dpu, ixoff, iyoff, ixsize, iysize

      ; Update the info structure
      ps_form_update_info, info, xoff=ixoff, yoff=iyoff, $
        xsize=ixsize, ysize=iysize
      ; Draw it
      ps_form_draw_form, info

      ; Put the info structure back in the top-level base and RETURN
      Widget_Control, event.top, Set_UValue=info, /No_Copy
      Return
      
  ENDIF

   ; This is the portion of the code that handles all events except for
   ; UP button events. The bulk of the work is done here. Basically,
   ; you need to erase the old box and draw a new box at the new
   ; location. Just keep doing this until you get an UP event.

  ps_form_real_coords, dpu, ixoff, iyoff, ixsize, iysize

  ; Simply draw the new box
  ps_form_draw_box, ixsize, iysize, ixoff, iyoff, info

  ; Put the info structure back in the top-level base.
  Widget_Control, event.top, Set_UValue=info, /No_Copy

END ;*******************************************************************



; 
; Buttondown events sent to this procedure at first.  This is sets up
; the initial move/drag elements and hands off the events to the more
; specialized procedures ps_form_grow_box and ps_form_move_box above.
;
Pro ps_form_Box_Events, event

  whatButtonType = ps_form_What_Button_Type(event)
  IF whatButtonType NE 'DOWN' THEN Return

  ; Get info structure out of TLB

  Widget_Control, event.top, Get_UValue=info, /No_Copy

  whatButtonPressed = ps_form_What_Button_Pressed(event)

  dpu = info.drawpixperunit
  ixmin = 0.
  iymin = 0.
  ixsize = info.devconfig.xsize
  iysize = info.devconfig.ysize
  ps_form_draw_coords, dpu, ixmin, iymin, ixsize, iysize
  ixmax = info.xpagesize
  iymax = info.ypagesize
  ps_form_draw_coords, dpu, ixmax, iymax
  ixoff = info.devconfig.xoff
  iyoff = info.devconfig.yoff
  ps_form_draw_coords, dpu, ixoff, iyoff

  if event.x LT ixmin OR event.x GT ixmax $
    OR event.y LT iymin OR event.y GT iymax then begin
      widget_control, event.top, set_uvalue=info, /no_copy
      return
  endif
  
  CASE whatButtonPressed OF
      
      'RIGHT': Begin
          
         ; Resize the plot box interactively. Change the event handler
         ; to ps_form_Grow_Box. All subsequent events will be handled by
         ; ps_form_Grow_Box until an UP event is detected. Then you will
         ; return to this event handler. Also, turn motion events ON.
          
          Widget_Control, event.id, Event_Pro='ps_form_Grow_Box', $
            Draw_Motion_Events=1
          
          ps_form_draw_box, 1./dpu, 1./dpu, ixoff, iyoff, info
          
          info.imousex = event.x
          info.imousey = event.y
          
      End
      
      'LEFT': Begin
          
         ; Resize the plot box interactively. Change the event handler
         ; to ps_form_Move_Box. All subsequent events will be handled by
         ; ps_form_Move_Box until an UP event is detected. Then you will
         ; return to this  event handler. Also, turn motion events ON.


         ; Only move the box if the cursor is inside the box.
         ;If it is NOT, then RETURN.

          if event.x LT ixoff OR event.x GT (ixoff+ixsize) OR $
            event.y LT iyoff OR event.y GT (iyoff+iysize) then begin 
              
              Widget_Control, event.top, Set_UValue=info, /No_Copy
              Return
          ENDIF
          
       ; Relocate the event handler and turn motion events ON.

          Widget_Control, event.id, Event_Pro='ps_form_Move_Box', $
            Draw_Motion_Events=1
          
          ; ideltx and idelty contain the offset of the lower left 
          ; corner of the plot region with respect to the mouse.
          info.ideltx  = ixoff - event.x
          info.idelty  = iyoff - event.y
          
      End

      ELSE:                     ; Middle button ignored in this program

  ENDCASE

   ; Put the info structure back into the top-level base

  Widget_Control, event.top, Set_UValue=info, /No_Copy

END ;*******************************************************************

; 
; Handle events to the drop-list widgets, which contain predefined
; configurations.
;
pro ps_form_predef_events, event

  name = tag_names(event, /structure_name)
  if strupcase(name) NE 'WIDGET_DROPLIST' then return

   ; Get the info structure out of the top-level base
  Widget_Control, event.top, Get_UValue=info, /No_Copy

  Widget_Control, event.id, Get_UValue=thislist

  ; Pre-read the values from the text fields
  Widget_Control, info.idfilename, Get_Value=filename
  ps_form_update_info, info, filename=filename

  case thislist of
      'PAPER':  info.paperindex = event.index   ; Paper change 
      'PREDEF': begin
          old_filename = info.devconfig.filename         ; Keep old filename
          info.devconfig = info.predefined(event.index)  ; New config
          info.paperindex = info.papersizes(event.index) ; New paper too
          if info.filechanged then $
            info.devconfig.filename = old_filename $
          else begin
              cd, current=thisdir
              l = strlen(thisdir)
              if strmid(info.devconfig.filename, 0, l) NE thisdir then $
                info.devconfig.filename = old_filename $
              else $
                info.devconfig.filename = filepath(info.devconfig.filename, $
                                                   root_dir=thisdir)
          endelse
      end
  endcase

  ; Be sure to select a pristine set of paper
  ps_form_select_papersize, info.paperindex, xpagesize, ypagesize, $
    landscape=info.devconfig.landscape, inches=info.devconfig.inches
  info.xpagesize = xpagesize
  info.ypagesize = ypagesize

  widget_control, info.idpaperlist, set_droplist_select=info.paperindex

  ; Reset the drawpixperunit value
  convfactor = 1.0
  if info.devconfig.inches EQ 0 then convfactor = convfactor * 2.54
  info.marginsize = 0.25 * convfactor

  ; The conversion between length and pixels cannot always be set precisely,
  ; depending on the size of the paper
  dpp = 10.0 / convfactor  ; Desire 10 pixels per inch
  if dpp * info.xpagesize GT info.xpixwinsize OR $
    dpp * info.ypagesize GT info.ypixwinsize then $
    dpp = min( [ float(info.xpixwinsize-2)/info.xpagesize, $
                 float(info.ypixwinsize-2)/info.ypagesize ])
  info.drawpixperunit = dpp
  info.pixredraw = 1

  ; Update the info structure and draw it
  ps_form_update_info, info, xoff=info.devconfig.xoff
  ps_form_draw_form, info

  Widget_Control, event.top, Set_UValue=info, /No_Copy
  return
end

;
; Handle events sent to any of the button elements of the form.
;
Pro ps_form_Event, event

   ; This is the main event handler for ps_form. It handles
   ; the exclusive buttons on the form. Other events on the form
   ; will have their own event handlers.

   ; Get the name of the event structure

  name = Tag_Names(event, /Structure_Name)

   ; Get the User Value of the Button
  Widget_Control, event.id, Get_UValue=thisButton

   ; If name is NOT "WIDGET_BUTTON" or this is not a button
   ; selection event, RETURN.
  nonexclusive = ( thisButton EQ 'ISOLATIN1' OR $
                   thisButton EQ 'COLOR' OR $
                   thisButton EQ 'ENCAPSULATED' OR $
                   thisButton EQ 'ASPECT' )

  IF name NE 'WIDGET_BUTTON' OR $
     (NOT nonexclusive AND event.select NE 1)  THEN Return

   ; Get the info structure out of the top-level base
  Widget_Control, event.top, Get_UValue=info, /No_Copy


  redraw_form = 0
  redraw_box = 0

  ; Pre-read the values from the text fields
  Widget_Control, info.idxsize, Get_Value=xsize
  Widget_Control, info.idysize, Get_Value=ysize
  Widget_Control, info.idxoff, Get_Value=xoff
  Widget_Control, info.idyoff, Get_Value=yoff
  Widget_Control, info.idfilename, Get_Value=filename
  ps_form_update_info, info, filename=filename

   ; Respond appropriately to whatever button was selected
  CASE thisButton OF

      'INCHES': Begin
          ps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          ps_form_update_info, info, inches=1
          redraw_form = 1
      end
          
      'CENTIMETERS': Begin
          ps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          ps_form_update_info, info, inches=0
          redraw_form = 1
      End
      
      'COLOR': Begin
          ps_form_update_info, info, color=(1-info.devconfig.color)
          redraw_form = 1
      End

      'BITS2': Begin
          ps_form_update_info, info, bits_per_pixel=2
          redraw_form = 1
      End

      'BITS4': Begin
          ps_form_update_info, info, bits_per_pixel=4
          redraw_form = 1
      End

      'BITS8': Begin
          ps_form_update_info, info, bits_per_pixel=8
          redraw_form = 1
      End

      'ISOLATIN1': Begin
          ps_form_update_info, info, isolatin1=(1-info.devconfig.isolatin1)
       End

      'ASPECT': begin
          if info.preserve_aspect EQ 0 then $
            info.aspect = info.devconfig.ysize / info.devconfig.xsize
          info.preserve_aspect = (1 - info.preserve_aspect)
      end

      'LANDSCAPE': Begin
          ps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          ps_form_update_info, info, landscape=1
          redraw_form = 1
          redraw_box = 1
      End

      'PORTRAIT': Begin
          ps_form_update_info, info, landscape=0
          ps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          redraw_form = 1
          redraw_box = 1
      End

      'ENCAPSULATED': Begin
          ps_form_update_info, info, encapsulated=(1-info.devconfig.encapsulated)
      End

      'ACCEPT': Begin

         ; The user wants to accept the information in the form.
         ; The procedure is to gather all the information from the
         ; form and then fill out a formInfo structure variable
         ; with the information. The formInfo structure is stored
         ; in a pointer. The reason for this is that we want the
         ; information to exist even after the form is destroyed.

         ; Gather the information from the form

          Widget_Control, info.idfilename, Get_Value=filename
          ps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          ps_form_update_info, info, filename=filename
          widget_control, event.id, get_value=buttonname

          formInfo = { $
                       cancel:0, $            ; CANCEL flag
                       create:0, $            ; CREATE flag
                       buttonname: buttonname, $
                       xpagesize:info.xpagesize, $
                       ypagesize:info.ypagesize, $
                       paperindex:info.paperindex, $
                       result:info.devconfig $; Results are ready-made
                     }

          goto, FINISH_DESTROY
      End

      'CREATE': Begin

          Widget_Control, info.idfilename, Get_Value=filename
          ps_form_update_info, info, xsize=xsize, ysize=ysize, $
            xoff=xoff, yoff=yoff
          ps_form_update_info, info, filename=filename

          formInfo = { $
                       cancel:0, $            ; CANCEL flag
                       create:1, $            ; CREATE flag
                       buttonname: 'Create File', $ 
                       xpagesize:info.xpagesize, $
                       ypagesize:info.ypagesize, $
                       paperindex:info.paperindex, $
                       result:info.devconfig $; Results are ready-made
                     }

          goto, FINISH_DESTROY

      End

      'CANCEL': Begin

         ; The user wants to cancel out of this form. We need a way to
         ; do that gracefully. Our method here is to set a "cancel"
         ; field in the formInfo structure.
          formInfo = {cancel:1, create:0}

          goto, FINISH_DESTROY
      End

  ENDCASE

  if redraw_form EQ 1 then $
    ps_form_draw_form, info, nobox=(1-redraw_box)

   ; Put the info structure back into the top-level base if the
   ; base is still in existence.

  If Widget_Info(event.top, /Valid) THEN $
    Widget_Control, event.top, Set_UValue=info, /No_Copy
  return


  ; We only reach this stage if we are ending the ps_form widget
  ; These commands store the results, restore colors, and destroy
  ; the form widget.
  FINISH_DESTROY:

         ; Put the formInfo structure into the location pointer
         ; to by the pointer
  Handle_Value, info.ptrresult, formInfo, /Set, /No_Copy

         ; Delete the pixmap window
  WDelete, info.idpixwid

         ; Restore the user's color table
  TVLct, info.red, info.green, info.blue

         ; Destroy the ps_form widget program
  Widget_Control, event.top, /Destroy

  return

END ;*******************************************************************

Function ps_form, xoffset, yoffset, Cancel=cancelButton, Help=help, $
     XSize=xsize, YSize=ysize, XOffset=xoff, YOffset=yoff, $
     Inches=inches, Color=color, Bits_Per_Pixel=bits_per_pixel, $
     Encapsulated=encapsulated, Landscape=landscape, Filename=filename, $
     Defaults=defaults, LocalDefaults=localDefaults, Initialize=initialize, $
     select=select, parent=parent, $
     Create=createButton, NoCommon=nocommon, PaperSize=paperSize, $
     button_names=buttons, button_sel=button_sel, $
     PreDefined=predefined, DefaultPaper=defaultpaper, $
     aspect=aspect, preserve_aspect=preserve_aspect, $
     xpagesize=xpagesize, ypagesize=ypagesize, pagebox=pagebox

   ; If the Help keyword is set, print some help information and return

  IF Keyword_Set(help) THEN BEGIN
      Doc_Library, 'ps_form'
      RETURN, 0
  ENDIF

  ; Set cancelButton and createButton as if canceled, so will be defined
  ; (and with appropriate values) even if user kills the window instead of
  ; using the buttons.  Normal exit will reassign them later on.
  cancelButton = 1
  createButton = 0

  ; Load default setups via a common block, if they are available
  if n_elements(predefined) EQ 0 then begin
      common ps_form_configs, ps_form_default_papersize, $
        ps_form_stdconfigs
      if n_elements(ps_form_stdconfigs) GT 0 then $
        predefined = ps_form_stdconfigs
  endif

  ; If the user has not set up a common block, then get some pre
  if n_elements(predefined) EQ 0 then $
    ps_form_load_configs, ps_form_default_papersize, predefined

  ; Transfer to local copies so that we don't overwrite
  confignames = predefined(*).configname
  configs     = predefined(*).config
  configs     = configs(*) ;; IDL 5.5 will make a 1xN array -- collapse it now
  papernames  = predefined(*).papersize
  if n_elements(defaultpaper) EQ 0 $
    AND n_elements(ps_form_default_papersize) GT 0 then $
    defaultpaper = ps_form_default_papersize
  if n_elements(defaultpaper) EQ 0 then $
    defaultpaper = 'Letter'

  papersizes = intarr(n_elements(papernames))

  ; If localdefaults exist, then enter them into a new first entry of 
  ; the configuration list
  if n_elements(localDefaults) NE 0 then begin
      configs     = [ configs(0), configs ]
      confignames = [ 'Local',    confignames ]
      papernames  = [defaultpaper, papernames ]
      papersizes  = [ 0,          papersizes ]

      tmpc = configs(0)
      struct_assign, localdefaults, tmpc, /nozero
      configs(0) = tmpc
  endif


  ; Generate a new entry at the beginning, which will be the initial, 
  ; default configuration.
  configs     = [ configs(0), configs ]
  confignames = [ 'Default',  confignames ]
  papernames  = [defaultpaper, papernames ]
  papersizes  = [ 0,          papersizes ]

  filechanged = 0
  defaultset = 0
  if n_elements(defaults) NE 0 then begin
      defaultset = 1
      tmpc = configs(0)
      struct_assign, defaults, tmpc, /nozero
      configs(0) = tmpc
      void = where( strupcase(Tag_Names(defaults)) EQ 'FILENAME', count )
      if (count NE 0) then filechanged = 1
  endif

  ; Next, enter in the keyword defaults
  IF NOT defaultset OR N_ELEMENTS(inches) GT 0 then begin
      if n_elements(inches) EQ 0 then inches = 1
      configs(0).inches    = keyword_set(inches)
  endif
  IF NOT defaultset OR n_elements(landscape) GT 0 then $
    configs(0).landscape = keyword_set(landscape)
  if NOT defaultset OR n_elements(color) GT 0 then $
    configs(0).color = keyword_set(color)
  if NOT defaultset OR n_elements(encapsulated) GT 0 then $
    configs(0).encapsulated = keyword_set(encapsulated)

  if NOT defaultset OR n_elements(bits_per_pixel) GT 0 then begin
      if n_elements(bits_per_pixel) EQ 0 then bpp = 8 else bpp = bits_per_pixel
      if bpp LT 1              then bpp = 2
      if bpp GT 2 AND bpp LT 4 then bpp = 4
      if bpp GT 4 AND bpp LT 8 then bpp = 8
      if bpp GT 8              then bpp = 8
      configs(0).bits_per_pixel = bpp
  endif
  
  IF N_ELements(filename) EQ 0 THEN BEGIN
      if NOT filechanged then begin
          CD, Current=thisDir
          filename = Filepath('idl.ps', Root_Dir=thisDir)
          filechanged = 0
          configs(0).filename = filename
      endif
  ENDIF else begin
      configs(0).filename = filename
      filechanged = 1
  endelse

  ; Get the size of the page, based on the papersize keyword
  if n_elements(paperSize) GT 1 then begin
      xpagesize = float(paperSize(0))
      ypagesize = float(paperSize(1))
      pind = 0
  endif else begin
      if n_elements(paperSize) EQ 0 then papersize = defaultpaper
      ps_form_select_papersize, papersize, xpagesize, ypagesize, $
        landscape=configs(0).landscape, inches=configs(0).inches, index=pind
  endelse
  
  convfactor = 1.0
  if configs(0).inches EQ 0 then convfactor = convfactor * 2.54
  defmarginsize = 1.50 * convfactor   ; 1 1/2 inch margins default
  
  if N_Elements(marginsize) EQ 0 then $
    marginsize    = 0.25 * convfactor ; 1/4 inch margins "minimum"

  ; "Unconvert" the configuration xoff, yoff, etc. into human-readable format,
  ; which is also the format of the keywords xoff and yoff passed to ps_form()

  nconfigs = n_elements(configs)
  for j = 0, nconfigs-1 do begin
      ps_form_select_papersize, papernames(j), tmpxpg, tmpypg, $
        landscape=configs(j).landscape, inches=configs(j).inches, $
        index=pind

      papersizes(j) = pind
      tmpc = configs(j)
      ps_form_conv_pscoord, tmpc, tmpxpg, tmpypg, /tohuman
      configs(j) = tmpc
  endfor

  if n_elements(aspect) GT 0 then aspect = aspect(0) > .001
  if n_elements(ysize) GT 0 then ysize = ysize(0)
  if n_elements(xsize) GT 0 then xsize = xsize(0)
  if n_elements(xsize) GT 0 AND n_elements(ysize) GT 0 then $
    aspect = ysize / (xsize > (ysize*0.001)) $
  else if n_elements(xsize) GT 0 AND n_elements(aspect) GT 0 then $
    ysize = xsize * aspect $
  else if n_elements(ysize) GT 0 AND n_elements(aspect) GT 0 then $
    xsize = ysize / aspect

  ; Compute an intelligent default X and Y size, if they aren't given
  pageaspect = xpagesize / ypagesize

  if NOT defaultset then begin 
    if n_elements(xsize) EQ 0 AND n_elements(ysize) EQ 0 then begin
        if n_elements(aspect) EQ 0 then begin
            IF !D.Window NE -1 THEN $
              aspect = Float(!D.X_VSize) / !D.Y_VSize $
            ELSE $
              aspect = 1.0
        endif

        if aspect GT 1.0 then BEGIN
            configs(0).xsize = xpagesize-2.0*marginsize
            configs(0).ysize = configs(0).xsize / aspect
        endif else begin
            configs(0).ysize = ypagesize-2.0*marginsize
            configs(0).xsize = configs(0).ysize * aspect
        endelse
    endif
    if n_elements(xsize) EQ 0 then $
      configs(0).xsize = 7.0 * convfactor
    if n_elements(ysize) EQ 0 then $
      configs(0).ysize = 5.0 * convfactor
    if n_elements(xoff)  EQ 0 then $
      configs(0).xoff  = (xpagesize-configs(0).xsize) / 2.0
    if n_elements(yoff)  EQ 0 then $
      configs(0).yoff  = (ypagesize-configs(0).ysize) / 2.0
  
    configs(0).xsize = marginsize>configs(0).xsize<(xpagesize-2.*marginsize)
    configs(0).ysize = marginsize>configs(0).ysize<(ypagesize-2.*marginsize)
    configs(0).xoff  = marginsize>configs(0).xoff <(xpagesize-configs(0).xsize)
    configs(0).yoff  = marginsize>configs(0).yoff <(ypagesize-configs(0).ysize)
  endif

  if keyword_set(preserve_aspect) then begin
      if n_elements(xsize) EQ 0 then xsize = configs(0).xsize
      if n_elements(ysize) EQ 0 then ysize = configs(0).ysize
      aspect = ysize / (xsize > (ysize*0.001))
  endif

  if n_elements(xsize) GT 0 then configs(0).xsize = xsize
  if n_elements(ysize) GT 0 then configs(0).ysize = ysize
  if n_elements(xoff)  GT 0 then configs(0).xoff  = xoff
  if n_elements(yoff)  GT 0 then configs(0).yoff  = yoff
  if n_elements(aspect) EQ 0 then aspect = configs(0).ysize / configs(0).xsize

  ; Return the initialized information, if that's all they were asking
  ; for.  Must convert back to "IDL" coordinates.
  IF Keyword_Set(initialize) THEN BEGIN
      sel = 0
      if n_elements(select) GT 0 then begin
          selen = strlen(select)
          wh = where(strupcase(strmid(confignames,0,selen)) EQ $
                     strupcase(select), ct)
          if ct GT 0 then sel = wh(0)
      endif
      ps_form_select_papersize, papernames(sel), tmpxpg, tmpypg, $
        landscape=configs(sel).landscape, inches=configs(sel).inches
      tmpc = configs(sel)
      xpagesize = tmpxpg & ypagesize = tmpypg
      pagebox = [(0-tmpc.xoff)/tmpc.xsize, $
                 (0-tmpc.yoff)/tmpc.ysize, $
                 (xpagesize-tmpc.xoff)/tmpc.xsize, $
                 (ypagesize-tmpc.yoff)/tmpc.ysize ]
      ps_form_conv_pscoord, tmpc, tmpxpg, tmpypg, /toidl
      cancelButton = 0
      createButton = 0
      return, tmpc
  endif

   ; This program cannot work if the graphics device is already set
   ; to PostScript. So if it is, set it to the native OS graphics device.
   ; Remember to set it back later.

  IF !D.Name EQ 'PS' THEN BEGIN

      oldName = 'PS'
      thisDevice = Byte(!Version.OS)
      thisDevice = StrUpCase( thisDevice(0:2) )
      IF thisDevice EQ 'MAC' OR thisDevice EQ 'WIN' THEN Set_Plot, thisDevice $
      ELSE Set_Plot, 'X'

  ENDIF ELSE oldName = !D.Name

   ; Check for optional offset parameters and give defaults if not passed

  Device, Get_Screen_Size=screenSize
  IF N_Elements(xoffset) EQ 0 THEN xoffset = (screenSize(0) - 600) / 2.
  IF N_Elements(yoffset) EQ 0 THEN yoffset = (screenSize(1) - 400) / 2.
  
  ; The draw widget will have the following dimensions
  xpixwinsize = 174
  ypixwinsize = 174    ; Hopefully will fit 11" x 17" sized paper

  ; The conversion between length and pixels cannot always be set precisely,
  ; depending on the size of the paper
  dpp = 10.0 / convfactor  ; Desire 10 pixels per inch
  if dpp * xpagesize GT xpixwinsize OR dpp * ypagesize GT ypixwinsize then $
    dpp = min( [ float(xpixwinsize-2)/xpagesize, $
                 float(ypixwinsize-2)/ypagesize ])

  ; Start building the widgets
  thisRelease = StrMid(!Version.Release, 0, 1)
  if thisRelease EQ '5' AND n_elements(parent) GT 0 THEN $
    extra_modal = {Modal:1, Group_Leader:parent(0) }
  tlb0 = Widget_Base(Title='Configure PostScript Parameters', Column=1, $
                     XOffset=xoffset, YOffset=yoffset, TLB_Frame_Attr=9, $
                     _EXTRA=extra_modal)

   ; Sub-bases for layout
  tlb = Widget_Base(tlb0, Column=1, Align_Center=1, frame=1)

  sizebase = Widget_Base(tlb, Row=1,  Align_Center=1)

  numbase = Widget_Base(sizebase, Column=1)

      numsub1 = Widget_Base(numbase, Row=1)

         junk = Widget_Label(numsub1, Value=' Units: ')
             junksub = Widget_Base(numsub1, Row=1, /Exclusive)
                inch = Widget_Button(junksub, Value='Inches', UValue='INCHES')
                cm = Widget_Button(junksub, Value='Centimeters', $
                   UValue='CENTIMETERS')

      numsub2 = Widget_Base(numbase, Row=1, Event_Pro='ps_form_NumEvents')

         xbase = Widget_Base(numsub2, Column=1, Base_Align_Right=1)
           x1base = Widget_Base(xbase, Row=1)
             junk   = Widget_Label(x1base, Value='XSize: ')
             xsizew = Widget_Text(x1base, Scr_XSize=60, /Editable, $
                                  Value='')

           x2base = Widget_Base(xbase, Row=1)
             junk  = Widget_Label(x2base, Value='XOffset: ')
             xoffw = Widget_Text(x2base, Scr_XSize=60, /Editable, $
                                 Value='')

         ybase = Widget_Base(numsub2, Column=1, Base_Align_Right=1)
           y1base = Widget_Base(ybase, Row=1)
             junk   = Widget_Label(y1base, Value='YSize: ')
             ysizew = Widget_Text(y1base, Scr_XSize=60, /Editable, $
                      Value='')

           y2base = Widget_Base(ybase, Row=1)
             junk  = Widget_Label(y2base, Value='YOffset: ')
             yoffw = Widget_Text(y2base, Scr_XSize=60, /Editable, $
                                 Value='')

     paperw = Widget_Label(numbase, $
       Value='                                        ' )
     dummy = widget_base(numbase, column=1, /nonexclusive)
     aspectw = widget_button(dummy, value='Preserve Aspect', uvalue='ASPECT')

   drawbase = Widget_Base(sizebase, Row=1, frame=1)

   draw = Widget_Draw(drawbase, XSize=xpixwinsize, YSize=ypixwinsize, $
     Event_Pro='ps_form_Box_Events', Button_Events=1)

   opttlb  = Widget_Base(tlb, Row=1, align_center=1, xpad=20)

   orientbase = Widget_Base(opttlb, Column=1, base_align_center=1)

   junk = Widget_Label(orientbase, Value='Orientation: ')
      junkbase = Widget_Base(orientbase, Column=1, /Frame, /Exclusive)
         land = Widget_Button(junkbase, Value='Landscape', UValue='LANDSCAPE')
         port = Widget_Button(junkbase, Value='Portrait', UValue='PORTRAIT')

   optbase = Widget_Base(opttlb, Column=1, /NonExclusive, frame=1)
     colorbut  = widget_button(optbase, Value='Color Output', $
                 uvalue='COLOR')
     encap     = Widget_Button(optbase, Value='Encapsulated (EPS)', $
                           uvalue='ENCAPSULATED')
     isolatin1 = widget_button(optbase, Value='ISOLatin1 Encoding', $
                 UValue='ISOLATIN1')

;   bitslabel = Widget_Label(opttlb, Value='   Color Bits:')

   bitsw = Widget_Base(opttlb, Column=1, /Exclusive, /frame)

      bit2 = Widget_Button(bitsw, Value='2 Bit Color', UValue='BITS2')
      bit4 = Widget_Button(bitsw, Value='4 Bit Color', UValue='BITS4')
      bit8 = Widget_Button(bitsw, Value='8 Bit Color', UValue='BITS8')

   filenamebase = Widget_Base(tlb, Column=1, Align_Center=1)
   fbase = Widget_Base(filenamebase, Row=1)
   textlabel = Widget_Label(fbase, Value='Filename: ')

       ; Set up text widget with an event handler that ignores any event.

   filenamew = Widget_Text(fbase, /Editable, Scr_XSize=300,  $
      Value='', Event_Pro='ps_form_Null_Events')
   filenameb = widget_button(fbase, value='Choose...', $
                             event_pro='ps_form_select_file')

   ; This is a base for selection of predefined configurations and paper sizes
   predefbase = Widget_Base(tlb0, row=1, /align_center, frame=1)
   junk = widget_label(predefbase, value='Predefined:')
   predlist = widget_droplist(predefbase, value=confignames, $
                          event_pro='ps_form_predef_events', UValue='PREDEF')
   junk = widget_label(predefbase, value='    Paper Sizes:')
   paplist = widget_droplist(predefbase, value=ps_form_papernames(),$
                          event_pro='ps_form_predef_events', UValue='PAPER')
   
   actionbuttonbase = Widget_Base(tlb0, Row=1, /Align_Center)
   cancel = Widget_Button(actionbuttonbase, Value='Cancel', UValue='CANCEL')
   if n_elements(buttons) GT 0 then begin
       for i = 0, n_elements(buttons)-1 do begin
           but = widget_button(actionbuttonbase, value=buttons(i), $
                               uvalue='ACCEPT')
       endfor
   endif else begin
       create = Widget_Button(actionbuttonbase, Value='Create File', $
                              UValue='CREATE')
       accept = Widget_Button(actionbuttonbase, Value='Accept', $
                              UValue='ACCEPT')
   endelse


   ; Modify the color table 
   ; Get the colors in the current color table
   TVLct, r, g, b, /Get

   ; Modify color indices N_Colors-2, N_Colors-3 and N_Colors-4 for
   ; drawing colors

   ; The number of colors in the session can be less then the
   ; number of colors in the color vectors on PCs (and maybe other
   ; computers), so take the smaller value. (Bug fix?)
   ncol = !D.N_Colors < N_Elements(r)
   red = r
   green = g
   blue=b
   red(ncol-4:ncol-2) = [70B, 0B, 255B]
   green(ncol-4:ncol-2) = [70B, 255B, 255B]
   blue(ncol-4:ncol-2) = [70B, 0B, 0B]

   ; Load the newly modified colortable
   TVLct, red, green, blue

   ; Create a reserve pixmap for keeping backing store
   owin = !d.window
   Window, /Free, XSize=xpixwinsize, YSize=ypixwinsize, /Pixmap
   pixwid = !D.Window

   ; Create a handle.  This will hold the result after the widget finishes
   ptr = Handle_Create()

   info = { $
            devconfig: configs(0), $
            iddraw: draw, $
            idpixwid: pixwid, $
            idwid: pixwid, $
            idtlb: tlb0, $
            idxsize: xsizew, $
            idysize: ysizew, $
            idxoff: xoffw, $
            idyoff: yoffw, $
            idfilename: filenamew, $
            idinch: inch, $
            idcm: cm, $
            idcolor: colorbut, $
            idbitbase: bitsw, $
            idbit2: bit2, $
            idbit4: bit4, $
            idbit8: bit8, $
            idisolatin1: isolatin1, $
            idencap: encap, $
            idland: land, $
            idport: port, $
            idpaperlabel: paperw, $
            idaspect: aspectw, $
            idpaperlist: paplist, $
            xpagesize: xpagesize, $
            ypagesize: ypagesize, $
            paperindex: pind, $
            marginsize: marginsize, $
            xpixwinsize: xpixwinsize, $
            ypixwinsize: ypixwinsize, $
            drawpixperunit: dpp, $
            filechanged: filechanged, $
            pixredraw: 1, $
            imousex: 0.0, $
            imousey: 0.0, $
            ideltx: 0.0, $
            idelty: 0.0, $
            pagecolor: ncol-2, $
            boxcolor: ncol-3, $
            bkgcolor: ncol-4, $
            red: r, $
            green: g, $
            blue: b, $
            ptrresult: ptr, $
            predefined: configs, $
            papersizes: papersizes, $
            defaultpaper: defaultpaper, $
            aspect: aspect, $
            preserve_aspect: keyword_set(preserve_aspect) $
          }
   
   ps_form_draw_form, info, /nobox
   Widget_Control, tlb0, /Realize
   Widget_Control, draw, Get_Value=wid
   info.idwid = wid

   ;; Make sure the current info is consistent
   ps_form_update_info, info
   ; Draw the remaining widgets
   widget_control, paplist, Set_DropList_Select=pind
   ps_form_draw_form, info

   ; Store the info structure in the top-level base

   Widget_Control, tlb0, Set_UValue=info, /No_Copy

   ; Set this widget program up as a modal or blocking widget. What this means
   ; is that you will return to the line after this XManager call when the
   ; widget is destroyed.

   thisRelease = StrMid(!Version.Release, 0, 1)
   if thisRelease EQ '4' then $
     xmanager_modal = {Modal:1}
   XManager, 'ps_form', tlb0, _extra=xmanager_modal

   ; Get the formInfo structure from the pointer location.

   Handle_Value, ptr, formInfo, /No_Copy

   ; Make sure the user didn't click a close button.

   IF N_Elements(formInfo) EQ 0 THEN Begin
       Handle_Free, ptr
       RETURN, 0
   EndIF

   ; Strip the CANCEL field out of the formInfo structure so the
   ; cancelButton flag can be returned via the CANCEL keyword and the
   ; formInfo structure is suitable for passing directly to the DEVICE
   ; procedure through its _Extra keyword.

   cancelButton = formInfo.cancel
   createButton = formInfo.create
   IF NOT cancelButton THEN begin
       xpagesize = formInfo.xpagesize
       ypagesize = formInfo.ypagesize
       paperindex  = formInfo.paperindex
       if n_elements(buttons) GT 0 then $
         button_sel = forminfo.buttonname
       formInfo = formInfo.result 
       
       papersize = ps_form_papernames()
       papersize = papersize(paperindex)
       pagebox = [(0-formInfo.xoff)/formInfo.xsize, $
                  (0-formInfo.yoff)/formInfo.ysize, $
                 (xpagesize-formInfo.xoff)/formInfo.xsize, $
                 (ypagesize-formInfo.yoff)/formInfo.ysize ]
       ps_form_conv_pscoord, formInfo, xpagesize, ypagesize, /toidl
   endif else $
     formInfo = 0

   ; Free up the space allocated to the pointers and the data

   Handle_Free, ptr

   if owin GE 0 then wset, owin
   Set_Plot, oldname

   RETURN, formInfo
END ;*******************************************************************

;+
; NAME:
;   PXPERFECT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Postscript device settings for "pixel perfect" matching to screen plot layout
;
; CALLING SEQUENCE:
;   PS_EXTRA = PXPERFECT([/LANDSCAPE], [/INCHES], [THICK_FACTOR=tf], [SCALE=s])
;
; DESCRIPTION:
;
;   PXPERFECT is designed to achieve nearly "pixel perfect" matching
;   of plot layout when rendering a plot on the IDL Postscript device.
;   The dimensions and character sizes of the current display device
;   are used to construct a group of settings which can be passed to
;   the Postscript device driver using the DEVICE procedure.
;
;   The key capability of PXPERFECT is to determine the size of fonts
;   to match the on-screen size.  Once this size is determined, IDL
;   will adjust other Postscript output dimensions such as plot
;   margins, font sizes, symbol sizes, etc, to match exactly the
;   on-screen layout.
;
;   The current direct graphics device must be a screen display
;   device, such as 'X' or 'WIN'.  The user wouuld first call
;   PXPERFECT() to determine what the appropriate settings for the
;   Postscript device would be.  At a later time, the user may switch
;   to the Postscript device to render the plot for output.
;
;   This is the approximate order of calling:
;     ;; Prerequisite: current graphics device is display device
;     SET_PLOT, 'X'  ;; or 'WIN'
;     TF = 1.0  ;; Thickness factor (see "Dealing with line thickness" below)
;
;     ;; User adjusts the plot layout to taste
;     PLOT, ... data ..., thick=1.0*TF
; 
;     ;; Capture layout settings and then initialize Postscript
;     PS_EXTRA = PXPERFECT(THICK_FACTOR=TF)
;     SET_PLOT, 'PS'       ;; NOTE: PXPERFECT() called *before* SET_PLOT
;     DEVICE, _EXTRA=PS_EXTRA
;
;     ;; User calls same plot command(s) with no changes to layout
;     PLOT, ... data ..., thick=1.0*TF
;
;     ;; Close output plot file
;     DEVICE, /CLOSE
;    
;   If the display window is resized, then PXPERFECT should be called
;   again to capture the new layout settings.
;
;   The value returned by PXPERFECT is an IDL structure, with fields
;   that are meant to be passed to the IDL Postscript driver using the
;   DEVICE, _EXTRA=(...) statement.
;
;   Output Page Size.  The dimensions of the Postscript output page
;   will be set so that the output page exactly matches the displayed
;   plot window.  The algorithm does assume that the user's display
;   density settings are correct, in particular, that !D.X_PX_CM is a
;   correct reflection of the number of screen pixels per centimeter.
;
;   The user can adjust the output page size in several ways.
;   PXPERFECT accepts the XSIZE, YSIZE and SCALE_FACTOR keywords and
;   interprets them in the same way that the standard procedure DEVICE
;   does.  In order to maintain the same layout, the user may specify
;   XSIZE or YSIZE, but not both.  If both XSIZE and YSIZE are
;   specified, then the aspect ratio of the output page will not match
;   the on-screen display window, and pixel-perfect layout matching
;   cannot be attained in that case.
;
;   Dealing with Line Thickness.  The Postscript device has a
;   different base line thickness compared to most on-screen display
;   devices.  The value returned in the THICK_FACTOR keyword is a
;   scale factor which should be multiplied by all thicknesses when
;   rendering to Postscript.
;
;   Thus, if the desired on-screen line width is 2.0 units, then the
;   Postscript line thickness will be 2.0*TF, where TF is the value
;   returned in the THICK_FACTOR keyword.
;
;   Passing Other Keywords to DEVICE.  PXPERFECT() accepts all the
;   keywords that the DEVICE procedure accepts.  Any keywords that do
;   not specifically affect PXPERFECT's operation are passed
;   along to the output structure, and hence to DEVICE.
;
;
; POSITIONAL PARAMETERS:
;
;   NONE
;
; KEYWORD PARAMETERS:
;
;   INCHES - set this keyword if Postscript dimensions are to be
;            specified in inches instead of centimeters.  This keyword
;            also specifies the units of the user-passed keywords
;            XSIZE, YSIZE, XOFFSET, YOFFSET.
;            Default: not set (i.e. centimeter units)
;
;   LANDSCAPE - set this keyword to indicate landscape orientation instead
;               of portrait orientation.
;               Default: not set (i.e. portrait orientation)
;
;   SCALE_FACTOR - a unitless scale factor which is used to scale the
;                  size of the Postscript page output.  By default the
;                  output page size in inches or centimeters is scaled
;                  to match the on-screen size.  Use this keyword to
;                  increase (>1.0) or decrease (<1.0) the size of the
;                  output page.
;                  Default: 1.0
;
;   THICK_FACTOR - upon output, THICK_FACTOR, which contain a factor
;                  which should be used to multiply all line width
;                  thicknesses.
;
;   XSIZE, YSIZE - user-requested output page size which may differ
;                  from default Postscript page size.  The user should
;                  specify either XSIZE or YSIZE, but not both;
;                  specifying both will cause the output page layout to not
;                  exactly match the on-screen graphic layout.  Also,
;                  XSIZE or YSIZE override the SCALE_FACTOR keyword.
;                  Default: not set (i.e. output page size will match
;                  on-screen size)
;
;  XOFFSET, YOFFSET - user-requested page offsets.
;                  Default: plot at origin (landscape plots are
;                  adjusted appropriately)
;
; RETURNS:
;
;   PXPERFECT returns a single IDL structure, which is meant to be
;   passed to the IDL Postscript device.  This structure is passed
;   using the DEVICE procedure and the _EXTRA mechanism.
;
; SIDE EFFECTS:
;
;   The graphics device must be set to a screen display device when
;   PXPERFECT is called.
;
;   Upon the first call to PXPERFECT, the graphics device is
;   momentarily switched to 'PS' in order to retrieve Postscript
;   device settings.
;
; EXAMPLE:
;   ;; Plot to screen display
;   PLOT, FINDGEN(10), charsize=1.5
;
;   ;; Initialize Postscript
;   PS = PXPERFECT()
;   SET_PLOT, 'PS'
;   DEVICE, _EXTRA=PS, FILENAME='outfile.ps'
;
;   ;; Same plot, to Postscript page
;   PLOT, FINDGEN(10), charsize=1.5
;
;   ;; Finish output
;   DEVICE, /CLOSE
;   
;
; SEE ALSO:
;
;   DEVICE, SET_PLOT
;
; MODIFICATION HISTORY:
;   Written, CM, 2010
;   Documented, CM, 2011-04-15
;   Square bracket array notation, CM, 2011-12-21
;   Logic fix for case when XSIZE & YSIZE given together, CM, 2012-09-27
;
;   $Id: pxperfect.pro,v 1.5 2012/09/27 23:18:54 cmarkwar Exp $
;
;-
; Copyright (C) 2010-2011,2012 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QPINT1D
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   One dimensional numerical integration of IDL function or expression
;
; MAJOR TOPICS:
;   Numerical Analysis.
;
; CALLING SEQUENCE:
;   value = QPINT1D(FUNCT, A, B, [ PRIVATE, /EXPRESSION, FUNCTARGS=, 
;                   ERROR=error, NFEV=nfev, STATUS=status, NSUBINTERVALS=nsub,
;                   EPSABS=, EPSREL=, LIMIT=, BREAKPOINTS=, NPOINTS=
;                   /SYMMETRIC, SYM_AXIS= ] )
;
; DESCRIPTION:
;
;  QPINT1D adaptively calculates an approximation result to a given
;  definite integral
;
;       result = Integral[ f(x) dx ] over [a,b]
;
;  hopefully satisfying a constraint on the accuracy of the solution.
;  QPINT1D is based on the QUADPACK fortran package originally by
;  Piessens, de Doncker, Ueberhuber and Kahaner (and implements
;  equivalents to the QAGSE, QAGPE, QAGIE, and DQKxx fortran routines).
;
;  The returned result is intended to satisfy the following claim for
;  accuracy: ABS(result-value) LE MAX([epsabs, epsrel*ABS(value)]),
;  where VALUE is the true value of the integral, and EPSABS and
;  EPSREL are the absolute and relative error tolerances defined
;  below.  An estimate of the error is returned in the ERROR keyword.
;  Either A or B may be finite or infinite (i.e., an improper
;  integral).
;
;  QPINT1D is "adaptive" in the sense that it locates regions of the
;  integration interval which contain the highest error, and focusses
;  its efforts on those regions.  The algorithm locates these regions
;  by successively bisecting the starting interval.  Each subinterval
;  is assigned an error estimate, and the region with the largest
;  error estimate is subdivided further, until each subinterval
;  carries approximately the same amount of error.  Convergence of the
;  procedure may be accelerated by the Epsilon algorithm due to Wynn.
;
;  The estimate of the integral and the estimate of the error in each
;  subinterval are computed using Gauss Kronrod quadrature.
;  Integrators based on the 15-, 21-, 31-, 41-, 51- and 61-point
;  Gauss-Kronrod rule are available, and selected using the NPOINTS
;  keyword.  Generally, the more points the greater the precision,
;  especially for rapidly varying functions.  However the default
;  value of 21 is often sufficient, especially because of the adaptive
;  nature of QPINT1D.
;
;  In the following sections the requirements for the form of the
;  integrand are established.  Also, a description of how QPINT1D
;  handles singularities and discontinuities is presented.
;
; INTEGRAND is a FUNCTION
;
;  The integrand can be specified in two forms, either as a standard
;  IDL function, or as an IDL expression.  If integrating a function,
;  then the FUNCT should be a string naming the function.  The
;  function must be declared as following:
;
;    FUNCTION MYFUNCT, X, P, KEYWORDS=...
;      RETURN, (compute function of X and P)
;    END
;
;  The function must accept at least one, but optionally two,
;  parameters.  The first, 'X', is a vector of abcissae where the
;  function is to be computed.  The function must return the same
;  number of function values as abcissae passed.  The second
;  positional parameter, 'P', is a purely optional PRIVATE parameter
;  as described below.  MYFUNCT may accept more positional parameters,
;  but QPINT1D will not use them.  The difference between X and P is
;  that X is the variable of integration, while P contains any other
;  information expected to remain essentially constant over the
;  integration.
;
; INTEGRAND is an EXPRESSION
;
;  The integrand can also be specfied as an IDL expression and setting
;  the EXPRESSION keyword.  Any expression that can accept a vector of
;  abcissae named 'X' and produce a corresponding vector of output is
;  a valid expression.  Here is an example:
;
;    RESULT = QPINT1D('X^2 * EXP(-X)', /EXPRESSION, 0D, 10D)
;
;  It is important to note that the variable of integration must
;  always be named 'X', and the expression must be vectorizable.  The
;  expression may also use the PRIVATE data, and as above, it would be
;  referred to according to the variable 'P'.  For example, if the
;  exponential decay constant is parameterized by PRIVATE(0), then the
;  expression would be:
;
;    RESULT = QPINT1D('X^2 * EXP(-X/P(0))', /EXPRESSION, 0D, 10D, PRIVATE)
;
;  The user is solely responsible for defining and using the PRIVATE
;  data.  QPINT1D does not access or modify PRIVATE / P; it only
;  passes it on to the user routine for convenience.
;
; IMPROPER INTEGRALS and DISCONTINUITIES
;
;  QPINT1D computes improper integrals, as well as integrands with
;  discontinuities or singularities.  
;
;  Improper integrals are integrals where one or both of the limits of
;  integration are "infinity."  (Formally, these integrals are defined
;  by taking the limit as the integration limit tends to infinity).
;  QPINT1D handles a small class of such integrals, generally for
;  integrands that are convergent and monotonic (i.e.,
;  non-oscillatory, and falling off as 1/ABS(X)^2 or steeper).  Such
;  integrals are handled by a transformation of the original interval
;  into the interval [0,1].
;
;  Integrals from negative infinity to positive infinity are done in
;  two subintervals.  By default the interval is split at X EQ 0,
;  however this can be controlled by using the SYM_AXIS keyword.
;  Users should note that if the first subinterval fails the second is
;  not attempted, and thus the return value VALUE should not be
;  trusted in those cases.
;
;  Infinite integration limits are specified by using the standard
;  values !VALUES.F_INFINITY or !VALUES.D_INFINITY.  No other special
;  invocation syntax is required.
;
;  The integration routine is able to handle integrands which have
;  integrable singularities at the endpoints.  For example, the
;  integral:
;
;    RESULT = QPINT1D('2*sqrt((1-x)/(1+x))/(1-x^2)', 0.0d, 1d, /expr)
;
;  has a singularity at a value of X EQ 1.  Still, the singularity is
;  integrable, and the value returned is a correct value of 2.
;
;  If known singularities are present within the interval of
;  integration, then users should pass the BREAKPOINTS keyword to list
;  the locations of these points.  QPINT1D will then integrate each
;  subinterval separately, while still maintaining an overall error
;  budget.
;
;  If known discontinuities exist in the integrand, then the user may
;  additionally list those points using the BREAKPOINTS keyword.
;
;  It should be noted that the algorithm used is different, depending
;  on whether the BREAKPOINTS keyword has been specified or not (this
;  is the difference between the QAGSE vs. QAGPE routines in the
;  original FORTRAN).  The algorithm *without* BREAKPOINTS is
;  generally thought to be more precise than *with*.  Thus, it may be
;  worth splitting the original integration interval manually and
;  invoking QPINT1D without BREAKPOINTS.
;
;
; INPUTS:
;
;  FUNCT - by default, a scalar string containing the name of an IDL
;          function to be integrated.  See above for the formal
;          definition of MYFUNCT.  (No default).
;
;          If the EXPRESSION keyword is set, then FUNCT is a scalar
;          string containing an IDL expression to be evaluated, as
;          described above.
;
;  A, B - a scalar number indicating the lower and upper limits of the
;         interval of integration (i.e., [A, B] is the interval of
;         integration).
;
;  PRIVATE - any optional variable to be passed on to the function to
;            be integrated.  For functions, PRIVATE is passed as the
;            second positional parameter; for expressions, PRIVATE can
;            be referenced by the variable 'P'.   QPINT1D does not
;            examine or alter PRIVATE.
;
; RETURNS:
;
;   The value of the integral.  If either A or B are double precision,
;   then the integral is computed in double precision; otherwise the
;   result is returned in single precision floating point.
;
; KEYWORD PARAMETERS:
;
;   BREAKPOINTS - an array of numbers specifying points within the
;                 integration interval where the integrand is
;                 discontinuous or singular.  Out of bounds points are
;                 ignored.
;                 Default: undefined, i.e., no such points
;
;   EPSABS - a scalar number, the absolute error tolerance requested
;            in the integral computation.  If less than or equal to
;            zero, then the value is ignored.
;            Default: 0
;
;   EPSREL - a scalar number, the relative (i.e., fractional) error
;            tolerance in the integral computation.  If less than or
;            equal to zero, then the value is ignored.
;            Default: 1e-4 for float, 1d-6 for double
;
;   EXPRESSION - if set, then FUNCT is an IDL expression.  Otherwise,
;                FUNCT is an IDL function.
;
;   ERROR - upon return, this keyword contains an estimate of the
;           error in the computation.
;
;   FUNCTARGS - A structure which contains the parameters to be passed
;               to the user-supplied function specified by FUNCT via
;               the _EXTRA mechanism.  This is the way you can pass
;               additional data to your user-supplied function without
;               using common blocks.  By default, no extra parameters
;               are passed to the user-supplied function.
;
;   LIMIT - a scalar, the maximum number of subintervals to create
;           before terminating execution.  Upon return, a STATUS value
;           of 1 indicates such an overflow occurred.
;           Default: 100
;
;   NFEV - upon return, this keyword contains the number of function
;          calls executed (i.e., the number of abcissae).
;
;   NPOINTS - a scalar, the number of Gauss Kronrod points to use in
;             computing the integral over a subinterval.  A larger
;             number of points can in principle increase the precision
;             of the integral, but also makes the computation take
;             longer.  Possible values are 15, 21, 31, 41, 51, and 61.
;             NPOINTS is rounded up to the next nearest available set,
;             with a maximum of 61.
;             Default: 21
;
;   NSUBINTERVALS - upon return, this keyword contains the number of
;                   subintervals the integration interval was divided
;                   into.
;
;   STATUS - upon return, the status of the integration operation is
;            returned in this keyword as an integer value.  A value of
;            zero indicates success; otherwise an abnormal condition
;            has occurred and the returned value should be considered
;            erroneous or less reliable according to STATUS:
;
;                 any negative number - outright failure (reserved for
;                                       future use).
;
;                 -1 - the input parameters are invalid, because
;                      epsabs LE 0 and epsrel LT max([50*EPS,0.5d-28]),
;                      where EPS is the machine precision, or if LIMIT
;                      is smaller than the number of BREAKPOINTS.
;
;                  0 - success.
;
;                  1 - maximum number of subdivisions allowed has been
;                      achieved. One can allow more subdivisions by
;                      increasing the value of limit (and taking the
;                      according dimension adjustments into
;                      account). However, if this yields no
;                      improvement it is advised to analyze the
;                      integrand in order to determine the integration
;                      difficulties.  If the position of a local
;                      difficulty can be determined (i.e. singularity,
;                      discontinuity within the interval), it should
;                      be supplied to the routine as an element of the
;                      vector BREAKPOINTS.
;
;                  2 - The occurrence of roundoff error is detected,
;                      which prevents the requested tolerance from
;                      being achieved.  The error may be
;                      under-estimated.
;
;                  3 - Extremely "bad" integrand behaviour occurs at
;                      some points of the integration interval.
;
;                  4 - The algorithm does not converge.  Roundoff
;                      error is detected in the extrapolation table.
;                      It is presumed that the requested tolerance
;                      cannot be achieved, and that the returned
;                      result is the best which can be obtained.
;
;                  5 - The integral is probably divergent, or only
;                      slowly convergent.  It must be noted that
;                      divergence can occur with any other value of
;                      ier GT 0.
;
;   SYM_AXIS - a scalar number, the bisection point of the real line
;              for improper integrals from negative infinity to
;              positive infinity.  Otherwise ignored.
;              Default: 0.
;
;   
; EXAMPLES:
;
;  Shows how function and expression can be used for exponential
;  integrand:
;
;    IDL> print, qpint1d('EXP(X)', 0D, 10D, /expr)
;           22025.466
;    IDL> print, qpint1d('EXP', 0D, 10D)
;           22025.466
;
;  Normal definite integral, and then parameterized using a PRIVATE
;  value of 2.
;    IDL> print, qpint1d('X^2*EXP(-X)', 0D, 10D, /expr)
;           1.9944612
;    IDL> print, qpint1d('X^2*EXP(-X/P(0))', 0D, 10D, 2D, /expr)
;           14.005568
;
;  Improper integrals of the gaussian function
;    IDL> inf = !values.d_infinity
;    IDL> print, qpint1d('EXP(-X^2)', 0D, +inf, 2D, /expr)
;          0.88622693
;    IDL> print, qpint1d('EXP(-X^2)', -inf, +inf, 2D, /expr), sqrt(!dpi)
;           1.7724539       1.7724539
;  The second integral shows the comparison to the analytic value of
;  SQRT(!DPI).
;
; COMMON BLOCKS:
;
;   COMMON QPINT1D_MACHAR
;   COMMON QPINT1D_PROFILE_COMMON
;   COMMON QPINT1D_QKEVAL_COMMON
;
;   These common blocks are used internally only and should not be
;   accessed or modified.
;
; REFERENCES:
;
;    R. Piessens, E. deDoncker-Kapenga, C. Uberhuber, D. Kahaner
;    Quadpack: a Subroutine Package for Automatic Integration
;    Springer Verlag, 1983.    Series in Computational Mathematics v.1
;    515.43/Q1S  100394Z
;
;    Netlib repository: http://www.netlib.org/quadpack/
;
;    SLATEC Common Mathematical Library, Version 4.1, July 1993
;    a comprehensive software library containing over
;    1400 general purpose mathematical and statistical routines
;    written in Fortran 77.  (http://www.netlib.org/slatec/)
;
; MODIFICATION HISTORY:
;   Written, Feb-Jun, 2001, CM
;   Documented, 04 Jun, 2001, CM
;   Add usage message, error checking, 15 Mar 2002, CM
;   Correct usage message, 28 Apr 2002, CM
;   More error checking when user EXPRession fails, 10 Jun 2009, CM
;
;  $Id: qpint1d.pro,v 1.14 2009/06/10 22:03:34 craigm Exp $
;-
; Copyright (C) 2001, 2002, 2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; --------------------------------------------------------------
; Some functions used in testing the algorithm
;
; Test functions
; .COMP
; FUNCTION BESTEST, X, N
;  RETURN, BESELJ(ABS(X-10)+0.001, N)
; END
; print, qpint1d('BESTEST', .1d, 35d, 1L, nev=nev, nsub=nsub, status=ier)

; .comp
; function invsq, x
;   return, 1/(abs(x-10)+0.0001)^2
; end
; print, qpint1d('INVSQ', 0d, 50d, nev=nev, nsub=nsub, status=ier, error=err)

; .comp 
; function broken, x
;   f = x*0
;   wh = where(x LT 0, ct)
;   if ct GT 0 then f(wh) = exp(x(wh))
;   wh = where(x GE 0 AND x LT 10, ct)
;   if ct GT 0 then f(wh) = x(wh)^2
;   wh = where(x GE 10, ct)
;   if ct GT 0 then f(wh) = exp(-x(wh))
;   return, f
; end
; print, qpint1d('BROKEN', -10d, 50d, nev=nev, nsub=nsub, status=ier, error=err) & print, err, ier, nsub


;; Function used in testing speed
pro qpint1d_profile, clear=clear
  common qpint1d_profile_common, profvals
;  if n_elements(profvals) EQ 0 OR keyword_set(clear) then $
;    profvals = {functime: 0D, tottime: 0D, srttime: 0D, acctime: 0D, $
;                qktime: 0D}
end

;; Following are machine constants that can be loaded once.  I have
;; found that bizarre underflow messages can be produced in each call
;; to MACHAR(), so this structure minimizes the number of calls to
;; one.

pro qpint1d_setmachar, double=isdouble
  common qpint1d_machar, qpint1d_machar_vals

  ;; In earlier versions of IDL, MACHAR itself could produce a load of
  ;; error messages.  We try to mask some of that out here.
  if (!version.release) LT 5 then dummy = check_math(1, 1)

  mch = 0.
  mch = machar(double=keyword_set(isdouble))
  dmachep = mch.eps
  dmaxnum = mch.xmax
  dminnum = mch.xmin
  dmaxlog = alog(mch.xmax)
  dminlog = alog(mch.xmin)
  if keyword_set(isdouble) then $
    dmaxgam = 171.624376956302725D $
  else $
    dmaxgam = 171.624376956302725
  drdwarf = sqrt(dminnum*1.5) * 10
  drgiant = sqrt(dmaxnum) * 0.1

  qpint1d_machar_vals = {machep: dmachep, maxnum: dmaxnum, minnum: dminnum, $
                       maxlog: dmaxlog, minlog: dminlog, maxgam: dmaxgam, $
                       rdwarf: drdwarf, rgiant: drgiant}

  if (!version.release) LT 5 then dummy = check_math(0, 0)

  return
end


;; --------------------------------------------------------
;; Main workhorse routine
pro qpint1d_qagse, f, a0, b0, result, abserr, private, functargs=fa, $
                   epsabs=epsabs, epsrel=epsrel, npoints=npts0, $
                   status=ier, limit=limit, neval=neval, nsubintervals=last, $
                   breakpoints=bpoints0, isdouble=isdouble, $
                   alist=alist, blist=blist, rlist=rlist, $
                   elist=elist, iord=iord
                   

  ;; Derived from QUADPACK QAGSE
  ;;***PURPOSE  The routine calculates an approximation result to a given
  ;;            definite integral I = Integral of F over (A,B),
  ;;            hopefully satisfying following claim for accuracy
  ;;            ABS(I-RESULT).LE.MAX(EPSABS,EPSREL*ABS(I)).
  ;;***LIBRARY   SLATEC (QUADPACK)

  common qpint1d_machar, machvals
  r1mach1 = machvals.minnum
  r1mach2 = machvals.maxnum
  r1mach4 = machvals.machep

  ;; Establish the precision we will be computing in, base on the
  ;; integration limits.
  a = a0
  b = b0
  zero = a*0.
  if n_elements(isdouble) EQ 0 then begin
      sz = size(zero)
      if sz(sz(0)+1) EQ 5 then isdouble = 1 else isdouble = 0
  endif
  isdouble = isdouble(0)

  ;; Establish default values
  if n_elements(neval) EQ 0 then neval = 0L
  if n_elements(limit) EQ 0 then limit = 100L
  if n_elements(epsabs) EQ 0 then epsabs = zero
  if n_elements(epsrel) EQ 0 then epsrel = zero + 1e-6
  if n_elements(npts0) EQ 0 then npoints = 21L $
  else                           npoints = floor(npts0(0))
  rlist2 = make_array(52, value=zero)
  res3la = rlist2(0:2)

  ;; These are the work arrays which manage the subintervals
  alist = make_array(limit, value=zero)
  blist = alist
  rlist = alist
  elist = alist
  iord = lonarr(limit)
  level = iord

  epmach = r1mach4

;            TEST ON VALIDITY OF PARAMETERS
  ier = 0L
  neval = 0
  last = 0
  result = zero
  abserr = zero

  ;; Extract the valid breakpoints
  nbp0 = n_elements(bpoints0)
  nbp = nbp0
  if nbp GT 0 then begin
      abmin = min([a,b], max=abmax)
      wh = where(bpoints0 GT abmin(0) AND bpoints0 LT abmax(0), nbp)
      if nbp GT 0 then begin
          ;; Valid breakpoints were found.  Sort them into place.
          bpoints = bpoints0(wh)
          if a LE b then bpoints = [a, bpoints(sort(bpoints)),  b] $
          else           bpoints = [a, bpoints(sort(-bpoints)), b]
          nbp = nbp + 2
          if nbp GE limit then goto, INPUT_ERROR
      endif
  endif
  if nbp EQ 0 then begin
      ;; By default, we have two breakpoints, namely the start and
      ;; stop of the interval.
      bpoints = [a, b]
      nbp = 2L
  endif

  ;; Search for infinite bounds
  dirsign = 1
  if finite(b) EQ 0 then begin
      bound = a
      dirsign = 2*(b GT 0) - 1
      a = zero
      b = zero + 1

      ;; Transform the breakpoints into the [0,1] interval
      bpoints = rotate(1/((bpoints-bound(0))*dirsign + 1),2)
  endif

  alist(0) = a
  blist(0) = b
  rlist(0) = zero
  elist(0) = zero
  xnum = (a(0)*b(0)*0.)
  sz = size(xnum)
  if sz(sz(0)+1) EQ 5 then xlim = 0.5d-28 else xlim = 0.5d-14

  if (epsabs LE 0 AND epsrel LT max([0.5e2*epmach,xlim])) then begin
      INPUT_ERROR:
      ier = 6L
      goto, LAB999
  endif

  nint = nbp-1
  npts = nbp-2
  npts2 = nbp

;           FIRST APPROXIMATION TO THE INTEGRAL
  uflow = r1mach1
  oflow = r1mach2
  resabs = zero
  a1 = bpoints(0)
  ndin = iord * 0
  for i = 0L,nint-1 do begin
      b1 = bpoints(i+1)

      qpint1d_qkeval, f,a1,b1,area1,error1,defabs,resa, private, $
        neval=neval, functargs=fa, inflow=bound, dirsign=dirsign, $
        isdouble=isdouble, npoints=npoints

      abserr = abserr+error1
      result = result+area1
      ndin(i) = (error1 EQ resa AND error1 NE zero)
      resabs = resabs+defabs
      level(i) = 0
      elist(i) = error1
      alist(i) = a1
      blist(i) = b1
      rlist(i) = area1
      iord(i) = i+1
      a1 = b1
  endfor

  if nbp0 GT 0 then begin
      wh = where(ndin EQ 1, ct)
      if ct GT 0 then elist(wh) = abserr
  endif
  errsum = total(elist(0:nint-1))

;           TEST ON ACCURACY.
  last = nint
  dres = abs(result)
  errbnd = max([epsabs,epsrel*dres])
  if (abserr LE 1.0e+02*epmach*resabs) AND (abserr GT errbnd) then $
    ier = 2L

  ;; Sort in descending order
  iord(0:nint-1) = sort(-elist(0:nint-1)) + 1

  if (limit LT npts2) then ier = 1L
  if (ier NE 0 OR abserr LE errbnd) then goto, LAB999

;           INITIALIZATION
  rlist2(1-1) = result
  maxerr = iord(0)
  errmax = elist(maxerr-1)
  area = result
  nrmax = 1L
  nres = 0L
  if nbp0 EQ 0 then begin
      numrl2 = 2L
      errsum = abserr
  endif else begin
      numrl2 = 1L
      erlarg = errsum
  endelse
  ktmin = 0
  extrap = 0
  noext = 0
  ertest = errbnd
  levmax = 1L
  iroff1 = 0
  iroff2 = 0
  iroff3 = 0
  ierro = 0
  abserr = oflow
  ksgn = -1
  if (dres GE (0.1E+01-0.5E+02*epmach)*resabs) then ksgn = 1
  
;           MAIN DO-LOOP
  for last = npts2, limit do begin

;           BISECT THE SUBINTERVAL WITH THE NRMAX-TH LARGEST
;           ERROR ESTIMATE.
      levcur = level(maxerr)+1
      a1 = alist(maxerr-1)
      b1 = 0.5e+00*(alist(maxerr-1)+blist(maxerr-1))
      a2 = b1
      b2 = blist(maxerr-1)
      erlast = errmax
      qpint1d_qkeval, f,a1,b1,area1,error1,resa,defab1, private, $
        neval=neval, functargs=fa, inflow=bound, dirsign=dirsign, $
        isdouble=isdouble, npoints=npoints
      qpint1d_qkeval, f,a2,b2,area2,error2,resa,defab2, private, $
        neval=neval, functargs=fa, inflow=bound, dirsign=dirsign, $
        isdouble=isdouble, npoints=npoints

;           IMPROVE PREVIOUS APPROXIMATIONS TO INTEGRAL
;           AND ERROR AND TEST FOR ACCURACY.
      area12 = area1+area2
      erro12 = error1+error2
      errsum = errsum+erro12-errmax
      area = area+(area12-rlist(maxerr-1))
      if NOT (defab1 EQ error1 OR defab2 EQ error2) then begin
          
          if NOT (abs(rlist(maxerr-1)-area12) GT 0.1e-04*abs(area12) $
                  OR erro12 LT 0.99e+00*errmax) then begin
              if (extrap) then iroff2 = iroff2+1
              if (NOT extrap) then iroff1 = iroff1+1
          endif
          if(last GT 10 AND erro12 GT errmax) then iroff3 = iroff3+1
      endif
      level(maxerr-1) = levcur
      level(last-1) = levcur
      rlist(maxerr-1) = area1
      rlist(last-1) = area2
      errbnd = max([epsabs,epsrel*abs(area)])

;           TEST FOR ROUNDOFF ERROR AND EVENTUALLY
;           SET ERROR FLAG.
      if (iroff1+iroff2 GE 10 OR iroff3 GE 20) then ier = 2L
      if (iroff2 GE 5) then ierro = 3

;           SET ERROR FLAG IN THE CASE THAT THE NUMBER OF
;           SUBINTERVALS EQUALS LIMIT.
      if last EQ limit then ier = 1L
      
;           SET ERROR FLAG IN THE CASE OF BAD INTEGRAND BEHAVIOUR
;           AT A POINT OF THE INTEGRATION RANGE.
      if (max([abs(a1),abs(b2)]) LE (0.1e+01+0.1e+03*epmach)* $
          (abs(a2)+0.1e+04*uflow)) then ier = 4L

;           APPEND THE NEWLY-CREATED INTERVALS TO THE LIST.
      if (error2 LE error1) then begin ;; IDL OK
          alist(last-1) = a2
          blist(maxerr-1) = b1
          blist(last-1) = b2
          elist(maxerr-1) = error1
          elist(last-1) = error2
      endif else begin
          alist(maxerr-1) = a2
          alist(last-1) = a1
          blist(last-1) = b1
          rlist(maxerr-1) = area2
          rlist(last-1) = area1
          elist(maxerr-1) = error2
          elist(last-1) = error1
      endelse

;           CALL SUBROUTINE QPSRT TO MAINTAIN THE DESCENDING ORDERING
;           IN THE LIST OF ERROR ESTIMATES AND SELECT THE
;           SUBINTERVAL WITH NRMAX-TH LARGEST ERROR ESTIMATE (TO BE
;           BISECTED NEXT).

      qpint1d_qpsrt, limit,last,maxerr,errmax,elist,iord,nrmax

; ***JUMP OUT OF DO-LOOP
      if (errsum LE errbnd) then goto, LAB115
; ***JUMP OUT OF DO-LOOP
      if (ier NE 0) then goto, LAB100
      if (nbp0 EQ 0 AND last EQ 2) then goto, LAB80
      if (noext) then goto, LAB90
      erlarg = erlarg-erlast
      if (nbp0 EQ 0) then begin
          if (abs(b1-a1) GT small) then erlarg = erlarg+erro12 
      endif else begin
          if (levcur+1 LE levmax) then erlarg = erlarg+erro12
      endelse
      if NOT (extrap) then begin
          bool = 0
          if nbp0 EQ 0 then begin
              if (abs(blist(maxerr-1)-alist(maxerr-1)) GT small) then $
                goto, LAB90
          endif else begin
              if (level(maxerr-1)+1 LE levmax) then goto, LAB90
          endelse
          extrap = 1
          nrmax = 2L
      endif
      
      if NOT (ierro EQ 3 OR erlarg LE ertest) then begin
;
;           THE SMALLEST INTERVAL HAS THE LARGEST ERROR.
;           BEFORE BISECTING DECREASE THE SUM OF THE ERRORS
;           OVER THE LARGER INTERVALS (ERLARG) AND PERFORM
;           EXTRAPOLATION.

          id = nrmax
          jupbnd = last
          if (last GT (2+limit/2)) then jupbnd = limit+3-last
          for k = id, jupbnd do begin
              maxerr = iord(nrmax-1)
              errmax = elist(maxerr-1)
; ***JUMP OUT OF DO-LOOP
              bool = 0
              if nbp0 EQ 0 then begin
                  if (abs(blist(maxerr-1)-alist(maxerr-1)) GT small) then $
                    goto, LAB90
              endif else begin
                  if (level(maxerr-1)+1 LE levmax) then goto, LAB90
              endelse
              nrmax = nrmax+1
          endfor
      endif

;           PERFORM EXTRAPOLATION.
      numrl2 = numrl2+1
      rlist2(numrl2-1) = area
      if (nbp0 GT 0 AND numrl2 LE 2) then goto, LAB72
      qpint1d_qelg, numrl2,rlist2,reseps,abseps,res3la,nres
      ktmin = ktmin+1
      if (ktmin GT 5 AND abserr LT 0.1e-02*errsum) then ier = 5L
      if NOT (abseps GE abserr) then begin
          ktmin = 0
          abserr = abseps
          result = reseps
          correc = erlarg
          ertest = max([epsabs,epsrel*abs(reseps)])
; ***JUMP OUT OF DO-LOOP
          if (abserr LE ertest) then goto, LAB100
      endif

;           PREPARE BISECTION OF THE SMALLEST INTERVAL.
      if (numrl2 EQ 1) then noext = 1
      if (ier EQ 5) then goto, LAB100

      LAB72:
      maxerr = iord(0)
      errmax = elist(maxerr-1)
      nrmax = 1L
      extrap = 0
      if nbp0 EQ 0 then small = small*0.5e+00
      levmax = levmax + 1
      erlarg = errsum
      goto, LAB90

      LAB80:
      small = abs(b-a)*0.375e+00
      erlarg = errsum
      ertest = errbnd
      rlist2(2-1) = area
      
      LAB90:
  endfor
      
  LAB100:
;           SET FINAL RESULT AND ERROR ESTIMATE.
  if abserr EQ oflow then goto, LAB115
  if ier+ierro EQ 0 then goto, LAB110
  if ierro EQ 3 then abserr = abserr+correc
  if ier EQ 0 then ier = 3L
  if NOT (result NE zero AND area NE zero) then begin
      if abserr GT errsum then goto, LAB115
      if area EQ 0 then goto, LAB130
      goto, LAB110
  endif
  if(abserr/abs(result) GT errsum/abs(area)) then goto, LAB115

;           TEST ON DIVERGENCE.
  LAB110:
  if (ksgn EQ (-1) AND max([abs(result),abs(area)]) LE $
      resabs*0.1e-01) then goto, LAB130
  if (0.1e-01 GT (result/area) OR (result/area) GT 0.1e+03 $
      OR errsum GT abs(area)) then ier = 6L
  goto, LAB130

  LAB115:
  result = total(rlist(0:last-1))
  abserr = errsum

  LAB130:
  if (ier GT 2) then ier = ier-1

  LAB999:
  result = result * dirsign
  return
end

;; Originally DQK21.F, this routine performs Gauss-Kronrod quadrature
;; using 15, 21, 31, 41, 51 or 61 points.
pro qpint1d_qkeval, f, a, b, result, abserr, resabs, resasc, priv, $  
                  functargs=fa, neval=neval, reset=reset, isdouble=isdouble, $
                  inflow=bound, dirsign=dirsign, npoints=npts0

  ;; Derived from QUADPACK QK21-QK61, and QK15I
  ;;***PURPOSE  To compute I = Integral of F over (A,B), with error
  ;;                           estimate
  ;;                       J = Integral of ABS(F) over (A,B)
  ;;***LIBRARY   SLATEC (QUADPACK)

  common qpint1d_qkeval_common, wg, wgk, xgk, ig, nptsreq, nptsact, prec

  if n_elements(npts0) EQ 0 then npts0 = 21L
  if n_elements(isdouble) EQ 0 then isdouble = 1

  ;; Determine the number of points "requested", versus the number
  ;; "actually" granted.
  if n_elements(nptsreq) EQ 0 OR keyword_set(reset) then begin
      nptsreq = 0L
      prec = -1L
  endif
  if npts0(0) NE nptsreq OR isdouble(0) NE prec then begin
      ;; If this is the first time around, or if we need to use a
      ;; different set of GK points, then request the new set of
      ;; points from GKWEIGHTS.
      nptsreq = npts0(0)
      prec = isdouble(0) EQ 1
      qpint1d_gkweights, wg, wgk, xgk, ig, nptsreq, nptsact, prec
      if keyword_set(reset) then return
  endif

  common qpint1d_machar, machvals
  r1mach1 = machvals.minnum
  r1mach2 = machvals.maxnum
  r1mach4 = machvals.machep
  common qpint1d_profile_common, profvals
;  prof_start1 = systime(1)

  if n_elements(neval) EQ 0 then neval = 0L
  epmach = r1mach4
  uflow = r1mach1

  zero = a*b*0.
  centr = 0.5e+00*(a+b)
  hlgth = 0.5e+00*(b-a)
  dhlgth = abs(hlgth)

  x = centr+hlgth*xgk
  if n_elements(bound) GT 0 then begin
      ;; Transformation for infinite integrals
      u = temporary(x)
      x = bound(0) + dirsign*(1/u - 1)
  endif

;  prof_start2 = systime(1)
  ;; Call with or without PRIVATE and _EXTRA keywords
  if n_elements(priv) GT 0 then begin
      if n_elements(fa) GT 0 then fv = call_function(f, x, priv, _EXTRA=fa) $
      else                        fv = call_function(f, x, priv)
  endif else begin
      if n_elements(fa) GT 0 then fv = call_function(f, x, _EXTRA=fa) $
      else                        fv = call_function(f, x)
  endelse
;  profvals.functime = profvals.functime + (systime(1) - prof_start2)
  neval = neval + n_elements(x)
  if n_elements(fv) NE n_elements(x) then $
    message, 'ERROR: Integrand function '+strupcase(f)+$
    ' must return a vector of values'
  
  if n_elements(bound) GT 0 then begin
      ;; Complete the transformation for infinite integrals
      fv = fv / u^2
  endif

  resk = total(wgk*fv)
  resabs = total(wgk*abs(fv))
  resg = total(wg*fv(ig))

  resasc = total(wgk*abs(fv-resk*0.5e+00))

  result = resk*hlgth
  resabs = resabs*dhlgth
  resasc = resasc*dhlgth
  abserr = abs((resk-resg)*hlgth)
  if (resasc NE 0.0e+00 AND abserr NE 0.0e+00) then $
    abserr = resasc*min([0.1e+01,(0.2e+03*abserr/resasc)^1.5])
  if (resabs GT uflow/(0.5e+02*epmach)) then $
    abserr = max([(epmach*0.5e+02)*resabs,abserr])
;  profvals.qktime = profvals.qktime + (systime(1) - prof_start1)
  return
end



pro qpint1d_qelg, n, epstab, result, abserr, res3la, nres

  ;; Derived from QUADPACK QELG
  ;;***PURPOSE  The routine determines the limit of a given sequence of
  ;;            approximations, by means of the Epsilon algorithm of
  ;;            P. Wynn. An estimate of the absolute error is also given.
  ;;            The condensed Epsilon table is computed. Only those
  ;;            elements needed for the computation of the next diagonal
  ;;            are preserved.
  ;;***LIBRARY   SLATEC

  common qpint1d_machar, machvals
  r1mach1 = machvals.minnum
  r1mach2 = machvals.maxnum
  r1mach4 = machvals.machep
  common qpint1d_profile_common, profvals
;  prof_start = systime(1)

  epmach = r1mach4
  oflow = r1mach2
  nres = nres+1
  abserr = oflow
  result = epstab(n-1)
  if (n LT 3) then goto, LAB100
  limexp = 50
  epstab(n+2-1) = epstab(n-1)
  newelm = (n-1)/2
  epstab(n-1) = oflow
  num = n
  k1 = n-1  ;; OK IDL 
  for i = 1, newelm do begin
      res = epstab(k1+2) ;; OK IDL
      e0 = epstab(k1-2)  ;; OK IDL
      e1 = epstab(k1-1)  ;; OK IDL
      e2 = res
      e1abs = abs(e1)
      delta2 = e2-e1
      err2 = abs(delta2)
      tol2 = max([abs(e2),e1abs])*epmach
      delta3 = e1-e0
      err3 = abs(delta3)
      tol3 = max([e1abs,abs(e0)])*epmach

      if NOT (err2 GT tol2 OR err3 GT tol3) then begin
;           IF E0, E1 AND E2 ARE EQUAL TO WITHIN MACHINE
;           ACCURACY, CONVERGENCE IS ASSUMED.
          result = res
          abserr = err2+err3
; ***JUMP OUT OF DO-LOOP
          goto, LAB100
      endif
      e3 = epstab(k1)
      epstab(k1) = e1
      delta1 = e1-e3
      err1 = abs(delta1)
      tol1 = max([e1abs,abs(e3)])*epmach

;           IF TWO ELEMENTS ARE VERY CLOSE TO EACH OTHER, OMIT
;           A PART OF THE TABLE BY ADJUSTING THE VALUE OF N
      if NOT (err1 LE tol1 OR err2 LE tol2 OR err3 LE tol3) then begin

          ;; Avoid underflow errors
          if abs(delta1) GE 0.5*abs(oflow) then odelta1 = delta1*0 $
          else                                  odelta1 = 1/delta1
          ss = odelta1+0.1e+01/delta2-0.1e+01/delta3
          epsinf = abs(ss*e1)
          
;           TEST TO DETECT IRREGULAR BEHAVIOUR IN THE TABLE, AND
;           EVENTUALLY OMIT A PART OF THE TABLE ADJUSTING THE VALUE
;           OF N.
          if (epsinf GT 0.1e-03) then goto, LAB30
      endif

      
      n = i+i-1
; ***JUMP OUT OF DO-LOOP
      goto, LAB50
      
;           COMPUTE A NEW ELEMENT AND EVENTUALLY ADJUST
;           THE VALUE OF RESULT.
      LAB30:
      res = e1+0.1e+01/ss
      epstab(k1) = res
      k1 = k1-2
      error = err2+abs(res-e2)+err3
      if NOT (error GT abserr) then begin
          abserr = error
          result = res
      endif
  endfor
  
;           SHIFT THE TABLE.
  LAB50:
  if (n EQ limexp) then n = 2*(limexp/2)-1
  ib = 1
  if ((num/2)*2 EQ num) then ib = 2
  ie = newelm+1
  ii = ib-1+lindgen(ie)*2
  epstab(ii) = epstab(ii+2) ;; OK IDL
  if NOT (num EQ n) then begin
      indx = num-n+1
      ii = lindgen(n)
      epstab(ii) = epstab(indx-1+ii) ;; OK IDL
  endif
  
  if NOT (nres GE 4) then begin
      res3la(nres-1) = result
      abserr = oflow
  endif else begin
      
;           COMPUTE ERROR ESTIMATE - OK IDL
      abserr = (abs(result-res3la(2))+abs(result-res3la(1)) $
                +abs(result-res3la(0)))
      res3la(0) = res3la(1)
      res3la(1) = res3la(2)
      res3la(2) = result
  endelse
  
  LAB100:
  abserr = max([abserr,0.5e+01*epmach*abs(result)])
;  profvals.acctime = profvals.acctime + (systime(1) - prof_start)
  return
end
  
pro qpint1d_qpsrt, limit, last, maxerr, ermax, elist, iord, nrmax
;;                              OOOOOO  OOOOO         OOOO  OOOOO

  ;; Derived from QUADPACK QPSRT
  ;;***PURPOSE  Subsidiary to QAGE, QAGIE, QAGPE, QAGSE, QAWCE, QAWOE and
  ;;            QAWSE
  ;;***LIBRARY   SLATEC

  ;; ELIST - list of unsorted errors
  ;; IORD - (O) list of indices which sort ELIST in descending order
  ;; LAST - index of last element (new elt) in ELIST
  ;; LIMIT - maximum size of ELIST

  ;; NRMAX - (O) position in IORD of the maximum error
  ;; MAXERR - (O) position in ELIST of the maximum error
  ;; ERMAX - (O) amount of maximum error
  common qpint1d_profile_common, profvals
;  prof_start = systime(1)

  if (last LE 2) then begin
      iord(1-1) = 1
      iord(2-1) = 2
      goto, LAB90
  endif

;           THIS PART OF THE ROUTINE IS ONLY EXECUTED
;           IF, DUE TO A DIFFICULT INTEGRAND, SUBDIVISION
;           INCREASED THE ERROR ESTIMATE. IN THE NORMAL CASE
;           THE INSERT PROCEDURE SHOULD START AFTER THE
;           NRMAX-TH LARGEST ERROR ESTIMATE.

  errmax = elist(maxerr-1)
  if (nrmax NE 1) then begin
      ido = nrmax-1
      
      for i = 1, ido do begin
          isucc = iord(nrmax-1-1)
; ***JUMP OUT OF DO-LOOP
          if (errmax LE elist(isucc-1)) then goto, LAB30
          iord(nrmax-1) = isucc
          nrmax = nrmax-1
      endfor
  endif

  LAB30:
  jupbn = last
  if (last GT (limit/2+2)) then jupbn = limit+3-last
  errmin = elist(last-1)

;           INSERT ERRMAX BY TRAVERSING THE LIST TOP-DOWN,
;           STARTING COMPARISON FROM THE ELEMENT ELIST(IORD(NRMAX+1)).
  jbnd = jupbn-1
  ibeg = nrmax+1
  if (ibeg LE jbnd) then begin
      for i = ibeg, jbnd do begin
          isucc = iord(i-1)
; ***JUMP OUT OF DO-LOOP
          if (errmax GE elist(isucc-1)) then goto, LAB60
          iord(i-1-1) = isucc
      endfor
  endif
  iord(jbnd-1) = maxerr
  iord(jupbn-1) = last
  goto, LAB90
  
;           INSERT ERRMIN BY TRAVERSING THE LIST BOTTOM-UP.
  LAB60:
  iord(i-1-1) = maxerr
  k = jbnd
  for j=i, jbnd do begin
      isucc = iord(k-1)
; ***JUMP OUT OF DO-LOOP
      if (errmin LT elist(isucc-1)) then goto, LAB80
      iord(k+1-1) = isucc
      k = k-1
  endfor
  iord(i-1) = last
  goto, LAB90
  LAB80:
  iord(k+1-1) = last

;           SET MAXERR AND ERMAX.
  LAB90:
  maxerr = iord(nrmax-1)
  ermax = elist(maxerr-1)
;  profvals.srttime = profvals.srttime + (systime(1) - prof_start)
  return
end

pro qpint1d_gkweights, wg, wgk, xgk, ig, nptsreq, nptsact, prec


  ;; The user has requested NPTSREQ points, however that number may
  ;; not be available.  Filter the number and record the *actual*
  ;; number of points used, NPTSACT


;           THE ABSCISSAE AND WEIGHTS ARE GIVEN FOR THE INTERVAL (-1,1).
;           BECAUSE OF SYMMETRY ONLY THE POSITIVE ABSCISSAE AND THEIR
;           CORRESPONDING WEIGHTS ARE GIVEN.
;
;           XGK    - ABSCISSAE OF THE 21-POINT KRONROD RULE
;                    XGK(2), XGK(4), ...  ABSCISSAE OF THE 10-POINT
;                    GAUSS RULE
;                    XGK(1), XGK(3), ...  ABSCISSAE WHICH ARE OPTIMALLY
;                    ADDED TO THE 10-POINT GAUSS RULE
;
;           WGK    - WEIGHTS OF THE 21-POINT KRONROD RULE
;
;           WG     - WEIGHTS OF THE 10-POINT GAUSS RULE

      ;; gauss quadrature weights and kronron quadrature abscissae and
      ;; weights as evaluated with 80 decimal digit arithmetic by
      ;; l. w. fullerton, bell labs, nov. 1981.
    
  if nptsreq LE 15 then begin
      nptsact = 15
      wg = [ $
             0.129484966168869693270611432679082d0, $
             0.279705391489276667901467771423780d0, $
             0.381830050505118944950369775488975d0, $
             0.417959183673469387755102040816327d0  ]

      xgk = [ $
              0.991455371120812639206854697526329d0, $
              0.949107912342758524526189684047851d0, $
              0.864864423359769072789712788640926d0, $
              0.741531185599394439863864773280788d0, $
              0.586087235467691130294144838258730d0, $
              0.405845151377397166906606412076961d0, $
              0.207784955007898467600689403773245d0, $
              0.000000000000000000000000000000000d0  ]

      wgk = [ $
              0.022935322010529224963732008058970d0, $
              0.063092092629978553290700663189204d0, $
              0.104790010322250183839876322541518d0, $
              0.140653259715525918745189590510238d0, $
              0.169004726639267902826583426598550d0, $
              0.190350578064785409913256402421014d0, $
              0.204432940075298892414161999234649d0, $
              0.209482141084727828012999174891714d0  ]
              
  endif else if nptsreq LE 21 then begin
      nptsact = 21
      wg = [  0.066671344308688137593568809893332d0, $
              0.149451349150580593145776339657697d0, $
              0.219086362515982043995534934228163d0, $
              0.269266719309996355091226921569469d0, $
              0.295524224714752870173892994651338d0  ]

      xgk = [ 0.995657163025808080735527280689003d0, $
              0.973906528517171720077964012084452d0, $
              0.930157491355708226001207180059508d0, $
              0.865063366688984510732096688423493d0, $
              0.780817726586416897063717578345042d0, $
              0.679409568299024406234327365114874d0, $
              0.562757134668604683339000099272694d0, $
              0.433395394129247190799265943165784d0, $
              0.294392862701460198131126603103866d0, $
              0.148874338981631210884826001129720d0, $
              0.000000000000000000000000000000000d0  ]

      wgk = [ 0.011694638867371874278064396062192d0, $
              0.032558162307964727478818972459390d0, $
              0.054755896574351996031381300244580d0, $
              0.075039674810919952767043140916190d0, $
              0.093125454583697605535065465083366d0, $
              0.109387158802297641899210590325805d0, $
              0.123491976262065851077958109831074d0, $
              0.134709217311473325928054001771707d0, $
              0.142775938577060080797094273138717d0, $
              0.147739104901338491374841515972068d0, $
              0.149445554002916905664936468389821d0  ]

  endif else if nptsreq LE 31 then begin
      nptsact = 31
      wg = [ $
             0.03075324199611726834628393577204d0, $
             0.07036604748810812479267416450667d0, $
             0.10715922046717193501869546685869d0, $
             0.13957067792615431447804794511028d0, $
             0.16626920581699393353200860481209d0, $
             0.18616100001556221106800561866423d0, $
             0.19843148532711157646118326443839d0, $
             0.20257824192556127280620199967519d0  ]

      xgk = [ $
              0.99800229869339706025172840152271d0, $
              0.98799251802048542849565718586613d0, $
              0.96773907567913913427347978784337d0, $
              0.93727339240070590437758947710209d0, $
              0.89726453234408190082509656454496d0, $
              0.84820658341042721620648320774217d0, $
              0.79041850144246593297649294817947d0, $
              0.72441773136017004746186054613938d0, $
              0.65099674129741697053735895313275d0, $
              0.57097217260853884757226737253911d0, $
              0.48508186364023968063655740232351d0, $
              0.39415134707756336987207370981045d0, $
              0.29918000715316881216780024266389d0, $
              0.20119409399743452230628303394596d0, $
              0.10114206691871749907074231447392d0, $
              0.00000000000000000000000000000000d0  ]

      wgk = [ $
              0.00537747987292334897792051430128d0, $
              0.01500794732931612258374763075807d0, $
              0.02546084732671532016874001019653d0, $
              0.03534636079137584622037948478360d0, $
              0.04458975132476487668227299373280d0, $
              0.05348152469092808725343147239430d0, $
              0.06200956780067064025139230960803d0, $
              0.06985412131872825879520077099147d0, $
              0.07684968075772037884432777482659d0, $
              0.08308050282313302108289247286104d0, $
              0.08856444305621177067275443693774d0, $
              0.09312659817082532125486872747346d0, $
              0.09664272698362367855179907627589d0, $
              0.09917359872179195932393173484603d0, $
              0.10076984552387559504946662617570d0, $
              0.10133000701479154907374792767493d0  ]
  endif else if nptsreq LE 41 then begin
      nptsact = 41
      wg = [ $
             0.017614007139152118311861962351853d0, $
             0.040601429800386941331039952274932d0, $
             0.062672048334109063569506535187042d0, $
             0.083276741576704748724758143222046d0, $
             0.101930119817240435036750135480350d0, $
             0.118194531961518417312377377711382d0, $
             0.131688638449176626898494499748163d0, $
             0.142096109318382051329298325067165d0, $
             0.149172986472603746787828737001969d0, $
             0.152753387130725850698084331955098d0  ]
      xgk = [ $
              0.998859031588277663838315576545863d0, $
              0.993128599185094924786122388471320d0, $
              0.981507877450250259193342994720217d0, $
              0.963971927277913791267666131197277d0, $
              0.940822633831754753519982722212443d0, $
              0.912234428251325905867752441203298d0, $
              0.878276811252281976077442995113078d0, $
              0.839116971822218823394529061701521d0, $
              0.795041428837551198350638833272788d0, $
              0.746331906460150792614305070355642d0, $
              0.693237656334751384805490711845932d0, $
              0.636053680726515025452836696226286d0, $
              0.575140446819710315342946036586425d0, $
              0.510867001950827098004364050955251d0, $
              0.443593175238725103199992213492640d0, $
              0.373706088715419560672548177024927d0, $
              0.301627868114913004320555356858592d0, $
              0.227785851141645078080496195368575d0, $
              0.152605465240922675505220241022678d0, $
              0.076526521133497333754640409398838d0, $
              0.000000000000000000000000000000000d0  ]
      wgk = [ $
              0.003073583718520531501218293246031d0, $
              0.008600269855642942198661787950102d0, $
              0.014626169256971252983787960308868d0, $
              0.020388373461266523598010231432755d0, $
              0.025882133604951158834505067096153d0, $
              0.031287306777032798958543119323801d0, $
              0.036600169758200798030557240707211d0, $
              0.041668873327973686263788305936895d0, $
              0.046434821867497674720231880926108d0, $
              0.050944573923728691932707670050345d0, $
              0.055195105348285994744832372419777d0, $
              0.059111400880639572374967220648594d0, $
              0.062653237554781168025870122174255d0, $
              0.065834597133618422111563556969398d0, $
              0.068648672928521619345623411885368d0, $
              0.071054423553444068305790361723210d0, $
              0.073030690332786667495189417658913d0, $
              0.074582875400499188986581418362488d0, $
              0.075704497684556674659542775376617d0, $
              0.076377867672080736705502835038061d0, $
              0.076600711917999656445049901530102d0  ]
  endif else if nptsreq LE 51 then begin
      nptsact = 51

      wg = [ $
             0.011393798501026287947902964113235d0, $
             0.026354986615032137261901815295299d0, $
             0.040939156701306312655623487711646d0, $
             0.054904695975835191925936891540473d0, $
             0.068038333812356917207187185656708d0, $
             0.080140700335001018013234959669111d0, $
             0.091028261982963649811497220702892d0, $
             0.100535949067050644202206890392686d0, $
             0.108519624474263653116093957050117d0, $
             0.114858259145711648339325545869556d0, $
             0.119455763535784772228178126512901d0, $
             0.122242442990310041688959518945852d0, $
             0.123176053726715451203902873079050d0  ]

      xgk = [ $
              0.999262104992609834193457486540341d0, $
              0.995556969790498097908784946893902d0, $
              0.988035794534077247637331014577406d0, $
              0.976663921459517511498315386479594d0, $
              0.961614986425842512418130033660167d0, $
              0.942974571228974339414011169658471d0, $
              0.920747115281701561746346084546331d0, $
              0.894991997878275368851042006782805d0, $
              0.865847065293275595448996969588340d0, $
              0.833442628760834001421021108693570d0, $
              0.797873797998500059410410904994307d0, $
              0.759259263037357630577282865204361d0, $
              0.717766406813084388186654079773298d0, $
              0.673566368473468364485120633247622d0, $
              0.626810099010317412788122681624518d0, $
              0.577662930241222967723689841612654d0, $
              0.526325284334719182599623778158010d0, $
              0.473002731445714960522182115009192d0, $
              0.417885382193037748851814394594572d0, $
              0.361172305809387837735821730127641d0, $
              0.303089538931107830167478909980339d0, $
              0.243866883720988432045190362797452d0, $
              0.183718939421048892015969888759528d0, $
              0.122864692610710396387359818808037d0, $
              0.061544483005685078886546392366797d0, $
              0.000000000000000000000000000000000d0  ]

      wgk = [ $
              0.001987383892330315926507851882843d0, $
              0.005561932135356713758040236901066d0, $
              0.009473973386174151607207710523655d0, $
              0.013236229195571674813656405846976d0, $
              0.016847817709128298231516667536336d0, $
              0.020435371145882835456568292235939d0, $
              0.024009945606953216220092489164881d0, $
              0.027475317587851737802948455517811d0, $
              0.030792300167387488891109020215229d0, $
              0.034002130274329337836748795229551d0, $
              0.037116271483415543560330625367620d0, $
              0.040083825504032382074839284467076d0, $
              0.042872845020170049476895792439495d0, $
              0.045502913049921788909870584752660d0, $
              0.047982537138836713906392255756915d0, $
              0.050277679080715671963325259433440d0, $
              0.052362885806407475864366712137873d0, $
              0.054251129888545490144543370459876d0, $
              0.055950811220412317308240686382747d0, $
              0.057437116361567832853582693939506d0, $
              0.058689680022394207961974175856788d0, $
              0.059720340324174059979099291932562d0, $
              0.060539455376045862945360267517565d0, $
              0.061128509717053048305859030416293d0, $
              0.061471189871425316661544131965264d0, $
              0.061580818067832935078759824240066d0  ]
;       note: wgk (26) was calculated from the values of wgk(1..25)

  endif else begin
      nptsact = 61

      wg = [ $
             0.007968192496166605615465883474674d0, $
             0.018466468311090959142302131912047d0, $
             0.028784707883323369349719179611292d0, $
             0.038799192569627049596801936446348d0, $
             0.048402672830594052902938140422808d0, $
             0.057493156217619066481721689402056d0, $
             0.065974229882180495128128515115962d0, $
             0.073755974737705206268243850022191d0, $
             0.080755895229420215354694938460530d0, $
             0.086899787201082979802387530715126d0, $
             0.092122522237786128717632707087619d0, $
             0.096368737174644259639468626351810d0, $
             0.099593420586795267062780282103569d0, $
             0.101762389748405504596428952168554d0, $
             0.102852652893558840341285636705415d0  ]

      xgk = [ $
              0.999484410050490637571325895705811d0, $
              0.996893484074649540271630050918695d0, $
              0.991630996870404594858628366109486d0, $
              0.983668123279747209970032581605663d0, $
              0.973116322501126268374693868423707d0, $
              0.960021864968307512216871025581798d0, $
              0.944374444748559979415831324037439d0, $
              0.926200047429274325879324277080474d0, $
              0.905573307699907798546522558925958d0, $
              0.882560535792052681543116462530226d0, $
              0.857205233546061098958658510658944d0, $
              0.829565762382768397442898119732502d0, $
              0.799727835821839083013668942322683d0, $
              0.767777432104826194917977340974503d0, $
              0.733790062453226804726171131369528d0, $
              0.697850494793315796932292388026640d0, $
              0.660061064126626961370053668149271d0, $
              0.620526182989242861140477556431189d0, $
              0.579345235826361691756024932172540d0, $
              0.536624148142019899264169793311073d0, $
              0.492480467861778574993693061207709d0, $
              0.447033769538089176780609900322854d0, $
              0.400401254830394392535476211542661d0, $
              0.352704725530878113471037207089374d0, $
              0.304073202273625077372677107199257d0, $
              0.254636926167889846439805129817805d0, $
              0.204525116682309891438957671002025d0, $
              0.153869913608583546963794672743256d0, $
              0.102806937966737030147096751318001d0, $
              0.051471842555317695833025213166723d0, $
              0.000000000000000000000000000000000d0  ]

      wgk = [ $
              0.001389013698677007624551591226760d0, $
              0.003890461127099884051267201844516d0, $
              0.006630703915931292173319826369750d0, $
              0.009273279659517763428441146892024d0, $
              0.011823015253496341742232898853251d0, $
              0.014369729507045804812451432443580d0, $
              0.016920889189053272627572289420322d0, $
              0.019414141193942381173408951050128d0, $
              0.021828035821609192297167485738339d0, $
              0.024191162078080601365686370725232d0, $
              0.026509954882333101610601709335075d0, $
              0.028754048765041292843978785354334d0, $
              0.030907257562387762472884252943092d0, $
              0.032981447057483726031814191016854d0, $
              0.034979338028060024137499670731468d0, $
              0.036882364651821229223911065617136d0, $
              0.038678945624727592950348651532281d0, $
              0.040374538951535959111995279752468d0, $
              0.041969810215164246147147541285970d0, $
              0.043452539701356069316831728117073d0, $
              0.044814800133162663192355551616723d0, $
              0.046059238271006988116271735559374d0, $
              0.047185546569299153945261478181099d0, $
              0.048185861757087129140779492298305d0, $
              0.049055434555029778887528165367238d0, $
              0.049795683427074206357811569379942d0, $
              0.050405921402782346840893085653585d0, $
              0.050881795898749606492297473049805d0, $
              0.051221547849258772170656282604944d0, $
              0.051426128537459025933862879215781d0, $
              0.051494729429451567558340433647099d0  ]
  endelse

  nhalf  = (nptsact-1)/2
  nquart = (nptsact-1)/4
  wgk = [  wgk(0:nhalf-1), rotate(wgk,2) ]
  xgk = [ -xgk(0:nhalf-1), rotate(xgk,2) ]
  wg  = [wg(0:nquart-1), rotate(wg,2)]
  ig  = lindgen(nhalf)*2 + 1

  ;; Convert to float from double if requested
  if prec EQ 0 then begin
      wgk = float(wgk)
      xgk = float(xgk)
      wg  = float(wg)
  endif
end

;; Evaluate a user-supplied expression
function qpint1d_eval, x, p, expression=expr
  y = 0
  cmd = 'Y = '+expr
  dummy = execute(cmd)
  if dummy NE 1 then begin
      err_string = ''+!error_state.msg
      message, 'ERROR: failed to execute expression "'+expr+'" ('+err_string+')'
  endif
  return, y
end

;; The outer routine which does most of the preparation and special
;; cases.
function qpint1d, f0, a0, b0, private, npoints=npoints, expression=expr, $
                  epsabs=epsabs, epsrel=epsrel, error=abserr, nfev=neval, $
                  status=ier, functargs=fa, limit=limit, nsubintervals=nsub, $
                  sym_axis=symaxis, symmetric=symmetric, breakpoints=bpoints0,$
                  alist=alist, blist=blist, rlist=rlist, $
                  elist=elist, iord=iord, nocatch=nocatch

  ;; Derived from QUADPACK QAGS
  ;;***PURPOSE  The routine calculates an approximation result to a given
  ;;            Definite integral  I = Integral of F over (A,B),
  ;;            Hopefully satisfying following claim for accuracy
  ;;           ABS(I-RESULT).LE.MAX(EPSABS,EPSREL*ABS(I)).
  ;;***LIBRARY   SLATEC (QUADPACK)

  if keyword_set(query) then return, 1
  common qpint1d_profile_common, profvals
  qpint1d_profile

  if n_params() EQ 0 then begin
      USAGE:
      message, 'USAGE:', /info
      message, ' G = QPINT1D(FUNCNAME, A, B, $', /info
      message, '             [EPSABS=, EPSREL=, ERROR=, STATUS=])', /info
      message, '      (or)', /info
      message, ' G = QPINT1D(EXPR, A, B, /EXPRESSION, $', /info
      message, '             [EPSABS=, EPSREL=, ERROR=, STATUS=])', /info
      return, !values.d_nan
  endif
  if n_elements(f0) EQ 0 OR n_elements(a0) EQ 0 OR n_elements(b0) EQ 0 then $
    goto, USAGE

  sz = size(f0)
  if sz(sz(0)+1) NE 7 OR n_elements(f0) NE 1 then begin
      message, 'ERROR: FUNCT must be a scalar string', /info
      return, !values.d_nan
  endif

  ;; Handle error conditions gracefully
  if NOT keyword_set(nocatch) then begin
      catch, catcherror
      if catcherror NE 0 then begin
          catch, /cancel
          message, 'Error detected while integrating "'+f0(0)+'"', /info
          message, !err_string, /info
          errmsg = 0
          if NOT keyword_set(expr) then begin
              f1 = byte(strupcase(strtrim(f0(0),2)))
              ca = (byte('A'))(0) 
              cz = (byte('Z'))(0) 
              c0 = (byte('0'))(0) 
              c9 = (byte('9'))(0) 
              c_ = (byte('_'))(0) 
              wh = where((f1 GE ca AND f1 LE cz) EQ 0 AND f1 NE c_ $
                         AND (f1 GE c0 AND f1 LE c9) EQ 0, ct)
              if ct GT 0 OR (f1(0) GE c0 AND f1(0) LE c9) then begin
                  message, ('FUNCT appears to be an expression.  Did you '+$
                            'intend to pass the /EXPRESSION keyword?'), /info
                  errmsg = 1
              endif
          endif
          if errmsg EQ 0 then $
            message, ('Please verify that function works and conforms to '+$
                      'the documentation'), /info
          ier = -1L
          return, !values.d_nan
      endif
  endif
  
;  prof_start = systime(1)
  neval = 0L
  sza = size(a0)
  szb = size(b0)
  ;; Determine the data precision, i.e. single or double precision
  if sza(sza(0)+1) EQ 5 OR szb(szb(0)+1) EQ 5 then begin
      isdouble = 1
      zero = 0D
      reldef = 1e-6
      a = double(a0(0))
      b = double(b0(0))
  endif else begin
      isdouble = 0
      zero = 0.
      reldef = 1e-4
      a = float(a0(0))
      b = float(b0(0))
  endelse
  qpint1d_setmachar, double=isdouble

  ;; Default values
  if n_elements(limit) EQ 0 then limit = 100L
  if n_elements(epsrel) EQ 0 then epsrel = zero + reldef
  if n_elements(epsabs) EQ 0 then epsabs = zero

  ;; Establish the initial return values return
  abserr = zero
  result = zero
  if a EQ b then begin
      ier = 0L
      return, result
  endif

  ;; Now prepare for potentially one or two integrals, depending on
  ;; whether the integral is fully infinite, or only partially
  infa = finite(a) EQ 0
  infb = finite(b) EQ 0

  if infa AND infb then begin
      ;; Fully infinite: break it into two partial integrals
      if n_elements(symaxis0) EQ 0 then symaxis = zero $
      else                              symaxis = zero + symaxis0(0)

      a1 = symaxis & b1 = b
      a2 = symaxis & b2 = a
      ef = 2.  ;; Each integral contributes half of error budget
  endif else if infa then begin
      ;; Partially infinite, [a,inf]: do only second partial integral
      a1 = zero    & b1 = zero
      a2 = b       & b2 = a
      ef = 1.
  endif else begin
      ;; Partially infinite, [inf,b]: do only first partial integral
      a1 = a       & b1 = b
      a2 = zero    & b2 = zero
      ef = 1.
  endelse

  ;; Prepare for EXPRESSION if requested
  if keyword_set(expr) then begin
      f = 'QPINT1D_EVAL'
      fa = {expression: strtrim(f0(0),2)}
  endif else begin
      f = strtrim(f0(0),2)
  endelse

  ;; Call first partial integral if requested
  ier = 0L
  neval = 0L
  nsub = 0L
  if a1 NE b1 then begin
      qpint1d_qagse, f, a1, b1, result, abserr, private, functargs=fa, $
        epsabs=epsabs/ef, epsrel=epsrel/ef, breakpoints=bpoints0, $
        status=ier, limit=limit, neval=neval, nsubintervals=nsub, $
        alist=alist, blist=blist, rlist=rlist, elist=elist, iord=iord, $
        npoints=npoints
  endif

  ;; Return if an error condition was detected
  if ier EQ 6 then ier = -1L
  if ier EQ -1 OR ier EQ 3 then return, result

  ;; Now call the second partial integral if requested
  if a2 NE b2 then begin
      qpint1d_qagse, f, a2, b2, result2, abserr2, private, functargs=fa, $
        epsabs=epsabs/ef, epsrel=epsrel/ef, breakpoints=bpoints0, $
        status=ier, limit=limit, neval=neval2, nsubintervals=nsub2, $
        alist=alist, blist=blist, rlist=rlist, elist=elist, iord=iord, $
        npoints=npoints

      ;; Merge the two results together
      result = result - result2
      abserr = abserr + abserr2
      neval  = neval  + neval2
      nsub   = nsub   + nsub2
  endif

;  profvals.tottime = profvals.tottime + (systime(1) - prof_start)

  ;; Convert from QUADPACK to QPINT1D errors
  if ier EQ 6 then ier = -1L
  return, result
end
;+
; NAME:
;   QRFAC
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Perform QR decomposition of a rectangular matrix
;
; MAJOR TOPICS:
;   Linear Systems
;
; CALLING SEQUENCE:
;   QRFAC, A, R, [ IPVT, /PIVOT, QMATRIX=qmatrix ]
;
; DESCRIPTION:
;
;  Given an MxN matrix A (M>N), the procedure QRFAC computes the QR
;  decomposition (factorization) of A.  This factorization is useful
;  in least squares applications solving the equation, A # x = B.
;  Together with the procedure QRSOLV, this equation can be solved in
;  a least squares sense.
;
;  The QR factorization produces two matrices, Q and R, such that
;
;     A = Q ## R
;
;  where Q is orthogonal such that TRANSPOSE(Q)##Q equals the identity
;  matrix, and R is upper triangular.  This procedure does not compute
;  Q directly, but returns the more-compact Householder reflectors,
;  which QRSOLV applies in constructing the solution.
;
;  Pivoting can be performed by setting the PIVOT keyword.  Rows with
;  the largest L2-norm are pivoted into the top positions of the
;  matrix.  The permutation matrix is returned in the IPVT parameter.
;
;
; PARAMETERS:
;
;   A - upon input, an MxN matrix ( =XARRAY(M,N) ) to be factored,
;       where M is greater than N.
;
;       Upon output, the upper triangular MxN matrix of Householder
;       reflectors used in reconstructing Q.  Obviously the original
;       matrix A is destroyed upon output.
;
;       Note that the dimensions of A in this routine are the
;       *TRANSPOSE* of the conventional appearance in the least
;       squares matrix equation.
;
;   R - upon ouptut, an upper triangular NxN matrix
;
;   IPVT - upon output, the permutation indices used in partial
;          pivoting.  If pivoting is used, this array should be passed
;          to the PIVOTS keyword of QRSOLV.  If the PIVOT keyword is
;          not set, then IPVT returns an unpermuted array of indices.
;
; KEYWORD PARAMETERS:
;
;   PIVOT - if set, then partial pivoting is performed, to bring the
;           rows with the largest norm to the top of the matrix.
;
;   QMATRIX - upon return, the fully explicit "Q" matrix is returned.
;             This matrix is optional since the Householder vectors
;             needed to solve QR problems, and to compute QMAT, are
;             also stored in A.  This square matrix can be used to
;             perform explicit matrix multiplication (although not
;             super efficiently).
;
;
; IMPLEMENTATION NOTE:
;
;   Upon return, A is in standard parameter order; A(*,IPVT) is in
;   permuted order.  RDIAG and QMATRIX are in permuted order upon
;   return.  QRSOLV accounts for these facts at the solution stage.
;
; EXAMPLE:
;
;  Decompose the 3x2 matrix [[9.,2.,6.],[4.,8.,7.]]
;    aa = [[9.,2.,6.],[4.,8.,7.]]
;    qrfac, aa, r, ipvt
;
;     IDL> print, aa
;          1.81818      0.181818      0.545455 
;         XXXXXXXXX      1.90160      0.432573 
;    (position marked with Xs is undefined)
;
;  Construct the matrix Q by expanding the Householder reflectors
;  returned in AA.  ( M = 3, N = 2 )  This same procedure is
;  accomplished by using the QMATRIX keyword.
;
;    ident = fltarr(m,m)  ;; Construct an identity matrix
;    ident(lindgen(m),lindgen(m)) = 1
;
;    q = ident
;    for i = 0, n-1 do begin
;     v = aa(*,i) & if i GT 0 then v(0:i-1) = 0  ;; extract reflector
;     q = q ## (ident - 2*(v # v)/total(v * v))  ;; generate matrix
;    endfor
;
;  Verify that Q ## R returns to the original AA
;
;     print, q(0:1,*) ## r
;         9.00000      4.00000
;         2.00000      8.00000
;         6.00000      7.00000
;     (transposed)
;
;  See example in QRSOLV to solve a least squares problem.
;   
;
; REFERENCES:
;
;   More', Jorge J., "The Levenberg-Marquardt Algorithm:
;     Implementation and Theory," in *Numerical Analysis*, ed. Watson,
;     G. A., Lecture Notes in Mathematics 630, Springer-Verlag, 1977.
;
; MODIFICATION HISTORY:
;   Written (taken from MPFIT), CM, Feb 2002
;   Added usage message, error checking, CM 15 Mar 2002
;   Corrected error in EXAMPLE, CM, 10 May 2002
;   Now returns Q matrix explicitly if requested, CM, 14 Jul 2002
;   Documented QMATRIX keyword, CM, 22 Jul 2002
;   Corrected errors in computations of R and Q matrices when
;     pivoting, CM, 21 May 2004
;   Small correction to documentation, CM, 05 Oct 2007
;   Documentation, CM, 17 Dec 2007
;
;  $Id: qrfac.pro,v 1.9 2007/12/17 10:29:29 craigm Exp $
;
;-
; Copyright (C) 2002, 2004, 2007, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;  if m LT n then begin
;      message, 'ERROR: A must be an MxN matrix where M > N', /info
;      goto, USAGE
;  endif

  machvals = machar(double=(tp EQ 5))
  
  MACHEP0 = machvals.eps
  
  ;; Compute the initial column norms and initialize arrays
  acnorm = make_array(n, value=a(0)*0.)
  for j = 0L, n-1 do $
    acnorm(j) = sqrt(total(a(*,j)^2))
  rdiag = acnorm
  wa = rdiag
  ipvt = lindgen(n)

  ;; Reduce a to r with householder transformations
  minmn = min([m,n])
  for j = 0L, minmn-1 do begin
      if NOT keyword_set(pivot) then goto, HOUSE1
      
      ;; Bring the column of largest norm into the pivot position
      rmax = max(rdiag(j:*))
      kmax = where(rdiag(j:*) EQ rmax, ct) + j
      if ct LE 0 then goto, HOUSE1
      kmax = kmax(0)
      
      ;; Exchange rows via the pivot only.  Avoid actually exchanging
      ;; the rows, in case there is lots of memory transfer.  The
      ;; exchange occurs later, within the body of MPFIT, after the
      ;; extraneous columns of the matrix have been shed.
      if kmax NE j then begin
          temp     = ipvt(j)   & ipvt(j)    = ipvt(kmax) & ipvt(kmax)  = temp
          rdiag(kmax) = rdiag(j)
          wa(kmax)    = wa(j)
      endif
      
      HOUSE1:

      ;; Compute the householder transformation to reduce the jth
      ;; column of A to a multiple of the jth unit vector
      lj     = ipvt(j)
      ajj    = a(j:*,lj)
      ajnorm = sqrt(total(ajj^2))
      if ajnorm EQ 0 then goto, NEXT_ROW
      if a(j,lj) LT 0 then ajnorm = -ajnorm
      
      ajj     = ajj / ajnorm
      ajj(0)  = ajj(0) + 1
      ;; *** Note optimization a(j:*,j)
      a(j,lj) = ajj
      
      ;; Apply the transformation to the remaining columns
      ;; and update the norms

      ;; NOTE to SELF: tried to optimize this by removing the loop,
      ;; but it actually got slower.  Reverted to "for" loop to keep
      ;; it simple.
      if j+1 LT n then begin
          for k=j+1, n-1 do begin
              lk = ipvt(k)
              ajk = a(j:*,lk)
              ;; *** Note optimization a(j:*,lk) 
              ;; (corrected 20 Jul 2000)
              if a(j,lj) NE 0 then $
                a(j,lk) = ajk - ajj * total(ajk*ajj)/a(j,lj)

              if keyword_set(pivot) AND rdiag(k) NE 0 then begin
                  temp = a(j,lk)/rdiag(k)
                  rdiag(k) = rdiag(k) * sqrt((1.-temp^2) > 0)
                  temp = rdiag(k)/wa(k)
                  if 0.05D*temp*temp LE MACHEP0 then begin
                      rdiag(k) = sqrt(total(a(j+1:*,lk)^2))
                      wa(k) = rdiag(k)
                  endif
              endif
          endfor
      endif

      NEXT_ROW:
      rdiag(j) = -ajnorm
  endfor

  r = fltarr(minmn,minmn)+a(0)*0
  for j = 1, minmn-1 do r(j,0:j-1) = a(0:j-1,ipvt(j))
  idiag = lindgen(minmn)
  r(idiag, idiag) = rdiag
  
  ;; Construct matrix Q explicitly, if requested
  forward_function arg_present
  if arg_present(qmat) then begin

      ident = fltarr(m,m)  ;; Construct an identity matrix
      ident(lindgen(m),lindgen(m)) = 1
      qmat = ident

      for i = 0L, n-1 do begin
          v = a(*,ipvt(i)) ;; extract reflector
          if i GT 0 then v(0:i-1) = 0  
          qmat = qmat ## (ident - 2*(v # v)/total(v * v))  ;; generate matrix
      endfor
      
  endif

  return
end
;+
; NAME:
;   QRSOLV
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Solve a linear equation after performing QR factorization
;
; MAJOR TOPICS:
;   Linear Systems
;
; CALLING SEQUENCE:
;   X = QRSOLV(A, R, B, PIVOTS=IPVT)
;
; DESCRIPTION:
;
;  The procedure QRSOLV completes the solution of a linear equation,
;
;        A ## x = B
;
;  after the MxN matrix has been factorized by QR decomposition.
;  After being factorized once using QRFAC, the matrices can be used
;  for multiple righthand sides (i.e., different B's).
;
;  The solution technique is to first compute the factorization using
;  QRFAC, which yields the orthogonal matrix Q and the upper
;  triangular matrix R.  [ Actually, Q is represented by its
;  Householder reflectors. ]  Then the solution vector, X, is computed
;  using QRSOLV.
;
;  If pivoting was performed in the factorization, the permutation
;  vector IPVT returned by QRFAC must also be passed to QRSOLV.
;  
;
; PARAMETERS:
;
;   A - upon input, the factorized matrix A, returned by QRFAC.
;
;   R - upon input, the upper diagonal matrix R, returned by QRFAC.
;
;   B - upon input, the righthand vector B, which fits into the
;       equation,  A ## x = B
;
;   X - upon ouptut, the solution vector X, to the above linear
;       equation.  For an overdetermined system, X is the least
;       squares solution which minimizes TOTAL( (A ## X - B)^2 ).
;
;
; KEYWORD PARAMETERS:
;
;   PIVOTS - upon input, the permutation matrix IPVT returned by
;            QRFAC, if pivoting is to be performed.
;
;
; EXAMPLE:
;
;  Solve the equation A ## X = B, in the least squares sense, where:
;
;    A = [[1.0,1.0,1.0,1.0,1.0,1.0],$
;         [0.6,0.8,0.5,0.8,0.7,0.9],$
;         [0.2,0.3,0.1,0.4,0.3,0.4]]
;
;  and B = [0.57E,0.69,0.5,0.7,0.6,0.8]
;
;  qrfac, a, r, ipvt, /PIVOT
;  x = qrsolv(a, r, b, PIVOTS=ipvt)
;
;  print, x
;       0.0834092     0.852273    -0.179545
;
; REFERENCES:
;
;   More', Jorge J., "The Levenberg-Marquardt Algorithm:
;     Implementation and Theory," in *Numerical Analysis*, ed. Watson,
;     G. A., Lecture Notes in Mathematics 630, Springer-Verlag, 1977.
;
; MODIFICATION HISTORY:
;   Written (taken from MPFIT), CM, Feb 2002
;   Usage message, error checking, CM, 15 Mar 2002
;   Error checking is fixed, CM, 10 May 2002
;   Found error in return of permuted results, CM, 21 May 2004
;
;  $Id: qrsolv.pro,v 1.4 2004/05/22 02:16:02 craigm Exp $
;
;-
; Copyright (C) 2002, 2004, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QTANG
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Find rotation angle(s) of unit quaternion
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   PHI = QTANG(Q)
;
; DESCRIPTION:
;
;  The function QTANG accepts a unit quaternion Q and returns the
;  rotation angle PHI of the quaternion.
;
;  Use QTAXIS and QTANG to extract the properties of an existing
;  quaternion.  Use QTCOMPOSE to combine a rotation axis and angle
;  into a new quaternion.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
; INPUTS:
;
;  Q - array of one or more unit quaternions.  For a single
;      quaternion, Q should be a 4-vector.  For N quaternions, Q
;      should be a 4xN array.
;
; RETURNS:
;
;  For a single quaternion, returns the scalar quaternion rotation
;  angle in radians.  For N quaternions, returns an N-vector of
;  rotation angles.
;
; KEYWORD PARAMETERS:
;
;  NONE
;
; EXAMPLE:
;
;   IDL> print, qtang(qtcompose([0d,1,0], !dpi/4))
;         0.78539816
;
;   Prints the angle part of the quaternion composed of a rotation of
;   !dpi/4 radians around the axis [0,1,0]
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Usage message, error checking, 15 Mar 2002, CM
;
;  $Id: qtang.pro,v 1.6 2008/12/14 20:00:31 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QTAXIS
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Find rotation axis of unit quaternion
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   VAXIS = QTAXIS(Q)
;
; DESCRIPTION:
;
;  The function QTAXIS accepts a unit quaternion Q and returns the
;  rotation axis VAXIS as a unit vector.  
;
;  Use QTAXIS and QTANG to extract the properties of an existing
;  quaternion.  Use QTCOMPOSE to combine a rotation axis and angle
;  into a new quaternion.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
; INPUTS:
;
;  Q - array of one or more unit quaternions.  For a single
;      quaternion, Q should be a 4-vector.  For N quaternions, Q
;      should be a 4xN array.
;
; RETURNS:
;
;  For a single quaternion, returns the rotation axis unit vector in a
;  3-vector. For N quaternions, returns a 3xN-vector of rotation
;  axis unit vectors.
;
; KEYWORD PARAMETERS:
;
;  NONE
;
; EXAMPLE:
;
;   IDL> print, qaxis(qtcompose([0d,1,0], !dpi/4))
;          0.0000000       1.0000000       0.0000000
;
;   Prints the axis part of the quaternion composed of a rotation of
;   !dpi/4 radians around the axis [0,1,0]
;
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Correct error in normalization, 26 Jan 2002, CM
;   Usage message, error checking, 15 Mar 2002, CM
;
;  $Id: qtaxis.pro,v 1.7 2008/12/14 20:00:31 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QTCOMPOSE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Convert a rotation angle and axis into quaternion
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   Q = QTCOMPOSE(VAXIS, PHI)
;
; DESCRIPTION:
;
;  The function QTCOMPOSE accepts a unit vector rotation axis VAXIS
;  and a rotation angle PHI, and returns the corresponding quaternion.
;
;  The user must take care to pass the same number of axes as rotation
;  angles.
;
;  Use QTAXIS and QTANG to extract the properties of an existing
;  quaternion.  Use QTCOMPOSE to combine a rotation axis and angle
;  into a new quaternion.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
; INPUTS:
;
;  VAXIS - array of one or more unit vectors specifying the rotation
;          axes.  For a single rotation, VAXIS should be a 3-vector.
;          For N vectors, VAXIS should be a 3xN array.
;
;  PHI - one or more rotation angles, in radians.  For a single
;        rotation, PHI should be a scalar.  For N rotations, PHI
;        should be an N-vector.
;
; RETURNS:
;
;  For a single rotation, returns a quaternion as a 4-vector.  For N
;  rotations, returns a 4xN vector of quaternions.
;
;
; KEYWORD PARAMETERS:
;
;  NONE
;
; EXAMPLE:
;
;   IDL> print, qtcompose([0d,1,0], !dpi/4)
;          0.0000000      0.38268343       0.0000000      0.92387953
;
;   Prints the quaternion composed of a rotation of !dpi/4 radians
;   around the axis [0,1,0]
;
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Allow output to be DOUBLE, 27 Jan 2002, CM
;   Allow vector vs scalar arguments, 28 Jan 2002, CM
;   Usage message, error checking, 15 Mar 2002, CM
;
;  $Id: qtcompose.pro,v 1.11 2008/12/14 20:00:31 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QTERP
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Smoothly interpolate from a grid of quaternions (spline or slerp)
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   QNEW = QTERP(TGRID, QGRID, TNEW, [/SLERP], QDIFF=, [/RESET])
;
; DESCRIPTION:
;
;  The function QTERP is used to interplate from a set of known unit
;  quaternions specified on a grid of independent values, to a new set
;  of independent values.  For example, given a set of quaternions at
;  specified key times, QTERP can interpolate at any points between
;  those times.  This has applications for computer animation and
;  spacecraft attitude control.
;
;  The "grid" of quaternions can be regularly or irregularly sampled.
;  The new values can also be regularly or irregularly sampled.
;
;  The simplest case comes when one wants to interpolate between two
;  quaternions Q1 and Q2.  In that case the user should specify the
;  gridded quaterion as QGRID = [[Q1], [Q2]], with grid points at
;  TGRID = [0d, 1d].  Then the user can sample any intermediate
;  orientation by specifying TNEW anywhere between 0 and 1.
;
;  The user has the option of performing pure spline interpolation of
;  the quaternion components (the default technique).  The resulting
;  interpolants are normalized to be unit quaternions.  This option is
;  useful for fast interpolation of quaternions, but suffers if the
;  grid is not well sampled enough.  Spline interpolation will not
;  strictly find the shortest path between two orientations.
;
;  The second option is to use Spherical Linear IntERPolation, or
;  SLERPing, to interpolate between quaternions (by specifying the
;  SLERP keyword).  This technique is guaranteed to find the shortest
;  path between two orientations, but is somewhat slower than spline
;  interpolation.  This approach involves computing a finite
;  difference of the data.  To avoid repeated computation of the
;  difference on every call, users can pass a named variable in the
;  QDIFF keyword.  This value can be reset with the RESET keyword.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
;  Users must have the VALUE_LOCATE() function, available either in
;  IDL 5.3 or later, or from the Markwardt web page.
;
; INPUTS:
;
;   TGRID - a vector of N independent variable values.  In the
;           simplest case, this can be [0, 1, ...] up to the number of
;           quaternions in the grid.  The grid sampling does not have
;           to be uniform.
;
;   QGRID - an 4xN array of unit quaternions specified on the grid.
;
;   TNEW - a vector of M desired independent variable values which
;          sample the grid specified by TGRID.  The desired values do
;          not have to be uniformly sampled.
;
; RETURNS:
;
;   A 4xM array of unit quaternions, where is M is the number of
;   desired samples.
;
;
; KEYWORD PARAMETERS:
;
;   SLERP - if set, then spherical linear interpolation is performed.
;           The default is to perform spline interpolation on the
;           quaternion coefficients.
;
;   QDIFF - upon return, QDIFF is filled with finite difference values
;           which can be used to speed computations in subsequent
;           calls.  Users should be aware that QDIFF may be
;           inadvertently reused from one call to the next.  When the
;           difference data should no longer be reused, the named
;           variable passed to the QDIFF keyword should be set to a
;           scalar, or the /RESET keyword should be used.
;
;   RESET - if set, then the QDIFF finite difference will be forced to
;           be recalculated, even if there is already data present and
;           passed to the QDIFF keyword.
;
;
; EXAMPLE:
;
;   This example starts with two quaternions representing rotations of
;   0 degrees and 45 degrees, and forms 1001 quaternions which are
;   smooth interpolations between 0 and 45 degrees.
;
;   ;; Create a grid of two quaternions at times 0 and 1
;   Q0 = qtcompose([1,0,0], 0D)       & T0 = 0D
;   Q1 = qtcompose([1,0,0], !dpi/4)   & T1 = 1D
;
;   ;; Put the grid elements into an array
;   TGRID = [T0, T1]
;   QGRID = [[Q0], [Q1]]
;
;   ;; Make an array of 11 values smoothly varying from 0 to 1
;   TNEW = dindgen(11)/10d
;
;   ;; Perform spherical linear interpolation
;   QNEW = QTERP(TGRID, QGRID, TNEW, /SLERP)
;
;   --->  (interpolated results in QNEW)
;  
;       0.0000000       0.0000000       0.0000000       1.0000000
;     0.039259816       0.0000000       0.0000000      0.99922904
;     0.078459096       0.0000000       0.0000000      0.99691733
;      0.11753740       0.0000000       0.0000000      0.99306846
;      0.15643447       0.0000000       0.0000000      0.98768834
;      0.19509032       0.0000000       0.0000000      0.98078528
;      0.23344536       0.0000000       0.0000000      0.97236992
;      0.27144045       0.0000000       0.0000000      0.96245524
;      0.30901699       0.0000000       0.0000000      0.95105652
;      0.34611706       0.0000000       0.0000000      0.93819134
;      0.38268343       0.0000000       0.0000000      0.92387953
;   
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Usage message; check for 0- and 1-length quaternions; handle case
;      when quaternions are GE 180 degrees apart; handle case of
;      interpolating beyond end of known grid, 15 Mar 2002, CM
;   Use simplified QTMULT with /INV, 21 Sep 2007, CM
;   Added sample output, 29 Sep 2008, CM
;   Handle pathalogical case when some input quaternions were NAN,
;     2012-10-10, CM
;
;  $Id: qterp.pro,v 1.9 2012/10/10 23:27:05 cmarkwar Exp $
;
;-
; Copyright (C) 2001, 2002, 2007, 2008, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QTEULER
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compose a series of euler-type rotations into a single quaternion
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   Q = QTEULER(AXES, ANG0, ANG1, ... )
;
; DESCRIPTION:
;
;  The function QTEULER composes a series of Euler-type rotations into
;  a single set of quaternion representations.
;
;  The user specifies a set of axes, and the angles to rotation about
;  those axes, and QTEULER constructs the corresponding quaternion.
;
;  There must be a one-to-one correspondence between the elements of
;  AXES and the number of rotations.  AXES specifies the rotation axes
;  as an string, which must be one of 'X', 'Y', or 'Z'.  Other axes
;  are invalid.  For example, the following call:
;
;    QTEULER(['X','Z'], THETA, PHI)
;
;  will rotate first about the *Z* axis by the angle PHI, and then
;  around the *resulting X* axis by angle THETA.
;
;  Several things are worth noting here.  First, rotations are applied
;  first from the right, not the left.  This conforms to the usual
;  matrix notation for applying rotations to a vector on the right
;  hand side.  For example, in matrix notation,
;
;      XNEW = A3 A2 A1 XOLD
;
;  applies first A1, then A2 and finally A3 to the XOLD vector,
;  resulting in the new vector XNEW.  The same semantics apply here.
;
;  A second thing to bear in mind is that the axes themselves change
;  during the rotations.  Thus, the coordinates specified in AXES
;  should be considered attached to the "body" and not the inertial
;  frame.
;
;
; INPUTS:
;
;  AXES - a string array, specifies the rotation axes.  Rotations are
;         applied last element first.  Each element of AXES must be
;         one of 'X', 'Y' or 'Z'.
;
;  ANG0, ..., ANGi - the successive rotation angles. [radians]  
;         Angle ANGi corresponds to axis AXES(i).
;
;         If ANGi is a scalar, then it will be promoted to a vector
;         the same size as the other rotation angles being performed.
;         Otherwise, if the angles ANGi are vectors, then they must
;         all be of the same size.
;
; RETURNS:
;
;  The resulting quaternion (or, if ANGi are vectors, array of
;  quaternions), which represent the requested rotations.
;
;
; KEYWORD PARAMETERS:
;
;  NONE
;
; EXAMPLE:
;
;    ;;              Precession        Nutation    
;    qtot = qteuler(['z','y','z',      'x','z','x'        ], $
;                    -zeta, +theta, -z, +eps0, -dpsi, -eps)
;
;   Applies a series of rotations to correct for earth nutation and
;   precession.  The order of rotations on a vector would be
;   X-Z-X-Z-Y-Z (i.e., the reverse order printed).
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, 27 Jan 2002, CM
;   More error checking, 03 Mar 2002, CM
;
;  $Id: qteuler.pro,v 1.5 2012/09/27 23:53:08 cmarkwar Exp $
;
;-
; Copyright (C) 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; Extract axis ei and angle angi
pro qteuler_extract, ax, i, ei, angi, $
                     ang0, ang1, ang2, ang3, ang4, $
                     ang5, ang6, ang7, ang8, ang9, $
                     status=status, errmsg=errmsg
                     
  status = 0
  zero = ang0(0)*0
  ex = [1,zero,zero] & ey = [zero,1,zero] & ez = [zero,zero,1]

  ei = [0D, 0D, 0D]

  if execute('ei = e'+ax(i)+' & angi = ang'+strtrim(i,2)) NE 1 then begin
      stop
      errmsg = 'Invalid axis specification'
      return
  endif

  status = 1
  return
end

function qteuler, axes, block=block, $
            ang0, ang1, ang2, ang3, ang4, ang5, ang6, ang7, ang8, ang9, $
            ang10, ang11, ang12, ang13, ang14, ang15

  if n_params() EQ 0 then begin
      info = 1
      USAGE_ERR:
      message, 'USAGE: Q = QTEULER(AXES, ANG0, ...)', /info
      message, '  AXES = ["X",...]    ("X" or "Y" or "Z")', /info
      message, '  ANGn = rotation angle (radians)', info=info
      return, 0
  endif
  if n_elements(axes) LT 1 OR n_elements(ang0) LT 1 then $
    goto, USAGE_ERR
  nang = n_params()-1

  ;; Check to be sure each axis label is 'X' 'Y' or 'Z'
  ax = strupcase(strmid(strtrim(axes,2),0,1))
  wh = where(ax NE 'X' AND ax NE 'Y' AND ax NE 'Z', ct)
  if ct GT 0 then begin
      errmsg = 'AXES must be one of "X", "Y" or "Z"'
      goto, BAD_AXIS
  endif
  if n_elements(ax) NE nang then begin
      errmsg = 'Number of AXES and rotations ANGi must agree'
      goto, BAD_AXIS
  endif

  qteuler_extract, ax, 0, ev, angv, status=status, errmsg=errmsg, $
    ang0, ang1, ang2, ang3, ang4, ang5, ang6, ang7, ang8, ang9

  if status EQ 0 then begin
      BAD_AXIS:
      message, 'ERROR: '+errmsg, /info
      goto, USAGE_ERR
  endif

  qq = qtcompose(ev, angv)
  for i = 1, nang-1 do begin
      qteuler_extract, ax, i, ev, angv, status=status, errmsg=errmsg, $
        ang0, ang1, ang2, ang3, ang4, ang5, ang6, ang7, ang8, ang9
      if status EQ 0 then goto, BAD_AXIS
      
      qq = qtmult(qq, qtcompose(ev, angv))
  endfor

  return, qq
end
;+
; NAME:
;   QTEXP
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute "exponentiation" of a non-unit quaternion
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   Q = QTEXP(QLOG)
;
; DESCRIPTION:
;
;   The function QTEXP computes the "exponentiation" of a quaternion.
;
;   The exponential is only defined for a non-unit quaternion with a
;   *zero* rotation angle.  Specifically, the expression
;
;      QTEXP([VAXIS * PHI/2, 0])    
;
;   becomes
; 
;      [VAXIS*SIN(PHI/2), COS(PHI/2)]
;
;   where VAXIS is the unit vector rotation axis and PHI is the
;   rotation angle.  Note that since VAXIS is a unit vector, the
;   product VAXIS*PHI can have an arbitrary direction and magnitude.
;
;   Typically the input to QTEXP is found by taking the logarithm of a
;   unit quaternion using QTLOG, and the identity QTEXP(QTLOG(Q)) is
;   the same as Q.
;   
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
; INPUTS:
;
;   QLOG - a non-unit quaternion of the form [VX, VY, VZ, 0]; or,
;          N quaternions of the same form, as a 4xN array.
;
;
; RETURNS:
;
;   The exponentiated unit quaternion(s).  For a single input
;   quaternion, returns a 4-vector; for N input quaternions, returns a
;   4xN array.
;
;
; KEYWORD PARAMETERS:
;
;   NONE
;
; EXAMPLE:
;
;   IDL> print, qtlog(qtcompose([0d,1,0], !dpi/4))
;         0.0000000      0.39269908       0.0000000       0.0000000
;
;   Prints the logarithm of the quaternion composed of a rotation of
;   !dpi/4 radians around the axis [0,1,0]
;
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Documentation corrected, 27 Jan 2002, CM
;   Usage message, error checking, 15 Mar 2002, CM
;
;  $Id: qtexp.pro,v 1.7 2002/05/09 23:03:27 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QTFIND
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Find quaternion(s) from direction cosine matrix
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   Q = QTFIND(MATRIX)
;
; DESCRIPTION:
;
;   The function QTFIND determines one or more unit quaternions from
;   direction cosine matrices.
;
;   This routine is optimized to avoid singularities which occur when
;   any one of the quaternion components is nearly zero.  Up to four
;   different transformations are attempted to maximize the precision
;   of all four quaternion components.
;
;   QTFIND and QTMAT are functional inverses: use QTFIND to convert a
;   known direction cosine matrix to a new quaternion; use QTMAT to
;   convert a known quaternion to matrix representation.
;
;   NUMERICAL ACCURACY: In a test of 1 billion randomly chosen
;   normalized quaternions at double precision, the maximum numerical
;   error was less than 4.5E-16 in each quaternion component, which is
;   comparable to the numerical accuracy of the double precision
;   representation itself.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
;
; INPUTS:
;
;   MATRIX - array of one or more direction cosine matrices.  For a
;            single matrix, MATRIX should be a 3x3 array.  For N
;            matrices, MATRIX should be a 3x3xN array.  The arrays are
;            assumed to be valid rotation matrices.
;
;
; RETURNS:
;
;   The resulting unit quaternions.  For a single matrix, returns a
;   single quaternion as a 4-vector.  For N matrices, returns N
;   quaternions as a 4xN array.
;
;
; KEYWORD PARAMETERS:
;
;   NONE
;
; EXAMPLE:
;
;   ;; Form a rotation matrix about the Z axis by 32 degrees
;   th1 = 32d*!dpi/180         
;   mat1 = [[cos(th1),-sin(th1),0],[sin(th1),cos(th1),0],[0,0,1]]
;   
;   ;; Form a rotation matrix about the X axis by 116 degrees
;   th2 = 116d*!dpi/180
;   mat2 = [[1,0,0],[0,cos(th2),-sin(th2)],[0,sin(th2),cos(th2)]]
;
;   ;; Find the quaternion that represents MAT1, MAT2 and the
;   composition of the two, MAT2 ## MAT1.
;
;    print, qtfind(mat1), qtfind(mat2), qtfind(mat2 ## mat1)
;       0.0000000       0.0000000      0.27563736      0.96126170
;      0.84804810       0.0000000       0.0000000      0.52991926
;      0.81519615     -0.23375373      0.14606554      0.50939109
;
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Re-added check to enforce q(3) GE 0, 15 Mar 2002, CM
;   Usage message, error checking, 15 Mar 2002, CM
;   Fixed bug which could produce all-zero quaternion; add
;     documentation about numerical accuracy, 2014-03-04, CM
;
;  $Id: qtfind.pro,v 1.9 2014/10/20 21:37:08 cmarkwar Exp $
;
;-
; Copyright (C) 2001, 2002, 2014, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; THIS ROUTINE CONVERTS ROTATION MATRIX AMAT INTO QUATERNION AQT
; IT ASSUMES AMAT IS A VALID ROTATION MATRIX
; THIS IS ADAPTED FROM CHAPTER 12 BY F.L.MARKLEY
;
; MODIFIED 11/22/95 TO AVOID SINGULARITIES (E.G., Q4=0.)
; THE SQUARE OF ONE OF THE QUATERNION ELEMENTS MUST BE >= 0.25
;	SINCE THE 4 SUM TO 1.
; MOD 11/24/95 TO MAKE SURE Q4 >= 0
; MOD 14-DEC-95 TO FIX BUG OF WRONG SIGN OF Q4 IF Q1,Q3,&Q4 < .5

  if n_params() EQ 0 then begin
      info = 1
      USAGE:
      message, 'USAGE:', /info
      message, 'Q = QTFIND(MATRIX)', /info
      message, '   MATRIX must be a 3x3xN array of direction cosines', $
        info=info
      return, 0
  endif

  sz = size(amat)
  if sz(0) LT 2 then begin
      DIM_ERROR:
      
      message, 'ERROR: MATRIX must be a 3x3xN array', /info
      return, 0
  endif
  if sz(1) NE 3 OR sz(2) NE 3 then goto, DIM_ERROR

  nq = n_elements(amat)/9
  ad0 = amat(0,0,*) & ad1 = amat(1,1,*) & ad2 = amat(2,2,*)
  a12 = amat(1,2,*) & a21 = amat(2,1,*)
  a20 = amat(2,0,*) & a02 = amat(0,2,*)
  a01 = amat(0,1,*) & a10 = amat(1,0,*)

  n1 = nq
  q0 = replicate(amat(0)*0+0., nq) & q1 = q0 & q2 = q0 & q3 = q0
  mask = bytarr(nq)

  qd = 1. + ad0 + ad1 + ad2
  wh = where(qd GE 0.99, ct)
  if ct GT 0 then begin
      qx = 0.5*sqrt(qd(wh))
      q3(wh) = qx
      qx = qx * 4
      q0(wh) = (a12-a21)(wh)/qx
      q1(wh) = (a20-a02)(wh)/qx
      q2(wh) = (a01-a10)(wh)/qx
      n1 = n1 - ct
      mask(wh) = 1
  endif 
  if n1 GT 0 then begin
      qd = 1. + ad0 - ad1 - ad2
      wh = where(mask EQ 0 AND qd GE 0.99, ct)
      if ct GT 0 then begin
          qx = 0.5*sqrt(qd(wh))
          q0(wh) = qx
          qx = qx * 4
          q3(wh) = (a12-a21)(wh)/qx
          q2(wh) = (a20+a02)(wh)/qx
          q1(wh) = (a01+a10)(wh)/qx
          n1 = n1 - ct
          mask(wh) = 1
      endif
  endif
  if n1 GT 0 then begin
      qd = 1. - ad0 - ad1 + ad2
      wh = where(mask EQ 0 AND qd GE 0.99, ct)
      if ct GT 0 then begin
          qx = 0.5*sqrt(qd(wh))
          q2(wh) = qx
          qx = qx * 4
          q1(wh) = (a12+a21)(wh)/qx
          q0(wh) = (a20+a02)(wh)/qx
          q3(wh) = (a01-a10)(wh)/qx
          n1 = n1 - ct
          mask(wh) = 1
      endif
  endif
  if n1 GT 0 then begin
      qd = 1. - ad0 + ad1 - ad2
      wh = where(mask EQ 0 AND qd GE 0.99, ct)
      if ct GT 0 then begin
          qx = 0.5*sqrt(qd(wh))
          q1(wh) = qx
          qx = qx * 4
          q2(wh) = (a12+a21)(wh)/qx
          q3(wh) = (a20-a02)(wh)/qx
          q0(wh) = (a01+a10)(wh)/qx
          n1 = n1 - ct
          ;; mask(wh) = 1
      endif
  endif

  wh = where(q3 LT 0, ct)
  if ct GT 0 then begin
      q0(wh) = -q0(wh)
      q1(wh) = -q1(wh)
      q2(wh) = -q2(wh)
      q3(wh) = -q3(wh)
  endif

  return, transpose([[q0],[q1],[q2],[q3]])
end
;+
; NAME:
;   QTINV
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute inverse of QUATERNION
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   QINV = QTINV(Q)
;
; DESCRIPTION:
;
;   The function QTINV computes the inverse of the quaternion Q.  The
;   inverse of a quaternion is equivalent to a rotation about the same
;   axis but the opposite direction.
;
;   The inverse is also defined mathematically such that
;
;     QTMULT( Q, QTINV(Q) )   
;
;   becomes [0, 0, 0, 1], which is the identity quaternion.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
;
; INPUTS:
;
;  Q - array of one or more unit quaternions.  For a single
;      quaternion, Q should be a 4-vector.  For N quaternions, Q
;      should be a 4xN array.
;
;
; RETURNS:
;
;   The resulting inverse unit quaternions.  For a single input
;   quaternion, returns a 4-vector.  For N input quaternions, returns
;   N quaternions as a 4xN array.
;
;
; KEYWORD PARAMETERS:
;
;   NONE
;
; EXAMPLE:
;
;   IDL> print, qtcompose([0d,1,0], !dpi/4)
;          0.0000000      0.38268343       0.0000000      0.92387953
;   IDL> print, qtinv(qtcompose([0d,1,0], !dpi/4))
;          0.0000000      0.38268343       0.0000000     -0.92387953
;
;   Prints the quaternion composed of a rotation of !dpi/4 radians
;   around the axis [0,1,0], then the inverse of the same quaternion.
;
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Usage message, error checking, 15 Mar 2002, CM
;
;  $Id: qtinv.pro,v 1.6 2002/05/09 23:03:27 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QTLOG
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute "logarithm" of a unit quaternion
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   QLOG = QTLOG(Q)
;
; DESCRIPTION:
;
;   The function QTLOG computes the "logarithm" of a unit quaternion.
;
;   The logarithm of a quaternion is defined for any unit quaternion,
;   such that the expression
;
;     QTLOG([VAXIS*SIN(PHI/2), COS(PHI/2)] 
;
;   becomes
;
;     [VAXIS * PHI/2, 0]
;
;   where VAXIS is the unit vector rotation axis and PHI is the
;   rotation angle.  Note that the output quaternion is not a *unit*
;   quaternion.  The output of QTLOG is also commonly known as an
;   *axial vector*, for a rotation axis VAXIS and rotation angle
;   PHI/2.
;
;   Typically the output to QTLOG is eventually exponentiated with the
;   QTEXP function, and the identity QTEXP(QTLOG(Q)) is the same as Q.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
;
; INPUTS:
;
;  Q - array of one or more unit quaternions.  For a single
;      quaternion, Q should be a 4-vector.  For N quaternions, Q
;      should be a 4xN array.
;
;
; RETURNS:
;
;   The non-unit quaternion logarithm(s).  For a single input
;   quaternion, returns a 4-vector of the form [VX, VY, VZ, 0].  For N
;   input quaternions, returns N quaternions of the same form as a 4xN
;   array.
;
;
; KEYWORD PARAMETERS:
;
;   NONE
;
; EXAMPLE:
;
;   IDL> q = qtlog(qtcompose([0d,1,0], !dpi/4))
;   IDL> print, qtexp(2 * q)
;          0.0000000      0.70710678       0.0000000      0.70710678
;
;   First, computes the logarithm Q of the quaternion composed of a
;   rotation of !dpi/4 radians around the axis [0,1,0].  Second,
;   computes the exponentiation of 2*Q.  This is the same as raising
;   the original quaternion to the second power.
;
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Documentation clarified & corrected, 27 Jan 2002, CM
;   Usage message, error checking, 15 Mar 2002, CM
;
;  $Id: qtlog.pro,v 1.6 2002/05/09 23:03:27 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QTMAT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Find direction cosine matrix from quaternion(s)
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   MATRIX = QTMAT(Q)
;
; DESCRIPTION:
;
;  The function QTMAT computes one or more direction cosine matrices
;  (i.e., rotation matrices) from unit quaternions.
;
;  The usage of the resulting matrix on a 3-vector X is either 
;  MATRIX # X, or MATRIX ## X, depdending on the meaning of the
;  rotation (i.e., body-fixed or coordinate-fixed, see QTVROT).
;
;  QTFIND and QTMAT are functional inverses: use QTFIND to convert a
;  known direction cosine matrix to a new quaternion; use QTMAT to
;  convert a known quaternion to matrix representation.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
;
; INPUTS:
;
;  Q - array of one or more unit quaternions.  For a single
;      quaternion, Q should be a 4-vector.  For N quaternions, Q
;      should be a 4xN array.
;
; KEYWORDS:
;
;  INVERT - if set, compute the matrix of QTINV(Q) instead Q
;
;
; RETURNS:
;
;   The direction cosine matrices.  For a single input quaternion,
;   retuns a 3x3 array.  For N input quaternions, returns a 3x3xN
;   array.
;
;
; KEYWORD PARAMETERS:
;
;   NONE
;
; EXAMPLE:
;
;   print, qtmat(qtcompose([0d,1,0], !dpi/4)) 
;        0.70710678       0.0000000      0.70710678
;         0.0000000       1.0000000       0.0000000
;       -0.70710678       0.0000000      0.70710678
;
;   Form a quaternion composed of a rotation of !dpi/4 radians around
;   the axis [0,1,0], and then print the corresponding rotation
;   matrix.
;
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Documentation clarifications, 28 Jan 2002, CM
;   Allow multiple quaternions, 28 Jan 2002, CM
;   Usage message, error checking, 15 Mar 2002, CM
;   Add INVERT keyword, 05 Oct 2007, CM
;
;  $Id: qtmat.pro,v 1.8 2008/12/14 20:00:31 craigm Exp $
;
;-
; Copyright (C) 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; THIS IS ADAPTED FROM CHAPTER 12 BY F.L.MARKLEY
  if n_params() EQ 0 then begin
      info = 1
      USAGE:
      message, 'USAGE:', /info
      message, 'MATRIX = QTMAT(Q)', info=info
      return, 0
  endif
  nq = n_elements(q)/4
  if nq LT 1 then goto, USAGE

  if NOT keyword_set(invert) then begin
      q1 = q(0,*) & q2 = q(1,*) & q3 = q(2,*) & q4 = q(3,*)
  endif else begin
      q1 = -q(0,*) & q2 = -q(1,*) & q3 = -q(2,*) & q4 = q(3,*)
  endelse

  a = dblarr(3,3,nq)
  A(0,0,*)=Q1*Q1-Q2*Q2-Q3*Q3+Q4*Q4
  A(0,1,*)=2.D0*(Q1*Q2+Q3*Q4)
  A(0,2,*)=2.D0*(Q1*Q3-Q2*Q4)
  A(1,0,*)=2.D0*(Q1*Q2-Q3*Q4)
  A(1,1,*)=-Q1*Q1+Q2*Q2-Q3*Q3+Q4*Q4
  A(1,2,*)=2.D0*(Q2*Q3+Q1*Q4)
  A(2,0,*)=2.D0*(Q1*Q3+Q2*Q4)
  A(2,1,*)=2.D0*(Q2*Q3-Q1*Q4)
  A(2,2,*)=-Q1*Q1-Q2*Q2+Q3*Q3+Q4*Q4

  return, a
end

;+
; NAME:
;   QTMULT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Multiply quaternions
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   QRESULT = QTMULT(Q1, [/INV1,]   Q2, [/INV2])
;
; DESCRIPTION:
;
;   The function QTMULT performs multiplication of quaternions.
;   Quaternion multiplication is not component-by-component, but
;   rather represents the composition of two rotations, namely Q2
;   followed by Q1.
;
;   More than one multiplication can be performed at one time if Q1
;   and Q2 are 4xN arrays.  In that case both input arrays must be of
;   the same dimension.
;
;   If INV1 is set, then the inverse of Q1 is used.  This is a
;   convenience, to avoid the call QTINV(Q1).  Of course, INV2 can
;   be set to use the inverse of Q2.
;
;   Note that quaternion multiplication is not commutative.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
;
; INPUTS:
;
;  Q1 - array of one or more unit quaternions, the first operand in
;       the multiplication.  For a single quaternion, Q1 should be a
;       4-vector.  For N quaternions, Q1 should be a 4xN array.
;       If INV1 is set, then the inverse of Q1 is used.
;
;  Q2 - same as Q1, for the second operand.
;       If INV2 is set, then the inverse of Q2 is used.
;
; RETURNS:
;
;   The resulting multiplied unit quaternions.  For a single inputs,
;   returns a 4-vector.  For N input quaternions, returns N
;   quaternions as a 4xN array.
;
;
; KEYWORD PARAMETERS:
;
;  INV1 - if set, use QTINV(Q1) in place of Q1.
;
;  INV2 - if set, use QTINV(Q2) in place of Q2.
;
; EXAMPLE:
;
;   Q1 = qtcompose([0,0,1],  32d*!dpi/180d)
;   Q2 = qtcompose([1,0,0], 116d*!dpi/180d)
;
;   IDL> print, qtmult(q1, q2)
;        0.81519615      0.23375373      0.14606554      0.50939109
;
;   Form a rotation quaternion of 32 degrees around the Z axis, and 
;   116 degrees around the X axis, then multiply the two quaternions.
;   
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTMULTN, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Documentation, allow 1xN or Nx1 multiplies, 27 Jan 2002, CM
;   Usage message, error checking, 15 Mar 2002, CM
;   Add the INV1 and INV2 keywords, 30 Aug 2007, CM
;
;  $Id: qtmult.pro,v 1.8 2007/09/03 07:18:25 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, 2007, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
; THIS ROUTINE MULTIPLIES QUATERNIONS
; CQT CORRESPONDS TO THE ROTATION AQT FOLLOWED BY BQT
; ASSUMING S/C COORDINATES ARE INITIALLY ALIGN WITH INERTIAL COORD.
; THEN ROTATION AQT DESCRIBES ROTATION SUCH THAT THE SUBROUTINE
;   QTXRA GIVES THE INERTIAL COORDINATES OF THE S/C X-AXIS
;   THE FIRST 3 COMPONENTS OF AQT GIVE THE EIGENAXIS EXPRESSED
;   IN S/C COORDINATES BEFORE THE ROTATION (=INTERTIAL COORD.).
; THE BQT ROTATION FOLLOWS THE AQT ROTATION. CQT THEN DESCRIBES
;   THIS COMBINATION SUCH THAT QTXRA GIVES THE INERTIAL COORDINATES
;   OF THE S/C X-AXIS AFTER BOTH ROTATIONS. 
;   THE FIRST 3 COMPONENTS OF BQT GIVE THE EIGENAXIS EXPRESSED
;   IN S/C COORDINATES AFTER THE AQT ROTATION.

  if n_params() EQ 0 then begin
      info = 1
      USAGE:
      message, 'USAGE:', /info
      message, 'QNEW = QTMULT(Q1, Q2)', info=info
      return, 0
  endif

  sz1 = size(aqt)
  sz2 = size(bqt)
  if sz1(0) LT 1 OR sz2(0) LT 1 then $
    message, 'ERROR: Q1 and Q2 must be quaternions'
  if sz1(1) NE 4 OR sz2(1) NE 4 then $
    message, 'ERROR: Q1 and Q2 must be quaternions'
  n1 = n_elements(aqt)/4
  n2 = n_elements(bqt)/4
  if n1 NE n2 AND n1 NE 1 AND n2 NE 1 then $
    message, 'ERROR: Q1 and Q2 must both have the same number of quaternions'

  nq = n1>n2
  cqt = make_array(value=aqt(0)*bqt(0)*0, dimension=[4,nq])

  if n1 GT 1 then begin
      aqt0 = aqt(0,*) & aqt1 = aqt(1,*) & aqt2 = aqt(2,*) & aqt3 = aqt(3,*)
  endif else begin
      aqt0 = aqt(0) & aqt1 = aqt(1) & aqt2 = aqt(2) & aqt3 = aqt(3)
  endelse
  if n2 GT 1 then begin
      bqt0 = bqt(0,*) & bqt1 = bqt(1,*) & bqt2 = bqt(2,*) & bqt3 = bqt(3,*)
  endif else begin
      bqt0 = bqt(0) & bqt1 = bqt(1) & bqt2 = bqt(2) & bqt3 = bqt(3)
  endelse
  if keyword_set(inverse1) then begin
      aqt0 = -aqt0 & aqt1 = -aqt1 & aqt2 = -aqt2
  endif
  if keyword_set(inverse2) then begin
      bqt0 = -bqt0 & bqt1 = -bqt1 & bqt2 = -bqt2
  endif

  CQT(0,0) = AQT0*BQT3 + AQT1*BQT2 - AQT2*BQT1 + AQT3*BQT0
  CQT(1,0) =-AQT0*BQT2 + AQT1*BQT3 + AQT2*BQT0 + AQT3*BQT1
  CQT(2,0) = AQT0*BQT1 - AQT1*BQT0 + AQT2*BQT3 + AQT3*BQT2
  CQT(3,0) =-AQT0*BQT0 - AQT1*BQT1 - AQT2*BQT2 + AQT3*BQT3
  
  return, cqt
end
;+
; NAME:
;   QTMULTN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Multiply several quaternions
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   QRESULT = QTMULTN(Q1, Q2, ...,  [/INV1, /INV2, ...] )
;
; DESCRIPTION:
;
;   The function QTMULTN performs multiplication of quaternions.
;   It is a convenience routine to simplify the multiplication
;   of a chain of several quaternions.  
;  
;   For example, 
;     QTMULTN(Q1,Q2,Q3,/INV3,Q4)
;   is the same as,
;     QTMULT(Q1,QTMULT(Q2,QTMULT(QTINV(Q3),Q4)))
;
;   Up to eight quaternions may be multiplied with this routine.
;
;   As for QTMULT(), Qn may be 'vectors' of quaternions, if the Qn are
;   4xN arrays.  In that case the input arrays must be of the same
;   dimension.
;
;   Note that quaternion multiplication is not commutative.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
;
; INPUTS:
;
;  Qn - array of one or more unit quaternions, the nth operand in the
;       multiplication.  For a single quaternion, Qn should be a
;       4-vector.  For N quaternions, Qn should be a 4xN array.
;       If INVn is set, then the inverse of Qn is used.
;
;  INVn - if set, use QTINV(Qn) in place of Qn.
;
;
; RETURNS:
;
;   The resulting multiplied unit quaternions.  For a single inputs,
;   returns a 4-vector.  For N input quaternions, returns N
;   quaternions as a 4xN array.
;
;
; KEYWORD PARAMETERS:
;
;   NONE
;
; EXAMPLE:
;
;   Q1 = qtcompose([0,0,1],  32d*!dpi/180d)
;   Q2 = qtcompose([1,0,0], 116d*!dpi/180d)
;
;   IDL> print, qtmult(q1, q2)
;        0.81519615      0.23375373      0.14606554      0.50939109
;
;   Form a rotation quaternion of 32 degrees around the Z axis, and 
;   116 degrees around the X axis, then multiply the two quaternions.
;   
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTMULTN, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, 30 Aug 2007, CM
;
;  $Id: qtmultn.pro,v 1.2 2008/12/14 20:00:31 craigm Exp $
;
;-
; Copyright (C) 2007, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QTNORMALIZE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Normalize a quaternion (unit quaternion and/or sign conventions)
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   QNEW = QTNORMALIZE(QOLD, UNITIZE=1, POS3=1)
;
; DESCRIPTION:
;
;   The function QTNORMALIZE performs normalization operations upon a
;   quaternion.  The two operations are: UNITIZE and POS3.
;
;   The UNITIZE operation occurs if /UNITIZE is set (this is the
;   default).  If set, then the returned quaternion is a unit
;   quaternion.  Non-unit input quaternions will be adjusted so that
;   the components have the same ratios, but unit magnitude.
;
;   The POS3 operation occurs if /POS3 is set (this is the default).
;   If set, then the returned quaternion is ensured to be positive in
;   its third component.  In other words, QNEW[3] GE 0.  Since the
;   same quaternion can have two different representations, differing
;   only in the signs of the components, the POS3 operation ensures
;   that one sign convention is used for all quaternions.  This is
;   useful for comparing quaternion component values.
;
;   By default /UNITIZE and /POS3 are both set.  In order to disable
;   them, set UNITIZE=0 or POS3=0 explicitly.
;
; INPUTS:
;
;  Q - array of one or more unit quaternions.  For a single
;      quaternion, Q should be a 4-vector.  For N quaternions, Q
;      should be a 4xN array.
;
;
; RETURNS:
;
;   The resulting normalized quaternions.  For single inputs, returns
;   a 4-vector.  For N inputs, returns N quaternions as a 4xN array.
;
;
; KEYWORD PARAMETERS:
;
;   UNITIZE - if set, then perform UNITIZE operation as described
;             above.  By default, UNITIZE=1.
;
;   POS3 - if set, then perform POS3 operation as described above.  By
;          default, POS3=1.
;
;
; EXAMPLE:
;
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, 2012-08-01, CM
;
;  $Id: qtnormalize.pro,v 1.2 2012/10/02 12:29:33 cmarkwar Exp $
;
;-
; Copyright (C) 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QTPOW
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Raise quaternion Q to the "power" POW
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   QNEW = QTPOW(Q, POW)
;
; DESCRIPTION:
;
;   The function QTPOW raises a quaterion Q to the power P.  The
;   operation 
;
;      QNEW = QTPOW(Q, POW)
;
;   is equivalent to
;
;      QNEW = QTEXP( POW * QTLOG(Q))
;
;   which is the same as the definition of raising a real number to
;   any power (however, QTPOW is faster than using QTLOG and QTEXP).
;
;   For integer values of POW, this form of exponentiation is also
;   directly equivalent to the multiplication of that many Q's
;   together.
;
;   Geometrically, raising Q to any power between 0 and 1 realizes a
;   rotation that smoothly interpolates between the identity
;   quaternion and Q.  Thus, QTPOW is useful for interpolation of
;   quaternions or SLERPing (spherical linear interpolation).
;
;   When raising more than one quaternion to a power at a time, the
;   number of quaternions and powers must be equal.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
;
; INPUTS:
;
;  Q - array of one or more unit quaternions.  For a single
;      quaternion, Q should be a 4-vector.  For N quaternions, Q
;      should be a 4xN array.
;
;  POW - array of N powers, where N is the number of quaternions.
;
;
; RETURNS:
;
;   The resulting exponentiated unit quaternions.  For a single
;   inputs, returns a 4-vector.  For N input quaternions, returns N
;   quaternions as a 4xN array.
;
;
; KEYWORD PARAMETERS:
;
;   NONE
;
; EXAMPLE:
;
;   ;; Form a rotation quaternion of 45 degrees about the X axis
;   Q = qtcompose([1,0,0], !dpi/4)
;
;   ;; Make an array of 1001 values smoothly varying from 0 to 1
;   P = dindgen(1001)/1000d
;
;   ;; Perform spherical linear interpolation
;   QNEW = QTERP(Q, P)
;
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Usage message, error checking, 15 Mar 2002, CM
;
;  $Id: qtpow.pro,v 1.5 2002/05/09 23:03:27 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   QTVROT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Apply quaternion rotation to a 3-vector
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   VNEW = QTVROT(V, Q, [/INVERT])
;
; DESCRIPTION:
;
;   The function QTVROT applies a quaternion rotation (or its inverse)
;   to a 3-vector V to produce a new vector VNEW.
;
;   If both V and VNEW are vector components measured in the same
;   inertial coordinate system, then VNEW returns the components of
;   the vector V rotated by quaternion Q.  I.e., the AXES stay fixed
;   and the VECTOR rotates.  Replace Q by QTINV(Q) in the case of
;   /INVERT.
;
;   If V are components of a vector measured in the "body" coordinate
;   frame, and Q represents the orientation of the body frame
;   w.r.t. the inertial frame, then VNEW are the components of the
;   same vector in the inertial frame.  I.e., the VECTOR stays fixed
;   and the AXES rotate.  For /INVERT, the coordinate transformation
;   is from inertial frame to body frame.
;
;   If either Q is a single quaternion, or V is a single 3-vector,
;   then QTVROT will expand the single to the number of elements of
;   the other operand.  Otherwise, the number of quaternions and
;   vectors must be equal.
;
;  Conventions for storing quaternions vary in the literature and from
;  library to library.  This library uses the convention that the
;  first three components of each quaternion are the 3-vector axis of
;  rotation, and the 4th component is the rotation angle.  Expressed
;  in formulae, a single quaternion is given by:
;
;     Q(0:2) = [VX, VY, VZ]*SIN(PHI/2)
;     Q(3)   =              COS(PHI/2)
;
;  where PHI is the rotation angle, and VAXIS = [VX, VY, VZ] is the
;  rotation eigen axis expressed as a unit vector.  This library
;  accepts quaternions of both signs, but by preference returns
;  quaternions with a positive 4th component.
;
;
; INPUTS:
;
;  V - array of one or more 3-vectors.  For a single vector, V should
;      be a 3-vector.  For N vectors, V should be a 3xN array.
;
;  Q - array of one or more unit quaternions.  For a single
;      quaternion, Q should be a 4-vector.  For N quaternions, Q
;      should be a 4xN array.
;
;
; RETURNS:
;
;   The resulting rotated vectors.  For single inputs, returns a
;   3-vector.  For N inputs, returns N vectors as a 3xN array.
;
;
; KEYWORD PARAMETERS:
;
;   INVERT - if set, then the antirotation represented by QTINV(Q) is
;            performed.
;
;
; EXAMPLE:
;
;   Q1 = qtcompose([0,0,1],  32d*!dpi/180d)
;   Q2 = qtcompose([1,0,0], 116d*!dpi/180d)
;   Q = qtmult(Q1, Q2)
;
;   V = [[1d,0,0],[0,1,0],[0,0,1]]
;
;   IDL> print, qtvrot(v, q)
;         0.84804810      0.52991926       0.0000000
;         0.23230132     -0.37175982      0.89879405
;         0.47628828     -0.76222058     -0.43837115
;
;
; SEE ALSO
;   QTANG, QTAXIS, QTCOMPOSE, QTERP, QTEXP, QTFIND, QTINV, QTLOG,
;   QTMAT, QTMULT, QTPOW, QTVROT
;
; MODIFICATION HISTORY:
;   Written, July 2001, CM
;   Documented, Dec 2001, CM
;   Small changes, 28 Jan 2002, CM
;   Usage message, error checking, 15 Mar 2002, CM
;
;  $Id: qtvrot.pro,v 1.7 2002/05/09 23:03:27 craigm Exp $
;
;-
; Copyright (C) 2001, 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; QVROT
;;
;; The FORWARD (default) transform: 
;;
;; * takes a vector vin (components given in inertial coordinates) and
;;  returns the components of the rotated vector vout (components
;;  given in inertial coordinates) -- ie, the AXES stay fixed and the
;;  VECTOR rotates; OR, equivalently,
;;
;; * takes a fixed vector vin (components given in body coordinates)
;;   and returns the components of the vector in inertial coordinates,
;;   where the body system is described by quaternion q -- ie, the
;;   VECTOR stays fixed and the AXES rotate.
;;
;;
;; The INVERSE transform (gotten by setting /INVERT):
;;
;; * takes a vector vin (components given in inertial coordinates) and
;;   returns the components of the anti-rotated vector vout
;;   (components given in inertial coordinates) -- ie, the AXES stay
;;   fixed and the VECTOR rotates.  Anti-rotated here means rotated in
;;   the opposite direction of q; OR, equivalently,
;;
;; * takes a fixed vector vin (components given in inertial
;;   coordinates) and returns the components of the vector in body
;;   coordinates, where the body system is described by quaternion q
;;   -- ie, the VECTOR stays fixed and the AXES rotate.
;;

function qtvrot, vin, q, invert=invert

  if n_params() EQ 0 then begin
      info = 1
      USAGE:
      message, 'USAGE:', /info
      message, 'VNEW = QTVROT(V, Q)', info=info
      return, 0
  endif
  nq = n_elements(q)/4
  nv = n_elements(vin)/3
  if nq LT 1 OR nv LT 1 then goto, USAGE

  if n_elements(q) GT 4 AND n_elements(vin) GT 3 then begin
      if n_elements(q)/4 NE n_elements(vin)/3 then begin
          message, 'ERROR: incompatible number of quaternions & vectors'
          return, -1L
      end
      vout = vin*q(0)*0.
      nq = n_elements(q)/4
      nv = nq
  endif else if n_elements(q) GT 4 then begin
      nq = n_elements(q)/4
      nv = 1L
      vout = vin(*) # (fltarr(nq)+1) * q(0)*0.
  endif else begin
      nq = 1L
      nv = n_elements(vin)/3
      vout = vin*q(0)*0.
  endelse
  vout = reform(vout, 3, max([nv,nq]), /overwrite)
  q1 = q(0,*) & q2 = q(1,*) & q3 = q(2,*) & q4 = q(3,*)
  if n_elements(q1) EQ 1 then begin
      q1 = q1(0)  & q2 = q2(0)  & q3 = q3(0)  & q4 = q4(0)
  endif else begin
      q1 = q1(*)  & q2 = q2(*)  & q3 = q3(*)  & q4 = q4(*)
  endelse
  v0 = vin(0,*) & v1 = vin(1,*) & v2 = vin(2,*)
  if n_elements(v0) EQ 1 then begin
      v0 = v0(0)  & v1 = v1(0)  & v2 = v2(0)
  endif else begin
      v0 = v0(*)  & v1 = v1(*)  & v2 = v2(*)
  endelse

  if NOT keyword_set(INVERT) then begin

      ;; FORWARD TRANSFORMATION
      VOUT(0,*)=((Q1*Q1-Q2*Q2-Q3*Q3+Q4*Q4)*V0 $
                 + 2.D0*(Q1*Q2-Q3*Q4)*V1 $
                 + 2.D0*(Q1*Q3+Q2*Q4)*V2)
      VOUT(1,*)=(2.D0*(Q1*Q2+Q3*Q4)*V0 $
                 + (-Q1*Q1+Q2*Q2-Q3*Q3+Q4*Q4)*V1 $
                 + 2.D0*(Q2*Q3-Q1*Q4)*V2)
      VOUT(2,*)=(2.D0*(Q1*Q3-Q2*Q4)*V0 $
                 + 2.D0*(Q2*Q3+Q1*Q4)*V1 $
                 + (-Q1*Q1-Q2*Q2+Q3*Q3+Q4*Q4)*V2)
  endif else begin
      ;; INVERSE TRANSFORMATION
      VOUT(0,*)=((Q1*Q1-Q2*Q2-Q3*Q3+Q4*Q4)*V0 $
                 + 2.D0*(Q1*Q2+Q3*Q4)*V1 $
                 + 2.D0*(Q1*Q3-Q2*Q4)*V2)
      VOUT(1,*)=(2.D0*(Q1*Q2-Q3*Q4)*V0 $
               + (-Q1*Q1+Q2*Q2-Q3*Q3+Q4*Q4)*V1 $
               + 2.D0*(Q2*Q3+Q1*Q4)*V2)
      VOUT(2,*)=(2.D0*(Q1*Q3+Q2*Q4)*V0 $
               + 2.D0*(Q2*Q3-Q1*Q4)*V1 $
               + (-Q1*Q1-Q2*Q2+Q3*Q3+Q4*Q4)*V2)
  endelse
  vout = vout

  return, vout
end
;+
; NAME:
;   QUINTERP
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Quintic spline interpolation from tabulated first and second derivatives
;
; MAJOR TOPICS:
;   Interpolation, Hermite Interpolation
;
; CALLING SEQUENCE:
;   QINTERP, XTAB, YTAB, YPTAB, YPPTAB, $
;      XINT, YINT, YPINT=, YPPINT=, MISSING=
;
; DESCRIPTION:
;
;   QUINTERP performs quintic spline interpolation of a function.
;   This routine is a natural extension of CUBETERP, in that it meant
;   for interpolation where the tabulated function has known values,
;   first derivatives *and* second derivatives at each point.  Given
;   that there are six known values for each interpolation interval,
;   the resulting interpolation function is a quintic polynomial (one
;   of a class of Hermite interpolating splines).
;
;   The user provides a tabulated set of data, whose (X,Y) positions
;   are (XTAB, YTAB), and whose first and second derivatives are YPTAB
;   and YPPTAB.  The user also provides a set of desired "X" abcissae
;   for which interpolants are requested.  The interpolated spline
;   values are returned in YINT.  The interpolated curve will smoothly
;   pass through the control points, and have the requested
;   derivatives at those points.
;
;   Note that the user must provide both derivatives (they are not
;   optional).  If you don't have one or more derivatives, then you
;   should use the IDL spline functions SPL_INIT/SPL_INTERP, or the
;   functions CUBETERP, QUADTERP or LINTERP instead.  Unlike CUBETERP,
;   if the requested point is outside of the tabulated range, the
;   function is not extrapolated.  Instead the value provided by the
;   MISSING keyword is returned for those points.
;
;   The user may also optionally request the first and second
;   derivatives of the function with the YPINT and YPPINT keywords.
;
; INPUTS:
;
;   XTAB - tabulated X values.  Must be sorted in increasing order.
;
;   YTAB - tabulated Y values.
;
;   YPTAB - tabulated first derivatives ( = dY/dX ). Not optional
;   YPPTAB - tabulated second derivatives ( = d(YPTAB)/dX ).  Not optional.
;
;   XINT - X values of desired interpolants.
;
; OUTPUTS:
;
;   YINT - Y values of desired interpolants.
;
; OPTIONAL KEYWORDS:
;
;   YPINT - upon return, the slope (first derivative) at the
;           interpolated positions.
;
;   YPPINT - upon return, the second derivative at the interpolated
;            positions.
;
;   MISSING - a value to report for "missing" data.  This function
;             does not perform extrapolation; any requested point
;             outside the range [MIN(XTAB),MAX(XTAB)] is considered
;             missing.
;             Default: 0
;
; EXAMPLE:
;
;  ;; Set up some fake data, a sinusoid
;  xtab = dindgen(101)/100d * 2d*!dpi    ; 100 points from 0 -> 2*!dpi
;  ytab = sin(xtab)    ;; values
;  yptab = cos(xtab)   ;; 1st deriv
;  ypptab = -sin(xtab) ;; 2nd deriv
;
;  ;; Interpolate to a finer grid
;  xint = dindgen(1001)/1000 * 2d*!dpi   ;; 1000 points from 0->2*!dpi
;  quinterp, xtab, ytab, yptab, ypptab, xint, yint, ypint=ypint, yppint=yppint
;
;  ;; Plot it
;  plot, xint, yint
;  oplot, xtab, ytab, psym=1, symsize=2
;  for i = 0, n_elements(xtab)-1 do $   ;; Also plot slopes
;    oplot, xtab(i)+[-0.5,0.5], ytab(i)+[-0.5,0.5]*yptab(i)
; 
;
; MODIFICATION HISTORY:
;   Written and documented, CM, 08 Oct 2008
;
;  $Id: quinterp.pro,v 1.2 2009/04/15 04:17:30 craigm Exp $
;
;-
; Copyright (C) 2008, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   RELPATH
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Construct a relative path between two absolute paths
;
; MAJOR TOPICS:
;   Files, I/O
;
; CALLING SEQUENCE:
;   RELPATH, FROM, [/FILE1,] TO, [/FILE2,] RELPATH, [CURRENT=, /INVERT]
;
; DESCRIPTION:
;
;   RELPATH constructs a relative path between two absolute paths.
;   That is, given two file name paths FROM and TO, RELPATH finds the
;   relative path which starts from the current directory of FROM and
;   ends in the directory of TO.
;
;   Note that the /FILE1 or /FILE2 keywords can be used to say whether
;   FROM or TO, respectively, is a file instead of a directory.  This
;   is important because RELPATH finds the relative paths between two
;   directories, and so the file components are ignored for those
;   purposes.
;
;   The INVERT keyword is allows one to invert the path: to find the
;   path from the current directory of TO, to the directory of FROM.
;
;   If the user specifies the CURRENT keyword, then relative paths are
;   assumed to originate in the CURRENT directory.  Otherwise the
;   actual current directory is used.
;
;   NORMPATH should be platform independent.  Note that the paths do
;   not necessarily need to exist on the file system.
;
; INPUTS:
;
;   FROM - scalar string, gives path of starting point (file or
;          directory).
;
;   TO - scalar string, gives path of ending point (file or
;        directory).
;
;   RELPATH - upon return, the relative path from FROM to TO.

;
; KEYWORDS:

;   CURRENT - if specified, must be a scalar string which gives the
;             path to the current directory used in forming the
;             normalized path.  If not specified, then the actual
;             current directory is used.
;
;   INVERT - invert the direction of the relative path, i.e. from TO
;            to FROM.
;
; EXAMPLES:
;
;   RELPATH, '/x/y/z', '/x/u/v', relpath & print, relpath
;     '../../u/v'
;
;   The two paths share a common root in /x.  Therefore, to get to
;   /x/u/v from /x/y/z, one must go up two directory levels and then
;   down into u/v.
;
;
; MODIFICATION HISTORY:
;   Written and documented, 12 Mar 2004 CM
;   Replaced call to STRCAT with STRJOIN, 09 Aug 2006 CM
;   Usage message, 23 Mar 2008 CM
;
;  $Id: relpath.pro,v 1.3 2008/03/23 18:14:57 craigm Exp $
;
;-
; Copyright (C) 2004, 2006, 2008, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   ROUTINE_NAMES  (DOCUMENTATION ONLY)
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Examine variables and parameters of procedures and call stack (OBSOLETE)
;
; CALLING SEQUENCE:
;   Various, see USAGE VARIATIONS.
;
; DESCRIPTION: 
;
;   ROUTINE_NAMES obtains information about routines, and their
;   variables and keywords.  Using these functions, a subroutine can
;   interrogate, and in some cases change, the values and names of
;   variables and parameters in its calling routine, or at the $MAIN$
;   level.  Some functionality of ROUTINE_NAMES is also in the IDL
;   system function ROUTINE_INFO, and other functionality is exclusive
;   to ROUTINE_NAMES.
;
;   ROUTINE_NAMES has been designated as "OBSOLETE" by RSI, although
;   it will probably not disappear soon since their own software
;   appears to use it.
;
;   ROUTINE_NAMES can be invoked in several different ways, which are
;   detailed below, under USAGE VARIATIONS.
;
;   ROUTINE_NAMES uses a notion of the current IDL "call level," which
;   is the numerical stack depth of the currently executing routine.
;   At each procedure or function call, the call level becomes one
;   *deeper*, and upon each RETURN, the call level becomes one
;   *shallower*.  The call stack always begins at the $MAIN$ level.
;   The current call stack can always be printed by executing HELP.
;
;   When specifying the call level to ROUTINE_NAMES, one can use one
;   of two numbering systems, depending on whichever is most
;   convenient.  In the *absolute* numbering system, the $MAIN$ level
;   starts at number 1, and becomes deeper with increasing numbers.
;   In the *relative* numbering system, the current (deepest) call
;   level is number 0, and becomes shallower with more negative
;   numbers.  Hence, if the deepest level is N, then the
;   correspondence is thus:
;
;      VALUE        MEANING
;      --------------------------------
;      1 or -N+1    $MAIN$ level
;      2 or -N+2    NEXT deeper level
;        ...           ...
;      N or 0       DEEPEST (currently executing) level
;
; USAGE VARIATIONS:
;
;   PROCS  = ROUTINE_NAMES(             [/UNRESOLVED])
;   PROCS  = ROUTINE_NAMES(/PROCEDURES [,/UNRESOLVED])
;   FUNCS  = ROUTINE_NAMES(/FUNCTIONS  [,/UNRESOLVED])
;
;            The currently compiled procedures and functions are
;            returned, respectively, as a string array.  Functions
;            declared via FORWARD_FUNCTION are also returned.  If the
;            UNRESOLVED keyword is set then the currently unresolved
;            procedures and functions are returned.  These are known
;            routines which have not yet been compiled.
;
;   PROCS  = ROUTINE_NAMES(/S_PROCEDURES)
;   FUNCS  = ROUTINE_NAMES(/S_FUNCTIONS)
;
;            The lists of system procedures and functions is returned,
;            as a string array.
;
;   LEVNUM = ROUTINE_NAMES(/LEVEL)
;
;            The call level of the calling routine is returned.
;
;   NAMES  = ROUTINE_NAMES(ARG0, ARG1, ..., ARGN, ARG_NAME=LEVEL)
;
;            The names of variables ARGi at call level LEVEL are
;            returned, as a string array.  Note that ARGi are the
;            actual parameters, not strings containing their names.
;            ARGi must be parameters that have been passed to the
;            calling procedure.  Variables that are unnamed at the
;            specified call level will return the empty string.
;            [IDL v5.0 and above only]
;            
;
;   VARS   = ROUTINE_NAMES(VARIABLES=LEVEL)
;
;            The names of variables at call level LEVEL are returned,
;            as a string array.
;
;   VARS   = ROUTINE_NAMES(PROC, /P_VARIABLES, /P_PARAMETERS)
;   VARS   = ROUTINE_NAMES(FUNC, /F_VARIABLES, /F_PARAMETERS)
;
;            The names of the variables and parameters, respectively,
;            defined in compiled procedure PROC, or compiled function
;            FUNC, are returned as a string array.
;
;   VALUE  = ROUTINE_NAMES(NAME, FETCH=LEVEL)
;
;            The value of the named variable NAME at call level LEVEL
;            is returned.  If the value is undefined, then the
;            assignment will cause an error.  Therefore, the only safe
;            way to retrieve a value is by using a variant of the
;            following:
;              IF N_ELEMENTS(ROUTINE_NAMES(NAME, FETCH=LEVEL)) GT 0 THEN $
;                VALUE  = ROUTINE_NAMES(NAME, FETCH=LEVEL)
;
;   DUMMY  = ROUTINE_NAMES(NAME, VALUE, STORE=LEVEL)
;
;            The value VALUE is stored into the named variable NAME at
;            call level LEVEL.  Note that there is no way to cause the
;            named variable to become undefined.  The value returned
;            in DUMMY can be ignored.
;            [IDL v5.2 and earlier: new variables cannot be created]
;            [IDL v5.3 and later: new variables can be created]
;
; SEE ALSO:
;
;   ROUTINE_INFO, ARG_PRESENT, DXDEBUG (Markwardt Debug Library)
;
; MODIFICATION HISTORY:
;   Written, 20 Jul 2000
;   Documented differences between IDL versions, 21 Sep 2000, CM
;
;
;  $Id: routine_names.pro,v 1.2 2001/03/25 18:10:43 craigm Exp $
;
;-
; Copyright (C) 2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   SetFitParm.pro
;
; AUTHOR:
;	F.Bringezu, denet - Internetservice, Halle Germany,
;	bringezu@denet.de
;
; PURPOSE:
;   Provide a widget interface for creating a parinfo structure.
;   This parinfo structure can by used by mpfit routines of Craig B. Markwardt.
;
; MAJOR TOPICS:
;   Widget, mpfit.
;
; CALLING SEQUENCE:
;   parinfo=SetFitParm(used_parinfo)
;
; DESCRIPTION:
;
;   SetFitParm creates PARINFO using a widget interface.
;   PARINFO provides constraints for paramters used by the mpfit routines.
;
;   PARINFO is an array of structures, one for each parameter.
;
;   A detailed description can be found in the documentation of mpcurvefit.pro
;   This routine creates an array that contains a structure for each element.
;   The structure has the following entries.
;
;   - VALUE (DOUBLE): The starting parameter
;   - FIXED (BOOLEAN): 1 fix the parameter, 0 don't fix it at the
;     point given in VALUE.
;   - LIMITS (DBLARRAY(2)): Set upper and lower limit.
;   - LIMITED (BOOLEAN ARRAY 2):  Fix the limit.
;
;
;   The parameter OLDPARINFO is optional. OLDPARINFO is used to set
;   the default values in the widget.
;
;   You can simply run:
;   test=SetFitParm() to create the array for the first time.
;   Once the array is created it can be used to set the default values
;   in the widget by calling
;
;   test2=SetFitParm(test)
;
; INPUTS:
;
;
; OPTIONAL INPUTS:
;
;   OLDFITPARM - The default values of the new array
;
; INPUT KEYWORD PARAMETERS:
;
;   PARENT - if this widget is to be a child, set this keyword to the
;            parent widget ID.
;
; OUTPUT KEYWORD PARAMETERS:
;
;   CANCEL - if the user selected the cancel button on the SETFITPARM
;            widget, then this keyword will be set upon exit.
;
; OUTPUTS:
;   PARINFO array of structures
;
; SEE ALSO:
;   mpcurvefit
;
; MODIFICATION HISTORY:
;   Written, FB, 12/1999
;   Documented, FB, Jan 2000
;   Generalized positioning code, CM 01 Feb 2000
;
;-
; Copyright (C) 1999, F.Bringezu
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-
;;;;;;;;;;;;;;;;;;;  table headline ;;;;;;;;;;;;;;;;;;;;;;;;
;; with top labels VALUE AND LIMIT

  WID_LABEL_6 = Widget_Label(WID_BASE_1, UNAME='WID_LABEL_6'  $
      ,XOFFSET=60 ,YOFFSET=15, XSIZE=42, YSIZE=18  $
      ,/ALIGN_LEFT ,VALUE='Value')



  WID_LABEL_8 = Widget_Label(WID_BASE_1, UNAME='WID_LABEL_8'  $
      ,XOFFSET=250 ,YOFFSET=15 ,XSIZE=40,YSIZE=18  $
      ,/ALIGN_LEFT ,VALUE='Limits')

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


  WID_TEXT_0 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_0' ,FRAME=1  $
      ,XOFFSET=60 ,YOFFSET=40 , VALUE=[strtrim(string(fparm(0).value),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable,/ALIGN_LEFT) ;;; Amplitude


  WID_TEXT_1 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_1' ,FRAME=1  $
      ,XOFFSET=60 ,YOFFSET=70, VALUE=[strtrim(string(fparm(1).value),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; X(max)


  WID_TEXT_2 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_2' ,FRAME=1  $
      ,XOFFSET=60 ,YOFFSET=100, VALUE=[strtrim(string(fparm(2).value),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; Width

  WID_TEXT_3 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_3' ,FRAME=1  $
      ,XOFFSET=60 ,YOFFSET=130,VALUE=[strtrim(string(fparm(3).value),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; Offset

  WID_TEXT_4 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_4' ,FRAME=1  $
      ,XOFFSET=60 ,YOFFSET=160 ,VALUE=[strtrim(string(fparm(4).value),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; Slope

;;;;; Text widgets for lower limits

  WID_TEXT_5 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_5' ,FRAME=1  $
      ,XOFFSET=210 ,YOFFSET=40 ,VALUE=[strtrim(string(fparm(0).limits(0)),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable,/ALIGN_LEFT) ;;; Amplitude


  WID_TEXT_6 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_6' ,FRAME=1  $
      ,XOFFSET=210 ,YOFFSET=70, VALUE=[strtrim(string(fparm(1).limits(0)),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; X(max)


  WID_TEXT_7 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_7' ,FRAME=1  $
      ,XOFFSET=210 ,YOFFSET=100,VALUE=[strtrim(string(fparm(2).limits(0)),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; Width

  WID_TEXT_8 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_8' ,FRAME=1  $
      ,XOFFSET=210 ,YOFFSET=130, VALUE=[strtrim(string(fparm(3).limits(0)),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; Offset

  WID_TEXT_9 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_9' ,FRAME=1  $
      ,XOFFSET=210 ,YOFFSET=160 ,VALUE=[strtrim(string(fparm(4).limits(0)),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; Slope


;;;;; Text widgets for upper limits

  WID_TEXT_10 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_10' ,FRAME=1  $
      ,XOFFSET=290 ,YOFFSET=40, VALUE=[strtrim(string(fparm(0).limits(1)),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable,/ALIGN_LEFT) ;;; Amplitude


  WID_TEXT_11 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_11' ,FRAME=1  $
      ,XOFFSET=290 ,YOFFSET=70, VALUE=[strtrim(string(fparm(1).limits(1)),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; X(max)


  WID_TEXT_12 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_12' ,FRAME=1  $
      ,XOFFSET=290 ,YOFFSET=100, VALUE=[strtrim(string(fparm(2).limits(1)),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; Width

  WID_TEXT_13 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_13' ,FRAME=1  $
      ,XOFFSET=290 ,YOFFSET=130, VALUE=[strtrim(string(fparm(3).limits(1)),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; Offset

  WID_TEXT_14 = Widget_Text(WID_BASE_1, UNAME='WID_TEXT_14' ,FRAME=1  $
      ,XOFFSET=290 ,YOFFSET=160, VALUE=[strtrim(string(fparm(4).limits(1)),1)]  $
      ,XSIZE=5 ,YSIZE=1,/editable) ;;; Slope




;;;;;;;;;;;; Container for checkboxes and checkboxes for FIXED ;;;;;;;;;;;;;;;;

  WID_BASE_2 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_2'  $
      ,XOFFSET=110 ,YOFFSET=40 ,XSIZE=20 ,YSIZE=20  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER , ROW=1 ,/NONEXCLUSIVE)


  WID_BUTTON_0 = Widget_Button(WID_BASE_2,/ALIGN_CENTER,UVALUE='FIX_HEIGHT' $
      , VALUE='')
      ;;; Amplitude


  WID_BASE_3 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_3'  $
      ,XOFFSET=110 ,YOFFSET=70 ,XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,/NONEXCLUSIVE)


  WID_BUTTON_1 = Widget_Button(WID_BASE_3 ,/ALIGN_LEFT,UVALUE='FIX_XMAX' $
      , VALUE='')
      ;;; X(max)


  WID_BASE_4 = Widget_Base(WID_BASE_1  $
      ,XOFFSET=110 ,YOFFSET=100 ,XSIZE=20 ,YSIZE=27 ,/ALIGN_TOP ,/BASE_ALIGN_CENTER, /NONEXCLUSIVE)


  WID_BUTTON_2 = Widget_Button(WID_BASE_4, /ALIGN_LEFT,UVALUE='FIX_WIDTH' $
      , VALUE='')
      ;;; Width

  WID_BASE_5 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_5'  $
      ,XOFFSET=110 ,YOFFSET=130 ,XSIZE=20 ,YSIZE=27, /ALIGN_TOP, /BASE_ALIGN_CENTER, /NONEXCLUSIVE)


  WID_BUTTON_3 = Widget_Button(WID_BASE_5, /ALIGN_LEFT, UVALUE='FIX_OFFSET' $
      ,  VALUE='')
      ;;; Slope

  WID_BASE_6 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_6'  $
      , XOFFSET=110 ,YOFFSET=160, XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER, /NONEXCLUSIVE)


  WID_BUTTON_4 = Widget_Button(WID_BASE_6,/ALIGN_LEFT, UVALUE='FIX_SLOPE' $
      ,  value='')
      ;;; Slope

;;;;;;;;;;;; Container for checkboxes and checkboxes for lower limited ;;;;;;;;;;;;;;;;

  WID_BASE_7 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_7'  $
      ,XOFFSET=180 ,YOFFSET=40 ,XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1  $
      ,/GRID_LAYOUT ,/NONEXCLUSIVE)


  WID_BUTTON_5 = Widget_Button(WID_BASE_7 $
       ,/ALIGN_LEFT,UVALUE='LIMIT_HEIGHT_LOW',  VALUE='')
      ;;; Height

  WID_BASE_8 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_8'  $
      ,XOFFSET=180 ,YOFFSET=70 ,XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1  $
      ,/GRID_LAYOUT ,/NONEXCLUSIVE)


  WID_BUTTON_6 = Widget_Button(WID_BASE_8 $
      ,/ALIGN_LEFT,UVALUE='LIMIT_XMAX_LOW', VALUE='')
      ;;; Xmax

  WID_BASE_9 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_9'  $
      ,XOFFSET=180 ,YOFFSET=100 ,XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1  $
      ,/GRID_LAYOUT ,/NONEXCLUSIVE)


  WID_BUTTON_7 = Widget_Button(WID_BASE_9  $
      ,/ALIGN_LEFT,UVALUE='LIMIT_WIDTH_LOW',  value='')
      ;;; Width

  WID_BASE_10 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_10'  $
      ,XOFFSET=180 ,YOFFSET=130 ,XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1  $
      ,/GRID_LAYOUT ,/NONEXCLUSIVE)


  WID_BUTTON_8 = Widget_Button(WID_BASE_10, UNAME='WID_BUTTON_8'  $
     ,/ALIGN_LEFT,UVALUE='LIMIT_OFFSET_LOW', value= '')
      ;;; Offset

  WID_BASE_11 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_11'  $
      ,XOFFSET=180 ,YOFFSET=160 ,XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1  $
      ,/GRID_LAYOUT ,/NONEXCLUSIVE)


  WID_BUTTON_9 = Widget_Button(WID_BASE_11, UNAME='WID_BUTTON_9'  $
      ,/ALIGN_LEFT,UVALUE='LIMIT_SLOPE_LOW',  value='')
      ;;; Offset


;;;;;;;;;;;; Container for checkboxes and checkboxes for upper limited ;;;;;;;;;;;;;;;;

  WID_BASE_12 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_12'  $
      ,XOFFSET=265 ,YOFFSET=40 ,XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1  $
      ,/GRID_LAYOUT ,/NONEXCLUSIVE)


  WID_BUTTON_10 = Widget_Button(WID_BASE_12, UNAME='WID_BUTTON_10' $
  ,/ALIGN_LEFT,UVALUE='LIMIT_HEIGHT_UP',  value='')
      ;;; Height

  WID_BASE_13 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_13'  $
      ,XOFFSET=265 ,YOFFSET=70 ,XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1  $
      ,/GRID_LAYOUT ,/NONEXCLUSIVE)


  WID_BUTTON_11 = Widget_Button(WID_BASE_13, UNAME='WID_BUTTON_11'  $
       ,/ALIGN_LEFT,UVALUE='LIMIT_XMAX_UP',  value='')
      ;;; Xmax

  WID_BASE_14 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_14'  $
      ,XOFFSET=265 ,YOFFSET=100 ,XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1  $
      ,/GRID_LAYOUT ,/NONEXCLUSIVE)


  WID_BUTTON_12 = Widget_Button(WID_BASE_14, UNAME='WID_BUTTON_12'  $
 	 ,/ALIGN_LEFT,UVALUE='LIMIT_WIDTH_UP',  value='')
      ;;; Width

  WID_BASE_15 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_15'  $
      ,XOFFSET=265 ,YOFFSET=130 ,XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1  $
      ,/GRID_LAYOUT ,/NONEXCLUSIVE)


  WID_BUTTON_13 = Widget_Button(WID_BASE_15, UNAME='WID_BUTTON_13'  $
    	,/ALIGN_LEFT,UVALUE='LIMIT_OFFSET_UP',  VALUE='')
      ;;; Offset

  WID_BASE_16 = Widget_Base(WID_BASE_1, UNAME='WID_BASE_16'  $
      ,XOFFSET=265 ,YOFFSET=160 ,XSIZE=20 ,YSIZE=27  $
      ,/ALIGN_TOP ,/BASE_ALIGN_CENTER ,TITLE='IDL' ,SPACE=2 ,ROW=1  $
      ,/GRID_LAYOUT ,/NONEXCLUSIVE)


  WID_BUTTON_14 = Widget_Button(WID_BASE_16, UNAME='WID_BUTTON_14'  $
     ,/ALIGN_LEFT,UVALUE='LIMIT_SLOPE_UP',  value='')
      ;;; Offset


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


  BUT_BASE=Widget_Base(tlb,Row=1,yoffset=260,xoffset=120,/ALIGN_CENTER)
  CANCEL=Widget_Button(BUT_BASE,Value='Cancel', UVALUE='Cancel')
  ACCEPT=Widget_Button(BUT_BASE,Value='Accept', UVALUE='Accept')

   ; Create a pointer. This will point to the location where the
   ; information collected from the user will be stored.


ptr = Ptr_New({fparm:fparm, Cancel:1})

   ; Create info structure to hold information needed in event handler. This info structure containes also the parinfo
   ; that is used for mpfit.


buttons=[WID_BUTTON_0,WID_BUTTON_1,WID_BUTTON_2,WID_BUTTON_3,WID_BUTTON_4,$
		 WID_BUTTON_5,WID_BUTTON_6,WID_BUTTON_7,WID_BUTTON_8,WID_BUTTON_9,$
		 WID_BUTTON_10,WID_BUTTON_11,WID_BUTTON_12,WID_BUTTON_13,WID_BUTTON_14,$
		 CANCEL]
text = 	[WID_TEXT_0,WID_TEXT_1,WID_TEXT_2,WID_TEXT_3,WID_TEXT_4,$
		 WID_TEXT_5,WID_TEXT_6,WID_TEXT_7,WID_TEXT_8,WID_TEXT_9,$
		 WID_TEXT_10,WID_TEXT_11,WID_TEXT_12,WID_TEXT_13,WID_TEXT_14]

for i=0,4 do begin
widget_control,buttons(i),set_button=fparm(i).fixed
endfor

for i=5,9 do begin
widget_control,buttons(i),set_button=fparm(i-5).limited(0)
endfor

for i=10,14 do begin
widget_control,buttons(i),set_button=fparm(i-10).limited(1)
endfor


info = {buttons:buttons, $ 	; Identifier of widget holding buttons (checkboxes).
		text:text,$			; Identifier of widget holding textfields.
		fparm:fparm,$		; The actual parinfo
		ptr:ptr} 			; The pointer


            ; Store the info structure in the top-level base

Widget_Control, tlb, Set_UValue=info, /No_Copy
Widget_Control, /REALIZE, tlb

   ; Register the program, set up event loop. Make this program a
   ; blocking widget. This will allow the program to also be called
   ; from IDL command line without a PARENT parameter. The program
   ; blocks here until the entire program is destroyed.

XManager, 'SetFitParm', tlb, Event_Handler='SetFitParm_Events'

  ; OK,

newInfo = *ptr
Ptr_Free, ptr

  ; All kinds of things can go wrong now. Let's CATCH them all.

Catch, error
IF error NE 0 THEN BEGIN
   Catch, /Cancel

		      ; If an error occurs, set the CANCEL flag and return -1.

   ok = Dialog_Message(!Err_String)
   cancel = 1
   RETURN, -1
ENDIF


   ; If the error flag is set, let's disappear!

cancel = newInfo.cancel
IF cancel THEN RETURN, FParm

   ; OK, try to read the data file. Watch out!


RETURN, newInfo.FParm
END ;*******************************************************************
;+
; NAME:
;   SRVADD
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Add velocity 3-vectors according to special relativity
;
; MAJOR TOPICS:
;   Physics, Geometry
;
; CALLING SEQUENCE:
;   U0 = SRVADD(U1, V)
;
; DESCRIPTION:
;
;  The function SRVADD performs addition of velocity 3-vectors
;  according to special relativity.
;
;  Consider two inertial coordinate frames.  Frame "0" is a "lab" or
;  rest frame.  Frame "1" is a "rocket" or moving frame, moving at
;  velocity V with respect to the lab frame.  The velocity V is
;  allowed to be an arbitrary 3-vector.
;
;    * An observer in the rocket frame sees a body moving at velocity U1.
;
;    * An observer in the lab frame sees the same body moving at
;      velocity U0.
;
;    * This function solves for U0 in terms of V and U1.
;
;  U1 and V are allowed to be 3xN arrays, which means more than one
;  vector can be computed in a single call.  If the dimensions of
;  either U1 or V are 3x1, then it will be expanded to match the
;  dimensions of the other vector.  This simulates addition by a
;  "scalar" vector.  Because V can be a 3xN array, this means that
;  multiple "rocket" frames can be computed at one time.
;
;  NOTE: Velocities passed to SRVADD are measured as a *fraction of
;        the speed of light*.  Therefore, if the velocities are
;        measured in some physical units, and CLIGHT is the speed of
;        light in those same units, then the following statement:
;
;           U0 = SRVADD(U1/CLIGHT, V/CLIGHT)*CLIGHT
;
;        will compute the velocity U0, also in the same units.
;
;
;  The formula for computing the velocity in the lab frame is:
;
;         ( (1-1/GAMMA)*(U1 . VUNIT)*VUNIT + U1/GAMMA + V )
;    U0 = -------------------------------------------------
;                           (1 - U1 . V)
;
;  where 
;    GAMMA is the Lorentz factor = 1/SQRT(1 - |V|^2)
;    VUNIT is the unit vector in the direction of V, = V/|V|
;    "." is the vector dot product
;
;  [ IDL notation is not strictly adhered to in this formula, for
;  clarity of presentation. ]
;
;
; INPUTS:
;
;   U1 - 3-vector or 3xN array, the velocity of a body as seen in the
;        rocket frame (frame 1).  The velocity is normalized such that
;        the speed of light is 1.
;
;
;   V - 3-vector or 3xN array, the velocity of the rocket frame as
;       seen by an observer in the lab.  The velocity is normalized
;       such that the speed of light is 1.
;
; RETURNS:
;
;   A 3xN array, containing the velocity of the body as seen in the
;   lab frame.  The velocity is normalized such that the speed of
;   light is 1.
;
; KEYWORD PARAMETERS:
;
;   CLASSICAL - if set, then classical velocity addition is performed,
;               and the relativistic form is disabled.
;               Default: not set (i.e., relativity is applied)
;
; EXAMPLE:
;
;   IDL> print, srvadd([0.1d,0,0],   [0.5d,0,0])
;         0.56504883       0.0000000       0.0000000
;
;   Adds velocities of 0.1 and 0.5 times the speed of light.  The
;   result is slightly less than the arithmetic sum.
;
;
;   IDL> print, srvadd([0.,0.1,0],[0.5d,0,0])
;         0.50000000     0.086602542       0.0000000
;
;   Adds velocities in two orthogonal directions.  Demonstrates the
;   relativistic aberration of velocities (i.e., velocities in the
;   perpendicular direction are affected).
;
;
; MODIFICATION HISTORY:
;   Written, 28 Jan 2002, CM
;   More documentation, 29 Jan 2002, CM
;   Add CLASSICAL keyword, 29 Jul 2002, CM
;
;  $Id: srvadd.pro,v 1.3 2002/07/29 23:16:47 craigm Exp $
;
;-
; Copyright (C) 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   SRVDOPP
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute relativistic doppler shift (arbitrary velocity & photon dir.)
;
; MAJOR TOPICS:
;   Physics, Geometry
;
; CALLING SEQUENCE:
;   NU1_NU0 = SRVDOPP(U0, V)
;
; DESCRIPTION:
;
;  The function SRVDOPP computes the relativistic doppler shift
;  between two inertial reference frames.
;
;  Consider two inertial coordinate frames.  Frame "0" is a "lab" or
;  rest frame.  Frame "1" is a "rocket" or moving frame, moving at
;  velocity V with respect to the lab frame.  The velocity V is
;  allowed to be an arbitrary 3-vector.
;
;    * An observer in the lab frame sees a photon of frequency NU0
;      propagating in the direction U0. (U0 is a unit 3-vector)
;
;    * An observer in the rocket frame observes the same photon with
;      frequency NU1.
;
;    * This function computes the ratio NU1 / NU0.
;
;  U0 and V are allowed to be 3xN arrays, which means more than one
;  set of values can be computed in a single call.  If the dimensions
;  of either U0 or V are 3x1, then it will be expanded to match the
;  dimensions of the other vector.
;
;  NOTE: Velocities passed to SRVDOPP are measured as a *fraction of
;        the speed of light*.
;
;  The formula for computing the relativistic doppler shift is:
;              
;    NU1_NU0 =  (1 - U0 . V) * GAMMA
;              
;  where 
;    GAMMA is the Lorentz factor = 1/SQRT(1 - |V|^2)
;    "." is the vector dot product
;
;  [ IDL notation is not strictly adhered to in this formula, for
;  clarity of presentation. ]
;
;
; INPUTS:
;
;   U0 - 3-vector or 3xN array, the unit vector of the photon
;        propagation direction, as seen in the lab frame.
;
;   V - 3-vector or 3xN array, the velocity of the rocket frame as
;       seen by an observer in the lab.  The velocity is normalized
;       such that the speed of light is 1.
;
; RETURNS:
;
;   A N-vector giving the ratio, NU1/NU0, which is the ratio of the
;   frequency observed in the rocket frame to the frequency seen in
;   the lab frame.
;
; KEYWORD PARAMETERS:
;
;   CLASSICAL - if set, then classical Doppler shift is performed,
;               and the relativistic form is disabled.
;               Default: not set (i.e., relativity is applied)
;
; EXAMPLE:
;
;   IDL> RATIO = SRVDOPP([-1d,0,0], [0.1d,0,0])
;
;   A photon of frequency NU0 is moving along the -x axis in the lab
;   frame; a rocket observer is moving with speed 0.1 c along the +x
;   axis.  NU0 * RATIO is the frequency seen by the rocket observer.
;
;
;   IDL> RATIO = SRVDOPP([0,-1d,0], [0.1,0,0])
;
;   The observer is the same, but the photon is moving along the -y
;   axis.  NU0 * RATIO is the frequency seen by the rocket observer.
;   This is the relativistic transverse doppler shift.
;
;
; MODIFICATION HISTORY:
;   Written, 05 May 2002, CM
;   Documentation, 12 May 2002, CM
;   Add CLASSICAL keyword, 29 Jul 2002, CM
;
;  $Id: srvdopp.pro,v 1.3 2002/07/29 23:16:47 craigm Exp $
;
;-
; Copyright (C) 2002, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   STATUSLINE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Maintain a one-line status line on a VT100-compatible terminal. (Unix)
;
; MAJOR TOPICS:
;   Text Output, Terminal.
;
; CALLING SEQUENCE:
;   STATUSLINE, string, column, LENGTH=length, [/CLOSE,]
;      [/CLEAR,] [/LEFT,] [/RIGHT,] [/QUIET,] [/ENABLE,] [/DISABLE]
;
; DESCRIPTION: 
;
;   STATUSLINE maintains the current line of a VT100- or
;   ANSI-compatible terminal, usually as a status line.
;
;   Programs that run for extended periods of time can inform the user
;   of the status of the computation by printing vital information.
;   Instead of cluttering the console by using the PRINT procedure,
;   which uses a new line with each call, STATUSLINE will re-use the
;   same line.  This can make a cleaner interface.
;
;   STATUSLINE interacts directly with the Unix terminal device,
;   sending VT100-compatible cursor commands.  As a side effect it
;   opens the terminal device /dev/tty and allocates a logical unit
;   number.  Picky programmers should call STATUSLINE, /CLOSE to close
;   the file unit.
;
;   Procedures that finish their computation, or wish to make normal
;   output to the console should first clear the terminal line with
;   STATUSLINE, /CLEAR.  This will ensure that the console is
;   uncluttered before printing.
;
;   By default, STATUSLINE enables output for terminal types vt100,
;   vtnnn, xterm, dec, or ansi.  *No* output appears on other
;   terminals.  You can enable it explicitly by calling STATUSLINE,
;   /ENABLE, and disable it by calling STATUSLINE, /DISABLE.
;
; INPUTS:
;
;   STRING - A string to be placed on the current line.
;
; OPTIONAL INPUTS:
;
;   COLUMN - The starting column number, beginning with zero.
;            Default: zero.
;
; INPUT KEYWORD PARAMETERS:
;
;   LENGTH - the record length, an integer.  Strings longer than this
;            length will be truncated.  
;            Default: strlen(STRING)
;
;   CLEAR - if set, clear the current line to the end.  Control
;           returns immediately (i.e., no output is made).
;
;   LEFT  - if set, then left justify the string within the record.
;           If the string is longer than the record length, then the
;           leftmost portion of the string is printed.
;           The Default (if /RIGHT is not given).
;
;   RIGHT - if set, then right jusfity the string within the record.
;           If the string is longer than the record length, then the
;           rightmost portion of the string is printed.
;
;   QUIET - if set, then no output is made (for this call only).
;
;   NOCR - if set, no carriage return operation is performed after
;          output.  This also has the side effect that in subsequent
;          calls, column "0" will not cause the cursor to move.
;          Default: cursor returns to column 0 after each output.
;
;   ENABLE - if set, then permanently enable output by STATUSLINE.
;            Normally STATUSLINE automatically enables output only for
;            vt100-compatible terminals.  By setting /ENABLE, you
;            override this automatic test.  However, /QUIET will
;            still override ENABLE in an individual call.
;
;   DISABLE - if set, then permanently disable output by STATUSLINE.
;             When disabled, no output is ever produced.  Output can
;             only be re-enabled again by using the /ENABLE flag.
;
;   CLOSE - if set, instruct STATUSLINE to close the terminal device
;           logical unit number.  Users should perform this operation
;           when the computation has finished so that the terminal
;           device is not left dangling open.  If, at a later time,
;           STATUSLINE is called again, the terminal device will be
;           re-opened.
;
; OUTPUTS:
;   NONE
;
; SEE ALSO:
;   PRINT, PRINTF
;   PRINTLOG - to maintain transcript of IDL output
;
; MODIFICATION HISTORY:
;   Written, CM, 1997-1998
;   Documented, CM, Sep 1999
;   Added NOCR keyword, CM, 28 Oct 1999
;   Doesn't crash if can't write to TTY.  Returns silently.  CM, 16
;     Nov 1999.
;   Added PRINTLOG to "SEE ALSO", CM, 22 Jun 2000
;   Keyword QUIET now causes earlier exit; catch errors in the CLEAR
;     case, CM, 12 Oct 2001
;   Allow variations on the "xterm" terminal type, CM, 26 Jun 2007
;
;  $Id: statusline.pro,v 1.5 2007/06/26 16:15:12 craigm Exp $
;
;-
; Copyright (C) 1998, 1999, 2000, 2001, 2007, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-
;+
; NAME:
;   SUBCELL
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Finds the position of a subwindow within a reference window.
;
; CALLING SEQUENCE:
;   sub = subcell(panel, refposition)
;
; DESCRIPTION: 
;
;   SUBCELL finds the position of a subwindow within another window.
;   This could be useful in cases where the position of one window is
;   specified relative to another one.
;
;   When plotting, one often wants to describe the position of the
;   plot box with respect to another box on the screen.  In that
;   respect, the reference window can be thought of as a virtual
;   display, and the SUBPOS as virtual a position on that display.
;   The SUBCELL function transforms the relative coordinates of the
;   virtual position back to normal screen coordinates.
;
; INPUTS:
;
;   SUBPOS - A four-element array giving the position of the
;            subwindow, *relative* to a reference window given by
;            POSITION.  Given as [XS1, YS1, XS2, YS2], which describes
;            the lower left and upper right corners of the subwindow.
;            Each value is a number between zero and one, zero being
;            the lower/left and one being the upper/right corners of
;            the reference window.
;
;   POSITION - A four-element array giving the position of the
;              reference window on the screen.  Equivalent to the
;              graphics keyword of the same name.
; 
; OPTIONAL INPUTS:
;   NONE
;
; INPUT KEYWORD PARAMETERS:
;
;   MARGIN - If set, then a default value for SUBPOS is found using
;            the DEFSUBCELL function.
;
; RETURNS:
;   The position of the subwindow, in normal coordinates.
;
; PROCEDURE:
;
; EXAMPLE:
;
;
; SEE ALSO:
;
;   DEFSUBCELL, SUBCELLARRAY
;
; EXTERNAL SUBROUTINES:
;
;   DEFSUBCELL
;
; MODIFICATION HISTORY:
;   Written, CM, 1997
;   Added copyright notice, 25 Mar 2001, CM
;
;  $Id: subcell.pro,v 1.2 2001/03/25 18:54:31 craigm Exp $
;
;-
; Copyright (C) 1997,2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   SUBCELLARRAY
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Returns a set of subcells, suitable for creating a matrix of plots.
;
; CALLING SEQUENCE:
;   subcellarray, xdivs, ydivs, newpanels, newsubpanels
;
; DESCRIPTION: 
;
;   SUBCELLARRAY generates a group of subcells.  The subcells are
;   useful for plotting a matrix of windows.
;
;   This procedure takes a list of subdivisions in X and Y,
;   designating the subdivision of the plot into num(X) X panels and
;   num(Y) Y panels, and creates a new batch of panels and subpanels,
;   which can be used in the individual plot commands of the array.
;
; INPUTS:
;
;   XDIVS - list of subdivisions in the X-direction.  Example: [1,1,2]
;           will create three panels in the X-direction such that
;           their sizes are in the ratio of 1:1:2 (1 being on the
;           left, 2 being on the right).  These are the subdivisions
;           of the SUBPANEL, the inner plot box boundary, not
;           divisions of the PANEL, which is the boundary that
;           includes axis labels.
;
;   YDIVS - same, for Y direction
;
; OPTIONAL INPUTS:
;   NONE
;
; INPUT KEYWORD PARAMETERS:
;
;   PANEL - Original panel (outer margin) of plot. Default is to fill
;           screen.
;
;   SUBPANEL - Original subpanel (inner margin) of plot.  Default is
;              to use defsubcell().
;
; OUTPUTS:
;
;   NEWPANELS - output array of panels.  The output is 4 x M x N where
;               M is the number of X divisions and N is the number of
;               Y divisions.
;
;   NEWSUBPANELS - output array of subpanels, with correct adjustment
;                  for margins, same format as NEWPANELS.
;
; PROCEDURE:
;
; EXAMPLE:
;
;   See PLOTCUBE for an example usage.
;
; SEE ALSO:
;
;   DEFSUBCELL, SUBCELLARRAY, PLOTCUBE
;
; EXTERNAL SUBROUTINES:
;
;   DEFSUBCELL, SUBCELL
;
; MODIFICATION HISTORY:
;   Written, CM, 1997
;   Added copyright notice, 25 Mar 2001, CM
;   Add usage message, 19 May 2009, CM
;
;  $Id: subcellarray.pro,v 1.4 2009/07/01 15:58:41 craigm Exp $
;
;-
; Copyright (C) 1997,2001,2009, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   TAGSIZE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Compute SIZE descriptors for each tag in a structure
;
; CALLING SEQUENCE:
;   SIZES = TAGSIZE(STRUCT, N_TAGS=ntags, TAG_NAMES=tagnames,
;                   STRUCTURE_NAME=structname, STATUS=status, LENGTH=length)
;
; DESCRIPTION: 
;
;   The TAGSIZE function determines the types and sizes of each tag in
;   a structure.  This is not as easy as it may seem, because IDL
;   makes it very, *very* difficult to find out the true dimensions of
;   a structure element.
;
;   Here is a brief explanation.  It is known that IDL drops trailing
;   dimensions of size 1 in many situations.  Also, for structures
;   only, arrays of any dimensionality which have only one element are
;   RETURNED AS SCALARS.  Thus, if you are doing any heavy duty work
;   with structures, copying and querying individual elements between
;   structures, etc., you will find that you will lose some crucial
;   dimensions which you can't normally regain.
;
;   TAGSIZE attempts to work around all of these limitations to
;   present the true dimensions of all elements in a structure.
;
;   It returns an 11xNTAGS array, which contains a SIZE-style vector
;   for each element in the structure.  Eleven elements is the largest
;   array size needed to describe any IDL data type using SIZE.  Thus,
;   to extract information about the second tag in structure X
;   (element number 1 starting from zero), you would use the following
;   code:
;
;     SIZES = TAGSIZE(X)  ;; Extract type information from structure X
;     SIZE_1 = SIZES(*,1) ;; Extract type information about the 2nd element
;
;     SIZE_1 = SIZE_1(0:SIZE_1(0)+2) ;; Trim the array if desired
;
;   The last command is optional, but trims the resulting array to be
;   a true SIZE-style result.
;     
;   TAGSIZE also has several convenience keywords to extract other
;   relevant information about a structure.
;
;
; INPUTS:
;
;   STRUCTURE - any structure to examine.  If the value is not a
;               structure then an error is reported.
;
; KEYWORDS:
;
;   N_TAGS - upon return, the number of tags in the structure is
;            stored in this keyword.
;
;   TAG_NAMES - upon return, the names of each tag are stored in this
;               keyword, as an array of strings.
;
;   STRUCTURE_NAME - upon return, the name of the structure is stored
;                    in this keyword.  If the structure is anonymous
;                    then the empty string ('') is returned.
;
;   LENGTH - upon return, the size in bytes of each tag element in the
;            structure is stored in this keyword, as an array of
;            integers.
;
;   STATUS - upon return, the status is stored in this keyword.  A
;            value of 1 indicates success, 0 indicates failure.
;
;
; RETURNS:
;
;   A two dimensional array, with dimensions LONARR(11,NTAGS),
;   containing the size information of all tag elements in the
;   structure.  SIZES(*,i) is the SIZE-style vector for tag element i.
;
; EXAMPLE:
;
;   Compute the sizes of the elements in X, defined here.
;     IDL> x = {a: [1], b: intarr(2,2), c: reform(strarr(2,1),2,1)}
;     IDL> help, /struct, x
;     ** Structure <818c8b4>, 3 tags, length=28, refs=1:
;        A               INT       Array[1]
;        B               INT       Array[2, 2]
;        C               STRING    Array[2, 1]
;     IDL> print, byte(tagsize(x))
;        1  [1]  2   1   0   0   0   0   0   0   0
;        2  [2   2]  2   4   0   0   0   0   0   0
;        2  [2   1]  7   2   0   0   0   0   0   0
;     [ Array dimensions are emphasized with brackets ]
;
;   Compare this to the type information returned by HELP, which is
;   incorrect for tags A and C.
;     IDL> help, x.a, x.b, x.c
;     <Expression>    INT       =        1
;     <Expression>    INT       = Array[2, 2]
;     <Expression>    STRING    = Array[2]
;
; SEE ALSO:
;
;   TAG_NAMES, N_TAGS, SIZE, HELP, INPUTFORM, HELPFORM
;
; MODIFICATION HISTORY:
;   Written, CM, 13 May 2000
;   Documented, 05 Jul 2000
;   Small documentation changes, CM, 31 Aug 2000
;   Signficant cleanup of HELP parsing, CM, 04 Dec 2000
;   Added case for array of structures with new parsing, CM 12 Jan
;     2001
;
;  $Id: tagsize.pro,v 1.4 2001/02/09 04:57:42 craigm Exp $
;
;-
; Copyright (C) 2000-2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   TAI_UTC
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute (TAI - UTC) time difference (i.e., leap seconds)
;
; MAJOR TOPICS:
;   Time
;
; CALLING SEQUENCE:
;   LEAP = TAI_UTC(JD_UTC)                  ;; or,
;   LEAP = TAI_UTC(JD_TAI, /INVERT)
;
; DESCRIPTION:
;
;   The function TAI_UTC computes the difference between International
;   Atomic Time (TAI) and Universal Coordinated Time (UTC), in
;   seconds.  
;
;   After 01 Jan 1972, the two time systems are synchronized, except
;   for a number of leap seconds added to account for the varying rate
;   of rotation of the earth.  While TAI is a continuous atomic time
;   system, UTC is a civil time system which may have discontinuities
;   where leap seconds are introduced.  This function computes the
;   differences between the two time systems.
;
;   The conversion from UTC to TAI is computed as:
;
;     JD_TAI = JD_UTC + TAI_UTC(JD_UTC)/86400
;
;   The inversion conversion, from TAI to UTC, is computed as:
;
;     JD_UTC = JD_TAI + TAI_UTC(JD_TAI, /INVERT)/86400
;
;   Here JD_UTC and JD_TAI are the UTC and TAI times measured in
;   Julian days respectively.
;
;   The introduction of leap seconds is not predictable, owing to the
;   non-linear processes that govern the rotation of the earth.  The
;   International Earth Rotation Service determines when leap seconds
;   will be introduced.  Thus, the user must download the history of
;   leap seconds.  This file can be downloaded at the following URL:
;
;     ftp://maia.usno.navy.mil/ser7/tai-utc.dat
;
;   NOTE - the leap second file must be kept up to date as new leap
;   seconds are introduced.  The file is kept internally in
;   memory, but is reloaded from disk at least once per day.
;
;   If the disk file is not available, then a copy of the file as
;   available from the USNO in 2009 is used, but a warning message is
;   printed.
;
;   The leap second data can be loaded in several ways:
;      1. The FILENAME keyword may specify the exact file name and path;
;      2. If FILENAME is not defined, or the empty string, then
;         the default location $ASTRO_DATA/tai-utc.dat is used;
;         (ASTRO_DATA is a system environment variable, used by
;          the IDL astronomy library to store auxiliary data files)
;      3. If neither #1 or #2 are available, then the internal table
;         is used.
;
;
; PARAMETERS: 
;
;   JD - time measured in Julian days.  The time being converted
;        *from*.
;
; RETURNS:
;
;   The number of seconds to be added to the input time, to arrive at
;   the desired time.
;
;
; KEYWORD PARAMETERS:
;
;   INVERT - if set, then convert from TAI to UTC.  If not set
;            (default), then convert from UTC to TAI.
;
;   FILENAME - a scalar string, indicating the file name containing
;              leap second data.  The data is only loaded once upon
;              the first call, and then with a frequency determined by
;              the RELOAD_EVERY keyword.  If FILENAME is not
;              specified or a blank string, then the leap second data
;              is found using the methods described above.
;              Default: not defined; i.e. TAI_UTC searches the default
;                       locations
;
;   RELOAD_EVERY - a scalar value, indicates how often the data should
;                  be reloaded for long-running tasks.  The value is
;                  expressed in days.  If the leap second data was
;                  loaded more than RELOAD_EVERY days ago, then it
;                  will be reloaded.  Note that a value of 0 will
;                  cause immediate re-load of data.
;                  Default: 1 (i.e. re-load every 1 day)
; 
; EXAMPLE:
;
;   For data stored in $ASTRO_DATA,
;     print, tai_utc(2451544.5d)  ;; Uses $ASTRO_DATA/tai-utc.dat
;         32.000000
;     
;   For the data stored in one's home directory,
;     filename = getenv('HOME')+'tai-utc.dat'
;     print, tai_utc(2451544.5d, filename=filename)
;         32.000000
;
;
; REFERENCES:
;
;   Definition of leap seconds.
;      http://tycho.usno.navy.mil/leapsec.html
;
;   File containing leap seconds.
;     ftp://maia.usno.navy.mil/ser7/tai-utc.dat
;
;
; SEE ALSO
;   TDB2TDT, SYSTIME, CALDAT, JULDAY
;   
; MODIFICATION HISTORY:
;   Written and Documented, CM, Dec 2001
;   Fixed array indexing errors when the requested time range falls in
;     the leap second period, and the input is an array; avoided use
;     of variable JDAY, which is a function clash for me, 02 Mar 2002,
;     CM
;   Added helpful usage message, CM, 15 Mar 2002
;   Made file handling more robust (instead of crashing), CM, 19 Jul 2005
;   Add 01 Jan 2006 leap second, CM, 03 Oct 2005
;   Add 01 Jan 2009 leap second, CM, 21 Jul 2008
;   Add documentation and the RELOAD_EVERY keyword, CM, 02 Dec 2009
;   New default file location is $ASTRO_DATA/tai-utc.dat, CM, 28 Dec 2009
;   Add 01 Jul 2012 leap second, CM, 2012-01-05
;   Correct note for previous leap second (thanks James Tursa), CM, 2012-07-19
;   Add 01 Jul 2015 leap second, CM, 2015-02-25
;   Add more error checking for cases of IDL Astronomy and "no" file,
;       CM, 2016-07-11
;   Add 01 Jan 2017 leap second, CM, 2016-07-11
;
;  $Id: tai_utc.pro,v 1.16 2016/07/11 21:26:27 cmarkwar Exp $
;
;-
; Copyright (C) 2001, 2002, 2005, 2008, 2009, 2012, 2015, 2016 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-
;+
; NAME:
;   TDB2TDT
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Relativistic clock corrections due to Earth motion in solar system 
;
; MAJOR TOPICS:
;   Planetary Orbits
;
; CALLING SEQUENCE:
;   corr = TDB2TDT(JD, TBASE=, DERIV=deriv)
;
; DESCRIPTION:
;
;   The function TDB2TDT computes relativistic corrections that must
;   be applied when performing high precision absolute timing in the
;   solar system.
;
;   According to general relativity, moving clocks, and clocks at
;   different gravitational potentials, will run at different rates
;   with respect to each other.  A clock placed on the earth will run
;   at a time-variable rate because of the non-constant influence of
;   the sun and other planets.  Thus, for the most demanding
;   astrophysical timing applications -- high precision pulsar timing
;   -- times in the accelerating earth observer's frame must be
;   corrected to an inertial frame, such as the solar system
;   barycenter (SSB).  This correction is also convenient because the
;   coordinate time at the SSB is the ephemeris time of the JPL
;   Planetary Ephemeris.
;
;   In general, the difference in the rate of Ti, the time kept by an
;   arbitrary clock, and the rate of T, the ephemeris time, is given
;   by the expression (Standish 1998):
;
;      dTi/dT = 1 - (Ui + vi^2/2) / c^2
;
;   where Ui is the potential of clock i, and vi is the velocity of
;   clock i.  However, when integrated, this expression depends on the
;   position of an individual clock.  A more convenient approximate
;   expression is:
;
;     T = Ti + (robs(Ti) . vearth(T))/c^2 + dtgeo(Ti) + TDB2TDT(Ti)
;
;   where robs is the vector from the geocenter to the observer;
;   vearth is the vector velocity of the earth; and dtgeo is a
;   correction to convert from the observer's clock to geocentric TT
;   time.  TDB2TDT is the value computed by this function, the
;   correction to convert from the geocenter to the solar system
;   barycenter.
;
;   As the above equation shows, while this function provides an
;   important component of the correction, the user must also be
;   responsible for (a) correcting their times to the geocenter (ie,
;   by maintaining atomic clock corrections); (b) estimating the
;   observatory position vector; and and (c) estimating earth's
;   velocity vector (using JPLEPHINTERP).
;
;   Users may note a circularity to the above equation, since
;   vearth(T) is expressed in terms of the SSB coordinate time.  This
;   appears to be a chicken and egg problem since in order to get the
;   earth's velocity, the ephemeris time is needed to begin with.
;   However, to the precision of the above equation, < 25 ns, it is
;   acceptable to replace vearth(T) with vearth(TT).
;
;   The method of computation of TDB2TDT in this function is based on
;   the analytical formulation by Fairhead, Bretagnon & Lestrade, 1988
;   (so-called FBL model) and Fairhead & Bretagnon 1990, in terms of
;   sinusoids of various amplitudes.  TDB2TDT has a dominant periodic
;   component of period 1 year and amplitude 1.7 ms.  The set of 791
;   coefficients used here were drawn from the Princeton pulsar timing
;   program TEMPO version 11.005 (Taylor & Weisberg 1989).
;
;   Because the TDB2TDT quantity is rather expensive to compute but
;   slowly varying, users may wish to also retrieve the time
;   derivative using the DERIV keyword, if they have many times to
;   convert over a short baseline.
;
; Verification
;
;   This implementation has been compared against a set of FBL test
;   data found in the 1996 IERS Conventions, Chapter 11, provided by
;   T. Fukushima.  It has been verified that this routine reproduces
;   the Fukushima numbers to the accuracy of the table, within
;   10^{-14} seconds.
;
;   Fukushima (1995) has found that the 791-term Fairhead & Bretagnon
;   analytical approximation use here has a maximum error of 23 ns and
;   rms error of 14 ns in the time range 1980-2000, compared to a
;   numerical integration (see Table 12).  In comparison the truncated
;   127-term approximation has a maximum error of ~130 ns and rms
;   error of 26 ns.
;
;
; PARAMETERS: 
;
;   JD - Geocentric time TT, scalar or vector, expressed in Julian
;        days.  The actual time used is (JD + TBASE).  For maximum
;        precision, TBASE should be used to express a fixed epoch in
;        whole day numbers, and JD should express fractional offset
;        days from that epoch.
;
;
; KEYWORD PARAMETERS:
;
;   TBASE - Julian day of a fixed epoch, which provides the
;           origin for times passed in JD.  Either a scalar, which
;           applies to all items, or a vector of same size as JD.
;           Default: 0
;
;   DERIV - upon return, contains the derivative of TDB2TDT in units
;           of seconds per day.  As many derivatives are returned as
;           values passed in JD.
;
;   NTERMS - number of terms to use in the computation, in case the
;            full series accuracy is not required. 
;            Default: all terms.
;
;
; RETURNS:
;   The correction offset(s) in units of seconds, to be applied as
;   noted above.
;
;
; EXAMPLE:
;
;   Find the correction at ephemeris time 2451544.5 (JD):
;     IDL> print, tdb2tdt(2451544.5d)
;       -0.00011376314
;   or 0.11 ms.
;
;
; REFERENCES:
;
;   Princeton TEMPO Program
;      http://pulsar.princeton.edu/tempo/
;
;   FBL Test Data Set
;      ftp://maia.usno.navy.mil/conventions/chapter11/fbl.results
;
;   Fairhead, L. & Bretagnon, P. 1990, A&A, 229, 240
;     (basis of this routine)
;
;   Fairhead, L. Bretagnon, P. & Lestrade, J.-F. 1988, in *The Earth's
;     Rotation and Reference Frames for Geodesy and Geodynamics*,
;     ed. A. K. Babcock and G. A. Wilkins, (Dordrecht: Kluwer), p. 419
;     (original "FBL" paper)
;
;   Fukushima, T. 1995, A&A, 294, 895  (error analysis)
;
;   Irwin, A. W. & Fukushima, T. 1999, A&A, 348, 642  (error analysis)
;
;   Standish, E. M. 1998, A&A, 336, 381 (description of time scales)
;
;   Taylor, J. H. & Weisberg, J. M. 1989, ApJ, 345, 434 (pulsar timing)
;
;
; SEE ALSO
;   JPLEPHREAD, JPLEPHINTERP, JPLEPHTEST
;   
; MODIFICATION HISTORY:
;   Original logic from Fairhead & Bretagnon, 1990
;   Drawn from TEMPO v. 11.005, copied 20 Jun 2001
;   Documented and vectorized, 30 Jun 2001
;   Added helpful usage message, CM, 15 Mar 2002
;   Add NTERMS keyword, CM, 07 Mar 2007
;   NTERMS was having no effect, now fixed, CM, 16 Jul 2008
;   Documentation about 'verification' was enhanced, CM, 27 Feb 2009
;   TBASE may be a vector, CM, 2012-04-09
;   Bug fix in case TBASE is not a vector, CM, 2013-09-29
;
;  $Id: tdb2tdt.pro,v 1.10 2013/09/30 02:27:05 cmarkwar Exp $
;
;-
; Copyright (C) 2001, 2002, 2007, 2009, 2012, 2013, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-
; T**1                          
fbldata = [ fbldata, $
 102.156724d,   6283.075849991d, 4.249032005d, $
   1.706807d,  12566.151699983d, 4.205904248d, $
   0.269668d,    213.299095438d, 3.400290479d, $
   0.265919d,    529.690965095d, 5.836047367d, $
   0.210568d,     -3.523118349d, 6.262738348d, $
   0.077996d,   5223.693919802d, 4.670344204d, $
   0.054764d,   1577.343542448d, 4.534800170d, $
   0.059146d,     26.298319800d, 1.083044735d, $
   0.034420d,   -398.149003408d, 5.980077351d, $
   0.032088d,  18849.227549974d, 4.162913471d, $
   0.033595d,   5507.553238667d, 5.980162321d, $
   0.029198d,   5856.477659115d, 0.623811863d, $
   0.027764d,    155.420399434d, 3.745318113d, $
   0.025190d,   5746.271337896d, 2.980330535d, $
   0.022997d,   -796.298006816d, 1.174411803d, $
   0.024976d,   5760.498431898d, 2.467913690d, $
   0.021774d,    206.185548437d, 3.854787540d, $
   0.017925d,   -775.522611324d, 1.092065955d, $
   0.013794d,    426.598190876d, 2.699831988d, $
   0.013276d,   6062.663207553d, 5.845801920d, $
   0.011774d,  12036.460734888d, 2.292832062d, $
   0.012869d,   6076.890301554d, 5.333425680d, $
   0.012152d,   1059.381930189d, 6.222874454d, $
   0.011081d,     -7.113547001d, 5.154724984d, $
   0.010143d,   4694.002954708d, 4.044013795d  ]
fbldata = [ fbldata, $
   0.009357d,   5486.777843175d, 3.416081409d, $
   0.010084d,    522.577418094d, 0.749320262d, $
   0.008587d,  10977.078804699d, 2.777152598d, $
   0.008628d,   6275.962302991d, 4.562060226d, $
   0.008158d,   -220.412642439d, 5.806891533d, $
   0.007746d,   2544.314419883d, 1.603197066d, $
   0.007670d,   2146.165416475d, 3.000200440d, $
   0.007098d,     74.781598567d, 0.443725817d, $
   0.006180d,   -536.804512095d, 1.302642751d, $
   0.005818d,   5088.628839767d, 4.827723531d, $
   0.004945d,  -6286.598968340d, 0.268305170d, $
   0.004774d,   1349.867409659d, 5.808636673d, $
   0.004687d,   -242.728603974d, 5.154890570d, $
   0.006089d,   1748.016413067d, 4.403765209d, $
   0.005975d,  -1194.447010225d, 2.583472591d, $
   0.004229d,    951.718406251d, 0.931172179d, $
   0.005264d,    553.569402842d, 2.336107252d, $
   0.003049d,   5643.178563677d, 1.362634430d, $
   0.002974d,   6812.766815086d, 1.583012668d, $
   0.003403d,  -2352.866153772d, 2.552189886d, $
   0.003030d,    419.484643875d, 5.286473844d, $
   0.003210d,     -7.046236698d, 1.863796539d, $
   0.003058d,   9437.762934887d, 4.226420633d, $
   0.002589d,  12352.852604545d, 1.991935820d, $
   0.002927d,   5216.580372801d, 2.319951253d  ]
fbldata = [ fbldata, $
   0.002425d,   5230.807466803d, 3.084752833d, $
   0.002656d,   3154.687084896d, 2.487447866d, $
   0.002445d,  10447.387839604d, 2.347139160d, $
   0.002990d,   4690.479836359d, 6.235872050d, $
   0.002890d,   5863.591206116d, 0.095197563d, $
   0.002498d,   6438.496249426d, 2.994779800d, $
   0.001889d,   8031.092263058d, 3.569003717d, $
   0.002567d,    801.820931124d, 3.425611498d, $
   0.001803d, -71430.695617928d, 2.192295512d, $
   0.001782d,      3.932153263d, 5.180433689d, $
   0.001694d,  -4705.732307544d, 4.641779174d, $
   0.001704d,  -1592.596013633d, 3.997097652d, $
   0.001735d,   5849.364112115d, 0.417558428d, $
   0.001643d,   8429.241266467d, 2.180619584d, $
   0.001680d,     38.133035638d, 4.164529426d, $
   0.002045d,   7084.896781115d, 0.526323854d, $
   0.001458d,   4292.330832950d, 1.356098141d, $
   0.001437d,     20.355319399d, 3.895439360d, $
   0.001738d,   6279.552731642d, 0.087484036d, $
   0.001367d,  14143.495242431d, 3.987576591d, $
   0.001344d,   7234.794256242d, 0.090454338d, $
   0.001438d,  11499.656222793d, 0.974387904d, $
   0.001257d,   6836.645252834d, 1.509069366d, $
   0.001358d,  11513.883316794d, 0.495572260d, $
   0.001628d,   7632.943259650d, 4.968445721d  ]
fbldata = [ fbldata, $
   0.001169d,    103.092774219d, 2.838496795d, $
   0.001162d,   4164.311989613d, 3.408387778d, $
   0.001092d,   6069.776754553d, 3.617942651d, $
   0.001008d,  17789.845619785d, 0.286350174d, $
   0.001008d,    639.897286314d, 1.610762073d, $
   0.000918d,  10213.285546211d, 5.532798067d, $
   0.001011d,  -6256.777530192d, 0.661826484d, $
   0.000753d,  16730.463689596d, 3.905030235d, $
   0.000737d,  11926.254413669d, 4.641956361d, $
   0.000694d,   3340.612426700d, 2.111120332d, $
   0.000701d,   3894.181829542d, 2.760823491d, $
   0.000689d,   -135.065080035d, 4.768800780d, $
   0.000700d,  13367.972631107d, 5.760439898d, $
   0.000664d,   6040.347246017d, 1.051215840d, $
   0.000654d,   5650.292110678d, 4.911332503d, $
   0.000788d,   6681.224853400d, 4.699648011d, $
   0.000628d,   5333.900241022d, 5.024608847d, $
   0.000755d,   -110.206321219d, 4.370971253d, $
   0.000628d,   6290.189396992d, 3.660478857d, $
   0.000635d,  25132.303399966d, 4.121051532d, $
   0.000534d,   5966.683980335d, 1.173284524d, $
   0.000543d,   -433.711737877d, 0.345585464d, $
   0.000517d,  -1990.745017041d, 5.414571768d, $
   0.000504d,   5767.611978898d, 2.328281115d, $
   0.000485d,   5753.384884897d, 1.685874771d  ]
fbldata = [ fbldata, $
   0.000463d,   7860.419392439d, 5.297703006d, $
   0.000604d,    515.463871093d, 0.591998446d, $
   0.000443d,  12168.002696575d, 4.830881244d, $
   0.000570d,    199.072001436d, 3.899190272d, $
   0.000465d,  10969.965257698d, 0.476681802d, $
   0.000424d,  -7079.373856808d, 1.112242763d, $
   0.000427d,    735.876513532d, 1.994214480d, $
   0.000478d,  -6127.655450557d, 3.778025483d, $
   0.000414d,  10973.555686350d, 5.441088327d, $
   0.000512d,   1589.072895284d, 0.107123853d, $
   0.000378d,  10984.192351700d, 0.915087231d, $
   0.000402d,  11371.704689758d, 4.107281715d, $
   0.000453d,   9917.696874510d, 1.917490952d, $
   0.000395d,    149.563197135d, 2.763124165d, $
   0.000371d,   5739.157790895d, 3.112111866d, $
   0.000350d,  11790.629088659d, 0.440639857d, $
   0.000356d,   6133.512652857d, 5.444568842d, $
   0.000344d,    412.371096874d, 5.676832684d, $
   0.000383d,    955.599741609d, 5.559734846d, $
   0.000333d,   6496.374945429d, 0.261537984d, $
   0.000340d,   6055.549660552d, 5.975534987d, $
   0.000334d,   1066.495477190d, 2.335063907d, $
   0.000399d,  11506.769769794d, 5.321230910d, $
   0.000314d,  18319.536584880d, 2.313312404d, $
   0.000424d,   1052.268383188d, 1.211961766d  ]
fbldata = [ fbldata, $
   0.000307d,     63.735898303d, 3.169551388d, $
   0.000329d,     29.821438149d, 6.106912080d, $
   0.000357d,   6309.374169791d, 4.223760346d, $
   0.000312d,  -3738.761430108d, 2.180556645d, $
   0.000301d,    309.278322656d, 1.499984572d, $
   0.000268d,  12043.574281889d, 2.447520648d, $
   0.000257d,  12491.370101415d, 3.662331761d, $
   0.000290d,    625.670192312d, 1.272834584d, $
   0.000256d,   5429.879468239d, 1.913426912d, $
   0.000339d,   3496.032826134d, 4.165930011d, $
   0.000283d,   3930.209696220d, 4.325565754d, $
   0.000241d,  12528.018664345d, 3.832324536d, $
   0.000304d,   4686.889407707d, 1.612348468d, $
   0.000259d,  16200.772724501d, 3.470173146d, $
   0.000238d,  12139.553509107d, 1.147977842d, $
   0.000236d,   6172.869528772d, 3.776271728d, $
   0.000296d,  -7058.598461315d, 0.460368852d, $
   0.000306d,  10575.406682942d, 0.554749016d, $
   0.000251d,  17298.182327326d, 0.834332510d, $
   0.000290d,   4732.030627343d, 4.759564091d, $
   0.000261d,   5884.926846583d, 0.298259862d, $
   0.000249d,   5547.199336460d, 3.749366406d, $
   0.000213d,  11712.955318231d, 5.415666119d, $
   0.000223d,   4701.116501708d, 2.703203558d, $
   0.000268d,   -640.877607382d, 0.283670793d  ]
fbldata = [ fbldata, $
   0.000209d,   5636.065016677d, 1.238477199d, $
   0.000193d,  10177.257679534d, 1.943251340d, $
   0.000182d,   6283.143160294d, 2.456157599d, $
   0.000184d,   -227.526189440d, 5.888038582d, $
   0.000182d,  -6283.008539689d, 0.241332086d, $
   0.000228d,  -6284.056171060d, 2.657323816d, $
   0.000166d,   7238.675591600d, 5.930629110d, $
   0.000167d,   3097.883822726d, 5.570955333d, $
   0.000159d,   -323.505416657d, 5.786670700d, $
   0.000154d,  -4136.910433516d, 1.517805532d, $
   0.000176d,  12029.347187887d, 3.139266834d, $
   0.000167d,  12132.439962106d, 3.556352289d, $
   0.000153d,    202.253395174d, 1.463313961d, $
   0.000157d,  17267.268201691d, 1.586837396d, $
   0.000142d,  83996.847317911d, 0.022670115d, $
   0.000152d,  17260.154654690d, 0.708528947d, $
   0.000144d,   6084.003848555d, 5.187075177d, $
   0.000135d,   5756.566278634d, 1.993229262d, $
   0.000134d,   5750.203491159d, 3.457197134d, $
   0.000144d,   5326.786694021d, 6.066193291d, $
   0.000160d,  11015.106477335d, 1.710431974d, $
   0.000133d,   3634.621024518d, 2.836451652d, $
   0.000134d,  18073.704938650d, 5.453106665d, $
   0.000134d,   1162.474704408d, 5.326898811d, $
   0.000128d,   5642.198242609d, 2.511652591d  ]
fbldata = [ fbldata, $
   0.000160d,    632.783739313d, 5.628785365d, $
   0.000132d,  13916.019109642d, 0.819294053d, $
   0.000122d,  14314.168113050d, 5.677408071d, $
   0.000125d,  12359.966151546d, 5.251984735d, $
   0.000121d,   5749.452731634d, 2.210924603d, $
   0.000136d,   -245.831646229d, 1.646502367d, $
   0.000120d,   5757.317038160d, 3.240883049d, $
   0.000134d,  12146.667056108d, 3.059480037d, $
   0.000137d,   6206.809778716d, 1.867105418d, $
   0.000141d,  17253.041107690d, 2.069217456d, $
   0.000129d,  -7477.522860216d, 2.781469314d, $
   0.000116d,   5540.085789459d, 4.281176991d, $
   0.000116d,   9779.108676125d, 3.320925381d, $
   0.000129d,   5237.921013804d, 3.497704076d, $
   0.000113d,   5959.570433334d, 0.983210840d, $
   0.000122d,   6282.095528923d, 2.674938860d, $
   0.000140d,    -11.045700264d, 4.957936982d, $
   0.000108d,  23543.230504682d, 1.390113589d, $
   0.000106d, -12569.674818332d, 0.429631317d, $
   0.000110d,   -266.607041722d, 5.501340197d, $
   0.000115d,  12559.038152982d, 4.691456618d, $
   0.000134d,  -2388.894020449d, 0.577313584d, $
   0.000109d,  10440.274292604d, 6.218148717d, $
   0.000102d,   -543.918059096d, 1.477842615d, $
   0.000108d,  21228.392023546d, 2.237753948d  ]
fbldata = [ fbldata, $
   0.000101d,  -4535.059436924d, 3.100492232d, $
   0.000103d,     76.266071276d, 5.594294322d, $
   0.000104d,    949.175608970d, 5.674287810d, $
   0.000101d,  13517.870106233d, 2.196632348d, $
   0.000100d,  11933.367960670d, 4.056084160d  ]

i2terms = n_elements(fbldata)/3
; T**2                          
fbldata = [ fbldata, $
   4.322990d,   6283.075849991d, 2.642893748d, $
   0.406495d,      0.000000000d, 4.712388980d, $
   0.122605d,  12566.151699983d, 2.438140634d, $
   0.019476d,    213.299095438d, 1.642186981d, $
   0.016916d,    529.690965095d, 4.510959344d, $
   0.013374d,     -3.523118349d, 1.502210314d, $
   0.008042d,     26.298319800d, 0.478549024d, $
   0.007824d,    155.420399434d, 5.254710405d, $
   0.004894d,   5746.271337896d, 4.683210850d, $
   0.004875d,   5760.498431898d, 0.759507698d, $
   0.004416d,   5223.693919802d, 6.028853166d, $
   0.004088d,     -7.113547001d, 0.060926389d, $
   0.004433d,  77713.771467920d, 3.627734103d, $
   0.003277d,  18849.227549974d, 2.327912542d, $
   0.002703d,   6062.663207553d, 1.271941729d, $
   0.003435d,   -775.522611324d, 0.747446224d, $
   0.002618d,   6076.890301554d, 3.633715689d, $
   0.003146d,    206.185548437d, 5.647874613d, $
   0.002544d,   1577.343542448d, 6.232904270d, $
   0.002218d,   -220.412642439d, 1.309509946d, $
   0.002197d,   5856.477659115d, 2.407212349d, $
   0.002897d,   5753.384884897d, 5.863842246d, $
   0.001766d,    426.598190876d, 0.754113147d, $
   0.001738d,   -796.298006816d, 2.714942671d, $
   0.001695d,    522.577418094d, 2.629369842d  ]
fbldata = [ fbldata, $
   0.001584d,   5507.553238667d, 1.341138229d, $
   0.001503d,   -242.728603974d, 0.377699736d, $
   0.001552d,   -536.804512095d, 2.904684667d, $
   0.001370d,   -398.149003408d, 1.265599125d, $
   0.001889d,  -5573.142801634d, 4.413514859d, $
   0.001722d,   6069.776754553d, 2.445966339d, $
   0.001124d,   1059.381930189d, 5.041799657d, $
   0.001258d,    553.569402842d, 3.849557278d, $
   0.000831d,    951.718406251d, 2.471094709d, $
   0.000767d,   4694.002954708d, 5.363125422d, $
   0.000756d,   1349.867409659d, 1.046195744d, $
   0.000775d,    -11.045700264d, 0.245548001d, $
   0.000597d,   2146.165416475d, 4.543268798d, $
   0.000568d,   5216.580372801d, 4.178853144d, $
   0.000711d,   1748.016413067d, 5.934271972d, $
   0.000499d,  12036.460734888d, 0.624434410d, $
   0.000671d,  -1194.447010225d, 4.136047594d, $
   0.000488d,   5849.364112115d, 2.209679987d, $
   0.000621d,   6438.496249426d, 4.518860804d, $
   0.000495d,  -6286.598968340d, 1.868201275d, $
   0.000456d,   5230.807466803d, 1.271231591d, $
   0.000451d,   5088.628839767d, 0.084060889d, $
   0.000435d,   5643.178563677d, 3.324456609d, $
   0.000387d,  10977.078804699d, 4.052488477d, $
   0.000547d, 161000.685737473d, 2.841633844d  ]
fbldata = [ fbldata, $
   0.000522d,   3154.687084896d, 2.171979966d, $
   0.000375d,   5486.777843175d, 4.983027306d, $
   0.000421d,   5863.591206116d, 4.546432249d, $
   0.000439d,   7084.896781115d, 0.522967921d, $
   0.000309d,   2544.314419883d, 3.172606705d, $
   0.000347d,   4690.479836359d, 1.479586566d, $
   0.000317d,    801.820931124d, 3.553088096d, $
   0.000262d,    419.484643875d, 0.606635550d, $
   0.000248d,   6836.645252834d, 3.014082064d, $
   0.000245d,  -1592.596013633d, 5.519526220d, $
   0.000225d,   4292.330832950d, 2.877956536d, $
   0.000214d,   7234.794256242d, 1.605227587d, $
   0.000205d,   5767.611978898d, 0.625804796d, $
   0.000180d,  10447.387839604d, 3.499954526d, $
   0.000229d,    199.072001436d, 5.632304604d, $
   0.000214d,    639.897286314d, 5.960227667d, $
   0.000175d,   -433.711737877d, 2.162417992d, $
   0.000209d,    515.463871093d, 2.322150893d, $
   0.000173d,   6040.347246017d, 2.556183691d, $
   0.000184d,   6309.374169791d, 4.732296790d, $
   0.000227d, 149854.400134205d, 5.385812217d, $
   0.000154d,   8031.092263058d, 5.120720920d, $
   0.000151d,   5739.157790895d, 4.815000443d, $
   0.000197d,   7632.943259650d, 0.222827271d, $
   0.000197d,     74.781598567d, 3.910456770d  ]
fbldata = [ fbldata, $
   0.000138d,   6055.549660552d, 1.397484253d, $
   0.000149d,  -6127.655450557d, 5.333727496d, $
   0.000137d,   3894.181829542d, 4.281749907d, $
   0.000135d,   9437.762934887d, 5.979971885d, $
   0.000139d,  -2352.866153772d, 4.715630782d, $
   0.000142d,   6812.766815086d, 0.513330157d, $
   0.000120d,  -4705.732307544d, 0.194160689d, $
   0.000131d, -71430.695617928d, 0.000379226d, $
   0.000124d,   6279.552731642d, 2.122264908d, $
   0.000108d,  -6256.777530192d, 0.883445696d  ]

i3terms = n_elements(fbldata)/3
; T**3                          
fbldata = [ fbldata, $
   0.143388d,   6283.075849991d, 1.131453581d, $
   0.006671d,  12566.151699983d, 0.775148887d, $
   0.001480d,    155.420399434d, 0.480016880d, $
   0.000934d,    213.299095438d, 6.144453084d, $
   0.000795d,    529.690965095d, 2.941595619d, $
   0.000673d,   5746.271337896d, 0.120415406d, $
   0.000672d,   5760.498431898d, 5.317009738d, $
   0.000389d,   -220.412642439d, 3.090323467d, $
   0.000373d,   6062.663207553d, 3.003551964d, $
   0.000360d,   6076.890301554d, 1.918913041d, $
   0.000316d,    -21.340641002d, 5.545798121d, $
   0.000315d,   -242.728603974d, 1.884932563d, $
   0.000278d,    206.185548437d, 1.266254859d, $
   0.000238d,   -536.804512095d, 4.532664830d, $
   0.000185d,    522.577418094d, 4.578313856d, $
   0.000245d,  18849.227549974d, 0.587467082d, $
   0.000180d,    426.598190876d, 5.151178553d, $
   0.000200d,    553.569402842d, 5.355983739d, $
   0.000141d,   5223.693919802d, 1.336556009d, $
   0.000104d,   5856.477659115d, 4.239842759d  ]

i4terms = n_elements(fbldata)/3
; T**4                          
fbldata = [ fbldata, $
   0.003826d,   6283.075849991d, 5.705257275d, $
   0.000303d,  12566.151699983d, 5.407132842d, $
   0.000209d,    155.420399434d, 1.989815753d  ]

    nterms = n_elements(fbldata)/3
    fbldata = reform(fbldata, 3, nterms, /overwrite)
    const0 = reform(fbldata(0,*), nterms)
    freq0  = reform(fbldata(1,*), nterms)
    phase0 = reform(fbldata(2,*), nterms)

    texp = dblarr(nterms) +   0
    texp(i1terms:i2terms-1) = 1
    texp(i2terms:i3terms-1) = 2
    texp(i3terms:i4terms-1) = 3
    texp(i4terms:*        ) = 4

  endif

  if n_elements(tbase) EQ 0 then tbase = 0D
  t = ((tbase(0)-2451545D) + jd(0))/365250.0D
  if t EQ 0 then t = 1d-100
  if n_elements(nt0) EQ 0 then begin
      nt = n_elements(const0)
  endif else begin
      nt = round(nt0(0))>1
  endelse

  ph = freq0(0:nt-1) * t + phase0(0:nt-1)
  sint = sin( ph )
  sinf = const0(0:nt-1) * t^texp(0:nt-1)

  dt = total(sinf*sint)*1d-6
  if arg_present(deriv) then $
    deriv = total(sinf*(texp(0:nt-1)*sint/t + freq0(0:nt-1)*cos(ph)))*(1d-6/365250.0D)

  return, dt
end

function tdb2tdt, jd, deriv=deriv, tbase=tbase0, nterms=nt

  if n_params() EQ 0 OR n_elements(jd) EQ 0 then begin
      message, 'USAGE: ', /info
      message, ' TDB = TDT + TDB2TDT(JD)', /info
      message, '     ;; All units in seconds', /info
      message, '     ;; JD is julian day number referred to TDT or TDB', /info
      message, '', /info
      message, 'Other timescales (all units in seconds; JD=Julian date):', $
        /info
      message, ' TT  = TAI + 32.184d     ;; TAI to Terrestrial Time', /info
      message, ' TDT = TAI + 32.184d     ;; TAI to Terrestrial Dynamical Time',$
        /info
      message, ' TDB = TDT + TDB2TDT(JD) ;; TDT to Barycentric Dynamical Time',$
        /info
      message, '     ;; (JD referred to TDT or TDB)', /info
      message, ' TAI = UTC + TAI_UTC(JD) ;; UTC to TAI (JD referred to UTC)', $
        /info
      message, ' UTC = TAI + TAI_UTC(JD, /INV) ;; UTC to TAI (JD referred to TAI)', /info
      return, 0
  endif

  sz = size(jd)
  n = n_elements(jd)
  ntb = n_elements(tbase0)

  ;; Expand dimensions of TBASE to match JD
  if ntb GT 0 then begin
      if ntb GT 1 AND ntb LT n then $
        message, 'ERROR: JD and TBASE dimensions must match'
      tbase = jd*0 + tbase0
  endif else begin
      tbase = jd*0
  endelse

  if n EQ 1 then $
    return, tdb2tdt_calc(jd, deriv=deriv, tbase=tbase)

  result = reform(double(jd), sz(1:sz(0)))
  if arg_present(deriv) then begin
      deriv = reform(double(jd), sz(1:sz(0)))
      for i = 0L, n-1 do begin
          result(i) = tdb2tdt_calc(jd(i), deriv=dd, tbase=tbase(i), nterms=nt)
          deriv(i) = dd
      endfor
  endif else begin
      for i = 0L, n-1 do begin
          result(i) = tdb2tdt_calc(jd(i), tbase=tbase(i), nterms=nt)
      endfor
  endelse

  return, result
end

;+
; NAME:
;   TNMIN
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE:
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Performs function minimization (Truncated-Newton Method)
;
; MAJOR TOPICS:
;   Optimization and Minimization
;
; CALLING SEQUENCE:
;   parms = TNMIN(MYFUNCT, X, FUNCTARGS=fcnargs, NFEV=nfev,
;                 MAXITER=maxiter, ERRMSG=errmsg, NPRINT=nprint,
;                 QUIET=quiet, XTOL=xtol, STATUS=status,
;                 FGUESS=fguess, PARINFO=parinfo, BESTMIN=bestmin,
;                 ITERPROC=iterproc, ITERARGS=iterargs, niter=niter)
;
; DESCRIPTION:
;
;  TNMIN uses the Truncated-Newton method to minimize an arbitrary IDL
;  function with respect to a given set of free parameters.  The
;  user-supplied function must compute the gradient with respect to
;  each parameter.  TNMIN is based on TN.F (TNBC) by Stephen Nash.
;
;  If you want to solve a least-squares problem, to perform *curve*
;  *fitting*, then you will probably want to use the routines MPFIT,
;  MPFITFUN and MPFITEXPR.  Those routines are specifically optimized
;  for the least-squares problem.  TNMIN is suitable for constrained
;  and unconstrained optimization problems with a medium number of
;  variables.  Function *maximization* can be performed using the
;  MAXIMIZE keyword.
;
;  TNMIN is similar to MPFIT in that it allows parameters to be fixed,
;  simple bounding limits to be placed on parameter values, and
;  parameters to be tied to other parameters.  One major difference
;  between MPFIT and TNMIN is that TNMIN does not compute derivatives
;  automatically by default.  See PARINFO and AUTODERIVATIVE below for
;  more discussion and examples.
;
; USER FUNCTION
;
;  The user must define an IDL function which returns the desired
;  value as a single scalar.  The IDL function must accept a list of
;  numerical parameters, P.  Additionally, keyword parameters may be
;  used to pass more data or information to the user function, via the
;  FUNCTARGS keyword.
;
;  The user function should be declared in the following way:
;
;     FUNCTION MYFUNCT, p, dp [, keywords permitted ]
;       ; Parameter values are passed in "p"
;       f  = ....   ; Compute function value
;       dp = ....   ; Compute partial derivatives (optional)
;       return, f
;     END
;
;  The function *must* accept at least one argument, the parameter
;  list P.  The vector P is implicitly assumed to be a one-dimensional
;  array.  Users may pass additional information to the function by
;  composing and _EXTRA structure and passing it in the FUNCTARGS
;  keyword.
;
;  User functions may also indicate a fatal error condition using the
;  ERROR_CODE common block variable, as described below under the
;  TNMIN_ERROR common block definition (by setting ERROR_CODE to a
;  number between -15 and -1).
;
;  EXPLICIT vs. NUMERICAL DERIVATIVES
;
;  By default, the user must compute the function gradient components
;  explicitly using AUTODERIVATIVE=0.  As explained below, numerical
;  derivatives can also be calculated using AUTODERIVATIVE=1.
;
;  For explicit derivatives, the user should call TNMIN using the
;  default keyword value AUTODERIVATIVE=0.  [ This is different
;  behavior from MPFIT, where AUTODERIVATIVE=1 is the default. ] The
;  IDL user routine should compute the gradient of the function as a
;  one-dimensional array of values, one for each of the parameters.
;  They are passed back to TNMIN via "dp" as shown above.
;
;  The derivatives with respect to fixed parameters are ignored; zero
;  is an appropriate value to insert for those derivatives.  Upon
;  input to the user function, DP is set to a vector with the same
;  length as P, with a value of 1 for a parameter which is free, and a
;  value of zero for a parameter which is fixed (and hence no
;  derivative needs to be calculated).  This input vector may be
;  overwritten as needed.
;
;  For numerical derivatives, a finite differencing approximation is
;  used to estimate the gradient values.  Users can activate this
;  feature by passing the keyword AUTODERIVATIVE=1.  Fine control over
;  this behavior can be achieved using the STEP, RELSTEP and TNSIDE
;  fields of the PARINFO structure.
;
;  When finite differencing is used for computing derivatives (ie,
;  when AUTODERIVATIVE=1), the parameter DP is not passed.  Therefore
;  functions can use N_PARAMS() to indicate whether they must compute
;  the derivatives or not.  However there is no penalty (other than
;  computation time) for computing the gradient values and users may
;  switch between AUTODERIVATIVE=0 or =1 in order to test both
;  scenarios.
;
; CONSTRAINING PARAMETER VALUES WITH THE PARINFO KEYWORD
;
;  The behavior of TNMIN can be modified with respect to each
;  parameter to be optimized.  A parameter value can be fixed; simple
;  boundary constraints can be imposed; limitations on the parameter
;  changes can be imposed; properties of the automatic derivative can
;  be modified; and parameters can be tied to one another.
;
;  These properties are governed by the PARINFO structure, which is
;  passed as a keyword parameter to TNMIN.
;
;  PARINFO should be an array of structures, one for each parameter.
;  Each parameter is associated with one element of the array, in
;  numerical order.  The structure can have the following entries
;  (none are required):
;
;     .VALUE - the starting parameter value (but see the START_PARAMS
;              parameter for more information).
;
;     .FIXED - a boolean value, whether the parameter is to be held
;              fixed or not.  Fixed parameters are not varied by
;              TNMIN, but are passed on to MYFUNCT for evaluation.
;
;     .LIMITED - a two-element boolean array.  If the first/second
;                element is set, then the parameter is bounded on the
;                lower/upper side.  A parameter can be bounded on both
;                sides.  Both LIMITED and LIMITS must be given
;                together.
;
;     .LIMITS - a two-element float or double array.  Gives the
;               parameter limits on the lower and upper sides,
;               respectively.  Zero, one or two of these values can be
;               set, depending on the values of LIMITED.  Both LIMITED
;               and LIMITS must be given together.
;
;     .PARNAME - a string, giving the name of the parameter.  The
;                fitting code of TNMIN does not use this tag in any
;                way.
;
;     .STEP - the step size to be used in calculating the numerical
;             derivatives.  If set to zero, then the step size is
;             computed automatically.  Ignored when AUTODERIVATIVE=0.
;
;     .TNSIDE - the sidedness of the finite difference when computing
;               numerical derivatives.  This field can take four
;               values:
;
;                  0 - one-sided derivative computed automatically
;                  1 - one-sided derivative (f(x+h) - f(x)  )/h
;                 -1 - one-sided derivative (f(x)   - f(x-h))/h
;                  2 - two-sided derivative (f(x+h) - f(x-h))/(2*h)
;
;              Where H is the STEP parameter described above.  The
;              "automatic" one-sided derivative method will chose a
;              direction for the finite difference which does not
;              violate any constraints.  The other methods do not
;              perform this check.  The two-sided method is in
;              principle more precise, but requires twice as many
;              function evaluations.  Default: 0.
;
;     .TIED - a string expression which "ties" the parameter to other
;             free or fixed parameters.  Any expression involving
;             constants and the parameter array P are permitted.
;             Example: if parameter 2 is always to be twice parameter
;             1 then use the following: parinfo(2).tied = '2 * P(1)'.
;             Since they are totally constrained, tied parameters are
;             considered to be fixed; no errors are computed for them.
;             [ NOTE: the PARNAME can't be used in expressions. ]
;
;  Future modifications to the PARINFO structure, if any, will involve
;  adding structure tags beginning with the two letters "MP" or "TN".
;  Therefore programmers are urged to avoid using tags starting with
;  these two combinations of letters; otherwise they are free to
;  include their own fields within the PARINFO structure, and they
;  will be ignored.
;
;  PARINFO Example:
;  parinfo = replicate({value:0.D, fixed:0, limited:[0,0], $
;                       limits:[0.D,0]}, 5)
;  parinfo(0).fixed = 1
;  parinfo(4).limited(0) = 1
;  parinfo(4).limits(0)  = 50.D
;  parinfo(*).value = [5.7D, 2.2, 500., 1.5, 2000.]
;
;  A total of 5 parameters, with starting values of 5.7,
;  2.2, 500, 1.5, and 2000 are given.  The first parameter
;  is fixed at a value of 5.7, and the last parameter is
;  constrained to be above 50.
;
;
; INPUTS:
;
;   MYFUNCT - a string variable containing the name of the function to
;             be minimized (see USER FUNCTION above).  The IDL routine
;             should return the value of the function and optionally
;             its gradients.
;
;   X - An array of starting values for each of the parameters of the
;       model.
;
;       This parameter is optional if the PARINFO keyword is used.
;       See above.  The PARINFO keyword provides a mechanism to fix or
;       constrain individual parameters.  If both X and PARINFO are
;       passed, then the starting *value* is taken from X, but the
;       *constraints* are taken from PARINFO.
;
;
; RETURNS:
;
;   Returns the array of best-fit parameters.
;
;
; KEYWORD PARAMETERS:
;
;   AUTODERIVATIVE - If this is set, derivatives of the function will
;                    be computed automatically via a finite
;                    differencing procedure.  If not set, then MYFUNCT
;                    must provide the (explicit) derivatives.
;                    Default: 0 (explicit derivatives required)
;
;   BESTMIN - upon return, the best minimum function value that TNMIN
;             could find.
;
;   EPSABS - a nonnegative real variable.  Termination occurs when the
;            absolute error between consecutive iterates is at most
;            EPSABS.  Note that using EPSREL is normally preferable
;            over EPSABS, except in cases where ABS(F) is much larger
;            than 1 at the optimal point.  A value of zero indicates
;            the absolute error test is not applied.  If EPSABS is
;            specified, then both EPSREL and EPSABS tests are applied;
;            if either succeeds then termination occurs.
;            Default: 0 (i.e., only EPSREL is applied).
;
;   EPSREL - a nonnegative input variable. Termination occurs when the
;            relative error between two consecutive iterates is at
;            most EPSREL.  Therefore, EPSREL measures the relative
;            error desired in the function.  An additional, more
;            lenient, stopping condition can be applied by specifying
;            the EPSABS keyword.
;            Default: 100 * Machine Precision
;
;   ERRMSG - a string error or warning message is returned.
;
;   FGUESS - provides the routine a guess to the minimum value.
;            Default: 0
;
;   FUNCTARGS - A structure which contains the parameters to be passed
;               to the user-supplied function specified by MYFUNCT via
;               the _EXTRA mechanism.  This is the way you can pass
;               additional data to your user-supplied function without
;               using common blocks.
;
;               Consider the following example:
;                if FUNCTARGS = { XVAL:[1.D,2,3], YVAL:[1.D,4,9]}
;                then the user supplied function should be declared
;                like this:
;                FUNCTION MYFUNCT, P, XVAL=x, YVAL=y
;
;               By default, no extra parameters are passed to the
;               user-supplied function.
;
;   ITERARGS - The keyword arguments to be passed to ITERPROC via the
;              _EXTRA mechanism.  This should be a structure, and is
;              similar in operation to FUNCTARGS.
;              Default: no arguments are passed.
;
;   ITERDERIV - Intended to print function gradient information.  If
;               set, then the ITERDERIV keyword is set in each call to
;               ITERPROC.  In the default ITERPROC, parameter values
;               and gradient information are both printed when this
;               keyword is set.
;
;   ITERPROC - The name of a procedure to be called upon each NPRINT
;              iteration of the TNMIN routine.  It should be declared
;              in the following way:
;
;              PRO ITERPROC, MYFUNCT, p, iter, fnorm, FUNCTARGS=fcnargs, $
;                PARINFO=parinfo, QUIET=quiet, _EXTRA=extra
;                ; perform custom iteration update
;              END
;
;              ITERPROC must accept the _EXTRA keyword, in case of
;              future changes to the calling procedure.
;
;              MYFUNCT is the user-supplied function to be minimized,
;              P is the current set of model parameters, ITER is the
;              iteration number, and FUNCTARGS are the arguments to be
;              passed to MYFUNCT.  FNORM is should be the function
;              value.  QUIET is set when no textual output should be
;              printed.  See below for documentation of PARINFO.
;
;              In implementation, ITERPROC can perform updates to the
;              terminal or graphical user interface, to provide
;              feedback while the fit proceeds.  If the fit is to be
;              stopped for any reason, then ITERPROC should set the
;              common block variable ERROR_CODE to negative value
;              between -15 and -1 (see TNMIN_ERROR common block
;              below).  In principle, ITERPROC should probably not
;              modify the parameter values, because it may interfere
;              with the algorithm's stability.  In practice it is
;              allowed.
;
;              Default: an internal routine is used to print the
;                       parameter values.
;
;   MAXITER - The maximum number of iterations to perform.  If the
;             number is exceeded, then the STATUS value is set to 5
;             and TNMIN returns.
;             Default: 200 iterations
;
;   MAXIMIZE - If set, the function is maximized instead of
;              minimized.
;
;   MAXNFEV - The maximum number of function evaluations to perform.
;             If the number is exceeded, then the STATUS value is set
;             to -17 and TNMIN returns.  A value of zero indicates no
;             maximum.
;             Default: 0 (no maximum)
;
;   NFEV - upon return, the number of MYFUNCT function evaluations
;          performed.
;
;   NITER - upon return, number of iterations completed.
;
;   NPRINT - The frequency with which ITERPROC is called.  A value of
;            1 indicates that ITERPROC is called with every iteration,
;            while 2 indicates every other iteration, etc.
;            Default value: 1
;
;   PARINFO - Provides a mechanism for more sophisticated constraints
;             to be placed on parameter values.  When PARINFO is not
;             passed, then it is assumed that all parameters are free
;             and unconstrained.  Values in PARINFO are never modified
;             during a call to TNMIN.
;
;             See description above for the structure of PARINFO.
;
;             Default value:  all parameters are free and unconstrained.
;
;   QUIET - set this keyword when no textual output should be printed
;           by TNMIN
;
;   STATUS - an integer status code is returned.  All values greater
;            than zero can represent success (however STATUS EQ 5 may
;            indicate failure to converge).  Gaps in the numbering
;            system below are to maintain compatibility with MPFIT.
;            Upon return, STATUS can have one of the following values:
;
;        -18  a fatal internal error occurred during optimization.
;
;        -17  the maximum number of function evaluations has been
;             reached without convergence.
;
;        -16  a parameter or function value has become infinite or an
;             undefined number.  This is usually a consequence of
;             numerical overflow in the user's function, which must be
;             avoided.
;
;        -15 to -1
;             these are error codes that either MYFUNCT or ITERPROC
;             may return to terminate the fitting process (see
;             description of TNMIN_ERROR common below).  If either
;             MYFUNCT or ITERPROC set ERROR_CODE to a negative number,
;             then that number is returned in STATUS.  Values from -15
;             to -1 are reserved for the user functions and will not
;             clash with TNMIN.
;
;	   0  improper input parameters.
;
;	   1  convergence was reached.
;
;          2-4 (RESERVED)
;
;	   5  the maximum number of iterations has been reached
;
;          6-8 (RESERVED)
;
;
; EXAMPLE:
;
;   FUNCTION F, X, DF, _EXTRA=extra  ;; *** MUST ACCEPT KEYWORDS
;     F  = (X(0)-1)^2 + (X(1)+7)^2
;     DF = [ 2D * (X(0)-1), 2D * (X(1)+7) ] ; Gradient
;     RETURN, F
;   END
;
;   P = TNMIN('F', [0D, 0D], BESTMIN=F0)
;   Minimizes the function F(x0,x1) = (x0-1)^2 + (x1+7)^2.
;
;
; COMMON BLOCKS:
;
;   COMMON TNMIN_ERROR, ERROR_CODE
;
;     User routines may stop the fitting process at any time by
;     setting an error condition.  This condition may be set in either
;     the user's model computation routine (MYFUNCT), or in the
;     iteration procedure (ITERPROC).
;
;     To stop the fitting, the above common block must be declared,
;     and ERROR_CODE must be set to a negative number.  After the user
;     procedure or function returns, TNMIN checks the value of this
;     common block variable and exits immediately if the error
;     condition has been set.  By default the value of ERROR_CODE is
;     zero, indicating a successful function/procedure call.
;
;
; REFERENCES:
;
;   TRUNCATED-NEWTON METHOD, TN.F
;      Stephen G. Nash, Operations Research and Applied Statistics
;      Department
;      http://www.netlib.org/opt/tn
;
;   Nash, S. G. 1984, "Newton-Type Minimization via the Lanczos
;      Method," SIAM J. Numerical Analysis, 21, p. 770-778
;
;
; MODIFICATION HISTORY:
;   Derived from TN.F by Stephen Nash with many changes and additions,
;      to conform to MPFIT paradigm, 19 Jan 1999, CM
;   Changed web address to COW, 25 Sep 1999, CM
;   Alphabetized documented keyword parameters, 02 Oct 1999, CM
;   Changed to ERROR_CODE for error condition, 28 Jan 2000, CM
;   Continued and fairly major improvements (CM, 08 Jan 2001):
;      - calling of user procedure is now concentrated in TNMIN_CALL,
;        and arguments are reduced by storing a large number of them
;        in common blocks;
;      - finite differencing is done within TNMIN_CALL; added
;        AUTODERIVATIVE=1 so that finite differencing can be enabled,
;        both one and two sided;
;      - a new procedure to parse PARINFO fields, borrowed from MPFIT;
;        brought PARINFO keywords up to date with MPFIT;
;      - go through and check for float vs. double discrepancies;
;      - add explicit MAXIMIZE keyword, and support in TNMIN_CALL and
;        TNMIN_DEFITER to print the correct values in that case;
;        TNMIN_DEFITER now prints function gradient values if
;        requested;
;      - convert to common-based system of MPFIT for storing machine
;        constants; revert TNMIN_ENORM to simple sum of squares, at
;        least for now;
;      - remove limit on number of function evaluations, at least for
;        now, and until I can understand what happens when we do
;        numerical derivatives.
;   Further changes: more float vs double; disable TNMINSTEP for now;
;     experimented with convergence test in case of function
;     maximization, 11 Jan 2001, CM
;   TNMINSTEP is parsed but not enabled, 13 Mar 2001
;   Major code cleanups; internal docs; reduced commons, CM, 08 Apr
;     2001
;   Continued code cleanups; documentation; the STATUS keyword
;     actually means something, CM, 10 Apr 2001
;   Added reference to Nash paper, CM, 08 Feb 2002
;   Fixed 16-bit loop indices, D. Schelgel, 22 Apr 2003
;   Changed parens to square brackets because of conflicts with
;     limits function.  K. Tolbert, 23 Feb 2005
;   Some documentation clarifications, CM, 09 Nov 2007
;   Ensure that MY_FUNCT returns a scalar; make it more likely that
;     error messages get back out to the user; fatal CATCH'd error 
;     now returns STATUS = -18, CM, 17 Sep 2008
;   Fix TNMIN_CALL when parameters are TIEd (thanks to Alfred de
;     Wijn), CM, 22 Nov 2009
;   Remember to TIE the parameters before final return (thanks to
;     Michael Smith), CM, 20 Jan 2010
;
; TODO
;  - scale derivatives semi-automatically;
;  - ability to scale and offset parameters;
;
;  $Id: tnmin.pro,v 1.20 2016/05/19 16:08:08 cmarkwar Exp $
;-
; Copyright (C) 1998-2001,2002,2003,2007,2008,2009 Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-
;%% TRUNCATED-NEWTON METHOD:  SUBROUTINES
;   FOR OTHER MACHINES, MODIFY ROUTINE MCHPR1 (MACHINE EPSILON)
;   WRITTEN BY:  STEPHEN G. NASH
;                OPERATIONS RESEARCH AND APPLIED STATISTICS DEPT.
;                GEORGE MASON UNIVERSITY
;                FAIRFAX, VA 22030
;******************************************************************

;; Routine which declares functions and common blocks
pro tnmin_dummy
  forward_function tnmin_enorm, tnmin_step1, tnmin
  forward_function tnmin_call, tnmin_autoder
  common tnmin_error, error_code
  common tnmin_machar, tnmin_machar_vals
  common tnmin_config, tnmin_tnconfig
  common tnmin_fcnargs, tnmin_tnfcnargs
  common tnmin_work, lsk, lyk, ldiagb, lsr, lyr
  a = 1
  return
end

;; Following are machine constants that can be loaded once.  I have
;; found that bizarre underflow messages can be produced in each call
;; to MACHAR(), so this structure minimizes the number of calls to
;; one.
pro tnmin_setmachar, double=isdouble

  common tnmin_machar, tnmin_machar_vals

  ;; In earlier versions of IDL, MACHAR itself could produce a load of
  ;; error messages.  We try to mask some of that out here.
  if (!version.release) LT 5 then dummy = check_math(1, 1)

  mch = 0.
  mch = machar(double=keyword_set(isdouble))
  dmachep = mch.eps
  dmaxnum = mch.xmax
  dminnum = mch.xmin
  dmaxlog = alog(mch.xmax)
  dminlog = alog(mch.xmin)
  if keyword_set(isdouble) then $
    dmaxgam = 171.624376956302725D $
  else $
    dmaxgam = 171.624376956302725
  drdwarf = sqrt(dminnum*1.5) * 10
  drgiant = sqrt(dmaxnum) * 0.1

  tnmin_machar_vals = {machep: dmachep, maxnum: dmaxnum, minnum: dminnum, $
                       maxlog: dmaxlog, minlog: dminlog, maxgam: dmaxgam, $
                       rdwarf: drdwarf, rgiant: drgiant}

  if (!version.release) LT 5 then dummy = check_math(0, 0)

  return
end

;; Procedure to parse the parameter values in PARINFO
pro tnmin_parinfo, parinfo, tnames, tag, values, default=def, status=status, $
                   n_param=n

  status = 0
  if n_elements(n) EQ 0 then n = n_elements(parinfo)

  if n EQ 0 then begin
      if n_elements(def) EQ 0 then return
      values = def
      status = 1
      return
  endif

  if n_elements(parinfo) EQ 0 then goto, DO_DEFAULT
  if n_elements(tnames) EQ 0 then tnames = tag_names(parinfo)
  wh = where(tnames EQ tag, ct)

  if ct EQ 0 then begin
      DO_DEFAULT:
      if n_elements(def) EQ 0 then return
      values = make_array(n, value=def(0))
      values(0) = def
  endif else begin
      values = parinfo.(wh(0))
  endelse

  status = 1
  return
end

;; Procedure to tie one parameter to another.
pro tnmin_tie, p, _ptied
  _wh = where(_ptied NE '', _ct)
 if _ct EQ 0 then return
  for _i = 0L, _ct-1 do begin
      _cmd = 'p('+strtrim(_wh(_i),2)+') = '+_ptied(_wh(_i))
      _err = execute(_cmd)
      if _err EQ 0 then begin
          message, 'ERROR: Tied expression "'+_cmd+'" failed.'
          return
      endif
  endfor
end

function tnmin_autoder, fcn, x, dx, dside=dside

  common tnmin_machar, machvals
  common tnmin_config, tnconfig

  MACHEP0 = machvals.machep
  DWARF   = machvals.minnum
  if n_elements(dside) NE n_elements(x) then dside = tnconfig.dside

  eps = sqrt(MACHEP0)
  h = eps * (1. + abs(x))

  ;; if STEP is given, use that
  wh = where(tnconfig.step GT 0, ct)
  if ct GT 0 then h(wh) = tnconfig.step(wh)

  ;; if relative step is given, use that
  wh = where(tnconfig.dstep GT 0, ct)
  if ct GT 0 then h(wh) = abs(tnconfig.dstep(wh)*x(wh))

  ;; In case any of the step values are zero
  wh = where(h EQ 0, ct)
  if ct GT 0 then h(wh) = eps

  ;; Reverse the sign of the step if we are up against the parameter
  ;; limit, or if the user requested it.
  mask = (dside EQ -1 OR (tnconfig.ulimited AND (x GT tnconfig.ulimit-h)))
  wh = where(mask, ct)
  if ct GT 0 then h(wh) = -h(wh)

  dx = x * 0.
  f = tnmin_call(fcn, x)
  for i = 0L, n_elements(x)-1 do begin
      if tnconfig.pfixed(i) EQ 1 then goto, NEXT_PAR
      hh = h(i)

      RESTART_PAR:
      xp = x
      xp(i) = xp(i) + hh

      fp = tnmin_call(fcn, xp)

      if abs(dside(i)) LE 1 then begin
          ;; COMPUTE THE ONE-SIDED DERIVATIVE
          dx(i) = (fp-f)/hh
      endif else begin
          ;; COMPUTE THE TWO-SIDED DERIVATIVE
          xp(i) = x(i) - hh

          fm = tnmin_call(fcn, xp)
          dx(i) = (fp-fm)/(2*hh)
      endelse
      NEXT_PAR:
  endfor

  return, f
end

;; Call user function or procedure, with _EXTRA or not, with
;; derivatives or not.
function tnmin_call, fcn, x1, dx, fullparam_=xall

;  on_error, 2
  common tnmin_config, tnconfig
  common tnmin_fcnargs, fcnargs

  ifree = tnconfig.ifree
  ;; Following promotes the byte array to a floating point array so
  ;; that users who simply re-fill the array aren't surprised when
  ;; their gradient comes out as bytes. :-)
  dx = tnconfig.pfixed + x1(0)*0.

  if n_elements(xall) GT 0 then begin
      x = xall
      x(ifree) = x1
  endif else begin
      x = x1
  endelse

  ;; Enforce TIEd parameters
  if keyword_set(tnconfig.qanytied) then tnmin_tie, x, tnconfig.ptied

  ;; Decide whether we are calling a procedure or function
  if tnconfig.proc then proc = 1 else proc = 0
  tnconfig.nfev = tnconfig.nfev + 1

  if n_params() EQ 3 then begin
      if tnconfig.autoderiv then $
        f = tnmin_autoder(fcn, x, dx) $
      else if n_elements(fcnargs) GT 0 then $
        f = call_function(fcn, x, dx, _EXTRA=fcnargs) $
      else $
        f = call_function(fcn, x, dx)

      dx = dx(ifree)
      if tnconfig.max then begin
          dx = -dx
          f = -f
      endif
  endif else begin
      if n_elements(fcnargs) GT 0 then $
        f = call_function(fcn, x, _EXTRA=fcnargs) $
      else $
        f = call_function(fcn, x)

      if n_elements(f) NE 1 then begin
          message, 'ERROR: function "'+fcn+'" returned a vector when '+$
            'a scalar was expected.'
      endif
  endelse

  if n_elements(f) GT 1 then return, f $
  else                       return, f(0)
end

function tnmin_enorm, vec

  common tnmin_config, tnconfig
  ;; Very simple-minded sum-of-squares
  if n_elements(tnconfig) GT 0 then if tnconfig.fastnorm then begin
      ans = sqrt(total(vec^2,1))
      goto, TERMINATE
  endif

  common tnmin_machar, machvals

  agiant = machvals.rgiant / n_elements(vec)
  adwarf = machvals.rdwarf * n_elements(vec)

  ;; This is hopefully a compromise between speed and robustness.
  ;; Need to do this because of the possibility of over- or underflow.
  mx = max(vec, min=mn)
  mx = max(abs([mx,mn]))
  if mx EQ 0 then return, vec(0)* 0.

  if mx GT agiant OR mx LT adwarf then ans = mx * sqrt(total((vec/mx)^2)) $
  else                                 ans = sqrt( total(vec^2) )

  TERMINATE:
  return, ans
end

;
; ROUTINES TO INITIALIZE PRECONDITIONER
;
pro tnmin_initpc, diagb, emat, n, upd1, yksk, gsk, yrsr, lreset
  ;; Rename common variables as they appear in INITP3.  Those
  ;; indicated in all caps are not used or renamed here.
; common tnmin_work, lsk, lyk, ldiagb, lsr, lyr
  common tnmin_work,  sk,  yk, LDIAGB,  sr,  yr
;                    I    I            I    I

  ;; From INITP3
  if keyword_set(upd1) then begin
      EMAT = DIAGB
  endif else if keyword_set(lreset) then begin
      BSK  = DIAGB*SK
      SDS  = TOTAL(SK*BSK)
      EMAT = DIAGB - DIAGB*DIAGB*SK*SK/SDS + YK*YK/YKSK
  endif else begin
      BSK  = DIAGB * SR
      SDS  = TOTAL(SR*BSK)
      SRDS = TOTAL(SK*BSK)
      YRSK = TOTAL(YR*SK)
      BSK  = DIAGB*SK - BSK*SRDS/SDS+YR*YRSK/YRSR
      EMAT = DIAGB-DIAGB*DIAGB*SR*SR/SDS+YR*YR/YRSR
      SDS  = TOTAL(SK*BSK)
      EMAT = EMAT - BSK*BSK/SDS+YK*YK/YKSK
  endelse

  return
end

pro tnmin_ssbfgs, n, gamma, sj, yj, hjv, hjyj, yjsj, yjhyj, $
         vsj, vhyj, hjp1v
;
; SELF-SCALED BFGS
;
  DELTA = (1. + GAMMA*YJHYJ/YJSJ)*VSJ/YJSJ - GAMMA*VHYJ/YJSJ
  BETA = -GAMMA*VSJ/YJSJ
  HJP1V = GAMMA*HJV + DELTA*SJ + BETA*HJYJ
  RETURN
end


;
; THIS ROUTINE ACTS AS A PRECONDITIONING STEP FOR THE
; LINEAR CONJUGATE-GRADIENT ROUTINE.  IT IS ALSO THE
; METHOD OF COMPUTING THE SEARCH DIRECTION FROM THE
; GRADIENT FOR THE NON-LINEAR CONJUGATE-GRADIENT CODE.
; IT REPRESENTS A TWO-STEP SELF-SCALED BFGS FORMULA.
;
pro tnmin_msolve, g, y, n, upd1, yksk, gsk, yrsr, lreset, first, $
                  hyr, hyk, ykhyk, yrhyr
  ;; Rename common variables as they appear in MSLV
; common tnmin_work, lsk, lyk, ldiagb, lsr, lyr
  common tnmin_work,  sk,  yk,  diagb,  sr,  yr
;                    I    I      I     I    I

  ;; From MSLV
  if keyword_set(UPD1) then begin
      Y = G / DIAGB
      RETURN
  endif

  ONE = G(0)*0 + 1.
  GSK = TOTAL(G*SK)

  if keyword_set(lreset) then begin
;
; COMPUTE GH AND HY WHERE H IS THE INVERSE OF THE DIAGONALS
;
      HG = G/DIAGB
      if keyword_set(FIRST) then begin
          HYK = YK/DIAGB
          YKHYK = TOTAL(YK*HYK)
      endif
      GHYK = TOTAL(G*HYK)
      TNMIN_SSBFGS,N,ONE,SK,YK,HG,HYK,YKSK, YKHYK,GSK,GHYK,Y
      RETURN
  endif

;
; COMPUTE HG AND HY WHERE H IS THE INVERSE OF THE DIAGONALS
;
  HG = G/DIAGB
  if keyword_set(FIRST) then begin
      HYK = YK/DIAGB
      HYR = YR/DIAGB
      YKSR = TOTAL(YK*SR)
      YKHYR = TOTAL(YK*HYR)
  endif
  GSR = TOTAL(G*SR)
  GHYR = TOTAL(G*HYR)
  if keyword_set(FIRST) then begin
      YRHYR = TOTAL(YR*HYR)
  endif

  TNMIN_SSBFGS,N,ONE,SR,YR,HG,HYR,YRSR, YRHYR,GSR,GHYR,HG
  if keyword_set(FIRST) then begin
      TNMIN_SSBFGS,N,ONE,SR,YR,HYK,HYR,YRSR, YRHYR,YKSR,YKHYR,HYK
  endif
  YKHYK = TOTAL(HYK*YK)
  GHYK  = TOTAL(HYK*G)
  TNMIN_SSBFGS,N,ONE,SK,YK,HG,HYK,YKSK, YKHYK,GSK,GHYK,Y

  RETURN
end

;
; THIS ROUTINE COMPUTES THE PRODUCT OF THE MATRIX G TIMES THE VECTOR
; V AND STORES THE RESULT IN THE VECTOR GV (FINITE-DIFFERENCE VERSION)
;
pro tnmin_gtims, v, gv, n, x, g, fcn, first, delta, accrcy, xnorm, $
        xnew

  IF keyword_set(FIRST) THEN BEGIN
      ;; Extra factor of ten is to avoid clashing with the finite
      ;; difference scheme which computes the derivatives
      DELTA = SQRT(100*ACCRCY)*(1.+XNORM)  ;; XXX diff than TN.F
;      DELTA = SQRT(ACCRCY)*(1.+XNORM)
      FIRST = 0
  ENDIF
  DINV = 1.  /DELTA

  F = tnmin_call(FCN, X + DELTA*V, GV, fullparam_=xnew)
  GV = (GV-G)*DINV
  return
end

;
; UPDATE THE PRECONDITIOING MATRIX BASED ON A DIAGONAL VERSION
; OF THE BFGS QUASI-NEWTON UPDATE.
;
pro tnmin_ndia3, n, e, v, gv, r, vgv
  VR = TOTAL(V*R)
  E = E - R*R/VR + GV*GV/VGV
  wh = where(e LE 1D-6, ct)
  if ct GT 0 then e(wh) = 1
  return
end

pro tnmin_fix, whlpeg, whupeg, z
  if whlpeg(0) NE -1 then z(whlpeg) = 0
  if whupeg(0) NE -1 then z(whupeg) = 0
end

;
; THIS ROUTINE PERFORMS A PRECONDITIONED CONJUGATE-GRADIENT
; ITERATION IN ORDER TO SOLVE THE NEWTON EQUATIONS FOR A SEARCH
; DIRECTION FOR A TRUNCATED-NEWTON ALGORITHM.  WHEN THE VALUE OF THE
; QUADRATIC MODEL IS SUFFICIENTLY REDUCED,
; THE ITERATION IS TERMINATED.
;
; PARAMETERS
;
; ZSOL        - COMPUTED SEARCH DIRECTION
; G           - CURRENT GRADIENT
; GV,GZ1,V    - SCRATCH VECTORS
; R           - RESIDUAL
; DIAGB,EMAT  - DIAGONAL PRECONDITONING MATRIX
; NITER       - NONLINEAR ITERATION #
; FEVAL       - VALUE OF QUADRATIC FUNCTION
pro tnmin_modlnp, zsol, gv, r, v, diagb, emat, $
         x, g, zk, n, niter, maxit, nmodif, nlincg, $
         upd1, yksk, gsk, yrsr, lreset, fcn, whlpeg, whupeg, $
         accrcy, gtp, gnorm, xnorm, xnew

;
; GENERAL INITIALIZATION
;
  zero = x(0)* 0.
  one = zero + 1
  IF (MAXIT EQ 0) THEN RETURN
  FIRST = 1
  RHSNRM = GNORM
  TOL = zero + 1.E-12
  QOLD = zero

;
; INITIALIZATION FOR PRECONDITIONED CONJUGATE-GRADIENT ALGORITHM
;
  tnmin_initpc, diagb, emat, n, upd1, yksk, gsk, yrsr, lreset

  R = -G
  V = G*0.
  ZSOL = V

;
; ************************************************************
; MAIN ITERATION
; ************************************************************
;
  FOR K = 1L, MAXIT DO BEGIN
      NLINCG = NLINCG + 1

;
; CG ITERATION TO SOLVE SYSTEM OF EQUATIONS
;
      tnmin_fix, whlpeg, whupeg, r
      TNMIN_MSOLVE, R, ZK, N, UPD1, YKSK, GSK, YRSR, LRESET, FIRST, $
        HYR, HYK, YKHYK, YRHYR
      tnmin_fix, whlpeg, whupeg, zk
      RZ = TOTAL(R*ZK)
      IF (RZ/RHSNRM LT TOL) THEN GOTO, MODLNP_80
      IF (K EQ 1) THEN BETA = ZERO $
      ELSE             BETA = RZ/RZOLD
      V = ZK + BETA*V
      tnmin_fix, whlpeg, whupeg, v
      TNMIN_GTIMS, V, GV, N, X, G, FCN, FIRST, DELTA, ACCRCY, XNORM, XNEW
      tnmin_fix, whlpeg, whupeg, gv
      VGV = TOTAL(V*GV)
      IF (VGV/RHSNRM LT TOL) THEN GOTO, MODLNP_50
      TNMIN_NDIA3, N,EMAT,V,GV,R,VGV
;
; COMPUTE LINEAR STEP LENGTH
;
      ALPHA = RZ / VGV
;
; COMPUTE CURRENT SOLUTION AND RELATED VECTORS
;
      ZSOL = ZSOL + ALPHA*V
      R = R - ALPHA*GV
;
; TEST FOR CONVERGENCE
;
      GTP = TOTAL(ZSOL*G)
      PR = TOTAL(R*ZSOL)
      QNEW = 5.E-1 * (GTP + PR)
      QTEST = K * (1.E0 - QOLD/QNEW)
      IF (QTEST LT 0.D0) THEN GOTO, MODLNP_70
      QOLD = QNEW
      IF (QTEST LE 5.D-1) THEN GOTO, MODLNP_70
;
; PERFORM CAUTIONARY TEST
;
      IF (GTP GT 0) THEN GOTO, MODLNP_40
      RZOLD = RZ
  ENDFOR

;
; TERMINATE ALGORITHM
;
  K = K-1
  goto, MODLNP_70

MODLNP_40:
  ZSOL = ZSOL - ALPHA*V
  GTP = TOTAL(ZSOL*G)
  goto, MODLNP_90

MODLNP_50:
  ;; printed output
MODLNP_60:
  IF (K GT 1) THEN GOTO, MODLNP_70
  TNMIN_MSOLVE,G,ZSOL,N,UPD1,YKSK,GSK,YRSR,LRESET,FIRST, $
    HYR, HYK, YKHYK, YRHYR
  ZSOL = -ZSOL
  tnmin_fix, whlpeg, whupeg, zsol
  GTP = TOTAL(ZSOL*G)
MODLNP_70:
  goto, MODLNP_90
MODLNP_80:
  IF (K  GT  1) THEN GOTO, MODLNP_70
  ZSOL = -G
  tnmin_fix, whlpeg, whupeg, zsol
  GTP = TOTAL(ZSOL*G)
  goto, MODLNP_70

;
; STORE (OR RESTORE) DIAGONAL PRECONDITIONING
;
MODLNP_90:
  diagb = emat
  return
end

function tnmin_step1, fnew, fm, gtp, smax, epsmch

; ********************************************************
; STEP1 RETURNS THE LENGTH OF THE INITIAL STEP TO BE TAKEN ALONG THE
; VECTOR P IN THE NEXT LINEAR SEARCH.
; ********************************************************

  D = ABS(FNEW-FM)
  ALPHA = FNEW(0)*0  + 1.
  IF (2.D0*D LE (-GTP) AND D GE EPSMCH) THEN $
    ALPHA = -2.*D/GTP
  IF (ALPHA GE SMAX) THEN ALPHA = SMAX
  return, alpha
end

;
; ************************************************************
; GETPTC, AN ALGORITHM FOR FINDING A STEPLENGTH, CALLED REPEATEDLY BY
; ROUTINES WHICH REQUIRE A STEP LENGTH TO BE COMPUTED USING CUBIC
; INTERPOLATION. THE PARAMETERS CONTAIN INFORMATION ABOUT THE INTERVAL
; IN WHICH A LOWER POINT IS TO BE FOUND AND FROM THIS GETPTC COMPUTES A
; POINT AT WHICH THE FUNCTION CAN BE EVALUATED BY THE CALLING PROGRAM.
; THE VALUE OF THE INTEGER PARAMETERS IENTRY DETERMINES THE PATH TAKEN
; THROUGH THE CODE.
; ************************************************************
pro tnmin_getptc, big, small, rtsmll, reltol, abstol, tnytol, $
         fpresn, eta, rmu, xbnd, u, fu, gu, xmin, fmin, gmin, $
         xw, fw, gw, a, b, oldf, b1, scxbnd, e, step, factor, $
         braktd, gtest1, gtest2, tol, ientry, itest

  ;; This chicanery is so that we get the data types right
  ZERO = fu(0)* 0.
; a1 = zero & scale = zero & chordm = zero
; chordu = zero & d1 = zero & d2 = zero
; denom = zero
  POINT1 = ZERO + 0.1
  HALF = ZERO + 0.5
  ONE = ZERO + 1
  THREE = ZERO + 3
  FIVE = ZERO + 5
  ELEVEN = ZERO + 11

  if ientry EQ 1 then begin ;; else clause = 20 (OK)
;
;      IENTRY=1
;      CHECK INPUT PARAMETERS
;
      ;; GETPTC_10:
      ITEST = 2
      IF (U LE ZERO OR XBND LE TNYTOL OR GU GT ZERO) THEN RETURN
      ITEST = 1
      IF (XBND LT ABSTOL) THEN ABSTOL = XBND
      TOL = ABSTOL
      TWOTOL = TOL + TOL
;
; A AND B DEFINE THE INTERVAL OF UNCERTAINTY, X AND XW ARE POINTS
; WITH LOWEST AND SECOND LOWEST FUNCTION VALUES SO FAR OBTAINED.
; INITIALIZE A,SMIN,XW AT ORIGIN AND CORRESPONDING VALUES OF
; FUNCTION AND PROJECTION OF THE GRADIENT ALONG DIRECTION OF SEARCH
; AT VALUES FOR LATEST ESTIMATE AT MINIMUM.
;
      A = ZERO
      XW = ZERO
      XMIN = ZERO
      OLDF = FU
      FMIN = FU
      FW = FU
      GW = GU
      GMIN = GU
      STEP = U
      FACTOR = FIVE
;
;      THE MINIMUM HAS NOT YET BEEN BRACKETED.
;
      BRAKTD = 0
;
; SET UP XBND AS A BOUND ON THE STEP TO BE TAKEN. (XBND IS NOT COMPUTED
; EXPLICITLY BUT SCXBND IS ITS SCALED VALUE.)  SET THE UPPER BOUND
; ON THE INTERVAL OF UNCERTAINTY INITIALLY TO XBND + TOL(XBND).
;
      SCXBND = XBND
      B = SCXBND + RELTOL*ABS(SCXBND) + ABSTOL
      E = B + B
      B1 = B
;
; COMPUTE THE CONSTANTS REQUIRED FOR THE TWO CONVERGENCE CRITERIA.
;
      GTEST1 = -RMU*GU
      GTEST2 = -ETA*GU
;
; SET IENTRY TO INDICATE THAT THIS IS THE FIRST ITERATION
;
      IENTRY = 2
      goto, GETPTC_210
  endif

;
; IENTRY = 2
;
; UPDATE A,B,XW, AND XMIN
;
  ;; GETPTC_20:
  IF (FU GT FMIN) THEN GOTO, GETPTC_60
;
; IF FUNCTION VALUE NOT INCREASED, NEW POINT BECOMES NEXT
; ORIGIN AND OTHER POINTS ARE SCALED ACCORDINGLY.
;
  CHORDU = OLDF - (XMIN + U)*GTEST1
  if NOT (FU LE CHORDU) then begin
;
; THE NEW FUNCTION VALUE DOES NOT SATISFY THE SUFFICIENT DECREASE
; CRITERION. PREPARE TO MOVE THE UPPER BOUND TO THIS POINT AND
; FORCE THE INTERPOLATION SCHEME TO EITHER BISECT THE INTERVAL OF
; UNCERTAINTY OR TAKE THE LINEAR INTERPOLATION STEP WHICH ESTIMATES
; THE ROOT OF F(ALPHA)=CHORD(ALPHA).
;
      CHORDM = OLDF - XMIN*GTEST1
      GU = -GMIN
      DENOM = CHORDM-FMIN
      IF (ABS(DENOM) LT 1.D-15) THEN BEGIN
          DENOM = ZERO + 1.E-15
          IF (CHORDM-FMIN LT 0.D0) THEN DENOM = -DENOM
      ENDIF
      IF (XMIN NE ZERO) THEN GU = GMIN*(CHORDU-FU)/DENOM
      FU = (HALF*U*(GMIN+GU) + FMIN) > FMIN
;
; IF FUNCTION VALUE INCREASED, ORIGIN REMAINS UNCHANGED
; BUT NEW POINT MAY NOW QUALIFY AS W.
;
      GETPTC_60:
      IF (U GE ZERO) THEN BEGIN
          B = U
          BRAKTD = 1
      ENDIF ELSE BEGIN
          A = U
      ENDELSE
      XW = U
      FW = FU
      GW = GU
  endif else begin
      ;; GETPTC_30:
      FW = FMIN
      FMIN = FU
      GW = GMIN
      GMIN = GU
      XMIN = XMIN + U
      A = A-U
      B = B-U
      XW = -U
      SCXBND = SCXBND - U
      IF (GU GT ZERO) THEN BEGIN
          B = ZERO
          BRAKTD = 1
      ENDIF ELSE BEGIN
          A = ZERO
      ENDELSE
      TOL = ABS(XMIN)*RELTOL + ABSTOL
  endelse

  TWOTOL = TOL + TOL
  XMIDPT = HALF*(A + B)

;
; CHECK TERMINATION CRITERIA
;
  CONVRG = ABS(XMIDPT) LE TWOTOL - HALF*(B-A) OR $
    ABS(GMIN) LE GTEST2 AND FMIN LT OLDF AND $
    (ABS(XMIN - XBND) GT TOL OR NOT BRAKTD)
  IF CONVRG THEN BEGIN
      ITEST = 0
      IF (XMIN NE ZERO) THEN RETURN
;
; IF THE FUNCTION HAS NOT BEEN REDUCED, CHECK TO SEE THAT THE RELATIVE
; CHANGE IN F(X) IS CONSISTENT WITH THE ESTIMATE OF THE DELTA-
; UNIMODALITY CONSTANT, TOL.  IF THE CHANGE IN F(X) IS LARGER THAN
; EXPECTED, REDUCE THE VALUE OF TOL.
;
      ITEST = 3
      IF (ABS(OLDF-FW) LE FPRESN*(ONE + ABS(OLDF))) THEN RETURN
      TOL = POINT1*TOL
      IF (TOL LT TNYTOL) THEN RETURN
      RELTOL = POINT1*RELTOL
      ABSTOL = POINT1*ABSTOL
      TWOTOL = POINT1*TWOTOL
  endif

;
; CONTINUE WITH THE COMPUTATION OF A TRIAL STEP LENGTH
;
  ;; GETPTC_100:
  R = ZERO
  Q = ZERO
  S = ZERO
  IF (ABS(E) GT TOL) THEN BEGIN
;
; FIT CUBIC THROUGH XMIN AND XW
;
      R = THREE*(FMIN-FW)/XW + GMIN + GW
      ABSR = ABS(R)
      Q = ABSR
      IF (GW EQ ZERO OR GMIN EQ ZERO) EQ 0 THEN BEGIN ;; else clause = 140 (OK)
;
; COMPUTE THE SQUARE ROOT OF (R*R - GMIN*GW) IN A WAY
; WHICH AVOIDS UNDERFLOW AND OVERFLOW.
;
          ABGW = ABS(GW)
          ABGMIN = ABS(GMIN)
          S = SQRT(ABGMIN)*SQRT(ABGW)
          IF ((GW/ABGW)*GMIN LE ZERO) THEN BEGIN
;
; COMPUTE THE SQUARE ROOT OF R*R + S*S.
;
              SUMSQ = ONE
              P = ZERO
              IF (ABSR LT S) THEN BEGIN ;; else clause = 110 (OK)
;
; THERE IS A POSSIBILITY OF OVERFLOW.
;
                  IF (S GT RTSMLL) THEN P = S*RTSMLL
                  IF (ABSR GE P) THEN SUMSQ = ONE +(ABSR/S)^2
                  SCALE = S
              endif else begin ;; flow to 120 (OK)
;
; THERE IS A POSSIBILITY OF UNDERFLOW.
;
                  ;; GETPTC_110:
                  IF (ABSR GT RTSMLL) THEN P = ABSR*RTSMLL
                  IF (S GE P) THEN SUMSQ = ONE + (S/ABSR)^2
                  SCALE = ABSR
              ENDELSE ;; flow to 120 (OK)
              ;; GETPTC_120:
              SUMSQ = SQRT(SUMSQ)
              Q = BIG
              IF (SCALE LT BIG/SUMSQ) THEN Q = SCALE*SUMSQ
          endif else begin ;; flow to 140
;
; COMPUTE THE SQUARE ROOT OF R*R - S*S
;
              ;; GETPTC_130:
              Q = SQRT(ABS(R+S))*SQRT(ABS(R-S))
              IF (R GE S OR R LE (-S)) EQ 0 THEN BEGIN
                  R = ZERO
                  Q = ZERO
                  goto, GETPTC_150
              endif
          endelse
      endif
;
; COMPUTE THE MINIMUM OF FITTED CUBIC
;
      ;; GETPTC_140:
      IF (XW LT ZERO) THEN Q = -Q
      S = XW*(GMIN - R - Q)
      Q = GW - GMIN + Q + Q
      IF (Q GT ZERO) THEN S = -S
      IF (Q LE ZERO) THEN Q = -Q
      R = E
      IF (B1 NE STEP OR BRAKTD) THEN E = STEP
  endif

;
; CONSTRUCT AN ARTIFICIAL BOUND ON THE ESTIMATED STEPLENGTH
;
GETPTC_150:
  A1 = A
  B1 = B
  STEP = XMIDPT
  IF (BRAKTD) EQ 0 THEN BEGIN ;; else flow to 160 (OK)
      STEP = -FACTOR*XW
      IF (STEP GT SCXBND) THEN STEP = SCXBND
      IF (STEP NE SCXBND) THEN FACTOR = FIVE*FACTOR
      ;; flow to 170 (OK)
  endif else begin
;
; IF THE MINIMUM IS BRACKETED BY 0 AND XW THE STEP MUST LIE
; WITHIN (A,B).
;
      ;; GETPTC_160:
      if (a NE zero OR xw GE zero) AND (b NE zero OR xw LE zero) then $
        goto, GETPTC_180
;
; IF THE MINIMUM IS NOT BRACKETED BY 0 AND XW THE STEP MUST LIE
; WITHIN (A1,B1).
;
      D1 = XW
      D2 = A
      IF (A EQ ZERO) THEN D2 = B
; THIS LINE MIGHT BE
;     IF (A EQ ZERO) THEN D2 = E
      U = - D1/D2
      STEP = FIVE*D2*(POINT1 + ONE/U)/ELEVEN
      IF (U LT ONE) THEN STEP = HALF*D2*SQRT(U)
  endelse
  ;; GETPTC_170:
  IF (STEP LE ZERO) THEN A1 = STEP
  IF (STEP GT ZERO) THEN B1 = STEP
;
; REJECT THE STEP OBTAINED BY INTERPOLATION IF IT LIES OUTSIDE THE
; REQUIRED INTERVAL OR IT IS GREATER THAN HALF THE STEP OBTAINED
; DURING THE LAST-BUT-ONE ITERATION.
;
GETPTC_180:
  if NOT (abs(s) LE abs(half*q*r) OR s LE q*a1 OR s GE q*b1) then begin
      ;; else clause = 200 (OK)
;
; A CUBIC INTERPOLATION STEP
;
      STEP = S/Q
;
; THE FUNCTION MUST NOT BE EVALUTATED TOO CLOSE TO A OR B.
;
      if NOT (step - a GE twotol AND b - step GE twotol) then begin
          ;; else clause = 210 (OK)
          IF (XMIDPT LE ZERO) THEN STEP = -TOL ELSE STEP = TOL
      endif ;; flow to 210 (OK)
  endif else begin
      ;; GETPTC_200:
      E = B-A
  endelse

;
; IF THE STEP IS TOO LARGE, REPLACE BY THE SCALED BOUND (SO AS TO
; COMPUTE THE NEW POINT ON THE BOUNDARY).
;
GETPTC_210:
  if (step GE scxbnd) then begin ;; else clause = 220 (OK)
      STEP = SCXBND
;
; MOVE SXBD TO THE LEFT SO THAT SBND + TOL(XBND) = XBND.
;
      SCXBND = SCXBND - (RELTOL*ABS(XBND)+ABSTOL)/(ONE + RELTOL)
  endif
  ;; GETPTC_220:
  U = STEP
  IF (ABS(STEP) LT TOL AND STEP LT ZERO) THEN U = -TOL
  IF (ABS(STEP) LT TOL AND STEP GE ZERO) THEN U = TOL
  ITEST = 1
  RETURN
end

;
;      LINE SEARCH ALGORITHMS OF GILL AND MURRAY
;
pro tnmin_linder, n, fcn, small, epsmch, reltol, abstol, $
         tnytol, eta, sftbnd, xbnd, p, gtp, x, f, alpha, g, $
         iflag, xnew

  zero = f(0) * 0.
  one = zero + 1.

  LSPRNT = 0L
  NPRNT  = 10000L
  RTSMLL = SQRT(SMALL)
  BIG = 1./SMALL
  ITCNT = 0L

;
;     SET THE ESTIMATED RELATIVE PRECISION IN F(X).
;
  FPRESN = 10.*EPSMCH
  U = ALPHA
  FU = F
  FMIN = F
  GU = GTP
  RMU = zero + 1E-4

;
;      FIRST ENTRY SETS UP THE INITIAL INTERVAL OF UNCERTAINTY.
;
  IENTRY = 1L

LINDER_10:
;
; TEST FOR TOO MANY ITERATIONS
;
  ITCNT = ITCNT + 1
  IF (ITCNT GT 30) THEN BEGIN
      ;; deviation from Nash: allow optimization to continue in outer
      ;; loop even if we fail to converge, if IFLAG EQ 0.  A value of
      ;; 1 indicates failure.  I believe that I tried IFLAG=0 once and
      ;; there was some problem, but I forget what it was.
      IFLAG = 1
      F = FMIN
      ALPHA = XMIN
      X = X + ALPHA*P
      RETURN
  ENDIF

  IFLAG = 0
  TNMIN_GETPTC,BIG,SMALL,RTSMLL,RELTOL,ABSTOL,TNYTOL, $
    FPRESN,ETA,RMU,XBND,U,FU,GU,XMIN,FMIN,GMIN, $
    XW,FW,GW,A,B,OLDF,B1,SCXBND,E,STEP,FACTOR, $
    BRAKTD,GTEST1,GTEST2,TOL,IENTRY,ITEST

;
;      IF ITEST=1, THE ALGORITHM REQUIRES THE FUNCTION VALUE TO BE
;      CALCULATED.
;
  IF (ITEST EQ 1) THEN BEGIN
      UALPHA = XMIN + U
      FU = TNMIN_CALL(FCN, X + UALPHA*P, LG, fullparam_=xnew)
      GU = TOTAL(LG*P)
;
;      THE GRADIENT VECTOR CORRESPONDING TO THE BEST POINT IS
;      OVERWRITTEN IF FU IS LESS THAN FMIN AND FU IS SUFFICIENTLY
;      LOWER THAN F AT THE ORIGIN.
;
      IF (FU LE FMIN AND FU LE OLDF-UALPHA*GTEST1) THEN $
        G = LG
;      print, 'fu = ', fu
      GOTO, LINDER_10
  ENDIF
;
;      IF ITEST=2 OR 3 A LOWER POINT COULD NOT BE FOUND
;
  IFLAG = 1
  IF (ITEST NE 0) THEN RETURN

;
;      IF ITEST=0 A SUCCESSFUL SEARCH HAS BEEN MADE
;
;  print, 'itcnt = ', itcnt
  IFLAG = 0
  F = FMIN
  ALPHA = XMIN
  X = X + ALPHA*P
  RETURN
END

pro tnmin_defiter, fcn, x, iter, fnorm, fmt=fmt, FUNCTARGS=fcnargs, $
                   quiet=quiet, deriv=df, dprint=dprint, pfixed=pfixed, $
                   maximize=maximize, _EXTRA=iterargs

  if keyword_set(quiet) then return
  if n_params() EQ 3 then begin
      fnorm = tnmin_call(fcn, x, df)
  endif

  if keyword_set(maximize) then f = -fnorm else f = fnorm
  print, iter, f, format='("Iter ",I6,"   FUNCTION = ",G20.8)'
  if n_elements(fmt) GT 0 then begin
      print, x, format=fmt
  endif else begin
      n = n_elements(x)
      ii = lindgen(n)
      p = '     P('+strtrim(ii,2)+') = '+string(x,format='(G)')
      if keyword_set(dprint) then begin
          p1 = strarr(n)
          wh = where(pfixed EQ 0, ct)
          if ct GT 0 AND n_elements(df) GE ct then begin
              if keyword_set(maximize) then df1 = -df else df1 = df
              p1(wh) = string(df1, format='(G)')
          endif
          wh = where(pfixed EQ 1, ct)
          if ct GT 0 then $
            p1(wh) = '          (FIXED)'
          p = p + '  :  DF/DP('+strtrim(ii,2)+') = '+p1
      endif
      print, p, format='(A)'
  endelse

  return
end

;      SUBROUTINE TNBC (IERROR, N, X, F, G, W, LW, SFUN, LOW, UP, IPIVOT)
;      IMPLICIT          DOUBLE PRECISION (A-H,O-Z)
;      INTEGER           IERROR, N, LW, IPIVOT(N)
;      DOUBLE PRECISION  X(N), G(N), F, W(LW), LOW(N), UP(N)
;
; THIS ROUTINE SOLVES THE OPTIMIZATION PROBLEM
;
;   MINIMIZE     F(X)
;      X
;   SUBJECT TO   LOW <= X <= UP
;
; WHERE X IS A VECTOR OF N REAL VARIABLES.  THE METHOD USED IS
; A TRUNCATED-NEWTON ALGORITHM (SEE "NEWTON-TYPE MINIMIZATION VIA
; THE LANCZOS ALGORITHM" BY S.G. NASH (TECHNICAL REPORT 378, MATH.
; THE LANCZOS METHOD" BY S.G. NASH (SIAM J. NUMER. ANAL. 21 (1984),
; PP. 770-778).  THIS ALGORITHM FINDS A LOCAL MINIMUM OF F(X).  IT DOES
; NOT ASSUME THAT THE FUNCTION F IS CONVEX (AND SO CANNOT GUARANTEE A
; GLOBAL SOLUTION), BUT DOES ASSUME THAT THE FUNCTION IS BOUNDED BELOW.
; IT CAN SOLVE PROBLEMS HAVING ANY NUMBER OF VARIABLES, BUT IT IS
; ESPECIALLY USEFUL WHEN THE NUMBER OF VARIABLES (N) IS LARGE.
;
; SUBROUTINE PARAMETERS:
;
; IERROR  - (INTEGER) ERROR CODE
;           ( 0 => NORMAL RETURN
;           ( 2 => MORE THAN MAXFUN EVALUATIONS
;           ( 3 => LINE SEARCH FAILED TO FIND LOWER
;           (          POINT (MAY NOT BE SERIOUS)
;           (-1 => ERROR IN INPUT PARAMETERS
; N       - (INTEGER) NUMBER OF VARIABLES
; X       - (REAL*8) VECTOR OF LENGTH AT LEAST N; ON INPUT, AN INITIAL
;           ESTIMATE OF THE SOLUTION; ON OUTPUT, THE COMPUTED SOLUTION.
; G       - (REAL*8) VECTOR OF LENGTH AT LEAST N; ON OUTPUT, THE FINAL
;           VALUE OF THE GRADIENT
; F       - (REAL*8) ON INPUT, A ROUGH ESTIMATE OF THE VALUE OF THE
;           OBJECTIVE FUNCTION AT THE SOLUTION; ON OUTPUT, THE VALUE
;           OF THE OBJECTIVE FUNCTION AT THE SOLUTION
; W       - (REAL*8) WORK VECTOR OF LENGTH AT LEAST 14*N
; LW      - (INTEGER) THE DECLARED DIMENSION OF W
; SFUN    - A USER-SPECIFIED SUBROUTINE THAT COMPUTES THE FUNCTION
;           AND GRADIENT OF THE OBJECTIVE FUNCTION.  IT MUST HAVE
;           THE CALLING SEQUENCE
;             SUBROUTINE SFUN (N, X, F, G)
;             INTEGER           N
;             DOUBLE PRECISION  X(N), G(N), F
; LOW, UP - (REAL*8) VECTORS OF LENGTH AT LEAST N CONTAINING
;           THE LOWER AND UPPER BOUNDS ON THE VARIABLES.  IF
;           THERE ARE NO BOUNDS ON A PARTICULAR VARIABLE, SET
;           THE BOUNDS TO -1.D38 AND 1.D38, RESPECTIVELY.
; IPIVOT  - (INTEGER) WORK VECTOR OF LENGTH AT LEAST N, USED
;           TO RECORD WHICH VARIABLES ARE AT THEIR BOUNDS.
;
; THIS IS AN EASY-TO-USE DRIVER FOR THE MAIN OPTIMIZATION ROUTINE
; LMQNBC.  MORE EXPERIENCED USERS WHO WISH TO CUSTOMIZE PERFORMANCE
; OF THIS ALGORITHM SHOULD CALL LMQBC DIRECTLY.
;
;----------------------------------------------------------------------
; THIS ROUTINE SETS UP ALL THE PARAMETERS FOR THE TRUNCATED-NEWTON
; ALGORITHM.  THE PARAMETERS ARE:
;
; ETA    - SEVERITY OF THE LINESEARCH
; MAXFUN - MAXIMUM ALLOWABLE NUMBER OF FUNCTION EVALUATIONS
; XTOL   - DESIRED ACCURACY FOR THE SOLUTION X*
; STEPMX - MAXIMUM ALLOWABLE STEP IN THE LINESEARCH
; ACCRCY - ACCURACY OF COMPUTED FUNCTION VALUES
; MSGLVL - CONTROLS QUANTITY OF PRINTED OUTPUT
;          0 = NONE, 1 = ONE LINE PER MAJOR ITERATION.
; MAXIT  - MAXIMUM NUMBER OF INNER ITERATIONS PER STEP
;
function tnmin, fcn, xall, fguess=fguess, functargs=fcnargs, parinfo=parinfo, $
                epsrel=epsrel0, epsabs=epsabs0, fastnorm=fastnorm, $
                nfev=nfev, maxiter=maxiter0, maxnfev=maxfun0, maximize=fmax, $
                errmsg=errmsg, nprint=nprint, status=status, nocatch=nocatch, $
                iterproc=iterproc, iterargs=iterargs, niter=niter,quiet=quiet,$
                autoderivative=autoderiv, iterderiv=iterderiv, bestmin=f

  if n_elements(nprint) EQ 0 then nprint = 1
  if n_elements(iterproc) EQ 0 then iterproc = 'TNMIN_DEFITER'
  if n_elements(autoderiv) EQ 0 then autoderiv = 0
  if n_elements(msglvl) EQ 0 then msglvl = 0
  if n_params() EQ 0 then begin
      message, "USAGE: PARMS = TNMIN('MYFUNCT', START_PARAMS, ... )", /info
      return, !values.d_nan
  endif
  iterd = keyword_set(iterderiv)
  maximize = keyword_set(fmax)
  status = 0L
  nfev = 0L
  errmsg = ''
  catch_msg = 'in TNMIN'

  common tnmin_config, tnconfig
  tnconfig = {fastnorm: keyword_set(fastnorm), proc: 0, nfev: 0L, $
              autoderiv: keyword_set(autoderiv), max: maximize}

  ;; Handle error conditions gracefully
  if NOT keyword_set(nocatch) then begin
      catch, catcherror
      if catcherror NE 0 then begin
          catch, /cancel
          err_string = ''+!error_state.msg
          message, /cont, 'Error detected while '+catch_msg+':'
          message, /cont,    err_string
          message, /cont, 'Error condition detected. Returning to MAIN level.'
          if errmsg EQ '' then $
            errmsg = 'Error detected while '+catch_msg+': '+err_string
          if status EQ 0 then status = -18
          return, !values.d_nan
      endif
  endif

  ;; Parinfo:
  ;; --------------- STARTING/CONFIG INFO (passed in to routine, not changed)
  ;; .value   - starting value for parameter
  ;; .fixed   - parameter is fixed
  ;; .limited - a two-element array, if parameter is bounded on
  ;;            lower/upper side
  ;; .limits - a two-element array, lower/upper parameter bounds, if
  ;;           limited vale is set
  ;; .step   - step size in Jacobian calc, if greater than zero

  catch_msg = 'parsing input parameters'
  ;; Parameters can either be stored in parinfo, or x.  Parinfo takes
  ;; precedence if it exists.
  if n_elements(xall) EQ 0 AND n_elements(parinfo) EQ 0 then begin
      errmsg = 'ERROR: must pass parameters in X or PARINFO'
      goto, TERMINATE
  endif

  ;; Be sure that PARINFO is of the right type
  if n_elements(parinfo) GT 0 then begin
      parinfo_size = size(parinfo)
      if parinfo_size(parinfo_size(0)+1) NE 8 then begin
          errmsg = 'ERROR: PARINFO must be a structure.'
          goto, TERMINATE
      endif
      if n_elements(xall) GT 0 AND n_elements(xall) NE n_elements(parinfo) $
        then begin
          errmsg = 'ERROR: number of elements in PARINFO and X must agree'
          goto, TERMINATE
      endif
  endif

  ;; If the parameters were not specified at the command line, then
  ;; extract them from PARINFO
  if n_elements(xall) EQ 0 then begin
      tnmin_parinfo, parinfo, tagnames, 'VALUE', xall, status=stx
      if stx EQ 0 then begin
          errmsg = 'ERROR: either X or PARINFO(*).VALUE must be supplied.'
          goto, TERMINATE
      endif

      sz = size(xall)
      ;; Convert to double if parameters are not float or double
      if sz(sz(0)+1) NE 4 AND sz(sz(0)+1) NE 5 then $
        xall = double(xall)
  endif
  npar = n_elements(xall)
  zero = xall(0) * 0.
  one  = zero + 1
  ten  = zero + 10
  twothird = (zero+2)/(zero+3)
  quarter = zero + 0.25
  half = zero + 0.5

  ;; Extract machine parameters
  sz = size(xall)
  tp = sz(sz(0)+1)
  if tp NE 4 AND tp NE 5 then begin
      if NOT keyword_set(quiet) then begin
          message, 'WARNING: input parameters must be at least FLOAT', /info
          message, '         (converting parameters to FLOAT)', /info
      endif
      xall = float(xall)
      sz = size(xall)
  endif
  isdouble = (sz(sz(0)+1) EQ 5)

  common tnmin_machar, machvals
  tnmin_setmachar, double=isdouble
  MCHPR1 = machvals.machep

  ;; TIED parameters?
  tnmin_parinfo, parinfo, tagnames, 'TIED', ptied, default='', n=npar
  ptied = strtrim(ptied, 2)
  wh = where(ptied NE '', qanytied)
  qanytied = qanytied GT 0
  tnconfig = create_struct(tnconfig, 'QANYTIED', qanytied, 'PTIED', ptied)

  ;; FIXED parameters ?
  tnmin_parinfo, parinfo, tagnames, 'FIXED', pfixed, default=0, n=npar
  pfixed = pfixed EQ 1
  pfixed = pfixed OR (ptied NE '')   ;; Tied parameters are also effectively fixed

  ;; Finite differencing step, absolute and relative, and sidedness of derivative
  tnmin_parinfo, parinfo, tagnames, 'STEP',     step, default=zero, n=npar
  tnmin_parinfo, parinfo, tagnames, 'RELSTEP', dstep, default=zero, n=npar
  tnmin_parinfo, parinfo, tagnames, 'TNSIDE',  dside, default=2,    n=npar

  ;; Maximum and minimum steps allowed to be taken in one iteration
  tnmin_parinfo, parinfo, tagnames, 'TNMAXSTEP', maxstep, default=zero, n=npar
  tnmin_parinfo, parinfo, tagnames, 'TNMINSTEP', minstep, default=zero, n=npar
  qmin = minstep *  0 ;; Disable minstep for now
  qmax = maxstep NE 0
  wh = where(qmin AND qmax AND maxstep LT minstep, ct)
  if ct GT 0 then begin
      errmsg = 'ERROR: TNMINSTEP is greater than TNMAXSTEP'
      goto, TERMINATE
  endif
  wh = where(qmin AND qmax, ct)
  qminmax = ct GT 0

  ;; Finish up the free parameters
  ifree = where(pfixed NE 1, ct)
  if ct EQ 0 then begin
      errmsg = 'ERROR: no free parameters'
      goto, TERMINATE
  endif

  ;; Compose only VARYING parameters
  xnew = xall      ;; xnew is the set of parameters to be returned
  x = xnew(ifree)  ;; x is the set of free parameters

  ;; LIMITED parameters ?
  tnmin_parinfo, parinfo, tagnames, 'LIMITED', limited, status=st1
  tnmin_parinfo, parinfo, tagnames, 'LIMITS',  limits,  status=st2
  if st1 EQ 1 AND st2 EQ 1 then begin

      ;; Error checking on limits in parinfo
      wh = where((limited[0,*] AND xall LT limits[0,*]) OR $
                 (limited[1,*] AND xall GT limits[1,*]), ct)
      if ct GT 0 then begin
          errmsg = 'ERROR: parameters are not within PARINFO limits'
          goto, TERMINATE
      endif
      wh = where(limited[0,*] AND limited[1,*] AND $
                 limits[0,*] GE limits[1,*] AND pfixed EQ 0, ct)
      if ct GT 0 then begin
          errmsg = 'ERROR: PARINFO parameter limits are not consistent'
          goto, TERMINATE
      endif


      ;; Transfer structure values to local variables
      qulim = limited[1, ifree]
      ulim  = limits [1, ifree]
      qllim = limited[0, ifree]
      llim  = limits [0, ifree]

      wh = where(qulim OR qllim, ct)
      if ct GT 0 then qanylim = 1 else qanylim = 0

  endif else begin

      ;; Fill in local variables with dummy values
      qulim = lonarr(n_elements(ifree))
      ulim  = x * 0.
      qllim = qulim
      llim  = x * 0.
      qanylim = 0

  endelse

  tnconfig = create_struct(tnconfig, $
                           'PFIXED', pfixed, 'IFREE', ifree, $
                           'STEP', step, 'DSTEP', dstep, 'DSIDE', dside, $
                           'ULIMITED', qulim, 'ULIMIT', ulim)


  common tnmin_fcnargs, tnfcnargs
  tnfcnargs = 0 & dummy = temporary(tnfcnargs)
  if n_elements(fcnargs) GT 0 then tnfcnargs = fcnargs

  ;; SET UP CUSTOMIZING PARAMETERS
  ;; ETA    - SEVERITY OF THE LINESEARCH
  ;; MAXFUN - MAXIMUM ALLOWABLE NUMBER OF FUNCTION EVALUATIONS
  ;; XTOL   - DESIRED ACCURACY FOR THE SOLUTION X*
  ;; STEPMX - MAXIMUM ALLOWABLE STEP IN THE LINESEARCH
  ;; ACCRCY - ACCURACY OF COMPUTED FUNCTION VALUES
  ;; MSGLVL - DETERMINES QUANTITY OF PRINTED OUTPUT
  ;;          0 = NONE, 1 = ONE LINE PER MAJOR ITERATION.
  ;; MAXIT  - MAXIMUM NUMBER OF INNER ITERATIONS PER STEP

  n = n_elements(x)
  if n_elements(maxit) EQ 0 then begin
      maxit = (n/2) < 50 > 2    ;; XXX diff than TN.F
  endif

  if n_elements(maxfun0) EQ 0 then $
    maxfun = 0L $
  else $
    maxfun = floor(maxfun0(0)) > 1
;  maxfun = 150L*n
;  if keyword_set(autoderiv) then $
;    maxfun = maxfun*(1L + round(total(abs(dside)> 1 < 2)))
  eta = zero + 0.25
  stepmx = zero + 10

  if n_elements(maxiter0) EQ 0 then $
    maxiter = 200L $
  else $
    maxiter = floor(maxiter0(0)) > 1

  g = replicate(x(0)* 0., n)

;; call minimizer
;
; THIS ROUTINE IS A BOUNDS-CONSTRAINED TRUNCATED-NEWTON METHOD.
; THE TRUNCATED-NEWTON METHOD IS PRECONDITIONED BY A LIMITED-MEMORY
; QUASI-NEWTON METHOD (THIS PRECONDITIONING STRATEGY IS DEVELOPED
; IN THIS ROUTINE) WITH A FURTHER DIAGONAL SCALING (SEE ROUTINE NDIA3).
; FOR FURTHER DETAILS ON THE PARAMETERS, SEE ROUTINE TNBC.
;

;
; initialize variables
;
  common tnmin_work, lsk, lyk, ldiagb, lsr, lyr
;                    I/O  I/O     I/O  I/O  I/O
  lsk = 0 & lyk = 0 & ldiagb = 0 & lsr = 0 & lyr = 0

  zero   = x(0)* 0.
  one    = zero + 1

  if n_elements(fguess) EQ 0 then fguess = one
  if maximize then f = -fguess else f = fguess
  conv = 0 & lreset = 0 & upd1 = 0 & newcon = 0
  gsk = zero & yksk = zero & gtp = zero & gtpnew = zero & yrsr = zero

  upd1 = 1
  ireset = 0L
  nmodif = 0L
  nlincg = 0L
  fstop  = f
  conv   = 0
  nm1    = n - 1

;; From CHKUCP
;
; CHECKS PARAMETERS AND SETS CONSTANTS WHICH ARE COMMON TO BOTH
; DERIVATIVE AND NON-DERIVATIVE ALGORITHMS
;
  EPSMCH = MCHPR1
  SMALL = EPSMCH*EPSMCH
  TINY = SMALL
  NWHY = -1L
;
; SET CONSTANTS FOR LATER
;
  ;; Some of these constants have been moved around for clarity (!)
  if n_elements(epsrel0) EQ 0 then epsrel = 100*MCHPR1 $
  else                             epsrel = epsrel0(0)+0.
  if n_elements(epsabs0) EQ 0 then epsabs = zero $
  else                             epsabs = abs(epsabs0(0))+0.

  ACCRCY = epsrel
  XTOL   = sqrt(ACCRCY)

  RTEPS = SQRT(EPSMCH)
  RTOL = XTOL
  IF (ABS(RTOL) LT ACCRCY) THEN RTOL = 10. *RTEPS

  FTOL2 = 0
  FTOL1 = RTOL^2 + EPSMCH    ;; For func chg convergence test (U1a)
  if epsabs NE 0 then $
    FTOL2 = EPSABS + EPSMCH ;; For absolute func convergence test (U1b)
  PTOL = RTOL + RTEPS       ;; For parm chg convergence test (U2)
  GTOL1 = ACCRCY^TWOTHIRD   ;; For gradient convergence test (U3, squared)
  GTOL2 = (1D-2*XTOL)^2     ;; For gradient convergence test (U4, squared)

;
; CHECK FOR ERRORS IN THE INPUT PARAMETERS
;
  IF (ETA LT 0.D0 OR STEPMX LT RTOL) THEN BEGIN
      errmsg = 'ERROR: input keywords are inconsistent'
      goto, TERMINATE
  endif
  ;; Check input parameters for errors
  if (n LE 0) OR (xtol LE 0) OR (maxit LE 0) then begin
      errmsg = 'ERROR: input keywords are inconsistent'
      goto, TERMINATE
  endif
  NWHY = 0L

  XNORM = TNMIN_ENORM(X)
  ALPHA = zero
  TEST = zero

; From SETUCR
;
; CHECK INPUT PARAMETERS, COMPUTE THE INITIAL FUNCTION VALUE, SET
; CONSTANTS FOR THE SUBSEQUENT MINIMIZATION
;
  fm = f
;
; COMPUTE THE INITIAL FUNCTION VALUE
;
  catch_msg = 'calling TNMIN_CALL'
  fnew = tnmin_call(fcn, x, g, fullparam_=xnew)

;
; SET CONSTANTS FOR LATER
;
  NITER = 0L
  OLDF = FNEW
  GTG = TOTAL(G*G)

  common tnmin_error, tnerr

  if nprint GT 0 AND iterproc NE '' then begin
      iflag = 0L
      if (niter-1) MOD nprint EQ 0 then begin
          catch_msg = 'calling '+iterproc
          tnerr = 0
          call_procedure, iterproc, fcn, xnew, niter, fnew, $
            FUNCTARGS=fcnargs, parinfo=parinfo, quiet=quiet, $
            dprint=iterd, deriv=g, pfixed=pfixed, maximize=maximize, $
            _EXTRA=iterargs
          iflag = tnerr
          if iflag LT 0 then begin
              errmsg = 'WARNING: premature termination by "'+iterproc+'"'
              nwhy = 4L
              goto, CLEANUP
          endif
      endif
  endif


  fold = fnew
  flast = fnew

; From LMQNBC
;
; TEST THE LAGRANGE MULTIPLIERS TO SEE IF THEY ARE NON-NEGATIVE.
; BECAUSE THE CONSTRAINTS ARE ONLY LOWER BOUNDS, THE COMPONENTS
; OF THE GRADIENT CORRESPONDING TO THE ACTIVE CONSTRAINTS ARE THE
; LAGRANGE MULTIPLIERS.  AFTERWORDS, THE PROJECTED GRADIENT IS FORMED.
;
  catch_msg = 'zeroing derivatives of pegged parameters'
  lmask = qllim AND (x EQ llim) AND (g GE 0)
  umask = qulim AND (x EQ ulim) AND (g LE 0)
  whlpeg = where(lmask, nlpeg)
  whupeg = where(umask, nupeg)
  tnmin_fix, whlpeg, whupeg, g
  GTG = TOTAL(G*G)

;
; CHECK IF THE INITIAL POINT IS A LOCAL MINIMUM.
;
  FTEST = ONE + ABS(FNEW)
  IF (GTG LT GTOL2*FTEST*FTEST) THEN GOTO, CLEANUP

;
; SET INITIAL VALUES TO OTHER PARAMETERS
;
  ICYCLE = NM1
  GNORM  = SQRT(GTG)
  DIFNEW = ZERO
  EPSRED = HALF/TEN
  FKEEP  = FNEW

;
; SET THE DIAGONAL OF THE APPROXIMATE HESSIAN TO UNITY.
;
  LDIAGB = replicate(one, n)


;
; ..................START OF MAIN ITERATIVE LOOP..........
;
; COMPUTE THE NEW SEARCH DIRECTION
;
  catch_msg = 'calling TNMIN_MODLNP'
  tnmin_modlnp, lpk, lgv, lz1, lv, ldiagb, lemat, $
    x, g, lzk, n, niter, maxit, nmodif, nlincg, upd1, yksk, $
    gsk, yrsr, lreset, fcn, whlpeg, whupeg, accrcy, gtpnew, gnorm, xnorm, $
    xnew

ITER_LOOP:
  catch_msg = 'computing step length'
  LOLDG = G
  PNORM = tnmin_enorm(LPK)
  OLDF = FNEW
  OLDGTP = GTPNEW

;
; PREPARE TO COMPUTE THE STEP LENGTH
;
  PE = PNORM + EPSMCH

;
; COMPUTE THE ABSOLUTE AND RELATIVE TOLERANCES FOR THE LINEAR SEARCH
;
  RELTOL = RTEPS*(XNORM + ONE)/PE
  ABSTOL = - EPSMCH*FTEST/(OLDGTP - EPSMCH)

;
; COMPUTE THE SMALLEST ALLOWABLE SPACING BETWEEN POINTS IN
; THE LINEAR SEARCH
;
  TNYTOL = EPSMCH*(XNORM + ONE)/PE

  ;; From STPMAX
  SPE = STEPMX/PE
  mmask = (NOT lmask AND NOT umask)
  wh = where(mmask AND (lpk GT 0) AND qulim AND (ulim - x LT spe*lpk), ct)
  if ct GT 0 then begin
      spe = min( (ulim(wh)-x(wh)) / lpk(wh))
  endif
  wh = where(mmask AND (lpk LT 0) AND qllim AND (llim - x GT spe*lpk), ct)
  if ct GT 0 then begin
      spe = min( (llim(wh)-x(wh)) / lpk(wh))
  endif

  ;; From LMQNBC
;
; SET THE INITIAL STEP LENGTH.
;
  ALPHA = TNMIN_STEP1(FNEW,FM,OLDGTP,SPE, epsmch)

;
; PERFORM THE LINEAR SEARCH
;
  catch_msg = 'performing linear search'
  tnmin_linder, n, fcn, small, epsmch, reltol, abstol, tnytol, $
    eta, zero, spe, lpk, oldgtp, x, fnew, alpha, g, nwhy, xnew

  NEWCON = 0
  IF (ABS(ALPHA-SPE) GT 1.D1*EPSMCH) EQ 0 THEN BEGIN
      NEWCON = 1
      NWHY   = 0L

      ;; From MODZ
      mmask = (NOT lmask AND NOT umask)
      wh = where(mmask AND (lpk LT 0) AND qllim $
                 AND (x-llim LE 10*epsmch*(abs(llim)+one)),ct)
      if ct GT 0 then begin
          flast = fnew
          lmask(wh) = 1
          x(wh) = llim(wh)
          whlpeg = where(lmask, nlpeg)
      endif
      wh = where(mmask AND (lpk GT 0) AND qulim $
                 AND (ulim-x LE 10*epsmch*(abs(ulim)+one)),ct)
      if ct GT 0 then begin
          flast = fnew
          umask(wh) = 1
          x(wh) = ulim(wh)
          whupeg = where(umask, nupeg)
      endif
      xnew(ifree) = x

      ;; From LMQNBC
      FLAST = FNEW
  endif

  FOLD = FNEW
  NITER = NITER + 1

;
; IF REQUIRED, PRINT THE DETAILS OF THIS ITERATION
;
  if nprint GT 0 AND iterproc NE '' then begin
      iflag = 0L
      xx = xnew
      xx(ifree) = x
      if (niter-1) MOD nprint EQ 0 then begin
          catch_msg = 'calling '+iterproc
          tnerr = 0
          call_procedure, iterproc, fcn, xx, niter, fnew, $
            FUNCTARGS=fcnargs, parinfo=parinfo, quiet=quiet, $
            dprint=iterd, deriv=g, pfixed=pfixed, maximize=maximize, $
            _EXTRA=iterargs
          iflag = tnerr
          if iflag LT 0 then begin
              errmsg = 'WARNING: premature termination by "'+iterproc+'"'
              nwhy = 4L
              goto, CLEANUP
          endif
      endif
  endif

  catch_msg = 'testing for convergence'
  IF (NWHY LT 0) THEN BEGIN
      NWHY = -2L
      goto, CLEANUP
  ENDIF
  IF (NWHY NE 0 AND NWHY NE 2) THEN BEGIN
      ;; THE LINEAR SEARCH HAS FAILED TO FIND A LOWER POINT
      NWHY = 3L
      goto, CLEANUP
  endif
  if nwhy GT 1 then begin
      fnew = tnmin_call(fcn, x, g, fullparam_=xnew)
  endif
  wh = where(finite(x) EQ 0, ct)
  if ct GT 0 OR finite(fnew) EQ 0 then begin
      nwhy = -3L
      goto, CLEANUP
  endif

;
; TERMINATE IF MORE THAN MAXFUN EVALUATIONS HAVE BEEN MADE
;
  NWHY = 2L
  if maxfun GT 0 AND tnconfig.nfev GT maxfun then goto, CLEANUP
  if niter GT maxiter then goto, CLEANUP
  NWHY = 0L

;
; SET UP PARAMETERS USED IN CONVERGENCE AND RESETTING TESTS
;
  DIFOLD = DIFNEW
  DIFNEW = OLDF - FNEW

;
; IF THIS IS THE FIRST ITERATION OF A NEW CYCLE, COMPUTE THE
; PERCENTAGE REDUCTION FACTOR FOR THE RESETTING TEST.
;
  IF (ICYCLE EQ 1) THEN BEGIN
      IF (DIFNEW GT 2.D0*DIFOLD) THEN EPSRED = EPSRED + EPSRED
      IF (DIFNEW LT 5.0D-1*DIFOLD) THEN EPSRED = HALF*EPSRED
  ENDIF
  LGV = G
  tnmin_fix, whlpeg, whupeg, lgv
  GTG = TOTAL(LGV*LGV)
  GNORM = SQRT(GTG)
  FTEST = ONE + ABS(FNEW)
  XNORM = tnmin_enorm(X)

  ;; From CNVTST
  LTEST = (FLAST - FNEW) LE (-5.D-1*GTPNEW)
  wh = where((lmask AND g LT 0) OR (umask AND g GT 0), ct)
  if ct GT 0 then begin
      conv = 0
      if NOT ltest then begin
          mx = max(abs(g(wh)), wh2)
          lmask(wh(wh2)) = 0 & umask(wh(wh2)) = 0
          FLAST = FNEW
          goto, CNVTST_DONE
      endif
  endif
  ;; Gill Murray and Wright tests are listed to the right.
  ;; Modifications due to absolute function value test are done here.

  fconv = abs(DIFNEW) LT FTOL1*FTEST              ;; U1a
  if ftol2 EQ 0 then begin
      pconv = ALPHA*PNORM LT PTOL*(ONE + XNORM)   ;; U2
      gconv = GTG LT GTOL1*FTEST*FTEST            ;; U3
  endif else begin
      ;; Absolute tolerance implies a loser constraint on parameters
      fconv = fconv OR (abs(difnew) LT ftol2)     ;; U1b
      acc2  = (FTOL2/FTEST + EPSMCH)
      pconv = ALPHA*PNORM LT SQRT(acc2)*(ONE + XNORM) ;; U2
      gconv = GTG LT (acc2^twothird)*FTEST*FTEST  ;; U3
  endelse
  IF ((PCONV AND FCONV AND GCONV) $               ;; U1 + U2 + U3
      OR (GTG LT GTOL2*FTEST*FTEST)) THEN BEGIN   ;; U4
      CONV = 1
  ENDIF ELSE BEGIN
      ;; Convergence failed
      CONV = 0
  ENDELSE

;
; FOR DETAILS, SEE GILL, MURRAY, AND WRIGHT (1981, P. 308) AND
; FLETCHER (1981, P. 116).  THE MULTIPLIER TESTS (HERE, TESTING
; THE SIGN OF THE COMPONENTS OF THE GRADIENT) MAY STILL NEED TO
; MODIFIED TO INCORPORATE TOLERANCES FOR ZERO.
;

CNVTST_DONE:
  ;; From LMQNBC

  IF (CONV) THEN GOTO, CLEANUP
  tnmin_fix, whlpeg, whupeg, g

;
; COMPUTE THE CHANGE IN THE ITERATES AND THE CORRESPONDING CHANGE
; IN THE GRADIENTS
;
  IF NEWCON EQ 0 THEN BEGIN
      LYK = G - LOLDG
      LSK = ALPHA*LPK
;
; SET UP PARAMETERS USED IN UPDATING THE PRECONDITIONING STRATEGY.
;
      YKSK = TOTAL(LYK*LSK)
      LRESET = 0

      IF (ICYCLE EQ NM1 OR DIFNEW LT EPSRED*(FKEEP-FNEW)) THEN LRESET = 1
      IF (LRESET EQ 0) THEN BEGIN
          YRSR = TOTAL(LYR*LSR)
          IF (YRSR LE ZERO) THEN LRESET = 1
      ENDIF
      UPD1 = 0
  ENDIF

;
;      COMPUTE THE NEW SEARCH DIRECTION
;
  ;; TNMIN_90:
  catch_msg = 'calling TNMIN_MODLNP'

  tnmin_modlnp, lpk, lgv, lz1, lv, ldiagb, lemat, $
    x, g, lzk, n, niter, maxit, nmodif, nlincg, upd1, yksk, $
    gsk, yrsr, lreset, fcn, whlpeg, whupeg, accrcy, gtpnew, gnorm, xnorm, $
    xnew

  IF (NEWCON) THEN GOTO, ITER_LOOP
;  IF (NOT LRESET) OR ICYCLE EQ 1 AND n_elements(LSR) GT 0 THEN BEGIN   ;; For testing
  IF (LRESET EQ 0) THEN BEGIN
;
; COMPUTE THE ACCUMULATED STEP AND ITS CORRESPONDING
; GRADIENT DIFFERENCE.
;
      LSR = LSR + LSK
      LYR = LYR + LYK
      ICYCLE = ICYCLE + 1
      goto, ITER_LOOP
  ENDIF

;
; RESET
;
  ;; TNMIN_110:
  IRESET = IRESET + 1
;
; INITIALIZE THE SUM OF ALL THE CHANGES IN X.
;
  LSR = LSK
  LYR = LYK
  FKEEP = FNEW
  ICYCLE = 1L
  goto, ITER_LOOP

;
; ...............END OF MAIN ITERATION.......................
;
  CLEANUP:

  nfev = tnconfig.nfev
  tnfcnargs = 0
  catch, /cancel
  case NWHY of
      -3: begin
          ;; INDEFINITE VALUE
          status = -16L
          if errmsg EQ '' then $
            errmsg = ('ERROR: parameter or function value(s) have become '+$
                      'infinite; check model function for over- '+$
                      'and underflow')
          return, !values.d_nan
      end
      -2: begin
          ;; INTERNAL ERROR IN LINE SEARCH
          status = -18L
          if errmsg EQ '' then $
            errmsg = 'ERROR: Fatal error during line search'
          return, !values.d_nan
      end
      -1: begin
          TERMINATE:
          ;; FATAL TERMINATION
          status = 0L
          if errmsg EQ '' then errmsg = 'ERROR: Invalid inputs'
          return, !values.d_nan
      end
      0: begin
          CONVERGED:
          status = 1L
      end
      2: begin
          ;; MAXIMUM NUMBER of FUNC EVALS or ITERATIONS REACHED
          if maxfun GT 0 AND nfev GT maxfun then begin
              status = -17L
              if errmsg EQ '' then $
                errmsg = ('WARNING: no convergence within maximum '+$
                          'number of function calls')
          endif else begin
              status = 5L
              if errmsg EQ '' then $
                errmsg = ('WARNING: no convergence within maximum '+$
                          'number of iterations')
          endelse
          FNEW = OLDF
      end
      3: begin
          status = -18L
          if errmsg EQ '' then errmsg = 'ERROR: Line search failed to converge'
      end
      4: begin
          ;; ABNORMAL TERMINATION BY USER ROUTINE
          status = iflag
      end
  endcase


  ;; Successful return
  F = FNEW
  xnew(ifree) = x
  if keyword_set(tnconfig.qanytied) then tnmin_tie, xnew, tnconfig.ptied

  return, xnew
end

;+
; NAME:
;   TRANSREAD
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;   Parse a tabular ASCII data file or string array.
;
; CALLING SEQUENCE:
;   TRANSREAD, UNIT, VARi [, FORMAT=FORMAT]  (first usage)
;      or
;   TRANSREAD, UNIT, VARi [, FORMAT=FORMAT], FILENAME=FILENAME  (second usage)
;      or
;   TRANSREAD, STRINGARRAY, VARi [, FORMAT=FORMAT]  (second usage)
;
; DESCRIPTION:
;   TRANSREAD parses an ASCII table into IDL variables, one variable
;   for each column in the table.  The tabular data is not limited to
;   numerical values, and can be processed with an IDL FORMAT
;   expression or with a delimeter character.
;
;   TRANSREAD behaves similarly to READF/READS in that it transfers
;   ASCII input data into IDL variables.  The difference is that
;   TRANSREAD reads more than one row in one pass, and returns data by
;   column.  In a sense, it forms the *transpose* of the typical
;   output from READF or READS (which returns data by row), hence the
;   name TRANSREAD.  [ TRANSREAD can parse up to 20 columns in its
;   current implementation, but that number can be easily increased. ]
;
;   TRANSREAD can optionally be provided with a FORMAT expression to
;   control the transfer of data.  The usage is the same as for
;   READ/READF/READS.  However, you may find that you need to slightly
;   modify your format statements to read properly.  In this
;   implementation, variables are intermediately parsed with READS,
;   which appears from my experimentation to require at least a
;   default length for transfers.
;
;   Hence, you should use:   ..., FORMAT='(D0.0,D0.0,I0)'       ; GOOD
;   instead of:              ..., FORMAT='(D,D,I)'          ; BAD
;
;   As with the standard IDL READ-style commands, you need to supply
;   initial values to your variables before calling TRANSREAD, which
;   are used to determine the type.  Then dimensions of the variable
;   are not important; TRANSREAD will grow the arrays to an
;   appropriate size to accomodate the input.  Lines from the input
;   which do not contain the correct number of columns or do not obey
;   the format statement are ignored.
;
;   TRANSREAD will also flexibly manage typical data files, which may
;   contain blank lines, lines with comments (see COMMENT keyword), or
;   incomplete lines.  These lines are ignored.  It can be programmed
;   to wait for a user-specified "trigger" phrase in the input before
;   beginning or ending processing, which can be useful if for example
;   the input table contains some header lines (see STARTCUE and
;   STOPCUE keywords).  [ The user can also pre-read these lines
;   before calling TRANSREAD. ]  Finally, the total number of lines
;   read can be controlled (see MAXLINES keyword).  TRANSREAD parses
;   until (a) the file ends, (b) the STOPCUE condition is met or (c)
;   the number of lines read reaches MAXLINES.
;
;   TRANSREAD has three possible usages.  In the first, the file must
;   already be open, and TRANSREAD begins reading at the current file
;   position.  In the second usage, a filename is given.  TRANSREAD
;   automatically opens the file, and reads tabular data from the
;   beginning of the file.  Normally the file is then closed, but this
;   can be prevented by using the NOCLOSE keyword.
;
;   In the third usage, a string array is passed instead of a file
;   unit.  Elements from the array are used one-by-one as if they were
;   read from the file.
;
;   Since TRANSREAD is not vectorized, and does a significant amount
;   of processing on a per-line basis, it is probably not optimal to
;   use on very large data files.
;
; INPUTS:
;
;   UNIT - in the first usage, UNIT is an open file unit which
;          contains ASCII tabular data to read.  UNIT must not be a
;          variable which could be mistaken for a string array.
;
;          In the second usage, when FILENAME is specified, then upon
;          return UNIT contains the file unit that TRANSREAD used for
;          reading.  Normally, the UNIT is closed before return, but
;          it can be kept open using the NOCLOSE keyword.  In that
;          case the unit should be closed with FREE_LUN.
;
;   STRINGARRAY - this is the third usage of TRANSREAD.  When a string
;                 array is passed, elements from the array are used as
;                 if they were lines from an input file.  The array
;                 must not be of a numeric type, so it cannot be
;                 mistaken for a file unit.  [ Of course, the string
;                 itself can contain ASCII numeric data. ]
;
; OUTPUTS:
;   VARi - List of named variables to receive columns from the table,
;          one variable for each column.  Upon output each variable
;          will be an array containing the same number of elements,
;          one for each row in the table.  If no rows were
;          successfully parsed, then the variable values are not
;          changed.  Use the COUNT output keyword to determine whether
;          any rows were parsed.
;
;          NOTE: Up to twenty columns may be parsed.  If more columns
;          are desired, then a simple modification must be made to the
;          IDL source code.  To do so, find the beginning of the
;          procdure definition, identified by the words, "pro
;          transread, ..."  and follow the instructions there.
;
; INPUT KEYWORD PARAMETERS:
;   FORMAT - an IDL format expression to be used to transfer *each*
;            row in the table.  If no format as given then the default
;            IDL transfer format is used, based on the types of the
;            input variables.  As mentioned in the description above,
;            a length should be assigned to each format code; a length
;            of zero can be used for numeric types.  Lines from the
;            input which do not contain the correct number of columns
;            or do not obey the format statement are ignored.
;
;   DELIM - A ASCII character string which separates (delimits) each
;           field in each row. This is commonly a comma or space. When
;           the DELIM keyword is used, the FORMAT string does not
;           require lengths for each variable. This allows data
;           entries in the text file to vary from line to line. For
;           example:  
;              TRANSREAD, UNIT, A,B,C, DELIM=',', FORMAT='(A,I,F)', FILENAME='file.csv' 
;           Notice that the format expression does not specify the
;           length of variables A, B, and C. They are separated by ','
;           on each line.  
;
;   COMMENT - A one-character string which designates a "comment" in
;             the input.  Input lines beginning with this character
;             (preceded by optional spaces) are ignored.  FAILCOUNT
;             does not increase.
;             DEFAULT: no comments are recognized.
;
;             NOTE: lines which do not match the format statement are
;             ignored.  Comments are likely to be ignored based on
;             this behavior, even without specifying the COMMENT
;             keyword; however the FAILCOUNT will increase.
;
;   MAXLINES - the maximum number of lines to be read from input.  The
;              count begins *after* any STARTCUE is satisfied (if any)
;              DEFAULT: no maximum is imposed.
;
;   SKIPLINES - the number of lines of input to skip before beginning
;               to parse the table.
;               DEFAULT: no lines are skipped.
;               NOTE: if STARTCUE is also given, then the line count
;               does not start until after the STARTCUE phrase has
;               been encountered.
;
;   STARTCUE - a unique string phrase that triggers the start of
;              parsing.  Lines up to and including the line containing
;              the cue are ignored.  Because each line is checked for
;              this starting cue, it should be unambiguous.
;              DEFAULT: parsing begins immediately.
;
;   STOPCUE - a unique string phrase that triggers the finishing of
;             parsing.  The line including the cue is ignored, and no
;             more reads occur afterward.
;             DEFAULT: no STOPCUE is imposed.
;
;   FILENAME - the presence of this keyword signals the second usage,
;              where TRANSREAD explicitly opens the input file named
;              by the string FILENAME.  Reading begins at the start of
;              the file.
;
;              Normally TRANSREAD will close the input file when it
;              finishes.  This can be prevented by setting the NOCLOSE
;              keyword.
;
;              DEFAULT: input is either an already-opened file passed
;              via the UNIT keyword, or a string array.
;
;   NOCLOSE - if set and if FILENAME is given, then the file is not
;             closed upon return.  The file unit is returned in UNIT,
;             and must be closed by the user via FREE_LUN, UNIT.
;             DEFAULT: any files that TRANSREAD opens are closed.
;
;   DEBUG - set this keyword to enable debugging messages.  Detailed
;           error messages will be printed for each failed line.
;
; OUTPUT KEYWORDS:
;   LINES - the number of lines read, including comments and failed
;           parses.
;
;   COUNT - the number of rows successfully parsed.  Can be zero if
;           accessing the input utterly fails, or if no rows are
;           present.
;
;   FAILCOUNT - the number of rows that could not be parsed
;               successfully.  Comments and blank lines are not
;               included.
;
; EXAMPLES:
;   OPENR, UNIT, 'widgets.dat', /GET_LUN
;   A = '' & B = 0L & C = 0D
;   TRANSREAD, UNIT, A, B, C, COUNT=COUNT, FORMAT='(A10,I0,D0.0)'
;   FREE_LUN, UNIT
;
;   (First usage) Opens widgets.dat and reads three columns.  The
;   first column is a ten-character string, the second an integer, and
;   the third a double precision value.
;
;   A = '' & B = 0L & C = 0D
;   TRANSREAD, UNIT, A, B, C, COUNT=COUNT, FORMAT='(A10,I0,D0.0)', $
;      FILENAME='widgets.dat'
;
;   (Second usage) Achieves the same effect as the first example, but
;   TRANSREAD opens and closes the file automatically.
;
;   SPAWN, 'cat widgets.dat', BUF
;   A = '' & B = 0L & C = 0D
;   TRANSREAD, BUF, A, B, C, COUNT=COUNT, FORMAT='(A10,I0,D0.0)'
;
;   (Third usage) Achieves the same effect as the first two examples,
;   but input is read from the string variable BUF.
;
;   A = '' & B = 0L & C = 0D
;   TRANSREAD, UNIT, A, B, C, DELIM=',', COUNT=COUNT, FORMAT='(A,I,D)', $
;      FILENAME='widgets.dat' 
; 
;   (Fourth usage) Example with DELIM keyword.  Here the delimeter is
;       a comma (DELIM=',').
;
; MODIFICATION HISTORY:
;   Feb 1999, Written, CM
;   Mar 1999, Added SKIPLINES and moved on_ioerror out of loop, CM
;   Jun 2000, Added NOCATCH and DEBUG keyword options, CM
;   Jul 2009, Added DELIM keyword, thanks to Chris Holmes
;
;-
; Copyright (C) 1997-2000, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy and distribute unmodified copies for
; non-commercial purposes, and to modify and use for personal or
; internal use, is granted.  All other rights are reserved.
;-
; NOTE: ADD COLUMNS HERE, as l21, l22, etc.  Remember to end lines
; with a dollar-sign, as "l20" is above.
               skiplines=skiplines, maxlines=maxlines, $
               format=format, comment=comment, nocatch=nocatch, debug=debug, $
               startcue=startcue, stopcue=stopcue, filename=filename, $
               lines=lines, count=count, noclose=noclose, failcount=failcount, $
               delim=delim


  count = 0L               
  if n_params() LE 1 then begin
      message, 'USAGES: TRANSREAD, UNIT, VAR1, VAR2, ...', /info
      message, '        TRANSREAD, UNIT, VAR1, VAR2, ..., FILENAME=FILENAME',$
        /info
      message, '        TRANSREAD, STRINGARRAY, VAR1, VAR2, ...', /info
      return
  endif

  ;; Default parameters
  if n_elements(maxlines) EQ 0 then maxlines = ishft(1L, 31) - 1
  if n_elements(skiplines) EQ 0 then skiplines = 0L
  s = strtrim(lindgen(n_params()-1)+1, 2)
  
  ;; Values are intermediately parsed into a structure.  The structure
  ;; needs to be created once, here, with the correct data types for
  ;; each column.  A special statement is composed explicitly and then
  ;; executed.  The data type of only the *first* element of the input
  ;; array is used.

  structexpr = 'st0 = create_struct('
  for i = 0L, n_params()-2 do begin
      structexpr = structexpr + '"d'+s(i)+'", l'+s(i)+'(0)'
      if i LT n_params()-2 then structexpr = structexpr + ','
  end
  st0 = 0L
  structexpr = structexpr + ')'
  dummy = execute(structexpr)
  st = st0

  ;; Initialize the statistics
  lines = 0L
  count = 0L
  failcount = 0L
  startwaiting = n_elements(startcue) GT 0  ;; If we wait for a STARTCUE
  stopwaiting  = n_elements(stopcue)  GT 0  ;; If we wait for a STOPCUE
  ccheck = n_elements(comment) GT 0
  done = 0

  ;; It saves a *lot* of execution time to avoid the x = [x, newx]
  ;; construction.  I allocate new memory for the "result" array in
  ;; chunks, which saves much time.
  outbuffersize = 0L

  ;; Check for a file unit, not a string array.
  sz = size(unit)
  if n_elements(filename) GT 0 AND sz(sz(0)+1) NE 7 then begin
      on_ioerror, OPEN_ERROR
      openr, unit, filename, /get_lun
      on_ioerror, NULL
      if 0 then begin
          OPEN_ERROR:
          message, 'ERROR: could not open '+filename
          return
      endif
  endif

  ;; If reading from a string buffer
  strread = 0
  if sz(sz(0)+1) EQ 7 then begin
      strread = 1
      xeof = 0
      nstrings = n_elements(unit)
      j = 0L   ;; j is the index into the string buffer
      goto, START_LOOP
  endif

  ;; Check for a valid file unit and that it is readable.  The catch
  ;; expression here is used to trap invalid file handles.
  catch, catcherror
  if catcherror NE 0 then begin
      catch, /cancel
      message, 'ERROR: file unit '+strtrim(unit)+' must be open and readable.'
      return
  end
  xeof = eof(unit)
  if xeof then return
  catch, /cancel

  START_LOOP:
  ;; Set up a catch handler which deals with a conversion error
  catcherror = 0
  if NOT keyword_set(nocatch) then catch, catcherror
  if catcherror NE 0 then begin

      ;; Some errors are worse than others.  If something goes wrong
      ;; during a parse, we can still go on to read more.
      if parsing then begin
          parsing = 0
          watchdog = 0
          failcount = failcount + 1  ;; but we increase the "fail" count

          DEBUG_CHECK:
          if keyword_set(debug) then begin
              print, '**DEBUGGING MESSAGE:  could not parse the following line'
              print, '**   <'+strbuffer(0)+'>'
              print, '**The error message was:'
              print, '**   '+!err_string
              print, '**The parsed variables were as follows:'
              help, /struct, st
              print, '**END OF DEBUGGING MESSAGE'
          endif
      endif
          
      goto, NEXT_LINE
  endif
  on_ioerror, DEBUG_CHECK

  ;; We keep reading until one of the three conditions are satisfied:
  ;; (a) the end of file (or end of string array) is reached; or
  ;; (b) the maximum number of lines is read; or
  ;; (c) the "stop" cue is encountered; or
  ;; (d) an "utter" failure occurs, prevent us from reading more data.

  while NOT xeof AND lines LT maxlines AND NOT done do begin

      ;; The watchdog is here to prevent infinite loops.  Since the
      ;; CATCH handler above causes the loop to restart, we could be
      ;; in trouble.  If at least the read fails, then there is no
      ;; sense in continuing the loop.  See the end of the loop where
      ;; the value of the watchdog is checked. 
      watchdog = 1
      strbuffer = ''

      ;; Either read from the file, or copy from the string array
      if strread then strbuffer = unit(j) else readf, unit, strbuffer
      
      ;; Successful read indicates that the loop can repeat.
      watchdog = 0

      ;; Check for the STARTCUE if needed
      if startwaiting then begin
          if strpos(strbuffer, startcue(0)) GE 0 then startwaiting = 0
          goto, NEXT_LINE
      endif

      ;; line count increases only once the STARTCUE is satisfied.
      lines = lines + 1

      ;; We may need to skip some lines, according to SKIPLINES
      if lines LE skiplines then goto, NEXT_LINE

      ;; Strip out surrounding white space.  Yes, white space should
      ;; not make a difference.
      trimbuffer = strtrim(strbuffer, 2)
      if trimbuffer EQ '' then goto, NEXT_LINE

      ;; Check for the STOPCUE if needed
      if stopwaiting then begin
          if strpos(strbuffer, stopcue(0)) GE 0 then begin
              done = 1
              goto, NEXT_LOOP
          endif
      endif

      ;; Check for a comment character if requested
      if ccheck then if strmid(strbuffer, 0, 1) EQ comment then $
        goto, NEXT_LINE

      ;; Parse data from the input string buffer.  Data is parsed into
      ;; the structure ST for convenience.  The PARSING variable
      ;; indicates to the CATCH handler that an error occurred here.
      st = st0
      parsing = 1
      if n_elements(delim) GT 0 then begin
          tmp = strsplit( strbuffer, delim, /extract, /preserve_null )
          for i = 0L, n_params()-2 do begin
              st.(i)=tmp[i]
          endfor
      endif else begin
          reads, strbuffer, st, format=format
      endelse
      parsing = 0

      ;; Increase the size of the result buffer as needed.  Minimum
      ;; size is 128 elements.  Growth rate doubles until the
      ;; increment exceeds 4096.
      while count GE outbuffersize do begin
          if outbuffersize EQ 0 then outbuffersize = 64L
          outbuffersize = outbuffersize + (outbuffersize < 4096L)
          newresult = make_array(outbuffersize, value=st)
          if n_elements(result) GT 0 then newresult(0) = result
          result = temporary(newresult)
      endwhile
      result(count) = st

      ;; Upon a successful parse, then increase the count.
      count = count + 1

      ;; Update status variables for either the input file or the
      ;; string array.
      NEXT_LINE:
      if strread then begin
          j = j + 1
          xeof = j GE nstrings
      endif else begin
          xeof = eof(unit)
      endelse
      
      NEXT_LOOP:
      ;; Watchdog is checked here to prevent infinite loops, as noted above.
      if watchdog then done = 1
  end

  FINISH:
  on_ioerror, NULL
  catch, /cancel
  ;; Close the file if needed
  if n_elements(filename) GT 0 AND NOT keyword_set(noclose) then begin
      free_lun, unit
  endif

  ;; Finally, extract the elements from the result structure
  if count GT 0 then begin
      result = result(0:count-1)
      for i = 0L, n_params()-2 do begin
          copyexpr = 'l'+s(i)+' = result.('+strtrim(i,2)+')'
          dummy = execute(copyexpr)
      endfor
  end

  return
end
;+
; NAME:
;   TZOFFSET
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   Craig.Markwardt@nasa.gov
;
; PURPOSE:
;   Compute timezone offset from GMT for any date
;
; CALLING SEQUENCE:
;   DT = TZOFFSET(T, [/JULIAN,] [/LOCAL,] [IS_DST=is_dst])
;   DT = TZOFFSET(/NOW)
;
; DESCRIPTION: 
;
;  The function TZOFFSET computes the time zone offset between the
;  local time zone and GMT for any date.
;
;  The time zone offset is defined here as the number of seconds of
;  time West of the Greenwich Meridian.  Equivalently, it is the
;  number of seconds that must be *added* to local time in order to
;  transform it to GMT.
;
;  Here are some examples for different time zones,
;
;       Time zone     TZOFFSET()
;         UTC               0     ;; Britain
;         GMT               0
;         GMT-5        +18000     ;; United States
;         GMT+10       -36000     ;; Australia
;
;  The user may input the date, T, as either seconds elapsed since
;  1970-01-01T00:00:00, or in Julian days (if /JULIAN is set).  The
;  input time may be either expressed in the user's local time zone
;  (if /LOCAL is set) or in UTC.
;
;
; METHODS:
;
;  Since IDL does not provide a way to compute the time zone directly,
;  TZOFFSET uses indirect methods.
;  
;  Essentially, it parses the output of SYSTIME(1) and
;  SYSTIME(1,/UTC), and computes the time difference between the local
;  system and UTC.  There is a search algorithm that finds Summer-time
;  transitions.
;
;  For speed, TZOFFSET() pre-computes time zone offsets and saves them
;  for future use as a table lookup.  On a relatively modern computer
;  in 2009, a century's worth of timezone data can be pre-computed in
;  less than one second.  If the time range of interest is smaller,
;  then the pre-computations will occur more quickly than that.  Once
;  the table has been pre-computed, interpolation of the resulting
;  table is extremely fast.
;
;  The IS_DST output parameter is estimated using a heuristic.
;  Basically, if TZOFFSET() increases, that is considered to be a
;  summer-time transition, and if TZOFFSET() decreases, that is
;  considered a transition to standard time.
;
; CAVEATS:
;
;  The results of TZOFFSET are only as good as your operating system's
;  timezone information.  If your system's timezone tables are
;  incomplete or erroneous, then so will be TZOFFSET's output.
;
;  TZOFFSET computes the timezone offsets for your system's current
;  time-zone.  To compute the offset for another different time zone,
;  you will need to reset your system's notion of the timezone.  On
;  Unix and Mac OS X systems, this can be done by setting the "TZ"
;  environment variable with SETENV.
;
;  For 32-bit Unix systems, timezone tables apparently run out in
;  2038.
;
;  Pre-computed timezone tables document Summer-time transitions to
;  within one second.  Users should avoid calling TZOFFSET() with
;  times exactly on the transition boundaries.
;
;  The IS_DST heuristic may not be perfect.  It is better to rely on
;  the actual timezone offset than to assume that IS_DST means
;  something.
;
; PARAMETERS:
;
;   T - input times, either array or scalar.  The times may be
;       in Julian days (if /JULIAN is set) or in seconds from
;       1970-01-01T00:00:00.  The times should be expressed in
;       the UTC timezone, or the local time zone if /LOCAL is set.
;
;
; RETURNS:
;
;   The resulting timezone offsets.  The return value will
;   have the same number of elements as the input T parameter.
;   See CAVEATS above.
;
; KEYWORD PARAMETERS:
;
;   IS_DST - upon return, IS_DST is set to an array containing a
;            boolean flag for each input time.  If the flag equals 1,
;            the corresponding input time is probably during "summer
;            time."  A flag value of 0 indicates probable
;            standard time.  See CAVEATS above.
;
;   JULIAN - if set, then the input times must be in Julian days.
;            DEFAULT: not set, i.e. input times are in seconds from 1970.
;
;   LOCAL - if set, then the input times must be measured in the local
;           timezone.
;           DEFAULT: not set, i.e. input times are in UTC timezone.
;
;   NOW - if set, then compute the timezone offset at the current
;         moment.  The values of T, JULIAN and LOCAL are ignored.
;
; SEE ALSO:
;
;   SYSTIME
;
; MODIFICATION HISTORY:
;   Written, CM, 14 Sep 2009
;   Documentation typos, CM, 25 Sep 2012
;   Documentation, CM, 2013-09-14
;
;  $Id: tzoffset.pro,v 1.7 2013/09/30 02:04:32 cmarkwar Exp $
;
;-
; Copyright (C) 2009, 2013, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;; ==================================================================
;; Initialize the lookup table with known good state
pro tzoffset_init, tlimits, tgrid, toff
  COMPILE_OPT strictarr
  tutc = systime(1, /julian, /utc)  ;; [day]
  tloc = systime(1, /julian)        ;; [day]

  ;; We round because since the two SYSTIME()'s are called a
  ;; few microseconds apart, they will not correspond to exactly the
  ;; same time, although it will be close.
  toff1 = round((tutc - tloc)*86400d)+0d ;; [sec]

  ;; Table has at least two entries so that the rest of the machinery
  ;; after this works properly, but for initialization purposes it is
  ;; the same value.
  tlimits = [tutc, tutc]   ;; [day]
  tgrid   = tlimits        ;; [day]
  toff    = [toff1, toff1] ;; [sec]

  return
end

;; Convert IDL time-string to YMDhms array
function tzoffset_str2jd, str
  COMPILE_OPT strictarr
  n = n_elements(str)
  monstr = strupcase(strmid(str,4,3)) ;; Month string
  mon = intarr(n)

  ;; Parse month string (I hope it's in English!!!)
  for i = 0L, n-1 do begin
     case monstr[i] of
        'JAN': mon[i] =  1
        'FEB': mon[i] =  2
        'MAR': mon[i] =  3
        'APR': mon[i] =  4
        'MAY': mon[i] =  5
        'JUN': mon[i] =  6
        'JUL': mon[i] =  7
        'AUG': mon[i] =  8
        'SEP': mon[i] =  9
        'OCT': mon[i] = 10
        'NOV': mon[i] = 11
        'DEC': mon[i] = 12
        else: message, 'ERROR: unrecognized month "'+monstr+'"'
     endcase
  endfor

  ;; Year, day are easier to parse because they are numerical
  yr  = fix(strmid(str,20,4))
  day = fix(strmid(str,8,2))

  ;; hour minute seconds
  hr  = fix(strmid(str,11,2))
  mi  = fix(strmid(str,14,2))
  sec = fix(strmid(str,17,2))

  jd = julday(mon, day, yr, hr, mi, sec)
;  print, yr, mon, day, hr, mi, sec, jd, $
;         format='(%"%04d-%02d-%02dT%02d:%02d:%02d = JD%25.6f")'
  return, jd
end

;; Compute the time zone offset for a single requested time
;;   Time T in Julian days
function tzoffset_calc, t
  COMPILE_OPT strictarr
  jd0 = 2440587.5D ;; JD of 1970

  t1 = (t-jd0) * 86400d     ;; [sec] from 1970
  ;; Vectorize for slight speed
  ;; Requested time in UTC ......   Local
  t_str = [ systime(0,t1,/utc), systime(0,t1) ]

  ;; Calendar dates for UTC and local time
  tt   = tzoffset_str2jd(t_str)
  tutc = tt[0]
  tloc = tt[1]

  ;; Compute the (UTC - Local) time and convert from days to seconds
  tzoff = round((tutc - tloc)*86400d)+0d
;  print, 'TZOFF = ', tzoff
  return, tzoff
end

;; ==================================================================
;; Extend the existing table in +TIME direction
;;    TSTOP - Julian day of last requested time (input)
;;    TLIMITS - [START, STOP] of table (input & output)
;;    TGRID - Sample grid of Julian days for known time zone offsets
;;    TOFF - time offset value at TGRID sample points (seconds)
;;    TSTEP - time search increment (days)
;;           (should be a small fraction of a year to capture DST transitions)
pro tzoffset_extendp, tstop, tlimits, tgrid, toff, tstep=tstep
  COMPILE_OPT strictarr

  n = n_elements(tgrid)
  while tstop GE tgrid[n-1] do begin
     tnext = tgrid[n-1] + tstep
     tzoff1 = tzoffset_calc(tnext)

     if tzoff1 NE toff[n-1] then begin
        ;; We found a new transition
        tgrid = [tgrid, tnext]
        toff  = [toff,  tzoff1]
        n = n + 1

        ;; Binary search for actual transition time
        t1 = tgrid[n-2]   & t2 = tgrid[n-1]
        toff1 = toff[n-2] & toff2 = toff[n-1]
        ;; Search to 1 second accuracy ( = 1/86400th of day)
        while t2 GT t1 + 1d/86400d do begin
           tnext = (t1 + t2)/2d ;; midpoint
           tzoffx = tzoffset_calc(tnext)
           if tzoffx EQ toff1 then begin
              t1 = tnext  ;; bracketed transition from left
           endif else begin
              t2 = tnext  ;; .. from right
           endelse
        endwhile

        tgrid[n-1] = t2
     endif else begin
        ;; There was no transition, but we still record that we
        ;; stepped this far while seeing no change in time zone offset

        if toff[n-2] EQ toff[n-1] then begin
           tgrid[n-1] = tnext
        endif else begin
           tgrid = [tgrid, tnext]
           toff  = [toff, tzoff1]
           n = n + 1
        endelse
     endelse
  endwhile

  ;; Update the table limits
  tlimits[1] = tgrid[n-1]
end

;; ==================================================================
;; Extend the existing table in -TIME direction
;;    TSTOP - Julian day of earliest requested time (input)
;;    TLIMITS - [START, STOP] of table (input & output)
;;    TGRID - Sample grid of Julian days for known time zone offsets
;;    TOFF - time offset value at TGRID sample points (seconds)
;;    TSTEP - time search increment (days)
;;           (should be a small fraction of a year to capture DST transitions)
pro tzoffset_extendm, tstop, tlimits, tgrid, toff, tstep=tstep
  COMPILE_OPT strictarr

  n = n_elements(tgrid)
  while tstop LE tgrid[0] do begin
     tnext = tgrid[0] - tstep
     tzoff1 = tzoffset_calc(tnext)

     if tzoff1 NE toff[0] then begin
        ;; We found a new transition
        tgrid = [tnext, tgrid]
        toff  = [tzoff1, toff ]
        n = n + 1

        ;; Binary search for actual transition time
        t1 = tgrid[0]   & t2 = tgrid[1]
        toff1 = toff[0] & toff2 = toff[1]
        ;; Search to 1 second accuracy ( = 1/86400th of day)
        while t2 GT t1 + 1d/86400d do begin
           tnext = (t1 + t2)/2d ;; midpoint
           tzoffx = tzoffset_calc(tnext)
           if tzoffx EQ toff1 then begin
              t1 = tnext  ;; bracketed transition from left
           endif else begin
              t2 = tnext  ;; .. from right
           endelse
        endwhile

        tgrid[1] = t2
     endif else begin
        ;; There was no transition, but we still record that we
        ;; stepped this far while seeing no change in time zone offset

        if toff[0] EQ toff[1] then begin
           tgrid[0] = tnext
        endif else begin
           tgrid = [tnext, tgrid]
           toff  = [tzoff1, toff]
           n = n + 1
        endelse
     endelse

  endwhile

  ;; Update the table limits
  tlimits[0] = tgrid[0]
end

;; ==================================================================
;; Estimate IS_DST based on time zone data
pro tzoffset_dst, tgrid, toff, dst
  COMPILE_OPT strictarr
  if n_elements(toff) EQ 0 then begin
     dst = [0]
     return
  endif

  dst = intarr(n_elements(toff)) - 1
  iprev = 0L
  for i = 1, n_elements(toff)-1 do begin
     if toff[i] EQ toff[i-1] then begin
        dst[i] = dst[iprev]
     endif else if toff[i] GT toff[i-1] then begin
        dst[i] = 0
        iprev = i
     endif else if toff[i] LT toff[i-1] then begin
        dst[i] = 1
        iprev = i
     endif
  endfor
  
  wh = where(dst LT 0, ct)
  if ct EQ 0 then return
  if ct EQ n_elements(dst) then begin
     dst[*] = 0
     return
  endif
  dst[wh] = 1-dst[max(wh)+1]

  return
end

;; ==================================================================
;; Main routine
function tzoffset, tt, julian=julian, now=now, local=local, is_dst=dst, $
                   reset=reset

  COMPILE_OPT strictarr
  common tzoffset, tlimits, tgrid, toff, is_dst

  if keyword_set(reset) then begin
     if n_elements(tlimits) GT 0 then begin
        dummy = temporary(tlimits)
        dummy = temporary(tgrid)
        dummy = temporary(toff)
     endif
     return, !values.d_nan
 endif

 if n_params() EQ 0 AND NOT keyword_set(now) then begin
     message, 'USAGE: OFF = TZOFFSET(T, [/JULIAN,] [/LOCAL])', /INFO
     message, '       OFF = TZOFFSET(/NOW)',                   /INFO
     return, !values.d_nan
 endif

  tstep = 30d  ;; [day] - timezone changes occur less frequently than TSTEP

  ;; If NOW is set, then retrieve the current Julian date in UTC time zone.
  if keyword_set(now) then begin
     tt = systime(1, /julian)
     julian = 1 & local = 0
  endif

  if keyword_set(julian) then begin
     t1 = tt
  endif else begin
     t1 = 2440587.5D + tt/86400d
  endelse

  mint = min(tt, max=maxt)

  ;; --------------
  ;; Initialize look-up table data the first time
  if n_elements(tlimits) EQ 0 then begin
     ;; Initialize the look-up table...
     tzoffset_init, tlimits, tgrid, toff
     ;; ... with at least a year on either side
     tzoffset_extendp, tlimits[1]+365d, tlimits, tgrid, toff, tstep=tstep
     tzoffset_extendm, tlimits[0]-365d, tlimits, tgrid, toff, tstep=tstep
     ;; ... and estimate summer time flag
     tzoffset_dst, tgrid, toff, is_dst
  endif


  ;; --------------
  ;; Extend the range of the look-up table if the input range
  ;; exceeds the table range
  extended = 0
  if mint LE tlimits[0] then begin
     tzoffset_extendm, mint, tlimits, tgrid, toff, tstep=tstep
     extended = 1
  endif
  if maxt GE tlimits[1] then begin
     tzoffset_extendp, maxt, tlimits, tgrid, toff, tstep=tstep
     extended = 1
  endif
  ;; Get DST data for new time grid
  if extended OR n_elements(is_dst) then begin
     tzoffset_dst, tgrid, toff, is_dst
  endif

  ;; --------------
  ;; Here is where we handle the user's specifically requested times
  ;; Find the positions of the requested times T1 in the look-up table
  ;; sample grid.
  ii = value_locate(tgrid, t1)

  ;; Retrieve the values by lookup
  tzoff = toff[ii]
  dst   = is_dst[ii]
  
  ;; Input time is a local time, therefore, do one iteration by adding
  ;; time zone offset and recomputing offset.  This will only change
  ;; things if the requested times are near a DST transition point.
  if keyword_set(local) then $
     return, tzoffset(t1+tzoff/86400d, /julian, is_dst=dst)

  return, tzoff
end
;+
; NAME:
;   UNITIZE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Construct a unit vector from a vector
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   U = UNITIZE(V)
;
; DESCRIPTION:
;
;   The function UNITIZE accepts any vector as input, and returns a
;   unit vector.  The returned vector has the same direction as V but
;   a unit magnitude. (using L2 norm)
;
;   Mostly commonly UNITIZE will be used on 3-vectors.  The input V
;   may either be a single 3-vector (i.e. DBLARR(3)) or it may be an
;   array of N 3-vectors, (i.e. DBLARR(3,N)).  The returned array will
;   have the same structure as V.
;
;   UNITIZE also works on vectors with arbitrary numbers of
;   components.  All that is required is that the vector components be
;   the first dimension of the input array V.
;
; INPUTS:
;
;  V - input array, commonly a 3-vector for a single vector, or a 3xN
;      array for N vectors.  It is also possible to pass any array
;      DBLARR(M,n1,n2,n3,...).
;
;
; RETURNS:
;
;   The resulting unitized vector or vectors.  The output has the same
;   dimension as the input, V.
;
;
; KEYWORD PARAMETERS:
;
;   NONE
;
; EXAMPLE:
;
;   print, unitize([3d,4d,0d])
;     ==> [0.6, 0.8, 0.0]
;
; SEE ALSO
;   UNITVECANG, ANGUNITVEC, CROSSP, QTNORMALIZE
;
; MODIFICATION HISTORY:
;   Written, 1999, CM
;   Converted to more general dimension, 2012-10-02, CM
;   Documented, 2012-10-02, CM
;
;  $Id: unitize.pro,v 1.5 2012/10/02 12:28:47 cmarkwar Exp $
;
;-
; Copyright (C) 1999, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   UNITVECANG
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Convert unit vector to longitude and (co)latitude (RA/Dec)
;
; MAJOR TOPICS:
;   Geometry
;
; CALLING SEQUENCE:
;   LONLAT = UNITVECANG(U, [/DEC])
;
; DESCRIPTION:
;
;   The function UNITVECANG converts a unit vector into two polar
;   angles.
;
;   The input should be one or more unit 3-vector describing points on
;   the unit sphere.  The input is either a 3-vector, or a 3xN array
;   representing N unit vectors (i.e. DBLARR(3,N)).
;
;   The returned array, LONLAT, describes that point in spherical
;   polar coordinates.
;   
;   LONLAT(0,*) is the longitude angle, measured in degrees from +X,
;   with positive angles rotating through +Y.  The range of
;   LONLAT(0,*) is 0 (+X) through 90 (+Y) through 360.
;
;   If DEC=0, LONLAT(1,*) represents a colatitude angle, measured in
;   degrees from +Z.  The range of LONLAT(1,*) is 0 (+Z) through 
;   180 (-Z).
;
;   If DEC=1, LONLAT(1,*) represents a latitude angle ("declination"
;   in astronomy), measured in degrees from the XY equator (positive
;   toward +Z).  The range of LONLAT(1,*) is -90 (-Z) through +90 (+Z).
;
;   The input U may either be a single 3-vector (i.e. DBLARR(3)) or it
;   may be an array of N 3-vectors, (i.e. DBLARR(3,N)).  It is the
;   responsibility of the user for U to be a unit vector.
;
;   ANGUNITVEC and UNITVECANG are functional inverses.
;   ANGUNITVEC(UNITVECANG(U)) should produce the same unit vector(s).

; INPUTS:
;
;  U - input unit vector, either a 3-vector or a 3xN array for N unit
;      vectors.
;
;
; RETURNS:
;
;   The resulting LONLAT array as described above.
;
;
; KEYWORD PARAMETERS:
;
;   DEC - if set, then the returned LONLAT(1,*) component is latitude;
;         if not set then LONLAT(1,*) is a colatitude.
;
; EXAMPLE:
;
;   ; Sample unit vector
;   U = [-9.1103345E-01,3.7439942E-01,1.7275169E-01]
;   print, unitvecang(U)
;     ==> [157.65924,80.052155]
;
; SEE ALSO
;   UNITVECANG, ANGUNITVEC, CROSSP, QTNORMALIZE
;
; MODIFICATION HISTORY:
;   Written, 1999, CM
;   Documented, 2012-10-02, CM
;
;  $Id: unitvecang.pro,v 1.4 2012/10/02 12:28:13 cmarkwar Exp $
;
;-
; Copyright (C) 1999, 2012, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   VALUE_LOCATE
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;
; PURPOSE:
;
;   Locate one or more values in a reference array (IDL LE 5.2 compatibility)
;
; CALLING SEQUENCE:
;
;   INDICES = VALUE_LOCATE(REF, VALUES)
;
; DESCRIPTION: 
;
;   VALUE_LOCATE locates the positions of given values within a
;   reference array.  The reference array need not be regularly
;   spaced.  This is useful for various searching, sorting and
;   interpolation algorithms.
;
;   The reference array should be a monotonically increasing or
;   decreasing list of values which partition the real numbers.  A
;   reference array of NBINS numbers partitions the real number line
;   into NBINS+1 regions, like so:
;
;
; REF:           X[0]         X[1]   X[2] X[3]     X[NBINS-1]
;      <----------|-------------|------|---|----...---|--------------->
; INDICES:  -1           0          1    2       3        NBINS-1
;
;
;   VALUE_LOCATE returns which partition each of the VALUES falls
;   into, according to the figure above.  For example, a value between
;   X[1] and X[2] would return a value of 1.  Values below X[0] return
;   -1, and above X[NBINS-1] return NBINS-1.  Thus, besides the value
;   of -1, the returned INDICES refer to the nearest reference value
;   to the left of the requested value.
;
;   If the reference array is monotonically decreasing then the
;   partitions are numbered starting at -1 from the right instead (and
;   the returned INDICES refer to the nearest reference value to the
;   *right* of the requested value).  If the reference array is
;   neither monotonically increasing or decreasing the results of
;   VALUE_LOCATE are undefined.
;
;   VALUE_LOCATE appears as a built-in funcion in IDL v5.3 and later.
;   This version of VALUE_LOCATE should work under IDL v4 and later,
;   and is intended to provide a portable solution for users who do
;   not have the latest version of IDL.  The algrorithm in this file
;   is slower but not terribly so, than the built-in version.
;
;   Users should be able to place this file in their IDL path safely:
;   under IDL 5.3 and later, the built-in function will take
;   precedence; under IDL 5.2 and earlier, this function will be used.
;
; INPUTS:
;
;   REF - the reference array of monotonically increasing or
;         decreasing values.
;
;   VALUES - a scalar value or array of values to be located in the
;            reference array.
;
;
; KEYWORDS:
;
;   L64 - (ignored) for compatibility with built-in version. 
;
;   NO_CROP - if set, and VALUES is outside of the region between X[0]
;             and X[NBINS-1], then the returned indices may be *less
;             than* -1 or *greater than* NBINS-1.  The user is the
;             responsible for cropping these values appropriately.
;
; RETURNS:
;
;   An array of indices between -1L and NBINS-1.  If VALUES is an
;   array then the returned array will have the same dimensions.
;
;
; EXAMPLE:
;
;   Cast random values into a histogram with bins from 1-10, 10-100,
;   100-1000, and 1000-10,000.
;
;     ;; Make bin edges - this is the ref. array
;     xbins = 10D^dindgen(5)  
;
;     ;; Make some random data that ranges from 1 to 10,000
;     x     = 10D^(randomu(seed,1000)*4)
;
;     ;; Find the bin number of each random value
;     ii    = value_locate(xbins, x)
;
;     ;; Histogram the data
;     hh    = histogram(ii)
;
;
; SEE ALSO:
;
;   VALUE_LOCATE (IDL 5.3 and later), HISTOGRAM, CMHISTOGRAM
;
;
; MODIFICATION HISTORY:
;   Written and documented, 21 Jan 2001
;   Case of XBINS having only one element, CM, 29 Apr 2001
;   Handle case of VALUES exactly hitting REF points, CM, 13 Oct 2001
; 
;  $Id: value_locate.pro,v 1.5 2001/10/13 17:59:34 craigm Exp $
;
;-
; Copyright (C) 2001, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;+
; NAME:
;   XATT_EL
;
; AUTHOR:
;   Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;   craigm@lheamail.gsfc.nasa.gov
;   UPDATED VERSIONs can be found on my WEB PAGE: 
;      http://cow.physics.wisc.edu/~craigm/idl/idl.html
;
; PURPOSE:
;   Compute X-ray attenuation coefficient from NIST tables
;
; MAJOR TOPICS:
;   Physics
;
; CALLING SEQUENCE:
;   MU_RHO = XATT_EL(ELEMENT, ENERGY)
;
; DESCRIPTION:
;
;  This function computes the X-ray mass absorption coefficient for a
;  given element, based on the NIST mass absorption coefficients.
;  These tables are most well sampled for energies between 1 keV and
;  100 MeV.  These coefficients are from the tables at
;
;     http://physics.nist.gov/PhysRefData/XrayMassCoef/cover.html
;
;  The user specifies the atomic elements, either by the atomic symbol
;  (as a character string), or by the atomic number (Z).  Values are
;  interpolated in log-log space.
;
;  For a compound or mixture, the ELEMENT parameter can be an array.
;  The elements are weighted according to the WEIGHTS keyword.  The
;  elements in the compound may be weighted by the relative masses of
;  each element (BY='MASS') or by the relative number of atoms of each
;  element (BY='NUMBER').  In the BY='NUMBER' case, standard atomic
;  masses are used.
;
;  The energy is specified as either a scalar value or an array, and
;  the same number of absorption coefficients are returned.
;
;  The transmission of a medium is then defined by:
;
;     TRANS = EXP(- MU_RHO * RHO * THICKNESS )
;
;  where MU_RHO is the value returned by this function (cm^2/g), RHO
;  is the mass density of the medium (g/cm^3), and THICKNESS is the
;  thickness of the material (cm).
;
;  The data are stored within this function.  The routine should be in
;  the user's path so that the data can be located.
;
;
; INPUTS:
;
;   EL - scalar or vector quantity specifying atomic elements.  Either
;        a string giving the atomic symbol, or an integer giving the
;        atomic number, Z.  A vector indicates a compound/mixture
;        consisting of multiple elements to be combined.
;
;   ENERGY - real scalar or array, gives the energy in keV of the
;            X-ray being absorbed.
;
; KEYWORDS:
;
;   WEIGHTS - an array of weights to be used in combining multiple
;             elements.  Elements should be combined in proportion to
;             their masses or number, according to the 'BY' keyword.
;             Weights are normalized to unity if necessary.
;             Default: equal weight to each element
;
;   BY - indicates how multiple elements weighting factors are to be
;        used.  If BY='WEIGHT' or BY='MASS', the WEIGHTS are assumed
;        to be the proportion of each element by mass.  If BY='NUMBER',
;        the WEIGHTS are assumed to be the number of atoms of each
;        element.  The atomic weight of each element is assumed to be
;        the mean atomic weight, averaged over the natural isotopic
;        abundences (See NIST web page
;        http://physics.nist.gov/PhysRefData/Compositions/).
;        Default: 'WEIGHT'
;
;   ATTENTYPE - type of scattering cross section to compute.  One of
;               the following:
;                   0 = coherent scattering (Thompson)
;                   1 = incoherent scattering (Compton)
;                   2 = photoelectric absorption
;                   3 = pair production by nuclear field
;                   4 = pair production by electron field
;                   5 = total attenuation/scattering cross section
;                   6 = total non-coherent scattering cross section
;               NOTE: ATTENTYPE always overrides the shortcut keywords
;               below.
;               Default: 5 
;
;   COHERENT_SCATTERING   - if set, equivalent to ATTENTYPE=0
;   INCOHERENT_SCATTERING - if set, equivalent to ATTENTYPE=1
;   PHOTOELECTRIC         - if set, equivalent to ATTENTYPE=2
;   PAIR_NUCLEAR          - if set, equivalent to ATTENTYPE=3
;   PAIR_ELECTRON         - if set, equivalent to ATTENTYPE=4
;   TOTAL                 - if set, equivalent to ATTENTYPE=5
;   NO_COHERENT           - if set, equivalent to ATTENTYPE=6
; 
;
; RETURNS:
;
;   MU_RHO - the mass attenuation coefficient, with units of cm^2/g.
;
;
; EXAMPLE:
;
;   MU_RHO = XATT_EL('Al', [20.,30,40])
;
;     compute coefficient for Aluminum at 20, 30 and 40 keV.
;
;   MU_RHO = XATT_EL(47, 60)
;
;     compute coefficient for Silver (Z=47) at 60 keV.
;
;   MU_RHO = XATT_EL(['H','O'], WEIGHTS=[2,1], BY='NUMBER', 60)
;   
;     compute coefficient for water (H2O) at 60 keV.
;
; REFERENCES:
;
;   Hubbell, J.H. and Seltzer, S.M. (2004), 
;     Tables of X-Ray Mass Attenuation Coefficients and Mass
;     Energy-Absorption Coefficients (version 1.4). 
;     [Online] Available: http://physics.nist.gov/xaamdi 
;     National Institute of Standards and Technology, Gaithersburg, MD.
;
;     Originally published as NISTIR 5632, National Institute of
;     Standards and Technology, Gaithersburg, MD (1995).
;
;   Coursey, J. S., Schwab, D. J. and Dragoset, R. A.
;     Atomic Weights and Isotopic Compositions (with Relative Atomic
;       Masses)
;     Web page http://physics.nist.gov/PhysRefData/Compositions/
;     Visited March 2006
;
; SEE ALSO:
;
;
; MODIFICATION HISTORY:
;   Written, 17 Jul 2002, CM
;   Documented, 24 Jul 2002, CM
;   Changed to more robust (?) way to determine path, 24 Jan 2003, CM
;   Use ROUTINE_INFO to determine path, 10 Mar 2003, CM
;   Add ability to process compounds and mixtures, 30 Jun 2005, CM
;   Completely revamp to handle the full XCOM cross section list, 19
;     Jul 2005, CM
;   Add the BY keyword for handling molecules by atomic number instead
;     of weight, 16 May 2006
;   Document difference between coherent/incoherent scattering,
;     2010-11-27, CM
;
;  $Id: xatt_el.pro,v 1.11 2011/04/07 23:33:06 cmarkwar Exp $
;
;-
; Copyright (C) 2002,2003,2005,2006,2010, Craig Markwardt
; This software is provided as is without any warranty whatsoever.
; Permission to use, copy, modify, and distribute modified or
; unmodified copies is granted, provided this copyright and disclaimer
; are included unchanged.
;-
;         1         2         3         4         5         6         7
;123456789012345678901234567890123456789012345678901234567890123456789012345678
; 1    1.000E-03 3.47E-01 5.03E-02 6.82E+00 0.00E+00 0.00E+00 7.21E+00 6.87E+00

  el = round(fix(strmid(ss,1,2)))
  ed = strtrim(strmid(ss,4,2))
  en = float(strmid(ss,7,9))*1000
  if NOT encoded then begin
      mu_cohscat = float(strmid(ss,17,8))
      mu_incscat = float(strmid(ss,26,8))
      mu_photo   = float(strmid(ss,35,8))
      mu_pairnuc = float(strmid(ss,44,8))
      mu_paire   = float(strmid(ss,53,8))
      mu_total   = float(strmid(ss,62,8))
      mu_totxcoh = float(strmid(ss,71,8))
  endif else begin
      mu_cohscat = xatt_el_decode_float(strmid(ss,17,3))
      mu_incscat = xatt_el_decode_float(strmid(ss,20,3))
      mu_photo   = xatt_el_decode_float(strmid(ss,23,3))
      mu_pairnuc = xatt_el_decode_float(strmid(ss,26,3))
      mu_paire   = xatt_el_decode_float(strmid(ss,29,3))
      mu_total   = xatt_el_decode_float(strmid(ss,32,3))
      mu_totxcoh = xatt_el_decode_float(strmid(ss,35,3))
  endelse
  
  mu = transpose([[mu_cohscat],[mu_incscat],[mu_photo],[mu_pairnuc],$
                  [mu_paire],[mu_total],[mu_totxcoh]])

  ind = lonarr(2,max(el)+1)
  for i = 0, max(el) do begin
      ii = where(el EQ i)
      ind(*,i) = [min(ii), max(ii)]
  endfor

  elsym = ['','H', 'He','Li','Be','B','C', 'N', 'O', 'F', 'Ne', 'Na', 'Mg', $
           'Al', 'Si', 'P', 'S', 'Cl', 'Ar', 'K', 'Ca', 'Sc', 'Ti', 'V', $
           'Cr', 'Mn', 'Fe', 'Co', 'Ni', 'Cu', 'Zn', 'Ga', 'Ge', 'As', 'Se', $
           'Br', 'Kr', 'Rb', 'Sr', 'Y', 'Zr', 'Nb', 'Mo', 'Tc', 'Ru', 'Rh', $
           'Pd', 'Ag', 'Cd', 'In', 'Sn', 'Sb', 'Te', 'I', 'Xe', 'Cs', 'Ba']
  elsym = [elsym, $
           'La', 'Ce', 'Pr', 'Nd', 'Pm', 'Sm', 'Eu', 'Gd', 'Tb', 'Dy', 'Ho', $
           'Er', 'Tm', 'Yb', 'Lu', 'Hf', 'Ta', 'W', 'Re', 'Os', 'Ir', 'Pt', $
           'Au', 'Hg', 'Tl', 'Pb', 'Bi', 'Po', 'At', 'Rn', 'Fr', 'Ra', 'Ac', $
           'Th', 'Pa', 'U', 'Np', 'Pu', 'Am']

  ;; Atomic weights and isotopic compositions
  ;; http://physics.nist.gov/PhysRefData/Compositions/
  amass = dblarr(256)
  amass(*) = !values.d_nan

  amass(1)  = 1.00794
  amass(2)  = 4.002602
  amass(3)  = 6.941
  amass(4)  = 9.012182
  amass(5)  = 10.811
  amass(6)  = 12.0107
  amass(7)  = 14.0067
  amass(8)  = 15.9994
  amass(9)  = 18.9984032
  amass(10) = 20.1797
  amass(11) = 22.989770
  amass(12) = 24.3050
  amass(13) = 26.981538
  amass(14) = 28.0855
  amass(15) = 30.973761
  amass(16) = 32.065
  amass(17) = 35.453
  amass(18) = 39.948
  amass(19) = 39.0983
  amass(20) = 40.078
  amass(21) = 44.955910
  amass(22) = 47.867
  amass(23) = 50.9415
  amass(24) = 51.9961
  amass(25) = 54.938049
  amass(26) = 55.845
  amass(27) = 58.933200
  amass(28) = 58.6934
  amass(29) = 63.546
  amass(30) = 65.409
  amass(31) = 69.723
  amass(32) = 72.64
  amass(33) = 74.92160
  amass(34) = 78.96
  amass(35) = 79.904
  amass(36) = 83.798
  amass(37) = 85.4678
  amass(38) = 87.62
  amass(39) = 88.90585
  amass(40) = 91.224
  amass(41) = 92.90638
  amass(42) = 95.94
  amass(44) = 101.07
  amass(45) = 102.90550
  amass(46) = 106.42
  amass(47) = 107.8682
  amass(48) = 112.411
  amass(49) = 114.818
  amass(50) = 118.710
  amass(51) = 121.760
  amass(52) = 127.60
  amass(53) = 126.90447
  amass(54) = 131.293
  amass(55) = 132.90545
  amass(56) = 137.327
  amass(57) = 138.9055
  amass(58) = 140.116
  amass(59) = 140.90765
  amass(60) = 144.24
  amass(62) = 150.36
  amass(63) = 151.964
  amass(64) = 157.25
  amass(65) = 158.92534
  amass(66) = 162.500
  amass(67) = 164.93032
  amass(68) = 167.259
  amass(69) = 168.93421
  amass(70) = 173.04
  amass(71) = 174.967
  amass(72) = 178.49
  amass(73) = 180.9479
  amass(74) = 183.84
  amass(75) = 186.207
  amass(76) = 190.23
  amass(77) = 192.217
  amass(78) = 195.078
  amass(79) = 196.96655
  amass(80) = 200.59
  amass(81) = 204.3833
  amass(82) = 207.2
  amass(83) = 208.98038
  amass(90) = 232.0381
  amass(91) = 231.03588
  amass(92) = 238.02891

  return
end

function xatt_el_value_locate, xbins, x
  nbins = n_elements(xbins)
  sz = size(xbins)

  ;; The values are computed by spline interpolation.  Here is the "y"
  ;; value of the spline, which is just the bin position.
  tp = sz(sz(0)+1)
  if tp EQ 1 OR tp EQ 2 OR tp EQ 12 then begin
      yy = findgen(nbins) - 0.5
      eps = (machar()).eps
  endif else begin
      yy = dindgen(nbins) - 0.5D
      eps = (machar(/double)).eps
  endelse      

  ii = round(spl_interp(xbins, yy, yy*0, x) + eps)
  ii = ii > (-1L) < (nbins-1)

  return, ii
end

pro xatt_el_tabinv, XARR, X, IEFF
  Npoints = N_elements(xarr) & npt= npoints - 1
  ieff = float(xatt_el_value_locate(xarr,x))
  g = where( (ieff LT npt) and (ieff GE 0), Ngood)
  if Ngood GT 0 then begin
      neff = ieff(g)
      diff = x(g) - xarr(neff) + 0.
      ieff(g) = neff +  diff / (xarr(neff+1) - xarr(neff) ) 
  endif
  return
end

pro xatt_el_linterp, Xtab, Ytab, Xint, Yint
  xatt_el_tabinv, xtab, xint, r
  yint = interpolate(ytab, r)
  return
end

function xatt_el, ellist, e, weights=wtlist0, by=by0, $
                  attentype=attentype0, $
                  coherent_scattering=cohscat, $
                  incoherent_scattering=incscat, $
                  photoelectric=photoel, $
                  pair_nuclear=pairnuc, $
                  pair_electron=paire, $
                  total=totatten, no_coherent=totnocoh

  common xatt_el_common, el, en, mu, ind, elsym, amass

  if n_params() EQ 0 then begin
      message, 'USAGE: Single elements', /info
      message, '  MU_RHO = XATT_EL(ELEMENT, ENERGIES)', /info
      message, 'Compounds weighted by number of atoms (example H2O)', /info
      message, '  MU_RHO = XATT_EL(["H","O"], ENERGIES, WEIGHTS=[2,1], BY="NUMBER")', /info
      message, 'Compounds weighted by mass (example H2O)', /info
      message, '  MU_RHO = XATT_EL(["H","O"], ENERGIES, WEIGHTS=[2,16], BY="MASS")', /info
      message, 'ELEMENTS - scalar or array', /info
      message, '         - elemental symbol (string) or atomic number (integer)', /info
      message, 'ENERGIES - scalar or array', /info
      message, '         - energy in keV (float or double)', /info
      message, 'RETURNS: attenuation coefficient', /info
      message, '    TRANSMISSION = EXP(-MU_RHO*THICKNESS*DENSITY)', /info
      return, !values.d_nan
  endif

  if n_elements(el) EQ 0 then xatt_el_parse
  if n_elements(by0) EQ 0 then by = 'WEIGHT' $
  else by = strupcase(strtrim(by0(0),2))

  if by NE 'WEIGHT' AND by NE 'MASS' AND by NE 'NUMBER' then $
    message, 'ERROR: the keyword BY must be one of "WEIGHT" or "NUMBER"'

  if n_elements(attentype0) GT 0 then attentype = round(attentype0(0)) $
  else begin
      if keyword_set(cohscat) then attentype = 0
      if keyword_set(incscat) then attentype = 1
      if keyword_set(photoel) then attentype = 2
      if keyword_set(pairnuc) then attentype = 3
      if keyword_set(paire)   then attentype = 4
      if keyword_set(totatten) then attentype = 5
      if keyword_set(totnocoh) then attentype = 6
      if n_elements(attentype) EQ 0 then attentype = 5  ;; Default TOTAL
  endelse

  sz = size(ellist)
  if n_elements(wtlist0) EQ 0 then begin
      wtlist = dblarr(n_elements(ellist))*0 + 1
  endif else begin
      wtlist = double(wtlist0)
  endelse

  elnum = lonarr(n_elements(ellist))
  if sz(sz(0)+1) NE 7 then begin
      elnum(*) = round(ellist)
  endif else begin
      for i = 0, n_elements(ellist)-1 do begin
          el0 = ellist(i)
          el1 = where(el0 EQ elsym, ct)
          if ct EQ 0 then $
            message, 'ERROR: Element '+el0(0)+' not found'
          elnum(i) = el1(0)
      endfor
  endelse

  if n_elements(wtlist) NE n_elements(ellist) then $
    message, 'ERROR: number of weights does not match number of elements'

  ;; If the user specified the composition by number, then convert to
  ;; a by-weight value by multiplying by the atomic weight for each
  ;; species.
  if by EQ 'NUMBER' then wtlist = wtlist * amass(elnum)

  ;; Normalize the composition weights
  wtlist = wtlist / total(wtlist)

  result = 0
  for i = 0, n_elements(ellist)-1 do begin

      el1 = elnum(i)
      
      en1 = en(ind(0,el1):ind(1,el1))
      mu1 = mu(attentype,ind(0,el1):ind(1,el1))
      mu1 = mu1(*)

      xatt_el_linterp, alog10(en1), alog10(mu1>1e-37), alog10(e), x
      resulti = 10d^x
      wh = where(resulti LT 2e-37, ct)
      if ct GT 0 then resulti(wh) = 0
      
      result = result + resulti * wtlist(i)
  endfor
  
  return, result
end

; ====================================================================
; Here is the cross section data.  It is arranged by element number,
; and then by energy.  The ENCODED table is not encoded for security
; reasons, but rather to make the file smaller in size. See above
; for the encoding strategy.
; ====================================================================
; Column layout
; EL  |ENERGY   |Encoded Data
; EL - atomic number
; ENERGY - energy in MeV
; Encoded data - cross section data
; ====================================================================


;====  START TABLE (ENCODED)
;==== ELEMENT  1
; 1    1.000E-03 CWQECPFbR@@R@@RgARFgR
; 1    1.500E-03 RhQIfPqUR@@R@@RRERAeR
; 1    2.000E-03 BWQAXQfTQ@@R@@RAFRXBQ
; 1    3.000E-03 aUQbHQaXQ@@R@@ReQQSfQ
; 1    4.000E-03 QBQrYQfIP@@R@@RTUQCRQ
; 1    5.000E-03 HAPS@QRcP@@R@@RTIQsIQ
; 1    6.000E-03 UgPcIQQWP@@R@@RDDQCTQ
; 1    8.000E-03 cVPCYQEfO@@R@@RSaQSUQ
; 1    1.000E-02 BVPSXQrRO@@R@@RCeQcQQ
; 1    1.500E-02 QFPcTQvTN@@R@@RsVQcUQ
; 1    2.000E-02 fYOcSQRPN@@R@@RcYQcSQ
; 1    3.000E-02 CBOSTQVGM@@R@@RSWQSTQ
; 1    4.000E-02 qQOCTQbHM@@R@@RCVQCTQ
; 1    5.000E-02 Q@OsDQAFM@@R@@RsFQsDQ
; 1    6.000E-02 gUNcEQeUL@@R@@RcFQcEQ
; 1    8.000E-02 tANCIQR@L@@R@@RCIQCIQ
; 1    1.000E-01 rVNRdQIbK@@R@@RRdQRdQ
; 1    1.500E-01 aCNbUQRPK@@R@@RbUQbUQ
; 1    2.000E-01 VaMBSQiSJ@@R@@RBSQBSQ
; 1    3.000E-01 CGMRAQbTJ@@R@@RRAQRAQ
; 1    4.000E-01 qSMAiQQAJ@@R@@RAiQAiQ
; 1    5.000E-01 QAMqSQUcI@@R@@RqSQqSQ
; 1    6.000E-01 gXLaPQcXI@@R@@RaPQaPQ
; 1    8.000E-01 tBLAPQAfI@@R@@RAPQAPQ
; 1    1.000E+00 rVLaFQQGI@@R@@RaFQaFQ
; 1    1.022E+00 bULaEQQBI@@R@@RaEQaEQ
; 1    1.250E+00 qWLQCQwYHdVL@@RQCQQCQ
; 1    1.500E+00 aCLACQEaHbRM@@RACQACQ
; 1    2.000E+00 VaKxVPsPHAEN@@RxWPxWP
; 1    2.044E+00 fQKhUPSYHQCN@@RhVPhVP
; 1    3.000E+00 CGKFiPRAHCBNBQMVbPVbP
; 1    4.000E+00 qSKuUPAVHT`NIdMEaPEaP
; 1    5.000E+00 QAKTfPQAHVXNQfNEEPEEP
; 1    6.000E+00 gXJtIPIAGX@NCANTPPTPP
; 1    7.000E+00 eTJSdPWUGITNDFNDHPDHP
; 1    8.000E+00 tBJSYPVPGAGOEHNsUPsUP
; 1    9.000E+00 CQJs@PuPGQHOFFNCXPCXP
; 1    1.000E+01 rVJCFPEHGaHOViNcEPcEP
; 1    1.100E+01 bHJBePTXGqGOGgNCGPCGP
; 1    1.200E+01 QbJbWPTGGAUOxQNRaPRaP
; 1    1.300E+01 aTJRRPCbGQSOYPNrWPrWP
; 1    1.400E+01 AQJrHPSSGaQOACObUPbUP
; 1    1.500E+01 aCJbFPcHGaWOQ@ORTPRTP
; 1    1.600E+01 AHJREPCGGqTOQGOBUPBUP
; 1    1.800E+01 XSIQgPrQGAfOaIObHPbHP
; 1    2.000E+01 VaIAbPBRGQgOAQOREPREP
; 1    2.200E+01 uQIaYPRIGBGOQROBDPBDP
; 1    2.400E+01 D`IQXPB@GRFOaROQePQeP
; 1    2.600E+01 DIIAXPAdGbDOqQOAgPAgP
; 1    2.800E+01 SRIAPPqQGrBOA`OAaPAaP
; 1    3.000E+01 CGIqBPQYGrIOAhOqUPqUP
; 1    4.000E+01 qSIAEPQHGbYObBOQTPQTP
; 1    5.000E+01 QAIxWOIRFRcOBYOARPARP
; 1    6.000E+01 gWHWUOGcFSBOrROqDPqDP
; 1    8.000E+01 tAHUfOEeFCROCGOaEPaEP
; 1    1.000E+02 rVHTdOdWFcUOsDOQIPQIP
; 1    1.500E+02 aCHSROS@FDEOCcOQDPQDP
; 1    2.000E+02 V`GrVOrBFtAOTGOQBPQBP
; 1    3.000E+02 CGGQfOQUFdSOdROQBPQBP
; 1    4.000E+02 qSGQSOQFFDcOTaOQCPQCP
; 1    5.000E+02 Q@GaGOiFETfOUBOQDPQDP
; 1    6.000E+02 gWFAIOwQEEFOeHOQDPQDP
; 1    8.000E+02 tAFHXNuXEUIOUQOQEPQEP
; 1    1.000E+03 rVFVhNdSEeGOeWOQFPQFP
; 1    1.500E+03 aCFDgNCHEEPOUaOQHPQHP
; 1    2.000E+03 V`EsWNrAEEWOFEOQIPQIP
; 1    3.000E+03 CGEbRNQTEUTOf@Oa@Pa@P
; 1    4.000E+03 qSEBBNQFEUYOfIOaAPaAP
; 1    5.000E+03 Q@EaVNiEDeQOvEOaAPaAP
; 1    6.000E+03 gWDAPNwQDeSOvIOaBPaBP
; 1    8.000E+03 tADAHNuXDeVOFUOaBPaBP
; 1    1.000E+04 rVDHcMdRDeWOFXOaBPaBP
; 1    1.500E+04 aCDV@MCHDeYOVSOaCPaCP
; 1    2.000E+04 V`CdYMrADuQOVUOaCPaCP
; 1    3.000E+04 CGCcDMQTDuROVXOaCPaCP
; 1    4.000E+04 qSCBXMQFDuROfPOaDPaDP
; 1    5.000E+04 Q@CBBMiDCuSOfQOaDPaDP
; 1    6.000E+04 gWBqQMwPCuSOfROaDPaDP
; 1    8.000E+04 tABqAMuXCuSOfSOaDPaDP
; 1    1.000E+05 rVBAGMdRCuTOfSOaDPaDP
;==== ELEMENT  2
; 2    1.000E-03 sYQABPFDS@@R@@RFHSFDS
; 2    1.500E-03 SUQRCPaTS@@R@@RaXSaTS
; 2    2.000E-03 cEQCYPVPR@@R@@RFfRVTR
; 2    3.000E-03 bSQvFPaXR@@R@@RBARqTR
; 2    4.000E-03 BFQXePvGQ@@R@@RyCQgGQ
; 2    5.000E-03 aRQQ@QCEQ@@R@@RuWQTEQ
; 2    6.000E-03 aHQaFQaUQ@@R@@Rd@QRbQ
; 2    8.000E-03 HSPAWQVHP@@R@@RRcQBIQ
; 2    1.000E-02 UaPQYQRbP@@R@@RBXQAiQ
; 2    1.500E-02 RePqRQwCO@@R@@RBIQA`Q
; 2    2.000E-02 qVPqVQrUO@@R@@RQfQqXQ
; 2    3.000E-02 XHOqUQFgN@@R@@RAdQqVQ
; 2    4.000E-02 dYOqQQRWN@@R@@RqVQqRQ
; 2    5.000E-02 CCOaWQa@N@@R@@RqPQaWQ
; 2    6.000E-02 RAOaSQFQM@@R@@RaUQaSQ
; 2    8.000E-02 QIOQUQBPM@@R@@RQVQQUQ
; 2    1.000E-01 gVNAXQQCM@@R@@RAYQAXQ
; 2    1.500E-01 CQNqCQBhL@@R@@RqDQqCQ
; 2    2.000E-01 QbNaBQQBL@@R@@RaBQaBQ
; 2    3.000E-01 XTMAFQCHK@@R@@RAFQAFQ
; 2    4.000E-01 DaMYSPq@K@@R@@RYSPYSP
; 2    5.000E-01 CHMxPPVgJ@@R@@RxQPxPP
; 2    6.000E-01 RDMHEPtCJ@@R@@RHEPHEP
; 2    8.000E-01 a@MGGPRHJ@@R@@RGHPGGP
; 2    1.000E+00 gYLvFPqFJ@@R@@RvFPvFP
; 2    1.022E+00 wFLfIPaEJ@@R@@RfIPfIP
; 2    1.250E+00 TbLeYPXRItPL@@ReYPeYP
; 2    1.500E+00 CRLUGPfCIbTM@@RUGPUGP
; 2    2.000E+00 QbLDQPSfIAFN@@RDRPDRP
; 2    2.044E+00 AdLtFPCdIQDN@@RtGPtGP
; 2    3.000E+00 XUKCWPbDICDNaAMSPPSPP
; 2    4.000E+00 DaKBiPQUITdNTfMRePReP
; 2    5.000E+00 CHKRPPQIIfSNIhMRXPRXP
; 2    6.000E+00 RDKbAPYWHXENQRNrAPrAP
; 2    7.000E+00 QWKQiPHBHYQNBENR@PR@P
; 2    8.000E+00 a@KAaPV`HAGORVNQdPQdP
; 2    9.000E+00 YPJaVPFEHQIOCENAaPAaP
; 2    1.000E+01 gYJQTPuIHaIOSRNqPPqPP
; 2    1.100E+01 vFJATPDfHqHOSfNaQPaQP
; 2    1.200E+01 uDJqEPDRHAVOtINQTPQTP
; 2    1.300E+01 TUJaGPDEHQTOtXNAWPAWP
; 2    1.400E+01 SbJa@PsTHaROUFNAQPAQP
; 2    1.500E+01 CRJQDPCXHaYOURNqFPqFP
; 2    1.600E+01 C@JAHPcEHqUOEgNqBPqBP
; 2    1.800E+01 rGJYbOBgHAgOVQNaDPaDP
; 2    2.000E+01 QbJYDORWHQhOW@NQHPQHP
; 2    2.200E+01 QYJHYOrBHBHOgTNQCPQCP
; 2    2.400E+01 qDJWdORBHRGOXDNAIPAIP
; 2    2.600E+01 QDJGUOQeHbEOhQNAFPAFP
; 2    2.800E+01 IaIGCOAaHrCOIENACPACP
; 2    3.000E+01 XUIfVOaXHBPOIVNA@PA@P
; 2    4.000E+01 DaIeIOaEHrQOQBOYAOYAO
; 2    5.000E+01 CHIDROYgGRdOaFOhQOhQO
; 2    6.000E+01 RDICaOhHGSBOqGOx@Ox@O
; 2    8.000E+01 a@IC@OVIGCQOQTOWeOWeO
; 2    1.000E+02 gYHBYOTdGcROaXOwXOwXO
; 2    1.500E+02 CRHqWOcHGSfOQaOgUOgUO
; 2    2.000E+02 QbHqIOBVGTHOBGOgSOgSO
; 2    3.000E+02 XTGIfNaTGDSObGOgXOgXO
; 2    4.000E+02 DaGwRNaCGTXOBPOwTOwTO
; 2    5.000E+02 CHGvINI`FdWOBXOwYOwYO
; 2    6.000E+02 RDGEWNXFFtTORUOGdOGdO
; 2    8.000E+02 a@GdGNVBFDdObTOW`OW`O
; 2    1.000E+03 gYFSQNDiFT`OrPOWeOWeO
; 2    1.500E+03 CRFBVNcFFTiOrYOHBOHBO
; 2    2.000E+03 QbFQ`NBUFECOBdOHFOHFO
; 2    3.000E+03 XTEqBNaSFEIOR`OXBOXBO
; 2    4.000E+03 DaEABNaBFUBORcOXEOXEO
; 2    5.000E+03 CHExDMyXEUDOReOXGOXGO
; 2    6.000E+03 RDEGGMXEEUEORgOXHOXHO
; 2    8.000E+03 a@EEUMVAEUFORiOh@Oh@O
; 2    1.000E+04 gYDDUMDiEUGOC@OhBOhBO
; 2    1.500E+04 CRDCGMcFEUIOCAOhCOhCO
; 2    2.000E+04 QbDrFMBTEe@OCBOhDOhDO
; 2    3.000E+04 XTCaSMaSEe@OCCOhEOhEO
; 2    4.000E+04 DaCaEMaBEeAOCDOhFOhFO
; 2    5.000E+04 CHCABMyXDeAOCDOhFOhFO
; 2    6.000E+04 RDChQLXEDeAOCDOhFOhFO
; 2    8.000E+04 a@CfPLVADeAOCEOhGOhGO
; 2    1.000E+05 gYBuGLDiDeAOCEOhGOhGO
;==== ELEMENT  3
; 3    1.000E-03 TAQCHPrCT@@R@@RrDTrCT
; 3    1.500E-03 CRQTWPfSS@@R@@RfWSfSS
; 3    2.000E-03 RbQUSPbWS@@R@@RrQSbXS
; 3    3.000E-03 rBQVaPgER@@R@@RWURwBR
; 3    4.000E-03 QdQXBPBdR@@R@@RSARRbR
; 3    5.000E-03 aTQiBPqFR@@R@@RaRRAVR
; 3    6.000E-03 qIQABQGVQ@@R@@RIhQHYQ
; 3    8.000E-03 AAQQHQBgQ@@R@@REEQDDQ
; 3    1.000E-02 GXPaIQqFQ@@R@@RCPQbUQ
; 3    1.500E-02 DAPASQCXP@@R@@RRHQqWQ
; 3    2.000E-02 BWPAXQqBP@@R@@RAfQaQQ
; 3    3.000E-02 a@PAYQsCO@@R@@RaTQQRQ
; 3    4.000E-02 GAOAWQaEO@@R@@RQUQAXQ
; 3    5.000E-02 TWOATQEgN@@R@@RAYQATQ
; 3    6.000E-02 cAOAPQSFN@@R@@RATQAQQ
; 3    8.000E-02 AcOqDQQIN@@R@@RqFQqDQ
; 3    1.000E-01 QHOaHQeQM@@R@@RaIQaHQ
; 3    1.500E-01 eFNQEQAUM@@R@@RQFQQEQ
; 3    2.000E-01 RfNAFQeRL@@R@@RAFQAFQ
; 3    3.000E-01 qBNi@PQVL@@R@@RiAPi@P
; 3    4.000E-01 GRMhDPfQK@@R@@RhEPhDP
; 3    5.000E-01 tUMWSPSTK@@R@@RWSPWSP
; 3    6.000E-01 s@MVfPb@K@@R@@RVgPVfP
; 3    8.000E-01 AfMVBPQAK@@R@@RVBPVBP
; 3    1.000E+00 QIMUPPFiJ@@R@@RUPPUPP
; 3    1.022E+00 QDMETPVAJ@@R@@RETPETP
; 3    1.250E+00 gPLTbPTEJVBL@@RTbPTbP
; 3    1.500E+00 eHLDWPCBJCSM@@RDXPDXP
; 3    2.000E+00 RgLCbPQbJqGN@@RCcPCcP
; 3    2.044E+00 BdLsWPAfJAXN@@RsXPsXP
; 3    3.000E+00 qBLC@PAHJSdNAEMCDPCDP
; 3    4.000E+00 GSKRPPWPIFQNdIMRWPRWP
; 3    5.000E+00 tUKRFPuQIhPNXTMbFPbFP
; 3    6.000E+00 s@KQaPdQIAFOqANBCPBCP
; 3    7.000E+00 BRKqRPCfIaCOqWNAfPAfP
; 3    8.000E+00 AfKQVPsBIqIObANqRPqRP
; 3    9.000E+00 AWKATPRaIQTObTNaRPaRP
; 3    1.000E+01 QIKqCPRYIaWOCDNQSPQSP
; 3    1.100E+01 IbJaDPrCIqYOCSNAUPAUP
; 3    1.200E+01 hEJQFPRBIQ`OsYNqIPqIP
; 3    1.300E+01 GCJQ@PQeIB@OTDNqDPqDP
; 3    1.400E+01 FFJADPA`IR@ODWNaIPaIP
; 3    1.500E+01 eHJIfOaWIRIOtXNaEPaEP
; 3    1.600E+01 dTJyIOQVIbGOEHNaBPaBP
; 3    1.800E+01 cWJXXOqHIBSOeSNQFPQFP
; 3    2.000E+01 RgJWaOaCIRWOVDNQAPQAP
; 3    2.200E+01 BUJwEOQBIbYOfQNAGPAGP
; 3    2.400E+01 BFJFgOABIBaOGDNADPADP
; 3    2.600E+01 qVJFUOyHHRbOGUNAAPAAP
; 3    2.800E+01 QRJFHOhXHCBOGcNIhOIhO
; 3    3.000E+01 qBJuVOHIHSAOXHNiYOiYO
; 3    4.000E+01 GSITXOFAHCYOiWNICOICO
; 3    5.000E+01 tUICbOtYHsXOAHOhXOhXO
; 3    6.000E+01 s@IcIOShHDAOQHOHXOHXO
; 3    8.000E+01 AfIbPORgHtFOqCOhIOhIO
; 3    1.000E+02 QIIREOrGHdROATOhAOhAO
; 3    1.500E+02 eHHQSOQWHECOaTOhAOhAO
; 3    2.000E+02 RgHa@OQHHeIOqWOhGOhGO
; 3    3.000E+02 qBHXSNGdGeQOQdOHPOHPO
; 3    4.000E+02 GRGfXNEhGE`OBEOXROXRO
; 3    5.000E+02 tUGUSNtPGUcORCOhQOhQO
; 3    6.000E+02 s@GtSNSaGFBORIOhXOhXO
; 3    8.000E+02 AfGsPNRdGVEObGOxYOxYO
; 3    1.000E+03 QIGCDNrEGfCOrCOHgOHgO
; 3    1.500E+03 eHFRBNQVGvEOBROXiOXiO
; 3    2.000E+03 RgFaTNQGGFROBXOIGOIGO
; 3    3.000E+03 qBFQDNGbFVPORTOYEOYEO
; 3    4.000E+03 GREHbMEfFVTORXOiAOiAO
; 3    5.000E+03 tUEgAMdYFVWObPOiDOiDO
; 3    6.000E+03 s@EVBMSaFVYObROiFOiFO
; 3    8.000E+03 AfEtQMRcFfQObTOy@Oy@O
; 3    1.000E+04 QIECeMrEFfRObUOyBOyBO
; 3    1.500E+04 eHDbVMQVFfUObWOyEOyEO
; 3    2.000E+04 RgDBDMQGFfVObYOyFOyFO
; 3    3.000E+04 qBDAQMGbEfWOrPOyHOyHO
; 3    4.000E+04 GRCAHMEfEfXOrPOyIOyIO
; 3    5.000E+04 tUCHaLdYEfXOrQOIPOIPO
; 3    6.000E+04 s@CGULSaEfXOrQOIPOIPO
; 3    8.000E+04 AfCuQLRcEfYOrQOIQOIQO
; 3    1.000E+05 QICdULrEEfYOrROIQOIQO
;==== ELEMENT  4
; 4    1.000E-03 UbQBIPFDT@@R@@RFDTFDT
; 4    1.500E-03 TeQsYPqYT@@R@@RA`TqYT
; 4    2.000E-03 T@QeHPGRS@@R@@RGWSGSS
; 4    3.000E-03 RfQwEPBIS@@R@@RRCSR@S
; 4    4.000E-03 rBQhSPxGR@@R@@RhXRHUR
; 4    5.000E-03 QcQYVPDHR@@R@@RtGRTHR
; 4    6.000E-03 aUQACQbFR@@R@@RRSRrFR
; 4    8.000E-03 aEQQFQHbQ@@R@@RQBRYhQ
; 4    1.000E-02 yUPaFQdCQ@@R@@RFWQEYQ
; 4    1.500E-02 UXPAQQQ@Q@@R@@RCGQRQQ
; 4    2.000E-02 STPAXQdAP@@R@@RbEQQ`Q
; 4    3.000E-02 qWPQQQAHP@@R@@RqYQaRQ
; 4    4.000E-02 AEPAYQDHO@@R@@RaTQQSQ
; 4    5.000E-02 VfOAWQQbO@@R@@RQUQAXQ
; 4    6.000E-02 TbOASQADO@@R@@RAYQATQ
; 4    8.000E-02 BbOqGQSdN@@R@@RAPQqGQ
; 4    1.000E-01 AbOqAQAfN@@R@@RqCQqAQ
; 4    1.500E-01 XINQHQDbM@@R@@RQIQQHQ
; 4    2.000E-01 dRNAHQAhM@@R@@RAIQAHQ
; 4    3.000E-01 BFNITPeCL@@R@@RIVPITP
; 4    4.000E-01 QFNHVPbBL@@R@@RHWPHVP
; 4    5.000E-01 GRMwSPQIL@@R@@RwTPwSP
; 4    6.000E-01 UFMWEPGQK@@R@@RWFPWEP
; 4    8.000E-01 R`MfHPsTK@@R@@RfIPfHP
; 4    1.000E+00 AfMeUPrBK@@R@@ReUPeUP
; 4    1.022E+00 qXMUYPR@K@@R@@RUYPUYP
; 4    1.250E+00 QIMEEPASKHRL@@REEPEEP
; 4    1.500E+00 hELTYPADKtQM@@RdPPdPP
; 4    2.000E+00 dTLSbPVXJAhN@@RSdPSdP
; 4    2.044E+00 DTLCgPvGJBCN@@RCiPCiP
; 4    3.000E+00 BFLCHPsQJEPNAHMSDPSDP
; 4    4.000E+00 QFLRWPRVJxWNDPMbVPbVP
; 4    5.000E+00 GSKbBPQeJQHOxWMrEPrEP
; 4    6.000E+00 UFKQfPQWJAUOqENRBPRBP
; 4    7.000E+00 sYKqVPqBJaYOAbNQePQeP
; 4    8.000E+00 R`KaQPQCJQaObGNAbPAbP
; 4    9.000E+00 bIKAXPY`IR@OrQNqQPqQP
; 4    1.000E+01 AfKqGPHaIbIOSCNaSPaSP
; 4    1.100E+01 QSKaHPWeIBUOSRNQVPQVP
; 4    1.200E+01 aIKa@PgBIbPOS`NQPPQPP
; 4    1.300E+01 Q@KQCPfSIrTOdENATPATP
; 4    1.400E+01 IXJAGPVBIBgOTYNAPPAPP
; 4    1.500E+01 hEJAAPeXIRiOTaNqFPqFP
; 4    1.600E+01 gEJiTOuAISAOeANqCPqCP
; 4    1.800E+01 uSJHaOdXIsBOuXNaGPaGP
; 4    2.000E+01 dTJXCOTIISQOvANaCPaCP
; 4    2.200E+01 CdJWTOsYIcXOvYNQIPQIP
; 4    2.400E+01 cBJGEOCVICdOgCNQFPQFP
; 4    2.600E+01 rUJfROSIISiOgTNQDPQDP
; 4    2.800E+01 rGJfEOReITBOHCNQBPQBP
; 4    3.000E+01 BFJUaOrUIdDOxINQ@PQ@P
; 4    4.000E+01 QFJtPOBDItVOYbNAEPAEP
; 4    5.000E+01 GRISbOaSIUDOQAOABPABP
; 4    6.000E+01 UFIsHOqEIEUOaAOA@PA@P
; 4    8.000E+01 R`IbWOAAIUbOqFOYdOYdO
; 4    1.000E+02 AfIbAOHDHfEOAXOYdOYdO
; 4    1.500E+02 hEHQXOuDHFaOaXOAAPAAP
; 4    2.000E+02 dTHaCOD@HWFOAaOABPABP
; 4    3.000E+02 BFHxUNbVHgPOQhOAEPAEP
; 4    4.000E+02 QFHFfNQiHGfOBIOAFPAFP
; 4    5.000E+02 GRGeXNQYHHDORGOAHPAHP
; 4    6.000E+02 UFGDfNqCHXGObCOAIPAIP
; 4    8.000E+02 R`GC`NYfGxEOrAOQ@PQ@P
; 4    1.000E+03 AfGSBNWgGHWOrGOQBPQBP
; 4    1.500E+03 hEFRHNuAGhTOBVOQCPQCP
; 4    2.000E+03 dTFaYNShGxSORQOQDPQDP
; 4    3.000E+03 BFFQGNbUGHdORWOQEPQEP
; 4    4.000E+03 QFFIFMQiGHiObPOQFPQFP
; 4    5.000E+03 GREGPMQYGXcObSOQFPQFP
; 4    6.000E+03 UFEfHMqCGXfObTOQGPQGP
; 4    8.000E+03 R`EDdMYeFXiObVOQGPQGP
; 4    1.000E+04 AfESeMWfFIAObWOQGPQGP
; 4    1.500E+04 hEDrSMuAFIDObYOQHPQHP
; 4    2.000E+04 dTDR@MShFIFOrPOQHPQHP
; 4    3.000E+04 BFDAUMbUFIGOrQOQHPQHP
; 4    4.000E+04 QFDQAMQiFIIOrROQHPQHP
; 4    5.000E+04 GRCIELQYFIIOrROQHPQHP
; 4    6.000E+04 UFCgULqCFIIOrSOQHPQHP
; 4    8.000E+04 R`CEgLYdEY@OrSOQHPQHP
; 4    1.000E+05 AfCtWLWfEY@OrSOQHPQHP
;==== ELEMENT  5
; 5    1.000E-03 HEQaQPaCU@@R@@RaCUaCU
; 5    1.500E-03 VeQCHPsVT@@R@@RsWTsVT
; 5    2.000E-03 EgQTWPQYT@@R@@RaPTQYT
; 5    3.000E-03 d@QGDPdRS@@R@@RdWSdSS
; 5    4.000E-03 SGQxSPAiS@@R@@RQcSAiS
; 5    5.000E-03 RRQIhPyCR@@R@@RiXRISR
; 5    6.000E-03 BIQAGQeBR@@R@@RUTRuCR
; 5    8.000E-03 QVQa@QBGR@@R@@RrERRIR
; 5    1.000E-02 aCQaIQA@R@@R@@RaERQCR
; 5    1.500E-02 wDPATQbUQ@@R@@RDcQDIQ
; 5    2.000E-02 tWPQQQABQ@@R@@RCAQRTQ
; 5    3.000E-02 BTPQUQbVP@@R@@RBFQAbQ
; 5    4.000E-02 AWPQUQAAP@@R@@RqYQaUQ
; 5    5.000E-02 yYOQRQtYO@@R@@RaVQQWQ
; 5    6.000E-02 VgOAYQbPO@@R@@RQXQQQQ
; 5    8.000E-02 DCOARQIiN@@R@@RAWQASQ
; 5    1.000E-01 bROqFQtPN@@R@@RqIQqFQ
; 5    1.500E-01 QHOaCQaBN@@R@@RaDQaCQ
; 5    2.000E-01 fWNQCQtYM@@R@@RQDQQCQ
; 5    3.000E-01 RhNIcPqDM@@R@@RIfPIcP
; 5    4.000E-01 aXNHbPuPL@@R@@RHdPHbP
; 5    5.000E-01 AGNHEPCFL@@R@@RHGPHFP
; 5    6.000E-01 GVMGUPQ`L@@R@@RGVPGUP
; 5    8.000E-01 d@MVUPYYK@@R@@RVUPVUP
; 5    1.000E+00 bYMEiPUgK@@R@@REiPEiP
; 5    1.022E+00 RWMEcPEUK@@R@@REcPEcP
; 5    1.250E+00 qRMeFPsQKQ@M@@ReGPeGP
; 5    1.500E+00 QIMtXPbYKVEM@@RtYPtYP
; 5    2.000E+00 vRLDHPqPKBVN@@RTAPTAP
; 5    2.044E+00 FSLDCPaUKbUN@@RDFPDFP
; 5    3.000E+00 RhLcAPYXJGDNQBMcHPcHP
; 5    4.000E+00 aXLbXPfPJQDOTYMB`PB`P
; 5    5.000E+00 AGLrAPEBJQSOYDMBXPBXP
; 5    6.000E+00 GVKBEPDDJAiOAPNbEPbEP
; 5    7.000E+00 EXKAdPsHJb@OAiNBHPBHP
; 5    8.000E+00 d@KaWPR`JBXOrGNQdPQdP
; 5    9.000E+00 sBKQTPRUJrTOBbNAdPAdP
; 5    1.000E+01 bYKARPbGJRhOcFNqVPqVP
; 5    1.100E+01 bBKqCPBDJSIOcWNaXPaXP
; 5    1.200E+01 AgKaEPAfJsHODFNaSPaSP
; 5    1.300E+01 QYKQGPqPJSWODSNQXPQXP
; 5    1.400E+01 qGKQAPQWJsTOtXNQSPQSP
; 5    1.500E+01 QIKAEPAVJCiOUANQPPQPP
; 5    1.600E+01 AEKA@PqFJDDOESNAVPAVP
; 5    1.800E+01 hIJYHOa@JtBOFCNAQPAQP
; 5    2.000E+01 vRJHVOAHJTVOVWNqGPqGP
; 5    2.200E+01 UUJGfOySItYOGGNqDPqDP
; 5    2.400E+01 dVJwEOHhITiOWTNqAPqAP
; 5    2.600E+01 SgJV`OXGIUHOWgNaIPaIP
; 5    2.800E+01 CSJVQOWVIuEOxGNaGPaGP
; 5    3.000E+01 RhJVFOGDIUQOxUNaEPaEP
; 5    4.000E+01 aXJT`OeDIVGOACOaAPaAP
; 5    5.000E+01 AGJDIOTGIfVOQFOQIPQIP
; 5    6.000E+01 GVISROCVIGFOaFOQHPQHP
; 5    8.000E+01 d@IrXORXIgUOAROQHPQHP
; 5    1.000E+02 bYIrAOBFIHHOQSOQIPQIP
; 5    1.500E+02 QIIaTOqGIHaOqTOaBPaBP
; 5    2.000E+02 vQHaIOABIiGOAhOaDPaDP
; 5    3.000E+02 RhHYBNFbHIdOBFOaHPaHP
; 5    4.000E+02 aXHWENUAHABPRGOqAPqAP
; 5    5.000E+02 AGHUbNDIHADPbEOqBPqBP
; 5    6.000E+02 GVGEFNCPHAFPrAOqDPqDP
; 5    8.000E+02 d@GSeNRUHAHPrIOqFPqFP
; 5    1.000E+03 bYGcENBDHAIPBUOqGPqGP
; 5    1.500E+03 QIGbGNqFHQBPRTOqIPqIP
; 5    2.000E+03 vQFqVNABHQCPRYOAQPAQP
; 5    3.000E+03 RhFaBNF`GQDPbTOARPARP
; 5    4.000E+03 aXFITMU@GQEPbXOASPASP
; 5    5.000E+03 AGFwQMDHGQEPrPOASPASP
; 5    6.000E+03 GVEVUMCPGQFPrQOASPASP
; 5    8.000E+03 d@EEDMRUGQFPrSOATPATP
; 5    1.000E+04 bYETBMBDGQFPrTOATPATP
; 5    1.500E+04 QIEBdMqFGQGPrVOAUPAUP
; 5    2.000E+04 vQDRIMABGQGPrWOAUPAUP
; 5    3.000E+04 RhDQQMF`FQGPrXOAUPAUP
; 5    4.000E+04 aXDQFMU@FQGPrXOAUPAUP
; 5    5.000E+04 AGDISLDHFQGPrYOAUPAUP
; 5    6.000E+04 GVCWgLCPFQGPrYOAUPAUP
; 5    8.000E+04 d@CVALRUFQGPrYOAUPAUP
; 5    1.000E+05 bYCTgLBDFQHPrYOAVPAVP
;==== ELEMENT  6
; 6    1.000E-03 AHRaFPbAU@@R@@RbAUbAU
; 6    1.500E-03 YYQRQPViT@@R@@RG@TViT
; 6    2.000E-03 xBQCfPCBT@@R@@RCCTCBT
; 6    3.000E-03 VCQFQPXfS@@R@@RICSXgS
; 6    4.000E-03 dPQHUPsRS@@R@@RsXSsSS
; 6    5.000E-03 SYQYePAgS@@R@@RQaSAhS
; 6    6.000E-03 RbQQ@QAES@@R@@RAISAGS
; 6    8.000E-03 R@QaEQdDR@@R@@RTXRtGR
; 6    1.000E-02 aRQqEQBHR@@R@@RrGRbAR
; 6    1.500E-02 yYPQQQUYQ@@R@@RHGQW@Q
; 6    2.000E-02 FXPaPQRHQ@@R@@RDRQsWQ
; 6    3.000E-02 sFPaUQuQP@@R@@RRVQbCQ
; 6    4.000E-02 BEPaUQRIP@@R@@RBHQAgQ
; 6    5.000E-02 qGPaSQADP@@R@@RAgQqSQ
; 6    6.000E-02 IaOaPQeWO@@R@@RqUQaVQ
; 6    8.000E-02 uQOQSQRGO@@R@@RaQQQUQ
; 6    1.000E-01 sROAWQACO@@R@@RQQQAXQ
; 6    1.500E-01 aXOqCQrQN@@R@@RqEQqCQ
; 6    2.000E-01 YTNaBQAFN@@R@@RaCQaBQ
; 6    3.000E-01 dFNAFQRhM@@R@@RAGQAFQ
; 6    4.000E-01 BPNYRPaGM@@R@@RYUPYRP
; 6    5.000E-01 QTNxPPFdL@@R@@RxRPxPP
; 6    6.000E-01 AGNHEPdEL@@R@@RHFPHEP
; 6    8.000E-01 FBMGGPRDL@@R@@RGHPGGP
; 6    1.000E+00 CeMvFPqCL@@R@@RvFPvFP
; 6    1.022E+00 cYMfIPaCL@@R@@Rv@PfIP
; 6    1.250E+00 BWMeYPxEKATM@@ReYPeYP
; 6    1.500E+00 qQMUGPFFKWiM@@RUHPUHP
; 6    2.000E+00 iSLDQPCcKSIN@@RDTPDTP
; 6    2.044E+00 iBLtFPsPKCTN@@RtIPtIP
; 6    3.000E+00 dHLCWPREKYCNaAMSVPSVP
; 6    4.000E+00 BQLBiPAXKAXOTfMCEPCEP
; 6    5.000E+00 QTLRPPQBKQiOIhMrQPrQP
; 6    6.000E+00 AGLbAPICJBTOQRNBWPBWP
; 6    7.000E+00 GfKQiPWVJBeOBENbIPbIP
; 6    8.000E+00 FBKAaPFYJcBORVNREPREP
; 6    9.000E+00 tVKaVPeYJSUOCENBEPBEP
; 6    1.000E+01 CeKQTPEFJCeOSRNQfPQfP
; 6    1.100E+01 SHKATPTUJTCOSfNAiPAiP
; 6    1.200E+01 bXKqEPTDJtHOtHNAcPAcP
; 6    1.300E+01 bHKaGPC`JdROtXNqXPqXP
; 6    1.400E+01 QgKa@PSPJDdOUFNqTPqTP
; 6    1.500E+01 qQKQDPcEJEDOUSNqPPqPP
; 6    1.600E+01 QQKAHPCDJeCOEgNaWPaWP
; 6    1.800E+01 QIKYaObXJUYOVQNaQPaQP
; 6    2.000E+01 iSJYDOBPJU`OGINQXPQXP
; 6    2.200E+01 WfJHYORGJVIOgTNQTPQTP
; 6    2.400E+01 fYJWdOQhJFUOXDNQRPQRP
; 6    2.600E+01 uPJGUOAbJfYOhPNQPPQPP
; 6    2.800E+01 TbJGCOaYJVaOICNAXPAXP
; 6    3.000E+01 dHJfUOQWJWBOITNAWPAWP
; 6    4.000E+01 BQJeIOQGJWfOQBOATPATP
; 6    5.000E+01 QTJDQOiHIXYOaEOASPASP
; 6    6.000E+01 AGJC`OwQIY@OqFOASPASP
; 6    8.000E+01 FBIC@OuVIIfOQROATPATP
; 6    1.000E+02 CeIBYOTYIADPaUOAVPAVP
; 6    1.500E+02 qQIqWOCEIQDPAgOQPPQPP
; 6    2.000E+02 iSHqIObHIa@PBBOQTPQTP
; 6    3.000E+02 dHHIeNQRIaGPb@OQYPQYP
; 6    4.000E+02 BQHwRNQDIqAPrBOaRPaRP
; 6    5.000E+02 QTHvINY@HqDPBPOaTPaTP
; 6    6.000E+02 AGHEWNWXHqFPBVOaVPaVP
; 6    8.000E+02 FBGdGNeXHqIPRUOaYPaYP
; 6    1.000E+03 CeGSQNTUHAQPbQOqPPqPP
; 6    1.500E+03 qQGBUNCCHASPbYOqSPqSP
; 6    2.000E+03 iSFQ`NbGHAUPrTOqTPqTP
; 6    3.000E+03 dHFqBNQQHAWPB`OqVPqVP
; 6    4.000E+03 BQFABNQDHAWPBcOqWPqWP
; 6    5.000E+03 QTFxDMIHGAXPBeOqWPqWP
; 6    6.000E+03 AGFGGMWWGAXPBfOqXPqXP
; 6    8.000E+03 FBEEUMeXGAYPBhOqXPqXP
; 6    1.000E+04 CeEDUMTTGAYPBiOqYPqYP
; 6    1.500E+04 qQECGMCCGQPPRaOqYPqYP
; 6    2.000E+04 iSDrFMbGGQPPRbOqYPqYP
; 6    3.000E+04 dHDaSMQQGQPPRcOA`PA`P
; 6    4.000E+04 BQDaEMQDGQPPRdOA`PA`P
; 6    5.000E+04 QTDABMIHFQPPRdOA`PA`P
; 6    6.000E+04 AGDhQLWWFQPPRdOA`PA`P
; 6    8.000E+04 FBCfPLeXFQPPRdOA`PA`P
; 6    1.000E+05 CeCuGLTTFQQPRdOA`PA`P
;==== ELEMENT  7
; 7    1.000E-03 aIRQ@PsAU@@R@@RsAUsAU
; 7    1.500E-03 QHRbCPAHU@@R@@RAHUAHU
; 7    2.000E-03 AERSQPtVT@@R@@RtWTtVT
; 7    3.000E-03 H@QUhPAUT@@R@@RAVTAUT
; 7    4.000E-03 VAQHBPV@S@@R@@RVGSV@S
; 7    5.000E-03 tWQYWPCIS@@R@@RSDSS@S
; 7    6.000E-03 CdQAGQqVS@@R@@RAaSqWS
; 7    8.000E-03 bYQaCQWGR@@R@@RWVRgIR
; 7    1.000E-02 BCQqCQSTR@@R@@RChRcXR
; 7    1.500E-02 aAQAXQiWQ@@R@@RaDRQBR
; 7    2.000E-02 HDPQWQCaQ@@R@@RVHQuGQ
; 7    3.000E-02 dCPaSQAAQ@@R@@RCGQbTQ
; 7    4.000E-02 RXPaTQSaP@@R@@RbIQBCQ
; 7    5.000E-02 qTPaRQAgP@@R@@RQhQAaQ
; 7    6.000E-02 aEPQYQABP@@R@@RAbQaYQ
; 7    8.000E-02 w@OQSQSbO@@R@@RaTQQWQ
; 7    1.000E-01 tWOAVQAgO@@R@@RQSQAXQ
; 7    1.500E-01 RGOqCQTbN@@R@@RqEQqCQ
; 7    2.000E-01 aCOaBQQdN@@R@@RaCQaBQ
; 7    3.000E-01 UQNAFQEVM@@R@@RAGQAFQ
; 7    4.000E-01 S@NYRPrCM@@R@@RYVPYSP
; 7    5.000E-01 QiNxPPaFM@@R@@RxRPxPP
; 7    6.000E-01 qHNHEPGbL@@R@@RHFPHEP
; 7    8.000E-01 wXMGGPSeL@@R@@RGHPGGP
; 7    1.000E+00 ThMvFPBUL@@R@@RvFPvFP
; 7    1.022E+00 tWMfIPbHL@@R@@Rv@PfIP
; 7    1.250E+00 SIMeYPQTLaYM@@ReYPeYP
; 7    1.500E+00 bAMUGPQBLyFM@@RUHPUHP
; 7    2.000E+00 aEMDQPGFKsSN@@RDUPDUP
; 7    2.044E+00 QIMtFPFdKDBN@@RDPPDPP
; 7    3.000E+00 USLCWPSfKAGOaAMSXPSXP
; 7    4.000E+00 SALR`PrRKqSOTfMCGPCGP
; 7    5.000E+00 QiLRPPBFKrBOIhMrTPrTP
; 7    6.000E+00 qHLbAPaVKBeOQRNRQPRQP
; 7    7.000E+00 ABLQiPqIKsCOBENrDPrDP
; 7    8.000E+00 wYKAaPQIKsUORVNbAPbAP
; 7    9.000E+00 VEKaVPADKTDOCENRAPRAP
; 7    1.000E+01 ThKQTPiGJDYOSRNBBPBBP
; 7    1.100E+01 TBKATPxEJDbOSgNQfPQfP
; 7    1.200E+01 CVKqEPWYJUAOtINQ`PQ`P
; 7    1.300E+01 ReKaGPVfJuHOtYNAePAeP
; 7    1.400E+01 RTKa@PFRJeTOUFNAbPAbP
; 7    1.500E+01 bAKQDPUfJEhOURNqXPqXP
; 7    1.600E+01 QeKAIPUWJV@OEgNqUPqUP
; 7    1.800E+01 QTKYbOTaJVQOVQNqQPqQP
; 7    2.000E+01 aEKYDOtIJFgOGINaWPaWP
; 7    2.200E+01 ACKXPOSgJgAOgTNaUPaUP
; 7    2.400E+01 hUJWdOcSJWQOXCNaSPaSP
; 7    2.600E+01 wGJGVOsDJwYOhPNaQPaQP
; 7    2.800E+01 vEJGCOCIJHDOICNaPPaPP
; 7    3.000E+01 UTJfVOBgJhHOITNQYPQYP
; 7    4.000E+01 SAJeIORDJiFOQAOQWPQWP
; 7    5.000E+01 QiJDROqPJA@PaEOQWPQWP
; 7    6.000E+01 qHJCaOAQJAFPqEOQWPQWP
; 7    8.000E+01 wXIC@OAEJQEPQROaPPaPP
; 7    1.000E+02 ThIBYOHPIaAPaUOaSPaSP
; 7    1.500E+02 bAIqWOUXIqBPAgOaXPaXP
; 7    2.000E+02 aEIqIOTHIqIPBAOqSPqSP
; 7    3.000E+02 USHIfNrXIAWPRIOqYPqYP
; 7    4.000E+02 SAHwRNBHIQRPrAOAcPAcP
; 7    5.000E+02 QiHvINaWIQUPrIOAePAeP
; 7    6.000E+02 qHHEWNqIIQWPBUOAgPAgP
; 7    8.000E+02 wXGdGNADIaPPRSOQ`PQ`P
; 7    1.000E+03 ThGSRNxBHaRPRYOQbPQbP
; 7    1.500E+03 bAGBVNUTHaUPbWOQePQeP
; 7    2.000E+03 aEGQ`NTFHaWPrROQfPQfP
; 7    3.000E+03 USFqBNrWHaYPrWOQhPQhP
; 7    4.000E+03 SAFABNBHHqPPB`OQiPQiP
; 7    5.000E+03 QiFxDMaVHqPPBbOB@PB@P
; 7    6.000E+03 qHFGGMqHHqQPBcOB@PB@P
; 7    8.000E+03 wXEEUMADHqQPBeOBAPBAP
; 7    1.000E+04 ThEDUMxAGqRPBfOBAPBAP
; 7    1.500E+04 bAECGMUTGqRPBhOBAPBAP
; 7    2.000E+04 aEErFMTEGqSPBiOBBPBBP
; 7    3.000E+04 USDaSMrWGqSPR`OBBPBBP
; 7    4.000E+04 SADaEMBHGqSPR`OBBPBBP
; 7    5.000E+04 QiDABMaVGqSPR`OBBPBBP
; 7    6.000E+04 qHDhQLqHGqSPRaOBBPBBP
; 7    8.000E+04 wXCfPLADGqSPRaOBBPBBP
; 7    1.000E+05 ThCuGLxAFqSPRaOBBPBBP
;==== ELEMENT  8
; 8    1.000E-03 QPRXQOTYU@@R@@RTYUTYU
; 8    1.500E-03 qIRqWPQUU@@R@@RQUUQUU
; 8    2.000E-03 aFRBePVdT@@R@@RVeTVdT
; 8    3.000E-03 A@REIPRFT@@R@@RRGTRFT
; 8    4.000E-03 GcQW@PiCS@@R@@RyASiDS
; 8    5.000E-03 VHQxTPtRS@@R@@RtYStSS
; 8    6.000E-03 ThQA@QrQS@@R@@RrWSrRS
; 8    8.000E-03 CUQQHQQBS@@R@@RQFSQCS
; 8    1.000E-02 RVQaIQUWR@@R@@RUeRuPR
; 8    1.500E-02 AYQAUQQTR@@R@@RAdRaYR
; 8    2.000E-02 IiPQTQVBQ@@R@@RhUQgVQ
; 8    3.000E-02 eEPaQQaTQ@@R@@RsXQcEQ
; 8    4.000E-02 cAPaRQvIP@@R@@RRYQbFQ
; 8    5.000E-02 RGPaQQCGP@@R@@RRCQQbQ
; 8    6.000E-02 QVPQXQaXP@@R@@RQaQqUQ
; 8    8.000E-02 YDOQRQVPO@@R@@RaXQQYQ
; 8    1.000E-01 UiOAVQSAO@@R@@RQUQAYQ
; 8    1.500E-01 rSOqCQhCN@@R@@RqFQqCQ
; 8    2.000E-01 QUOaBQcEN@@R@@RaDQaBQ
; 8    3.000E-01 VfNAFQYIM@@R@@RAGQAFQ
; 8    4.000E-01 ScNYRPScM@@R@@RYWPYSP
; 8    5.000E-01 RRNxPPRBM@@R@@RxSPxPP
; 8    6.000E-01 qUNHEPqBM@@R@@RHGPHEP
; 8    8.000E-01 IdMGHPfWL@@R@@RGIPGHP
; 8    1.000E+00 v@MvFPTDL@@R@@RvGPvGP
; 8    1.022E+00 FCMv@PCfL@@R@@Rv@Pv@P
; 8    1.250E+00 DCMeYPbRLQdM@@RuPPeYP
; 8    1.500E+00 B`MUGPQ`LAGN@@RUIPUHP
; 8    2.000E+00 QXMDRPa@LdGN@@RDVPDVP
; 8    2.044E+00 QQMtFPQFLdPN@@RDQPDPP
; 8    3.000E+00 G@LCWPfXKaBOaBMcPPcPP
; 8    4.000E+00 SdLR`PTYKQhOTfMS@PS@P
; 8    5.000E+00 RRLRPPCXKbUOIhMrXPrXP
; 8    6.000E+00 qULbAPB`KcFOQRNRUPRUP
; 8    7.000E+00 aILQiPrDKC`OBENrIPrIP
; 8    8.000E+00 IeKAaPB@KdIORVNbFPbFP
; 8    9.000E+00 wXKaVPqVKtSOCENRGPRGP
; 8    1.000E+01 v@KQTPQVKUCOSRNBIPBIP
; 8    1.100E+01 eAKATPAPKUPOSgNBCPBCP
; 8    1.200E+01 tHKqEPaHKEcOtINQgPQgP
; 8    1.300E+01 sSKaGPQGKVDOtYNQcPQcP
; 8    1.400E+01 cBKa@PAHKFSOUGNQ`PQ`P
; 8    1.500E+01 B`KQDPA@KvPOUSNAgPAgP
; 8    1.600E+01 BVKAIPyFJVfOEgNAdPAdP
; 8    1.800E+01 QeKYbOhEJGSOVQNA`PA`P
; 8    2.000E+01 QXKYEOwHJGdOW@NqWPqWP
; 8    2.200E+01 q@KXPOfXJhBOgTNqUPqUP
; 8    2.400E+01 AIKWdOFIJXWOXCNqSPqSP
; 8    2.600E+01 yCJGVOePJHiOhPNqRPqRP
; 8    2.800E+01 HDJGCOUIJYHOICNqQPqQP
; 8    3.000E+01 G@JfVODcJIUOISNqQPqQP
; 8    4.000E+01 SdJeIOSYJAFPQAOqPPqPP
; 8    5.000E+01 RRJDROBeJQDPaEOqQPqQP
; 8    6.000E+01 qUJCaOrGJaAPqEOqRPqRP
; 8    8.000E+01 IeIC@OqWJqAPQROqVPqVP
; 8    1.000E+02 v@IBYOAQJqHPaTOqYPqYP
; 8    1.500E+02 B`IqWOyFIQPPAfOAgPAgP
; 8    2.000E+02 QXIqIOGAIQXPB@OQbPQbP
; 8    3.000E+02 G@HIfNdVIaWPRHOQiPQiP
; 8    4.000E+02 SdHwRNSPIqRPbIOBCPBCP
; 8    5.000E+02 RRHvINrYIqVPrGOBFPBFP
; 8    6.000E+02 qUHEXNrCIqXPBROBHPBHP
; 8    8.000E+02 IeGdHNqUIAbPRPORAPRAP
; 8    1.000E+03 v@GSRNAPIAdPRUORCPRCP
; 8    1.500E+03 B`GBVNy@HAgPbSORFPRFP
; 8    2.000E+03 QXGQ`NVgHAiPbXORGPRGP
; 8    3.000E+03 G@FqBNdUHQaPrSORIPRIP
; 8    4.000E+03 SdFABNCYHQbPrUOb@Pb@P
; 8    5.000E+03 RRFxDMrYHQbPrWObAPbAP
; 8    6.000E+03 qUFGHMrBHQcPrXObAPbAP
; 8    8.000E+03 IeEEUMqTHQcPB`ObBPbBP
; 8    1.000E+04 v@EDUMqIHQdPBaObBPbBP
; 8    1.500E+04 B`ECHMiIGQdPBbObCPbCP
; 8    2.000E+04 QXErFMVgGQePBcObCPbCP
; 8    3.000E+04 G@DaSMdUGQePBdObCPbCP
; 8    4.000E+04 SdDaEMCYGQePBeObDPbDP
; 8    5.000E+04 RRDABMrYGQePBeObDPbDP
; 8    6.000E+04 qUDhRLrBGQePBeObDPbDP
; 8    8.000E+04 IeCfQLqTGQePBeObDPbDP
; 8    1.000E+05 v@CuGLqIGQePBeObDPbDP
;==== ELEMENT  9
; 9    1.000E-03 aRRFSOeUU@@R@@ReUUeUU
; 9    1.500E-03 QRRqEPQhU@@R@@RQhUQhU
; 9    2.000E-03 APRbAPICT@@R@@RIETICT
; 9    3.000E-03 QERT@PBhT@@R@@RBiTBhT
; 9    4.000E-03 i@QU`PaET@@R@@RaFTaET
; 9    5.000E-03 wGQGVPFSS@@R@@RVQSFTS
; 9    6.000E-03 UhQxVPsRS@@R@@RsYSsSS
; 9    8.000E-03 TDQAFQQUS@@R@@RaPSQVS
; 9    1.000E-02 CFQQHQwXR@@R@@RhARW`R
; 9    1.500E-02 qSQqEQRHR@@R@@RBYRrBR
; 9    2.000E-02 QDQASQxUQ@@R@@RQCRABR
; 9    3.000E-02 FIPQQQrGQ@@R@@RDYQChQ
; 9    4.000E-02 sTPQRQy@P@@R@@RBcQBUQ
; 9    5.000E-02 RSPQQQDXP@@R@@RbAQQfQ
; 9    6.000E-02 AbPAYQBVP@@R@@RQbQqTQ
; 9    8.000E-02 AGPATQYVO@@R@@RaTQQSQ
; 9    1.000E-01 GAOqHQTYO@@R@@RQPQASQ
; 9    1.500E-01 cAOaEQaBO@@R@@Rq@QaGQ
; 9    2.000E-01 AcOQEQDdN@@R@@RQHQQFQ
; 9    3.000E-01 XINAAQqGN@@R@@RABQAAQ
; 9    4.000E-01 dRNIBPEiM@@R@@RIGPICP
; 9    5.000E-01 RfNhDPSHM@@R@@RhGPhDP
; 9    6.000E-01 BFNgSPQhM@@R@@RgUPgSP
; 9    8.000E-01 QFNvPPYiL@@R@@RvRPvQP
; 9    1.000E+00 GRMFCPfAL@@R@@RFDPFCP
; 9    1.022E+00 WAMUgPEaL@@R@@RUgPUgP
; 9    1.250E+00 tUMuIPSdLBFM@@REPPuIP
; 9    1.500E+00 s@MT`PBfLQDN@@RTbPTaP
; 9    2.000E+00 AfMTHPA`LTUN@@RdCPdCP
; 9    2.044E+00 qXMTCPqTLT`N@@RTHPTHP
; 9    3.000E+00 hELcIPA@Lq@OQEMCRPCRP
; 9    4.000E+00 dTLrTPFgKRAOtPMRfPRfP
; 9    5.000E+00 RgLrGPe@KBcOyFMbVPbVP
; 9    6.000E+00 BFLBIPTHKCWOATNBVPBVP
; 9    7.000E+00 QRLAhPCYKDEOQdNrAPrAP
; 9    8.000E+00 QFLqQPRiKTWOBSNRIPRIP
; 9    9.000E+00 YGKQXPbRKEDOBiNRAPRAP
; 9    1.000E+01 GSKAVPrCKEVOsDNBDPBDP
; 9    1.100E+01 VDKqFPR@KEeOsVNQhPQhP
; 9    1.200E+01 UFKaHPQ`KfAOTFNQdPQdP
; 9    1.300E+01 DPKa@PqUKVTOTSNQ`PQ`P
; 9    1.400E+01 sYKQDPaQKFeODiNAgPAgP
; 9    1.500E+01 s@KAHPQPKWDOeDNAePAeP
; 9    1.600E+01 R`KACPAPKGPOUVNAbPAbP
; 9    1.800E+01 bIKIPOaCKW`OVGNqYPqYP
; 9    2.000E+01 AfKhWOQ@KxEOvRNqWPqWP
; 9    2.200E+01 QSKHEOYeJxUOgCNqUPqUP
; 9    2.400E+01 aIKWSOIHJYAOwPNqTPqTP
; 9    2.600E+01 Q@KGGOxEJIUOXDNqSPqSP
; 9    2.800E+01 IWJfWOwSJyVOXUNqSPqSP
; 9    3.000E+01 hEJvAOg@JA@PXcNqSPqSP
; 9    4.000E+01 dTJEAOuDJQBPAEOqSPqSP
; 9    5.000E+01 RgJTIOdEJaAPQHOqUPqUP
; 9    6.000E+01 BFJcQOSSJaHPaHOqWPqWP
; 9    8.000E+01 QFJBdObSJqIPATOAbPAbP
; 9    1.000E+02 GSIrFOR@JAWPQUOAfPAfP
; 9    1.500E+02 s@IaXOqIJQYPqUOQdPQdP
; 9    2.000E+02 AfIqBOADJaWPAiOQiPQiP
; 9    3.000E+02 hEHyDNVeIqVPBEOBFPBFP
; 9    4.000E+02 dTHwBNe@IAbPREORAPRAP
; 9    5.000E+02 RgHFFNTFIAePbBORDPRDP
; 9    6.000E+02 BFHUINCWIAhPbGORFPRFP
; 9    8.000E+02 QFHDENbPIQaPrDORIPRIP
; 9    1.000E+03 GSGsCNBHIQdPrIObAPbAP
; 9    1.500E+03 s@GrCNqHIQgPBVObDPbDP
; 9    2.000E+03 AfGA`NADIQiPRPObEPbEP
; 9    3.000E+03 hEFaENVbHBAPRTObGPbGP
; 9    4.000E+03 dTFiWMUIHBBPRWObHPbHP
; 9    5.000E+03 RgFWaMTEHBBPRXObIPbIP
; 9    6.000E+03 BFFvPMCVHBCPRYObIPbIP
; 9    8.000E+03 QFFUFMRYHBCPbQOr@Pr@P
; 9    1.000E+04 GSEdBMBHHBDPbROr@Pr@P
; 9    1.500E+04 s@ERaMqHHBDPbSOrAPrAP
; 9    2.000E+04 AfEbDMADHBEPbTOrAPrAP
; 9    3.000E+04 hEDQTMVbGBEPbTOrAPrAP
; 9    4.000E+04 dTDQIMUIGBEPbUOrBPrBP
; 9    5.000E+04 RgDiVLTEGBEPbUOrBPrBP
; 9    6.000E+04 BFDXGLCVGBEPbUOrBPrBP
; 9    8.000E+04 QFDfFLRYGBEPbUOrBPrBP
; 9    1.000E+05 GSCEILBHGBEPbUOrBPrBP
;==== ELEMENT  10
;10    1.000E-03 Q`REXOGQU@@R@@RGQUGQU
;10    1.500E-03 A`RQFPbVU@@R@@RbWUbVU
;10    2.000E-03 aXRQcPaDU@@R@@RaDUaDU
;10    3.000E-03 ARRcTPDDT@@R@@RDETDDT
;10    4.000E-03 QFRuFPqWT@@R@@RqXTqWT
;10    5.000E-03 IUQVbPiDS@@R@@RyDSiDS
;10    6.000E-03 wTQhHPuHS@@R@@REWSuIS
;10    8.000E-03 EPQADQbFS@@R@@RrCSbGS
;10    1.000E-02 ShQQHQQES@@R@@Ra@SQFS
;10    1.500E-02 bCQqGQcER@@R@@RcQRsIR
;10    2.000E-02 AVQAWQqAR@@R@@RaQRAVR
;10    3.000E-02 wSPQVQSYQ@@R@@RUbQUEQ
;10    4.000E-02 tVPQXQARQ@@R@@RCWQC@Q
;10    5.000E-02 cBPQWQFgP@@R@@RRXQbFQ
;10    6.000E-02 rAPQUQsYP@@R@@RRFQQcQ
;10    8.000E-02 qFPQPQAXP@@R@@RqXQaTQ
;10    1.000E-01 XeOATQWBO@@R@@RaPQQQQ
;10    1.500E-01 TAOqAQQ`O@@R@@RqGQqCQ
;10    2.000E-01 rDOaAQWWN@@R@@RaDQaAQ
;10    3.000E-01 AEOAEQREN@@R@@RAFQAEQ
;10    4.000E-01 UcNISPiEM@@R@@RYPPITP
;10    5.000E-01 C`NhRPE@M@@R@@RhVPhSP
;10    6.000E-01 bTNWhPSAM@@R@@RHAPWhP
;10    8.000E-01 AYNGAPQWM@@R@@RGCPGAP
;10    1.000E+00 YRMvAPyXL@@R@@RvBPvAP
;10    1.022E+00 YBMfDPYGL@@R@@RfEPfDP
;10    1.250E+00 V@MeTPfCLBQM@@ReUPeTP
;10    1.500E+00 dCMUCPTQLqCN@@RUDPUDP
;10    2.000E+00 rHMtGPBcLu@N@@RDSPDSP
;10    2.044E+00 bHMtBPrTLuQN@@RtHPtHP
;10    3.000E+00 AFMCTPQWLQQOa@MSYPSYP
;10    4.000E+00 UfLBgPAHLBUOTbMSBPSBP
;10    5.000E+00 CaLBXPXFKcIOI`MBbPBbP
;10    6.000E+00 bULRIPVUKDDOQPNbQPbQP
;10    7.000E+00 QeLQgPEWKtPOBCNBVPBVP
;10    8.000E+00 AYLqYPdYKuAORTNrEPrEP
;10    9.000E+00 QHLaUPT@KEeOCCNbFPbFP
;10    1.000E+01 YSKQSPcTKvEOCYNb@Pb@P
;10    1.100E+01 GhKARPcHKF`OScNRDPRDP
;10    1.200E+01 fRKqDPRhKgAOtENR@PR@P
;10    1.300E+01 eTKaFPrSKWYOtTNBFPBFP
;10    1.400E+01 DfKQIPRRKWeOUBNBDPBDP
;10    1.500E+01 dCKQCPrDKhHOEXNBAPBAP
;10    1.600E+01 sRKAHPRHKXYOEbNQiPQiP
;10    1.800E+01 RdKIcOQbKYGOFUNQfPQfP
;10    2.000E+01 rHKIGOqRKiXOGCNQePQeP
;10    2.200E+01 QgKHROQVKAAPWVNQcPQcP
;10    2.400E+01 aUKGgOARKAFPHENQcPQcP
;10    2.600E+01 AQKwIOqAKQ@PXQNQbPQbP
;10    2.800E+01 aBKVgOaAKQCPXcNQbPQbP
;10    3.000E+01 AFKfPOQBKQGPyCNQbPQbP
;10    4.000E+01 UfJeEOxEJq@PQ@OQdPQdP
;10    5.000E+01 CaJtHOfTJAPPaCOQfPQfP
;10    6.000E+01 bUJsWOUQJAYPqDOB@PB@P
;10    8.000E+01 AYJRhOTAJaQPQPOBFPBFP
;10    1.000E+02 YSIBWOcHJqPPaRORAPRAP
;10    1.500E+02 dCIqVORHJAdPAcOb@Pb@P
;10    2.000E+02 rHIqHOaSJQcPQfObGPbGP
;10    3.000E+02 AFIyWNAHJBDPRCOrEPrEP
;10    4.000E+02 UfHgUNXCIR@PbCOrIPrIP
;10    5.000E+02 CaHvDNVPIRCPr@OBSPBSP
;10    6.000E+02 bUHESNEQIRFPrEOBUPBUP
;10    8.000E+02 AYHdDNDFIb@PBROBYPBYP
;10    1.000E+03 YSGCYNcDIbCPBVORQPRQP
;10    1.500E+03 dCGBSNRFIbFPRSORTPRTP
;10    2.000E+03 rHGAhNaRIbHPRWORVPRVP
;10    3.000E+03 AFGqANAHIr@PbQORXPRXP
;10    4.000E+03 UfFAANX@HrAPbTORYPRYP
;10    5.000E+03 CaFhGMFXHrBPbUORYPRYP
;10    6.000E+03 bUFGAMEPHrCPbVObPPbPP
;10    8.000E+03 AYFEPMDEHrCPbXObPPbPP
;10    1.000E+04 YSEDQMcDHrDPbXObQPbQP
;10    1.500E+04 dCECEMRFHrDPrPObQPbQP
;10    2.000E+04 rHErDMaRHrDPrPObRPbRP
;10    3.000E+04 AFEaRMAHHrEPrQObRPbRP
;10    4.000E+04 UfDaDMX@GrEPrQObRPbRP
;10    5.000E+04 CaDAAMFXGrEPrRObRPbRP
;10    6.000E+04 bUDXTLEPGrEPrRObRPbRP
;10    8.000E+04 AYDVULDEGrEPrRObSPbSP
;10    1.000E+05 YSCuCLcDGrEPrRObSPbSP
;==== ELEMENT  11
;11    1.000E-03 QbRaGPVRT@@R@@RVTTVRT
;11    1.035E-03 QaRqCPUdT@@R@@RUfTUdT
;11    1.072E-03 Q`RqHPEQT@@R@@RESTEQT
;11 K  1.072E-03 Q`RqHPFSU@@R@@RFTUFSU
;11    1.500E-03 qWRQiPSIU@@R@@RSIUSIU
;11    2.000E-03 aTRbTPQRU@@R@@RQRUQRU
;11    3.000E-03 APRSePEFT@@R@@REGTEFT
;11    4.000E-03 QIReHPbET@@R@@RbFTbET
;11    5.000E-03 YcQVVPQHT@@R@@RQITQHT
;11    6.000E-03 xAQwRPVdS@@R@@RGCSVeS
;11    8.000E-03 UcQiRPReS@@R@@RCBSRfS
;11    1.000E-02 DQQQ@QQPS@@R@@RQVSQQS
;11    1.500E-02 BWQq@QtBR@@R@@RdYRDUR
;11    2.000E-02 aQQAPQqVR@@R@@RBFRQ`R
;11    3.000E-02 hPPAXQDeQ@@R@@Rg@QvDQ
;11    4.000E-02 uCPQQQQcQ@@R@@RSgQCTQ
;11    5.000E-02 cQPQQQyGP@@R@@RB`QBTQ
;11    6.000E-02 bPPAYQUIP@@R@@RbGQBAQ
;11    8.000E-02 QSPATQBCP@@R@@RA`QaTQ
;11    1.000E-01 AAPqIQIcO@@R@@RQYQAXQ
;11    1.500E-01 dTOaFQbTO@@R@@RqDQaIQ
;11    2.000E-01 bUOQFQAEO@@R@@Ra@QQGQ
;11    3.000E-01 QIOAAQC@N@@R@@RACQABQ
;11    4.000E-01 vSNYAPaIN@@R@@RYIPYBP
;11    5.000E-01 tANxBPViM@@R@@RxGPxCP
;11    6.000E-01 C@NwPPtFM@@R@@RwTPwQP
;11    8.000E-01 aYNvWPb@M@@R@@RvYPvWP
;11    1.000E+00 AHNFIPqGM@@R@@RV@PFIP
;11    1.022E+00 ADNFBPaIM@@R@@RFCPFBP
;11    1.250E+00 VbMETPxSLRYM@@REUPEUP
;11    1.500E+00 DaMTePvCLARN@@RTgPTfP
;11    2.000E+00 rQMdBPSfLeTN@@RdHPdHP
;11    2.044E+00 RYMTGPCcLFHN@@RdCPdCP
;11    3.000E+00 a@MsBPb@LaQOQFMCYPCYP
;11    4.000E+00 vVLrWPQPLbPOtUMCDPCDP
;11    5.000E+00 tCLrIPQDLCYOIVMrUPrUP
;11    6.000E+00 CALRBPYCKdIOAUNRVPRVP
;11    7.000E+00 bALQ`PgRKTiOQfNBRPBRP
;11    8.000E+00 aYLqSPVSKeSOBUNrBPrBP
;11    9.000E+00 qDLQYPuQKfAORbNbDPbDP
;11    1.000E+01 AHLAWPEGKvSOsGNRHPRHP
;11    1.100E+01 XeKqGPTWKgAOC`NRCPRCP
;11    1.200E+01 WRKaIPTEKgUOd@NR@PR@P
;11    1.300E+01 FPKaAPC`KHEOTXNBGPBGP
;11    1.400E+01 URKQEPSPKHSOTdNBDPBDP
;11    1.500E+01 DaKAIPcEKxYOeINBBPBBP
;11    1.600E+01 dCKADPCDKYBOeQNBAPBAP
;11    1.800E+01 sDKYPObWKyROfBNQhPQhP
;11    2.000E+01 rQKxVOrIKACPvXNQgPQgP
;11    2.200E+01 bDKXCORFKAHPw@NQfPQfP
;11    2.400E+01 AhKgPOQgKQBPwWNQfPQfP
;11    2.600E+01 aPKWDOAaKQFPhANQfPQfP
;11    2.800E+01 qHKvSOaXKa@PhRNQfPQfP
;11    3.000E+01 a@KvHOQVKaCPIANQfPQfP
;11    4.000E+01 vVJEGOQFKqHPAFOQiPQiP
;11    5.000E+01 tCJdCOiCJAYPQIOBCPBCP
;11    6.000E+01 CAJcTOgVJQWPaIOBGPBGP
;11    8.000E+01 aYJBgOuRJqPPATORCPRCP
;11    1.000E+02 AHJrHOTVJA`PQVORIPRIP
;11    1.500E+02 DaIqPOCCJQePqVObIPbIP
;11    2.000E+02 rQIqCObFJBDPAhOrFPrFP
;11    3.000E+02 a@IITNQQJREPBDOBUPBUP
;11    4.000E+02 vVHwINQCJbAPRDORPPRPP
;11    5.000E+02 tCHVBNIBIbEPb@ORSPRSP
;11    6.000E+02 CAHeDNWRIbHPbEORVPRVP
;11    8.000E+02 aYHDINeSIrBPrBORYPRYP
;11    1.000E+03 AHHsGNTQIrEPrGObRPbRP
;11    1.500E+03 DaGrENC@IrHPBTObUPbUP
;11    2.000E+03 rQGAbNbEIBPPBXObWPbWP
;11    3.000E+03 a@GaGNQPIBSPRSObYPbYP
;11    4.000E+03 vVFyWMQCIBTPRUOrPPrPP
;11    5.000E+03 tCFWhMIAHBUPRWOrQPrQP
;11    6.000E+03 CAFvWMWPHBUPRXOrRPrRP
;11    8.000E+03 aYFeBMeSHBVPbPOrRPrRP
;11    1.000E+04 AHFdFMTPHBVPbQOrSPrSP
;11    1.500E+04 DaERdMC@HBWPbROrSPrSP
;11    2.000E+04 rQEbFMbEHBWPbSOrTPrTP
;11    3.000E+04 a@EQVMQPHBXPbTOrTPrTP
;11    4.000E+04 vVDa@MQCHBXPbTOrTPrTP
;11    5.000E+04 tCDyULI@GBXPbTOrTPrTP
;11    6.000E+04 CADhELWPGBXPbTOrTPrTP
;11    8.000E+04 aYDvBLeSGBXPbUOrUPrUP
;11    1.000E+05 AHDUDLTPGBXPbUOrUPrUP
;==== ELEMENT  12
;12    1.000E-03 RERQTPi@T@@R@@RiBTi@T
;12    1.142E-03 BIRAdPFTT@@R@@RFVTFTT
;12    1.305E-03 BCRRGPTQT@@R@@RTSTTQT
;12 K  1.305E-03 BCRRGPETU@@R@@RETUETU
;12    1.500E-03 QfRRSPD@U@@R@@RD@UD@U
;12    2.000E-03 qXRsAPQcU@@R@@RQcUQcU
;12    3.000E-03 QPRTVPVWT@@R@@RVXTVWT
;12    4.000E-03 aHRuSPRfT@@R@@RRgTRfT
;12    5.000E-03 AIRFdPQWT@@R@@RQXTQWT
;12    6.000E-03 y@QGiPiHS@@R@@RyHSiIS
;12    8.000E-03 F`QiXPShS@@R@@RDFSSiS
;12    1.000E-02 UBQQAQBDS@@R@@RRASBES
;12    1.500E-02 BhQqBQUdR@@R@@RvFRFGR
;12    2.000E-02 AhQARQBSR@@R@@RrVRRXR
;12    3.000E-02 A@QQRQvXQ@@R@@Ry@Qx@Q
;12    4.000E-02 fFPQTQrQQ@@R@@RDhQdEQ
;12    5.000E-02 dEPQTQqBQ@@R@@RcIQBgQ
;12    6.000E-02 CGPQSQwEP@@R@@RRWQbFQ
;12    8.000E-02 AbPAXQBiP@@R@@RQeQqWQ
;12    1.000E-01 a@PASQAPP@@R@@RaYQQWQ
;12    1.500E-01 UROq@QsYO@@R@@RqIQqDQ
;12    2.000E-01 SFOa@QQQO@@R@@RaDQaAQ
;12    3.000E-01 AROAEQtCN@@R@@RAFQAEQ
;12    4.000E-01 HCNyIPAgN@@R@@RIYPIQP
;12    5.000E-01 UENXYPAAN@@R@@RhUPhPP
;12    6.000E-01 SXNWePvBM@@R@@RWiPWeP
;12    8.000E-01 BBNVhPSIM@@R@@RGAPViP
;12    1.000E+00 aINfHPQhM@@R@@Rv@PfHP
;12    1.022E+00 aDNfAPAgM@@R@@RfCPfBP
;12    1.250E+00 hGMeRPaGMRdM@@ReSPeRP
;12    1.500E+00 uTMUAPYHLaQN@@RUCPUBP
;12    2.000E+00 cCMtFPuTLvGN@@RDSPDRP
;12    2.044E+00 CIMt@PUULFfN@@RtHPtGP
;12    3.000E+00 ATMCSPSHLAaOa@McQPcQP
;12    4.000E+00 HHLBfPRGLRcOT`MSFPSFP
;12    5.000E+00 UGLBWPaTLScOyVMBgPBgP
;12    6.000E+00 SYLRHPqBLDbOQPNbXPbXP
;12    7.000E+00 bTLQfPQ@LeROBBNRTPRTP
;12    8.000E+00 BBLqYPIQKvDORSNBUPBTP
;12    9.000E+00 aPLaTPhCKVhOCANrGPrGP
;12    1.000E+01 aILQRPwAKWWOCXNrAPrAP
;12    1.100E+01 AGLARPVWKXAOSaNbGPbGP
;12    1.200E+01 XhKqCPUgKhPOtCNbCPbCP
;12    1.300E+01 gUKaEPEWKIFOtRNbAPbAP
;12    1.400E+01 fPKQIPEDKIXOU@NRHPRHP
;12    1.500E+01 uUKQCPdXKIhOEUNRGPRGP
;12    1.600E+01 EEKAGPtGKABPuYNREPREP
;12    1.800E+01 SiKI`OCeKAIPFRNRDPRDP
;12    2.000E+01 cCKIDOCTKQEPViNRCPRCP
;12    2.200E+01 bWKxIOSAKaAPWRNRBPRBP
;12    2.400E+01 bDKGdOBdKaFPHANRBPRBP
;12    2.600E+01 QaKwFObQKqAPHWNRCPRCP
;12    2.800E+01 aUKVeOBQKqEPHiNRCPRCP
;12    3.000E+01 ATKVXObEKqIPiHNRDPRDP
;12    4.000E+01 HHJeCOaWKQUPAIORHPRHP
;12    5.000E+01 UGJtFOqCKaWPaBObCPbCP
;12    6.000E+01 SYJsVOQ@KqWPqCObGPbGP
;12    8.000E+01 BBJRgOhAJQaPAYOrFPrFP
;12    1.000E+02 aIJBVOVUJBAPaPOBRPBRP
;12    1.500E+02 uUIqUOtEJRHPA`ORTPRTP
;12    2.000E+02 cCIqGOcEJbHPQcObQPbQP
;12    3.000E+02 ATIyTNRFJBPPR@OrQPrQP
;12    4.000E+02 HHHgSNaRJBWPb@OrWPrWP
;12    5.000E+02 UGHvANq@JRRPbGOBaPBaP
;12    6.000E+02 SYHEQNAHJRUPrBOBdPBdP
;12    8.000E+02 BBHdBNHIIbPPrIOBhPBhP
;12    1.000E+03 aIHCWNFWIbRPBTOR`PR`P
;12    1.500E+03 uUGBSNtAIbWPRQORdPRdP
;12    2.000E+03 cCGAhNcDIbYPRVORgPRgP
;12    3.000E+03 ATGqANRFIrRPbQORiPRiP
;12    4.000E+03 HHFAANaRIrSPbTOC@PC@P
;12    5.000E+03 UGFhDMaIIrTPbUOCAPCAP
;12    6.000E+03 SYFViMAHIrTPbWOCBPCBP
;12    8.000E+03 BBFuHMHHHrUPbXOCCPCCP
;12    1.000E+04 aIFDPMFWHrVPbYOCCPCCP
;12    1.500E+04 uUECDMtAHrVPrQOCDPCDP
;12    2.000E+04 cCErDMcCHrWPrROCDPCDP
;12    3.000E+04 ATEaQMRFHrWPrROCDPCDP
;12    4.000E+04 HHDaDMaRHrWPrSOCEPCEP
;12    5.000E+04 UGDAAMaIHrXPrSOCEPCEP
;12    6.000E+04 SYDXQLAHHrXPrTOCEPCEP
;12    8.000E+04 BBDVSLHHGrXPrTOCEPCEP
;12    1.000E+05 aIDuALFWGrXPrTOCEPCEP
;==== ELEMENT  13
;13    1.000E-03 bFRASPQHU@@R@@RQIUQHU
;13    1.500E-03 BDRBXPD@T@@R@@RDBTD@T
;13    1.560E-03 BARRYPcPT@@R@@RcRTcPT
;13 K  1.560E-03 BARRYPSfU@@R@@RSfUSfU
;13    2.000E-03 AdRsGPbFU@@R@@RbFUbFU
;13    3.000E-03 QRRtSPGgT@@R@@RGhTGgT
;13    4.000E-03 q@REaPSYT@@R@@RcPTSYT
;13    5.000E-03 QBRvYPQbT@@R@@RQcTQbT
;13    6.000E-03 iTQwPPQDT@@R@@RQETQDT
;13    8.000E-03 gCQiIPTeS@@R@@RECSTfS
;13    1.000E-02 UQQAFQRVS@@R@@RbRSRWS
;13    1.500E-02 SDQaGQWQR@@R@@RWfRgTR
;13    2.000E-02 BEQqGQS@R@@R@@RCTRcDR
;13    3.000E-02 Q@QAVQxRQ@@R@@RQCRABR
;13    4.000E-02 FfPAYQSPQ@@R@@ReXQE@Q
;13    5.000E-02 dXPQPQqRQ@@R@@RcXQcAQ
;13    6.000E-02 sIPAXQYVP@@R@@RrXQBTQ
;13    8.000E-02 B@PATQsXP@@R@@RBBQAbQ
;13    1.000E-01 qBPqIQAdP@@R@@RqPQQWQ
;13    1.500E-01 VBOaGQTiO@@R@@RqHQqBQ
;13    2.000E-01 SPOQGQB@O@@R@@RaBQQIQ
;13    3.000E-01 QXOABQuTN@@R@@RADQACQ
;13    4.000E-01 XcNYFPBXN@@R@@RiHPYIP
;13    5.000E-01 uSNxGPqDN@@R@@RHUPxIP
;13    6.000E-01 SiNwUPHPM@@R@@RG`PwVP
;13    8.000E-01 bENFaPdEM@@R@@RFdPFbP
;13    1.000E+00 ATNVCPbTM@@R@@RVEPVCP
;13    1.022E+00 qHNFFPBYM@@R@@RFHPFGP
;13    1.250E+00 iAMEXPaYMSCM@@RUPPEYP
;13    1.500E+00 vIMThPaBMqQN@@REAPE@P
;13    2.000E+00 cPMdEPgSLvUN@@RtBPtBP
;13    2.044E+00 CTMd@PwHLgGN@@RdHPdGP
;13    3.000E+00 aPMsEPdBLQbOQGMSTPSTP
;13    4.000E+00 I@LrYPBhLS@OtXMSAPSAP
;13    5.000E+00 uVLBQPRHLTEOYRMBdPBdP
;13    6.000E+00 D@LRCPqTLU@OAVNbVPbUP
;13    7.000E+00 RdLQaPAULUdOQgNRSPRSP
;13    8.000E+00 bELqTPaDLfYOBWNBTPBTP
;13    9.000E+00 qXLaPPAILwHORdNrGPrGP
;13    1.000E+01 ATLAXPiVKH@OsINrBPrBP
;13    1.100E+01 QILqHPhYKXVOCbNbHPbHP
;13    1.200E+01 A@Lq@PGiKIHOdCNbEPbEP
;13    1.300E+01 XRKaBPgCKYVOdQNbCPbCP
;13    1.400E+01 wEKQFPfWKA@PTgNbAPbAP
;13    1.500E+01 FPKQ@PVIKADPuBNRIPRIP
;13    1.600E+01 eRKAEPuWKAHPeUNRHPRHP
;13    1.800E+01 DTKYVOEIKQEPfFNRGPRGP
;13    2.000E+01 cPKHbOTUKaBPFbNRGPRGP
;13    2.200E+01 RhKXIOTAKaHPwDNRGPRGP
;13    2.400E+01 RPKgUOsUKqCPGaNRGPRGP
;13    2.600E+01 RCKWIOCUKqHPhFNRHPRHP
;13    2.800E+01 AdKvXOSIKARPhWNRIPRIP
;13    3.000E+01 aPKFRORgKAVPIENb@Pb@P
;13    4.000E+01 I@JU@Ob@KaSPAGObEPbEP
;13    5.000E+01 uVJdFOqUKqVPQIOrAPrAP
;13    6.000E+01 D@JcWOAUKAfPaIOrFPrFP
;13    8.000E+01 bEJBiOAHKBAPAUOBUPBUP
;13    1.000E+02 ATJBPOhTJRBPQVORRPRRP
;13    1.500E+02 FPIqQOuTJbIPqVObTPbTP
;13    2.000E+02 cPIqDOdIJBPPAhOrRPrRP
;13    3.000E+02 aPIYPNBfJRSPBDOBcPBcP
;13    4.000E+02 I@HGTNRDJbPPRDOBiPBiP
;13    5.000E+02 uVHVFNqQJbUPb@ORcPRcP
;13    6.000E+02 D@HeHNASJbXPbFORfPRfP
;13    8.000E+02 bEHTBNAGJrSPrCOC@PC@P
;13    1.000E+03 ATHsINXTIrVPrGOCCPCCP
;13    1.500E+03 FPGrGNeYIBaPBUOCGPCGP
;13    2.000E+03 cPGAcNdGIBcPBYOS@PS@P
;13    3.000E+03 aPGaGNBeIBfPRTOSBPSBP
;13    4.000E+03 I@FIcMRCIBgPRVOSDPSDP
;13    5.000E+03 uVFHDMqQIBhPRXOSEPSEP
;13    6.000E+03 D@FFbMARIBiPRYOSEPSEP
;13    8.000E+03 bEFeEMAGIBiPbQOSFPSFP
;13    1.000E+04 ATFdIMXSHR`PbROSGPSGP
;13    1.500E+04 FPERfMeYHRaPbSOSGPSGP
;13    2.000E+04 cPEbHMdGHRaPbTOSHPSHP
;13    3.000E+04 aPEQWMBeHRaPbUOSHPSHP
;13    4.000E+04 I@DaAMRCHRbPbVOSHPSHP
;13    5.000E+04 uVDIcLqQHRbPbVOSIPSIP
;13    6.000E+04 D@DxALARHRbPbVOSIPSIP
;13    8.000E+04 bEDvGLAGHRbPbVOSIPSIP
;13    1.000E+05 ATDUHLXSGRbPbVOSIPSIP
;==== ELEMENT  14
;14    1.000E-03 RSRqBPQWU@@R@@RQWUQWU
;14    1.500E-03 bIRrIPuCT@@R@@RuFTuCT
;14    1.839E-03 RBRCHPCGT@@R@@RCITCGT
;14 K  1.839E-03 RBRCHPSIU@@R@@RSIUSIU
;14    2.000E-03 BERsIPrWU@@R@@RrXUrWU
;14    3.000E-03 aWRTfPyWT@@R@@RyXTyWT
;14    4.000E-03 APRVCPTQT@@R@@RTSTTQT
;14    5.000E-03 aARWAPBTT@@R@@RBUTBTT
;14    6.000E-03 AERWhPAVT@@R@@RAWTAVT
;14    8.000E-03 HDQYQPvHS@@R@@RFWSvIS
;14    1.000E-02 fBQAHQsAS@@R@@RsISsCS
;14    1.500E-02 SYQaIQIeR@@R@@RACSYhR
;14    2.000E-02 rDQAPQDIR@@R@@RDVRdCR
;14    3.000E-02 aEQQPQQFR@@R@@RATRqAR
;14    4.000E-02 GiPQSQdYQ@@R@@RGAQfBQ
;14    5.000E-02 EPPQTQrAQ@@R@@RtHQCeQ
;14    6.000E-02 SbPQSQaIQ@@R@@RcAQBaQ
;14    8.000E-02 rBPAXQUBP@@R@@RbCQB@Q
;14    1.000E-01 QTPASQRPP@@R@@RAdQaXQ
;14    1.500E-01 WCOqAQFaO@@R@@RAUQqHQ
;14    2.000E-01 DHOaAQrTO@@R@@RaHQaCQ
;14    3.000E-01 AdOAFQGhN@@R@@RAHQAFQ
;14    4.000E-01 ADOIXPCQN@@R@@RiQPYQP
;14    5.000E-01 vPNhVPAeN@@R@@RxUPhXP
;14    6.000E-01 dVNHBPQFN@@R@@RHHPHCP
;14    8.000E-01 bRNGEPEeM@@R@@RGHPGFP
;14    1.000E+00 aXNvDPcTM@@R@@RvFPvDP
;14    1.022E+00 aQNfGPCSM@@R@@RfIPfHP
;14    1.250E+00 AHNeWPrCMSRM@@ReYPeXP
;14    1.500E+00 GWMUEPaXMQaN@@RUHPUHP
;14    2.000E+00 d@MDPPAEMWSN@@RDXPDXP
;14    2.044E+00 DCMtEPABMXBN@@RDSPDSP
;14    3.000E+00 AgMCVPE`LRDOaAMcXPcXP
;14    4.000E+00 AEMBiPSeLCVOTdMcDPcDP
;14    5.000E+00 vSLBYPRhLdSOIeMRgPRgP
;14    6.000E+00 dWLb@PrILeXOQQNrYPrYP
;14    7.000E+00 CTLQhPQiLfQOBDNbVPbVP
;14    8.000E+00 bSLA`PqPLGUORUNRWPRWP
;14    9.000E+00 BHLaVPAYLhAOCDNRQPRQP
;14    1.000E+01 aXLQTPqBLX`OSQNBVPBVP
;14    1.100E+01 qILASPQILYSOSeNBSPBSP
;14    1.200E+01 QGLqDPAHLAAPtGNBPPBPP
;14    1.300E+01 YfKaGPIiKAFPtWNrHPrHP
;14    1.400E+01 XYKa@PYBKQAPUDNrFPrFP
;14    1.500E+01 GXKQDPHVKQFPUPNrEPrEP
;14    1.600E+01 VWKAHPGiKa@PEdNrDPrDP
;14    1.800E+01 UIKIiOVeKaHPFXNrDPrDP
;14    2.000E+01 dAKYBOfBKqEPGENrDPrDP
;14    2.200E+01 CXKHWOeRKARPWYNrDPrDP
;14    2.400E+01 RbKWbOUBKAXPHHNrEPrEP
;14    2.600E+01 BYKGTOtQKQSPXTNrFPrFP
;14    2.800E+01 REKGAOtFKQXPXfNrGPrGP
;14    3.000E+01 AgKfTODFKaSPyFNrHPrHP
;14    4.000E+01 AEKeHOCAKAbPQ@OBUPBUP
;14    5.000E+01 vSJDQOrIKQfPaCORRPRRP
;14    6.000E+01 dWJC`OQiKBGPqCORXPRXP
;14    8.000E+01 bSJRiOAXKbDPAYObYPbYP
;14    1.000E+02 aXJBYOQHKrEPaQOrVPrVP
;14    1.500E+02 GXIqWOGdJRUPAaORaPRaP
;14    2.000E+02 dAIqIOEfJbVPQdOC@PC@P
;14    3.000E+02 AgIIcNS`JB`PR@OSAPSAP
;14    4.000E+02 AEIwPNRbJBhPb@OSHPSHP
;14    5.000E+02 vSHvGNrDJRdPbGOcCPcCP
;14    6.000E+02 dWHEVNQeJRhPrCOcFPcFP
;14    8.000E+02 bSHdFNAVJCCPBPOsAPsAP
;14    1.000E+03 aXHSQNQGJCFPBUOsDPsDP
;14    1.500E+03 GXGBUNwWISAPRROsIPsIP
;14    2.000E+03 dAGQ`NEcISDPRWOCQPCQP
;14    3.000E+03 AgGqBNCiISGPbQOCTPCTP
;14    4.000E+03 AEGABNRaISIPbTOCVPCVP
;14    5.000E+03 vSFxBMrCISIPbVOCWPCWP
;14    6.000E+03 dWFGEMQdIc@PbWOCXPCXP
;14    8.000E+03 bSFESMAVIcAPbYOCYPCYP
;14    1.000E+04 aXFDTMQGIcBPrPOCYPCYP
;14    1.500E+04 GXECGMwWHcBPrQOSPPSPP
;14    2.000E+04 dAErFMEcHcCPrROSPPSPP
;14    3.000E+04 AgEaSMCiHcDPrSOSQPSQP
;14    4.000E+04 AEEaEMRaHcDPrSOSQPSQP
;14    5.000E+04 vSDABMrCHcDPrTOSQPSQP
;14    6.000E+04 dWDXYLQdHcDPrTOSQPSQP
;14    8.000E+04 bSDVYLAVHcDPrTOSQPSQP
;14    1.000E+05 aXDuFLQGHcDPrTOSRPSRP
;==== ELEMENT  15
;15    1.000E-03 bVRQAPQaU@@R@@RQaUQaU
;15    1.500E-03 BQRBHPVRT@@R@@RVUTVRT
;15    2.000E-03 RFRCCPC@T@@R@@RCBTC@T
;15    2.145E-03 R@RcIPBWT@@R@@RBYTBWT
;15 K  2.145E-03 R@RcIPBWU@@R@@RBWUBWU
;15    3.000E-03 qTRdTPQBU@@R@@RQBUQBU
;15    4.000E-03 AUREiPeCT@@R@@ReDTeCT
;15    5.000E-03 aDRFhPBeT@@R@@RBfTBeT
;15    6.000E-03 AHRwRPqQT@@R@@RqSTqRT
;15    8.000E-03 xCQYCPWWS@@R@@RgVSWXS
;15    1.000E-02 VTQACQSfS@@R@@RDDSSgS
;15    1.500E-02 CbQaCQQIS@@R@@RaDSa@S
;15    2.000E-02 RPQqEQTgR@@R@@RuERU@R
;15    3.000E-02 qDQAUQARR@@R@@RqPRQWR
;15    4.000E-02 HUPAXQuWQ@@R@@RX@QgEQ
;15    5.000E-02 EaPAXQBeQ@@R@@RTbQtDQ
;15    6.000E-02 dBPAXQaPQ@@R@@RCYQCGQ
;15    8.000E-02 RQPATQvGP@@R@@RrBQBGQ
;15    1.000E-01 aVPqIQSBP@@R@@RAgQqPQ
;15    1.500E-01 wROaGQXSO@@R@@RASQqFQ
;15    2.000E-01 DSOQGQCTO@@R@@RaEQaAQ
;15    3.000E-01 B@OABQYdN@@R@@RAEQACQ
;15    4.000E-01 QCOi@PtAN@@R@@RyFPiEP
;15    5.000E-01 gINHQPrDN@@R@@RXQPHTP
;15    6.000E-01 EGNwYPAVN@@R@@RGePG`P
;15    8.000E-01 BfNFePGQM@@R@@RFhPFfP
;15    1.000E+00 AcNVFPdQM@@R@@RVHPVFP
;15    1.022E+00 qUNV@PtEM@@R@@RVBPV@P
;15    1.250E+00 QGNUQPReMsPM@@RUSPUQP
;15    1.500E+00 XDMEAPRCMB@N@@REDPECP
;15    2.000E+00 TXMdGPqCMGfN@@RtFPtEP
;15    2.044E+00 tHMdBPaHMHWN@@RtAPtAP
;15    3.000E+00 BDMsFPwCLbCOQHMSYPSYP
;15    4.000E+00 QDMBaPTiLcPOD`MSGPSGP
;15    5.000E+00 wCLBRPsVLDbOYWMRbPRaP
;15    6.000E+00 EILRDPCALUaOAWNrUPrUP
;15    7.000E+00 sTLQbPRQLFhOQhNbSPbSP
;15    8.000E+00 BfLqUPRELwUOBXNRUPRUP
;15    9.000E+00 bFLaQPAhLXTORfNBYPBYP
;15    1.000E+01 AcLAYPaWLiFOCQNBUPBUP
;15    1.100E+01 QQLqIPQPLYaOCdNBRPBRP
;15    1.200E+01 aGLq@PqFLAEPdDNBPPBPP
;15    1.300E+01 AHLaCPaDLQAPdSNrHPrHP
;15    1.400E+01 yEKQFPQELQFPTiNrGPrGP
;15    1.500E+01 XDKQ@PAFLaAPuDNrFPrFP
;15    1.600E+01 WFKAEPYcKaEPeWNrFPrFP
;15    1.800E+01 eUKiQOxUKqCPfINrFPrFP
;15    2.000E+01 TXKHfOGbKAQPFeNrFPrFP
;15    2.200E+01 sYKhCOGGKAWPwGNrGPrGP
;15    2.400E+01 SHKgYOFTKQTPGdNrHPrHP
;15    2.600E+01 rQKgBOUbKQYPhINBPPBPP
;15    2.800E+01 rDKFaOEXKaTPxPNBQPBQP
;15    3.000E+01 BDKFUOU@KaYPIHNBSPBSP
;15    4.000E+01 QDKUCOsXKAiPAGORQPRQP
;15    5.000E+01 wCJdHOCAKBCPQIORXPRXP
;15    6.000E+01 EIJcYOBYKREPaIObUPbUP
;15    8.000E+01 BfJRaOAfKrBPAUOrVPrVP
;15    1.000E+02 AcJBQOAXKBTPQVOBdPBdP
;15    1.500E+02 XDIqROIeJbTPqUORiPRiP
;15    2.000E+02 TXIqEOwGJrVPAhOCHPCHP
;15    3.000E+02 BDIYUNT`JR`PBDOc@Pc@P
;15    4.000E+02 QDIGXNcWJRiPRCOcHPcHP
;15    5.000E+02 wCHVINRdJCDPb@OsCPsCP
;15    6.000E+02 EIHu@NBUJCIPbEOsFPsFP
;15    8.000E+02 BfHTDNAcJSDPrBOCQPCQP
;15    1.000E+03 AcHCQNAWJSGPrGOCUPCUP
;15    1.500E+03 XDGrHNyWIcCPBTOSPPSPP
;15    2.000E+03 TXGAdNwBIcEPBXOSRPSRP
;15    3.000E+03 BDGaHNDhIcIPRROSUPSUP
;15    4.000E+03 QDGIhMcVIs@PRUOSWPSWP
;15    5.000E+03 wCFHHMRcIsAPRVOSXPSXP
;15    6.000E+03 EIFFeMBTIsBPRXOSXPSXP
;15    8.000E+03 BfFeHMAcIsCPRYOSYPSYP
;15    1.000E+04 AcFtAMAVIsCPbPOcPPcPP
;15    1.500E+04 XDERhMyVHsDPbROcQPcQP
;15    2.000E+04 TXEbIMwBHsEPbROcQPcQP
;15    3.000E+04 BDEQXMDhHsEPbSOcRPcRP
;15    4.000E+04 QDEaAMcVHsFPbSOcRPcRP
;15    5.000E+04 wCDIgLRcHsFPbTOcRPcRP
;15    6.000E+04 EIDxELBTHsFPbTOcRPcRP
;15    8.000E+04 BfDFPLAcHsFPbTOcRPcRP
;15    1.000E+05 AcDeALAVHsFPbTOcRPcRP
;==== ELEMENT  16
;16    1.000E-03 ReRAAPBSU@@R@@RBSUBSU
;16    1.500E-03 bYRQePxAT@@R@@RxDTxAT
;16    2.000E-03 BSRRbPCcT@@R@@RCeTCcT
;16    2.472E-03 RHRsWPRET@@R@@RRGTRET
;16 K  2.472E-03 RHRsWPBGU@@R@@RBGUBGU
;16    3.000E-03 QeRdTPqDU@@R@@RqDUqDU
;16    4.000E-03 aPRF@PvBT@@R@@RvDTvBT
;16    5.000E-03 qERGGPCWT@@R@@RCYTCWT
;16    6.000E-03 QGRWePR@T@@R@@RRBTR@T
;16    8.000E-03 YAQyFPyFS@@R@@RIVSyGS
;16    1.000E-02 gCQAEQTcS@@R@@REASTdS
;16    1.500E-02 t@QaEQAYS@@R@@RQUSQQS
;16    2.000E-02 BbQqGQfIR@@R@@RvQRFSR
;16    3.000E-02 QQQAXQAaR@@R@@RRARQfR
;16    4.000E-02 YTPQQQGPQ@@R@@RIgQXbQ
;16    5.000E-02 VXPQRQcWQ@@R@@REeQUIQ
;16    6.000E-02 D`PQQQBFQ@@R@@RDEQSWQ
;16    8.000E-02 BfPAWQhFP@@R@@RRYQr@Q
;16    1.000E-01 AiPASQDEP@@R@@RBBQAcQ
;16    1.500E-01 HbOqAQQAP@@R@@RQQQARQ
;16    2.000E-01 EGOaAQTQO@@R@@Rq@QaEQ
;16    3.000E-01 bIOAFQqAO@@R@@RAIQAGQ
;16    4.000E-01 q@OIXPeWN@@R@@RiWPYTP
;16    5.000E-01 xENhWPCHN@@R@@RxXPxPP
;16    6.000E-01 EaNHBPQcN@@R@@RX@PHDP
;16    8.000E-01 cHNGFPyXM@@R@@RW@PGGP
;16    1.000E+00 R@NvEPFHM@@R@@RvGPvEP
;16    1.022E+00 BANfHPuTM@@R@@Rv@PfHP
;16    1.250E+00 qDNeXPCiMTAM@@RuPPeXP
;16    1.500E+00 yCMUFPBbMbAN@@RUIPUHP
;16    2.000E+00 eEMDPPqUMhWN@@RTPPDYP
;16    2.044E+00 ECMtEPaYMyDN@@RDUPDTP
;16    3.000E+00 rCMCVPiTLBUOaAMsQPsQP
;16    4.000E+00 qAMBiPVULSfOTeMcIPcIP
;16    5.000E+00 HPLRPPTdLeIOIfMCDPCDP
;16    6.000E+00 EdLbAPSeLFYOQQNBgPBgP
;16    7.000E+00 dILQhPcILWVOBDNrVPrVP
;16    8.000E+00 cHLA`PBbLXQORUNbXPbXP
;16    9.000E+00 RYLaVPBVLyHOCDNbSPbSP
;16    1.000E+01 R@LQTPRHLABPSQNRYPRYP
;16    1.100E+01 qTLASPQfLAIPSfNRVPRVP
;16    1.200E+01 AVLqDPqXLQEPtGNRTPRTP
;16    1.300E+01 aDLaGPaSLaAPtWNRSPRSP
;16    1.400E+01 AGLa@PQPLaGPUENRRPRRP
;16    1.500E+01 yDKQDPqILqBPUPNRRPRRP
;16    1.600E+01 hAKAHPq@LqGPEdNRRPRRP
;16    1.800E+01 FXKY`OQELAVPFXNRRPRRP
;16    2.000E+01 eEKYCOABLQTPGENRSPRSP
;16    2.200E+01 tDKHXOiEKaRPWYNRTPRTP
;16    2.400E+01 cUKWcOHTKaXPHHNRVPRVP
;16    2.600E+01 SAKGTOwUKqUPXSNRXPRXP
;16    2.800E+01 bXKGBOWHKA`PXeNRYPRYP
;16    3.000E+01 rCKfUOfXKAePyENbQPbQP
;16    4.000E+01 qAKeHOTeKBGPQ@OrQPrQP
;16    5.000E+01 HPJDQOScKbCPaCOrYPrYP
;16    6.000E+01 EdJC`OcFKrFPqCOBgPBgP
;16    8.000E+01 cHJC@OBSKRTPAYORiPRiP
;16    1.000E+02 R@JBYOQdKbWPaPOCHPCHP
;16    1.500E+02 yDIqWOaIKBiPA`OcEPcEP
;16    2.000E+02 eEIqIOiTJCBPQcOsFPsFP
;16    3.000E+02 rCIIdNFQJSHPBIOCYPCYP
;16    4.000E+02 qAIwQND`JcGPRIOSWPSWP
;16    5.000E+02 HPHvHNCdJsCPbFOcRPcRP
;16    6.000E+02 EdHEVNc@JsHPrAOcVPcVP
;16    8.000E+02 cHHdGNBPJCTPrHOsRPsRP
;16    1.000E+03 R@HSQNQbJCWPBSOsUPsUP
;16    1.500E+03 yDGBUNaHJSSPRPOCaPCaP
;16    2.000E+03 eEGQ`NYXISVPRTOCdPCdP
;16    3.000E+03 rCGqBNvIISYPRYOCgPCgP
;16    4.000E+03 qAGABNtYIcQPbQOChPChP
;16    5.000E+03 HPFxCMCcIcRPbSOS`PS`P
;16    6.000E+03 EdFGFMSIIcSPbTOS`PS`P
;16    8.000E+03 cHFETMrIIcTPbUOSaPSaP
;16    1.000E+04 R@FDTMQbIcUPbVOSbPSbP
;16    1.500E+04 yDECGMaHIcVPbXOScPScP
;16    2.000E+04 eEErFMYWHcVPbYOScPScP
;16    3.000E+04 rCEaSMvHHcWPbYOSdPSdP
;16    4.000E+04 qAEaEMtYHcWPrPOSdPSdP
;16    5.000E+04 HPDABMCcHcWPrPOSdPSdP
;16    6.000E+04 EdDhPLSIHcWPrPOSdPSdP
;16    8.000E+04 cHDVYLrIHcXPrPOSePSeP
;16    1.000E+05 R@DuGLQbHcXPrQOSePSeP
;==== ELEMENT  17
;17    1.000E-03 CCRXVOBcU@@R@@RBcUBcU
;17    1.500E-03 B`RaYPyTT@@R@@RyWTyTT
;17    2.000E-03 RSRRYPDYT@@R@@RTRTDYT
;17    2.822E-03 RBRSgPqUT@@R@@RqWTqUT
;17 K  2.822E-03 RBRSgPaSU@@R@@RaTUaSU
;17    3.000E-03 BDRdEPAWU@@R@@RAWUAWU
;17    4.000E-03 aVReRPGBT@@R@@RGDTGBT
;17    5.000E-03 qIRvQPCiT@@R@@RS`TCiT
;17    6.000E-03 a@RWXPrGT@@R@@RrHTrGT
;17    8.000E-03 iGQXcPAFT@@R@@RAHTAGT
;17    1.000E-02 GQQA@QeTS@@R@@RuSSeUS
;17    1.500E-02 DYQQIQqSS@@R@@RqXSqTS
;17    2.000E-02 RfQqAQwAR@@R@@RwTRGTR
;17    3.000E-02 QXQAQQRCR@@R@@RBSRbGR
;17    4.000E-02 A@QAUQxRQ@@R@@RQBRABR
;17    5.000E-02 VaPAUQtDQ@@R@@RFXQuYQ
;17    6.000E-02 EEPAUQBTQ@@R@@RtIQCiQ
;17    8.000E-02 CBPAQQIbP@@R@@RrPQrIQ
;17    1.000E-01 B@PqGQDcP@@R@@RBEQAeQ
;17    1.500E-01 yDOaEQqDP@@R@@RAXQqIQ
;17    2.000E-01 uHOQFQERO@@R@@RaGQaAQ
;17    3.000E-01 BTOAAQQWO@@R@@RAEQACQ
;17    4.000E-01 qHOY@PFeN@@R@@RyAPYGP
;17    5.000E-01 HhNxCPsSN@@R@@RHUPxFP
;17    6.000E-01 VHNwQPrCN@@R@@RG`PwSP
;17    8.000E-01 CXNvXPQHN@@R@@RFcPvYP
;17    1.000E+00 bCNV@PwFM@@R@@RVCPVAP
;17    1.022E+00 RDNFCPVfM@@R@@RFFPFDP
;17    1.250E+00 ASNEUPtQMdDM@@REXPEVP
;17    1.500E+00 YbMTfPCQMbGN@@RTiPThP
;17    2.000E+00 UXMdCPRBMHhN@@RtCPtBP
;17    2.044E+00 uEMTHPBEMYWN@@RdHPdHP
;17    3.000E+00 BXMsCPQFMRQOQGMSYPSXP
;17    4.000E+00 APMrXPWaLDDOtVMSIPSIP
;17    5.000E+00 XdLBPPUeLEQOIXMRePReP
;17    6.000E+00 fALRBPtVLfROAVNB`PB`P
;17    7.000E+00 TVLQaPSfLwQOQfNrPPrPP
;17    8.000E+00 CYLqSPsILhYOBUNbSPbSP
;17    9.000E+00 rVLQYPRfLYWORcNRXPRXP
;17    1.000E+01 bCLAXPbSLADPsGNRUPRUP
;17    1.100E+01 AeLqHPrFLQAPC`NRSPRSP
;17    1.200E+01 QULaIPRDLQHPd@NRQPRQP
;17    1.300E+01 qBLaBPQfLaDPTXNRPPRPP
;17    1.400E+01 QDLQEPAaLq@PTdNRPPRPP
;17    1.500E+01 YcKAIPaXLqEPeINRPPRPP
;17    1.600E+01 xSKADPQVLAPPeQNRPPRPP
;17    1.800E+01 V`KYROqHLAYPfBNRQPRQP
;17    2.000E+01 UYKxXOaCLQWPvXNRRPRRP
;17    2.200E+01 dRKXEOQALaUPgINRTPRTP
;17    2.400E+01 ChKgROAALqRPwVNRVPRVP
;17    2.600E+01 sAKWEOyBKqXPXINRXPRXP
;17    2.800E+01 BeKvUOhRKAdPhPNbPPbPP
;17    3.000E+01 BXKvIOHBKAiPXhNbRPbRP
;17    4.000E+01 APKEHOUeKRAPAFOrRPrRP
;17    5.000E+01 XdJdDOtSKbGPQHOBaPBaP
;17    6.000E+01 fAJcUOSbKBPPaHOBiPBiP
;17    8.000E+01 CYJBhORcKRYPASOCBPCBP
;17    1.000E+02 bCJrIOrCKrRPQTOSAPSAP
;17    1.500E+02 YcIqPOQUKRdPqSOcIPcIP
;17    2.000E+02 UYIqCOQFKCHPAeOCPPCPP
;17    3.000E+02 BXIIVNwPJcDPB@OSSPSSP
;17    4.000E+02 APIGQNuWJsCPR@OcQPcQP
;17    5.000E+02 XdHVCNdQJsIPRFOcWPcWP
;17    6.000E+02 fAHeENCdJCTPbAOsQPsQP
;17    8.000E+02 CYHT@NBhJSPPbHOsVPsVP
;17    1.000E+03 bCHsGNr@JSSPrBOC`PC`P
;17    1.500E+03 YcGrFNQSJSYPrIOCePCeP
;17    2.000E+03 UYGAbNQEJcRPBSOChPChP
;17    3.000E+03 BXGaGNgWIcUPBWOSaPSaP
;17    4.000E+03 APGyYMuUIcWPRPOScPScP
;17    5.000E+03 XdFH@MdPIcXPRQOSdPSdP
;17    6.000E+03 fAFvXMCcIcYPRROSePSeP
;17    8.000E+03 CYFeCMBgIsPPRSOSfPSfP
;17    1.000E+04 bCFdGMr@IsQPRTOSgPSgP
;17    1.500E+04 YcEReMQSIsRPRVOShPShP
;17    2.000E+04 UYEbGMQEIsRPRVOShPShP
;17    3.000E+04 BXEQVMgWHsSPRWOSiPSiP
;17    4.000E+04 APEa@MuUHsSPRWOSiPSiP
;17    5.000E+04 XdDyXLdPHsSPRXOSiPSiP
;17    6.000E+04 fADhGLCcHsSPRXOSiPSiP
;17    8.000E+04 CYDvDLBgHsTPRXOSiPSiP
;17    1.000E+05 bCDUFLr@HsTPRXOSiPSiP
;==== ELEMENT  18
;18    1.000E-03 CDRGHOSHU@@R@@RSHUSHU
;18    1.500E-03 BbRARPQ@U@@R@@RQ@UQ@U
;18    2.000E-03 RWRb@PEIT@@R@@RUBTEIT
;18    3.000E-03 BHRsRPaXT@@R@@RqPTaXT
;18    3.203E-03 QiRD@PAPT@@R@@RARTAPT
;18 K  3.203E-03 QiRD@PaGU@@R@@RaGUaGU
;18    4.000E-03 aYREBPWUT@@R@@RWWTWUT
;18    5.000E-03 AQRV@PdAT@@R@@RdCTdAT
;18    6.000E-03 a@RVgPRXT@@R@@RRYTRXT
;18    8.000E-03 iEQhIPQGT@@R@@RQHTQGT
;18    1.000E-02 GQQiIPfCS@@R@@RvBSfDS
;18    1.500E-02 TVQQ@QQcS@@R@@RQhSQdS
;18    2.000E-02 CBQaAQhAR@@R@@RhSRxCR
;18    3.000E-02 aRQqBQBPR@@R@@RrPRRSR
;18    4.000E-02 ABQqEQYaQ@@R@@RaCRQCR
;18    5.000E-02 GGPqFQTeQ@@R@@RGAQv@Q
;18    6.000E-02 UHPqEQrYQ@@R@@RdVQTEQ
;18    8.000E-02 SAPqBQQCQ@@R@@RrVQBUQ
;18    1.000E-01 BFPaHQUVP@@R@@RBDQAdQ
;18    1.500E-01 iSOQHQQTP@@R@@RASQqCQ
;18    2.000E-01 UUOAIQfHO@@R@@RaAQQEQ
;18    3.000E-01 RROYRPAcO@@R@@RYePyPP
;18    4.000E-01 ASOXUPWhN@@R@@RxXPhSP
;18    5.000E-01 YHNGbPtDN@@R@@RWfPGgP
;18    6.000E-01 vINgDPrRN@@R@@RwCPgGP
;18    8.000E-01 cPNvGPqHN@@R@@RFRPvHP
;18    1.000E+00 rANuSPXYM@@R@@RuVPuTP
;18    1.022E+00 bANeWPXBM@@R@@RuPPeXP
;18    1.250E+00 AXNUCPUPMdFM@@RUEPUDP
;18    1.500E+00 ACNdVPShMbGN@@RtPPdXP
;18    2.000E+00 uXMShPBWMHfN@@RDGPDGP
;18    2.044E+00 USMScPrIMYUN@@RDCPDBP
;18    3.000E+00 RWMSCPqFMRPOAIMsHPsHP
;18    4.000E+00 ATMbQPi@LDCODWMCBPCBP
;18    5.000E+00 iELbEPVbLuHOXaMB`PB`P
;18    6.000E+00 FRLQiPUSLVYOqGNbWPbWP
;18    7.000E+00 tRLqYPdPLgWOAdNRXPRXP
;18    8.000E+00 cQLaSPScLhTOrANRRPRRP
;18    9.000E+00 BfLQPPCTLYQOrUNBXPBXP
;18    1.000E+01 rALqIPCELACPSGNBUPBUP
;18    1.100E+01 QaLaIPrTLQ@PSWNBSPBSP
;18    1.200E+01 aQLaAPBYLQGPSeNBRPBRP
;18    1.300E+01 qGLQDPbGLaCPt@NBRPBRP
;18    1.400E+01 QHLAHPR@LaIPdTNBRPBRP
;18    1.500E+01 ACLACPQdLqDPTgNBRPBRP
;18    1.600E+01 ICKyXOAaLqIPeGNBRPBRP
;18    1.800E+01 WDKXdOaPLAXPEdNBTPBTP
;18    2.000E+01 uXKhEOASLQVPvFNBUPBUP
;18    2.200E+01 tXKgVOaILaTPFdNBWPBWP
;18    2.400E+01 DAKWFOQHLqQPgHNRPPRPP
;18    2.600E+01 CRKvROAHLqWPgYNRRPRRP
;18    2.800E+01 ReKvDOYiKAbPHGNRTPRTP
;18    3.000E+01 RWKF@Oy@KAhPHSNRVPRVP
;18    4.000E+01 AUKtWOFiKBIPYaNbWPbWP
;18    5.000E+01 iEJShOEXKbEPQAOrVPrVP
;18    6.000E+01 FRJCSOTTKrHPa@OBdPBdP
;18    8.000E+01 cQJrQOsIKRWPqDORgPRgP
;18    1.000E+02 rAJbEOrPKrPPATOCGPCGP
;18    1.500E+02 ACJaPOqYKRbPaROcDPcDP
;18    2.000E+02 uXIaEOqDKCEPqSOsEPsEP
;18    3.000E+02 RWIHiNXbJcAPAhOCYPCYP
;18    4.000E+02 AUIVfNfXJs@PQfOSWPSWP
;18    5.000E+02 iEHuVNuDJsFPBBOcRPcRP
;18    6.000E+02 FRHTcNDUJCQPBGOcVPcVP
;18    8.000E+02 cQHCeNsCJCVPRCOsRPsRP
;18    1.000E+03 rAHSGNbWJSPPRGOsUPsUP
;18    1.500E+03 ACHbANqXJSVPbCOC`PC`P
;18    2.000E+03 uXGqQNqCJSYPbGOCcPCcP
;18    3.000E+03 RWGQINHhIcRPr@OCfPCfP
;18    4.000E+03 AUGi@MfVIcTPrCOChPChP
;18    5.000E+03 iEFWRMuCIcUPrDOCiPCiP
;18    6.000E+03 FRFvHMDTIcVPrEOS`PS`P
;18    8.000E+03 cQFTaMsCIcWPrFOSaPSaP
;18    1.000E+04 rAFDAMbVIcWPrGOSaPSaP
;18    1.500E+04 ACFrWMqXIcXPrHOSbPSbP
;18    2.000E+04 uXERCMqCIcYPrIOScPScP
;18    3.000E+04 RWEAWMHhHcYPBPOScPScP
;18    4.000E+04 AUEQCMfVHsPPBPOSdPSdP
;18    5.000E+04 iEDYILuCHsPPBPOSdPSdP
;18    6.000E+04 FRDwWLDTHsPPBPOSdPSdP
;18    8.000E+04 cQDUeLsCHsPPBPOSdPSdP
;18    1.000E+05 rADDeLbVHsPPBQOSdPSdP
;==== ELEMENT  19
;19    1.000E-03 sERaBPDEU@@R@@RDFUDEU
;19    1.500E-03 CHRQfPAQU@@R@@RARUAQU
;19    2.000E-03 BbRrPPVVT@@R@@RVYTVVT
;19    3.000E-03 rCRTFPRGT@@R@@Rb@TRHT
;19    3.607E-03 BGRThPqAT@@R@@RqCTqAT
;19 K  3.607E-03 BGRThPa@U@@R@@Ra@Ua@U
;19    4.000E-03 QbREVPiDT@@R@@RiFTiDT
;19    5.000E-03 aPRVXPUGT@@R@@RUITUGT
;19    6.000E-03 qFRWQPSIT@@R@@Rc@TSIT
;19    8.000E-03 ADRXcPAVT@@R@@RAWTAVT
;19    1.000E-02 xFQYhPGaS@@R@@RWaSGbS
;19    1.500E-02 eCQQHQBTS@@R@@RRPSBUS
;19    2.000E-02 CYQq@QAES@@R@@RAISAFS
;19    3.000E-02 AgQAQQCHR@@R@@RCQRcBR
;19    4.000E-02 QHQAUQaHR@@R@@RQTRARR
;19    5.000E-02 hAPAVQFPQ@@R@@RhXQGfQ
;19    6.000E-02 FCPAUQcRQ@@R@@ReXQEHQ
;19    8.000E-02 cSPARQAWQ@@R@@RcEQBiQ
;19    1.000E-01 BQPqHQgFP@@R@@RrDQR@Q
;19    1.500E-01 QCPaGQBCP@@R@@RQXQAWQ
;19    2.000E-01 VQOQGQhFO@@R@@RqBQaEQ
;19    3.000E-01 RfOACQBRO@@R@@RAHQAEQ
;19    4.000E-01 aXOiBPAEO@@R@@RIYPyCP
;19    5.000E-01 AHOHSPuUN@@R@@RhPPHYP
;19    6.000E-01 WQNGaPcPN@@R@@RWbPGeP
;19    8.000E-01 dDNFgPAcN@@R@@RVcPFiP
;19    1.000E+00 rRNVHPQDN@@R@@RfBPVIP
;19    1.022E+00 bPNVAPAHN@@R@@RVEPVBP
;19    1.250E+00 qTNUSPgIMTaM@@RUVPUTP
;19    1.500E+00 aANEBPeGMbPN@@REGPEFP
;19    2.000E+00 F`MdIPcGMAAO@@RDPPtIP
;19    2.044E+00 VQMdDPSFMAIO@@RtEPtEP
;19    3.000E+00 CBMsGPqYMBeOQHMcWPcVP
;19    4.000E+00 qPMBbPaAMTYODbMcHPcHP
;19    5.000E+00 AIMBSPYBLVBOiQMCEPCEP
;19    6.000E+00 WVLREPgILWPOAWNRaPRaP
;19    7.000E+00 UULQcPFFLxROQiNBbPBbP
;19    8.000E+00 dELqVPUHLIbOBYNrWPrWP
;19    9.000E+00 sFLaRPTRLAHPRfNrSPrSP
;19    1.000E+01 rRLQPPDALQGPCRNrPPrPP
;19    1.100E+01 bELAPPcPLaEPCeNbYPbYP
;19    1.200E+01 AiLqAPcGLqCPdFNbXPbXP
;19    1.300E+01 aQLaCPRiLAPPdTNbXPbXP
;19    1.400E+01 qILQGPrVLAVPEANbXPbXP
;19    1.500E+01 aALQAPRVLQRPuENbYPbYP
;19    1.600E+01 AFLAFPrHLQXPeXNbYPbYP
;19    1.800E+01 HPKiTOR@LaYPv@NrQPrQP
;19    2.000E+01 F`KHiOAhLqXPFfNrTPrTP
;19    2.200E+01 eRKhFOaYLAfPwGNrVPrVP
;19    2.400E+01 tRKwROQTLQdPGeNrYPrYP
;19    2.600E+01 DBKgEOARLBAPhINBbPBbP
;19    2.800E+01 CWKFdOqALBGPxPNBdPBdP
;19    3.000E+01 CBKFWOaBLRCPIHNBgPBgP
;19    4.000E+01 qPKUDOIFKrHPAGOC@PC@P
;19    5.000E+01 AIKdIOg@KRVPQIOSAPSAP
;19    6.000E+01 WVJsPOUgKrPPaIOc@Pc@P
;19    8.000E+01 dEJRbODUKRaPATOsEPsEP
;19    1.000E+02 rRJBROSUKCGPQUOCVPCVP
;19    1.500E+02 aAJqSOrEKsAPqTOcVPcVP
;19    2.000E+02 F`IqEOqVKCVPAgOsXPsXP
;19    3.000E+02 CBIYYNQGKcTPBBOSdPSdP
;19    4.000E+02 qPIWQNxWJsUPRAODCPDCP
;19    5.000E+02 AIIfANGAJCaPRHODIPDIP
;19    6.000E+02 WVHuBNEdJCfPbCOTDPTDP
;19    8.000E+02 dEHTFNtHJScPbIOd@Pd@P
;19    1.000E+03 rRHCRNSPJSgPrDOdDPdDP
;19    1.500E+03 aAHrINrCJDDPBQOt@Pt@P
;19    2.000E+03 F`GAeNqUJDGPBUOtDPtDP
;19    3.000E+03 CBGaHNQGJTAPBYOtGPtGP
;19    4.000E+03 qPGYbMxUITCPRROtIPtIP
;19    5.000E+03 AIGXAMG@ITDPRSODPPDPP
;19    6.000E+03 WVFFhMEcITEPRTODQPDQP
;19    8.000E+03 dEFu@MtGITFPRVODRPDRP
;19    1.000E+04 rRFtCMSPITGPRWODSPDSP
;19    1.500E+04 aAFRiMrCITHPRXODTPDTP
;19    2.000E+04 F`Er@MqUITIPRYODUPDUP
;19    3.000E+04 CBEQXMQGITIPbPODUPDUP
;19    4.000E+04 qPEaBMxTHd@PbPODVPDVP
;19    5.000E+04 AIEYaLViHd@PbPODVPDVP
;19    6.000E+04 WVDxHLEcHd@PbQODVPDVP
;19    8.000E+04 dEDFRLtGHd@PbQODVPDVP
;19    1.000E+05 rRDeBLSPHd@PbQODVPDVP
;==== ELEMENT  20
;20    1.000E-03 SXRAYPDfU@@R@@RDgUDfU
;20    1.500E-03 cFRrFPqQU@@R@@RqQUqQU
;20    2.000E-03 RfRS@PWgT@@R@@RH@TWgT
;20    3.000E-03 BVRDXPbUT@@R@@RbXTbUT
;20    4.000E-03 BERuRPa@T@@R@@RaBTa@T
;20    4.038E-03 BDRuVPQGT@@R@@RQITQGT
;20 K  4.038E-03 BDRuVPABU@@R@@RABUABU
;20    5.000E-03 qRRvYPFAT@@R@@RFCTFAT
;20    6.000E-03 AVRwRPsRT@@R@@RsSTsRT
;20    8.000E-03 QBRYGPqQT@@R@@RqSTqRT
;20    1.000E-02 XeQABQiDS@@R@@RyDSiES
;20    1.500E-02 eWQaAQRaS@@R@@RRhSRbS
;20    2.000E-02 CbQqBQaES@@R@@RqASaGS
;20    3.000E-02 BFQATQsSR@@R@@RDHRCgR
;20    4.000E-02 q@QAXQQUR@@R@@RAcRqPR
;20    5.000E-02 IDPAYQG`Q@@R@@RABRiIQ
;20    6.000E-02 fUPAYQDSQ@@R@@RVXQUaQ
;20    8.000E-02 DAPAUQA`Q@@R@@RcVQcEQ
;20    1.000E-01 bWPAQQXcP@@R@@RRWQr@Q
;20    1.500E-01 aEPq@QRPP@@R@@RaWQQUQ
;20    2.000E-01 gCOa@QABP@@R@@RqHQq@Q
;20    3.000E-01 cIOAEQC@O@@R@@RQBQAHQ
;20    4.000E-01 AgOIVPqAO@@R@@RyXPiPP
;20    5.000E-01 a@OhVPWFN@@R@@RHePxSP
;20    6.000E-01 xFNHBPDYN@@R@@RXEPHFP
;20    8.000E-01 tRNGEPbHN@@R@@RWBPGGP
;20    1.000E+00 CBNvDPARN@@R@@RvIPvFP
;20    1.022E+00 BiNfHPqDN@@R@@RvBPfIP
;20    1.250E+00 QdNeXPIIMuFM@@RuQPeYP
;20    1.500E+00 qDNUFPVVMBbN@@ReAPUIP
;20    2.000E+00 WWMDPPDGMQ@O@@RTRPTRP
;20    2.044E+00 gEMtEPScMQIO@@RDXPDWP
;20    3.000E+00 sFMCWPbCMCHOaAMsXPsXP
;20    4.000E+00 AiMBiPQQMTfOTeMCPPsIP
;20    5.000E+00 aAMRPPQCMfROIfMSGPSGP
;20    6.000E+00 HQLbAPIELX@OQQNCCPCCP
;20    7.000E+00 VHLQhPWRLIROBDNRePReP
;20    8.000E+00 tSLA`PFSLAFPRUNBiPBiP
;20    9.000E+00 sTLaVPeQLQGPCDNBfPBfP
;20    1.000E+01 CCLQTPTgLaGPSQNBdPBdP
;20    1.100E+01 RPLASPDWLqEPSeNBcPBcP
;20    1.200E+01 R@LqDPDELATPtGNBbPBbP
;20    1.300E+01 qYLaGPsQLQQPtVNBcPBbP
;20    1.400E+01 QTLa@PCRLQXPUDNBcPBcP
;20    1.500E+01 qELQDPSGLaUPUPNBdPBdP
;20    1.600E+01 QHLAHPRfLqQPEcNBePBeP
;20    1.800E+01 yEKY`ObPLAbPFVNBhPBgP
;20    2.000E+01 WWKYCOrBLQbPGDNR`PR`P
;20    2.200E+01 fFKHXOR@LBAPWWNRcPRcP
;20    2.400E+01 eFKWcOQaLBIPHFNRgPRfP
;20    2.600E+01 DXKGTOqVLRGPXQNC@PC@P
;20    2.800E+01 CfKGBOaSLbDPXcNCCPCCP
;20    3.000E+01 sGKfUOQQLr@PyBNCFPCFP
;20    4.000E+01 AiKeHOQBLRVPQ@Oc@Pc@P
;20    5.000E+01 aAKDQOXaKrVPaBOsBPsBP
;20    6.000E+01 HQJC`OwIKRaPqBOCRPCRP
;20    8.000E+01 tSJC@OUQKSDPAXOSYPSYP
;20    1.000E+02 CCJBYOtIKs@PQYOsQPsQP
;20    1.500E+02 qEJqWORaKSWPqYOScPScP
;20    2.000E+02 WWIqIORHKsSPQaODFPDFP
;20    3.000E+02 sFIIdNAUKSbPBGOdCPdCP
;20    4.000E+02 AiIwQNAIKDDPRGOtCPtCP
;20    5.000E+02 aAIvHNhXJTAPbCODPPDPP
;20    6.000E+02 HQHEVNgCJTGPbHODUPDUP
;20    8.000E+02 tSHdGNERJdDPrEOTRPTRP
;20    1.000E+03 CCHSQNtCJdHPBPOTVPTVP
;20    1.500E+03 qEHBUNBiJtEPBWOdRPdRP
;20    2.000E+03 WWGQ`NRGJtIPRROdVPdVP
;20    3.000E+03 sFGqBNATJDSPRVOtPPtPP
;20    4.000E+03 AiGABNAHJDUPRYOtRPtRP
;20    5.000E+03 aAGxCMhVIDWPbQOtTPtTP
;20    6.000E+03 HQFGFMgAIDXPbROtUPtUP
;20    8.000E+03 tSFETMEQIDYPbSOtVPtVP
;20    1.000E+04 CCFDTMtCITPPbTOtWPtWP
;20    1.500E+04 qEFCGMBiITQPbVOtXPtXP
;20    2.000E+04 WWErFMRFITRPbWOtXPtXP
;20    3.000E+04 sFEaSMATITRPbWOtYPtYP
;20    4.000E+04 AiEaEMAHITRPbXOtYPtYP
;20    5.000E+04 aAEABMhVHTSPbXOD`PD`P
;20    6.000E+04 HQDhPLgAHTSPbXOD`PD`P
;20    8.000E+04 tSDVYLEQHTSPbYOD`PD`P
;20    1.000E+05 CCDuGLtCHTSPbYOD`PD`P
;==== ELEMENT  21
;21    1.000E-03 SURq@PeCU@@R@@ReDUeCU
;21    1.500E-03 cDRR@PAeU@@R@@RAfUAeU
;21    2.000E-03 ReRB`PhXT@@R@@RxPThXT
;21    3.000E-03 BVRDFPR`T@@R@@RRbTR`T
;21    4.000E-03 BERe@PqAT@@R@@RqCTqAT
;21    4.493E-03 AhRuQPIYS@@R@@RiYSYPS
;21 K  4.493E-03 AhRuQPXCT@@R@@RXETXCT
;21    5.000E-03 qRRf@PfIT@@R@@RvATfIT
;21    6.000E-03 AVRGGPSbT@@R@@RScTSbT
;21    8.000E-03 QARHVPAbT@@R@@RAcTAbT
;21    1.000E-02 HdQIXPIeS@@R@@RYeSIfS
;21    1.500E-02 eRQQBQSCS@@R@@Rc@SSES
;21    2.000E-02 CbQaCQqFS@@R@@RAQSqGS
;21    3.000E-02 BFQqDQDGR@@R@@RDQRd@R
;21    4.000E-02 q@QqHQqPR@@R@@RQgRAdR
;21    5.000E-02 IFPqIQXXQ@@R@@RAIRYgQ
;21    6.000E-02 fXPqIQDhQ@@R@@RVcQfGQ
;21    8.000E-02 DDPqFQQiQ@@R@@RsUQsEQ
;21    1.000E-01 rPPqBQYaP@@R@@RRXQrAQ
;21    1.500E-01 aGPaAQrXP@@R@@RaRQAYQ
;21    2.000E-01 wAOQBQQDP@@R@@RqAQaDQ
;21    3.000E-01 sCOIePsFO@@R@@RAEQABQ
;21    4.000E-01 AiOHfPAWO@@R@@RYIPI@P
;21    5.000E-01 aBOX@PHDN@@R@@RxAPXHP
;21    6.000E-01 HXNWPPEDN@@R@@RgTPWUP
;21    8.000E-01 tXNfPPRVN@@R@@RfWPfSP
;21    1.000E+00 CGNUdPQYN@@R@@RUhPUeP
;21    1.022E+00 RdNEhPQQN@@R@@RUbPEiP
;21    1.250E+00 QfNuAPABNuDM@@RuEPuCP
;21    1.500E+00 qGNDcPwHMrYN@@RDhPDfP
;21    2.000E+00 gXMTBPTWMAIO@@RdDPdDP
;21    2.044E+00 wEMDGPDRMQGO@@Rd@PTIP
;21    3.000E+00 CQMcDPRPMCDOQDMSUPSUP
;21    4.000E+00 QbMrQPaYMDhOdSMc@Pc@P
;21    5.000E+00 aCMrDPaGMVQOiCMC@PC@P
;21    6.000E+00 XTLBGPAAMWfOARNBhPBhP
;21    7.000E+00 fGLAfPHRLiFOQaNB`PB`P
;21    8.000E+00 D`LaYPWILADPrINrVPrVP
;21    9.000E+00 sYLQUPfGLQEPBeNrSPrSP
;21    1.000E+01 CGLATPUVLaDPcHNrRPrRP
;21    1.100E+01 RTLqDPE@LqCPsPNrQPrQP
;21    1.200E+01 RCLaFPTSLAQPDINrQPrQP
;21    1.300E+01 AbLQIPTELAXPDVNrQPrQP
;21    1.400E+01 QWLQBPCbLQUPDaNrRPrRP
;21    1.500E+01 qGLAGPSTLaRPUDNrSPrSP
;21    1.600E+01 a@LAAPs@LaXPEVNrUPrUP
;21    1.800E+01 IYKiGORaLqYPFENrWPrWP
;21    2.000E+01 gXKXUObPLAhPVYNB`PB`P
;21    2.200E+01 vEKWdOrELQgPGHNBdPBdP
;21    2.400E+01 uDKGRORDLBEPWTNBgPBgP
;21    2.600E+01 TUKVgOQgLRCPWfNR`PR`P
;21    2.800E+01 SbKVWOAbLRIPxENRdPRdP
;21    3.000E+01 CRKfBOaYLbFPxRNRgPRgP
;21    4.000E+01 QbKTeOaELRQPABOSAPSAP
;21    5.000E+01 aCKTCOYeKrQPQDOcCPcCP
;21    6.000E+01 XTJSVOhEKBfPaDOsDPsDP
;21    8.000E+01 D`JBaOVEKCHPqHOSPPSPP
;21    1.000E+02 CGJrCOT`KcDPAYOcRPcRP
;21    1.500E+02 qGJaVOcEKSPPaWOCcPCcP
;21    2.000E+02 gXIq@OBSKcVPqYOSgPSgP
;21    3.000E+02 CQIiANaRKCePQcOTCPTCP
;21    4.000E+02 QbIgBNaAKSePBBOdCPdCP
;21    5.000E+02 aCIUgNiYJDCPBHOt@Pt@P
;21    6.000E+02 XTHUANHGJDHPRCOtDPtDP
;21    8.000E+02 D`HSiNFEJTEPRIODQPDQP
;21    1.000E+03 CGHcINDdJd@PbDODUPDUP
;21    1.500E+03 qGHbINcBJdFPr@OTRPTRP
;21    2.000E+03 gXGqXNBRJt@PrDOTUPTUP
;21    3.000E+03 CQGaDNaQJtDPrHOTYPTYP
;21    4.000E+03 QbGYSMaAJtFPBQOdQPdQP
;21    5.000E+03 aCGwYMiVItHPBROdSPdSP
;21    6.000E+03 XTFfQMHEItHPBTOdSPdSP
;21    8.000E+03 D`FEIMFDIDPPBUOdUPdUP
;21    1.000E+04 CGFTFMDcIDPPBVOdUPdUP
;21    1.500E+04 qGFBgMcBIDRPBWOdWPdWP
;21    2.000E+04 gXEbAMBRIDRPBXOdWPdWP
;21    3.000E+04 CQEQRMaQIDSPBYOdXPdXP
;21    4.000E+04 QbEQGMaAIDSPBYOdXPdXP
;21    5.000E+04 aCEYRLiVHDSPRPOdXPdXP
;21    6.000E+04 XTDHELHEHDSPRPOdXPdXP
;21    8.000E+04 D`DVGLFDHDTPRPOdYPdYP
;21    1.000E+05 CGDEBLDcHDTPRPOdYPdYP
;==== ELEMENT  22
;22    1.000E-03 cYRQHPEfU@@R@@REgUEfU
;22    1.500E-03 sIRQePBIU@@R@@RR@UBIU
;22    2.000E-03 CIRbRPIcT@@R@@RIfTIcT
;22    3.000E-03 RXRCdPs@T@@R@@RsBTs@T
;22    4.000E-03 RFRTdPQPT@@R@@RQRTQPT
;22    4.966E-03 AbREhPXIS@@R@@RxHSh@S
;22 K  4.966E-03 AbREhPFfT@@R@@RFhTFfT
;22    5.000E-03 AaRUaPFbT@@R@@RFdTFbT
;22    6.000E-03 QTRvWPtAT@@R@@RtBTtAT
;22    8.000E-03 QFRXFPBAT@@R@@RBBTBAT
;22    1.000E-02 i@QYIPQ@T@@R@@RQATQ@T
;22    1.500E-02 EeQAIQSRS@@R@@RSYSSSS
;22    2.000E-02 DAQa@QQSS@@R@@RQYSQUS
;22    3.000E-02 RGQqAQdRR@@R@@RTgRtUR
;22    4.000E-02 qGQqEQQdR@@R@@RbARBHR
;22    5.000E-02 YSPqFQIbQ@@R@@RaARQBR
;22    6.000E-02 GBPqFQePQ@@R@@RgVQVfQ
;22    8.000E-02 dFPqCQr@Q@@R@@RDEQcSQ
;22    1.000E-01 BePaIQQDQ@@R@@RrRQBTQ
;22    1.500E-01 qDPQIQcCP@@R@@RaUQQQQ
;22    2.000E-01 wUOQ@QqCP@@R@@RqAQaDQ
;22    3.000E-01 SSOiXPSbO@@R@@RADQAAQ
;22    4.000E-01 BAOxQPqRO@@R@@RIHPHhP
;22    5.000E-01 aIOWgPIPN@@R@@RXIPHFP
;22    6.000E-01 IANwHPU`N@@R@@RWSPGTP
;22    8.000E-01 EHNFYPC@N@@R@@RVWPVRP
;22    1.000E+00 cFNEdPAgN@@R@@REiPEfP
;22    1.022E+00 SBNuXPqWN@@R@@REcPE`P
;22    1.250E+00 BINeBPa@NUWM@@ReFPeDP
;22    1.500E+00 AUNtUPhTMR`N@@RD`PtYP
;22    2.000E+00 XFMDEPuEMQBO@@RTHPTGP
;22    2.044E+00 GaMD@PUGMaAO@@RTDPTCP
;22    3.000E+00 cSMSIPRbMSCOQBMSQPSQP
;22    4.000E+00 BDMbVPQgMECOTVMSGPSGP
;22    5.000E+00 qAMr@PAXMvQOIHMRhPRhP
;22    6.000E+00 IGLBCPQHMh@OqINBgPBgP
;22    7.000E+00 fWLAcPIaLYSOAhNB`PB`P
;22    8.000E+00 U@LaVPxHLAGPrENrVPrVP
;22    9.000E+00 DCLQSPwALQHPB`NrTPrTP
;22    1.000E+01 cGLAQPFXLaHPcCNrSPrSP
;22    1.100E+01 rPLqBPEbLqGPcTNrSPrSP
;22    1.200E+01 bGLaDPeHLAUPDBNrSPrSP
;22    1.300E+01 QcLQGPDcLQSPtHNrTPrTP
;22    1.400E+01 aWLQ@PDULaPPtSNrUPrUP
;22    1.500E+01 AULAEPTBLaVPEFNrVPrVP
;22    1.600E+01 aHLYhOCdLqRPuGNrXPrXP
;22    1.800E+01 AALYBOsHLAdPUeNBaPBaP
;22    2.000E+01 XGKHQOCBLQdPFWNBdPBdP
;22    2.200E+01 vUKGaOrSLBCPVfNBhPBhP
;22    2.400E+01 eWKw@OBYLRAPGQNRbPRbP
;22    2.600E+01 DcKFeObILRIPGbNRePReP
;22    2.800E+01 TGKFVORALbFPhANRiPRiP
;22    3.000E+01 cSKVBOQgLrBPXWNCBPCBP
;22    4.000E+01 BDKDgOAVLRYPAAOSGPSGP
;22    5.000E+01 qAKDFOQFLrXPQBOs@Ps@P
;22    6.000E+01 IGJSPOYYKRdPaAOCQPCQP
;22    8.000E+01 U@JrVOWEKSGPqFOSXPSXP
;22    1.000E+02 cGJbIOuPKsCPAVOsQPsQP
;22    1.500E+02 AUJaSOsXKcPPaTOSbPSbP
;22    2.000E+02 XGIaHOBcKsVPqUODFPDFP
;22    3.000E+02 cSIIFNAhKSePAiOdCPdCP
;22    4.000E+02 BDIW@NAQKDFPQhOtCPtCP
;22    5.000E+02 qAIEhNQCKTDPBDODPPDPP
;22    6.000E+02 IGHECNyHJTIPBIODUPDUP
;22    8.000E+02 U@HScNGCJdFPREOTRPTRP
;22    1.000E+03 cGHcCNeRJtAPRIOTVPTVP
;22    1.500E+03 AUHbFNsUJtHPbEOdRPdRP
;22    2.000E+03 XGGqUNBaJDQPbIOdVPdVP
;22    3.000E+03 cSGaANAgJDUPrCOtPPtPP
;22    4.000E+03 BDGyHMAPJDXPrFOtRPtRP
;22    5.000E+03 qAGgWMQBJDYPrGOtSPtSP
;22    6.000E+03 IGFVPMyFITPPrHOtTPtTP
;22    8.000E+03 U@FEAMGBITQPrIOtVPtVP
;22    1.000E+04 cGFDIMeQITRPBPOtVPtVP
;22    1.500E+04 AUFBcMsTITSPBROtWPtWP
;22    2.000E+04 XGERGMBaITTPBROtXPtXP
;22    3.000E+04 cSEQPMAgITTPBSOtYPtYP
;22    4.000E+04 BDEQEMAPITUPBTOtYPtYP
;22    5.000E+04 qAEyGLQBITUPBTOtYPtYP
;22    6.000E+04 IGDWbLyFHTUPBTOtYPtYP
;22    8.000E+04 U@DFGLGBHTUPBTOD`PD`P
;22    1.000E+05 cGDTdLeQHTUPBTOD`PD`P
;==== ELEMENT  23
;23    1.000E-03 CbRAGPFYU@@R@@RVPUFYU
;23    1.500E-03 SRRA`PrDU@@R@@RrDUrDU
;23    2.000E-03 cCRBSPQ@U@@R@@RQAUQ@U
;23    3.000E-03 rQRSYPsRT@@R@@RsTTsRT
;23    4.000E-03 bGRdUPaYT@@R@@RqQTaYT
;23    5.000E-03 QaRePPIIS@@R@@RiISY@S
;23    5.465E-03 qWRF@PGIS@@R@@RgHSW@S
;23 K  5.465E-03 qWRF@PEeT@@R@@REgTEeT
;23    6.000E-03 aRRFSPdWT@@R@@RdYTdWT
;23    8.000E-03 aBRGaPb@T@@R@@RbBTb@T
;23    1.000E-02 iQQHfPaAT@@R@@RaBTaAT
;23    1.500E-02 FIQAFQSaS@@R@@RShSSbS
;23    2.000E-02 TIQQFQqQS@@R@@RqWSqSS
;23    3.000E-02 bHQaHQeAR@@R@@RUVRuDR
;23    4.000E-02 ATQqBQb@R@@R@@RBWRrCR
;23    5.000E-02 YiPqCQQAR@@R@@RqERaER
;23    6.000E-02 wGPqCQvGQ@@R@@RHTQwPQ
;23    8.000E-02 DXPq@QbRQ@@R@@RtGQSbQ
;23    1.000E-01 C@PaGQqAQ@@R@@RBhQRXQ
;23    1.500E-01 AQPQGQsQP@@R@@RaXQQTQ
;23    2.000E-01 XHOAHQQSP@@R@@RqBQaDQ
;23    3.000E-01 sSOYQPTSO@@R@@RACQYfP
;23    4.000E-01 RBOXUPQiO@@R@@RXgPxUP
;23    5.000E-01 qGOGcPAIO@@R@@RHGPWdP
;23    6.000E-01 YSNgEPFdN@@R@@RGQPwBP
;23    8.000E-01 uHNvHPCXN@@R@@RFWPFQP
;23    1.000E+00 CUNuTPRFN@@R@@RuYPuVP
;23    1.022E+00 s@NeXPBEN@@R@@RuSPuPP
;23    1.250E+00 bANUCPqINuYM@@RUGPUEP
;23    1.500E+00 QSNdWPA@NC@N@@RtRPtQP
;23    2.000E+00 hTMShPf@MQFO@@RTAPTAP
;23    2.044E+00 hGMScPUiMaEO@@RDGPDGP
;23    3.000E+00 CdMSDPsHMcBOQ@MCWPCVP
;23    4.000E+00 RFMbQPbHMUGODXMSDPSDP
;23    5.000E+00 qHMbFPqQMFiOXbMRfPRfP
;23    6.000E+00 iPLB@PqFMHROqGNBfPBeP
;23    7.000E+00 GELqYPQCMyYOAeNrYPrYP
;23    8.000E+00 EPLaSPiWLQ@PrANrVPrVP
;23    9.000E+00 dGLQPPHSLaAPrUNrTPrTP
;23    1.000E+01 CVLqIPGWLqAPSGNrTPrTP
;23    1.100E+01 BfLq@PvQLAPPSWNrTPrTP
;23    1.200E+01 BPLaBPFILAYPSeNrUPrTP
;23    1.300E+01 BELQEPUWLQWPtANrVPrVP
;23    1.400E+01 qVLAHPUCLaTPdTNrWPrWP
;23    1.500E+01 QTLACPtULqQPTgNrYPrYP
;23    1.600E+01 qELI`ODSLqWPeGNB`PB`P
;23    1.800E+01 AGLXfOS`LAhPEdNBdPBdP
;23    2.000E+01 hTKhFOCXLQiPvFNBhPBhP
;23    2.200E+01 WDKgWOSDLBHPFdNRbPRbP
;23    2.400E+01 F@KWGOBgLRGPgHNRfPRfP
;23    2.600E+01 UAKvSObSLbDPgXNRiPRiP
;23    2.800E+01 DQKvEOBTLrAPHFNCCPCCP
;23    3.000E+01 CdKFAObGLrHPHQNCGPCGP
;23    4.000E+01 RFKtXOaXLbUPIhNcCPcCP
;23    5.000E+01 qHKSiOqCLBePQ@OsFPsFP
;23    6.000E+01 iPJCTOQ@LCAPQIOCWPCWP
;23    8.000E+01 EPJrQOhCKcDPqCOcUPcUP
;23    1.000E+02 CVJbEOVVKCQPASOsXPsXP
;23    1.500E+02 QTJaPOtEKcXPaQODAPDAP
;23    2.000E+02 hTIaFOcFKCePqROTEPTEP
;23    3.000E+02 CdIXaNRGKDEPAeOtBPtBP
;23    4.000E+02 RFIVgNaRKTFPQdODRPDRP
;23    5.000E+02 qHIuWNq@KdCPB@ODYPDYP
;23    6.000E+02 iPHTdNAHKdIPBDOTTPTTP
;23    8.000E+02 EPHCfNX@JtFPR@OdQPdQP
;23    1.000E+03 CVHSHNFWJDQPRDOdUPdUP
;23    1.500E+03 QTHbBNtAJDXPb@OtRPtRP
;23    2.000E+03 hTGqRNcCJTQPbDOtUPtUP
;23    3.000E+03 CdGQINRFJTUPbHOtYPtYP
;23    4.000E+03 RFGiAMaRJTXPr@ODbPDbP
;23    5.000E+03 qHGWSMaIJTYPrAODcPDcP
;23    6.000E+03 iPFvIMAHJdPPrBODdPDdP
;23    8.000E+03 EPFTbMHHIdQPrDODePDeP
;23    1.000E+04 CVFDBMFWIdRPrDODfPDfP
;23    1.500E+04 QTFrXMtAIdSPrFODgPDgP
;23    2.000E+04 hTERCMcCIdTPrFODgPDgP
;23    3.000E+04 CdEAWMRFIdTPrGODhPDhP
;23    4.000E+04 RFEQCMaRIdUPrGODhPDhP
;23    5.000E+04 qHEiALaIIdUPrHODiPDiP
;23    6.000E+04 iPDwXLAHIdUPrHODiPDiP
;23    8.000E+04 EPDUgLHHHdUPrHODiPDiP
;23    1.000E+05 CVDDfLFVHdUPrHODiPDiP
;==== ELEMENT  24
;24    1.000E-03 TDRXTOGPU@@R@@RGPUGPU
;24    1.500E-03 CfRAYPbYU@@R@@RbYUbYU
;24    2.000E-03 SWRRAPaGU@@R@@RaHUaGU
;24    3.000E-03 CBRcHPtAT@@R@@RtDTtAT
;24    4.000E-03 RSRtFPQfT@@R@@RQiTQfT
;24    5.000E-03 RCRuCPAFT@@R@@RAHTAFT
;24    5.989E-03 AaRVIPvIS@@R@@RVWSvIS
;24 K  5.989E-03 AaRVIPUDT@@R@@RUFTUDT
;24    6.000E-03 A`Rf@PUDT@@R@@RUFTUDT
;24    8.000E-03 qERgVPRPT@@R@@RRQTRPT
;24    1.000E-02 AERxXPqHT@@R@@RqITqHT
;24    1.500E-02 fSQAFQDYS@@R@@RTWSTQS
;24    2.000E-02 TWQQGQQhS@@R@@RBDSQiS
;24    3.000E-02 BYQaIQFFR@@R@@RFSRVHR
;24    4.000E-02 QWQqDQRVR@@R@@RBfRrPR
;24    5.000E-02 AIQqFQqAR@@R@@RQURATR
;24    6.000E-02 HEPqEQGXQ@@R@@RiTQHcQ
;24    8.000E-02 T`PqCQCIQ@@R@@RT`QDQQ
;24    1.000E-01 cIPaIQQUQ@@R@@RSGQBdQ
;24    1.500E-01 QUPQIQDPP@@R@@RqYQaSQ
;24    2.000E-01 XhOQAQAbP@@R@@RqHQaIQ
;24    3.000E-01 T@OyRPEPO@@R@@RAGQACQ
;24    4.000E-01 rCOxTPrHO@@R@@RiAPXhP
;24    5.000E-01 QPOH@Pq@O@@R@@RhHPXCP
;24    6.000E-01 AEOGQPXHN@@R@@RgPPGYP
;24    8.000E-01 UaNVRPTFN@@R@@RfRPVVP
;24    1.000E+00 sYNEgPRYN@@R@@RUcPEiP
;24    1.022E+00 cSNE`PBVN@@R@@REfPEcP
;24    1.250E+00 BSNeEPaVNfFM@@ReIPeGP
;24    1.500E+00 aYNtWPa@NcBN@@RDcPDaP
;24    2.000E+00 YPMDGPGQMaDO@@RdAPd@P
;24    2.044E+00 IIMDBPWFMqDO@@RTGPTFP
;24    3.000E+00 dBMc@PDCMCUOQBMSVPSUP
;24    4.000E+00 rHMbWPrRMUROTXMcCPcCP
;24    5.000E+00 QRMrAPBDMwEOYBMCFPCFP
;24    6.000E+00 AFMBDPaRMXhOAPNRfPReP
;24    7.000E+00 wVLAcPqEMADPAiNR`PR`P
;24    8.000E+00 UdLaWPQEMQGPrFNBgPBgP
;24    9.000E+00 dYLQSPA@MaIPBaNBfPBfP
;24    1.000E+01 C`LARPX`LAPPcDNBfPBeP
;24    1.100E+01 SDLqCPWiLQPPcUNBfPBfP
;24    1.200E+01 bTLaDPgDLQYPDDNBgPBgP
;24    1.300E+01 bELQGPfSLaWPDPNBhPBhP
;24    1.400E+01 QdLQAPV@LqUPtUNR`PR`P
;24    1.500E+01 aYLAEPeVLAbPEHNRbPRbP
;24    1.600E+01 AXLA@PeGLAhPuINRdPRdP
;24    1.800E+01 QGLYFOdTLBAPUgNRhPRhP
;24    2.000E+01 YPKHUOTDLRBPVPNCCPCCP
;24    2.200E+01 GeKGeOsTLbBPVhNCGPCGP
;24    2.400E+01 fPKwCOCQLrAPGSNSAPSAP
;24    2.600E+01 eRKFhOSCLrIPGeNSFPSFP
;24    2.800E+01 DeKFYOR`LBVPhCNc@Pc@P
;24    3.000E+01 dBKVEObYLRTPXYNcDPcDP
;24    4.000E+01 rHKDiOB@LBbPAAOCQPCQP
;24    5.000E+01 QRKDHOQXLCDPQBOSVPSVP
;24    6.000E+01 AFKSQOqALc@PaBOcXPcXP
;24    8.000E+01 UdJrWOyYKCUPqFOCgPCgP
;24    1.000E+02 C`Jr@OG`KcSPAVODAPDAP
;24    1.500E+02 aYJaTOUGKSbPaTOdEPdEP
;24    2.000E+02 YPIaHOCgKT@PqUODPPDPP
;24    3.000E+02 dBIY@NRWKt@PAiOTXPTXP
;24    4.000E+02 rHIWCNQcKDRPQgOdYPdYP
;24    5.000E+02 QRIU`NQTKTPPBCOtVPtVP
;24    6.000E+02 AFIEENaHKTVPBGODbPDbP
;24    8.000E+02 UdHSeNiRJdSPRCODiPDiP
;24    1.000E+03 C`HcENgYJdXPRGOTcPTcP
;24    1.500E+03 aYHbGNUCJtUPbCOE@PE@P
;24    2.000E+03 YPGqUNCdJtYPbFOEDPEDP
;24    3.000E+03 dBGaBNRVJDdPr@OEHPEHP
;24    4.000E+03 rHGIRMQbJDfPrBOU@PU@P
;24    5.000E+03 QRGwPMQTJDgPrCOUAPUAP
;24    6.000E+03 AFGVSMaHJDhPrDOUBPUBP
;24    8.000E+03 UdFECMiPIT`PrFOUDPUDP
;24    1.000E+04 C`FTAMgXIT`PrGOUDPUDP
;24    1.500E+04 aYFBdMUBITbPrHOUFPUFP
;24    2.000E+04 YPERHMCdITbPrHOUFPUFP
;24    3.000E+04 dBEQQMRVITcPrIOUGPUGP
;24    4.000E+04 rHEQFMQbITcPrIOUGPUGP
;24    5.000E+04 QREIQLQTITcPBPOUGPUGP
;24    6.000E+04 AFEWfLaHITdPBPOUHPUHP
;24    8.000E+04 UdDV@LiPHTdPBPOUHPUHP
;24    1.000E+05 C`DTfLgXHTdPBPOUHPUHP
;==== ELEMENT  25
;25    1.000E-03 dDRiDOHIU@@R@@RHIUHIU
;25    1.500E-03 SeRQYPRhU@@R@@RRhURhU
;25    2.000E-03 cURRIPARU@@R@@RARUARU
;25    3.000E-03 CIRcHPDbT@@R@@RDeTDbT
;25    4.000E-03 bQRdHPb@T@@R@@RbCTb@T
;25    5.000E-03 bARUIPQIT@@R@@RaATQIT
;25    6.000E-03 AhRFAPWFS@@R@@RwESWFS
;25    6.539E-03 qTRFRPeRS@@R@@RE`SeSS
;25 K  6.539E-03 qTRFRPTPT@@R@@RTRTTPT
;25    8.000E-03 AQRGQPrRT@@R@@RrSTrRT
;25    1.000E-02 Q@RXRPQPT@@R@@RQQTQPT
;25    1.500E-02 FhQADQTeS@@R@@RECSTfS
;25    2.000E-02 tVQQEQRIS@@R@@RbESb@S
;25    3.000E-02 bQQaGQvUR@@R@@RWDRFhR
;25    4.000E-02 aUQqBQBgR@@R@@RSGRC@R
;25    5.000E-02 QDQqCQAWR@@R@@RqQRaPR
;25    6.000E-02 HTPqCQHRQ@@R@@RAFRyUQ
;25    8.000E-02 UEPqAQCYQ@@R@@RuAQtYQ
;25    1.000E-01 CUPaGQqUQ@@R@@RsGQCBQ
;25    1.500E-01 aSPQHQE@P@@R@@RAdQaXQ
;25    2.000E-01 IUOAIQBGP@@R@@RqIQq@Q
;25    3.000E-01 tBOYWPVGO@@R@@RAFQABQ
;25    4.000E-01 BVOhQPrRO@@R@@RYCPHiP
;25    5.000E-01 QYOGhPAYO@@R@@RXIPHCP
;25    6.000E-01 Q@Ow@PyIN@@R@@RWQPGPP
;25    8.000E-01 fDNFSPtXN@@R@@RVTPFWP
;25    1.000E+00 D@NuXPRgN@@R@@REePEaP
;25    1.022E+00 CcNuRPBbN@@R@@RuYPuUP
;25    1.250E+00 RVNUGPQaNVRM@@ReBPe@P
;25    1.500E+00 qXNtPPqHNsDN@@RtWPtUP
;25    2.000E+00 A@NDBPHYMaHO@@RTFPTEP
;25    2.044E+00 iPMSfPh@MqHO@@RTBPTAP
;25    3.000E+00 DVMSFPdRMSUOQAMSRPSRP
;25    4.000E+00 RQMbTPSAMeWOTQMcAPcAP
;25    5.000E+00 aPMbHPrCMWUOXiMCDPCDP
;25    6.000E+00 QAMBAPAfMiBOqHNRePReP
;25    7.000E+00 XILAaPQTMAGPAfNR`PR`P
;25    8.000E+00 fGLaUPqBMa@PrCNBhPBgP
;25    9.000E+00 TeLQQPQEMqCPrWNBgPBgP
;25    1.000E+01 DALAPPABMATPc@NBgPBgP
;25    1.100E+01 sBLqAPYBLQTPcPNBhPBhP
;25    1.200E+01 rYLaCPhGLaSPShNBiPBiP
;25    1.300E+01 rHLQFPWVLqQPtDNRaPRaP
;25    1.400E+01 BELAIPVgLqYPdXNRcPRcP
;25    1.500E+01 qXLADPFVLAfPE@NRePReP
;25    1.600E+01 QWLIhOFBLQcPuANRgPRgP
;25    1.800E+01 aDLICOeILBFPEhNCBPCBP
;25    2.000E+01 A@LxCOtRLRGPFPNCGPCGP
;25    2.200E+01 hIKwTOdGLbGPFhNSAPSAP
;25    2.400E+01 VgKgCOCiLrFPwBNSFPSFP
;25    2.600E+01 UdKvYOSWLBUPwSNcAPcAP
;25    2.800E+01 UBKFPOs@LRSPXANcEPcEP
;25    3.000E+01 DVKFFOCGLbPPHWNcIPcIP
;25    4.000E+01 RQKDbObGLBiPYdNCWPCWP
;25    5.000E+01 aQKDBOAaLSAPQAOcSPcSP
;25    6.000E+01 QAKCVOQPLcHPa@OsUPsUP
;25    8.000E+01 fGJrSOQBLSTPqDOSePSeP
;25    1.000E+02 DAJbGOHiKsRPATODIPDIP
;25    1.500E+02 qXJaQOU`KDBPaQOtDPtDP
;25    2.000E+02 A@JaGODQKd@PqRODYPDYP
;25    3.000E+02 DVIXhNRcKDPPAeOdXPdXP
;25    4.000E+02 RQIGCNb@KTSPQdOtYPtYP
;25    5.000E+02 aQIEbNqVKdQPQiODfPDfP
;25    6.000E+02 QAIThNAVKdVPBCOTbPTbP
;25    8.000E+02 fGHCiNQ@KtTPBIOTiPTiP
;25    1.000E+03 DAHc@NxWJtYPRCOEDPEDP
;25    1.500E+03 qXHbDNEdJDfPRIOU@PU@P
;25    2.000E+03 A@HqSNtHJT`PbCOUDPUDP
;25    3.000E+03 DVGa@NRbJTdPbFOUHPUHP
;25    4.000E+03 RQGiIMRIJTgPbHOeAPeAP
;25    5.000E+03 aQGWYMqUJThPr@OeBPeBP
;25    6.000E+03 QAGFTMAVJTiPrAOeCPeCP
;25    8.000E+03 fGFTfMAIJEAPrBOeDPeDP
;25    1.000E+04 DAFDEMxUIEAPrCOeEPeEP
;25    1.500E+04 qXFB`MEdIEBPrDOeFPeFP
;25    2.000E+04 A@FREMtHIECPrDOeGPeGP
;25    3.000E+04 DVEAXMRbIEDPrEOeGPeGP
;25    4.000E+04 RQEQDMRIIEDPrEOeHPeHP
;25    5.000E+04 aQEiHLqUIEDPrFOeHPeHP
;25    6.000E+04 QAEGdLAVIEDPrFOeHPeHP
;25    8.000E+04 fGDFALAIIEEPrFOeHPeHP
;25    1.000E+05 DADDiLxUHEEPrFOeHPeHP
;==== ELEMENT  26
;26    1.000E-03 TTRxXOIHU@@R@@RIIUIHU
;26    1.500E-03 dDRQSPCPU@@R@@RCPUCPU
;26    2.000E-03 ScRRBPaRU@@R@@RaSUaRU
;26    3.000E-03 sERcAPUTT@@R@@RUXTUTT
;26    4.000E-03 BeRdAPRTT@@R@@RRWTRTT
;26    5.000E-03 BRRUCPqGT@@R@@RAPTqGT
;26    6.000E-03 BFRUgPhGS@@R@@RHXShHS
;26    7.112E-03 qTRF`PUDS@@R@@RuBSUES
;26 K  7.112E-03 qTRF`PDFT@@R@@RDHTDFT
;26    8.000E-03 QTRGPPCDT@@R@@RCFTCDT
;26    1.000E-02 a@RXTPaYT@@R@@RqQTaYT
;26    1.500E-02 GVQAEQeRS@@R@@RuQSeSS
;26    2.000E-02 UGQQFQRPS@@R@@RRWSRRS
;26    3.000E-02 BeQaIQwVR@@R@@RXHRGiR
;26    4.000E-02 A`QqDQsBR@@R@@RcSRCUR
;26    5.000E-02 aDQqFQqPR@@R@@RQfRAcR
;26    6.000E-02 YHPqFQyXQ@@R@@Ra@RQAR
;26    8.000E-02 ePPqCQDFQ@@R@@RUeQuIQ
;26    1.000E-01 sWPq@QBDQ@@R@@RsRQsDQ
;26    1.500E-01 qXPa@QEfP@@R@@RQfQqYQ
;26    2.000E-01 ACPQAQBSP@@R@@RAVQqFQ
;26    3.000E-01 tSOyYPgGO@@R@@RQ@QAEQ
;26    4.000E-01 bYOHaPcAO@@R@@RIPPYCP
;26    5.000E-01 qTOHFPqVO@@R@@RHQPhDP
;26    6.000E-01 aAOGWPQAO@@R@@RwPPWXP
;26    8.000E-01 FcNVWPeUN@@R@@RvPPfSP
;26    1.000E+00 tHNUbPSQN@@R@@RUiPUeP
;26    1.022E+00 d@NEePsDN@@R@@RUcPEiP
;26    1.250E+00 BaNeIPbFNGCM@@RuEPuBP
;26    1.500E+00 QeNDaPaSNSXN@@RDhPDfP
;26    2.000E+00 Q@NTAPA@NqFO@@RdFPdEP
;26    2.044E+00 AENDFPiYMAWO@@RdBPdAP
;26    3.000E+00 DhMcCPEUMsXOQCMcRPcRP
;26    4.000E+00 rUMrPPcWMFDOdRMsAPsAP
;26    5.000E+00 qVMrCPrUMHCOi@MSEPSDP
;26    6.000E+00 aBMBFPRIMIaOAQNCFPCFP
;26    7.000E+00 XgLAePAaMQDPQ`NCAPCAP
;26    8.000E+00 FgLaXPQUMaHPrHNRiPRiP
;26    9.000E+00 ESLQUPqEMAQPBdNRiPRiP
;26    1.000E+01 DPLASPa@MQSPcGNRiPRiP
;26    1.100E+01 cSLqDPAGMaSPcXNCAPCAP
;26    1.200E+01 CELaEPySLqSPDGNCBPCBP
;26    1.300E+01 bPLQHPHiLAbPDTNCDPCDP
;26    1.400E+01 bDLQBPXILQ`PtXNCGPCGP
;26    1.500E+01 QeLAFPWYLQhPUANCIPCIP
;26    1.600E+01 qRLAAPGGLBEPESNSBPSBP
;26    1.800E+01 qFLiDOfBLRIPFANSGPSGP
;26    2.000E+01 Q@LXROUULrAPVUNcBPcBP
;26    2.200E+01 IHKWaOEBLBQPGDNcHPcHP
;26    2.400E+01 gSKGPOTWLRQPGYNsCPsCP
;26    2.600E+01 VPKVdOd@LbPPW`NsHPsHP
;26    2.800E+01 eQKVUOChLbYPhINCRPCRP
;26    3.000E+01 DiKf@OcQLrVPhUNCWPCWP
;26    4.000E+01 rUKTcObWLCGPABOcWPcWP
;26    5.000E+01 qVKTAORBLs@PQCOCcPCcP
;26    6.000E+01 aBKSTOqVLCXPaBOSfPSfP
;26    8.000E+01 FgJB`OqALsVPqGOTGPTGP
;26    1.000E+02 DPJrBOADLSePAWOtCPtCP
;26    1.500E+02 QeJaUOVcKdFPaTOTYPTYP
;26    2.000E+02 Q@Jq@OUHKDUPqUOtVPtVP
;26    3.000E+02 DhIYHNCUKdWPAiOTePTeP
;26    4.000E+02 rUIWINRXKD`PQgOEGPEGP
;26    5.000E+02 qVIUeNBFKDhPBCOUEPUEP
;26    6.000E+02 aBIU@NqRKTdPBGOe@Pe@P
;26    8.000E+02 FgHShNaIKECPRCOeHPeHP
;26    1.000E+03 DPHcGNACKEHPRGOuCPuCP
;26    1.500E+03 QeHbINFfJUEPbCOEPPEPP
;26    2.000E+03 Q@HqWNUDJUIPbFOETPETP
;26    3.000E+03 DhGaCNCSJeDPr@OEXPEXP
;26    4.000E+03 rUGYPMRWJeFPrBOUPPUPP
;26    5.000E+03 qVGwWMBFJeHPrCOURPURP
;26    6.000E+03 aBGVYMqQJeIPrDOUSPUSP
;26    8.000E+03 FgFEHMaIJu@PrFOUTPUTP
;26    1.000E+04 DPFTDMACJuAPrFOUUPUUP
;26    1.500E+04 QeFBfMFeIuBPrHOUWPUWP
;26    2.000E+04 Q@Fb@MUDIuCPrHOUWPUWP
;26    3.000E+04 DhEQRMCSIuDPrIOUXPUXP
;26    4.000E+04 rUEQGMRWIuDPrIOUXPUXP
;26    5.000E+04 qVEIYLBFIuDPrIOUXPUXP
;26    6.000E+04 aBEHBLqQIuEPBPOUYPUYP
;26    8.000E+04 FgDVELaIIuEPBPOUYPUYP
;26    1.000E+05 DPDEALACIuEPBPOUYPUYP
;==== ELEMENT  27
;27    1.000E-03 dVRHDOyYU@@R@@RI`UyYU
;27    1.500E-03 tGRARPcYU@@R@@RsPUcYU
;27    2.000E-03 DGRQhPqWU@@R@@RqXUqWU
;27    3.000E-03 CYRCBPFIT@@R@@RVCTFIT
;27    4.000E-03 RhRSiPB`T@@R@@RBcTB`T
;27    5.000E-03 RTRDhPQRT@@R@@RQTTQRT
;27    6.000E-03 RGReYPYES@@R@@RyGSYES
;27    7.709E-03 aYRVaPTTS@@R@@RtQSTTS
;27 K  7.709E-03 aYRVaPSTT@@R@@RSVTSTT
;27    8.000E-03 aSRGIPcCT@@R@@RcETcCT
;27    1.000E-02 aFRhCPAcT@@R@@RAdTAcT
;27    1.500E-02 wXQABQVAS@@R@@Rf@SVBS
;27    2.000E-02 uIQQCQrTS@@R@@RB`SrUS
;27    3.000E-02 RhQaFQXTR@@R@@RXfRhVR
;27    4.000E-02 AhQqAQcVR@@R@@RShRsYR
;27    5.000E-02 q@QqCQAhR@@R@@RRDRBAR
;27    6.000E-02 iPPqCQAIR@@R@@RqARaBR
;27    8.000E-02 EfPqAQTRQ@@R@@RFQQEcQ
;27    1.000E-01 SePaGQbHQ@@R@@RSeQSVQ
;27    1.500E-01 AgPQHQVWP@@R@@RBBQAdQ
;27    2.000E-01 AHPAIQrSP@@R@@RAXQqGQ
;27    3.000E-01 TgOiSPXHO@@R@@RAIQADQ
;27    4.000E-01 BcOhWPcRO@@R@@RyAPICP
;27    5.000E-01 AbOWcPQiO@@R@@RxBPXCP
;27    6.000E-01 aGOwEPaEO@@R@@RgPPGXP
;27    8.000E-01 WINFWPvIN@@R@@RfPPVSP
;27    1.000E+00 dQNEbPShN@@R@@RUaPEfP
;27    1.022E+00 DQNuVPsWN@@R@@REdPE`P
;27    1.250E+00 ReNeAPRUNgIM@@ReGPeDP
;27    1.500E+00 BENtSPAdNcYN@@RDaPtYP
;27    2.000E+00 QFNDDPQCNAPO@@Rd@PTIP
;27    2.044E+00 QANSiPQ@NQQO@@RTFPTEP
;27    3.000E+00 UDMSHPVEMCgOQAMSXPSXP
;27    4.000E+00 BiMbUPTDMVHOTTMcHPcHP
;27    5.000E+00 AeMbIPS@MhAOIEMSCPSCP
;27    6.000E+00 aHMBCPBVMA@PqINCEPCDP
;27    7.000E+00 ITLAbPBDMQFPAgNCAPC@P
;27    8.000E+00 gCLaVPqTMqAPrDNRiPRiP
;27    9.000E+00 uQLQRPQRMATPrYNRiPRiP
;27    1.000E+01 dRLAQPqEMQVPcBNC@PC@P
;27    1.100E+01 CbLqBPaAMaWPcRNCBPCBP
;27    1.200E+01 cALaCPAIMqVPD@NCDPCDP
;27    1.300E+01 rTLQFPA@MAePtFNCFPCFP
;27    1.400E+01 rFLQ@PiALQdPtQNCIPCIP
;27    1.500E+01 BFLADPXTLBBPECNSAPSAP
;27    1.600E+01 AaLYeOWfLBIPuDNSDPSDP
;27    1.800E+01 ASLIIOG@LbCPUbNc@Pc@P
;27    2.000E+01 QFLxHOfELrEPFTNcFPcFP
;27    2.200E+01 YVKwYOeTLBVPVbNsAPsAP
;27    2.400E+01 HCKgHOUDLRVPwFNsFPsFP
;27    2.600E+01 FdKFcOtRLbUPwWNCRPCRP
;27    2.800E+01 U`KFUOtFLrTPXFNCWPCWP
;27    3.000E+01 UDKV@ODFLBbPXQNSQPSQP
;27    4.000E+01 BiKDeOC@LSCPYiNsRPsRP
;27    5.000E+01 AeKDEOrILsGPQAOChPChP
;27    6.000E+01 aHKCYOQhLSUPa@ODBPDBP
;27    8.000E+01 gCJrUOAWLCcPqDOdDPdDP
;27    1.000E+02 dRJbHOQGLDCPATODPPDPP
;27    1.500E+02 BFJaSOwXKtDPaQOdWPdWP
;27    2.000E+02 QFJaHOEbKTSPqRODcPDcP
;27    3.000E+02 UDIIDNCgKtVPAeOECPECP
;27    4.000E+02 BiIGHNR`KDiPQcOUEPUEP
;27    5.000E+02 AeIEfNrBKTgPQiOeCPeCP
;27    6.000E+02 aHIEBNQcKECPBCOeHPeHP
;27    8.000E+02 gCHSbNAUKUAPBIOuFPuFP
;27    1.000E+03 dRHcBNQFKUFPRCOEQPEQP
;27    1.500E+03 BFHbENwQJeDPRHOEXPEXP
;27    2.000E+03 QFHqTNuXJeHPbAOURPURP
;27    3.000E+03 UDGaANCeJuCPbEOUVPUVP
;27    4.000E+03 BiGyEMBiJuEPbGOUYPUYP
;27    5.000E+03 AeGgTMrAJuGPbHOePPePP
;27    6.000E+03 aHGFXMQcJuHPbIOeQPeQP
;27    8.000E+03 gCFTiMATJuIPr@OeSPeSP
;27    1.000E+04 dRFDHMQEJEPPrAOeTPeTP
;27    1.500E+04 BFFBbMwPIEQPrBOeUPeUP
;27    2.000E+04 QFFRGMuWIERPrCOeUPeUP
;27    3.000E+04 UDEAYMCeIESPrCOeVPeVP
;27    4.000E+04 BiEQEMBiIESPrDOeVPeVP
;27    5.000E+04 AeEyDLrAIESPrDOeWPeWP
;27    6.000E+04 aHEW`LQcIESPrDOeWPeWP
;27    8.000E+04 gCDFELATIETPrDOeWPeWP
;27    1.000E+05 dRDTcLQEIETPrDOeWPeWP
;==== ELEMENT  28
;28    1.000E-03 EERGaOIeU@@R@@RIfUIeU
;28    1.004E-03 EERGfOyUU@@R@@RyUUyUU
;28    1.008E-03 EERWaOiUU@@R@@RiVUiUU
;28 L1 1.008E-03 EERWaOQ@V@@R@@RQ@VQ@V
;28    1.500E-03 tVRqIPdCU@@R@@RdCUdCU
;28    2.000E-03 DURQfPBDU@@R@@RBEUBDU
;28    3.000E-03 CdRC@PGFT@@R@@RW@TGFT
;28    4.000E-03 cIRShPcET@@R@@RcHTcET
;28    5.000E-03 BbRT`PqVT@@R@@RqYTqVT
;28    6.000E-03 BRRuSPAGT@@R@@RAITAGT
;28    8.000E-03 AaRWGPtVS@@R@@RTeStWS
;28    8.333E-03 qSRwIPdES@@R@@RDSSdES
;28 K  8.333E-03 qSRwIPcHT@@R@@RcITcHT
;28    1.000E-02 AQRxFPBGT@@R@@RBITBHT
;28    1.500E-02 hPQADQVhS@@R@@RGHSG@S
;28    2.000E-02 UeQQFQSES@@R@@RcBSSFS
;28    3.000E-02 s@Qq@QIhR@@R@@RACSA@S
;28    4.000E-02 BHQqFQdFR@@R@@RdPRtIR
;28    5.000E-02 ATQqHQRIR@@R@@RBWRrCR
;28    6.000E-02 AFQqHQaGR@@R@@RQQRAQR
;28    8.000E-02 FXPqFQu@Q@@R@@RwAQfVQ
;28    1.000E-01 tGPqBQbXQ@@R@@RDTQD@Q
;28    1.500E-01 BGPaCQwUP@@R@@RbAQB@Q
;28    2.000E-01 a@PQDQcCP@@R@@RQXQAVQ
;28    3.000E-01 UQOA@QyPO@@R@@RQEQQ@Q
;28    4.000E-01 SDOIBPt@O@@R@@RyVPIUP
;28    5.000E-01 BCOhFPrGO@@R@@RxPPXPP
;28    6.000E-01 AQOgUPAYO@@R@@RWdPG`P
;28    8.000E-01 WhNvTPgPN@@R@@RFiPFaP
;28    1.000E+00 UBNFFPtSN@@R@@RVFPVAP
;28    1.022E+00 T`NF@PDYN@@R@@RFIPFDP
;28    1.250E+00 cHNERPCDNWhM@@REYPEVP
;28    1.500E+00 bHNTcPRINDBN@@REBPTiP
;28    2.000E+00 aHNdAPqENQRO@@RtIPtGP
;28    2.044E+00 aCNTFPq@NaSO@@RtEPtCP
;28    3.000E+00 uQMsAPw@MTIOQFMsUPsTP
;28    4.000E+00 cAMrVPTaMfWOtSMCTPCTP
;28    5.000E+00 BFMrIPcWMHgOIRMcIPcIP
;28    6.000E+00 ASMRAPRbMAHPAUNcAPcAP
;28    7.000E+00 AEMQ`PBRMaEPQeNSGPSGP
;28    8.000E+00 HCLqSPBGMAQPBTNSFPSFP
;28    9.000E+00 vELQYPA`MQUPR`NSGPSGP
;28    1.000E+01 UDLAWPQYMaXPsENSHPSHP
;28    1.100E+01 dELqGPASMA`PsWNcAPcAP
;28    1.200E+01 SWLaIPq@MQ`PTGNcCPcCP
;28    1.300E+01 CDLaAPQHMB@PTTNcFPcFP
;28    1.400E+01 bRLQEPAIMBIPT`NcIPcIP
;28    1.500E+01 bHLAIPAAMRHPeDNsBPsBP
;28    1.600E+01 BALADPIRLbFPUVNsEPsEP
;28    1.800E+01 QYLIWOhHLBQPVFNCQPCQP
;28    2.000E+01 aHLxSOwILRTPvPNCXPCXP
;28    2.200E+01 AFLXAOfWLbUPg@NSTPSTP
;28    2.400E+01 XbKWXOFHLrVPgVNcPPcPP
;28    2.600E+01 gPKWBOUXLBfPHINcUPcUP
;28    2.800E+01 VVKvQOUFLRePHYNsQPsQP
;28    3.000E+01 uQKvFOD`LCCPHfNsVPsVP
;28    4.000E+01 cAKEEOSULsGPADOShPShP
;28    5.000E+01 BFKdBOBbLcSPQFOTGPTGP
;28    6.000E+01 ASKcSOrDLCcPaEOtBPtBP
;28    8.000E+01 HCJBfOqTLTCPqIOTUPTUP
;28    1.000E+02 UDJrHOqILtDPQPOtSPtSP
;28    1.500E+02 bHJaYOi@KdXPaWOEAPEAP
;28    2.000E+02 aHJqCOFhKDhPqYOUIPUIP
;28    3.000E+02 uQIIQNTXKUBPQbOEQPEQP
;28    4.000E+02 cAIwGNCSKeFPB@OUSPUSP
;28    5.000E+02 BFIV@NrTKuEPBFOeQPeQP
;28    6.000E+02 ASIeBNbHKEQPR@OeWPeWP
;28    8.000E+02 HCHDHNqQKUPPRFOuUPuUP
;28    1.000E+03 UDHsFNqGKUUPb@OEaPEaP
;28    1.500E+03 bHHrDNYAJeSPbFOEhPEhP
;28    2.000E+03 aHHAaNFcJeXPbIOUbPUbP
;28    3.000E+03 uQGaFNTUJuRPrCOUgPUgP
;28    4.000E+03 cAGyTMCQJuUPrEOUiPUiP
;28    5.000E+03 BFGWfMrSJuWPrFOFAPFAP
;28    6.000E+03 ASGvUMbHJuXPrGOFBPFBP
;28    8.000E+03 HCFe@MqQJuYPrHOFCPFCP
;28    1.000E+04 UDFdEMqGJE`PrIOFDPFDP
;28    1.500E+04 bHFRcMY@IEaPBPOFFPFFP
;28    2.000E+04 aHFbFMFcIEbPBQOFFPFFP
;28    3.000E+04 uQEQVMTUIEcPBQOFGPFGP
;28    4.000E+04 cAEQIMCQIEcPBROFGPFGP
;28    5.000E+04 BFEySLrSIEcPBROFHPFHP
;28    6.000E+04 ASEhBLbHIEcPBROFHPFHP
;28    8.000E+04 HCDvALqQIEdPBROFHPFHP
;28    1.000E+05 UDDUCLqGIEdPBROFHPFHP
;==== ELEMENT  29
;29    1.000E-03 EERUaOAFV@@R@@RAFVAFV
;29    1.047E-03 ECRvFOyCU@@R@@RyCUyCU
;29    1.096E-03 EARFdOhDU@@R@@RhEUhDU
;29 L1 1.096E-03 EARFdOyDU@@R@@RyEUyDU
;29    1.500E-03 DaRAIPDQU@@R@@RDRUDQU
;29    2.000E-03 TSRQYPREU@@R@@RREUREU
;29    3.000E-03 SeRRYPGUT@@R@@RGYTGUT
;29    4.000E-03 CPRSSPCTT@@R@@RCWTCTT
;29    5.000E-03 RaRtIPAgT@@R@@RQ`TAgT
;29    6.000E-03 RPRUHPQCT@@R@@RQFTQCT
;29    8.000E-03 AgRVWPEFS@@R@@ReFSEGS
;29    8.979E-03 aURWFPcVS@@R@@RCcScVS
;29 K  8.979E-03 aURWFPrWT@@R@@RrXTrWT
;29    1.000E-02 AURwSPRDT@@R@@RRFTRET
;29    1.500E-02 H`QyVPwAS@@R@@RGQSwBS
;29    2.000E-02 FFQQ@QsAS@@R@@RsHSsBS
;29    3.000E-02 sGQaCQAES@@R@@RAISAFS
;29    4.000E-02 RBQaIQTRR@@R@@RDfRdUR
;29    5.000E-02 AWQqAQrDR@@R@@RbQRBWR
;29    6.000E-02 AHQqAQqER@@R@@RQYRAXR
;29    8.000E-02 VYPaIQeXQ@@R@@RgSQVgQ
;29    1.000E-01 DUPaFQBhQ@@R@@RTXQTDQ
;29    1.500E-01 RAPQGQxEP@@R@@RbBQBAQ
;29    2.000E-01 aCPAIQCYP@@R@@RQVQATQ
;29    3.000E-01 eROYXPAEP@@R@@RQBQAFQ
;29    4.000E-01 cAOhSPdVO@@R@@RIQPIIP
;29    5.000E-01 BGOW`PRWO@@R@@RxFPXFP
;29    6.000E-01 ATOwBPaRO@@R@@RgSPGXP
;29    8.000E-01 XENFTPhFN@@R@@RfQPVRP
;29    1.000E+00 eCNE`PUDN@@R@@RU`PEeP
;29    1.022E+00 EANuTPDiN@@R@@REcPuXP
;29    1.250E+00 sENUIPs@NHBM@@ReFPeCP
;29    1.500E+00 rCNtRPrHNDBN@@RD`PtXP
;29    2.000E+00 qANDCPAVNQQO@@Rd@PTIP
;29    2.044E+00 aFNShPAQNaRO@@RTGPTEP
;29    3.000E+00 EcMSGPWbMTFOQAMcPPSYP
;29    4.000E+00 cHMbTPuBMfROTSMsBPsAP
;29    5.000E+00 R@MbHPShMxYOIAMSHPSGP
;29    6.000E+00 AVMBBPSGMAGPqHNSAPSAP
;29    7.000E+00 AGMAaPbRMaDPAgNCHPCHP
;29    8.000E+00 h@LaUPbDMAPPrCNCGPCGP
;29    9.000E+00 FXLQRPQeMQTPrXNCHPCHP
;29    1.000E+01 eELAQPqRMaVPc@NS@PS@P
;29    1.100E+01 tDLqAPQUMqXPcPNSCPSCP
;29    1.200E+01 cULaCPAPMAhPSiNSEPSEP
;29    1.300E+01 SALQFPaHMQhPtDNSHPSHP
;29    1.400E+01 bXLQ@PQHMBGPdXNcBPcBP
;29    1.500E+01 rCLADPAIMRFPEANcEPcEP
;29    1.600E+01 BELYaOABMbCPuBNcHPcHP
;29    1.800E+01 aRLIFOXfLrHPEiNsDPsDP
;29    2.000E+01 qALxEOWiLRQPFQNCQPCQP
;29    2.200E+01 AILwVOgALbSPFiNCWPCWP
;29    2.400E+01 YAKgEOVWLrSPwCNSSPSSP
;29    2.600E+01 wWKFaOFDLBcPwSNSYPSYP
;29    2.800E+01 vPKFROUXLRbPXANcTPcTP
;29    3.000E+01 EcKFHOUILC@PHVNcYPcYP
;29    4.000E+01 cHKDcOCdLsDPYcNSbPSbP
;29    5.000E+01 R@KDCOCELSYPQAOT@PT@P
;29    6.000E+01 AVKCXORSLsYPa@OdEPdEP
;29    8.000E+01 h@JrTOAhLDHPqCODYPDYP
;29    1.000E+02 eEJbGOQPLdIPASOdVPdVP
;29    1.500E+02 rCJaROYdKdRPaPOTdPTdP
;29    2.000E+02 qAJaGOGTKDbPqPOUBPUBP
;29    3.000E+02 EcII@NTdKEEPAcOuCPuCP
;29    4.000E+02 cHIGENsPKUIPQaOEUPEUP
;29    5.000E+02 R@IEdNRfKeGPQfOUSPUSP
;29    6.000E+02 AVIE@NBVKuDPB@OUYPUYP
;29    8.000E+02 h@HS`NAeKERPBEOeWPeWP
;29    1.000E+03 eEHcANAXKEXPBIOuRPuRP
;29    1.500E+03 rCHbDNIeJUUPRDOuYPuYP
;29    2.000E+03 qAHqTNwHJePPRGOEcPEcP
;29    3.000E+03 EcGaANTbJeTPb@OEgPEgP
;29    4.000E+03 cHGyAMcYJeWPbBOU`PU`P
;29    5.000E+03 R@GgRMReJeXPbCOUaPUaP
;29    6.000E+03 AVGFVMBVJeYPbDOUbPUbP
;29    8.000E+03 h@FThMAdJuQPbEOUdPUdP
;29    1.000E+04 eEFDFMAXJuRPbFOUePUeP
;29    1.500E+04 rCFBaMIdIuSPbGOUfPUfP
;29    2.000E+04 qAFRFMwHIuTPbHOUgPUgP
;29    3.000E+04 EcEAYMTbIuTPbHOUgPUgP
;29    4.000E+04 cHEQDMcYIuUPbHOUhPUhP
;29    5.000E+04 R@EyALReIuUPbIOUhPUhP
;29    6.000E+04 AVEGgLBVIuUPbIOUhPUhP
;29    8.000E+04 h@DFCLAdIuUPbIOUhPUhP
;29    1.000E+05 eEDTaLAWIuUPbIOUhPUhP
;==== ELEMENT  30
;30    1.000E-03 eDRVXOQUU@@R@@RQUUQUU
;30    1.010E-03 eDRfXOQQU@@R@@RQRUQQU
;30    1.020E-03 eCRvYOAXU@@R@@RAXUAXU
;30 L3 1.020E-03 eCRvYOSRU@@R@@RSSUSRU
;30    1.031E-03 eCRVaOtXU@@R@@RtYUtXU
;30    1.043E-03 eBRGCOFYU@@R@@RFYUFYU
;30 L2 1.043E-03 eBRGCOhCU@@R@@RhDUhCU
;30    1.116E-03 UIRG`OwYU@@R@@RwYUwYU
;30    1.194E-03 UDRhSOwGU@@R@@RwGUwGU
;30 L1 1.194E-03 UDRhSOxIU@@R@@RHPUxIU
;30    1.500E-03 ThRQIPDbU@@R@@RDbUDbU
;30    2.000E-03 dXRqPPrGU@@R@@RrGUrGU
;30    3.000E-03 DHRbTPhGT@@R@@RxAThGT
;30    4.000E-03 STRSRPCcT@@R@@RCgTCcT
;30    5.000E-03 CERtEPBIT@@R@@RRBTBIT
;30    6.000E-03 bSRUBPaFT@@R@@RaITaFT
;30    8.000E-03 QiRFXPeWS@@R@@REgSeWS
;30    9.659E-03 aQRGTPsDS@@R@@RSQSsDS
;30 K  9.659E-03 aQRGTPRRT@@R@@RRTTRRT
;30    1.000E-02 QTRgQPrAT@@R@@RrCTrBT
;30    1.500E-02 yCQiVPHAS@@R@@RXBSHBS
;30    2.000E-02 FQQAIQcTS@@R@@RsRScVS
;30    3.000E-02 SXQaCQQFS@@R@@RaASQGS
;30    4.000E-02 bFQaIQECR@@R@@RuHRUFR
;30    5.000E-02 QVQqAQbQR@@R@@RBiRrTR
;30    6.000E-02 QEQqBQQQR@@R@@RqVRaUR
;30    8.000E-02 GAPq@QvGQ@@R@@RxFQgVQ
;30    1.000E-01 tSPaGQcDQ@@R@@RTgQTPQ
;30    1.500E-01 bEPQHQIQP@@R@@RrDQRBQ
;30    2.000E-01 qAPAIQSdP@@R@@RaRQAYQ
;30    3.000E-01 UiOiRPQIP@@R@@RQDQAHQ
;30    4.000E-01 CROhWPu@O@@R@@RYTPi@P
;30    5.000E-01 bAOWdPRbO@@R@@RHUPhCP
;30    6.000E-01 QTOwFPAdO@@R@@RgYPWTP
;30    8.000E-01 xPNFXPIQN@@R@@RfVPVWP
;30    1.000E+00 UXNEcPEfN@@R@@RUdPEiP
;30    1.022E+00 uDNuWPUVN@@R@@REgPEbP
;30    1.250E+00 SXNeAPsVNHUM@@Ru@PeFP
;30    1.500E+00 BYNtTPrQNdBN@@RDcPDaP
;30    2.000E+00 APNDEPaWNQXO@@RdDPdBP
;30    2.044E+00 qDND@PaQNqPO@@Rd@PTHP
;30    3.000E+00 fBMSHPI@MtCOQAMcSPcSP
;30    4.000E+00 SPMbVPFDMFiOTUMsFPsFP
;30    5.000E+00 bDMr@PTQMYDOIFMcBPcBP
;30    6.000E+00 QVMBCPSYMQAPqINSFPSFP
;30    7.000E+00 QDMAbPRgMaIPAgNSDPSDP
;30    8.000E+00 xVLaVPRTMAUPrDNSDPSDP
;30    9.000E+00 VbLQSPbAMaPPrYNSEPSEP
;30    1.000E+01 ePLAQPQeMqSPcBNSHPSGP
;30    1.100E+01 dSLqBPqUMAePcRNc@Pc@P
;30    1.200E+01 CiLaDPQYMQfPD@NcCPcCP
;30    1.300E+01 sBLQGPAUMBFPtFNcGPcGP
;30    1.400E+01 BfLQ@PqDMREPtQNs@Ps@P
;30    1.500E+01 BYLAEPaDMbDPECNsDPsCP
;30    1.600E+01 RILYfOQEMrBPuDNsGPsGP
;30    1.800E+01 qSLY@OAAMBWPUbNCTPCTP
;30    2.000E+01 APLHPOIELbPPFTNSQPSQP
;30    2.200E+01 QFLG`OXGLrSPVbNSXPSXP
;30    2.400E+01 ySKgIOGTLBdPwFNcTPcTP
;30    2.600E+01 hIKFdOFcLRdPwWNsPPsPP
;30    2.800E+01 WEKFUOvBLCCPXENsVPsVP
;30    3.000E+01 fCKVAOEgLSAPXPNCaPCaP
;30    4.000E+01 SPKDfOtELCVPYgNDEPDEP
;30    5.000E+01 bDKDEOCULsSPQAOdDPdDP
;30    6.000E+01 QVKCYOBfLScPa@ODPPDPP
;30    8.000E+01 xVJrUORCLdCPqDOdTPdTP
;30    1.000E+02 ePJbIOqPLDUPATODbPDbP
;30    1.500E+02 BYJaSOQBLtYPaPOUAPUAP
;30    2.000E+02 APJaHOHQKE@PqQOu@Pu@P
;30    3.000E+02 fCIIENUYKeDPAcOUQPUQP
;30    4.000E+02 SPIGINTIKuGPQaOeTPeTP
;30    5.000E+02 bDIEgNsEKEVPQfOuRPuRP
;30    6.000E+02 QVIEBNrYKUSPB@OuXPuXP
;30    8.000E+02 xVHSbNBIKeRPBFOEfPEfP
;30    1.000E+03 ePHcCNaWKeWPBIOUaPUaP
;30    1.500E+03 BYHbENQAKuUPREOUiPUiP
;30    2.000E+03 APHqTNxEJE`PRHOFCPFCP
;30    3.000E+03 fCGaANUVJEdPbAOFHPFHP
;30    4.000E+03 SPGyGMTGJEgPbCOV@PV@P
;30    5.000E+03 bDGgVMsDJEhPbDOVBPVBP
;30    6.000E+03 QVGFYMrXJU`PbEOVCPVCP
;30    8.000E+03 xVFE@MBIJUaPbFOVDPVDP
;30    1.000E+04 ePFDHMaWJUbPbGOVEPVEP
;30    1.500E+04 BYFBbMQAJUcPbHOVFPVFP
;30    2.000E+04 APFRGMxDIUdPbHOVGPVGP
;30    3.000E+04 fCEQPMUVIUePbIOVHPVHP
;30    4.000E+04 SPEQEMTGIUePbIOVHPVHP
;30    5.000E+04 bDEyFLsDIUePbIOVHPVHP
;30    6.000E+04 QVEWaLrXIUePbIOVHPVHP
;30    8.000E+04 xVDFFLBIIUfPr@OVIPVIP
;30    1.000E+05 ePDTcLaWIUfPr@OVIPVIP
;==== ELEMENT  31
;31    1.000E-03 eBRFXOaYU@@R@@RqPUaYU
;31    1.056E-03 UIRGFOAYU@@R@@RAYUAYU
;31    1.115E-03 UFRgXOqAU@@R@@RqAUqAU
;31 L3 1.115E-03 UFRgXOCaU@@R@@RCbUCaU
;31    1.129E-03 UERGbOdTU@@R@@RdTUdTU
;31    1.142E-03 UDRWfOeTU@@R@@ReUUeTU
;31 L2 1.142E-03 UDRWfOwDU@@R@@RwDUwDU
;31    1.218E-03 U@RxVOFcU@@R@@RFcUFcU
;31    1.298E-03 EFRiROvEU@@R@@RvFUvEU
;31 L1 1.298E-03 EFRiROg@U@@R@@RgAUg@U
;31    1.500E-03 TdRQHPEHU@@R@@REIUEHU
;31    2.000E-03 dSRaYPRQU@@R@@RRRURQU
;31    3.000E-03 DDRbPPHbT@@R@@RHfTHbT
;31    4.000E-03 SRRCSPDIT@@R@@RTCTDIT
;31    5.000E-03 CFRd@PbCT@@R@@RbGTbCT
;31    6.000E-03 bVRTbPqFT@@R@@RqHTqFT
;31    8.000E-03 BBRVIPFIS@@R@@Rv@SV@S
;31    1.000E-02 QWRgGPcFS@@R@@RCRScFS
;31    1.037E-02 QQRGTPRdS@@R@@RS@SReS
;31 K  1.037E-02 QQRGTPb@T@@R@@RbATb@T
;31    1.500E-02 YPQiDPHSS@@R@@RXTSHTS
;31    2.000E-02 VRQAEQCeS@@R@@RScSCfS
;31    3.000E-02 cUQQHQaCS@@R@@RaHSaDS
;31    4.000E-02 rAQaDQuGR@@R@@RuSREYR
;31    5.000E-02 QYQaGQrYR@@R@@RCHRRbR
;31    6.000E-02 QGQaGQaRR@@R@@RAgRqUR
;31    8.000E-02 WFPaEQFeQ@@R@@RHbQXAQ
;31    1.000E-01 DcPaBQCYQ@@R@@Re@QtQQ
;31    1.500E-01 r@PQDQABQ@@R@@RrIQRFQ
;31    2.000E-01 qDPAFQdHP@@R@@RaRQAYQ
;31    3.000E-01 VEOyBPq@P@@R@@RQBQAFQ
;31    4.000E-01 SQOHPPuWO@@R@@RyBPXgP
;31    5.000E-01 bFOgYPSIO@@R@@RhDPHAP
;31    6.000E-01 QXOWCPBAO@@R@@RGYPwCP
;31    8.000E-01 XcNfGPACO@@R@@RFWPvHP
;31    1.000E+00 uSNeUPFPN@@R@@RuWPuQP
;31    1.022E+00 EYNUYPFHN@@R@@RuPPeUP
;31    1.250E+00 cWNEEPTANXXM@@RUDPU@P
;31    1.500E+00 RUNTYPRfNdGN@@RdYPdWP
;31    2.000E+00 ATNSbPAbNQYO@@RTAPT@P
;31    2.044E+00 qHNCgPqVNqQO@@RDHPDFP
;31    3.000E+00 vIMCIPIaMtEOAHMSTPSSP
;31    4.000E+00 cPMRWPVYMV`ODQMcHPcHP
;31    5.000E+00 r@MbBPTbMYFOxXMSFPSEP
;31    6.000E+00 aPMQgPSaMQAPqENS@PS@P
;31    7.000E+00 QGMqWPcDMaIPAbNCHPCHP
;31    8.000E+00 XiLaQPrVMAUPbGNCIPCHP
;31    9.000E+00 WALAXPBPMaPPrQNS@PS@P
;31    1.000E+01 uVLqGPRBMqSPSBNSCPSCP
;31    1.100E+01 tVLaHPQaMAePSQNSFPSFP
;31    1.200E+01 D@La@PqSMQePChNSIPSIP
;31    1.300E+01 CQLQCPQXMBEPdCNcCPcCP
;31    1.400E+01 RdLAGPAUMREPTVNcFPcFP
;31    1.500E+01 RVLAAPqEMbDPDhNs@Ps@P
;31    1.600E+01 bELiVOaEMrBPUGNsDPsDP
;31    1.800E+01 qXLHcOQ@MBWPuSNCQPCQP
;31    2.000E+01 ATLXDOIcLbPPfDNCXPCXP
;31    2.200E+01 QILWVOHgLrRPvPNSUPSUP
;31    2.400E+01 YiKGFOHILBcPWCNcQPcQP
;31    2.600E+01 XRKfSOGRLRcPWRNcWPcWP
;31    2.800E+01 wDKfFOFfLCCPGiNsSPsSP
;31    3.000E+01 FPKUbOvHLSAPhCNsYPsYP
;31    4.000E+01 cPKtQOtRLCVPiVNDCPDCP
;31    5.000E+01 r@KScOsULsRPAGOdBPdBP
;31    6.000E+01 aPKsIOS@LScPQFOtHPtHP
;31    8.000E+01 XiJbWOrALdCPaIOdRPdRP
;31    1.000E+02 uVJbBOAdLDTPqIOD`PD`P
;31    1.500E+02 RVJQXOaBLtXPQUOU@PU@P
;31    2.000E+02 ATJaDOYCKTiPaUOeHPeHP
;31    3.000E+02 FPIxWNFGKeCPqWOEYPEYP
;31    4.000E+02 cPIFgNTUKuFPAeOeRPeRP
;31    5.000E+02 r@IeYNcSKEUPQ`OuPPuPP
;31    6.000E+02 aPIDgNCCKURPQdOuVPuVP
;31    8.000E+02 XiHC`NbGKePPQiOEdPEdP
;31    1.000E+03 uVHSCNAaKeVPBBOEiPEiP
;31    1.500E+03 RVHRHNaAKuTPBGOUgPUgP
;31    2.000E+03 ATHaYNIFJuXPR@OFAPFAP
;31    3.000E+03 FPGQHNFDJEcPRCOFEPFEP
;31    4.000E+03 cPGIHMTSJEePREOFHPFHP
;31    5.000E+03 r@GGRMcRJEgPRFOFIPFIP
;31    6.000E+03 aPGfIMCBJEhPRGOV@PV@P
;31    8.000E+03 XiFDeMbFJEiPRHOVBPVBP
;31    1.000E+04 uVFSfMAaJU`PRIOVCPVCP
;31    1.500E+04 RVFrTMaAJUbPb@OVDPVDP
;31    2.000E+04 ATFR@MIFIUbPbAOVEPVEP
;31    3.000E+04 FPEAUMFDIUcPbAOVEPVEP
;31    4.000E+04 cPEQAMTSIUcPbAOVFPVFP
;31    5.000E+04 r@EIGLcRIUdPbBOVFPVFP
;31    6.000E+04 aPEgVLCBIUdPbBOVFPVFP
;31    8.000E+04 XiDEhLbFIUdPbBOVFPVFP
;31    1.000E+05 uVDtXLAaIUdPbBOVFPVFP
;==== ELEMENT  32
;32    1.000E-03 uDRVIOAiU@@R@@RAiUAiU
;32    1.103E-03 eHRgCOQPU@@R@@RQPUQPU
;32    1.217E-03 eARHSOQIU@@R@@RQIUQIU
;32 L3 1.217E-03 eARHSOtFU@@R@@RtFUtFU
;32    1.232E-03 e@RXYOdUU@@R@@RdVUdUU
;32    1.248E-03 UIRxVOTgU@@R@@RTgUTgU
;32 L2 1.248E-03 UIRxVOfUU@@R@@RfVUfUU
;32    1.328E-03 UDRiROFGU@@R@@RFHUFGU
;32    1.414E-03 EIRAEPUUU@@R@@RUUUUUU
;32 L1 1.414E-03 EIRAEPfHU@@R@@RfIUfHU
;32    1.500E-03 EDRQEPEWU@@R@@REWUEWU
;32    2.000E-03 tQRaWPrQU@@R@@RrQUrQU
;32    3.000E-03 T@RbPPYWT@@R@@RiQTYWT
;32    4.000E-03 SXRCRPDVT@@R@@RTPTDVT
;32    5.000E-03 SBRTGPBTT@@R@@RBWTBTT
;32    6.000E-03 rSRDfPAXT@@R@@RQQTAXT
;32    8.000E-03 BIRFHPfWS@@R@@RFiSfXS
;32    1.000E-02 aTRWBPSWS@@R@@RsTSSXS
;32    1.110E-02 AURgQPbVS@@R@@RBaSbWS
;32 K  1.110E-02 AURgQPQgT@@R@@RQhTQgT
;32    1.500E-02 IhQIEPIDS@@R@@RYESIES
;32    2.000E-02 vWQACQTDS@@R@@RdBSTES
;32    3.000E-02 C`QQFQqDS@@R@@RqHSqES
;32    4.000E-02 BQQaBQEdR@@R@@RfARUgR
;32    5.000E-02 aVQaEQCDR@@R@@RsDRSGR
;32    6.000E-02 aBQaEQqWR@@R@@RBBRQ`R
;32    8.000E-02 GWPaDQWRQ@@R@@RYPQxUQ
;32    1.000E-01 EEPaAQCdQ@@R@@RUUQEEQ
;32    1.500E-01 BQPQCQQBQ@@R@@RBYQbEQ
;32    2.000E-01 APPAEQtSP@@R@@RaVQQRQ
;32    3.000E-01 FSOiCPATP@@R@@RQCQAGQ
;32    4.000E-01 cWOxBPFQO@@R@@RyCPXfP
;32    5.000E-01 rGOgRPSTO@@R@@RhAPWgP
;32    6.000E-01 aVOGFPbDO@@R@@RGUPgIP
;32    8.000E-01 yFNfBPQDO@@R@@RFSPvCP
;32    1.000E+00 FANePPWBN@@R@@RuSPeWP
;32    1.022E+00 uUNUTPvWN@@R@@ReVPePP
;32    1.250E+00 CeNEAPTWNX`M@@RU@PEFP
;32    1.500E+00 bXNTUPcINDQN@@RdVPdSP
;32    2.000E+00 QQNCiPBBNaSO@@RDIPDGP
;32    2.044E+00 ATNCdPQeNqUO@@RDEPDCP
;32    3.000E+00 vPMCFPAINDVOAGMSRPSRP
;32    4.000E+00 sWMRUPwAMGGOtGMcGPcGP
;32    5.000E+00 BQMb@PEUMyGOxPMSFPSFP
;32    6.000E+00 aXMQePtCMQDPqDNSAPSAP
;32    7.000E+00 aCMqUPSYMqBPA`NCIPCIP
;32    8.000E+00 ISLQYPCFMAXPbENS@PS@P
;32    9.000E+00 GULAWPbVMaSPbXNSCPSCP
;32    1.000E+01 FCLqFPrEMqVPCINSFPSFP
;32    1.100E+01 TiLaGPRAMAiPCXNSIPSIP
;32    1.200E+01 TILQIPQaMB@PCeNcCPcCP
;32    1.300E+01 SWLQBPqUMR@PTINcFPcFP
;32    1.400E+01 CHLAFPaQMb@PTRNs@Ps@P
;32    1.500E+01 bXLAAPAYMbHPDcNsDPsDP
;32    1.600E+01 rFLYWOqIMrGPUCNsHPsHP
;32    1.800E+01 AfLxTOaBMRRPeXNCUPCUP
;32    2.000E+01 QQLHFOAIMbVPVHNSSPSSP
;32    2.200E+01 aELGYOIbLrXPfTNcPPcPP
;32    2.400E+01 AELG@OXeLBiPGFNcWPcWP
;32    2.600E+01 XbKVWOhBLC@PGUNsSPsSP
;32    2.800E+01 wPKf@OgPLCIPGbNsYPsYP
;32    3.000E+01 vQKEgOGFLSHPXFNCePCeP
;32    4.000E+01 sWKdWOeCLSSPYVNT@PT@P
;32    5.000E+01 BQKCiOTELC`PAFOt@Pt@P
;32    6.000E+01 aXKsFOCTLDAPQEODVPDVP
;32    8.000E+01 ISJbUORVLtAPaHOtQPtQP
;32    1.000E+02 FCJb@OBDLTSPqGODiPDiP
;32    1.500E+02 bXJQVOqELDhPQSOUIPUIP
;32    2.000E+02 QQJaCOAALEIPaSOuGPuGP
;32    3.000E+02 vPIhYNvRKuCPqUOUYPUYP
;32    4.000E+02 sWIFaNECKEWPAcOuRPuRP
;32    5.000E+02 BQIeTNDBKUVPAhOE`PE`P
;32    6.000E+02 aXIDcNsEKeRPQaOEfPEfP
;32    8.000E+02 ISHsWNRQKuQPQfOUePUeP
;32    1.000E+03 FCHS@NBAKuWPB@OF@PF@P
;32    1.500E+03 bXHRGNqDKEePBEOFHPFHP
;32    2.000E+03 QQHaXNA@KEiPBHOVBPVBP
;32    3.000E+03 vPGQGNfXJUdPRAOVFPVFP
;32    4.000E+03 sWGXiMEAJUgPRCOVIPVIP
;32    5.000E+03 BQGwEMDAJUhPRDOfAPfAP
;32    6.000E+03 aXGfDMsDJUiPREOfBPfBP
;32    8.000E+03 ISFD`MRPJFAPRFOfCPfCP
;32    1.000E+04 FCFSbMB@JFBPRFOfDPfDP
;32    1.500E+04 bXFrQMqDJFCPRGOfEPfEP
;32    2.000E+04 QQFBHMA@JFDPRHOfFPfFP
;32    3.000E+04 vPEATMfXIFEPRHOfGPfGP
;32    4.000E+04 sWEQ@MEAIFEPRIOfGPfGP
;32    5.000E+04 BQEXhLDAIFEPRIOfGPfGP
;32    6.000E+04 aXEgPLsDIFEPRIOfGPfGP
;32    8.000E+04 ISDEbLRPIFFPRIOfHPfHP
;32    1.000E+05 FCDtTLB@IFFPRIOfHPfHP
;==== ELEMENT  33
;33    1.000E-03 UQREaORBU@@R@@RRBURBU
;33    1.150E-03 ERRgHOQRU@@R@@RQRUQRU
;33    1.323E-03 uARIGOAIU@@R@@RAIUAIU
;33 L3 1.323E-03 uARIGOTSU@@R@@RTSUTSU
;33    1.341E-03 u@RiEODXU@@R@@RDYUDXU
;33    1.359E-03 eIRITODTU@@R@@RDUUDTU
;33 L2 1.359E-03 eIRITOFHU@@R@@RFHUFHU
;33    1.500E-03 UIRAIPeBU@@R@@ReCUeBU
;33    1.526E-03 UHRQBPTiU@@R@@RE@UTiU
;33 L1 1.526E-03 UHRQBPeUU@@R@@ReUUeUU
;33    2.000E-03 DeRaPPRcU@@R@@RRcURcU
;33    3.000E-03 dARRVPADU@@R@@RAEUADU
;33    4.000E-03 cWRCPPDhT@@R@@RTbTDhT
;33    5.000E-03 cARTEPbXT@@R@@RrQTbXT
;33    6.000E-03 BaRDcPaST@@R@@RaVTaST
;33    8.000E-03 RHRFBPwES@@R@@RWWSwFS
;33    1.000E-02 qQRGDPSdS@@R@@RTASSdS
;33    1.187E-02 APRGdPBSS@@R@@RRXSBTS
;33 K  1.187E-02 APRGdPqXT@@R@@RqYTqXT
;33    1.500E-02 ACRXdPyTS@@R@@RIeSyUS
;33    2.000E-02 GGQABQDXS@@R@@RTVSDYS
;33    3.000E-02 ShQQEQAUS@@R@@RQQSAWS
;33    4.000E-02 RSQaBQvIR@@R@@RvVRVQR
;33    5.000E-02 qUQaDQsDR@@R@@RcSRCVR
;33    6.000E-02 aHQaEQQeR@@R@@Rb@RBGR
;33    8.000E-02 GdPaDQhHQ@@R@@RACRYQQ
;33    1.000E-01 u@PaAQdCQ@@R@@RUgQETQ
;33    1.500E-01 RSPQBQaEQ@@R@@RbRQrGQ
;33    2.000E-01 AWPAEQeEP@@R@@RqRQQWQ
;33    3.000E-01 vXOiBPaPP@@R@@RQEQAHQ
;33    4.000E-01 CgOxAPWEO@@R@@RIQPICP
;33    5.000E-01 RPOgQPSeO@@R@@RhFPHAP
;33    6.000E-01 qUOGFPRPO@@R@@RGXPwAP
;33    8.000E-01 IgNfAPaHO@@R@@RFTPvDP
;33    1.000E+00 vDNUYPWfN@@R@@RuSPeWP
;33    1.022E+00 FGNUSPWVN@@R@@ReWPeQP
;33    1.250E+00 DFNE@PUANyAM@@RUAPEFP
;33    1.500E+00 BbNTUPcXNTYN@@RdVPdSP
;33    2.000E+00 QYNChPbFNaYO@@RDIPDHP
;33    2.044E+00 QRNCdPRHNAbO@@RDFPDDP
;33    3.000E+00 GGMCFPaBNdQOAGMSTPSSP
;33    4.000E+00 ShMRUPXEMgIOtGMs@PcIP
;33    5.000E+00 RUMb@PFHMiVOxPMSIPSHP
;33    6.000E+00 qWMQePDcMQGPqDNSDPSDP
;33    7.000E+00 q@MqUPSiMqFPA`NSCPSCP
;33    8.000E+00 YeLQYPCPMQSPbENSEPSEP
;33    9.000E+00 GfLAVPRfMaXPbXNSGPSGP
;33    1.000E+01 vGLqFPbRMAbPCINcAPcAP
;33    1.100E+01 eFLaGPrEMQdPCXNcDPcDP
;33    1.200E+01 DRLQIPRCMBFPCdNcHPcHP
;33    1.300E+01 sWLQBPQdMRFPTINsBPsBP
;33    1.400E+01 cELAFPqYMbFPTQNsFPsFP
;33    1.500E+01 BcLA@PaVMrEPDcNCQPCPP
;33    1.600E+01 BYLYWOQTMBTPUBNCUPCUP
;33    1.800E+01 QgLxTOqFMRYPeWNSSPSSP
;33    2.000E+01 QYLHFOaAMrSPVGNcPPcPP
;33    2.200E+01 qBLGYOAIMBfPfSNcXPcXP
;33    2.400E+01 QALG@OYeLRhPGENsUPsUP
;33    2.600E+01 IRKVWOYDLCHPGTNCaPCaP
;33    2.800E+01 XBKf@OHULSHPGaNChPChP
;33    3.000E+01 GGKEgOGeLcGPXDNSdPSdP
;33    4.000E+01 ShKdVOEaLcSPYUNd@Pd@P
;33    5.000E+01 RUKCiOdQLSaPAFODPPDPP
;33    6.000E+01 qWKsEOCbLTBPQEOTWPTWP
;33    8.000E+01 YeJbUOBdLDSPaHODcPDcP
;33    1.000E+02 vGJb@ObGLdVPqGOEAPEAP
;33    1.500E+02 BcJQVOQPLEAPQSOuBPuBP
;33    2.000E+02 QYJaCOQBLeCPaSOUQPUQP
;33    3.000E+02 GGIhYNGVKEWPqUOuTPuTP
;33    4.000E+02 ShIF`NUYKeRPAbOEgPEgP
;33    5.000E+02 RUIeSNDWKuQPAgOUePUeP
;33    6.000E+02 qWIDbNsRKuXPQaOFAPFAP
;33    8.000E+02 YeHsWNrYKEgPQfOV@PV@P
;33    1.000E+03 vGHS@NbCKUbPQiOVEPVEP
;33    1.500E+03 BcHRFNAYKFAPBDOfCPfCP
;33    2.000E+03 QYHaXNQAKFEPBGOfHPfHP
;33    3.000E+03 GGGQFNGRJV@PR@OvBPvBP
;33    4.000E+03 ShGXiMUWJVCPRBOvEPvEP
;33    5.000E+03 RUGwEMDUJVDPRCOvFPvFP
;33    6.000E+03 qWGfCMsQJVFPRDOvHPvHP
;33    8.000E+03 YeFD`MrXJVGPREOvIPvIP
;33    1.000E+04 vGFSbMbCJVHPREOFPPFPP
;33    1.500E+04 BcFrQMAXJVIPRFOFQPFQP
;33    2.000E+04 QYFBHMQAJf@PRGOFRPFRP
;33    3.000E+04 GGEATMGRIfAPRGOFSPFSP
;33    4.000E+04 ShEQ@MUWIfAPRHOFSPFSP
;33    5.000E+04 RUEXhLDUIfAPRHOFSPFSP
;33    6.000E+04 qWEWYLsQIfBPRHOFTPFTP
;33    8.000E+04 YeDEbLrXIfBPRHOFTPFTP
;33    1.000E+05 vGDtTLbCIfBPRHOFTPFTP
;==== ELEMENT  34
;34    1.000E-03 UVRuIOrAU@@R@@RrBUrAU
;34    1.198E-03 ETRgHOQPU@@R@@RQQUQPU
;34    1.436E-03 eIRiXOyVT@@R@@RIbTyVT
;34 L3 1.436E-03 eIRiXOtDU@@R@@RtEUtDU
;34    1.456E-03 eHRIhOTBU@@R@@RTBUTBU
;34    1.476E-03 eFRAAPS`U@@R@@RSaUS`U
;34 L2 1.476E-03 eFRAAPUYU@@R@@RUYUUYU
;34    1.500E-03 eERACPuCU@@R@@RuDUuCU
;34    1.654E-03 UDRQIPtDU@@R@@RtDUtDU
;34 L1 1.654E-03 UDRQIPTaU@@R@@RTbUTaU
;34    2.000E-03 T`RQTPCIU@@R@@RS@UCIU
;34    3.000E-03 dCRRPPQAU@@R@@RQBUQAU
;34    4.000E-03 cXRsDPeAT@@R@@ReETeAT
;34    5.000E-03 cBRDGPBfT@@R@@RR`TBfT
;34    6.000E-03 BcRtSPqTT@@R@@RqWTqTT
;34    8.000E-03 bAREfPGiS@@R@@RXASGiS
;34    1.000E-02 qTRFcPdCS@@R@@RDQSdDS
;34    1.266E-02 qARW`PRHS@@R@@RrBSRIS
;34 K  1.266E-02 qARW`PQWT@@R@@RQYTQXT
;34    1.500E-02 AFRhVPABT@@R@@RACTABT
;34    2.000E-02 gAQIePtTS@@R@@RDbStUS
;34    3.000E-02 DGQQBQQTS@@R@@RaPSQVS
;34    4.000E-02 bPQQHQFaR@@R@@RWHRVbR
;34    5.000E-02 qYQaAQSVR@@R@@RCfRcXR
;34    6.000E-02 qBQaBQBIR@@R@@RrDRbAR
;34    8.000E-02 HDPa@QHiQ@@R@@RAIRAAR
;34    1.000E-01 ETPQHQTVQ@@R@@RfHQuSQ
;34    1.500E-01 bPPQ@QqEQ@@R@@RrPQBTQ
;34    2.000E-01 QRPABQeYP@@R@@RqTQQYQ
;34    3.000E-01 VgOIAPqTP@@R@@RQDQAGQ
;34    4.000E-01 SiOXBPwWO@@R@@Ry@PX`P
;34    5.000E-01 RWOGTPt@O@@R@@RXCPGgP
;34    6.000E-01 A`OV`PrRO@@R@@RwEPWGP
;34    8.000E-01 ABOFGPqIO@@R@@RvAPfAP
;34    1.000E+00 VSNEWPhWN@@R@@ReRPUUP
;34    1.022E+00 fENEQPhDN@@R@@RUUPEYP
;34    1.250E+00 TINDiPUWNYPM@@RE@PTfP
;34    1.500E+00 RaNDUPDANdWN@@RTVPTSP
;34    2.000E+00 aTNC`PBVNqRO@@RDAPSiP
;34    2.044E+00 QWNsUPrGNAdO@@RSgPSfP
;34    3.000E+00 gIMRiPqBNdUOAEMCXPCWP
;34    4.000E+00 T@MBYPHeMwEOdGMcEPcDP
;34    5.000E+00 bRMREPfPMySOXPMSDPSDP
;34    6.000E+00 AbMQ`PeDMQHPq@NSAPS@P
;34    7.000E+00 qDMqQPtDMqGPqVNS@PS@P
;34    8.000E+00 ACMQVPcYMQTPb@NSBPSBP
;34    9.000E+00 X@LASPcAMaYPbRNSEPSEP
;34    1.000E+01 VVLqCPBdMAcPCBNSIPSIP
;34    1.100E+01 ERLaDPRUMQePCPNcCPcCP
;34    1.200E+01 TVLQFPrAMBGPsUNcGPcGP
;34    1.300E+01 ChLAIPRAMRGPDINsAPsAP
;34    1.400E+01 sELACPQdMbGPDQNsEPsEP
;34    1.500E+01 RbLIbOA`MrFPtRNCPPsIP
;34    1.600E+01 RVLyEOaWMBUPEANCTPCTP
;34    1.800E+01 BBLXTOAWMbQPUTNSRPSRP
;34    2.000E+01 aTLGhOqAMrUPFCNcPPcPP
;34    2.200E+01 qFLwBOQHMBhPFXNcWPcWP
;34    2.400E+01 QDLFdOAHMRiPFiNsUPsUP
;34    2.600E+01 yQKFROYaLS@PgGNCbPCbP
;34    2.800E+01 xGKFFOYELc@PgSNChPChP
;34    3.000E+01 gIKuTOXQLcIPWeNSdPSdP
;34    4.000E+01 T@KTVOfILcUPyCNd@Pd@P
;34    5.000E+01 bRKCaOTiLScPADODQPDQP
;34    6.000E+01 AbKcHOTDLTDPQBOTXPTXP
;34    8.000E+01 ACKRYOCHLDUPaEODdPDdP
;34    1.000E+02 VVJREOBULdXPqDOECPECP
;34    1.500E+02 RbJQSOaSLEDPAYOuDPuDP
;34    2.000E+02 aTJa@OaBLeEPQYOUSPUSP
;34    3.000E+02 gIIXPNHHKUPPqPOuUPuUP
;34    4.000E+02 T@IfUNFEKeTPqXOEhPEhP
;34    5.000E+02 bRIUQNDdKuSPAbOUgPUgP
;34    6.000E+02 AbItQNDCKE`PAfOFCPFCP
;34    8.000E+02 ACIcXNCBKEiPQaOVAPVAP
;34    1.000E+03 VVHCCNBRKUePQdOVGPVGP
;34    1.500E+03 RbHRBNaQKFCPQiOfEPfEP
;34    2.000E+03 aTHaTNaAKFGPBBOfIPfIP
;34    3.000E+03 gIGQDNHDJVBPBEOvDPvDP
;34    4.000E+03 T@GxYMFCJVEPBGOvGPvGP
;34    5.000E+03 bRGWIMDbJVGPBHOvHPvHP
;34    6.000E+03 AbGFIMDBJVHPBHOvIPvIP
;34    8.000E+03 ACGdYMCAJVIPBIOFQPFQP
;34    1.000E+04 VVFCcMBQJf@PR@OFRPFRP
;34    1.500E+04 RbFbUMaQJfBPRAOFSPFSP
;34    2.000E+04 aTFBDMaAJfBPRAOFTPFTP
;34    3.000E+04 gIEAPMHDIfCPRBOFTPFTP
;34    4.000E+04 T@EAHMFCIfCPRBOFUPFUP
;34    5.000E+04 bRExXLDbIfDPRBOFUPFUP
;34    6.000E+04 AbEGRLDBIfDPRBOFUPFUP
;34    8.000E+04 ACEeYLCAIfDPRCOFUPFUP
;34    1.000E+05 VVDdSLBQIfDPRCOFVPFVP
;==== ELEMENT  35
;35    1.000E-03 EcRUGObRU@@R@@RbRUbRU
;35    1.500E-03 UQRAAPYfT@@R@@RA@UYfT
;35    1.550E-03 EXRAFPi@T@@R@@RiFTi@T
;35 L3 1.550E-03 EXRAFPtAU@@R@@RtAUtAU
;35    1.573E-03 EVRAHPScU@@R@@RSdUScU
;35    1.596E-03 ETRQAPSYU@@R@@RSYUSYU
;35 L2 1.596E-03 ETRQAPU@U@@R@@RU@UU@U
;35    1.686E-03 uHRa@PDYU@@R@@RTPUDYU
;35    1.782E-03 uARq@PSfU@@R@@RSgUSfU
;35 L1 1.782E-03 uARq@PDYU@@R@@RDYUDYU
;35    2.000E-03 UERQSPCPU@@R@@RCQUCPU
;35    3.000E-03 DTRRRPaCU@@R@@RaCUaCU
;35    4.000E-03 CdRsIPuXT@@R@@REaTuXT
;35    5.000E-03 sFRTEPSHT@@R@@RcATSHT
;35    6.000E-03 RfRDaPQdT@@R@@RQgTQdT
;35    8.000E-03 rBRUePxYS@@R@@RICSxYS
;35    1.000E-02 AeRVaPtRS@@R@@RTaStSS
;35    1.347E-02 aIRhEPBDS@@R@@RRHSBES
;35 K  1.347E-02 aIRhEPAVT@@R@@RAWTAVT
;35    1.500E-02 QBRxSPQAT@@R@@RQBTQAT
;35    2.000E-02 gUQYdPUHS@@R@@ReGSUIS
;35    3.000E-02 tCQQCQqPS@@R@@RqUSqQS
;35    4.000E-02 rWQa@QWPR@@R@@RW`RgRR
;35    5.000E-02 QaQaBQSeR@@R@@RdFRDGR
;35    6.000E-02 APQaCQrBR@@R@@RRXRBTR
;35    8.000E-02 XWPaBQY`Q@@R@@Ra@RQAR
;35    1.000E-01 E`PQIQEIQ@@R@@RFfQfHQ
;35    1.500E-01 rXPQAQQQQ@@R@@RR`QbRQ
;35    2.000E-01 aRPADQvIP@@R@@RAdQaXQ
;35    3.000E-01 GVOYFPQfP@@R@@RQIQQAQ
;35    4.000E-01 dGOhFPxWO@@R@@RYVPYDP
;35    5.000E-01 rUOWWPDeO@@R@@RxCPHEP
;35    6.000E-01 QbOGBPCGO@@R@@RWRPwBP
;35    8.000E-01 AIOVHPQWO@@R@@RFTPvCP
;35    1.000E+00 ViNUVPI`N@@R@@RuSPeVP
;35    1.022E+00 fYNUPPyBN@@R@@ReVPUYP
;35    1.250E+00 DXNThPfINAAN@@REIPEEP
;35    1.500E+00 SANTRPTRNTdN@@RdUPdRP
;35    2.000E+00 qUNCfPrWNAaO@@RDIPDGP
;35    2.044E+00 aXNCbPbXNQdO@@RDEPDDP
;35    3.000E+00 G`MCDPAYNDhOAFMSUPSTP
;35    4.000E+00 tIMRTPYiMwQOtDMsCPsBP
;35    5.000E+00 BaMRIPGTMABPhTMcCPcCP
;35    6.000E+00 QeMQdPU`MaDPqCNSIPSIP
;35    7.000E+00 ASMqTPDhMASPqYNc@PSIP
;35    8.000E+00 Q@MQXPTFMaQPbDNcBPcBP
;35    9.000E+00 hWLAVPcRMqVPbVNcEPcEP
;35    1.000E+01 GBLqEPc@MQaPCGNcIPcIP
;35    1.100E+01 EaLaFPBgMBDPCUNsDPsDP
;35    1.200E+01 DhLQHPbPMRFPCbNsHPsHP
;35    1.300E+01 TFLQAPrGMbGPTFNCSPCSP
;35    1.400E+01 SXLAEPRHMrHPDYNCXPCXP
;35    1.500E+01 SBLYiOBBMBWPD`NSRPSRP
;35    1.600E+01 rTLYQOAhMRVPEINSWPSWP
;35    1.800E+01 RGLhYOaUMrSPeTNcUPcUP
;35    2.000E+01 qVLHBOAXMBgPVCNsTPsTP
;35    2.200E+01 AULGUOqCMCAPVYNCbPCbP
;35    2.400E+01 aBLVfOaAMSCPGANS`PS`P
;35    2.600E+01 ADLVSOQAMcDPwINSgPSgP
;35    2.800E+01 XfKVFOACMsDPwVNDDPDDP
;35    3.000E+01 GaKEdOYVLCSPHINT@PT@P
;35    4.000E+01 tIKdTOGGLCbPIXNtHPtHP
;35    5.000E+01 BaKCgOeQLT@PAEOdPPdPP
;35    6.000E+01 QeKsCOdULtBPQDOtWPtWP
;35    8.000E+01 Q@KbSOCVLdUPaGOEDPEDP
;35    1.000E+02 GBJRHOrVLDiPqFOeDPeDP
;35    1.500E+02 SBJQUOAcLeFPQQOUVPUVP
;35    2.000E+02 qVJaBOqGLEXPaQOuVPuVP
;35    3.000E+02 GaIhTNIHKuTPqSOF@PF@P
;35    4.000E+02 tIIvWNF`KEhPA`OVCPVCP
;35    5.000E+02 BaIePNETKUhPAeOfBPfBP
;35    6.000E+02 QeID`NTSKFEPAiOfIPfIP
;35    8.000E+02 Q@IsUNsIKVDPQdOvHPvHP
;35    1.000E+03 GBHCHNrQKf@PQgOFSPFSP
;35    1.500E+03 SBHRENAaKfIPBBOVRPVRP
;35    2.000E+03 qVHaWNqFKvDPBEOVVPVVP
;35    3.000E+03 GaGQFNIDJvIPBHOfQPfQP
;35    4.000E+03 tIGXdMvWJFRPR@OfTPfTP
;35    5.000E+03 BaGwAMERJFTPRAOfUPfUP
;35    6.000E+03 QeGf@MTRJFUPRAOfWPfWP
;35    8.000E+03 Q@GtXMsIJFVPRBOfXPfXP
;35    1.000E+04 GBFS`MrQJFWPRCOfYPfYP
;35    1.500E+04 SBFbYMAaJFYPRDOvPPvPP
;35    2.000E+04 qVFBGMqEJVPPRDOvQPvQP
;35    3.000E+04 GaEASMICIVPPREOvRPvRP
;35    4.000E+04 tIEQ@MvWIVQPREOvRPvRP
;35    5.000E+04 BaEXcLERIVQPREOvSPvSP
;35    6.000E+04 QeEWULTQIVQPREOvSPvSP
;35    8.000E+04 Q@EuYLsIIVQPRFOvSPvSP
;35    1.000E+05 GBDtQLrQIVQPRFOvSPvSP
;==== ELEMENT  36
;36    1.000E-03 U`RtVOBeU@@R@@RBeUBeU
;36    1.500E-03 UXRyGOAIU@@R@@RAIUAIU
;36    1.675E-03 EURQAPxAT@@R@@RxFTxAT
;36 L3 1.675E-03 EURQAPSaU@@R@@RSbUSaU
;36    1.701E-03 ESRQCPSQU@@R@@RSRUSQU
;36    1.727E-03 EQRQFPSFU@@R@@RSGUSFU
;36 L2 1.727E-03 EQRQFPTVU@@R@@RTVUTVU
;36    1.822E-03 uERaFPShU@@R@@RSiUShU
;36    1.921E-03 eHRqEPCXU@@R@@RCXUCXU
;36 L1 1.921E-03 eHRqEPSdU@@R@@RSeUSdU
;36    2.000E-03 eBRASPSYU@@R@@RcPUSYU
;36    3.000E-03 DYRBPPq@U@@R@@RqAUq@U
;36    4.000E-03 ChRcGPVET@@R@@RVITVET
;36    5.000E-03 sIRDCPsIT@@R@@RCSTsIT
;36    6.000E-03 RhRdYPBGT@@R@@RR@TBGT
;36    8.000E-03 rEREaPIQS@@R@@RiUSIQS
;36    1.000E-02 AhRvSPEFS@@R@@ReFSEGS
;36    1.433E-02 aBRhIPAdS@@R@@RQgSAeS
;36 K  1.433E-02 aBRhIPq@T@@R@@RqATq@T
;36    1.500E-02 QERHYPQFT@@R@@RQGTQFT
;36    2.000E-02 GaQiWPEVS@@R@@RUUSEWS
;36    3.000E-02 DRQQ@QA`S@@R@@RAeSAaS
;36    4.000E-02 BdQQGQWiR@@R@@RxIRXAR
;36    5.000E-02 QfQa@QdAR@@R@@RTRRtCR
;36    6.000E-02 ATQaAQBWR@@R@@RrTRRYR
;36    8.000E-02 H`Pa@QAFR@@R@@RaGRQHR
;36    1.000E-01 UePQGQEVQ@@R@@RgBQfSQ
;36    1.500E-01 BfPAIQaRQ@@R@@RC@QrQQ
;36    2.000E-01 aWPABQFiP@@R@@RAgQqPQ
;36    3.000E-01 gWOXhPRBP@@R@@RQIQQAQ
;36    4.000E-01 tIOHIPIYO@@R@@RIXPIDP
;36    5.000E-01 BdOGRPeGO@@R@@RhCPWdP
;36    6.000E-01 QhOFhPsDO@@R@@RGQPgAP
;36    8.000E-01 QBOFFPqQO@@R@@RvDPfCP
;36    1.000E+00 g@NEUPAFO@@R@@ReSPUVP
;36    1.022E+00 V`NEPPAAO@@R@@RUWPUPP
;36    1.250E+00 dRNDhPFcNACN@@RE@PTfP
;36    1.500E+00 cANDTPTaNEDN@@RTWPTTP
;36    2.000E+00 AaNsYPCANAcO@@RDBPD@P
;36    2.044E+00 qSNsTPRaNQgO@@RShPSgP
;36    3.000E+00 HDMRhPaRNTdOADMSPPCYP
;36    4.000E+00 TRMBYPAHNwXOdFMcIPcHP
;36    5.000E+00 R`MREPHFMACPHXMc@PSIP
;36    6.000E+00 BAMQ`PvIMaEPq@NSGPSGP
;36    7.000E+00 AXMqQPeHMATPqUNSGPSGP
;36    8.000E+00 QCMQUPTPMaRPRINc@Pc@P
;36    9.000E+00 XdLASPSaMqXPbQNcDPcDP
;36    1.000E+01 gDLqBPCVMQbPCANcHPcHP
;36    1.100E+01 UhLaCPS@MBFPsINsCPsCP
;36    1.200E+01 ECLQFPBaMRHPsTNsHPsHP
;36    1.300E+01 dILAIPRVMbIPDHNCRPCRP
;36    1.400E+01 sPLACPrFMrIPDPNCWPCWP
;36    1.500E+01 cBLyYORIMBYPtPNSRPSRP
;36    1.600E+01 BcLyCOBDMRXPTiNSVPSVP
;36    1.800E+01 bCLXROqYMrUPURNcUPcUP
;36    2.000E+01 AaLGfOQYMBiPFANsTPsTP
;36    2.200E+01 QPLw@OATMCCPFVNCbPCbP
;36    2.400E+01 aFLFbOqAMSEPFgNS`PS`P
;36    2.600E+01 AGLFQOa@McFPgDNShPShP
;36    2.800E+01 iCKFDOQAMsFPgPNDEPDEP
;36    3.000E+01 HEKuROACMCVPWcNTAPTAP
;36    4.000E+01 TSKTUOgTLCdPiHNtIPtIP
;36    5.000E+01 R`KC`OFFLTCPACOdQPdQP
;36    6.000E+01 BAKcGOEBLtEPQAOtYPtYP
;36    8.000E+01 QCKRXOsTLdXPaDOEFPEFP
;36    1.000E+02 gDJRDORhLTaPqCOeFPeFP
;36    1.500E+02 cBJQROQgLeIPAXOUYPUYP
;36    2.000E+02 AaJa@OAXLUQPQXOuYPuYP
;36    3.000E+02 HEIHWNIaKuWPaYOFBPFBP
;36    4.000E+02 TSIfTNwDKUbPqVOVFPVFP
;36    5.000E+02 R`IEYNEgKFAPAaOfEPfEP
;36    6.000E+02 BAItPNDiKFHPAeOvBPvBP
;36    8.000E+02 QCIcWNcVKVHPAiOFPPFPP
;36    1.000E+03 gDHCBNRcKfDPQcOFVPFVP
;36    1.500E+03 cBHRANQeKvCPQgOVTPVTP
;36    2.000E+03 AaHaSNAVKvGPB@OVYPVYP
;36    3.000E+03 HEGQDNyUJFSPBCOfTPfTP
;36    4.000E+03 TSGxWMwBJFUPBEOfWPfWP
;36    5.000E+03 R`GWGMEeJFWPBFOfXPfXP
;36    6.000E+03 BAGFHMDhJFXPBGOvPPvPP
;36    8.000E+03 QCGdXMcVJVPPBHOvQPvQP
;36    1.000E+04 gDFCbMRbJVQPBHOvRPvRP
;36    1.500E+04 cBFbTMQeJVRPBIOvSPvSP
;36    2.000E+04 AaFBCMAVJVSPBIOvTPvTP
;36    3.000E+04 HEEAPMyUIVTPR@OvUPvUP
;36    4.000E+04 TSEAHMwAIVTPR@OvUPvUP
;36    5.000E+04 R`ExVLEeIVTPR@OvVPvVP
;36    6.000E+04 BAEGPLDgIVUPRAOvVPvVP
;36    8.000E+04 QCEeXLcVIVUPRAOvVPvVP
;36    1.000E+05 gDDdRLRbIVUPRAOvVPvVP
;==== ELEMENT  37
;37    1.000E-03 F@RVgOSGU@@R@@RSGUSGU
;37    1.500E-03 eURQEPaAU@@R@@RaBUaAU
;37    1.804E-03 ETRASPwST@@R@@RwXTwST
;37 L3 1.804E-03 ETRASPCIU@@R@@RS@UCIU
;37    1.834E-03 ERRAVPRgU@@R@@RRhURgU
;37    1.864E-03 EPRAYPBfU@@R@@RBfUBfU
;37 L2 1.864E-03 EPRAYPSeU@@R@@RSfUSeU
;37    2.000E-03 u@RaQPCPU@@R@@RCQUCPU
;37    2.065E-03 eERaWPSEU@@R@@RSEUSEU
;37 L1 2.065E-03 eERaWPcPU@@R@@RcQUcPU
;37    3.000E-03 dPRRRPAQU@@R@@RARUAQU
;37    4.000E-03 SiRsFPvQT@@R@@RvUTvQT
;37    5.000E-03 CXRTAPsQT@@R@@RsTTsQT
;37    6.000E-03 CGRtWPbGT@@R@@Rr@TbGT
;37    8.000E-03 BSREgPACT@@R@@RAFTACT
;37    1.000E-02 QeRvWPUVS@@R@@RuWSUWS
;37    1.500E-02 a@RXPPqXS@@R@@RQaSqYS
;37    1.520E-02 QHRXVPqRS@@R@@RAdSqRS
;37 K  1.520E-02 QHRXVPa@T@@R@@RaATa@T
;37    2.000E-02 XGQiXPEiS@@R@@RUhSU`S
;37    3.000E-02 dSQQ@QQeS@@R@@RBASQfS
;37    4.000E-02 RhQQGQhYR@@R@@RYARHaR
;37    5.000E-02 BFQa@QTYR@@R@@RTbRtQR
;37    6.000E-02 QRQaAQrQR@@R@@RRhRBcR
;37    8.000E-02 iEPa@QQFR@@R@@RqHRaHR
;37    1.000E-01 fFPQHQF@Q@@R@@RG`QWGQ
;37    1.500E-01 CAPQ@QqYQ@@R@@RSIQBiQ
;37    2.000E-01 qVPABQgRP@@R@@RQfQqXQ
;37    3.000E-01 X@OIDPrDP@@R@@RaBQQDQ
;37    4.000E-01 dTOXEPAEP@@R@@RiWPiAP
;37    5.000E-01 C@OGXPEeO@@R@@RxFPHFP
;37    6.000E-01 BIOVcPsQO@@R@@RWQPw@P
;37    8.000E-01 QIOV@PQ`O@@R@@RFQPfIP
;37    1.000E+00 gQNEYPQHO@@R@@ReYPeQP
;37    1.022E+00 gINETPQCO@@R@@ReRPUUP
;37    1.250E+00 DhNTbPgPNAIN@@REEPE@P
;37    1.500E+00 sINDWPEVNeGN@@RdQPTXP
;37    2.000E+00 QaNCbPsENQaO@@RDFPDDP
;37    2.044E+00 AcNsWPcCNBEO@@RDCPDAP
;37    3.000E+00 XPMCAPA`NUCOAEMSUPSTP
;37    4.000E+00 tXMRQPa@NHGOdIMsCPsCP
;37    5.000E+00 CFMRGPXcMAFPXUMcEPcEP
;37    6.000E+00 RCMQaPGIMaIPqANcCPcBP
;37    7.000E+00 QVMqRPEfMAYPqWNcDPcDP
;37    8.000E+00 a@MQWPTiMaWPbANcGPcGP
;37    9.000E+00 IULATPtDMAdPbSNsAPsAP
;37    1.000E+01 gULqCPCcMQiPCCNsFPsFP
;37    1.100E+01 vBLaDPCTMRCPCQNCQPCQP
;37    1.200E+01 uALQGPSAMbEPsWNCVPCVP
;37    1.300E+01 TSLQ@PBdMrGPTANSQPSQP
;37    1.400E+01 S`LADPbQMBWPDSNSVPSVP
;37    1.500E+01 CPLIgOBRMRWPtTNcQPcQP
;37    1.600E+01 RiLIPObEMbWPECNcVPcVP
;37    1.800E+01 rFLXYOQhMBdPUVNsUPsUP
;37    2.000E+01 QaLWbOqWMRiPFENCePCeP
;37    2.200E+01 QXLwFOQYMSCPVPNScPScP
;37    2.400E+01 qCLFhOAUMcFPVbNDAPDAP
;37    2.600E+01 QCLFVOqCMsGPw@NDIPDIP
;37    2.800E+01 yVKFIOaCMCXPgUNTFPTFP
;37    3.000E+01 XPKuWOQDMSWPWhNdCPdCP
;37    4.000E+01 tXKTXOHVLSgPyENTRPTRP
;37    5.000E+01 CFKCcOvQLdGPADOtUPtUP
;37    6.000E+01 RCKs@OUVLTPPQBOTdPTdP
;37    8.000E+01 a@KbPOTDLDdPaEOeBPeBP
;37    1.000E+02 gUJRFOcILEHPqDOESPESP
;37    1.500E+02 CPJQTORHLEVPAYOuVPuVP
;37    2.000E+02 QaJa@OaSLeYPQYOUgPUgP
;37    3.000E+02 XPIXTNAILUfPqPOfAPfAP
;37    4.000E+02 tXIfYNXBKVAPqWOvEPvEP
;37    5.000E+02 CFIUTNVPKfAPAbOFUPFUP
;37    6.000E+02 RCItTNEQKfHPAfOVRPVRP
;37    8.000E+02 a@IsPNDEKvHPQaOfQPfQP
;37    1.000E+03 gUHCENcDKFTPQdOfWPfWP
;37    1.500E+03 CPHRCNRFKVSPQiOvUPvUP
;37    2.000E+03 QaHaUNaRKVXPBBOF`PF`P
;37    3.000E+03 XPGQDNAHKfSPBEOFePFeP
;37    4.000E+03 tXGHdMX@JfVPBGOFhPFhP
;37    5.000E+03 CFGgBMFWJfXPBHOFiPFiP
;37    6.000E+03 RCGVCMuIJfYPBIOVaPVaP
;37    8.000E+03 a@GtRMDEJvQPR@OVbPVbP
;37    1.000E+04 gUFCeMcDJvRPR@OVcPVcP
;37    1.500E+04 CPFbVMRFJvSPRAOVePVeP
;37    2.000E+04 QaFBEMaRJvTPRBOVePVeP
;37    3.000E+04 XPEAQMAHJvUPRBOVfPVfP
;37    4.000E+04 tXEAHMHIIvUPRCOVgPVgP
;37    5.000E+04 CFEHcLFWIvVPRCOVgPVgP
;37    6.000E+04 RCEGVLuIIvVPRCOVgPVgP
;37    8.000E+04 a@EuRLDDIvVPRCOVgPVgP
;37    1.000E+05 gUDdULcDIvVPRCOVhPVhP
;==== ELEMENT  38
;38    1.000E-03 VBRHQOCYU@@R@@RCYUCYU
;38    1.500E-03 uSRqCPqDU@@R@@RqEUqDU
;38    1.940E-03 EPRqTPWET@@R@@RgATWET
;38 L3 1.940E-03 EPRqTPBfU@@R@@RBfUBfU
;38    2.000E-03 uFRqYPRXU@@R@@RRYURXU
;38    2.007E-03 uERA`PRWU@@R@@RRWURWU
;38 L2 2.007E-03 uERA`PSWU@@R@@RSXUSWU
;38    2.109E-03 eHRAiPSHU@@R@@RSIUSHU
;38    2.216E-03 e@RQhPBdU@@R@@RBdUBdU
;38 L1 2.216E-03 e@RQhPcDU@@R@@RcDUcDU
;38    3.000E-03 dWRbVPQRU@@R@@RQSUQRU
;38    4.000E-03 DFRCVPgFT@@R@@Rw@TgFT
;38    5.000E-03 SURTHPDBT@@R@@RDFTDBT
;38    6.000E-03 SDRDcPBVT@@R@@RRPTBVT
;38    8.000E-03 BYRUaPQBT@@R@@RQETQCT
;38    1.000E-02 BARvYPFGS@@R@@RfGSFGS
;38    1.500E-02 aERHXPQeS@@R@@RBHSQeS
;38    1.610E-02 QDRxXPQYS@@R@@RqQSaPS
;38 K  1.610E-02 QDRxXPQ@T@@R@@RQATQ@T
;38    2.000E-02 XPQiTPfIS@@R@@RvISv@S
;38    3.000E-02 DaQQ@QR@S@@R@@RRFSRAS
;38    4.000E-02 S@QQGQyIR@@R@@RIbRYQR
;38    5.000E-02 RFQa@QTgR@@R@@RuAREIR
;38    6.000E-02 QXQaAQRcR@@R@@RcARCFR
;38    8.000E-02 iVPa@QaFR@@R@@RAXRqHR
;38    1.000E-01 VTPQHQVTQ@@R@@RxGQwQQ
;38    1.500E-01 SEPQ@QQfQ@@R@@RsGQCEQ
;38    2.000E-01 AdPABQxDP@@R@@RBDQAfQ
;38    3.000E-01 HXOIDPRXP@@R@@RaEQQFQ
;38    4.000E-01 DfOXGPQFP@@R@@RIaPyCP
;38    5.000E-01 SDOGXPFTO@@R@@RHTPXCP
;38    6.000E-01 RIOVdPDIO@@R@@RWWPwEP
;38    8.000E-01 aDOVAPR@O@@R@@RFUPvBP
;38    1.000E+00 WhNUPPqAO@@R@@RuQPeSP
;38    1.022E+00 gTNEUPaDO@@R@@ReUPUWP
;38    1.250E+00 UBNTcPxINQCN@@REGPEBP
;38    1.500E+00 SVNDXPFCNEXN@@RdSPTYP
;38    2.000E+00 B@NCbPcYNQhO@@RDHPDFP
;38    2.044E+00 QbNsXPSVNRBO@@RDDPDCP
;38    3.000E+00 XaMCAPQhNeIOAEMSWPSVP
;38    4.000E+00 EBMRQPqBNxAOt@MsFPsFP
;38    5.000E+00 cAMRGPIcMQ@PXVMcIPcHP
;38    6.000E+00 bCMQbPwYMqCPqANcGPcGP
;38    7.000E+00 aTMqRPFTMQSPqWNcHPcHP
;38    8.000E+00 aEMQWPEXMqRPbANsBPsBP
;38    9.000E+00 YaLATPtWMAiPbSNsFPsFP
;38    1.000E+01 HCLqDPdAMBDPCDNCQPCQP
;38    1.100E+01 fTLaEPsWMRHPCRNCWPCWP
;38    1.200E+01 UXLQGPCRMrAPsXNSRPSRP
;38    1.300E+01 tULQ@PSBMBSPTANSXPSXP
;38    1.400E+01 T@LADPBgMRTPDTNcSPcSP
;38    1.500E+01 SWLIiObVMbTPtTNcXPcXP
;38    1.600E+01 SDLIROBXMrTPECNsSPsSP
;38    1.800E+01 BXLhQORGMRaPUWNCcPCcP
;38    2.000E+01 BALWdOQdMCGPFFNScPScP
;38    2.200E+01 aVLwGOqUMcAPVQNDBPDBP
;38    2.400E+01 qILFiOQYMsDPVbNT@PT@P
;38    2.600E+01 QILFWOAVMCVPwANTHPTHP
;38    2.800E+01 ABLV@OqEMSWPgVNdFPdFP
;38    3.000E+01 XbKuXOaFMcWPWiNtCPtCP
;38    4.000E+01 EBKTYOiILDHPyENdSPdSP
;38    5.000E+01 cAKCcOwFLtHPADODgPDgP
;38    6.000E+01 bCKs@OV@LdQPQBOEFPEFP
;38    8.000E+01 aEKbPOTTLTfPaEOuEPuEP
;38    1.000E+02 HCJRFOcQLeAPqDOUVPUVP
;38    1.500E+02 SWJQTOBPLePPAYOU`PU`P
;38    2.000E+02 BAJaAOqYLEdPQYOVAPVAP
;38    3.000E+02 XbIXVNQILVAPqPOvFPvFP
;38    4.000E+02 EBIvPNXaKfGPqWOVQPVQP
;38    5.000E+02 cAIUUNWCKvGPAbOfQPfQP
;38    6.000E+02 bCItUNUcKFTPAfOfXPfXP
;38    8.000E+02 aEIsQNDUKVTPQaOvWPvWP
;38    1.000E+03 HCHCENSVKfQPQdOFcPFcP
;38    1.500E+03 SWHRCNrGKvPPQiOVbPVbP
;38    2.000E+03 BAHaUNqXKvUPBBOVgPVgP
;38    3.000E+03 XbGQENQHKF`PBFOGBPGBP
;38    4.000E+03 EBGHeMHhJFcPBGOGEPGEP
;38    5.000E+03 cAGgDMW@JFePBIOGGPGGP
;38    6.000E+03 bCGVDMUbJFfPBIOGHPGHP
;38    8.000E+03 aEGtSMDTJFhPR@OW@PW@P
;38    1.000E+04 HCFCfMSUJFiPRAOWAPWAP
;38    1.500E+04 SWFbWMrGJVaPRBOWBPWBP
;38    2.000E+04 BAFBEMqWJVaPRCOWCPWCP
;38    3.000E+04 XbEAQMQHJVbPRCOWDPWDP
;38    4.000E+04 EBEAIMHgIVcPRDOWDPWDP
;38    5.000E+04 cAEHeLW@IVcPRDOWDPWDP
;38    6.000E+04 bCEGXLUbIVcPRDOWEPWEP
;38    8.000E+04 aEEuSLDTIVcPRDOWEPWEP
;38    1.000E+05 HCDdVLSUIVcPRDOWEPWEP
;==== ELEMENT  39
;39    1.000E-03 vGRHPOCfU@@R@@RCfUCfU
;39    1.500E-03 UeRqFPAYU@@R@@RAYUAYU
;39    2.000E-03 UURAcPwFT@@R@@RGRTwFT
;39    2.080E-03 EYRQ`PfXT@@R@@RvTTfXT
;39 L3 2.080E-03 EYRQ`PbRU@@R@@RbSUbRU
;39    2.117E-03 EVRQdPBWU@@R@@RBXUBWU
;39    2.155E-03 ESRQgPrDU@@R@@RrDUrDU
;39 L2 2.155E-03 ESRQgPcFU@@R@@RcFUcFU
;39    2.261E-03 uERBGPRaU@@R@@RRaURaU
;39    2.373E-03 eFRRFPRYU@@R@@RbPURYU
;39 L1 2.373E-03 eFRRFPRfU@@R@@RRfURfU
;39    3.000E-03 DbRrPPaUU@@R@@RaUUaUU
;39    4.000E-03 d@RSPPGiT@@R@@RWcTGiT
;39    5.000E-03 cWRdCPtIT@@R@@RDRTtIT
;39    6.000E-03 cDRDhPbYT@@R@@RrSTbYT
;39    8.000E-03 RXRUhPaCT@@R@@RaFTaCT
;39    1.000E-02 BIRFfPfVS@@R@@RFgSfVS
;39    1.500E-02 qARXTPRDS@@R@@RbHSRES
;39    1.704E-02 QARIFPAYS@@R@@RaQSQPS
;39 K  1.704E-02 QARIFPABT@@R@@RACTABT
;39    2.000E-02 X`QyPPvVS@@R@@RFfSvWS
;39    3.000E-02 EDQQAQbGS@@R@@RrCSbHS
;39    4.000E-02 cFQQGQABS@@R@@RAFSACS
;39    5.000E-02 bGQaAQERR@@R@@RuVRUTR
;39    6.000E-02 aWQaBQc@R@@R@@RCYRsCR
;39    8.000E-02 ABQaAQqHR@@R@@RaQRQQR
;39    1.000E-01 FhPQIQWGQ@@R@@RIEQxFQ
;39    1.500E-01 sBPQAQREQ@@R@@RcPQcFQ
;39    2.000E-01 QdPACQiAP@@R@@RREQQeQ
;39    3.000E-01 XeOYDPBeP@@R@@RaIQa@Q
;39    4.000E-01 UCOhFPaHP@@R@@RAAQYTP
;39    5.000E-01 sBOWWPWEO@@R@@RhQPhHP
;39    6.000E-01 rBOGBPTTO@@R@@RwPPGWP
;39    8.000E-01 qAOVHPrCO@@R@@RVUPFRP
;39    1.000E+00 HSNUWPAUO@@R@@RE`PuQP
;39    1.022E+00 HHNUQPqHO@@R@@RuSPeUP
;39    1.250E+00 EQNThPyANQIN@@RUDPEIP
;39    1.500E+00 sVNTSPfYNuUN@@RdYPdUP
;39    2.000E+00 RBNCgPDINBGO@@RTDPTBP
;39    2.044E+00 BCNCbPSeNbAO@@RT@PDHP
;39    3.000E+00 ISMCDPRINUQOAGMcSPcRP
;39    4.000E+00 u@MRTPAVNhTOtEMCSPCRP
;39    5.000E+00 CPMRIPAINQDPhVMsEPsEP
;39    6.000E+00 rFMQdPhSMqHPqCNsDPsDP
;39    7.000E+00 qSMqTPWCMQYPqYNsFPsFP
;39    8.000E+00 qCMQYPFGMqXPbDNCPPCPP
;39    9.000E+00 AEMAVPeGMQfPbVNCUPCUP
;39    1.000E+01 HYLqEPdVMRBPCGNSPPSPP
;39    1.100E+01 GBLaFPTHMbFPCVNSVPSVP
;39    1.200E+01 U`LQHPsXMBPPCbNcRPcRP
;39    1.300E+01 EBLQAPCUMRRPTFNcXPcXP
;39    1.400E+01 tCLAEPSHMbSPDYNsSPsSP
;39    1.500E+01 sWLA@PRdMrTPD`NsYPsYP
;39    1.600E+01 sBLYROrTMBdPEINCdPCdP
;39    1.800E+01 bRLxPOBPMCBPeSNSePSeP
;39    2.000E+01 RBLHCORDMSHPVCNDEPDEP
;39    2.200E+01 qULGVOQcMsCPVXNTDPTDP
;39    2.400E+01 AWLVgOqVMCVPG@NdCPdCP
;39    2.600E+01 aFLVTOaRMSYPwHNtBPtBP
;39    2.800E+01 AHLVGOAYMsPPwTNtIPtIP
;39    3.000E+01 ITKEdOqIMC`PHGNDWPDWP
;39    4.000E+01 uAKdTOACMdBPIVNtXPtXP
;39    5.000E+01 CPKChOXDLTSPAEOECPECP
;39    6.000E+01 rFKsDOvTLtXPQCOeCPeCP
;39    8.000E+01 qCKbSOEBLUDPaFOUSPUSP
;39    1.000E+02 HYJRIOSiLuIPqEOuUPuUP
;39    1.500E+02 sWJQVObULE`PQQOV@PV@P
;39    2.000E+02 RBJaBOQhLFDPaPOvBPvBP
;39    3.000E+02 ITIhUNqALvBPqROVXPVXP
;39    4.000E+02 uAIvWNIeKFYPqYOvSPvSP
;39    5.000E+02 CPIeQNGgKVYPAdOFcPFcP
;39    6.000E+02 rFID`NVUKfWPAhOV`PV`P
;39    8.000E+02 qCIsUNTaKvWPQcOG@PG@P
;39    1.000E+03 HYHCINScKFcPQfOGFPGFP
;39    1.500E+03 sWHRFNbRKVcPBAOWEPWEP
;39    2.000E+03 RBHaWNQfKVhPBDOg@Pg@P
;39    3.000E+03 ITGQFNqAKGDPBHOgFPgFP
;39    4.000E+03 uAGXeMIaJGGPBIOgIPgIP
;39    5.000E+03 CPGwBMGdJGIPRAOwAPwAP
;39    6.000E+03 rFGfAMVTJWAPRAOwBPwBP
;39    8.000E+03 qCGtXMT`JWBPRBOwDPwDP
;39    1.000E+04 HYFS`MSbJWCPRCOwEPwEP
;39    1.500E+04 sWFrPMbQJWEPRDOwFPwFP
;39    2.000E+04 RBFBGMQfJWEPREOwGPwGP
;39    3.000E+04 ITEASMqAJWGPREOwHPwHP
;39    4.000E+04 uAEQ@MI`IWGPRFOwHPwHP
;39    5.000E+04 CPEXdLGdIWGPRFOwIPwIP
;39    6.000E+04 rFEWVLVTIWGPRFOwIPwIP
;39    8.000E+04 qCEE`LT`IWGPRFOwIPwIP
;39    1.000E+05 HYDtRLSbIWHPRFOGPPGPP
;==== ELEMENT  40
;40    1.000E-03 VURX@Od@U@@R@@RdAUd@U
;40    1.500E-03 VCRqDPaSU@@R@@RaSUaSU
;40    2.000E-03 uQRAaPHFT@@R@@RXBTHFT
;40    2.222E-03 URRBBPf@T@@R@@RfFTf@T
;40 L3 2.222E-03 URRBBPrIU@@R@@RrIUrIU
;40    2.264E-03 EYRBFPbEU@@R@@RbEUbEU
;40    2.307E-03 EVRBIPRAU@@R@@RRBURAU
;40 L2 2.307E-03 EVRBIPReU@@R@@RReUReU
;40    2.417E-03 uGRRIPbSU@@R@@RbTUbSU
;40    2.532E-03 eIRbIPrEU@@R@@RrFUrEU
;40 L1 2.532E-03 eIRbIPbYU@@R@@RbYUbYU
;40    3.000E-03 TdRbYPqWU@@R@@RqWUqWU
;40    4.000E-03 t@RCXPHVT@@R@@RXQTHVT
;40    5.000E-03 sVRdAPtRT@@R@@RtVTtRT
;40    6.000E-03 sARDfPR`T@@R@@RRcTR`T
;40    8.000E-03 bTRUfPqCT@@R@@RqFTqCT
;40    1.000E-02 RERFePg@S@@R@@RGRSg@S
;40    1.500E-02 qERXPPrBS@@R@@RBVSrCS
;40    1.800E-02 AFRiDPqIS@@R@@RQPSqIS
;40 K  1.800E-02 AFRiDPyES@@R@@RIWSyFS
;40    2.000E-02 iBQiTPWDS@@R@@RgDSWES
;40    3.000E-02 eAQQ@QBRS@@R@@RBYSBSS
;40    4.000E-02 sHQQGQAIS@@R@@RQDSQ@S
;40    5.000E-02 rFQa@QEbR@@R@@RVGRUdR
;40    6.000E-02 qSQaAQCUR@@R@@RsTRSWR
;40    8.000E-02 AFQaAQAYR@@R@@RqRRaRR
;40    1.000E-01 WFPQHQwVQ@@R@@RiVQXdQ
;40    1.500E-01 CVPQAQrDQ@@R@@RsYQCTQ
;40    2.000E-01 BBPACQA@Q@@R@@RbDQBCQ
;40    3.000E-01 yDOYDPSAP@@R@@RqBQaBQ
;40    4.000E-01 uEOhEPAPP@@R@@RABQiUP
;40    5.000E-01 CVOWWPGbO@@R@@RhYPxEP
;40    6.000E-01 BROGBPTfO@@R@@RwVPWQP
;40    8.000E-01 qGOVHPRUO@@R@@RVWPFSP
;40    1.000E+00 HaNUVPQYO@@R@@REaPuRP
;40    1.022E+00 HTNUPPQQO@@R@@RuTPeVP
;40    1.250E+00 eUNThPABOaDN@@RUEPEIP
;40    1.500E+00 ScNTSPwBNUeN@@RtPPdVP
;40    2.000E+00 bANCgPDXNRCO@@RTEPTBP
;40    2.044E+00 RBNCbPtBNbHO@@RTAPDIP
;40    3.000E+00 IeMCDPBPNeVOAFMcTPcSP
;40    4.000E+00 UTMRTPaPNHgOtEMCUPCUP
;40    5.000E+00 SUMRIPQINQGPhUMsHPsHP
;40    6.000E+00 BVMQdPIRMAQPqCNsGPsGP
;40    7.000E+00 AaMqTPwXMaSPqYNCPPCPP
;40    8.000E+00 qIMQYPfQMAcPbDNCTPCTP
;40    9.000E+00 Q@MAVPuUMB@PbVNCYPCYP
;40    1.000E+01 HgLqEPEHMRGPCGNSUPSUP
;40    1.100E+01 wCLaFPTUMrBPCUNcRPcQP
;40    1.200E+01 VFLQHPTBMBUPCbNcXPcXP
;40    1.300E+01 eELQAPsVMRXPTFNsTPsTP
;40    1.400E+01 TSLAEPCVMrPPDXNC`PC`P
;40    1.500E+01 SdLYiOcAMB`PtYNCePCeP
;40    1.600E+01 CWLYRORhMRaPEHNSaPSaP
;40    1.800E+01 rTLxPObRMCIPeSNDBPDBP
;40    2.000E+01 bBLHBOrDMcFPVBNTBPTBP
;40    2.200E+01 AcLGUORAMCQPVWNdBPdBP
;40    2.400E+01 QTLVfOQbMSTPViNtAPtAP
;40    2.600E+01 qALVTOqVMcWPwGNDPPDPP
;40    2.800E+01 QCLVGOaSMsXPwSNDXPDXP
;40    3.000E+01 IfKEdOQQMCiPHGNTVPTVP
;40    4.000E+01 UTKdTOQBMtBPITNDhPDhP
;40    5.000E+01 SUKChOHfLdTPAEOUCPUCP
;40    6.000E+01 BVKsDOwDLDhPQCOuCPuCP
;40    8.000E+01 qIKbSOEVLeEPaFOeTPeTP
;40    1.000E+02 HgJRIOtELUQPqEOEgPEgP
;40    1.500E+02 SdJQVOBhLUcPQPOfCPfCP
;40    2.000E+02 bBJaBORELVGPaPOFVPFVP
;40    3.000E+02 IfIhUNASLFVPqROvRPvRP
;40    4.000E+02 UTIvWNAGLfSPqYOFgPFgP
;40    5.000E+02 SUIeQNXWKvTPAdOVhPVhP
;40    6.000E+02 BVID`NWDKFbPAgOGEPGEP
;40    8.000E+02 qIIsUNuEKVbPQbOWEPWEP
;40    1.000E+03 HgHCHNdHKViPQfOgBPgBP
;40    1.500E+03 SdHRENBeKGHPBAOwAPwAP
;40    2.000E+03 bBHaWNRDKWDPBDOwFPwFP
;40    3.000E+03 IfGQFNARKg@PBGOGQPGQP
;40    4.000E+03 UTGXeMAGKgCPBIOGUPGUP
;40    5.000E+03 SUGwAMXTJgEPR@OGWPGWP
;40    6.000E+03 BVGf@MWBJgFPRAOGXPGXP
;40    8.000E+03 qIGtXMuDJgHPRBOWPPWPP
;40    1.000E+04 HgFS`MdGJgIPRCOWPPWPP
;40    1.500E+04 SdFrPMBeJwAPRDOWRPWRP
;40    2.000E+04 bBFBGMRCJwAPRDOWSPWSP
;40    3.000E+04 IfEASMARJwBPREOWTPWTP
;40    4.000E+04 UTEQ@MAGJwCPREOWTPWTP
;40    5.000E+04 SUEXdLXTIwCPREOWUPWUP
;40    6.000E+04 BVEWVLWBIwCPREOWUPWUP
;40    8.000E+04 qIEuYLuDIwCPREOWUPWUP
;40    1.000E+05 HgDtQLdGIwCPRFOWUPWUP
;==== ELEMENT  41
;41    1.000E-03 FaRFdOTYU@@R@@RdPUTYU
;41    1.500E-03 FPRQHPqXU@@R@@RqYUqXU
;41    2.000E-03 UgRaUPHcT@@R@@RHiTHdT
;41    2.371E-03 eVRQiPuYT@@R@@REdTuYT
;41 L3 2.371E-03 eVRQiPRHU@@R@@RRHURHU
;41    2.417E-03 eRRBCPBEU@@R@@RBEUBEU
;41    2.465E-03 UYRBGPQcU@@R@@RQdUQcU
;41 L2 2.465E-03 UYRBGPbYU@@R@@RbYUbYU
;41    2.579E-03 UPRRGPBQU@@R@@RBQUBQU
;41    2.698E-03 EPRbHPRFU@@R@@RRFURFU
;41 L1 2.698E-03 EPRbHPBVU@@R@@RBWUBVU
;41    3.000E-03 UFRRTPQ`U@@R@@RQaUQ`U
;41    4.000E-03 DVRsEPYBT@@R@@RYGTYBT
;41    5.000E-03 CiRT@PEIT@@R@@RUCTEIT
;41    6.000E-03 CRRtWPSDT@@R@@RSGTSDT
;41    8.000E-03 rSRUbPATT@@R@@RAWTATT
;41    1.000E-02 bCRFcPGaS@@R@@RHDSGbS
;41    1.500E-02 AQRHYPRRS@@R@@RbWSRSS
;41    1.899E-02 ACRITPq@S@@R@@RAQSqAS
;41 K  1.899E-02 ACRITPhWS@@R@@RxXShXS
;41    2.000E-02 iRQiUPgPS@@R@@RwQSgQS
;41    3.000E-02 ETQQ@QbPS@@R@@RbWSbQS
;41    4.000E-02 SSQQGQQHS@@R@@RaBSQIS
;41    5.000E-02 BWQa@QfHR@@R@@RfTRFPR
;41    6.000E-02 AbQaBQsSR@@R@@RDCRCeR
;41    8.000E-02 QAQaAQaRR@@R@@RAeRqTR
;41    1.000E-01 WPPQIQHSQ@@R@@RADRiRQ
;41    1.500E-01 cRPQAQRUQ@@R@@RDBQcVQ
;41    2.000E-01 RBPADQAIQ@@R@@RrDQRCQ
;41    3.000E-01 IaOYIPCPP@@R@@RqFQaFQ
;41    4.000E-01 eROx@PQTP@@R@@RADQIdP
;41    5.000E-01 cTOgQPXXO@@R@@RHcPHWP
;41    6.000E-01 RTOGFPEUO@@R@@RGfPgPP
;41    8.000E-01 ATOfBPB`O@@R@@RfTPVPP
;41    1.000E+00 iFNePPqUO@@R@@REgPuWP
;41    1.022E+00 HgNUTPaVO@@R@@RuYPuQP
;41    1.250E+00 UdNEAPQBOq@N@@Re@PUDP
;41    1.500E+00 TCNTVPHENfAN@@RtTPtPP
;41    2.000E+00 rCNCiPTbNbAO@@RTHPTFP
;41    2.044E+00 bCNCdPtUNrGO@@RTEPTCP
;41    3.000E+00 ADNCFPbSNEeOAGMcYPcXP
;41    4.000E+00 EcMRVPqUNYEOtGMSPPCYP
;41    5.000E+00 sSMbAPq@Na@PxQMCTPCSP
;41    6.000E+00 RYMQePACNAUPqDNCSPCSP
;41    7.000E+00 Q`MqUPXRMaXPA`NCVPCVP
;41    8.000E+00 AVMaPPgEMAhPbENSQPSQP
;41    9.000E+00 QEMAWPv@MBFPbXNSVPSVP
;41    1.000E+01 yBLqFPUWMbCPCINcSPcSP
;41    1.100E+01 wQLaGPTiMrHPCWNcYPcYP
;41    1.200E+01 FXLQIPTQMRSPCdNsVPsVP
;41    1.300E+01 URLQBPTBMbVPTHNCbPCbP
;41    1.400E+01 tVLAFPsYMrWPTQNChPChP
;41    1.500E+01 TDLAAPSQMBiPDbNSdPSdP
;41    1.600E+01 cTLYXOcGMRiPUAND@PD@P
;41    1.800E+01 BhLxVOBgMSHPeVNTBPTBP
;41    2.000E+01 rCLHHORVMsEPVFNdBPdBP
;41    2.200E+01 QcLWPOrAMSQPfQNtCPtCP
;41    2.400E+01 aRLGAOR@McUPGCNDRPDRP
;41    2.600E+01 qHLVXOQcMsXPGRNTQPTQP
;41    2.800E+01 QILfAOqXMCiPwXNdPPdPP
;41    3.000E+01 ADLEhOaUMD@PXANdWPdWP
;41    4.000E+01 EcKdWOaBMDTPYPNEAPEAP
;41    5.000E+01 sSKS`OiYLtWPAEOeGPeGP
;41    6.000E+01 RYKsFOHCLECPQDOEXPEXP
;41    8.000E+01 AVKbUOUhLEPPaFOuYPuYP
;41    1.000E+02 yCJb@OtVLeWPqFOFCPFCP
;41    1.500E+02 TDJQWOSELV@PQQOFPPFPP
;41    2.000E+02 rCJaCOrFLvEPaQOfSPfSP
;41    3.000E+02 ADJxQNQWLfTPqROV`PV`P
;41    4.000E+02 EcIFbNQGLFbPqYOGGPGGP
;41    5.000E+02 sSIeTNyGKVcPAdOWGPWGP
;41    6.000E+02 RYIDcNG`KGAPAhOgEPgEP
;41    8.000E+02 AVIsWNEeKWBPQcOwEPwEP
;41    1.000E+03 yBHS@NdXKWIPQfOGRPGRP
;41    1.500E+03 TDHRGNSBKgIPBAOWQPWQP
;41    2.000E+03 rCHaXNrDKwDPBDOWVPWVP
;41    3.000E+03 ADHQGNQVKGPPBGOgRPgRP
;41    4.000E+03 EcGIAMQGKGSPBIOgUPgUP
;41    5.000E+03 sSGwFMyDJGUPR@OgWPgWP
;41    6.000E+03 RYGfDMwXJGWPRAOgXPgXP
;41    8.000E+03 AVGDaMEdJGYPRBOwPPwPP
;41    1.000E+04 yBFScMdWJWPPRCOwRPwRP
;41    1.500E+04 TDFrQMSAJWQPRDOwSPwSP
;41    2.000E+04 rCFBIMrCJWSPRDOwTPwTP
;41    3.000E+04 ADFATMQVJWSPREOwUPwUP
;41    4.000E+04 EcEQAMQGJWTPREOwUPwUP
;41    5.000E+04 sSEI@LyDIWTPREOwUPwUP
;41    6.000E+04 RYEgPLwXIWTPREOwUPwUP
;41    8.000E+04 AVEEcLEdIWTPREOwVPwVP
;41    1.000E+05 yBDtTLdWIWTPREOwVPwVP
;==== ELEMENT  42
;42    1.000E-03 VdRFSOTdU@@R@@RTdUTdU
;42    1.500E-03 VTRQBPQbU@@R@@RQbUQbU
;42    2.000E-03 VARQXPYST@@R@@RiPTYST
;42    2.520E-03 eWRBEPuFT@@R@@RERTuFT
;42 L3 2.520E-03 eWRBEPQgU@@R@@RQhUQgU
;42    2.572E-03 eRRBIPAfU@@R@@RAfUAfU
;42    2.625E-03 UXRRDPqTU@@R@@RqUUqTU
;42 L2 2.625E-03 UXRRDPBSU@@R@@RBSUBSU
;42    2.743E-03 EXRbDPRHU@@R@@RRHURHU
;42    2.866E-03 uHRrDPQfU@@R@@RQfUQfU
;42 L1 2.866E-03 uHRrDPbDU@@R@@RbDUbDU
;42    3.000E-03 eGRBUPBAU@@R@@RBAUBAU
;42    4.000E-03 TVRcEPiVT@@R@@RyQTiVT
;42    5.000E-03 SgRShPEQT@@R@@REUTEQT
;42    6.000E-03 CYRdUPsDT@@R@@RsGTsDT
;42    8.000E-03 rWRE`PQTT@@R@@RQWTQTT
;42    1.000E-02 bGRvRPxDS@@R@@RXXSxES
;42    1.500E-02 AURxGPrPS@@R@@RBeSrQS
;42    2.000E-02 IiQYQPa@S@@R@@RqASaAS
;42 K  2.000E-02 IiQYQPGeS@@R@@RWeSGfS
;42    2.000E-02 IiQYQPGeS@@R@@RWeSGfS
;42    3.000E-02 UXQAIQrTS@@R@@RBaSrUS
;42    4.000E-02 cTQQFQaES@@R@@RaISaFS
;42    5.000E-02 RTQQIQfWR@@R@@RGDRvYR
;42    6.000E-02 AgQa@QSgR@@R@@RdGRDIR
;42    8.000E-02 QDQa@QqSR@@R@@RQfRAeR
;42    1.000E-01 wSPQHQIAQ@@R@@RQ@RABR
;42    1.500E-01 sTPQ@QrSQ@@R@@RdAQCcQ
;42    2.000E-01 RIPACQQHQ@@R@@RBRQb@Q
;42    3.000E-01 AAPYAPcWP@@R@@RqHQaHQ
;42    4.000E-01 EbOhCPaVP@@R@@RAEQIiP
;42    5.000E-01 sVOWTPiFO@@R@@RHePHWP
;42    6.000E-01 bSOG@PEiO@@R@@RGePWYP
;42    8.000E-01 AYOVGPCCO@@R@@RfRPFWP
;42    1.000E+00 YXNUUPAiO@@R@@REdPuTP
;42    1.022E+00 YHNEYPA`O@@R@@RuWPeWP
;42    1.250E+00 VENTgPaAOqDN@@RUGPU@P
;42    1.500E+00 dHNTRPxPNvGN@@RtQPdWP
;42    2.000E+00 BQNCfPuBNbFO@@RTFPTDP
;42    2.044E+00 rANCaPUCNBRO@@RTCPTAP
;42    3.000E+00 AGNCDPBdNUgOAFMcWPcVP
;42    4.000E+00 FCMRTPAiNyBOtDMSPPCYP
;42    5.000E+00 CfMRIPAQNaBPhTMCTPCTP
;42    6.000E+00 bXMQdPQANAXPqCNCTPCTP
;42    7.000E+00 QgMqTPYIMqPPqYNCWPCWP
;42    8.000E+00 QQMQXPGaMQaPbCNSRPSRP
;42    9.000E+00 QIMAVPvYMBIPbVNSXPSXP
;42    1.000E+01 iULqEPF@MbFPCFNcUPcUP
;42    1.100E+01 WhLaFPuGMBRPCUNsRPsRP
;42    1.200E+01 vPLQHPDfMRVPCaNsYPsXP
;42    1.300E+01 uQLQAPDTMbYPTENCePCeP
;42    1.400E+01 TcLAEPDHMBbPDWNSbPSbP
;42    1.500E+01 dILYhOsXMRcPtXNShPShP
;42    1.600E+01 sWLYPOSRMCCPEGNDDPDDP
;42    1.800E+01 RhLhYOCIMcCPeQNTEPTEP
;42    2.000E+01 BQLHAOrUMCPPV@NdFPdFP
;42    2.200E+01 B@LGTOBXMSVPVUNtGPtGP
;42    2.400E+01 aXLVeObFMsPPVgNDWPDWP
;42    2.600E+01 ASLVSOBHMCcPwENTVPTVP
;42    2.800E+01 aCLVFOQbMSePwQNdTPdTP
;42    3.000E+01 AGLEcOqXMDFPHDNtRPtRP
;42    4.000E+01 FDKdSOqBMTQPIQNEFPEFP
;42    5.000E+01 CfKCgOADMDdPAEOuCPuCP
;42    6.000E+01 bXKsCOhTLEIPQCOUTPUTP
;42    8.000E+01 QQKbSOFSLEXPaEOEfPEfP
;42    1.000E+02 iUJRHOUBLuUPqDOV@PV@P
;42    1.500E+02 dIJQUOsILVHPAYOFXPFXP
;42    2.000E+02 BQJaBORTLFSPQYOvQPvQP
;42    3.000E+02 AGJhTNaYLvTPqQOViPViP
;42    4.000E+02 FCIvVNaFLVaPqXOWFPWFP
;42    5.000E+02 CfIePNAALGBPAbOgFPgFP
;42    6.000E+02 bXItYNHPKWAPAfOwDPwDP
;42    8.000E+02 QQIsTNv@KgAPQaOGTPGTP
;42    1.000E+03 iUHCHNECKgHPQdOWQPWQP
;42    1.500E+03 dIHRENsEKwHPQiOgPPgPP
;42    2.000E+03 BQHaVNRQKGTPBBOgVPgVP
;42    3.000E+03 AGHQFNaXKWPPBEOwRPwRP
;42    4.000E+03 FCGXcMaFKWSPBGOwUPwUP
;42    5.000E+03 CfGwAMA@KWUPBHOwWPwWP
;42    6.000E+03 bXGVIMxGJWVPBHOwXPwXP
;42    8.000E+03 QQGtWMfHJWXPBIOG`PG`P
;42    1.000E+04 iUFS`MEBJgPPR@OGaPGaP
;42    1.500E+04 dIFbYMsEJgQPRAOGcPGcP
;42    2.000E+04 BQFBGMRQJgRPRBOGcPGcP
;42    3.000E+04 AGFASMaWJgSPRBOGePGeP
;42    4.000E+04 FCEQ@MaFJgSPRBOGePGeP
;42    5.000E+04 CfEXcLA@JgTPRBOGePGeP
;42    6.000E+04 bXEWTLxGIgTPRCOGePGeP
;42    8.000E+04 QQEuYLfHIgUPRCOGfPGfP
;42    1.000E+05 iUDtQLEBIgUPRCOGfPGfP
;==== ELEMENT  43
;43    1.000E-03 WBRGBOuEU@@R@@RuFUuEU
;43    1.500E-03 fYRaAPBIU@@R@@RBIUBIU
;43    2.000E-03 fDRaWPADU@@R@@RADUADU
;43    2.677E-03 eVRbFPEAT@@R@@REGTEBT
;43 L3 2.677E-03 eVRbFPAaU@@R@@RAaUAaU
;43    2.734E-03 eRRrAPqPU@@R@@RqPUqPU
;43    2.793E-03 UWRrEPaPU@@R@@RaPUaPU
;43 L2 2.793E-03 UWRrEPbBU@@R@@RbBUbBU
;43    3.000E-03 EPRRRPAfU@@R@@RAfUAfU
;43    3.043E-03 uGRRVPqYU@@R@@RA`UqYU
;43 L1 3.043E-03 uGRRVPBEU@@R@@RBFUBEU
;43    4.000E-03 dWRs@PACU@@R@@RADUACU
;43    5.000E-03 DGRDAPuYT@@R@@REdTE`T
;43    6.000E-03 SXRdVPSXT@@R@@RcRTSXT
;43    8.000E-03 BdRE`PaUT@@R@@RaXTaUT
;43    1.000E-02 rCRvRPXiS@@R@@RiCSI@S
;43    1.500E-02 QPRxGPRbS@@R@@RCHSRcS
;43    2.000E-02 ACRYPPq@S@@R@@RAQSqAS
;43    2.104E-02 YVQiXPQBS@@R@@RaCSQCS
;43 K  2.104E-02 YVQiXPwGS@@R@@RGXSwHS
;43    3.000E-02 uXQAIQRbS@@R@@RRiSRcS
;43    4.000E-02 sWQQEQqCS@@R@@RqHSqDS
;43    5.000E-02 bTQQIQWDR@@R@@RWRRgFR
;43    6.000E-02 QeQa@QdFR@@R@@RTWRtHR
;43    8.000E-02 QIQa@QAfR@@R@@RR@RQhR
;43    1.000E-01 HEPQHQyQQ@@R@@RQGRAIR
;43    1.500E-01 CiPQ@QRfQ@@R@@RDUQDFQ
;43    2.000E-01 bIPACQaGQ@@R@@RRSQrAQ
;43    3.000E-01 AFPYCPShP@@R@@RARQqAQ
;43    4.000E-01 FGOhEPAaP@@R@@RAGQAAQ
;43    5.000E-01 ScOWWPAAP@@R@@RXgPXWP
;43    6.000E-01 rUOGBPFRO@@R@@RWcPgVP
;43    8.000E-01 QVOVIPsAO@@R@@RfWPVRP
;43    1.000E+00 A@OUWPBFO@@R@@REhPuXP
;43    1.022E+00 YXNUQPQfO@@R@@RE`PuQP
;43    1.250E+00 FRNTiPqBOAPN@@Re@PUCP
;43    1.500E+00 DWNTSPYPNfRN@@RtTPtPP
;43    2.000E+00 RRNCgPE`NrDO@@RTIPTFP
;43    2.044E+00 BQNCbPePNRPO@@RTEPTCP
;43    3.000E+00 QBNCEPS@NVDOAGMsQPcYP
;43    4.000E+00 v@MRTPBFNYXOtEMSSPSSP
;43    5.000E+00 DCMb@PQSNaFPhVMCXPCXP
;43    6.000E+00 B`MQdPaANQRPqCNCYPCXP
;43    7.000E+00 BFMqTPA@NqUPqYNSRPSRP
;43    8.000E+00 QXMQYPXPMQfPbDNSXPSXP
;43    9.000E+00 aDMAVPwIMREPbWNcTPcTP
;43    1.000E+01 AAMqEPVSMrBPCGNsQPsQP
;43    1.100E+01 xCLaFPEdMBXPCVNsXPsXP
;43    1.200E+01 G@LQHPeIMbSPCbNCePCeP
;43    1.300E+01 UgLQAPDcMrVPTFNSbPSbP
;43    1.400E+01 UDLAEPDTMBiPDYNSiPSiP
;43    1.500E+01 DXLA@PTAMC@PtYNDFPDFP
;43    1.600E+01 SdLYSOCbMSAPEINTBPTBP
;43    1.800E+01 SALxROsFMsAPeSNdDPdDP
;43    2.000E+01 RRLHDORiMCXPVBNtEPtEP
;43    2.200E+01 BHLGWOrPMcUPVXNDVPDVP
;43    2.400E+01 qULVhOBVMsYPViNTVPTVP
;43    2.600E+01 AYLVUObEMSbPwGNdVPdVP
;43    2.800E+01 aILVHOBHMDEPwSNtTPtTP
;43    3.000E+01 QBLEeOQdMTFPHFNDcPDcP
;43    4.000E+01 v@KdUOASMdRPISNUHPUHP
;43    5.000E+01 DCKChOQCMTfPAEOEUPEUP
;43    6.000E+01 B`KsDOyILeBPQCOeWPeWP
;43    8.000E+01 QXKbTOVhLeQPaEOF@PF@P
;43    1.000E+02 AAKRIOUVLEiPqEOfDPfDP
;43    1.500E+02 DXJQVOcXLvCPQPOfTPfTP
;43    2.000E+02 RRJaBOrULVYPQYOFgPFgP
;43    3.000E+02 QBJhVNAcLV`PqQOWEPWEP
;43    4.000E+02 v@IvXNqGLGGPqXOwBPwBP
;43    5.000E+02 DCIeRNAILWIPAcOGSPGSP
;43    6.000E+02 B`IDaNYBKgHPAfOWQPWQP
;43    8.000E+02 QXIsVNFcKwIPQaOgRPgRP
;43    1.000E+03 AAICINEWKGUPQeOgXPgXP
;43    1.500E+03 DXHRFNcTKWVPQiOwXPwXP
;43    2.000E+03 RRHaWNrSKgRPBBOGdPGdP
;43    3.000E+03 QBHQFNAbKgXPBEOW`PW`P
;43    4.000E+03 v@GXfMqFKwQPBGOWcPWcP
;43    5.000E+03 DCGwCMAIKwSPBHOWePWeP
;43    6.000E+03 B`GfAMIIJwUPBIOWgPWgP
;43    8.000E+03 QXGtYMFbJwWPR@OWhPWhP
;43    1.000E+04 AAGSaMEVJwXPRAOH@PH@P
;43    1.500E+04 DXFrPMcTJwYPRBOHAPHAP
;43    2.000E+04 RRFBHMrSJGaPRBOHBPHBP
;43    3.000E+04 QBFASMAbJGaPRCOHCPHCP
;43    4.000E+04 v@EQ@MqFJGbPRCOHCPHCP
;43    5.000E+04 DCEXfLAIJGbPRCOHDPHDP
;43    6.000E+04 B`EWWLIIIGbPRCOHDPHDP
;43    8.000E+04 QXEE`LFbIGbPRCOHDPHDP
;43    1.000E+05 AAEtRLEUIGcPRDOHDPHDP
;==== ELEMENT  44
;44    1.000E-03 gHRuYOuQU@@R@@RuRUuQU
;44    1.500E-03 FhRADPbCU@@R@@RbDUbCU
;44    2.000E-03 FTRQPPQAU@@R@@RQBUQAU
;44    2.838E-03 uQRbCPdUT@@R@@RtPTdUT
;44 L3 2.838E-03 uQRbCPaTU@@R@@RaTUaTU
;44    2.902E-03 eVRbHPQTU@@R@@RQUUQTU
;44    2.967E-03 ePRrCPAUU@@R@@RAUUAUU
;44 L2 2.967E-03 ePRrCPQgU@@R@@RQgUQgU
;44    3.000E-03 UWRrFPQfU@@R@@RQfUQfU
;44    3.224E-03 uIRRTPaSU@@R@@RaTUaSU
;44 L1 3.224E-03 uIRRTPAgU@@R@@RAgUAgU
;44    4.000E-03 DaRSDPAIU@@R@@RAIUAIU
;44    5.000E-03 TGRCfPVCT@@R@@RVGTVCT
;44    6.000E-03 cVRTRPsYT@@R@@RCcTsYT
;44    8.000E-03 R`ReWPqVT@@R@@RqXTqVT
;44    1.000E-02 rGRfPPYVS@@R@@RI`SYVS
;44    1.500E-02 QSRhEPSAS@@R@@RcGSSBS
;44    2.000E-02 AERyFPqHS@@R@@RQPSqIS
;44    2.212E-02 YHQyRPADS@@R@@RQDSAES
;44 K  2.212E-02 YHQyRPvWS@@R@@RFhSvXS
;44    3.000E-02 UcQAGQCGS@@R@@RSDSCHS
;44    4.000E-02 CgQQDQAPS@@R@@RAUSAQS
;44    5.000E-02 rRQQGQWSR@@R@@RWbRgUR
;44    6.000E-02 B@QQIQTPR@@R@@RDbRdRR
;44    8.000E-02 aBQQIQQgR@@R@@RbARBIR
;44    1.000E-01 hHPQGQACR@@R@@RaCRQER
;44    1.500E-01 DAPAIQSEQ@@R@@RdUQdEQ
;44    2.000E-01 rEPABQqFQ@@R@@RbRQrHQ
;44    3.000E-01 AIPIDPdGP@@R@@RATQqCQ
;44    4.000E-01 fFOXGPQdP@@R@@RAGQAAQ
;44    5.000E-01 DEOWPPAIP@@R@@RXiPXYP
;44    6.000E-01 BcOVfPVaO@@R@@RWcPgUP
;44    8.000E-01 aQOVCPSVO@@R@@RfUPFYP
;44    1.000E+00 ACOURPbBO@@R@@REePuTP
;44    1.022E+00 Y`NEVPRAO@@R@@RuWPeWP
;44    1.250E+00 fSNTdPAROATN@@RUFPU@P
;44    1.500E+00 dQNDYPABOvXN@@RtQPdVP
;44    2.000E+00 bPNCdPfCNrHO@@RTFPTDP
;44    2.044E+00 BYNsYPFBNRUO@@RTCPTAP
;44    3.000E+00 QFNCBPsCNfEOAFMcYPcXP
;44    4.000E+00 VQMRRPbANySOtAMSSPSRP
;44    5.000E+00 TFMRHPaTNaHPXYMCXPCXP
;44    6.000E+00 BiMQbPq@NQTPqBNCYPCYP
;44    7.000E+00 RCMqSPAGNqWPqWNSSPSSP
;44    8.000E+00 aSMQWPYBMQhPbBNSYPSYP
;44    9.000E+00 aIMAUPWbMRGPbTNcVPcVP
;44    1.000E+01 ADMqDPG@MrEPCDNsSPsSP
;44    1.100E+01 hQLaEPfFMRQPCRNC`PC`P
;44    1.200E+01 gCLQGPeWMbVPsXNChPChP
;44    1.300E+01 VFLQAPUGMB`PTBNSePSeP
;44    1.400E+01 uALAEPtVMRbPDTNDBPDBP
;44    1.500E+01 dSLYcODPMCDPtUNDHPDHP
;44    1.600E+01 DGLIUOT@MSEPEDNTEPTEP
;44    1.800E+01 cALhTOcPMsEPUXNdGPdGP
;44    2.000E+01 bPLWgOcAMSSPFGNtIPtIP
;44    2.200E+01 RELGPOBiMcYPVQNTPPTPP
;44    2.400E+01 AaLVbObSMCdPVbNdPPdPP
;44    2.600E+01 QTLFYOBQMSgPw@NtPPtPP
;44    2.800E+01 qCLVCObCMT@PgVNtYPtYP
;44    3.000E+01 QFLE`OBGMdAPWhNDgPDgP
;44    4.000E+01 VQKdQOQSMdWPyDNeCPeCP
;44    5.000E+01 TGKCeOaAMEAPADOUPPUPP
;44    6.000E+01 BiKsAOA@MeHPQBOuRPuRP
;44    8.000E+01 aSKbQOGXLeWPaDOFFPFFP
;44    1.000E+02 ADKRGOUeLUePqCOv@Pv@P
;44    1.500E+02 dSJQUOSdLFPPAXOvPPvPP
;44    2.000E+02 bPJaAOReLfWPQXOVePVeP
;44    3.000E+02 QFJXYNQfLVhPaYOgCPgCP
;44    4.000E+02 VQIvSNAWLWFPqVOGPPGPP
;44    5.000E+02 TGIUWNQGLgGPAaOWQPWQP
;44    6.000E+02 BiItWNyWKwFPAdOWYPWYP
;44    8.000E+02 aSIsRNwBKGWPAiOgYPgYP
;44    1.000E+03 ADICFNEeKWTPQbOwWPwWP
;44    1.500E+03 dSHRDNS`KgTPQgOGfPGfP
;44    2.000E+03 bPHaVNRbKwPPB@OWbPWbP
;44    3.000E+03 QFHQENQeKwVPBCOWhPWhP
;44    4.000E+03 VQGHhMAVKG`PBDOHAPHAP
;44    5.000E+03 TGGgFMQGKGbPBEOHCPHCP
;44    6.000E+03 BiGVFMyTJGdPBFOHEPHEP
;44    8.000E+03 aSGtUMw@JGePBGOHFPHFP
;44    1.000E+04 ADGCgMEdJGgPBHOHHPHHP
;44    1.500E+04 dSFbXMCiJGhPBIOHIPHIP
;44    2.000E+04 bPFBFMRbJGiPBIOX@PX@P
;44    3.000E+04 QFFARMQeJW`PBIOXAPXAP
;44    4.000E+04 VQEAIMAVJWaPR@OXBPXBP
;44    5.000E+04 TGEHhLQGJWaPR@OXBPXBP
;44    6.000E+04 BiEWPLySIWaPR@OXBPXBP
;44    8.000E+04 aSEuULw@IWaPR@OXBPXBP
;44    1.000E+05 ADEdXLEdIWaPR@OXBPXBP
;==== ELEMENT  45
;45    1.000E-03 GYRUSOVFU@@R@@RVGUVFU
;45    1.500E-03 W@RA@PBRU@@R@@RBSUBRU
;45    2.000E-03 fVRAUPaAU@@R@@RaAUaAU
;45    3.000E-03 uWRrAPtHT@@R@@RDTTtHT
;45    3.004E-03 uWRrBPtGT@@R@@RDSTtGT
;45 L3 3.004E-03 uWRrBPQQU@@R@@RQQUQQU
;45    3.074E-03 uQRrGPARU@@R@@RARUARU
;45    3.146E-03 eURBSPqCU@@R@@RqDUqCU
;45 L2 3.146E-03 eURBSPAdU@@R@@RAeUAdU
;45    3.276E-03 UTRRTPaWU@@R@@RaWUaWU
;45    3.412E-03 ESRbTPQQU@@R@@RQQUQQU
;45 L1 3.412E-03 ESRbTPqSU@@R@@RqSUqSU
;45    4.000E-03 ThRCIPQGU@@R@@RQGUQGU
;45    5.000E-03 tBRC`PVTT@@R@@RVYTVTT
;45    6.000E-03 sXRDVPDFT@@R@@RT@TDFT
;45    8.000E-03 RiReRPAhT@@R@@RQaTAhT
;45    1.000E-02 BTRVWPACT@@R@@RAETACT
;45    1.500E-02 QYRhDPsES@@R@@RSRSsFS
;45    2.000E-02 AIRyFPQPS@@R@@RaQSQPS
;45    2.322E-02 XaQIiPI`R@@R@@RAHSY`R
;45 K  2.322E-02 XaQIiPvAS@@R@@RFQSvBS
;45    3.000E-02 VEQAGQcFS@@R@@RsCScGS
;45    4.000E-02 DBQQDQAYS@@R@@RQTSQPS
;45    5.000E-02 BcQQHQHER@@R@@RHURXFR
;45    6.000E-02 BIQQIQDbR@@R@@RUERTdR
;45    8.000E-02 aGQQIQRBR@@R@@RrFRbDR
;45    1.000E-01 hRPQGQQAR@@R@@RqARaCR
;45    1.500E-01 THPQ@QCPQ@@R@@RTbQTPQ
;45    2.000E-01 BVPABQAWQ@@R@@RrTQRPQ
;45    3.000E-01 QDPIHPdSP@@R@@RAXQqGQ
;45    4.000E-01 VTOhAPRAP@@R@@RQ@QACQ
;45    5.000E-01 dCOWSPQHP@@R@@RYCPxQP
;45    6.000E-01 RfOViPWQO@@R@@RHDPwTP
;45    8.000E-01 aXOVFPCgO@@R@@RvQPVTP
;45    1.000E+00 AHOUTPBQO@@R@@REiPuYP
;45    1.022E+00 ACOEYPr@O@@R@@REbPuRP
;45    1.250E+00 VcNTfPQUOQPN@@Re@PUCP
;45    1.500E+00 DbNTQPQAOGEN@@RtTPtPP
;45    2.000E+00 rRNCfPvXNBWO@@Rd@PTGP
;45    2.044E+00 bPNCaPVTNbTO@@RTFPTDP
;45    3.000E+00 aANCCPcRNFTOAFMsSPsRP
;45    4.000E+00 F`MRSPBQNA@PtCMSWPSVP
;45    5.000E+00 tEMRIPqXNqAPhSMSSPSRP
;45    6.000E+00 CBMQcPAQNQXPqBNSTPSTP
;45    7.000E+00 bBMqTPQFNAbPqXNSYPSYP
;45    8.000E+00 qPMQXPIiMBCPbCNcUPcUP
;45    9.000E+00 qDMAUPXYMbCPbUNsRPsRP
;45    1.000E+01 AIMqEPWXMBQPCFNC`PC`P
;45    1.100E+01 I@LaFPvYMRXPCTNCgPCgP
;45    1.200E+01 WVLQHPVDMrSPC`NSePSeP
;45    1.300E+01 FTLQAPeQMBgPTDNDCPDBP
;45    1.400E+01 UVLAEPUFMC@PDVNT@PT@P
;45    1.500E+01 DdLYgOtWMSBPtWNTGPTGP
;45    1.600E+01 dELIYODTMcCPEFNdCPdCP
;45    1.800E+01 sFLhXOS`MCSPePNtFPtFP
;45    2.000E+01 rRLH@OCWMcRPFINDXPDXP
;45    2.200E+01 bELGSOSCMsXPVTNTYPTYP
;45    2.400E+01 AiLVeOBeMScPVeNtPPtPP
;45    2.600E+01 aQLVSObRMDGPwCND`PD`P
;45    2.800E+01 qILVEOBRMd@PgXNDiPDiP
;45    3.000E+01 aALEcObEMtAPHANThPThP
;45    4.000E+01 FaKdSOaVMtYPyHNuEPuEP
;45    5.000E+01 tFKCfOqAMUDPADOeSPeSP
;45    6.000E+01 CBKsCOAIMEQPQBOEfPEfP
;45    8.000E+01 qPKbSOX@LEaPaEOf@Pf@P
;45    1.000E+02 AIKRHOFULV@PqDOFUPFUP
;45    1.500E+02 DdJQUOdGLVUPAYOFfPFfP
;45    2.000E+02 rRJaBOSILFcPQXOWAPWAP
;45    3.000E+02 aAJhSNRBLWEPaYOGPPGPP
;45    4.000E+02 FaIvUNQYLwCPqVOWWPWWP
;45    5.000E+02 tFIUYNaGLGUPAaOgYPgYP
;45    6.000E+02 CBItYNAFLWSPAeOwVPwVP
;45    8.000E+02 qPIsTNWbKgUPAiOGhPGhP
;45    1.000E+03 AIICHNvDKwRPQbOWdPWdP
;45    1.500E+03 DdHRENdBKGcPQgOHEPHEP
;45    2.000E+03 rRHaVNSFKGiPB@OXAPXAP
;45    3.000E+03 aAHQFNRAKWePBCOXFPXFP
;45    4.000E+03 FaGXbMQXKWhPBDOh@Ph@P
;45    5.000E+03 tFGw@MaGKHAPBFOhBPhBP
;45    6.000E+03 CBGVIMAEKHBPBFOhDPhDP
;45    8.000E+03 qPGtWMWaJHDPBGOhEPhEP
;45    1.000E+04 AIGCiMvCJHEPBHOhFPhFP
;45    1.500E+04 DdFbYMdBJHGPBIOhHPhHP
;45    2.000E+04 rRFBGMSFJHHPBIOhIPhIP
;45    3.000E+04 aAFASMRAJHIPR@Ox@Px@P
;45    4.000E+04 FaEAIMQXJHIPR@Ox@Px@P
;45    5.000E+04 tFEXbLaFJHIPR@Ox@Px@P
;45    6.000E+04 CBEWTLAEJX@PR@OxAPxAP
;45    8.000E+04 qPEuXLWaIX@PR@OxAPxAP
;45    1.000E+05 AIEtPLvCIXAPRAOxBPxBP
;==== ELEMENT  46
;46    1.000E-03 gSRdGOVSU@@R@@RVTUVSU
;46    1.500E-03 gGRHWORWU@@R@@RRXURWU
;46    2.000E-03 FdRq@PaIU@@R@@RaIUaIU
;46    3.000E-03 UdRREPdWT@@R@@RtSTdWT
;46    3.173E-03 uYRbIPDET@@R@@RTATDET
;46 L3 3.173E-03 uYRbIPqEU@@R@@RqFUqEU
;46    3.251E-03 uRRrEPaHU@@R@@RaHUaHU
;46    3.330E-03 eVRBQPaAU@@R@@RaBUaAU
;46 L2 3.330E-03 eVRBQPaVU@@R@@RaVUaVU
;46    3.465E-03 UTRRRPQQU@@R@@RQRUQQU
;46    3.604E-03 ESRbRPqGU@@R@@RqHUqGU
;46 L1 3.604E-03 ESRbRPQXU@@R@@RQXUQXU
;46    4.000E-03 UBRRbPaBU@@R@@RaCUaBU
;46    5.000E-03 DRRcRPFgT@@R@@RVaTFgT
;46    6.000E-03 CfRdGPdGT@@R@@RtATdGT
;46    8.000E-03 CDRETPQiT@@R@@RBBTQiT
;46    1.000E-02 BXRvIPAHT@@R@@RQATAIT
;46    1.500E-02 aRRHHPSTS@@R@@RsQSSUS
;46    2.000E-02 QBRYIPQXS@@R@@RqPSQYS
;46    2.435E-02 XRQIhPIHR@@R@@RA@SYHR
;46 K  2.435E-02 XRQIhPEaS@@R@@RU`SEbS
;46    3.000E-02 fHQAEQsIS@@R@@RCVSCPS
;46    4.000E-02 T@QQBQQVS@@R@@RaQSQWS
;46    5.000E-02 BiQQFQHTR@@R@@RHeRXVR
;46    6.000E-02 RDQQGQEGR@@R@@REPRUHR
;46    8.000E-02 qAQQGQbCR@@R@@RBXRrER
;46    1.000E-01 HcPQEQQGR@@R@@RqHRaIR
;46    1.500E-01 dIPAHQcPQ@@R@@RUBQdYQ
;46    2.000E-01 RRPAAQQVQ@@R@@RBcQRXQ
;46    3.000E-01 QGPXgPTcP@@R@@RQQQqIQ
;46    4.000E-01 vROXAPbEP@@R@@RQ@QADQ
;46    5.000E-01 tEOGTPaFP@@R@@RYCPxPP
;46    6.000E-01 CDOV`PHBO@@R@@RHAPwQP
;46    8.000E-01 qSOFHPTDO@@R@@RfWPVPP
;46    1.000E+00 QAOEXPRXO@@R@@REePuTP
;46    1.022E+00 AFOERPBUO@@R@@RuWPeWP
;46    1.250E+00 WCNTaPaVOQTN@@RUFPEIP
;46    1.500E+00 TfNDVPQIOg@N@@RtPPdUP
;46    2.000E+00 rYNCaPgDNRQO@@RTFPTCP
;46    2.044E+00 bWNsVPViNbYO@@RTCPT@P
;46    3.000E+00 aDNC@PCfNVROAEMsPPcYP
;46    4.000E+00 ViMRPPRWNAAPdHMSUPSUP
;46    5.000E+00 DXMRFPQ`NqBPXRMSRPSQP
;46    6.000E+00 SAMQaPQPNQYPqANSTPSSP
;46    7.000E+00 bIMqRPaDNAdPqVNSYPSXP
;46    8.000E+00 qUMQVPAENBEPb@NcUPcUP
;46    9.000E+00 qHMATPYEMbEPbRNsRPsRP
;46    1.000E+01 QBMqCPHHMBSPCBNC`PC`P
;46    1.100E+01 iFLaDPgCMbPPCPNChPChP
;46    1.200E+01 wXLQFPVTMrUPsUNSfPSfP
;46    1.300E+01 fSLQ@PUhMBiPDINDDPDDP
;46    1.400E+01 uRLADPEYMCBPDQNTAPTAP
;46    1.500E+01 ThLIfOEHMSDPtQNTHPTHP
;46    1.600E+01 tGLyHOtSMcFPE@NdEPdEP
;46    1.800E+01 CVLXXOTEMCVPUSNtHPtHP
;46    2.000E+01 B`LWaOsPMcUPFBNTPPTPP
;46    2.200E+01 rALwEOsDMCaPFVNdRPdRP
;46    2.400E+01 QdLFfOCDMSgPFfNtRPtRP
;46    2.600E+01 aVLFUOrYMT@PgDNDbPDbP
;46    2.800E+01 ASLFHORWMdCPWYNTbPTbP
;46    3.000E+01 aDLuVOrIMtEPWbNEAPEAP
;46    4.000E+01 G@KTXOqWMDbPiFNuHPuHP
;46    5.000E+01 DXKCbOAPMUHPACOeVPeVP
;46    6.000E+01 SAKcIOQFMEUPQAOEiPEiP
;46    8.000E+01 qUKbPOhRLEfPaCOfDPfDP
;46    1.000E+02 QBKREOFfLVEPqBOFYPFYP
;46    1.500E+02 ThJQSOTTLfPPAWOV`PV`P
;46    2.000E+02 B`Ja@OCPLFhPQVOWEPWEP
;46    3.000E+02 aDJXSNbFLg@PaWOGUPGUP
;46    4.000E+02 G@IfXNaYLwHPqTOgRPgRP
;46    5.000E+02 DXIUSNqELWPPqXOwSPwSP
;46    6.000E+02 SAItSNQBLWYPAbOGbPGbP
;46    8.000E+02 qUIsPNHSKwPPAfOWcPWcP
;46    1.000E+03 QBICDNvTKwXPAiOH@PH@P
;46    1.500E+03 ThHRBNDYKGhPQdOX@PX@P
;46    2.000E+03 B`HaTNsGKWePQgOXFPXFP
;46    3.000E+03 aDHQDNbDKHAPQiOhBPhBP
;46    4.000E+03 G@GHbMaXKHDPBAOhEPhEP
;46    5.000E+03 DXGgBMqEKHFPBBOhGPhGP
;46    6.000E+03 SAGVBMQBKHHPBCOhHPhHP
;46    8.000E+03 qUGtQMHQJX@PBDOxAPxAP
;46    1.000E+04 QBGCeMvSJXAPBDOxBPxBP
;46    1.500E+04 ThFbVMDYJXCPBEOxCPxCP
;46    2.000E+04 B`FBDMsFJXCPBEOxDPxDP
;46    3.000E+04 aDFAQMbDJXDPBFOxEPxEP
;46    4.000E+04 G@EAHMaXJXEPBFOxFPxFP
;46    5.000E+04 DXEHbLqEJXEPBFOxFPxFP
;46    6.000E+04 SAEGULQBJXEPBFOxFPxFP
;46    8.000E+04 qUEuRLHQIXEPBFOxFPxFP
;46    1.000E+05 QBEdULvSIXFPBGOxGPxGP
;==== ELEMENT  47
;47    1.000E-03 GcRThOGCU@@R@@RGDUGCU
;47    1.500E-03 GURYGOrXU@@R@@RrYUrXU
;47    2.000E-03 GBRqEPqIU@@R@@RAPUqIU
;47    3.000E-03 VARRGPEGT@@R@@RUDTEHT
;47    3.351E-03 EaRBUPCcT@@R@@RCiTCcT
;47 L3 3.351E-03 EaRBUPaGU@@R@@RaGUaGU
;47    3.436E-03 uTRRQPQIU@@R@@Ra@UQIU
;47    3.524E-03 eWRRXPQBU@@R@@RQCUQBU
;47 L2 3.524E-03 eWRRXPQTU@@R@@RQUUQTU
;47    3.662E-03 UURbXPAPU@@R@@RAQUAPU
;47    3.806E-03 ETRrYPaHU@@R@@RaHUaHU
;47 L1 3.806E-03 ETRrYPAVU@@R@@RAWUAVU
;47    4.000E-03 eHRRcPq@U@@R@@RqAUq@U
;47    5.000E-03 TXRcRPwDT@@R@@RwITwDT
;47    6.000E-03 D@RdGPTWT@@R@@RdQTTWT
;47    8.000E-03 SDRERPRCT@@R@@RRFTRCT
;47    1.000E-02 RVRvIPQGT@@R@@RQITQGT
;47    1.500E-02 aXRX@PCbS@@R@@RD@SCcS
;47    2.000E-02 QFRiBPqQS@@R@@RAdSqRS
;47    2.551E-02 hGQAAQhPR@@R@@RYSRxPR
;47 K  2.551E-02 hGQAAQEUS@@R@@RUTSEVS
;47    3.000E-02 VTQAFQSYS@@R@@RcWScPS
;47    4.000E-02 dGQQCQaWS@@R@@RqRSaXS
;47    5.000E-02 CBQQFQICR@@R@@RIURYDR
;47    6.000E-02 bCQQHQERR@@R@@RuWRUTR
;47    8.000E-02 qFQQHQBPR@@R@@RbURRQR
;47    1.000E-01 iCPQFQaFR@@R@@RAWRqHR
;47    1.500E-01 DXPAIQCiQ@@R@@RESQThQ
;47    2.000E-01 bTPABQaYQ@@R@@RRgQrQQ
;47    3.000E-01 aBPIDPuDP@@R@@RQVQATQ
;47    4.000E-01 GCOXGPBTP@@R@@RQCQAFQ
;47    5.000E-01 TVOWPPqGP@@R@@RyBPHgP
;47    6.000E-01 SIOVfPxRO@@R@@RXEPGcP
;47    8.000E-01 AaOVDPTPO@@R@@RvWPVYP
;47    1.000E+00 QFOURPBaO@@R@@RUbPE`P
;47    1.022E+00 QAOEWPbWO@@R@@REdPuSP
;47    1.250E+00 GXNTdPA`OaPN@@ReBPUDP
;47    1.500E+00 e@NTPPaIOWPN@@RtUPtPP
;47    2.000E+00 RcNCdPGhNbPO@@RdAPTHP
;47    2.044E+00 B`NsYPgPNrXO@@RTHPTEP
;47    3.000E+00 q@NCBPTINvTOAFMsUPsTP
;47    4.000E+00 wDMRRPrYNADPtAMcQPcPP
;47    5.000E+00 tPMRHPBGNqFPXYMSXPSWP
;47    6.000E+00 cFMQcPaSNaTPqBNcPPcPP
;47    7.000E+00 BPMqSPqENAiPqXNcUPcUP
;47    8.000E+00 AdMQXPQDNRAPbBNsRPsRP
;47    9.000E+00 AUMAUPYcMrAPbTNC`PC`P
;47    1.000E+01 QGMqDPxWMRPPCDNChPChP
;47    1.100E+01 yQLaEPGdMbWPCRNSgPSfP
;47    1.200E+01 XFLQGPW@MBcPsXNDEPDEP
;47    1.300E+01 VeLQAPFXMRgPTBNTCPTCP
;47    1.400E+01 UiLAEPUeMSAPDTNd@Pd@P
;47    1.500E+01 eBLYcOUQMcCPtUNdHPdHP
;47    1.600E+01 TYLIVOUCMsEPEDNtEPtEP
;47    1.800E+01 cRLhUOTPMSVPUWNDXPDXP
;47    2.000E+01 RdLWgODAMsUPFFNdQPdQP
;47    2.200E+01 BSLGQOcQMSbPVPNtSPtSP
;47    2.400E+01 BDLVbOcIMDHPVbNDdPDdP
;47    2.600E+01 qTLVPOCBMdBPw@NTdPTdP
;47    2.800E+01 QPLVCOrYMtEPgTNEDPEDP
;47    3.000E+01 qALEaORYMDWPWgNUCPUCP
;47    4.000E+01 wDKdQOQaMTfPyBNUQPUQP
;47    5.000E+01 tPKCeOQRMuBPADOEaPEaP
;47    6.000E+01 cFKsBOaEMePPQBOFDPFDP
;47    8.000E+01 AdKbROyCLFBPaDOFPPFPP
;47    1.000E+02 QGKRGOGSLvAPqCOfVPfVP
;47    1.500E+02 eBJQUOTbLvXPAXOGIPGIP
;47    2.000E+02 RdJaAOcXLGFPQWOwDPwDP
;47    3.000E+02 qAJXYNBTLwIPaXOgUPgUP
;47    4.000E+02 wDIvSNAcLWXPqUOGbPGbP
;47    5.000E+02 tPIUWNAVLwPPqYOWcPWcP
;47    6.000E+02 cFItWNaBLwYPAcOHBPHBP
;47    8.000E+02 AdIsSNYCKWaPAhOXCPXCP
;47    1.000E+03 QGICGNw@KWhPQaOh@Ph@P
;47    1.500E+03 eBHRDNDfKX@PQeOxAPxAP
;47    2.000E+03 RdHaVNcUKXEPQhOxGPxGP
;47    3.000E+03 qAHQENBSKhBPBAOHSPHSP
;47    4.000E+03 wDGHiMAbKhEPBBOHVPHVP
;47    5.000E+03 tPGgGMAVKhGPBCOHXPHXP
;47    6.000E+03 cFGVFMaAKhIPBDOXPPXPP
;47    8.000E+03 AdGtUMYAJxAPBEOXRPXRP
;47    1.000E+04 QGGChMgIJxBPBFOXSPXSP
;47    1.500E+04 eBFbXMDfJxDPBFOXUPXUP
;47    2.000E+04 RdFBFMcTJxEPBGOXVPXVP
;47    3.000E+04 qAFARMBSJxFPBGOXWPXWP
;47    4.000E+04 wDEAIMAbJxFPBHOXWPXWP
;47    5.000E+04 tPEHhLAVJxGPBHOXXPXXP
;47    6.000E+04 cFEWQLaAJxGPBHOXXPXXP
;47    8.000E+04 AdEuVLYAIxGPBHOXXPXXP
;47    1.000E+05 QGEdYLgIIxGPBHOXXPXXP
;==== ELEMENT  48
;48    1.000E-03 GcRuHOwDU@@R@@RwEUwDU
;48    1.500E-03 GTRiYORbU@@R@@RRcURbU
;48    2.000E-03 G@RqHPAWU@@R@@RAWUAWU
;48    3.000E-03 VARRGPuET@@R@@REQTuET
;48    3.538E-03 eVRRVPSRT@@R@@RSXTSRT
;48 L3 3.538E-03 eVRRVPQEU@@R@@RQEUQEU
;48    3.631E-03 UXRbSPAHU@@R@@RAHUAHU
;48    3.727E-03 UQRrPPAAU@@R@@RAAUAAU
;48 L2 3.727E-03 UQRrPPqHU@@R@@RqIUqHU
;48    4.000E-03 eIRBiPQFU@@R@@RQGUQFU
;48    4.018E-03 eHRR`PQEU@@R@@RQFUQEU
;48 L1 4.018E-03 eHRR`PqBU@@R@@RqCUqBU
;48    5.000E-03 TYRSUPgTT@@R@@RgYTgTT
;48    6.000E-03 DARTGPtUT@@R@@RtYTtUT
;48    8.000E-03 SEReHPbBT@@R@@RbETbBT
;48    1.000E-02 RWRfAPaBT@@R@@RaDTaBT
;48    1.500E-02 aYRW`PD@S@@R@@RTHSDAS
;48    2.000E-02 QHRXiPqYS@@R@@RQbSA`S
;48    2.671E-02 GbQYgPWcR@@R@@RHaRHCR
;48 K  2.671E-02 GbQYgPThS@@R@@REFSTiS
;48    3.000E-02 fQQACQcYS@@R@@RsVSsPS
;48    4.000E-02 tBQQ@QqRS@@R@@RqXSqSS
;48    5.000E-02 CEQQDQyFR@@R@@RyXRIWR
;48    6.000E-02 bFQQEQeTR@@R@@RUhRuUR
;48    8.000E-02 qHQQEQRPR@@R@@RrURbQR
;48    1.000E-01 yFPQCQqBR@@R@@RQRRASR
;48    1.500E-01 TUPAGQDGQ@@R@@RUYQUDQ
;48    2.000E-01 bXPYhPqWQ@@R@@RCDQrWQ
;48    3.000E-01 aDPHePeQP@@R@@RQWQAUQ
;48    4.000E-01 WEOH@PRWP@@R@@RQCQAFQ
;48    5.000E-01 dSOwDPATP@@R@@RiEPxYP
;48    6.000E-01 cDOFbPi@O@@R@@RHFPwTP
;48    8.000E-01 AdOFAPtUO@@R@@RfWPFYP
;48    1.000E+00 QHOEQPRgO@@R@@REcPuQP
;48    1.022E+00 QCOuFPBbO@@R@@RuUPeTP
;48    1.250E+00 gPNDePQ`OaSN@@RUCPEEP
;48    1.500E+00 eINDQPqFOgPN@@RdWPdRP
;48    2.000E+00 RhNsVPxANbRO@@RTDPTAP
;48    2.044E+00 BeNsRPHCNBaO@@RTAPDHP
;48    3.000E+00 qCNRfPDRNvWOADMsPPcXP
;48    4.000E+00 GWMBWPRdNAEPdCMSVPSUP
;48    5.000E+00 tXMRDPRHNqGPHRMSTPSSP
;48    6.000E+00 sBMAiPqRNaTPaINSVPSVP
;48    7.000E+00 BTMqPPARNAiPqTNcRPcRP
;48    8.000E+00 AgMQTPa@NRAPRGNcYPcYP
;48    9.000E+00 AXMARPAENrAPRYNsWPsWP
;48    1.000E+01 a@MqBPiCMRPPRhNCePCeP
;48    1.100E+01 IhLaCPhFMbWPsENSdPSdP
;48    1.200E+01 x@LQEPGWMBbPsQNDBPDBP
;48    1.300E+01 GGLAHPFaMRgPDDNT@PT@P
;48    1.400E+01 V@LACPfGMS@PtENTHPTHP
;48    1.500E+01 uALySOE`McCPdUNdEPdEP
;48    1.600E+01 dWLiGOuIMsDPTcNtBPtBP
;48    1.800E+01 cYLHXOtSMSUPEVNDVPDVP
;48    2.000E+01 RiLGbOdBMsTPUdNTYPTYP
;48    2.200E+01 BWLgFOC`MSaPvHNtQPtQP
;48    2.400E+01 BGLvXOCVMDGPvWNDbPDbP
;48    2.600E+01 qWLvGOSHMdAPWENTbPTbP
;48    2.800E+01 QRLFAORcMtDPGYNEBPEBP
;48    3.000E+01 qCLeYOrSMDVPGaNUAPUAP
;48    4.000E+01 GWKTROBAMTePYCNEYPEYP
;48    5.000E+01 tXKsWOQYMuAPAAOuYPuYP
;48    6.000E+01 sBKcEOqBMUYPAIOFBPFBP
;48    8.000E+01 AgKRVOIaLFAPaAOvHPvHP
;48    1.000E+02 a@KRCOGaLv@Pq@OfTPfTP
;48    1.500E+02 uAJQROUGLvWPATOGFPGFP
;48    2.000E+02 RiJQIOCgLGEPQSOwBPwBP
;48    3.000E+02 qCJHRNRWLwGPaUOgRPgRP
;48    4.000E+02 GWIVYNQbLWVPqQOG`PG`P
;48    5.000E+02 tXIEVNQTLgXPqVOWaPWaP
;48    6.000E+02 sBIdXNaHLwWPqYOH@PH@P
;48    8.000E+02 AgIcUNYYKGiPAdOXAPXAP
;48    1.000E+03 a@IC@NgWKWgPAgOXHPXHP
;48    1.500E+03 uAHR@NUAKHGPQaOhIPhIP
;48    2.000E+03 RiHaRNCcKXDPQdOxEPxEP
;48    3.000E+03 qCHQCNRUKh@PQfOHQPHQP
;48    4.000E+03 GWGxRMQbKhCPQhOHTPHTP
;48    5.000E+03 tXGWCMQSKhFPQiOHVPHVP
;48    6.000E+03 sBGFDMaHKhGPB@OHXPHXP
;48    8.000E+03 AgGdUMYWJhIPBAOXPPXPP
;48    1.000E+04 a@GC`MgVJx@PBAOXQPXQP
;48    1.500E+04 uAFbSMUAJxBPBBOXRPXRP
;48    2.000E+04 RiFBBMCcJxCPBCOXTPXTP
;48    3.000E+04 qCFqIMRUJxDPBCOXUPXUP
;48    4.000E+04 GWEAGMQaJxEPBCOXUPXUP
;48    5.000E+04 tXExQLQSJxEPBDOXUPXUP
;48    6.000E+04 sBEwFLaHJxEPBDOXVPXVP
;48    8.000E+04 AgEeTLYWIxEPBDOXVPXVP
;48    1.000E+05 a@ETYLgVIxFPBDOXVPXVP
;==== ELEMENT  49
;49    1.000E-03 WeREUOG`U@@R@@RGaUG`U
;49    1.500E-03 WTRIgOSBU@@R@@RSCUSBU
;49    2.000E-03 GIRARPQWU@@R@@RQXUQWU
;49    3.000E-03 VIRb@PuUT@@R@@REaTuUT
;49    3.730E-03 ePRrSPs@T@@R@@RsFTs@T
;49 L3 3.730E-03 ePRrSPADU@@R@@RAEUADU
;49    3.833E-03 URRB`PIaT@@R@@RIgTIbT
;49    3.938E-03 ESRBgPiFT@@R@@RyATiFT
;49 L2 3.938E-03 ESRBgPaEU@@R@@RaEUaEU
;49    4.000E-03 uIRRbPaCU@@R@@RaCUaCU
;49    4.238E-03 eARCHPAFU@@R@@RAGUAFU
;49 L3 4.238E-03 eARCHPaBU@@R@@RaBUaBU
;49    5.000E-03 dYRSWPHIT@@R@@RXCTHIT
;49    6.000E-03 TARTGPECT@@R@@REGTECT
;49    8.000E-03 cCReDPrFT@@R@@RrITrFT
;49    1.000E-02 bSRVHPaIT@@R@@RqBTq@T
;49    1.500E-02 qSRGfPdFS@@R@@RDUSdGS
;49    2.000E-02 aARXePQaS@@R@@RBDSQbS
;49    2.794E-02 WUQAAQGVR@@R@@RxARWVR
;49 K  2.794E-02 WUQAAQdUS@@R@@RtSSdVS
;49    3.000E-02 FaQACQCgS@@R@@RSeSChS
;49    4.000E-02 DTQQ@QAbS@@R@@RAgSAcS
;49    5.000E-02 SEQQCQIhR@@R@@RACSYiR
;49    6.000E-02 rDQQEQUfR@@R@@RvARFGR
;49    8.000E-02 ASQQEQbUR@@R@@RRaRrVR
;49    1.000E-01 iWPQCQAPR@@R@@RaQRQQR
;49    1.500E-01 tPPAFQtDQ@@R@@REhQEQQ
;49    2.000E-01 rWPYfPAiQ@@R@@RSGQBiQ
;49    3.000E-01 aIPHdPFBP@@R@@RaQQAYQ
;49    4.000E-01 GQOWiPrVP@@R@@RQEQAGQ
;49    5.000E-01 D`OwDPQUP@@R@@RyGPHiP
;49    6.000E-01 sFOFaPIiO@@R@@RXDPG`P
;49    8.000E-01 QaOFAPUAO@@R@@RvQPVRP
;49    1.000E+00 aCOEQPSIO@@R@@REePuSP
;49    1.022E+00 QHOuEPCCO@@R@@RuXPeVP
;49    1.250E+00 GhNDdPBEOaYN@@RUDPEFP
;49    1.500E+00 EXNDPPAWOGeN@@RdXPdSP
;49    2.000E+00 CINsVPXdNbYO@@RTEPTBP
;49    2.044E+00 RfNsRPhRNBhO@@RTBPDIP
;49    3.000E+00 qHNRfPtUNVaOADMsQPsPP
;49    4.000E+00 wTMBWPSENAGPdCMSXPSWP
;49    5.000E+00 TeMRCPrDNqIPHQMSVPSVP
;49    6.000E+00 CTMAiPAdNaWPaINcPPSYP
;49    7.000E+00 RSMqPPQRNQcPqTNcVPcUP
;49    8.000E+00 QdMQTPaINREPRGNsSPsSP
;49    9.000E+00 QSMARPQBNrFPRYNCaPCaP
;49    1.000E+01 aDMqAPIiMRTPRhNS`PS`P
;49    1.100E+01 ABMaCPHeMrRPsENSiPShP
;49    1.200E+01 hQLQEPH@MBhPsPNDGPDGP
;49    1.300E+01 wCLAHPw@MCBPDCNTFPTEP
;49    1.400E+01 vBLABPvQMSFPtENdDPdCP
;49    1.500E+01 UQLySOfAMcIPdUNtAPtAP
;49    1.600E+01 DdLiGOuXMCPPTcNtIPtHP
;49    1.800E+01 CbLHWOEGMcRPEUNTRPTRP
;49    2.000E+01 S@LGaOTRMCaPUcNdUPdUP
;49    2.200E+01 RVLgEODGMShPvGNtXPtXP
;49    2.400E+01 RELvXOsQMTDPvWNDiPDiP
;49    2.600E+01 AcLvGOCPMdIPWCNE@PE@P
;49    2.800E+01 QXLFAOSDMDRPGXNU@PU@P
;49    3.000E+01 qHLeYORbMTTPG`NUIPUIP
;49    4.000E+01 wUKTROREMECPYBNUXPUXP
;49    5.000E+01 TfKsWOqQMEPPAAOEhPEhP
;49    6.000E+01 CTKcEOAQMeYPAIOVBPVBP
;49    8.000E+01 QdKRVOAEMVAPaAOFYPFYP
;49    1.000E+02 aDKRCOxGLFQPq@OvUPvUP
;49    1.500E+02 UQJQQOUTLFiPATOWHPWHP
;49    2.000E+02 S@JQIOTDLWGPQSOGTPGTP
;49    3.000E+02 qHJHRNrULWPPaTOwUPwUP
;49    4.000E+02 wUIVYNBFLgYPqQOWcPWcP
;49    5.000E+02 TfIEVNaULGaPqUOHDPHDP
;49    6.000E+02 CTIdWNqGLW`PqYOXCPXCP
;49    8.000E+02 QdIcUNACLHBPAcOhDPhDP
;49    1.000E+03 aDIC@NhAKX@PAfOxBPxBP
;49    1.500E+03 UQHR@NEWKhAPQaOHSPHSP
;49    2.000E+03 S@HaRNT@KhHPQcOHYPHYP
;49    3.000E+03 qHHQCNrSKxDPQfOXUPXUP
;49    4.000E+03 wUGxQMBEKxHPQhOXXPXXP
;49    5.000E+03 TfGWBMaTKHPPQiOhPPhPP
;49    6.000E+03 CTGFDMqGKHQPQiOhRPhRP
;49    8.000E+03 QdGdUMABKHSPB@OhTPhTP
;49    1.000E+04 aDGC`Mh@JHUPBAOhUPhUP
;49    1.500E+04 UQFbSMEWJHWPBBOhWPhWP
;49    2.000E+04 S@FBBMT@JHXPBBOhXPhXP
;49    3.000E+04 qHFqIMrSJHYPBCOhYPhYP
;49    4.000E+04 wUEAGMBEJHYPBCOxPPxPP
;49    5.000E+04 TfExPLaTJHYPBCOxPPxPP
;49    6.000E+04 CTEwELqGJXPPBCOxPPxPP
;49    8.000E+04 QdEeTLABJXPPBCOxPPxPP
;49    1.000E+05 aDETYLh@IXPPBDOxQPxQP
;==== ELEMENT  50
;50    1.000E-03 H@ReGOXEU@@R@@RXFUXEU
;50    1.500E-03 WWRiXOcIU@@R@@Rs@UcIU
;50    2.000E-03 W@RAQPaVU@@R@@RaVUaVU
;50    3.000E-03 f@Rb@PFHT@@R@@RVDTFHT
;50    3.929E-03 EVRBfPCFT@@R@@RSATCFT
;50 L3 3.929E-03 EVRBfPi@T@@R@@RiFTi@T
;50    4.000E-03 EQRRaPyDT@@R@@RyITyDT
;50    4.156E-03 u@RCAPHRT@@R@@RHWTHRT
;50 L2 4.156E-03 u@RCAPQDU@@R@@RQDUQDU
;50    4.308E-03 UIRSAPAEU@@R@@RAEUAEU
;50    4.465E-03 EHRcAPiVT@@R@@RyQTiVT
;50 L3 4.465E-03 EHRcAPQAU@@R@@RQBUQAU
;50    5.000E-03 tRRSTPHRT@@R@@RHWTHRT
;50    6.000E-03 TDRTBPeET@@R@@ReITeET
;50    8.000E-03 cFRUFPBWT@@R@@RRPTBWT
;50    1.000E-02 bURFGPqFT@@R@@RqHTqFT
;50    1.500E-02 qTRwSPDXS@@R@@RdVSDYS
;50    2.000E-02 aCRHaPBAS@@R@@RRESBBS
;50    2.920E-02 WIQA@QVdR@@R@@RwVRGDR
;50 K  2.920E-02 WIQA@QdHS@@R@@RtFSdIS
;50    3.000E-02 VaQAAQDDS@@R@@RTBSDES
;50    4.000E-02 TQQAHQAiS@@R@@RQdSQ`S
;50    5.000E-02 c@QQAQACS@@R@@RAGSADS
;50    6.000E-02 rHQQCQfAR@@R@@RVWRvCR
;50    8.000E-02 AVQQCQrWR@@R@@RCCRBhR
;50    1.000E-01 IfPQBQAWR@@R@@RaXRQXR
;50    1.500E-01 tYPAEQTVQ@@R@@RFIQeQQ
;50    2.000E-01 BcPIbPB@Q@@R@@RcFQRhQ
;50    3.000E-01 qBPxRPvEP@@R@@RaTQQQQ
;50    4.000E-01 WVOGiPRaP@@R@@RQFQAHQ
;50    5.000E-01 TaOgDPaTP@@R@@RyGPHhP
;50    6.000E-01 CTOvRPAEP@@R@@RXAPwWP
;50    8.000E-01 QeOUcPERO@@R@@RfVPFWP
;50    1.000E+00 aFOuDPsHO@@R@@RE`PeWP
;50    1.022E+00 a@OeHPcBO@@R@@RuRPePP
;50    1.250E+00 HFNtXPRGOqRN@@REIPEAP
;50    1.500E+00 eQNtEPQUOH@N@@RdTPTXP
;50    2.000E+00 SFNsQPIWNrSO@@RTAPDHP
;50    2.044E+00 CCNcWPYDNRbO@@RDHPDEP
;50    3.000E+00 AQNRbPECNViOABMcYPcWP
;50    4.000E+00 WbMBTPsDNAHPTGMSVPSUP
;50    5.000E+00 EGMRAPBWNAPPx@MSUPSTP
;50    6.000E+00 SRMAfPQeNaYPaGNSXPSXP
;50    7.000E+00 RYMaWPaQNQdPqRNcUPcTP
;50    8.000E+00 QhMQRPqFNRFPRDNsRPsRP
;50    9.000E+00 QWMAPPQHNrGPRUNCaPCaP
;50    1.000E+01 aGMq@PAENRVPRdNS`PCiP
;50    1.100E+01 AEMaAPyEMrSPsANShPShP
;50    1.200E+01 H`LQCPHVMBiPcUNDGPDGP
;50    1.300E+01 WPLAGPwRMCDPShNTFPTFP
;50    1.400E+01 FWLAAPGIMSHPdINdDPdDP
;50    1.500E+01 eTLiPOVVMs@PTXNtBPtAP
;50    1.600E+01 TeLYEOVAMCRPDfNtIPtIP
;50    1.800E+01 SaLxFOuFMcSPuHNTSPTSP
;50    2.000E+01 SGLwQOtWMCcPEeNdVPdVP
;50    2.200E+01 bRLWFOt@MD@PfHNtYPtXP
;50    2.400E+01 b@LfYOSaMTFPfXNT`PT`P
;50    2.600E+01 AhLfHOSYMtAPGDNEAPEAP
;50    2.800E+01 aRLUcOsBMDTPwHNUAPUAP
;50    3.000E+01 AQLeQOCHMTVPgYNe@Pe@P
;50    4.000E+01 WbKDVObGMEFPXiNePPePP
;50    5.000E+01 EGKsROA`MERPYhNU`PU`P
;50    6.000E+01 SRKcAOAYMuQPAHOVDPVDP
;50    8.000E+01 QhKRSOQAMVCPQIOVQPVQP
;50    1.000E+02 aGKR@OHcLFTPaHOvXPvXP
;50    1.500E+02 eTJQPOEdLVaPAROgAPgAP
;50    2.000E+02 SGJQGOtGLg@PQQOGWPGWP
;50    3.000E+02 AQJxANR`LWSPaROwXPwXP
;50    4.000E+02 WbIVQNRGLwRPaXOWePWeP
;50    5.000E+02 EGIuINqTLGePqSOHGPHGP
;50    6.000E+02 SRIdQNAULWdPqVOXFPXFP
;50    8.000E+02 QhIcPNAHLHFPAaOhHPhHP
;50    1.000E+03 aGIRfNhWKXDPAdOxEPxEP
;50    1.500E+03 eTHBGNuWKhEPAhOHVPHVP
;50    2.000E+03 SGHaPNtCKxAPQaOXRPXRP
;50    3.000E+03 AQHQANBiKxHPQcOXXPXXP
;50    4.000E+03 WbGhPMRFKHQPQeOhQPhQP
;50    5.000E+03 EGGGCMqSKHSPQfOhSPhSP
;50    6.000E+03 SRGUfMATKHUPQgOhUPhUP
;50    8.000E+03 QhGTYMAHKHWPQhOhWPhWP
;50    1.000E+04 aGGsUMhUJHXPQhOhXPhXP
;50    1.500E+04 eTFRYMuWJXPPQiOxPPxPP
;50    2.000E+04 SGFQiMtCJXQPQiOxQPxQP
;50    3.000E+04 AQFqGMBhJXRPB@OxRPxRP
;50    4.000E+04 WbEAEMRFJXSPB@OxSPxSP
;50    5.000E+04 EGEXYLqSJXSPB@OxSPxSP
;50    6.000E+04 SREgFLATJXSPB@OxSPxSP
;50    8.000E+04 QhEUWLAHJXSPB@OxSPxSP
;50    1.000E+05 aGETSLhUIXTPBAOxTPxTP
;==== ELEMENT  51
;51    1.000E-03 XARECOXXU@@R@@RXYUXXU
;51    1.500E-03 gWRyBOCXU@@R@@RCYUCXU
;51    2.000E-03 WIRqGPqVU@@R@@RqWUqVU
;51    3.000E-03 fGRRHPFWT@@R@@RVSTFWT
;51    4.000E-03 EWRR`PSAT@@R@@RSGTSAT
;51    4.132E-03 uGRRiPBfT@@R@@RRbTBfT
;51 L3 4.132E-03 uGRRiPhTT@@R@@RxPThTT
;51    4.254E-03 eHRCGPXGT@@R@@RhBTXGT
;51    4.380E-03 UIRSEPwRT@@R@@RwWTwRT
;51 L2 4.380E-03 UIRSEPADU@@R@@RAEUADU
;51    4.537E-03 EIRcEPiTT@@R@@RiYTiTT
;51    4.698E-03 ThRsEPHiT@@R@@RXdTHiT
;51 L3 4.698E-03 ThRsEPABU@@R@@RACUABU
;51    5.000E-03 tXRSSPH`T@@R@@RHeTH`T
;51    6.000E-03 d@RT@PUST@@R@@RUWTUST
;51    8.000E-03 sARUBPbPT@@R@@RbSTbPT
;51    1.000E-02 bYRF@PAST@@R@@RAVTAST
;51    1.500E-02 qWRgVPtTS@@R@@RTbStUS
;51    2.000E-02 aERxSPRCS@@R@@RbGSRDS
;51    3.000E-02 GHQA@QFbR@@R@@RgSRVbR
;51    3.049E-02 VaQA@QVQR@@R@@RwARfQR
;51 K  3.049E-02 VaQA@QSiS@@R@@RDGSD@S
;51    4.000E-02 dRQAGQQgS@@R@@RBCSQhS
;51    5.000E-02 cGQQ@QAHS@@R@@RQBSAIS
;51    6.000E-02 BTQQBQVRR@@R@@RFhRfSR
;51    8.000E-02 QPQQBQRaR@@R@@RSHRCCR
;51    1.000E-01 AAQQAQQUR@@R@@RqVRaVR
;51    1.500E-01 TbPADQDcQ@@R@@RvFQEgQ
;51    2.000E-01 RaPyVPRAQ@@R@@RsHQCIQ
;51    3.000E-01 qEPhWPvUP@@R@@RaXQQTQ
;51    4.000E-01 wYOGdPS@P@@R@@RQGQAIQ
;51    5.000E-01 EEOg@PqUP@@R@@RIUPXeP
;51    6.000E-01 STOfXPQBP@@R@@RXEPG`P
;51    8.000E-01 BAOEiPuXO@@R@@RfWPFWP
;51    1.000E+00 aIOuAPcQO@@R@@RE`PeWP
;51    1.022E+00 aDOeEPCSO@@R@@RuRPePP
;51    1.250E+00 x@NtUPrAOqWN@@REHPE@P
;51    1.500E+00 uXNtBPaVOhAN@@RdSPTWP
;51    2.000E+00 cFNcYPAAOrYO@@RT@PDGP
;51    2.044E+00 SBNcUPyTNRiO@@RDGPDDP
;51    3.000E+00 AUNRaPuFNWAOABMcYPcWP
;51    4.000E+00 XFMBSPSUNAIPTEMSWPSVP
;51    5.000E+00 eBMBIPbSNARPhFMSVPSUP
;51    6.000E+00 cSMAePBHNqQPaGNcPPSYP
;51    7.000E+00 bWMaVPqQNQfPqQNcVPcVP
;51    8.000E+00 BDMQRPAUNRIPRCNsTPsTP
;51    9.000E+00 aQMqIPaFNBPPRTNCcPCcP
;51    1.000E+01 qAMaIPQANRYPRbNSbPSbP
;51    1.100E+01 AHMa@PYeMrVPcINDAPDAP
;51    1.200E+01 IGLQCPXiMRcPcSNT@PT@P
;51    1.300E+01 wSLAFPhAMCHPSfNTIPTIP
;51    1.400E+01 fVLAAPWTMcBPdGNdGPdGP
;51    1.500E+01 EaLYUOVhMsDPTVNtEPtEP
;51    1.600E+01 U@LY@OFYMCVPDcNDSPDSP
;51    1.800E+01 DCLxAOeYMcXPuENTWPTWP
;51    2.000E+01 cGLgWOEGMCgPEaNtPPtPP
;51    2.200E+01 rPLWBOTWMDEPfDNDcPDcP
;51    2.400E+01 bGLfUOTFMdAPfSNTePTeP
;51    2.600E+01 QcLfEOCbMtFPViNEFPEFP
;51    2.800E+01 aWLU`OSRMDYPwCNUFPUFP
;51    3.000E+01 AULUXOcGMdQPgTNeEPeEP
;51    4.000E+01 XFKDSOBRMUAPXcNeUPeUP
;51    5.000E+01 eBKsPOQaMEYPYaNUfPUfP
;51    6.000E+01 cSKSIOQXMuXPAGOf@Pf@P
;51    8.000E+01 BDKRROQHMfAPQIOVXPVXP
;51    1.000E+02 qAKBIOyHLVQPaGOFePFeP
;51    1.500E+02 EaJAYOfALViPAQOgHPgHP
;51    2.000E+02 cGJQGOdTLgHPQPOWUPWUP
;51    3.000E+02 AUJhFNCHLgRPaQOGfPGfP
;51    4.000E+02 XFIFWNrALGaPaWOHDPHDP
;51    5.000E+02 eBIuFNAeLWdPqROXFPXFP
;51    6.000E+02 cSITYNQTLHCPqUOhEPhEP
;51    8.000E+02 BDISXNQELXEPqYOxGPxGP
;51    1.000E+03 qAIReNiAKhCPAbOHTPHTP
;51    1.500E+03 EaHBFNVCKxDPAgOXUPXUP
;51    2.000E+03 cGHQYNdPKHPPAiOhQPhQP
;51    3.000E+03 AUHQANCFKHWPQbOhXPhXP
;51    4.000E+03 XFGXUMr@KXQPQcOxQPxQP
;51    5.000E+03 eBGViMAdKXSPQdOxSPxSP
;51    6.000E+03 cSGUcMQSKXUPQeOxUPxUP
;51    8.000E+03 BDGTWMQEKXWPQfOxWPxWP
;51    1.000E+04 qAGsSMYIJXXPQgOxXPxXP
;51    1.500E+04 EaFRXMVCJhPPQgOH`PH`P
;51    2.000E+04 cGFQhMTYJhQPQhOHaPHaP
;51    3.000E+04 AUFqGMCFJhRPQhOHbPHbP
;51    4.000E+04 XFEAEMr@JhRPQiOHbPHbP
;51    5.000E+04 eBEXTLAdJhSPQiOHcPHcP
;51    6.000E+04 cSEgBLQSJhSPQiOHcPHcP
;51    8.000E+04 BDEUSLQEJhSPQiOHcPHcP
;51    1.000E+05 qAETPLYIIhTPQiOHdPHdP
;==== ELEMENT  52
;52    1.000E-03 HERtTOHRU@@R@@RHSUHRU
;52    1.003E-03 HERtWOxGU@@R@@RxHUxGU
;52    1.006E-03 HERtYOxBU@@R@@RxCUxBU
;52 M1 1.006E-03 HERtYOhWU@@R@@RhXUhWU
;52    1.500E-03 gQRXeOcPU@@R@@RcQUcPU
;52    2.000E-03 WBRqCPAcU@@R@@RAcUAcU
;52    3.000E-03 f@RRDPvST@@R@@RvYTvST
;52    4.000E-03 EPRBePcDT@@R@@Rs@TcDT
;52    4.341E-03 UFRCFPbST@@R@@RbXTbST
;52 L3 4.341E-03 UFRCFPGcT@@R@@RGhTGcT
;52    4.475E-03 EGRSEPwHT@@R@@RGSTwHT
;52    4.612E-03 ThRcCPVeT@@R@@RG@TVeT
;52 L2 4.612E-03 ThRcCPIPT@@R@@RIUTIPT
;52    4.773E-03 DhRsCPhXT@@R@@RxSThXT
;52    4.939E-03 tWRCSPHAT@@R@@RHFTHAT
;52 L1 4.939E-03 tWRCSPiET@@R@@RiITiET
;52    5.000E-03 tSRCVPXgT@@R@@RIATXgT
;52    6.000E-03 TGRDAPeXT@@R@@RuRTeXT
;52    8.000E-03 cIRThPbWT@@R@@RrPTbWT
;52    1.000E-02 bWREbPAWT@@R@@RQPTAWT
;52    1.500E-02 qVRGRPDiS@@R@@REHST`S
;52    2.000E-02 aERHVPbAS@@R@@RrDSbBS
;52    3.000E-02 GGQyPPGGR@@R@@RGhRWGR
;52    3.181E-02 FYQIdPUiR@@R@@RvTRFIR
;52 K  3.181E-02 FYQIdPcTS@@R@@RsRScUS
;52    4.000E-02 dQQACQBAS@@R@@RBFSBBS
;52    5.000E-02 cGQAGQQ@S@@R@@RQDSQAS
;52    6.000E-02 BTQAIQfYR@@R@@RGDRF`R
;52    8.000E-02 QPQAIQC@R@@R@@RcERSAR
;52    1.000E-01 AAQAHQQYR@@R@@RA`RqPR
;52    1.500E-01 TcPAAQTiQ@@R@@RFYQF@Q
;52    2.000E-01 RbPIYPRIQ@@R@@RCSQSDQ
;52    3.000E-01 qFPHRPG@P@@R@@RaXQQTQ
;52    4.000E-01 GcOgSPcBP@@R@@RQFQAIQ
;52    5.000E-01 EGOG@PAbP@@R@@RyCPHbP
;52    6.000E-01 SVOVPPQFP@@R@@RHBPgWP
;52    8.000E-01 BBOuSPFBO@@R@@RVTPvDP
;52    1.000E+00 q@OUFPsVO@@R@@ReWPUTP
;52    1.022E+00 aEOUAPSXO@@R@@RUYPEWP
;52    1.250E+00 xENdRPBQOqXN@@RTgPDhP
;52    1.500E+00 EaNdAPqSOhDN@@RTRPDVP
;52    2.000E+00 cHNSYPAEOrYO@@RDAPShP
;52    2.044E+00 SDNSUPAAORhO@@RShPSeP
;52    3.000E+00 AVNBcPUXNGGOIiLcQPSYP
;52    4.000E+00 hAMrFPsPNAIPDCMCYPCYP
;52    5.000E+00 eFMBDPrSNAQPHCMCYPCYP
;52    6.000E+00 cUMA`PRFNaYPaCNSSPSSP
;52    7.000E+00 bXMaRPqXNQePaVNcPPcPP
;52    8.000E+00 BEMAWPQQNRGPBGNcXPcXP
;52    9.000E+00 aRMqEPqANrHPBWNsWPsWP
;52    1.000E+01 qAMaFPQENRVPBdNCfPCfP
;52    1.100E+01 AIMQGPACNrTPc@NSePSeP
;52    1.200E+01 YCLQ@PyDMR`PSSNDDPDDP
;52    1.300E+01 wXLACPXRMCEPCeNTCPTCP
;52    1.400E+01 vQLyYOGcMSHPTENdAPdAP
;52    1.500E+01 EdLiIOgDMsAPDSNdIPdIP
;52    1.600E+01 UCLHeOvTMCSPtPNtGPtGP
;52    1.800E+01 DFLHHOUaMcTPe@NTQPTQP
;52    2.000E+01 cILGVOeGMCcPeUNdTPdTP
;52    2.200E+01 rRLVcOtUMDAPFGNtWPtWP
;52    2.400E+01 bHLFWOtBMTGPFUNDhPDhP
;52    2.600E+01 QdLFHOSfMtAPF`NTiPTiP
;52    2.800E+01 aXLuSOcVMDTPWCNEIPEIP
;52    3.000E+01 AVLESOCPMTWPGSNUIPUIP
;52    4.000E+01 hBKtAORQMEFPhXNUXPUXP
;52    5.000E+01 eFKcPOQiMESPiTNEiPEiP
;52    6.000E+01 cUKS@OaTMuRPADOVCPVCP
;52    8.000E+01 BEKBUOaBMVDPQEOVPPVPP
;52    1.000E+02 qAKBCOySLFTPaDOvWPvWP
;52    1.500E+02 EdJAUOFTLVaPqGOg@Pg@P
;52    2.000E+02 cIJQCODaLg@PAVOGVPGVP
;52    3.000E+02 AVJHDNc@LWSPQVOwWPwWP
;52    4.000E+02 hBIv@NBPLwSPaROWePWeP
;52    5.000E+02 eFIeANQaLGePaWOHGPHGP
;52    6.000E+02 cUIDVNQYLWdPqPOXFPXFP
;52    8.000E+02 BEICXNQILHFPqTOhGPhGP
;52    1.000E+03 qAIBgNYUKXDPqWOxEPxEP
;52    1.500E+03 EdHB@NvFKhEPAaOHUPHUP
;52    2.000E+03 cIHQUNtWKxAPAdOXQPXQP
;52    3.000E+03 AVHAHNSHKxHPAfOXWPXWP
;52    4.000E+03 hBGxBMrHKHQPAhOhQPhQP
;52    5.000E+03 eFGF`MQaKHTPAiOhSPhSP
;52    6.000E+03 cUGuWMQYKHUPQ`OhUPhUP
;52    8.000E+03 BEGDTMQIKHWPQaOhWPhWP
;52    1.000E+04 qAGcSMYSJHYPQaOhXPhXP
;52    1.500E+04 EdFRQMvFJXPPQbOxPPxPP
;52    2.000E+04 cIFQcMtWJXQPQbOxQPxQP
;52    3.000E+04 AVFqCMSHJXRPQcOxRPxRP
;52    4.000E+04 hBEABMrHJXSPQcOxRPxRP
;52    5.000E+04 eFExALQaJXSPQcOxSPxSP
;52    6.000E+04 cUEGBLQYJXSPQcOxSPxSP
;52    8.000E+04 BEEuHLQIJXTPQcOxSPxSP
;52    1.000E+05 qAEtHLYSIXTPQcOxSPxSP
;==== ELEMENT  53
;53    1.000E-03 HRRdYOIIU@@R@@RY@UIIU
;53    1.035E-03 xIRTgOHUU@@R@@RHVUHUU
;53    1.072E-03 xFReGOGfU@@R@@RGgUGfU
;53 M1 1.072E-03 xFReGOh@U@@R@@Rh@Uh@U
;53    1.500E-03 WfRXgOSaU@@R@@RSbUSaU
;53    2.000E-03 GURqDPQiU@@R@@RB@UQiU
;53    3.000E-03 FVRRIPwFT@@R@@RGRTwFT
;53    4.000E-03 eSRRcPSUT@@R@@RcQTSUT
;53    4.557E-03 eCRs@PRTT@@R@@RRYTRTT
;53 L3 4.557E-03 eCRs@PWPT@@R@@RWUTWPT
;53    4.702E-03 UCRsIPGCT@@R@@RGHTGCT
;53    4.852E-03 ECRCXPVYT@@R@@RfTTVYT
;53 L2 4.852E-03 ECRCXPHhT@@R@@RXcTHhT
;53    5.000E-03 TdRSWPxHT@@R@@RHSTxHT
;53    5.188E-03 DbRcXPgRT@@R@@RgVTgRT
;53 L1 5.188E-03 DbRcXPxYT@@R@@RHdTxYT
;53    6.000E-03 tFRTCPVCT@@R@@RVHTVCT
;53    8.000E-03 CURUAPBiT@@R@@RRbTBiT
;53    1.000E-02 B`RUfPaPT@@R@@RaSTaPT
;53    1.500E-02 AdRWXPuBS@@R@@RUQSuCS
;53    2.000E-02 qARhUPBPS@@R@@RRTSBQS
;53    3.000E-02 GVQYaPwRR@@R@@RXVRGbR
;53    3.317E-02 FSQABQEaR@@R@@RVURUaR
;53 K  3.317E-02 FSQABQSQS@@R@@RSXSSRS
;53    4.000E-02 DfQAFQRES@@R@@RbASRFS
;53    5.000E-02 CUQAIQQIS@@R@@RaCSa@S
;53    6.000E-02 RXQQAQgAR@@R@@RWXRwBR
;53    8.000E-02 QXQQBQcDR@@R@@RSQRsER
;53    1.000E-01 AGQQ@QqRR@@R@@RQdRAcR
;53    1.500E-01 eBPADQERQ@@R@@RVhQFVQ
;53    2.000E-01 CIPyQPrHQ@@R@@RcVQsEQ
;53    3.000E-01 ATPhSPgUP@@R@@RqWQaSQ
;53    4.000E-01 hIOGaPSSP@@R@@RaBQQCQ
;53    5.000E-01 uHOWHPQiP@@R@@RyPPYFP
;53    6.000E-01 sWOfVPaGP@@R@@RxAPWdP
;53    8.000E-01 RDOEgPfPO@@R@@RvUPVSP
;53    1.000E+00 qHOeIPTBO@@R@@REdPuPP
;53    1.022E+00 qBOeCPSbO@@R@@RuVPeSP
;53    1.250E+00 HfNtTPbTOAhN@@RUAPEBP
;53    1.500E+00 VFNtAPAiOxQN@@RdUPTYP
;53    2.000E+00 CXNcXPQEORdO@@RTBPDIP
;53    2.044E+00 sCNcTPQAOSDO@@RDIPDFP
;53    3.000E+00 QUNR`PVANGQOAAMsRPsPP
;53    4.000E+00 xQMBRPDENQDPTCMcQPcPP
;53    5.000E+00 UXMBIPRiNAXPhCMcQPcPP
;53    6.000E+00 CgMAePrFNqWPaFNcVPcUP
;53    7.000E+00 BeMaVPQdNBCPqPNsSPsSP
;53    8.000E+00 RHMQQPaUNbFPRBNCaPCaP
;53    9.000E+00 qRMqIPASNBXPRSNSaPSaP
;53    1.000E+01 qIMaIPaFNbWPRaND@PD@P
;53    1.100E+01 QEMa@PQCNBePcHNT@PT@P
;53    1.200E+01 iYLQCPABNCBPcRNTIPTIP
;53    1.300E+01 hELAFPyAMSGPSdNdHPdHP
;53    1.400E+01 WBLA@PXVMsBPdENtGPtGP
;53    1.500E+01 f@LYROWbMCUPTTNDUPDUP
;53    1.600E+01 EULIGOwFMSWPDbNTSPTSP
;53    1.800E+01 tALhIOFVMsYPuBNdXPdXP
;53    2.000E+01 CYLgTOuUMD@PuYNDbPDbP
;53    2.200E+01 BhLW@OUHMTHPfBNTePTeP
;53    2.400E+01 BRLfSOtRMtDPfQNEHPEHP
;53    2.600E+01 BFLfCOtCMDYPVgNUIPUIP
;53    2.800E+01 qXLEgOD@MdSPw@Nu@Pu@P
;53    3.000E+01 QULUVOsQMtVPgQNEPPEPP
;53    4.000E+01 xRKDROrTMeGPHiNEaPEaP
;53    5.000E+01 UXKcYORGMeVPIgNVCPVCP
;53    6.000E+01 CgKSHOA`MUfPAFOvHPvHP
;53    8.000E+01 RHKRQOqCMvIPQHOvVPvVP
;53    1.000E+02 qIKBHOAFMvQPaFOGDPGDP
;53    1.500E+02 f@JAXOGCLg@PAPOGYPGYP
;53    2.000E+02 CYJQFOeFLWPPAYOwWPwWP
;53    3.000E+02 QUJhDNCYLGePaPOHIPHIP
;53    4.000E+02 xRIFUNbRLHEPaVOhHPhHP
;53    5.000E+02 UXIuDNBILXHPqQOHPPHPP
;53    6.000E+02 CgITWNqTLhGPqTOHYPHYP
;53    8.000E+02 RHISWNq@LxIPqXOhQPhQP
;53    1.000E+03 qIIRdNADLHXPAaOhYPhYP
;53    1.500E+03 f@HBENVeKXYPAfOH`PH`P
;53    2.000E+03 CYHQYNeAKhVPAhOHfPHfP
;53    3.000E+03 QUHQ@NCWKxSPQaOXcPXcP
;53    4.000E+03 xRGXRMbPKxVPQbOXgPXgP
;53    5.000E+03 UXGVgMBHKxYPQcOXiPXiP
;53    6.000E+03 CgGUaMqSKH`PQdOI@PI@P
;53    8.000E+03 RHGTUMq@KHcPQeOICPICP
;53    1.000E+04 qIGsRMADKHdPQfOIDPIDP
;53    1.500E+04 f@FRWMVdJHfPQfOIFPIFP
;53    2.000E+04 CYFQhMe@JHgPQgOIGPIGP
;53    3.000E+04 QUFqFMCWJHhPQgOIHPIHP
;53    4.000E+04 xREAEMbPJHhPQhOIHPIHP
;53    5.000E+04 UXEXRLBHJHiPQhOIIPIIP
;53    6.000E+04 CgEg@LqSJHiPQhOIIPIIP
;53    8.000E+04 RHEURLq@JHiPQhOIIPIIP
;53    1.000E+05 qIEDYLADJHiPQhOIIPIIP
;==== ELEMENT  54
;54    1.000E-03 HVRDROIPU@@R@@RIQUIPU
;54    1.072E-03 xIRTgOXCU@@R@@RXDUXCU
;54    1.149E-03 xCRUXOGCU@@R@@RGDUGCU
;54 M1 1.149E-03 xCRUXOwCU@@R@@RwDUwCU
;54    1.500E-03 H@RXRODHU@@R@@RDHUDHU
;54    2.000E-03 GXRaHPBHU@@R@@RBIUBHU
;54    3.000E-03 FXRRBPwRT@@R@@RwXTwRT
;54    4.000E-03 eTRBgPsST@@R@@RsYTsST
;54    4.782E-03 EIRsHPrFT@@R@@RBQTrFT
;54 L3 4.782E-03 EIRsHPFiT@@R@@RVdTFiT
;54    5.000E-03 TdRSRPvDT@@R@@RvITvDT
;54    5.104E-03 DhRSXPF@T@@R@@RFDTF@T
;54 L2 5.104E-03 DhRSXPXCT@@R@@RXHTXCT
;54    5.275E-03 tXRcXPWQT@@R@@RWVTWRT
;54    5.453E-03 dWRsXPVdT@@R@@RViTVdT
;54 L1 5.453E-03 dWRsXPHBT@@R@@RHFTHBT
;54    6.000E-03 tGRDGPvCT@@R@@RvGTvCT
;54    8.000E-03 CVRECPC@T@@R@@RCCTC@T
;54    1.000E-02 BaREePaVT@@R@@RaYTaVT
;54    1.500E-02 AeRGTPUUS@@R@@RuTSUVS
;54    2.000E-02 qBRHYPRQS@@R@@RbUSRRS
;54    3.000E-02 WUQySPHHR@@R@@RXcRXGR
;54    3.456E-02 VBQAAQERR@@R@@RVCRURR
;54 K  3.456E-02 VBQAAQcDS@@R@@RsBScES
;54    4.000E-02 TaQADQbAS@@R@@RbGSbBS
;54    5.000E-02 CYQAGQaCS@@R@@RaGSaDS
;54    6.000E-02 bQQAIQGUR@@R@@RGbRWVR
;54    8.000E-02 aQQQ@QsFR@@R@@RcSRCWR
;54    1.000E-01 AIQAHQqYR@@R@@RBARQ`R
;54    1.500E-01 u@PABQeUQ@@R@@Rg@QfWQ
;54    2.000E-01 SDPYUPBYQ@@R@@RsVQCUQ
;54    3.000E-01 AVPHYPHAP@@R@@RA`QaUQ
;54    4.000E-01 HTOgYPsPP@@R@@RaBQQDQ
;54    5.000E-01 EWOGFPBIP@@R@@RyPPYEP
;54    6.000E-01 CdOVVPqDP@@R@@RhHPW`P
;54    8.000E-01 RHOuXPVdO@@R@@RvPPFXP
;54    1.000E+00 APOeAPtDO@@R@@RuXPeTP
;54    1.022E+00 qDOUFPTCO@@R@@RuPPUWP
;54    1.250E+00 IBNdVPrXOQaN@@REEPTfP
;54    1.500E+00 fHNdDPQiOHeN@@RTYPTSP
;54    2.000E+00 STNcRPaAORgO@@RDHPDDP
;54    2.044E+00 sINSXPQGOSGO@@RDEPDAP
;54    3.000E+00 QXNBePFRNGVOYhLcXPcWP
;54    4.000E+00 HgMrHPdENQDPDGMSXPSWP
;54    5.000E+00 eXMBFPSDNAXPX@MSXPSXP
;54    6.000E+00 SdMAbPBXNqWPaDNcSPcSP
;54    7.000E+00 R`MaSPBDNBCPaWNsQPsQP
;54    8.000E+00 bBMAYPqSNbGPBINC`PsYP
;54    9.000E+00 qUMqGPQPNBXPBYNCiPCiP
;54    1.000E+01 ARMaGPqBNbXPBgNSiPSiP
;54    1.100E+01 QGMQHPQHNBfPcCNDHPDHP
;54    1.200E+01 IfLQAPAGNCBPSVNTHPTHP
;54    1.300E+01 HPLADPyWMSHPChNdGPdGP
;54    1.400E+01 gELIhOXgMsBPTHNtFPtFP
;54    1.500E+01 vALyHOx@MCUPDWNDTPDTP
;54    1.600E+01 UULXcOwRMSXPtTNTRPTRP
;54    1.800E+01 tHLXFOvWMC`PeDNdWPdWP
;54    2.000E+01 SULWSOFCMD@PuPNDbPDbP
;54    2.200E+01 RcLViOETMTHPVBNTePTeP
;54    2.400E+01 BWLVSOTdMtEPVPNEGPEGP
;54    2.600E+01 R@LVCOTTMTPPFfNUHPUHP
;54    2.800E+01 AaLuYOTIMdSPWHNeIPeIP
;54    3.000E+01 QXLEXOCiMtVPGYNuIPuIP
;54    4.000E+01 HhKtEOBgMeGPxUNE`PE`P
;54    5.000E+01 eXKcSObGMeVPyQNVBPVBP
;54    6.000E+01 SeKSCOAhMUfPAEOvHPvHP
;54    8.000E+01 bBKBWOAPMFPPQFOvVPvVP
;54    1.000E+02 ARKBEOQAMvQPaDOGDPGDP
;54    1.500E+02 vAJAVOwGLgAPqHOGYPGYP
;54    2.000E+02 SUJQDOUQLWPPAWOwWPwWP
;54    3.000E+02 QXJXANcVLGePQWOHIPHIP
;54    4.000E+02 HhIvENrTLHEPaTOhHPhHP
;54    5.000E+02 eXIeFNRILXHPaXOHPPHPP
;54    6.000E+02 SeITPNAbLhGPqQOHYPHYP
;54    8.000E+02 bBISRNqGLHPPqUOhQPhQP
;54    1.000E+03 ARIBiNAILHXPqXOhYPhYP
;54    1.500E+03 vAHBBNgGKhPPAcOH`PH`P
;54    2.000E+03 SUHQVNEUKhVPAeOHgPHgP
;54    3.000E+03 QXHAINcTKxSPAhOXcPXcP
;54    4.000E+03 HhGxIMrSKxWPAiOXgPXgP
;54    5.000E+03 eXGFfMRHKxYPQ`OXiPXiP
;54    6.000E+03 SeGEbMAbKHaPQaOIAPIAP
;54    8.000E+03 bBGDXMqFKHcPQbOICPICP
;54    1.000E+04 ARGcVMAIKHdPQbOIDPIDP
;54    1.500E+04 vAFRSMgGJHfPQcOIFPIFP
;54    2.000E+04 SUFQeMEUJHgPQcOIGPIGP
;54    3.000E+04 QXFqDMcSJHhPQdOIHPIHP
;54    4.000E+04 HhEACMrSJHiPQdOIHPIHP
;54    5.000E+04 eXExHLRHJHiPQdOIIPIIP
;54    6.000E+04 SeEGILAbJHiPQdOIIPIIP
;54    8.000E+04 bBEETLqFJX`PQdOIIPIIP
;54    1.000E+05 AREDRLAIJX`PQeOIIPIIP
;==== ELEMENT  55
;55    1.000E-03 XUREhOyFU@@R@@RyGUyFU
;55    1.032E-03 XRRVCOxVU@@R@@RxWUxVU
;55    1.065E-03 HYRvIOhAU@@R@@RhAUhAU
;55 M2 1.065E-03 HYRvIOhXU@@R@@RhYUhXU
;55    1.139E-03 HRRVgOWUU@@R@@RWVUWUU
;55    1.217E-03 xERWYOVXU@@R@@RVYUVXU
;55 M1 1.217E-03 xERWYOFhU@@R@@RFiUFhU
;55    1.500E-03 HGRIfOtCU@@R@@RtDUtCU
;55    2.000E-03 WXRAPPbBU@@R@@RbCUbBU
;55    3.000E-03 VYRb@PhET@@R@@RxBThET
;55    4.000E-03 uURRdPD@T@@R@@RDETD@T
;55    5.000E-03 EDRSXPbET@@R@@Rr@TbET
;55    5.012E-03 ECRSYPbDT@@R@@RbITbDT
;55 L3 5.012E-03 ECRSYPfRT@@R@@RfXTfRT
;55    5.183E-03 TbRcYPFIT@@R@@RVDTFIT
;55    5.359E-03 DbRsYPePT@@R@@ReTTePT
;55 L2 5.359E-03 DbRsYPgTT@@R@@RgYTgTT
;55    5.534E-03 tRRCiPGET@@R@@RW@TGET
;55    5.714E-03 dRRShPVQT@@R@@RVVTVQT
;55 L1 5.714E-03 dRRShPWPT@@R@@RWUTWPT
;55    6.000E-03 DVRTDPfWT@@R@@RvQTfWT
;55    8.000E-03 SUREHPSHT@@R@@RcATSHT
;55    1.000E-02 BiREiPqVT@@R@@RqYTqVT
;55    1.500E-02 Q`RGVPUaS@@R@@RVASUbS
;55    2.000E-02 qFRXRPbXS@@R@@RBbSbYS
;55    3.000E-02 wYQyVPhSR@@R@@RYQRxSR
;55    3.598E-02 UdQABQUGR@@R@@REfReGR
;55 K  3.598E-02 UdQABQCGS@@R@@RSDSCHS
;55    4.000E-02 EGQADQrBS@@R@@RrHSrCS
;55    5.000E-02 cPQAHQaIS@@R@@RqDSq@S
;55    6.000E-02 rPQAIQGgR@@R@@RhERWhR
;55    8.000E-02 aVQQ@QSVR@@R@@RCdRcWR
;55    1.000E-01 QCQAIQQ`R@@R@@RRBRBAR
;55    1.500E-01 EYPABQFBQ@@R@@RWYQGDQ
;55    2.000E-01 cEPiPPbVQ@@R@@RSdQcRQ
;55    3.000E-01 QRPXTPXVP@@R@@RAfQqQQ
;55    4.000E-01 xUOwSPSfP@@R@@RaFQQGQ
;55    5.000E-01 eYOW@PbDP@@R@@RYaPyDP
;55    6.000E-01 ShOfPPATP@@R@@RHSPHCP
;55    8.000E-01 bGOEbPGUO@@R@@RvYPVVP
;55    1.000E+00 AVOeDPdUO@@R@@REePuQP
;55    1.022E+00 APOUIPDUO@@R@@RuWPeSP
;55    1.250E+00 yGNdYPC@OQiN@@RUAPEAP
;55    1.500E+00 VRNdGPREOYIN@@RdTPTXP
;55    2.000E+00 cXNcUPqAOCGO@@RTBPDHP
;55    2.044E+00 SRNcPPaFOcHO@@RDIPDFP
;55    3.000E+00 aTNBgPVbNgWOA@MsSPsQP
;55    4.000E+00 iBMBPPTXNQGPT@McSPcRP
;55    5.000E+00 U`MBGPsHNQRPXEMcTPcSP
;55    6.000E+00 T@MAcPbWNAbPaENcYPcYP
;55    7.000E+00 CAMaTPb@NBHPaXNsWPsWP
;55    8.000E+00 rAMQPPAfNrBPR@NCfPCfP
;55    9.000E+00 AbMqHPaRNRTPRPNSfPSfP
;55    1.000E+01 AXMaGPASNrTPBhNDFPDFP
;55    1.100E+01 aBMQIPaGNRbPcDNTFPTFP
;55    1.200E+01 ACMQBPQENCIPSXNdEPdEP
;55    1.300E+01 xTLAEPAENcEPS`NtEPtEP
;55    1.400E+01 WSLYdOiUMCPPdANDTPDTP
;55    1.500E+01 VVLISOXcMSSPDYNTSPTSP
;55    1.600E+01 uWLXiOxAMcVPtWNdQPdQP
;55    1.800E+01 TVLhAOgHMChPeGNtWPtWP
;55    2.000E+01 cYLWWOFXMDIPuSNTaPTaP
;55    2.200E+01 CELGCOEeMdGPVENEDPEDP
;55    2.400E+01 RVLVWOuBMDTPVTNUGPUGP
;55    2.600E+01 RHLVGODhMTYPV`NeIPeIP
;55    2.800E+01 AhLEbOTPMtTPgBNuIPuIP
;55    3.000E+01 aTLUQOTHMDgPWSNUPPUPP
;55    4.000E+01 iCKtHOCHMuIPH`NUbPUbP
;55    5.000E+01 U`KcVOBTMuXPyVNfEPfEP
;55    6.000E+01 T@KSEOBBMFIPAEOVQPVQP
;55    8.000E+01 rAKBXOQPMVTPQGOVaPVaP
;55    1.000E+02 AXKBFOa@MFfPaEOWIPWIP
;55    1.500E+02 VVJAWOWbLwFPqIOgUPgUP
;55    2.000E+02 cYJQEOUbLgWPAWOWcPWcP
;55    3.000E+02 aTJXFNScLHBPQXOhFPhFP
;55    4.000E+02 iCIvINRdLhBPaTOHUPHUP
;55    5.000E+02 U`IeINrELxFPaYOXXPXXP
;55    6.000E+02 T@ITSNQfLHVPqROhWPhWP
;55    8.000E+02 rAISTNAWLXXPqVOxYPxYP
;55    1.000E+03 AXIRaNQGLhWPqYOHhPHhP
;55    1.500E+03 VVHBCNGbKxYPAdOXiPXiP
;55    2.000E+03 cYHQWNEfKHePAfOIEPIEP
;55    3.000E+03 aTHAINSaKXbPAiOYBPYBP
;55    4.000E+03 iCGHUMRcKXfPQaOYFPYFP
;55    5.000E+03 U`GVaMrDKXiPQbOYHPYHP
;55    6.000E+03 T@GEeMQeKI@PQbOi@Pi@P
;55    8.000E+03 rAGTQMAVKIBPQcOiBPiBP
;55    1.000E+04 AXGcXMQGKIDPQdOiCPiCP
;55    1.500E+04 VVFRUMGaJIFPQeOiEPiEP
;55    2.000E+04 cYFQfMEfJIGPQeOiFPiFP
;55    3.000E+04 aTFqEMS`JIHPQfOiGPiGP
;55    4.000E+04 iCEADMRcJIHPQfOiHPiHP
;55    5.000E+04 U`EHTLrDJIHPQfOiHPiHP
;55    6.000E+04 T@EWCLQeJIIPQfOiIPiIP
;55    8.000E+04 rAEEWLAVJIIPQfOiIPiIP
;55    1.000E+05 AXEDULQGJIIPQfOiIPiIP
;==== ELEMENT  56
;56    1.000E-03 XRRFfOXSU@@R@@RXTUXSU
;56    1.031E-03 HYRWBOWhU@@R@@RWhUWhU
;56    1.062E-03 HVRwIOGVU@@R@@RGWUGVU
;56 M3 1.062E-03 HVRwIOXTU@@R@@RXUUXTU
;56    1.099E-03 HRRwPOWeU@@R@@RWeUWeU
;56    1.137E-03 xHRHBOGPU@@R@@RGQUGPU
;56 M2 1.137E-03 xHRHBOGcU@@R@@RGdUGcU
;56    1.212E-03 xARhROFdU@@R@@RFeUFdU
;56    1.293E-03 hCRiFOUhU@@R@@RUiUUhU
;56 M1 1.293E-03 hCRiFOfEU@@R@@RfFUfEU
;56    1.500E-03 HBRAIPDYU@@R@@RTPUDYU
;56    2.000E-03 WQRAYPrAU@@R@@RrBUrAU
;56    3.000E-03 VVRbEPhST@@R@@RxPThST
;56    4.000E-03 uSRRePTIT@@R@@RdETTIT
;56    5.000E-03 ECRSXPrFT@@R@@RBQTrFT
;56    5.247E-03 DhRsRPBIT@@R@@RRDTBIT
;56 L3 5.247E-03 DhRsRPFET@@R@@RV@TFET
;56    5.432E-03 tWRCbPUWT@@R@@ReQTUWT
;56    5.624E-03 dVRScPUBT@@R@@RUGTUBT
;56 L2 5.624E-03 dVRScPVgT@@R@@RGBTVgT
;56    5.803E-03 TURDBPFUT@@R@@RVPTFUT
;56    5.989E-03 DVRTBPUgT@@R@@RFATUgT
;56 L1 5.989E-03 DVRTBPFiT@@R@@RVcTFiT
;56    6.000E-03 DVRTBPFeT@@R@@RV`TFeT
;56    8.000E-03 SURECPs@T@@R@@RsCTs@T
;56    1.000E-02 R`REaPAcT@@R@@RAfTAcT
;56    1.500E-02 QaRwDPVES@@R@@RvESVFS
;56    2.000E-02 qGRxHPrYS@@R@@RRdSB`S
;56    3.000E-02 GgQYYPIBR@@R@@RY`RYBR
;56    3.744E-02 eVQAAQDcR@@R@@RUPRTcR
;56 K  3.744E-02 eVQAAQBeS@@R@@RRbSBfS
;56    4.000E-02 UBQABQBPS@@R@@RBVSBQS
;56    5.000E-02 cTQAFQqCS@@R@@RqHSqDS
;56    6.000E-02 rSQAHQXCR@@R@@RXQRhDR
;56    8.000E-02 aYQAHQcYR@@R@@RSfRsYR
;56    1.000E-01 QDQAGQQgR@@R@@Rb@RBHR
;56    1.500E-01 UVPAAQfFQ@@R@@RGcQgGQ
;56    2.000E-01 s@PIUPrWQ@@R@@RDEQsRQ
;56    3.000E-01 QTPHQPXeP@@R@@RAiQqTQ
;56    4.000E-01 X`OgRPTEP@@R@@RaGQQHQ
;56    5.000E-01 uXOG@PrEP@@R@@RYbPyEP
;56    6.000E-01 DEOVPPQQP@@R@@RHQPHAP
;56    8.000E-01 r@OuSPGbO@@R@@RvTPVQP
;56    1.000E+00 AXOUGPDiO@@R@@RE`PeUP
;56    1.022E+00 AROUAPdWO@@R@@RuRPUXP
;56    1.250E+00 YTNdSPSEOBBN@@REFPTfP
;56    1.500E+00 fTNdAPbFOyCN@@RTYPTSP
;56    2.000E+00 sTNSYPqGOS@O@@RDHPDDP
;56    2.044E+00 SXNSUPqBOsAO@@RDEPDAP
;56    3.000E+00 aWNBcPgFNwROIiLcYPcXP
;56    4.000E+00 yHMrFPD`NQHPDCMcPPSYP
;56    5.000E+00 FAMBDPSUNQRPHCMcQPcQP
;56    6.000E+00 TGMA`PB`NAbPaCNcWPcVP
;56    7.000E+00 CGMaRPr@NBIPaVNsUPsUP
;56    8.000E+00 rEMAWPQeNrCPBGNCdPCdP
;56    9.000E+00 AeMqFPaYNRTPBWNSdPSdP
;56    1.000E+01 QPMaFPAYNrTPBdNDDPDDP
;56    1.100E+01 aDMQGPqCNRbPc@NTDPTDP
;56    1.200E+01 ADMQ@PaANCIPSSNdDPdDP
;56    1.300E+01 HiLACPQ@NcEPCdNtDPtDP
;56    1.400E+01 gWLyYOAANCPPTDNDSPDSP
;56    1.500E+01 fXLy@OyDMSSPDSNTRPTRP
;56    1.600E+01 EgLHeOhYMcVPtPNdPPdPP
;56    1.800E+01 dTLHIOgRMCiPUINtVPtVP
;56    2.000E+01 sVLGVOvYMDIPeTNT`PT`P
;56    2.200E+01 S@LVcOVAMdHPFFNEDPEDP
;56    2.400E+01 bQLFXOUVMDUPFTNUFPUFP
;56    2.600E+01 bBLFHOU@MdPPvYNeHPeHP
;56    2.800E+01 QbLuTOtQMtTPWANuIPuIP
;56    3.000E+01 aWLESOtHMDgPGRNEYPEYP
;56    4.000E+01 yIKtBOcCMEPPhWNUbPUbP
;56    5.000E+01 FAKcPORVMuYPiQNfEPfEP
;56    6.000E+01 TGKS@ORAMFIPADOVQPVQP
;56    8.000E+01 rEKBUOQWMVTPQEOV`PV`P
;56    1.000E+02 QPKBCOaEMFfPaCOWIPWIP
;56    1.500E+02 fXJAUOhHLwGPqGOgUPgUP
;56    2.000E+02 sVJQCOVILgWPAUOWcPWcP
;56    3.000E+02 aWJHDNTALHCPQVOhFPhFP
;56    4.000E+02 yIIv@NCHLhCPaROHUPHUP
;56    5.000E+02 FAIeANBVLxFPaVOXXPXXP
;56    6.000E+02 TGIDVNBELHVPaYOhWPhWP
;56    8.000E+02 rEICYNQTLXYPqTOH`PH`P
;56    1.000E+03 QPIBgNaCLhWPqWOHhPHhP
;56    1.500E+03 fXHB@NXHKxYPAaOXiPXiP
;56    2.000E+03 sVHQUNVCKHePAdOIEPIEP
;56    3.000E+03 aWHAHNDIKXbPAgOYBPYBP
;56    4.000E+03 yIGxBMCFKXfPAhOYFPYFP
;56    5.000E+03 FAGFaMBUKXiPAiOYHPYHP
;56    6.000E+03 TGGuWMBDKI@PQ`Oi@Pi@P
;56    8.000E+03 rEGDUMQSKIBPQaOiBPiBP
;56    1.000E+04 QPGcSMaCKIDPQaOiCPiCP
;56    1.500E+04 fXFRQMXGJIFPQbOiEPiEP
;56    2.000E+04 sVFQcMVCJIGPQcOiFPiFP
;56    3.000E+04 aWFqCMDHJIHPQcOiGPiGP
;56    4.000E+04 yIEABMCFJIIPQcOiHPiHP
;56    5.000E+04 FAExALBUJIIPQdOiIPiIP
;56    6.000E+04 TGEGCLBDJIIPQdOiIPiIP
;56    8.000E+04 rEEuILQSJY@PQdOiIPiIP
;56    1.000E+05 QPEtHLaBJY@PQdOiIPiIP
;==== ELEMENT  57
;57    1.000E-03 xTRFhOIHU@@R@@RIIUIHU
;57    1.060E-03 hWRGQOWgU@@R@@RWhUWgU
;57    1.123E-03 hQRWgOViU@@R@@RG@UViU
;57 M3 1.123E-03 hQRWgOHBU@@R@@RHBUHBU
;57    1.163E-03 XVRxBOGTU@@R@@RGUUGTU
;57    1.204E-03 XRRhWOV`U@@R@@RVaUV`U
;57 M2 1.204E-03 XRRhWOwAU@@R@@RwBUwAU
;57    1.280E-03 HTRy@OFRU@@R@@RFSUFRU
;57    1.361E-03 xERYeOeTU@@R@@ReUUeTU
;57 M1 1.361E-03 xERYeOU`U@@R@@RU`UU`U
;57    1.500E-03 h@RQAPtVU@@R@@RtWUtVU
;57    2.000E-03 gWRQQPBVU@@R@@RBVUBVU
;57    3.000E-03 fYRbHPi@T@@R@@RiGTi@T
;57    4.000E-03 EdRRhPDWT@@R@@RTSTDWT
;57    5.000E-03 UCRcQPRST@@R@@RRXTRST
;57    5.483E-03 DdRCiPQiT@@R@@RBDTQiT
;57 L3 5.483E-03 DdRCiPuQT@@R@@RuVTuQT
;57    5.683E-03 tRRD@PeDT@@R@@ReITeDT
;57    5.891E-03 dQRTAPD`T@@R@@RDeTD`T
;57 L2 5.891E-03 dQRTAPVPT@@R@@RVUTVPT
;57    6.000E-03 TURTGPfGT@@R@@RvBTfGT
;57    6.266E-03 DQRt@PeQT@@R@@ReUTeQT
;57 L1 6.266E-03 DQRt@PFWT@@R@@RVRTFWT
;57    8.000E-03 cTREHPCYT@@R@@RSSTCYT
;57    1.000E-02 RgREePQdT@@R@@RQgTQdT
;57    1.500E-02 QeRwGPVSS@@R@@RvSSVTS
;57    2.000E-02 APRHQPRgS@@R@@RSBSRhS
;57    3.000E-02 XBQiSPiRR@@R@@RAESyQR
;57    3.892E-02 UPQABQdRR@@R@@ReGRtRR
;57 K  3.892E-02 UPQABQrQS@@R@@RrWSrRS
;57    4.000E-02 eHQACQRRS@@R@@RRXSRSS
;57    5.000E-02 sVQAFQAPS@@R@@RAUSAQS
;57    6.000E-02 BbQAHQXWR@@R@@RXfRhXR
;57    8.000E-02 qTQAIQCiR@@R@@RTHRD@R
;57    1.000E-01 QHQAGQBIR@@R@@RrBRb@R
;57    1.500E-01 uVPAAQfUQ@@R@@RhDQgVQ
;57    2.000E-01 CRPYPPReQ@@R@@RdDQS`Q
;57    3.000E-01 aPPHVPYUP@@R@@RQfQA`Q
;57    4.000E-01 iCOgVPDSP@@R@@Rq@QaAQ
;57    5.000E-01 F@OGDPRQP@@R@@RABQYUP
;57    6.000E-01 d@OVTPaQP@@R@@RXWPXEP
;57    8.000E-01 rIOuWPxHO@@R@@RFdPfPP
;57    1.000E+00 QTOe@PeDO@@R@@REhPuRP
;57    1.022E+00 AXOUDPEAO@@R@@RuYPeTP
;57    1.250E+00 Y`NdUPsHOBIN@@RUAPEAP
;57    1.500E+00 FiNdCPBROiXN@@RdTPTWP
;57    2.000E+00 CiNcRPAWOc@O@@RTBPDHP
;57    2.044E+00 sRNSWPAROCRO@@RDIPDFP
;57    3.000E+00 qSNBePwWNWdOYeLsTPsRP
;57    4.000E+00 yTMrHPUCNaAPDFMcUPcTP
;57    5.000E+00 fDMBEPsYNQVPHHMcVPcVP
;57    6.000E+00 tCMAaPRiNAgPaDNsSPsRP
;57    7.000E+00 SHMaSPBVNRDPaWNCaPCaP
;57    8.000E+00 BTMAXPBHNrHPBHNSaPS`P
;57    9.000E+00 QcMqFPAaNbPPBXNDAPDAP
;57    1.000E+01 QVMaFPQYNB`PBfNTAPTAP
;57    1.100E+01 aIMQHPARNRiPcBNdBPdAP
;57    1.200E+01 AHMQAPaINSFPSUNtBPtBP
;57    1.300E+01 iCLADPQGNsBPCgNDRPDRP
;57    1.400E+01 WfLIeOAHNCWPTGNTQPTQP
;57    1.500E+01 VcLyFOYhMcQPDUNdPPdPP
;57    1.600E+01 V@LXaOiHMsTPtSNdYPdYP
;57    1.800E+01 DbLXDOXDMSgPeBNDePDeP
;57    2.000E+01 S`LWQOgDMTHPeXNE@PE@P
;57    2.200E+01 cBLVhOVRMtGPV@NUDPUDP
;57    2.400E+01 rQLVROUdMTTPFXNeGPeGP
;57    2.600E+01 rALVBOEUMtPPFcNuIPuIP
;57    2.800E+01 QiLuWOECMDdPWENUPPUPP
;57    3.000E+01 qSLEWOdWMTgPGVNePPePP
;57    4.000E+01 yUKtDOCTMUQPxQNFDPFDP
;57    5.000E+01 fDKcSOrSMUaPiVNvGPvGP
;57    6.000E+01 tCKSBObFMfBPADOfTPfTP
;57    8.000E+01 BTKBVOaXMfXPQEOGDPGDP
;57    1.000E+02 QVKBEOqCMGAPaDOwDPwDP
;57    1.500E+02 VcJAVOHdLWRPqGOGaPGaP
;57    2.000E+02 S`JQDOfPLGcPAVOHIPHIP
;57    3.000E+02 qSJHINtILXIPQVOHSPHSP
;57    4.000E+02 yUIvDNcHLHPPaSOhSPhSP
;57    5.000E+02 fDIeENbRLXTPaWOxVPxVP
;57    6.000E+02 tCIDYNRILhTPqPOHePHeP
;57    8.000E+02 BTISQNaTLxWPqUOXhPXhP
;57    1.000E+03 QVIBiNqALHePqXOIFPIFP
;57    1.500E+03 VcHBBNxRKXgPAbOYHPYHP
;57    2.000E+03 S`HQVNVTKIDPAeOiDPiDP
;57    3.000E+03 qSHAINtFKYAPAhOyAPyAP
;57    4.000E+03 yUGxHMcGKYEPAiOyEPyEP
;57    5.000E+03 fDGFeMbQKYHPQ`OyHPyHP
;57    6.000E+03 tCGEaMRHKi@PQaOyIPyIP
;57    8.000E+03 BTGDWMaSKiBPQbOIQPIQP
;57    1.000E+04 QVGcUMqAKiCPQbOISPISP
;57    1.500E+04 VcFRRMxQJiEPQcOIUPIUP
;57    2.000E+04 S`FQdMVSJiFPQdOIVPIVP
;57    3.000E+04 qSFqDMtFJiGPQdOIWPIWP
;57    4.000E+04 yUEACMcGJiHPQeOIWPIWP
;57    5.000E+04 fDExGLbQJiHPQeOIXPIXP
;57    6.000E+04 tCEGGLRHJiHPQeOIXPIXP
;57    8.000E+04 BTEERLaSJiIPQeOIXPIXP
;57    1.000E+05 QVEDQLqAJiIPQeOIXPIXP
;==== ELEMENT  58
;58    1.000E-03 XiRvSOyPU@@R@@RyQUyPU
;58    1.089E-03 HiRWROWhU@@R@@RWhUWhU
;58    1.185E-03 xYRxCOVUU@@R@@RVVUVUU
;58 M3 1.185E-03 xYRxCOWSU@@R@@RWTUWSU
;58    1.228E-03 xURhWOVhU@@R@@RVhUVhU
;58    1.273E-03 xPRIBOFVU@@R@@RFVUFVU
;58 M2 1.273E-03 xPRIBOFdU@@R@@RFeUFdU
;58    1.352E-03 hRRiWOFAU@@R@@RFBUFAU
;58    1.437E-03 XRRADPeIU@@R@@Ru@UeIU
;58 M1 1.437E-03 XRRADPURU@@R@@RUSUURU
;58    1.500E-03 HURAIPEBU@@R@@RECUEBU
;58    2.000E-03 WbRAYPbPU@@R@@RbQUbPU
;58    3.000E-03 VbRbEPyYT@@R@@RIfTyYT
;58    4.000E-03 FERRfPtUT@@R@@RDaTtUT
;58    5.000E-03 uARSYPbYT@@R@@RrTTbYT
;58    5.723E-03 DgRD@PAiT@@R@@RQdTAiT
;58 L3 5.723E-03 DgRD@PEQT@@R@@REVTEQT
;58    6.000E-03 tQRTEPDfT@@R@@RTaTDfT
;58    6.164E-03 dRRdCPTQT@@R@@RTVTTQT
;58 L2 6.164E-03 dRRdCPVDT@@R@@RVITVDT
;58    6.354E-03 TQRtCPuPT@@R@@RuTTuPT
;58    6.549E-03 DQRDRPeIT@@R@@RuCTeIT
;58 L1 6.549E-03 DQRDRPV@T@@R@@RVETV@T
;58    8.000E-03 sVREGPcYT@@R@@RsSTcYT
;58    1.000E-02 CGREePBET@@R@@RBHTBET
;58    1.500E-02 BBRwHPVcS@@R@@RWDSVdS
;58    2.000E-02 AURHSPSFS@@R@@RsASSGS
;58    3.000E-02 HPQiXPACS@@R@@RQBSACS
;58    4.000E-02 EWQACQTVR@@R@@ReARdWR
;58    4.044E-02 uHQADQDSR@@R@@REGRTSR
;58 K  4.044E-02 uHQADQRWS@@R@@RbSSRXS
;58    5.000E-02 CiQAGQAWS@@R@@RQRSAXS
;58    6.000E-02 RbQAIQIER@@R@@RIURYFR
;58    8.000E-02 AaQAIQTBR@@R@@RDQRdCR
;58    1.000E-01 aCQAHQbAR@@R@@RBURrBR
;58    1.500E-01 UhPABQGGQ@@R@@RhYQHIQ
;58    2.000E-01 SUPYXPSDQ@@R@@RDUQT@Q
;58    3.000E-01 aVPXSPABQ@@R@@RBDQAgQ
;58    4.000E-01 iPOwRPtTP@@R@@RqDQaEQ
;58    5.000E-01 fDOW@PbYP@@R@@RADQyYP
;58    6.000E-01 tGOVYPqSP@@R@@RxVPxBP
;58    8.000E-01 BYOEbPXhO@@R@@RVfPvQP
;58    1.000E+00 aPOeDPeQO@@R@@RUfPE`P
;58    1.022E+00 QTOUIPuGO@@R@@REhPuRP
;58    1.250E+00 ACOdYPcRORHN@@RUHPEHP
;58    1.500E+00 WHNdGPRYOAAO@@RtPPdSP
;58    2.000E+00 DENcUPQWOsBO@@RTHPTDP
;58    2.044E+00 ChNcPPQROSTO@@RTEPTAP
;58    3.000E+00 A`NBgPxBNXGOA@MsYPsWP
;58    4.000E+00 AANBPPUPNaDPT@MsPPcYP
;58    5.000E+00 FYMBGPDFNaPPXEMsSPsRP
;58    6.000E+00 TQMAcPc@NQaPaENsYPsYP
;58    7.000E+00 sBMaTPbSNRIPaXNChPChP
;58    8.000E+00 RTMQPPbCNBTPR@NShPShP
;58    9.000E+00 BAMqHPQcNbVPRPNDIPDHP
;58    1.000E+01 aRMaHPqPNBgPBhNTIPTIP
;58    1.100E+01 qDMQIPQRNCFPcDNt@Pt@P
;58    1.200E+01 QCMQBPqHNcDPSXNDQPDPP
;58    1.300E+01 iQLAEPaFNCPPS`NTQPTQP
;58    1.400E+01 hILYdOQENSVPd@NdQPdPP
;58    1.500E+01 gBLITOAGNsPPDYNtPPtPP
;58    1.600E+01 vELXiOYbMCcPtVNtYPtYP
;58    1.800E+01 EBLhAOxPMDGPeGNTePTeP
;58    2.000E+01 DFLWWOwTMdHPuRNU@PU@P
;58    2.200E+01 sFLGDOVhMDWPVENeEPeEP
;58    2.400E+01 BbLVXOvDMdUPVSNuHPuHP
;58    2.600E+01 BPLVGOEbMDaPFiNUPPUPP
;58    2.800E+01 BGLEbOuGMTfPgANeRPeRP
;58    3.000E+01 AaLUQOTiMEIPWRNuRPuRP
;58    4.000E+01 ABLtHOcXMeTPxYNVGPVGP
;58    5.000E+01 VPKcVORaMFEPyTNVRPVRP
;58    6.000E+01 TQKSEOBQMvGPAEOvYPvYP
;58    8.000E+01 RTKBYOqYMFdPQFOg@Pg@P
;58    1.000E+02 aRKBFOASMWGPaEOWPPWPP
;58    1.500E+02 gBJAWOITLwPPqHOWiPWiP
;58    2.000E+02 DFJQEOGELHBPAWOhHPhHP
;58    3.000E+02 AaJXGNdXLxIPQXOhSPhSP
;58    4.000E+02 ABJFPNSQLhPPaTOHcPHcP
;58    5.000E+02 VPIu@NB`LxTPaXOXfPXfP
;58    6.000E+02 TQITSNrCLHdPqQOIFPIFP
;58    8.000E+02 RTISTNqULXgPqVOYIPYIP
;58    1.000E+03 aRIRaNAPLIFPqYOiGPiGP
;58    1.500E+03 gBHBCNyBKYHPAcOyIPyIP
;58    2.000E+03 DFHQWNVhKiEPAfOIVPIVP
;58    3.000E+03 AaHAINdUKyCPAiOYSPYSP
;58    4.000E+03 ABHHUMCYKyGPQ`OYVPYVP
;58    5.000E+03 VPGVaMrYKyIPQaOYYPYYP
;58    6.000E+03 TQGEfMrCKIQPQbOiQPiQP
;58    8.000E+03 RTGTQMqTKISPQcOiSPiSP
;58    1.000E+04 aRGcXMAPKIUPQdOiTPiTP
;58    1.500E+04 gBFRUMyAJIVPQdOiVPiVP
;58    2.000E+04 DFFQfMVhJIXPQeOiWPiWP
;58    3.000E+04 AaFqEMdUJIYPQeOiXPiXP
;58    4.000E+04 ABFADMCYJIYPQfOiYPiYP
;58    5.000E+04 VPEHTLrYJYPPQfOyPPyPP
;58    6.000E+04 TQEWCLrCJYPPQfOyPPyPP
;58    8.000E+04 RTEEWLqTJYPPQfOyPPyPP
;58    1.000E+05 aREDULAPJYPPQfOyPPyPP
;==== ELEMENT  59
;59    1.000E-03 iHRVSOAFV@@R@@RAFVAFV
;59    1.115E-03 YFRWPOXDU@@R@@RXEUXDU
;59    1.242E-03 ICRXSOfGU@@R@@RfHUfGU
;59 M3 1.242E-03 ICRXSOgAU@@R@@RgBUgAU
;59    1.289E-03 XiRHhOfUU@@R@@RfVUfUU
;59    1.337E-03 XeRiEOVCU@@R@@RVDUVCU
;59 M2 1.337E-03 XeRiEOVPU@@R@@RVQUVPU
;59    1.500E-03 xWRAFPEHU@@R@@REIUEHU
;59    1.511E-03 xVRAFPE@U@@R@@REAUE@U
;59 M1 1.511E-03 xVRAFPeCU@@R@@ReDUeCU
;59    2.000E-03 hERAUPrVU@@R@@RrWUrVU
;59    3.000E-03 gDRb@PADU@@R@@RAEUADU
;59    4.000E-03 vDRR`PEGT@@R@@RUCTEGT
;59    5.000E-03 UWRSSPBgT@@R@@RRbTBgT
;59    5.964E-03 TeRDFPAbT@@R@@RAgTAbT
;59 L3 5.964E-03 TeRDFPUBT@@R@@RUGTUBT
;59    6.000E-03 TcRDHPEIT@@R@@RUDTEIT
;59    6.440E-03 dXRtAPdFT@@R@@RtATdFT
;59 L2 6.440E-03 dXRtAPEaT@@R@@REfTEaT
;59    6.635E-03 TXRDPPEPT@@R@@RETTEPT
;59    6.835E-03 DWRTPPEAT@@R@@REFTEAT
;59 L1 6.835E-03 DWRTPPuYT@@R@@REdTuYT
;59    8.000E-03 ScREBPSaT@@R@@RSeTSaT
;59    1.000E-02 c@RE`PRHT@@R@@RbATRHT
;59    1.500E-02 BIRwFPwHS@@R@@RgPSwIS
;59    2.000E-02 QPRHUPsGS@@R@@RSSSsHS
;59    3.000E-02 xTQyTPAIS@@R@@RQISQ@S
;59    4.000E-02 eYQADQDhR@@R@@RUVRTiR
;59    4.199E-02 eHQAEQdFR@@R@@RDiRtFR
;59 K  4.199E-02 eHQAEQBUS@@R@@RRRSBVS
;59    5.000E-02 DDQAHQQUS@@R@@RaPSQVS
;59    6.000E-02 CCQQ@QYVR@@R@@RYhRiWR
;59    8.000E-02 AhQQ@QtFR@@R@@RdVRDWR
;59    1.000E-01 aHQAIQrER@@R@@RRYRBVR
;59    1.500E-01 fCPACQWSQ@@R@@RYHQXVQ
;59    2.000E-01 sPPiXPsEQ@@R@@RdYQtBQ
;59    3.000E-01 qSPhRPAIQ@@R@@RRCQQeQ
;59    4.000E-01 A@PGaPEHP@@R@@RqIQaIQ
;59    5.000E-01 VPOWHPBhP@@R@@RAGQAAQ
;59    6.000E-01 TVOfWPAeP@@R@@RXhPXRP
;59    8.000E-01 bPOEhPiTO@@R@@RW@PFdP
;59    1.000E+00 aWOu@PFCO@@R@@RFGPU`P
;59    1.022E+00 aPOeDPuWO@@R@@RUhPEbP
;59    1.250E+00 AHOtUPCiObGN@@ReGPUFP
;59    1.500E+00 GYNtBPrXOAEO@@RtXPtPP
;59    2.000E+00 dCNcYPaYOCTO@@RdDPd@P
;59    2.044E+00 DENcTPaSOcWO@@RdAPTGP
;59    3.000E+00 AhNR`PXcNHTOABMCfPCdP
;59    4.000E+00 AFNBRPU`NaHPTDMsWPsVP
;59    5.000E+00 vYMBIPtENaUPhDMC`PsYP
;59    6.000E+00 tQMAePCSNQgPaFNCgPCgP
;59    7.000E+00 CVMaVPBbNbEPqPNSfPSfP
;59    8.000E+00 bUMQQPrINRQPRCNDGPDFP
;59    9.000E+00 R@MqIPBGNrTPRSNTHPTGP
;59    1.000E+01 qPMaIPAcNRePRbNdIPdIP
;59    1.100E+01 APMa@PaSNSDPcHNDPPDPP
;59    1.200E+01 QHMQCPAWNsCPcRNTQPTQP
;59    1.300E+01 A@MAFPqDNSPPSdNdQPdQP
;59    1.400E+01 hVLAAPaDNcUPdENtQPtQP
;59    1.500E+01 WTLYUOQDNC`PTTNDaPDaP
;59    1.600E+01 fSLIIOAFNScPDbNT`PT`P
;59    1.800E+01 eDLxAOyAMTHPuCNEGPEGP
;59    2.000E+01 dDLgVOhIMtIPuYNeCPeCP
;59    2.200E+01 SQLWBOGWMTYPfANuHPuHP
;59    2.400E+01 ReLfUOvYMtWPfPNUQPUQP
;59    2.600E+01 RQLfDOfCMTdPVfNeTPeTP
;59    2.800E+01 RFLEiOuUMEIPgINuUPuUP
;59    3.000E+01 AiLUXOuDMeCPgPNEgPEgP
;59    4.000E+01 AFLDSOSdMuYPHhNvCPvCP
;59    5.000E+01 vYKsPOSBMfAPIdNfXPfXP
;59    6.000E+01 tQKSIORXMVSPAFOVfPVfP
;59    8.000E+01 bUKRQOQbMGBPQHOwIPwIP
;59    1.000E+02 qPKBIOQSMwFPaFOgYPgYP
;59    1.500E+02 WTJAYOAAMW`PAPOXIPXIP
;59    2.000E+02 dDJQGOWULhBPAXOHYPHYP
;59    3.000E+02 AiJhFNEALhPPQYOHePHeP
;59    4.000E+02 AFJFWNsULHbPaUOIEPIEP
;59    5.000E+02 vYIuFNC@LXfPqPOYIPYIP
;59    6.000E+02 tQITYNRPLIFPqSOiHPiHP
;59    8.000E+02 bUISXNAgLi@PqWOIQPIQP
;59    1.000E+03 qPIReNQPLiIPA`OYPPYPP
;59    1.500E+03 WTHBFNYgKIRPAeOiRPiRP
;59    2.000E+03 dDHQYNGWKIYPAgOiYPiYP
;59    3.000E+03 AiHQANThKYVPQ`OyWPyWP
;59    4.000E+03 AFHXUMsSKiQPQbOIaPIaP
;59    5.000E+03 vYGViMRiKiSPQcOIcPIcP
;59    6.000E+03 tQGUbMBYKiUPQcOIePIeP
;59    8.000E+03 bUGTVMAgKiWPQdOIgPIgP
;59    1.000E+04 qPGsSMAYKiYPQeOIiPIiP
;59    1.500E+04 WTFRXMYeJyQPQfOY`PY`P
;59    2.000E+04 dDFQhMGWJyRPQfOYbPYbP
;59    3.000E+04 AiFqGMThJySPQgOYcPYcP
;59    4.000E+04 AFFAEMsSJyTPQgOYcPYcP
;59    5.000E+04 vYEXTLRiJyTPQgOYdPYdP
;59    6.000E+04 tQEgBLBYJyTPQgOYdPYdP
;59    8.000E+04 bUEUSLAgJyTPQgOYdPYdP
;59    1.000E+05 qPETPLAYJyUPQgOYePYeP
;==== ELEMENT  60
;60    1.000E-03 IPRvBOfRU@@R@@RfSUfRU
;60    1.002E-03 IPRvDOvWU@@R@@RvXUvWU
;60    1.005E-03 yIRvFOVbU@@R@@RVcUVbU
;60 M4 1.005E-03 yIRvFOXQU@@R@@RXRUXQU
;60    1.142E-03 iDRGVOW@U@@R@@RWAUW@U
;60    1.297E-03 YARhUOUbU@@R@@RUcUUbU
;60 M3 1.297E-03 YARhUOFbU@@R@@RFcUFbU
;60    1.349E-03 IERIFOfFU@@R@@RfGUfFU
;60    1.403E-03 I@RIXOuTU@@R@@RuUUuTU
;60 M2 1.403E-03 I@RIXOFHU@@R@@RFIUFHU
;60    1.500E-03 HiRABPeFU@@R@@ReGUeFU
;60    1.575E-03 HaRAHPtSU@@R@@RtTUtSU
;60 M1 1.575E-03 HaRAHPTdU@@R@@RTeUTdU
;60    2.000E-03 xHRAQPBgU@@R@@RBhUBgU
;60    3.000E-03 wGRREPAIU@@R@@RAIUAIU
;60    4.000E-03 FVRBcPu@T@@R@@RuGTu@T
;60    5.000E-03 eXRCUPC@T@@R@@RCFTC@T
;60    6.000E-03 ECRD@PAhT@@R@@RQcTAhT
;60    6.208E-03 TaRT@PqRT@@R@@RqWTqRT
;60 L3 6.208E-03 TaRT@PDdT@@R@@RDiTDdT
;60    6.460E-03 tVRdCPtHT@@R@@RDSTtHT
;60    6.721E-03 dRRtEPSgT@@R@@RDATSgT
;60 L2 6.721E-03 dRRtEPEQT@@R@@REVTEQT
;60    6.921E-03 TQRDUPECT@@R@@REHTECT
;60    7.126E-03 DQRTTPdXT@@R@@RtRTdXT
;60 L1 7.126E-03 DQRTTPEPT@@R@@REUTEPT
;60    8.000E-03 DARTbPDET@@R@@RDITDET
;60    1.000E-02 cFRuPPbGT@@R@@Rr@TbGT
;60    1.500E-02 RCRgDPwPS@@R@@RWbSwQS
;60    2.000E-02 QSRxCPSRS@@R@@RcXSSSS
;60    3.000E-02 XaQiSPQES@@R@@RaESQFS
;60    4.000E-02 E`QACQUCR@@R@@REaReCR
;60    4.357E-02 EIQAEQDCR@@R@@RdTRTCR
;60 K  4.357E-02 EIQAEQr@S@@R@@RrGSrAS
;60    5.000E-02 TBQAGQaPS@@R@@RaUSaQS
;60    6.000E-02 CIQAIQYaR@@R@@RACSA@S
;60    8.000E-02 QbQAIQTTR@@R@@RDdRdUR
;60    1.000E-01 qAQAHQBUR@@R@@RbYRRVR
;60    1.500E-01 vFPABQGfQ@@R@@RYRQHiQ
;60    2.000E-01 sXPiQPSQQ@@R@@RDdQDWQ
;60    3.000E-01 qWPXVPQDQ@@R@@RRHQB@Q
;60    4.000E-01 ABPwVPuDP@@R@@RAQQqAQ
;60    5.000E-01 fVOWCPCCP@@R@@RAHQABQ
;60    6.000E-01 dWOfRPQeP@@R@@RIDPXWP
;60    8.000E-01 bVOEePABP@@R@@RWCPFfP
;60    1.000E+00 qQOeFPvEO@@R@@RFGPU`P
;60    1.022E+00 aTOeAPFHO@@R@@RUhPEbP
;60    1.250E+00 Q@OtRPT@OrBN@@ReFPUEP
;60    1.500E+00 gXNdIPRcOAGO@@RtWPdYP
;60    2.000E+00 tCNcVPqXOSPO@@RdDPTIP
;60    2.044E+00 TENcRPqROsSO@@RdAPTFP
;60    3.000E+00 QcNBiPIPNXUOAAMCfPCdP
;60    4.000E+00 AINBQPf@NaIPTAMsXPsWP
;60    5.000E+00 VfMBHPTXNaWPXIMCaPC`P
;60    6.000E+00 DcMAdPcQNQiPaFNChPCgP
;60    7.000E+00 SUMaUPRfNbGPaYNSgPSgP
;60    8.000E+00 rRMQPPRQNRSPRANDHPDHP
;60    9.000E+00 REMqHPRHNrVPRQNTIPTIP
;60    1.000E+01 qTMaHPQbNRgPR`Nt@Pt@P
;60    1.100E+01 ATMQIPqRNSGPcFNDRPDQP
;60    1.200E+01 aAMQBPQUNsEPcPNTSPTRP
;60    1.300E+01 ACMAFPAQNSRPSbNdSPdSP
;60    1.400E+01 HhLYiOq@NcXPdBNtSPtSP
;60    1.500E+01 wSLIXOa@NCcPTQNDcPDcP
;60    1.600E+01 F`LICOQBNSfPtXNTbPTbP
;60    1.800E+01 uGLhEOyYMdAPeINU@PU@P
;60    2.000E+01 tELgQOxQMDSPuUNeFPeFP
;60    2.200E+01 SYLGGOGdMdSPVGNEPPEPP
;60    2.400E+01 CBLfPOWDMDaPVUNUTPUTP
;60    2.600E+01 RWLf@OVTMTgPVaNeWPeWP
;60    2.800E+01 bBLEeOFDMUCPgDNuYPuYP
;60    3.000E+01 QcLUTOeQMeFPWUNU`PU`P
;60    4.000E+01 AILDPOTDMEcPHaNvGPvGP
;60    5.000E+01 VfKcXOcGMfEPyWNvRPvRP
;60    6.000E+01 DcKSGOrQMVXPAEOGAPGAP
;60    8.000E+01 rRKRPOBAMGGPQGOGTPGTP
;60    1.000E+02 qTKBGOaPMGQPaEOwTPwTP
;60    1.500E+02 wSJAXOAFMWfPqIOhDPhDP
;60    2.000E+02 tEJQFOWbLhHPAWOXUPXUP
;60    3.000E+02 QcJh@NeFLhVPQXOX`PX`P
;60    4.000E+02 AIJFSNSdLHhPaTOYAPYAP
;60    5.000E+02 VfIuBNSELICPaXOiEPiEP
;60    6.000E+02 DcITVNbRLYCPqQOyEPyEP
;60    8.000E+02 rRISVNQfLiGPqVOIXPIXP
;60    1.000E+03 qTIRcNQWLyFPqYOYVPYVP
;60    1.500E+03 wSHBDNAELIYPAcOiYPiYP
;60    2.000E+03 tEHQXNGdKYVPAeOyVPyVP
;60    3.000E+03 QcHQ@NeCKiSPAhOIcPIcP
;60    4.000E+03 AIHHYMSbKiWPQ`OIgPIgP
;60    5.000E+03 VfGVdMSDKyPPQaOY`PY`P
;60    6.000E+03 DcGEiMbQKyRPQaOYaPYaP
;60    8.000E+03 rRGTSMQfKyTPQbOYdPYdP
;60    1.000E+04 qTGsPMQWKyUPQcOYePYeP
;60    1.500E+04 wSFRVMAEKyWPQdOYgPYgP
;60    2.000E+04 tEFQgMGdJyYPQdOYhPYhP
;60    3.000E+04 QcFqFMeBJI`PQeOYiPYiP
;60    4.000E+04 AIFADMSbJI`PQeOA@QA@Q
;60    5.000E+04 VfEHXLSCJIaPQeOA@QA@Q
;60    6.000E+04 DcEWGLbQJIaPQeOA@QA@Q
;60    8.000E+04 rREUPLQfJIbPQeOA@QA@Q
;60    1.000E+05 qTEDWLQWJIbPQeOA@QA@Q
;==== ELEMENT  61
;61    1.000E-03 iYRfCOBEU@@R@@RBFUBEU
;61    1.013E-03 iXRvCOB@U@@R@@RBAUB@U
;61    1.027E-03 iWRFTOQeU@@R@@RQfUQeU
;61 M5 1.027E-03 iWRFTORTU@@R@@RRUURTU
;61    1.039E-03 iURVTOCeU@@R@@RCfUCeU
;61    1.051E-03 iTRfTOuYU@@R@@RE`UuYU
;61 M4 1.051E-03 iTRfTOWIU@@R@@Rg@UWIU
;61    1.194E-03 YPRwVOvIU@@R@@RFPUvIU
;61    1.357E-03 yCRIAOeXU@@R@@ReYUeXU
;61 M3 1.357E-03 yCRIAOVUU@@R@@RVUUVUU
;61    1.413E-03 iHRITOUhU@@R@@RUiUUhU
;61    1.471E-03 iARIiOEVU@@R@@REWUEVU
;61 M2 1.471E-03 iARIiOuYU@@R@@RE`UuYU
;61    1.500E-03 YHRAAPUTU@@R@@RUUUUTU
;61    1.653E-03 IBRQCPDYU@@R@@RTPUDYU
;61 M1 1.653E-03 IBRQCPdYU@@R@@RtPUdYU
;61    2.000E-03 hVRqIPCDU@@R@@RCEUCDU
;61    3.000E-03 gTRRCPQEU@@R@@RQFUQEU
;61    4.000E-03 vQRBaPeTT@@R@@RuQTeTT
;61    5.000E-03 U`RCSPc@T@@R@@RcFTc@T
;61    6.000E-03 eBRShPB@T@@R@@RBETB@T
;61    6.459E-03 TeRdAPaUT@@R@@RqPTaUT
;61 L3 6.459E-03 TeRdAPdST@@R@@RdXTdST
;61    6.730E-03 tYRtEPTGT@@R@@RdBTTGT
;61    7.013E-03 dTRDXPsVT@@R@@RC`TsVT
;61 L2 7.013E-03 dTRDXPUCT@@R@@RUHTUCT
;61    7.217E-03 TTRTWPtXT@@R@@RDbTtXT
;61    7.428E-03 DSRdWPDUT@@R@@RTPTDUT
;61 L1 7.428E-03 DSRdWPUDT@@R@@RUITUDT
;61    8.000E-03 TFRTbPdGT@@R@@RtATdGT
;61    1.000E-02 sIRuPPBQT@@R@@RBTTBQT
;61    1.500E-02 bARgFPXHS@@R@@RHQSXIS
;61    2.000E-02 QXRxGPsUS@@R@@RSbSsVS
;61    3.000E-02 iEQyPPaBS@@R@@RqCSaCS
;61    4.000E-02 FBQADQEWR@@R@@RVHRUXR
;61    4.518E-02 E@QAFQCiR@@R@@RDYRSiR
;61 K  4.518E-02 E@QAFQb@S@@R@@RbGSbBS
;61    5.000E-02 dHQAHQaXS@@R@@RqSSaYS
;61    6.000E-02 cAQQ@QADS@@R@@RAISAFS
;61    8.000E-02 B@QQAQD`R@@R@@RUARTaR
;61    1.000E-01 qFQAIQRYR@@R@@RBdRrPR
;61    1.500E-01 fRPACQxFQ@@R@@RAARyIQ
;61    2.000E-01 ScPyRPsSQ@@R@@RU@QtQQ
;61    3.000E-01 AePhVPaBQ@@R@@RbGQBIQ
;61    4.000E-01 AGPGePuQP@@R@@RAVQqFQ
;61    5.000E-01 VdOgAPcEP@@R@@RQBQAEQ
;61    6.000E-01 DgOvPPBIP@@R@@RiHPxYP
;61    8.000E-01 rXOUaPAIP@@R@@RgHPG@P
;61    1.000E+00 qYOuCPFbO@@R@@RVIPFAP
;61    1.022E+00 qQOeGPVRO@@R@@RV@PUcP
;61    1.250E+00 QEOtWPDPOBQN@@RuEPeCP
;61    1.500E+00 HANtDPSDOQBO@@RDePtWP
;61    2.000E+00 TRNsQPQaOcSO@@RtAPdFP
;61    2.044E+00 tCNcVPAdOCgO@@RdHPdCP
;61    3.000E+00 BANRbPAAOHcOABMSbPS`P
;61    4.000E+00 QCNBTPfTNqCPTFMCePCdP
;61    5.000E+00 gFMR@PT`NqQPhIMChPChP
;61    6.000E+00 EDMAfPCfNBDPaGNSfPSeP
;61    7.000E+00 sPMaWPSGNrCPqQNDFPDFP
;61    8.000E+00 BdMQRPbYNbPPRDNTGPTGP
;61    9.000E+00 bDMAPPrCNBcPRTNdHPdHP
;61    1.000E+01 AbMq@PBENCEPRcNDPPDPP
;61    1.100E+01 QPMaAPAcNcEPcINTRPTQP
;61    1.200E+01 aFMQCPaVNCTPcTNdSPdSP
;61    1.300E+01 AGMAGPQQNcRPSfNtTPtTP
;61    1.400E+01 iFLAAPqINsXPdGNDePDdP
;61    1.500E+01 HGLiPOaHNScPTVNTePTeP
;61    1.600E+01 GILYDOQINDGPDdNEDPEDP
;61    1.800E+01 ePLxEOAENtBPuENeBPeBP
;61    2.000E+01 TTLwPOyAMTTPEaNuHPuHP
;61    2.200E+01 sULWFOxIMtUPfDNUTPUTP
;61    2.400E+01 SELfYOgSMTcPfSNeXPeXP
;61    2.600E+01 bYLfHOViMU@PViNEaPEaP
;61    2.800E+01 rBLUbOFVMeFPwBNUcPUcP
;61    3.000E+01 BBLeQOF@MEPPgSNFEPFEP
;61    4.000E+01 QCLDUODRMUhPXaNVRPVRP
;61    5.000E+01 gFKsROSPMFRPIhNFiPFiP
;61    6.000E+01 EEKcAOBiMvUPAFOWHPWHP
;61    8.000E+01 BdKRSOREMgEPQHOgRPgRP
;61    1.000E+02 AbKR@OqQMgPPaFOWdPWdP
;61    1.500E+02 HGJAYOQCMXFPAPOHUPHUP
;61    2.000E+02 TTJQGOHWLXPPAYOxWPxWP
;61    3.000E+02 BBJx@NeRLHhPQYOYCPYCP
;61    4.000E+02 QCJVPNdALYAPaUOyDPyDP
;61    5.000E+02 gFIuHNsFLiFPqPOIXPIXP
;61    6.000E+02 EEIdQNB`LyFPqSOYXPYXP
;61    8.000E+02 BdIcPNR@LYPPqWOyRPyRP
;61    1.000E+03 AbIRfNaXLiPPA`OIaPIaP
;61    1.500E+03 HGHBGNQBLyRPAeOYcPYcP
;61    2.000E+03 TTHaPNxHKI`PAgOA@QA@Q
;61    3.000E+03 BBHQANUYKIgPQ`OAAQAAQ
;61    4.000E+03 QCHXYMTIKYbPQaOAAQAAQ
;61    5.000E+03 gFGGBMsEKYdPQbOAAQAAQ
;61    6.000E+03 EEGUfMrYKYfPQcOABQABQ
;61    8.000E+03 BdGTYMBIKYiPQdOABQABQ
;61    1.000E+04 AbGsUMaWKA@QQeOABQABQ
;61    1.500E+04 HGFRYMQBKA@QQeOABQABQ
;61    2.000E+04 TTFQiMxGJA@QQfOABQABQ
;61    3.000E+04 BBFqGMUXJA@QQfOABQABQ
;61    4.000E+04 QCFAEMTHJA@QQgOABQABQ
;61    5.000E+04 gFEXXLsEJAAQQgOACQACQ
;61    6.000E+04 EEEgFLrYJAAQQgOACQACQ
;61    8.000E+04 BdEUVLBIJAAQQgOACQACQ
;61    1.000E+05 AbETSLaWJAAQQgOACQACQ
;==== ELEMENT  62
;62    1.000E-03 iWRUdOR@U@@R@@RRAUR@U
;62    1.039E-03 iSRfDOQeU@@R@@RQfUQeU
;62    1.080E-03 YYRVVOAbU@@R@@RAcUAbU
;62 M5 1.080E-03 YYRVVORQU@@R@@RRRURQU
;62    1.093E-03 YXRfVOsTU@@R@@RsUUsTU
;62    1.106E-03 YVRvVOUUU@@R@@RUVUUUU
;62 M4 1.106E-03 YVRvVOvXU@@R@@RvYUvXU
;62    1.253E-03 ISRGfOUgU@@R@@RUhUUgU
;62    1.420E-03 iFRIHOeEU@@R@@ReFUeEU
;62 M3 1.420E-03 iFRIHOFFU@@R@@RFGUFFU
;62    1.500E-03 YGRiWOuEU@@R@@RuFUuEU
;62    1.541E-03 YCRYhOEDU@@R@@REEUEDU
;62 M2 1.541E-03 YCRYhOuEU@@R@@RuFUuEU
;62    1.629E-03 IDRAFPtSU@@R@@RtTUtSU
;62    1.723E-03 XdRQCPTHU@@R@@RTIUTHU
;62 M1 1.723E-03 XdRQCPtGU@@R@@RtHUtGU
;62    2.000E-03 hVRqCPSAU@@R@@RSBUSAU
;62    3.000E-03 gVRBDPQIU@@R@@RQIUQIU
;62    4.000E-03 vTRrPPE`T@@R@@REgTE`T
;62    5.000E-03 UcRs@Ps@T@@R@@RsFTs@T
;62    6.000E-03 eERCdPBFT@@R@@RRBTBFT
;62    6.716E-03 DcRTIPQTT@@R@@RQYTQTT
;62 L3 6.716E-03 DcRTIPdIT@@R@@RtCTdIT
;62    7.008E-03 dWRtBPCeT@@R@@RCiTCeT
;62    7.312E-03 TRRDUPCUT@@R@@RSPTCUT
;62 L2 7.312E-03 TRRDUPtQT@@R@@RtVTtQT
;62    7.521E-03 DQRTUPtIT@@R@@RDTTtIT
;62    7.737E-03 tARdTPT@T@@R@@RTDTT@T
;62 L1 7.737E-03 tARdTPtST@@R@@RtXTtST
;62    8.000E-03 TIRtUPtFT@@R@@RDPTtFT
;62    1.000E-02 CQRUQPBVT@@R@@RRPTBWT
;62    1.500E-02 bBRGCPHPS@@R@@RhSSHQS
;62    2.000E-02 QYRXCPCfS@@R@@RDCSCgS
;62    3.000E-02 y@QIUPaFS@@R@@RqGSaGS
;62    4.000E-02 FEQAAQeVR@@R@@RvFRuVR
;62    4.683E-02 tUQADQcSR@@R@@RdARsSR
;62 K  4.683E-02 tUQADQBDS@@R@@RR@SBES
;62    5.000E-02 dIQAEQqRS@@R@@RqWSqSS
;62    6.000E-02 cCQAGQAFS@@R@@RQASAGS
;62    8.000E-02 BAQAHQT`R@@R@@ReAREAR
;62    1.000E-01 qGQAGQbVR@@R@@RR`RrVR
;62    1.500E-01 fVPAAQXYQ@@R@@RACRiPQ
;62    2.000E-01 SfPYQPCeQ@@R@@RUIQD`Q
;62    3.000E-01 AfPHWPaFQ@@R@@Rr@QRAQ
;62    4.000E-01 AHPgXPU`P@@R@@RAWQqFQ
;62    5.000E-01 G@OGFPsFP@@R@@RQAQADQ
;62    6.000E-01 TbOVVPRGP@@R@@RiBPxSP
;62    8.000E-01 B`OuYPQCP@@R@@Rg@PVbP
;62    1.000E+00 AaOeBPGGO@@R@@RVAPUcP
;62    1.022E+00 qSOUFPvVO@@R@@RFAPEdP
;62    1.250E+00 QFOdWPTVOBSN@@ReGPUEP
;62    1.500E+00 HINdEPcFOQBO@@RtWPdYP
;62    2.000E+00 TWNcSPQhOcUO@@RdDPTIP
;62    2.044E+00 tGNSYPQaOChO@@RdAPTGP
;62    3.000E+00 BCNBfPADOHbOA@MCgPCeP
;62    4.000E+00 QENrIPFhNqCPDHMC`PsYP
;62    5.000E+00 wCMBFPEGNqQPXAMCcPCcP
;62    6.000E+00 EIMAbPSiNBCPaDNSaPSaP
;62    7.000E+00 sTMaTPcHNrBPaXNDAPDAP
;62    8.000E+00 BfMAYPrXNRXPBINTBPTBP
;62    9.000E+00 bFMqGPBQNBbPBYNdDPdDP
;62    1.000E+01 AcMaGPRBNCCPBgNtEPtEP
;62    1.100E+01 QRMQHPQ`NcCPcCNDWPDWP
;62    1.200E+01 aGMQAPqQNCRPSVNTXPTXP
;62    1.300E+01 AHMAEPQVNSYPChNdYPdYP
;62    1.400E+01 yFLY`OATNsUPTHND`PD`P
;62    1.500E+01 XELIPOqCNS`PDWNT`PT`P
;62    1.600E+01 WFLXeOaCNDDPtTNTiPTiP
;62    1.800E+01 eVLXHOAHNdIPeDNUGPUGP
;62    2.000E+01 TYLWUOiRMTQPeYNuDPuCP
;62    2.200E+01 sYLGAOhWMtQPVANEYPEXP
;62    2.400E+01 SHLVUOGhMT`PFYNeSPeSP
;62    2.600E+01 rQLVEOgCMEGPFdNuVPuVP
;62    2.800E+01 rDLE`OfWMeBPWGNEhPEhP
;62    3.000E+01 BDLUPOf@MuFPGWNUiPUiP
;62    4.000E+01 QELtGOTWMUdPxRNFWPFWP
;62    5.000E+01 wCKcTOcRMvGPiWNFdPFdP
;62    6.000E+01 EIKSDORiMvPPADOWCPWCP
;62    8.000E+01 BgKBXObBMg@PQEOWVPWVP
;62    1.000E+02 AcKBFOqWMWUPaDOGhPGhP
;62    1.500E+02 XEJAVOQGMX@PqGOxIPxIP
;62    2.000E+02 TYJQEOxULHSPAUOxPPxPP
;62    3.000E+02 BDJXCNEaLHbPQVOIFPIFP
;62    4.000E+02 QEJvGNtELIDPaROiGPiGP
;62    5.000E+02 wCIeGNCWLYIPaVOIQPIQP
;62    6.000E+02 EIITQNBiLiIPaYOYQPYQP
;62    8.000E+02 BgISSNRGLISPqSOiTPiTP
;62    1.000E+03 AcIR`NqSLYRPqVOySPySP
;62    1.500E+03 XEHBCNQELiUPA`OIePIeP
;62    2.000E+03 TYHQWNhVKyRPAcOYbPYbP
;62    3.000E+03 BDHAINuWKI`PAeOYiPYiP
;62    4.000E+03 QEHHQMtCKIdPAgOA@QA@Q
;62    5.000E+03 wCGFhMCVKIfPAhOAAQAAQ
;62    6.000E+03 EIGEdMBhKIhPAhOAAQAAQ
;62    8.000E+03 BgGDYMRFKY`PAiOAAQAAQ
;62    1.000E+04 AcGcWMqSKYbPQ`OAAQAAQ
;62    1.500E+04 XEFRTMQEKYdPQaOAAQAAQ
;62    2.000E+04 TYFQeMhUJYePQaOAAQAAQ
;62    3.000E+04 BDFqDMuWJYfPQbOABQABQ
;62    4.000E+04 QEFACMtCJYgPQbOABQABQ
;62    5.000E+04 wCEHQLCVJYgPQbOABQABQ
;62    6.000E+04 EIEWALBhJYhPQbOABQABQ
;62    8.000E+04 BgEEULRFJYhPQbOABQABQ
;62    1.000E+05 AcEDSLqSJYhPQbOABQABQ
;==== ELEMENT  63
;63    1.000E-03 Y`REaObAU@@R@@RbBUbAU
;63    1.063E-03 IdRfIOQgU@@R@@RQhUQgU
;63    1.131E-03 yWRFaOqUU@@R@@RqVUqUU
;63 M5 1.131E-03 yWRFaOrCU@@R@@RrDUrCU
;63    1.146E-03 yURVbOSSU@@R@@RSTUSSU
;63    1.161E-03 yTRGCOuEU@@R@@RuFUuEU
;63 M4 1.161E-03 yTRGCOFWU@@R@@RFXUFWU
;63    1.311E-03 YYRXBOuPU@@R@@RuQUuPU
;63    1.481E-03 IRRyEOEBU@@R@@RECUEBU
;63 M3 1.481E-03 IRRyEOE`U@@R@@REaUE`U
;63    1.500E-03 IPRIYOeRU@@R@@ReRUeRU
;63    1.614E-03 iHRACPtVU@@R@@RtWUtVU
;63 M2 1.614E-03 iHRACPEFU@@R@@REGUEFU
;63    1.704E-03 i@RQ@PDXU@@R@@RDYUDXU
;63    1.800E-03 Y@RQGPSgU@@R@@RShUSgU
;63 M1 1.800E-03 Y@RQGPTEU@@R@@RTFUTEU
;63    2.000E-03 HiRqAPcGU@@R@@RcHUcGU
;63    3.000E-03 GhRBBPaEU@@R@@RaFUaEU
;63    4.000E-03 VdRbWPVBT@@R@@RVITVBT
;63    5.000E-03 VBRcFPCXT@@R@@RSTTCXT
;63    6.000E-03 ERRC`PRHT@@R@@RbCTRHT
;63    6.977E-03 DdRdFPAWT@@R@@RQRTAWT
;63 L3 6.977E-03 DdRdFPDHT@@R@@RTCTDHT
;63    7.290E-03 dWRDQPcTT@@R@@RcYTcTT
;63    7.617E-03 TQRTUPcFT@@R@@Rs@TcFT
;63 L2 7.617E-03 TQRTUPDUT@@R@@RDYTDUT
;63    8.000E-03 tBRtPPSeT@@R@@RSiTSeT
;63    8.052E-03 t@RtSPChT@@R@@RSbTChT
;63 L1 8.052E-03 t@RtSPDXT@@R@@RTSTDXT
;63    1.000E-02 SRREWPRYT@@R@@RbSTRYT
;63    1.500E-02 bHRViPHeS@@R@@RIISHfS
;63    2.000E-02 aSRX@PDGS@@R@@RdDSDHS
;63    3.000E-02 YYQITPqDS@@R@@RATSqDS
;63    4.000E-02 fEQAAQUiR@@R@@RvRRFIR
;63    4.852E-02 dTQAEQCXR@@R@@RDERSYR
;63 K  4.852E-02 dTQAEQQdS@@R@@RB@SQeS
;63    5.000E-02 DSQAEQA`S@@R@@RAeSAaS
;63    6.000E-02 sCQAGQQAS@@R@@RQFSQBS
;63    8.000E-02 BHQAHQUDR@@R@@REVReER
;63    1.000E-01 AQQAGQrYR@@R@@RCDRR`R
;63    1.500E-01 FhPABQIFQ@@R@@RAHRAAR
;63    2.000E-01 DIPYUPDFQ@@R@@RESQEBQ
;63    3.000E-01 QcPXQPqDQ@@R@@RrHQRIQ
;63    4.000E-01 QAPwRPfFP@@R@@RQQQAPQ
;63    5.000E-01 gEOW@PSWP@@R@@RQDQAGQ
;63    6.000E-01 EIOVYPr@P@@R@@RIPPHiP
;63    8.000E-01 R`OEbPa@P@@R@@RwAPGBP
;63    1.000E+00 AgOeEPWRO@@R@@RVIPF@P
;63    1.022E+00 qYOUIPg@O@@R@@RFIPUaP
;63    1.250E+00 a@OtPPDeORRN@@RuCPeAP
;63    1.500E+00 xHNdHPCVOQFO@@RDbPtTP
;63    2.000E+00 tSNcUPR@OsUO@@RdHPdDP
;63    2.044E+00 TSNcQPBCOD@O@@RdEPdAP
;63    3.000E+00 RANBhPQAOIDOAAMSaPCiP
;63    4.000E+00 QINBPPwANqFPT@MCePCcP
;63    5.000E+00 gPMBGPuINqTPXFMCiPChP
;63    6.000E+00 eGMAcPdDNBGPaENSgPSfP
;63    7.000E+00 ChMaUPCXNrGPaXNDGPDGP
;63    8.000E+00 RgMQPPReNbSPR@NTIPTHP
;63    9.000E+00 rEMqHPRVNBgPRPNt@Pt@P
;63    1.000E+01 Q`MaHPbENCIPBhNDRPDRP
;63    1.100E+01 QWMQIPBANs@PcDNTTPTTP
;63    1.200E+01 qBMQBPAbNCXPSXNdVPdUP
;63    1.300E+01 QBMAEPaVNcVPS`NtWPtWP
;63    1.400E+01 iYLYeOQRNCbPd@NDhPDhP
;63    1.500E+01 HTLIUOAQNSgPDYNThPThP
;63    1.600E+01 GRLI@OqANTBPtVNEHPEHP
;63    1.800E+01 EgLhCOQENtGPeFNeFPeFP
;63    2.000E+01 tULWXOABNdPPuRNERPERP
;63    2.200E+01 ScLGEOYIMD`PVDNUXPUXP
;63    2.400E+01 s@LVYOxFMTiPVRNuSPuSP
;63    2.600E+01 BaLVHOgVMUFPFhNEfPEfP
;63    2.800E+01 BRLEcOGGMuBPg@NUhPUhP
;63    3.000E+01 RALUROVWMEVPWQNV@PV@P
;63    4.000E+01 QILtIODdMFEPxVNVXPVXP
;63    5.000E+01 gPKcVOCcMFYPyQNVfPVfP
;63    6.000E+01 eHKSFOSGMFcPAEOgFPgFP
;63    8.000E+01 RgKBYOrFMwCPQFOwPPwPP
;63    1.000E+02 Q`KBGOAgMgYPaDOHBPHBP
;63    1.500E+02 HTJAWOaDMhEPqGOXTPXTP
;63    2.000E+02 tUJQEOiGLXYPAVOHePHeP
;63    3.000E+02 RAJXHNVELXhPQVOiBPiBP
;63    4.000E+02 QIJFPNdQLiAPaROISPISP
;63    5.000E+02 gPIu@NcXLyEPaVOYWPYWP
;63    6.000E+02 eHITTNCGLIVPaYOiWPiWP
;63    8.000E+02 RgISUNr@LiPPqTOIaPIaP
;63    1.000E+03 Q`IRbNAdLiYPqVOY`PY`P
;63    1.500E+03 HTHBDNaBLIbPAaOA@QA@Q
;63    2.000E+03 tUHQXNYGKY`PAcOAAQAAQ
;63    3.000E+03 RAHQ@NVAKYgPAfOABQABQ
;63    4.000E+03 QIHHVMTYKA@QAgOABQABQ
;63    5.000E+03 gPGVbMcWKA@QAhOABQABQ
;63    6.000E+03 eHGEgMCFKAAQAiOACQACQ
;63    8.000E+03 RgGTRMbIKAAQQ`OACQACQ
;63    1.000E+04 Q`GcYMAcKAAQQ`OACQACQ
;63    1.500E+04 HTFRUMaBKAAQQaOACQACQ
;63    2.000E+04 tUFQfMYFJAAQQbOACQACQ
;63    3.000E+04 RAFqEMVAJAAQQbOACQACQ
;63    4.000E+04 QIFADMTXJAAQQbOACQACQ
;63    5.000E+04 gPEHULcVJABQQbOACQACQ
;63    6.000E+04 eHEWELCEJABQQbOACQACQ
;63    8.000E+04 RgEEXLbIJABQQcOACQACQ
;63    1.000E+05 Q`EDVLAcJABQQcOADQADQ
;==== ELEMENT  64
;64    1.000E-03 IhReSObHU@@R@@RbIUbHU
;64    1.089E-03 yYRfIOQeU@@R@@RQfUQeU
;64    1.185E-03 iYRGBOaVU@@R@@RaWUaVU
;64 M5 1.185E-03 iYRGBOAcU@@R@@RAdUAcU
;64    1.201E-03 iXRWDOrQU@@R@@RrRUrQU
;64    1.217E-03 iVRgFOSiU@@R@@RD@USiU
;64 M4 1.217E-03 iVRgFODaU@@R@@RDbUDaU
;64    1.500E-03 yHRiHOECU@@R@@REDUECU
;64    1.544E-03 yCRiPOdYU@@R@@RtPUdYU
;64 M3 1.544E-03 yCRiPOERU@@R@@RESUERU
;64    1.615E-03 iERAAPDiU@@R@@RT`UDiU
;64    1.688E-03 YHRAFPDQU@@R@@RDRUDQU
;64 M2 1.688E-03 YHRAFPdXU@@R@@RdYUdXU
;64    1.782E-03 IHRQCPTEU@@R@@RTFUTEU
;64    1.881E-03 XhRa@PcXU@@R@@RcYUcXU
;64 M1 1.881E-03 XhRa@PCdU@@R@@RCeUCdU
;64    2.000E-03 HeRaHPsEU@@R@@RsFUsEU
;64    3.000E-03 GeRQfPaHU@@R@@RaIUaHU
;64    4.000E-03 VbRbPPvAT@@R@@RvHTvAT
;64    5.000E-03 VARSHPSYT@@R@@RcUTSYT
;64    6.000E-03 ERRsQPbET@@R@@RrATbET
;64    7.243E-03 tPRdHPqHT@@R@@RASTqHT
;64 L3 7.243E-03 tPRdHPC`T@@R@@RCdTC`T
;64    7.579E-03 TSRDSPsHT@@R@@RCRTsHT
;64    7.930E-03 tFRTWPCAT@@R@@RCETCAT
;64 L2 7.930E-03 tFRTWPT@T@@R@@RTETT@T
;64    8.000E-03 tCRdPPDBT@@R@@RDGTDCT
;64    8.376E-03 TFRtUPSYT@@R@@RcSTSYT
;64 L1 8.376E-03 TFRtUPTET@@R@@RTITTET
;64    1.000E-02 SSRuEPbVT@@R@@RbYTbVT
;64    1.500E-02 bIRFbPY@S@@R@@RyDSYAS
;64    2.000E-02 aTRWaPTIS@@R@@RtFSd@S
;64    3.000E-02 iTQiCPqHS@@R@@RAXSqIS
;64    4.000E-02 fHQYcPVIR@@R@@RVbRfIR
;64    5.000E-02 DUQACQsAR@@R@@RCfRCQR
;64    5.024E-02 DRQACQcGR@@R@@RCaRsGR
;64 K  5.024E-02 DRQACQAaS@@R@@RAfSAbS
;64    6.000E-02 sDQAEQQCS@@R@@RQHSQDS
;64    8.000E-02 BIQAFQeFR@@R@@RUWRuFR
;64    1.000E-01 ARQAEQBfR@@R@@RSARRgR
;64    1.500E-01 VdPYfPyAQ@@R@@RQ@RACR
;64    2.000E-01 TCPyGPTIQ@@R@@RUTQUBQ
;64    3.000E-01 QePxEPqHQ@@R@@RBQQbBQ
;64    4.000E-01 QCPWXPFXP@@R@@RQRQAQQ
;64    5.000E-01 wBOVgPcYP@@R@@RQDQAGQ
;64    6.000E-01 UDOFWPrHP@@R@@RyGPHfP
;64    8.000E-01 RcOuQPaEP@@R@@RgEPVfP
;64    1.000E+00 AiOUEPG`O@@R@@RVBPUcP
;64    1.022E+00 AaOEIPGVO@@R@@RFBPEdP
;64    1.250E+00 aBOdQPECORTN@@ReFPUDP
;64    1.500E+00 HWNd@PSYOQGO@@RtVPdWP
;64    2.000E+00 tXNSXPRHOsWO@@RdCPTHP
;64    2.044E+00 TXNSTPR@ODBO@@Rd@PTEP
;64    3.000E+00 RCNBbPQEOIDOIgLCfPCdP
;64    4.000E+00 a@NrFPWXNqEPDBMC`PsYP
;64    5.000E+00 gXMBDPUXNqTPHAMCdPCdP
;64    6.000E+00 uCMA`PtINBGPaCNScPSbP
;64    7.000E+00 SbMaRPcQNrFPaUNDCPDCP
;64    8.000E+00 C@MAWPCENbRPBFNTEPTDP
;64    9.000E+00 rGMqEPbUNBfPBVNdGPdFP
;64    1.000E+01 QbMaEPrCNCHPBcNtHPtHP
;64    1.100E+01 QYMQGPBHNcHPSHNTPPTPP
;64    1.200E+01 qCMQ@PAhNCWPSQNdRPdRP
;64    1.300E+01 QDMACPqQNcTPCcNtSPtSP
;64    1.400E+01 I`LyWOQWNC`PTBNDdPDdP
;64    1.500E+01 XTLiHOAVNSfPDPNTdPTdP
;64    1.600E+01 WQLHdOqENDIPdWNEDPEDP
;64    1.800E+01 UcLHHOQINtEPUGNeBPeBP
;64    2.000E+01 D`LGUOAFNTWPeQNuHPuHP
;64    2.200E+01 SgLVbOYQMtXPFBNUTPUTP
;64    2.400E+01 sDLFVOhTMTfPFPNeXPeXP
;64    2.600E+01 BdLFGOWbMUDPvUNEbPEbP
;64    2.800E+01 BULuSOwAMeIPGGNUdPUdP
;64    3.000E+01 RCLEROvYMESPwFNFFPFFP
;64    4.000E+01 a@LtAOEAMFBPhPNVTPVTP
;64    5.000E+01 gYKcPOSfMFUPYRNVaPVaP
;64    6.000E+01 uDKS@OcHMvYPACOgAPgAP
;64    8.000E+01 C@KBTOBSMgIPQDOgUPgUP
;64    1.000E+02 QbKBCOQdMgTPaBOWgPWgP
;64    1.500E+02 XTJATOaHMhAPqEOHYPHYP
;64    2.000E+02 D`JQCOYXLXTPASOH`PH`P
;64    3.000E+02 RCJHCNvFLXcPQSOYFPYFP
;64    4.000E+02 a@JfINtVLYEPQYOyHPyHP
;64    5.000E+02 gYIe@NCaLy@PaSOYQPYQP
;64    6.000E+02 uCIDVNSGLIPPaVOiQPiQP
;64    8.000E+02 C@ICXNrGLYTPqPOyTPyTP
;64    1.000E+03 QbIBfNQ`LiSPqSOIcPIcP
;64    1.500E+03 XTHB@NaFLyVPqWOYfPYfP
;64    2.000E+03 D`HQUNIXKIcPqYOA@QA@Q
;64    3.000E+03 RCHAHNvBKYaPAbOAAQAAQ
;64    4.000E+03 a@HxAMtTKYePAcOAAQAAQ
;64    5.000E+03 gYGvYMsYKYhPAdOABQABQ
;64    6.000E+03 uCGuVMSFKA@QAeOABQABQ
;64    8.000E+03 C@GDTMrGKA@QAfOABQABQ
;64    1.000E+04 QbGcRMAiKA@QAfOABQABQ
;64    1.500E+04 XTFRPMaFKAAQAgOABQABQ
;64    2.000E+04 D`FQbMIWJAAQAhOACQACQ
;64    3.000E+04 RCFqCMvBJAAQAhOACQACQ
;64    4.000E+04 a@FABMtTJAAQAhOACQACQ
;64    5.000E+04 gYEx@LsYJAAQAhOACQACQ
;64    6.000E+04 uCEGBLSFJAAQAiOACQACQ
;64    8.000E+04 C@EuHLrGJAAQAiOACQACQ
;64    1.000E+05 QbEtHLAiJAAQAiOACQACQ
;==== ELEMENT  65
;65    1.000E-03 AASUQOrIU@@R@@RBPUrIU
;65    1.114E-03 YhRFPOQdU@@R@@RQeUQdU
;65    1.241E-03 IhRgIOQXU@@R@@RQYUQXU
;65 M5 1.241E-03 IhRgIObHU@@R@@RbIUbHU
;65    1.258E-03 IgRGPOsFU@@R@@RsGUsFU
;65    1.275E-03 IfRWPOTfU@@R@@RTgUTfU
;65 M4 1.275E-03 IfRWPOEgU@@R@@REhUEgU
;65    1.500E-03 iSRYBOuAU@@R@@RuAUuAU
;65    1.611E-03 YQRYaODVU@@R@@RDWUDVU
;65 M3 1.611E-03 YQRYaOUEU@@R@@RUFUUEU
;65    1.688E-03 ITRADPdSU@@R@@RdTUdSU
;65    1.768E-03 yGRQ@PTFU@@R@@RTGUTFU
;65 M2 1.768E-03 yGRQ@PDQU@@R@@RDRUDQU
;65    1.865E-03 iGRQGPSaU@@R@@RSbUSaU
;65    1.967E-03 YFRaDPCWU@@R@@RCXUCWU
;65 M1 1.967E-03 YFRaDPcSU@@R@@RcTUcSU
;65    2.000E-03 YCRaFPSPU@@R@@RSQUSPU
;65    3.000E-03 XCRQcPqEU@@R@@RqEUqEU
;65    4.000E-03 WHRRVPfRT@@R@@RvPTfRT
;65    5.000E-03 vERSEPsWT@@R@@RCdTsWT
;65    6.000E-03 eSRcWPrGT@@R@@RBRTrGT
;65    7.514E-03 tTRtGPqBT@@R@@RqGTqBT
;65 L3 7.514E-03 tTRtGPcQT@@R@@RcVTcQT
;65    8.000E-03 DYRTWPCIT@@R@@RSCTCIT
;65    8.252E-03 tHRdWPBdT@@R@@RBhTBdT
;65 L2 8.252E-03 tHRdWPChT@@R@@RSbTChT
;65    8.477E-03 dGRtVPcST@@R@@RcWTcST
;65    8.708E-03 TGRDePCPT@@R@@RCTTCPT
;65 L1 8.708E-03 TGRDePScT@@R@@RSgTScT
;65    1.000E-02 cVRuBPrXT@@R@@RBbTrXT
;65    1.500E-02 rGRF`PYVS@@R@@RI`SYVS
;65    2.000E-02 aYRGiPDQS@@R@@RTYSDRS
;65    3.000E-02 YeQiCPAUS@@R@@RQVSAVS
;65    4.000E-02 FXQYdPVTR@@R@@RgIRfTR
;65    5.000E-02 TYQACQSPR@@R@@RDFRcPR
;65    5.200E-02 tBQADQSDR@@R@@RcWRcDR
;65 K  5.200E-02 tBQADQqRS@@R@@RqXSqSS
;65    6.000E-02 CUQAEQQHS@@R@@RaBSQIS
;65    8.000E-02 RFQAFQUPR@@R@@REbReQR
;65    1.000E-01 AWQAEQC@R@@R@@RcERSAR
;65    1.500E-01 WGPA@QyYQ@@R@@RQERAHR
;65    2.000E-01 dGPIQPDQQ@@R@@RuWQuEQ
;65    3.000E-01 BAPxIPAVQ@@R@@RRPQr@Q
;65    4.000E-01 QFPgQPFeP@@R@@RQVQAUQ
;65    5.000E-01 WXOG@PSaP@@R@@RQGQAIQ
;65    6.000E-01 uBOVPPRSP@@R@@RYVPICP
;65    8.000E-01 CDOuTPqBP@@R@@RwGPGFP
;65    1.000E+00 QfOUGPhHO@@R@@Rf@PF@P
;65    1.022E+00 AgOUBPWbO@@R@@RV@PUaP
;65    1.250E+00 aFOdSPuDObRN@@RuBPUIP
;65    1.500E+00 xXNdBPCaOaAO@@RDaPtRP
;65    2.000E+00 TeNcPPrAOChO@@RdGPdBP
;65    2.044E+00 tTNSVPbCOTCO@@RdDPTIP
;65    3.000E+00 bANBdPaBOiFOYbLSaPCiP
;65    4.000E+00 aDNrGPHCNqHPDDMCePCdP
;65    5.000E+00 WfMBEPUaNqWPHDMCiPCiP
;65    6.000E+00 URMAaPdUNRAPaCNShPShP
;65    7.000E+00 DFMaRPCbNBPPaVNDIPDHP
;65    8.000E+00 SAMAXPcCNbWPBGNdAPd@P
;65    9.000E+00 BVMqFPB`NRaPBWNtCPtBP
;65    1.000E+01 QiMaFPBWNSCPBdNDUPDUP
;65    1.100E+01 aTMQHPb@NsDPc@NTWPTWP
;65    1.200E+01 qHMQ@PQiNSSPSSNdYPdYP
;65    1.300E+01 QHMADPAaNsQPCeND`PD`P
;65    1.400E+01 ABMIbOaWNCgPTDNTaPTaP
;65    1.500E+01 HeLyCOQTNDBPDSNEBPEBP
;65    1.600E+01 wXLHhOASNTGPdYNUBPUBP
;65    1.800E+01 VDLXBOaENDSPUINu@Pu@P
;65    2.000E+01 ThLGXOQBNdUPeTNEWPEWP
;65    2.200E+01 TALVeOAANDfPFENeSPeSP
;65    2.400E+01 CVLFYOYDMEEPFSNuWPuWP
;65    2.600E+01 RdLV@OxHMeCPvXNUaPUaP
;65    2.800E+01 RTLuVOwTMuHPW@NFDPFDP
;65    3.000E+01 bALEUOWHMUSPGPNVEPVEP
;65    4.000E+01 aDLtCOeIMVCPhSNfUPfUP
;65    5.000E+01 WfKcQOTIMVWPYVNGCPGCP
;65    6.000E+01 USKSAOCVMVaPACOwCPwCP
;65    8.000E+01 SAKBVORWMGRPQDOwXPwXP
;65    1.000E+02 QiKBDOBEMwXPaBOXAPXAP
;65    1.500E+02 HeJAUOqFMxEPqEOhSPhSP
;65    2.000E+02 ThJQDOAAMhYPASOXePXeP
;65    3.000E+02 bAJHGNvSLIHPQSOyBPyBP
;65    4.000E+02 aDJvBNEDLyAPQYOYSPYSP
;65    5.000E+02 WfIeCNDBLIVPaSOiWPiWP
;65    6.000E+02 USIDXNsELYVPaVOyXPyXP
;65    8.000E+02 SAISPNRQLyPPqQOYaPYaP
;65    1.000E+03 QiIBhNBALI`PqSOA@QA@Q
;65    1.500E+03 HeHBANqDLYcPqWOAAQAAQ
;65    2.000E+03 ThHQVNA@LA@QA`OABQABQ
;65    3.000E+03 bAHAHNfXKAAQAbOACQACQ
;65    4.000E+03 aDHxEMEAKAAQAdOACQACQ
;65    5.000E+03 WfGFbMDAKAAQAeOACQACQ
;65    6.000E+03 USGuYMsDKABQAeOADQADQ
;65    8.000E+03 SAGDVMRPKABQAfOADQADQ
;65    1.000E+04 QiGcTMB@KABQAgOADQADQ
;65    1.500E+04 HeFRRMqCKABQAhOADQADQ
;65    2.000E+04 ThFQcMA@KABQAhOADQADQ
;65    3.000E+04 bAFqCMfWJABQAhOADQADQ
;65    4.000E+04 aDFABMEAJACQAiOADQADQ
;65    5.000E+04 WfExDLDAJACQAiOADQADQ
;65    6.000E+04 USEGELsDJACQAiOADQADQ
;65    8.000E+04 SAEEPLRPJACQAiOAEQAEQ
;65    1.000E+05 QiEDPLB@JACQAiOAEQAEQ
;==== ELEMENT  66
;66    1.000E-03 ABSeGOBXU@@R@@RBYUBXU
;66    1.138E-03 AASf@OQdU@@R@@RQeUQdU
;66    1.295E-03 YdRgGOQQU@@R@@RQRUQQU
;66 M5 1.295E-03 YdRgGORAU@@R@@RRBURAU
;66    1.314E-03 YbRGPOSEU@@R@@RSFUSEU
;66    1.333E-03 Y`RWSOdXU@@R@@RdYUdXU
;66 M4 1.333E-03 Y`RWSOUPU@@R@@RUQUUPU
;66    1.500E-03 yTRhWOUTU@@R@@RUUUUTU
;66    1.676E-03 YVRIfOdBU@@R@@RdCUdBU
;66 M3 1.676E-03 YVRIfODhU@@R@@RDiUDhU
;66    1.757E-03 IYRADPtGU@@R@@RtHUtGU
;66    1.842E-03 IQRQ@PSaU@@R@@RSbUSaU
;66 M2 1.842E-03 IQRQ@PTFU@@R@@RTGUTFU
;66    2.000E-03 iDRa@PCVU@@R@@RCWUCVU
;66    2.047E-03 YIRaCPcHU@@R@@RcIUcHU
;66 M1 2.047E-03 YIRaCPCRU@@R@@RCSUCRU
;66    3.000E-03 hERAfPAPU@@R@@RAPUAPU
;66    4.000E-03 w@RBXPFhT@@R@@RVeTFhT
;66    5.000E-03 FVRCEPSbT@@R@@RSiTSbT
;66    6.000E-03 uSRSVPBVT@@R@@RRRTBVT
;66    7.790E-03 dYRtFPaET@@R@@Rq@TaET
;66 L3 7.790E-03 dYRtFPsIT@@R@@RCTTsIT
;66    8.000E-03 TXRDUPcBT@@R@@RcGTcBT
;66    8.581E-03 tARdXPbUT@@R@@RbYTbUT
;66 L2 8.581E-03 tARdXPcST@@R@@RcWTcST
;66    8.810E-03 dARtVPCPT@@R@@RCTTCPT
;66    9.046E-03 TARDePSIT@@R@@RcCTSIT
;66 L1 9.046E-03 TARDePcXT@@R@@RsSTcXT
;66    1.000E-02 sSRUIPBfT@@R@@RR`TBfT
;66    1.500E-02 BQRfWPYbS@@R@@RABTYbS
;66    2.000E-02 qRRwVPTXS@@R@@RtVSTYS
;66    3.000E-02 AARYAPQQS@@R@@RaSSQRS
;66    4.000E-02 fQQIcPFbR@@R@@RWXRVbR
;66    5.000E-02 dXQABQcVR@@R@@RdCRsVR
;66    5.379E-02 TGQACQRhR@@R@@RSPRCHR
;66 K  5.379E-02 TGQACQaRS@@R@@RaXSaSS
;66    6.000E-02 SQQADQaAS@@R@@RaFSaBS
;66    8.000E-02 b@QAEQeYR@@R@@RFARuYR
;66    1.000E-01 QPQAEQSAR@@R@@RsFRcAR
;66    1.500E-01 wAPYbPABR@@R@@RQIRQBR
;66    2.000E-01 tEPyCPTXQ@@R@@RUeQURQ
;66    3.000E-01 BEPxCPQRQ@@R@@RRVQrEQ
;66    4.000E-01 QIPWUPWFP@@R@@RQYQAWQ
;66    5.000E-01 wUOVePDIP@@R@@RQHQQ@Q
;66    6.000E-01 ETOFVPbTP@@R@@RiTPY@P
;66    8.000E-01 S@OuPPqHP@@R@@RwIPGHP
;66    1.000E+00 B@OUDPhWO@@R@@Rf@PF@P
;66    1.022E+00 QbOEHPx@O@@R@@RVAPUaP
;66    1.250E+00 aIOdPPUYObWN@@RuBPUIP
;66    1.500E+00 XgNTIPSiOaDO@@RD`PtQP
;66    2.000E+00 EGNSXPBROSeO@@RdFPdAP
;66    2.044E+00 DeNSSPrDOd@O@@RdDPTIP
;66    3.000E+00 bFNBbPaHOyFOIeLS`PChP
;66    4.000E+00 aGNrEPHPNAPPDAMCePCdP
;66    5.000E+00 XDMBCPVHNqYPWiMS`PCiP
;66    6.000E+00 eUMA`PDfNRBPaCNSiPShP
;66    7.000E+00 TEMaQPSiNBRPaUNT@PDIP
;66    8.000E+00 SHMAWPsHNbYPBFNdAPdAP
;66    9.000E+00 RQMqEPRcNRcPBUNtDPtCP
;66    1.000E+01 BDMaEPRXNSEPBbNDVPDVP
;66    1.100E+01 aXMQGPr@NsFPSGNTXPTXP
;66    1.200E+01 AQMAIPBHNSUPSQNtPPtPP
;66    1.300E+01 a@MACPQ`NsSPCbNDbPDbP
;66    1.400E+01 ADMyUOqTNCiPTANTcPTcP
;66    1.500E+01 IELiFOaQNDEPDPNECPECP
;66    1.600E+01 WeLHbOQPNTIPdVNUDPUCP
;66    1.800E+01 fILHFOqANDUPUENuBPuBP
;66    2.000E+01 EILGSOQGNdXPePNEYPEYP
;66    2.200E+01 dALV`OAENDiPFANeUPeUP
;66    2.400E+01 STLFUOYUMEHPvHNE`PE`P
;66    2.600E+01 CALFFOxUMeFPvSNUdPUdP
;66    2.800E+01 bPLuQOHHMEQPGDNFFPFFP
;66    3.000E+01 bFLEQOWPMUVPwDNVHPVHP
;66    4.000E+01 aGLt@OUSMVFPXWNfXPfXP
;66    5.000E+01 XEKSYOtGMfPPIYNGFPGFP
;66    6.000E+01 eVKCIOcRMVePABOwGPwGP
;66    8.000E+01 SHKBTObYMGVPQCOGbPGbP
;66    1.000E+02 BDKBBORDMGbPaAOXEPXEP
;66    1.500E+02 IEJATOAQMxIPqDOhWPhWP
;66    2.000E+02 EIJQCOAFMxSPAROXiPXiP
;66    3.000E+02 bFJHANGBLYCPQROyFPyFP
;66    4.000E+02 aGJfGNeFLyEPQXOYWPYWP
;66    5.000E+02 XEIe@Nd@LYPPaROyRPyRP
;66    6.000E+02 eVIDUNSPLiQPaUOIbPIbP
;66    8.000E+02 SHICWNbRLyUPaYOYePYeP
;66    1.000E+03 BDIBfNBILIdPqROA@QA@Q
;66    1.500E+03 IEHB@NAPLYgPqVOABQABQ
;66    2.000E+03 EIHQTNAELA@QqXOABQABQ
;66    3.000E+03 bFHAGNVgKAAQA`OACQACQ
;66    4.000E+03 aGHhIMeCKABQAbOADQADQ
;66    5.000E+03 XEGvXMTHKABQAcOADQADQ
;66    6.000E+03 eVGuUMCYKABQAcOADQADQ
;66    8.000E+03 SHGDSMbQKABQAdOADQADQ
;66    1.000E+04 BDGcRMBIKABQAeOADQADQ
;66    1.500E+04 IEFRPMqIKACQAeOAEQAEQ
;66    2.000E+04 EIFQbMAEKACQAfOAEQAEQ
;66    3.000E+04 bFFqBMVgJACQAfOAEQAEQ
;66    4.000E+04 aGFABMeCJACQAgOAEQAEQ
;66    5.000E+04 XEEhHLTHJACQAgOAEQAEQ
;66    6.000E+04 eVEG@LCXJACQAgOAEQAEQ
;66    8.000E+04 SHEuGLbQJACQAgOAEQAEQ
;66    1.000E+05 BDEtGLBIJACQAgOAEQAEQ
;==== ELEMENT  67
;67    1.000E-03 ADSUDObQU@@R@@RbRUbQU
;67    1.162E-03 ABSfBOQeU@@R@@RQfUQeU
;67    1.351E-03 A@SGYOAUU@@R@@RAVUAUU
;67 M5 1.351E-03 A@SGYOBFU@@R@@RBGUBFU
;67    1.371E-03 A@SgROCDU@@R@@RCEUCDU
;67    1.392E-03 YiRwUODXU@@R@@RDYUDXU
;67 M4 1.392E-03 YiRwUOUHU@@R@@RUIUUHU
;67    1.500E-03 IhRHXOEdU@@R@@REeUEdU
;67    1.741E-03 iTRAAPDCU@@R@@RDDUDCU
;67 M3 1.741E-03 iTRAAPdWU@@R@@RdXUdWU
;67    1.830E-03 YURAFPTEU@@R@@RTFUTEU
;67    1.923E-03 IURQCPsPU@@R@@RsPUsPU
;67 M2 1.923E-03 IURQCPScU@@R@@RScUScU
;67    2.000E-03 yGRQHPSXU@@R@@RSYUSXU
;67    2.128E-03 iCRaFPSBU@@R@@RSCUSBU
;67 M1 2.128E-03 iCRaFPcFU@@R@@RcGUcFU
;67    3.000E-03 xFRAcPAVU@@R@@RAVUAVU
;67    4.000E-03 GRRBTPWIT@@R@@RgFTWIT
;67    5.000E-03 VWRC@PT@T@@R@@RTGTT@T
;67    6.000E-03 EdRSQPRXT@@R@@RbTTRXT
;67    8.000E-03 dXRtIPaBT@@R@@RaGTaBT
;67    8.071E-03 dTRDRPa@T@@R@@RaDTa@T
;67 L3 8.071E-03 dTRDRPcDT@@R@@RcHTcDT
;67    8.484E-03 DTRTXPBdT@@R@@RBiTBdT
;67    8.918E-03 dERtUPRPT@@R@@RRTTRPT
;67 L2 8.918E-03 dERtUPCRT@@R@@RCVTCRT
;67    9.153E-03 TERDcPcAT@@R@@RcETcAT
;67    9.394E-03 DERTbPCAT@@R@@RCETCAT
;67 L1 9.394E-03 DERTbPCXT@@R@@RSRTCXT
;67    1.000E-02 CaRUCPRgT@@R@@RCATRgT
;67    1.500E-02 BWRfPPADT@@R@@RAFTADT
;67    2.000E-02 qURgYPD`S@@R@@RThSDaS
;67    3.000E-02 ADRIGPQYS@@R@@RqPSaPS
;67    4.000E-02 vWQyYPWFR@@R@@RWdRgFR
;67    5.000E-02 tYQABQCdR@@R@@RDSRSeR
;67    5.562E-02 DEQACQBeR@@R@@RsFRRfR
;67 K  5.562E-02 DEQACQQTS@@R@@RQYSQUS
;67    6.000E-02 cPQADQaFS@@R@@RqASaGS
;67    8.000E-02 bEQAEQUaR@@R@@RfDRFBR
;67    1.000E-01 QTQADQcCR@@R@@RCYRsDR
;67    1.500E-01 WPPYaPAFR@@R@@RaDRQFR
;67    2.000E-01 DWPyCPD`Q@@R@@RVHQuSQ
;67    3.000E-01 RAPxBPaPQ@@R@@RbTQBSQ
;67    4.000E-01 aBPWUPWRP@@R@@RaSQQQQ
;67    5.000E-01 WfOVdPt@P@@R@@Ra@QQBQ
;67    6.000E-01 UYOFVPrXP@@R@@RI`PiDP
;67    8.000E-01 SIOuPPAVP@@R@@RGXPWFP
;67    1.000E+00 BFOUDPYDO@@R@@RfFPFEP
;67    1.022E+00 QgOEHPxUO@@R@@RVEPUfP
;67    1.250E+00 qCOdPPU`OrTN@@RuEPeBP
;67    1.500E+00 iCNTIPdAOaGO@@RDcPtTP
;67    2.000E+00 eANSXPRUODDO@@RdIPdDP
;67    2.044E+00 TiNSSPBVOt@O@@RdFPdAP
;67    3.000E+00 rBNBbPqDOYTOIeLScPSaP
;67    4.000E+00 qANrEPHdNARPDBMChPCfP
;67    5.000E+00 xHMBCPVQNAbPWiMScPSbP
;67    6.000E+00 EbMA`PUBNRFPaCNDBPDAP
;67    7.000E+00 dHMaQPd@NBVPaUNTCPTCP
;67    8.000E+00 cGMAWPSVNrRPBFNdEPdEP
;67    9.000E+00 RYMqEPCHNRgPBUNtHPtHP
;67    1.000E+01 R@MaEPrQNSIPBbNTPPTPP
;67    1.100E+01 qSMQGPBRNCPPSGNdSPdSP
;67    1.200E+01 AVMAIPRINcPPSQNtUPtUP
;67    1.300E+01 aDMACPQiNsXPCbNDgPDfP
;67    1.400E+01 AGMyVOAcNSdPTANThPThP
;67    1.500E+01 yALiFOaYNT@PtINEIPEIP
;67    1.600E+01 XILHbOQWNdEPdVNUIPUIP
;67    1.800E+01 FWLHFOqHNTQPUENuHPuHP
;67    2.000E+01 eDLGSOaCNtTPePNUUPUUP
;67    2.200E+01 tCLV`OQ@NTePF@NuQPuQP
;67    2.400E+01 cTLFUOA@NUDPvHNEfPEfP
;67    2.600E+01 S@LFFOi@MuBPvRNF@PF@P
;67    2.800E+01 bWLuQOHYMEXPGDNVCPVCP
;67    3.000E+01 rCLEQOGiMeSPwDNfEPfEP
;67    4.000E+01 qALt@OEaMfDPXVNvVPvVP
;67    5.000E+01 xHKSYOdPMfYPIXNWDPWDP
;67    6.000E+01 EbKCIOC`MGDPABOGUPGUP
;67    8.000E+01 cHKBTOBbMWUPQCOWaPWaP
;67    1.000E+02 R@KBBObEMWbPaAOhDPhDP
;67    1.500E+02 yBJATOAYMHYPqDOxWPxWP
;67    2.000E+02 eDJQCOQAMHdPAROIIPIIP
;67    3.000E+02 rCJHANwHLiDPQROIWPIWP
;67    4.000E+02 qAJfHNURLIVPQXOiYPiYP
;67    5.000E+02 xHIe@NDQLiQPaQOIcPIcP
;67    6.000E+02 EbIDUNcWLyRPaTOYcPYcP
;67    8.000E+02 cHICWNrULIfPaXOAAQAAQ
;67    1.000E+03 R@IBfNb@LYfPqQOABQABQ
;67    1.500E+03 yBHB@NAWLAAQqUOACQACQ
;67    2.000E+03 eDHQTNQ@LABQqWOADQADQ
;67    3.000E+03 rCHAGNwBKABQA`OADQADQ
;67    4.000E+03 qAHhIMEYKACQAaOAEQAEQ
;67    5.000E+03 xHGvXMtIKACQAbOAEQAEQ
;67    6.000E+03 EbGuUMcVKACQAcOAEQAEQ
;67    8.000E+03 cHGDSMrUKADQAdOAEQAEQ
;67    1.000E+04 R@GcRMb@KADQAdOAFQAFQ
;67    1.500E+04 yBFRPMAVKADQAeOAFQAFQ
;67    2.000E+04 eDFQbMQ@KADQAeOAFQAFQ
;67    3.000E+04 rCFqCMwBJADQAfOAFQAFQ
;67    4.000E+04 qAFABMEYJADQAfOAFQAFQ
;67    5.000E+04 xHEhHLtIJADQAfOAFQAFQ
;67    6.000E+04 EbEG@LcVJADQAfOAFQAFQ
;67    8.000E+04 cHEuGLrTJADQAfOAFQAFQ
;67    1.000E+05 R@EtGLb@JADQAfOAFQAFQ
;==== ELEMENT  68
;68    1.000E-03 AFSEBOrTU@@R@@RrUUrTU
;68    1.187E-03 ADSfDOQfU@@R@@RQgUQfU
;68    1.409E-03 ABSwPOAPU@@R@@RAQUAPU
;68 M5 1.409E-03 ABSwPOBCU@@R@@RBDUBCU
;68    1.431E-03 ABSGdORfU@@R@@RRgURfU
;68    1.453E-03 AASWiOtBU@@R@@RtCUtBU
;68 M4 1.453E-03 AASWiODfU@@R@@RDgUDfU
;68    1.500E-03 AASx@OFFU@@R@@RFGUFFU
;68    1.812E-03 I`RACPCcU@@R@@RCdUCcU
;68 M3 1.812E-03 I`RACPDTU@@R@@RDUUDTU
;68    2.000E-03 iQRQEPSQU@@R@@RSRUSQU
;68    2.006E-03 iPRQFPCYU@@R@@RSPUCYU
;68 M2 2.006E-03 iPRQFPsQU@@R@@RsRUsQU
;68    2.104E-03 IYRaBPsCU@@R@@RsDUsCU
;68    2.206E-03 yIRaIPRiU@@R@@RC@URiU
;68 M1 2.206E-03 yIRaIPSBU@@R@@RSCUSBU
;68    3.000E-03 hQRqYPQRU@@R@@RQSUQRU
;68    4.000E-03 gVRBPPWQT@@R@@RWYTWQT
;68    5.000E-03 vYRRePdIT@@R@@RtFTdIT
;68    6.000E-03 FDRCVPrPT@@R@@RrVTrPT
;68    8.000E-03 DcRtCPaHT@@R@@RqCTaHT
;68    8.358E-03 dURDXPQDT@@R@@RQITQDT
;68 L3 8.358E-03 dURDXPCHT@@R@@RSCTCHT
;68    8.799E-03 DTRdUPbYT@@R@@RrTTbYT
;68    9.264E-03 dDRDbPrET@@R@@RBPTrFT
;68 L2 9.264E-03 dDRDbPcCT@@R@@RcGTcCT
;68    9.505E-03 TCRT`PCCT@@R@@RCGTCCT
;68    9.751E-03 DCRTiPBeT@@R@@RBiTBeT
;68 L1 9.751E-03 DCRTiPcIT@@R@@RsCTcIT
;68    1.000E-02 SdREGPCIT@@R@@RSCTCIT
;68    1.500E-02 RTRVTPAHT@@R@@RQATAHT
;68    2.000E-02 A`RgSPEBS@@R@@Re@SEBS
;68    3.000E-02 AFRIBPaVS@@R@@RqXSaWS
;68    4.000E-02 VfQyVPWRR@@R@@RxARgRR
;68    5.000E-02 TbQABQDDR@@R@@RdSRTDR
;68    5.749E-02 SeQACQrSR@@R@@RcCRBdR
;68 K  5.749E-02 SeQACQAVS@@R@@RQQSAWS
;68    6.000E-02 cYQADQqAS@@R@@RqFSqBS
;68    8.000E-02 rBQAEQVDR@@R@@RFXRfER
;68    1.000E-01 QXQADQsGR@@R@@RcSRCWR
;68    1.500E-01 wRPYaPQAR@@R@@RaIRaAR
;68    2.000E-01 TYPyCPEBQ@@R@@RFQQUfQ
;68    3.000E-01 RGPxBPaWQ@@R@@RrRQRQQ
;68    4.000E-01 aFPWUPW`P@@R@@RaWQQUQ
;68    5.000E-01 h@OVePTSP@@R@@RaCQQEQ
;68    6.000E-01 uVOFVPRcP@@R@@RYgPyIP
;68    8.000E-01 cIOuPPQTP@@R@@RWWPgDP
;68    1.000E+00 RBOUDPiTO@@R@@RvBPVAP
;68    1.022E+00 BCOEIPiBO@@R@@RfAPFAP
;68    1.250E+00 qGOdPPfBOBbN@@RuIPeEP
;68    1.500E+00 YRNTIPDTOqAO@@RDfPtWP
;68    2.000E+00 uHNSXPbYOTDO@@RtBPdFP
;68    2.044E+00 UENSTPRYODPO@@RdIPdDP
;68    3.000E+00 BPNBbPAQOyROIeLSfPScP
;68    4.000E+00 qENrEPyANATPDBMSaPCiP
;68    5.000E+00 hTMBCPFeNAdPWiMSfPSeP
;68    6.000E+00 F@MA`PuHNRIPaCNDFPDEP
;68    7.000E+00 DQMaRPDRNBYPaUNTGPTGP
;68    8.000E+00 sHMAWPsTNrVPBFNdIPdIP
;68    9.000E+00 bWMqEPcDNCAPBUNDRPDRP
;68    1.000E+01 RFMaEPBeNcDPBbNTUPTUP
;68    1.100E+01 qYMQGPRUNCUPSHNdXPdWP
;68    1.200E+01 QPMQ@Pr@NcTPSQND`PD`P
;68    1.300E+01 aHMACPR@NCcPCbNTbPTbP
;68    1.400E+01 Q@MyVOQbND@PTBNECPECP
;68    1.500E+01 iQLiGOqXNTEPDPNUDPUDP
;68    1.600E+01 HTLHbOaUNt@PdVNeEPeDP
;68    1.800E+01 fWLHGOAUNTWPUENETPETP
;68    2.000E+01 EPLGTOaIND`PePNeQPeQP
;68    2.200E+01 DWLVaOQFNEBPFANuXPuXP
;68    2.400E+01 sULFVOAENeAPvHNUcPUcP
;68    2.600E+01 c@LFFOiWMuIPvSNFGPFGP
;68    2.800E+01 rVLuROXcMUUPGDNf@Pf@P
;68    3.000E+01 BPLEROhIMuPPwDNvCPvCP
;68    4.000E+01 qELt@OV@MvBPXVNFdPFdP
;68    5.000E+01 hUKSYODcMvWPIXNgCPgCP
;68    6.000E+01 FAKS@OSiMWCPABOWTPWTP
;68    8.000E+01 sHKBTORgMgUPQCOHAPHAP
;68    1.000E+02 RFKBCOrFMHBPaAOxDPxDP
;68    1.500E+02 iQJATOQVMhPPqDOHhPHhP
;68    2.000E+02 EPJQCOQGMXePAROi@Pi@P
;68    3.000E+02 BPJHBNwULyEPQQOYXPYXP
;68    4.000E+02 qEJfHNE`LYXPQWOI`PI`P
;68    5.000E+02 hUIe@NdSLySPaQOYePYeP
;68    6.000E+02 FAIDUNCfLIdPaTOA@QA@Q
;68    8.000E+02 sHICXNBiLYhPaXOABQABQ
;68    1.000E+03 RFIBfNrALAAQqQOACQACQ
;68    1.500E+03 iQHB@NQTLABQqUOADQADQ
;68    2.000E+03 EPHQUNQELACQqWOAEQAEQ
;68    3.000E+03 BPHAHNgYKADQqYOAFQAFQ
;68    4.000E+03 qEHx@MuWKADQAaOAFQAFQ
;68    5.000E+03 hUGvXMdRKADQAbOAFQAFQ
;68    6.000E+03 FAGuUMCeKADQAbOAFQAFQ
;68    8.000E+03 sHGDSMBhKAEQAcOAGQAGQ
;68    1.000E+04 RFGcRMrAKAEQAdOAGQAGQ
;68    1.500E+04 iQFRPMQTKAEQAdOAGQAGQ
;68    2.000E+04 EPFQbMQEKAEQAeOAGQAGQ
;68    3.000E+04 BPFqCMgYJAEQAeOAGQAGQ
;68    4.000E+04 qEFABMuWJAEQAeOAGQAGQ
;68    5.000E+04 hUEhILdQJAEQAfOAGQAGQ
;68    6.000E+04 FAEGALCeJAEQAfOAGQAGQ
;68    8.000E+04 sHEuGLBhJAEQAfOAGQAGQ
;68    1.000E+05 RFEtGLrAJAFQAfOAGQAGQ
;==== ELEMENT  69
;69    1.000E-03 AHSTbOBiU@@R@@RR`UBiU
;69    1.211E-03 AFSfFOQhU@@R@@RQiUQhU
;69    1.468E-03 ADSWdOqEU@@R@@RqFUqEU
;69 M5 1.468E-03 ADSWdOAdU@@R@@RAfUAdU
;69    1.500E-03 ACSXEOSbU@@R@@RSdUSbU
;69    1.515E-03 ACShDOTDU@@R@@RTEUTDU
;69 M4 1.515E-03 ACShDODbU@@R@@RDcUDbU
;69    1.689E-03 AASyEOd@U@@R@@RdAUd@U
;69    1.885E-03 YeRAFPcVU@@R@@RcWUcVU
;69 M3 1.885E-03 YeRAFPdDU@@R@@RdEUdDU
;69    2.000E-03 IcRQCPcXU@@R@@RcYUcXU
;69    2.090E-03 yTRQIPsBU@@R@@RsCUsBU
;69 M2 2.090E-03 yTRQIPSRU@@R@@RSSUSRU
;69    2.196E-03 iSRaFPSEU@@R@@RSFUSEU
;69    2.307E-03 YQRqCPBaU@@R@@RBbUBaU
;69 M1 2.307E-03 YQRqCPRdU@@R@@RReURdU
;69    3.000E-03 HcRqWPQXU@@R@@RQYUQXU
;69    4.000E-03 GgRrGPGgT@@R@@RWeTGgT
;69    5.000E-03 ViRRbPTPT@@R@@RTWTTPT
;69    6.000E-03 fBRCRPBcT@@R@@RBiTBcT
;69    8.000E-03 ThRt@PqET@@R@@RAPTqET
;69    8.648E-03 dURTUPQ@T@@R@@RQETQ@T
;69 L3 8.648E-03 dURTUPRdT@@R@@RRiTRdT
;69    9.120E-03 DSRtRPRVT@@R@@RbQTRVT
;69    9.617E-03 dBRT`PbCT@@R@@RbGTbCT
;69 L2 9.617E-03 dBRT`PCFT@@R@@RS@TCFT
;69    1.000E-02 DFRECPrYT@@R@@RBcTrYT
;69    1.012E-02 DAREGPrPT@@R@@RrTTrPT
;69 L1 1.012E-02 DAREGPSCT@@R@@RSGTSCT
;69    1.500E-02 bRRVPPQCT@@R@@RQFTQCT
;69    2.000E-02 AeRgPPeFS@@R@@REUSeGS
;69    3.000E-02 Q@RI@PqUS@@R@@RAgSqVS
;69    4.000E-02 WGQyVPWbR@@R@@RxTRHBR
;69    5.000E-02 EGQABQdFR@@R@@RDgRtFR
;69    5.939E-02 CfQADQbSR@@R@@RSBRrTR
;69 K  5.939E-02 CfQADQAQS@@R@@RAVSARS
;69    6.000E-02 C`QADQqFS@@R@@RAQSqGS
;69    8.000E-02 rIQAEQFPR@@R@@RvTRVPR
;69    1.000E-01 aSQAEQSQR@@R@@RsXRcRR
;69    1.500E-01 WfPYdPQFR@@R@@RqDRaFR
;69    2.000E-01 tTPyFPeGQ@@R@@RfXQfAQ
;69    3.000E-01 bDPxFPqVQ@@R@@RBbQbPQ
;69    4.000E-01 q@PWYPxCP@@R@@RqRQQYQ
;69    5.000E-01 HWOVhPtXP@@R@@RaFQQHQ
;69    6.000E-01 UeOFYPS@P@@R@@RABQYXP
;69    8.000E-01 CPOuSPaRP@@R@@RgYPwEP
;69    1.000E+00 RIOUGPABP@@R@@RFPPVHP
;69    1.022E+00 R@OUAPyUO@@R@@Rv@PFIP
;69    1.250E+00 AQOdSPVWOR`N@@REUPuAP
;69    1.500E+00 IeNdAPdYOqEO@@RTaPDaP
;69    2.000E+00 UVNcPPBdOdEO@@RtFPtAP
;69    2.044E+00 uBNSUPrTOTRO@@RtCPdHP
;69    3.000E+00 BXNBcPAYOYdOY`LD@PShP
;69    4.000E+00 APNrFPIcNAWPDDMSePSdP
;69    5.000E+00 XdMBDPgCNAhPHCMDAPD@P
;69    6.000E+00 fAMAaPeXNbCPaCNTAPT@P
;69    7.000E+00 TVMaRPdVNRTPaVNdCPdBP
;69    8.000E+00 CYMAXPSeNBaPBGNtEPtEP
;69    9.000E+00 rVMqFPCRNCFPBVNDXPDXP
;69    1.000E+01 bDMaFPCANcIPBdNdQPdQP
;69    1.100E+01 AeMQGPbYNSQPSINtTPtTP
;69    1.200E+01 QUMQ@PBSNsPPSRNDgPDfP
;69    1.300E+01 qBMADPbANCiPCdNTiPTiP
;69    1.400E+01 QDMIaOBCNDFPTCNUAPUAP
;69    1.500E+01 YdLyAOAhNdBPDQNeBPeAP
;69    1.600E+01 xSLHgOqTNtGPdXNuBPuBP
;69    1.800E+01 V`LXAOQSNdTPUGNURPURP
;69    2.000E+01 UYLGXOqFNDhPeRNuPPuPP
;69    2.200E+01 dRLVdOaBNU@PFCNEfPEfP
;69    2.400E+01 ChLFYOQANu@PFQNFBPFBP
;69    2.600E+01 sALFIOABNEXPvUNVFPVFP
;69    2.800E+01 BeLuUOIQMeTPGGNv@Pv@P
;69    3.000E+01 BXLETOxTME`PwGNFRPFRP
;69    4.000E+01 APLtBOFSMFRPXYNVePVdP
;69    5.000E+01 XdKcQOEIMFhPYRNwEPwDP
;69    6.000E+01 fAKSAOdAMgDPABOgVPgVP
;69    8.000E+01 CYKBUOSCMwWPQCOXDPXDP
;69    1.000E+02 bDKBDOBYMXEPaAOHXPHXP
;69    1.500E+02 YdJAUOaUMxTPqDOIBPIBP
;69    2.000E+02 UYJQDOaCMIIPAROyEPyEP
;69    3.000E+02 BXJHFNXFLYPPQROySPySP
;69    4.000E+02 APJvANVALySPQXOYePYeP
;69    5.000E+02 XdIeBNDhLIiPaROAAQAAQ
;69    6.000E+02 fAIDWNDGLA@QaTOABQABQ
;69    8.000E+02 CYICYNCELAAQaXOACQACQ
;69    1.000E+03 bDIBgNBTLABQqQOADQADQ
;69    1.500E+03 YdHBANaRLADQqUOAFQAFQ
;69    2.000E+03 UYHQUNaBLADQqWOAFQAFQ
;69    3.000E+03 BXHAHNXAKAEQA`OAGQAGQ
;69    4.000E+03 APHxCMFHKAFQAaOAHQAHQ
;69    5.000E+03 XdGFbMDfKAFQAbOAHQAHQ
;69    6.000E+03 fAGuXMDEKAFQAcOAHQAHQ
;69    8.000E+03 CYGDUMCDKAFQAcOAHQAHQ
;69    1.000E+04 bDGcTMBSKAGQAdOAHQAHQ
;69    1.500E+04 YdFRQMaRKAGQAeOAIQAIQ
;69    2.000E+04 UYFQcMaBKAGQAeOAIQAIQ
;69    3.000E+04 BXFqCMX@JAGQAeOAIQAIQ
;69    4.000E+04 APFABMFGJAGQAfOAIQAIQ
;69    5.000E+04 XdExCLDfJAGQAfOAIQAIQ
;69    6.000E+04 fAEGDLDEJAGQAfOAIQAIQ
;69    8.000E+04 CYEEPLCDJAGQAfOAIQAIQ
;69    1.000E+05 bDEtILBSJAGQAfOAIQAIQ
;==== ELEMENT  70
;70    1.000E-03 AHStUOCAU@@R@@RCBUCAU
;70    1.500E-03 ADSW`OqDU@@R@@RqEUqDU
;70    1.528E-03 ADSHGOaIU@@R@@Rq@UaIU
;70 M5 1.528E-03 ADSHGOQdU@@R@@RQeUQdU
;70    1.552E-03 ACShBOrUU@@R@@RrVUrUU
;70    1.576E-03 ACSxGOCiU@@R@@RS`UCiU
;70 M4 1.576E-03 ACSxGOTSU@@R@@RTTUTSU
;70    1.753E-03 AASIWOSgU@@R@@RShUSgU
;70    1.950E-03 YfRAGPCYU@@R@@RSPUCYU
;70 M3 1.950E-03 YfRAGPDDU@@R@@RDEUDDU
;70    2.000E-03 YaRQ@PsYU@@R@@RC`UsYU
;70    2.173E-03 ySRaAPSBU@@R@@RSCUSBU
;70 M2 2.173E-03 ySRaAPsAU@@R@@RsBUsAU
;70    2.283E-03 iRRaHPRfU@@R@@RRgURfU
;70    2.398E-03 YQRqEPbTU@@R@@RbUUbTU
;70 M1 2.398E-03 YQRqEPrVU@@R@@RrWUrVU
;70    3.000E-03 XcRqRPaSU@@R@@RaTUaSU
;70    4.000E-03 WfRr@PXAT@@R@@RXITXAT
;70    5.000E-03 GIRBePdUT@@R@@RtRTdUT
;70    6.000E-03 vARsDPRbT@@R@@RRiTRbT
;70    8.000E-03 EFRd@PqIT@@R@@RATTqIT
;70    8.944E-03 TYRTUPADT@@R@@RAITADT
;70 L3 8.944E-03 TYRTUPrXT@@R@@RBbTrXT
;70    9.447E-03 tDRtQPBQT@@R@@RBUTBQT
;70    9.978E-03 TCRTaPBIT@@R@@RRCTBIT
;70 L2 9.978E-03 TCRTaPRdT@@R@@RRhTRdT
;70    1.000E-02 TCRTbPR`T@@R@@RRdTR`T
;70    1.049E-02 SdREHPRTT@@R@@RRXTRTT
;70 L1 1.049E-02 SdREHPRcT@@R@@RRgTRcT
;70    1.500E-02 bVRvGPQGT@@R@@RQITQGT
;70    2.000E-02 AhRGVPESS@@R@@ReSSETS
;70    3.000E-02 QARHfPAaS@@R@@RQcSAbS
;70    4.000E-02 gHQiRPhBR@@R@@RIDRxAR
;70    5.000E-02 UEQA@QDRR@@R@@REDRTRR
;70    6.000E-02 CfQACQbVR@@R@@RSERrVR
;70    6.133E-02 sSQACQRPR@@R@@RRhRbPR
;70 K  6.133E-02 sSQACQqBS@@R@@RqGSqCS
;70    8.000E-02 BRQADQVVR@@R@@RVaRfWR
;70    1.000E-01 aVQACQcQR@@R@@RChRsRR
;70    1.500E-01 HIPIdPa@R@@R@@RqHRq@R
;70    2.000E-01 DbPiFPEUQ@@R@@RFfQvHQ
;70    3.000E-01 bHPhGPAcQ@@R@@RBhQbUQ
;70    4.000E-01 qBPWQPhUP@@R@@RqUQaRQ
;70    5.000E-01 hSOVaPTgP@@R@@RaGQQIQ
;70    6.000E-01 FGOFRPcBP@@R@@RACQiUP
;70    8.000E-01 CVOeWPaYP@@R@@RwQPwFP
;70    1.000E+00 bCOUAPAFP@@R@@RFPPVGP
;70    1.022E+00 RDOEFPABP@@R@@RfIPFHP
;70    1.250E+00 ATOTXPFeOReN@@RETPeIP
;70    1.500E+00 A@OTGPDiOqGO@@RT`PtYP
;70    2.000E+00 eWNSVPRfOtAO@@RtEPdIP
;70    2.044E+00 ESNSRPBfOTXO@@RtBPdFP
;70    3.000E+00 RSNBaPQVOA@PIaLSiPSfP
;70    4.000E+00 ARNrDPABOAXPD@MSdPScP
;70    5.000E+00 YAMBBPWRNAiPWeMD@PSiP
;70    6.000E+00 vCMqYPUaNbDPaBNT@PT@P
;70    7.000E+00 dUMaQPDeNRTPaTNdBPdBP
;70    8.000E+00 SVMAVPT@NBbPBENtEPtDP
;70    9.000E+00 BaMqDPSUNCGPBTNDXPDXP
;70    1.000E+01 bHMaEPSCNs@PBaNdQPdQP
;70    1.100E+01 AhMQFPrYNSRPSFNtTPtTP
;70    1.200E+01 QXMAIPRRNsQPCYNDgPDfP
;70    1.300E+01 qEMACPr@NS`PC`NTiPTiP
;70    1.400E+01 QFMyQORANDGPDINUAPUAP
;70    1.500E+01 AAMiBOQeNdCPtGNeBPeBP
;70    1.600E+01 XaLxXOAaNtHPdSNuCPuBP
;70    1.800E+01 GDLHCOQYNdUPUBNURPURP
;70    2.000E+01 uPLGPOAQNDiPUVNuPPuPP
;70    2.200E+01 tQLFhOaGNUAPUgNEgPEgP
;70    2.400E+01 SfLFROQFNu@PvDNFBPFBP
;70    2.600E+01 sGLFCOAFNEYPfXNVGPVGP
;70    2.800E+01 RaLeYOyWMeUPG@Nv@Pv@P
;70    3.000E+01 RSLuIOIGME`PgINFSPFSP
;70    4.000E+01 ARLdHOfXMFSPXQNVePVeP
;70    5.000E+01 YBKSWOeHMFiPIRNwEPwEP
;70    6.000E+01 vCKCHOtGMgFPAAOgWPgWP
;70    8.000E+01 SVKBSOcEMwYPQBOXDPXDP
;70    1.000E+02 bHKBBORXMXFPa@OHYPHYP
;70    1.500E+02 AAKATOqQMxUPqCOICPICP
;70    2.000E+02 uPJQCOaHMY@PAPOyFPyFP
;70    3.000E+02 RSJWhNHWLYQPQPOyTPyTP
;70    4.000E+02 ARJfENvDLyTPQVOYfPYfP
;70    5.000E+02 YBIUGNEGLY`PaPOAAQAAQ
;70    6.000E+02 vCIDSNdBLA@QaROABQABQ
;70    8.000E+02 SVICVNSFLABQaVOADQADQ
;70    1.000E+03 bHIBeNRSLABQaYOADQADQ
;70    1.500E+03 AAIQiNaXLADQqSOAFQAFQ
;70    2.000E+03 uPHQTNaFLAEQqUOAFQAFQ
;70    3.000E+03 RSHAGNHRKAEQqWOAGQAGQ
;70    4.000E+03 ARHhFMvAKAFQqYOAHQAHQ
;70    5.000E+03 YBGvUMEEKAFQA`OAHQAHQ
;70    6.000E+03 vCGuRMdAKAFQA`OAHQAHQ
;70    8.000E+03 SVGDQMSEKAFQAaOAHQAHQ
;70    1.000E+04 bHGcPMRRKAGQAbOAIQAIQ
;70    1.500E+04 AAGBYMaXKAGQAbOAIQAIQ
;70    2.000E+04 uPFQaMaFKAGQAcOAIQAIQ
;70    3.000E+04 RSFqBMHQJAGQAcOAIQAIQ
;70    4.000E+04 ARFAAMvAJAGQAcOAIQAIQ
;70    5.000E+04 YBEhELEEJAGQAcOAIQAIQ
;70    6.000E+04 vCEVgLd@JAGQAdOAIQAIQ
;70    8.000E+04 SVEuELSEJAGQAdOAIQAIQ
;70    1.000E+05 bHEtELRRJAGQAdOAIQAIQ
;==== ELEMENT  71
;71    1.000E-03 Q@StTOSHU@@R@@RSIUSHU
;71    1.500E-03 AFSWeOAQU@@R@@RARUAQU
;71    1.588E-03 AESXROaEU@@R@@RaFUaEU
;71 M5 1.588E-03 AESXROQVU@@R@@RQWUQVU
;71    1.614E-03 ADShWOr@U@@R@@RrAUr@U
;71    1.639E-03 ADSHcOCPU@@R@@RCQUCPU
;71 M4 1.639E-03 ADSHcOCiU@@R@@RS`UCiU
;71    2.000E-03 AASQ@PCTU@@R@@RCUUCTU
;71    2.024E-03 A@SQBPsDU@@R@@RsEUsDU
;71 M3 2.024E-03 A@SQBPChU@@R@@RCiUChU
;71    2.140E-03 YaRQIPsIU@@R@@RCPUsIU
;71    2.263E-03 yYRaGPRfU@@R@@RRgURfU
;71 M2 2.263E-03 yYRaGPSEU@@R@@RSFUSEU
;71    2.375E-03 iYRqDPBbU@@R@@RBcUBbU
;71    2.491E-03 YXRAQPRRU@@R@@RRSURRU
;71 M1 2.491E-03 YXRAQPbSU@@R@@RbTUbSU
;71    3.000E-03 IFRqQPqPU@@R@@RqQUqPU
;71    4.000E-03 X@RbIPHXT@@R@@RXVTHXT
;71    5.000E-03 gBRBcPDfT@@R@@RTdTDfT
;71    6.000E-03 FTRsBPCFT@@R@@RSCTCFT
;71    8.000E-03 UHRTHPAVT@@R@@RQQTAVT
;71    9.244E-03 TVRdUPA@T@@R@@RAETA@T
;71 L3 9.244E-03 TVRdUPbVT@@R@@RrPTbVT
;71    1.000E-02 dCRTaPRGT@@R@@RbATRGT
;71    1.035E-02 DIRECPQhT@@R@@RBBTQhT
;71 L2 1.035E-02 DIRECPrRT@@R@@RrVTrRT
;71    1.061E-02 SiRUAPRVT@@R@@RbPTRVT
;71    1.087E-02 CiRUIPBQT@@R@@RBUTBQT
;71 L1 1.087E-02 CiRUIPrYT@@R@@RBcTrYT
;71    1.500E-02 rSRvEPaBT@@R@@RaETaBT
;71    2.000E-02 QcRGSPeXS@@R@@REhSeYS
;71    3.000E-02 QDRHdPQ`S@@R@@RBBSQaS
;71    4.000E-02 GXQiQPhSR@@R@@RIWRxRR
;71    5.000E-02 eIQA@QdUR@@R@@ReHRtUR
;71    6.000E-02 SfQACQB`R@@R@@Rs@RR`R
;71    6.331E-02 cSQACQBQR@@R@@RBgRRQR
;71 K  6.331E-02 cSQACQaFS@@R@@RqASaGS
;71    8.000E-02 BYQADQFaR@@R@@RWFRVaR
;71    1.000E-01 qPQACQsVR@@R@@RDCRCfR
;71    1.500E-01 xBPIePaER@@R@@RASRqER
;71    2.000E-01 TfPiHPuQQ@@R@@RWCQfSQ
;71    3.000E-01 rEPhIPQbQ@@R@@RRhQrUQ
;71    4.000E-01 qFPWSPIIP@@R@@RA`QaVQ
;71    5.000E-01 HiOVcPeCP@@R@@Rq@QaBQ
;71    6.000E-01 fEOFTPsIP@@R@@RAEQIdP
;71    8.000E-01 SWOeYPqXP@@R@@RGcPGWP
;71    1.000E+00 r@OUCPQBP@@R@@RFXPfEP
;71    1.022E+00 bAOEHPAGP@@R@@RvGPVEP
;71    1.250E+00 AXOTYPgBOCCN@@RUPPuEP
;71    1.500E+00 ACOTHPUEOAQO@@RTdPDdP
;71    2.000E+00 EdNSWPSBODRO@@RtIPtCP
;71    2.044E+00 ePNSSPCAOdYO@@RtEPt@P
;71    3.000E+00 bQNBaPaTOABPIdLDCPD@P
;71    4.000E+00 AWNrEPAHOQQPDAMShPSgP
;71    5.000E+00 IPMBCPWbNQbPWhMDEPDDP
;71    6.000E+00 VSMqYPfBNbGPaBNTEPTDP
;71    7.000E+00 D`MaQPU@NRXPaUNdGPdFP
;71    8.000E+00 cWMAWPtBNBfPBFNDPPtIP
;71    9.000E+00 R`MqEPsSNSBPBUNTSPTSP
;71    1.000E+01 rEMaEPcINsEPBbNdVPdVP
;71    1.100E+01 QdMQGPRdNSWPSGNtYPtYP
;71    1.200E+01 aSMAIPbUNsWPSPNTcPTbP
;71    1.300E+01 qIMACPBRNSePCaNEEPEEP
;71    1.400E+01 a@MyTObBNTCPT@NUGPUGP
;71    1.500E+01 ADMiEOBENdIPtHNeHPeHP
;71    1.600E+01 YILHaOQ`NDTPdUNuIPuIP
;71    1.800E+01 gFLHEOaWNtRPUDNUYPUYP
;71    2.000E+01 EhLGROAXNTfPUXNuWPuWP
;71    2.200E+01 DfLV`OqDNUHPUiNUdPUdP
;71    2.400E+01 DHLFTOaANuHPvFNV@PV@P
;71    2.600E+01 CXLFEOQANUWPvPNfEPfEP
;71    2.800E+01 C@LuQOACNuSPGBNvIPvIP
;71    3.000E+01 bQLEQOYTMEiPwANVQPVQP
;71    4.000E+01 AWLt@OGBMVRPXSNGDPGDP
;71    5.000E+01 IQKSYOUUMViPITNGUPGUP
;71    6.000E+01 VSKCIOTYMwFPABOwWPwWP
;71    8.000E+01 cXKBTOCQMW`PQBOhFPhFP
;71    1.000E+02 rEKBBOrQMhHPa@OhPPhPP
;71    1.500E+02 AEKATOqYMHhPqCOYFPYFP
;71    2.000E+02 EhJQCOqDMiCPAQOIYPIYP
;71    3.000E+02 bQJHANX`LiTPQPOIhPIhP
;71    4.000E+02 AWJfGNfVLIhPQVOAAQAAQ
;71    5.000E+02 IQIUINuBLA@QaPOABQABQ
;71    6.000E+02 VSIDTNDSLAAQaSOADQADQ
;71    8.000E+02 cXICWNsBLACQaWOAEQAEQ
;71    1.000E+03 rEIBeNbVLADQaYOAFQAFQ
;71    1.500E+03 AEIQiNqWLAEQqSOAGQAGQ
;71    2.000E+03 EhHQTNqCLAFQqUOAHQAHQ
;71    3.000E+03 bQHAGNHdKAGQqXOAIQAIQ
;71    4.000E+03 AWHhHMfSKAGQqYOAIQAIQ
;71    5.000E+03 IQGvWMu@KAHQA`OAIQAIQ
;71    6.000E+03 VSGuTMDRKAHQA`OQ@QQ@Q
;71    8.000E+03 cXGDRMsAKAHQAaOQ@QQ@Q
;71    1.000E+04 rEGcQMbUKAHQAbOQ@QQ@Q
;71    1.500E+04 AEGRPMqWKAHQAbOQ@QQ@Q
;71    2.000E+04 EhFQbMqCKAHQAcOQ@QQ@Q
;71    3.000E+04 bQFqBMHdJAIQAcOQ@QQ@Q
;71    4.000E+04 AWFABMfSJAIQAcOQ@QQ@Q
;71    5.000E+04 IQEhGLu@JAIQAdOQAQQAQ
;71    6.000E+04 VSEViLDRJAIQAdOQAQQAQ
;71    8.000E+04 cXEuFLsAJAIQAdOQAQQAQ
;71    1.000E+05 rEEtFLbUJAIQAdOQAQQAQ
;==== ELEMENT  72
;72    1.000E-03 QASdROsBU@@R@@RsDUsBU
;72    1.500E-03 AGSGdOAXU@@R@@RAYUAXU
;72    1.662E-03 AESHeOQIU@@R@@Ra@UQIU
;72 M5 1.662E-03 AESHeOAXU@@R@@RAYUAXU
;72    1.689E-03 AESIBORHU@@R@@RRIURHU
;72    1.716E-03 ADSYIOcBU@@R@@RcCUcBU
;72 M4 1.716E-03 ADSYIOcSU@@R@@RcTUcSU
;72    2.000E-03 AASAIPSYU@@R@@RcPUSYU
;72    2.108E-03 A@SQFPSDU@@R@@RSEUSDU
;72 M3 2.108E-03 A@SQFPcUU@@R@@RcVUcUU
;72    2.233E-03 IiRaCPSGU@@R@@RSHUSGU
;72    2.365E-03 yVRqAPrVU@@R@@RrWUrVU
;72 M2 2.365E-03 yVRqAPRcU@@R@@RRdURcU
;72    2.480E-03 iURqHPbSU@@R@@RbTUbSU
;72    2.601E-03 YSRAUPrEU@@R@@RrFUrEU
;72 M1 2.601E-03 YSRAUPBVU@@R@@RBWUBVU
;72    3.000E-03 YBRaYPqVU@@R@@RqWUqVU
;72    4.000E-03 XFRbFPxXT@@R@@RHfTxXT
;72    5.000E-03 gHRrYPEDT@@R@@RUATEDT
;72    6.000E-03 VQRcHPSHT@@R@@RcDTSHT
;72    8.000E-03 eDRTDPQRT@@R@@RQWTQRT
;72    9.561E-03 DXRtQPYTS@@R@@RA@TYUS
;72 L3 9.561E-03 DXRtQPRQT@@R@@RRVTRQT
;72    1.000E-02 dIRDfPbFT@@R@@Rr@TbFT
;72    1.074E-02 D@REIPAeT@@R@@RAiTAeT
;72 L2 1.074E-02 D@REIPRUT@@R@@RRYTRUT
;72    1.100E-02 S`RUHPBPT@@R@@RBTTBPT
;72    1.127E-02 CaReFPbGT@@R@@RrATbGT
;72 L1 1.127E-02 CaReFPbRT@@R@@RbVTbRT
;72    1.500E-02 rWRfHPaFT@@R@@RaITaFT
;72    2.000E-02 QfRwDPEhS@@R@@RFISEiS
;72    3.000E-02 QFRxUPQgS@@R@@RR@SQhS
;72    4.000E-02 gPQYRPXgR@@R@@RIcRIGR
;72    5.000E-02 uGQYePDdR@@R@@REXRTdR
;72    6.000E-02 DCQABQRbR@@R@@RCRRCBR
;72    6.535E-02 SRQACQr@R@@R@@RrURBPR
;72 K  6.535E-02 SRQACQQIS@@R@@RaDSa@S
;72    8.000E-02 RSQACQViR@@R@@RwERW@R
;72    1.000E-01 qSQACQChR@@R@@RTERShR
;72    1.500E-01 HXPyXPaIR@@R@@RAXRqIR
;72    2.000E-01 EEPiBPUaQ@@R@@RwDQFcQ
;72    3.000E-01 rIPhDPQiQ@@R@@RCEQBbQ
;72    4.000E-01 qIPGXPIVP@@R@@RAcQaYQ
;72    5.000E-01 IGOFiPEUP@@R@@RqBQaCQ
;72    6.000E-01 vHOFPPSTP@@R@@RAFQYdP
;72    8.000E-01 cTOeUPAfP@@R@@RGhPWRP
;72    1.000E+00 rEOU@PQGP@@R@@RVPPfGP
;72    1.022E+00 bEOEDPQBP@@R@@RvIPVFP
;72    1.250E+00 QROTWPWTOCIN@@RUPPuEP
;72    1.500E+00 AFOTFPuGOATO@@RTdPDdP
;72    2.000E+00 UgNSUPcFODYO@@RtIPtCP
;72    2.044E+00 uRNSQPSDOtWO@@RtFPt@P
;72    3.000E+00 bVNB`PqQOACPyXLDCPD@P
;72    4.000E+00 QPNrCPQBOQRPShMSiPSgP
;72    5.000E+00 iQMBBPhFNQcPWcMDEPDDP
;72    6.000E+00 fWMqXPFXNbIPaBNTEPTEP
;72    7.000E+00 T`MaPPuBNbPPaTNdHPdGP
;72    8.000E+00 sVMAVPTPNBhPBDNDQPDQP
;72    9.000E+00 RgMqDPCiNSDPBSNTTPTTP
;72    1.000E+01 BPMaDPCSNsGPB`NdXPdXP
;72    1.100E+01 QiMQFPCFNSYPSENDaPDaP
;72    1.200E+01 aWMAIPrVNsYPCXNTdPTdP
;72    1.300E+01 ARMABPRRNShPsYNEGPEFP
;72    1.400E+01 aCMiYOrANTEPDHNUIPUIP
;72    1.500E+01 AGMi@ORCNtBPtFNu@Pu@P
;72    1.600E+01 yILxVOQhNDWPdRNEQPEQP
;72    1.800E+01 GRLH@OqTNtTPU@NeQPeQP
;72    2.000E+01 FALwHOQTNTiPUTNE`PE`P
;72    2.200E+01 TgLFfOqINeAPUeNUgPUgP
;72    2.400E+01 TGLFQOaFNEQPvBNVCPVBP
;72    2.600E+01 SVLFBOQFNUYPfVNfGPfGP
;72    2.800E+01 CGLeWOAGNuVPVgNFQPFQP
;72    3.000E+01 bWLuGOYcMUbPgFNVTPVTP
;72    4.000E+01 QPLdGOwAMVVPHWNGGPGGP
;72    5.000E+01 iRKSWOuXMGCPyGNGXPGXP
;72    6.000E+01 fXKCGOtXMGPPAAOGaPGaP
;72    8.000E+01 sVKBROSUMWdPQBOhIPhIP
;72    1.000E+02 BPKBAOBbMxBPQIOhTPhTP
;72    1.500E+02 AGKASOAgMXbPqBOYIPYIP
;72    2.000E+02 FAJQBOAPMiGPAPOYSPYSP
;72    3.000E+02 bWJWfNiFLiYPAYOYbPYbP
;72    4.000E+02 QPJfCNVdLYcPQUOAAQAAQ
;72    5.000E+02 iQIUFNUTLAAQQYOACQACQ
;72    6.000E+02 fXIDRNdRLABQaQOADQADQ
;72    8.000E+02 sVICUNCVLACQaUOAEQAEQ
;72    1.000E+03 BPIBdNrVLADQaXOAFQAFQ
;72    1.500E+03 AGIQhNAdLAFQqROAHQAHQ
;72    2.000E+03 FAHQSNqHLAFQqTOAHQAHQ
;72    3.000E+03 bWHAGNi@KAGQqVOAIQAIQ
;72    4.000E+03 QPHhCMV`KAHQqXOQ@QQ@Q
;72    5.000E+03 iQGvSMURKAHQqXOQ@QQ@Q
;72    6.000E+03 fXGuQMdPKAHQqYOQ@QQ@Q
;72    8.000E+03 sVGDPMCUKAHQA`OQ@QQ@Q
;72    1.000E+04 BPGSYMrVKAIQA`OQ@QQ@Q
;72    1.500E+04 AGGBXMAdKAIQAaOQAQQAQ
;72    2.000E+04 FAFQaMqHKAIQAaOQAQQAQ
;72    3.000E+04 bWFqBMYIJAIQAbOQAQQAQ
;72    4.000E+04 QPFAAMV`JAIQAbOQAQQAQ
;72    5.000E+04 iQEhCLURJAIQAbOQAQQAQ
;72    6.000E+04 fXEVeLdPJAIQAbOQAQQAQ
;72    8.000E+04 sVEuCLCUJAIQAbOQAQQAQ
;72    1.000E+05 BPEtDLrVJAIQAbOQAQQAQ
;==== ELEMENT  73
;73    1.000E-03 QCSDYOSPU@@R@@RSQUSPU
;73    1.500E-03 AHSwPOQVU@@R@@RQWUQVU
;73    1.735E-03 AFSYDOQDU@@R@@RQEUQDU
;73 M5 1.735E-03 AFSYDOqIU@@R@@RAPUqIU
;73    1.764E-03 AFSyAOBFU@@R@@RBGUBFU
;73    1.793E-03 AESIYOCCU@@R@@RCDUCCU
;73 M4 1.793E-03 AESIYOsGU@@R@@RsHUsGU
;73    2.000E-03 ACSAGPsVU@@R@@RsWUsVU
;73    2.194E-03 AASQIPRgU@@R@@RRiURhU
;73 M3 2.194E-03 AASQIPCUU@@R@@RCVUCUU
;73    2.327E-03 YeRaGPRiU@@R@@RC@URiU
;73    2.469E-03 IaRqFPRYU@@R@@RbPURYU
;73 M2 2.469E-03 IaRqFPrVU@@R@@RrWUrVU
;73    2.586E-03 iYRARPBXU@@R@@RBYUBXU
;73    2.708E-03 YURQPPbBU@@R@@RbCUbBU
;73 M1 2.708E-03 YURQPPrBU@@R@@RrCUrBU
;73    3.000E-03 iERaWPAcU@@R@@RAdUAcU
;73    4.000E-03 hGRbCPYDT@@R@@RiBTYDT
;73    5.000E-03 wIRrUPeFT@@R@@RuCTeFT
;73    6.000E-03 fQRcEPsBT@@R@@RsHTsBT
;73    8.000E-03 uDRTAPQYT@@R@@RaTTQYT
;73    9.881E-03 DSRtYPYES@@R@@RiPSYFS
;73 L3 9.881E-03 DSRtYPrIT@@R@@RBTTrIT
;73    1.000E-02 tHRDcPrCT@@R@@RrHTrDT
;73    1.114E-02 ScRUIPqUT@@R@@RqYTqUT
;73 L2 1.114E-02 ScRUIPBQT@@R@@RBUTBQT
;73    1.141E-02 CdReGPbGT@@R@@RrATbGT
;73    1.168E-02 sTRuFPRDT@@R@@RRHTRET
;73 L1 1.168E-02 sTRuFPBXT@@R@@RRRTBXT
;73    1.500E-02 BcRfDPqAT@@R@@RqDTqAT
;73    2.000E-02 B@Rw@PVCS@@R@@RvCSVCS
;73    3.000E-02 QHRxQPBFS@@R@@RRISBGS
;73    4.000E-02 wXQIYPyHR@@R@@RACSIXR
;73    5.000E-02 UPQYbPEGR@@R@@RuRRUGR
;73    6.000E-02 TBQABQCER@@R@@RSWRSFR
;73    6.742E-02 CRQABQbAR@@R@@RbURrAR
;73 K  6.742E-02 CRQABQQDS@@R@@RQHSQES
;73    8.000E-02 RYQACQgCR@@R@@RWYRwCR
;73    1.000E-01 qXQABQDBR@@R@@Rt@RTBR
;73    1.500E-01 hYPyWPqER@@R@@RQSRATR
;73    2.000E-01 UHPiAPVFQ@@R@@RgPQGHQ
;73    3.000E-01 BVPhDPBHQ@@R@@RSEQR`Q
;73    4.000E-01 ASPGXPY`P@@R@@RAhQqTQ
;73    5.000E-01 yAOFiPuQP@@R@@RqEQaFQ
;73    6.000E-01 VUOFPPsQP@@R@@RAHQAAQ
;73    8.000E-01 sTOeUPQeP@@R@@RWhPgQP
;73    1.000E+00 BROU@PaCP@@R@@RVWPvBP
;73    1.022E+00 rBOEEPQGP@@R@@RFUPfBP
;73    1.250E+00 QVOTWPWaOSFN@@RUTPuIP
;73    1.500E+00 AIOTFPeTOAXO@@RThPDgP
;73    2.000E+00 VDNSUPCROTYO@@RDQPtEP
;73    2.044E+00 EhNSQPs@ODhO@@RtHPtBP
;73    3.000E+00 rTNB`PqYOAEPyXLDFPDCP
;73    4.000E+00 QTNrCPQHOQUPSiMDBPD@P
;73    5.000E+00 IgMBBPhUNQfPWcMDHPDGP
;73    6.000E+00 FfMqXPvYNrBPaBNTIPTHP
;73    7.000E+00 EDMaPPUWNbSPaTNtAPtAP
;73    8.000E+00 CfMAVPtQNRbPBDNDUPDTP
;73    9.000E+00 CEMqDPDHNSGPBSNTXPTXP
;73    1.000E+01 BWMaDPSYNCQPB`NtRPtQP
;73    1.100E+01 BDMQFPc@NcSPSENDePDeP
;73    1.200E+01 qRMAIPBiNCcPCWNThPThP
;73    1.300E+01 AVMABPbSNDBPsXNUAPUAP
;73    1.400E+01 aFMiYOBRNd@PDHNeDPeCP
;73    1.500E+01 Q@Mi@ObCNtFPtENuEPuEP
;73    1.600E+01 iULxVOBHNTRPdRNEVPEVP
;73    1.800E+01 gRLH@OAbND`PU@NeWPeWP
;73    2.000E+01 VHLwHOaRNEDPUTNEePEeP
;73    2.200E+01 UALFfOAVNeGPUdNFCPFBP
;73    2.400E+01 dILFQOqBNEWPvANVIPVIP
;73    2.600E+01 cULFBOaANeUPfUNvDPvCP
;73    2.800E+01 SELeWOQBNEcPVgNFXPFXP
;73    3.000E+01 rULuGOADNUhPgFNfPPfPP
;73    4.000E+01 QTLdGOgUMfSPHVNWEPWEP
;73    5.000E+01 IhKSVOFEMWAPyGNWVPWVP
;73    6.000E+01 FfKCGOE@MGXPAAOGiPGiP
;73    8.000E+01 CfKBROsQMHBPQAOxHPxHP
;73    1.000E+02 BWKBAOReMHQPQIOxSPxSP
;73    1.500E+02 Q@KASOQeMIAPqBOiIPiIP
;73    2.000E+02 VHJQBOAVMyHPqIOiSPiSP
;73    3.000E+02 rUJWfNiYLyYPAYOA@QA@Q
;73    4.000E+02 QTJfCNgFLA@QQTOABQABQ
;73    5.000E+02 IhIUFNE`LABQQXOADQADQ
;73    6.000E+02 FfIDRNDcLACQaQOAEQAEQ
;73    8.000E+02 CfICUNcRLAEQaUOAGQAGQ
;73    1.000E+03 BWIBdNBiLAEQaXOAGQAGQ
;73    1.500E+03 Q@IQhNQcLAGQqQOAIQAIQ
;73    2.000E+03 VHHQSNATLAHQqSOAIQAIQ
;73    3.000E+03 rUHAGNiRKAHQqVOQ@QQ@Q
;73    4.000E+03 QTHhCMgBKAIQqWOQAQQAQ
;73    5.000E+03 IhGvSMuWKAIQqXOQAQQAQ
;73    6.000E+03 FfGuQMDaKAIQqYOQAQQAQ
;73    8.000E+03 CfGDPMcQKQ@QqYOQAQQAQ
;73    1.000E+04 BWGSYMBiKQ@QA`OQBQQBQ
;73    1.500E+04 Q@GBXMQbKQ@QAaOQBQQBQ
;73    2.000E+04 VHFQaMATKQ@QAaOQBQQBQ
;73    3.000E+04 rUFqBMiRJQ@QAaOQBQQBQ
;73    4.000E+04 QTFAAMgAJQ@QAbOQBQQBQ
;73    5.000E+04 IhEhCLuWJQ@QAbOQBQQBQ
;73    6.000E+04 FfEVeLDaJQ@QAbOQBQQBQ
;73    8.000E+04 CfEuCLcQJQ@QAbOQBQQBQ
;73    1.000E+05 BWEtDLBiJQ@QAbOQBQQBQ
;==== ELEMENT  74
;74    1.000E-03 QDStDOcWU@@R@@RcXUcWU
;74    1.500E-03 Q@SWQOaSU@@R@@RaTUaSU
;74    1.809E-03 AFSyHOQ@U@@R@@RQAUQ@U
;74 M5 1.809E-03 AFSyHOq@U@@R@@RqBUq@U
;74    1.840E-03 AFSYWOQcU@@R@@RQdUQcU
;74    1.872E-03 AFSyUOBeU@@R@@RBfUBeU
;74 M4 1.872E-03 AFSyUOSAU@@R@@RSBUSAU
;74    2.000E-03 ADSAEPSaU@@R@@RSbUSaU
;74    2.281E-03 AASaBPBbU@@R@@RBcUBbU
;74 M3 2.281E-03 AASaBPcGU@@R@@RcHUcGU
;74    2.423E-03 YgRq@PBbU@@R@@RBcUBbU
;74    2.575E-03 IbRqIPBTU@@R@@RBUUBTU
;74 M2 2.575E-03 IbRqIPRYU@@R@@RbPURYU
;74    2.694E-03 iYRAVPrCU@@R@@RrDUrCU
;74    2.820E-03 YURQSPBIU@@R@@RR@UBIU
;74 M1 2.820E-03 YURQSPRHU@@R@@RRIURHU
;74    3.000E-03 yFRaSPAiU@@R@@RQ`UAiU
;74    4.000E-03 xGRRIPIXT@@R@@RYVTIXT
;74    5.000E-03 GXRrQPEVT@@R@@RUSTEVT
;74    6.000E-03 vPRc@PCUT@@R@@RSQTCUT
;74    8.000E-03 ERRDGPaUT@@R@@RqQTaUT
;74    1.000E-02 DURtYPiDS@@R@@RiYSiES
;74    1.021E-02 tFRDfPxVS@@R@@Ri@SxVS
;74 L3 1.021E-02 tFRDfPbIT@@R@@RrCTbIT
;74    1.085E-02 TAREGPQdT@@R@@RQhTQdT
;74    1.154E-02 CfReHPaUT@@R@@RaYTaUT
;74 L2 1.154E-02 CfReHPbGT@@R@@RrATbGT
;74    1.182E-02 sWRuFPRET@@R@@RRITRET
;74    1.210E-02 cXRETPBCT@@R@@RBGTBCT
;74 L1 1.210E-02 cXRETPrDT@@R@@RrHTrDT
;74    1.500E-02 BiRf@PqFT@@R@@RqITqFT
;74    2.000E-02 BDRgEPvFS@@R@@RVWSvGS
;74    3.000E-02 a@RhTPRDS@@R@@RbGSRES
;74    4.000E-02 WdQISPyXR@@R@@RAGSIhR
;74    5.000E-02 eQQIfPeIR@@R@@RUeRuIR
;74    6.000E-02 dAQAAQSIR@@R@@RsQRcIR
;74    6.953E-02 sBQABQRBR@@R@@RRURbBR
;74 K  6.953E-02 sBQABQAHS@@R@@RQBSAIS
;74    8.000E-02 bTQACQGTR@@R@@RGaRWTR
;74    1.000E-01 AaQABQTER@@R@@RDTRdFR
;74    1.500E-01 HhPyTPAPR@@R@@RQXRAYR
;74    2.000E-01 eIPYHPFPQ@@R@@RGdQwBQ
;74    3.000E-01 RQPhAPRGQ@@R@@RcDQRiQ
;74    4.000E-01 AVPGVPACQ@@R@@RQbQqXQ
;74    5.000E-01 YTOFgPUfP@@R@@RqHQaHQ
;74    6.000E-01 vQOvHPChP@@R@@RAIQACQ
;74    8.000E-01 CdOeTPBDP@@R@@RHGPgXP
;74    1.000E+00 BXOEIPaHP@@R@@RfRPvGP
;74    1.022E+00 rGOECPaCP@@R@@RVPPfFP
;74    1.250E+00 aPOTVPhHOcCN@@RUXPERP
;74    1.500E+00 QAOTEPUaOQQO@@RE@PDiP
;74    2.000E+00 fINSTPSWOdXO@@RDSPtGP
;74    2.044E+00 FBNSPPCUOTgO@@RDPPtDP
;74    3.000E+00 BaNrYPAhOAGPyULDGPDEP
;74    4.000E+00 QXNrCPaCOQWPShMDDPDBP
;74    5.000E+00 AANBAPIDNQhPWaMT@PDIP
;74    6.000E+00 GCMqXPW@NrDPaANdAPd@P
;74    7.000E+00 UGMaPPEbNbVPaSNtDPtCP
;74    8.000E+00 SfMAVPTbNRdPBDNDWPDWP
;74    9.000E+00 SCMqDPdFNc@PBRNdQPdQP
;74    1.000E+01 RSMaDPsUNCTPrYNtUPtTP
;74    1.100E+01 BIMQFPsDNcVPSDNDhPDhP
;74    1.200E+01 qVMAHPCBNCgPCWNEBPEAP
;74    1.300E+01 QPMABPrUNDFPsWNUDPUDP
;74    1.400E+01 aIMiWORRNdDPDFNeGPeGP
;74    1.500E+01 QCMYGOrCNDPPtDNuHPuHP
;74    1.600E+01 Y`LxTORGNTVPdPNUPPUPP
;74    1.800E+01 GbLWiOQ`NDcPEINuPPuPP
;74    2.000E+01 vCLwFOaYNEHPUSNEiPEiP
;74    2.200E+01 eCLFdOQRNuAPUcNFGPFGP
;74    2.400E+01 DPLvIOqHNURPv@NfCPfCP
;74    2.600E+01 sULF@OaGNuPPfSNvHPvHP
;74    2.800E+01 cCLeVOQGNEhPVeNVRPVRP
;74    3.000E+01 BaLuFOAHNFCPgDNfUPfUP
;74    4.000E+01 QXLdFOWhMfXPHSNg@Pg@P
;74    5.000E+01 AALSVOvAMWFPyDNgRPgRP
;74    6.000E+01 GDKCFOeBMWTPA@OWePWeP
;74    8.000E+01 SfKBROChMHIPQAOHTPHTP
;74    1.000E+02 RSKBAOCHMHWPQIOH`PH`P
;74    1.500E+02 QCKASOBDMIIPqAOyFPyFP
;74    2.000E+02 vCJQBOQRMIUPqIOyPPyPP
;74    3.000E+02 BaJWdNAAMIgPAXOAAQAAQ
;74    4.000E+02 QXJfBNWWLAAQQTOACQACQ
;74    5.000E+02 AAJUENFELACQQXOAEQAEQ
;74    6.000E+02 GDIDQNECLADQaPOAFQAFQ
;74    8.000E+02 SfICTNsWLAEQaTOAGQAGQ
;74    1.000E+03 RSIBcNCBLAFQaWOAHQAHQ
;74    1.500E+03 QCIQhNBALAHQqQOQ@QQ@Q
;74    2.000E+03 vCHQSNQQLAHQqSOQ@QQ@Q
;74    3.000E+03 BaHAFNA@LAIQqUOQAQQAQ
;74    4.000E+03 QXHhBMWSKQ@QqVOQBQQBQ
;74    5.000E+03 AAHvQMFBKQ@QqWOQBQQBQ
;74    6.000E+03 GDGuPMEBKQ@QqXOQBQQBQ
;74    8.000E+03 SfGtIMsVKQ@QqYOQBQQBQ
;74    1.000E+04 RSGSXMCAKQAQqYOQBQQBQ
;74    1.500E+04 QCGBXMBAKQAQA`OQCQQCQ
;74    2.000E+04 vCFQ`MQPKQAQA`OQCQQCQ
;74    3.000E+04 BaFqAMA@KQAQA`OQCQQCQ
;74    4.000E+04 QXFAAMWRJQAQAaOQCQQCQ
;74    5.000E+04 AAFhALFBJQAQAaOQCQQCQ
;74    6.000E+04 GDEVdLEAJQAQAaOQCQQCQ
;74    8.000E+04 SfEuBLsVJQAQAaOQCQQCQ
;74    1.000E+05 RSEtCLCAJQAQAaOQCQQCQ
;==== ELEMENT  75
;75    1.000E-03 QFSdAOCfU@@R@@RCgUCfU
;75    1.500E-03 QASwDOqRU@@R@@RqSUqRU
;75    1.822E-03 AHSiHOQDU@@R@@RQEUQDU
;75 M5 1.822E-03 AHSiHOQDU@@R@@RQEUQDU
;75    1.885E-03 AGSiUOqSU@@R@@RqUUqSU
;75    1.949E-03 AGSA@PbUU@@R@@RbVUbUU
;75 M4 1.949E-03 AGSA@PrSU@@R@@RrTUrSU
;75    2.000E-03 AFSACPsVU@@R@@RsWUsVU
;75    2.367E-03 ABSaEPbXU@@R@@RrPUbXU
;75 M3 2.367E-03 ABSaEPSAU@@R@@RSBUSAU
;75    2.520E-03 A@SqCPbXU@@R@@RbYUbXU
;75    2.682E-03 IeRARPr@U@@R@@RrAUr@U
;75 M2 2.682E-03 IeRARPBTU@@R@@RBUUBTU
;75    2.804E-03 yRRAYPb@U@@R@@RbAUb@U
;75    2.932E-03 YXRQWPQhU@@R@@RQiUQhU
;75 M1 2.932E-03 YXRQWPBGU@@R@@RBHUBGU
;75    3.000E-03 YQRaPPQfU@@R@@RQgUQfU
;75    4.000E-03 HYRREPIfT@@R@@RYdTIfT
;75    5.000E-03 WYRbWPeXT@@R@@RuVTeXT
;75    6.000E-03 F`RSFPSYT@@R@@RcVTSYT
;75    8.000E-03 UQRDDPqRT@@R@@RqXTqRT
;75    1.000E-02 TSRtWPiUS@@R@@RAATiVS
;75    1.054E-02 tARTdPHRS@@R@@RHfSHSS
;75 L3 1.054E-02 tARTdPRIT@@R@@RbCTRIT
;75    1.122E-02 DERUFPAeT@@R@@RAiTAeT
;75    1.196E-02 sYRuHPQVT@@R@@RaPTQVT
;75 L2 1.196E-02 sYRuHPRET@@R@@RRITRET
;75    1.224E-02 sPREVPBDT@@R@@RBGTBDT
;75    1.253E-02 cQRUTPQbT@@R@@RQfTQcT
;75 L1 1.253E-02 cQRUTPbCT@@R@@RbFTbCT
;75    1.500E-02 ReRVGPAQT@@R@@RATTAQT
;75    2.000E-02 BHRgAPfRS@@R@@RFdSfSS
;75    3.000E-02 aCRhQPbDS@@R@@RrGSbDS
;75    4.000E-02 XBQIPPABS@@R@@RQASACS
;75    5.000E-02 uTQIdPUSR@@R@@RfAReSR
;75    6.000E-02 t@QAAQsDR@@R@@RCgRCTR
;75    7.168E-02 cDQABQBDR@@R@@RBVRRDR
;75 K  7.168E-02 cDQABQACS@@R@@RAGSADS
;75    8.000E-02 rPQABQwPR@@R@@RHGRG`R
;75    1.000E-01 AfQABQt@R@@R@@RTYRDPR
;75    1.500E-01 Y@PySPAUR@@R@@RaTRQUR
;75    2.000E-01 ERPYHPfVQ@@R@@RXBQWXQ
;75    3.000E-01 RXPhAPbFQ@@R@@RsDQCHQ
;75    4.000E-01 QPPGVPAHQ@@R@@RQhQAcQ
;75    5.000E-01 yYOFgPfDP@@R@@RAQQqAQ
;75    6.000E-01 FiOvIPDFP@@R@@RQAQADQ
;75    8.000E-01 SdOeTPRDP@@R@@RXHPwYP
;75    1.000E+00 RTOEIPqEP@@R@@RfYPFSP
;75    1.022E+00 BTOEDPaIP@@R@@RVWPvBP
;75    1.250E+00 aTOTVPhYOsAN@@ReSPEVP
;75    1.500E+00 QDOTEPVIOQUO@@REDPTbP
;75    2.000E+00 FWNSTPsUOtYO@@RDVPDPP
;75    2.044E+00 VINSPPcROEHO@@RDSPtGP
;75    3.000E+00 BhNrYPQgOAIPyVLTAPDHP
;75    4.000E+00 aRNrCPaIOQYPShMDGPDEP
;75    5.000E+00 ADNBAPIWNBAPWaMTDPTCP
;75    6.000E+00 gCMqXPGTNrGPaANdEPdDP
;75    7.000E+00 uAMaPPV@NbYPaSNtGPtGP
;75    8.000E+00 DGMAVPUENRhPBDNTQPTQP
;75    9.000E+00 cAMqDPDVNcDPBSNdUPdUP
;75    1.000E+01 bPMaDPSbNCXPrYNtYPtYP
;75    1.100E+01 REMQFPSPNsPPSDNTcPTcP
;75    1.200E+01 AaMAIPSFNSaPCWNEFPEFP
;75    1.300E+01 QTMABPBhNT@PsWNUIPUIP
;75    1.400E+01 qCMiWObTNdHPDGNuBPuBP
;75    1.500E+01 QFMYHOBTNDUPtDNETPETP
;75    1.600E+01 ABMxUObGNdQPdQNUUPUUP
;75    1.800E+01 HDLWiOQiNDiPEINuVPuVP
;75    2.000E+01 VQLwGOqWNUDPUSNUePUeP
;75    2.200E+01 uHLFeOQYNuGPUcNVCPVCP
;75    2.400E+01 TRLFPOATNUXPv@NfIPfIP
;75    2.600E+01 CeLFAOqBNuWPfTNFUPFUP
;75    2.800E+01 sBLeWOaBNUdPVeNVYPVYP
;75    3.000E+01 BiLuGOQCNV@PgDNvRPvRP
;75    4.000E+01 aSLdFOxEMvVPHSNgHPgHP
;75    5.000E+01 ADLSVOfPMgDPyCNwPPwPP
;75    6.000E+01 gCKCGOEVMgRPA@OHDPHDP
;75    8.000E+01 DGKBRODEMXHPQAOXSPXSP
;75    1.000E+02 bPKBAOcBMXWPQIOHiPHiP
;75    1.500E+02 QFKASORCMYHPqAOIVPIVP
;75    2.000E+02 VQJQBOQYMYUPqIOI`PI`P
;75    3.000E+02 BiJWeNAFMYhPAXOABQABQ
;75    4.000E+02 aSJfBNWaLABQQTOADQADQ
;75    5.000E+02 ADJUENvBLADQQXOAFQAFQ
;75    6.000E+02 gCIDQNeGLAEQaPOAGQAGQ
;75    8.000E+02 DGICTNSeLAFQaTOAHQAHQ
;75    1.000E+03 bPIBcNSELAGQaWOAIQAIQ
;75    1.500E+03 QFIQhNR@LAIQqPOQAQQAQ
;75    2.000E+03 VQHQSNQXLQ@QqROQAQQAQ
;75    3.000E+03 BiHAFNAELQ@QqUOQBQQBQ
;75    4.000E+03 aSHhBMGgKQAQqVOQCQQCQ
;75    5.000E+03 ADHvRMv@KQAQqWOQCQQCQ
;75    6.000E+03 gCGuPMeEKQAQqWOQCQQCQ
;75    8.000E+03 DGGtIMScKQBQqXOQCQQCQ
;75    1.000E+04 bPGSYMSEKQBQqYOQDQQDQ
;75    1.500E+04 QFGBXMR@KQBQqYOQDQQDQ
;75    2.000E+04 VQFQ`MQWKQBQA`OQDQQDQ
;75    3.000E+04 BiFqAMAEKQBQA`OQDQQDQ
;75    4.000E+04 aSFAAMGgJQBQA`OQDQQDQ
;75    5.000E+04 ADFhALfIJQBQA`OQDQQDQ
;75    6.000E+04 gCEVdLeEJQBQAaOQDQQDQ
;75    8.000E+04 DGEuBLScJQBQAaOQDQQDQ
;75    1.000E+05 bPEtCLSEJQBQAaOQDQQDQ
;==== ELEMENT  76
;76    1.000E-03 QGSDEODBU@@R@@RDCUDBU
;76    1.500E-03 QBSWDOqYU@@R@@RA`UqYU
;76    1.960E-03 AGSIgOAAU@@R@@RABUAAU
;76 M5 1.960E-03 AGSIgOADU@@R@@RAEUADU
;76    2.000E-03 AGSAAPbAU@@R@@RbBUbAU
;76    2.031E-03 AFSACPRXU@@R@@RRYURXU
;76 M4 2.031E-03 AFSACPBcU@@R@@RBdUBcU
;76    2.234E-03 ADSQEPbXU@@R@@RbYUbXU
;76    2.457E-03 ABSaGPRSU@@R@@RRTURSU
;76 M3 2.457E-03 ABSaGPRdU@@R@@RReURdU
;76    2.619E-03 YiRqFPRQU@@R@@RRRURQU
;76    2.792E-03 I`RAVPREU@@R@@RRFUREU
;76 M2 2.792E-03 I`RAVPbIU@@R@@Rr@UbIU
;76    3.000E-03 YWRQXPQcU@@R@@RQdUQcU
;76    3.049E-03 YRRaPPAfU@@R@@RAgUAfU
;76 M1 3.049E-03 YRRaPPQdU@@R@@RQeUQdU
;76    4.000E-03 XURRBPAAU@@R@@RABUAAU
;76    5.000E-03 gTRbSPEfT@@R@@RUcTEfT
;76    6.000E-03 FeRSAPsQT@@R@@RsXTsQT
;76    8.000E-03 UVRShPqXT@@R@@RAdTqXT
;76    1.000E-02 TXRtQPYiS@@R@@RADTYiS
;76    1.087E-02 dCRTiPHCS@@R@@RHVSHCS
;76 L3 1.087E-02 dCRTiPBHT@@R@@RRBTBHT
;76    1.160E-02 SfReBPqTT@@R@@RqYTqUT
;76    1.238E-02 sPRETPAWT@@R@@RQPTAWT
;76 L2 1.238E-02 sPRETPBBT@@R@@RBFTBBT
;76    1.267E-02 cPRUQPQaT@@R@@RQeTQaT
;76    1.297E-02 SQRUYPAaT@@R@@RAeTAaT
;76 L1 1.297E-02 SQRUYPBIT@@R@@RRCTBIT
;76    1.500E-02 RhRFIPAUT@@R@@RAXTAUT
;76    2.000E-02 R@RWBPFbS@@R@@RGDSFcS
;76    3.000E-02 aDRXPPrAS@@R@@RBTSrBS
;76    4.000E-02 hCQiIPAFS@@R@@RQESAGS
;76    5.000E-02 EcQySPuSR@@R@@RFQREcR
;76    6.000E-02 tFQYgPCWR@@R@@RD@RSWR
;76    7.387E-02 SBQAAQQeR@@R@@RrFRBER
;76 K  7.387E-02 SBQAAQyUR@@R@@RABSIeR
;76    8.000E-02 rTQAAQWaR@@R@@RhIRHAR
;76    1.000E-01 AiQAAQDQR@@R@@RtPRTQR
;76    1.500E-01 iDPiTPAYR@@R@@RaXRQYR
;76    2.000E-01 UQPY@PFgQ@@R@@RxCQwXQ
;76    3.000E-01 bRPXDPrDQ@@R@@RCQQSEQ
;76    4.000E-01 QSPGPPQBQ@@R@@RBAQAfQ
;76    5.000E-01 YfOFaPFWP@@R@@RASQqCQ
;76    6.000E-01 GAOvDPdAP@@R@@RQCQAEQ
;76    8.000E-01 DAOePPbBP@@R@@RhBPGbP
;76    1.000E+00 RYOEEPAPP@@R@@RvPPFUP
;76    1.022E+00 BXOTiPqDP@@R@@RVXPvCP
;76    1.250E+00 aWOTRPICOsEN@@ReRPEVP
;76    1.500E+00 QGOTBPFTOQXO@@RECPTbP
;76    2.000E+00 VYNSRPCiODeO@@RDVPtIP
;76    2.044E+00 vANCWPsVOUEO@@RDSPtFP
;76    3.000E+00 RdNrWPBDOAIPiXLT@PDGP
;76    4.000E+00 aVNrAPqDOaPPSeMDFPDEP
;76    5.000E+00 AFNB@PIcNBBPGeMTCPTBP
;76    6.000E+00 wGMqWPwQNrHPa@NdDPdDP
;76    7.000E+00 EQMQYPvBNrPPaRNtGPtGP
;76    8.000E+00 TDMATPuDNRiPBBNTQPTQP
;76    9.000E+00 cHMqCPdRNcEPBQNdUPdUP
;76    1.000E+01 bUMaCPDGNCYPrWNtYPtYP
;76    1.100E+01 RIMQEPcSNsQPSANTcPTcP
;76    1.200E+01 AdMAHPcHNSbPCTNEGPEFP
;76    1.300E+01 QWMAAPRhNTAPsTNe@PUIP
;76    1.400E+01 qEMYYOrTNdIPDCNuBPuBP
;76    1.500E+01 QHMYAORSNDVPtANETPETP
;76    1.600E+01 ADMhXOrENdRPTWNUUPUUP
;76    1.800E+01 XILWcOBFNT`PEENuWPuWP
;76    2.000E+01 fTLwAOAcNUEPEXNUfPUfP
;76    2.200E+01 EXLvYOaUNuHPEhNVCPVCP
;76    2.400E+01 dQLvEOQPNUYPfDNv@Pv@P
;76    2.600E+01 ScLUfOqGNuXPVXNFUPFUP
;76    2.800E+01 sHLeROaGNUePFiNfPPfPP
;76    3.000E+01 ReLuBOQHNVAPWHNvSPvSP
;76    4.000E+01 aVLdCOhUMvWPxFNgIPgIP
;76    5.000E+01 AFLSSOFdMgFPiENwQPwQP
;76    6.000E+01 wGKCDOeUMgTPYeNHEPHEP
;76    8.000E+01 TEKBPOd@MXIPQ@OXUPXUP
;76    1.000E+02 bUKQiOsDMXXPQHOX`PX`P
;76    1.500E+02 QHKARObAMi@Pq@OIXPIXP
;76    2.000E+02 fTJQAOaUMYWPqHOIbPIbP
;76    3.000E+02 ReJGhNQ@MA@QAWOABQABQ
;76    4.000E+02 aVJVGNh@LABQQROAEQAEQ
;76    5.000E+02 AFJUANVULADQQVOAFQAFQ
;76    6.000E+02 wGItHNEVLAEQQYOAGQAGQ
;76    8.000E+02 TEICRNDILAGQaROAIQAIQ
;76    1.000E+03 bUIBaNcGLAHQaUOQ@QQ@Q
;76    1.500E+03 QHIQfNRHLAIQaYOQAQQAQ
;76    2.000E+03 fTHQRNaSLQ@QqQOQBQQBQ
;76    3.000E+03 ReHAFNAILQAQqSOQBQQBQ
;76    4.000E+03 aVHXFMXEKQAQqTOQCQQCQ
;76    5.000E+03 AFHfWMVRKQAQqUOQCQQCQ
;76    6.000E+03 wGGeUMESKQBQqVOQCQQCQ
;76    8.000E+03 TEGtFMDGKQBQqVOQDQQDQ
;76    1.000E+04 bUGSVMcFKQBQqWOQDQQDQ
;76    1.500E+04 QHGBVMRGKQBQqXOQDQQDQ
;76    2.000E+04 fTFAiMaSKQBQqXOQDQQDQ
;76    3.000E+04 ReFq@MAIKQBQqXOQDQQDQ
;76    4.000E+04 aVFA@MXEJQBQqYOQDQQDQ
;76    5.000E+04 AFFXELVRJQCQqYOQDQQDQ
;76    6.000E+04 wGEFiLESJQCQqYOQDQQDQ
;76    8.000E+04 TEEeHLDGJQCQqYOQDQQDQ
;76    1.000E+05 bUEt@LcFJQCQqYOQDQQDQ
;==== ELEMENT  77
;77    1.000E-03 QISScOdCU@@R@@RdDUdCU
;77    1.500E-03 QDSG@OAiU@@R@@RQ`UAiU
;77    2.000E-03 AISYgOABU@@R@@RACUABU
;77    2.040E-03 AHSABPyWT@@R@@RIhTyWT
;77 M5 2.040E-03 AHSABPAEU@@R@@RAFUAEU
;77    2.078E-03 AHSADPaPU@@R@@RaQUaPU
;77    2.116E-03 AGSAFPBSU@@R@@RBUUBSU
;77 M4 2.116E-03 AGSAFPRWU@@R@@RRXURWU
;77    2.323E-03 AESQHPBYU@@R@@RRPUBYU
;77    2.551E-03 ACSqAPBQU@@R@@RBRUBQU
;77 M3 2.551E-03 ACSqAPrYU@@R@@RB`UrYU
;77    2.724E-03 AASAQPrHU@@R@@RrIUrHU
;77    2.909E-03 IdRQQPBCU@@R@@RBDUBCU
;77 M2 2.909E-03 IdRQQPRFU@@R@@RRGURFU
;77    3.000E-03 yTRQVPB@U@@R@@RBAUB@U
;77    3.174E-03 YVRaVPqVU@@R@@RqWUqVU
;77 M1 3.174E-03 YVRaVPAcU@@R@@RAdUAcU
;77    4.000E-03 xPRR@PAEU@@R@@RAFUAEU
;77    5.000E-03 wWRbQPV@T@@R@@RVHTV@T
;77    6.000E-03 VfRS@PCgT@@R@@RSdTCgT
;77    8.000E-03 eVRSgPAfT@@R@@RQaTAfT
;77    1.000E-02 dWRtPPADT@@R@@RAITADT
;77    1.122E-02 THREIPwSS@@R@@RXFSwTS
;77 L3 1.122E-02 THREIPB@T@@R@@RBDTB@T
;77    1.199E-02 S`RuAPaWT@@R@@RqPTaWT
;77    1.282E-02 cSRUTPqIT@@R@@RASTqIT
;77 L2 1.282E-02 cSRUTPQbT@@R@@RQfTQbT
;77    1.312E-02 STReRPAbT@@R@@RAeTAbT
;77    1.342E-02 CVRuPPqRT@@R@@RqVTqRT
;77 L1 1.342E-02 CVRuPPQiT@@R@@RBBTQiT
;77    1.500E-02 CERFIPQPT@@R@@RQSTQPT
;77    2.000E-02 RERWAPW@S@@R@@RwBSW@S
;77    3.000E-02 aGRHYPBQS@@R@@RRUSBRS
;77    4.000E-02 HSQiHPQAS@@R@@Ra@SQAS
;77    5.000E-02 UgQySPF@R@@R@@RfYRV@R
;77    6.000E-02 DWQYhPcSR@@R@@RTGRsSR
;77    7.611E-02 CEQAAQAhR@@R@@RbHRQhR
;77 K  7.611E-02 CEQAAQyBR@@R@@RySRIRR
;77    8.000E-02 BaQAAQh@R@@R@@RXXRx@R
;77    1.000E-01 QcQAAQTVR@@R@@RDfRdVR
;77    1.500E-01 IXPiVPQUR@@R@@RqTRaUR
;77    2.000E-01 eUPYBPWEQ@@R@@RhSQHFQ
;77    3.000E-01 bYPXFPBTQ@@R@@RSSQcFQ
;77    4.000E-01 QWPGQPQGQ@@R@@RBGQQaQ
;77    5.000E-01 ABPFcPvXP@@R@@RAVQqFQ
;77    6.000E-01 gAOvEPDRP@@R@@RQEQAHQ
;77    8.000E-01 TCOeQPrCP@@R@@RxFPWdP
;77    1.000E+00 bWOEFPAWP@@R@@RvYPVSP
;77    1.022E+00 RVOEAPAQP@@R@@RfWPFQP
;77    1.250E+00 qROTSPIXOCTN@@ReYPURP
;77    1.500E+00 a@OTCPvUOaRO@@REHPTfP
;77    2.000E+00 vXNSSPDIOTgO@@RTPPDSP
;77    2.044E+00 FYNCXPSdOeGO@@RDWPDPP
;77    3.000E+00 CCNrXPRDOQBPyQLTDPTAP
;77    4.000E+00 qPNrBPAPOaRPSfMT@PDIP
;77    5.000E+00 AINB@PACOBEPGgMTGPTFP
;77    6.000E+00 WXMqWPHHNBRPaANdIPdHP
;77    7.000E+00 UWMQYPfSNrTPaRNDRPDQP
;77    8.000E+00 dGMAUPePNCCPBCNTVPTUP
;77    9.000E+00 sGMqCPDdNcIPBQNtPPtPP
;77    1.000E+01 rSMaCPdFNSTPrXNDdPDdP
;77    1.100E+01 bFMQEPC`NsVPSBNThPThP
;77    1.200E+01 Q`MAHPCSNSgPCUNUBPUBP
;77    1.300E+01 aRMABPSCNTFPsUNeEPeEP
;77    1.400E+01 qIMiROBgNtEPDDNuHPuHP
;77    1.500E+01 aAMYCObUNTRPtBNUPPUPP
;77    1.600E+01 AGMxPOBVNdWPTXNeRPeQP
;77    1.800E+01 HTLWeORFNTfPEFNEcPEcP
;77    2.000E+01 FcLwCOQbNeBPEYNFBPFBP
;77    2.200E+01 eULFaOqRNEUPEiNfAPfAP
;77    2.400E+01 tULvFOQWNeVPfFNvGPvGP
;77    2.600E+01 DDLUgOATNEePVYNVSPVSP
;77    2.800E+01 CYLeTOqCNFCPV`NfWPfWP
;77    3.000E+01 CDLuDOaCNVIPWINFaPFaP
;77    4.000E+01 qQLdDOIEMFePxHNwGPwGP
;77    5.000E+01 AILSTOWFMwEPiGNG`PG`P
;77    6.000E+01 WYKCEOUbMwSPYgNXDPXDP
;77    8.000E+01 dGKBQODPMhIPQ@OhUPhUP
;77    1.000E+02 rSKB@OCYMhYPQHOIAPIAP
;77    1.500E+02 aAKAROrAMyBPq@OYYPYYP
;77    2.000E+02 FcJQAOqSMiYPqHOYdPYdP
;77    3.000E+02 CDJW`NQEMAAQAWOACQACQ
;77    4.000E+02 qQJVINXXLADQQROAFQAFQ
;77    5.000E+02 AIJUBNFeLAEQQVOAGQAGQ
;77    6.000E+02 WYItINuQLAFQQYOAHQAHQ
;77    8.000E+02 dGICRNdHLAHQaSOQ@QQ@Q
;77    1.000E+03 rSIBbNCRLAIQaUOQAQQAQ
;77    1.500E+03 aAIQgNbHLQ@QaYOQBQQBQ
;77    2.000E+03 FcHQRNqQLQAQqQOQCQQCQ
;77    3.000E+03 CDHAFNQDLQBQqSOQDQQDQ
;77    4.000E+03 qQHXHMXSKQBQqTOQDQQDQ
;77    5.000E+03 AIHfYMFbKQCQqUOQEQQEQ
;77    6.000E+03 WYGeWMeYKQCQqVOQEQQEQ
;77    8.000E+03 dGGtGMdFKQCQqWOQEQQEQ
;77    1.000E+04 rSGSWMCQKQCQqWOQEQQEQ
;77    1.500E+04 aAGBVMbGKQDQqXOQEQQEQ
;77    2.000E+04 FcFAiMqQKQDQqXOQEQQEQ
;77    3.000E+04 CDFqAMQDKQDQqXOQFQQFQ
;77    4.000E+04 qQFA@MXRJQDQqYOQFQQFQ
;77    5.000E+04 AIFXGLFbJQDQqYOQFQQFQ
;77    6.000E+04 WYEV`LeXJQDQqYOQFQQFQ
;77    8.000E+04 dGEeILdFJQDQqYOQFQQFQ
;77    1.000E+05 rSEtALCQJQDQqYOQFQQFQ
;==== ELEMENT  78
;78    1.000E-03 aASsGODRU@@R@@RDSUDRU
;78    1.500E-03 QFSfAOQgU@@R@@RQiUQgU
;78    2.000E-03 QASYCOAGU@@R@@RAHUAGU
;78    2.122E-03 AISIdOIPT@@R@@RYQTIPT
;78 M5 2.122E-03 AISIdOABU@@R@@RACUABU
;78    2.161E-03 AISAAPQSU@@R@@RQTUQSU
;78    2.202E-03 AHSACPbIU@@R@@Rr@UbIU
;78 M4 2.202E-03 AHSACPBTU@@R@@RBUUBTU
;78    2.413E-03 AFSQEPrGU@@R@@RrHUrGU
;78    2.645E-03 ACSaHPbIU@@R@@Rr@UbIU
;78 M3 2.645E-03 ACSaHPbUU@@R@@RbVUbUU
;78    3.000E-03 YbRAXPQfU@@R@@RQgUQfU
;78    3.026E-03 IiRQPPQaU@@R@@RQbUQaU
;78 M2 3.026E-03 IiRQPPBCU@@R@@RBDUBCU
;78    3.158E-03 yTRQWPAdU@@R@@RAeUAdU
;78    3.296E-03 YYRaTPaVU@@R@@RaWUaVU
;78 M1 3.296E-03 YYRaTPqSU@@R@@RqTUqSU
;78    4.000E-03 HdRBBPAIU@@R@@RQ@UAIU
;78    5.000E-03 GiRRSPvBT@@R@@RFPTvBT
;78    6.000E-03 GFRCBPDAT@@R@@RDHTDAT
;78    8.000E-03 uTRSaPQcT@@R@@RQiTQcT
;78    1.000E-02 tTRdUPAHT@@R@@RQCTAHT
;78    1.156E-02 TBRUEPGSS@@R@@RGdSGSS
;78 L3 1.156E-02 TBRUEPQ`T@@R@@RQeTQaT
;78    1.239E-02 CdRuHPQXT@@R@@RaRTQXT
;78    1.327E-02 SVReQPqAT@@R@@RqETqAT
;78 L2 1.327E-02 SVReQPAbT@@R@@RAeTAbT
;78    1.357E-02 CXReYPqRT@@R@@RqVTqRT
;78    1.388E-02 sIRuWPaST@@R@@RaWTaST
;78 L1 1.388E-02 sIRuWPAiT@@R@@RQbTAiT
;78    1.500E-02 SARFDPQUT@@R@@RQXTQUT
;78    2.000E-02 RIRGFPwES@@R@@RWWSwES
;78    3.000E-02 aIRHTPRPS@@R@@RbTSRQS
;78    4.000E-02 XYQiCPQES@@R@@RaDSQFS
;78    5.000E-02 FIQiXPfER@@R@@RVeRvDR
;78    6.000E-02 TVQYcPsXR@@R@@RtDRChR
;78    7.839E-02 RfQAAQAaR@@R@@Rb@RQaR
;78 K  7.839E-02 RfQAAQXhR@@R@@RyHRIHR
;78    8.000E-02 BfQAAQxDR@@R@@RxSRHUR
;78    1.000E-01 QgQAAQtPR@@R@@RTiRD`R
;78    1.500E-01 iYPiSPaPR@@R@@RqYRqPR
;78    2.000E-01 uXPIIPGQQ@@R@@RX`QxBQ
;78    3.000E-01 rUPXDPRTQ@@R@@RcRQsEQ
;78    4.000E-01 aPPGPPaBQ@@R@@RRBQQfQ
;78    5.000E-01 AEPFaPGFP@@R@@RAYQqIQ
;78    6.000E-01 wHOvCPdQP@@R@@RQGQAIQ
;78    8.000E-01 dCOePPBTP@@R@@RHVPHCP
;78    1.000E+00 rSOEEPQSP@@R@@RFfPVXP
;78    1.022E+00 bROE@PAWP@@R@@RvSPFWP
;78    1.250E+00 qVOTSPY`OSQN@@RuSPUUP
;78    1.500E+00 aCOTBPGEOaVO@@RUAPTiP
;78    2.000E+00 VeNSRPdGOEGO@@RTRPDUP
;78    2.044E+00 fVNCXPTAOuGO@@RDYPDRP
;78    3.000E+00 S@NrWPbCOQCPiYLTFPTCP
;78    4.000E+00 qUNrAPAWOaTPSeMTBPTAP
;78    5.000E+00 QBNB@PAGOBGPGeMd@PTIP
;78    6.000E+00 wXMqWPHSNBTPa@NtAPt@P
;78    7.000E+00 uQMQYPVaNrVPaRNDTPDTP
;78    8.000E+00 tHMAUPEdNCFPBBNTXPTXP
;78    9.000E+00 CVMqCPEENsBPBQNtSPtSP
;78    1.000E+01 B`MaCPDTNSWPrWNDgPDgP
;78    1.100E+01 rBMQEPSfNsYPSANEAPEAP
;78    1.200E+01 QeMAHPSWND@PCTNUEPUEP
;78    1.300E+01 aVMAAPcFNd@PsTNeHPeHP
;78    1.400E+01 ASMiPORiNtHPDCNERPEQP
;78    1.500E+01 aEMYBOrVNTUPtANUTPUTP
;78    1.600E+01 AIMhXORVNtQPTWNeUPeUP
;78    1.800E+01 hULWcObENE@PEDNEgPEgP
;78    2.000E+01 G@LwBOB@NeFPEXNFFPFFP
;78    2.200E+01 uYLvYOA`NEYPEhNfEPfEP
;78    2.400E+01 DgLvEOaSNuPPfDNFRPFRP
;78    2.600E+01 TELUfOQPNU`PVXNVWPVWP
;78    2.800E+01 SWLeROqHNFHPFhNvRPvRP
;78    3.000E+01 SALuCOaHNfDPWGNFfPFfP
;78    4.000E+01 qULdCOISMVaPxENGSPGRP
;78    5.000E+01 QBLSSOGUMGQPiDNGfPGfP
;78    6.000E+01 wYKCDOVFMwYPYdNh@Ph@P
;78    8.000E+01 tHKBPOTWMxFPQ@OxQPxQP
;78    1.000E+02 B`KQiOcTMxVPQGOIHPIHP
;78    1.500E+02 aEKAROBQMyIPq@OiVPiVP
;78    2.000E+02 G@JQAOA`MyVPqGOA@QA@Q
;78    3.000E+02 SAJGiNQIMABQAVOADQADQ
;78    4.000E+02 qUJVHNXcLADQQROAGQAGQ
;78    5.000E+02 QBJUANWDLAFQQVOAHQAHQ
;78    6.000E+02 wYItHNUdLAGQQXOAIQAIQ
;78    8.000E+02 tHICRNDULAIQaROQAQQAQ
;78    1.000E+03 B`IBaNSVLQ@QaTOQBQQBQ
;78    1.500E+03 aEIQfNrGLQAQaXOQCQQCQ
;78    2.000E+03 G@HQRNqXLQBQqPOQDQQDQ
;78    3.000E+03 SAHAFNQHLQCQqROQEQQEQ
;78    4.000E+03 qUHXFMHhKQCQqSOQEQQEQ
;78    5.000E+03 QBHfWMW@KQDQqTOQEQQEQ
;78    6.000E+03 wYGeVMUbKQDQqUOQFQQFQ
;78    8.000E+03 tHGtFMDTKQDQqUOQFQQFQ
;78    1.000E+04 B`GSVMSUKQDQqVOQFQQFQ
;78    1.500E+04 aEGBVMrGKQDQqWOQFQQFQ
;78    2.000E+04 G@FAiMqXKQEQqWOQFQQFQ
;78    3.000E+04 SAFq@MQHKQEQqWOQFQQFQ
;78    4.000E+04 qUFA@MHhJQEQqWOQGQQGQ
;78    5.000E+04 QBFXELW@JQEQqXOQGQQGQ
;78    6.000E+04 wYEFiLUbJQEQqXOQGQQGQ
;78    8.000E+04 tHEeHLDTJQEQqXOQGQQGQ
;78    1.000E+05 B`Et@LSUJQEQqXOQGQQGQ
;==== ELEMENT  79
;79    1.000E-03 aCScGOdTU@@R@@RdUUdTU
;79    1.500E-03 QHSFGOBHU@@R@@RBIUBHU
;79    2.000E-03 QCSXfOQCU@@R@@RQDUQCU
;79    2.206E-03 Q@SAAPIHT@@R@@RYITIHT
;79 M5 2.206E-03 Q@SAAPIcT@@R@@RYdTIcT
;79    2.248E-03 Q@SADPAXU@@R@@RAYUAXU
;79    2.291E-03 AISAFPbAU@@R@@RbBUbAU
;79 M4 2.291E-03 AISAFPrEU@@R@@RrFUrEU
;79    2.507E-03 AGSQHPbGU@@R@@RbHUbGU
;79    2.743E-03 ADSqBPRIU@@R@@Rb@URIU
;79 M3 2.743E-03 ADSqBPRSU@@R@@RRTURSU
;79    3.000E-03 AASAVPBDU@@R@@RBEUBDU
;79    3.148E-03 YdRQTPAaU@@R@@RAbUAaU
;79 M2 3.148E-03 YdRQTPQbU@@R@@RQcUQbU
;79    3.283E-03 yYRaQPqTU@@R@@RqUUqTU
;79    3.425E-03 iSRaYPQXU@@R@@RQXUQXU
;79 M1 3.425E-03 iSRaYPaTU@@R@@RaUUaTU
;79    4.000E-03 IARQiPQCU@@R@@RQDUQCU
;79    5.000E-03 HCRRPPVXT@@R@@RfVTVXT
;79    6.000E-03 WIRRiPTHT@@R@@RdETTHT
;79    8.000E-03 EeRChPBAT@@R@@RBGTBAT
;79    1.000E-02 DdRdSPQCT@@R@@RQHTQCT
;79    1.192E-02 DHReDPWGS@@R@@RWXSWGS
;79 L3 1.192E-02 DHReDPAcT@@R@@RAgTAcT
;79    1.279E-02 sYREXPQQT@@R@@RQUTQQT
;79    1.373E-02 SQRuRPaET@@R@@RaHTaET
;79 L2 1.373E-02 SQRuRPqST@@R@@RqVTqST
;79    1.404E-02 CSRE`PaTT@@R@@RaWTaTT
;79    1.435E-02 sDREhPQUT@@R@@RQYTQUT
;79 L1 1.435E-02 sDREhPA`T@@R@@RAcTA`T
;79    1.500E-02 SHRFDPaPT@@R@@RaTTaQT
;79    2.000E-02 bDRGEPgUS@@R@@RGhSgVS
;79    3.000E-02 qBRHSPbQS@@R@@RrUSbRS
;79    4.000E-02 H`QiCPa@S@@R@@Rq@SaAS
;79    5.000E-02 fDQiXPVTR@@R@@RgFRfSR
;79    6.000E-02 dWQYdPSfR@@R@@RTSRDFR
;79    8.000E-02 RdQAAQqYR@@R@@RRIRAiR
;79    8.072E-02 BiQAAQqUR@@R@@RRDRAeR
;79 K  8.072E-02 BiQAAQXQR@@R@@RX`RhQR
;79    1.000E-01 BBQAAQDfR@@R@@RUFRTfR
;79    1.500E-01 YePiUPaVR@@R@@RAfRqVR
;79    2.000E-01 UcPYAPwQQ@@R@@RiBQhRQ
;79    3.000E-01 BcPXFPbUQ@@R@@RsTQCVQ
;79    4.000E-01 aUPGRPaGQ@@R@@RRHQBAQ
;79    5.000E-01 AHPFcPwIP@@R@@RQSQARQ
;79    6.000E-01 WYOvEPDcP@@R@@RQIQQBQ
;79    8.000E-01 tEOeQPRVP@@R@@RhPPXGP
;79    1.000E+00 BaOEFPaQP@@R@@RVePfWP
;79    1.022E+00 bYOEAPQTP@@R@@RFbPVUP
;79    1.250E+00 AaOTTPADPcPN@@RuYPeQP
;79    1.500E+00 aGOTCPGPOqPO@@RUGPEDP
;79    2.000E+00 WFNSSPDXOUIO@@RTWPTPP
;79    2.044E+00 FeNCYPtBOUPO@@RTTPDWP
;79    3.000E+00 c@NrXPrDOQEPyRLd@PTGP
;79    4.000E+00 A`NrBPQTOaWPSfMTGPTEP
;79    5.000E+00 QENBAPQCOR@PGhMdDPdCP
;79    6.000E+00 HAMqWPHcNBWPaANtFPtEP
;79    7.000E+00 EiMQYPgCNB`PaSNDYPDXP
;79    8.000E+00 TQMAUPVANS@PBCNdSPdSP
;79    9.000E+00 SVMqCPeINsGPBQNtXPtXP
;79    1.000E+01 BiMaDPdUNcQPrXNTcPTbP
;79    1.100E+01 rHMQEPTENCdPSBNEGPEFP
;79    1.200E+01 B@MAHPsTNDEPCUNeAPeAP
;79    1.300E+01 qQMABPCQNdEPsUNuDPuDP
;79    1.400E+01 AWMiSOSCNDTPDDNEXPEWP
;79    1.500E+01 aHMYDOBiNdQPtBNePPePP
;79    1.600E+01 QCMxQObXNtWPTXNuRPuRP
;79    1.800E+01 XaLWfOrENEGPEFNUdPUdP
;79    2.000E+01 gBLwDOBINuCPEYNVDPVDP
;79    2.200E+01 UfLFbOAhNUVPEiNvBPvBP
;79    2.400E+01 EALvGOqQNuXPfFNFYPFYP
;79    2.600E+01 dGLUhOQWNUgPVYNfUPfUP
;79    2.800E+01 cXLeTOATNVEPV`NF`PF`P
;79    3.000E+01 cALuDOqDNvBPWINVdPVdP
;79    4.000E+01 A`LdEOIfMG@PxGNWRPWRP
;79    5.000E+01 QELSTOG`MWPPiFNWePWeP
;79    6.000E+01 HBKCEOFUMGiPYfNx@Px@P
;79    8.000E+01 TQKBQOtXMHVPQ@OHbPHbP
;79    1.000E+02 BiKB@OCaMHgPQHOYIPYIP
;79    1.500E+02 aHKARORRMYQPq@OyXPyXP
;79    2.000E+02 gBJQBOAhMIhPqGOAAQAAQ
;79    3.000E+02 cAJWaNaEMACQAWOAFQAFQ
;79    4.000E+02 A`Jf@NyDLAFQQROAHQAHQ
;79    5.000E+02 QEJUCNGVLAGQQVOAIQAIQ
;79    6.000E+02 HBItINfALAIQQXOQAQQAQ
;79    8.000E+02 TQICSNdVLQ@QaROQBQQBQ
;79    1.000E+03 BiIBbNsRLQAQaTOQCQQCQ
;79    1.500E+03 aHIQgNBXLQCQaXOQDQQDQ
;79    2.000E+03 gBHQSNAfLQCQqPOQEQQEQ
;79    3.000E+03 cAHAFNaDLQDQqROQFQQFQ
;79    4.000E+03 A`HXHMiIKQEQqTOQGQQGQ
;79    5.000E+03 QEHfYMGSKQEQqTOQGQQGQ
;79    6.000E+03 HBGeWMVIKQEQqUOQGQQGQ
;79    8.000E+03 TQGtGMdTKQEQqVOQGQQGQ
;79    1.000E+04 BiGSWMsQKQFQqVOQGQQGQ
;79    1.500E+04 aHGBWMBXKQFQqWOQHQQHQ
;79    2.000E+04 gBFQ`MAfKQFQqWOQHQQHQ
;79    3.000E+04 cAFqAMaDKQFQqWOQHQQHQ
;79    4.000E+04 A`FA@MiHJQFQqXOQHQQHQ
;79    5.000E+04 QEFXHLGSJQFQqXOQHQQHQ
;79    6.000E+04 HBEVaLVIJQFQqXOQHQQHQ
;79    8.000E+04 TQEu@LdTJQFQqXOQHQQHQ
;79    1.000E+05 BiEtALsQJQFQqXOQHQQHQ
;==== ELEMENT  80
;80    1.000E-03 aCSSVODbU@@R@@RDcUDbU
;80    1.500E-03 QISFVORFU@@R@@RRGURFU
;80    2.000E-03 QCSyBOQGU@@R@@RQHUQGU
;80    2.295E-03 Q@SQ@PhVT@@R@@RxWThVT
;80 M5 2.295E-03 Q@SQ@PyXT@@R@@RIiTyXT
;80    2.339E-03 AISQBPATU@@R@@RAUUATU
;80    2.385E-03 AISQEPRBU@@R@@RRCURBU
;80 M4 2.385E-03 AISQEPbHU@@R@@RbIUbHU
;80    2.606E-03 AFSaGPRGU@@R@@RRHURGU
;80    2.847E-03 ACSAPPBGU@@R@@RBHUBGU
;80 M3 2.847E-03 ACSAPPrIU@@R@@RBPUrIU
;80    3.000E-03 ABSAXPRAU@@R@@RRBURAU
;80    3.278E-03 IeRaSPaYU@@R@@RqPUaYU
;80 M2 3.278E-03 IeRaSPA`U@@R@@RAaUA`U
;80    3.417E-03 yPRqPPaSU@@R@@RaTUaSU
;80    3.562E-03 YTRqXPAXU@@R@@RAYUAXU
;80 M1 3.562E-03 YTRqXPQTU@@R@@RQUUQTU
;80    4.000E-03 IFRB@PQGU@@R@@RQHUQGU
;80    5.000E-03 HIRRPPvYT@@R@@RFgTvYT
;80    6.000E-03 gDRRgPtAT@@R@@RtITtAT
;80    8.000E-03 EiRCePBHT@@R@@RRDTBHT
;80    1.000E-02 DhRTYPQGT@@R@@RaBTQGT
;80    1.228E-02 D@Ru@PFfS@@R@@RgGSFgS
;80 L3 1.228E-02 D@Ru@PqTT@@R@@RqXTqTT
;80    1.321E-02 sQRUUPAST@@R@@RAWTAST
;80    1.421E-02 CRRE`PQGT@@R@@RaATQGT
;80 L2 1.421E-02 CRRE`PaST@@R@@RaVTaST
;80    1.452E-02 sDREgPQUT@@R@@RQXTQUT
;80    1.484E-02 cFRUePAWT@@R@@RQPTAWT
;80 L1 1.484E-02 cFRUePqPT@@R@@RqSTqPT
;80    1.500E-02 cBRUiPaUT@@R@@RaXTaUT
;80    2.000E-02 bGRViPGiS@@R@@RXBSW`S
;80    3.000E-02 qDRxEPrPS@@R@@RBdSrQS
;80    4.000E-02 XcQYDPaDS@@R@@RqDSaES
;80    5.000E-02 vCQiPPvWR@@R@@RWPRFgR
;80    6.000E-02 tTQIfPTAR@@R@@RdXRdAR
;80    8.000E-02 RhQA@QAfR@@R@@RbFRQfR
;80    8.310E-02 B`QA@QaWR@@R@@RBERqXR
;80 K  8.310E-02 B`QA@QHHR@@R@@RHWRXIR
;80    1.000E-01 BFQA@QTgR@@R@@ReHREGR
;80    1.500E-01 AAQYXPqQR@@R@@RQaRAaR
;80    2.000E-01 FCPIEPWeQ@@R@@RIVQHeQ
;80    3.000E-01 BhPXAPrTQ@@R@@RCcQSUQ
;80    4.000E-01 aXPwGPqBQ@@R@@RbBQBFQ
;80    5.000E-01 Q@PvYPgVP@@R@@RQVQAUQ
;80    6.000E-01 wTOvBPEAP@@R@@RaAQQCQ
;80    8.000E-01 DSOUXPbUP@@R@@RhXPhDP
;80    1.000E+00 BgOECPaWP@@R@@RViPvQP
;80    1.022E+00 rUOThPaPP@@R@@RFfPVXP
;80    1.250E+00 AeOTQPAHPcVN@@REaPeSP
;80    1.500E+00 aIOTAPgYOqTO@@RUHPEEP
;80    2.000E+00 w@NSQPdUOeGO@@RTWPTPP
;80    2.044E+00 G@NCWPDYOUXO@@RTTPDWP
;80    3.000E+00 cFNrWPBSOQGPiVLdAPTGP
;80    4.000E+00 AdNrAPQYOaXPSdMTGPTEP
;80    5.000E+00 QHNQiPQGORBPGcMdEPdCP
;80    6.000E+00 XHMqVPYGNBYPa@NtFPtEP
;80    7.000E+00 FAMQXPWQNBbPaRNTPPDYP
;80    8.000E+00 dPMATPvDNSAPBBNdTPdTP
;80    9.000E+00 cTMqCPEYNsHPBPNtYPtXP
;80    1.000E+01 ReMaCPDbNcSPrVNTdPTcP
;80    1.100E+01 BSMQEPtANCfPS@NEHPEHP
;80    1.200E+01 BEMAGPChNDGPCSNeBPeBP
;80    1.300E+01 qTMAAPSTNdGPsSNuFPuEP
;80    1.400E+01 QPMYXOcENDVPDBNEYPEYP
;80    1.500E+01 qAMIIOC@NdSPdINeQPeQP
;80    1.600E+01 QEMhVOrXNtYPTUNuSPuSP
;80    1.800E+01 IILWaOBTNEIPECNUePUeP
;80    2.000E+01 wFLw@ORGNuEPEVNVEPVEP
;80    2.200E+01 FILvXOQeNUXPEfNvDPvDP
;80    2.400E+01 UBLvCOqWNE`PfBNVQPVQP
;80    2.600E+01 tFLUeOaRNF@PVUNfWPfWP
;80    2.800E+01 sVLeQOQPNVHPFfNFbPFbP
;80    3.000E+01 cGLuAOqINvDPWENVfPVfP
;80    4.000E+01 AdLdBOABNGBPxBNWTPWTP
;80    5.000E+01 QHLSROHHMWSPi@NWhPWhP
;80    6.000E+01 XHKCDOfXMWbPY`NxCPxCP
;80    8.000E+01 dPKrIOTfMXPPAIOHePHeP
;80    1.000E+02 ReKQiOSdMX`PQGOiBPiBP
;80    1.500E+02 qAKARObQMYTPaIOIaPIaP
;80    2.000E+02 wFJQAOQeMYbPqGOABQABQ
;80    3.000E+02 cGJGgNaIMADQAVOAFQAFQ
;80    4.000E+02 AdJVFNiXLAFQQQOAHQAHQ
;80    5.000E+02 QHJU@NwSLAHQQUOQ@QQ@Q
;80    6.000E+02 XHItGNFTLAIQQWOQAQQAQ
;80    8.000E+02 dPICQNDbLQAQaQOQBQQBQ
;80    1.000E+03 ReIBaNCfLQBQaSOQCQQCQ
;80    1.500E+03 qAIQfNRWLQCQaWOQEQQEQ
;80    2.000E+03 wFHQRNQcLQDQaYOQFQQFQ
;80    3.000E+03 cGHAENaHLQEQqQOQFQQFQ
;80    4.000E+03 AdHXDMiSKQEQqROQGQQGQ
;80    5.000E+03 QHHfVMwPKQEQqSOQGQQGQ
;80    6.000E+03 XHGeTMFRKQFQqTOQGQQGQ
;80    8.000E+03 dPGtEMDaKQFQqUOQHQQHQ
;80    1.000E+04 ReGSUMCeKQFQqUOQHQQHQ
;80    1.500E+04 qAGBUMRWKQFQqVOQHQQHQ
;80    2.000E+04 wFFAiMQbKQFQqVOQHQQHQ
;80    3.000E+04 cGFq@MaHKQGQqVOQHQQHQ
;80    4.000E+04 AdFYiLiRJQGQqWOQHQQHQ
;80    5.000E+04 QHFXCLgYJQGQqWOQHQQHQ
;80    6.000E+04 XHEFhLFQJQGQqWOQHQQHQ
;80    8.000E+04 dPEeGLDaJQGQqWOQHQQHQ
;80    1.000E+05 ReEdILCeJQGQqWOQHQQHQ
;==== ELEMENT  81
;81    1.000E-03 aDScROTiU@@R@@REAUTiU
;81    1.500E-03 QISVYObEU@@R@@RbFUbEU
;81    2.000E-03 QCSYROaBU@@R@@RaCUaBU
;81    2.389E-03 AISQGPhDT@@R@@RxEThDT
;81 M5 2.389E-03 AISQGPQBU@@R@@RQCUQBU
;81    2.437E-03 AHSa@PQQU@@R@@RQRUQQU
;81    2.485E-03 AHSaBPBCU@@R@@RBDUBCU
;81 M4 2.485E-03 AHSaBPrDU@@R@@RrFUrDU
;81    2.711E-03 AESqDPRDU@@R@@RREURDU
;81    2.957E-03 ABSAXPQeU@@R@@RQfUQeU
;81 M3 2.957E-03 ABSAXPbFU@@R@@RbGUbFU
;81    3.000E-03 ABSQPPRHU@@R@@RRIURHU
;81    3.416E-03 ySRqRPQXU@@R@@RQYUQXU
;81 M2 3.416E-03 ySRqRPaXU@@R@@RaYUaXU
;81    3.557E-03 YWRqYPQRU@@R@@RQSUQRU
;81    3.704E-03 IQRAfPqHU@@R@@RqIUqHU
;81 M1 3.704E-03 IQRAfPATU@@R@@RAUUATU
;81    4.000E-03 Y@RBAPa@U@@R@@RaAUa@U
;81    5.000E-03 XCRRPPViT@@R@@RGGTViT
;81    6.000E-03 gIRRfPDTT@@R@@RTRTDTT
;81    8.000E-03 UcRCbPRET@@R@@RbATRET
;81    1.000E-02 TbRTUPaAT@@R@@RaFTaAT
;81    1.266E-02 SaRuEPVVS@@R@@RVfSVVS
;81 L3 1.266E-02 SaRuEPaUT@@R@@RaYTaUT
;81    1.364E-02 cRReQPqET@@R@@RqITqET
;81    1.470E-02 sCREgPQ@T@@R@@RQDTQAT
;81 L2 1.470E-02 sCREgPQTT@@R@@RQWTQTT
;81    1.500E-02 cFRUdPAVT@@R@@RQPTAVT
;81    1.535E-02 SGRFBPqHT@@R@@RARTqHT
;81 L1 1.535E-02 SGRFBPaPT@@R@@RaSTaPT
;81    2.000E-02 r@RVbPXBS@@R@@RxFSXCS
;81    3.000E-02 qFRhGPrYS@@R@@RRcSrYS
;81    4.000E-02 IDQIFPaIS@@R@@RqISaIS
;81    5.000E-02 FSQYRPGAR@@R@@RwURWAR
;81    6.000E-02 DaQyWPdFR@@R@@RDdRtFR
;81    8.000E-02 CBQYePQcR@@R@@RrCRBCR
;81    8.553E-02 rQQYfPaQR@@R@@RQhRqPR
;81 K  8.553E-02 rQQYfPgXR@@R@@RHERwXR
;81    1.000E-01 BIQYbPEIR@@R@@REPRUIR
;81    1.500E-01 ACQYQPqVR@@R@@RQfRAeR
;81    2.000E-01 VCPXiPXHQ@@R@@RiYQIHQ
;81    3.000E-01 RbPHEPBbQ@@R@@RSbQcSQ
;81    4.000E-01 qQPwBPqFQ@@R@@RbGQR@Q
;81    5.000E-01 QBPvTPWdP@@R@@RQXQAWQ
;81    6.000E-01 GhOfHPUIP@@R@@RaCQQEQ
;81    8.000E-01 TQOUUPrUP@@R@@RxUPx@P
;81    1.000E+00 RbOE@PqTP@@R@@RGCPvTP
;81    1.022E+00 B`OTePaVP@@R@@RFiPfQP
;81    1.250E+00 AiODXPQBPsQN@@REcPeTP
;81    1.500E+00 qBODHPWhOqWO@@RUIPEFP
;81    2.000E+00 GUNCYPDcOuEO@@RTXPTQP
;81    2.044E+00 WCNCTPdVOeVO@@RTUPDXP
;81    3.000E+00 sBNrUPRSOQHPiPLdAPTHP
;81    4.000E+00 AgNbIPaUOaYPSaMTGPTFP
;81    5.000E+00 a@NQhPaAORCPwXMdEPdDP
;81    6.000E+00 xDMqUPYPNRPPQINtGPtFP
;81    7.000E+00 VCMQWPwXNBcPaPNTPPTPP
;81    8.000E+00 dYMASPVWNSBPB@NdUPdTP
;81    9.000E+00 sQMqBPeXNsIPrHND`PtYP
;81    1.000E+01 C@MaBPE@NcTPrTNTdPTdP
;81    1.100E+01 BXMQDPDVNCgPCHNEIPEHP
;81    1.200E+01 BIMAGPDBNDHPCQNeCPeCP
;81    1.300E+01 qXMAAPcVNdHPsQNuGPuFP
;81    1.400E+01 QSMYROsFNDWPSiNUPPUPP
;81    1.500E+01 qDMICOS@NdTPdFNeRPeRP
;81    1.600E+01 QGMhPOBhNDaPTRNuTPuTP
;81    1.800E+01 iGLGfORRNU@PTiNUfPUfP
;81    2.000E+01 WQLgEObDNuFPERNVFPVFP
;81    2.200E+01 fALvTOBBNePPEbNvEPvEP
;81    2.400E+01 eBLfIOAcNEaPVHNVRPVRP
;81    2.600E+01 DTLUaOaXNFAPVQNfYPfYP
;81    2.800E+01 CcLUWOQUNVIPFaNFdPFcP
;81    3.000E+01 sDLeHOATNvFPW@NVhPVgP
;81    4.000E+01 AhLd@OAFNGDPhFNWVPWUP
;81    5.000E+01 a@LSPOxGMWUPYDNH@PH@P
;81    6.000E+01 xDKCBOVbMWdPIcNxEPxEP
;81    8.000E+01 dYKrHOUDMXRPAIOHgPHgP
;81    1.000E+02 CAKQhODHMXbPQFOiDPiDP
;81    1.500E+02 qDKAQOrPMYWPaHOIdPIdP
;81    2.000E+02 WQJQ@OBBMYePqFOABQABQ
;81    3.000E+02 sDJGbNqDMADQAUOAFQAFQ
;81    4.000E+02 AhJVBNA@MAFQQPOAIQAIQ
;81    5.000E+02 a@JEGNHALAHQQTOQ@QQ@Q
;81    6.000E+02 xDItDNfVLAIQQVOQAQQAQ
;81    8.000E+02 dYIsINTiLQAQaPOQCQQCQ
;81    1.000E+03 CAIrYNSiLQBQaROQDQQDQ
;81    1.500E+03 qDIQeNbVLQCQaVOQEQQEQ
;81    2.000E+03 WQHQQNQiLQDQaXOQFQQFQ
;81    3.000E+03 sDHAENqCLQEQqPOQGQQGQ
;81    4.000E+03 AhHHIMYfKQEQqQOQGQQGQ
;81    5.000E+03 a@HfQMWgKQFQqROQGQQGQ
;81    6.000E+03 xDGeQMfTKQFQqSOQHQQHQ
;81    8.000E+03 dYGtBMThKQFQqSOQHQQHQ
;81    1.000E+04 CAGSSMShKQFQqTOQHQQHQ
;81    1.500E+04 qDGBTMbVKQGQqTOQHQQHQ
;81    2.000E+04 WQFAgMQiKQGQqUOQHQQHQ
;81    3.000E+04 sDFaIMqCKQGQqUOQIQQIQ
;81    4.000E+04 AhFYbLYfJQGQqUOQIQQIQ
;81    5.000E+04 a@FHHLWfJQGQqUOQIQQIQ
;81    6.000E+04 xDEFcLfTJQGQqVOQIQQIQ
;81    8.000E+04 dYEeDLThJQGQqVOQIQQIQ
;81    1.000E+05 CAEdFLShJQGQqVOQIQQIQ
;==== ELEMENT  82
;82    1.000E-03 aESSYOe@U@@R@@ReAUe@U
;82    1.500E-03 a@SfPOrDU@@R@@RrFUrDU
;82    2.000E-03 QDSiROaGU@@R@@RaIUaGU
;82    2.484E-03 AISaDPW`T@@R@@RHATW`T
;82 M5 2.484E-03 AISaDPqHU@@R@@RAPUqHU
;82    2.534E-03 AHSaGPaTU@@R@@RaUUaTU
;82    2.586E-03 AHSq@PQcU@@R@@RQdUQcU
;82 M4 2.586E-03 AHSq@PBTU@@R@@RBUUBTU
;82    3.000E-03 ACSQRPQeU@@R@@RQfUQeU
;82    3.066E-03 ABSQVPAeU@@R@@RAfUAeU
;82 M3 3.066E-03 ABSQVPRDU@@R@@RREURDU
;82    3.301E-03 YcRaXPqXU@@R@@RqYUqXU
;82    3.554E-03 iURAaPAYU@@R@@RQPUAYU
;82 M2 3.554E-03 iURAaPQWU@@R@@RQXUQXU
;82    3.699E-03 YPRAiPASU@@R@@RATUASU
;82    3.851E-03 yDRQfPq@U@@R@@RqAUq@U
;82 M1 3.851E-03 yDRQfPqFU@@R@@RqGUqFU
;82    4.000E-03 YHRBDPaDU@@R@@RaEUaDU
;82    5.000E-03 hARRRPgBT@@R@@Rw@TgBT
;82    6.000E-03 wFRRgPdPT@@R@@RdWTdPT
;82    8.000E-03 F@RCaPbCT@@R@@RbITbCT
;82    1.000E-02 ThRTTPaFT@@R@@RqATaFT
;82    1.304E-02 CeRETPvAS@@R@@RvPSvBS
;82 L3 1.304E-02 CeRETPQXT@@R@@RaRTQXT
;82    1.500E-02 sARUbPAHT@@R@@RQBTAHT
;82    1.520E-02 cFRUfPADT@@R@@RAHTAET
;82 L2 1.520E-02 cFRUfPAUT@@R@@RAYTAUT
;82    1.553E-02 SHRFDPqHT@@R@@RAQTqHT
;82    1.586E-02 S@RVAPqAT@@R@@RqDTqAT
;82 L1 1.586E-02 S@RVAPQRT@@R@@RQUTQRT
;82    2.000E-02 rDRV`PHPS@@R@@RhTSHPS
;82    3.000E-02 qHRhCPBiS@@R@@RCCSBiS
;82    4.000E-02 i@QIBPqCS@@R@@RATSqDS
;82    5.000E-02 VUQIXPgIR@@R@@RHDRwIR
;82    6.000E-02 T`QySPDSR@@R@@REBRTSR
;82    8.000E-02 CHQYbPBAR@@R@@RBRRRAR
;82    8.800E-02 bSQYcPQUR@@R@@RQaRaUR
;82 K  8.800E-02 bSQYcPwBR@@R@@RgXRGRR
;82    1.000E-01 RCQIiPeDR@@R@@RUURuDR
;82    1.500E-01 AEQIXPAaR@@R@@RBARQaR
;82    2.000E-01 fFPXgPHVQ@@R@@RYiQyFQ
;82    3.000E-01 RiPHDPRcQ@@R@@RDCQsSQ
;82    4.000E-01 qUPwAPARQ@@R@@RrBQREQ
;82    5.000E-01 QDPvSPhFP@@R@@RaQQQPQ
;82    6.000E-01 HFOfFPEQP@@R@@RaEQQGQ
;82    8.000E-01 dROUTPBgP@@R@@RHgPHQP
;82    1.000E+00 RiOTiPAaP@@R@@RW@PF`P
;82    1.022E+00 BgOTdPqSP@@R@@RVfPfXP
;82    1.250E+00 QcODXPQGPsXN@@REhPeXP
;82    1.500E+00 qEODGPxBOAaO@@ReBPEIP
;82    2.000E+00 gSNCXPECOEUO@@RdQPTSP
;82    2.044E+00 w@NCTPDeOuWO@@RTXPTPP
;82    3.000E+00 CQNrTPbSOQIPYYLdCPd@P
;82    4.000E+00 QbNbIPqROqQPSaMd@PTHP
;82    5.000E+00 aCNQhPaFOREPwWMdGPdFP
;82    6.000E+00 XTMqUPIiNRRPQINtIPtHP
;82    7.000E+00 fHMQWPX@NBePaPNTSPTRP
;82    8.000E+00 DaMASPFdNSEPB@NdWPdWP
;82    9.000E+00 C`MqBPUaNCRPrHNDbPDbP
;82    1.000E+01 CHMaBPe@NcWPrTNTgPTgP
;82    1.100E+01 RTMQDPdTNS`PCHNUBPUAP
;82    1.200E+01 RDMAGPTINTBPCPNeFPeFP
;82    1.300E+01 AbMA@PCaNtBPsPNEPPEPP
;82    1.400E+01 QWMYPOSPNTPPSiNUSPUSP
;82    1.500E+01 qGMIBOcCNdXPdFNeVPeVP
;82    1.600E+01 a@MXYOC@NDdPTQNuXPuXP
;82    1.800E+01 YPLGeObSNUDPThNF@PF@P
;82    2.000E+01 wPLgDOrCNEPPEQNfAPf@P
;82    2.200E+01 vFLvSOR@NeTPE`NvIPvIP
;82    2.400E+01 uDLfIOQaNEfPVFNVWPVWP
;82    2.600E+01 TULU`OqUNFFPFYNvSPvSP
;82    2.800E+01 ScLUWOaQNfDPF`NFhPFhP
;82    3.000E+01 CRLeGOQPNFQPGHNGBPGBP
;82    4.000E+01 QbLTIOQ@NW@PhENgQPgQP
;82    5.000E+01 aCLSPOxPMgQPYBNHFPHFP
;82    6.000E+01 XUKCAOWIMH@PIaNHQPHQP
;82    8.000E+01 DaKrHOuDMXXPAHOXcPXcP
;82    1.000E+02 CHKQgOdDMXiPQFOyAPyAP
;82    1.500E+02 qGKAPOBaMiTPaHOYaPYaP
;82    2.000E+02 wPJQ@OR@MA@QqEOACQACQ
;82    3.000E+02 CRJGaNqIMAEQATOAGQAGQ
;82    4.000E+02 QbJVANADMAGQQPOAIQAIQ
;82    5.000E+02 aCJEFNxBLAIQQSOQAQQAQ
;82    6.000E+02 XUItCNVcLQ@QQVOQBQQBQ
;82    8.000E+02 DaIsHNUILQBQaPOQDQQDQ
;82    1.000E+03 CHIrXNTELQCQaROQEQQEQ
;82    1.500E+03 qGIQdNrVLQDQaUOQFQQFQ
;82    2.000E+03 wPHQPNBGLQEQaWOQGQQGQ
;82    3.000E+03 CRHAENqHLQFQqPOQHQQHQ
;82    4.000E+03 QbHHHMADLQFQqQOQHQQHQ
;82    5.000E+03 aCHfPMhHKQGQqROQHQQHQ
;82    6.000E+03 XUGePMV`KQGQqROQIQQIQ
;82    8.000E+03 DaGtAMUHKQGQqSOQIQQIQ
;82    1.000E+04 CHGSRMTDKQGQqSOQIQQIQ
;82    1.500E+04 qGGBSMrVKQGQqTOQIQQIQ
;82    2.000E+04 wPFAgMBGKQHQqTOQIQQIQ
;82    3.000E+04 CRFaIMqHKQHQqUOa@Qa@Q
;82    4.000E+04 QbFYaLACKQHQqUOa@Qa@Q
;82    5.000E+04 aCFHGLhHJQHQqUOa@Qa@Q
;82    6.000E+04 XUEFbLV`JQHQqUOa@Qa@Q
;82    8.000E+04 DaEeCLUGJQHQqUOa@Qa@Q
;82    1.000E+05 CHEdFLTDJQHQqUOa@Qa@Q
;==== ELEMENT  83
;83    1.000E-03 aGSSPOESU@@R@@RETUESU
;83    1.500E-03 aBSFYOBVU@@R@@RBWUBVU
;83    2.000E-03 QFSYUOqDU@@R@@RqEUqDU
;83    2.580E-03 AISq@PgRT@@R@@RwSTgRT
;83 M5 2.580E-03 AISq@PqWU@@R@@RqXUqWU
;83    2.633E-03 AHSqCPAaU@@R@@RAbUAaU
;83    2.688E-03 AHSqFPAeU@@R@@RAfUAeU
;83 M4 2.688E-03 AHSqFPRWU@@R@@RRXURWU
;83    3.000E-03 ADSQTPBDU@@R@@RBEUBDU
;83    3.177E-03 ABSaSPqVU@@R@@RqWUqVU
;83 M3 3.177E-03 ABSaSPBDU@@R@@RBEUBDU
;83    3.427E-03 YeRqWPaYU@@R@@RqPUaYU
;83    3.696E-03 iRRQaPAPU@@R@@RAQUAPU
;83 M2 3.696E-03 iRRQaPAYU@@R@@RQPUAYU
;83    3.845E-03 IPRQhPqFU@@R@@RqFUqFU
;83    3.999E-03 y@RBFPaCU@@R@@RaDUaCU
;83 M1 3.999E-03 y@RBFPaIU@@R@@Rq@UaIU
;83    4.000E-03 y@RBFPaIU@@R@@Rq@UaIU
;83    5.000E-03 xBRRTPWPT@@R@@RWXTWPT
;83    6.000E-03 GWRRiPtXT@@R@@RDfTtXT
;83    8.000E-03 V@RCbPrBT@@R@@RrHTrBT
;83    1.000E-02 EGRTUPqAT@@R@@RqFTqAT
;83    1.342E-02 CaRUUPV@S@@R@@RFYSVAS
;83 L3 1.342E-02 CaRUUPQRT@@R@@RQVTQRT
;83    1.500E-02 sGRUcPQCT@@R@@RQFTQCT
;83    1.571E-02 c@RFIPYdS@@R@@RACTYeS
;83 L2 1.571E-02 c@RFIPqHT@@R@@RARTqHT
;83    1.605E-02 SBRVFPqBT@@R@@RqETqBT
;83    1.639E-02 CERfDPaET@@R@@RaHTaET
;83 L1 1.639E-02 CERfDPAUT@@R@@RAXTAUT
;83    2.000E-02 rIRVaPxQS@@R@@RXeSxQS
;83    3.000E-02 AQRhCPC@S@@R@@RSESCAS
;83    4.000E-02 IQQICPqIS@@R@@RQPSAPS
;83    5.000E-02 vPQIYPgQR@@R@@RxHRwQR
;83    6.000E-02 EBQyUPdSR@@R@@ReCRtSR
;83    8.000E-02 SEQYdPRAR@@R@@RRRRbAR
;83    9.053E-02 RWQYdPQPR@@R@@RAfRaPR
;83 K  9.053E-02 RWQYdPGBR@@R@@RwHRWBR
;83    1.000E-01 RHQYaPERR@@R@@RuTRURR
;83    1.500E-01 AHQYQPAhR@@R@@RBHRQgR
;83    2.000E-01 FRPXiPxYQ@@R@@RACRiYQ
;83    3.000E-01 CGPHFPCEQ@@R@@RTFQCfQ
;83    4.000E-01 qYPwCPAXQ@@R@@RrIQbAQ
;83    5.000E-01 QGPvUPhSP@@R@@RaVQQTQ
;83    6.000E-01 hHOfHPeUP@@R@@RaHQQIQ
;83    8.000E-01 tUOUVPCAP@@R@@RIDPXVP
;83    1.000E+00 CGOEAPQ`P@@R@@RgAPVaP
;83    1.022E+00 ReOTfPAaP@@R@@RGGPvWP
;83    1.250E+00 QiODYPaBPCgN@@RUePuVP
;83    1.500E+00 qIODIPxROAfO@@ReHPUEP
;83    2.000E+00 GeNSPPeGOUXO@@RdVPTXP
;83    2.044E+00 WRNCUPEHOU`O@@RdSPTUP
;83    3.000E+00 SQNrUPrUOaAPiRLdHPdDP
;83    4.000E+00 QhNr@PA`OqTPSbMdDPdBP
;83    5.000E+00 aGNQiPqBORHPwYMtBPt@P
;83    6.000E+00 xYMqUPACORVPa@NDTPDSP
;83    7.000E+00 FVMQXPHWNBiPaQNTXPTWP
;83    8.000E+00 TeMATPWFNSIPBANtSPtRP
;83    9.000E+00 SaMqBPVHNCWPrINDhPDgP
;83    1.000E+01 SGMaBPETNsRPrUNECPEBP
;83    1.100E+01 bRMQDPDeNSePCINUGPUGP
;83    1.200E+01 b@MAGPtGNTGPCQNuBPuAP
;83    1.300E+01 AhMAAPShNtGPsQNEVPEVP
;83    1.400E+01 aRMYTOcUNTVPD@NUYPUYP
;83    1.500E+01 AQMIEOsGNtTPdGNuRPuRP
;83    1.600E+01 aDMhROSDNT`PTSNEdPEdP
;83    1.800E+01 yXLGhOrTNe@PE@NFGPFGP
;83    2.000E+01 WbLgGOBTNEWPESNfHPfGP
;83    2.200E+01 VULvUORINuQPEbNFWPFWP
;83    2.400E+01 UPLvAOQiNUcPVHNfUPfUP
;83    2.600E+01 dYLUbOAcNVDPVQNFaPFaP
;83    2.800E+01 DDLUYOaXNvBPFbNVfPVfP
;83    3.000E+01 SRLeIOQVNFYPW@NWAPWAP
;83    4.000E+01 QhLd@OQENWHPhGNwPPwPP
;83    5.000E+01 aGLSQOIIMwPPYENXEPXEP
;83    6.000E+01 H`KCBOWQMX@PIdNXQPXQP
;83    8.000E+01 TeKrHOUXMhYPAIOIDPIDP
;83    1.000E+02 SGKQhODSMY@PQFOIRPIRP
;83    1.500E+02 AQKAQORcMyVPaHOA@QA@Q
;83    2.000E+02 WbJQAORIMAAQqFOADQADQ
;83    3.000E+02 SRJGdNAUMAFQAUOAHQAHQ
;83    4.000E+02 QhJVDNAIMAIQQPOQAQQAQ
;83    5.000E+02 aGJEHNhYLQ@QQTOQBQQBQ
;83    6.000E+02 H`ItENgDLQAQQVOQCQQCQ
;83    8.000E+02 TeICPNERLQCQaPOQEQQEQ
;83    1.000E+03 SGIrYNtCLQDQaROQFQQFQ
;83    1.500E+03 AQIQeNBiLQFQaVOQGQQGQ
;83    2.000E+03 WbHQQNRFLQFQaXOQHQQHQ
;83    3.000E+03 SRHAENATLQGQqPOQIQQIQ
;83    4.000E+03 QhHXAMAHLQHQqQOa@Qa@Q
;83    5.000E+03 aGHfSMhUKQHQqROa@Qa@Q
;83    6.000E+03 H`GeRMgAKQHQqSOa@Qa@Q
;83    8.000E+03 TeGtCMEQKQIQqSOa@Qa@Q
;83    1.000E+04 SGGSTMtCKQIQqTOa@Qa@Q
;83    1.500E+04 AQGBTMBhKQIQqTOaAQaAQ
;83    2.000E+04 WbFAhMRFKQIQqUOaAQaAQ
;83    3.000E+04 SRFq@MATKQIQqUOaAQaAQ
;83    4.000E+04 QhFYdLAHKQIQqUOaAQaAQ
;83    5.000E+04 aGFX@LhUJQIQqVOaAQaAQ
;83    6.000E+04 H`EFeLgAJQIQqVOaAQaAQ
;83    8.000E+04 TeEeELEPJQIQqVOaAQaAQ
;83    1.000E+05 SGEdGLtBJQIQqVOaAQaAQ
;==== ELEMENT  84
;84    1.000E-03 q@SCYOuQU@@R@@RuRUuQU
;84    1.500E-03 aESVVORYU@@R@@RbPURYU
;84    2.000E-03 QHSyROAQU@@R@@RARUAQU
;84    2.683E-03 Q@SqIPwGT@@R@@RGXTwGT
;84 M5 2.683E-03 Q@SqIPRIU@@R@@RbAURIU
;84    2.740E-03 AISARPQgU@@R@@RQhUQgU
;84    2.798E-03 AISAVPqVU@@R@@RqXUqVU
;84 M4 2.798E-03 AISAVPrPU@@R@@RrQUrPU
;84    3.000E-03 AFSQXPRDU@@R@@RREURDU
;84    3.302E-03 ACSqTPaXU@@R@@RaYUaXU
;84 M3 3.302E-03 ACSqTPQeU@@R@@RQfUQeU
;84    3.567E-03 YfRAiPaQU@@R@@RaRUaQU
;84    3.854E-03 iURBDPqCU@@R@@RqDUqCU
;84 M2 3.854E-03 iURBDPAQU@@R@@RARUAQU
;84    4.000E-03 IYRRAPaIU@@R@@Rq@UaIU
;84    4.149E-03 yCRRIPQHU@@R@@RQIUQHU
;84 M1 4.149E-03 yCRRIPaCU@@R@@RaDUaCU
;84    5.000E-03 XQRbPPGeT@@R@@RWcTGeT
;84    6.000E-03 gURCEPEAT@@R@@REITEAT
;84    8.000E-03 fERCgPBST@@R@@RBYTBST
;84    1.000E-02 UIRdPPqGT@@R@@RASTqHT
;84    1.381E-02 sYRuQPUeS@@R@@RvDSUfS
;84 L3 1.381E-02 sYRuQPAWT@@R@@RQQTAXT
;84    1.500E-02 CWRF@PQHT@@R@@RaBTQHT
;84    1.624E-02 SGRfGPYSS@@R@@RIeSYSS
;84 L2 1.624E-02 SGRfGPqCT@@R@@RqFTqCT
;84    1.659E-02 CIRvEPaFT@@R@@RaITaFT
;84    1.694E-02 CBRFRPa@T@@R@@RaCTa@T
;84 L1 1.694E-02 CBRFRPqIT@@R@@RARTqIT
;84    2.000E-02 BVRVhPY@S@@R@@RyESYAS
;84    3.000E-02 AURx@PSES@@R@@Rs@SSFS
;84    4.000E-02 iYQYAPAVS@@R@@RQWSAWS
;84    5.000E-02 VaQYXPHAR@@R@@RH`RXAR
;84    6.000E-02 UHQIdPDhR@@R@@RUPRThR
;84    8.000E-02 cEQA@QbBR@@R@@RbURrBR
;84    9.311E-02 RSQA@QAWR@@R@@RAbRQWR
;84 K  9.311E-02 RSQA@QvYR@@R@@RWDRFiR
;84    1.000E-01 bEQA@QeWR@@R@@RUiRuWR
;84    1.500E-01 QAQiQPQfR@@R@@RRGRBFR
;84    2.000E-01 fTPIIPi@Q@@R@@RAHRAAR
;84    3.000E-01 SGPXEPc@Q@@R@@RtCQDBQ
;84    4.000E-01 AfPGRPQVQ@@R@@RBXQr@Q
;84    5.000E-01 aBPFcPIIP@@R@@RqQQQYQ
;84    6.000E-01 XYOvFPUfP@@R@@RqBQaCQ
;84    8.000E-01 TbOeRPSGP@@R@@RiHPxYP
;84    1.000E+00 SIOEGPB@P@@R@@RwIPGGP
;84    1.022E+00 CFOEBPQbP@@R@@RgDPVcP
;84    1.250E+00 BFOTUPaIPD@N@@RFIPEhP
;84    1.500E+00 ATOTDPi@OQbO@@RuIPeEP
;84    2.000E+00 XDNSTPUVOuVO@@RtUPdWP
;84    2.044E+00 G`NCYPuFOFIO@@RtRPdTP
;84    3.000E+00 cTNrYPRaOaEPySLtFPtCP
;84    4.000E+00 BENrCPQ`OqXPSgMtBPt@P
;84    5.000E+00 qANBAPqIObCPGiMDPPtIP
;84    6.000E+00 YCMqXPAIObRPaANTRPTQP
;84    7.000E+00 vQMaPPXcNRfPaSNdWPdVP
;84    8.000E+00 UDMAUPWTNcFPBCNDbPDaP
;84    9.000E+00 DFMqDPVRNSTPBRNTgPTgP
;84    1.000E+01 cIMaDPuSNC`PrXNUBPUBP
;84    1.100E+01 rRMQEPUANDCPSCNeGPeGP
;84    1.200E+01 bHMAHPdQNdFPCUNERPERP
;84    1.300E+01 QeMABPd@NDVPsUNUWPUVP
;84    1.400E+01 aXMiUOCeNdVPDENuPPuPP
;84    1.500E+01 AVMYFOSVNDdPtBNEcPEcP
;84    1.600E+01 aIMxSOs@NEAPTXNUfPUfP
;84    1.800E+01 ABMWhOBiNuAPEFNVIPVIP
;84    2.000E+01 hBLwEORWNUXPEYNFPPFPP
;84    2.200E+01 F`LFcOrANEcPEiNfPPVYP
;84    2.400E+01 uQLvHOR@NFEPfENvXPvXP
;84    2.600E+01 DgLUiOQbNfFPVYNVePVeP
;84    2.800E+01 d@LeUOqWNFUPV`NW@PW@P
;84    3.000E+01 cVLuEOaUNfRPWHNgEPgEP
;84    4.000E+01 BFLdFOaANwCPxFNGfPGfP
;84    5.000E+01 qBLSUOYWMGfPiENxBPxBP
;84    6.000E+01 YDKCFOWaMhGPYdNhXPhXP
;84    8.000E+01 UDKBQOEgMHgPQ@OiCPiCP
;84    1.000E+02 cIKB@OdWMiIPQGOiQPiQP
;84    1.500E+02 AVKASOCIMYfPq@OABQABQ
;84    2.000E+02 hBJQBOr@MADQqGOAFQAFQ
;84    3.000E+02 cVJWcNQSMAHQAVOQ@QQ@Q
;84    4.000E+02 BFJfANQDMQAQQROQCQQCQ
;84    5.000E+02 qBJUDNYELQCQQUOQEQQEQ
;84    6.000E+02 YDIDPNgRLQDQQXOQFQQFQ
;84    8.000E+02 UDICTNuQLQEQaROQGQQGQ
;84    1.000E+03 cIIBcNTVLQFQaTOQHQQHQ
;84    1.500E+03 AVIQgNCDLQHQaXOa@Qa@Q
;84    2.000E+03 hBHQSNbHLQIQqPOaAQaAQ
;84    3.000E+03 cVHAFNQRLa@QqROaBQaBQ
;84    4.000E+03 BFHh@MQDLa@QqSOaBQaBQ
;84    5.000E+03 qBHvQMYAKaAQqTOaBQaBQ
;84    6.000E+03 YDGeYMWYKaAQqUOaCQaCQ
;84    8.000E+03 UDGtHMeYKaAQqUOaCQaCQ
;84    1.000E+04 cIGSXMTUKaAQqVOaCQaCQ
;84    1.500E+04 AVGBWMCCKaAQqVOaCQaCQ
;84    2.000E+04 hBFQ`MbHKaBQqWOaCQaCQ
;84    3.000E+04 cVFqAMQRKaBQqWOaDQaDQ
;84    4.000E+04 BFFAAMQDKaBQqWOaDQaDQ
;84    5.000E+04 qBFh@LY@JaBQqXOaDQaDQ
;84    6.000E+04 YDEVcLWXJaBQqXOaDQaDQ
;84    8.000E+04 UDEuALeYJaBQqXOaDQaDQ
;84    1.000E+05 cIEtBLTUJaBQqXOaDQaDQ
;==== ELEMENT  85
;85    1.000E-03 qBSCTOEeU@@R@@REgUEeU
;85    1.021E-03 qBSSVOeTU@@R@@ReUUeTU
;85    1.042E-03 qBScXOESU@@R@@RETUESU
;85 N1 1.042E-03 qBScXOUTU@@R@@RUUUUTU
;85    1.500E-03 aGSVTOrRU@@R@@RrSUrRU
;85    2.000E-03 a@SyXOAXU@@R@@RAYUAXU
;85    2.787E-03 Q@SAWPWBT@@R@@RgCTWBT
;85 M5 2.787E-03 Q@SAWPBRU@@R@@RBSUBRU
;85    2.847E-03 Q@SQQPBAU@@R@@RBBUBAU
;85    2.909E-03 AISQUPaXU@@R@@RaYUaXU
;85 M4 2.909E-03 AISQUPrXU@@R@@RrYUrXU
;85    3.000E-03 AHSaPPbDU@@R@@RbEUbDU
;85    3.426E-03 ACSAdPaPU@@R@@RaQUaPU
;85 M3 3.426E-03 ACSAdPAfU@@R@@RAgUAfU
;85    4.000E-03 iTRREPaGU@@R@@RaHUaGU
;85    4.008E-03 iSRRFPaFU@@R@@RaGUaFU
;85 M2 4.008E-03 iSRRFPqDU@@R@@RqEUqDU
;85    4.160E-03 IWRbCPaBU@@R@@RaCUaBU
;85    4.317E-03 yARrAPQBU@@R@@RQCUQBU
;85 M1 4.317E-03 yARrAPQGU@@R@@RQGUQGU
;85    5.000E-03 hURbTPXFT@@R@@RhETXGT
;85    6.000E-03 wXRCIPeBT@@R@@Ru@TeBT
;85    8.000E-03 vGRSaPRTT@@R@@RbPTRTT
;85    1.000E-02 u@RdTPATT@@R@@RAYTATT
;85    1.421E-02 sVREePuXS@@R@@RVFSuYS
;85 L3 1.421E-02 sVREePART@@R@@RAVTART
;85    1.500E-02 STRFDPaDT@@R@@RaHTaDT
;85    1.678E-02 SBRFRPY@S@@R@@RIRSY@S
;85 L2 1.678E-02 SBRFRPaGT@@R@@Rq@TaGT
;85    1.714E-02 CDRFYPaAT@@R@@RaDTaAT
;85    1.749E-02 RgRVVPQET@@R@@RQHTQET
;85 L1 1.749E-02 RgRVVPqCT@@R@@RqFTqCT
;85    2.000E-02 RRRGAPITS@@R@@RyPSIUS
;85    3.000E-02 AXRxDPcIS@@R@@RCTScIS
;85    4.000E-02 YcQYEPQSS@@R@@RaTSQTS
;85    5.000E-02 W@QiRPxIR@@R@@RYIRHXR
;85    6.000E-02 uBQIiPUBR@@R@@RuUReBR
;85    8.000E-02 sDQAAQrCR@@R@@RrWRBSR
;85    9.573E-02 BYQAAQASR@@R@@RqXRQSR
;85 K  9.573E-02 BYQAAQVTR@@R@@RFiRfUR
;85    1.000E-01 rAQAAQEdR@@R@@RVGRUdR
;85    1.500E-01 QDQiWPBDR@@R@@RbERRCR
;85    2.000E-01 FcPYEPYXQ@@R@@RQBRAER
;85    3.000E-01 cGPh@PsDQ@@R@@RDYQTFQ
;85    4.000E-01 QaPGWPaSQ@@R@@RRVQrGQ
;85    5.000E-01 aEPFhPYRP@@R@@RqWQaTQ
;85    6.000E-01 HeOFPPfEP@@R@@RqEQaGQ
;85    8.000E-01 EHOeVPsCP@@R@@RYPPXiP
;85    1.000E+00 cIOUAPR@P@@R@@RWTPgAP
;85    1.022E+00 SEOEEPBAP@@R@@RwHPGFP
;85    1.250E+00 RCOTXPqFPTAN@@RVIPUhP
;85    1.500E+00 AXOTGPiVOQhO@@REXPuCP
;85    2.000E+00 HQNSVPEdOUaO@@RDbPtTP
;85    2.044E+00 HENSRPeSOfEO@@RtYPtQP
;85    3.000E+00 sVNBaPCEOaGPI`LDRPtIP
;85    4.000E+00 RBNrDPB@OAbPSiMtHPtFP
;85    5.000E+00 qFNBBPAVObGPWdMDVPDUP
;85    6.000E+00 ISMqYPQDObVPaBNTYPTXP
;85    7.000E+00 VcMaQPyGNCAPaTNtSPtRP
;85    8.000E+00 uAMAVPWaNsBPBDNDhPDhP
;85    9.000E+00 TIMqEPFcNcPPBSNEDPECP
;85    1.000E+01 CPMaEPFANCfPB`Ne@PUIP
;85    1.100E+01 BaMQFPuFNT@PSENuEPuEP
;85    1.200E+01 rFMAIPDcNtBPCWNUPPUPP
;85    1.300E+01 BAMACPDPNTSPsXNeUPeTP
;85    1.400E+01 qSMyRODDNtSPDGNuXPuXP
;85    1.500E+01 QQMiCOsSNTaPtENUbPUbP
;85    1.600E+01 qCMxYOCVNEHPdQNFEPFDP
;85    1.800E+01 AEMHCOCCNuIPEINfHPfHP
;85    2.000E+01 XPLGQObYNeWPUSNFYPFYP
;85    2.200E+01 GBLFhOBRNUbPUcNfYPfYP
;85    2.400E+01 U`LFSOb@NVEPfINFhPFhP
;85    2.600E+01 ECLFDOBANvFPfSNGEPGEP
;85    2.800E+01 tDLuPOAfNVUPVdNgAPgAP
;85    3.000E+01 sXLuIOqSNvSPgCNwFPwFP
;85    4.000E+01 RBLdHOaGNGUPHRNWgPWgP
;85    5.000E+01 qFLSXOA@NWhPyANHTPHTP
;85    6.000E+01 ITKCHOhHMHPPA@OHaPHaP
;85    8.000E+01 uAKBSOVEMIAPQ@OyGPyGP
;85    1.000E+02 CPKBBODiMITPQHOyVPyVP
;85    1.500E+02 QQKATOcCMAAQq@OADQADQ
;85    2.000E+02 XPJQCOBQMAEQqHOAHQAHQ
;85    3.000E+02 sXJWhNaPMQ@QAWOQBQQBQ
;85    4.000E+02 RBJfENa@MQCQQSOQEQQEQ
;85    5.000E+02 qFJUHNYXLQDQQVOQFQQFQ
;85    6.000E+02 ITIDSNWhLQFQQYOQHQQHQ
;85    8.000E+02 uAICVNUhLQGQaSOQIQQIQ
;85    1.000E+03 CPIBeNtXLQHQaUOa@Qa@Q
;85    1.500E+03 QQIQiNSHLa@QaYOaBQaBQ
;85    2.000E+03 XPHQTNrILaAQqQOaCQaCQ
;85    3.000E+03 sXHAGNQYLaBQqSOaCQaCQ
;85    4.000E+03 RBHhFMQILaBQqTOaDQaDQ
;85    5.000E+03 qFHvUMYTKaBQqUOaDQaDQ
;85    6.000E+03 ITGuSMWdKaCQqVOaDQaDQ
;85    8.000E+03 uAGDQMUfKaCQqWOaEQaEQ
;85    1.000E+04 CPGcPMtWKaCQqWOaEQaEQ
;85    1.500E+04 QQGBYMSHKaCQqXOaEQaEQ
;85    2.000E+04 XPFQaMrHKaCQqXOaEQaEQ
;85    3.000E+04 sXFqBMQYKaDQqXOaEQaEQ
;85    4.000E+04 RBFAAMQIKaDQqYOaFQaFQ
;85    5.000E+04 qFFhELYSJaDQqYOaFQaFQ
;85    6.000E+04 ITEVhLWdJaDQqYOaFQaFQ
;85    8.000E+04 uAEuELUfJaDQqYOaFQaFQ
;85    1.000E+05 CPEtELtWJaDQqYOaFQaFQ
;==== ELEMENT  86
;86    1.000E-03 aHSSIOEaU@@R@@REcUEaU
;86    1.047E-03 aHSCUOuDU@@R@@RuEUuDU
;86    1.097E-03 aGSsSOT`U@@R@@RTaUT`U
;86 N1 1.097E-03 aGSsSOE@U@@R@@REBUE@U
;86    1.500E-03 aCSVAOrQU@@R@@RrRUrQU
;86    2.000E-03 QGSYIOAXU@@R@@RAYUAXU
;86    2.892E-03 AESAVPVST@@R@@RfSTVST
;86 M5 2.892E-03 AESAVPrAU@@R@@RrBUrAU
;86    3.000E-03 ADSQRPQTU@@R@@RQUUQTU
;86    3.022E-03 ADSQSPQQU@@R@@RQRUQQU
;86 M4 3.022E-03 ADSQSPBVU@@R@@RBWUBVU
;86    3.270E-03 AASaXPQ`U@@R@@RQaUQ`U
;86    3.538E-03 I`RAbPAWU@@R@@RAXUAWU
;86 M3 3.538E-03 I`RAbPqPU@@R@@RqQUqPU
;86    4.000E-03 yARBGPaFU@@R@@RaGUaFU
;86    4.159E-03 YERREPQDU@@R@@RQEUQDU
;86 M2 4.159E-03 YERREPaAU@@R@@RaBUaAU
;86    4.317E-03 XiRbBPQ@U@@R@@RQAUQ@U
;86    4.482E-03 HcRr@PAAU@@R@@RABUAAU
;86 M1 4.482E-03 HcRr@PAEU@@R@@RAFUAEU
;86    5.000E-03 xERRTPHHT@@R@@RXFTHHT
;86    6.000E-03 WRRRgPUFT@@R@@ReDTUFT
;86    8.000E-03 VGRsUPRQT@@R@@RRXTRQT
;86    1.000E-02 UCRDTPART@@R@@RAXTAST
;86    1.462E-02 STReYPuDS@@R@@RuPSuDS
;86 L3 1.462E-02 STReYPqAT@@R@@RqDTqAT
;86    1.500E-02 CTRuWPaBT@@R@@RaFTaBT
;86    1.734E-02 RaRfDPhFS@@R@@RXVShGS
;86 L2 1.734E-02 RaRfDPQFT@@R@@RQHTQFT
;86    1.769E-02 BdRvAPQ@T@@R@@RQCTQ@T
;86    1.805E-02 rXRvGPAET@@R@@RAHTAET
;86 L1 1.805E-02 rXRvGPaAT@@R@@RaDTaAT
;86    2.000E-02 BURvPPyAS@@R@@RYVSyBS
;86    3.000E-02 ATRWfPcES@@R@@RCQScFS
;86    4.000E-02 iXQxSPQRS@@R@@RaRSQSS
;86    5.000E-02 VbQYHPxDR@@R@@RYBRHSR
;86    6.000E-02 UIQITPEIR@@R@@RuQRUIR
;86    8.000E-02 cFQiTPrCR@@R@@RrURBRR
;86    9.840E-02 rBQiSPqBR@@R@@RaURARR
;86 K  9.840E-02 rBQiSPUcR@@R@@RfFRFCR
;86    1.000E-01 bFQiRPuVR@@R@@RFIREfR
;86    1.500E-01 QBQiDPBAR@@R@@RbARR@R
;86    2.000E-01 fXPxTPIWQ@@R@@RQ@RACR
;86    3.000E-01 c@PGePsAQ@@R@@RDRQT@Q
;86    4.000E-01 AgPWDPaRQ@@R@@RRRQrCQ
;86    5.000E-01 aCPVXPIWP@@R@@RqSQaPQ
;86    6.000E-01 hWOVBPfBP@@R@@RqBQaCQ
;86    8.000E-01 ThOEQPsBP@@R@@RiCPxSP
;86    1.000E+00 cCODiPR@P@@R@@Rw@PVhP
;86    1.022E+00 CIODdPBAP@@R@@RWEPFdP
;86    1.250E+00 BIOtHPqEPDAN@@RUhPuWP
;86    1.500E+00 AVOSiPiTOQdO@@ReIPUDP
;86    2.000E+00 hENCQPEcOuWO@@RdUPTWP
;86    2.044E+00 W`NsGPeQOV@O@@RdRPTTP
;86    3.000E+00 cYNbYPCDOaDPyHLdFPdCP
;86    4.000E+00 BHNbDPQiOqVPCbMdBPd@P
;86    5.000E+00 qCNQdPAVOb@PgPMt@PdHP
;86    6.000E+00 iEMqQPQDORWPQGNDRPDQP
;86    7.000E+00 F`MQTPyCNR`PQWNTVPTUP
;86    8.000E+00 eAMAPPGgNc@PQfNtPPtPP
;86    9.000E+00 TAMaIPF`NCWPrCNDePDeP
;86    1.000E+01 sCMQIPUhNsRPbXNEAPE@P
;86    1.100E+01 rVMQAPuCNSfPCANUFPUEP
;86    1.200E+01 rBMADPDaNTGPsBNu@Pu@P
;86    1.300E+01 QgMIcOtHNtHPcRNETPETP
;86    1.400E+01 qPMy@ODBNTWPS`NUXPUWP
;86    1.500E+01 AXMHcOsQNtTPTFNuPPuPP
;86    1.600E+01 q@MHQOCTNTaPDQNEcPEcP
;86    1.800E+01 ACMgYOCANeAPDgNFEPFEP
;86    2.000E+01 xDLGIObXNEWPeINfFPfFP
;86    2.200E+01 FiLVXOBQNuQPeWNFUPFUP
;86    2.400E+01 uYLVEORINUcPFBNfSPfSP
;86    2.600E+01 TcLuXOB@NVDPvDNF`PF`P
;86    2.800E+01 dFLEUOAeNvBPfTNVePVeP
;86    3.000E+01 sQLUFOqRNFYPVaNGIPGIP
;86    4.000E+01 BILT@OaFNWIPHENgYPgYP
;86    5.000E+01 qCLCROYgMwPPX`NXDPXDP
;86    6.000E+01 iGKReOhDMX@PYWNXPPXPP
;86    8.000E+01 eAKrCOVBMhYPAFOIDPIDP
;86    1.000E+02 sDKQcODfMYAPQCOIRPIRP
;86    1.500E+02 AXKqGOcAMyVPaEOA@QA@Q
;86    2.000E+02 xDJAHOBPMAAQqBOADQADQ
;86    3.000E+02 sQJgTNQYMAFQAQOAHQAHQ
;86    4.000E+02 BIJUhNQIMAIQAVOQAQQAQ
;86    5.000E+02 qCJTeNYSLQ@QAYOQBQQBQ
;86    6.000E+02 iGIdDNWcLQBQQROQCQQCQ
;86    8.000E+02 eAIsANUdLQCQQVOQEQQEQ
;86    1.000E+03 sDIrSNtULQDQQXOQFQQFQ
;86    1.500E+03 AXIQ`NSGLQFQaQOQGQQGQ
;86    2.000E+03 xDHAWNrGLQFQaSOQHQQHQ
;86    3.000E+03 sQHABNQXLQGQaUOQIQQIQ
;86    4.000E+03 BIHWaMQILQHQaWOa@Qa@Q
;86    5.000E+03 qCHFVMIXKQHQaWOa@Qa@Q
;86    6.000E+03 iGGEXMW`KQHQaXOa@Qa@Q
;86    8.000E+03 eAGdBMUcKQIQaYOa@Qa@Q
;86    1.000E+04 sDGCUMtTKQIQaYOaAQaAQ
;86    1.500E+04 AXGrHMSFKQIQqPOaAQaAQ
;86    2.000E+04 xDFAcMrGKQIQqPOaAQaAQ
;86    3.000E+04 sQFaFMQXKQIQqPOaAQaAQ
;86    4.000E+04 BIFyPLQHKQIQqQOaAQaAQ
;86    5.000E+04 qCFW`LIXJQIQqQOaAQaAQ
;86    6.000E+04 iGEfXLW`JQIQqQOaAQaAQ
;86    8.000E+04 eAEUBLUbJa@QqQOaAQaAQ
;86    1.000E+05 sDETGLtTJa@QqQOaAQaAQ
;==== ELEMENT  87
;87    1.000E-03 q@SDIOFGU@@R@@RFHUFGU
;87    1.074E-03 aISTPOuBU@@R@@RuCUuBU
;87    1.153E-03 aHSTeOdVU@@R@@RdXUdVU
;87 N1 1.153E-03 aHSTeOtVU@@R@@RtWUtVU
;87    1.500E-03 aDSVeOBcU@@R@@RBdUBcU
;87    2.000E-03 QHSYcOQUU@@R@@RQVUQUU
;87    3.000E-03 AFSQXPvAT@@R@@RFQTvAT
;87 M5 3.000E-03 AFSQXPQhU@@R@@RB@UQhU
;87    3.000E-03 AFSQXPQhU@@R@@RQiUQhU
;87    3.136E-03 ADSaVPATU@@R@@RAUUATU
;87 M4 3.136E-03 ADSaVPbDU@@R@@RbEUbDU
;87    3.389E-03 AASAbPqXU@@R@@RqYUqXU
;87    3.663E-03 I`RQePAQU@@R@@RARUAQU
;87 M3 3.663E-03 I`RQePaSU@@R@@RaTUaSU
;87    4.000E-03 ITRRBPqAU@@R@@RqBUqAU
;87    4.327E-03 YARbHPAHU@@R@@RAIUAHU
;87 M2 4.327E-03 YARbHPQDU@@R@@RQEUQDU
;87    4.487E-03 XfRrFPAEU@@R@@RAFUAEU
;87    4.652E-03 H`RBTPYXT@@R@@RiWTYXT
;87 M1 4.652E-03 H`RBTPYiT@@R@@RAAUYiT
;87    5.000E-03 HXRbPPHPT@@R@@RHYTHPT
;87    6.000E-03 gTRCBPuGT@@R@@REUTuGT
;87    8.000E-03 fHRsYPbRT@@R@@RbXTbRT
;87    1.000E-02 eCRDXPAYT@@R@@RQTTAYT
;87    1.500E-02 SRREaPeBS@@R@@RUWSeBS
;87    1.503E-02 SQREbPUIS@@R@@RUTSUIS
;87 L3 1.503E-02 SQREbPaGT@@R@@Rq@TaGT
;87    1.641E-02 SHRFIPA@T@@R@@RACTA@T
;87    1.791E-02 BgRvIPGiS@@R@@RXHSW`S
;87 L2 1.791E-02 BgRvIPQAT@@R@@RQDTQAT
;87    1.827E-02 B`RFUPAET@@R@@RAHTAET
;87    1.864E-02 rSRVRPA@T@@R@@RACTA@T
;87 L1 1.864E-02 rSRVRPQFT@@R@@RQITQFT
;87    2.000E-02 RQRvUPiXS@@R@@RYcSiXS
;87    3.000E-02 AXRH@PsIS@@R@@RSUSCPS
;87    4.000E-02 YaQxWPQYS@@R@@RaYSQYS
;87    5.000E-02 W@QiCPxRR@@R@@RYRRHaR
;87    6.000E-02 uBQIYPuCR@@R@@RUfRESR
;87    8.000E-02 sDQiYPBTR@@R@@RBgRRTR
;87    1.000E-01 rBQiWPqCR@@R@@RaVRARR
;87    1.011E-01 bGQiWPaIR@@R@@RaQRqHR
;87 K  1.011E-01 bGQiWPuWR@@R@@RFIREfR
;87    1.500E-01 QEQiIPBIR@@R@@RbIRRHR
;87    2.000E-01 FgPH`PIeQ@@R@@RQDRAGR
;87    3.000E-01 cIPW`PCVQ@@R@@RTXQdEQ
;87    4.000E-01 QcPWIPaYQ@@R@@RbPQBQQ
;87    5.000E-01 aGPfSPYaP@@R@@RqXQaUQ
;87    6.000E-01 XdOVFPVRP@@R@@RqFQaGQ
;87    8.000E-01 UDOEUPCXP@@R@@RITPXcP
;87    1.000E+00 sCOTbPb@P@@R@@RGUPWBP
;87    1.022E+00 SIODgPR@P@@R@@RgIPVgP
;87    1.250E+00 REODQPARPTBN@@RFIPEgP
;87    1.500E+00 QPODBPAAPB@O@@RuHPeCP
;87    2.000E+00 XQNCSPVAOUcO@@RtRPdTP
;87    2.044E+00 XENsIPEiOfGO@@RdYPdPP
;87    3.000E+00 CaNrPPSIOaFPIULtBPdIP
;87    4.000E+00 RENbFPBHOqYPCeMdHPdFP
;87    5.000E+00 qGNQePQSObCPgUMtFPtDP
;87    6.000E+00 YVMqRPQIObQPQGNDXPDWP
;87    7.000E+00 GBMQUPyWNRePQXNdRPdQP
;87    8.000E+00 uHMAQPhENcEPQgNtWPtVP
;87    9.000E+00 dEMq@PWCNSSPrDNTbPTbP
;87    1.000E+01 CTMa@PfFNsXPrPNEHPEGP
;87    1.100E+01 BeMQBPUYNDBPCCNeCPeBP
;87    1.200E+01 rIMAEPEDNdDPsENuGPuGP
;87    1.300E+01 BDMY`OTYNDTPcTNURPUQP
;87    1.400E+01 qVMyGOd@NdSPSbNeUPeUP
;87    1.500E+01 QSMHiOChNDaPTINuYPuXP
;87    1.600E+01 qEMHWOcPNThPDTNUaPUaP
;87    1.800E+01 AFMwTOSENeHPT`NVDPVDP
;87    2.000E+01 hQLWDOB`NUUPuBNvEPvEP
;87    2.200E+01 WBLfSORRNE`PuQNVUPVUP
;87    2.400E+01 UhLVIObINFBPFFNvSPvSP
;87    2.600E+01 U@LEbOR@NfCPvHNV`PV`P
;87    2.800E+01 tILEYOQdNFRPfXNGEPGEP
;87    3.000E+01 CcLe@OA`NVYPVfNg@Pg@P
;87    4.000E+01 RELTCOqBNw@PX@NG`PG`P
;87    5.000E+01 qHLCUOADNGbPXfNhFPhFP
;87    6.000E+01 YWKRgOhRMhCPiSNhSPhSP
;87    8.000E+01 uHKrDOFPMHbPAFOYGPYGP
;87    1.000E+02 CUKQdOEIMiDPQDOYVPYVP
;87    1.500E+02 QSKqHOsFMYaPaEOABQABQ
;87    2.000E+02 hQJAIORQMACQqCOAEQAEQ
;87    3.000E+02 CcJwPNaWMAHQAROQ@QQ@Q
;87    4.000E+02 REJFCNaEMQ@QAWOQBQQBQ
;87    5.000E+02 qHJTiNYgLQBQQPOQDQQDQ
;87    6.000E+02 YWIdGNx@LQCQQSOQEQQEQ
;87    8.000E+02 uHIsCNfBLQEQQWOQGQQGQ
;87    1.000E+03 CUIrTNTgLQFQQYOQHQQHQ
;87    1.500E+03 QSIQbNsALQGQaSOQIQQIQ
;87    2.000E+03 hQHAXNBXLQHQaUOa@Qa@Q
;87    3.000E+03 CcHACNaULQIQaWOaAQaAQ
;87    4.000E+03 REHWfMaDLa@QaXOaAQaAQ
;87    5.000E+03 qHHVQMYbKa@QaYOaBQaBQ
;87    6.000E+03 YWGURMhGKa@QaYOaBQaBQ
;87    8.000E+03 uHGdEMf@Ka@QqPOaBQaBQ
;87    1.000E+04 CUGCWMTfKaAQqQOaBQaBQ
;87    1.500E+04 QSGBPMsAKaAQqQOaCQaCQ
;87    2.000E+04 hQFAdMBXKaAQqROaCQaCQ
;87    3.000E+04 CcFaGMaUKaAQqROaCQaCQ
;87    4.000E+04 REFyWLaDKaAQqROaCQaCQ
;87    5.000E+04 qHFWeLYbJaAQqROaCQaCQ
;87    6.000E+04 YWEvRLhFJaAQqROaCQaCQ
;87    8.000E+04 uHEUELf@JaAQqSOaCQaCQ
;87    1.000E+05 CUETILTfJaAQqSOaCQaCQ
;==== ELEMENT  88
;88    1.000E-03 q@StYOVIU@@R@@Rf@UVIU
;88    1.028E-03 q@STfOEhU@@R@@REiUEhU
;88    1.058E-03 q@SUCOUYU@@R@@RePUUYU
;88 N2 1.058E-03 q@SUCOeWU@@R@@ReXUeWU
;88    1.130E-03 aISUWOE@U@@R@@REBUE@U
;88    1.208E-03 aHSFCODQU@@R@@RDRUDQU
;88 N1 1.208E-03 aHSFCOTQU@@R@@RTRUTQU
;88    1.500E-03 aDSwQORdU@@R@@RReURdU
;88    2.000E-03 QHSAFPaQU@@R@@RaRUaQU
;88    3.000E-03 AFSaSPVVT@@R@@RfVTVVT
;88    3.105E-03 AESaYPFFT@@R@@RVGTFFT
;88 M5 3.105E-03 AESaYPqPU@@R@@RqQUqPU
;88    3.176E-03 ADSqSPQRU@@R@@RQSUQRU
;88    3.248E-03 ACSqWPqFU@@R@@RqGUqFU
;88 M4 3.248E-03 ACSqWPBCU@@R@@RBDUBCU
;88    3.510E-03 A@SQaPaTU@@R@@RaUUaTU
;88    3.792E-03 yQRBFPqCU@@R@@RqDUqCU
;88 M3 3.792E-03 yQRBFPQUU@@R@@RQVUQUU
;88    4.000E-03 IYRRFPqFU@@R@@RqGUqFU
;88    4.490E-03 I@RBPPAAU@@R@@RABUAAU
;88 M2 4.490E-03 I@RBPPAHU@@R@@RAIUAHU
;88    4.653E-03 HdRBXPIgT@@R@@RYfTIgT
;88    4.822E-03 hYRRUPIDT@@R@@RYCTIDT
;88 M1 4.822E-03 hYRRUPIST@@R@@RYRTIST
;88    5.000E-03 XRRbSPhVT@@R@@RxTThVT
;88    6.000E-03 gYRCFPUTT@@R@@ReQTUTT
;88    8.000E-03 vCRCaPrPT@@R@@RrWTrPT
;88    1.000E-02 eHRDXPQTT@@R@@RQYTQTT
;88    1.500E-02 SVRE`PEPS@@R@@RuVSEPS
;88    1.544E-02 CURU`PE@S@@R@@RuESEAS
;88 L3 1.544E-02 CURU`PaBT@@R@@RaETaBT
;88    1.690E-02 SARVIPYTS@@R@@RIfSYUS
;88    1.848E-02 B`RFWPGXS@@R@@RwWSGYS
;88 L2 1.848E-02 B`RFWPAET@@R@@RAHTAET
;88    1.886E-02 rSRVTPA@T@@R@@RACTA@T
;88    1.924E-02 bWRfPPYSS@@R@@RI`SYSS
;88 L1 1.924E-02 bWRfPPQ@T@@R@@RQCTQ@T
;88    2.000E-02 RTRvSPYgS@@R@@RABTYgS
;88    3.000E-02 QPRWgPSQS@@R@@RcVSSQS
;88    4.000E-02 AARxSPaTS@@R@@RqUSaUS
;88    5.000E-02 gAQYIPIDR@@R@@RIeRYCR
;88    6.000E-02 EQQIUPUSR@@R@@RVGReSR
;88    8.000E-02 CPQiUPRSR@@R@@RRgRbSR
;88    1.000E-01 rFQiTPqHR@@R@@RqQRAXR
;88    1.039E-01 bAQiRPaDR@@R@@RQVRqDR
;88 K  1.039E-01 bAQiRPUQR@@R@@REcReQR
;88    1.500E-01 QGQiGPRER@@R@@RrFRbDR
;88    2.000E-01 G@PxXPAAR@@R@@RQGRQ@R
;88    3.000E-01 sEPGhPSWQ@@R@@RtPQtFQ
;88    4.000E-01 QgPWGPqUQ@@R@@RbVQBWQ
;88    5.000E-01 aIPfQPACQ@@R@@RAbQaYQ
;88    6.000E-01 YCOVEPvVP@@R@@RqHQaIQ
;88    8.000E-01 eEOETPcQP@@R@@RYXPIEP
;88    1.000E+00 CPOTaPbHP@@R@@RWSPWIP
;88    1.022E+00 cFODfPRIP@@R@@RwGPGEP
;88    1.250E+00 b@ODPPAXPTIN@@RVDPUbP
;88    1.500E+00 QTODAPAEPBDO@@RERPeFP
;88    2.000E+00 xQNCSPvEOFCO@@RtUPdVP
;88    2.044E+00 xDNsHPVBOvGO@@RtRPdSP
;88    3.000E+00 S`NrPPsAOaHPISLtEPtAP
;88    4.000E+00 b@NbEPRFOAaPCdMt@PdHP
;88    5.000E+00 AQNQePQXObEPgTMtHPtFP
;88    6.000E+00 yXMqRPaDObSPQGNTPPDYP
;88    7.000E+00 WIMQUPAAORgPQWNdTPdSP
;88    8.000E+00 UPMAQPXVNcGPQgNtYPtYP
;88    9.000E+00 tEMaIPwINSUPrDNTePTdP
;88    1.000E+01 SRMa@PVPNCaPbYNU@PU@P
;88    1.100E+01 RaMQBPuYNDDPCBNeEPeEP
;88    1.200E+01 BUMAEPeBNdFPsDNEPPEPP
;88    1.300E+01 BIMIhOtVNDWPcSNUTPUTP
;88    1.400E+01 A`MyEOtFNdVPSaNeXPeXP
;88    1.500E+01 QWMHgODCNDdPTHNEaPEaP
;88    1.600E+01 qHMHUOsTNEAPDSNUdPUdP
;88    1.800E+01 AIMwROcGNuBPDiNVGPVGP
;88    2.000E+01 HaLWBORaNUYPuANvHPvHP
;88    2.200E+01 gHLfRObQNEcPeYNVXPVXP
;88    2.400E+01 VBLVHOrHNFFPFENvVPvVP
;88    2.600E+01 eALEaORHNfGPvGNVcPVcP
;88    2.800E+01 DYLEXOBANFVPfWNGIPGIP
;88    3.000E+01 SbLUIOAfNfSPVdNgDPgDP
;88    4.000E+01 b@LTBOqGNwDPHHNGePGeP
;88    5.000E+01 AQLCTOAHNGgPXcNxAPxAP
;88    6.000E+01 yYKRgOXdMhHPiPNhXPhXP
;88    8.000E+01 UQKrDOfSMHhPAFOiBPiBP
;88    1.000E+02 SRKQdOeGMy@PQCOiQPiQP
;88    1.500E+02 QWKqHOCXMYgPaEOABQABQ
;88    2.000E+02 HaJAHObPMADQqBOAFQAFQ
;88    3.000E+02 SbJgXNqSMAHQAQOQ@QQ@Q
;88    4.000E+02 b@JFANaIMQAQAWOQCQQCQ
;88    5.000E+02 AQJThNACMQCQQPOQEQQEQ
;88    6.000E+02 yYIdFNhPLQDQQSOQFQQFQ
;88    8.000E+02 UQIsCNFULQFQQVOQGQQGQ
;88    1.000E+03 SRIrTNUELQGQQYOQIQQIQ
;88    1.500E+03 QWIQaNCSLQHQaROa@Qa@Q
;88    2.000E+03 HaHAXNRWLQIQaTOaAQaAQ
;88    3.000E+03 SbHACNqQLa@QaWOaBQaBQ
;88    4.000E+03 b@HWeMaILa@QaXOaBQaBQ
;88    5.000E+03 AQHVPMACLaAQaYOaCQaCQ
;88    6.000E+03 yYGUQMXWKaAQaYOaCQaCQ
;88    8.000E+03 UQGdDMFSKaAQqPOaCQaCQ
;88    1.000E+04 SRGCWMUDKaAQqQOaCQaCQ
;88    1.500E+04 QWGrIMCSKaBQqQOaCQaCQ
;88    2.000E+04 HaFAdMRWKaBQqROaDQaDQ
;88    3.000E+04 SbFaGMqQKaBQqROaDQaDQ
;88    4.000E+04 b@FyULaHKaBQqROaDQaDQ
;88    5.000E+04 AQFWdLACKaBQqROaDQaDQ
;88    6.000E+04 yYEvQLXWJaBQqROaDQaDQ
;88    8.000E+04 UQEUDLFRJaBQqSOaDQaDQ
;88    1.000E+05 SRETILUDJaBQqSOaDQaDQ
;==== ELEMENT  89
;89    1.000E-03 qCSDgOFVU@@R@@RFWUFVU
;89    1.039E-03 qBSUBOFBU@@R@@RFCUFBU
;89    1.080E-03 qBSuHOeQU@@R@@ReRUeQU
;89 N2 1.080E-03 qBSuHOeYU@@R@@RuPUeYU
;89    1.171E-03 qASUcODhU@@R@@RT`UDhU
;89    1.269E-03 aISVQOTIU@@R@@Rd@UTIU
;89 N1 1.269E-03 aISVQOdHU@@R@@RdIUdHU
;89    1.500E-03 aFSWaOCGU@@R@@RCHUCGU
;89    2.000E-03 a@SAIPaXU@@R@@RqPUaXU
;89    3.000E-03 AGSaVPFgT@@R@@RVhTFgT
;89    3.219E-03 AESqXPEeT@@R@@RUfTEeT
;89 M5 3.219E-03 AESqXPQSU@@R@@RQTUQSU
;89    3.294E-03 ADSAbPAQU@@R@@RARUAQU
;89    3.370E-03 ACSAgPq@U@@R@@RqAUq@U
;89 M4 3.370E-03 ACSAgPAhU@@R@@RAiUAhU
;89    3.630E-03 A@SB@PQVU@@R@@RQWUQVU
;89    3.909E-03 yRRREPaIU@@R@@Rq@UaIU
;89 M3 3.909E-03 yRRREPAYU@@R@@RQPUAYU
;89    4.000E-03 iRRb@PARU@@R@@RASUARU
;89    4.656E-03 XgRRRPiVT@@R@@RyUTiVT
;89 M2 4.656E-03 XgRRRPABU@@R@@RACUABU
;89    5.000E-03 hURbXPhPT@@R@@RhYThPT
;89    5.002E-03 hURbXPXYT@@R@@RhXTXYT
;89 M1 5.002E-03 hURbXPXgT@@R@@RIETXgT
;89    6.000E-03 GaRS@PuUT@@R@@REcTuUT
;89    8.000E-03 FSRCePBaT@@R@@RBhTBaT
;89    1.000E-02 uHRTRPaPT@@R@@RaUTaPT
;89    1.500E-02 cSREdPeSS@@R@@RF@SeTS
;89    1.587E-02 CQRFCPDfS@@R@@ReASDgS
;89 L3 1.587E-02 CQRFCPQHT@@R@@RaATQHT
;89    1.740E-02 CGRvBPYHS@@R@@RIYSYHS
;89    1.908E-02 rURfRPWDS@@R@@RGSSWES
;89 L2 1.908E-02 rURfRPAAT@@R@@RADTAAT
;89    1.946E-02 bYRfXPYYS@@R@@RIgSiPS
;89    1.984E-02 bSRvTPYCS@@R@@RIPSYDS
;89 L1 1.984E-02 bSRvTPAET@@R@@RAHTAET
;89    2.000E-02 bPRvWPACT@@R@@RAFTADT
;89    3.000E-02 QSRHAPcUS@@R@@RCaScVS
;89    4.000E-02 ACRxWPqQS@@R@@RAbSqRS
;89    5.000E-02 wIQiCPITR@@R@@RACSYSR
;89    6.000E-02 UUQYPPuXR@@R@@RFSREhR
;89    8.000E-02 CYQyPPbVR@@R@@RS@RrUR
;89    1.000E-01 BRQiYPAUR@@R@@RqYRQTR
;89    1.068E-01 RGQiVPaAR@@R@@RQRRqAR
;89 K  1.068E-01 RGQiVPuAR@@R@@ReRREPR
;89    1.500E-01 a@QyBPbBR@@R@@RBSRrAR
;89    2.000E-01 g@PHcPAER@@R@@RaARQDR
;89    3.000E-01 CUPWcPsRQ@@R@@RDfQTQQ
;89    4.000E-01 BCPgBPAbQ@@R@@RrUQRUQ
;89    5.000E-01 qCPfUPAGQ@@R@@RAgQqTQ
;89    6.000E-01 IPOVIPGHP@@R@@RARQqCQ
;89    8.000E-01 EQOEXPsYP@@R@@RI`PiFP
;89    1.000E+00 SQOTdPrIP@@R@@RgYPwDP
;89    1.022E+00 sFODiPbIP@@R@@RWRPWHP
;89    1.250E+00 bGODSPQUPdIN@@RfEPFBP
;89    1.500E+00 QXODCPQ@PBIO@@RUPPuEP
;89    2.000E+00 XhNCUPfVOVIO@@RDbPtSP
;89    2.044E+00 hQNCQPFROVTO@@RtYPtPP
;89    3.000E+00 DBNrRPCWOqAPIYLDQPtGP
;89    4.000E+00 bGNbGPbGOAdPCgMtFPtDP
;89    5.000E+00 AUNQfPaVObIPgYMDTPDRP
;89    6.000E+00 AANqSPq@ObXPQHNTVPTUP
;89    7.000E+00 GRMQVPAFOCBPQYNtPPtPP
;89    8.000E+00 eXMARPXfNsBPQhNDfPDeP
;89    9.000E+00 DYMq@PwTNcPPrENEAPEAP
;89    1.000E+01 cTMaAPF`NCfPrQNUGPUGP
;89    1.100E+01 CAMQCPFFNT@PCENuBPuBP
;89    1.200E+01 RSMAFPEWNtCPsFNEXPEWP
;89    1.300E+01 REMYeOTgNTTPcVNeRPeRP
;89    1.400E+01 AfMIQOTVNtSPSdNuVPuVP
;89    1.500E+01 aRMXdOdANTbPd@NEiPEiP
;89    1.600E+01 ARMXQOSaNEIPDVNFBPFBP
;89    1.800E+01 QBMwXOCRNEPPTbNfFPfFP
;89    2.000E+01 Y@LWGOCDNeWPuDNFWPFWP
;89    2.200E+01 WRLfVOrSNUbPuSNfWPfWP
;89    2.400E+01 vBLfCOBXNVEPFHNFfPFfP
;89    2.600E+01 uHLEeObHNvFPFQNGCPGCP
;89    2.800E+01 dTLUQOR@NVUPvQNWIPWIP
;89    3.000E+01 DDLeBOQeNvSPViNwDPwDP
;89    4.000E+01 bGLTEOASNGUPXCNWfPWfP
;89    5.000E+01 AVLCVOQCNWhPXiNHSPHSP
;89    6.000E+01 AALRhOyEMHPPiVNH`PH`P
;89    8.000E+01 eXKrEOVcMIAPAGOyFPyFP
;89    1.000E+02 cTKQeOUQMITPQDOyUPyUP
;89    1.500E+02 aRKqIOcTMAAQaFOADQADQ
;89    2.000E+02 Y@JAIOrRMAEQqCOAHQAHQ
;89    3.000E+02 DDJwSNAaMQ@QAROQBQQBQ
;89    4.000E+02 bGJFFNqEMQCQAWOQEQQEQ
;89    5.000E+02 AVJEANAHMQDQQQOQFQQFQ
;89    6.000E+02 AAJdINXiLQFQQTOQHQQHQ
;89    8.000E+02 eXIsENvSLQGQQWOQIQQIQ
;89    1.000E+03 cTIrVNuHLQHQaPOa@Qa@Q
;89    1.500E+03 aRIQcNSYLa@QaSOaBQaBQ
;89    2.000E+03 Y@HAYNbYLaAQaVOaCQaCQ
;89    3.000E+03 DDHADNqYLaBQaXOaDQaDQ
;89    4.000E+03 bGHH@MqDLaBQaYOaDQaDQ
;89    5.000E+03 AVHVTMAGLaCQqPOaDQaDQ
;89    6.000E+03 AAHUUMXfKaCQqQOaEQaEQ
;89    8.000E+03 eXGdGMvRKaCQqQOaEQaEQ
;89    1.000E+04 cTGCYMuGKaCQqROaEQaEQ
;89    1.500E+04 aRGBQMSXKaDQqROaEQaEQ
;89    2.000E+04 Y@FAeMbYKaDQqSOaEQaEQ
;89    3.000E+04 DDFaHMqYKaDQqSOaFQaFQ
;89    4.000E+04 bGFIbLqDKaDQqSOaFQaFQ
;89    5.000E+04 AVFWiLAGKaDQqTOaFQaFQ
;89    6.000E+04 AAFvVLXeJaDQqTOaFQaFQ
;89    8.000E+04 eXEUHLvQJaDQqTOaFQaFQ
;89    1.000E+05 cTEdALuGJaDQqTOaFQaFQ
;==== ELEMENT  90
;90    1.000E-03 qCSDaOfPU@@R@@RfQUfPU
;90    1.081E-03 qBSuBOuRU@@R@@RuTUuRU
;90    1.168E-03 qASEgOTfU@@R@@RThUTfU
;90 N2 1.168E-03 qASEgOECU@@R@@REEUECU
;90    1.246E-03 q@SvDODUU@@R@@RDVUDUU
;90    1.329E-03 aISFdOScU@@R@@RSdUScU
;90 N1 1.329E-03 aISFdOD@U@@R@@RDBUD@U
;90    1.500E-03 aFSGhOSEU@@R@@RSFUSEU
;90    2.000E-03 a@SAIPqSU@@R@@RqTUqSU
;90    3.000E-03 AGSaVPGGT@@R@@RWHTGGT
;90    3.332E-03 ACSAdPUWT@@R@@ReWTUWT
;90 M5 3.332E-03 ACSAdPqHU@@R@@RqIUqHU
;90    3.410E-03 ABSAhPq@U@@R@@RqAUq@U
;90    3.491E-03 AASQbPaBU@@R@@RaCUaBU
;90 M4 3.491E-03 AASQbPqTU@@R@@RqUUqTU
;90    4.000E-03 YYRRIPaDU@@R@@RaEUaDU
;90    4.046E-03 YTRbAPaAU@@R@@RaBUaAU
;90 M3 4.046E-03 YTRbAPAQU@@R@@RAQUAQU
;90    4.421E-03 YGRrIPQCU@@R@@RQCUQCU
;90    4.830E-03 xXRRYPIBT@@R@@RY@TIBT
;90 M2 4.830E-03 xXRRYPYWT@@R@@RiUTYWT
;90    5.000E-03 hRRbWPxYT@@R@@RHhTxYT
;90    5.182E-03 HVRrUPHET@@R@@RXCTHET
;90 M1 5.182E-03 HVRrUPxIT@@R@@RHXTxIT
;90    6.000E-03 wYRCIPEgT@@R@@RUeTEgT
;90    8.000E-03 FSRCcPBgT@@R@@RRdTBgT
;90    1.000E-02 uHRDXPaTT@@R@@RaYTaTT
;90    1.500E-02 cTRuXPuWS@@R@@RVDSuXS
;90    1.630E-02 sBRFEPdUS@@R@@RTiSdVS
;90 L3 1.630E-02 sBRFEPQBT@@R@@RQFTQBT
;90    1.792E-02 RhRvEPhXS@@R@@RXhShXS
;90    1.969E-02 bVRfTPvQS@@R@@RVhSvRS
;90 L2 1.969E-02 bVRfTPiPS@@R@@RIgSiPS
;90    2.000E-02 bQRfYPY@S@@R@@RyGSYAS
;90    2.047E-02 RTRvVPXYS@@R@@RHeShPS
;90 L1 2.047E-02 RTRvVPYbS@@R@@RABTYcS
;90    3.000E-02 QTRWaPsSS@@R@@RCiSsTS
;90    4.000E-02 ACRhVPqUS@@R@@RAfSqVS
;90    5.000E-02 GTQYAPiXR@@R@@RAESyWR
;90    6.000E-02 UYQyHPUdR@@R@@RVYRFCR
;90    8.000E-02 SQQYXPrSR@@R@@RSHRBcR
;90    1.000E-01 BTQYWPAYR@@R@@RAcRQYR
;90    1.097E-01 BIQYSPQFR@@R@@RAVRaFR
;90 K  1.097E-01 BIQYSPECR@@R@@RuDRUCR
;90    1.500E-01 aAQiAPbFR@@R@@RBWRrER
;90    2.000E-01 gGPxSPAGR@@R@@RaCRQFR
;90    3.000E-01 CXPGdPCaQ@@R@@RTdQTYQ
;90    4.000E-01 BEPWDPAgQ@@R@@RrYQRXQ
;90    5.000E-01 qEPVXPQ@Q@@R@@RQ`QqVQ
;90    6.000E-01 YQOVBPgGP@@R@@RASQqDQ
;90    8.000E-01 EWOERPS`P@@R@@RIfPyAP
;90    1.000E+00 SUODiPBVP@@R@@RwQPwEP
;90    1.022E+00 CPODdPrFP@@R@@RWTPg@P
;90    1.250E+00 r@OtHPQYPtBN@@RfEPFBP
;90    1.500E+00 aQOSiPQCPRBO@@RUPPuDP
;90    2.000E+00 Y@NCQPFeOfCO@@RDaPtRP
;90    2.044E+00 xRNsGPfQOVXO@@RtXPdYP
;90    3.000E+00 DGNbYPSWOqAPyILDPPtFP
;90    4.000E+00 r@NbDPrCOAdPCcMtEPtBP
;90    5.000E+00 AWNQdPqQObIPgQMDRPDQP
;90    6.000E+00 ABNqQPqCObWPQGNTTPTSP
;90    7.000E+00 WRMQTPAIOCAPQWNdXPdXP
;90    8.000E+00 uVMAPPiANsBPQfNDdPDcP
;90    9.000E+00 TUMaIPWeNcPPrCNTiPTiP
;90    1.000E+01 cYMQIPViNCePbXNUEPUEP
;90    1.100E+01 CEMQAPfCNDIPCANu@Pu@P
;90    1.200E+01 RVMADPeRNtBPsBNEUPEUP
;90    1.300E+01 RHMIdOUANTRPcRNePPePP
;90    1.400E+01 AhMyAOdYNtRPS`NuTPuTP
;90    1.500E+01 aTMHdOtCNT`PTFNEgPEgP
;90    1.600E+01 ATMHRODBNEGPDQNF@PF@P
;90    1.800E+01 QDMwPOSRNuHPDgNfCPfCP
;90    2.000E+01 iBLW@OSBNeUPeINFUPFUP
;90    2.200E+01 gRLVYOBaNU`PeWNfUPfUP
;90    2.400E+01 FQLVFORUNVCPFBNFdPFcP
;90    2.600E+01 EVLuXOrDNvDPvDNGAPGAP
;90    2.800E+01 tQLEVORFNVSPfSNWGPWGP
;90    3.000E+01 T@LUGOB@NvQPVaNwBPwAP
;90    4.000E+01 rALTAOAWNGSPHDNWcPWcP
;90    5.000E+01 AXLCSOQFNWfPHiNHPPHPP
;90    6.000E+01 ABLReOYYMxGPYUNxWPxWP
;90    8.000E+01 uVKrCOWBMXhPAEOyCPyCP
;90    1.000E+02 cYKQcOeVMIQPQCOyRPyRP
;90    1.500E+02 aTKqHOsTMAAQaDOADQADQ
;90    2.000E+02 iBJAHOrYMAEQqBOAGQAGQ
;90    3.000E+02 T@JgUNAeMQ@QAQOQBQQBQ
;90    4.000E+02 rAJUiNqIMQBQAVOQDQQDQ
;90    5.000E+02 AXJTfNQAMQDQAYOQFQQFQ
;90    6.000E+02 ABJdENiCLQEQQROQGQQGQ
;90    8.000E+02 uVIsBNVbLQGQQVOQIQQIQ
;90    1.000E+03 cYIrSNUSLQHQQXOa@Qa@Q
;90    1.500E+03 aTIQaNcXLa@QaROaAQaAQ
;90    2.000E+03 iBHAWNrVLaAQaTOaBQaBQ
;90    3.000E+03 T@HACNAdLaAQaVOaCQaCQ
;90    4.000E+03 rAHWbMqHLaBQaWOaDQaDQ
;90    5.000E+03 AXHFWMQ@LaBQaXOaDQaDQ
;90    6.000E+03 ABHEYMi@KaBQaYOaDQaDQ
;90    8.000E+03 uVGdCMV`KaCQaYOaDQaDQ
;90    1.000E+04 cYGCUMURKaCQqPOaEQaEQ
;90    1.500E+04 aTGrIMcXKaCQqQOaEQaEQ
;90    2.000E+04 iBFAcMrVKaCQqQOaEQaEQ
;90    3.000E+04 T@FaFMAdKaCQqQOaEQaEQ
;90    4.000E+04 rAFyQLqHKaDQqROaEQaEQ
;90    5.000E+04 AXFWaLQ@KaDQqROaEQaEQ
;90    6.000E+04 ABFfYLYIJaDQqROaEQaEQ
;90    8.000E+04 uVEUCLFiJaDQqROaEQaEQ
;90    1.000E+05 cYETGLURJaDQqROaEQaEQ
;==== ELEMENT  91
;91    1.000E-03 qGStPOVRU@@R@@RVSUVRU
;91    1.003E-03 qGStROFXU@@R@@RFYUFXU
;91    1.007E-03 qGStTOFTU@@R@@RFUUFTU
;91 N3 1.007E-03 qGStTOFfU@@R@@RFgUFfU
;91    1.110E-03 qESuIOuRU@@R@@RuTUuRU
;91    1.224E-03 qDSFHOtXU@@R@@RD`UtXU
;91 N2 1.224E-03 qDSFHODeU@@R@@RDfUDeU
;91    1.303E-03 qCSVTOdIU@@R@@RtAUdIU
;91    1.387E-03 qBSGDOC`U@@R@@RCbUC`U
;91 N1 1.387E-03 qBSGDOChU@@R@@RCiUChU
;91    1.500E-03 q@SwROsAU@@R@@RsCUsAU
;91    2.000E-03 aDSAGPAbU@@R@@RAcUAbU
;91    3.000E-03 QASaTPGUT@@R@@RWVTGUT
;91    3.442E-03 AESAiPETT@@R@@RUUTETT
;91 M5 3.442E-03 AESAiPqEU@@R@@RqFUqEU
;91    3.525E-03 ADSQcPaFU@@R@@RaGUaFU
;91    3.611E-03 ACSQhPQGU@@R@@RQIUQGU
;91 M4 3.611E-03 ACSQhPaXU@@R@@RaYUaXU
;91    4.000E-03 YaRRHPq@U@@R@@RqAUq@U
;91    4.174E-03 yRRbGPQGU@@R@@RQHUQGU
;91 M3 4.174E-03 yRRbGPqFU@@R@@RqGUqFU
;91    5.000E-03 HiRbVPhWT@@R@@RxVThWT
;91    5.001E-03 HiRbVPhWT@@R@@RxVThWT
;91 M2 5.001E-03 HiRbVPi@T@@R@@RiITi@T
;91    5.181E-03 xXRBiPHST@@R@@RXRTHST
;91    5.367E-03 XVRBbPwST@@R@@RGaTwST
;91 M1 5.367E-03 XVRBbPHFT@@R@@RXDTHFT
;91    6.000E-03 HBRCIPVDT@@R@@RfBTVDT
;91    8.000E-03 fQRCdPCAT@@R@@RCGTCAT
;91    1.000E-02 USRTQPqQT@@R@@RqWTqQT
;91    1.500E-02 sUREdPFFS@@R@@RFTSFGS
;91    1.673E-02 sCRf@PTVS@@R@@RT`STWS
;91 L3 1.673E-02 sCRf@PQ@T@@R@@RQCTQ@T
;91    2.000E-02 rPRvWPvUS@@R@@RGBSvVS
;91    2.031E-02 bURFbPFWS@@R@@RvUSFXS
;91 L2 2.031E-02 bURFbPYHS@@R@@RIUSYIS
;91    2.071E-02 RXRFhPxTS@@R@@RI@SxTS
;91    2.110E-02 RSRVdPxBS@@R@@RXXSxBS
;91 L1 2.110E-02 RSRVdPiPS@@R@@RIfSiQS
;91    3.000E-02 QYRH@PSaS@@R@@RDHSSbS
;91    4.000E-02 AGRxWPAdS@@R@@RQfSAeS
;91    5.000E-02 gYQiCPABS@@R@@RQ@SACS
;91    6.000E-02 uXQYPPfFR@@R@@RVcRvER
;91    8.000E-02 cSQyQPBhR@@R@@RsDRRhR
;91    1.000E-01 RRQyQPQXR@@R@@RQbRaWR
;91    1.126E-01 BFQiUPQDR@@R@@RATRaDR
;91 K  1.126E-01 BFQiUPT`R@@R@@Re@RTiR
;91    1.500E-01 aFQyDPrFR@@R@@RRXRBUR
;91    2.000E-01 WSPHfPQBR@@R@@RaIRaAR
;91    3.000E-01 cQPWfPD@Q@@R@@RUEQtYQ
;91    4.000E-01 RCPgEPQgQ@@R@@RR`QbYQ
;91    5.000E-01 APPfXPQFQ@@R@@RQgQAcQ
;91    6.000E-01 IhOfBPgWP@@R@@RAYQqIQ
;91    8.000E-01 eYOUPPTAP@@R@@RABQiQP
;91    1.000E+00 cYOTgPbPP@@R@@RWdPWWP
;91    1.022E+00 STOTaPBYP@@R@@RwVPGQP
;91    1.250E+00 rIODUPaXPDWN@@RFRPVHP
;91    1.500E+00 aWODEPa@Pb@O@@ReTPEWP
;91    2.000E+00 IWNCVPgDOFUO@@RTcPDcP
;91    2.044E+00 IHNCRPVhOFaO@@RDiPD`P
;91    3.000E+00 dDNrSPsWOqEPYSLTPPDUP
;91    4.000E+00 rINbHPBVOAiPChMDTPDRP
;91    5.000E+00 QSNQgPA`OrEPwRMTRPTPP
;91    6.000E+00 AGNqTPAQOrTPQHNdTPdSP
;91    7.000E+00 GcMQVPQEOCHPQYNtYPtXP
;91    8.000E+00 F@MARPyQNCPPQiNTdPTdP
;91    9.000E+00 tTMqAPxINcXPrFNU@PU@P
;91    1.000E+01 CdMaAPwGNSdPrRNeFPeFP
;91    1.100E+01 SGMQCPVWNTIPCFNERPERP
;91    1.200E+01 bWMAFPUbNDRPsHNUWPUWP
;91    1.300E+01 bGMA@PuINdSPcWNuRPuRP
;91    1.400E+01 QfMIVOTdNDcPSeNEfPEfP
;91    1.500E+01 qQMXhOTVNEAPdBNF@PF@P
;91    1.600E+01 QPMXUOdDNUIPDXNVCPVCP
;91    1.800E+01 QIMGaOsQNUPPTdNvGPvGP
;91    2.000E+01 iPLgAOcINuXPuGNVYPVYP
;91    2.200E+01 WdLfYORfNFDPuUNF`PF`P
;91    2.400E+01 fWLfFObYNfGPVANViPViP
;91    2.600E+01 eXLEhOBVNFYPFSNWFPWFP
;91    2.800E+01 T`LUTObGNfXPvSNwCPwCP
;91    3.000E+01 dGLeEORANFfPGANGXPGXP
;91    4.000E+01 BPLTGOQUNgPPXFNXAPXAP
;91    5.000E+01 QTLCXOaBNXEPIBNhPPhPP
;91    6.000E+01 AGLC@OAANXWPiYNXgPXgP
;91    8.000E+01 F@KrGOWPMYIPAGOYTPYTP
;91    1.000E+02 CdKQfOUfMiSPQDOYePYeP
;91    1.500E+02 qQKAPOSdMACQaFOAFQAFQ
;91    2.000E+02 iPJQ@ORdMAGQqDOQ@QQ@Q
;91    3.000E+02 dGJwWNQeMQBQASOQDQQDQ
;91    4.000E+02 BPJFHNAVMQEQAXOQGQQGQ
;91    5.000E+02 QTJEDNQGMQGQQQOQIQQIQ
;91    6.000E+02 AGJtANySLQHQQTOa@Qa@Q
;91    8.000E+02 F@IsGNgILa@QQXOaBQaBQ
;91    1.000E+03 CdIrWNEbLaAQaPOaCQaCQ
;91    1.500E+03 qQIQdNChLaBQaTOaDQaDQ
;91    2.000E+03 iPHQPNRaLaCQaVOaEQaEQ
;91    3.000E+03 dGHADNQdLaDQaXOaFQaFQ
;91    4.000E+03 BPHHDMAULaEQaYOaGQaGQ
;91    5.000E+03 QTHVWMQFLaEQqPOaGQaGQ
;91    6.000E+03 AGHUWMiYKaEQqQOaGQaGQ
;91    8.000E+03 F@GdIMgFKaFQqROaGQaGQ
;91    1.000E+04 CdGSQMEaKaFQqROaHQaHQ
;91    1.500E+04 qQGBRMCgKaFQqSOaHQaHQ
;91    2.000E+04 iPFAfMR`KaFQqSOaHQaHQ
;91    3.000E+04 dGFaHMQdKaFQqSOaHQaHQ
;91    4.000E+04 BPFIfLAUKaFQqTOaHQaHQ
;91    5.000E+04 QTFHCLQFKaFQqTOaHQaHQ
;91    6.000E+04 AGFvYLiXJaGQqTOaHQaHQ
;91    8.000E+04 F@EeALgFJaGQqTOaHQaHQ
;91    1.000E+05 CdEdDLEaJaGQqTOaHQaHQ
;==== ELEMENT  92
;92    1.000E-03 qFSTSOfQU@@R@@RfSUfQU
;92    1.022E-03 qESdVOvFU@@R@@RvGUvFU
;92    1.045E-03 qEStYOVBU@@R@@RVCUVBU
;92 N3 1.045E-03 qEStYOVQU@@R@@RVRUVQU
;92    1.153E-03 qDSESOERU@@R@@RESUERU
;92    1.273E-03 qBSVBOTQU@@R@@RTSUTQU
;92 N2 1.273E-03 qBSVBOTXU@@R@@RTYUTXU
;92    1.354E-03 qASfPODEU@@R@@RDFUDEU
;92    1.441E-03 q@SWAOSYU@@R@@RcPUSYU
;92 N1 1.441E-03 q@SWAOcVU@@R@@RcWUcVU
;92    1.500E-03 aISGUOsGU@@R@@RsHUsGU
;92    2.000E-03 aCSACPAeU@@R@@RAgUAeU
;92    3.000E-03 Q@SaPPWXT@@R@@RgYTWXT
;92    3.552E-03 ADSAiPUET@@R@@ReFTUET
;92 M5 3.552E-03 ADSAiPaFU@@R@@RaGUaFU
;92    3.639E-03 ACSQcPQHU@@R@@RQIUQHU
;92    3.728E-03 ABSQhPQ@U@@R@@RQAUQ@U
;92 M4 3.728E-03 ABSQhPQWU@@R@@RQXUQWU
;92    4.000E-03 IeRRBPqBU@@R@@RqCUqBU
;92    4.303E-03 YSRbFPQ@U@@R@@RQAUQ@U
;92 M3 4.303E-03 YSRbFPaHU@@R@@RaIUaHU
;92    5.000E-03 HdRRYPH`T@@R@@RHiTH`T
;92    5.182E-03 hWRbWPHCT@@R@@RXBTHCT
;92 M2 5.182E-03 hWRbWPXRT@@R@@RhQTXRT
;92    5.362E-03 XQRrTPGcT@@R@@RWbTGcT
;92    5.548E-03 xERBbPg@T@@R@@RgHTg@T
;92 M1 5.548E-03 xERBbPWQT@@R@@RWYTWQT
;92    6.000E-03 WgRCAPf@T@@R@@RfHTf@T
;92    8.000E-03 VWRsUPCDT@@R@@RSATCDT
;92    1.000E-02 UPRDPPqTT@@R@@RqYTqTT
;92    1.500E-02 sSRuQPVES@@R@@RVSSVES
;92    1.717E-02 cBRVDPtCS@@R@@RdVStDS
;92 L3 1.717E-02 cBRVDPADT@@R@@RAGTADT
;92    2.000E-02 bYRfSPFcS@@R@@RWASFdS
;92    2.095E-02 RTRvWPFDS@@R@@Rv@SFES
;92 L2 2.095E-02 RTRvWPXXS@@R@@RHdSXXS
;92    2.135E-02 BXRFcPXGS@@R@@RHRSXGS
;92    2.176E-02 BRRFiPwWS@@R@@RHBSwXS
;92 L1 2.176E-02 BRRFiPXgS@@R@@RiBSXhS
;92    3.000E-02 QXRGcPSfS@@R@@RTCSSgS
;92    4.000E-02 AGRXXPAgS@@R@@RQhSAhS
;92    5.000E-02 gXQICPADS@@R@@RQBSADS
;92    6.000E-02 uXQyAPvFR@@R@@RGCRFVR
;92    8.000E-02 cSQYRPRdR@@R@@RCPRCCR
;92    1.000E-01 RRQYQPaQR@@R@@RQeRqPR
;92    1.156E-01 QgQISPAIR@@R@@RqHRQHR
;92 K  1.156E-01 QgQISPdPR@@R@@RDiRtPR
;92    1.500E-01 aFQYFPrGR@@R@@RRYRBVR
;92    2.000E-01 WTPhXPQDR@@R@@Rq@RaBR
;92    3.000E-01 cRPGaPDEQ@@R@@RUIQDcQ
;92    4.000E-01 RCPWAPB@Q@@R@@RRbQrQQ
;92    5.000E-01 APPVUPQHQ@@R@@RQhQAdQ
;92    6.000E-01 YbOV@PGaP@@R@@RAYQqIQ
;92    8.000E-01 uQOEPPTIP@@R@@RABQYYP
;92    1.000E+00 sQODgPbUP@@R@@RW`PWRP
;92    1.022E+00 SUODbPRTP@@R@@RwRPwFP
;92    1.250E+00 BPOtGPqRPDVN@@RvGPVCP
;92    1.500E+00 aXOShPaBPb@O@@RUYPERP
;92    2.000E+00 YRNCPPwHOFTO@@RDhPtXP
;92    2.044E+00 YBNsFPWAOF`O@@RDdPtUP
;92    3.000E+00 dFNbXPCeOqDPyFLDUPDPP
;92    4.000E+00 BPNbDPRQOAhPCaMtIPtGP
;92    5.000E+00 QTNQcPAcOrCPWXMDVPDUP
;92    6.000E+00 AGNqQPASOrQPQFNTXPTWP
;92    7.000E+00 GgMQTPQGOCEPQVNtSPtRP
;92    8.000E+00 FCMAPPIiNsFPQeNDhPDgP
;92    9.000E+00 tWMaHPXTNcTPrBNEDPECP
;92    1.000E+01 CfMQIPWQNS`PbWNUIPUIP
;92    1.100E+01 SIMQAPfYNTDPC@NuEPuEP
;92    1.200E+01 bXMADPFCNtFPsANUPPUPP
;92    1.300E+01 bIMIaOEYNTWPcPNeUPeUP
;92    1.400E+01 QgMiHOECNtWPChNuYPuYP
;92    1.500E+01 qRMHaOdUNTfPTDNUcPUcP
;92    1.600E+01 QQMxIOtANUCPtINFFPFEP
;92    1.800E+01 QIMgWOsWNETPDeNfIPfIP
;92    2.000E+01 iVLGGOsENuRPeFNVQPVQP
;92    2.200E+01 WhLVWOCANUgPeTNvQPvQP
;92    2.400E+01 vQLVDOrTNf@PUiNV`PV`P
;92    2.600E+01 uRLuVORQNFQPvANGHPGHP
;92    2.800E+01 TcLETOrANfQPfPNgDPgDP
;92    3.000E+01 dILUEORENvYPFhNwIPwIP
;92    4.000E+01 BQLDIOQXNWQPH@NHBPHBP
;92    5.000E+01 QULCROaENHEPHdNHYPHYP
;92    6.000E+01 AGLRdOACNHWPYQNHgPHgP
;92    8.000E+01 FDKrBOgTMIIPAEOISPISP
;92    1.000E+02 CfKQcOFGMYRPQBOIcPIcP
;92    1.500E+02 qRKqGODAMABQaDOAEQAEQ
;92    2.000E+02 iVJAHOC@MAFQqAOAIQAIQ
;92    3.000E+02 dIJgRNQiMQAQAPOQCQQCQ
;92    4.000E+02 BQJUgNAYMQDQAUOQFQQFQ
;92    5.000E+02 QUJTdNQIMQEQAXOQGQQGQ
;92    6.000E+02 AGJdCNIiLQGQQQOQIQQIQ
;92    8.000E+02 FDIs@NGQLQHQQUOa@Qa@Q
;92    1.000E+03 CfIrRNUcLQIQQWOaAQaAQ
;92    1.500E+03 qRIQ`NSeLaAQaQOaCQaCQ
;92    2.000E+03 iVHAWNRfLaBQaSOaDQaDQ
;92    3.000E+03 dIHABNQgLaCQaUOaEQaEQ
;92    4.000E+03 BQHGiMAXLaCQaVOaEQaEQ
;92    5.000E+03 QUHFUMQHLaDQaWOaEQaEQ
;92    6.000E+03 AGHEWMIeKaDQaWOaFQaFQ
;92    8.000E+03 FDGdAMwIKaDQaXOaFQaFQ
;92    1.000E+04 CfGCTMUaKaDQaYOaFQaFQ
;92    1.500E+04 qRGrHMSdKaEQaYOaFQaFQ
;92    2.000E+04 iVFAcMRfKaEQqPOaGQaGQ
;92    3.000E+04 dIFaFMQgKaEQqPOaGQaGQ
;92    4.000E+04 BQFiXLAXKaEQqPOaGQaGQ
;92    5.000E+04 QUFGhLQHKaEQqPOaGQaGQ
;92    6.000E+04 AGFfVLIeJaEQqPOaGQaGQ
;92    8.000E+04 FDEUALwIJaEQqPOaGQaGQ
;92    1.000E+05 CfETFLUaJaEQqQOaGQaGQ
;==== ELEMENT  93
;93    1.000E-03 qISTROVdU@@R@@RVeUVdU
;93    1.042E-03 qIStXOFTU@@R@@RFVUFTU
;93    1.087E-03 qHSEEOUhU@@R@@RF@UUhU
;93 N3 1.087E-03 qHSEEOvGU@@R@@RvHUvGU
;93    1.201E-03 qGSeYOeGU@@R@@ReIUeGU
;93    1.328E-03 qESFUOtGU@@R@@RtHUtGU
;93 N2 1.328E-03 qESFUODSU@@R@@RDTUDSU
;93    1.500E-03 qCSGWOCXU@@R@@RCYUCXU
;93    1.501E-03 qCSGWOCWU@@R@@RCYUCWU
;93 N1 1.501E-03 qCSGWOSTU@@R@@RSUUSTU
;93    2.000E-03 aFSADPQeU@@R@@RQfUQeU
;93    3.000E-03 QCSaPPWhT@@R@@RHITWhT
;93    3.666E-03 AESQfPEDT@@R@@RUETEDT
;93 M5 3.666E-03 AESQfPaAU@@R@@RaBUaAU
;93    3.757E-03 ADSB@PQCU@@R@@RQDUQCU
;93    3.850E-03 ACSBEPAGU@@R@@RAHUAGU
;93 M4 3.850E-03 ACSBEPQQU@@R@@RQRUQQU
;93    4.000E-03 AASRCPqHU@@R@@RqIUqHU
;93    4.435E-03 iWRrDPAGU@@R@@RAHUAGU
;93 M3 4.435E-03 iWRrDPaEU@@R@@RaFUaEU
;93    5.000E-03 IIRbPPiCT@@R@@RyBTiCT
;93    5.366E-03 xTRrVPwQT@@R@@RG`TwQT
;93 M2 5.366E-03 xTRrVPXHT@@R@@RhGTXHT
;93    5.542E-03 XYRBdPWUT@@R@@RgTTWUT
;93    5.723E-03 HSRRaPVgT@@R@@RGFTVgT
;93 M1 5.723E-03 HSRRaPgGT@@R@@RwFTgGT
;93    6.000E-03 XIRCCPFYT@@R@@RVWTFYT
;93    8.000E-03 vURsXPSHT@@R@@RcETSHT
;93    1.000E-02 eURDTPAbT@@R@@RAgTAbT
;93    1.500E-02 CdRuWPFUS@@R@@RFdSFUS
;93    1.761E-02 cBRfIPdFS@@R@@RTYSdFS
;93 L3 1.761E-02 cBRfIPAAT@@R@@RAETAAT
;93    2.000E-02 rWRvQPWFS@@R@@RGUSWGS
;93    2.160E-02 RRRVePEbS@@R@@RFHSEcS
;93 L2 2.160E-02 RRRVePhIS@@R@@RXUSx@S
;93    2.201E-02 BVRGAPW`S@@R@@RXESW`S
;93    2.243E-02 BQRGGPWQS@@R@@RwVSWRS
;93 L1 2.243E-02 BQRGGPhWS@@R@@RXbShXS
;93    3.000E-02 aSRWcPTDS@@R@@RtASTES
;93    4.000E-02 Q@RhXPQfS@@R@@RBHSQgS
;93    5.000E-02 WcQYEPAIS@@R@@RQHSQ@S
;93    6.000E-02 UgQISPfYR@@R@@RwIRvYR
;93    8.000E-02 sUQiTPCIR@@R@@RSWRSIR
;93    1.000E-01 bPQiTPqPR@@R@@RBERqYR
;93    1.187E-01 QeQYTPAGR@@R@@RqFRQFR
;93 K  1.187E-01 QeQYTPDXR@@R@@RtWRTWR
;93    1.500E-01 q@QiIPBWR@@R@@RrPRRWR
;93    2.000E-01 GaPHaPQIR@@R@@RqERaGR
;93    3.000E-01 sUPWbPdEQ@@R@@REQQEDQ
;93    4.000E-01 bAPgAPR@Q@@R@@RCDQBbQ
;93    5.000E-01 AUPfUPaDQ@@R@@RBEQQaQ
;93    6.000E-01 ACPVIPhBP@@R@@RQTQATQ
;93    8.000E-01 UcOEXPDRP@@R@@RAEQY`P
;93    1.000E+00 CeOTdPB`P@@R@@RXCPwTP
;93    1.022E+00 cYODiPbXP@@R@@RWdPWXP
;93    1.250E+00 BYODSPAaPdPN@@RVTPfIP
;93    1.500E+00 qTODDPaIPbHO@@RuSPUUP
;93    2.000E+00 Y`NCUPwYOfUO@@RTiPDiP
;93    2.044E+00 IXNCQPWPOGBO@@RTfPDfP
;93    3.000E+00 DSNrRPDEOqHPYPLTUPTPP
;93    4.000E+00 RPNbGPbTOQbPCgMDYPDVP
;93    5.000E+00 aPNQfPQcOrHPgYMTVPTTP
;93    6.000E+00 QANqSPQQOrWPQHNdXPdWP
;93    7.000E+00 XIMQVPaDOSBPQYNDcPDbP
;93    8.000E+00 fGMARPADOCSPQhNThPTgP
;93    9.000E+00 TfMq@PI@NsRPrENUDPUDP
;93    1.000E+01 DBMaAPWaNSiPrQNu@Pu@P
;93    1.100E+01 sBMQCPGENdCPCDNEVPEVP
;93    1.200E+01 rYMAFPvENDVPsFNeRPeQP
;93    1.300E+01 rHMYfOuXNdWPcVNuWPuVP
;93    1.400E+01 BEMIROu@NDhPSdNUaPUaP
;93    1.500E+01 qYMXdODiNEFPd@NFEPFEP
;93    1.600E+01 QWMXROTTNeDPDUNVHPVHP
;93    1.800E+01 aDMwXOSgNUVPTbNFSPFSP
;93    2.000E+01 A@MWHOSSNEdPuDNfUPfUP
;93    2.200E+01 x@LfWOSGNV@PuRNFfPFfP
;93    2.400E+01 VhLfCOBhNvDPFHNGEPGEP
;93    2.600E+01 UdLEeObTNVUPFPNgCPgCP
;93    2.800E+01 UCLUROBSNvUPvPNGPPGPP
;93    3.000E+01 DVLeCObFNVdPVhNWUPWUP
;93    4.000E+01 RQLTEOaVNgXPXBNXIPXIP
;93    5.000E+01 aQLCWOqANhCPXgNhXPhXP
;93    6.000E+01 QBLRiOAHNhVPiTNIGPIGP
;93    8.000E+01 fHKrFOHDMiIPAFOiTPiTP
;93    1.000E+02 DBKQfOvIMyTPQDOAAQAAQ
;93    1.500E+02 qYKqIOdBMADQaEOAGQAGQ
;93    2.000E+02 A@KAIOSEMAIQqCOQAQQAQ
;93    3.000E+02 DWJwTNBIMQCQAROQFQQFQ
;93    4.000E+02 RQJFFNQWMQFQAWOQHQQHQ
;93    5.000E+02 aQJEBNaEMQHQQPOa@Qa@Q
;93    6.000E+02 QBJt@NADMQIQQSOaAQaAQ
;93    8.000E+02 fHIsFNG`LaAQQWOaCQaCQ
;93    1.000E+03 DBIrVNfDLaBQQYOaDQaDQ
;93    1.500E+03 qYIQcNTELaDQaSOaFQaFQ
;93    2.000E+03 A@IAYNSALaEQaUOaFQaFQ
;93    3.000E+03 DWHADNBGLaFQaWOaGQaGQ
;93    4.000E+03 RQHHAMQVLaFQaXOaHQaHQ
;93    5.000E+03 aQHVUMaDLaFQaYOaHQaHQ
;93    6.000E+03 QBHUUMADLaGQqPOaHQaHQ
;93    8.000E+03 fHGdHMwXKaGQqPOaIQaIQ
;93    1.000E+04 DBGCYMfBKaGQqQOaIQaIQ
;93    1.500E+04 qYGBQMTEKaGQqQOaIQaIQ
;93    2.000E+04 A@GAfMSAKaHQqROaIQaIQ
;93    3.000E+04 DWFaHMBGKaHQqROaIQaIQ
;93    4.000E+04 RQFIbLQVKaHQqROq@Qq@Q
;93    5.000E+04 aQFH@LaDKaHQqROq@Qq@Q
;93    6.000E+04 QBFvVLADKaHQqSOq@Qq@Q
;93    8.000E+04 fHEUILwWJaHQqSOq@Qq@Q
;93    1.000E+05 DBEdBLfBJaHQqSOq@Qq@Q
;==== ELEMENT  94
;94    1.000E-03 ARSDTOWHU@@R@@RWIUWHU
;94    1.056E-03 AQStWOVRU@@R@@RVTUVRU
;94    1.115E-03 APSUAOUcU@@R@@RUdUUcU
;94 N3 1.115E-03 APSUAOv@U@@R@@RvBUv@U
;94    1.237E-03 qISEaOUHU@@R@@RUIUUHU
;94    1.372E-03 qGSVYOdEU@@R@@RdGUdEU
;94 N2 1.372E-03 qGSVYOtAU@@R@@RtBUtAU
;94    1.500E-03 qESwCOcQU@@R@@RcRUcQU
;94    1.559E-03 qESgWOsDU@@R@@RsEUsDU
;94 N1 1.559E-03 qESgWOCPU@@R@@RCRUCPU
;94    2.000E-03 aISABPBBU@@R@@RBDUBBU
;94    3.000E-03 QFSQXPhHT@@R@@RxIThHT
;94    3.778E-03 AFSQhPDhT@@R@@RTiTDhT
;94 M5 3.778E-03 AFSQhPQGU@@R@@RQHUQGU
;94    3.874E-03 AESBCPAIU@@R@@RQ@UAIU
;94    3.973E-03 ADSBGPABU@@R@@RACUABU
;94 M4 3.973E-03 ADSBGPqIU@@R@@RAPUqIU
;94    4.000E-03 ADSBIPARU@@R@@RASUARU
;94    4.557E-03 ySRrEPACU@@R@@RADUACU
;94 M3 4.557E-03 ySRrEPa@U@@R@@RaAUa@U
;94    5.000E-03 iGRRUPYVT@@R@@RiUTYVT
;94    5.541E-03 xURrYPwDT@@R@@RGSTwDT
;94 M2 5.541E-03 xURrYPwYT@@R@@RGhTwYT
;94    5.734E-03 XWRBgPWFT@@R@@RgETWFT
;94    5.933E-03 HPRRePVXT@@R@@RfWTVXT
;94 M1 5.933E-03 HPRRePFfT@@R@@RVeTFgT
;94    6.000E-03 xDRRhPfXT@@R@@RvVTfXT
;94    8.000E-03 FfRsSPcHT@@R@@RsETcHT
;94    1.000E-02 uTRtIPAhT@@R@@RQdTAhT
;94    1.500E-02 SaRuSPfWS@@R@@RGFSfWS
;94    1.806E-02 SHRvEPTCS@@R@@RDUSTDS
;94 L3 1.806E-02 SHRvEPyYS@@R@@RAATyYS
;94    2.000E-02 BbRfYPGRS@@R@@RwQSGSS
;94    2.227E-02 BXRGCPUUS@@R@@RE`SUVS
;94 L2 2.227E-02 BXRGCPWbS@@R@@RXGSWbS
;94    2.268E-02 BRRGIPWTS@@R@@RwYSWUS
;94    2.310E-02 rFRWEPWIS@@R@@RGTSg@S
;94 L1 2.310E-02 rFRWEPx@S@@R@@RXTSx@S
;94    3.000E-02 aWRWbPdHS@@R@@RDUSdIS
;94    4.000E-02 QBRhXPBCS@@R@@RRESBDS
;94    5.000E-02 HIQYDPQCS@@R@@RaBSQDS
;94    6.000E-02 V@QIRPVeR@@R@@RgURGDR
;94    8.000E-02 CcQiUPcBR@@R@@RsPRsBR
;94    1.000E-01 bVQiUPqWR@@R@@RRCRAfR
;94    1.218E-01 QaQYSPADR@@R@@RqBRQCR
;94 K  1.218E-01 QaQYSPt@R@@R@@RTYRDPR
;94    1.500E-01 qCQy@PRTR@@R@@RrWRbSR
;94    2.000E-01 WiPHbPaBR@@R@@RqIRqAR
;94    3.000E-01 CdPWcPtIQ@@R@@RUWQUHQ
;94    4.000E-01 bFPgBPRHQ@@R@@RSBQR`Q
;94    5.000E-01 AYPfVPaIQ@@R@@RR@QQfQ
;94    6.000E-01 AEPf@PXUP@@R@@RQXQAWQ
;94    8.000E-01 FHOEYPdPP@@R@@RAGQAAQ
;94    1.000E+00 SeOTePRaP@@R@@RhFPGgP
;94    1.022E+00 sYOT`PrYP@@R@@RHGPwPP
;94    1.250E+00 RVODTPAiPdXN@@RfSPvHP
;94    1.500E+00 qYODEPqDPrCO@@RE`PeRP
;94    2.000E+00 ABOCVPXAOvXO@@REEPTeP
;94    2.044E+00 ySNCRPGaOWEO@@REAPTaP
;94    3.000E+00 TUNrSPdBOAPPYRLTYPTUP
;94    4.000E+00 RWNbGPrUOQePChMTSPTPP
;94    5.000E+00 aUNQgPBAOBQPwQMdPPTXP
;94    6.000E+00 QDNqTPQWOB`PQHNtRPtQP
;94    7.000E+00 HQMQVPaIOSEPQYNDfPDfP
;94    8.000E+00 FTMARPAHOCVPQhNEBPEAP
;94    9.000E+00 EIMqAPyFNsUPrFNUHPUHP
;94    1.000E+01 TBMaAPhBNDBPrQNuEPuDP
;94    1.100E+01 CQMQCPwCNdGPCENUQPUPP
;94    1.200E+01 BfMAFPfPNTPPsGNeVPeVP
;94    1.300E+01 BTMYhOFANtRPcVNEaPEaP
;94    1.400E+01 RAMITOUQNTbPSeNUfPUfP
;94    1.500E+01 AcMXfOEINUAPdANV@PV@P
;94    1.600E+01 aQMXTOtRNeIPDVNfCPfCP
;94    1.800E+01 aGMG`OTCNeQPTcNFXPFXP
;94    2.000E+01 ACMWIOcWNEiPuENvQPvPP
;94    2.200E+01 XSLfXOs@NVFPuTNVbPVbP
;94    2.400E+01 WFLfEOC@NFPPFINWAPWAP
;94    2.600E+01 V@LEfOrTNfRPFQNgIPgIP
;94    2.800E+01 eGLUSORSNFaPvQNGVPGVP
;94    3.000E+01 TXLeDOrENG@PViNgRPgRP
;94    4.000E+01 RXLTFOqRNwUPXCNhFPhFP
;94    5.000E+01 aULCWOqFNxAPXhNxVPxVP
;94    6.000E+01 QELC@OQCNxTPiVNYEPYEP
;94    8.000E+01 FUKrFOxEMyHPAGOySPySP
;94    1.000E+02 TCKQfOfSMIcPQDOAAQAAQ
;94    1.500E+02 AcKAPOtHMAEQaFOAHQAHQ
;94    2.000E+02 ACKAIOcGMQ@QqCOQBQQBQ
;94    3.000E+02 TXJwVNRGMQDQAROQGQQGQ
;94    4.000E+02 RXJFGNaSMQGQAWOQIQQIQ
;94    5.000E+02 aUJECNq@MQIQQPOaAQaAQ
;94    6.000E+02 QEJtANAHMa@QQSOaBQaBQ
;94    8.000E+02 FUIsFNX@LaBQQWOaDQaDQ
;94    1.000E+03 TCIrWNFXLaCQQYOaEQaEQ
;94    1.500E+03 AcIQcNtALaEQaSOaGQaGQ
;94    2.000E+03 ACIQPNcCLaFQaUOaHQaHQ
;94    3.000E+03 TXHADNRFLaGQaWOaIQaIQ
;94    4.000E+03 RXHHCMaRLaGQaXOaIQaIQ
;94    5.000E+03 aUHVVMaILaHQaYOaIQaIQ
;94    6.000E+03 QEHUVMAHLaHQaYOq@Qq@Q
;94    8.000E+03 FUGdIMHHKaHQqPOq@Qq@Q
;94    1.000E+04 TCGSPMFVKaHQqQOq@Qq@Q
;94    1.500E+04 AcGBRMtAKaIQqQOq@Qq@Q
;94    2.000E+04 ACGAfMcCKaIQqROqAQqAQ
;94    3.000E+04 TXFaHMREKaIQqROqAQqAQ
;94    4.000E+04 RXFIdLaRKaIQqROqAQqAQ
;94    5.000E+04 aUFHBLaIKaIQqROqAQqAQ
;94    6.000E+04 QEFvXLAHKaIQqROqAQqAQ
;94    8.000E+04 FUEe@LHGJaIQqSOqAQqAQ
;94    1.000E+05 TCEdCLFVJaIQqSOqAQqAQ
;==== ELEMENT  95
;95    1.000E-03 ARStCOwEU@@R@@RwGUwEU
;95    1.066E-03 ARStQOVXU@@R@@RVYUVXU
;95    1.136E-03 AQSUAOEiU@@R@@RU`UEiU
;95 N3 1.136E-03 AQSUAOfFU@@R@@RfGUfFU
;95    1.266E-03 qISEdOEIU@@R@@RU@UEIU
;95    1.412E-03 qHSfVOTDU@@R@@RTEUTDU
;95 N2 1.412E-03 qHSfVOTIU@@R@@Rd@UTIU
;95    1.500E-03 qFSWFOsQU@@R@@RsSUsQU
;95    1.617E-03 qESGcOSIU@@R@@Rc@USIU
;95 N1 1.617E-03 qESGcOcEU@@R@@RcFUcEU
;95    2.000E-03 q@SA@PBHU@@R@@RR@UBHU
;95    3.000E-03 QGSQUPXRT@@R@@RhTTXRT
;95    3.887E-03 AFSB@PtPT@@R@@RDaTtPT
;95 M5 3.887E-03 AFSB@PQ@U@@R@@RQAUQ@U
;95    4.000E-03 ADSBEPADU@@R@@RAEUADU
;95    4.092E-03 ACSR@PyUT@@R@@RIeTyUT
;95 M4 4.092E-03 ACSR@PqHU@@R@@RqIUqHU
;95    4.370E-03 A@SbCPQGU@@R@@RQHUQGU
;95    4.667E-03 iYRrFPYhT@@R@@RAAUYhT
;95 M3 4.667E-03 iYRrFPQFU@@R@@RQGUQFU
;95    5.000E-03 yDRRQPI`T@@R@@RY`TI`T
;95    5.710E-03 hVRBaPVhT@@R@@RGGTVhT
;95 M2 5.710E-03 hVRBaPGPT@@R@@RGYTGPT
;95    6.000E-03 HPRRcPVVT@@R@@RfTTVVT
;95    6.121E-03 x@RRhPfDT@@R@@RvBTfDT
;95 M1 6.121E-03 x@RRhPVPT@@R@@RVXTVPT
;95    8.000E-03 VaRcWPsFT@@R@@RCSTsFT
;95    1.000E-02 uXRtCPQbT@@R@@RQhTQbT
;95    1.500E-02 SdReVPFdS@@R@@RgDSFdS
;95    1.850E-02 SBRvGPShS@@R@@Rt@SSiS
;95 L3 1.850E-02 SBRvGPyHS@@R@@RyPSyIS
;95    2.000E-02 BeRfRPgTS@@R@@RWdSgUS
;95    2.294E-02 BQRGFPeES@@R@@RUPSeFS
;95 L2 2.294E-02 BQRGFPWPS@@R@@RwUSWQS
;95    2.335E-02 rERWBPWFS@@R@@RGPSWFS
;95    2.377E-02 r@RWGPFcS@@R@@RGGSFdS
;95 L1 2.377E-02 r@RWGPGhS@@R@@RXBSGiS
;95    3.000E-02 aXRGePtHS@@R@@RTUStHS
;95    4.000E-02 QCRhPPBHS@@R@@Rb@SBIS
;95    5.000E-02 XHQIGPQFS@@R@@RaESQGS
;95    6.000E-02 VGQyEPWER@@R@@RGfRgDR
;95    8.000E-02 CgQYWPsBR@@R@@RC`RCQR
;95    1.000E-01 bYQYWPAbR@@R@@RRIRQbR
;95    1.250E-01 AeQITPA@R@@R@@RaHRQ@R
;95 K  1.250E-01 AeQITPT@R@@R@@RtHRTIR
;95    1.500E-01 qEQiCPRYR@@R@@RBbRbXR
;95    2.000E-01 X@PxVPaER@@R@@RARRqDR
;95    3.000E-01 CiPGhPTPQ@@R@@ReXQeIQ
;95    4.000E-01 bIPWHPbDQ@@R@@RSHQReQ
;95    5.000E-01 QQPfRPqCQ@@R@@RRDQQiQ
;95    6.000E-01 AGPVFPH`P@@R@@RaPQQPQ
;95    8.000E-01 VHOEUPtTP@@R@@RAHQABQ
;95    1.000E+00 DAOTbPCAP@@R@@RxCPWcP
;95    1.022E+00 CeODgPBhP@@R@@RXDPwUP
;95    1.250E+00 bPODRPQePtRN@@RfWPFQP
;95    1.500E+00 AbODBPqIPrFO@@REbPeTP
;95    2.000E+00 ACOCTPxGOFeO@@REFPTfP
;95    2.044E+00 Y`NsIPHGOgCO@@REBPTbP
;95    3.000E+00 dSNrQPtFOAQPIVLdPPTUP
;95    4.000E+00 bQNbFPBdOQfPCeMTSPTPP
;95    5.000E+00 aXNQePBGOBQPgVMdPPTXP
;95    6.000E+00 QFNqSPaROB`PQGNtQPtPP
;95    7.000E+00 XVMQUPqCOSEPQXNDfPDeP
;95    8.000E+00 VVMAQPQBOCWPQgNEBPEAP
;95    9.000E+00 UHMq@PiUNsVPrDNUHPUGP
;95    1.000E+01 d@Ma@PHWNDBPrPNuDPuDP
;95    1.100E+01 CWMQBPWUNdGPCCNUPPUPP
;95    1.200E+01 RbMAEPFaNTPPsDNeVPeVP
;95    1.300E+01 BYMYbOVINtRPcTNEaPEaP
;95    1.400E+01 RDMyIOeXNTbPSbNUfPUfP
;95    1.500E+01 AgMXaOeDNUAPTHNV@PV@P
;95    1.600E+01 aTMHYODgNeIPDSNfCPfCP
;95    1.800E+01 q@MwUOdENeQPT`NFXPFXP
;95    2.000E+01 AEMWEOsXNU`PuBNvPPvPP
;95    2.200E+01 hXLfTOCPNVFPuPNVbPVaP
;95    2.400E+01 gILfAOCHNFPPFENWAPWAP
;95    2.600E+01 fBLEcOBbNfRPvGNgIPgIP
;95    2.800E+01 uFLUPObQNFbPfWNGVPGVP
;95    3.000E+01 dWLeAOBRNG@PVdNgRPgRP
;95    4.000E+01 bSLTDOqXNwVPHGNhGPhGP
;95    5.000E+01 aXLCUOAPNxBPXbNxWPxWP
;95    6.000E+01 QGLRhOQFNxUPYYNYFPYFP
;95    8.000E+01 VWKrEOXYMyIPAFOyTPyTP
;95    1.000E+02 d@KQeOFcMIdPQCOABQABQ
;95    1.500E+02 AgKqIOTQMAEQaEOAHQAHQ
;95    2.000E+02 AEKAIOsGMQ@QqBOQBQQBQ
;95    3.000E+02 dWJwQNbDMQEQAQOQGQQGQ
;95    4.000E+02 bSJFDNaWMQGQAVOa@Qa@Q
;95    5.000E+02 aXJE@NqDMQIQAYOaAQaAQ
;95    6.000E+02 QGJdHNQAMaAQQROaCQaCQ
;95    8.000E+02 VWIsDNxDLaBQQUOaDQaDQ
;95    1.000E+03 d@IrUNfWLaCQQXOaEQaEQ
;95    1.500E+03 AgIQbNDTLaEQaQOaGQaGQ
;95    2.000E+03 AEIAYNsCLaFQaSOaHQaHQ
;95    3.000E+03 dWHACNbBLaGQaVOaIQaIQ
;95    4.000E+03 bSHWhMaVLaHQaWOaIQaIQ
;95    5.000E+03 aXHVRMqCLaHQaXOq@Qq@Q
;95    6.000E+03 QGHUSMQALaHQaXOq@Qq@Q
;95    8.000E+03 VWGdFMxBKaHQaYOq@Qq@Q
;95    1.000E+04 d@GCXMfUKaIQaYOq@Qq@Q
;95    1.500E+04 AgGBPMDSKaIQqPOqAQqAQ
;95    2.000E+04 AEGAeMsBKaIQqPOqAQqAQ
;95    3.000E+04 dWFaGMbBKaIQqQOqAQqAQ
;95    4.000E+04 bSFyYLaVKaIQqQOqAQqAQ
;95    5.000E+04 aXFWgLqCKaIQqQOqAQqAQ
;95    6.000E+04 QGFvTLQAKaIQqQOqAQqAQ
;95    8.000E+04 VWEUGLxAJaIQqQOqAQqAQ
;95    1.000E+05 d@Ed@LfUJaIQqQOqAQqAQ
;==== ELEMENT  96
;96    1.000E-03 ASSdEOWRU@@R@@RWTUWRU
;96    1.074E-03 ARSdXOfTU@@R@@RfVUfTU
;96    1.154E-03 AQSUDOEgU@@R@@REhUEgU
;96 N3 1.154E-03 AQSUDOfCU@@R@@RfDUfCU
;96    1.289E-03 APSEiOEEU@@R@@REFUEEU
;96    1.440E-03 qHSvSODIU@@R@@RT@UDIU
;96 N2 1.440E-03 qHSvSOTGU@@R@@RTIUTGU
;96    1.500E-03 qGSGHOCbU@@R@@RCcUCbU
;96    1.643E-03 qESGhOSGU@@R@@RSHUSGU
;96 N1 1.643E-03 qESGhOcCU@@R@@RcDUcCU
;96    2.000E-03 q@SIhORDU@@R@@RREURDU
;96    3.000E-03 QGSQSPxWT@@R@@RHiTxWT
;96    3.971E-03 AESBBPdQT@@R@@RtQTdQT
;96 M5 3.971E-03 AESBBPADU@@R@@RAEUADU
;96    4.000E-03 AESBCPACU@@R@@RADUACU
;96    4.227E-03 ABSRDPiBT@@R@@RyBTiBT
;96 M4 4.227E-03 ABSRDPaIU@@R@@Rq@UaIU
;96    4.503E-03 YaRbGPQAU@@R@@RQBUQAU
;96    4.797E-03 iPRBPPYUT@@R@@RiUTYUT
;96 M3 4.797E-03 iPRBPPQAU@@R@@RQBUQAU
;96    5.000E-03 yIRBYPAAU@@R@@RABUAAU
;96    5.895E-03 XTRBfPfQT@@R@@RfYTfQT
;96 M2 5.895E-03 XTRBfPGAT@@R@@RGITGAT
;96    6.000E-03 HTRRaPvQT@@R@@RvYTvQT
;96    6.288E-03 h@RCBPUgT@@R@@RFETUgT
;96 M1 6.288E-03 h@RCBPfBT@@R@@Rv@TfBT
;96    8.000E-03 VdRcTPCTT@@R@@RSQTCTT
;96    1.000E-02 EaRdIPQgT@@R@@RBCTQgT
;96    1.500E-02 SgReRPGAS@@R@@RGQSGBS
;96    1.893E-02 CGRvIPCeS@@R@@RTFSCfS
;96 L3 1.893E-02 CGRvIPIDS@@R@@RyESIDS
;96    2.000E-02 BgRVWPGeS@@R@@RXDSGfS
;96    2.380E-02 rBRWBPDhS@@R@@RUBSDiS
;96 L2 2.380E-02 rBRWBPViS@@R@@RgBSViS
;96    2.413E-02 bHRWFPvTS@@R@@RVgSvTS
;96    2.446E-02 bDRg@PVPS@@R@@RvSSVPS
;96 L1 2.446E-02 bDRg@PGYS@@R@@RwRSGYS
;96    3.000E-02 qPRwYPDWS@@R@@RdUSDXS
;96    4.000E-02 QDRXSPRCS@@R@@RbFSRDS
;96    5.000E-02 hFQXiPQIS@@R@@RaHSa@S
;96    6.000E-02 fCQiGPwFR@@R@@RHGRGUR
;96    8.000E-02 SbQYPPCRR@@R@@RSaRSRR
;96    1.000E-01 rRQYPPAhR@@R@@RbERQhR
;96    1.282E-01 qYQyDPiWQ@@R@@RaDRAFR
;96 K  1.282E-01 qYQyDPSaR@@R@@RTHRD@R
;96    1.500E-01 qGQYFPbTR@@R@@RBgRrSR
;96    2.000E-01 h@PxPPaHR@@R@@RATRqFR
;96    3.000E-01 SdPGcPdQQ@@R@@RuYQuIQ
;96    4.000E-01 rCPWCPr@Q@@R@@RcDQCAQ
;96    5.000E-01 QSPVXPqGQ@@R@@RRHQBBQ
;96    6.000E-01 AIPVCPIGP@@R@@RaSQQRQ
;96    8.000E-01 fHOERPDiP@@R@@RAIQACQ
;96    1.000E+00 DHODiPSAP@@R@@RHQPH@P
;96    1.022E+00 SaODdPRhP@@R@@RhAPGbP
;96    1.250E+00 bTOtIPBAPtVN@@RvQPFUP
;96    1.500E+00 AeOD@PASPrIO@@REePeWP
;96    2.000E+00 AEOCRPhTOVcO@@REHPTgP
;96    2.044E+00 AAOsHPxCOw@O@@REDPTdP
;96    3.000E+00 tQNbYPDYOAQPIPLdQPTVP
;96    4.000E+00 bVNbEPRcOQfPCcMTSPTQP
;96    5.000E+00 qQNQdPRDOBRPgQMdPPTXP
;96    6.000E+00 QINqRPaWOBaPQGNtQPtPP
;96    7.000E+00 xQMQTPqGOSEPQWNDfPDeP
;96    8.000E+00 fWMAPPQEOCWPQfNEAPEAP
;96    9.000E+00 eGMaIPYdNsVPrCNUHPUGP
;96    1.000E+01 dGMa@PxSNDBPbXNuDPuCP
;96    1.100E+01 SSMQBPwXNdGPCANUPPUPP
;96    1.200E+01 RgMAEPGANTPPsBNeVPeUP
;96    1.300E+01 RSMIfOvHNtRPcRNEaPE`P
;96    1.400E+01 RHMyCOEeNTbPCiNUfPUeP
;96    1.500E+01 Q`MHfOEPNUAPTFNV@PV@P
;96    1.600E+01 aWMHTOEANeIPDQNfCPfCP
;96    1.800E+01 qBMwQOtHNeQPDgNFXPFXP
;96    2.000E+01 AGMWAOCiNU`PeHNvPPvPP
;96    2.200E+01 HdLfPOSPNVFPeVNVaPVaP
;96    2.400E+01 GRLVGOSHNFPPFANWAPWAP
;96    2.600E+01 vCLuYORaNfRPvCNgIPgIP
;96    2.800E+01 EULEWObXNFbPfRNGVPGVP
;96    3.000E+01 tULUHOBYNGAPV`NgRPgRP
;96    4.000E+01 bWLTAOAcNwVPHBNhGPhGP
;96    5.000E+01 qQLCSOATNxBPHfNxWPxWP
;96    6.000E+01 QILRfOQINxVPYSNYFPYFP
;96    8.000E+01 fXKrCOHeMIPPAEOyUPyUP
;96    1.000E+02 dHKQdOGCMIePQBOABQABQ
;96    1.500E+02 Q`KqHOdUMAFQaDOAHQAHQ
;96    2.000E+02 AGKAHOCWMQ@QqAOQBQQBQ
;96    3.000E+02 tUJgVNr@MQEQAPOQGQQGQ
;96    4.000E+02 bWJF@NqRMQHQAUOa@Qa@Q
;96    5.000E+02 qQJTgNqHMQIQAXOaAQaAQ
;96    6.000E+02 QIJdENQEMaAQQQOaCQaCQ
;96    8.000E+02 fXIsBNXYLaCQQTOaDQaDQ
;96    1.000E+03 dHIrSNFgLaDQQWOaFQaFQ
;96    1.500E+03 Q`IQaNTWLaEQaPOaGQaGQ
;96    2.000E+03 AGIAXNCSLaFQaROaHQaHQ
;96    3.000E+03 tUHACNbHLaGQaTOaIQaIQ
;96    4.000E+03 bWHWcMqQLaHQaVOaIQaIQ
;96    5.000E+03 qQHFXMqGLaHQaVOq@Qq@Q
;96    6.000E+03 QIHUPMQDLaHQaWOq@Qq@Q
;96    8.000E+03 fXGdDMXVKaIQaXOq@Qq@Q
;96    1.000E+04 dHGCVMFeKaIQaXOq@Qq@Q
;96    1.500E+04 Q`GrIMTWKaIQaYOqAQqAQ
;96    2.000E+04 AGGAdMCRKaIQaYOqAQqAQ
;96    3.000E+04 tUFaGMbHKaIQaYOqAQqAQ
;96    4.000E+04 bWFySLqQKaIQqPOqAQqAQ
;96    5.000E+04 qQFWbLqGKaIQqPOqAQqAQ
;96    6.000E+04 QIFvPLQDKaIQqPOqAQqAQ
;96    8.000E+04 fXEUDLXVJq@QqPOqAQqAQ
;96    1.000E+05 dHETHLFeJq@QqPOqAQqAQ
;==== ELEMENT  97
;97    1.000E-03 AVSdBOGcU@@R@@RGdUGcU
;97    1.111E-03 AUSDfOVPU@@R@@RVQUVPU
;97    1.235E-03 ASSUVOuIU@@R@@REQUuIU
;97 N3 1.235E-03 ASSUVOuTU@@R@@RuUUuTU
;97    1.500E-03 APSGDOSdU@@R@@RSeUSdU
;97    1.554E-03 qISwEOcWU@@R@@RcXUcWU
;97 N2 1.554E-03 qISwEOsQU@@R@@RsSUsQU
;97    1.651E-03 qHSW`OcHU@@R@@RcIUcHU
;97    1.755E-03 qGSHXOBiU@@R@@RR`UBiU
;97 N1 1.755E-03 qGSHXORdU@@R@@RRfURdU
;97    2.000E-03 qCSIeObDU@@R@@RbEUbDU
;97    3.000E-03 a@SQSPYGT@@R@@RiITYGT
;97    4.000E-03 AGSBDPtTT@@R@@RDdTtTT
;97    4.132E-03 AFSR@PtIT@@R@@RTPTtIT
;97 M5 4.132E-03 AFSR@PIbT@@R@@RYcTIbT
;97    4.247E-03 ADSRFPyCT@@R@@RITTyCT
;97    4.366E-03 ACSbAPHfT@@R@@RXgTHgT
;97 M4 4.366E-03 ACSbAPaCU@@R@@RaDUaCU
;97    4.661E-03 YhRrDPAFU@@R@@RAGUAFU
;97    4.977E-03 iTRBYPIFT@@R@@RYFTIFT
;97 M3 4.977E-03 iTRBYPAFU@@R@@RAGUAFU
;97    5.000E-03 iRRRPPAEU@@R@@RAFUAEU
;97    6.000E-03 hURRbPfPT@@R@@RfXTfPT
;97    6.147E-03 XRRRhPVIT@@R@@RfHTVIT
;97 M2 6.147E-03 XRRRhPVWT@@R@@RfUTVWT
;97    6.348E-03 xERCFPFFT@@R@@RVDTFFT
;97    6.556E-03 XGRSCPUYT@@R@@ReXTUYT
;97 M1 6.556E-03 XGRSCPEcT@@R@@RUaTEcT
;97    8.000E-03 WARcVPSWT@@R@@RcTTSWT
;97    1.000E-02 UeRtBPBDT@@R@@RR@TBDT
;97    1.500E-02 DFReVPw@S@@R@@RwQSwAS
;97    1.945E-02 CERVRPsTS@@R@@RDESsUS
;97 L3 1.945E-02 CERVRPxWS@@R@@RIISxXS
;97    2.000E-02 ReRfRPHIS@@R@@RxISX@S
;97    2.438E-02 r@RgEPtVS@@R@@RE@StWS
;97 L2 2.438E-02 r@RgEPFcS@@R@@RGGSFdS
;97    2.483E-02 bERw@PVQS@@R@@RvTSVRS
;97    2.527E-02 RIRwEPfAS@@R@@RFSSfBS
;97 L1 2.527E-02 RIRwEPWFS@@R@@RwHSWFS
;97    3.000E-02 qTRGePdTS@@R@@RDcSdUS
;97    4.000E-02 QGRhPPbBS@@R@@RrESbCS
;97    5.000E-02 HXQIGPaDS@@R@@RqDSaES
;97    6.000E-02 FQQyEPgYR@@R@@RHRRwXR
;97    8.000E-02 DCQYXPSXR@@R@@RDHRcXR
;97    1.000E-01 B`QYYPQgR@@R@@RrERBGR
;97    1.316E-01 qVQIPPIWQ@@R@@RaBRADR
;97 K  1.316E-01 qVQIPPsYR@@R@@RDFRChR
;97    1.500E-01 AQQiEPrTR@@R@@RRgRBcR
;97    2.000E-01 HUPxXPqBR@@R@@RQPRAQR
;97    3.000E-01 DFPWaPD`Q@@R@@RF@QUYQ
;97    4.000E-01 BPPgAPBPQ@@R@@RsFQSBQ
;97    5.000E-01 QXPfUPASQ@@R@@RbEQBIQ
;97    6.000E-01 QBPVIPIYP@@R@@RaXQQWQ
;97    8.000E-01 FXOEXPUCP@@R@@RQCQAFQ
;97    1.000E+00 dAOTdPcFP@@R@@RhRPh@P
;97    1.022E+00 DDODiPSBP@@R@@RHRPHAP
;97    1.250E+00 rSODSPRAPDhN@@RFgPVYP
;97    1.500E+00 QaODDPQPPBVO@@RUgPuXP
;97    2.000E+00 AIOCUPIFOWAO@@RUHPEGP
;97    2.044E+00 ADOCQPxSOWPO@@RUDPECP
;97    3.000E+00 DgNrRPtQOAUPYPLdYPdTP
;97    4.000E+00 rUNbGPCGOB@PCgMdQPTXP
;97    5.000E+00 qVNQfPbDOBVPgYMdXPdVP
;97    6.000E+00 aCNqSPqUOBePQHNtYPtXP
;97    7.000E+00 IAMQVPASOcAPQYNTcPTcP
;97    8.000E+00 VaMARPaAOSSPQhNEIPEIP
;97    9.000E+00 EVMq@PADOCbPrENeFPeEP
;97    1.000E+01 DRMaAPYENDIPrQNERPERP
;97    1.100E+01 cUMQCPXENtDPCDNUYPUXP
;97    1.200E+01 CGMAFPwDNTXPsFNuUPuTP
;97    1.300E+01 bRMYfOfXND`PcUNU`PU`P
;97    1.400E+01 bFMISOVBNE@PScNFEPFEP
;97    1.500E+01 QgMXeOeUNe@Pd@NVIPVIP
;97    1.600E+01 qSMXROeENuHPDUNvCPvCP
;97    1.800E+01 qGMwYOTYNuQPTaNVXPVXP
;97    2.000E+01 QAMWHODGNF@PuDNFaPFaP
;97    2.200E+01 YDLfWOcVNfGPuRNGCPGCP
;97    2.400E+01 gXLfCOsBNVQPFGNgCPgCP
;97    2.600E+01 VULEeOCENvSPvINGRPGQP
;97    2.800E+01 eULUROBaNVdPfYNWYPWYP
;97    3.000E+01 TbLeCObQNWCPVgNwUPwUP
;97    4.000E+01 rWLTFOQaNGiPX@NHQPHQP
;97    5.000E+01 qWLCWOQQNHWPXeNXbPXbP
;97    6.000E+01 aCLRiOaENXaPiRNyBPyBP
;97    8.000E+01 VaKrFOiFMYVPAFOYbPYbP
;97    1.000E+02 DSKQfOwFMA@QQCOACQACQ
;97    1.500E+02 QgKqIODfMAGQaEOQ@QQ@Q
;97    2.000E+02 QAKAIOcSMQBQqBOQDQQDQ
;97    3.000E+02 TbJwTNBQMQGQAQOQIQQIQ
;97    4.000E+02 rWJFFNA`Ma@QAVOaBQaBQ
;97    5.000E+02 qWJEBNATMaBQQPOaDQaDQ
;97    6.000E+02 aCJt@Na@MaCQQROaEQaEQ
;97    8.000E+02 VaIsFNXhLaEQQVOaGQaGQ
;97    1.000E+03 DSIrVNWHLaFQQXOaHQaHQ
;97    1.500E+03 QgIQcNtXLaGQaROaIQaIQ
;97    2.000E+03 QAIAYNSYLaHQaTOq@Qq@Q
;97    3.000E+03 TbHADNrILaIQaVOqAQqAQ
;97    4.000E+03 rWHHAMqYLq@QaWOqBQqBQ
;97    5.000E+03 qWHVUMASLq@QaXOqBQqBQ
;97    6.000E+03 aCHUUMQILqAQaXOqBQqBQ
;97    8.000E+03 VaGdHMXfKqAQaYOqCQqCQ
;97    1.000E+04 DSGSPMWGKqAQqPOqCQqCQ
;97    1.500E+04 QgGBQMtXKqAQqPOqCQqCQ
;97    2.000E+04 QAGAfMSXKqAQqQOqCQqCQ
;97    3.000E+04 TbFaHMrIKqBQqQOqCQqCQ
;97    4.000E+04 rWFIcLqYKqBQqQOqCQqCQ
;97    5.000E+04 qWFH@LASKqBQqQOqCQqCQ
;97    6.000E+04 aCFvWLQIKqBQqQOqCQqCQ
;97    8.000E+04 VaEUILXfJqBQqQOqCQqCQ
;97    1.000E+05 DSEdBLWFJqBQqROqDQqDQ
;==== ELEMENT  98
;98    1.000E-03 AWSDHOGhU@@R@@RGiUGhU
;98    1.131E-03 AUStXOvIU@@R@@RFQUvIU
;98    1.279E-03 ATSUYOUIU@@R@@Re@UUIU
;98 N3 1.279E-03 ATSUYOURU@@R@@RUTUURU
;98    1.500E-03 AQSF`ODEU@@R@@RDFUDEU
;98    1.616E-03 qISGTOCXU@@R@@RSPUCXU
;98 N2 1.616E-03 qISGTOSRU@@R@@RSTUSRU
;98    1.705E-03 qHSWcOSEU@@R@@RSGUSEU
;98    1.799E-03 qGSHUOBbU@@R@@RBdUBbU
;98 N1 1.799E-03 qGSHUOBgU@@R@@RBiUBgU
;98    2.000E-03 qDSYUOr@U@@R@@RrAUr@U
;98    3.000E-03 aASAYPIRT@@R@@RYTTIRT
;98    4.000E-03 AHSQiPDfT@@R@@RTgTDfT
;98    4.253E-03 AESRAPdAT@@R@@RtBTdAT
;98 M5 4.253E-03 AESRAPITT@@R@@RYUTITT
;98    4.373E-03 ADSRGPXcT@@R@@RICTXcT
;98    4.497E-03 ACSbBPHTT@@R@@RXUTHTT
;98 M4 4.497E-03 ACSbBPQGU@@R@@RQHUQGU
;98    5.000E-03 yPRBUPYHT@@R@@RiGTYHT
;98    5.109E-03 YYRBYPhYT@@R@@RxYThYT
;98 M3 5.109E-03 YYRBYPAAU@@R@@RABUAAU
;98    6.000E-03 xRRBfPvWT@@R@@RFeTvWT
;98    6.359E-03 HPRCAPEbT@@R@@RU`TEbT
;98 M2 6.359E-03 HPRCAPVGT@@R@@RfETVGT
;98    6.554E-03 hDRCHPuRT@@R@@RE`TuRT
;98    6.754E-03 HGRSFPuAT@@R@@RuITuAT
;98 M1 6.754E-03 HGRSFPUST@@R@@ReQTUST
;98    8.000E-03 WFRcPPcTT@@R@@RsRTcTT
;98    1.000E-02 UiRdFPBIT@@R@@RRETBIT
;98    1.500E-02 DIRUYPGWS@@R@@RGiSGXS
;98    1.993E-02 RiRVTPcPS@@R@@RSaScQS
;98 L3 1.993E-02 RiRVTPx@S@@R@@RhQSxAS
;98    2.000E-02 RgRVUPhGS@@R@@RXXShHS
;98    2.525E-02 bARgHPDSS@@R@@RdVSDTS
;98 L2 2.525E-02 bARgHPvGS@@R@@RfPSvHS
;98    2.568E-02 RFRwCPV@S@@R@@RvCSVAS
;98    2.611E-02 RBRwHPEdS@@R@@RFFSEeS
;98 L1 2.611E-02 RBRwHPvSS@@R@@RVeSvTS
;98    3.000E-02 qVRwXPtTS@@R@@RTbStUS
;98    4.000E-02 QHRXSPbHS@@R@@RBPSbIS
;98    5.000E-02 XWQXiPaHS@@R@@RqGSaHS
;98    6.000E-02 FXQiGPW`R@@R@@RhTRH@R
;98    8.000E-02 DGQYQPcYR@@R@@RTIRsXR
;98    1.000E-01 BcQYRPBDR@@R@@RBQRRCR
;98    1.360E-01 aYQiHPXgQ@@R@@RQFRY`Q
;98 K  1.360E-01 aYQiHPSUR@@R@@RCaRcTR
;98    1.500E-01 ASQYGPrYR@@R@@RCCRBhR
;98    2.000E-01 XVPxRPqER@@R@@RQRRATR
;98    3.000E-01 TBPGePTbQ@@R@@RVAQuPQ
;98    4.000E-01 BSPWFPBVQ@@R@@RCRQSGQ
;98    5.000E-01 aQPfPPAWQ@@R@@RbIQRCQ
;98    6.000E-01 QDPVEPyWP@@R@@RqQQQYQ
;98    8.000E-01 VXOETPeIP@@R@@RQDQAGQ
;98    1.000E+00 dHOTaPsFP@@R@@RxPPhGP
;98    1.022E+00 T@ODfPcBP@@R@@RHYPHHP
;98    1.250E+00 rXODQPRHPTbN@@RVaPfTP
;98    1.500E+00 QdODAPQUPBYO@@RF@PEaP
;98    2.000E+00 Q@OCSPyDOWIO@@Re@PEIP
;98    2.044E+00 AFOsIPIAOWWO@@RUEPEEP
;98    3.000E+00 TfNrQPDfOAVPIULtPPdUP
;98    4.000E+00 B`NbFPSGOBAPCeMdRPTYP
;98    5.000E+00 qYNQePrAOBWPgUMdXPdVP
;98    6.000E+00 aENqRPAaOBfPQGNtYPtWP
;98    7.000E+00 YGMQUPAWOcAPQXNTcPTbP
;98    8.000E+00 GCMAQPaDOSSPQgNEIPEHP
;98    9.000E+00 UUMq@PAGOCbPrDNeEPeEP
;98    1.000E+01 TPMa@PIRNDIPbYNERPEQP
;98    1.100E+01 sRMQBPxINtDPCBNUXPUXP
;98    1.200E+01 SCMAEPWVNTXPsDNuTPuTP
;98    1.300E+01 bVMYaOFhND`PcSNU`PU`P
;98    1.400E+01 r@MyGOvANEAPSaNFEPFDP
;98    1.500E+01 B@MX`OEbNe@PTGNVIPVIP
;98    1.600E+01 qVMHWOEPNuHPDRNvCPvCP
;98    1.800E+01 qIMwTOtRNuQPDhNVXPVXP
;98    2.000E+01 QCMWDOTINF@Pu@NFaPFaP
;98    2.200E+01 y@LfSOsWNfGPeXNGCPGCP
;98    2.400E+01 GbLf@OCSNVQPFCNgCPgCP
;98    2.600E+01 fVLEbOSCNvTPvENGQPGQP
;98    2.800E+01 uTLEYOBiNVdPfUNWYPWYP
;98    3.000E+01 E@Le@ObXNWCPVbNwUPwUP
;98    4.000E+01 BbLTCOQgNW`PHENHQPHQP
;98    5.000E+01 A`LCUOQVNHWPHiNXbPXbP
;98    6.000E+01 aELRgOaHNXbPYVNyCPyCP
;98    8.000E+01 GDKrDOYSMYWPAEOYbPYbP
;98    1.000E+02 TPKQeOWWMA@QQCOACQACQ
;98    1.500E+02 B@KqIOE@MAHQaDOQ@QQ@Q
;98    2.000E+02 QCKAIOsTMQBQqAOQDQQDQ
;98    3.000E+02 E@JwPNBXMQGQAPOQIQQIQ
;98    4.000E+02 BbJFCNAfMa@QAUOaBQaBQ
;98    5.000E+02 A`JTiNAXMaBQAYOaDQaDQ
;98    6.000E+02 aEJdGNaCMaCQQQOaEQaEQ
;98    8.000E+02 GDIsDNiELaEQQUOaGQaGQ
;98    1.000E+03 TPIrUNwILaFQQWOaHQaHQ
;98    1.500E+03 B@IQbNTbLaHQaPOaIQaIQ
;98    2.000E+03 QCIAXNcYLaIQaROq@Qq@Q
;98    3.000E+03 E@HACNBVLaIQaTOqAQqAQ
;98    4.000E+03 BbHWgMAdLq@QaVOqBQqBQ
;98    5.000E+03 A`HVQMAXLq@QaVOqBQqBQ
;98    6.000E+03 aEHURMaCLqAQaWOqBQqBQ
;98    8.000E+03 GDGdEMiBKqAQaXOqCQqCQ
;98    1.000E+04 TPGCWMwGKqAQaXOqCQqCQ
;98    1.500E+04 B@GBPMTaKqAQaYOqCQqCQ
;98    2.000E+04 QCGAeMcYKqBQaYOqCQqCQ
;98    3.000E+04 E@FaGMBVKqBQaYOqCQqCQ
;98    4.000E+04 BbFyWLAdKqBQqPOqDQqDQ
;98    5.000E+04 A`FWfLAWKqBQqPOqDQqDQ
;98    6.000E+04 aEFvSLaCKqBQqPOqDQqDQ
;98    8.000E+04 GDEUFLiBJqBQqPOqDQqDQ
;98    1.000E+05 TPEd@LwGJqBQqPOqDQqDQ
;==== ELEMENT  99
;99    1.000E-03 QPSDCOwWU@@R@@RwYUwWU
;99    1.016E-03 AYSTAOWXU@@R@@RgPUWXU
;99    1.032E-03 AYSd@OGPU@@R@@RGQUGPU
;99 N4 1.032E-03 AYSd@OgRU@@R@@RgTUgRU
;99    1.168E-03 AXSTcOfAU@@R@@RfCUfAU
;99    1.321E-03 AVSuUOEGU@@R@@REHUEGU
;99 N3 1.321E-03 AVSuUOuIU@@R@@REQUuIU
;99    1.500E-03 ASSvROdAU@@R@@RdBUdAU
;99    1.680E-03 AQSwQOsDU@@R@@RsFUsDU
;99 N2 1.680E-03 AQSwQOsHU@@R@@RCPUsHU
;99    1.772E-03 APShAOCCU@@R@@RCDUCCU
;99    1.868E-03 qISxTOrQU@@R@@RrSUrQU
;99 N1 1.868E-03 qISxTOrVU@@R@@RrWUrVU
;99    2.000E-03 qGSIVOrIU@@R@@RBPUrIU
;99    3.000E-03 aCSAXPI`T@@R@@RYbTI`T
;99    4.000E-03 QASQhPEFT@@R@@RUGTEFT
;99    4.374E-03 AFSRFPT@T@@R@@RdATT@T
;99 M5 4.374E-03 AFSRFPIET@@R@@RYFTIET
;99    4.500E-03 AESbAPXXT@@R@@RhYTXXT
;99    4.630E-03 ACSbGPXDT@@R@@RhDTXDT
;99 M4 4.630E-03 ACSbGPQCU@@R@@RQDUQCU
;99    5.000E-03 Y`RBTPIYT@@R@@RYYTIYT
;99    5.252E-03 iSRRUPHPT@@R@@RHYTHPT
;99 M3 5.252E-03 iSRRUPI`T@@R@@RY`TI`T
;99    6.000E-03 X`RBfPGBT@@R@@RWATGBT
;99    6.574E-03 xIRCHPUTT@@R@@ReSTUTT
;99 M2 6.574E-03 xIRCHPEhT@@R@@RUfTEhT
;99    6.773E-03 hBRSFPEUT@@R@@RUTTEUT
;99    6.977E-03 HFRcCPEFT@@R@@RUETEFT
;99 M1 6.977E-03 HFRcCPeGT@@R@@RuFTeHT
;99    8.000E-03 w@RcPPsVT@@R@@RCcTsVT
;99    1.000E-02 V@RdFPRFT@@R@@RbBTRFT
;99    1.500E-02 TGRePPwTS@@R@@RXFSwUS
;99    2.000E-02 CDRVWPsPS@@R@@RDASsPS
;99    2.041E-02 RfRfSPSQS@@R@@RCaSSRS
;99 L3 2.041E-02 RfRfSPXFS@@R@@RHVSXFS
;99    2.304E-02 RURGBPEhS@@R@@RVDSEiS
;99    2.602E-02 RGRwIPdDS@@R@@RDVSdES
;99 L2 2.602E-02 RGRwIPVAS@@R@@RvCSVAS
;99    2.646E-02 RCRGTPEeS@@R@@RFGSEeS
;99    2.690E-02 BHRGYPePS@@R@@REaSePS
;99 L1 2.690E-02 BHRGYPFUS@@R@@RfWSFVS
;99    3.000E-02 A`RGaPDiS@@R@@REHST`S
;99    4.000E-02 a@RXVPrFS@@R@@RBYSrGS
;99    5.000E-02 xVQICPqBS@@R@@RARSqCS
;99    6.000E-02 fSQyAPhBR@@R@@RXgRxAR
;99    8.000E-02 TGQYUPCdR@@R@@RtFRSdR
;99    1.000E-01 BiQYVPRBR@@R@@RRQRbBR
;99    1.395E-01 aVQyBPxVQ@@R@@RQCRiYQ
;99 K  1.395E-01 aVQyBPCRR@@R@@RcXRSQR
;99    1.500E-01 AVQiCPBhR@@R@@RSBRRgR
;99    2.000E-01 xWPxWPqIR@@R@@RQWRAXR
;99    3.000E-01 dBPW`PEIQ@@R@@RvAQEhQ
;99    4.000E-01 RPPg@PRUQ@@R@@RSRQcGQ
;99    5.000E-01 aUPfTPQSQ@@R@@RrFQRIQ
;99    6.000E-01 QGPVIPABQ@@R@@RqUQaTQ
;99    8.000E-01 vVOEXPUQP@@R@@RQGQQ@Q
;99    1.000E+00 DPOTePSPP@@R@@RHiPHUP
;99    1.022E+00 dBODiPsFP@@R@@RhWPhEP
;99    1.250E+00 BeODSPbGPEBN@@RGDPvVP
;99    1.500E+00 B@ODDPaRPRUO@@RVAPUaP
;99    2.000E+00 QDOCUPyUOwEO@@ReHPUFP
;99    2.044E+00 AIOCQPIPOwTO@@ReCPUCP
;99    3.000E+00 U@NrRPEGOAXPYPLtVPtQP
;99    4.000E+00 BhNbGPs@OBDPCgMdWPdUP
;99    5.000E+00 AeNQfPBQORQPgYMtTPtRP
;99    6.000E+00 aHNqTPAhOBiPQHNDdPDcP
;99    7.000E+00 IUMQVPQTOcEPQYNTiPThP
;99    8.000E+00 gCMARPq@OSWPQhNUEPUDP
;99    9.000E+00 uRMqAPQBOCgPrENuAPuAP
;99    1.000E+01 dSMaAPIbNTDPrQNEXPEXP
;99    1.100E+01 CcMQCPxUNDPPCDNeUPeTP
;99    1.200E+01 cBMAFPGhNdSPsFNEaPEaP
;99    1.300E+01 rTMYgOWGNDfPcUNUfPUfP
;99    1.400E+01 rGMISOVWNEFPScNVAPVAP
;99    1.500E+01 BFMXeOFFNeFPd@NfFPfFP
;99    1.600E+01 AaMXSOeSNETPDUNFPPFPP
;99    1.800E+01 ASMwYOTbNuXPTaNfVPfUP
;99    2.000E+01 QFMWIOtGNFGPuCNFiPFiP
;99    2.200E+01 YXLfWOScNvEPuQNWAPWAP
;99    2.400E+01 HELfDOSWNVYPFGNwAPwAP
;99    2.600E+01 FfLEfOcGNFbPvINWPPWPP
;99    2.800E+01 UbLUSOCANGCPfXNgXPgXP
;99    3.000E+01 UELeCOB`NgBPVfNGdPGdP
;99    4.000E+01 R`LTFOBENH@PHINXRPXRP
;99    5.000E+01 AfLCWOaRNXXPXdNIDPIDP
;99    6.000E+01 aILRiOqDNIDPiQNITPITP
;99    8.000E+01 gEKrFOYbMyPPAFOAAQAAQ
;99    1.000E+02 dTKQfOGiMABQQCOAEQAEQ
;99    1.500E+02 BFKqIOeAMAIQaEOQBQQBQ
;99    2.000E+02 QFKAIOCiMQCQqBOQFQQFQ
;99    3.000E+02 UEJwUNRXMQHQAQOaAQaAQ
;99    4.000E+02 R`JFGNQcMaAQAVOaCQaCQ
;99    5.000E+02 AfJEBNQTMaCQAYOaEQaEQ
;99    6.000E+02 aIJt@NaIMaEQQROaGQaGQ
;99    8.000E+02 gEIsFNiSLaFQQUOaHQaHQ
;99    1.000E+03 dTIrVNgYLaHQQXOaIQaIQ
;99    1.500E+03 BFIQcNUCLaIQaQOqAQqAQ
;99    2.000E+03 QFIAYNCdLq@QaSOqBQqBQ
;99    3.000E+03 UEHADNRVLqAQaUOqCQqCQ
;99    4.000E+03 R`HHAMQbLqBQaVOqDQqDQ
;99    5.000E+03 AfHVUMQTLqBQaWOqDQqDQ
;99    6.000E+03 aIHUVMaHLqBQaXOqDQqDQ
;99    8.000E+03 gEGdHMiPKqCQaXOqDQqDQ
;99    1.000E+04 dTGSPMgXKqCQaYOqEQqEQ
;99    1.500E+04 BFGBRMUBKqCQqPOqEQqEQ
;99    2.000E+04 QFGAfMCdKqCQqPOqEQqEQ
;99    3.000E+04 UEFaHMRVKqCQqPOqEQqEQ
;99    4.000E+04 R`FIcLQbKqDQqPOqEQqEQ
;99    5.000E+04 AfFHALQSKqDQqQOqEQqEQ
;99    6.000E+04 aIFvWLaHKqDQqQOqEQqEQ
;99    8.000E+04 gEEUILYYJqDQqQOqEQqEQ
;99    1.000E+05 dTEdBLgXJqDQqQOqEQqEQ
;====  END TABLE
;+
; NAME:
;       XWINDOW
;
; PURPOSE:
;       This routine implements a "smart" resizeable graphics window.
;       It is used as a wrapper for built-in IDL graphics procedures
;       such as SURFACE, CONTOUR, PLOT, SHADE_SURF, etc. In additon,
;       it can be used to display any user-written graphics procedure
;       so long as that procedure follows three simple rules: (1) It
;       does not open it's own graphics windows, (2) It is defined with
;       no more than ten positional arguments (an unlimited number
;       of keyword arguments are allowed), and (3) It is defined
;       with an _EXTRA keyword.
;
;       Keyword arguments permit the window to have its own portion
;       of a color table and to be able to change the colors loaded in
;       that portion of the color table. Colors are updated
;       automatically on both 8-bit and 24-bit color displays. In
;       addition, the window colors can "protect" themselves. I mean
;       by this that the window can re-load its own colors into the
;       color table when the cursor is moved over the window. This
;       prevents other applications from changing the colors used to
;       display data in this window. (This is an issue mainly in
;       IDL 5.x applications where widget applications can run
;       concurrently with commands from the IDL command line.)
;
;       Keyword arguments also permit the window to create output
;       files of its contents. These files can be color and
;       gray-scale PostScript, GIF, TIFF, or JPEG files.
;
; AUTHOR:
;       ************* CM 19 Jan 1999 VERSION **********
;       Craig B. Markwardt, NASA/GSFC Code 662, Greenbelt, MD 20770
;       craigm@lheamail.gsfc.nasa.gov
;
;       Originally by:
;       FANNING SOFTWARE CONSULTING
;       David Fanning, Ph.D.
;       2642 Bradbury Court
;       Fort Collins, CO 80521 USA
;       Phone: 970-221-0438
;       E-mail: davidf@dfanning.com
;       Coyote's Guide to IDL Programming: http://www.dfanning.com
;
; CATEGORY:
;       Widgets, Graphics.
;
; CALLING SEQUENCE:
;       XWINDOW, command, P1, P2, ... , keywords=..., ...
;
; REQUIRED INPUTS:
;       COMMAND: The graphics procedure command to be executed. This parameter
;       must be a STRING. Examples are 'SURFACE', 'CONTOUR', 'PLOT', etc.
;
; OPTIONAL INPUTS:
;       Pn: A positional parameter appropriate for the graphics command.
;           Any number of parameters between 0 and 10 may be given.
;
; INPUT KEYWORD PARAMETERS:
;       CPMENU: Setting this keyword adds a "Color Protection" button to the
;       "Controls" menu. Color protection can then be turned ON or OFF for the
;       window. Otherwise, the color protection scheme used to open the window
;       cannot be changed once the window is open. (See the PROTECT keyword.)
;       The default is to have this keyword OFF.
;
;       ERASE: Setting this keyword "erases" the contents of the current
;       graphics window before re-executing the graphics command. For example,
;       this keyword might need to be set if the graphics "command" is TVSCL.
;       The default is to NOT erase the display before reissuing the graphics
;       command.
;
;       _EXTRA: This keyword forms an anonymous structure of any unrecognized
;       keywords passed to the program. The keywords must be appropriate
;       for the graphics command being executed.
;
;       GROUP_LEADER: The group leader for this program. When the group leader
;       is destroyed, this program will be destroyed.
;
;       OUTPUT: Set this keyword if you want a "File Output" menu on
;       the menu bar. The default is to have this item turned OFF.
;
;       JUST_REGISTER: If this keyword is set, the XWINDOW program is just
;       registered with XMANAGER, but XMANAGER doesn't run. This is
;       useful, for example, if you want to open an XWINDOW window in
;       the widget definition module of another widget program.
;
;       NO_CHANGE_CONFIG: Normally as the XWINDOW graphics window is resized
;       the size (or aspect ratio, in the case of PostScript) of the
;       hardware configuration dialogs change to reflect the new size of
;       the graphics window. This results in file output that resembles
;       the current graphics window in size and aspect ratio. If you want
;       the file output dialogs to remember their current configuration
;       even as the window is resized, set this keyword.
;
;       NOMENU: Setting this keyword results in a graphics window without
;       menu items. The default is to have a "Controls" menu item in the
;       window menu bar with a "Quit" button. Setting this keyword
;       automatically turns of the COLORS, OUTPUT, and CPMENU menu
;       choices. (Note that the values specified by the COLORS keyword
;       will still be valid for color protection, but no "Change Colors..."
;       menu item will appear.)
;
;       PROTECT: If this keyword is set, color protection for the draw
;       widget is turned ON. What this means is that the window colors
;       (see the XCOLOR keyword) will be restored when the cursor enters
;       the draw widget window. This prevents someone at the IDL command
;       line in IDL 5.0 from changing the window display colors permanently.
;
;       WTITLE: This is the window title. It is the string "Resizeable
;       COMMAND Window (1)" by default, where COMMAND is the input
;       parameter. And the number (1 in this case) is the window
;       index number of the draw widget.
;
;       WXPOS: This is the initial X offset of the window. Default is to
;       position the window in the approximate middle of the display.
;
;       WYPOS: This is the initial Y offset of the window. Default is to
;       position the window in the approximate middle of the display.
;
;       WXSIZE: This is the initial X size of the window. Default is 400
;       pixels.
;
;       WYSIZE: This is the initial Y size of the window. Default is 400
;       pixels.
;
;       XCOLORS: Using this keyword adds a "Change Colors..." button to the
;       "Controls" menu. Set this keyword to the number of colors available
;       in the window and the starting index of the first color. For example,
;       to allow the window access to 100 colors, starting at color index 50
;       (i.e., color indices 50 to 149), use XColor=[100, 50]. If you use the
;       keyword syntax "/XColor", all the colors available will be used, not just
;       one color. If the keyword is set to a scalar value greater than 1, the
;       starting color index is set to 0. The default value for this keyword
;       is [(!D.N_COLORS < 256), 0]. Note that color "protection" may be
;       turned on (via the PROTECT keyword) even if this keyword is NOT used.
;
; OUTPUT KEYWORD PARAMETERS:
;       DRAWID: This keyword returns the draw widget identifier of the draw
;       widget created in XWINDOW.
;
;       TOP: This keyword returns the identifier of the top-level base widget
;       created by XWINDOW.
;
;       WID: This keyword returns the window index number of the draw widget
;       created in XWINDOW.
;
; COMMON BLOCKS:
;       None.
;
; SIDE EFFECTS:
;       If color protection is ON, the window colors are reloaded when the
;       cursor enters the XWINDOW graphics windows.
;
; RESTRICTIONS: This program requires three additional programs from
;       the Fanning Software Consulting library: PSWINDOW, PS_FORM (CM
;       version; available at
;       http://astrog.physics.wisc.edu/~craigm/idl), and XCOLORS. You
;       might also want to get the program TVIMAGE if you will be
;       displaying images in XWINDOW graphics windows.
;
;       If the "command" program requires keywords that are also keywords
;       to XWINDOW, then you must use the keyword twice on the command line.
;
; EXAMPLE:
;       To display a surface in the window, type:
;
;       XWINDOW, 'SURFACE', Dist(20), Charsize=1.5
;
;       To enable the Change Colors and File Output menu items, type:
;
;       XWINDOW, 'SHADE_SURF', Dist(30), /XColors, /Output
;
; MODIFICATION HISTORY:
;       Written by: David Fanning, October 96.
;       XSIZE and YSIZE keywords changed to WXSIZE and WYSIZE so as not to
;          conflict with these keywords on other programs. 14 April 1997, DWF.
;        Updated as non-blocking widget for IDL 5.0. 14 April 1997, DWF.
;        Extensively modified to work on either 8-bit or 24-bit displays,
;          to enable color protection schemes, to send the contents to a
;          number of different output files, and to give the user choices
;          about which menu items to enable. 21 April 1997, DWF.
;        Renamed COLORS keyword to XCOLORS and fixed a problem cancelling
;           out of File Configuration dialogs. 23 April 1997, DWF.
;        Modification: Craig Markwardt, 21 October 1997
;           Added capability for up to ten positional parameters
;        Modification: CM 15 May 1998
;           PS_FORM dependencies are not hardcoded now.  Requires
;           CM version of PS_FORM function.
;        Modification: CM 19 Jan 1999
;           Added Parent keyword to widget invocation of PS_FORM, and
;           make widgets MODAL-safe.
;-
; Compose the command
thisCommand = proName
FOR i = 2, np DO $
  thisCommand = thisCommand + ', plotObj.param' +STRTRIM(i-1, 2)

; If any extra keywords are present, put them on the command line
IF extraFlag THEN $
  thisCommand = thisCommand + ', _EXTRA=plotObj.extra' ELSE $
  extra = 0

; We need to make sure that all of the parameters are set, at least to 0,
; so that they can be entered into the plotobj structure.
IF NOT KEYWORD_SET(param1) then param1 = 0
IF NOT KEYWORD_SET(param2) then param2 = 0
IF NOT KEYWORD_SET(param3) then param3 = 0
IF NOT KEYWORD_SET(param4) then param4 = 0
IF NOT KEYWORD_SET(param5) then param5 = 0
IF NOT KEYWORD_SET(param6) then param6 = 0
IF NOT KEYWORD_SET(param7) then param7 = 0
IF NOT KEYWORD_SET(param8) then param8 = 0
IF NOT KEYWORD_SET(param9) then param9 = 0
IF NOT KEYWORD_SET(param10) then param10 = 0

plotObj = { thisCommand:thisCommand, extra:extra, $
            param1:param1, param2:param2, param3:param3, param4:param4, $
            param5:param5, param6:param6, param7:param7, param8:param8, $
            param9:param9, param10:param10 }

   ; Store the Plot Object at a pointer location.

plotObjPtr = HANDLE_CREATE()

   ; Create the widgets for this program.

DEVICE, GET_SCREEN_SIZE=screenSize
IF N_ELEMENTS(wxpos) EQ 0 THEN wxpos = (screenSize(0) - xsize) / 2.
IF N_ELEMENTS(wypos) EQ 0 THEN wypos = (screenSize(1) - ysize) / 2.
IF NOT nomenu THEN BEGIN

   tlb = WIDGET_BASE(TLB_SIZE_EVENTS=1, $
      XOFFSET=wxpos, YOFFSET=wypos, MBar=menubase)

   controls = Widget_Button(menubase, Value='Controls', /Menu)

      ; Need a COLORS button?

   IF needColors THEN BEGIN
      colorsID = WIDGET_BUTTON(controls, Value='Change Colors...', $
         Event_Pro='XWINDOW_COLORS', UValue=colors)
   ENDIF

         ; Need color protection buttons?

  IF cpmenu THEN BEGIN
      cprotect = Widget_Button(controls, Value='Color Protection', $
         /Menu, Event_Pro='XWindow_Color_Protection')
      cprotectON = Widget_Button(cprotect, Value='ON', UVALUE='ON')
      cprotectOFF = Widget_Button(cprotect, Value='OFF', UVALUE='OFF')
   ENDIF ELSE BEGIN
      cprotectON = -1L
      cprotectOFF = -1L
   ENDELSE

      ; Need FILE OUTPUT button?

   IF needOutput THEN BEGIN
      outputButton = WIDGET_BUTTON(menubase, Value='File Output', $
         /Menu, Event_Pro='XWindow_Create_Files')
      psID = WIDGET_BUTTON(outputButton, Value='Create PostScript File')
      gifID = WIDGET_BUTTON(outputButton, Value='Create GIF File')
      tiffID = WIDGET_BUTTON(outputButton, Value='Create TIFF File')
      jpegID = WIDGET_BUTTON(outputButton, Value='Create JPEG File')
      configure = WIDGET_BUTTON(outputButton, Value='Configure Output File', $
         /Menu, /Separator, Event_Pro='XWindow_Configure_Files')
      ps_config = WIDGET_BUTTON(configure, Value='Configure PostScript File...')
      gif_config = WIDGET_BUTTON(configure, Value='Configure GIF File...')
      tiff_config = WIDGET_BUTTON(configure, Value='Configure TIFF File...')
      jpeg_config = WIDGET_BUTTON(configure, Value='Configure JPEG File...')
   ENDIF ELSE BEGIN
      psID = -1L
      gifID = -1L
      tiffID = -1L
      jpegID = -1L
   ENDELSE
   quit = Widget_Button(controls, Value='Quit', Event_Pro='XWindow_Quit')
ENDIF ELSE tlb = WIDGET_BASE(TLB_SIZE_EVENTS=1, $
      XOFFSET=wxpos, YOFFSET=wypos)

drawID = WIDGET_DRAW(tlb, XSIZE=xsize, YSIZE=ysize, $
   Event_Pro='XWindow_Draw_Event', Tracking_Events=protect)

WIDGET_CONTROL, tlb, /REALIZE
WIDGET_CONTROL, drawID, GET_VALUE=wid
WSET, wid

   ; Give each window a unique title.

wtitle = wtitle + ' (' + STRTRIM(wid,2) + ')'
Widget_Control, tlb, TLB_SET_TITLE=wtitle

   ; Set color protection button sensitivity.

IF cpmenu THEN BEGIN
   IF protect THEN BEGIN
      WIDGET_CONTROL, cprotectON, Sensitive=0
      WIDGET_CONTROL, cprotectOFF, Sensitive=1
   ENDIF ELSE BEGIN
      WIDGET_CONTROL, cprotectON, Sensitive=1
      WIDGET_CONTROL, cprotectOFF, Sensitive=0
   ENDELSE
ENDIF

   ; If something goes wrong executing the command, trap it.

CATCH, error
   IF error NE 0 THEN BEGIN
      ok = WIDGET_MESSAGE(["There is a problem executing the command", $
                           "string in XWINDOW. Please check keyword", $
                           "spelling and command syntax. Returning..."])
      HANDLE_FREE, plotObjPtr
      WIDGET_CONTROL, tlb, /DESTROY
      RETURN
   ENDIF

   ok = EXECUTE(plotObj.thisCommand)
   IF NOT ok THEN BEGIN
      ok = WIDGET_MESSAGE(["There is a problem executing the command", $
                           "string in XWINDOW. Please check keyword", $
                           "spelling and command syntax. Returning..."])
      HANDLE_FREE, plotObjPtr
      WIDGET_CONTROL, tlb, /DESTROY
      RETURN
   ENDIF

CATCH, /CANCEL

   ; Store the Plot Object in its pointer.

HANDLE_VALUE, plotObjPtr, plotObj, /SET, /NO_COPY

   ; Create an info structure.

info = { top:tlb, $                         ; Top level widget
         xsize:xsize, $                     ; X size of window.
         ysize:ysize, $                     ; Y size of window.
         wid:wid, $                         ; Window index number.
         drawID:drawID, $                   ; Draw widget identifier.
         cprotectON:cprotectON, $           ; Color protection ON button.
         cprotectOFF:cprotectOFF, $         ; Color protection OFF button.
         wtitle:wtitle, $                   ; Window title.
         r:r, $                             ; Red colors in window.
         g:g, $                             ; Green colors in window.
         b:b, $                             ; Blue colors in window.
         wcolors:wcolors, $                 ; Number of window colors.
         gifID:gifID, $                     ; ID of Create GIF file button.
         tiffID:tiffID, $                   ; ID of Create TIFF file button.
         jpegID:jpegID, $                   ; ID of Create JPEG file button.
         psID:psID, $                       ; ID of Create PS file button.
         bottom:bottom, $                   ; Starting color index.
         protect:protect, $                 ; Protect colors flag.
         nomenu:nomenu, $                   ; No menu flag.
         nochange:nochange, $               ; No change flag.
         erase:Keyword_Set(erase), $        ; Need erasure flag.
         ncolors:(!D.N_Colors < 256), $     ; Size of color table.
         plotObjPtr:plotObjPtr, $           ; Pointer to plot object.
         output:needOutput }                ; File Output menu flag.

   ; File Output configuration structures, if needed.

IF Keyword_Set(output) THEN BEGIN
CD, Current=thisDir
ps = ps_form(/init, filename=FilePath(Root_Dir=thisDir,'xwindow.ps'))
pslocal = ps_form(/init, filename=FilePath(Root_Dir=thisDir,'xwindow.ps'), $
                  xsize=10., xoff=0.5, ysize=7.5, yoff=0.5, color=1, $
                  landscape=1)
gif =  {XWINDOW_GIF,XSIZE:400, YSIZE:400, COLOR:1, $
       FILENAME:FilePath(Root_Dir=thisDir,'xwindow.gif'), $
       ORDER:0, QUALITY:-1}
jpeg = {XWINDOW_JPEG,XSIZE:400, YSIZE:400, COLOR:1, $
       FILENAME:FilePath(Root_Dir=thisDir,'xwindow.jpg'), $
       ORDER:0, QUALITY:75}
tiff = {XWINDOW_TIFF,XSIZE:400, YSIZE:400, COLOR:1, $
       FILENAME:FilePath(Root_Dir=thisDir,'xwindow.tif'), $
       ORDER:1, QUALITY:-1}
info = CREATE_STRUCT(info, 'PS', ps, 'PSLOCAL', pslocal, 'GIF', gif, $
                     'JPEG', jpeg, 'TIFF', tiff)
ENDIF

   ; Store the info structure in the TLB.

WIDGET_CONTROL, tlb, SET_UVALUE=info, /NO_COPY

   ; Register the program as on-blocking in 5.0.

thisRelease = StrMid(!Version.Release, 0, 1)
IF thisRelease EQ '5' THEN $
   XManager, 'xwindow', tlb, EVENT_HANDLER='XWINDOW_RESIZE_EVENTS', $
      CLEANUP='XWINDOW_CLEANUP', GROUP_LEADER=group, $
      JUST_REG=justRegister, /No_Block ELSE $
   XManager, 'xwindow', tlb, EVENT_HANDLER='XWINDOW_RESIZE_EVENTS', $
      CLEANUP='XWINDOW_CLEANUP', GROUP_LEADER=group, JUST_REG=justRegister
END