Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/math/kalman.src

Text File | 1988-05-03 | 430.9 KB | 14,737 lines

--::::::::::::::::::::::::::::
--CPU-TIME-CLOCK-SPEC.ADA
--::::::::::::::::::::::::::::

-- This is a function to get CPU time in seconds of type DURATION

function Cpu_Time_Clock return Duration;
--::::::::::::::::::::::::::::
--CPU-TIME-CLOCK-BODY.TXT
--::::::::::::::::::::::::::::

function Cpu_Time_Clock return Duration is

   -- This is a TeleSoft-Ada function to get CPU time in seconds

begin

   return Duration (0.0);

end Cpu_Time_Clock;
--::::::::::::::::::::::::::::
--CPU-TIME-CLOCK-SPEC.ADA
--::::::::::::::::::::::::::::

-- This is a function to get CPU time in seconds of type DURATION

function Cpu_Time_Clock return Duration;
--::::::::::::::::::::::::::::
--CPU-TIME-CLOCK-BODY.ADA
--::::::::::::::::::::::::::::

with System;
use System;
with Condition_Handling;
use Condition_Handling;
with Starlet;
use Starlet;

function Cpu_Time_Clock return Duration is

   -- This is a VAX Ada function to get CPU time in seconds

   Time: Integer;
   Status: Cond_Value_Type;
   Item_List: constant Item_List_Type
              := ((4, Jpi_Cputim, Time'Address, Address_Zero),
                  (0, 0, Address_Zero, Address_Zero));

begin

   -- Call GETJPI to set CPUTIM to total accumulated CPU time
   -- (in 10-millisecond tics)

   Getjpiw (Status => Status, Itmlst => Item_List);
   return Duration (Float (Time) / 100.0);

end Cpu_Time_Clock;
--::::::::::::::::::::::::::::
--CPU-TIME-CLOCK-BODY.ADA
--::::::::::::::::::::::::::::

with System;
use System;
with Condition_Handling;
use Condition_Handling;
with Starlet;
use Starlet;

function Cpu_Time_Clock return Duration is

   -- This is a VAX Ada function to get CPU time in seconds

   Time: Integer;
   Status: Cond_Value_Type;
   Item_List: constant Item_List_Type
              := ((4, Jpi_Cputim, Time'Address, Address_Zero),
                  (0, 0, Address_Zero, Address_Zero));

begin

   -- Call GETJPI to set CPUTIM to total accumulated CPU time
   -- (in 10-millisecond tics)

   Getjpiw (Status => Status, Itmlst => Item_List);
   return Duration (Float (Time) / 100.0);

end Cpu_Time_Clock;
--::::::::::::::::::::::::::::
--KALMAN-OPTIONS-SPEC.ADA
--::::::::::::::::::::::::::::

package Kalman_Options is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Options
   --!
   --! Purpose:
   --!    This package contains values which might be changed during
   --!    the installation of the Ada Kalman Filter. It is expected
   --!    that a mature compiler would be able to recognize the
   --!    values as constants and optimize away any unecessary code
   --!    resulting from using the constants. In this way, a kind
   --!    of macro facility can be created within the bounds of Ada.
   --!
   --! Globals:
   --!    Execute_Debug_Code
   --!       if True will execute the built-in debug code, otherwise
   --!       the debug code will not be executed.
   --!
   --!    Prompt_For_Math_Library
   --!       if True will execute the run-time prompt for the actual
   --!       math library to use, otherwise the Whitaker math library
   --!       will be used.
   --!
   --!    Use_Fast_Matrix_Operations
   --!       if True will execute the fast matrix operations instead
   --!       of the full matrix calculations, otherwise the matrix
   --!       library will be used. By using the fast matrix operations
   --!       an estimated 4500 floating-point multiplies will be
   --!       reduced to approximately 900.
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!    Not applicable.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --! Changes:
   --!    13-MAY-1985
   --!       Changed constants to final delivery values.
   --!
   --!----------------------------------------------------------------

   Execute_Debug_Code         : constant Boolean := False;
   Prompt_For_Math_Library    : constant Boolean := False;
   Use_Fast_Matrix_Operations : constant Boolean := True;

end Kalman_Options;
--::::::::::::::::::::::::::::
--NUMERIC-IO-SPEC.ADA
--::::::::::::::::::::::::::::


with Text_Io; use Text_Io;
package Numeric_Io is

   procedure Get (File : in File_Type; Item : out Integer);
   procedure Get (Item : out Integer);
   procedure Get (File : in File_Type; Item : out Float);
   procedure Get (Item : out Float);
   procedure Put (File : in File_Type;
                  Item : in Integer; Width : in Field := Integer'Width);
   procedure Put (Item : in Integer; Width : in Field := Integer'Width);
   procedure Put (File : in File_Type;
                  Item : in Float; Width : in Field := 2);
   procedure Put (Item : in Float; Width : in Field := 2);

end Numeric_Io;
--::::::::::::::::::::::::::::
--NUMERIC-IO-BODY.ADA
--::::::::::::::::::::::::::::


with Text_Io;
use Text_Io;
package body Numeric_Io is
   -- This ought to be done by instantiating the FLOAT_IO and INTEGER_IO
   --  But if you dont yet have the generic TEXT_IO implemented yet
   --  then something like this does the job on the DEC-10 IAPC
   --  But it is a kludge
   --  No effort has been put into making it pretty or portable

   package Integer_Io is new Text_Io.Integer_Io (Integer); use Integer_Io;
   package Float_Io is new Text_Io.Float_Io (Float); use Float_Io;

   procedure Get (File : in File_Type; Item : out Integer) is
   begin
      Integer_Io.Get (File, Item);
   end Get;

   procedure Get (Item : out Integer) is
   begin
      Integer_Io.Get (Item);
   end Get;

   procedure Get (File : in File_Type; Item : out Float) is
   begin
      Float_Io.Get (File, Item);
   end Get;

   procedure Get (Item : out Float) is
   begin
      Float_Io.Get (Item);
   end Get;

   procedure Put (File : in File_Type;
                  Item : in Integer; Width : in Field := Integer'Width) is
   begin
      Integer_Io.Put (File, Item, Width);
   end Put;

   procedure Put (Item : in Integer; Width : in Field := Integer'Width) is
   begin
      Integer_Io.Put (Item, Width);
   end Put;

   procedure Put (File : in File_Type;
                  Item : in Float; Width : in Field := 2) is
   begin
      Float_Io.Put (File, Item, Width);
   end Put;

   procedure Put (Item : in Float; Width : in Field := 2) is
   begin
      Float_Io.Put (Item, Width);
   end Put;

end Numeric_Io;
--::::::::::::::::::::::::::::
--FLOATING-CHARACTERISTICS-SPEC.ADA
--::::::::::::::::::::::::::::


package Floating_Characteristics is
   --  This package is a floating mantissa definition of a binary FLOAT
   --  It was first used on the DEC-10 and the VAX but should work for any
   --  since the parameters are obtained by initializing on the actual hardware
   --  Otherwise the parameters could be set in the spec if known
   --  This is a preliminary package that defines the properties
   --  of the particular floating point type for which we are going to
   --  generate the math routines
   --  The constants are those required by the routines described in
   --  "Software Manual for the Elementary Functions" W. Cody & W. Waite
   --  Prentice-Hall 1980
   --  Actually most are needed only for the test programs
   --  rather than the functions themselves, but might as well be here
   --  Most of these could be in the form of attributes if
   --  all the floating types to be considered were those built into the
   --  compiler, but we also want to be able to support user defined types
   --  such as software floating types of greater precision than
   --  the hardware affords, or types defined on one machine to
   --  simulate another
   --  So we use the Cody-Waite names and derive them from an adaptation of the
   --  MACHAR routine as given by Cody-Waite in Appendix B

    Ibeta : Integer;
    --  The radix of the floating-point representation

    It : Integer;
    --  The number of base IBETA digits in the DIS_FLOAT significand

    Irnd : Integer;
    --  TRUE (1) if floating addition rounds, FALSE (0) if truncates

    Ngrd : Integer;
    --  Number of guard digits for multiplication

    Machep : Integer;
    --  The largest negative integer such that
    --    1.0 + FLOAT (IBETA) ** MACHEP /= 1.0
    --  except that MACHEP is bounded below by - (IT + 3)

    Negep : Integer;
    --  The largest negative integer such that
    --    1.0 -0 FLOAT (IBETA) ** NEGEP /= 1.0
    --  except that NEGEP is bounded below by - (IT + 3)

    Iexp : Integer;
    --  The number of bits (decimal places if IBETA = 10)
    --  reserved for the representation of the exponent (including
    --  the bias or sign) of a floating-point number

    Minexp : Integer;
    --  The largest in magnitude negative integer such that
    --  FLOAT (IBETA) ** MINEXP is a positive floating-point number


    Maxexp : Integer;
    --  The largest positive exponent for a finite floating-point number

    Eps : Float;
    --  The smallest positive floating-point number such that
    --                              1.0 + EPS /= 1.0
    --  In particular, if IBETA = 2 or IRND = 0,
    --  EPS = FLOAT (IBETA) ** MACHEP
    --  Otherwise, EPS = (FLOAT (IBETA) ** MACHEP) / 2


    Epsneg : Float;
    --  A small positive floating-point number such that 1.0-EPSNEG /= 1.0

    Xmin : Float;
    --  The smallest non-vanishing floating-point power of the radix
    --  In particular, XMIN = FLOAT (IBETA) ** MINEXP

    Xmax : Float;
    --  The largest finite floating-point number

   --  Here the structure of the floating type is defined
   --  I have assumed that the exponent is always some integer form
   --  The mantissa can vary
   --  Most often it will be a fixed type or the same floating type
   --  depending on the most efficient machine implementation
   --  Most efficient implementation may require details of the machine hardware
   --  In this version the simplest representation is used
   --  The mantissa is extracted into a FLOAT and uses the predefined operations
   subtype Exponent_Type is Integer;    --  should be derived  ##########
   subtype Mantissa_Type is Float;     --   range -1.0..1.0;
   --  A consequence of the rigorous constraints on MANTISSA_TYPE is that
   --  operations must be very carefully examined to make sure that no number
   --  greater than one results
   --  Actually this limitation is important in constructing algorithms
   --  which will also run when MANTISSA_TYPE is a fixed point type

   --  If we are not using the STANDARD type, we have to define all the
   --  operations at this point
   --  We also need PUT for the type if it is not otherwise available

   --  Now we do something strange
   --  Since we do not know in the following routines whether the mantissa
   --  will be carried as a fixed or floating type, we have to make some
   --  provision for dividing by two
   --  We cannot use the literals, since FIXED/2.0 and FLOAT/2 will fail
   --  We define a type-dependent factor that will work
   Mantissa_Divisor_2 : constant Float := 2.0;
   Mantissa_Divisor_3 : constant Float := 3.0;
   --  This will work for the MANTISSA_TYPE defined above
   --  The alternative of defining an operation "/" to take care of it
   --  is too sweeping and would allow unAda-like errors

   Mantissa_Half : constant Mantissa_Type := 0.5;


   procedure Defloat (X : in Float;
                      N : in out Exponent_Type; F : in out Mantissa_Type);
   procedure Refloat (N : in Exponent_Type; F : in Mantissa_Type;
                                                   X : in out Float);
   --  Since the user may wish to define a floating type by some other name
   --  CONVERT_TO_FLOAT is used rather than just FLOAT for explicit coersion
   function Convert_To_Float (K : Integer) return Float;
   --  function Convert_To_Float (N : Exponent_Type) return Float;
   function Convert_To_Float (F : Mantissa_Type) return Float;

end Floating_Characteristics;
--::::::::::::::::::::::::::::
--FLOATING-CHARACTERISTICS-BODY.ADA
--::::::::::::::::::::::::::::


with Text_Io; use Text_Io;
package body Floating_Characteristics is
   --  This package is a floating mantissa definition of a binary FLOAT

    A, B, Y, Z : Float;
    I, K, Mx, Iz : Integer;
    Beta, Betam1, Betain : Float;
    One : Float := 1.0;
    Zero : Float := 0.0;

   procedure Defloat (X : in Float;
                      N : in out Exponent_Type; F : in out Mantissa_Type) is
      --  This is admittedly a slow method - but portable - for breaking down
      --  a floating point number into its exponent and mantissa
      --  Obviously with knowledge of the machine representation
      --  it could be replaced with a couple of simple extractions
      Exponent_Length : Integer := Iexp;
      M : Exponent_Type;
      W, Y, Z : Float;
   begin
      N := 0;
      F := 0.0;
      Y := abs (X);
      if Y = 0.0  then
         return;
      elsif Y < 0.5  then
         for J in reverse 0.. (Exponent_Length - 2)  loop
            --  Dont want to go all the way to 2.0** (EXPONENT_LENGTH - 1)
            --  Since that (or its reciprocal) will overflow if exponent biased
            --  Ought to use talbular values rather than compute each time
            M := Exponent_Type (2 ** J);
            Z := 1.0 / (2.0**M);
            W := Y / Z;
            if W < 1.0  then
               Y := W;
               N := N - M;
            end if;
         end loop;
      else
         for J in reverse 0.. (Exponent_Length - 2)  loop
            M := Exponent_Type (2 ** J);
            Z := 2.0**M;
            W := Y / Z;
            if W >= 0.5  then
               Y := W;
               N := N + M;
            end if;
         end loop;
         --  And just to clear up any loose ends from biased exponents
      end if;
      while Y < 0.5  loop
         Y := Y * 2.0;
         N := N - 1;
      end loop;
      while Y >= 1.0  loop
         Y := Y / 2.0;
         N := N + 1;
      end loop;
      F := Mantissa_Type (Y);
      if X < 0.0  then
         F := -F;
      end if;
      return;
   exception
      when others =>
         N := 0;
         F := 0.0;
         return;
   end Defloat;


   procedure Refloat (N : in Exponent_Type; F : in Mantissa_Type;
                                                   X : in out Float) is
      --  Again a brute force method - but portable
      --  Watch out near MAXEXP
      M : Integer;
      Y : Float;
   begin
      if F = 0.0  then
         X := Zero;
         return;
      end if;
      M := Integer (N);
      Y := abs (Float (F));
      while Y < 0.5  loop
         M := M - 1;
         if M < Minexp  then
            X := Zero;
         end if;
         Y := Y + Y;
         exit when M <= Minexp;
      end loop;
      if M = Maxexp  then
         M := M - 1;
         X := Y * 2.0**M;
         X := X * 2.0;
      elsif M <= Minexp + 2  then
         M := M + 3;
         X := Y * 2.0**M;
         X := ((X / 2.0) / 2.0) / 2.0;
      else
         X := Y * 2.0**M;
      end if;
      if F < 0.0  then
         X := -X;
      end if;
      return;
   end Refloat;

   function Convert_To_Float (K : Integer) return Float is
   begin
      return Float (K);
   end Convert_To_Float;

   -- function Convert_To_Float (N : Exponent_Type) return Float is
   -- begin
   --    return Float (N);
   -- end Convert_To_Float;

   function Convert_To_Float (F : Mantissa_Type) return Float is
   begin
      return Float (F);
   end Convert_To_Float;


begin
   --  Initialization for the VAX with values derived by MACHAR
   --  In place of running MACHAR as the actual initialization

    Ibeta :=    2;
    It :=    24;
    Irnd :=    1;
    Negep :=    -24;
    Epsneg :=    5.9604644E-008;
    Machep :=    -24;
    Eps :=    5.9604644E-008;
    Ngrd :=    0;
    Xmin := 5.9E-39;
    Minexp :=    -126;
    Iexp :=    8;
    Maxexp :=    127;
    Xmax :=    8.5E37 * 2.0;


   ----  This initialization is the MACHAR routine of Cody and Waite Appendix B.
   --PUT ("INITIALIZATING WITH MACHAR     -     ");
   --    A := ONE;
   --    while (((A + ONE) - A) - ONE) = ZERO  loop
   --      A := A + A;
   --    end loop;
   --    B := ONE;
   --    while ((A + B) - A) = ZERO  loop
   --      B := B + B;
   --    end loop;
   --    IBETA := INTEGER ((A + B) - A);
   --    BETA := CONVERT_TO_FLOAT (IBETA);
   --
   --
   --    IT := 0;
   --    B := ONE;
   --    while (((B + ONE) - B) - ONE) = ZERO  loop
   --      IT := IT + 1;
   --      B := B * BETA;
   --    end loop;
   --
   --
   --    IRND := 0;
   --    BETAM1 := BETA - ONE;
   --    if ((A + BETAM1) - A) /= ZERO  then
   --      IRND := 1;
   --    end if;
   --
   --
   --    NEGEP := IT + 3;
   --    BETAIN := ONE / BETA;
   --    A := ONE;
   --  --  for I in 1..NEGEP  loop
   --  for I in 1..50  loop
   --  exit when I > NEGEP;
   --      A := A * BETAIN;
   --    end loop;
   --    B := A;
   --    while ((ONE - A) - ONE) = ZERO  loop
   --      A := A * BETA;
   --      NEGEP := NEGEP - 1;
   --    end loop;
   --    NEGEP := -NEGEP;
   --
   --
   --    EPSNEG := A;
   --    if (IBETA /= 2) and (IRND /= 0)  then
   --      A := (A * (ONE + A)) / (ONE + ONE);
   --      if ((ONE - A) - ONE) /= ZERO  then
   --        EPSNEG := A;
   --      end if;
   --    end if;
   --
   --
   --    MACHEP := -IT - 3;
   --    A := B;
   --    while ((ONE + A) - ONE) = ZERO  loop
   --      A := A * BETA;
   --      MACHEP := MACHEP + 1;
   --    end loop;
   --
   --
   --    EPS := A;
   --    if (IBETA /= 2) and (IRND /= 0)  then
   --      A := (A * (ONE + A)) / (ONE + ONE);
   --      if ((ONE + A) - ONE) /= ZERO  then
   --        EPS := A;
   --      end if;
   --    end if;
   --
   --
   --    NGRD := 0;
   --    if ((IRND = 0) and ((ONE + EPS) * ONE - ONE) /= ZERO)  then
   --      NGRD := 1;
   --    end if;
   --
   --
   --    I := 0;
   --    K := 1;
   --    Z := BETAIN;
   --    loop
   --      Y := Z;
   --      Z := Y * Y;
   --      A := Z * ONE;
   --      exit when ((A + A) = ZERO) or (ABS (Z) >= Y);
   --      I := I + 1;
   --      K := K + K;
   --    end loop;
   --    if (IBETA /= 10)  then
   --      IEXP := I + 1;
   --      MX := K + K;
   --    else
   --      IEXP := 2;
   --      IZ := IBETA;
   --      while (K >= IZ)  loop
   --        IZ := IZ * IBETA;
   --        IEXP := IEXP + 1;
   --      end loop;
   --      MX := IZ + IZ - 1;
   --    end if;
   --
   --    loop
   --      XMIN := Y;
   --      Y := Y * BETAIN;
   --      A := Y * ONE;
   --      exit when ((A + A) = ZERO) or (ABS (Y) >= XMIN);
   --      K := K + 1;
   --    end loop;
   --
   --
   --    MINEXP := -K;
   --
   --
   --    if ((MX <= (K + K - 3)) and (IBETA /= 10))  then
   --      MX := MX + MX;
   --      IEXP := IEXP + 1;
   --    end if;
   --
   --
   --    MAXEXP := MX + MINEXP;
   --    I := MAXEXP + MINEXP;
   --    if ((IBETA = 2) and (I = 0))  then
   --      MAXEXP := MAXEXP - 1;
   --    end if;
   --    if (I > 20)  then
   --      MAXEXP := MAXEXP - 1;
   --    end if;
   --    if (A /= Y)  then
   --      MAXEXP := MAXEXP - 2;
   --    end if;
   --
   --
   --    XMAX := ONE - EPSNEG;
   --    if ((XMAX * ONE) /= XMAX)  then
   --      XMAX := ONE - BETA * EPSNEG;
   --    end if;
   --    XMAX := XMAX / (BETA * BETA * BETA * XMIN);
   --    I := MAXEXP + MINEXP + 3;
   --    if I > 0  then
   --      for J in 1..50  loop
   --  exit when J > I;
   --        if IBETA = 2  then
   --          XMAX := XMAX + XMAX;
   --        else
   --          XMAX := XMAX * BETA;
   --        end if;
   --      end loop;
   --    end if;
   --
   --PUT ("INITIALIZED"); NEW_LINE;

end Floating_Characteristics;
--::::::::::::::::::::::::::::
--NUMERIC-PRIMITIVES-SPEC.ADA
--::::::::::::::::::::::::::::


with Floating_Characteristics; use Floating_Characteristics;
package Numeric_Primitives is

   --  This may seem a little much but is put in this form to allow the
   --  same form to be used for a generic package
   --  If that is not needed, simple litterals could be substituted
   Zero  : Float := Convert_To_Float (Integer (0));
   One   : Float := Convert_To_Float (Integer (1));
   Two   : Float := One + One;
   Three : Float := One + One + One;
   Half  : Float := One / Two;

   --  The following "constants" are effectively deferred to
   --  the initialization part of the package body
   --  This is in order to make it possible to generalize the floating type
   --  If that capability is not desired, constants may be included here
   Pi            : Float;
   One_Over_Pi   : Float;
   Two_Over_Pi   : Float;
   Pi_Over_Two   : Float;
   Pi_Over_Three : Float;
   Pi_Over_Four  : Float;
   Pi_Over_Six   : Float;


   function Sign (X, Y : Float) return Float;
    --  Returns the value of X with the sign of Y
   function Max (X, Y :  Float) return Float;
    --  Returns the algebraicly larger of X and Y
   function Truncate (X : Float) return Float;
    --  Returns the floating value of the integer no larger than X
    --  AINT (X)
   function Round (X : Float) return Float;
    --  Returns the floating value nearest X
    --  AINTRND (X)
   function Ran return Float;
    --  This uses a portable algorithm and is included at this point
    --  Algorithms that presume unique machine hardware information
    --  should be initiated in FLOATING_CHARACTERISTICS

end Numeric_Primitives;
--::::::::::::::::::::::::::::
--NUMERIC-PRIMITIVES-BODY.ADA
--::::::::::::::::::::::::::::


with Floating_Characteristics; use Floating_Characteristics;
package body Numeric_Primitives is

   function Sign (X, Y : Float) return Float is
      --  Returns the value of X with the sign of Y
   begin
      if Y >= 0.0  then
         return X;
      else
         return -X;
      end if;
   end Sign;

   function Max (X, Y : Float) return Float is
   begin
      if X >= Y  then
         return X;
      else
         return Y;
      end if;
   end Max;

   function Truncate (X : Float) return Float is
      --  Optimum code depends on how the system rounds at exact halves
   begin
      if Float (Integer (X)) = X  then
         return X;
      end if;
      if X > Zero  then
         return Float (Integer (X - Half));
      elsif X = Zero  then
         return Zero;
      else
         return Float (Integer (X + Half));
      end if;
   end Truncate;

   function Round (X : Float) return Float is
   begin
      return Float (Integer (X));
   end Round;


   package Key is
      X : Integer := 10_001;
      Y : Integer := 20_001;
      Z : Integer := 30_001;
   end Key;

   function Ran return Float is
      --  This rectangular random number routine is adapted from a report
      --  "A Pseudo-Random Number Generator" by B. A. Wichmann and I. D. Hill
      --  NPL Report DNACS XX (to be published)
      --  In this stripped version, it is suitable for machines supporting
      --  INTEGER at only 16 bits and is portable in Ada
      W : Float;
   begin

      Key.X := 171 * (Key.X mod 177 - 177) -  2 * (Key.X / 177);
      if Key.X < 0  then
         Key.X := Key.X + 30269;
      end if;

      Key.Y := 172 * (Key.Y mod 176 - 176) - 35 * (Key.Y / 176);
      if Key.Y < 0  then
         Key.Y := Key.Y + 30307;
      end if;

      Key.Z := 170 * (Key.Z mod 178 - 178) - 63 * (Key.Z / 178);
      if Key.Z < 0  then
         Key.Z := Key.Z + 30323;
      end if;

      --  CONVERT_TO_FLOAT is used instead of FLOAT since the floating
      --  type may be software defined

      W :=     Convert_To_Float (Key.X)/30269.0
           + Convert_To_Float (Key.Y)/30307.0
           + Convert_To_Float (Key.Z)/30323.0;

      return  W - Convert_To_Float (Integer (W - 0.5));

   end Ran;

begin
   Pi            := Convert_To_Float (Integer (3)) +
                    Convert_To_Float (Mantissa_Type (0.14159_26535_89793_23846));
   One_Over_Pi   := Convert_To_Float (Mantissa_Type (0.31830_98861_83790_67154));
   Two_Over_Pi   := Convert_To_Float (Mantissa_Type (0.63661_97723_67581_34308));
   Pi_Over_Two   := Convert_To_Float (Integer (1)) +
                    Convert_To_Float (Mantissa_Type (0.57079_63267_94896_61923));
   Pi_Over_Three := Convert_To_Float (Integer (1)) +
                    Convert_To_Float (Mantissa_Type (0.04719_75511_96597_74615));
   Pi_Over_Four  := Convert_To_Float (Mantissa_Type (0.78539_81633_97448_30962));
   Pi_Over_Six   := Convert_To_Float (Mantissa_Type (0.52359_87755_98298_87308));

end Numeric_Primitives;

with Floating_Characteristics; use Floating_Characteristics;
package Core_Functions is

   Exp_Large : Float;
   Exp_Small : Float;

   function Sqrt (X : Float) return Float;
   function Cbrt (X : Float) return Float;
   function Log (X : Float) return Float;
   function Log10 (X : Float) return Float;
   function Exp (X : Float) return Float;
   function "**" (X, Y : Float) return Float;

end Core_Functions;

--::::::::::::::::::::::::::::
--CORE-FUNCTIONS-BODY.ADA
--::::::::::::::::::::::::::::


with Text_Io; use Text_Io;
with Floating_Characteristics; use Floating_Characteristics;
with Numeric_Io; use Numeric_Io;
with Numeric_Primitives; use Numeric_Primitives;
package body Core_Functions is

   --  The following routines are coded directly from the algorithms and
   --  coeficients given in "Software Manual for the Elementry Functions"
   --  by William J. Cody, Jr. and William Waite, Prentice_Hall, 1980
   --  CBRT by analogy
   --  A more general formulation uses MANTISSA_TYPE, etc.
   --  The coeficients are appropriate for 25 to 32 bits floating significance
   --  They will work for less but slightly shorter versions are possible
   --  The routines are coded to stand alone so they need not be compiled together

   --  These routines have been coded to accept a general MANTISSA_TYPE
   --  That is, they are designed to work with a manitssa either fixed of float
   --  There are some explicit conversions which are required but these will
   --  not cause any extra code to be generated

   --      16 JULY 1982       W A WHITAKER  AFATL EGLIN AFB FL 32542
   --                         T C EICHOLTZ  USAFA


   function Sqrt (X : Float) return Float is
      M, N : Exponent_Type;
      F, Y : Mantissa_Type;
      Result : Float;

      subtype Index is Integer range 0..100;    --  #########################
      Sqrt_L1 : Index := 3;
      --  Could get away with SQRT_L1 := 2 for 28 bits
      --  Using the better Cody-Waite coeficients overflows MANTISSA_TYPE
      Sqrt_C1 : Mantissa_Type := 8#0.3317777777#;
      Sqrt_C2 : Mantissa_Type := 8#0.4460000000#;
      Sqrt_C3 : Mantissa_Type := 8#0.55202_36314_77747_36311_0#;

   begin
      if X = Zero  then
         Result := Zero;
         return Result;
      elsif X = One  then            --  To get exact SQRT (1.0)
         Result := One;
         return Result;
      elsif X < Zero  then
         New_Line;
         Put ("*** ERROR: CALLED SQRT FOR NEGATIVE ARGUMENT ");
         Put (X);
         Put ("  USED ABSOLUTE VALUE ***");
         New_Line;
         Result := Sqrt (abs (X));
         return Result;
      else
         Defloat (X, N, F);
         Y := Sqrt_C1 + Mantissa_Type (Sqrt_C2 * F);
         for J in 1..Sqrt_L1  loop
            Y := Y/Mantissa_Divisor_2 + Mantissa_Type ((F/Mantissa_Divisor_2)/Y);
         end loop;
         if (N mod 2) /= 0  then
            Y := Mantissa_Type (Sqrt_C3 * Y);
            N := N + 1;
         end if;
         M := N/2;
         Refloat (M,Y,Result);
         return Result;
      end if;
   exception
      when others =>
         New_Line;
         Put ("*** ERROR: EXCEPTION IN SQRT, X = ");
         Put (X);
         Put ("  RETURNED 1.0 ***");
         New_Line;
         return One;
   end Sqrt;


   function Cbrt (X : Float) return Float is
      M, N : Exponent_Type;
      F, Y : Mantissa_Type;
      Result : Float;

      subtype Index is Integer range 0..100;    --  #########################
      Cbrt_L1 : Index := 3;
      Cbrt_C1 : Mantissa_Type := 0.5874009;
      Cbrt_C2 : Mantissa_Type := 0.4125990;
      Cbrt_C3 : Mantissa_Type := 0.62996_05249;
      Cbrt_C4 : Mantissa_Type := 0.79370_05260;

   begin
      if X = Zero then
         Result := Zero;
         return Result;
      else
         Defloat (X, N, F);
         F := abs (F);
         Y := Cbrt_C1 + Mantissa_Type (Cbrt_C2 * F);
         for J in 1 .. Cbrt_L1 loop
            Y :=     Y
                 - (  Y/Mantissa_Divisor_3
                    - Mantissa_Type ((F/Mantissa_Divisor_3) / Mantissa_Type (Y*Y)) );
         end loop;
         case (N mod 3) is
            when 0 =>
               null;
            when 1 =>
               Y := Mantissa_Type (Cbrt_C3 * Y);
               N := N + 2;
            when 2 =>
               Y := Mantissa_Type (Cbrt_C4 * Y);
               N := N + 1;
            when others =>
               null;
         end case;
         M := N/3;
         if X < Zero  then
            Y := -Y;
         end if;
         Refloat (M, Y, Result);
         return Result;
      end if;
   exception
      when others =>
         Result := One;
         if X < Zero then
            Result := - One;
         end if;
         New_Line;
         Put ("*** ERROR: EXCEPTION IN CBRT, X = ");
         Put (X);
         Put ("  RETURNED  ");
         Put (Result);
         Put (" ***");
         New_Line;
         return Result;
   end Cbrt;

   function Log (X : Float) return Float is
      --  Uses fixed formulation for generality

      Result : Float;
      N : Exponent_Type;
      Xn : Float;
      Y : Float;
      F : Mantissa_Type;
      Z, Zden, Znum : Mantissa_Type;

      C0 : constant Mantissa_Type := 0.20710_67811_86547_52440;
      --  SQRT (0.5) - 0.5
      C1 : constant Float := 8#0.543#;
      C2 : constant Float :=-2.12194_44005_46905_82767_9E-4;

      function R (Z : Mantissa_Type) return Mantissa_Type is
         --  Use fixed formulation here because the float coeficents are > 1.0
         --  and would exceed the limits on a MANTISSA_TYPE
         A0 : constant Mantissa_Type := 0.04862_85276_587;
         B0 : constant Mantissa_Type := 0.69735_92187_803;
         B1 : constant Mantissa_Type :=-0.125;
         C  : constant Mantissa_Type := 0.01360_09546_862;
      begin
         return Z + Mantissa_Type (Z *
                                   Mantissa_Type (Mantissa_Type (Z * Z) * (C +
                                                                           Mantissa_Type (A0/ (B0 + Mantissa_Type (B1 *


                                                                                                           Mantissa_Type
                                                                                                                   (Z *
                                                                                                                    Z)))
                                                                           ))
                                   ));
      end R;

   begin

      if X < Zero          then
         New_Line;
         Put ("*** ERROR: CALLED LOG FOR NEGATIVE ");
         Put (X);
         Put (" USED ABS => ");
         Result := Log (abs (X));
         Put (Result);
         Put (" ***");
         New_Line;
      elsif X = Zero  then
         New_Line;
         Put ("*** ERROR: CALLED LOG FOR ZERO ARGUMENT, RETURNED ");
         Result := -Xmax;      --  SUPPOSED TO BE -LARGE
         Put (Result);
         Put (" ***");
         New_Line;
      else
         Defloat (X,N,F);
         Znum := F - Mantissa_Half;
         Y := Convert_To_Float (Znum);
         Zden := Znum / Mantissa_Divisor_2 + Mantissa_Half;
         if Znum > C0  then
            Y := Y - Mantissa_Half;
            Znum := Znum - Mantissa_Half;
            Zden := Zden + Mantissa_Half/Mantissa_Divisor_2;
         else
            N := N -1;
         end if;
         Z    := Mantissa_Type (Znum / Zden);
         Result := Convert_To_Float (R (Z));
         if N /= 0  then
            Xn := Convert_To_Float (N);
            Result := (Xn * C2 + Result) + Xn * C1;
         end if;
      end if;
      return Result;

   exception
      when others =>
         New_Line;
         Put ("*** ERROR: EXCEPTION IN LOG, X = ");
         Put (X);
         Put ("  RETURNED 0.0 ***");
         New_Line;
         return Zero;
   end Log;


   function Log10 (X : Float) return Float is
      Log_10_Of_2 : constant Float :=
                    Convert_To_Float (Mantissa_Type (8#0.33626_75425_11562_41615#));
   begin
      return Log (X) * Log_10_Of_2;
   end Log10;

   function Exp (X : Float) return Float is

      Result : Float;
      N : Exponent_Type;
      Xg, Xn, X1, X2 : Float;
      F, G : Mantissa_Type;

      Bigx : Float := Exp_Large;
      Smallx : Float := Exp_Small;

      One_Over_Log_2 : constant Float :=  1.4426_95040_88896_34074;
      C1 : constant Float :=  0.69335_9375;
      C2 : constant Float := -2.1219_44400_54690_58277E-4;

      function R (G : Mantissa_Type) return Mantissa_Type is
         Z , Gp, Q : Mantissa_Type;

         P0 : constant Mantissa_Type :=  0.24999_99999_9992;
         P1 : constant Mantissa_Type :=  0.00595_04254_9776;
         Q0 : constant Mantissa_Type :=  0.5;
         Q1 : constant Mantissa_Type :=  0.05356_75176_4522;
         Q2 : constant Mantissa_Type :=  0.00029_72936_3682;
      begin
         Z  := Mantissa_Type (G * G);
         Gp := Mantissa_Type ((Mantissa_Type (P1 * Z) + P0) * G );
         Q  := Mantissa_Type ((Mantissa_Type (Q2 * Z) + Q1) * Z ) + Q0;
         return Mantissa_Half + Mantissa_Type ( Gp / (Q - Gp) );
      end R;


   begin

      if X > Bigx  then
         New_Line;
         Put ("*** ERROR: EXP CALLED WITH TOO BIG A POSITIVE ARGUMENT, ");
         Put (X);
         Put ("   RETURNED XMAX ***");
         New_Line;
         Result := Xmax;
      elsif X < Smallx  then
         New_Line;
         Put ("*** ERROR: EXP CALLED WITH TOO BIG A NEGATIVE ARGUMENT, ");
         Put (X);
         Put ("  RETURNED ZERO ***");
         New_Line;
         Result := Zero;
      elsif abs (X) < Eps  then
         Result := One;
      else
         N  := Exponent_Type (X * One_Over_Log_2);
         Xn := Convert_To_Float (N);
         X1 := Round (X);
         X2 := X - X1;
         Xg := ((X1 - Xn * C1) + X2 ) - Xn * C2;
         G  := Mantissa_Type (Xg);
         N  := N + 1;
         F := R (G);
         Refloat (N, F, Result);
      end if;
      return Result;

   exception
      when others =>
         New_Line;
         Put ("*** ERROR: EXCEPTION IN EXP, X = ");
         Put (X);
         Put ("  RETURNED 1.0 ***");
         New_Line;
         return One;
   end Exp;

   function "**" (X, Y : Float) return Float is
      --  This is the last function to be coded since it appeared that it really
      --  was un-Ada-like and ought not be in the regular package
      --  Nevertheless it was included in this version
      --  It is specific for FLOAT and does not have the MANTISSA_TYPE generality
      M, N : Exponent_Type;
      G : Mantissa_Type;
      P, Temp, Iw1, I : Integer;
      Result, Z, V, R, U1, U2, W, W1, W2, W3, Y1, Y2 : Float;

      K : constant Float := 0.44269_50408_88963_40736;
      Ibigx : constant Integer := Integer (Truncate (16.0 * Log (Xmax) - 1.0));
      Ismallx : constant Integer := Integer (Truncate (16.0 * Log (Xmin) + 1.0));

      P1 : constant Float := 0.83333_32862_45E-1;
      P2 : constant Float := 0.12506_48500_52E-1;

      Q1 : constant Float := 0.69314_71805_56341;
      Q2 : constant Float := 0.24022_65061_44710;
      Q3 : constant Float := 0.55504_04881_30765E-1;
      Q4 : constant Float := 0.96162_06595_83789E-2;
      Q5 : constant Float := 0.13052_55159_42810E-2;

      A1 : array (1 .. 17) of Float:=
                 (  8#1.00000_0000#,
                  8#0.75222_5750#,
                  8#0.72540_3067#,
                  8#0.70146_3367#,
                  8#0.65642_3746#,
                  8#0.63422_2140#,
                  8#0.61263_4520#,
                  8#0.57204_2434#,
                  8#0.55202_3631#,
                  8#0.53254_0767#,
                  8#0.51377_3265#,
                  8#0.47572_4623#,
                  8#0.46033_7602#,
                  8#0.44341_7233#,
                  8#0.42712_7017#,
                  8#0.41325_3033#,
                  8#0.40000_0000#  );

      A2 : array (1 .. 8) of Float :=
                 (  8#0.00000_00005_22220_66302_61734_72062#,
                  8#0.00000_00003_02522_47021_04062_61124#,
                  8#0.00000_00005_21760_44016_17421_53016#,
                  8#0.00000_00007_65401_41553_72504_02177#,
                  8#0.00000_00002_44124_12254_31114_01243#,
                  8#0.00000_00000_11064_10432_66404_42174#,
                  8#0.00000_00004_72542_16063_30176_55544#,
                  8#0.00000_00001_74611_03661_23056_22556#  );


      function Reduce (V : Float) return Float is
      begin
         return Float (Integer (16.0 * V)) * 0.0625;
      end Reduce;

   begin
      if X <= Zero then
         if X < Zero then
            Result := (abs (X))**Y;
            New_Line;
            Put ("*** ERROR: X ** Y CALLED WITH X = ");
            Put (X);
            Put ("  USED ABS, RETURNED ");
            Put (Result);
            Put (" ***");
            New_Line;
         else
            if Y <= Zero then
               if Y = Zero then
                  Result := Zero;
               else
                  Result := Xmax;
               end if;
               New_Line;
               Put ("*** ERROR: X ** Y CALLED WITH X = 0, Y = ");
               Put (Y);
               Put ("  RETURNED ");
               Put (Result);
               Put (" ***");
               New_Line;
            else
               Result := Zero;
            end if;
         end if;
      else
         Defloat (X, M, G);
         P := 1;
         if G <= A1 (9) then
            P := 9;
         end if;
         if G <= A1 (P+4) then
            P := P + 4;
         end if;
         if G <= A1 (P+2) then
            P := P + 2;
         end if;
         Z := ((G - A1 (P+1)) - A2 ((P+1)/2))/ (G + A1 (P+1));
         Z := Z + Z;
         V := Z * Z;
         R := (P2 * V + P1) * V * Z;
         R := R + K * R;
         U2 := (R + Z * K) + Z;
         U1 := Float (Integer (M) * 16 - P) * 0.0625;
         Y1 := Reduce (Y);
         Y2 := Y - Y1;
         W := U2 * Y + U1 * Y2;
         W1 := Reduce (W);
         W2 := W - W1;
         W := W1 + U1 * Y1;
         W1 := Reduce (W);
         W2 := W2 + (W - W1);
         W3 := Reduce (W2);
         Iw1 := Integer (Truncate (16.0 * (W1 + W3)));
         W2 := W2 - W3;
         if W > Float (Ibigx) then
            Result := Xmax;
            Put ("*** ERROR: X ** Y CALLED  X =");
            Put (X);
            Put ("   Y =");
            Put (Y);
            Put ("   TOO LARGE,  RETURNED ");
            Put (Result);
            Put (" ***");
            New_Line;
         elsif W < Float (Ismallx) then
            Result := Zero;
            Put ("*** ERROR: X ** Y CALLED  X =");
            Put (X);
            Put ("   Y =");
            Put (Y);
            Put ("   TOO SMALL,  RETURNED ");
            Put (Result);
            Put (" ***");
            New_Line;
         else
            if W2 > Zero then
               W2 := W2 - 0.0625;
               Iw1 := Iw1 + 1;
            end if;
            if Iw1 < Integer (Zero) then
               I := 0;
            else
               I := 1;
            end if;
            M := Exponent_Type (I + Iw1/16);
            P := 16 * Integer (M) - Iw1;
            Z := ((((Q5 * W2 + Q4) * W2 + Q3) * W2 + Q2) * W2 + Q1) * W2;
            Z := A1 (P+1) + (A1 (P+1) * Z);

            Refloat (M, Z, Result);
         end if;
      end if;
      return Result;
   end "**";

begin
   Exp_Large := Log (Xmax) * (One - Eps);
   Exp_Small := Log (Xmin) * (One - Eps);
end Core_Functions;
--::::::::::::::::::::::::::::
--TRIG-FUNCTIONS-SPEC.ADA
--::::::::::::::::::::::::::::


--  The following is a series of complete and machine-independent,
--  but not necessarily efficient, packages which, if compiled in order,
--  will provide the elementary functions required by some benchmarks

--  This specific file was prepared for the VAX/VMS Telesoft 1.3d Oct84 release
--  This is an unvalidated system

package Trig_Functions is
   function Sin (X : Float) return Float;
   function Cos (X : Float) return Float;
   function Tan (X : Float) return Float;
   function Cot (X : Float) return Float;
   function Asin (X : Float) return Float;
   function Acos (X : Float) return Float;
   function Atan (X : Float) return Float;
   function Atan2 (V, U : Float) return Float;
   function Sinh (X : Float) return Float;
   function Cosh (X : Float) return Float;
   function Tanh (X : Float) return Float;
end Trig_Functions;
--::::::::::::::::::::::::::::
--TRIG-FUNCTIONS-BODY.ADA
--::::::::::::::::::::::::::::


with Text_Io; use Text_Io;
with Floating_Characteristics; use Floating_Characteristics;
with Numeric_Io; use Numeric_Io;
with Numeric_Primitives; use Numeric_Primitives;
with Core_Functions; use Core_Functions;
package body Trig_Functions is

   --  PRELIMINARY VERSION *********************************

   --  The following routines are coded directly from the algorithms and
   --  coeficients given in "Software Manual for the Elementry Functions"
   --  by William J. Cody, Jr. and William Waite, Prentice_Hall, 1980
   --  This particular version is stripped to work with FLOAT and INTEGER
   --  and uses a mantissa represented as a FLOAT
   --  A more general formulation uses MANTISSA_TYPE, etc.
   --  The coeficients are appropriate for 25 to 32 bits floating significance
   --  They will work for less but slightly shorter versions are possible
   --  The routines are coded to stand alone so they need not be compiled together

   --      16 JULY 1982       W A WHITAKER  AFATL EGLIN AFB FL 32542
   --                         T C EICHOLTZ  USAFA


   function Sin (X : Float) return Float is
      Sgn, Y : Float;
      N : Integer;
      Xn : Float;
      F, G, X1, X2 : Float;
      Result : Float;

      Ymax : Float := Float (Integer (Pi * Two** (It/2)));
      Beta : Float := Convert_To_Float (Ibeta);
      Epsilon : Float := Beta ** (-It/2);

      C1 : constant Float :=  3.140625;
      C2 : constant Float :=  9.6765_35897_93E-4;

      function R (G : Float) return Float is
         R1 : constant Float := -0.16666_66660_883;
         R2 : constant Float :=  0.83333_30720_556E-2;
         R3 : constant Float := -0.19840_83282_313E-3;
         R4 : constant Float :=  0.27523_97106_775E-5;
         R5 : constant Float := -0.23868_34640_601E-7;
      begin
         return ((((R5*G + R4)*G + R3)*G + R2)*G + R1)*G;
      end R;

   begin
      if X < Zero  then
         Sgn := -One;
         Y := -X;
      else
         Sgn := One;
         Y := X;
      end if;

      if Y > Ymax  then
         New_Line;
         Put ("*** ERROR: SIN CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY ");
         Put (X);
         Put (" ***");
         New_Line;
      end if;

      N := Integer (Y * One_Over_Pi);
      Xn := Convert_To_Float (N);
      if N mod 2 /= 0  then
         Sgn := -Sgn;
      end if;
      X1 := Truncate (abs (X));
      X2 := abs (X) - X1;
      F := ((X1 - Xn*C1) + X2) - Xn*C2;
      if abs (F) < Epsilon  then
         Result := F;
      else
         G := F * F;
         Result := F + F*R (G);
      end if;
      return (Sgn * Result);
   end Sin;


   function Cos (X : Float) return Float is
      Sgn, Y : Float;
      N : Integer;
      Xn : Float;
      F, G, X1, X2 : Float;
      Result : Float;

      Ymax : Float := Float (Integer (Pi * Two** (It/2)));
      Beta : Float := Convert_To_Float (Ibeta);
      Epsilon : Float := Beta ** (-It/2);

      C1 : constant Float :=  3.140625;
      C2 : constant Float :=  9.6765_35897_93E-4;

      function R (G : Float) return Float is
         R1 : constant Float := -0.16666_66660_883;
         R2 : constant Float :=  0.83333_30720_556E-2;
         R3 : constant Float := -0.19840_83282_313E-3;
         R4 : constant Float :=  0.27523_97106_775E-5;
         R5 : constant Float := -0.23868_34640_601E-7;
      begin
         return ((((R5*G + R4)*G + R3)*G + R2)*G + R1)*G;
      end R;

   begin
      Sgn := 1.0;
      Y := abs (X) + Pi_Over_Two;

      if Y > Ymax  then
         New_Line;
         Put ("*** ERROR: COS CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY ");
         Put (X);
         Put (" ***");
         New_Line;
      end if;

      N := Integer (Y * One_Over_Pi);
      Xn := Convert_To_Float (N);
      if N mod 2 /= 0  then
         Sgn := -Sgn;
      end if;
      Xn := Xn - 0.5;          -- TO FORM COS INSTEAD OF SIN
      X1 := Truncate (abs (X));
      X2 := abs (X) - X1;
      F := ((X1 - Xn*C1) + X2) - Xn*C2;
      if abs (F) < Epsilon  then
         Result := F;
      else
         G := F * F;
         Result := F + F*R (G);
      end if;
      return (Sgn * Result);
   end Cos;


   function Tan (X : Float) return Float is
      Sgn, Y : Float;
      N : Integer;
      Xn : Float;
      F, G, X1, X2 : Float;
      Result : Float;

      Ymax : Float := Float (Integer (Pi * Two** (It/2))) /2.0;
      Beta : Float := Convert_To_Float (Ibeta);
      Epsilon : Float := Beta ** (-It/2);

      C1 : constant Float :=  8#1.444#;
      C2 : constant Float :=  4.8382_67948_97E-4;

      function R (G : Float) return Float is
         P0 : constant Float :=  1.0;
         P1 : constant Float := -0.11136_14403_566;
         P2 : constant Float :=  0.10751_54738_488E-2;
         Q0 : constant Float :=  1.0;
         Q1 : constant Float := -0.44469_47720_281;
         Q2 : constant Float :=  0.15973_39213_300E-1;
      begin
         return ((P2*G + P1)*G*F + F) / (((Q2*G + Q1)*G +0.5) + 0.5);
      end R;

   begin
      Y := abs (X);
      if Y > Ymax  then
         New_Line;
         Put ("*** ERROR: TAN CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY ");
         Put (X);
         Put (" ***");
         New_Line;
      end if;

      N := Integer (X * Two_Over_Pi);
      Xn := Convert_To_Float (N);
      X1 := Truncate (X);
      X2 := X - X1;
      F := ((X1 - Xn*C1) + X2) - Xn*C2;
      if abs (F) < Epsilon  then
         Result := F;
      else
         G := F * F;
         Result := R (G);
      end if;
      if N mod 2 = 0  then
         return Result;
      else
         return -1.0/Result;
      end if;
   end Tan;

   function Cot (X : Float) return Float is
      Sgn, Y : Float;
      N : Integer;
      Xn : Float;
      F, G, X1, X2 : Float;
      Result : Float;


      Ymax : Float := Float (Integer (Pi * Two** (It/2))) /2.0;
      Beta : Float := Convert_To_Float (Ibeta);
      Epsilon : Float := Beta ** (-It/2);
      Epsilon1 : Float :=  1.0/Xmax;

      C1 : constant Float :=  8#1.444#;
      C2 : constant Float :=  4.8382_67948_97E-4;

      function R (G : Float) return Float is
         P0 : constant Float :=  1.0;
         P1 : constant Float := -0.11136_14403_566;
         P2 : constant Float :=  0.10751_54738_488E-2;
         Q0 : constant Float :=  1.0;
         Q1 : constant Float := -0.44469_47720_281;
         Q2 : constant Float :=  0.15973_39213_300E-1;
      begin
         return ((P2*G + P1)*G*F + F) / (((Q2*G + Q1)*G +0.5) + 0.5);
      end R;

   begin
      Y := abs (X);
      if Y < Epsilon1  then
         New_Line;
         Put ("*** ERROR: COT CALLED WITH ARGUMENT TOO NEAR ZERO ");
         Put (X);
         Put (" ***");
         New_Line;
         if X < 0.0  then
            return -Xmax;
         else
            return Xmax;
         end if;
      end if;
      if Y > Ymax  then
         New_Line;
         Put ("*** ERROR: COT CALLED WITH ARGUMENT TOO LARGE FOR ACCURACY ");
         Put (X);
         Put (" ***");
         New_Line;
      end if;

      N := Integer (X * Two_Over_Pi);
      Xn := Convert_To_Float (N);
      X1 := Truncate (X);
      X2 := X - X1;
      F := ((X1 - Xn*C1) + X2) - Xn*C2;
      if abs (F) < Epsilon  then
         Result := F;
      else
         G := F * F;
         Result := R (G);
      end if;
      if N mod 2 /= 0  then
         return -Result;
      else
         return 1.0/Result;
      end if;
   end Cot;


   function Asin (X : Float) return Float is
      G, Y : Float;
      Result : Float;
      Beta : Float := Convert_To_Float (Ibeta);
      Epsilon : Float := Beta ** (-It/2);

      function R (G : Float) return Float is
         P1 : constant Float := -0.27516_55529_0596E1;
         P2 : constant Float :=  0.29058_76237_4859E1;
         P3 : constant Float := -0.59450_14419_3246;
         Q0 : constant Float := -0.16509_93320_2424E2;
         Q1 : constant Float :=  0.24864_72896_9164E2;
         Q2 : constant Float := -0.10333_86707_2113E2;
         Q3 : constant Float :=  1.0;
      begin
         return (((P3*G + P2)*G + P1)*G) / (((G + Q2)*G + Q1)*G + Q0);
      end R;

   begin
      Y := abs (X);

      if Y > Half  then
         if Y > 1.0  then
            New_Line;
            Put ("*** ERROR: ASIN CALLED FOR ");
            Put (X);
            Put (" (>1)  TRUNCATED TO 1, CONTINUED ***");
            New_Line;
            Y := 1.0;
         end if;
         G := ((0.5 - Y) + 0.5) / 2.0;
         Y := -2.0 * Sqrt (G);
         Result := Y + Y * R (G);
         Result := (Pi_Over_Four + Result) + Pi_Over_Four;
      else
         if Y < Epsilon  then
            Result := Y;
         else
            G := Y * Y;
            Result := Y + Y * R (G);
         end if;
      end if;
      if X < 0.0  then
         Result := -Result;
      end if;

      return Result;
   end Asin;

   function Acos (X : Float) return Float is
      G, Y : Float;
      Result : Float;
      Beta : Float := Convert_To_Float (Ibeta);
      Epsilon : Float := Beta ** (-It/2);

      function R (G : Float) return Float is
         P1 : constant Float := -0.27516_55529_0596E1;
         P2 : constant Float :=  0.29058_76237_4859E1;
         P3 : constant Float := -0.59450_14419_3246;
         Q0 : constant Float := -0.16509_93320_2424E2;
         Q1 : constant Float :=  0.24864_72896_9164E2;
         Q2 : constant Float := -0.10333_86707_2113E2;
         Q3 : constant Float :=  1.0;
      begin
         return (((P3*G + P2)*G + P1)*G) / (((G + Q2)*G + Q1)*G + Q0);
      end R;

   begin
      Y := abs (X);

      if Y > Half  then
         if Y > 1.0  then
            New_Line;
            Put ("*** ERROR: ACOS CALLED FOR ");
            Put (X);
            Put (" (> 1)  TRUNCATED TO 1, CONTINUED ***");
            New_Line;
            Y := 1.0;
         end if;
         G := ((0.5 - Y) + 0.5) / 2.0;
         Y := -2.0 * Sqrt (G);
         Result := Y + Y * R (G);
         if X < 0.0  then
            Result := (Pi_Over_Two + Result) + Pi_Over_Two;
         else
            Result := -Result;
         end if;

      else
         if Y < Epsilon  then
            Result := Y;
         else
            G := Y * Y;
            Result := Y + Y * R (G);
         end if;
         if X < 0.0  then
            Result := (Pi_Over_Four + Result) + Pi_Over_Four;
         else
            Result := (Pi_Over_Four - Result) + Pi_Over_Four;
         end if;
      end if;

      return Result;
   end Acos;


   function Atan (X : Float) return Float is
      F, G : Float;
      subtype Region is Integer range 0..3;    --  ##########
      N : Region;
      Result : Float;

      Beta : Float := Convert_To_Float (Ibeta);

      Epsilon : Float := Beta ** (-It/2);

      Sqrt_3           : constant Float :=  1.73205_08075_68877_29353;
      Sqrt_3_Minus_1   : constant Float :=  0.73205_08075_68877_29353;
      Two_Minus_Sqrt_3 : constant Float :=  0.26794_91924_31122_70647;

      function R (G : Float) return Float is
         P0 : constant Float := -0.14400_83448_74E1;
         P1 : constant Float := -0.72002_68488_98;
         Q0 : constant Float :=  0.43202_50389_19E1;
         Q1 : constant Float :=  0.47522_25845_99E1;
         Q2 : constant Float :=  1.0;
      begin
         return ((P1*G + P0)*G) / ((G + Q1)*G + Q0);
      end R;

   begin
      F := abs (X);

      if F > 1.0  then
         F := 1.0 / F;
         N := 2;
      else
         N := 0;
      end if;

      if F > Two_Minus_Sqrt_3  then
         F := (((Sqrt_3_Minus_1 * F - 0.5) - 0.5) + F) / (Sqrt_3 + F);
         N := N + 1;
      end if;

      if abs (F) < Epsilon  then
         Result := F;
      else
         G := F * F;
         Result := F + F * R (G);
      end if;

      if N > 1  then
         Result := - Result;
      end if;

      case N is
         when 0  =>
            Result := Result;
         when 1  =>
            Result := Pi_Over_Six + Result;
         when 2  =>
            Result := Pi_Over_Two + Result;
         when 3  =>
            Result := Pi_Over_Three + Result;
      end case;

      if X < 0.0  then
         Result := - Result;
      end if;

      return Result;

   end Atan;



   function Atan2 (V, U : Float) return Float is
      X, Result : Float;

   begin

      if U = 0.0  then
         if V = 0.0  then
            Result := 0.0;
            New_Line;
            Put ("*** ERROR: ATAN2 CALLED WITH 0.0 / 0.0   RETURNED ");
            Put (Result);
            Put (" ***");
            New_Line;
         elsif V > 0.0  then
            Result := Pi_Over_Two;
         else
            Result := - Pi_Over_Two;
         end if;

      else
         X := abs (V/U);
         --  If underflow or overflow is detected, go to the exception
         Result := Atan (X);
         if U < 0.0  then
            Result := Pi - Result;
         end if;
         if V < 0.0  then
            Result := - Result;
         end if;
      end if;
      return Result;
   exception
      when Numeric_Error  =>
         if abs (V) > abs (U)  then
            Result := Pi_Over_Two;
            if V < 0.0  then
               Result := - Result;
            end if;
         else
            Result := 0.0;
            if U < 0.0  then
               Result := Pi - Result;
            end if;
         end if;
         return Result;
   end Atan2;


   function Sinh (X : Float) return Float is
      G, W, Y, Z : Float;
      Result : Float;
      Beta : Float := Convert_To_Float (Ibeta);
      Epsilon : Float := Beta ** (-It/2);

      Ybar : Float := Exp_Large;
      Ln_V : Float := 8#0.542714#;
      V_Over_2_Minus_1 : Float :=  0.13830_27787_96019_02638E-4;
      Wmax : Float := Ybar - Ln_V + 0.69;

      function R (G : Float) return Float is
         P0 : constant Float :=  0.10622_28883_7151E4;
         P1 : constant Float :=  0.31359_75645_6058E2;
         P2 : constant Float :=  0.34364_14035_8506;
         Q0 : constant Float :=  0.63733_73302_1822E4;
         Q1 : constant Float := -0.13051_01250_9199E3;
         Q2 : constant Float :=  1.0;
      begin
         return (((P2*G + P1)*G + P0)*G) / ((G + Q1)*G + Q0);
      end R;

   begin
      Y := abs (X);

      if Y <= 1.0  then
         if Y < Epsilon  then
            Result := X;
         else
            G := X * X;
            Result := X + X * R (G);
         end if;

      else
         if Y <= Ybar  then
            Z := Exp (Y);
            Result := (Z - 1.0/Z) / 2.0;
         else
            W := Y - Ln_V;
            if W > Wmax  then
               New_Line;
               Put ("*** ERROR: SINH CALLED WITH TOO LARGE ARGUMENT ");
               Put (X);
               Put ("  RETURN BIG ***");
               New_Line;
               W := Wmax;
            end if;
            Z := Exp (W);
            Result := Z + V_Over_2_Minus_1 * Z;
         end if;
         if X < 0.0  then
            Result := -Result;
         end if;

      end if;
      return Result;
   end Sinh;


   function Cosh (X : Float) return Float is
      G, W, Y, Z : Float;
      Result : Float;
      Beta : Float := Convert_To_Float (Ibeta);
      Epsilon : Float := Beta ** (-It/2);

      Ybar : Float := Exp_Large;
      Ln_V : Float := 8#0.542714#;
      V_Over_2_Minus_1 : Float :=  0.13830_27787_96019_02638E-4;
      Wmax : Float := Ybar - Ln_V + 0.69;

      function R (G : Float) return Float is
         P0 : constant Float :=  0.10622_28883_7151E4;
         P1 : constant Float :=  0.31359_75645_6058E2;
         P2 : constant Float :=  0.34364_14035_8506;
         Q0 : constant Float :=  0.63733_73302_1822E4;
         Q1 : constant Float := -0.13051_01250_9199E3;
         Q2 : constant Float :=  1.0;
      begin
         return (((P2*G + P1)*G + P0)*G) / ((G + Q1)*G + Q0);
      end R;

   begin
      Y := abs (X);

      if Y <= Ybar  then
         Z := Exp (Y);
         Result := (Z + 1.0/Z) / 2.0;
      else
         W := Y - Ln_V;
         if W > Wmax  then
            New_Line;
            Put ("*** ERROR: COSH CALLED WITH TOO LARGE ARGUMENT ");
            Put (X);
            Put ("  RETURN BIG ***");
            New_Line;
            W := Wmax;
         end if;
         Z := Exp (W);
         Result := Z + V_Over_2_Minus_1 * Z;
      end if;

      return Result;
   end Cosh;


   function Tanh (X : Float) return Float is
      G, W, Y, Z : Float;
      Result : Float;
      Beta : Float := Convert_To_Float (Ibeta);
      Epsilon : Float := Beta ** (-It/2);

      Xbig : Float := (Log (2.0) + Convert_To_Float (It + 1) * Log (Beta))/2.0;
      Ln_3_Over_2 : Float :=  0.54930_61443_34054_84570;

      function R (G : Float) return Float is
         P0 : constant Float := -0.21063_95800_0245E2;
         P1 : constant Float := -0.93363_47565_2401;
         Q0 : constant Float :=  0.63191_87401_5582E2;
         Q1 : constant Float :=  0.28077_65347_0471E2;
         Q2 : constant Float :=  1.0;
      begin
         return ((P1*G + P0)*G) / ((G + Q1)*G + Q0);
      end R;

   begin
      Y := abs (X);

      if Y > Xbig  then
         Result := 1.0;
      else
         if Y > Ln_3_Over_2  then
            Result := 0.5 - 1.0 / (Exp (Y + Y) + 1.0);
            Result := Result + Result;
         else
            if Y < Epsilon  then
               Result := Y;
            else
               G := Y * Y;
               Result := Y + Y * R (G);
            end if;
         end if;
      end if;
      if X < 0.0  then
         Result := - Result;
      end if;

      return Result;
   end Tanh;


begin
   null;
end Trig_Functions;
--::::::::::::::::::::::::::::
--FLOAT-MATH-LIB-SPEC.ADA
--::::::::::::::::::::::::::::

package Float_Math_Lib is

   -- Stub for Digital math library

   function Sqrt  (A : Float) return Float;
   function Cbrt  (A : Float) return Float;
   function Log   (A : Float) return Float;
   function Log10 (A : Float) return Float;
   function Log2  (A : Float) return Float;
   function Exp   (A : Float) return Float;

   function "**"  (X, Y : Float) return Float;

   -------------------------------------------------------------------

   -- Sine, cosine, and tangent of an angle given in radians.

   function Sin (A : Float) return Float;
   function Cos (A : Float) return Float;
   function Tan (A : Float) return Float;
   function Cot (A : Float) return Float;

   -------------------------------------------------------------------

   -- Arc sine, arc cosine, and arc tangent - return an angle
   -- expressed in radians.

   function Asin (A : Float) return Float;
   function Acos (A : Float) return Float;
   function Atan (A : Float) return Float;

   -------------------------------------------------------------------

   -- Arc tangent with two parameters - Arc Tan (A1/A2) - returns
   -- an angle expressed in radians.

   function Atan2 (A1, A2 : Float) return Float;

   -------------------------------------------------------------------

   -- Hyperbolic sine, cosine, and tangent of an angle in radians.

   function Sinh (A : Float) return Float;
   function Cosh (A : Float) return Float;
   function Tanh (A : Float) return Float;

   -------------------------------------------------------------------

   -- Trigonometric functions for angles expressed in degrees.

   function Sind (A : Float) return Float;
   function Cosd (A : Float) return Float;
   function Tand (A : Float) return Float;

   function Asind (A : Float) return Float;
   function Acosd (A : Float) return Float;
   function Atand (A : Float) return Float;

   function Atan2D (A1, A2 : Float) return Float;

   -------------------------------------------------------------------

   -- pragma Inline (Sqrt, Log,  Log10, Log2,  Exp,
   --                Sin,  Cos,  Tan,   Cot,
   --                Asin, Acos, Atan,  Atan2, Sinh,  Cosh,  Tanh,
   --                Sind, Cosd, Tand,  Asind, Acosd, Atand, Atan2D);

end Float_Math_Lib;
--::::::::::::::::::::::::::::
--FLOAT-MATH-LIB-BODY.ADA
--::::::::::::::::::::::::::::

package body Float_Math_Lib is

   -- Stub for Digital math library

   function Sqrt (A : Float) return Float is
   begin
      return 1.0;
   end Sqrt;

   function Cbrt (A : Float) return Float is
   begin
      return 1.0;
   end Cbrt;

   function Log (A : Float) return Float is
   begin
      return 1.0;
   end Log;

   function Log10 (A : Float) return Float is
   begin
      return 1.0;
   end Log10;

   function Log2 (A : Float) return Float is
   begin
      return 1.0;
   end Log2;

   function Exp (A : Float) return Float is
   begin
      return 1.0;
   end Exp;

   function "**" (X, Y : Float) return Float is
   begin
      return 1.0;
   end "**";

   -------------------------------------------------------------------

   -- Sine, cosine, and tangent of an angle given in radians.

   function Sin (A : Float) return Float is
   begin
      return 1.0;
   end Sin;

   function Cos (A : Float) return Float is
   begin
      return 1.0;
   end Cos;

   function Tan (A : Float) return Float is
   begin
      return 1.0;
   end Tan;

   function Cot (A : Float) return Float is
   begin
      return 1.0;
   end Cot;

   -------------------------------------------------------------------

   -- Arc sine, arc cosine, and arc tangent - return an angle
   -- expressed in radians.

   function Asin (A : Float) return Float is
   begin
      return 1.0;
   end Asin;

   function Acos (A : Float) return Float is
   begin
      return 1.0;
   end Acos;

   function Atan (A : Float) return Float is
   begin
      return 1.0;
   end Atan;

   -------------------------------------------------------------------

   -- Arc tangent with two parameters - Arc Tan (A1/A2) - returns
   -- an angle expressed in radians.

   function Atan2 (A1, A2 : Float) return Float is
   begin
      return 1.0;
   end Atan2;

   -------------------------------------------------------------------

   -- Hyperbolic sine, cosine, and tangent of an angle in radians.

   function Sinh (A : Float) return Float is
   begin
      return 1.0;
   end Sinh;

   function Cosh (A : Float) return Float is
   begin
      return 1.0;
   end Cosh;

   function Tanh (A : Float) return Float is
   begin
      return 1.0;
   end Tanh;

   -------------------------------------------------------------------

   -- Trigonometric functions for angles expressed in degrees.

   function Sind (A : Float) return Float is
   begin
      return 1.0;
   end Sind;

   function Cosd (A : Float) return Float is
   begin
      return 1.0;
   end Cosd;

   function Tand (A : Float) return Float is
   begin
      return 1.0;
   end Tand;

   function Asind (A : Float) return Float is
   begin
      return 1.0;
   end Asind;

   function Acosd (A : Float) return Float is
   begin
      return 1.0;
   end Acosd;

   function Atand (A : Float) return Float is
   begin
      return 1.0;
   end Atand;

   function Atan2D (A1, A2 : Float) return Float is
   begin
      return 1.0;
   end Atan2D;

end Float_Math_Lib;
--::::::::::::::::::::::::::::
--KALMAN-MATRIX-LIB-SPEC.ADA
--::::::::::::::::::::::::::::

package Kalman_Matrix_Lib is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Matrix_Lib
   --!
   --! Purpose:
   --!    This package provides the necessary matrix manipulation
   --!    routines required for the Ada Kalman Filter.
   --!
   --! Interfaces:
   --!    "-"
   --!       returns the difference between two matrices, vectors,
   --!       or an element and a matrix or vector.
   --!
   --!    "+"
   --!       returns the sum of two matrices, vectors,
   --!       or an element and a matrix or vector.
   --!
   --!    "*"
   --!       returns the product of an element and a matrix
   --!       or vector or the matrix multiplication of two
   --!       matrices (or vectors).
   --!
   --!    "/"
   --!       returns the division of two matrices, vectors,
   --!       or an element and a matrix or vector.
   --!
   --!    "**"
   --!       returns the general inverse of a matrix.
   --!
   --!    To_Vector
   --!       converts a matrix (with one row or column) to a matrix.
   --!
   --!    To_Matrix
   --!       converts a vector to a matrix.
   --!
   --!    Zero
   --!       returns a vector or matrix of all zeroes.
   --!
   --!    Identity
   --!       returns a square matrix with a diagonal of ones.
   --!
   --!    Transpose
   --!       returns the matrix transpose of a matrix.
   --!
   --!    Inverse
   --!       returns the single inverse of a matrix (if one
   --!       can be found).
   --!
   --! Exceptions:
   --!    Matrix_Error
   --!       is raised if the indicated operation cannot be performed.
   --!
   --!    Inverse_Error
   --!       is raised if the Inverse operation cannot be performed.
   --!
   --! Notes:
   --!    The Inverse function is currently only defined for matrices
   --!    of dimension 3x3 or smaller (maximum needed by the Kalman
   --!    Filter).
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --!----------------------------------------------------------------

   subtype Index is Positive;
   subtype Element is Float;

   type Vector is array (Index range <>) of Element;
   type Matrix is array (Index range <>, Index range <>) of Element;

   -------------------------------------------------------------------

   -- Matrix conversions.

   function To_Vector (Item: Matrix) return Vector;
   function To_Matrix (Item: Vector) return Matrix;

   -------------------------------------------------------------------

   -- Zero matrix.

   function Zero (Size: Vector) return Vector;
   function Zero (Size: Matrix) return Matrix;

   -------------------------------------------------------------------

   -- Matrix identity.

   function Identity (Size: Matrix) return Matrix;

   -------------------------------------------------------------------

   -- Matrix transpose.

   function Transpose (Item: Vector) return Matrix;
   function Transpose (Item: Matrix) return Matrix;

   -------------------------------------------------------------------

   -- Matrix subtraction.

   function "-" (Right: Vector) return Vector;
   function "-" (Right: Matrix) return Matrix;

   function "-" (Left: Vector;  Right: Element) return Vector;
   function "-" (Left: Element; Right: Vector)  return Vector;

   function "-" (Left: Element; Right: Matrix)  return Matrix;
   function "-" (Left: Matrix;  Right: Element) return Matrix;

   function "-" (Left: Vector; Right: Vector) return Vector;
   function "-" (Left: Matrix; Right: Vector) return Matrix;
   function "-" (Left: Vector; Right: Matrix) return Matrix;
   function "-" (Left: Matrix; Right: Matrix) return Matrix;

   -------------------------------------------------------------------

   -- Matrix addition.

   function "+" (Right: Vector) return Vector;
   function "+" (Right: Matrix) return Matrix;

   function "+" (Left: Vector;  Right: Element) return Vector;
   function "+" (Left: Element; Right: Vector)  return Vector;

   function "+" (Left: Element; Right: Matrix)  return Matrix;
   function "+" (Left: Matrix;  Right: Element) return Matrix;

   function "+" (Left: Vector; Right: Vector) return Vector;
   function "+" (Left: Matrix; Right: Vector) return Matrix;
   function "+" (Left: Vector; Right: Matrix) return Matrix;
   function "+" (Left: Matrix; Right: Matrix) return Matrix;

   -------------------------------------------------------------------

   -- Matrix multiplication.

   function "*" (Left: Vector;  Right: Element) return Vector;
   function "*" (Left: Element; Right: Vector)  return Vector;

   function "*" (Left: Element; Right: Matrix)  return Matrix;
   function "*" (Left: Matrix;  Right: Element) return Matrix;

   function "*" (Left: Vector; Right: Vector) return Matrix;
   function "*" (Left: Vector; Right: Matrix) return Matrix;
   function "*" (Left: Matrix; Right: Vector) return Matrix;
   function "*" (Left: Matrix; Right: Matrix) return Matrix;

   -------------------------------------------------------------------

   -- Matrix division.

   function "/" (Left: Vector;  Right: Element) return Vector;
   function "/" (Left: Element; Right: Vector)  return Vector;

   function "/" (Left: Element; Right: Matrix)  return Matrix;
   function "/" (Left: Matrix;  Right: Element) return Matrix;

   -------------------------------------------------------------------

   -- Matrix inversion.

   function Inverse (Item: Matrix) return Matrix;

   function "**" (Left: Matrix; Right: Integer) return Matrix;

   -------------------------------------------------------------------

   Matrix_Error:  exception;
   Inverse_Error: exception;

end Kalman_Matrix_Lib;
--::::::::::::::::::::::::::::
--KALMAN-MATRIX-LIB-BODY.ADA
--::::::::::::::::::::::::::::

package body Kalman_Matrix_Lib is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Matrix_Lib
   --!
   --! Purpose:
   --!    This package body contains the matrix operations needed
   --!    by the Ada Kalman Filter.
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!    Not applicable.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --! Changes:
   --!    22-APR-1985
   --!       Re-initialized the L and M indexes in "+" and "*" which
   --!       were used to index the Right array. This resulted in
   --!       a value outside the array bounds. This was not picked
   --!       up by the VAX Ada compiler as a Constraint_Error, as
   --!       required by the Ada LRM, but generated a "Digital
   --!       reserved op-code" message.
   --!
   --!    23-APR-1985
   --!       Moved the point of initialization of L to outside the
   --!       outer loop in "+" and "*". This resulted in L tracking
   --!       the J index and not the I index as required.
   --!
   --!----------------------------------------------------------------

   pragma Page;
   -------------------------------------------------------------------

   function Zero return Element is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Zero
      --!
      --! Purpose:
      --!    This local function returns a zero value.
      --!
      --! Parameters:
      --!    Not applicable.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      return (0.0);
   end Zero;

   pragma Page;
   -------------------------------------------------------------------

   function One return Element is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    One
      --!
      --! Purpose:
      --!    This local function returns a one.
      --!
      --! Parameters:
      --!    Not applicable.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      return (1.0);
   end One;

   pragma Page;
   -------------------------------------------------------------------

   function To_Vector (Item: Matrix) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    To_Vector
      --!
      --! Purpose:
      --!    This function converts a matrix (with one row or column)
      --!    to a vector.
      --!
      --! Parameters:
      --!    Item
      --!       is a matrix with one row or column.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the parameter is not of the correct
      --!       shape.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      if (Item'Length (1) = 1) then
         declare
            Result: Vector (Item'range (2));
         begin
            for I in Item'range (2) loop
               Result (I) := Item (Item'First (1), I);
            end loop;

            return (Result);
         end;

      elsif (Item'Length (2) = 1) then
         declare
            Result: Vector (Item'range (1));
         begin
            for I in Item'range (1) loop
               Result (I) := Item (I, Item'First (2));
            end loop;

            return (Result);
         end;

      else
         raise Matrix_Error;
      end if;
   end To_Vector;

   pragma Page;
   -------------------------------------------------------------------

   function To_Matrix (Item: Vector) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    To_Matrix
      --!
      --! Purpose:
      --!    This function converts a vector to a matrix of one row.
      --!
      --! Parameters:
      --!    Item
      --!       is a vector.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Item'First .. Item'First, Item'range);

   begin
      for I in Item'range loop
         Result (Item'First, I) := Item (I);
      end loop;

      return (Result);
   end To_Matrix;

   pragma Page;
   -------------------------------------------------------------------

   function Zero (Size: Vector) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Zero
      --!
      --! Purpose:
      --!    This function returns a vector of all zeroes.
      --!
      --! Parameters:
      --!    Size
      --!       is a vector of the desired size.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Only the Size'range value is used to determine the size.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Size'range);

   begin
      for I in Result'range loop
         Result (I) := Zero;
      end loop;

      return (Result);
   end Zero;

   pragma Page;
   -------------------------------------------------------------------

   function Zero (Size: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Zero
      --!
      --! Purpose:
      --!    This function returns a matrix of all zeroes.
      --!
      --! Parameters:
      --!    Size
      --!       is a matrix of the desired size.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Only the Size'range value is used to determine the size.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Size'range (1), Size'range (2));

   begin
      for I in Result'range (1) loop
         for J in Result'range (2) loop
            Result (I, J) := Zero;
         end loop;
      end loop;

      return (Result);
   end Zero;

   pragma Page;
   -------------------------------------------------------------------

   function Identity (Size: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Identity
      --!
      --! Purpose:
      --!    This function returns a square matrix with the diagonal
      --!    all ones and everything else all zeroes.
      --!
      --! Parameters:
      --!    Size
      --!       is a matrix of the desired size.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the matrix is not square.
      --!
      --! Notes:
      --!    Only the Size'range value is used to determine the size.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Size'range (1), Size'range (2));

   begin
      if (Size'Length (1) /= Size'Length (2)) then
         raise Matrix_Error;
      end if;

      for I in Result'range (1) loop
         for J in Result'range (2) loop
            if (I = J) then
               Result (I, J) := One;
            else
               Result (I, J) := Zero;
            end if;
         end loop;
      end loop;

      return (Result);
   end Identity;

   pragma Page;
   -------------------------------------------------------------------

   function Transpose (Item: Vector) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Transpose
      --!
      --! Purpose:
      --!    This function returns the transpose of a vector by
      --!    first converting the vector to a matrix of one row.
      --!
      --! Parameters:
      --!    Item
      --!       is the vector to be transposed.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Item'range, Item'First .. Item'First);

   begin
      for I in Item'range loop
         Result (I, Item'First) := Item (I);
      end loop;

      return (Result);
   end Transpose;

   pragma Page;
   -------------------------------------------------------------------

   function Transpose (Item: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Transpose
      --!
      --! Purpose:
      --!    This procedure returns the transpose of a matrix.
      --!
      --! Parameters:
      --!    Item
      --!       is the matrix to be transposed.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Item'range (2), Item'range (1));

   begin
      for I in Item'range (1) loop
         for J in Item'range (2) loop
            Result (J, I) := Item (I, J);
         end loop;
      end loop;

      return (Result);
   end Transpose;

   pragma Page;
   -------------------------------------------------------------------

   function "-" (Right: Vector) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "-"
      --!
      --! Purpose:
      --!    This function returns the negative of a vector by
      --!    negating all elements.
      --!
      --! Parameters:
      --!    Right
      --!       is the vector to be negated.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Right'range);

   begin
      for I in Right'range loop
         Result (I) := - Right (I);
      end loop;

      return (Result);
   end "-";

   pragma Page;
   -------------------------------------------------------------------

   function "-" (Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "-"
      --!
      --! Purpose:
      --!    This function returns the negative of a matrix by
      --!    negating all elements.
      --!
      --! Parameters:
      --!    Right
      --!       is the matrix to be negated.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Right'range (1), Right'range (2));

   begin
      for I in Right'range (1) loop
         for J in Right'range (2) loop
            Result (I, J) := - Right (I, J);
         end loop;
      end loop;

      return (Result);
   end "-";

   pragma Page;
   -------------------------------------------------------------------

   function "-" (Left: Vector;  Right: Element) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "-"
      --!
      --! Purpose:
      --!    This function subtracts an element from all elements
      --!    of a vector.
      --!
      --! Parameters:
      --!    Left
      --!       is the vector of values.
      --!
      --!    Right
      --!       is the value to subtract from the vector.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Left'range);

   begin
      for I in Left'range loop
         Result (I) := Left (I) - Right;
      end loop;

      return (Result);
   end "-";

   pragma Page;
   -------------------------------------------------------------------

   function "-" (Left: Element; Right: Vector) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "-"
      --!
      --! Purpose:
      --!    This function returns a vector produced by subtracting
      --!    a vector from a value.
      --!
      --! Parameters:
      --!    Left
      --!       is the value to be subtracted from.
      --!
      --!    Right
      --!       is the vector to subtract from the value.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Right'range);

   begin
      for I in Right'range loop
         Result (I) := Left - Right (I);
      end loop;

      return (Result);
   end "-";

   pragma Page;
   -------------------------------------------------------------------

   function "-" (Left: Element; Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "-"
      --!
      --! Purpose:
      --!    This function returns a matrix produced by subtracting
      --!    a matrix from a value.
      --!
      --! Parameters:
      --!    Left
      --!       is the value to be subtracted from.
      --!
      --!    Right
      --!       is the matrix to subtract from the value.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Right'range (1), Right'range (2));

   begin
      for I in Right'range (1) loop
         for J in Right'range (2) loop
            Result (I, J) := Left - Right (I, J);
         end loop;
      end loop;

      return (Result);
   end "-";

   pragma Page;
   -------------------------------------------------------------------

   function "-" (Left: Matrix; Right: Element) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "-"
      --!
      --! Purpose:
      --!    This function subtracts a value from all elements of
      --!    a matrix.
      --!
      --! Parameters:
      --!    Left
      --!       is the matrix.
      --!
      --!    Right
      --!       is the value to subtract from the matrix.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Left'range (1), Left'range (2));

   begin
      for I in Left'range (1) loop
         for J in Left'range (2) loop
            Result (I, J) := Left (I, J) - Right;
         end loop;
      end loop;

      return (Result);
   end "-";

   pragma Page;
   -------------------------------------------------------------------

   function "-" (Left: Vector; Right: Vector) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "-"
      --!
      --! Purpose:
      --!    This function subtracts two vectors.
      --!
      --! Parameters:
      --!    Left
      --!       is a vector.
      --!
      --!    Right
      --!       is a vector.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the vectors are not the same size.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Left'range);
      J: Index := Right'First;

   begin
      if (Left'Length /= Right'Length) then
         raise Matrix_Error;
      end if;

      for I in Left'range loop
         Result (I) := Left (I) - Right (J);
         exit when (J = Right'Last);
         J := Index'Succ (J);
      end loop;

      return (Result);
   end "-";

   pragma Page;
   -------------------------------------------------------------------

   function "-" (Left: Matrix; Right: Vector) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "-"
      --!
      --! Purpose:
      --!    This function subtracts a vector from a matrix by
      --!    first converting the vector to a single column matrix.
      --!
      --! Parameters:
      --!    Left
      --!       is the matrix.
      --!
      --!    Left
      --!       is the vector.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the resulting matrices are not of the
      --!       the same size.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      if (Left'Length (1) = 1) then
         return (Left - To_Matrix (Right));

      elsif (Left'Length (2) = 1) then
         return (Left - Transpose (Right));

      else
         raise Matrix_Error;
      end if;
   end "-";

   pragma Page;
   -------------------------------------------------------------------

   function "-" (Left: Vector; Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "-"
      --!
      --! Purpose:
      --!    This function subtracts a vector from a matrix by first
      --!    converting the vector to a matrix of one row.
      --!
      --! Parameters:
      --!    Left
      --!       is the vector.
      --!
      --!    Left
      --!       is the matrix.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the resulting matrices are not of the
      --!       the same size.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      if (Right'Length (1) = 1) then
         return (To_Matrix (Left) - Right);

      elsif (Right'Length (2) = 1) then
         return (Transpose (Left) - Right);

      else
         raise Matrix_Error;
      end if;
   end "-";

   pragma Page;
   -------------------------------------------------------------------

   function "-" (Left: Matrix; Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "-"
      --!
      --! Purpose:
      --!    This function subtracts corresponding elements from
      --!    two matrices.
      --!
      --! Parameters:
      --!    Left
      --!       is a matrix.
      --!
      --!    Right
      --!       is a matrix.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the matrices are not the same size.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Left'range (1), Left'range (2));
      L: Index;
      M: Index;

   begin
      if (Left'Length (1) /= Right'Length (1)) or
         (Left'Length (2) /= Right'Length (2)) then
         raise Matrix_Error;
      end if;

      L := Right'First (1);
      for I in Left'range (1) loop

         M := Right'First (2);
         for J in Left'range (2) loop
            Result (I, J) := Left (I, J) - Right (L, M);

            exit when (M = Right'Last (2));
            M := Index'Succ (M);
         end loop;

         exit when (L = Right'Last (1));
         L := Index'Succ (L);
      end loop;

      return (Result);
   end "-";

   pragma Page;
   -------------------------------------------------------------------

   function "+" (Right: Vector) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "+"
      --!
      --! Purpose:
      --!    This function returns the vector.
      --!
      --! Parameters:
      --!    Right
      --!       is the vector.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Right'range);

   begin
      for I in Right'range loop
         Result (I) := + Right (I);
      end loop;

      return (Result);
   end "+";

   pragma Page;
   -------------------------------------------------------------------

   function "+" (Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "+"
      --!
      --! Purpose:
      --!    This function returns the matrix.
      --!
      --! Parameters:
      --!    Right
      --!       is the matrix.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Right'range (1), Right'range (2));

   begin
      for I in Right'range (1) loop
         for J in Right'range (2) loop
            Result (I, J) := + Right (I, J);
         end loop;
      end loop;

      return (Result);
   end "+";

   pragma Page;
   -------------------------------------------------------------------

   function "+" (Left: Vector;  Right: Element) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "+"
      --!
      --! Purpose:
      --!    This function adds a value to all elements of a vector.
      --!
      --! Parameters:
      --!    Left
      --!       is the vector.
      --!
      --!    Right
      --!       is the value.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Left'range);

   begin
      for I in Left'range loop
         Result (I) := Left (I) + Right;
      end loop;

      return (Result);
   end "+";

   pragma Page;
   -------------------------------------------------------------------

   function "+" (Left: Element; Right: Vector) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "+"
      --!
      --! Purpose:
      --!    This function adds a value to all elements of a vector.
      --!
      --! Parameters:
      --!    Left
      --!       is the value.
      --!
      --!    Right
      --!       is the vector.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Right'range);

   begin
      for I in Right'range loop
         Result (I) := Left + Right (I);
      end loop;

      return (Result);
   end "+";

   pragma Page;
   -------------------------------------------------------------------

   function "+" (Left: Element; Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "+"
      --!
      --! Purpose:
      --!    This function adds a value to all elements of a matrix.
      --!
      --! Parameters:
      --!    Left
      --!       is the value.
      --!
      --!    Right
      --!       is the matrix.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Right'range (1), Right'range (2));

   begin
      for I in Right'range (1) loop
         for J in Right'range (2) loop
            Result (I, J) := Left + Right (I, J);
         end loop;
      end loop;

      return (Result);
   end "+";

   pragma Page;
   -------------------------------------------------------------------

   function "+" (Left: Matrix; Right: Element) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "+"
      --!
      --! Purpose:
      --!    This function adds a value to all elements of a matrix.
      --!
      --! Parameters:
      --!    Left
      --!       is the matrix.
      --!
      --!    Right
      --!       is the value.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Left'range (1), Left'range (2));

   begin
      for I in Left'range (1) loop
         for J in Left'range (2) loop
            Result (I, J) := Left (I, J) + Right;
         end loop;
      end loop;

      return (Result);
   end "+";

   pragma Page;
   -------------------------------------------------------------------

   function "+" (Left: Vector; Right: Vector) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "+"
      --!
      --! Purpose:
      --!    This function adds corresponding elements of a vector.
      --!
      --! Parameters:
      --!    Left
      --!       is a vector.
      --!
      --!    Right
      --!       is a vector.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the vectors are not the same size.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Left'range);
      J: Index := Right'First;

   begin
      if (Left'Length /= Right'Length) then
         raise Matrix_Error;
      end if;

      for I in Left'range loop
         Result (I) := Left (I) + Right (J);
         exit when (J = Right'Last);
         J := Index'Succ (J);
      end loop;

      return (Result);
   end "+";

   pragma Page;
   -------------------------------------------------------------------

   function "+" (Left: Matrix; Right: Vector) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "+"
      --!
      --! Purpose:
      --!    This function adds all elements of a vector to a matrix
      --!    by first converting the vector to a matrix of one column.
      --!
      --! Parameters:
      --!    Left
      --!       is the matrix.
      --!
      --!    Left
      --!       is the vector.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the resulting matrices are not the same
      --!       size.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      if (Left'Length (1) = 1) then
         return (Left + To_Matrix (Right));

      elsif (Left'Length (2) = 1) then
         return (Left + Transpose (Right));

      else
         raise Matrix_Error;
      end if;
   end "+";

   pragma Page;
   -------------------------------------------------------------------

   function "+" (Left: Vector; Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "+"
      --!
      --! Purpose:
      --!    This function adds corresponding elements of a vector
      --!    to a matrix by first converting the vector to a matrix.
      --!
      --! Parameters:
      --!    Left
      --!       is the vector.
      --!
      --!    Right
      --!       is the matrix.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the resulting matrices are not the same
      --!       size.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      if (Right'Length (1) = 1) then
         return (To_Matrix (Left) + Right);

      elsif (Right'Length (2) = 1) then
         return (Transpose (Left) + Right);

      else
         raise Matrix_Error;
      end if;
   end "+";

   pragma Page;
   -------------------------------------------------------------------

   function "+" (Left: Matrix; Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "+"
      --!
      --! Purpose:
      --!    This function adds corresponding elements of matrices.
      --!
      --! Parameters:
      --!    Left
      --!       is a matrix.
      --!
      --!    Right
      --!       is a matrix.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the matrices are not the same size.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Left'range (1), Left'range (2));
      L: Index;
      M: Index;

   begin
      if (Left'Length (1) /= Right'Length (1)) or
         (Left'Length (2) /= Right'Length (2)) then
         raise Matrix_Error;
      end if;

      L := Right'First (1);
      for I in Left'range (1) loop

         M := Right'First (2);
         for J in Left'range (2) loop
            Result (I, J) := Left (I, J) + Right (L, M);

            exit when (M = Right'Last (2));
            M := Index'Succ (M);
         end loop;

         exit when (L = Right'Last (1));
         L := Index'Succ (L);
      end loop;

      return (Result);
   end "+";

   pragma Page;
   -------------------------------------------------------------------

   function "*" (Left: Vector;  Right: Element) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "*"
      --!
      --! Purpose:
      --!    This function multiplies all elements of a vector by
      --!    a value.
      --!
      --! Parameters:
      --!    Left
      --!       is the vector.
      --!
      --!    Right
      --!       is the value.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Left'range);

   begin
      for I in Left'range loop
         Result (I) := Left (I) * Right;
      end loop;

      return (Result);
   end "*";

   pragma Page;
   -------------------------------------------------------------------

   function "*" (Left: Element; Right: Vector) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "*"
      --!
      --! Purpose:
      --!    This function multiplies all elements of a vector by a
      --!    value.
      --!
      --! Parameters:
      --!    Left
      --!       is the value.
      --!
      --!    Right
      --!       is the vector.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Right'range);

   begin
      for I in Right'range loop
         Result (I) := Left * Right (I);
      end loop;

      return (Result);
   end "*";

   pragma Page;
   -------------------------------------------------------------------

   function "*" (Left: Element; Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "*"
      --!
      --! Purpose:
      --!    This function multiplies all elements of a matrix by a
      --!    value.
      --!
      --! Parameters:
      --!    Left
      --!       is the value.
      --!
      --!    Right
      --!       is the matrix.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Right'range (1), Right'range (2));

   begin
      for I in Right'range (1) loop
         for J in Right'range (2) loop
            Result (I, J) := Left * Right (I, J);
         end loop;
      end loop;

      return (Result);
   end "*";

   pragma Page;
   -------------------------------------------------------------------

   function "*" (Left: Matrix; Right: Element) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "*"
      --!
      --! Purpose:
      --!    This function multiplies all elements of a matrix by a
      --!    value.
      --!
      --! Parameters:
      --!    Left
      --!       is the matrix.
      --!
      --!    Right
      --!       is the value.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Left'range (1), Left'range (2));

   begin
      for I in Left'range (1) loop
         for J in Left'range (2) loop
            Result (I, J) := Left (I, J) * Right;
         end loop;
      end loop;

      return (Result);
   end "*";

   pragma Page;
   -------------------------------------------------------------------

   function "*" (Left: Vector; Right: Vector) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "*"
      --!
      --! Purpose:
      --!    This function performs a matrix multiplication of two
      --!    vectors by first converting one to a matrix of one row
      --!    and the other to a matrix of one column.
      --!
      --! Parameters:
      --!    Left
      --!       is a vector.
      --!
      --!    Right
      --!       is a vector.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the resulting matrices are not the
      --!       correct shape.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      return (To_Matrix (Left) * Transpose (Right));
   end "*";

   pragma Page;
   -------------------------------------------------------------------

   function "*" (Left: Vector; Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "*"
      --!
      --! Purpose:
      --!    This function performs a matrix multiplication of a
      --!    vector and a matrix by first converting the vector
      --!    to a matrix of one row.
      --!
      --! Parameters:
      --!    Left
      --!       is the vector.
      --!
      --!    Right
      --!       is the matrix.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the resulting matrices are not the
      --!       correct shape.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      return (To_Matrix (Left) * Right);
   end "*";

   pragma Page;
   -------------------------------------------------------------------

   function "*" (Left: Matrix; Right: Vector) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "*"
      --!
      --! Purpose:
      --!    This function performs a matrix multiplication of a
      --!    matrix and a vector by first converting the vector
      --!    to a matrix of one column.
      --!
      --! Parameters:
      --!    Left
      --!       is the matrix.
      --!
      --!    Right
      --!       is the vector.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the resulting matrices are not the
      --!       correct shape.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      return (Left * Transpose (Right));
   end "*";

   pragma Page;
   -------------------------------------------------------------------

   function "*" (Left: Matrix; Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "*"
      --!
      --! Purpose:
      --!    This function performs a matrix multiplication of
      --!    two matrices.
      --!
      --! Parameters:
      --!    Left
      --!       is a matrix.
      --!
      --!    Right
      --!       is a matrix.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the matrices are not the correct shape.
      --!
      --! Notes:
      --!    The left matrix must have dimensionality of NxL and the
      --!    right matrix must be LxM. The result will be NxM.
      --!
      --!-------------------------------------------------------------

      Sum: Element;
      Result: Matrix (Left'range (1), Right'range (2));

   begin
      if (Left'Length (2) /= Right'Length (1)) then
         raise Matrix_Error;
      end if;

      for I in Left'range (1) loop
         for J in Right'range (2) loop
            Sum := Zero;

            for K in Left'range (2) loop
               Sum := Sum + Left (I, K) * Right (K, J);
            end loop;

            Result (I, J) := Sum;
         end loop;
      end loop;

      return (Result);
   end "*";

   pragma Page;
   -------------------------------------------------------------------

   function "/" (Left: Vector;  Right: Element) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "/"
      --!
      --! Purpose:
      --!    This function divides all elements of a vector by a
      --!    value.
      --!
      --! Parameters:
      --!    Left
      --!       is the vector.
      --!
      --!    Right
      --!       is the value.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Left'range);

   begin
      for I in Left'range loop
         Result (I) := Left (I) / Right;
      end loop;

      return (Result);
   end "/";

   pragma Page;
   -------------------------------------------------------------------

   function "/" (Left: Element; Right: Vector) return Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "/"
      --!
      --! Purpose:
      --!    This function divides a value by all elements in a
      --!    vector.
      --!
      --! Parameters:
      --!    Left
      --!       is the value.
      --!
      --!    Right
      --!       is the value.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Vector (Right'range);

   begin
      for I in Right'range loop
         Result (I) := Left / Right (I);
      end loop;

      return (Result);
   end "/";

   pragma Page;
   -------------------------------------------------------------------

   function "/" (Left: Element; Right: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "/"
      --!
      --! Purpose:
      --!    This function divides a value by all elements of a
      --!    matrix.
      --!
      --! Parameters:
      --!    Left
      --!       is the value.
      --!
      --!    Right
      --!       is the matrix.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Right'range (1), Right'range (2));

   begin
      for I in Right'range (1) loop
         for J in Right'range (2) loop
            Result (I, J) := Left / Right (I, J);
         end loop;
      end loop;

      return (Result);
   end "/";

   pragma Page;
   -------------------------------------------------------------------

   function "/" (Left: Matrix; Right: Element) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "/"
      --!
      --! Purpose:
      --!    This function divides all elements of a matrix by a
      --!    value.
      --!
      --! Parameters:
      --!    Left
      --!       is the matrix.
      --!
      --!    Right
      --!       is the value.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result: Matrix (Left'range (1), Left'range (2));

   begin
      for I in Left'range (1) loop
         for J in Left'range (2) loop
            Result (I, J) := Left (I, J) / Right;
         end loop;
      end loop;

      return (Result);
   end "/";

   pragma Page;
   -------------------------------------------------------------------

   function Inverse (Item: Matrix) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Inverse
      --!
      --! Purpose:
      --!    This function calculates the single inverse of a matrix.
      --!
      --! Parameters:
      --!    Item
      --!       is the matrix to invert.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the matrix is not square.
      --!
      --!    Inverse_Error
      --!       is raised if the matrix inverse cannot be perfomed.
      --!
      --! Notes:
      --!    Only 3x3 matrices (or smaller) will be inverted.
      --!
      --!-------------------------------------------------------------

      function Det (Item: Matrix) return Element is
         -- Compute the determinant of a 2x2 matrix.
      begin
         if (Item'Length (1) /= 2) or
            (Item'Length (2) /= 2) then
            raise Matrix_Error;
         else
            declare
               A: Element renames
                  Item (Item'First (1),     Item'First (2));
               B: Element renames
                  Item (Item'First (1),     Item'First (2) + 1);
               C: Element renames
                  Item (Item'First (1) + 1, Item'First (2));
               D: Element renames
                  Item (Item'First (1) + 1, Item'First (2) + 1);
            begin
               return (A*D - B*C);
            end;
         end if;
      end Det;

      pragma Page;
      ----------------------------------------------------------------

   begin
      if (Item'Length (1) /= Item'Length (2)) then
         raise Matrix_Error;
      end if;

      if (Item'Length (1) = 1) then
         return (1.0 / Item);

      elsif (Item'Length (1) = 2) then

         declare
            A: Element renames
               Item (Item'First (1),     Item'First (2));
            B: Element renames
               Item (Item'First (1),     Item'First (2) + 1);
            C: Element renames
               Item (Item'First (1) + 1, Item'First (2));
            D: Element renames
               Item (Item'First (1) + 1, Item'First (2) + 1);
            X: Element := Det (Item);
         begin
            if (X = Zero) then
               raise Inverse_Error;
            else
               return (( D/X, -B/X),
                       (-C/X,  A/X));
            end if;
         end;

      elsif (Item'Length (1) = 3) then
         declare
            A: Element renames
               Item (Item'First (1),     Item'First (2));
            B: Element renames
               Item (Item'First (1),     Item'First (2) + 1);
            C: Element renames
               Item (Item'First (1),     Item'First (2) + 2);
            D: Element renames
               Item (Item'First (1) + 1, Item'First (2));
            E: Element renames
               Item (Item'First (1) + 1, Item'First (2) + 1);
            F: Element renames
               Item (Item'First (1) + 1, Item'First (2) + 2);
            G: Element renames
               Item (Item'First (1) + 2, Item'First (2));
            H: Element renames
               Item (Item'First (1) + 2, Item'First (2) + 1);
            I: Element renames
               Item (Item'First (1) + 2, Item'First (2) + 2);

            Result: Matrix (Item'First(1) .. Item'Last(1),
                            Item'First(2) .. Item'Last(2));

            A1: Element renames
                Result (Result'First (1),     Result'First (2));
            B1: Element renames
                Result (Result'First (1),     Result'First (2) + 1);
            C1: Element renames
                Result (Result'First (1),     Result'First (2) + 2);
            D1: Element renames
                Result (Result'First (1) + 1, Result'First (2));
            E1: Element renames
                Result (Result'First (1) + 1, Result'First (2) + 1);
            F1: Element renames
                Result (Result'First (1) + 1, Result'First (2) + 2);
            G1: Element renames
                Result (Result'First (1) + 2, Result'First (2));
            H1: Element renames
                Result (Result'First (1) + 2, Result'First (2) + 1);
            I1: Element renames
                Result (Result'First (1) + 2, Result'First (2) + 2);

            X: Element := (A*E*I + B*F*G + C*D*H -
                           C*E*G - B*D*I - A*F*H);
         begin
            if (X = Zero) then
               raise Inverse_Error;
            else
               -- Create matrix of cofactors.
               A1 := + Det (Matrix' ((E,F),
                                     (H,I)));
               B1 := - Det (Matrix' ((D,F),
                                     (G,I)));
               C1 := + Det (Matrix' ((D,E),
                                     (G,H)));
               D1 := - Det (Matrix' ((B,C),
                                     (H,I)));
               E1 := + Det (Matrix' ((A,C),
                                     (G,I)));
               F1 := - Det (Matrix' ((A,B),
                                     (G,H)));
               G1 := + Det (Matrix' ((B,C),
                                     (E,F)));
               H1 := - Det (Matrix' ((A,C),
                                     (D,F)));
               I1 := + Det (Matrix' ((A,B),
                                     (D,E)));

               -- Generate adjoint matrix.
               Result := Transpose (Result);

               return (Result / X);
            end if;
         end;
      else
         raise Matrix_Error; -- Gaussian elimination required.
      end if;
   end Inverse;

   pragma Page;
   -------------------------------------------------------------------

   function "**" (Left: Matrix; Right: Integer) return Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "**"
      --!
      --! Purpose:
      --!    This function computes the general inverse of a matrix.
      --!
      --! Parameters:
      --!    Left
      --!       is the matrix to be inverted.
      --!
      --!    Right
      --!       is the power of the inversion.
      --!
      --! Exceptions:
      --!    Matrix_Error
      --!       is raised if the matrix is not square.
      --!
      --!    Inverse_Error
      --!       is raised if the matrix inverse cannot be perfomed.
      --!
      --! Notes:
      --!    Only 3x3 matrices (or smaller) will be inverted.
      --!
      --!-------------------------------------------------------------

      Factor,
      Result: Matrix (Left'range (1), Left'range (2));

   begin
      if (Right = -1) then
         return (Inverse (Left));
      end if;

      if (Left'Length (1) /= Left'Length (2)) then
         raise Matrix_Error;
      end if;

      if (Right = 0) then
         return (Identity (Left));

      elsif (Right > 0) then
         Factor := Left;
         Result := Factor;

      elsif (Right < 0) then
         Factor := Inverse (Left);
         Result := Factor;
      end if;

      for I in 1 .. Integer'Pred (abs (Right)) loop
         Result := Result * Factor;
      end loop;

      return (Result);
   end "**";

end Kalman_Matrix_Lib;
--::::::::::::::::::::::::::::
--KALMAN-STRING-SPEC.ADA
--::::::::::::::::::::::::::::

package Kalman_String is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_String
   --!
   --! Purpose:
   --!    This package provides a text type and procedures necessary
   --!    to initialize, compare and manipulate items of the type.
   --!
   --! Adapted from:
   --!    Common APSE Interface Set
   --!    Version 1.3, August 1984
   --!    Ada Joint Program Office
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!    Not applicable.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --! Changes:
   --!    03-APR-1985
   --!       Moved Text_Data type declaration from body to private
   --!       part of specification because TeleSoft could not find
   --!       the components of an incomplete type.
   --!
   --!    04-APR-1985
   --!       Changed Kalman_Text to Kalman_String because of TeleSoft
   --!       file naming conflict with Kalman_Text_Io.
   --!
   --!----------------------------------------------------------------

   subtype Index is Natural;
   type Text_Type is limited private;

   -------------------------------------------------------------------

   function Length (Text : in Text_Type) return Index;
   function Value  (Text : in Text_Type) return String;
   function Empty  (Text : in Text_Type) return Boolean;

   -------------------------------------------------------------------

   procedure Initialize (Text : in out Text_Type);
   procedure Free       (Text : in out Text_Type);

   -------------------------------------------------------------------

   function Text (Value : in String)    return Text_Type;
   function Text (Value : in Character) return Text_Type;

   -------------------------------------------------------------------

   function "&" (Left  : in Text_Type;
                 Right : in Text_Type) return Text_Type;
   function "&" (Left  : in Text_Type;
                 Right : in String)    return Text_Type;
   function "&" (Left  : in Text_Type;
                 Right : in Character) return Text_Type;
   function "&" (Left  : in String;
                 Right : in Text_Type) return Text_Type;
   function "&" (Left  : in Character;
                 Right : in Text_Type) return Text_Type;

   -------------------------------------------------------------------

   function "="  (Left  : in Text_Type;
                  Right : in Text_Type) return Boolean;
   function "<"  (Left  : in Text_Type;
                  Right : in Text_Type) return Boolean;
   function "<=" (Left  : in Text_Type;
                  Right : in Text_Type) return Boolean;
   function ">"  (Left  : in Text_Type;
                  Right : in Text_Type) return Boolean;
   function ">=" (Left  : in Text_Type;
                  Right : in Text_Type) return Boolean;

   -------------------------------------------------------------------

   procedure Set (Object : in out Text_Type;
                  Value  : in     Text_Type);
   procedure Set (Object : in out Text_Type;
                  Value  : in     String);
   procedure Set (Object : in out Text_Type;
                  Value  : in     Character);

   -------------------------------------------------------------------

   procedure Append (Tail : in     Text_Type;
                     To   : in out Text_Type);
   procedure Append (Tail : in     String;
                     To   : in out Text_Type);
   procedure Append (Tail : in     Character;
                     To   : in out Text_Type);

   -------------------------------------------------------------------

   procedure Amend (Object   : in out Text_Type;
                    By       : in     Text_Type;
                    Position : in     Index := 1);
   procedure Amend (Object   : in out Text_Type;
                    By       : in     String;
                    Position : in     Index := 1);
   procedure Amend (Object   : in out Text_Type;
                    By       : in     Character;
                    Position : in     Index := 1);

   -------------------------------------------------------------------

   function Locate (Fragment : in Text_Type;
                    Within   : in Text_Type;
                    Position : in Index := 1) return Index;
   function Locate (Fragment : in String;
                    Within   : in Text_Type;
                    Position : in Index := 1) return Index;
   function Locate (Fragment : in Character;
                    Within   : in Text_Type;
                    Position : in Index := 1) return Index;

private

   type Text_Data;
   type Text_Type is access Text_Data;

   type Text_Data is
      record
         Length : Index := 0;
         Value  : String (1..256);
      end record;

end Kalman_String;
--::::::::::::::::::::::::::::
--KALMAN-STRING-BODY.ADA
--::::::::::::::::::::::::::::

package body Kalman_String is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_String
   --!
   --! Purpose:
   --!    This package body provides the procedures necessary
   --!    to initialize, compare, and manipulate items of
   --!    the private type Text.
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!    Not applicable.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --! Changes:
   --!    03-APR-1985
   --!       Moved Text_Data type declaration from body to private
   --!       part of specification because TeleSoft could not find
   --!       the components of an incomplete type.
   --!
   --!    04-APR-1985
   --!       Changed Kalman_Text to Kalman_String because of TeleSoft
   --!       file naming conflict with Kalman_Text_Io.
   --!
   --!----------------------------------------------------------------

   pragma Page;
   ------------------------------------------------------------------

   function Check (Text : in Text_Type) return Text_Type is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Check
      --!
      --! Purpose:
      --!    This local function returns an access to text.
      --!    If the input access variable has not yet been
      --!    allocated, then Check performs the allocation.
      --!
      --! Parameters:
      --!    Text
      --!       is an access to some text.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result : Text_Type := Text;
      Value  : Text_Data;

   begin
      begin
         Value := Text.all;
      exception
         when Constraint_Error =>
            Result := new Text_Data;
      end;

      return Result;
   end Check;

   pragma Page;
   ------------------------------------------------------------------

   function Length (Text : in Text_Type) return Index is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Length
      --!
      --! Purpose:
      --!    This function returns the length of the text string
      --!    contained in the text data.
      --!
      --! Parameters:
      --!    Text
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result : Text_Type := Check (Text);

   begin
      return Result.Length;
   end Length;

   pragma Page;
   ------------------------------------------------------------------

   function Value (Text : in Text_Type) return String is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Value
      --!
      --! Purpose:
      --!    This function returns the string contained within the
      --!    text data.
      --!
      --! Parameters:
      --!    Text
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result : Text_Type := Check (Text);

   begin
      return Result.Value (1 .. Result.Length);
   end Value;

   pragma Page;
   ------------------------------------------------------------------

   function Empty (Text : in Text_Type) return Boolean is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Empty
      --!
      --! Purpose:
      --!    This function returns a boolean value which indicates
      --!    whether the indicated text is empty.
      --!
      --! Parameters:
      --!    Text
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result : Text_Type := Check (Text);

   begin
      return Result.Length = 0;
   end Empty;

   pragma Page;
   ------------------------------------------------------------------

   procedure Initialize (Text : in out Text_Type) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Initialize
      --!
      --! Purpose:
      --!    This procedure destroys the access by Text to Text_Data
      --!    (if any access exists) and allocates new Text_Data to
      --!    which Text is pointed.
      --!
      --! Parameters:
      --!    Text
      --!       is an access to Text_Data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      Free (Text);
      Text := new Text_Data;
   end Initialize;

   pragma Page;
   ------------------------------------------------------------------

   procedure Free (Text : in out Text_Type) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Free
      --!
      --! Purpose:
      --!    This procedure destroys the access of Text to Text_Data.
      --!
      --! Parameters:
      --!    Text
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      Text := null;
   end Free;

   pragma Page;
   ------------------------------------------------------------------

   function Text (Value : in String) return Text_Type is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Text
      --!
      --! Purpose:
      --!    This function returns text data initialized from
      --!    the input string.
      --!
      --! Parameters:
      --!    Value
      --!       is a string.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result : Text_Type;

   begin
      Initialize (Result);

      if (Value'Length > 0) then
         Result.Value (1 .. Value'Length) := Value;
      end if;

      Result.Length := Value'Length;
      return Result;
   end Text;

   pragma Page;
   ------------------------------------------------------------------

   function Text (Value : in Character) return Text_Type is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Text
      --!
      --! Purpose:
      --!    This function returns text data initialized from the
      --!    input character.
      --!
      --! Parameters:
      --!    Value
      --!       is a character.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result : Text_Type;

   begin
      Initialize (Result);

      Result.Value (1) := Value;
      Result.Length := 1;
      return Result;
   end Text;

   pragma Page;
   ------------------------------------------------------------------

   function "&" (Left  : in Text_Type;
                 Right : in Text_Type) return Text_Type is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "&"
      --!
      --! Purpose:
      --!    This function returns new text in which the Right
      --!    text has been appended to the Left text.
      --!
      --! Parameters:
      --!    Left
      --!       is an access to text data.
      --!    Right
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result : Text_Type;
      L : Text_Type := Check (Left);
      R : Text_Type := Check (Right);

   begin
      Initialize (Result);

      Result.Value (1 .. L.Length) := L.Value (1 .. L.Length);
      Result.Value (L.Length + 1 .. L.Length + R.Length)
         := R.Value (1 .. R.Length);
      Result.Length := L.Length + R.Length;
      return Result;
   end "&";

   pragma Page;
   ------------------------------------------------------------------

   function "&" (Left  : in Text_Type;
                 Right : in String) return Text_Type is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "&"
      --!
      --! Purpose:
      --!    This function returns new text in which the Right
      --!    string has been appended to the Left text.
      --!
      --! Parameters:
      --!    Left
      --!       is an access to text data.
      --!    Right
      --!       is a string.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      return Left & Text (Right);
   end "&";

   pragma Page;
   ------------------------------------------------------------------

   function "&" (Left  : in Text_Type;
                 Right : in Character) return Text_Type is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "&"
      --!
      --! Purpose:
      --!    This function returns new text in which the Right
      --!    character has been appended to the Left text.
      --!
      --! Parameters:
      --!    Left
      --!       is an access to text data.
      --!    Right
      --!       is a character.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      return Left & Text (Right);
   end "&";

   pragma Page;
   ------------------------------------------------------------------

   function "&" (Left  : in String;
                 Right : in Text_Type) return Text_Type is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "&"
      --!
      --! Purpose:
      --!    This function returns new text in which the Right
      --!    text has been appended to the Left string.
      --!
      --! Parameters:
      --!    Left
      --!       is a string.
      --!    Right
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      return Text (Left) & Right;
   end "&";

   pragma Page;
   ------------------------------------------------------------------

   function "&" (Left  : in Character;
                 Right : in Text_Type) return Text_Type is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "&"
      --!
      --! Purpose:
      --!    This function returns new text in which the Right
      --!    text has been appended to the Left character.
      --!
      --! Parameters:
      --!    Left
      --!       is a character.
      --!    Right
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      return Text (Left) & Right;
   end "&";

   pragma Page;
   ------------------------------------------------------------------

   function "=" (Left  : in Text_Type;
                 Right : in Text_Type) return Boolean is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "="
      --!
      --! Purpose:
      --!    This function returns a boolean which indicates whether
      --!    the Left text is equal to the Right text.
      --!
      --! Parameters:
      --!    Left
      --!       is an access to text data.
      --!    Right
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      L : Text_Type := Check (Left);
      R : Text_Type := Check (Right);

   begin
      return L.Value (1 .. L.Length) = R.Value (1 .. R.Length);
   end "=";

   pragma Page;
   ------------------------------------------------------------------

   function "<" (Left  : in Text_Type;
                 Right : in Text_Type) return Boolean is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "<"
      --!
      --! Purpose:
      --!    This function returns a boolean which indicates whether
      --!    the Left text is less than the Right text.
      --!
      --! Parameters:
      --!    Left
      --!       is an access to text data.
      --!    Right
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      L : Text_Type := Check (Left);
      R : Text_Type := Check (Right);

   begin
      return L.Value (1 .. L.Length) < R.Value (1 .. R.Length);
   end "<";

   pragma Page;
   ------------------------------------------------------------------

   function "<=" (Left  : in Text_Type;
                  Right : in Text_Type) return Boolean is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "<="
      --!
      --! Purpose:
      --!    This function returns a boolean which indicates whether
      --!    the Left text is less than or equal to the Right text.
      --!
      --! Parameters:
      --!    Left
      --!       is an access to text data.
      --!    Right
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      L : Text_Type := Check (Left);
      R : Text_Type := Check (Right);

   begin
      return L.Value (1 .. L.Length) <= R.Value (1 .. R.Length);
   end "<=";

   pragma Page;
   ------------------------------------------------------------------

   function ">" (Left  : in Text_Type;
                 Right : in Text_Type) return Boolean is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    ">"
      --!
      --! Purpose:
      --!    This function returns a boolean which indicates whether
      --!    the Left text is greater than the Right text.
      --!
      --! Parameters:
      --!    Left
      --!       is an access to text data.
      --!    Right
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      L : Text_Type := Check (Left);
      R : Text_Type := Check (Right);

   begin
      return L.Value (1 .. L.Length) > R.Value (1 .. R.Length);
   end ">";

   pragma Page;
   ------------------------------------------------------------------

   function ">=" (Left  : in Text_Type;
                  Right : in Text_Type) return Boolean is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    ">="
      --!
      --! Purpose:
      --!    This function returns a boolean which indicates whether
      --!    the Left text is greater than or equal to the Right text.
      --!
      --! Parameters:
      --!    Left
      --!       is an access to text data.
      --!    Right
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      L : Text_Type := Check (Left);
      R : Text_Type := Check (Right);

   begin
      return L.Value (1 .. L.Length) >= R.Value (1 .. R.Length);
   end ">=";

   pragma Page;
   ------------------------------------------------------------------

   procedure Set (Object : in out Text_Type;
                  Value  : in     Text_Type) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Set
      --!
      --! Purpose:
      --!    This procedure sets one text to the value of another.
      --!
      --! Parameters:
      --!    Object
      --!       is an access to text.
      --!    Value
      --!       is an access to text.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Text : Text_Type := Check (Value);

   begin
      Initialize (Object);
      Object.all := Text.all;
   end Set;

   pragma Page;
   ------------------------------------------------------------------

   procedure Set (Object : in out Text_Type;
                  Value  : in     String) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Set
      --!
      --! Purpose:
      --!    This procedure sets one text to the value of a string.
      --!
      --! Parameters:
      --!    Object
      --!       is an access to text.
      --!    Value
      --!       is a string.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      Set (Object, Text (Value));
   end Set;

   pragma Page;
   ------------------------------------------------------------------

   procedure Set (Object : in out Text_Type;
                  Value  : in     Character) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Set
      --!
      --! Purpose:
      --!    This procedure sets one text to the value of a character.
      --!
      --! Parameters:
      --!    Object
      --!       is an access to text.
      --!    Value
      --!       is a character.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      Set (Object, Text (Value));
   end Set;

   pragma Page;
   ------------------------------------------------------------------

   procedure Append (Tail : in     Text_Type;
                     To   : in out Text_Type) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Append
      --!
      --! Purpose:
      --!    This procedure appends one text to another.
      --!
      --! Parameters:
      --!    Tail
      --!       is an access to text data.
      --!    To
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      To := (To & Tail);
   end Append;

   pragma Page;
   ------------------------------------------------------------------

   procedure Append (Tail : in     String;
                     To   : in out Text_Type) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Append
      --!
      --! Purpose:
      --!    This procedure appends a string to text.
      --!
      --! Parameters:
      --!    Tail
      --!       is a string.
      --!    To
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      Append (Text (Tail), To);
   end Append;

   pragma Page;
   ------------------------------------------------------------------

   procedure Append (Tail : in     Character;
                     To   : in out Text_Type) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Append
      --!
      --! Purpose:
      --!    This procedure appends a character to text.
      --!
      --! Parameters:
      --!    Tail
      --!       is a character.
      --!    To
      --!       is an access to text data.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      Append (Text (Tail), To);
   end Append;

   pragma Page;
   ------------------------------------------------------------------

   procedure Amend (Object   : in out Text_Type;
                    By       : in     Text_Type;
                    Position : in     Index := 1) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Amend
      --!
      --! Purpose:
      --!    This procedure changes the value of text
      --!    at the specified position.
      --!
      --! Parameters:
      --!    Object
      --!       is an access to text data.
      --!    By
      --!       is an access to text data (replacement text).
      --!    Position
      --!       indicates at which point the replacement is to occur.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Text : Text_Type := Check (By);

   begin
      Object := Check (Object);

      Object.Value (Position .. Position + Text.Length - 1)
         := Text.Value (1 .. Text.Length);

      if (Position + Text.Length > Object.Length) then
         Object.Length := Position + Text.Length;
      end if;
   end Amend;

   pragma Page;
   ------------------------------------------------------------------

   procedure Amend (Object   : in out Text_Type;
                    By       : in     String;
                    Position : in     Index := 1) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Amend
      --!
      --! Purpose:
      --!    This procedure changes the value of text
      --!    at the specified position.
      --!
      --! Parameters:
      --!    Object
      --!       is an access to text data.
      --!    By
      --!       is a string (replacement string).
      --!    Position
      --!       indicates at which point the replacement is to occur.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      Amend (Object, Text (By), Position);
   end Amend;

   pragma Page;
   ------------------------------------------------------------------

   procedure Amend (Object   : in out Text_Type;
                    By       : in     Character;
                    Position : in     Index := 1) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Amend
      --!
      --! Purpose:
      --!    This procedure changes the value of text
      --!    at the specified position.
      --!
      --! Parameters:
      --!    Object
      --!       is an access to text data.
      --!    By
      --!       is a character (replacement character).
      --!    Position
      --!       indicates at which point the replacement is to occur.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      Amend (Object, Text (By), Position);
   end Amend;

   pragma Page;
   ------------------------------------------------------------------

   function Locate (Fragment : in Text_Type;
                    Within   : in Text_Type;
                    Position : in Index := 1) return Index is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Locate
      --!
      --! Purpose:
      --!    This function returns the location of the fragment
      --!    within the text (or zero if the fragment is not found).
      --!
      --! Parameters:
      --!    Fragment
      --!       is an access to text data.
      --!    Within
      --!       is an access to text data.
      --!    Position
      --!       is the point at which the search for the
      --!       fragment is to commence.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Result : Index := 0;
      F : Text_Type := Check (Fragment);
      W : Text_Type := Check (Within);

   begin
      for I in Position .. W.Length - F.Length + 1 loop

         if (W.Value (I .. I + F.Length - 1) =
             F.Value (1 .. F.Length)) then

            Result := I;
            exit;
         end if;
      end loop;

      return Result;
   end Locate;

   pragma Page;
   ------------------------------------------------------------------

   function Locate (Fragment : in String;
                    Within   : in Text_Type;
                    Position : in Index := 1) return Index is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Locate
      --!
      --! Purpose:
      --!    This function returns the location of the fragment
      --!    within the text (or zero if the fragment is not found).
      --!
      --! Parameters:
      --!    Fragment
      --!       is a string.
      --!    Within
      --!       is an access to text data.
      --!    Position
      --!       is the point at which the search for the
      --!       fragment is to commence.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      return Locate (Text (Fragment), Within, Position);
   end Locate;

   pragma Page;
   ------------------------------------------------------------------

   function Locate (Fragment : in Character;
                    Within   : in Text_Type;
                    Position : in Index := 1) return Index is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Locate
      --!
      --! Purpose:
      --!    This function returns the location of the fragment
      --!    within the text (or zero if the fragment is not found).
      --!
      --! Parameters:
      --!    Fragment
      --!       is a character.
      --!    Within
      --!       is an access to text data.
      --!    Position
      --!       is the point at which the search for the
      --!       fragment is to commence.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      return Locate (Text (Fragment), Within, Position);
   end Locate;

   pragma Page;
   ------------------------------------------------------------------

begin
   null;
end Kalman_String;
--::::::::::::::::::::::::::::
--KALMAN-CHECK-SPEC.ADA
--::::::::::::::::::::::::::::

package Kalman_Check is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Check
   --!
   --! Purpose:
   --!    This package determines whether the spelling of a word
   --!    matches that of a "correct" word given that certain
   --!    typing or spelling errors may have occurred.
   --!
   --! Adapted from:
   --!    Spelling Correction in User Interfaces,
   --!    Durham, Lamb, and Saxe, CMU-CS-82-151,
   --!    Carnegie-Mellon University, 1982.
   --!
   --! Interfaces:
   --!    Possibly_Correct
   --!       returns a boolean value which indicates whether the
   --!       spelling of the Word intends the spelling of the
   --!       "correct" word.
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!    Single missing letters, single incorrect letters, and
   --!    transposed characters are corrected for when determining
   --!    whether the spelling might be correct.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --!----------------------------------------------------------------

   function Possibly_Correct
      (Word, Correct_Word: in String) return Boolean;

end Kalman_Check;
--::::::::::::::::::::::::::::
--KALMAN-CHECK-BODY.ADA
--::::::::::::::::::::::::::::

package body Kalman_Check is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Check
   --!
   --! Purpose:
   --!    This package body determines whether the spelling of a word
   --!    matches that of a "correct" word given that certain
   --!    typing or spelling errors may have occurred.
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!    Single missing letters, single incorrect letters, and
   --!    transposed characters are corrected for when determining
   --!    whether the spelling might be correct.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --!----------------------------------------------------------------

   Difference: constant Integer
               := Character'Pos ('a') - Character'Pos ('A');

   pragma Page;
   -------------------------------------------------------------------

   function Same_Character (A, B: in Character) return Boolean is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Same_Character
      --!
      --! Purpose:
      --!    This local function returns a boolean value which
      --!    indicates whether the input characters are equal.
      --!
      --! Parameters:
      --!    A
      --!       is a character.
      --!
      --!    B
      --!       is a character.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    If the characters differ only in case, they are still
      --!    considered equal.
      --!
      --!-------------------------------------------------------------

      Folded_A,
      Folded_B: Integer;

   begin
      Folded_A := Character'Pos (A);
      Folded_B := Character'Pos (B);

      if A in 'a'..'z' then
         Folded_A := Folded_A - Difference;
      end if;

      if B in 'a'..'z' then
         Folded_B := Folded_B - Difference;
      end if;

      return Folded_A = Folded_B;
   end Same_Character;

   pragma Page;
   -------------------------------------------------------------------

   function First_Difference (A, B: in String) return Integer is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    First_Difference
      --!
      --! Purpose:
      --!    This local function returns the first character position
      --!    in which the two strings are not equal.
      --!
      --! Parameters:
      --!    A
      --!       is a string.
      --!
      --!    B
      --!       is a string.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    If one or both of the strings are null, then
      --!    First_Difference returns a zero index. If the two
      --!    strings are equal throughout the length of the
      --!    smaller of the two, then First_Difference returns
      --!    one greater than the lenght of the shorter as the
      --!    index.
      --!
      --!-------------------------------------------------------------

      Last_Index: Integer;

   begin
      if A'Length <= B'Length then
         Last_Index := A'Length;
      else
         Last_Index := B'Length;
      end if;

      if Last_Index = 0 then
         return 0;
      end if;

      for I in 1 .. Last_Index loop

         if not Same_Character (A (I), B (I)) then
            return I;
         end if;
      end loop;

      return Last_Index + 1;
   end First_Difference;

   pragma Page;
   -------------------------------------------------------------------

   function Match_Substring
      (A, B:    in String;
       First_A,
       First_B: in Natural) return Boolean is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Match_Substring
      --!
      --! Purpose:
      --!    This local function returns a boolean value which
      --!    indicates whether the specified substrings of the
      --!    strings are equal.
      --!
      --! Parameters:
      --!    A
      --!       is a string.
      --!
      --!    B
      --!       is a string.
      --!
      --!    First_A
      --!       is the index position of the start of the substring
      --!       of A.
      --!
      --!    First_B
      --!       is the index position of the start of the substring
      --!       of B.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    If the length of the substring of B is greater than
      --!    the length of the substring of A, then the substrings
      --!    can not match. Otherwise, it is determined whether the
      --!    substrings match throughout the length of the substring
      --!    of B.
      --!
      --!-------------------------------------------------------------

   begin
      if First_B > B'Length then
         return True;
      elsif (First_A > A'Length) or
            ((B'Last - First_B) > (A'Last - First_A)) then
         return False;
      end if;

      for I in 0 .. (B'Last - First_B) loop
         if not Same_Character
            (A (I+ First_A),
             B (I + First_B)) then return False;
         end if;
      end loop;

      return True;
   end Match_Substring;

   pragma Page;
   -------------------------------------------------------------------

   function Possibly_Correct
      (Word,
       Correct_Word: in String) return Boolean is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Possibly_Correct
      --!
      --! Purpose:
      --!    This function returns a boolean which indicates whether
      --!    the spelling of Word might intend the spelling of the
      --!    Correct_Word.
      --!
      --! Parameters:
      --!    Word
      --!       is a string.
      --!
      --!    Correct_Word
      --!       is a string which contains the "correct" spelling.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Single missing letters, single incorrect letters, and
      --!    transposed characters are corrected for when determining
      --!    whether the spelling might be correct.
      --!
      --!-------------------------------------------------------------

      Index: Integer;

      A: String (1..Word'Length);
      B: String (1..Correct_Word'Length);

   begin
      if (A'Length = 0) or (B'Length = 0) then
         return False;
      end if;

      A := Word;
      B := Correct_Word;

      -- Can't match if word is more than one longer.
      if (A'Length - 1) > B'Length then
         return False;
      end if;

      -- Step 1: Find index of first different characters.
      Index := First_Difference (B, A);

      -- Assume wrong letter if difference is at end of word.
      if (Index = A'Length) and (A'Length > 2) then
         return True;
      end if;

      -- Step 2: Check for transposed characters and tail match.
      if (B'Last > Index) and (A'Last > Index) then

         if Same_Character (B (Index),     A (Index + 1)) and
            Same_Character (B (Index + 1), A (Index))     and

            Match_Substring (B, A, Index+2, Index+2) then
            return True;
         end if;
      end if;

      -- Step 3: Apply remaining tail substring matches.
      if Match_Substring (B, A, Index+1, Index) then
         return True;
      end if;

      -- Don't try other tests on two character strings.
      if A'Length = 2 then
         return False;
      end if;

      if Match_Substring (B, A, Index, Index+1) then
         return True;
      end if;

      if Match_Substring (B, A, Index+1, Index+1) then
         return True;
      end if;

      return False;
   end Possibly_Correct;

end Kalman_Check;
--::::::::::::::::::::::::::::
--KALMAN-TEXT-IO-SPEC.ADA
--::::::::::::::::::::::::::::

with Text_Io;
use Text_Io;

package Kalman_Text_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Text_Io
   --!
   --! Purpose:
   --!    This package provides support for the friendly I/O used
   --!    by the Ada Kalman Filter. Lines read in by a Get_Line
   --!    will be saved in Buffer for later reference.
   --!
   --! Interfaces:
   --!    Get_Line
   --!       is called to read a Buffer from File after displaying
   --!       the Prompt string to Current_Output.
   --!
   --!    Buffer
   --!       is the current line read by a Get_Line routine.
   --!
   --!    Length
   --!       is the Length of Buffer.
   --!
   --!    Index
   --!       is the current Index position of Buffer.
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!    A Buffer is not read if characters still remain from the
   --!    previous call to Get_Line.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --!----------------------------------------------------------------

   Index:  Natural := 0;    -- Current character position.
   Length: Natural := 0;    -- Current line length.
   Buffer: String (1..256); -- Current line.

   procedure Get_Line (File   : in File_Type;
                       Prompt : in String := "");

   procedure Get_Line (Prompt : in String := "");

end Kalman_Text_Io;
--::::::::::::::::::::::::::::
--KALMAN-TEXT-IO-BODY.ADA
--::::::::::::::::::::::::::::

package body Kalman_Text_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Text_Io
   --!
   --! Purpose:
   --!    This package body provides support for the friendly I/O used
   --!    by the Ada Kalman Filter. Lines read in by a Get_Line
   --!    will be saved in Buffer for later reference.
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!    A Buffer is not read if characters still remain from the
   --!    previous call to Get_Line.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --! Changes:
   --!    26-APR-1985
   --!       Added code to skip the remainder of the line when an
   --!       Ada comment line ("-- text") is found.
   --!
   --!----------------------------------------------------------------

   pragma Page;
   -------------------------------------------------------------------

   procedure Get_Line (File   : in File_Type;
                       Prompt : in String := "") is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get_Line
      --!
      --! Purpose:
      --!    This procedure gets a line from the specified File
      --!    if the current Buffer is empty.
      --!
      --! Parameters:
      --!    File
      --!       is the specified input file.
      --!
      --!   Prompt
      --!       is the prompt string.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    If the current Buffer is empty, then an attempt is
      --!    made to read a new buffer from the specified file.
      --!    A prompt is issued if the user has specified one.
      --!    Preceding blanks, trailing blanks, and comments
      --!    (any string beginning with "--" to the end-of-line)
      --!    are ignored.
      --!
      --!-------------------------------------------------------------

      Display_Prompt : Boolean := (Prompt /= "");

   begin

      loop
         if (Index <= 0) or (Index > Length) then

            if (Display_Prompt) then
               Put (Prompt);
            end if;

            Get_Line (File, Buffer, Length);

            if (Display_Prompt) then
               New_Line;
            end if;

            Index := Buffer'First;

            -- Skip trailing blanks.
            for I in reverse Index .. Length loop

               if (Buffer (I) /= ' ') then
                  Length := I;
                  exit;
               end if;
            end loop;
         end if;

         -- Skip preceding blanks.
         for I in Index .. Length loop

            if (Buffer (I) /= ' ') then
               Index := I;
               exit;
            end if;
         end loop;

         if (Index+1 <= Length) and then
            (Buffer (Index..Index+1) = "--") then
            Index := Length + 1; -- Skip comment.
         else
            exit; -- No comment line.
         end if;
      end loop;

   end Get_Line;

   pragma Page;
   -------------------------------------------------------------------

   procedure Get_Line (Prompt : in String := "") is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get_Line
      --!
      --! Purpose:
      --!    This procedure gets a line from the current input
      --!    if the current Buffer is empty.
      --!
      --! Parameters:
      --!   Prompt
      --!       is the prompt string.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    If the current Buffer is empty, then an attempt is
      --!    made to read a new buffer from the current input.
      --!    A prompt is issued if the user has specified one.
      --!    Preceding blanks, trailing blanks, and comments
      --!    (any string beginning with "--" to the end-of-line)
      --!    are ignored.
      --!
      --!-------------------------------------------------------------

   begin

      Get_Line (Current_Input, Prompt);

   end Get_Line;

end Kalman_Text_Io;
--::::::::::::::::::::::::::::
--GENERIC-FIXED-IO-SPEC.ADA
--::::::::::::::::::::::::::::

with Text_Io;
use Text_Io;

generic
   type Num is delta <>;

package Generic_Fixed_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Generic_Fixed_Io
   --!
   --! Purpose:
   --!    This generic package provides a friendly version of the
   --!    package Text_Io.Fixed_Io for the Ada Kalman Filter.
   --!
   --! Interfaces:
   --!    Same as Text_Io.Fixed_Io.
   --!
   --! Exceptions:
   --!    Same as Text_Io.Fixed_Io.
   --!
   --!
   --! Notes:
   --!    Friendly features include:
   --!       prompting the user for input,
   --!       converting integer input to type Num,
   --!       displaying error messages when invalid input is entered,
   --!       and indicating the range of correct input after an
   --!       error is encountered.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --!----------------------------------------------------------------

   Default_Fore : Field := Num'Fore;
   Default_Aft  : Field := Num'Aft;
   Default_Exp  : Field := 0;

   -------------------------------------------------------------------

   procedure Get (File   : in  File_Type;
                  Item   : out Num;
                  Width  : in  Field  := 0;
                  Prompt : in  String := "");

   procedure Get (Item   : out Num;
                  Width  : in  Field  := 0;
                  Prompt : in  String := "");

   -------------------------------------------------------------------

   procedure Put (File : in File_Type;
                  Item : in Num;
                  Fore : in Field := Default_Fore;
                  Aft  : in Field := Default_Aft;
                  Exp  : in Field := Default_Exp);

   procedure Put (Item : in Num;
                  Fore : in Field := Default_Fore;
                  Aft  : in Field := Default_Aft;
                  Exp  : in Field := Default_Exp);

   -------------------------------------------------------------------

   procedure Get (From : in  String;
                  Item : out Num;
                  Last : out Positive);

   procedure Put (To   : out String;
                  Item : in  Num;
                  Aft  : in  Field   := Default_Aft;
                  Exp  : in  Integer := Default_Exp);

end Generic_Fixed_Io;
--::::::::::::::::::::::::::::
--GENERIC-FIXED-IO-BODY.ADA
--::::::::::::::::::::::::::::

with Text_Io;
with Kalman_Text_Io;

use Text_Io;
use Kalman_Text_Io;

package body Generic_Fixed_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Generic_Fixed_Io
   --!
   --! Purpose:
   --!    This generic package body provides a friendly version of the
   --!    package Text_Io.Fixed_Io for the Ada Kalman Filter.
   --!
   --!
   --! Notes:
   --!    Friendly features include:
   --!       prompting the user for input,
   --!       converting integer input to type Num,
   --!       displaying error messages when invalid input is entered,
   --!       and indicating the range of correct input after an
   --!       error is encountered.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --! Changes:
   --!    26-APR-1985
   --!       Added check for empty Index before accessing Line array
   --!       in Get procedure. This could have resulted in an index
   --!       out of bounds.
   --!
   --!----------------------------------------------------------------

   package Fixed_Io is
      new Text_Io.Fixed_Io (Num);

   package Integer_Io is
      new Text_Io.Integer_Io (Integer);

   pragma Page;
   -------------------------------------------------------------------

   procedure Get(File   : in  File_Type;
                 Item   : out Num;
                 Width  : in  Field  := 0;
                 Prompt : in  String := "") is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get
      --!
      --! Purpose:
      --!    This procedure displays the Prompt to Current_Output
      --!    and then attempts to read a value of type Num from the
      --!    specified File. If an Integer value is read, it is
      --!    converted to Num. If an invalid value is read, an
      --!    error message is displayed to Current_Output, and
      --!    a new value is read from the specified File.
      --!
      --! Parameters:
      --!    File
      --!       is the file from which the Item will be read.
      --!
      --!    Item
      --!       returns the Num value as read from File.
      --!
      --!    Width
      --!       is the maximum field width for Item.
      --!
      --!    Prompt
      --!       is the prompt to be displayed to Current_Output.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Last:   Natural; -- Last character returned from Get.
      Field:  Natural; -- Field length (based on width).
      Number: Integer; -- Local integer value for Get.

   begin

      loop
         Get_Line (File, Prompt);

         if (Width = 0) then
            Field := Length;
         elsif (Index + Width - 1 > Length) then
            Field := Length;
         else
            Field := Index + Width - 1;
         end if;

         begin
            -- Check for Fixed number.
            if (Index >= Buffer'First) and then
               (Buffer (Index) = '.') then
               Fixed_Io.Get ("0" & Buffer (Index..Field), Item, Last);
            else
               Fixed_Io.Get (Buffer (Index..Field), Item, Last);
            end if;

            Index := Last + 1;
            return;
         exception
            when others =>
               begin
                  -- Check for integer number.
                  Integer_Io.Get (Buffer (Index..Field),
                                  Number, Last);
                  Item := Num (Number);
                  Index := Last + 1;
                  return;
               exception
                  when others =>
                     Last := Length;

                     -- Find next blank.
                     for I in Index + 1 .. Length loop

                        if (Buffer (I) = ' ') then
                           Last := I - 1;
                           exit;
                        end if;
                     end loop;
               end;
         end;

         if (Index > Length) then
            New_Line;
            Put ("%FIXED-E-EMPTY, ");
            Put ("A correct value ");
            Put ("is in the range:");
            New_Line;
         else
            New_Line;
            Put ("%FIXED-E-RANGE, ");
            Put ("The value """);
            Put (Buffer (Index..Last));
            Put (""" is not in the range:");
            New_Line;
         end if;

         Put ("   ");
         Put (Num'First, Fore => 1);
         Put ("  ..  ");
         Put (Num'Last, Fore => 1);
         New_Line;

         New_Line;
         Put ("%FIXED-E-RETRY, ");
         Put ("Please enter a ");

         if (Index <= Length) then
            Put ("correct ");
         end if;

         Put ("value.");
         New_Line;

         Index := Last + 1;
      end loop;

   end Get;

   pragma Page;
   -------------------------------------------------------------------

   procedure Get(Item   : out Num;
                 Width  : in  Field  := 0;
                 Prompt : in  String := "") is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get
      --!
      --! Purpose:
      --!    This procedure displays the Prompt to Current_Output
      --!    and then attempts to read a value of type Num from
      --!    Current_Input. If an Integer value is read, it is
      --!    converted to Num. If an invalid value is read, an
      --!    error message is displayed to Current_Output, and
      --!    a new value is read from the Current_Input.
      --!
      --! Parameters:
      --!    Item
      --!       returns the Num value as read from Current_Input.
      --!
      --!    Width
      --!       is the maximum field width for Item.
      --!
      --!    Prompt
      --!       is the prompt to be displayed to Current_Output.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Get (Current_Input, Item, Width, Prompt);

   end Get;

   pragma Page;
   -------------------------------------------------------------------

   procedure Put(File : in File_Type;
                 Item : in Num;
                 Fore : in Field := Default_Fore;
                 Aft  : in Field := Default_Aft;
                 Exp  : in Field := Default_Exp) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Put
      --!
      --! Purpose:
      --!    This procedure writes an Item of type Num to the
      --!    specified File using the field definitions.
      --!
      --! Parameters:
      --!    Same as Fixed_Io.Put (File, Item, Fore, Aft, Exp).
      --!
      --! Exceptions:
      --!    Same as Fixed_Io.Put (File, Item, Fore, Aft, Exp).
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Fixed_Io.Put (File, Item, Fore, Aft, Exp);

   end Put;

   pragma Page;
   -------------------------------------------------------------------

   procedure Put(Item : in Num;
                 Fore : in Field := Default_Fore;
                 Aft  : in Field := Default_Aft;
                 Exp  : in Field := Default_Exp) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Put
      --!
      --! Purpose:
      --!    This procedure writes an Item of type Num to
      --!    standard output using the field definitions.
      --!
      --! Parameters:
      --!    Same as Fixed_Io.Put (Item, Fore, Aft, Exp).
      --!
      --! Exceptions:
      --!    Same as Fixed_Io.Put (Item, Fore, Aft, Exp).
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Fixed_Io.Put (Item, Fore, Aft, Exp);

   end Put;

   pragma Page;
   -------------------------------------------------------------------

   procedure Get (From : in  String;
                  Item : out Num;
                  Last : out Positive) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get
      --!
      --! Purpose:
      --!    This procedure attempts to read an Item of type Num from
      --!    the String From.
      --!
      --! Parameters:
      --!    Same as Fixed_Io.Get (From, Item , Last).
      --!
      --! Exceptions:
      --!    Same as Fixed_Io.Get (From, Item , Last).
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Fixed_Io.Get (From, Item, Last);

   end Get;

   pragma Page;
   -------------------------------------------------------------------

   procedure Put (To   : out String;
                  Item : in  Num;
                  Aft  : in  Field   := Default_Aft;
                  Exp  : in  Integer := Default_Exp) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Put
      --!
      --! Purpose:
      --!    This procedure writes an Item of type Num to the
      --!    String To.
      --!
      --! Parameters:
      --!    Same as Fixed_Io.Put (To, Item, Aft, Exp).
      --!
      --! Exceptions:
      --!    Same as Fixed_Io.Put (To, Item, Aft, Exp).
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Fixed_Io.Put (To, Item, Aft, Exp);

   end Put;

end Generic_Fixed_Io;
--::::::::::::::::::::::::::::
--GENERIC-INTEGER-IO-SPEC.ADA
--::::::::::::::::::::::::::::

with Text_Io;
use Text_Io;

generic
   type Num is range <>;

package Generic_Integer_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Generic_Integer_Io
   --!
   --! Purpose:
   --!    This generic package provides a friendly version of the
   --!    package Text_Io.Integer_Io for the Ada Kalman Filter.
   --!
   --! Interfaces:
   --!    Same as Text_Io.Integer_Io.
   --!
   --! Exceptions:
   --!    Same as Text_Io.Integer_Io.
   --!
   --! Notes:
   --!    Friendly features include:
   --!       prompting the user for input,
   --!       converting float input to type Num,
   --!       displaying error messages when invalid input is entered,
   --!       and indicating the range of correct input after an
   --!       error is encountered.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --!----------------------------------------------------------------

   Default_Width : Field := Num'Width;
   Default_Base  : Field := 10;

   -------------------------------------------------------------------

   procedure Get (File   : in  File_Type;
                  Item   : out Num;
                  Width  : in  Field  := 0;
                  Prompt : in  String := "");

   procedure Get (Item   : out Num;
                  Width  : in  Field  := 0;
                  Prompt : in  String := "");

   -------------------------------------------------------------------

   procedure Put (File  : in File_Type;
                  Item  : in Num;
                  Width : in Field := Default_Width;
                  Base  : in Field := Default_Base);

   procedure Put (Item  : in Num;
                  Width : in Field := Default_Width;
                  Base  : in Field := Default_Base);

   -------------------------------------------------------------------

   procedure Get (From : in  String;
                  Item : out Num;
                  Last : out Positive);

   procedure Put (To   : out String;
                  Item : in  Num;
                  Base : in  Field   := Default_Base);

end Generic_Integer_Io;
--::::::::::::::::::::::::::::
--GENERIC-INTEGER-IO-BODY.ADA
--::::::::::::::::::::::::::::

with Text_Io;
with Kalman_Text_Io;

use Text_Io;
use Kalman_Text_Io;

package body Generic_Integer_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Generic_Integer_Io
   --!
   --! Purpose:
   --!    This generic package body provides a friendly version of the
   --!    package Text_Io.Float_Io for the Ada Kalman Filter.
   --!
   --! Notes:
   --!    Friendly features include:
   --!       prompting the user for input,
   --!       converting float input to type Num,
   --!       displaying error messages when invalid input is entered,
   --!       and indicating the range of correct input after an
   --!       error is encountered.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --! Changes:
   --!    26-APR-1985
   --!       Added check for empty Index before accessing Line array
   --!       in Get procedure. This could have resulted in an index
   --!       out of bounds.
   --!
   --!----------------------------------------------------------------

   package Integer_Io is
      new Text_Io.Integer_Io (Num);

   package Float_Io is
      new Text_Io.Float_Io (Float);

   pragma Page;
   -------------------------------------------------------------------

   procedure Get(File   : in  File_Type;
                 Item   : out Num;
                 Width  : in  Field  := 0;
                 Prompt : in  String := "") is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get
      --!
      --! Purpose:
      --!    This procedure displays the Prompt to Current_Output
      --!    and then attempts to read a value of type Num from the
      --!    specified File. If an Integer value is read, it is
      --!    converted to Num. If an invalid value is read, an
      --!    error message is displayed to Current_Output, and
      --!    a new value is read from the specified File.
      --!
      --! Parameters:
      --!    File
      --!       is the file from which the Item will be read.
      --!
      --!    Item
      --!       returns the Num value as read from File.
      --!
      --!    Width
      --!       is the maximum field width for Item.
      --!
      --!    Prompt
      --!       is the prompt to be displayed to Current_Output.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Last:   Natural; -- Last character returned from Get.
      Field:  Natural; -- Field length (based on width).
      Number: Float;   -- Local float value for Get.

   begin

      loop
         Get_Line (File, Prompt);

         if (Width = 0) then
            Field := Length;
         elsif (Index + Width - 1 > Length) then
            Field := Length;
         else
            Field := Index + Width - 1;
         end if;

         begin
            -- Check for float number.
            if (Index >= Buffer'First) and then
               (Buffer (Index) = '.') then
               Float_Io.Get ("0" & Buffer (Index..Field),
                             Number, Last);
            else
               Float_Io.Get (Buffer (Index..Field), Number, Last);
            end if;

            Item := Num (Number);
            Index := Last + 1;
            return;
         exception
            when others =>
               begin
                  -- Check for integer number.
                  Integer_Io.Get (Buffer (Index..Field),
                                  Item, Last);
                  Index := Last + 1;
                  return;
               exception
                  when others =>
                     Last := Length;

                     -- Find next blank.
                     for I in Index + 1 .. Length loop

                        if (Buffer (I) = ' ') then
                           Last := I - 1;
                           exit;
                        end if;
                     end loop;
               end;
         end;

         if (Index > Length) then
            New_Line;
            Put ("%INTEGER-E-EMPTY, ");
            Put ("A correct value ");
            Put ("is in the range:");
            New_Line;
         else
            New_Line;
            Put ("%INTEGER-E-RANGE, ");
            Put ("The value """);
            Put (Buffer (Index..Last));
            Put (""" is not in the range:");
            New_Line;
         end if;

         Put ("   ");
         Put (Num'First, Width => 1);
         Put ("  ..  ");
         Put (Num'Last, Width => 1);
         New_Line;

         New_Line;
         Put ("%INTEGER-E-RETRY, ");
         Put ("Please enter a ");

         if (Index <= Length) then
            Put ("correct ");
         end if;

         Put ("value.");
         New_Line;

         Index := Last + 1;
      end loop;

   end Get;

   pragma Page;
   -------------------------------------------------------------------

   procedure Get(Item   : out Num;
                 Width  : in  Field  := 0;
                 Prompt : in  String := "") is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get
      --!
      --! Purpose:
      --!    This procedure displays the Prompt to Current_Output
      --!    and then attempts to read a value of type Num from
      --!    Current_Input. If an Integer value is read, it is
      --!    converted to Num. If an invalid value is read, an
      --!    error message is displayed to Current_Output, and
      --!    a new value is read from the Current_Input.
      --!
      --! Parameters:
      --!    Item
      --!       returns the Num value as read from Current_Input.
      --!
      --!    Width
      --!       is the maximum field width for Item.
      --!
      --!    Prompt
      --!       is the prompt to be displayed to Current_Output.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Get (Current_Input, Item, Width, Prompt);

   end Get;

   pragma Page;
   -------------------------------------------------------------------

   procedure Put(File  : in File_Type;
                 Item  : in Num;
                 Width : in Field := Default_Width;
                 Base  : in Field := Default_Base) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Put
      --!
      --! Purpose:
      --!    This procedure writes an Item of type Num to the
      --!    specified File using the field definitions.
      --!
      --! Parameters:
      --!    Same as Integer_Io.Put (File, Item, Width, Base).
      --!
      --! Exceptions:
      --!    Same as Integer_Io.Put (File, Item, Width, Base).
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Integer_Io.Put (File, Item, Width, Base);

   end Put;

   pragma Page;
   -------------------------------------------------------------------

   procedure Put(Item  : in Num;
                 Width : in Field := Default_Width;
                 Base  : in Field := Default_Base) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Put
      --!
      --! Purpose:
      --!    This procedure writes an Item of type Num to
      --!    standard output using the field definitions.
      --!
      --! Parameters:
      --!    Same as Integer_Io.Put (Item, Width, Base).
      --!
      --! Exceptions:
      --!    Same as Integer_Io.Put (Item, Width, Base).
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Integer_Io.Put (Item, Width, Base);

   end Put;

   pragma Page;
   -------------------------------------------------------------------

   procedure Get (From : in  String;
                  Item : out Num;
                  Last : out Positive) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get
      --!
      --! Purpose:
      --!    This procedure attempts to read an Item of type Num
      --!    from the String From.
      --!
      --! Parameters:
      --!    Same as Integer_Io.Get (From, Item, Last).
      --!
      --! Exceptions:
      --!    Same as Integer_Io.Get (From, Item, Last).
      --!
      --! Notes:
      --!    Not aplicable.
      --!
      --!-------------------------------------------------------------

   begin

      Integer_Io.Get (From, Item, Last);

   end Get;

   pragma Page;
   -------------------------------------------------------------------

   procedure Put (To   : out String;
                  Item : in  Num;
                  Base : in Field := Default_Base) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Put
      --!
      --! Purpose:
      --!    This procedure attempts to write an Item of type Num
      --!    to the String To.
      --!
      --! Parameters:
      --!    Same as Integer_Io.Put (To, Item, Base).
      --!
      --! Exceptions:
      --!    Same as Integer_Io.Put (To, Item, Base).
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Integer_Io.Put (To, Item, Base);

   end Put;

end Generic_Integer_Io;
--::::::::::::::::::::::::::::
--GENERIC-FLOAT-IO-SPEC.ADA
--::::::::::::::::::::::::::::

with Text_Io;
use Text_Io;

generic
   type Num is digits <>;

package Generic_Float_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Generic_Float_Io
   --!
   --! Purpose:
   --!    This generic package provides a friendly version of the
   --!    package Text_Io.Float_Io for the Ada Kalman Filter.
   --!
   --! Interfaces:
   --!    Same as Text_Io.Float_Io.
   --!
   --! Exceptions:
   --!    Same as Text_Io.Float_Io.
   --!
   --!
   --! Notes:
   --!    Friendly features include:
   --!       prompting the user for input,
   --!       converting integer input to type Num,
   --!       displaying error messages when invalid input is entered,
   --!       and indicating the range of correct input after an
   --!       error is encountered.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --!----------------------------------------------------------------

   Default_Fore : Field := 2;
   Default_Aft  : Field := Num'digits-1;
   Default_Exp  : Field := 3;

   -------------------------------------------------------------------

   procedure Get (File   : in  File_Type;
                  Item   : out Num;
                  Width  : in  Field  := 0;
                  Prompt : in  String := "");

   procedure Get (Item   : out Num;
                  Width  : in  Field  := 0;
                  Prompt : in  String := "");

   -------------------------------------------------------------------

   procedure Put (File : in File_Type;
                  Item : in Num;
                  Fore : in Field := Default_Fore;
                  Aft  : in Field := Default_Aft;
                  Exp  : in Field := Default_Exp);

   procedure Put (Item : in Num;
                  Fore : in Field := Default_Fore;
                  Aft  : in Field := Default_Aft;
                  Exp  : in Field := Default_Exp);

   -------------------------------------------------------------------

   procedure Get (From : in  String;
                  Item : out Num;
                  Last : out Positive);

   procedure Put (To   : out String;
                  Item : in  Num;
                  Aft  : in  Field   := Default_Aft;
                  Exp  : in  Integer := Default_Exp);

end Generic_Float_Io;
--::::::::::::::::::::::::::::
--GENERIC-FLOAT-IO-BODY.ADA
--::::::::::::::::::::::::::::

with Text_Io;
with Kalman_Text_Io;

use Text_Io;
use Kalman_Text_Io;

package body Generic_Float_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Generic_Float_Io
   --!
   --! Purpose:
   --!    This generic package body provides a friendly version of the
   --!    package Text_Io.Float_Io for the Ada Kalman Filter.
   --!
   --! Notes:
   --!    Friendly features include:
   --!       prompting the user for input,
   --!       converting integer input to type Num,
   --!       displaying error messages when invalid input is entered,
   --!       and indicating the range of correct input after an
   --!       error is encountered.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --! Changes:
   --!    26-APR-1985
   --!       Added check for empty Index before accessing Line array
   --!       in Get procedure. This could have resulted in an index
   --!       out of bounds.
   --!
   --!----------------------------------------------------------------

   package Float_Io is
      new Text_Io.Float_Io (Num);

   package Integer_Io is
      new Text_Io.Integer_Io (Integer);

   pragma Page;
   -------------------------------------------------------------------

   procedure Get(File   : in  File_Type;
                 Item   : out Num;
                 Width  : in  Field  := 0;
                 Prompt : in  String := "") is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get
      --!
      --! Purpose:
      --!    This procedure displays the Prompt to Current_Output
      --!    and then attempts to read a value of type Num from the
      --!    specified File. If an Integer value is read, it is
      --!    converted to Num. If an invalid value is read, an
      --!    error message is displayed to Current_Output, and
      --!    a new value is read from the specified File.
      --!
      --! Parameters:
      --!    File
      --!       is the file from which the Item will be read.
      --!
      --!    Item
      --!       returns the Num value as read from File.
      --!
      --!    Width
      --!       is the maximum field width for Item.
      --!
      --!    Prompt
      --!       is the prompt to be displayed to Current_Output.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Last:   Natural; -- Last character returned from Get.
      Field:  Natural; -- Field length (based on width).
      Number: Integer; -- Local integer value for Get.

   begin

      loop
         Get_Line (File, Prompt);

         if (Width = 0) then
            Field := Length;
         elsif (Index + Width - 1 > Length) then
            Field := Length;
         else
            Field := Index + Width - 1;
         end if;

         begin
            -- Check for float number.
            if (Index >= Buffer'First) and then
               (Buffer (Index) = '.') then
               Float_Io.Get ("0" & Buffer (Index..Field), Item, Last);
            else
               Float_Io.Get (Buffer (Index..Field), Item, Last);
            end if;

            Index := Last + 1;
            return;
         exception
            when others =>
               begin
                  -- Check for integer number.
                  Integer_Io.Get (Buffer (Index..Field),
                                  Number, Last);
                  Item := Num (Number);
                  Index := Last + 1;
                  return;
               exception
                  when others =>
                     Last := Length;

                     -- Find next blank.
                     for I in Index + 1 .. Length loop

                        if (Buffer (I) = ' ') then
                           Last := I - 1;
                           exit;
                        end if;
                     end loop;
               end;
         end;

         if (Index > Length) then
            New_Line;
            Put ("%FLOAT-E-EMPTY, ");
            Put ("A correct value ");
            Put ("is in the range:");
            New_Line;
         else
            New_Line;
            Put ("%FLOAT-E-RANGE, ");
            Put ("The value """);
            Put (Buffer (Index..Last));
            Put (""" is not in the range:");
            New_Line;
         end if;

         Put ("   ");
         Put (Num'First, Fore => 1);
         Put ("  ..  ");
         Put (Num'Last, Fore => 1);
         New_Line;

         New_Line;
         Put ("%FLOAT-E-RETRY, ");
         Put ("Please enter a ");

         if (Index <= Length) then
            Put ("correct ");
         end if;

         Put ("value.");
         New_Line;

         Index := Last + 1;
      end loop;

   end Get;

   pragma Page;
   -------------------------------------------------------------------

   procedure Get(Item   : out Num;
                 Width  : in  Field  := 0;
                 Prompt : in  String := "") is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get
      --!
      --! Purpose:
      --!    This procedure displays the Prompt to Current_Output
      --!    and then attempts to read a value of type Num from
      --!    Current_Input. If an Integer value is read, it is
      --!    converted to Num. If an invalid value is read, an
      --!    error message is displayed to Current_Output, and
      --!    a new value is read from the Current_Input.
      --!
      --! Parameters:
      --!    Item
      --!       returns the Num value as read from Current_Input.
      --!
      --!    Width
      --!       is the maximum field width for Item.
      --!
      --!    Prompt
      --!       is the prompt to be displayed to Current_Output.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Get (Current_Input, Item, Width, Prompt);

   end Get;

   pragma Page;
   -------------------------------------------------------------------

   procedure Put(File : in File_Type;
                 Item : in Num;
                 Fore : in Field := Default_Fore;
                 Aft  : in Field := Default_Aft;
                 Exp  : in Field := Default_Exp) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Put
      --!
      --! Purpose:
      --!    This procedure writes the Item of type Num to the
      --!    specified File using the field definitions.
      --!
      --! Parameters:
      --!    File
      --!       is the file to which the Item will be written.
      --!
      --!    Item
      --!       is the Num value to be written to File.
      --!
      --!    Fore, Aft, Exp
      --!       Same as Float_Io.
      --!
      --! Exceptions:
      --!    Same as Float_Io.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Float_Io.Put (File, Item, Fore, Aft, Exp);

   end Put;

   pragma Page;
   -------------------------------------------------------------------

   procedure Put(Item : in Num;
                 Fore : in Field := Default_Fore;
                 Aft  : in Field := Default_Aft;
                 Exp  : in Field := Default_Exp) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Put
      --!
      --! Purpose:
      --!    This procedure writes the Item of type Num to
      --!    standard output using the field definitions.
      --!
      --! Parameters:
      --!    Item
      --!       is the Num value to be written to File.
      --!
      --!    Fore, Aft, Exp
      --!       Same as Float_Io.
      --!
      --! Exceptions:
      --!    Same as Float_Io.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Float_Io.Put (Item, Fore, Aft, Exp);

   end Put;

   pragma Page;
   -------------------------------------------------------------------

   procedure Get (From : in  String;
                  Item : out Num;
                  Last : out Positive) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get
      --!
      --! Purpose:
      --!    This procedure attempts to get an Item of type Num
      --!    from the String From.
      --!
      --! Parameters:
      --!    Same as Float_Io.Get (From, Item, Last).
      --!
      --! Exceptions:
      --!    Same as Float_Io.Get (From, Item, Last).
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Float_Io.Get (From, Item, Last);

   end Get;

   pragma Page;
   -------------------------------------------------------------------

   procedure Put (To   : out String;
                  Item : in  Num;
                  Aft  : in  Field   := Default_Aft;
                  Exp  : in  Integer := Default_Exp) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Put
      --!
      --! Purpose:
      --!    This procedure writes an Item of type Num to the
      --!    String To using the field definitions.
      --!
      --! Parameters:
      --!    Same as Float_Io.Put (To, Item, Aft, Exp).
      --!
      --! Exceptions:
      --!    Same as Float_Io.Put (To, Item, Aft, Exp).
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Float_Io.Put (To, Item, Aft, Exp);

   end Put;

end Generic_Float_Io;
--::::::::::::::::::::::::::::
--GENERIC-SPELLING-IO-SPEC.ADA
--::::::::::::::::::::::::::::

with Text_Io;
use Text_Io;

generic
   type Enumeration is (<>);

package Generic_Spelling_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Generic_Spelling_Io
   --!
   --! Purpose:
   --!    This generic package provides a friendly means of reading
   --!    and writing Enumeration values.
   --!
   --! Interfaces:
   --!    Get
   --!       reads an Item of type Enumeration after prompting the
   --!       user.
   --!
   --!    Put
   --!       writes the image of an Item of type Enumeration.
   --!
   --! Exceptions:
   --!    Spelling_Error
   --!       is an internal exception which is raised if user input
   --!       matches none or more than one of the Enumeration values.
   --!
   --! Notes:
   --!    Friendly features of this package include:
   --!       entering least number of characters which provide
   --!          unambiguous result,
   --!       corrections of missing characters,
   --!       corrections of two letter transpositions.
   --!    It is expected that these features account for about 85 %
   --!    of all spelling errors.
   --!
   --!    If Assume is False in the call to Get, an Enumeration
   --!    value which is selected as a match to the input word,
   --!    though not a perfect match, is displayed with an informatory
   --!    message on standard output.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --!----------------------------------------------------------------

   pragma Page;
   -------------------------------------------------------------------

   Spelling_Error: exception;

   procedure Get (File:   in  File_Type;
                  Item:   out Enumeration;
                  Prompt: in  String  := "";
                  Assume: in  Boolean := True);

   procedure Get (Item:   out Enumeration;
                  Prompt: in  String  := "";
                  Assume: in  Boolean := True);

   procedure Put (File: in File_Type;
                  Item: in Enumeration);

   procedure Put (Item: in Enumeration);


end Generic_Spelling_Io;
--::::::::::::::::::::::::::::
--GENERIC-SPELLING-IO-BODY.ADA
--::::::::::::::::::::::::::::

with Text_Io;
with Kalman_String;
with Kalman_Check;
with Kalman_Text_Io;

use Text_Io;
use Kalman_String;
use Kalman_Check;
use Kalman_Text_Io;

package body Generic_Spelling_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Generic_Spelling_Io
   --!
   --! Purpose:
   --!    This generic package body provides a friendly means of
   --!    reading and writing Enumeration values.
   --!
   --! Exceptions:
   --!    Spelling_Error
   --!       is an internal exception which is raised if user input
   --!       matches none or more than one of the Enumeration values.
   --!
   --! Notes:
   --!    Friendly features of this package include:
   --!       entering least number of characters which provide
   --!          unambiguous result,
   --!       corrections of missing characters,
   --!       corrections of two letter transpositions.
   --!    It is expected that these features account for about 85 %
   --!    of all spelling errors.
   --!
   --!    If Assume is False in the call to Get, an Enumeration
   --!    value which is selected as a match to the input word,
   --!    though not a perfect match, is displayed with an informatory
   --!    message on standard output.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --! Changes:
   --!    04-APR-1985
   --!       Changed Kalman_Text to Kalman_String because of TeleSoft
   --!       file naming conflict with Kalman_Text_Io.
   --!
   --!----------------------------------------------------------------

   Index:  Natural renames Kalman_Text_Io.Index;
   Length: Natural renames Kalman_Text_Io.Length;

   pragma Page;
   -------------------------------------------------------------------

   Difference: constant Integer
               := Character'Pos ('a') - Character'Pos ('A');

   type Enumeration_Table is
      array (Enumeration'First .. Enumeration'Last) of Text_Type;

   Symbol: Enumeration_Table;

   pragma Page;
   -------------------------------------------------------------------

   function Correct

      (Word:   in String;
       Assume: in Boolean := False) return Enumeration is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Correct
      --!
      --! Purpose:
      --!    This local function returns an Enumeration value which
      --!    best matches the input Word.
      --!
      --! Parameters:
      --!    Word
      --!       is a string which is compared to values of type
      --!       Enumeration.
      --!
      --!    Assume
      --!       is a boolean which indicates whether a message
      --!       informing the user of the selected match is displayed.
      --!
      --! Exceptions:
      --!    Spelling_Error
      --!       is raised if the Word matches none or more than one
      --!       of the Enumeration values.
      --!
      --! Notes:
      --!    If more than one value "matches" the Word, the list of
      --!    potential matches is displayed before Spelling_Error is
      --!    raised. If none match, then all values of type
      --!    Enumeration are displayed.
      --!
      --!-------------------------------------------------------------

      Match_Count: Integer := 0;
      Last_Match: Enumeration;

      Found: Boolean;

      type Match_Array is
           array (Enumeration'First .. Enumeration'Last) of Boolean;

      Match: Match_Array;

      pragma Page;
      ----------------------------------------------------------------

      function Convert (Value: String) return String is

         --!----------------------------------------------------------
         --!
         --! Name:
         --!    Convert
         --!
         --! Purpose:
         --!    This local function returns the input string after
         --!    converting upper case to lower case.
         --!
         --! Parameters:
         --!    Value
         --!       is a string.
         --!
         --! Exceptions:
         --!    Not applicable.
         --!
         --! Notes:
         --!    Not applicable.
         --!
         --!----------------------------------------------------------

         Result: String (Value'range) := Value;

      begin
         if (Result'Length > 0) then

            if (Result (Result'First) = ''') then
               -- Don't convert characters.
               return (Result);
            end if;

            if (Result (Result'Last) = ''') then
               -- Don't convert characters.
               return (Result);
            end if;
         end if;

         for I in Result'range loop
            if (Result (I) in 'a'..'z') then
               Result (I) := Character'Val
                             (Character'Pos
                              (Result (I)) - Difference);
            end if;
         end loop;
         return (Result);
      end Convert;

      pragma Page;
      ----------------------------------------------------------------

      function Compare (A, B: String) return Boolean is

         --!----------------------------------------------------------
         --!
         --! Name:
         --!    Compare
         --!
         --! Purpose:
         --!    This local function returns a boolean value which
         --!    indicates whether the first character of the strings
         --!    are equal.
         --!
         --! Parameters:
         --!    A
         --!       is a string.
         --!
         --!    B
         --!       is a string.
         --!
         --! Exceptions:
         --!    Not applicable.
         --!
         --! Notes:
         --!    Letters in upper case and lower case are considered
         --!    equal.
         --!
         --!----------------------------------------------------------

         X1: Integer := A'First;
         Y1: Integer := B'First;

         X: String (X1..X1) := A (X1..X1);
         Y: String (Y1..Y1) := B (Y1..Y1);

      begin
         return (Convert (X) = Convert (Y));
      end Compare;

      pragma Page;
      ----------------------------------------------------------------

   begin

      for I in Enumeration'First .. Enumeration'Last loop

         if (Kalman_String.Length (Symbol (I)) = 0) then
            Match (I) := False;
         elsif (Word'Length = 1) then
            Match (I) := Compare (Word, Value (Symbol (I)));
         elsif (Word'Length = 2) then
            Match (I) := Compare (Word, Value (Symbol (I)));
         else
            Match (I) := Possibly_Correct (Word, Value (Symbol (I)));
         end if;

         if (Match (I)) then
            Match_Count := Match_Count + 1;
            Last_Match := I;
         end if;
      end loop;

      if (Match_Count = 1) then
         if (not Assume) then
            if (Convert (Word) /= Value (Symbol (Last_Match))) then
               New_Line;
               Put ("%SPELL-I-ASSUME, ");
               Put ("The value """);
               Put (Convert (Word));
               Put (""" is assumed to be """);
               Put (Value (Symbol (Last_Match)));
               Put (""".");
               New_Line;
               New_Line;
            end if;
         else
            null;
         end if;

         return Last_Match;

      elsif (Match_Count > 1) then

         New_Line;
         Put ("%SPELL-E-ANYONE, ");
         Put ("The value """);
         Put (Convert (Word));
         Put (""" could be any of the following:");
         New_Line;

         for I in Enumeration'First .. Last_Match loop
            if (Match (I)) then
               Put ("   ");
               Put (Value (Symbol (I)));
               New_Line;
            end if;
         end loop;

         raise Spelling_Error;
      else
         New_Line;
         Put ("%SPELL-E-UNKNOWN, ");
         Put ("The value """);
         Put (Convert (Word));
         Put (""" is not one of the following:");
         New_Line;

         for I in Enumeration'First .. Enumeration'Last loop
            Put ("   ");
            Put (Value (Symbol (I)));
            New_Line;
         end loop;

         raise Spelling_Error;
      end if;
   end Correct;

   pragma Page;
   -------------------------------------------------------------------

   procedure Get (File:   in  File_Type;
                  Item:   out Enumeration;
                  Prompt: in  String  := "";
                  Assume: in  Boolean := True) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get
      --!
      --! Purpose:
      --!    This procedure reads an Item of type Enumeration from
      --!    File after prompting.
      --!
      --! Parameters:
      --!    File
      --!       is the input file.
      --!
      --!    Item
      --!       is the selected Enumeration value.
      --!
      --!    Prompt
      --!       is the prompt string.
      --!
      --!    Assume
      --!       is a boolean which indicates whether a message
      --!       informing the user of the selected match is displayed.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The user if reprompted if a spelling error occurs.
      --!
      --!-------------------------------------------------------------

      Last: Natural;

   begin
      loop
         Get_Line (File, Prompt);

         if (Index > Length) then
            New_Line;
            Put ("%SPELL-E-LEGAL, ");
            Put ("A correct value is one of the following:");
            New_Line;

            for I in Enumeration'First .. Enumeration'Last loop
               Put ("   ");
               Put (Value (Symbol (I)));
               New_Line;
            end loop;

            New_Line;
            Put ("%SPELL-E-EMPTY, ");
            Put ("Please enter a value.");
            New_Line;
         else
            -- Skip preceding blanks.
            for I in Index .. Length loop

               if (Buffer (I) /= ' ') then
                  Index := I;
                  exit;
               end if;
            end loop;

            Last := Length;

            -- Find next blank.
            for I in Index + 1 .. Length loop

               if (Buffer (I) = ' ') then
                  Last := I - 1;
                  exit;
               end if;
            end loop;

            begin
               Item := Correct (Buffer (Index..Last), Assume);
               Index := Last + 1;
               exit;
            exception
               when Spelling_Error =>
                  New_Line;
                  Put ("%SPELL-E-RETRY, ");
                  Put ("Please re-enter the correct value.");
                  New_Line;

                  Index := Last + 1;
            end;
         end if;
      end loop;
   end Get;

   pragma Page;
   -------------------------------------------------------------------

   procedure Get (Item:   out Enumeration;
                  Prompt: in  String  := "";
                  Assume: in  Boolean := True) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Get
      --!
      --! Purpose:
      --!    This procedure reads an Item of type Enumeration from
      --!    Current_Input after prompting.
      --!
      --! Parameters:
      --!    Item
      --!       is the selected Enumeration value.
      --!
      --!    Prompt
      --!       is the prompt string.
      --!
      --!    Assume
      --!       is a boolean which indicates whether a message
      --!       informing the user of the selected match is displayed.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The user if reprompted if a spelling error occurs.
      --!
      --!-------------------------------------------------------------

   begin

      Get (Current_Input, Item, Prompt, Assume);

   end Get;

   pragma Page;
   -------------------------------------------------------------------

   procedure Put (File: in File_Type;
                  Item: in Enumeration) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Put
      --!
      --! Purpose:
      --!    This procedure writes the image of an Item of type
      --!    Enumeration to File.
      --!
      --! Parameters:
      --!    File
      --!       is the output file.
      --!
      --!   Item
      --!       is the Enumeration value.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Put (File, Enumeration'Image (Item));

   end Put;

   pragma Page;
   -------------------------------------------------------------------

   procedure Put (Item: in Enumeration) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Put
      --!
      --! Purpose:
      --!    This procedure writes the image of an Item of type
      --!    Enumeration to standard output.
      --!
      --! Parameters:
      --!   Item
      --!       is the Enumeration value.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      Put (Enumeration'Image (Item));

   end Put;

   pragma Page;
   -------------------------------------------------------------------

begin

   for I in Enumeration'First .. Enumeration'Last loop
      Set (Symbol (I), Enumeration'Image (I));
   end loop;

end Generic_Spelling_Io;
--::::::::::::::::::::::::::::
--KALMAN-DURATION-IO-SPEC.ADA
--::::::::::::::::::::::::::::

with Generic_Fixed_Io;

package Kalman_Duration_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Duration_Io
   --!
   --! Purpose:
   --!    This generic package instantiation provides a library unit
   --!    instantiation of the package Generic_Fixed_Io in order to
   --!    minimize the compilation overhead of the Ada Kalman Filter.
   --!
   --! Interfaces:
   --!    Same as package Generic_Fixed_Io.
   --!
   --! Exceptions:
   --!    Same as package Generic_Fixed_Io.
   --!
   --! Notes:
   --!    Not applicable.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Jeffrey G. Smith
   --!
   --!----------------------------------------------------------------

   new Generic_Fixed_Io (Duration);
--::::::::::::::::::::::::::::
--KALMAN-INTEGER-IO-SPEC.ADA
--::::::::::::::::::::::::::::

with Generic_Integer_Io;

package Kalman_Integer_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Integer_Io
   --!
   --! Purpose:
   --!    This generic package instantiation provides a library unit
   --!    instantiation of the package Generic_Integer_Io in order to
   --!    minimize the compilation overhead of the Ada Kalman Filter.
   --!
   --! Interfaces:
   --!    Same as package Generic_Integer_Io.
   --!
   --! Exceptions:
   --!    Same as package Generic_Integer_Io.
   --!
   --! Notes:
   --!    Not applicable.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Jeffrey G. Smith
   --!
   --!----------------------------------------------------------------

   new Generic_Integer_Io (Integer);
with Generic_Float_Io;

package Kalman_Float_Io is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Float_Io
   --!
   --! Purpose:
   --!    This generic package instantiation provides a library unit
   --!    instantiation of the package Generic_Float_Io in order to
   --!    minimize the compilation overhead of the Ada Kalman Filter.
   --!
   --! Interfaces:
   --!    Same as package Generic_Float_Io.
   --!
   --! Exceptions:
   --!    Same as package Generic_Float_Io.
   --!
   --! Notes:
   --!    Not applicable.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Jeffrey G. Smith
   --!
   --!----------------------------------------------------------------

   new Generic_Float_Io (Float);
--::::::::::::::::::::::::::::
--KALMAN-TRIG-LIB-SPEC.ADA
--::::::::::::::::::::::::::::

package Kalman_Trig_Lib is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Trig_Lib
   --!
   --! Purpose:
   --!    This package provides a common interface to several
   --!    different mathematics libraries for the Ada Kalman Filter.
   --!
   --! Interfaces:
   --!    Sqrt
   --!       returns the square root of the input value.
   --!
   --!    Cbrt
   --!       returns the cube root of the input value.
   --!
   --!    Log
   --!       returns the natural logarithm of the input value.
   --!
   --!    Log10
   --!       returns the base 10 logarithm of the input value.
   --!
   --!    Log2
   --!       returns the base 2 logarithm of the input value.
   --!
   --!    Exp
   --!       returns "e" raised to the power of the input value.
   --!
   --!    "**"
   --!       returns the value raised to the specified power.
   --!
   --!    Sin
   --!       returns the sine of the input angle.
   --!
   --!    Cos
   --!       returns the cosine of the input angle.
   --!
   --!    Tan
   --!       returns the tangent of the input angle.
   --!
   --!    Cot
   --!       returns the cotangent of the input angle.
   --!
   --!    Asin
   --!       returns the arcsine expressed in radians
   --!       of the input value.
   --!
   --!    Acos
   --!       returns the arccosine expressed in radians
   --!       of the input value.
   --!
   --!    Atan
   --!       returns the arctangent expressed in radians
   --!       of the input value.
   --!
   --!    Atan2
   --!       returns the arctangent expressed in radians
   --!       of the input values.
   --!
   --!    Sinh
   --!       returns the hyperbolic sine of the input angle.
   --!
   --!    Cosh
   --!       returns the hyperbolic cosine of the input angle.
   --!
   --!    Tanh
   --!       returns the hyperbolic tangent of the input angle.
   --!
   --!    Sind
   --!       returns the sine of the angle expressed in degrees.
   --!
   --!    Cosd
   --!       returns the cosine of the angle expressed in degrees.
   --!
   --!    Tand
   --!       returns the tangent of the angle expressed in degrees.
   --!
   --!    Asind
   --!       returns the arcsine in degrees of the value.
   --!
   --!    Acosd
   --!       returns the arccosine in degrees of the value.
   --!
   --!    Atand
   --!       returns the arctangent in degrees of the value.
   --!
   --!    Atan2d
   --!       returns the arctangent in degrees of the values.
   --!
   --! Exceptions:
   --!    Math_Error
   --!       is raised if the requested operation cannot be performed.
   --!
   --! Notes:
   --!    Not all operations are available from every math library.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --! Changes:
   --!    04-APR-1985
   --!       Changed Kalman_Math_Lib to Kalman_Trig_Lib because of
   --!       TeleSoft file naming conflict with Kalman_Matrix.
   --!
   --!----------------------------------------------------------------

   -- Vendor name (of real Math library).

   type Vendor_Type is (Digital, Telesoft, Whitaker, Stub);
   Vendor: Vendor_Type := Whitaker;

   procedure Request_Vendor;

   -------------------------------------------------------------------

   function Sqrt  (A : Float) return Float;
   function Cbrt  (A : Float) return Float;
   function Log   (A : Float) return Float;
   function Log10 (A : Float) return Float;
   function Log2  (A : Float) return Float;
   function Exp   (A : Float) return Float;

   function "**"  (X, Y : Float) return Float;

   -------------------------------------------------------------------

   -- Sine, cosine, and tangent of an angle given in radians.

   function Sin (A : Float) return Float;
   function Cos (A : Float) return Float;
   function Tan (A : Float) return Float;
   function Cot (A : Float) return Float;

   -------------------------------------------------------------------

   -- Arc sine, arc cosine, and arc tangent - return an angle
   -- expressed in radians.

   function Asin (A : Float) return Float;
   function Acos (A : Float) return Float;
   function Atan (A : Float) return Float;

   -------------------------------------------------------------------

   -- Arc tangent with two parameters - Arc Tan (A1/A2) - returns
   -- an angle expressed in radians.

   function Atan2 (A1, A2 : Float) return Float;

   -------------------------------------------------------------------

   -- Hyperbolic sine, cosine, and tangent of an angle in radians.

   function Sinh (A : Float) return Float;
   function Cosh (A : Float) return Float;
   function Tanh (A : Float) return Float;

   -------------------------------------------------------------------

   -- Trigonometric functions for angles expressed in degrees.

   function Sind (A : Float) return Float;
   function Cosd (A : Float) return Float;
   function Tand (A : Float) return Float;

   function Asind (A : Float) return Float;
   function Acosd (A : Float) return Float;
   function Atand (A : Float) return Float;

   function Atan2D (A1, A2 : Float) return Float;

   -------------------------------------------------------------------

   Math_Error: exception;

   -- pragma Inline (Sqrt, Log, Log10, Log2, Exp, Sin, Cos, Tan, Cot,
   --                Asin, Acos, Atan, Atan2, Sinh, Cosh, Tanh,
   --                Sind, Cosd, Tand, Asind, Acosd, Atand, Atan2D);

end Kalman_Trig_Lib;
--::::::::::::::::::::::::::::
--KALMAN-TRIG-LIB-BODY.ADA
--::::::::::::::::::::::::::::

with Generic_Spelling_Io;

with Float_Math_Lib;      -- Digital
with Realfunc;            -- TeleSoft
with Core_Functions;      -- Whitaker
with Trig_Functions;      -- Whitaker

with Text_Io;
with Kalman_Options;

use Text_Io;
use Kalman_Options;

package body Kalman_Trig_Lib is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Trig_Lib
   --!
   --! Purpose:
   --!    This package body provides a common interface to several
   --!    different mathematics libraries for the Ada Kalman Filter.
   --!
   --! Exceptions:
   --!    Math_Error
   --!       is raised if the requested operation cannot be performed.
   --!
   --! Notes:
   --!    Not all operations are available from every library.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Daryl R. Winters
   --!
   --! Changes:
   --!    04-APR-1985
   --!       Changed Kalman_Math_Lib to Kalman_Trig_Lib because of
   --!       TeleSoft file naming conflict with Kalman_Matrix.
   --!
   --!----------------------------------------------------------------

   package Vendor_Io is
      new Generic_Spelling_Io (Vendor_Type);
   use Vendor_Io;

   pragma Page;
   -------------------------------------------------------------------

   procedure Request_Vendor is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Request_Vendor
      --!
      --! Purpose:
      --!    This procedure sets the vendor name from user input.
      --!
      --! Parameters:
      --!    Not applicable.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    This routine should be called once to initialize
      --!    the choice of mathematics library.
      --!
      --!-------------------------------------------------------------

   begin

      Get (Vendor, Prompt => "%TRIG-P-MTHLIB, " &
                       "Math library? ");

   end Request_Vendor;

   pragma Page;
   -------------------------------------------------------------------

   function Sqrt (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Sqrt
      --!
      --! Purpose:
      --!    This function returns the square root of the input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Sqrt (A);
         when Telesoft =>
            return Realfunc.Sqrt (A);
         when Whitaker =>
            return Core_Functions.Sqrt (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Sqrt;

   pragma Page;
   -------------------------------------------------------------------

   function Cbrt (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Cbrt
      --!
      --! Purpose:
      --!    This function returns the cube root of the input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            raise Math_Error;
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            return Core_Functions.Cbrt (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Cbrt;

   pragma Page;
   -------------------------------------------------------------------

   function Log (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Log
      --!
      --! Purpose:
      --!    This function returns the natural logarithm of the
      --!    input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Log (A);
         when Telesoft =>
            return Realfunc.Ln (A);
         when Whitaker =>
            return Core_Functions.Log (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Log;

   pragma Page;
   -------------------------------------------------------------------

   function Log10 (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Log10
      --!
      --! Purpose:
      --!    This function returns the base 10 logarithm of the
      --!    input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Log10 (A);
         when Telesoft =>
            return Realfunc.Log (A);
         when Whitaker =>
            return Core_Functions.Log10 (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Log10;

   pragma Page;
   -------------------------------------------------------------------

   function Log2 (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Log2
      --!
      --! Purpose:
      --!    This function returns the base 2 logarithm of the
      --!    input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Log2 (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            raise Math_Error;
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Log2;

   pragma Page;
   -------------------------------------------------------------------

   function Exp (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Exp
      --!
      --! Purpose:
      --!    This function returns "e" raised to the power of the
      --!    input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Exp (A);
         when Telesoft =>
            return Realfunc.Exp (A);
         when Whitaker =>
            return Core_Functions.Exp (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Exp;

   pragma Page;
   -------------------------------------------------------------------

   function "**" (X, Y : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    "**"
      --!
      --! Purpose:
      --!    This function returns the value X raised to the
      --!    power Y.
      --!
      --! Parameters:
      --!    X
      --!       is the base value.
      --!    Y
      --!       is the power.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            raise Math_Error;
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            return Core_Functions."**" (X, Y);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end "**";

   pragma Page;
   -------------------------------------------------------------------

   function Sin (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Sin
      --!
      --! Purpose:
      --!    This function returns the sine of the input angle.
      --!
      --! Parameters:
      --!    A
      --!       is the angle expressed in radians.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Sin (A);
         when Telesoft =>
            return Realfunc.Sin (A);
         when Whitaker =>
            return Trig_Functions.Sin (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Sin;

   pragma Page;
   -------------------------------------------------------------------

   function Cos (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Cos
      --!
      --! Purpose:
      --!    This function returns the cosine of the input angle.
      --!
      --! Parameters:
      --!    A
      --!       is the angle expressed in radians.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Cos (A);
         when Telesoft =>
            return Realfunc.Cos (A);
         when Whitaker =>
            return Trig_Functions.Cos (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Cos;

   pragma Page;
   -------------------------------------------------------------------

   function Tan (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Tan
      --!
      --! Purpose:
      --!    This function returns the tangent of the input angle.
      --!
      --! Parameters:
      --!    A
      --!       is the angle expressed in radians.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Tan (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            return Trig_Functions.Tan (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Tan;

   pragma Page;
   -------------------------------------------------------------------

   function Cot (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Cot
      --!
      --! Purpose:
      --!    This function returns the cotangent of the input angle.
      --!
      --! Parameters:
      --!    A
      --!       is the angle expressed in radians.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            raise Math_Error;
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            return Trig_Functions.Cot (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Cot;

   pragma Page;
   -------------------------------------------------------------------

   function Asin (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Asin
      --!
      --! Purpose:
      --!    This function returns the arcsine of the input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Asin (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            return Trig_Functions.Asin (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Asin;

   pragma Page;
   -------------------------------------------------------------------

   function Acos (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Acos
      --!
      --! Purpose:
      --!    This function returns the arccosine of the input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Acos (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            return Trig_Functions.Acos (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Acos;

   pragma Page;
   -------------------------------------------------------------------

   function Atan (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Atan
      --!
      --! Purpose:
      --!    This function returns the arctangent of the input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Atan (A);
         when Telesoft =>
            return Realfunc.Arctan (A);
         when Whitaker =>
            return Trig_Functions.Atan (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Atan;

   pragma Page;
   -------------------------------------------------------------------

   function Atan2 (A1, A2 : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Atan2
      --!
      --! Purpose:
      --!    This function returns the arctangent of the input values.
      --!
      --! Parameters:
      --!    A1
      --!       is a float value.
      --!    A2
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Atan2 (A1, A2);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            return Trig_Functions.Atan2 (A1, A2);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Atan2;

   pragma Page;
   -------------------------------------------------------------------

   function Sinh (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Sinh
      --!
      --! Purpose:
      --!    This function returns the hyperbolic sine of the
      --!    input angle.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Sinh (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            return Trig_Functions.Sinh (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Sinh;

   pragma Page;
   -------------------------------------------------------------------

   function Cosh (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Cosh
      --!
      --! Purpose:
      --!    This function returns the hyperbolic cosine of the
      --!    input angle.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Cosh (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            return Trig_Functions.Cosh (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Cosh;

   pragma Page;
   -------------------------------------------------------------------

   function Tanh (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Tanh
      --!
      --! Purpose:
      --!    This function returns the hyperbolic tangent of the
      --!    input angle.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Tanh (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            return Trig_Functions.Tanh (A);
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Tanh;

   pragma Page;
   -------------------------------------------------------------------

   function Sind (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Sind
      --!
      --! Purpose:
      --!    This function returns the sine of the input angle
      --!    which is expressed in degrees.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Sind (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            raise Math_Error;
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Sind;

   pragma Page;
   -------------------------------------------------------------------

   function Cosd (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Cosd
      --!
      --! Purpose:
      --!    This function returns the cosine of the input angle
      --!    which is expressed in degrees.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Cosd (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            raise Math_Error;
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Cosd;

   pragma Page;
   -------------------------------------------------------------------

   function Tand (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Tand
      --!
      --! Purpose:
      --!    This function returns the tangent of the input angle
      --!    which is expressed in degrees.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Tand (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            raise Math_Error;
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Tand;

   pragma Page;
   -------------------------------------------------------------------

   function Asind (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Asind
      --!
      --! Purpose:
      --!    This function returns an angle expressed in degrees
      --!    which is the arcsine of the input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Asind (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            raise Math_Error;
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Asind;

   pragma Page;
   -------------------------------------------------------------------

   function Acosd (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Acosd
      --!
      --! Purpose:
      --!    This function returns an angle expressed in degrees
      --!    which is the arccosine of the input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Acosd (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            raise Math_Error;
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Acosd;

   pragma Page;
   -------------------------------------------------------------------

   function Atand (A : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Atand
      --!
      --! Purpose:
      --!    This function returns an angle expressed in degrees
      --!    which is the arctangent of the input value.
      --!
      --! Parameters:
      --!    A
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Atand (A);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            raise Math_Error;
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Atand;

   pragma Page;
   -------------------------------------------------------------------

   function Atan2D (A1, A2 : Float) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Atan2D
      --!
      --! Purpose:
      --!    This function returns an angle expressed in degrees
      --!    which is the arctangent of the input values.
      --!
      --! Parameters:
      --!    A1
      --!       is a float value.
      --!    A2
      --!       is a float value.
      --!
      --! Exceptions:
      --!    Math_Error
      --!       is raised if any exception occurs.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      case Vendor is
         when Digital =>
            return Float_Math_Lib.Atan2D (A1, A2);
         when Telesoft =>
            raise Math_Error;
         when Whitaker =>
            raise Math_Error;
         when others =>
            return 1.0;
      end case;

   exception
      when others =>
         raise Math_Error;
   end Atan2D;

   pragma Page;
   -------------------------------------------------------------------

begin

   if (Prompt_For_Math_Library) then
      Request_Vendor;
   end if;

end Kalman_Trig_Lib;
--::::::::::::::::::::::::::::
--KALMAN-UTILITIES-BODY.ADA
--::::::::::::::::::::::::::::

with Kalman_Trig_Lib;
with Kalman_Matrix_Lib;

use Kalman_Trig_Lib;
use Kalman_Matrix_Lib;

package body Kalman_Utilities is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Utilities
   --!
   --! Purpose:
   --!    This package body provides a set of utilities necessary for
   --!    and specific to the Ada Kalman Filter.
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Jeffrey G. Smith
   --!
   --! Changes:
   --!    04-APR-1985
   --!       Changed Kalman_Math_Lib to Kalman_Trig_Lib because of
   --!       TeleSoft file naming conflict with Kalman_Matrix.
   --!
   --!----------------------------------------------------------------

   pragma Page;
   -------------------------------------------------------------------

   function Convert (From : Polar_Position)
      return Cartesian_Position is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Convert
      --!
      --! Purpose:
      --!    This function converts a position expressed in Polar
      --!    coordinates (R, Theta, and Height) to a position
      --!    expressed in Cartesian coordinates (X, Y, and Z).
      --!
      --! Parameters:
      --!    From
      --!       is the Polar position (R, Theta, and Height).
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The range is assumed to be the range along the ground
      --!    and not the slant range.
      --!
      --!-------------------------------------------------------------

   begin

      return (X => From.R * Cos (From.Theta),
              Y => From.R * Sin (From.Theta),
              Z => From.Height);

   end Convert;

   pragma Page;
   -------------------------------------------------------------------

   function Distance
      (From : in Cartesian_Position;
       To   : in Cartesian_Position) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Distance
      --!
      --! Purpose:
      --!    This function computes the distance between two points
      --!    expressed in Cartesian coordinates.
      --!
      --! Parameters:
      --!    From
      --!       is a point expressed in Cartesian coordinates
      --!    To
      --!       is a point expressed in Cartesian coordinates
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The units of the points are assumed to be nautical miles
      --!    for X and Y components and feet for the Z component.
      --!    Therefore, the Z value must be divided by the number of
      --!    feet per nautical mile before the distance (expressed in
      --!    nautical miles) can be computed.
      --!
      --!-------------------------------------------------------------

      Diff_In_X_Squared,
      Diff_In_Y_Squared,
      Diff_In_Z_Squared : Float;

   begin

      Diff_In_X_Squared := (From.X - To.X) ** 2;
      Diff_In_Y_Squared := (From.Y - To.Y) ** 2;
      Diff_In_Z_Squared := ((From.Z - To.Z) / Feet_Per_Nautical_Mile)
                            ** 2;

      return Sqrt (Diff_In_X_Squared +
                   Diff_In_Y_Squared +
                   Diff_In_Z_Squared);

   end Distance;

   pragma Page;
   -------------------------------------------------------------------

   function Distance
      (From : in Polar_Position;
       To   : in Polar_Position) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Distance
      --!
      --! Purpose:
      --!    This function computes the distance between two points
      --!    expressed in Polar coordinates.
      --!
      --! Parameters:
      --!    From
      --!       is a point expressed in Polar coordinates
      --!    To
      --!       is a point expressed in Polar coordinates
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The units of the points are assumed to be nautical miles
      --!    for R, radians for Theta, and feet for Height. Both
      --!    points are converted to Cartesian coordinates and the
      --!    distance between them is computed by the function for
      --!    use with Cartesian coordinates.
      --!
      --!-------------------------------------------------------------

   begin

      return Distance (Convert (From), Convert (To));

   end Distance;

   pragma Page;
   -------------------------------------------------------------------

   function Distance
      (From : in Polar_Position;
       To   : in Cartesian_Position) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Distance
      --!
      --! Purpose:
      --!    This function computes the distance between two points
      --!    the first expressed in Polar coordinates, the latter
      --!    expressed in Cartesian coordinates.
      --!
      --! Parameters:
      --!    From
      --!       is a point expressed in Polar coordinates
      --!    To
      --!       is a point expressed in Cartesian coordinates
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The units of the first point are assumed to be nautical
      --!    miles for R, radians for Theta, and feet for Height.
      --!    The units of the second point are assumed to be nautical
      --!    miles for X and Y components and feet for the Z
      --!    component. The first point is converted to Cartesian
      --!    coordinates and the distance is then computed by
      --!    function for use with Cartesian coordinates.
      --!
      --!-------------------------------------------------------------

   begin

      return Distance (Convert (From), To);

   end Distance;

   pragma Page;
   -------------------------------------------------------------------

   function Distance
      (From : in Cartesian_Position;
       To   : in Polar_Position) return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Distance
      --!
      --! Purpose:
      --!    This function computes the distance between two points
      --!    the first expressed in Cartesian coordinates, the latter
      --!    expressed in Polar coordinates.
      --!
      --! Parameters:
      --!    From
      --!       is a point expressed in Cartesian coordinates
      --!    To
      --!       is a point expressed in Polar coordinates
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The units of the second point are assumed to be nautical
      --!    miles for R, radians for Theta, and feet for Height.
      --!    The units of the first point are assumed to be nautical
      --!    miles for X and Y components and feet for the Z
      --!    component. The second point is converted to Cartesian
      --!    coordinates and the distance is then computed by
      --!    function for use with Cartesian coordinates.
      --!
      --!-------------------------------------------------------------

   begin

      return Distance (From, Convert (To));

   end Distance;

   pragma Page;
   -------------------------------------------------------------------

   function Is_Active (Track : in Single_Track) return Boolean is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Is_Active
      --!
      --! Purpose:
      --!    This function determines whether the track stored in
      --!    the specified track record is active or not.
      --!
      --! Parameters:
      --!    Track
      --!       is a track record
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      if Track.State = Active then
         return True;
      else
         return False;
      end if;

   end Is_Active;

   pragma Page;
   -------------------------------------------------------------------

   function Make_Phi
      (Delta_Time  : in Duration)
      return State_Transition_Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Make_Phi
      --!
      --! Purpose:
      --!    This function determines a state transition matrix from
      --!    the time between two observations of a single track.
      --!
      --! Parameters:
      --!    Delta_Time
      --!       is the time between observations.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Velocity is assumed to be constant over the
      --!    period between observations. The state vectors
      --!    are assumed to have nine components, three of position,
      --!    three of velocity, and three of acceleration.
      --!
      --!-------------------------------------------------------------

      Phi                   : State_Transition_Matrix;
      Delta_T               : Float := Float(Delta_Time);
      Delta_T_Squared_Div_2 : Float := (Delta_T * Delta_T) / 2.0;

   begin

      Phi := Identity (Phi);

      -- Using the fact that PHI is a square matrix

      for Index in State_Transition_Matrix'range loop

         if (Integer(Index) rem 3) = 1 then

            Phi (Index, Index + 1) := Delta_T;

         end if;
      end loop;

      return Phi;

   end Make_Phi;

   pragma Page;
   -------------------------------------------------------------------

   function Make_Psi
      (Location : in Polar_Location)
      return Position_Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Make_Psi
      --!
      --! Purpose:
      --!    This function returns the position components of
      --!    location where location is defined to be position,
      --!    velocity, and acceleration.
      --!
      --! Parameters:
      --!    Location
      --!       is the location of the track in Polar coordinates.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      return Vector'(Location.Position.R * Feet_Per_Nautical_Mile,
                     Location.Position.Theta,
                     Location.Position.Height);

   end Make_Psi;

   pragma Page;
   -------------------------------------------------------------------

   function Make_Psi
      (Location : in Cartesian_Location)
      return Position_Vector is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Make_Psi
      --!
      --! Purpose:
      --!    This function returns the position components of
      --!    location where location is defined to be position,
      --!    velocity, and acceleration.
      --!
      --! Parameters:
      --!    Location
      --!       is the location of the track in Cartesian coordinates.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      return Vector'(Location.Position.X * Feet_Per_Nautical_Mile,
                     Location.Position.Y * Feet_Per_Nautical_Mile,
                     Location.Position.Z);

   end Make_Psi;

   pragma Page;
   -------------------------------------------------------------------

   function Make_Polar_Error_Covariance
      (Delta_Time : in Duration)
      return Covariance_Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Make_Polar_Error_Covariance
      --!
      --! Purpose:
      --!    This function determines the initial error covariance
      --!    matrix from the measurement covariance matrix and the
      --!    time between observations.
      --!
      --! Parameters:
      --!    Delta_Time
      --!       is the time between observations.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The measurement covariance matrix is defined in
      --!    package Kalman_Definitions. The formula for
      --!    initial error covariance is taken from
      --!
      --!      Singer, "Estimating Optimal Tracking Filter Performance
      --!      for Manned Maneuvering Targets," IEEE Transactions
      --!      on Aerospace and Electronic Systems, Vol AES-6, No. 4,
      --!      July 1970, pages 473-483.
      --!
      --!-------------------------------------------------------------

      Error_Covariance : Covariance_Matrix;
      R11 : Float renames Polar_Measurement_Covariance (1,1);
      R22 : Float renames Polar_Measurement_Covariance (2,2);
      R33 : Float renames Polar_Measurement_Covariance (3,3);

   begin

      Error_Covariance := Zero (Error_Covariance);

      Error_Covariance (1,1) := R11;
      Error_Covariance (1,2) := R11 / Float (Delta_Time);
      Error_Covariance (2,1) := Error_Covariance (1,2);
      Error_Covariance (2,2) := 2.0 * R11 / (Float (Delta_Time) ** 2);

      Error_Covariance (4,4) := R22;
      Error_Covariance (4,5) := R22 / Float (Delta_Time);
      Error_Covariance (5,4) := Error_Covariance (4,5);
      Error_Covariance (5,5) := 2.0 * R22 / (Float (Delta_Time) ** 2);

      Error_Covariance (7,7) := R33;
      Error_Covariance (7,8) := R33 / Float (Delta_Time);
      Error_Covariance (8,7) := Error_Covariance (7,8);
      Error_Covariance (8,8) := 2.0 * R33 / (Float (Delta_Time) ** 2);

      return Error_Covariance;

   end Make_Polar_Error_Covariance;

   pragma Page;
   -------------------------------------------------------------------

   function Make_Xyz_Error_Covariance
      (Delta_Time : in Duration)
      return Covariance_Matrix is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Make_XYZ_Error_Covariance
      --!
      --! Purpose:
      --!    This function determines the initial error covariance
      --!    matrix from the measurement covariance matrix and the
      --!    time between observations.
      --!
      --! Parameters:
      --!    Delta_Time
      --!       is the time between observations.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The measurement covariance matrix is defined in
      --!    package Kalman_Definitions. The formula for
      --!    initial error covariance is taken from
      --!
      --!      Singer, "Estimating Optimal Tracking Filter Performance
      --!      for Manned Maneuvering Targets," IEEE Transactions
      --!      on Aerospace and Electronic Systems, Vol AES-6, No. 4,
      --!      July 1970, pages 473-483.
      --!
      --!-------------------------------------------------------------

      Error_Covariance : Covariance_Matrix;
      R11 : Float renames Cartesian_Measurement_Covariance (1,1);
      R22 : Float renames Cartesian_Measurement_Covariance (2,2);
      R33 : Float renames Cartesian_Measurement_Covariance (3,3);

   begin

      Error_Covariance := Zero (Error_Covariance);

      Error_Covariance (1,1) := R11;
      Error_Covariance (1,2) := R11 / Float (Delta_Time);
      Error_Covariance (2,1) := Error_Covariance (1,2);
      Error_Covariance (2,2) := 2.0 * R11 / (Float (Delta_Time) ** 2);

      Error_Covariance (4,4) := R22;
      Error_Covariance (4,5) := R22 / Float (Delta_Time);
      Error_Covariance (5,4) := Error_Covariance (4,5);
      Error_Covariance (5,5) := 2.0 * R22 / (Float (Delta_Time) ** 2);

      Error_Covariance (7,7) := R33;
      Error_Covariance (7,8) := R33 / Float (Delta_Time);
      Error_Covariance (8,7) := Error_Covariance (7,8);
      Error_Covariance (8,8) := 2.0 * R33 / (Float (Delta_Time) ** 2);

      return Error_Covariance;

   end Make_Xyz_Error_Covariance;

end Kalman_Utilities;
--::::::::::::::::::::::::::::
--KALMAN-FUNCTIONS-SPEC.ADA
--::::::::::::::::::::::::::::

with Calendar;
with Kalman_Definitions;

use Calendar;
use Kalman_Definitions;

package Kalman_Functions is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!   Kalman_Functions
   --!
   --! Purpose:
   --!   This package implements the basic Kalman Filter functions
   --!   of Initiate, Update, and Filter.
   --!
   --! Interfaces:
   --!    Initiate
   --!       initializes the Smoothed location from the
   --!       observed Location.
   --!
   --!    Update
   --!       initializes the Smoothed location, Error_Covariance,
   --!       and Maneuver_Detector constant from the previous
   --!       Smoothed location and the observed Location.
   --!
   --!    Filter
   --!       determines the best estimate of the current position
   --!       of the track based on the observed Location and
   --!       the previous Smoothed position and Error_Covariance.
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!    The Kalman Filter functions should be called in the
   --!    following order for any given track:
   --!       Initiate, Update, Filter, Filter, ...
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Jeffrey G. Smith
   --!
   --!----------------------------------------------------------------

   procedure Initiate
      (Location           : in     Cartesian_Location;
       Observed_Time      : in     Time;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time :    out Time;
       Predicted          :    out Location_Vector);

   procedure Initiate
      (Location           : in     Polar_Location;
       Observed_Time      : in     Time;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time :    out Time;
       Predicted          :    out Location_Vector);

   -------------------------------------------------------------------

   procedure Update
      (Location           : in     Cartesian_Location;
       Observed_Time      : in     Time;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Detector  : in out Float);

   procedure Update
      (Location           : in     Polar_Location;
       Observed_Time      : in     Time;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Detector  : in out Float);

   -------------------------------------------------------------------

   procedure Filter
      (Location           : in     Cartesian_Location;
       Observed_Time      : in     Time;
       Maneuver_Detector  : in     Float;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Indicator : in out Float);

   procedure Filter
      (Location           : in     Polar_Location;
       Observed_Time      : in     Time;
       Maneuver_Detector  : in     Float;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Indicator : in out Float);

   -------------------------------------------------------------------

   procedure Filter
      (Location           : in     Cartesian_Location;
       Observed_Time      : in     Time;
       Maneuver_Detector  : in     Float;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Indicator : in out Float;
       Cpu_Time           :    out Duration;
       Real_Time          :    out Duration);

   procedure Filter
      (Location           : in     Polar_Location;
       Observed_Time      : in     Time;
       Maneuver_Detector  : in     Float;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Indicator : in out Float;
       Cpu_Time           :    out Duration;
       Real_Time          :    out Duration);

end Kalman_Functions;
--::::::::::::::::::::::::::::
--KALMAN-FUNCTIONS-BODY.ADA
--::::::::::::::::::::::::::::

with Kalman_Options;
with Kalman_Definitions;
with Kalman_Status;
with Kalman_Threshold;
with Kalman_Matrix_Lib;
with Kalman_Utilities;
with Kalman_Time;

use Kalman_Options;
use Kalman_Definitions;
use Kalman_Status;
use Kalman_Threshold;
use Kalman_Matrix_Lib;
use Kalman_Utilities;
use Kalman_Time;

package body Kalman_Functions is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Functions
   --!
   --! Purpose:
   --!    This package body implements the basic Kalman Filter
   --!    functions of Initiate, Update, and Filter.
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!    The Kalman Filter functions should be called in the
   --!    following order for any given track:
   --!       Initiate, Update, Filter, Filter, ...
   --!
   --!    The Kalman Filter functions are overloaded to accept
   --!    input in either Polar or Cartesian coordinates. The
   --!    Filter function is further overloaded to provide performance
   --!    information.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Jeffrey G. Smith
   --!
   --! Changes:
   --!    04-APR-1985
   --!       Changed Kalman_Trace to Kalman_Threshold because of
   --!       TeleSoft file naming conflict with Kalman_Track.
   --!
   --!    23-APR-1985
   --!       Scale white noise matrix Q for Theta by R ** 2
   --!
   --!    24-APR-1985
   --!       Add "Execute_Debug_Code" flag around status call
   --!       in fix of 23-APR-1985.
   --!
   --!    29-APR-1985
   --!       Changed debug threshold on Status call in package
   --!       initialization to "Nothing".
   --!
   --!----------------------------------------------------------------

   Pid : Package_Id;

   procedure Initiate
      (Location           : in     Cartesian_Location;
       Observed_Time      : in     Time;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time :    out Time;
       Predicted          :    out Location_Vector) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Initiate
      --!
      --! Purpose:
      --!    This procedure initializes the Smoothed location from
      --!    the observed Location.
      --!
      --! Parameters:
      --!    Location
      --!       is the observed Location expressed in Cartesian
      --!       coordinates (X in nautical miles, Y in nautical miles,
      --!       Z in feet).
      --!    Observed_Time
      --!       is the time at which the hit was recorded.
      --!    Smoothed
      --!       is the initial position of the track in Cartesian
      --!       coordinates (X, Y, Z in feet, velocity in feet per
      --!       second, acceleration in feet per second squared).
      --!    Last_Observed_Time
      --!       is the time at which the hit was recorded.
      --!    Predicted
      --!       is the initial position of the track in Cartesian
      --!       coordinates (X, Y, Z in feet, velocity in feet per
      --!       second, acceleration in feet per second squared).
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The Smoothed location is simply the observed Location
      --!    with nautical miles converted to feet. The Predicted
      --!    location is the same as the Smoothed location. The
      --!    Last_Observed_Time is the same as the Observed_Time.
      --!    The Initiate procedure should be called when a
      --!    correlation algorithm has determined that the observed
      --!    Location does not correspond to any existing track.
      --!
      --!-------------------------------------------------------------

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Functions.Initiate (Cartesian)");
      end if;

      Smoothed := Vector' (Location.Position.X *
                           Feet_Per_Nautical_Mile,
                           Location.Velocity.X *
                           Feet_Per_Nautical_Mile /
                           Seconds_Per_Hour,
                           Location.Acceleration.X *
                           Feet_Per_Nautical_Mile /
                           (Seconds_Per_Hour ** 2),

                           Location.Position.Y *
                           Feet_Per_Nautical_Mile,
                           Location.Velocity.Y *
                           Feet_Per_Nautical_Mile /
                           Seconds_Per_Hour,
                           Location.Acceleration.Y *
                           Feet_Per_Nautical_Mile /
                           (Seconds_Per_Hour ** 2),

                           Location.Position.Z,
                           Location.Velocity.Z,
                           Location.Acceleration.Z);

      Last_Observed_Time := Observed_Time;

      Predicted := Smoothed;

      if (Execute_Debug_Code) then
         Status (Pid, Parameters,
                 "At exit, Smoothed Location ",
                 Smoothed);
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Functions.Initiate (Cartesian)");
      end if;

   end Initiate;

   pragma Page;
   -------------------------------------------------------------------

   procedure Initiate
      (Location           : in     Polar_Location;
       Observed_Time      : in     Time;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time :    out Time;
       Predicted          :    out Location_Vector) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Initiate
      --!
      --! Purpose:
      --!    This procedure initializes the Smoothed location from
      --!    the observed Location.
      --!
      --! Parameters:
      --!    Location
      --!       is the observed Location expressed in Polar
      --!       coordinates (R in nautical miles, Theta in radians,
      --!       Height in feet).
      --!    Observed_Time
      --!       is the time at which the hit was recorded.
      --!    Smoothed
      --!       is the initial position of the track in Polar
      --!       coordinates (R, Height in feet, velocity in feet per
      --!       second, acceleration in feet per second squared,
      --!       Theta in radians, velocity in radians per second,
      --!       acceleration in radians per second squared).
      --!    Last_Observed_Time
      --!       is the time at which the hit was recorded.
      --!    Predicted
      --!       is the initial position of the track in Polar
      --!       coordinates (R, Height in feet, velocity in feet per
      --!       second, acceleration in feet per second squared,
      --!       Theta in radians, velocity in radians per second,
      --!       acceleration in radians per second squared).
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The Smoothed location is simply the observed Location
      --!    with nautical miles converted to feet. The Predicted
      --!    location is the same as the Smoothed location. The
      --!    Last_Observed_Time is the same as the Observed_Time.
      --!    The Initiate procedure should be called when a
      --!    correlation algorithm has determined that the observed
      --!    Location does not correspond to any existing track.
      --!
      --!-------------------------------------------------------------

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Functions.Initiate (Polar)");
      end if;

      Smoothed := Vector' (Location.Position.R *
                           Feet_Per_Nautical_Mile,
                           Location.Velocity.R *
                           Feet_Per_Nautical_Mile /
                           Seconds_Per_Hour,
                           Location.Acceleration.R *
                           Feet_Per_Nautical_Mile /
                           (Seconds_Per_Hour ** 2),

                           Location.Position.Theta,
                           Location.Velocity.Theta,
                           Location.Acceleration.Theta,

                           Location.Position.Height,
                           Location.Velocity.Height,
                           Location.Acceleration.Height);

      Last_Observed_Time := Observed_Time;

      Predicted := Smoothed;

      if (Execute_Debug_Code) then
         Status (Pid, Parameters,
                 "At exit, Smoothed Location ",
                 Smoothed);
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Functions.Initiate (Polar)");
      end if;

   end Initiate;

   pragma Page;
   -------------------------------------------------------------------

   procedure Update
      (Location           : in     Cartesian_Location;
       Observed_Time      : in     Time;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Detector  : in out Float) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Update
      --!
      --! Purpose:
      --!    This procedure initializes the Smoothed location,
      --!    Error_Covariance, and Maneuver_Detector from the
      --!    previous Smoothed location and the observed Location.
      --!
      --! Parameters:
      --!    Location
      --!       is the observed Location expressed in Cartesian
      --!       coordinates (X in nautical miles, Y in nautical miles,
      --!       Z in feet).
      --!    Observed_Time
      --!       is the time at which the hit was recorded.
      --!    Smoothed (on input)
      --!       is the previous position of the track in Cartesian
      --!       coordinates (X, Y, Z in feet, velocity in feet per
      --!       second, acceleration in feet per second squared).
      --!    Smoothed (on output)
      --!       is the updated position of the track in Cartesian
      --!       coordinates (X, Y, Z in feet, velocity in feet per
      --!       second, acceleration in feet per second squared).
      --!    Last_Observed_Time (on input)
      --!       is the time at which the previous hit was recorded.
      --!    Last_Observed_Time (on output)
      --!       is the time at which the hit was recorded.
      --!    Error Covariance
      --!       is the initial error covariance matrix which is
      --!       based on the measurement covariance and the delta
      --!       time.
      --!    Predicted
      --!       is the initial position of the track in Cartesian
      --!       coordinates (X, Y, Z in feet, velocity in feet per
      --!       second, acceleration in feet per second squared).
      --!    Maneuver_Detector
      --!       is the initial white noise matrix constant which
      --!       is used by the Filter function to determine the amount
      --!       of credibility in the observed Location.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The velocity is computed by the Update function unless
      --!    it was included in the observed Location passed to the
      --!    Initiate function.
      --!
      --!-------------------------------------------------------------

      Delta_Time  : Duration;
      Phi         : State_Transition_Matrix;

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Functions.Update (Cartesian)");
         Status (Pid, Parameters,
                 "At entry, Smoothed Location ",
                 Smoothed);
      end if;

      -- Compute the time between observations.

      Delta_Time := Observed_Time - Last_Observed_Time;
      if (Execute_Debug_Code) then
         Status (Pid, Internals,
                 "Delta Time ", Float(Delta_Time));
      end if;

      -- Compute the state transition matrix.

      Phi := Make_Phi (Delta_Time);

      if (Execute_Debug_Code) then
         Status (Pid, Internals,
                 "State Transition matrix ", Phi);
      end if;

      --                                 P          S
      -- Compute the predicted location X  = PHI * X   .
      --                                            k-1

      if (Use_Fast_Matrix_Operations) then
         Predicted (1) := Smoothed (1) +
                          (Float (Delta_Time) * Smoothed (2));
         Predicted (2) := Smoothed (2);
         Predicted (3) := Smoothed (3);
         Predicted (4) := Smoothed (4) +
                          (Float (Delta_Time) * Smoothed (5));
         Predicted (5) := Smoothed (5);
         Predicted (6) := Smoothed (6);
         Predicted (7) := Smoothed (7) +
                          (Float (Delta_Time) * Smoothed (8));
         Predicted (8) := Smoothed (8);
         Predicted (9) := Smoothed (9);
      else
         Predicted := To_Vector (Phi * Smoothed);
      end if;

      -- Initialize the maneuver detector constant and
      --   the error covariance matrix.

      Maneuver_Detector := Initial_Cartesian_Maneuver_Detector;
      Error_Covariance
         := Make_Xyz_Error_Covariance (Delta_Time);

      -- Update the last observation time.

      Last_Observed_Time := Observed_Time;

      -- Compute the smoothed location:
      --   initialize position components
      --   to observed position components,
      --   compute initial velocity,
      --   initialize acceleration components
      --   to observed acceleration components,

      if Location.Velocity = Null_Cartesian_Velocity then

         Smoothed
            := Vector'
               (Location.Position.X * Feet_Per_Nautical_Mile,
                ((Location.Position.X * Feet_Per_Nautical_Mile)
                 - Smoothed (1)) / Float(Delta_Time),
                Location.Acceleration.X,

                Location.Position.Y * Feet_Per_Nautical_Mile,
                ((Location.Position.Y * Feet_Per_Nautical_Mile)
                 - Smoothed (4)) / Float(Delta_Time),
                Location.Acceleration.Y,

                Location.Position.Z,
                (Location.Position.Z - Smoothed (7)) /
                Float(Delta_Time),
                Location.Acceleration.Z);
      else
         Smoothed
            := Vector'
               (Location.Position.X * Feet_Per_Nautical_Mile,
                Location.Velocity.X * Feet_Per_Nautical_Mile /
                Seconds_Per_Hour,
                Location.Acceleration.X *
                Feet_Per_Nautical_Mile /
                (Seconds_Per_Hour ** 2),

                Location.Position.Y * Feet_Per_Nautical_Mile,
                Location.Velocity.Y * Feet_Per_Nautical_Mile /
                Seconds_Per_Hour,
                Location.Acceleration.Y *
                Feet_Per_Nautical_Mile /
                (Seconds_Per_Hour ** 2),

                Location.Position.Z,
                Location.Velocity.Z,
                Location.Acceleration.Z);
      end if;

      if (Execute_Debug_Code) then
         Status (Pid, Parameters,
                 "At exit, Smoothed Location ",
                 Smoothed);
         Status (Pid, Parameters,
                 "Predicted Location ", Predicted);
         Status (Pid, Parameters,
                 "Error Covariance ", Error_Covariance);
         Status (Pid, Parameters,
                 "Maneuver Detector ", Maneuver_Detector);
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Functions.Update (Cartesian)");
      end if;

   end Update;

   pragma Page;
   -------------------------------------------------------------------

   procedure Update
      (Location           : in     Polar_Location;
       Observed_Time      : in     Time;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Detector  : in out Float) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Update
      --!
      --! Purpose:
      --!    This procedure initializes the Smoothed location,
      --!    Error_Covariance, and Maneuver_Detector from the
      --!    previous Smoothed location and the observed Location.
      --!
      --! Parameters:
      --!    Location
      --!       is the observed Location expressed in Polar
      --!       coordinates (R in nautical miles, Theta in radians,
      --!       Height in feet).
      --!    Observed_Time
      --!       is the time at which the hit was recorded.
      --!    Smoothed (on input)
      --!       is the previous position of the track in Polar
      --!       coordinates (R, and Height in feet, velocity in feet
      --!       per second, acceleration in feet per second squared,
      --!       Theta in radians, velocity in radians per second,
      --!       acceleration in radians per second squared).
      --!    Smoothed (on output)
      --!       is the current position of the track in Polar
      --!       coordinates (R, and Height in feet, velocity in feet
      --!       per second, acceleration in feet per second squared,
      --!       Theta in radians, velocity in radians per second,
      --!       acceleration in radians per second squared).
      --!    Last_Observed_Time (on input)
      --!       is the time at which the previous hit was recorded.
      --!    Last_Observed_Time (on output)
      --!       is the time at which the hit was recorded.
      --!    Error Covariance
      --!       is the initial error covariance matrix which is
      --!       based on the measurement covariance and the delta
      --!       time.
      --!    Predicted
      --!       is the predicted position of the track in Polar
      --!       coordinates (R, and Height in feet, velocity in feet
      --!       per second, acceleration in feet per second squared,
      --!       Theta in radians, velocity in radians per second,
      --!       acceleration in radians per second squared).
      --!    Maneuver_Detector
      --!       is the initial white noise matrix constant which
      --!       is used by the Filter function to determine the amount
      --!       of credibility in the observed Location.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The velocity is computed by the Update function unless
      --!    it was included in the observed Location passed to the
      --!    Initiate function.
      --!
      --!-------------------------------------------------------------

      Delta_Time  : Duration;
      Phi         : State_Transition_Matrix;

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Functions.Update (Polar)");
         Status (Pid, Parameters,
                 "At entry, Smoothed Location ",
                 Smoothed);
      end if;

      -- Compute the time between observations.

      Delta_Time := Observed_Time - Last_Observed_Time;

      if (Execute_Debug_Code) then
         Status (Pid, Internals,
                 "Delta Time ", Float(Delta_Time));
      end if;

      -- Compute the state transition matrix.

      Phi := Make_Phi (Delta_Time);

      if (Execute_Debug_Code) then
         Status (Pid, Internals,
                 "State Transition matrix ", Phi);
      end if;

      --                                 P          S
      -- Compute the predicted location X  = PHI * X   .
      --                                            k-1

      if (Use_Fast_Matrix_Operations) then
         Predicted (1) := Smoothed (1) +
                          (Float (Delta_Time) * Smoothed (2));
         Predicted (2) := Smoothed (2);
         Predicted (3) := Smoothed (3);
         Predicted (4) := Smoothed (4) +
                          (Float (Delta_Time) * Smoothed (5));
         Predicted (5) := Smoothed (5);
         Predicted (6) := Smoothed (6);
         Predicted (7) := Smoothed (7) +
                          (Float (Delta_Time) * Smoothed (8));
         Predicted (8) := Smoothed (8);
         Predicted (9) := Smoothed (9);
      else
         Predicted := To_Vector (Phi * Smoothed);
      end if;

      -- Initialize the maneuver detector constant and
      --   the error covariance matrix.

      Maneuver_Detector := Initial_Polar_Maneuver_Detector;
      Error_Covariance  := Make_Polar_Error_Covariance (Delta_Time);

      -- Update the last observation time.

      Last_Observed_Time := Observed_Time;

      -- Compute the smoothed location:
      --   initialize position components
      --   to observed position components,
      --   compute initial velocity,
      --   initialize acceleration components
      --   to observed acceleration components.

      if Location.Velocity = Null_Polar_Velocity then

         Smoothed
            := Vector'
               (Location.Position.R * Feet_Per_Nautical_Mile,
                ((Location.Position.R * Feet_Per_Nautical_Mile)
                 - Smoothed (1)) / Float(Delta_Time),
                Location.Acceleration.R,

                Location.Position.Theta,
                (Location.Position.Theta - Smoothed (4)) /
                Float(Delta_Time),
                Location.Acceleration.Theta,

                Location.Position.Height,
                (Location.Position.Height - Smoothed (7)) /
                Float(Delta_Time),
                Location.Acceleration.Height);
      else
         Smoothed
            := Vector'
               (Location.Position.R * Feet_Per_Nautical_Mile,
                Location.Velocity.R * Feet_Per_Nautical_Mile /
                Seconds_Per_Hour,
                Location.Acceleration.R *
                Feet_Per_Nautical_Mile /
                (Seconds_Per_Hour ** 2),

                Location.Position.Theta,
                Location.Velocity.Theta,
                Location.Acceleration.Theta,

                Location.Position.Height,
                Location.Velocity.Height,
                Location.Acceleration.Height);

      end if;

      if (Execute_Debug_Code) then
         Status (Pid, Parameters,
                 "At exit, Smoothed Location ",
                 Smoothed);
         Status (Pid, Parameters,
                 "Predicted Location ", Predicted);
         Status (Pid, Parameters,
                 "Error Covariance ", Error_Covariance);
         Status (Pid, Parameters,
                 "Maneuver Detector ", Maneuver_Detector);
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Functions.Update (Polar)");
      end if;

   end Update;

   pragma Page;
   -------------------------------------------------------------------

   generic
      type Coordinate_Location is private;
      Measurement_Covariance : in Measurement_Covariance_Matrix;
      System                 : in Coordinate_System;

      with function Make_Psi
         (Location : Coordinate_Location)
         return Position_Vector is <>;

   procedure Generic_Filter
      (Location           : in     Coordinate_Location;
       Observed_Time      : in     Time;
       Maneuver_Detector  : in     Float;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Indicator : in out Float);

   pragma Page;
   -------------------------------------------------------------------

   procedure Generic_Filter
      (Location           : in     Coordinate_Location;
       Observed_Time      : in     Time;
       Maneuver_Detector  : in     Float;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Indicator : in out Float) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Generic_Filter
      --!
      --! Purpose:
      --!    This procedure determines the best estimate of the
      --!    current position of a tracked object using the observed
      --!    Location, the previous Smoothed location, and the
      --!    previous Error_Covariance.
      --!
      --! Parameters:
      --!    Location
      --!       is the observed Location.
      --!    Observed_Time
      --!       is the time at which the hit was recorded.
      --!    Maneuver_Detector
      --!       is the white noise matrix constant which determines
      --!       the amount of credibility in the observed Location.
      --!    Smoothed (on input)
      --!       is the previous position of the track.
      --!    Smoothed (on output)
      --!       is the current position of the track.
      --!    Last_Observed_Time (on input)
      --!       is the time at which the previous hit was recorded.
      --!    Last_Observed_Time (on output)
      --!       is the time at which the hit was recorded.
      --!    Error Covariance (on input)
      --!       is the previous error covariance matrix.
      --!    Error Covariance (on output)
      --!       is the current error covariance matrix.
      --!    Predicted
      --!       is the predicted position of the track.
      --!    Maneuver_Indicator
      --!       is the sum of squares of errors.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Generic_Filter is a template for filter functions which
      --!    may be instantiated in specified coordinate systems.
      --!
      --!    The maneuver detector is used to tune the filter
      --!    calculations. As the value is increased, the filter
      --!    places less importance on the predicted position and
      --!    more on the observation when determining the best
      --!    estimate of the current position.
      --!
      --!    The maneuver indicator tells whether the filter
      --!    believes that the tracked object is in a maneuver.
      --!    When a maneuver is in progress, increase the maneuver
      --!    detector to lessen the reliance on the track history.
      --!
      --!-------------------------------------------------------------

      subtype Element_Matrix is Matrix (1 .. 1, 1 .. 1);

      Delta_Time                 : Duration;
      Phi                        : State_Transition_Matrix;
      Temporary_Error_Covariance : Covariance_Matrix;
      Filter_Gain                : Filter_Gain_Matrix;
      White_Noise                : White_Noise_Matrix;
      Observed_Position          : Position_Vector;
      Sum_Of_Squares_Of_Errors   : Element_Matrix;

      P   : Covariance_Matrix
            renames Temporary_Error_Covariance;
      Q   : White_Noise_Matrix
            renames White_Noise;
      H   : Position_Extractor_Matrix
            renames Position_Extractor;
      R   : Measurement_Covariance_Matrix
            renames Measurement_Covariance;
      K   : Filter_Gain_Matrix
            renames Filter_Gain;
      Psi : Position_Vector
            renames Observed_Position;

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure Kalman_Functions." &
                 "Generic_Filter");
         Status (Pid, Parameters,
                 "At entry, Smoothed Location ", Smoothed);
         Status (Pid, Parameters,
                 "Maneuver Detector ", Maneuver_Detector);
         Status (Pid, Parameters,
                 "Error Covariance ", Error_Covariance);
      end if;

      -- Compute the time between observations.

      Delta_Time := Observed_Time - Last_Observed_Time;

      if (Execute_Debug_Code) then
         Status (Pid, Internals,
                 "Delta Time ", Float(Delta_Time));
      end if;

      -- Compute the state transition matrix.

      Phi := Make_Phi (Delta_Time);

      if (Execute_Debug_Code) then
         Status (Pid, Internals,
                 "State Transition Matrix ", Phi);
      end if;

      --                                 P          S
      -- Compute the predicted location X  = PHI * X   .
      --                                            k-1

      if (Use_Fast_Matrix_Operations) then
         Predicted (1) := Smoothed (1) +
                          (Float (Delta_Time) * Smoothed (2));
         Predicted (2) := Smoothed (2);
         Predicted (3) := Smoothed (3);
         Predicted (4) := Smoothed (4) +
                          (Float (Delta_Time) * Smoothed (5));
         Predicted (5) := Smoothed (5);
         Predicted (6) := Smoothed (6);
         Predicted (7) := Smoothed (7) +
                          (Float (Delta_Time) * Smoothed (8));
         Predicted (8) := Smoothed (8);
         Predicted (9) := Smoothed (9);
      else
         Predicted := To_Vector (Phi * Smoothed);
      end if;

      declare

         T : Float := Float (Delta_Time);
         R11 : Float renames R (1,1);
         R22 : Float renames R (2,2);
         R33 : Float renames R (3,3);

      begin

         --
         -- Compute the white noise matrix.
         --
         -- Q = C  * Q
         --      k    0
         --

         Q := Zero (Q);

         if (Use_Fast_Matrix_Operations) then

            Q (1,1) := (T ** 5) * Maneuver_Detector / 20.0;
            Q (4,4) := Q (1,1);
            Q (7,7) := Q (1,1);

            Q (1,2) := (T ** 4) * Maneuver_Detector / 8.0;
            Q (2,1) := Q (1,2);
            Q (4,5) := Q (1,2);
            Q (5,4) := Q (1,2);
            Q (7,8) := Q (1,2);
            Q (8,7) := Q (1,2);

            Q (1,3) := (T ** 3) * Maneuver_Detector / 6.0;
            Q (3,1) := Q (1,3);
            Q (4,6) := Q (1,3);
            Q (6,4) := Q (1,3);
            Q (7,9) := Q (1,3);
            Q (9,7) := Q (1,3);

            Q (2,2) := (T ** 3) * Maneuver_Detector / 3.0;
            Q (5,5) := Q (2,2);
            Q (8,8) := Q (2,2);

            Q (2,3) := (T * T) * Maneuver_Detector / 2.0;
            Q (3,2) := Q (2,3);
            Q (5,6) := Q (2,3);
            Q (6,5) := Q (2,3);
            Q (8,9) := Q (2,3);
            Q (9,8) := Q (2,3);

            Q (3,3) := T * Maneuver_Detector;
            Q (6,6) := Q (3,3);
            Q (9,9) := Q (3,3);

         else

            Q (1,1) := (T ** 5) / 20.0;
            Q (4,4) := Q (1,1);
            Q (7,7) := Q (1,1);

            Q (1,2) := (T ** 4) / 8.0;
            Q (2,1) := Q (1,2);
            Q (4,5) := Q (1,2);
            Q (5,4) := Q (1,2);
            Q (7,8) := Q (1,2);
            Q (8,7) := Q (1,2);

            Q (1,3) := (T ** 3) / 6.0;
            Q (3,1) := Q (1,3);
            Q (4,6) := Q (1,3);
            Q (6,4) := Q (1,3);
            Q (7,9) := Q (1,3);
            Q (9,7) := Q (1,3);

            Q (2,2) := (T ** 3) / 3.0;
            Q (5,5) := Q (2,2);
            Q (8,8) := Q (2,2);

            Q (2,3) := (T * T) / 2.0;
            Q (3,2) := Q (2,3);
            Q (5,6) := Q (2,3);
            Q (6,5) := Q (2,3);
            Q (8,9) := Q (2,3);
            Q (9,8) := Q (2,3);

            Q (3,3) := T;
            Q (6,6) := T;
            Q (9,9) := T;

            Q := Maneuver_Detector * Q;

         end if;

         if System = Polar_System and abs (Smoothed (1)) > 1.0 then

            if (Execute_Debug_Code) then

               Status (Pid, Internals,
                       "Scaling White Noise in Theta");

            end if;

            for Row in 4 .. 6 loop
               for Column in 4 .. 6 loop
                  Q (Row, Column) := Q (Row, Column) /
                                     (Smoothed (1) * Smoothed (1));
               end loop;
            end loop;
         end if;

         if (Execute_Debug_Code) then
            Status (Pid, Internals, "White Noise ", Q);
         end if;

         --
         -- Compute the error covariance matrix from the
         --   previous error covariance
         --   and the white noise matrix.
         --
         --                                  T
         -- P = (Phi * Error_Covariance * Phi ) + Q
         --

         if (Use_Fast_Matrix_Operations) then
            P := Error_Covariance;
            for Index in P'range (2) loop
               P (1, Index) := P (1, Index) +
                               (Float (Delta_Time) * P (2, Index));
               P (4, Index) := P (4, Index) +
                               (Float (Delta_Time) * P (5, Index));
               P (7, Index) := P (7, Index) +
                               (Float (Delta_Time) * P (8, Index));
            end loop;
            for Index in P'range (1) loop
               P (Index, 1) := P (Index, 1) +
                               (Float (Delta_Time) * P (Index, 2));
               P (Index, 4) := P (Index, 4) +
                               (Float (Delta_Time) * P (Index, 5));
               P (Index, 7) := P (Index, 7) +
                               (Float (Delta_Time) * P (Index, 8));
            end loop;

            declare

               R1,
               R2,
               C1,
               C2 : Integer;

            begin

               for Row in 1 .. 3 loop
                  R1 := Row + 3;
                  R2 := Row + 6;
                  for Column in 1 .. 3 loop
                     C1 := Column + 3;
                     C2 := Column + 6;
                     P (Row, Column) := P (Row, Column)
                                        + Q (Row, Column);
                     P (R1, C1) := P (R1, C1) + Q (R1, C1);
                     P (R2, C2) := P (R2, C2) + Q (R2, C2);
                  end loop;
               end loop;
            end;
         else
            P := Phi * Error_Covariance * Transpose (Phi) + Q;
         end if;

         if (Execute_Debug_Code) then
            Status (Pid, Internals,
                    "Temporary Error Covariance ", P);
         end if;

      end;

      --
      -- Compute the filter gain matrix from the
      --   error covariance matrix (P),
      --   the measurement covariance matrix (R),
      --   and the matrix (H) which
      --   extracts the position component from
      --   location (position, velocity,
      --   and acceleration).
      --
      --
      --          T             T     -1
      -- K = P * H  * (H * P * H  + R)
      --

      begin

         if (Use_Fast_Matrix_Operations) then

            declare

               Temp_Mc : Measurement_Covariance_Matrix;
               Temp_Fg : Filter_Gain_Matrix;

            begin

               Temp_Mc (1,1) := R (1,1) + P (1,1);
               Temp_Mc (1,2) := R (1,2) + P (1,4);
               Temp_Mc (1,3) := R (1,3) + P (1,7);
               Temp_Mc (2,1) := R (2,1) + P (4,1);
               Temp_Mc (2,2) := R (2,2) + P (4,4);
               Temp_Mc (2,3) := R (2,3) + P (4,7);
               Temp_Mc (3,1) := R (3,1) + P (7,1);
               Temp_Mc (3,2) := R (3,2) + P (7,4);
               Temp_Mc (3,3) := R (3,3) + P (7,7);

               Temp_Mc := Inverse (Temp_Mc);

               for Row in Temp_Fg'range (1) loop
                  Temp_Fg (Row, 1) := P (Row, 1);
                  Temp_Fg (Row, 2) := P (Row, 4);
                  Temp_Fg (Row, 3) := P (Row, 7);
               end loop;

               K := Temp_Fg * Temp_Mc;

            end;

         else
            K := P * Transpose (H) *
                 Inverse (H * P * Transpose (H) + R);
         end if;

      exception

         when Inverse_Error =>
            K := ((1.0, 0.0, 0.0),
                  (0.0, 0.0, 0.0),
                  (0.0, 0.0, 0.0),
                  (0.0, 1.0, 0.0),
                  (0.0, 0.0, 0.0),
                  (0.0, 0.0, 0.0),
                  (0.0, 0.0, 1.0),
                  (0.0, 0.0, 0.0),
                  (0.0, 0.0, 0.0));

      end;

      if (Execute_Debug_Code) then
         Status (Pid, Internals,
                 "Filter Gain Matrix ", K);
      end if;

      --
      -- Compute the smoothed location using the predicted location,
      --   the filter gain matrix, the observed position,
      --   and the predicted
      --   position.
      --
      --  S        P                   P
      -- X      = X  + K * (PSI - H * X )
      --  k + 1

      Psi := Make_Psi (Location);

      if (Execute_Debug_Code) then
         Status (Pid, Internals, "Determine Smoothed");
      end if;

      if (Use_Fast_Matrix_Operations) then
         declare

            Pos : Position_Vector;

         begin

            Pos (1) := Psi (1) - Predicted (1);
            Pos (2) := Psi (2) - Predicted (4);
            Pos (3) := Psi (3) - Predicted (7);

            Smoothed := To_Vector
                        (Predicted + (K * Pos));

         end;

      else
         Smoothed := To_Vector
                     (Predicted + (K * (Psi - (H * Predicted))));
      end if;

      --
      -- Update the error covariance matrix.
      --
      --  S
      -- P      = (I - K * H) * P
      --  k + 1
      --

      if (Execute_Debug_Code) then
         Status (Pid, Internals, "Determine P");
      end if;

      if (Use_Fast_Matrix_Operations) then

         declare

            Temp1,
            Temp2 : Covariance_Matrix;

         begin

            if (Execute_Debug_Code) then
               Status (Pid, Internals, "Determine Temp1");
            end if;

            Temp1 := Zero (Temp1);

            for Row in Temp1'range (1) loop
               Temp1 (Row, 1) := K (Row, 1);
               Temp1 (Row, 4) := K (Row, 2);
               Temp1 (Row, 7) := K (Row, 3);
            end loop;

            if (Execute_Debug_Code) then
               Status (Pid, Internals, "Determine Temp2");
            end if;

            Temp2 := Identity (Error_Covariance);

            for Row in Temp1'range (1) loop
               Temp2 (Row, 1) := Temp2 (Row, 1) - Temp1 (Row, 1);
               Temp2 (Row, 4) := Temp2 (Row, 4) - Temp1 (Row, 4);
               Temp2 (Row, 7) := Temp2 (Row, 7) - Temp1 (Row, 7);
            end loop;

            if (Execute_Debug_Code) then
               Status (Pid, Internals, "Determine Temp2 * P");
            end if;

            Error_Covariance := Temp2 * P;

         end;

      else
         Error_Covariance := (Identity (Error_Covariance)
                              - (K * H)) * P;
      end if;

      --
      -- Compute the sum of squares of errors.
      --
      --                  P T            T -1             P
      --  SSE = (Psi - H X ) * (H * P * H )   * (Psi - H X )
      --

      if (Use_Fast_Matrix_Operations) then

         declare

            Temp_Mc : Measurement_Covariance_Matrix;
            Temp_P  : Position_Vector;

         begin

            Temp_P (1) := Psi (1) - Predicted (1);
            Temp_P (2) := Psi (2) - Predicted (4);
            Temp_P (3) := Psi (3) - Predicted (7);

            Temp_Mc (1,1) := P (1,1);
            Temp_Mc (1,2) := P (1,4);
            Temp_Mc (1,3) := P (1,7);
            Temp_Mc (2,1) := P (4,1);
            Temp_Mc (2,2) := P (4,4);
            Temp_Mc (2,3) := P (4,7);
            Temp_Mc (3,1) := P (7,1);
            Temp_Mc (3,2) := P (7,4);
            Temp_Mc (3,3) := P (7,7);

            begin

               if (Execute_Debug_Code) then
                  Status (Pid, Internals, "Invert Temp_Mc");
               end if;

               Temp_Mc := Inverse (Temp_Mc);

            exception

               when Inverse_Error =>
                  Temp_Mc := Identity (Temp_Mc);

            end;

            if (Execute_Debug_Code) then
               Status (Pid, Internals, "Temp_P * Temp_Mc * " &
                                       "Temp_P");
            end if;

            Sum_Of_Squares_Of_Errors := Temp_P * Temp_Mc * Temp_P;
         end;

      else
         begin

            Sum_Of_Squares_Of_Errors := Transpose (Psi - (H
                                                          * Predicted)) *
                                        Inverse (H * (P
                                                      * Transpose (H))) *
                                        (Psi - (H * Predicted));
         exception

            when Inverse_Error =>

               Sum_Of_Squares_Of_Errors := Transpose (Psi - (H
                                                             * Predicted)) *
                                           (Psi - (H * Predicted));

         end;

      end if;

      Maneuver_Indicator := Sum_Of_Squares_Of_Errors (1,1);

      --
      -- Update the last observation time.
      --

      Last_Observed_Time := Observed_Time;

      if (Execute_Debug_Code) then
         Status (Pid, Parameters,
                 "Upon exit, Smoothed Location ", Smoothed);
         Status (Pid, Parameters,
                 "Predicted Location ", Predicted);
         Status (Pid, Parameters,
                 "Error Covariance ", Error_Covariance);
         Status (Pid, Parameters,
                 "Maneuver Indicator ", Maneuver_Indicator);
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure Kalman_Functions." &
                 "Generic_Filter");
      end if;

   end Generic_Filter;

   pragma Page;
   -------------------------------------------------------------------

   procedure Cartesian_Filter is
      new Generic_Filter
          (Coordinate_Location    => Cartesian_Location,
           Measurement_Covariance => Cartesian_Measurement_Covariance,
           System                 => Cartesian_System);

   procedure Polar_Filter is
      new Generic_Filter
          (Coordinate_Location    => Polar_Location,
           Measurement_Covariance => Polar_Measurement_Covariance,
           System                 => Polar_System);

   pragma Page;
   -------------------------------------------------------------------

   procedure Filter
      (Location           : in     Cartesian_Location;
       Observed_Time      : in     Time;
       Maneuver_Detector  : in     Float;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Indicator : in out Float) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Filter
      --!
      --! Purpose:
      --!    This procedure executes the Kalman Filter equations
      --!    for a Location expressed in Cartesian coordinates.
      --!
      --! Parameters:
      --!    Location
      --!       is the observed Location in Cartesian coordinates
      --!       (X and Y in nautical miles, Z in feet).
      --!    Observed_Time
      --!       is the time at which the hit was recorded.
      --!    Maneuver_Detector
      --!       is the white noise matrix constant which determines
      --!       the amount of credibility in the observed Location.
      --!    Smoothed (on input)
      --!       is the previous position of the track.
      --!    Smoothed (on output)
      --!       is the current position of the track.
      --!    Last_Observed_Time (on input)
      --!       is the time at which the previous hit was recorded.
      --!    Last_Observed_Time (on output)
      --!       is the time at which the hit was recorded.
      --!    Error Covariance (on input)
      --!       is the previous error covariance matrix.
      --!    Error Covariance (on output)
      --!       is the current error covariance matrix.
      --!    Predicted
      --!       is the predicted position of the track.
      --!    Maneuver_Indicator
      --!       is the sum of squares of errors.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Refer to the procedure header of Generic_Filter.
      --!
      --!-------------------------------------------------------------

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Filter.Filter (Cartesian)");
      end if;

      Cartesian_Filter (Location,
                        Observed_Time,
                        Maneuver_Detector,
                        Smoothed,
                        Last_Observed_Time,
                        Error_Covariance,
                        Predicted,
                        Maneuver_Indicator);

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Functions.Filter (Cartesian)");
      end if;

   end Filter;

   pragma Page;
   -------------------------------------------------------------------

   procedure Filter
      (Location           : in     Polar_Location;
       Observed_Time      : in     Time;
       Maneuver_Detector  : in     Float;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Indicator : in out Float) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Filter
      --!
      --! Purpose:
      --!    This procedure executes the Kalman Filter equations for
      --!    a Location expressed in Polar coordinates.
      --!
      --! Parameters:
      --!    Location
      --!       is the observed Location in Polar coordinates
      --!       (R in nautical miles, Theta in radians, Height in
      --!       feet).
      --!    Observed_Time
      --!       is the time at which the hit was recorded.
      --!    Maneuver_Detector
      --!       is the white noise matrix constant which determines
      --!       the amount of credibility in the observed Location.
      --!    Smoothed (on input)
      --!       is the previous position of the track.
      --!    Smoothed (on output)
      --!       is the current position of the track.
      --!    Last_Observed_Time (on input)
      --!       is the time at which the previous hit was recorded.
      --!    Last_Observed_Time (on output)
      --!       is the time at which the hit was recorded.
      --!    Error Covariance (on input)
      --!       is the previous error covariance matrix.
      --!    Error Covariance (on output)
      --!       is the current error covariance matrix.
      --!    Predicted
      --!       is the predicted position of the track.
      --!    Maneuver_Indicator
      --!       is the sum of squares of errors.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Refer to the procedure header for Generic_Filter.
      --!
      --!-------------------------------------------------------------

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Functions.Filter (Polar)");
      end if;

      Polar_Filter (Location,
                    Observed_Time,
                    Maneuver_Detector,
                    Smoothed,
                    Last_Observed_Time,
                    Error_Covariance,
                    Predicted,
                    Maneuver_Indicator);

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Functions.Filter (Polar)");
      end if;

   end Filter;

   pragma Page;
   -------------------------------------------------------------------

   procedure Filter
      (Location           : in     Cartesian_Location;
       Observed_Time      : in     Time;
       Maneuver_Detector  : in     Float;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Indicator : in out Float;
       Cpu_Time           :    out Duration;
       Real_Time          :    out Duration) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Filter
      --!
      --! Purpose:
      --!    This procedure executes the Kalman Filter equations for
      --!    a Location expressed in Cartesian coordinates. It also
      --!    supplies timing information to assist in determining
      --!    the efficiency (or lack of efficiency) of the Ada Kalman
      --!    Filter.
      --!
      --! Parameters:
      --!    Location
      --!       is the observed Location in Cartesian coordinates
      --!       (X and Y in nautical miles, Z in feet).
      --!    Observed_Time
      --!       is the time at which the hit was recorded.
      --!    Maneuver_Detector
      --!       is the white noise matrix constant which determines
      --!       the amount of credibility in the observed Location.
      --!    Smoothed (on input)
      --!       is the previous position of the track.
      --!    Smoothed (on output)
      --!       is the current position of the track.
      --!    Last_Observed_Time (on input)
      --!       is the time at which the previous hit was recorded.
      --!    Last_Observed_Time (on output)
      --!       is the time at which the hit was recorded.
      --!    Error Covariance (on input)
      --!       is the previous error covariance matrix.
      --!    Error Covariance (on output)
      --!       is the current error covariance matrix.
      --!    Predicted
      --!       is the predicted position of the track.
      --!    Maneuver_Indicator
      --!       is the sum of squares of errors.
      --!    Cpu_Time
      --!       is the amount of CPU Time used in the single call
      --!       to the Cartesian_Filter procedure.
      --!    Real_Time
      --!       is the amount of running time used in the single call
      --!       to the Cartesian_Filter procedure.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Refer to the procedure header for Generic_Filter.
      --!
      --!-------------------------------------------------------------

      Cpu_Start,
      Real_Start,
      Cpu_Stop,
      Real_Stop : Duration;

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Filter.Filter (Cartesian)");
      end if;

      Get_Time (Cpu_Start, Real_Start);

      Cartesian_Filter (Location,
                        Observed_Time,
                        Maneuver_Detector,
                        Smoothed,
                        Last_Observed_Time,
                        Error_Covariance,
                        Predicted,
                        Maneuver_Indicator);

      Get_Time (Cpu_Stop, Real_Stop);

      Cpu_Time  := Cpu_Stop  - Cpu_Start;
      Real_Time := Real_Stop - Real_Start;

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Functions.Filter (Cartesian)");
      end if;

   end Filter;

   pragma Page;
   -------------------------------------------------------------------

   procedure Filter
      (Location           : in     Polar_Location;
       Observed_Time      : in     Time;
       Maneuver_Detector  : in     Float;
       Smoothed           : in out Location_Vector;
       Last_Observed_Time : in out Time;
       Error_Covariance   : in out Covariance_Matrix;
       Predicted          : in out Location_Vector;
       Maneuver_Indicator : in out Float;
       Cpu_Time           :    out Duration;
       Real_Time          :    out Duration) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Filter
      --!
      --! Purpose:
      --!    This procedure executes the Kalman Filter equations for
      --!    a Location expressed in Polar coordinates. It also
      --!    supplies timing information to assist in determining
      --!    the efficiency (or lack of efficiency) of the Ada Kalman
      --!    Filter.
      --!
      --! Parameters:
      --!    Location
      --!       is the observed Location in Polar coordinates
      --!       (R in nautical miles, Theta in radians,
      --!       Height in feet).
      --!    Observed_Time
      --!       is the time at which the hit was recorded.
      --!    Maneuver_Detector
      --!       is the white noise matrix constant which determines
      --!       the amount of credibility in the observed Location.
      --!    Smoothed (on input)
      --!       is the previous position of the track.
      --!    Smoothed (on output)
      --!       is the current position of the track.
      --!    Last_Observed_Time (on input)
      --!       is the time at which the previous hit was recorded.
      --!    Last_Observed_Time (on output)
      --!       is the time at which the hit was recorded.
      --!    Error Covariance (on input)
      --!       is the previous error covariance matrix.
      --!    Error Covariance (on output)
      --!       is the current error covariance matrix.
      --!    Predicted
      --!       is the predicted position of the track.
      --!    Maneuver_Indicator
      --!       is the sum of squares of errors.
      --!    Cpu_Time
      --!       is the amount of CPU Time used in the single call
      --!       to the Polar_Filter procedure.
      --!    Real_Time
      --!       is the amount of running time used in the single call
      --!       to the Polar_Filter procedure.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Refer to the procedure header for Generic_Filter.
      --!
      --!-------------------------------------------------------------

      Cpu_Start,
      Real_Start,
      Cpu_Stop,
      Real_Stop : Duration;

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Functions.Filter (Polar)");
      end if;

      Get_Time (Cpu_Start, Real_Start);

      Polar_Filter (Location,
                    Observed_Time,
                    Maneuver_Detector,
                    Smoothed,
                    Last_Observed_Time,
                    Error_Covariance,
                    Predicted,
                    Maneuver_Indicator);

      Get_Time (Cpu_Stop, Real_Stop);

      Cpu_Time  := Cpu_Stop  - Cpu_Start;
      Real_Time := Real_Stop - Real_Start;

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Functions.Filter (Polar)");
      end if;

   end Filter;

begin -- Package Initialization

   if (Execute_Debug_Code) then
      Pid := New_Package_Id;
      Status (Pid, Nothing,
              "Kalman_Functions Package Initialization");
   end if;

end Kalman_Functions;
--::::::::::::::::::::::::::::
--KALMAN-TRACK-SPEC.ADA
--::::::::::::::::::::::::::::

with Calendar;
with Kalman_Definitions;

use Calendar;
use Kalman_Definitions;

package Kalman_Track is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!   Kalman_Track
   --!
   --! Purpose:
   --!   This package acts as a stand-alone tracking package
   --!   using Kalman_Filter techniques. It correlates specified
   --!   "hits" with existing tracks or initiates new tracks.
   --!   Kalman Filter operations are then performed on the track.
   --!   Tracks which have not been correlated with "hits" for
   --!   one full sensor device scan time are "coasted" to their
   --!   presumed new position. Tracks which have been coasted beyond
   --!   a maximum coast count are suspended.
   --!
   --! Interfaces:
   --!    Track
   --!       correlates the observed Location with an existing
   --!       track or initiates a new track, then performs Kalman
   --!       Filter operations on the track.
   --!
   --! Exceptions:
   --!    Mismatched_Coordinate_System
   --!       is raised if an Observed Location is correlated to a
   --!       track whose matrices are stored in the other
   --!       coordinate system.
   --!
   --!    No_More_Tracks_Available
   --!       is raised if a new track should be initiated when
   --!       no room exists in the TRACK_DATA for a new track.
   --!
   --! Notes:
   --!    The Track procedure may be invoked with Locations
   --!    expressed in either Cartesian or Polar coordinates.
   --!    Timing information is also available if desired.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Jeffrey G. Smith
   --!
   --!----------------------------------------------------------------

   Mismatched_Coordinate_System : exception;

   No_More_Tracks_Available : exception;

   procedure Track
      (Location      : in     Cartesian_Location;
       Observed_Time : in     Time;
       Cycle_Time    : in     Duration;
       Track         : in out Track_Data;
       Track_Id      : in out Integer;
       Object_Id     : in     Object_Identification := Null_Object);

   procedure Track
      (Location      : in     Polar_Location;
       Observed_Time : in     Time;
       Cycle_Time    : in     Duration;
       Track         : in out Track_Data;
       Track_Id      : in out Integer;
       Object_Id     : in     Object_Identification := Null_Object);

   -------------------------------------------------------------------

   procedure Track
      (Location      : in     Cartesian_Location;
       Observed_Time : in     Time;
       Cycle_Time    : in     Duration;
       Track         : in out Track_Data;
       Track_Id      : in out Integer;
       Cpu_Time      :    out Duration;
       Real_Time     :    out Duration;
       Object_Id     : in     Object_Identification := Null_Object);

   procedure Track
      (Location      : in     Polar_Location;
       Observed_Time : in     Time;
       Cycle_Time    : in     Duration;
       Track         : in out Track_Data;
       Track_Id      : in out Integer;
       Cpu_Time      :    out Duration;
       Real_Time     :    out Duration;
       Object_Id     : in     Object_Identification := Null_Object);

end Kalman_Track;
--::::::::::::::::::::::::::::
--KALMAN-TRACK-BODY.ADA
--::::::::::::::::::::::::::::

with Calendar;
with Kalman_Options;
with Kalman_Definitions;
with Kalman_Matrix_Lib;
with Kalman_Functions;
with Kalman_Utilities;
with Kalman_Status;
with Kalman_Threshold;
with Kalman_Time;

use Calendar;
use Kalman_Options;
use Kalman_Definitions;
use Kalman_Matrix_Lib;
use Kalman_Functions;
use Kalman_Utilities;
use Kalman_Status;
use Kalman_Threshold;
use Kalman_Time;

package body Kalman_Track is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Track
   --!
   --! Purpose:
   --!    This package body acts as a stand-alone tracking package
   --!    using Kalman Filter techniques. It correlates specified
   --!    "hits" with existing tracks or initiates new tracks.
   --!    Kalman Filter operations are then performed on the track.
   --!    Tracks which have not been correlated with "hits" for
   --!    one full sensor device scan time are "coasted" to their
   --!    presumed new location. Tracks which have been "coasted"
   --!    beyond a maximum coast count are suspended.
   --!
   --! Exceptions:
   --!    Mismatched_Coordinate_System
   --!       is raised if an observed Location is correlated to a
   --!       track whose matrices are stored in the other
   --!       coordinate system.
   --!
   --!    No_More_Tracks_Available
   --!       is raised if a new track should be initiated when
   --!       no room exists in the TRACK_DATA for a new track.
   --!
   --! Notes:
   --!    The correlation procedure contained in Kalman_Track
   --!    is used to determine which if any of the active tracks
   --!    should be correlated with the observation. It simply
   --!    determines the closest track of those within a maximum
   --!    correlation distance and adjudges it the correlated
   --!    track. This procedure leaves much room for improvement
   --!    and would be an appropriate candidate for a separate
   --!    package.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Jeffrey G. Smith
   --!
   --! Changes:
   --!    04-APR-1985
   --!       Changed Kalman_Trace to Kalman_Threshold because of
   --!       TeleSoft file naming conflict with Kalman_Track.
   --!
   --!    24-APR-1985
   --!       Added code to Generic_Track to handle theta crossover
   --!       problem discovered during testing of MULTI_POLAR
   --!       scenario.
   --!
   --!    29-APR-1985
   --!       Changed debug threshold on Status call in package
   --!       initialization to "Nothing".
   --!
   --!----------------------------------------------------------------

   Pid : Package_Id;

   procedure Suspend
      (Track : in out Single_Track);

   procedure Coast
      (Observed_Time : in     Time;
       Cycle_Time    : in     Duration;
       Track         : in out Track_Data);

   function Aggregate
      (C1, C2, C3 : Float) return Cartesian_Position;

   function Aggregate
      (C1, C2, C3 : Float) return Polar_Position;

   function Position_Component_Of (Location : in Cartesian_Location)
      return Cartesian_Position;

   function Position_Component_Of (Location : in Polar_Location)
      return Polar_Position;

   function Range_Component_Of (Position : in Polar_Position)
      return Float;

   function Range_Component_Of (Position : in Cartesian_Position)
      return Float;

   function Theta_Component_Of (Position : in Polar_Position)
      return Float;

   function Theta_Component_Of (Position : in Cartesian_Position)
      return Float;

   function Original_Units_Of (Position : Polar_Position)
      return Polar_Position;

   function Original_Units_Of (Position : Cartesian_Position)
      return Cartesian_Position;

   pragma Page;
   -------------------------------------------------------------------

   generic
      type Coordinate_Position is private;
      type Other_Coordinate_Position  is private;
      Other_Coordinate_System : in Coordinate_System;

      with function Distance
         (From : Other_Coordinate_Position;
          To   : Coordinate_Position)
         return Float is <>;

      with function Distance
         (From : Coordinate_Position;
          To   : Coordinate_Position)
         return Float is <>;

      with function Aggregate
         (C1, C2, C3 : Float)
         return Coordinate_Position is <>;

      with function Aggregate
         (C1, C2, C3 : Float)
         return Other_Coordinate_Position is <>;

      with function Original_Units_Of
         (Position : Coordinate_Position)
         return Coordinate_Position is <>;

      with function Original_Units_Of
         (Position : Other_Coordinate_Position)
         return Other_Coordinate_Position is <>;

   function Generic_Correlation
      (Position      : in Coordinate_Position;
       Observed_Time : in Time;
       Object_Id     : in Object_Identification;
       Track         : in Track_Data) return Integer;

   Uncorrelated_Plot : exception;

   pragma Page;
   -------------------------------------------------------------------

   generic
      type Coordinate_Location is private;
      Input_Coordinate_System : in Coordinate_System;

      with procedure Initiate
         (Location           : in     Coordinate_Location;
          Observed_Time      : in     Time;
          Smoothed           : in out Location_Vector;
          Last_Observed_Time :    out Time;
          Predicted          :    out Location_Vector) is <>;

   procedure Generic_Initiate_Track
      (Location        : in     Coordinate_Location;
       Observed_Time   : in     Time;
       Object_Id       : in     Object_Identification;
       Track           : in out Track_Data;
       Track_Id        : in out Integer);

   pragma Page;
   -------------------------------------------------------------------

   generic
      type Coordinate_Location is private;

      with procedure Filter
         (Location           : in     Coordinate_Location;
          Observed_Time      : in     Time;
          Maneuver_Detector  : in     Float;
          Smoothed           : in out Location_Vector;
          Last_Observed_Time : in out Time;
          Error_Covariance   : in out Covariance_Matrix;
          Predicted          : in out Location_Vector;
          Maneuver_Indicator : in out Float) is <>;

      with procedure Update
         (Location           : in     Coordinate_Location;
          Observed_Time      : in     Time;
          Smoothed           : in out Location_Vector;
          Last_Observed_Time : in out Time;
          Error_Covariance   : in out Covariance_Matrix;
          Predicted          : in out Location_Vector;
          Maneuver_Detector  : in out Float) is <>;

   procedure Generic_Update_Or_Filter
      (Location        : in     Coordinate_Location;
       Observed_Time   : in     Time;
       Track_Id        : in     Integer;
       Track           : in out Track_Data);

   pragma Page;
   -------------------------------------------------------------------

   generic
      type Coordinate_Location is private;
      type Coordinate_Position is private;
      type Other_Location      is private;
      Other_Coordinate_System : Coordinate_System;

      with function Correlation
         (Position      : in     Coordinate_Position;
          Observed_Time : in     Time;
          Object_Id     : in     Object_Identification;
          Track         : in     Track_Data)
         return Integer is <>;

      with procedure Initiate_Track
         (Location      : in     Coordinate_Location;
          Observed_Time : in     Time;
          Object_Id     : in     Object_Identification;
          Track         : in out Track_Data;
          Track_Id      : in out Integer) is <>;

      with procedure Update_Or_Filter
         (Location      : in     Coordinate_Location;
          Observed_Time : in     Time;
          Track_Id      : in     Integer;
          Track         : in out Track_Data) is <>;

      with function Position_Component_Of
         (Location      : in     Coordinate_Location)
         return Coordinate_Position is <>;

      with function Range_Component_Of
         (Position      : in     Coordinate_Position)
         return Float is <>;

      with function Theta_Component_Of
         (Position      : in     Coordinate_Position)
         return Float is <>;

      with procedure Initiate
         (Location           : in     Coordinate_Location;
          Observed_Time      : in     Time;
          Smoothed           : in out Location_Vector;
          Last_Observed_Time :    out Time;
          Predicted          :    out Location_Vector) is <>;

   procedure Generic_Track
      (Location        : in     Coordinate_Location;
       Observed_Time   : in     Time;
       Object_Id       : in     Object_Identification;
       Cycle_Time      : in     Duration;
       Track           : in out Track_Data;
       Track_Id        : in out Integer);

   pragma Page;
   -------------------------------------------------------------------

   procedure Suspend
      (Track : in out Single_Track) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Suspend
      --!
      --! Purpose:
      --!    This procedure sets the state of the specified track
      --!    to suspended.
      --!
      --! Parameters:
      --!    Track
      --!       is the track which is being suspended.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Suspend merely sets the state to suspended, not
      --!    checking to see whether the specified track was
      --!    active in the first place.
      --!
      --!-------------------------------------------------------------

   begin
      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure Kalman_Track.Suspend");
      end if;

      Track := Single_Track'(State => Suspended);

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure Kalman_Track.Suspend");
      end if;
   end Suspend;

   pragma Page;
   -------------------------------------------------------------------

   procedure Coast
      (Observed_Time : in     Time;
       Cycle_Time    : in     Duration;
       Track         : in out Track_Data) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Coast
      --!
      --! Purpose:
      --!    This procedure determines whether any "active" tracks
      --!    have not been correlated with any "hits" for a period
      --!    of time greater than one sensor device scan time.  If
      --!    so, the procedure adds the number of times the sensor
      --!    device has scanned without recording a "hit" for this
      --!    track to the coast count in the TRACK_DATA.
      --!
      --! Parameters:
      --!    Observed_Time
      --!       is the time at which a "hit" was most recently
      --!       recorded.
      --!    Cycle_Time
      --!       is the time it takes the sensor device to make one
      --!       full pass
      --!    Track
      --!       is the array of track records.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The Coast procedure knows that a track has been
      --!    "coasted" beyond the maximum coast count when the
      --!    addition of the current coast count and the number
      --!    cycle times passed causes an exception. It then
      --!    suspends the offending track.
      --!
      --!-------------------------------------------------------------

      Cycles_Since_Last_Update : Natural;

   begin
      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure Kalman_Track.Coast");
      end if;

      for Index in Track'range loop

         if Is_Active (Track(Index)) then
            begin
               if (Execute_Debug_Code) then
                  Status (Pid, Internals,
                          "Checking Track ",
                          Integer(Index));
               end if;

               Cycles_Since_Last_Update
                  := Integer (Observed_Time -
                              Track(Index).Updated_Time) /
                     Integer (Cycle_Time);

               if (Execute_Debug_Code) then
                  Status (Pid, Internals,
                          "Current Coast Count ",
                          Integer(Track(Index).Coast_Counter));
                  Status (Pid, Internals,
                          "Cycles since last update ",
                          Integer(Cycles_Since_Last_Update));
               end if;

               Track(Index).Coast_Counter
                  := Track(Index).Coast_Counter +
                     Cycles_Since_Last_Update;

               Track(Index).Updated_Time
                  := Track(Index).Updated_Time +
                     Duration(Cycles_Since_Last_Update *
                              Integer(Cycle_Time));

            exception
               when Constraint_Error =>
                  if (Execute_Debug_Code) then
                     Status (Pid, Internals,
                             "Suspending Track");
                  end if;

                  Suspend (Track (Index));
            end;
         end if;
      end loop;

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure Kalman_Track.Coast");
      end if;
   end Coast;

   pragma Page;
   -------------------------------------------------------------------

   function Aggregate (C1, C2, C3 : Float)
      return Cartesian_Position is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Aggregate
      --!
      --! Purpose:
      --!    This function returns the Cartesian_Position
      --!    value with C1, C2, and C3 in the place of
      --!    X, Y, and Z.
      --!
      --! Parameters:
      --!    C1
      --!       is the first (X) component.
      --!    C2
      --!       is the second (Y) component.
      --!    C3
      --!       is the third (Z) component.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      return Cartesian_Position'(C1, C2, C3);

   end Aggregate;

   pragma Page;
   -------------------------------------------------------------------

   function Aggregate (C1, C2, C3 : Float)
      return Polar_Position is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Aggregate
      --!
      --! Purpose:
      --!    This function returns the Polar_Position
      --!    value with C1, C2, and C3 in the place of
      --!    R, Theta, and Height.
      --!
      --! Parameters:
      --!    C1
      --!       is the first (R) component.
      --!    C2
      --!       is the second (Theta) component.
      --!    C3
      --!       is the third (Height) component.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      return Polar_Position'(C1, C2, C3);

   end Aggregate;

   pragma Page;
   -------------------------------------------------------------------

   function Position_Component_Of (Location : in Cartesian_Location)
      return Cartesian_Position is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Position_Component_of
      --!
      --! Purpose:
      --!    This function returns the Cartesian_Position
      --!    component of the specified Location.
      --!
      --! Parameters:
      --!    Location
      --!       is the location of the object with
      --!       position, velocity, and acceleration components.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      return Location.Position;

   end Position_Component_Of;

   pragma Page;
   -------------------------------------------------------------------

   function Position_Component_Of (Location : in Polar_Location)
      return Polar_Position is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Position_Component_of
      --!
      --! Purpose:
      --!    This function returns the Polar_Position
      --!    component of the specified Location.
      --!
      --! Parameters:
      --!    Location
      --!       is the location of the object with
      --!       position, velocity, and acceleration components.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      return Location.Position;

   end Position_Component_Of;

   pragma Page;
   -------------------------------------------------------------------

   function Range_Component_Of (Position : in Cartesian_Position)
      return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Range_Component_of
      --!
      --! Purpose:
      --!    This function satisfies the Ada compiler
      --!    with respect to generic instantiations of
      --!    Generic_Track.
      --!
      --! Parameters:
      --!    Position
      --!       is the position of the object with
      --!       X, Y, and Z components.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      return 0.0;

   end Range_Component_Of;

   pragma Page;
   -------------------------------------------------------------------

   function Range_Component_Of (Position : in Polar_Position)
      return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Range_Component_of
      --!
      --! Purpose:
      --!    This function returns the range component of
      --!    the position expressed in Range, Theta, and Height.
      --!
      --! Parameters:
      --!    Position
      --!       is the position of the object with
      --!       R, Theta, and Height components.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      return Position.R;

   end Range_Component_Of;

   pragma Page;
   -------------------------------------------------------------------

   function Theta_Component_Of (Position : in Polar_Position)
      return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Theta_Component_of
      --!
      --! Purpose:
      --!    This function returns the theta component of
      --!    the position expressed in Range, Theta, and Height.
      --!
      --! Parameters:
      --!    Position
      --!       is the position of the object with
      --!       R, Theta, and Height components.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      return Position.Theta;

   end Theta_Component_Of;

   pragma Page;
   -------------------------------------------------------------------

   function Theta_Component_Of (Position : in Cartesian_Position)
      return Float is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Theta_Component_of
      --!
      --! Purpose:
      --!    This function satisfies the Ada compiler
      --!    with respect to generic instantiations of
      --!    Generic_Track.
      --!
      --! Parameters:
      --!    Position
      --!       is the position of the object with
      --!       R, Theta, and Height components.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin

      return 0.0;

   end Theta_Component_Of;

   pragma Page;
   -------------------------------------------------------------------

   function Original_Units_Of (Position : Polar_Position)
      return Polar_Position is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Original_Units_of
      --!
      --! Purpose:
      --!    This function returns the original units of the
      --!    specified Polar_Position.
      --!
      --! Parameters:
      --!    Position
      --!       is the position in internal units.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The value of the range component R is converted from
      --!    feet to nautical miles.
      --!
      --!-------------------------------------------------------------

   begin

      return (Position.R / Feet_Per_Nautical_Mile,
              Position.Theta,
              Position.Height);

   end Original_Units_Of;

   pragma Page;
   -------------------------------------------------------------------

   function Original_Units_Of (Position : Cartesian_Position)
      return Cartesian_Position is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Original_Units_of
      --!
      --! Purpose:
      --!    This function returns the original units of the
      --!    specified Cartesian_Position.
      --!
      --! Parameters:
      --!    Position
      --!       is the position in internal units.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    The value of the X and Y components are converted from
      --!    feet to nautical miles.
      --!
      --!-------------------------------------------------------------

   begin

      return (Position.X / Feet_Per_Nautical_Mile,
              Position.Y / Feet_Per_Nautical_Mile,
              Position.Z);

   end Original_Units_Of;

   pragma Page;
   -------------------------------------------------------------------

   function Generic_Correlation
      (Position      : in Coordinate_Position;
       Observed_Time : in Time;
       Object_Id     : in Object_Identification;
       Track         : in Track_Data) return Integer is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Generic_Correlation
      --!
      --! Purpose:
      --!    This generic function determines which if any of the
      --!    existing active tracks should be correlated with the
      --!    "hit" recorded by the sensor device. If none correlate,
      --!    then Generic_Correlation raises the Uncorrelated_Plot
      --!    exception to signal that a new track should be initiated.
      --!    Generic_Correlation returns the track number of the
      --!    correlated track.
      --!
      --! Parameters:
      --!    Position
      --!       is position components of the observed "hit."
      --!    Observed_Time
      --!       is the time at which the "hit" occurred.
      --!    Object_Id
      --!       is the object identification (beacon) information
      --!       received along with the "hit" information.
      --!    Track
      --!       is the array of track records.
      --!
      --! Exceptions:
      --!    Uncorrelated_Plot
      --!       is raised if the "hit" can not be correlated to
      --!       any existing active track.
      --!
      --! Notes:
      --!    The correlation algorithm first attempts to match the
      --!    Object_Id with the object ID of any existing track.
      --!    If none match, then the track whose predicted position
      --!    at time equal to Observed_Time is closest to Position
      --!    and lies within the Maximum_Correlation_Distance is
      --!    correlated.
      --!
      --!-------------------------------------------------------------

      Delta_Time               : Duration;
      Phi                      : State_Transition_Matrix;
      Predicted                : Location_Vector;
      Same_Position            : Coordinate_Position;
      Other_Position           : Other_Coordinate_Position;
      Minimum_Distance         : Float;
      Distance_From_Hit        : Float;
      No_Tracks_In_Range       : Boolean := True;
      Track_Id                 : Integer;

   begin
      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to function Kalman_Track.Correlation");
         Status (Pid, Parameters,
                 "Object Identification ", Object_Id);
      end if;

      Minimum_Distance := Maximum_Correlation_Distance + 1.0;

      -- Attempt to correlate based on the object id.

      if Object_Id /= Null_Object then

         if (Execute_Debug_Code) then
            Status (Pid, Internals,
                    "Correlation based on Object Id");
         end if;

         for Index in Track'range loop

            if Is_Active (Track (Index)) then

               if Object_Id = Track(Index).Object_Id.all then
                  if (Execute_Debug_Code) then
                     Status (Pid, Parameters,
                             "Based on Object Id, "&
                             "correlating to Track ",
                             Integer (Index));
                     Status (Pid, Entry_Exit,
                             "<-- Exit from function " &
                             "Kalman_Track.Correlation");
                  end if;

                  return Index;
               end if;
            end if;
         end loop;
      end if;

      -- Determine all tracks whose predicted location lies within
      --  the maximum correlation distance.

      if (Execute_Debug_Code) then
         Status (Pid, Internals,
                 "Determination of tracks within Circle");
      end if;

      for Index in Track'range loop

         if (Execute_Debug_Code) then
            Status (Pid, Internals,
                    "Checking Track ", Integer(Index));
         end if;

         if Is_Active (Track(Index)) then

            Delta_Time := Observed_Time -
                          Track(Index).Last_Observed_Time;

            if (Execute_Debug_Code) then
               Status (Pid, Internals,
                       "Delta Time ", Float (Delta_Time));
            end if;

            Phi        := Make_Phi (Delta_Time);

            if (Execute_Debug_Code) then
               Status (Pid, Internals,
                       "State Transition Matrix ", Phi);
            end if;

            Predicted  := To_Vector(Phi * Track(Index).Smoothed);

            if (Execute_Debug_Code) then
               Status (Pid, Internals,
                       "Predicted Location ", Predicted);
            end if;

            if Track (Index).Coordinates_Are_In_The =
               Other_Coordinate_System then

               if (Execute_Debug_Code) then
                  Status (Pid, Internals,
                          "Other Coordinate System");
               end if;

               Other_Position := Original_Units_Of
                                 (Aggregate (Predicted (1),
                                             Predicted (4),
                                             Predicted (7)));

               Distance_From_Hit
                  := Distance (Other_Position,
                               Position);

               if (Execute_Debug_Code) then
                  Status (Pid, Internals,
                          "Distance from Hit ",
                          Distance_From_Hit);
               end if;

               if Distance_From_Hit <=
                  Maximum_Correlation_Distance then

                  if (Execute_Debug_Code) then
                     Status (Pid, Internals,
                             "In Range");
                  end if;

                  if No_Tracks_In_Range then

                     No_Tracks_In_Range := False;
                     Minimum_Distance := Distance_From_Hit;
                     Track_Id := Index;

                  else
                     if Distance_From_Hit < Minimum_Distance then
                        Minimum_Distance := Distance_From_Hit;
                        Track_Id := Index;
                     end if;
                  end if;
               end if;
            else

               if (Execute_Debug_Code) then
                  Status (Pid, Internals,
                          "Same Coordinate System");
               end if;

               Same_Position := Original_Units_Of
                                (Aggregate (Predicted (1),
                                            Predicted (4),
                                            Predicted (7)));

               Distance_From_Hit
                  := Distance (Same_Position,
                               Position);

               if (Execute_Debug_Code) then
                  Status (Pid, Internals,
                          "Distance from Hit",
                          Distance_From_Hit);
               end if;

               if Distance_From_Hit <=
                  Maximum_Correlation_Distance then

                  if (Execute_Debug_Code) then
                     Status (Pid, Internals,
                             "In Range");
                  end if;

                  if No_Tracks_In_Range then

                     No_Tracks_In_Range := False;
                     Minimum_Distance := Distance_From_Hit;
                     Track_Id := Index;

                  else
                     if Distance_From_Hit < Minimum_Distance then
                        Minimum_Distance := Distance_From_Hit;
                        Track_Id := Index;
                     end if;
                  end if;
               end if;
            end if;

         end if;
      end loop;

      -- No tracks in range - therefore raise UNCORRELATED_PLOT.

      if No_Tracks_In_Range then

         if (Execute_Debug_Code) then
            Status (Pid, Parameters,
                    "No Tracks in range");
            Status (Pid, Entry_Exit,
                    "<-- Exit from function "&
                    "Kalman_Track.Correlation");
         end if;

         raise Uncorrelated_Plot;
      end if;

      -- At least one track in range - return closest

      if (Execute_Debug_Code) then
         Status (Pid, Parameters,
                 "Corrrelation to track ", Track_Id);
         Status (Pid, Entry_Exit,
                 "<-- Exit from function " &
                 "Kalman_Track.Correlation");
      end if;

      return Track_Id;

   end Generic_Correlation;

   pragma Page;
   -------------------------------------------------------------------

   function Correlation is
      new Generic_Correlation
          (Coordinate_Position       => Polar_Position,
           Other_Coordinate_Position => Cartesian_Position,
           Other_Coordinate_System   => Cartesian_System);

   function Correlation is
      new Generic_Correlation
          (Coordinate_Position       => Cartesian_Position,
           Other_Coordinate_Position => Polar_Position,
           Other_Coordinate_System   => Polar_System);

   pragma Page;
   -------------------------------------------------------------------

   procedure Generic_Initiate_Track
      (Location        : in     Coordinate_Location;
       Observed_Time   : in     Time;
       Object_Id       : in     Object_Identification;
       Track           : in out Track_Data;
       Track_Id        : in out Integer) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Generic_Initiate_Track
      --!
      --! Purpose:
      --!    This generic procedure determines whether room exists in
      --!    the array of track records to initiate a new track. If
      --!    so, Generic_Initiate_Track initializes the track record
      --!    and performs the Kalman_Filter operation Initiate on the
      --!    new track.
      --!
      --! Parameters:
      --!    Location
      --!       is the position, velocity, and acceleration of the
      --!       observed "hit."
      --!    Observed_Time
      --!       is the time at which the "hit" was recorded.
      --!    Object_Id
      --!       is the object identification information received
      --!       with the "hit."
      --!    Track
      --!       is the array of track records.
      --!    Track_Id
      --!       is the track number of the initiated track.
      --!
      --! Exceptions:
      --!    No_More_Tracks_Available
      --!       is raised if no room exists to initiate a new track.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

      Track_Is_Available : Boolean := False;
      Null_Location_Vector : constant Location_Vector
                             := (0.0, others => 0.0);

   begin
      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Track.Initiate_Track");
      end if;

      for Index in Track'range loop

         if not Is_Active (Track (Index)) then

            Track_Is_Available := True;
            Track_Id := Index;
            exit;
         end if;
      end loop;

      if Track_Is_Available then

         if (Execute_Debug_Code) then
            Status (Pid, Internals,
                    "Track is available");
         end if;

         Track (Track_Id)
            := Single_Track'
                 (State => Active,
                  Coordinates_Are_In_The
                     => Input_Coordinate_System,
                  Object_Id
                     => new Object_Identification'(Object_Id),
                  Filter => Initialize,
                  Updated_Time => Observed_Time,
                  Smoothed => Null_Location_Vector,
                  Error_Covariance => (1 .. 9 => (1 .. 9 => 0.0)),
                  Maneuver_Detector => 0.0,
                  Predicted => Null_Location_Vector,
                  Maneuver_Indicator => 0.0,
                  Coast_Counter => 0,
                  Last_Observed_Time => Observed_Time,
                  Last_Observed_Location => Null_Location_Vector);

         Initiate (Location, Observed_Time,
                   Track (Track_Id).Smoothed,
                   Track (Track_Id).Last_Observed_Time,
                   Track (Track_Id).Predicted);

         Track (Track_Id).Last_Observed_Location
            := Track (Track_Id).Smoothed;

         Track (Track_Id).Filter := Ready_To_Update;

      else
         if (Execute_Debug_Code) then
            Status (Pid, Internals,
                    "No More Tracks Available");
            Status (Pid, Entry_Exit,
                    "<-- Exit from procedure " &
                    "Kalman_Track.Initiate_track");
         end if;

         raise No_More_Tracks_Available;
      end if;

      if (Execute_Debug_Code) then
         Status (Pid, Parameters,
                 "New Track assigned to position ", Track_Id);
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Track.Initiate_track");
      end if;

   end Generic_Initiate_Track;

   pragma Page;
   -------------------------------------------------------------------

   procedure Initiate_Track is
      new Generic_Initiate_Track
          (Coordinate_Location     => Polar_Location,
           Input_Coordinate_System => Polar_System);

   procedure Initiate_Track is
      new Generic_Initiate_Track
          (Coordinate_Location     => Cartesian_Location,
           Input_Coordinate_System => Cartesian_System);

   pragma Page;
   -------------------------------------------------------------------

   procedure Generic_Update_Or_Filter
      (Location        : in     Coordinate_Location;
       Observed_Time   : in     Time;
       Track_Id        : in     Integer;
       Track           : in out Track_Data) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Generic_Update_Or_Filter
      --!
      --! Purpose:
      --!    This generic procedure performs the Kalman Filter
      --!    operation Update or Filter dependent upon the filter
      --!    state of the specified track.
      --!
      --! Parameters:
      --!    Location
      --!       is the position, velocity, and acceleration of the
      --!       observed "hit."
      --!    Observed_Time
      --!       is the time at which the "hit" was recorded.
      --!    Track_Id
      --!       is the track number of the specified track.
      --!    Track
      --!       is the array of track records.
      --!
      --! Exceptions:
      --!    Not applicable.
      --!
      --! Notes:
      --!    Not applicable.
      --!
      --!-------------------------------------------------------------

   begin
      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Track.Update_or_Filter");
      end if;

      if Track (Track_Id).Filter = Ready_To_Filter then

         if (Execute_Debug_Code) then
            Status (Pid, Internals,
                    "Ready to filter");
         end if;

         Filter (Location,
                 Observed_Time,
                 Track (Track_Id).Maneuver_Detector,
                 Track (Track_Id).Smoothed,
                 Track (Track_Id).Last_Observed_Time,
                 Track (Track_Id).Error_Covariance,
                 Track (Track_Id).Predicted,
                 Track (Track_Id).Maneuver_Indicator);

      else
         if (Execute_Debug_Code) then
            Status (Pid, Internals,
                    "Ready to Update");
         end if;

         Update (Location,
                 Observed_Time,
                 Track (Track_Id).Smoothed,
                 Track (Track_Id).Last_Observed_Time,
                 Track (Track_Id).Error_Covariance,
                 Track (Track_Id).Predicted,
                 Track (Track_Id).Maneuver_Detector);

         Track (Track_Id).Filter := Ready_To_Filter;
      end if;

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Track.Update_or_Filter");
      end if;

   end Generic_Update_Or_Filter;

   pragma Page;
   -------------------------------------------------------------------

   procedure Update_Or_Filter is
      new Generic_Update_Or_Filter
          (Coordinate_Location => Polar_Location);

   procedure Update_Or_Filter is
      new Generic_Update_Or_Filter
          (Coordinate_Location => Cartesian_Location);

   pragma Page;
   -------------------------------------------------------------------

   procedure Generic_Track
      (Location        : in     Coordinate_Location;
       Observed_Time   : in     Time;
       Object_Id       : in     Object_Identification;
       Cycle_Time      : in     Duration;
       Track           : in out Track_Data;
       Track_Id        : in out Integer) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Generic_Track
      --!
      --! Purpose:
      --!    This generic procedure correlates the observed Location
      --!    with an existing track or initiates a new track. It then
      --!    performs Kalman Filter operations on the specified track.
      --!    At the end of each Kalman Filter operation, Generic_Track
      --!    coasts tracks which have not been correlated with "hits"
      --!    for more than a cycle time of the sensor device.
      --!
      --! Parameters:
      --!    Location
      --!       is the position, velocity, and acceleration of the
      --!       observed "hit."
      --!    Observed_Time
      --!       is the time at which the "hit" was recorded.
      --!    Object_Id
      --!       is the object identification information received
      --!       with the "hit."
      --!    Cycle_Time
      --!       is the time it takes the sensor device to make
      --!       one full pass.
      --!    Track
      --!       is the array of track records.
      --!    Track_Id
      --!       is the track number of the initiated track.
      --!
      --! Exceptions:
      --!    Mismatched_Coordinate_System
      --!       is raised if a "hit" is correlated to a track whose
      --!       matrices are stored in the other coordinate system.
      --!    No_More_Tracks_Available
      --!       is raised if a new track should be initiated when
      --!       no room exists in the Track_Data for a new track.
      --!
      --! Notes:
      --!    An Uncorrelated_Plot exception raised in the Correlation
      --!    function is handled by initiating a new track.
      --!
      --!-------------------------------------------------------------

      Position              : Coordinate_Position;
      Difference_In_Theta   : Float;
      R                     : Float;
      R_Near_Origin         : Float := 2.0;
      Pi                    : constant Float := 3.1416;
      Large_Change_In_Theta : Float := Pi / 4.0;

   begin
      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure Kalman_Track.Track");
      end if;

      begin
         Track_Id := Correlation (Position_Component_Of (Location),
                                  Observed_Time,
                                  Object_Id,
                                  Track);

         if Track (Track_Id).Coordinates_Are_In_The =
            Other_Coordinate_System then

            if (Execute_Debug_Code) then
               Status (Pid, Parameters,
                       "Mismatched Coordinate System");
               Status (Pid, Entry_Exit,
                       "<-- Exit from procedure " &
                       "Kalman_Track.Track");
            end if;

            raise Mismatched_Coordinate_System;

         else
            if (Execute_Debug_Code) then
               Status (Pid, Internals,
                       "Plot correlated to ", Track_Id);
            end if;

            if Other_Coordinate_System = Cartesian_System then

               Position := Position_Component_Of (Location);
               R := Range_Component_Of (Position);
               Difference_In_Theta
                  := abs (Theta_Component_Of (Position) -
                          Track (Track_Id).Smoothed (4));

            else

               R := R_Near_Origin + 1.0;
               Difference_In_Theta := 0.0;

            end if;

            if R <= R_Near_Origin or
               Difference_In_Theta >= Large_Change_In_Theta then

               Initiate (Location, Observed_Time,
                         Track (Track_Id).Smoothed,
                         Track (Track_Id).Last_Observed_Time,
                         Track (Track_Id).Predicted);
               Track (Track_Id).Filter := Ready_To_Update;
               Track (Track_Id).Maneuver_Indicator := 0.0;

            else
               Update_Or_Filter (Location,
                                 Observed_Time,
                                 Track_Id,
                                 Track);

            end if;

            Track (Track_Id).Last_Observed_Location
               := Track (Track_Id).Smoothed;
            Track (Track_Id).Updated_Time := Observed_Time;
            Track (Track_Id).Coast_Counter := 0;

         end if;

      exception
         when Uncorrelated_Plot =>
            if (Execute_Debug_Code) then
               Status (Pid, Internals,
                       "Uncorrelated Plot");
            end if;

            Initiate_Track (Location,
                            Observed_Time,
                            Object_Id,
                            Track,
                            Track_Id);

         when others =>
            if (Execute_Debug_Code) then
               Status (Pid, Parameters,
                       "Unhandled Exception");
               Status (Pid, Entry_Exit,
                       "<-- Exit from procedure " &
                       "Kalman_Track.Track");
            end if;
            raise ;
      end;

      if (Execute_Debug_Code) then
         Status (Pid, Internals,
                 "Coast active tracks");
      end if;

      Coast (Observed_Time, Cycle_Time, Track);

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Track.Track");
      end if;

   end Generic_Track;

   pragma Page;
   -------------------------------------------------------------------

   procedure Cartesian_Track is
      new Generic_Track
          (Coordinate_Location     => Cartesian_Location,
           Coordinate_Position     => Cartesian_Position,
           Other_Location          => Polar_Location,
           Other_Coordinate_System => Polar_System);

   procedure Polar_Track is
      new Generic_Track
          (Coordinate_Location     => Polar_Location,
           Coordinate_Position     => Polar_Position,
           Other_Location          => Cartesian_Location,
           Other_Coordinate_System => Cartesian_System);

   pragma Page;
   -------------------------------------------------------------------

   procedure Track
      (Location      : in     Cartesian_Location;
       Observed_Time : in     Time;
       Cycle_Time    : in     Duration;
       Track         : in out Track_Data;
       Track_Id      : in out Integer;
       Object_Id     : in     Object_Identification := Null_Object) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Track
      --!
      --! Purpose:
      --!    This procedure correlates the observed Location
      --!    with an existing track or initiates a new track. It then
      --!    performs Kalman Filter operations on the specified track.
      --!    At the end of each Kalman Filter operation, Track
      --!    coasts tracks which have not been correlated with "hits"
      --!    for more than a cycle time of the sensor device.
      --!
      --! Parameters:
      --!    Location
      --!       is the position, velocity, and acceleration of the
      --!       observed "hit."
      --!    Observed_Time
      --!       is the time at which the "hit" was recorded.
      --!    Cycle_Time
      --!       is the time it takes the sensor device to make
      --!       one full pass.
      --!    Track
      --!       is the array of track records.
      --!    Track_Id
      --!       is the track number of the initiated track.
      --!    Object_Id
      --!       is the object identification information received
      --!       with the "hit."
      --!
      --! Exceptions:
      --!    Mismatched_Coordinate_System
      --!       is raised if a "hit" is correlated to a track whose
      --!       matrices are stored in the other coordinate system.
      --!    No_More_Tracks_Available
      --!       is raised if a new track should be initiated when
      --!       no room exists in the Track_Data for a new track.
      --!
      --! Notes:
      --!    An Uncorrelated_Plot exception raised in the Correlation
      --!    function is handled by initiating a new track.
      --!
      --!-------------------------------------------------------------

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure Kalman_Track.Track " &
                 "(Cartesian)");
      end if;

      Cartesian_Track (Location,
                       Observed_Time,
                       Object_Id,
                       Cycle_Time,
                       Track,
                       Track_Id);

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure Kalman_Track.Track " &
                 "(Cartesian)");
      end if;

   end Track;

   pragma Page;
   -------------------------------------------------------------------

   procedure Track
      (Location      : in     Polar_Location;
       Observed_Time : in     Time;
       Cycle_Time    : in     Duration;
       Track         : in out Track_Data;
       Track_Id      : in out Integer;
       Object_Id     : in     Object_Identification := Null_Object) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Track
      --!
      --! Purpose:
      --!    This procedure correlates the observed Location
      --!    with an existing track or initiates a new track. It then
      --!    performs Kalman Filter operations on the specified track.
      --!    At the end of each Kalman Filter operation, Track
      --!    coasts tracks which have not been correlated with "hits"
      --!    for more than a cycle time of the sensor device.
      --!
      --! Parameters:
      --!    Location
      --!       is the position, velocity, and acceleration of the
      --!       observed "hit."
      --!    Observed_Time
      --!       is the time at which the "hit" was recorded.
      --!    Cycle_Time
      --!       is the time it takes the sensor device to make
      --!       one full pass.
      --!    Track
      --!       is the array of track records.
      --!    Track_Id
      --!       is the track number of the initiated track.
      --!    Object_Id
      --!       is the object identification information received
      --!       with the "hit."
      --!
      --! Exceptions:
      --!    Mismatched_Coordinate_System
      --!       is raised if a "hit" is correlated to a track whose
      --!       matrices are stored in the other coordinate system.
      --!    No_More_Tracks_Available
      --!       is raised if a new track should be initiated when
      --!       no room exists in the Track_Data for a new track.
      --!
      --! Notes:
      --!    An Uncorrelated_Plot exception raised in the Correlation
      --!    function is handled by initiating a new track.
      --!
      --!-------------------------------------------------------------

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Track.Track (Polar)");
      end if;

      Polar_Track (Location,
                   Observed_Time,
                   Object_Id,
                   Cycle_Time,
                   Track,
                   Track_Id);

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Track.Track (Polar)");
      end if;

   end Track;

   pragma Page;
   -------------------------------------------------------------------

   procedure Track
      (Location      : in     Cartesian_Location;
       Observed_Time : in     Time;
       Cycle_Time    : in     Duration;
       Track         : in out Track_Data;
       Track_Id      : in out Integer;
       Cpu_Time      :    out Duration;
       Real_Time     :    out Duration;
       Object_Id     : in     Object_Identification := Null_Object) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Track
      --!
      --! Purpose:
      --!    This procedure correlates the observed Location
      --!    with an existing track or initiates a new track. It then
      --!    performs Kalman Filter operations on the specified track.
      --!    At the end of each Kalman Filter operation, Track
      --!    coasts tracks which have not been correlated with "hits"
      --!    for more than a cycle time of the sensor device.
      --!
      --! Parameters:
      --!    Location
      --!       is the position, velocity, and acceleration of the
      --!       observed "hit."
      --!    Observed_Time
      --!       is the time at which the "hit" was recorded.
      --!    Cycle_Time
      --!       is the time it takes the sensor device to make
      --!       one full pass.
      --!    Track
      --!       is the array of track records.
      --!    Track_Id
      --!       is the track number of the initiated track.
      --!    Cpu_Time
      --!       is the amount of CPU time used to execute the
      --!       tracking operations.
      --!    Real_Time
      --!       is the amount of wall time used to execute the
      --!       tracking operations.
      --!    Object_Id
      --!       is the object identification information received
      --!       with the "hit."
      --!
      --! Exceptions:
      --!    Mismatched_Coordinate_System
      --!       is raised if a "hit" is correlated to a track whose
      --!       matrices are stored in the other coordinate system.
      --!    No_More_Tracks_Available
      --!       is raised if a new track should be initiated when
      --!       no room exists in the Track_Data for a new track.
      --!
      --! Notes:
      --!    An Uncorrelated_Plot exception raised in the Correlation
      --!    function is handled by initiating a new track.
      --!
      --!-------------------------------------------------------------

      Cpu_Start,
      Real_Start,
      Cpu_Stop,
      Real_Stop : Duration;

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure Kalman_Track.Track " &
                 "(Cartesian)");
      end if;

      Get_Time (Cpu_Start, Real_Start);

      Cartesian_Track (Location,
                       Observed_Time,
                       Object_Id,
                       Cycle_Time,
                       Track,
                       Track_Id);

      Get_Time (Cpu_Stop, Real_Stop);

      Cpu_Time  := Cpu_Stop  - Cpu_Start;
      Real_Time := Real_Stop - Real_Start;

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure Kalman_Track.Track " &
                 "(Cartesian)");
      end if;

   end Track;

   pragma Page;
   -------------------------------------------------------------------

   procedure Track
      (Location      : in     Polar_Location;
       Observed_Time : in     Time;
       Cycle_Time    : in     Duration;
       Track         : in out Track_Data;
       Track_Id      : in out Integer;
       Cpu_Time      :    out Duration;
       Real_Time     :    out Duration;
       Object_Id     : in     Object_Identification := Null_Object) is

      --!-------------------------------------------------------------
      --!
      --! Name:
      --!    Track
      --!
      --! Purpose:
      --!    This procedure correlates the observed Location
      --!    with an existing track or initiates a new track. It then
      --!    performs Kalman Filter operations on the specified track.
      --!    At the end of each Kalman Filter operation, Track
      --!    coasts tracks which have not been correlated with "hits"
      --!    for more than a cycle time of the sensor device.
      --!
      --! Parameters:
      --!    Location
      --!       is the position, velocity, and acceleration of the
      --!       observed "hit."
      --!    Observed_Time
      --!       is the time at which the "hit" was recorded.
      --!    Cycle_Time
      --!       is the time it takes the sensor device to make
      --!       one full pass.
      --!    Track
      --!       is the array of track records.
      --!    Track_Id
      --!       is the track number of the initiated track.
      --!    Cpu_Time
      --!       is the amount of CPU time used to execute the
      --!       tracking operations.
      --!    Real_Time
      --!       is the amount of wall time used to execute the
      --!       tracking operations.
      --!    Object_Id
      --!       is the object identification information received
      --!       with the "hit."
      --!
      --! Exceptions:
      --!    Mismatched_Coordinate_System
      --!       is raised if a "hit" is correlated to a track whose
      --!       matrices are stored in the other coordinate system.
      --!    No_More_Tracks_Available
      --!       is raised if a new track should be initiated when
      --!       no room exists in the Track_Data for a new track.
      --!
      --! Notes:
      --!    An Uncorrelated_Plot exception raised in the Correlation
      --!    function is handled by initiating a new track.
      --!
      --!-------------------------------------------------------------

      Cpu_Start,
      Real_Start,
      Cpu_Stop,
      Real_Stop : Duration;

   begin

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "--> Entry to procedure " &
                 "Kalman_Track.Track (Polar)");
      end if;

      Get_Time (Cpu_Start, Real_Start);

      Polar_Track (Location,
                   Observed_Time,
                   Object_Id,
                   Cycle_Time,
                   Track,
                   Track_Id);

      Get_Time (Cpu_Stop, Real_Stop);

      Cpu_Time  := Cpu_Stop  - Cpu_Start;
      Real_Time := Real_Stop - Real_Start;

      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "<-- Exit from procedure " &
                 "Kalman_Track.Track (Polar)");
      end if;

   end Track;

begin

   if (Execute_Debug_Code) then
      Pid := New_Package_Id;
      Status (Pid, Nothing,
              "Kalman_Track Package Initialization");
   end if;

end Kalman_Track;
--::::::::::::::::::::::::::::
--KALMAN-MAIN-BODY.ADA
--::::::::::::::::::::::::::::

with Generic_Spelling_Io;

with Text_Io;
with Calendar;
with Kalman_Options;
with Kalman_Definitions;
with Kalman_Trig_Lib;
with Kalman_Track;
with Kalman_Status;
with Kalman_Threshold;
with Kalman_Float_Io;
with Kalman_Integer_Io;
with Kalman_Duration_Io;
with Kalman_Time;

use Text_Io;
use Calendar;
use Kalman_Options;
use Kalman_Definitions;
use Kalman_Trig_Lib;
use Kalman_Track;
use Kalman_Status;
use Kalman_Threshold;
use Kalman_Float_Io;
use Kalman_Integer_Io;
use Kalman_Duration_Io;
use Kalman_Time;

procedure Kalman_Main is

   --!----------------------------------------------------------------
   --!
   --! Name:
   --!    Kalman_Main
   --!
   --! Purpose:
   --!    This procedure performs the required setup and
   --!    initialization to minimally test the Kalman_Track
   --!    Package. It should normally be called from the
   --!    containing support environment as a main procedure.
   --!
   --! Parameters:
   --!    Not applicable.
   --!
   --! Files:
   --!    Hit_File
   --!       contains the observations to be passed to Track.
   --!
   --!    Log_File
   --!       receives the debug messages and data values produced
   --!       during testing if debug is on.
   --!
   --!    Track_File
   --!       receives the smoothed locations returned from Track,
   --!       and final performance data.
   --!
   --!    Current_Input
   --!       contains interactive debug commands (if debugging).
   --!
   --!    Current_Output
   --!       contains interactive debug output (if debugging).
   --!
   --! Exceptions:
   --!    Not applicable.
   --!
   --! Notes:
   --!    Kalman_Main exists to simplify testing of the Ada Kalman
   --!    Filter. It shows one method by which the Ada Kalman Filter
   --!    can be used, but by no means defines the only method.
   --!    Kalman_Main accepts hit data as input and produces track
   --!    files as output. The track file contains the hit, smoothed
   --!    position, their difference, the maneuver indicator, and, for
   --!    Cartesian input, the speed of the tracked object.
   --!
   --! Contract:
   --!    Ada Tracking Package Using Kalman Filter Methods
   --!    Contract No. N66001-85-C-0044 (31 December 1984)
   --!
   --! Prepared for:
   --!    Naval Ocean Systems Center (WIS JPMO)
   --!    271 Catalina Blvd., Building A-33
   --!    San Diego, CA 92152
   --!
   --! Prepared by:
   --!    Software Systems Engineering
   --!    Federal Systems Group
   --!
   --!    Sanders Associates, Inc.
   --!    95 Canal Street
   --!    Nashua, NH 03061
   --!
   --! Author:
   --!    Jeffrey G. Smith
   --!
   --! Changes:
   --!    04-APR-1985
   --!       Changed Kalman_Trace to Kalman_Threshold because of
   --!       TeleSoft file naming conflict with Kalman_Track.
   --!
   --!    04-APR-1985
   --!       Changed Kalman_Math_Lib to Kalman_Trig_Lib because of
   --!       TeleSoft file naming conflict with Kalman_Matrix.
   --!
   --!    22-APR-1985
   --!       Added echo of option values to assist in testing.
   --!
   --!    23-APR-1985
   --!       Changed Track_File Open/Create to Create/Open in order
   --!       to permit multiple versions on VAX/VMS systems.
   --!
   --!    24-APR-1985
   --!       Commented out GET statements which initialize
   --!       white noise matrix coefficients and initialized the
   --!       values used in testing at declaration time.
   --!
   --!    29-APR-1985
   --!       Changed debug threshold on first call of procedure
   --!       Status to "Nothing".
   --!
   --!----------------------------------------------------------------

   Hit_File      : File_Type;
   Track_File    : File_Type;
   Pid           : Package_Id;
   Cartesian     : Cartesian_Location;
   Polar         : Polar_Location;
   Observed_Time : Time;
   Initial_Time  : Time;
   Cycle_Time    : Duration;
   Offset        : Duration;
   Tracks        : Track_Data (1..5);
   Track_Id      : Integer;
   Number_Of_Hits: Integer := 0;
   Degrees_To_Radians : Float := (3.1416 / 180.0);
   X_Nmph        : Float;
   Y_Nmph        : Float;
   Maneuver_In_Progress_Indicator : Float := 100.0;
   Maneuvering   : Float := 100.0;
   Straight_Line : Float := 5.0;
   Halt          : exception;
   Cpu_Time      : Duration;
   Real_Time     : Duration;
   Cpu_Total     : Duration := 0.0;
   Real_Total    : Duration := 0.0;
   Coordinates   : Coordinate_System;

   package Coordinate_Io is
      new Generic_Spelling_Io (Coordinate_System);
   use Coordinate_Io;

   package Vendor_Io is
      new Generic_Spelling_Io (Vendor_Type);
   use Vendor_Io;

   package Boolean_Io is
      new Generic_Spelling_Io (Boolean);
   use Boolean_Io;

begin

   if (Execute_Debug_Code) then
      Pid := New_Package_Id;
      Status (Pid, Nothing,
              "Kalman_Main Procedure Initialization");
      Status (Pid, Entry_Exit,
              "--> Enter procedure Kalman_Main");
   end if;

   Initial_Time := Clock;

   begin
      Open (Hit_File, In_File, "HIT$INPUT:");
   exception
      when others =>

         if (Execute_Debug_Code) then
            Status (Pid, Entry_Exit,
                    "Exception raised on Open (Hit_File)");
         end if;

         Put ("%KALMAN-E-HITEXC, ");
         Put ("Exception raised on Open (Hit_File)");
         New_Line;

         raise Halt;
   end;

   begin
      begin
         Create (Track_File, Out_File, "TRK$OUTPUT:");
      exception
         when others =>
            Open (Track_File, Out_File, "TRK$OUTPUT:");
      end;

   exception
      when others =>
         if (Execute_Debug_Code) then
            Status (Pid, Entry_Exit,
                    "Exception raised on Open (Track_File)");
         end if;

         Put ("%KALMAN-E-TRKEXC, ");
         Put ("Exception raised on Open (Track_File)");
         New_Line;

         raise Halt;
   end;

   --!----------------------------------------------------------------
   --!
   --! Get (Maneuver_In_Progress_Indicator,
   --!      Prompt => "%KALMAN-P-MANIND, " &
   --!      "Value at which maneuver is assumed? ");
   --!
   --! Get (Straight_Line,
   --!      Prompt => "%KALMAN-P-STLCON, " &
   --!      "Straight_Line White Noise Matrix Constant? ");
   --!
   --! Get (Maneuvering,
   --!      Prompt => "%KALMAN-P-MANCON, " &
   --!      "Maneuvering White Noise Matrix Constant? ");
   --!
   --!----------------------------------------------------------------

   New_Line (Track_File);

   Put (Track_File, "Track file for ");
   Put (Track_File, Date_And_Time (Initial_Time));
   New_Line (Track_File);

   New_Line (Track_File);

   Put (Track_File, "Math library: ");
   Put (Track_File, Vendor);
   New_Line (Track_File);

   Put (Track_File, "Execute debug code: ");
   Put (Track_File, Execute_Debug_Code);
   New_Line (Track_File);

   Put (Track_File, "Use fast matrix operations: ");
   Put (Track_File, Use_Fast_Matrix_Operations);
   New_Line (Track_File);

   New_Line (Track_File);

   Put (Track_File, "Maximum coast count: ");
   Put (Track_File, Integer (Maximum_Coast_Count), 1);
   New_Line (Track_File);

   Put (Track_File, "Maximum correlation distance: ");
   Put (Track_File, Float (Maximum_Correlation_Distance), 1);
   New_Line (Track_File);

   New_Line (Track_File);

   Put (Track_File, "Value at which maneuver is " &
                    "assumed to occur: ");
   Put (Track_File, Maneuver_In_Progress_Indicator,
        Fore => 5, Aft => 1, Exp => 0);
   New_Line (Track_File);

   Put (Track_File, "Straight-Line White Noise Matrix Constant: ");
   Put (Track_File, Straight_Line,
        Fore => 5, Aft => 1, Exp => 0);
   New_Line (Track_File);

   Put (Track_File, "Maneuvering White Noise Matrix Constant: ");
   Put (Track_File, Maneuvering,
        Fore => 5, Aft => 1, Exp => 0);
   New_Line (Track_File);

   begin
      Get (Hit_File, Cycle_Time);
      Get (Hit_File, Coordinates);
   exception
      when End_Error =>
         if (Execute_Debug_Code) then
            Status (Pid, Entry_Exit,
                    "End of file encountered on Get (Hit_File)");
         end if;

         Put ("%KALMAN-E-CYCLE, ");
         Put ("End of file encountered on Get (Hit_File)");
         New_Line;

         raise Halt;
   end;

   Put (Track_File, "Cycle Time: ");
   Put (Track_File, Cycle_Time);
   New_Line (Track_File);

   Put (Track_File, "Coordinate System: ");
   Put (Track_File, Coordinates);
   New_Line (Track_File, Spacing => 2);

   Set_Col (Track_File, To => 107);
   Put (Track_File, "Maneuver");
   New_Line (Track_File);

   Put (Track_File, "Track Id      Time     SCN " &
                    "      SMO     DELTA " &
                    "    SCN       SMO     DELTA " &
                    "   SCN      SMO     DELTA " &
                    "    Indicator");

   if Coordinates = Cartesian_System then
      Put (Track_File, "     SPEED");
   end if;

   New_Line (Track_File);

   if (Execute_Debug_Code) then
      Status (Pid, Internals, "Cycle Time ", Float(Cycle_Time));
   end if;

   while not End_Of_File (Hit_File) loop

      begin
         Get (Hit_File, Offset);

         if Coordinates = Polar_System then
            Get (Hit_File, Polar.Position.R);
            Get (Hit_File, Polar.Position.Theta);
            Polar.Position.Theta
               := Polar.Position.Theta * Degrees_To_Radians;
         else
            Get (Hit_File, Cartesian.Position.X);
            Get (Hit_File, Cartesian.Position.Y);
         end if;

         Number_Of_Hits := Number_Of_Hits + 1;

      exception
         when End_Error =>
            if (Execute_Debug_Code) then
               Status (Pid, Entry_Exit,
                        "End of file encountered on Get (Hit_File)");
            end if;

            Put ("%KALMAN-E-ENDHIT, ");
            Put ("End of file encountered on Get (Hit_File)");
            New_Line;

            raise Halt;
      end;

      if (Execute_Debug_Code) then
         Status (Pid, Internals, "Time ", Float(Offset));
      end if;

      if Coordinates = Polar_System then
         if (Execute_Debug_Code) then
            Status (Pid, Internals, "R Position ",
                    Polar.Position.R);
            Status (Pid, Internals, "Theta Position ",
                    Polar.Position.Theta);
         end if;

         -- Track the observed object.

         Track (Polar,
                Initial_Time + Offset,
                Cycle_Time,
                Tracks,
                Track_Id,
                Cpu_Time,
                Real_Time);
      else
         if (Execute_Debug_Code) then
            Status (Pid, Internals, "X Position ",
                    Cartesian.Position.X);
            Status (Pid, Internals, "Y Position ",
                    Cartesian.Position.Y);
         end if;

         -- Track the observed object.

         Track (Cartesian,
                Initial_Time + Offset,
                Cycle_Time,
                Tracks,
                Track_Id,
                Cpu_Time,
                Real_Time);
      end if;

      Cpu_Total  := Cpu_Total  + Cpu_Time;
      Real_Total := Real_Total + Real_Time;

      if (Execute_Debug_Code) then
         Status (Pid, Internals, "Performance data");
         Status (Pid, Internals, "CPU Time ",  Float (Cpu_Time));
         Status (Pid, Internals, "Real Time ", Float (Real_Time));
         Status (Pid, Internals, "Track ID ", Track_Id);
      end if;

      Put (Track_File, Track_Id, Width =>5);
      Put (Track_File, "      ");
      Put (Track_File, Float (Offset),
           Fore => 4, Aft => 2, Exp => 0);
      Put (Track_File, ' ');

      if Coordinates = Polar_System then

         Put (Track_File, Polar.Position.R,
              Fore => 4, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Tracks (Track_Id).Smoothed (1) /
                          Feet_Per_Nautical_Mile,
              Fore => 4, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Polar.Position.R -
                          (Tracks (Track_Id).Smoothed (1) /
                           Feet_Per_Nautical_Mile),
              Fore => 2, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Polar.Position.Theta,
              Fore => 4, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Tracks (Track_Id).Smoothed (4),
              Fore => 4, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Polar.Position.Theta -
                          Tracks (Track_Id).Smoothed (4),
              Fore => 2, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Polar.Position.Height /
              Feet_Per_Nautical_Mile,
              Fore => 3, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Tracks (Track_Id).Smoothed (7) /
                          Feet_Per_Nautical_Mile,
              Fore => 3, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, (Polar.Position.Height -
                           Tracks (Track_Id).Smoothed (7)) /
                           Feet_Per_Nautical_Mile,
              Fore => 2, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Tracks (Track_Id).Maneuver_Indicator,
              Fore => 8, Aft => 4, Exp => 0);

      else

         Put (Track_File, Cartesian.Position.X,
              Fore => 4, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Tracks (Track_Id).Smoothed (1) /
                          Feet_Per_Nautical_Mile,
              Fore => 4, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Cartesian.Position.X -
                          (Tracks (Track_Id).Smoothed (1) /
                           Feet_Per_Nautical_Mile),
              Fore => 2, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Cartesian.Position.Y,
              Fore => 4, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Tracks (Track_Id).Smoothed (4) /
                          Feet_Per_Nautical_Mile,
              Fore => 4, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Cartesian.Position.Y -
                          (Tracks (Track_Id).Smoothed (4) /
                           Feet_Per_Nautical_Mile),
              Fore => 2, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Cartesian.Position.Z /
              Feet_Per_Nautical_Mile,
              Fore => 3, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Tracks (Track_Id).Smoothed (7) /
                          Feet_Per_Nautical_Mile,
              Fore => 3, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, (Cartesian.Position.Z -
                           Tracks (Track_Id).Smoothed (7)) /
                           Feet_Per_Nautical_Mile,
              Fore => 2, Aft => 4, Exp => 0);
         Put (Track_File, ' ');
         Put (Track_File, Tracks (Track_Id).Maneuver_Indicator,
              Fore => 8, Aft => 4, Exp => 0);

         X_Nmph := Tracks (Track_Id).Smoothed (2) /
                   Feet_Per_Nautical_Mile *
                   Seconds_Per_Hour;
         Y_Nmph := Tracks (Track_Id).Smoothed (5) /
                   Feet_Per_Nautical_Mile *
                   Seconds_Per_Hour;

         Put (Track_File, Sqrt (X_Nmph ** 2 + Y_Nmph ** 2),
              Fore => 8, Aft => 1, Exp => 0);

      end if;

      New_Line (Track_File);

      if (Number_Of_Hits rem 5 = 0) then
         New_Line (Track_File);
      end if;

      if abs (Tracks (Track_Id).Maneuver_Indicator) >
         Maneuver_In_Progress_Indicator then

         Tracks (Track_Id).Maneuver_Detector := Maneuvering;
      else
         Tracks (Track_Id).Maneuver_Detector := Straight_Line;
      end if;

   end loop;

   New_Line (Track_File);

   Put (Track_File, "     Performance summary:");
   New_Line (Track_File);

   Put (Track_File, "        Number of radar hits: ");
   Put (Track_File, Number_Of_Hits, 1);
   New_Line (Track_File);

   Put (Track_File, "        CPU Time / Number of Hits: ");
   Put (Track_File, Float (Cpu_Total) / Float (Number_Of_Hits), 1);
   Put (Track_File, " seconds");
   New_Line (Track_File);

   Put (Track_File, "        Real Time / Number of Hits: ");
   Put (Track_File, Float (Real_Total) / Float (Number_Of_Hits), 1);
   Put (Track_File, " seconds");
   New_Line (Track_File);

   if (Execute_Debug_Code) then
      Status (Pid, Entry_Exit, "Performance summary");
      Status (Pid, Entry_Exit, "Number of hits ", Number_Of_Hits);

      Status (Pid, Entry_Exit, "CPU Time / Number of Hits ",
              Float (Cpu_Total) / Float (Number_Of_Hits));

      Status (Pid, Entry_Exit, "Real Time / Number of Hits ",
              Float (Real_Total) / Float (Number_Of_Hits));

      Status (Pid, Entry_Exit, "<-- Exit procedure Kalman_Main");
   end if;

   if Is_Open (Hit_File) then
      Close (Hit_File);
   end if;

   if Is_Open (Track_File) then
      Close (Track_File);
   end if;

   if Is_Open (Log_File) then
      Close (Log_File);
   end if;

exception
   when others =>
      if (Execute_Debug_Code) then
         Status (Pid, Entry_Exit,
                 "Exception raised in Kalman_Main");
         Status (Pid, Entry_Exit,
                 "<-- Exit procedure Kalman_Main");
      end if;

      Put ("%KALMAN-E-EXCPTN, ");
      Put ("Exception raised in Kalman_Main");
      New_Line;

      if Is_Open (Hit_File) then
         Close (Hit_File);
      end if;

      if Is_Open (Track_File) then
         Close (Track_File);
      end if;

      if Is_Open (Log_File) then
         Close (Log_File);
      end if;

end Kalman_Main;