Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/simu/qsap.src

Text File | 1988-05-03 | 328.4 KB | 10,280 lines

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--qsap1.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--===========================================================
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date   : June 1985
--===========================================================


package Network_Parameters is
--===========================================================
--     Contains QSAP Network Parameters Likely to be altered
--     during system installation.
--============================================================


       --==========Setup Parameters ========================

    Max_Index_Size    : constant Natural := 100;
                       --  Max RealMatrix and RealVector index sizes.
                       --        Also sets Max Number of Nodes.
                       --        Also sets Max Number of Jobs.

    Max_Float_Digits  : constant := 6;

    Max_Moment_Order  : constant := 5;

    Max_Coxian_Stages : constant := 20;

end Network_Parameters;
package MIN_MAX_PAK is

   function MIN (X: INTEGER; Y: INTEGER) return INTEGER;
   function MAX (X: INTEGER; Y: INTEGER) return INTEGER;

end MIN_MAX_PAK;

package body MIN_MAX_PAK is

-- ************************************************************

function MIN (X: INTEGER; Y: INTEGER) return INTEGER is

begin

   if X <= Y then
      return X;
   else
      return Y;
   end if;

end MIN;

-- ************************************************************

function MAX (X: INTEGER; Y: INTEGER) return INTEGER is

begin

   if X >= Y then
      return X;
   else
      return Y;
   end if;

end MAX;

end MIN_MAX_PAK;
with TEXT_IO; use TEXT_IO;
with MIN_MAX_PAK; use MIN_MAX_PAK;
generic
   type REAL is digits <>;
package GEN_TEXT_HANDLER is

    MAX_TEXT_LENGTH: constant INTEGER := 256; -- max length of any text
    SUBSCRIPT_RANGE: exception;

    subtype INDX  is INTEGER range 0 .. MAX_TEXT_LENGTH;
     --==============================================
    type    TEXT (MAX_LENGTH: INDX := 0) is private;
     --==============================================

    function STRNG     (FROM: TEXT; LENG: NATURAL:=0)    return STRING;
    function LENGTH    (FROM: TEXT)                      return INTEGER;
    function EQUAL     (LEFT: TEXT; RIGHT: TEXT)         return BOOLEAN;
    function "<"       (LEFT: TEXT; RIGHT: TEXT)         return BOOLEAN;
    function "<="      (LEFT: TEXT; RIGHT: TEXT)         return BOOLEAN;
    function ">"       (LEFT: TEXT; RIGHT: TEXT)         return BOOLEAN;
    function ">="      (LEFT: TEXT; RIGHT: TEXT)         return BOOLEAN;

    function TXT       (FROM: STRING)                    return TEXT;
    function TXT       (FROM: CHARACTER)                 return TEXT;
    function TXT       (FROM: INTEGER; LENG: INTEGER)    return TEXT;
    function TXT       (FROM: INTEGER)                   return TEXT;
    function TXT       (FROM: REAL)                      return TEXT;

    function "&"       (LEFT: TEXT;   RIGHT: TEXT)       return TEXT;
    function SUBSTR    (FROM: TEXT;   START: INTEGER;
                                      LENG:  INTEGER)    return TEXT;
    function SUBSTR    (FROM: TEXT;   START: INTEGER)    return TEXT;
    function INDEX     (FROM: TEXT;   SEEK:  TEXT)       return INTEGER;
    function BEFORE    (FROM: TEXT;   SEEK:  TEXT)       return TEXT;
    function AFTER     (FROM: TEXT;   SEEK:  TEXT)       return TEXT;
    function TRANSLATE (FROM: TEXT;   CHANGE:TEXT;
                                      SEEK:  TEXT)       return TEXT;
    function UP_CASE   (FROM:TEXT)                       return TEXT;
    function LOW_CASE  (FROM:TEXT)                       return TEXT;
    function REMOVE_LEADING         (FROM: TEXT;
                                     REMOVE: STRING)     return TEXT;
    function REMOVE_TRAILING        (FROM: TEXT;
                                     REMOVE: STRING)     return TEXT;
    function DUPLICATE              (REPEAT: STRING;
                                     TIMES : INTEGER)    return TEXT;

    procedure SET(TO: in out STRING;  FROM: in TEXT);
    procedure SET(TO: out INTEGER; FROM: in TEXT; NUMERIC: out BOOLEAN);
    procedure SET(TO: out REAL;    FROM: in TEXT; NUMERIC: out BOOLEAN);
    procedure SET(TO: out REAL;    FROM: in TEXT);

private

    type TEXT (MAX_LENGTH: INDX := 0) is
    record
        VALUE: STRING (1 .. MAX_LENGTH);
    end record;

end GEN_TEXT_HANDLER;
with TEXT_IO; use TEXT_IO;

package body GEN_TEXT_HANDLER is


   package INT_IO is new INTEGER_IO(INTEGER); use INT_IO;
   package FLT_IO is new FLOAT_IO(REAL);     use FLT_IO;

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

    function STRNG (FROM: TEXT; LENG: NATURAL:=0) return STRING is

       Blank: String (1 .. Leng-Length(From)) := (others => ' ');

    begin

       if    Leng = 0 then
          return From.Value;
       elsif Leng > Length(From) then
          return From.Value & Blank;
       else
          return From.Value(1 .. Leng);
       end if;

    end STRNG;

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

    function LENGTH (FROM: TEXT)  return INTEGER is

    begin
       return FROM.VALUE'LENGTH;
    end LENGTH;

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

    function EQUAL  (LEFT: TEXT; RIGHT: TEXT)  return BOOLEAN is

       NEW_LEFT:  STRING (1 .. RIGHT.VALUE'LENGTH);
       NEW_RIGHT: STRING (1 .. LEFT.VALUE'LENGTH);

    begin
       if    (LEFT.VALUE'LENGTH = RIGHT.VALUE'LENGTH) then
          return  LEFT.VALUE = RIGHT.VALUE;
       elsif (LEFT.VALUE'LENGTH < RIGHT.VALUE'LENGTH) then
          SET    (NEW_LEFT, LEFT);
          return  NEW_LEFT = RIGHT.VALUE;
       else
          SET    (NEW_RIGHT, RIGHT);
          return  LEFT.VALUE = NEW_RIGHT;
       end if;
    end EQUAL;
    function ">"    (LEFT: TEXT; RIGHT: TEXT)  return BOOLEAN is

       NEW_LEFT:  STRING (1 .. RIGHT.VALUE'LENGTH);
       NEW_RIGHT: STRING (1 .. LEFT.VALUE'LENGTH);

    begin
       if    (LEFT.VALUE'LENGTH = RIGHT.VALUE'LENGTH) then
          return  LEFT.VALUE > RIGHT.VALUE;
       elsif (LEFT.VALUE'LENGTH < RIGHT.VALUE'LENGTH) then
          SET    (NEW_LEFT, LEFT);
          return  NEW_LEFT > RIGHT.VALUE;
       else
          SET    (NEW_RIGHT, RIGHT);
          return  LEFT.VALUE > NEW_RIGHT;
       end if;
    end ">";

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

    function "<"    (LEFT: TEXT; RIGHT: TEXT)  return BOOLEAN is

       NEW_LEFT:  STRING (1 .. RIGHT.VALUE'LENGTH);
       NEW_RIGHT: STRING (1 .. LEFT.VALUE'LENGTH);

    begin
       if    (LEFT.VALUE'LENGTH = RIGHT.VALUE'LENGTH) then
          return  LEFT.VALUE < RIGHT.VALUE;
       elsif (LEFT.VALUE'LENGTH < RIGHT.VALUE'LENGTH) then
          SET    (NEW_LEFT, LEFT);
          return  NEW_LEFT < RIGHT.VALUE;
       else
          SET    (NEW_RIGHT, RIGHT);
          return  LEFT.VALUE < NEW_RIGHT;
       end if;
    end "<";

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

    function "<="   (LEFT: TEXT; RIGHT: TEXT)  return BOOLEAN is

    begin
       return  not (LEFT > RIGHT);
    end "<=";

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

    function ">="   (LEFT: TEXT; RIGHT: TEXT)  return BOOLEAN is

    begin
       return  not (LEFT < RIGHT);
    end ">=";
    function TXT    (FROM: STRING)           return TEXT is

    begin
       return (FROM'LENGTH, FROM);
    end TXT;

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

    function TXT    (FROM: CHARACTER)        return TEXT is

       TO: STRING (1 .. 1);

    begin
       TO (1) := FROM;
       return (1, TO);
    end TXT;

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

    function TXT    (FROM: INTEGER; LENG: INTEGER)   return TEXT is

       TO: STRING (1 .. LENG);

    begin
       PUT (TO, FROM);
       return (LENG, TO);
    end TXT;

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

    function TXT  (FROM: INTEGER)  return TEXT is

       TO:   STRING (1 .. 20);

    begin
       PUT (TO, FROM);
       return  REMOVE_LEADING (TXT(TO), " ");
    end TXT;
function Txt (From: Real) return Text is

   S              : String (1 .. 20);
   Exp_Notation   : Text;
   Dec_Notation   : Text;
   E_Position     : Integer;
   Fore           : String (1 .. 1);
   Aft            : Text;
   Exponent       : Text;
   Expon          : Integer;
   Zeros_To_Add   : Integer;
   Mantissa_Length: Integer;
   Sign           : Text;
   Exp_Sign       : Text;
   Numeric        : Boolean;

begin

   Put (S, From, Aft => Real'Digits-1);
   Exp_Notation := Remove_Leading (Up_Case (Txt(S)), " ");
   E_Position   := Index (Exp_Notation, Txt('E'));

   if Substr(Exp_Notation,1,1) = Txt("-") then
      Sign := Txt("-");
      Set (Fore, Substr(Exp_Notation,2,1));
      Aft := Remove_Trailing (Substr(Exp_Notation,4,E_Position-4),"0");
   else
      Sign := Txt("");
      Set (Fore, Substr(Exp_Notation,1,1));
      Aft := Remove_Trailing (Substr(Exp_Notation,3,E_Position-3),"0");
   end if;

   if Length(Aft) = 0 then
      Aft := Txt("0");
   end if;

   Exp_Sign := Substr (Exp_Notation,E_Position+1,1);
   if Exp_Sign = Txt("+") then
      Exp_Sign := Txt("");
   end if;

   Exponent := Remove_Leading (Substr (Exp_Notation,E_Position+2),
               "0");
   Set (Expon, Exp_Sign & Exponent, Numeric);

   Exp_Notation := Sign & Txt(Fore) & Txt(".") & Aft & Txt("e") &
                   Exp_Sign & Exponent;
   Mantissa_length := Length(Sign) + 1 + 1 + Length(Aft);

   if Expon < 0 then
      if Aft = Txt("0") then
         Mantissa_Length:= Mantissa_Length - 1;
         Aft := Txt("");
      end if;

      if Length(Exp_Notation) <= Mantissa_Length + Abs(Expon) then
         return Exp_Notation;
      else
         return Sign & Txt("0.") & Duplicate("0",Abs(Expon)-1) &
                Txt(Fore) & Aft;
      end if;
   else
      Zeros_To_Add := Max (Expon+1 - Length(Aft), 0);

      if Length(Sign) + Expon >= Real'Digits then
         return Exp_Notation;
      else
         Dec_Notation := Txt(Fore) & Aft & Duplicate("0",Zeros_To_Add);
         return Sign & Txt(Fore) & Substr(Dec_Notation,
                2,Expon) & Txt('.') & Substr(Dec_Notation,Expon+2);
      end if;
   end if;

end Txt;
    function "&"    (LEFT: TEXT; RIGHT: TEXT)  return TEXT is

    begin
       return TXT (STRNG(LEFT) & STRNG(RIGHT));
    end "&";

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

    function SUBSTR (FROM: TEXT; START: INTEGER; LENG: INTEGER) return TEXT is

    begin

       if (START < 1) or (START > LENGTH(FROM)) or (LENG < 0) or
          (START+LENG > LENGTH(FROM)+1) then
          raise SUBSCRIPT_RANGE;
       end if;
       return TXT (STRNG(FROM) (START .. START+LENG-1));

    end SUBSTR;

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

    function SUBSTR (FROM: TEXT; START: INTEGER) return TEXT is

    begin

       if (START < 1) or (START > LENGTH(FROM))  then
          raise SUBSCRIPT_RANGE;
       end if;
       return SUBSTR (FROM, START, LENGTH(FROM) + 1 - START);

    end SUBSTR;

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

    function INDEX  (FROM: TEXT; SEEK: TEXT)  return INTEGER is

    begin

       if SEEK.VALUE'LENGTH = 0 then
          return 0;
       end if;

       for IDX in 1 .. INTEGER'(FROM.VALUE'LENGTH - SEEK.VALUE'LENGTH+1) loop
          if FROM.VALUE (IDX .. IDX+SEEK.VALUE'LENGTH-1) = SEEK.VALUE then
             return IDX;
          end if;
       end loop;
       return 0;

    end INDEX;
    function AFTER (FROM: TEXT; SEEK: TEXT)  return TEXT is

       MARK: INTEGER;

    begin
       MARK := INDEX(FROM,SEEK);
       if    MARK = 0 then
          return (LENGTH(FROM), STRNG(FROM));
       elsif MARK+LENGTH(SEEK)-1 < LENGTH(FROM) then
          return SUBSTR (FROM, MARK+LENGTH(SEEK), LENGTH(FROM)-MARK-LENGTH(SEEK)+1);
       else
          return (0, "");
       end if;
    end AFTER;

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

function TRANSLATE (FROM: TEXT; CHANGE: TEXT; SEEK: TEXT) return TEXT is

   LENG: INTEGER := MIN (LENGTH(CHANGE), LENGTH(SEEK));
   TO:   TEXT    := FROM;

begin

   for FROMX in FROM.VALUE'RANGE loop
      for SEEKX in 1 .. LENG loop
         if FROM.VALUE (FROMX) = SEEK.VALUE (SEEKX) then
            TO.VALUE (FROMX) := CHANGE.VALUE(SEEKX);
            exit;
         end if;
      end loop;
   end loop;

   return TO;

end TRANSLATE;

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

function UP_CASE (FROM: TEXT) return TEXT is

begin

   return TRANSLATE (FROM, TXT("ABCDEFGHIJKLMNOPQRSTUVWXYZ"),
                           TXT("abcdefghijklmnopqrstuvwxyz"));

end UP_CASE;
function LOW_CASE (FROM: TEXT) return TEXT is

begin

   return TRANSLATE (FROM, TXT("abcdefghijklmnopqrstuvwxyz"),
                           TXT("ABCDEFGHIJKLMNOPQRSTUVWXYZ"));

end LOW_CASE;

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

function Remove_Leading (From:   Text;
                         Remove: String) return Text is

begin

   for Idx in 1 .. From.Value'Length loop
      if From.Value (Idx .. Idx) /= Remove then
         return (From.Value'Length-Idx+1,
                 From.Value (Idx .. From.Value'Length));
      end if;
   end loop;

   return (0, "");

end Remove_Leading;

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

function Remove_Trailing (From:    Text;
                          Remove:  String) return Text is

begin

   for Idx in reverse 1 .. From.Value'Length  loop
      if From.Value (Idx .. Idx) /= Remove then
         return (Idx, From.Value(1 .. Idx));
      end if;
   end loop;

   return (0, "");

end Remove_Trailing;
function DUPLICATE  (REPEAT: STRING;
                     TIMES : INTEGER)    return TEXT is

   TO:     TEXT := TXT("");

begin

   for CHARX in 1 .. TIMES loop
      TO := TO & TXT(REPEAT);
   end loop;

   return TO;

end DUPLICATE;

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

function BEFORE (FROM: TEXT; SEEK: TEXT)  return TEXT is

   MARK: INTEGER;

begin
   MARK := INDEX(FROM,SEEK);
   if MARK = 0 then
      return (LENGTH(FROM), STRNG(FROM));
   else
      return SUBSTR (FROM, 1, MARK-1);
   end if;
end BEFORE;

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

procedure SET (TO: in out STRING; FROM: in TEXT) is

   OFFSET: INTEGER;

begin
   if (FROM.VALUE'LENGTH <= TO'LENGTH) then
      OFFSET := TO'FIRST - 1;
      TO (1+OFFSET .. FROM.VALUE'LENGTH+OFFSET) := FROM.VALUE;
      for IDX in INTEGER'(FROM.VALUE'LENGTH+1) .. TO'LENGTH loop
         TO (IDX+OFFSET) := ' ';
      end loop;
   else
      TO (1+OFFSET .. TO'LENGTH+OFFSET) := FROM.VALUE (1 .. TO'LENGTH);
   end if;
end SET;
procedure SET (TO: out INTEGER; FROM: in TEXT; NUMERIC: out BOOLEAN) is

   COUNT: POSITIVE;

begin

   GET (FROM.VALUE, TO, COUNT);
   NUMERIC := TRUE;

   exception when others =>
      TO      := 0;
      NUMERIC := FALSE;

end SET;

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

procedure SET (TO: out REAL; FROM: in TEXT; NUMERIC: out BOOLEAN) is

   COUNT: POSITIVE;

begin

   GET (FROM.VALUE, TO, COUNT);
   NUMERIC := TRUE;

   exception when others =>
      TO      := 0.0;
      NUMERIC := FALSE;

end SET;

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

procedure SET (TO: out REAL; FROM: in TEXT) is

   COUNT: POSITIVE;

begin

   GET (FROM.VALUE, TO, COUNT);

end SET;


end GEN_TEXT_HANDLER;

generic
  type ListItem is private;
--**************************
package Gen_List_Handler is
--=================GENERIC LIST HANDLER =======================
--    Exports abstract data type ListType which supports a
--    bi-directionally linked list of User-Defined elements of
--    type ListItem .
--=============================================================


   type ListType is private;

   type BeforeAfter is (Before,After);

   -- *** Movement Operators
   procedure Move_To_First_Item( On        : in out ListType ;
                                 Within_List : out Boolean );

   procedure Move_To_Last_Item( On        : in out ListType ;
                                 Within_List : out Boolean );

   procedure Move_To_Next_Item ( On        : in out ListType ;
                                 Within_List : out Boolean);

   procedure Move_To_Prev_Item ( On          : in out ListType;
                                 Within_List : out Boolean);

   -- *** List Item operators
   procedure Get( From : in ListType;
                  The_Value : out ListItem);

   procedure Insert( Onto  : in out ListType ;
                     The_Value  : in ListItem ;
                     Where : BeforeAfter);

   procedure Remove( From : in out ListType);

   procedure Replace( In_List : in out ListType ;
                      Item : in ListItem);

   procedure Dispose( List : in out ListType);


   -- *** List Attributes
   function Is_Empty( List : in ListType) return Boolean;

   function Is_First_Item ( List : in ListType) return Boolean;

   function Is_Last_Item ( List : in ListType) return Boolean;

   function Length ( List : in ListType) return natural;

   List_Access_Exception : Exception;

   private
      type chain_list;
      type ListCell;

      type chain_list is access ListCell;
      type ListCell is
         record
            Item_Value : ListItem;
            Next_Item  : chain_list;
            Prev_Item  : chain_list;
         end record;

      type ListType is
    record
      head_node : chain_list;
      current_node : chain_list;
    end record;

   end;
with Unchecked_Deallocation;

package body Gen_List_Handler is


    procedure kill_node is new
                         Unchecked_Deallocation(ListCell,chain_list);

 --*************************************************************

    procedure Move_To_First_Item (On       : in out ListType;
                      Within_List: out Boolean) is

        L: chain_list := On.head_node;

      begin
        if L = null then
          Within_List := FALSE;
        else
            Within_List := TRUE;
            On.current_node := L;
        end if;
      end Move_To_First_Item;

 --*************************************************************

    procedure Move_To_Last_Item (On       : in out ListType;
                      Within_List: out Boolean) is

        L: chain_list := On.current_node;

      begin
        if On.head_node = null then
          Within_List := FALSE;
        else
            Within_List := TRUE;
            while L.Next_Item /= null loop
            L:= L.Next_Item;
            end loop;
            On.current_node := L;
        end if;
      end Move_To_Last_Item;


 --*************************************************************

    procedure Move_To_Next_Item (On       : in out ListType;
                      Within_List: out Boolean) is

        L: chain_list := On.current_node;

      begin
        Within_List := FALSE;
        if On.head_node /= null then
           if L.Next_Item /= null then
              Within_List := TRUE;
              L := L.Next_Item;
              On.current_node := L;
           end if;
        end if;
      end Move_To_Next_Item;

 --************************************************************

    procedure Move_To_Prev_Item (On       : in out ListType;
                      Within_List: out Boolean) is

        L: chain_list := On.current_node;

      begin
        Within_List := FALSE;
        if On.head_node /= null then
           if L.Prev_Item /= null then
              Within_List := TRUE;
              L := L.Prev_Item;
              On.current_node := L;
           end if;
        end if;
    end Move_To_Prev_Item;


 --************************************************************

    procedure Get (From        : in ListType;
               The_Value        : out ListItem) is

        L : chain_list := From.current_node;

    begin
      if From.head_node = null then
        raise List_Access_Exception;
      else
        The_Value := L.Item_Value;
      end if;
    end Get;


 --************************************************************

    procedure Insert (Onto        : in out ListType;
              The_Value    : in ListItem;
              Where        : BeforeAfter ) is

        L : chain_list := Onto.current_node;
        N : chain_list;

    begin

      N := new ListCell;
      N.Item_Value := The_Value;
      N.Next_Item  := null;
      N.Prev_Item  := null;

      if Onto.head_node = null then
         Onto.head_node := new ListCell;
         Onto.head_node := N;
         Onto.current_node := N;
         return;
      end if;

      If (Where = After) then

       -- It is to be inserted after
       if L.Next_Item /= null then
        N.Next_Item := L.Next_Item;
        L.Next_Item := N;
        N.Prev_Item := L;
        L := L.Next_Item;
        N := N.Next_Item;
        N.Prev_Item := L;
          else
        L.Next_Item := N;
        N.Prev_Item := L;
        L := L.Next_Item;
       end if;

      else
       -- It is to be inserted before
       if L.Prev_Item /= null then
        L := L.Prev_Item;
        N.Next_Item := L.Next_Item;
        L.Next_Item := N;
        N.Prev_Item := L;
        L := L.Next_Item;
        N := N.Next_Item;
        N.Prev_Item := L;
          else
        N.Next_Item := L;
        L.Prev_Item := N;
        L := L.Prev_Item;
      end if;
     end if;

    if L.Prev_Item = null then
       Onto.head_node := L;
    end if;

    Onto.current_node := L;
    end Insert;

 --***********************************************************

    procedure Remove (From : in out ListType) is

        L : chain_list := From.current_node;
        N : chain_list;

      begin

        if L.Next_Item /= null and L.Prev_Item = null then
        -- remove first node
        N := L;
        L := L.Next_Item;
        N.Next_Item := null;
        L.Prev_Item := null;
        kill_node (N);
        From.head_node := L;

        elsif  L.Next_Item = null and L.Prev_Item /= null then
        -- remove last node
        N := L;
        L := L.Prev_Item;
        N.Prev_Item := null;
        L.Next_Item := null;
        kill_node(N);

        elsif  L.Next_Item /= null and L.Prev_Item /= null then
        -- removing a middle node
        N := L;
        L := L.Prev_Item;
        L.Next_Item := N.Next_Item;
        N.Next_Item := null;
        L := L.Next_Item;
        L.Prev_Item := N.Prev_Item;
        N.Prev_Item := null;
        kill_node(N);

        else
        -- no node to remove, be sure of it
        kill_node(L);
        From.head_node := null;
            From.current_node := null;
        end if;

        From.current_node := L;

     end Remove;

 --**********************************************************

    procedure Replace (In_List : in out ListType;
               Item    : in ListItem) is

        L : chain_list := In_list.current_node;

     begin
       If In_List.head_node = null then
        raise List_Access_Exception;
       else
        L.Item_value := Item;
        In_list.current_node := L;
       end if;
     end Replace;

 --*********************************************************

    procedure Dispose( List : in out ListType) is

      L : chain_list := List.head_node;
      N : chain_list;

    begin
      if L /= null then
      -- we kill the list
      while L.Next_Item /= null loop
        N := L;
        L := L.Next_Item;
        N.Next_Item := null;
        L.Prev_Item := null;
        kill_node (N);
      end loop;
      kill_node (L);
      kill_node (List.current_node);
      kill_node (List.head_node);
      end if;
    end Dispose;

 --********************************************************

    function Is_Empty(List : in ListType) return Boolean is

      L : chain_list := List.head_node;

      begin
        if L = null then
        return TRUE;
         else
        return FALSE;
        end if;
      end Is_Empty;

 --********************************************************
    function Is_Last_Item (List : in ListType) return Boolean is

      L : chain_list ;

      begin
    if List.head_node = null then
        return TRUE;
    end if;
        L := List.current_node ;
        if L.Next_Item = null then
        return TRUE;
         else
        return FALSE;
        end if;
      end Is_Last_Item;

 --********************************************************
    function Is_First_Item (List : in ListType) return Boolean is

      L : chain_list ;

      begin
    if List.head_node = null then
        return TRUE;
    end if;
        L := List.current_node ;
        if L.Prev_Item = null then
        return TRUE;
         else
        return FALSE;
        end if;
      end Is_First_Item;

 --********************************************************
    function Length ( List : in ListType) return natural is

      L : chain_list := List.head_node;
      N : chain_list;
      counter : natural := 0;

      begin
        if L = null then
        return counter;
        else
        N := L;

        loop
          counter := counter + 1;
          if N.Next_Item = null then
            return counter;
          else
            N := N.Next_Item;
          end if;
        end loop;

        end if;
      end Length;

   end Gen_List_Handler;
generic
   type DynFloat is digits <>;
   type IndexType is range <>;
package Gen_Dyn_Mat is
--==================  GENERIC DYNAMIC MATRIX PACKAGE ==================
--    Exports two Abstract Dynamic Array Types DynMatrix and DynVector.
--    The size of the dynvector(or dynmatrix) can be constrained at  decl
--    time. These arrays must not be constrained at declaration time if
--    they are to be changed during execution(by using the Allocate
--    function or other exported function which returns a Dynamic type).
--             DV : DynVector(5)              -- Constrained to size 5
--             DV : DynVector := Allocate(5); -- Initialized to size 5
--=====================================================================


   --=============DYNAMIC ARRAY TYPES===============
   type DynVector(Size : IndexType := 1) is private;

   type DynMatrix(Row_Size : IndexType   := 1;
                  Col_Size : IndexType   := 1) is private;
   --===============================================


   type    Vect         is array (IndexType range <>) of DynFloat;

   type    Matrx         is array (IndexType   range<>,
                                   IndexType   range<>) of DynFloat;
    -- ******************* DynVector Primitives  **************

    --    Exports the Basic Array Operations (Assignment, Value_Of ...)

   function Allocate (Size   : IndexType) return DynVector;
   function Value_Of(DV      : DynVector;
                     At_Index: IndexType) return DynFloat;

   function Last_Index_Of(DV : DynVector) return IndexType;
   function Dyn_Vector_Of(V  : Vect)      return DynVector;
   function Vector_Of(DV     : DynVector) return Vect;

   procedure Assign(DV       : in out DynVector;
                    At_Index : IndexType ;
                    Value    : DynFloat) ;

   pragma InLine (Allocate, Value_Of, Last_Index_Of, Dyn_Vector_Of,
                  Vector_Of, Assign);

   -- ******************  DynMatrix Primitives ***************

    --    Exports the Basic Matrix  Operations (Assignment, Value_Of ...)

   function Allocate(Row_Size , Col_Size : IndexType) return DynMatrix;

   function Value_Of( DM             : DynMatrix ;
                      At_Row, At_Col : IndexType) return DynFloat;

   function Last_Row_Of(DM  : DynMatrix) return IndexType;

   function Last_Col_Of(DM  : DynMatrix) return IndexType;

   function Dyn_Matrix_Of(M : Matrx)     return DynMatrix;

   function Matrix_Of(DM    : DynMatrix) return Matrx;

   procedure Assign( DM             : in out DynMatrix;
                     At_Row, At_Col : IndexType;
                     Value          : DynFloat);
   pragma InLine (Allocate, Value_Of, Last_Row_Of, Last_Col_Of,
                  Dyn_Matrix_Of, Matrix_Of, Assign );
--****************************** Matrix Library **************
--    Exports Mathematical Operations associated with arrays.
--              **** Vector Operations ****

      function Vectors_OK(V1,V2: DynVector)      return Boolean;

      function "*"       (I : Integer ; V : DynVector) return DynVector;
      function "*"       (R : DynFloat; V : DynVector) return DynVector;
      function "+"       (V1,V2 : DynVector) return DynVector;
      function "-"       (V :     DynVector) return DynVector;
      function "-"       (V1,V2 : DynVector) return DynVector;
      function Dot       (V1,V2 : DynVector) return DynFloat;
      function Sum_Vec   (V :     DynVector) return DynFloat;

      function Make_Mat  (V :     DynVector;
                          Dim :   Positive) return DynMatrix;

      pragma InLine (Vectors_OK , Sum_Vec );

   -- **********   MATRIX operations   **********

      function Mat_Multiply_OK (M1,M2: DynMatrix) return Boolean;
      function Mat_Match       (M1,M2: DynMatrix) return Boolean;

      function "*" (I : Integer ; M : DynMatrix) return DynMatrix;
      function "*" (R : DynFloat ; M : DynMatrix) return DynMatrix;
      function "+" (M1,M2 : DynMatrix) return DynMatrix;
      function "-" (M :     DynMatrix) return DynMatrix;
      function "*" (M1,M2 : DynMatrix) return DynMatrix;
      function "-" (M1,M2 : DynMatrix) return DynMatrix;
      function Transpose_Mat  (M  : DynMatrix) return DynMatrix;

      function Sum_Mat_By_Row (M  : DynMatrix;
                               Row: IndexType) return DynFloat;

      function Sum_Mat_By_Col (M  : DynMatrix;
                               Col: IndexType) return DynFloat;

      function Extract_Row    (M  : DynMatrix;
                              Row : IndexType) return DynVector;

      function Extract_Col    (M  : DynMatrix;
                              Col : IndexType) return DynVector;

      procedure Replace_Row (In_Mat : in out DynMatrix;
                             Row    : IndexType;
                             Value  : in DynVector);

      procedure Replace_Col (In_Mat : in out DynMatrix;
                             Col    : IndexType;
                             Value  : in DynVector);

      pragma InLine ( Mat_Multiply_OK, Mat_Match,  Sum_Mat_By_Row,
                      Sum_Mat_By_Col, Extract_Row, Extract_Col);

      function Unit_Mat (Size : IndexType)    return DynMatrix;
      function Invert_Mat (M : in  DynMatrix) return DynMatrix;

   -- **********   MATRIX and VECTOR operations   **********

      function Vec_Mat_OK (V :   DynVector;
                           M :   DynMatrix) return Boolean;

      function Mat_Vec_OK (M :   DynMatrix;
                           V :   DynVector) return Boolean;

      function "*"        (V :   DynVector;
                           M :   DynMatrix) return DynVector;

      function "*"        (M :   DynMatrix;
                           V :   DynVector) return DynVector;

     pragma InLine (Vec_Mat_OK , Mat_Vec_OK);

   -- **********   EXCEPTIONS **********

      Matrix_Mismatch_Error  : exception;
      Matrix_Inversion_Error : exception;

private
   type DynVector(Size : IndexType := 1) is
      record
        Vec : Vect(1..Size);
      end record;

   type DynMatrix(Row_Size : IndexType   := 1;
                  Col_Size : IndexType   := 1) is
     record
        Mat : Matrx (1  .. Row_Size,
                     1  .. Col_Size);
     end record;

end Gen_Dyn_Mat;

package body Gen_Dyn_Mat is

    --  *** DynVector Primitives  ***

   --*************************************************
   function Allocate( Size:IndexType) return DynVector is
   begin
         return (Size,(others => 0.0));
  end Allocate;

   --*************************************************
   function Value_Of(DV:DynVector; At_Index : IndexType) return DynFloat is
   begin
     return DV.Vec(At_Index);
   end Value_Of;

   --*************************************************
   function Last_Index_Of(DV:DynVector) return IndexType is
   begin
      return DV.Vec'Last;
   end Last_Index_Of;

   --*************************************************
   function Dyn_Vector_Of(V:Vect) return DynVector is
   begin
      return (V'last,(V));
   end Dyn_Vector_Of;

   --*************************************************
   function Vector_Of(DV:DynVector) return Vect is
   begin
      return DV.Vec;
   end Vector_Of;

   -- DynMatrix Primitives

   --*************************************************
   function Allocate( Row_Size, Col_Size : IndexType) return DynMatrix is
   begin
     return (Row_Size,Col_Size,(others=> (others =>0.0)));
   end Allocate;


   --*************************************************
   function Value_Of(DM : DynMatrix;
                     At_Row,At_Col :IndexType) return DynFloat is
   begin
      return DM.Mat(At_Row,At_Col);
   end Value_Of;

   --*************************************************
   procedure Assign(DV:in out DynVector;  At_Index:IndexType; Value:DynFloat)is
   begin
      DV.Vec(At_Index) := Value;
   end Assign;
    -- *** DynMatrix Primitives ***

   --*************************************************
   function Last_Row_Of(DM:DynMatrix) return IndexType is
   begin
      return DM.Mat'Last(1);
   end Last_Row_Of;

   --*************************************************
   function Last_Col_Of(DM:DynMatrix) return IndexType is
   begin
     return DM.Mat'Last(2);
   end Last_Col_Of;

   --*************************************************
   function Dyn_Matrix_Of(M:Matrx) return DynMatrix is
   begin
    return (M'last(1),M'last(2),(M));
   end Dyn_Matrix_Of;

   --*************************************************
   function Matrix_Of(DM:DynMatrix) return Matrx is
   begin
      return DM.Mat;
   end Matrix_Of;

    -- *** Matrix Library Routines  ***
   --*************************************************
   procedure Assign( DM            : in out DynMatrix;
                     At_Row,At_Col : IndexType;
                     Value         : DynFloat)is
   begin
      DM.Mat(At_Row,At_Col) := Value;
   end Assign;

  --   ***** Matrix Library
  function Vectors_OK (V1,V2: DynVector) return Boolean is
     -- Returns true if V1 and V2 have same size
  begin
     return (V1.Vec'Length = V2.Vec'Length);
  end Vectors_OK;

  -- ************************************************************

  function "*" (I : Integer ; V : DynVector) return DynVector is
    Local : DynVector(V.Size);
  begin
    for Row in V.Vec'Range loop
       Local.Vec(Row) := DynFloat(I) * V.Vec(Row);
    end loop;
    return Local;
  end "*";

  -- ************************************************************
  function "*" (R : DynFloat ; V : DynVector) return DynVector is
    Local : DynVector(V.Size);
  begin
    for Row in V.Vec'Range loop
       Local.Vec(Row) := R * V.Vec(Row);
    end loop;
    return Local;
  end "*";

  -- ************************************************************
  function "+" (V1,V2: DynVector) return DynVector is
     Sum : DynVector (V1.Size);
  begin
     if Vectors_OK (V1,V2) then
        for Row in V1.Vec'Range loop
           Sum.Vec(Row) := V1.Vec(Row) + V2.Vec(Row);
        end loop;
        return Sum;
     else
        raise Matrix_Mismatch_Error;
     end if;
  end "+";

  -- ************************************************************

  function "-" (V: DynVector) return DynVector is
     -- Performs unitary minus
     Neg : DynVector(V.Size);
  begin
     for Row in V.Vec'Range loop
        Neg.Vec(Row) := -V.Vec(Row);
     end loop;
     return Neg;
  end "-";

  -- ************************************************************

  function "-" (V1,V2: DynVector) return DynVector is
     -- Performs vector subtraction V1 - V2
     Diff : DynVector(V1.Size);
  begin
     if Vectors_OK (V1,V2) then
        return V1 + (-V2);
     else
        raise Matrix_Mismatch_Error;
     end if;
  end "-";
   -- ************************************************************

  function Dot (V1,V2 :DynVector) return DynFloat is
     -- Performs vector dot product V1 * V2
     Sum: DynFloat;
  begin
     if Vectors_OK (V1,V2) then
        Sum := 0.0;
        for Row in V1.Vec'Range loop
           Sum := Sum + V1.Vec(Row) * V2.Vec(Row);
        end loop;
        return Sum;
     else
        raise Matrix_Mismatch_Error;
     end if;
  end Dot;

  -- ************************************************************

  function Sum_Vec (V: DynVector) return DynFloat is
     -- Sums the elements of vector V
     Sum: DynFloat;
  begin
     Sum := 0.0;
     for Row in V.Vec'Range loop
        Sum := Sum + V.Vec(Row);
     end loop;
     return Sum;
  end Sum_Vec;

  -- ************************************************************

  function Make_Mat (V:   DynVector;
                     Dim: Positive)  return DynMatrix is
     -- Converts V into a matrix. Dim determines in which dimension it goes
     M1: DynMatrix(V.Size,1);
     M2: DynMatrix(1,V.Size);
  begin
     if    (Dim = 1) then
        for Row in V.Vec'Range loop
           M1.Mat (Row,1) := V.Vec(Row);
        end loop;
        return M1;
     elsif (Dim = 2) then
        for Col in V.Vec'Range loop
           M2.Mat (1,Col) := V.Vec(Col);
        end loop;
        return M2;
     else
        raise Matrix_Mismatch_Error;
     end if;
  end Make_Mat;

  -- ************************************************************

  function Mat_Multiply_OK (M1,M2: DynMatrix) return Boolean is
     -- Returns true if number of cols in M1 = number of rows in M2
  begin
     return (M1.Mat'Length(2) = M2.Mat'Length(1));
  end Mat_Multiply_Ok;

  -- ************************************************************

  function Mat_Match (M1,M2: DynMatrix) return Boolean is
     -- Returns true if M1 and M2 have same dimension
  begin
     return (M1.Mat'Length(1) = M2.Mat'Length(1)) and
            (M1.Mat'Length(2) = M2.Mat'Length(2));
  end Mat_Match;

  -- ************************************************************

  function "*" (I : Integer ; M : DynMatrix) return DynMatrix is
    Local : DynMatrix(M.Row_Size,M.Col_Size);
  begin
     for Row in M.Mat'Range(1) loop
        for Col in M.Mat'Range(2) loop
           Local.Mat(Row,Col) := DynFloat(I) * M.Mat(Row,Col);
        end loop;
     end loop;
     return Local;
  end "*";

  -- ************************************************************

  function "*" (R : DynFloat ; M : DynMatrix) return DynMatrix is
    Local : DynMatrix(M.Row_Size,M.Col_Size);
  begin
     for Row in M.Mat'Range(1) loop
        for Col in M.Mat'Range(2) loop
           Local.Mat(Row,Col) := R * M.Mat(Row,Col);
        end loop;
     end loop;
     return Local;
  end "*";


  -- ************************************************************
  function "+" (M1,M2: DynMatrix) return DynMatrix is
     -- Performs matrix addition.
     Sum:       DynMatrix (M1.Row_Size, M1.Col_Size);
  begin
     if Mat_Match (M1,M2) then
        for Row in M1.Mat'Range(1) loop
           for Col in M1.Mat'Range(2) loop
              Sum.Mat(Row,Col) := M1.Mat(Row,Col) + M2.Mat(Row,Col);
           end loop;
        end loop;
        return Sum;
     else
        raise Matrix_Mismatch_Error;
     end if;
  end "+";

  -- ************************************************************

  function "-" (M: DynMatrix) return DynMatrix is
     -- Performs unitary minus
     Neg : DynMatrix (M.Row_Size, M.Col_Size);
  begin
     for Row in M.Mat'Range(1) loop
        for Col in M.Mat'Range(2) loop
           Neg.Mat(Row,Col) := -M.Mat(Row,Col);
        end loop;
     end loop;
     return Neg;
  end "-";

  -- ************************************************************

  function "-" (M1,M2: DynMatrix) return DynMatrix is
     -- Performs matrix substraction M1 - M2
     Diff : DynMatrix (M1.Row_Size, M1.Col_Size);
  begin
     if Mat_Match (M1,M2) then
        return M1 + (-M2);
     else
        raise Matrix_Mismatch_Error;
     end if;
  end "-";

  -- ************************************************************

  function Transpose_Mat (M: DynMatrix) return DynMatrix is
     -- Performs matrix transposition
     Tran: DynMatrix (M.Col_Size, M.Row_Size);
  begin
     for Row in M.Mat'Range(1) loop
        for Col in M.Mat'Range(2) loop
           Tran.Mat(Col,Row) := M.Mat(Row,Col);
        end loop;
     end loop;
     return Tran;
  end Transpose_Mat;

  -- ************************************************************

  function Extract_Row (M:   DynMatrix;
                        Row: IndexType)     return DynVector is
     -- Extracts row Row from M
     Slice: DynVector (M.Col_Size);
  begin
     if Row in M.Mat'Range(1) then
        for Col in M.Mat'Range(2) loop
           Slice.Vec(Col) := M.Mat(Row,Col);
        end loop;
        return Slice;
     else
        raise Matrix_Mismatch_Error;
     end if;
  end Extract_Row;

  -- ************************************************************

  function Extract_Col (M:   DynMatrix;
                        Col: IndexType)     return DynVector is
     -- Extracts column Col from M
     Slice: DynVector (M.Row_Size);
  begin
     if Col in M.Mat'Range(2) then
        for Row in M.Mat'Range(1) loop
           Slice.Vec(Row) := M.Mat(Row,Col);
        end loop;
        return Slice;
     else
        raise Matrix_Mismatch_Error;
     end if;
  end Extract_Col;

  --***************************************************
  procedure Replace_Row (In_Mat : in out DynMatrix; Row  : IndexType;
                         Value  : in DynVector) is
  begin
     if (In_Mat.Mat'Last(2) /= Value.Vec'Last) or
                          (Row not in In_Mat.Mat'Range(1)) then
        raise Matrix_Mismatch_Error;
     end if;
     for Col in In_Mat.Mat'Range(2) loop
        In_Mat.Mat(Row,Col) := Value.Vec(Col);
     end loop;
  end Replace_Row;

  --***************************************************
  procedure Replace_Col (In_Mat : in out DynMatrix; Col  : IndexType;
                         Value  : in DynVector) is
  begin
     if (In_Mat.Mat'last(1) /= Value.Vec'last) or
                          (Col not in In_Mat.Mat'range(2)) then
        raise Matrix_Mismatch_Error;
     end if;
     for Row in In_Mat.Mat'Range(1) loop
        In_Mat.Mat(Row,Col) := Value.Vec(Row);
     end loop;
  end Replace_Col;


  -- ************************************************************

  function Sum_Mat_By_Row  (M:   DynMatrix;
                            Row: IndexType)     return DynFloat is
     -- Sums the elements in row Row of M
  begin
     if Row in M.Mat'range then
        return Sum_Vec (Extract_Row (M,Row));
     else
        raise Matrix_Mismatch_Error;
     end if;
   end Sum_Mat_By_Row;

  -- ************************************************************

  function Sum_Mat_By_Col  (M:   DynMatrix;
                            Col: IndexType)     return DynFloat is
     -- Sums the elements in column Col of M
  begin
     if Col in M.Mat'range then
        return Sum_Vec (Extract_Col (M,Col));
     else
        raise Matrix_Mismatch_Error;
     end if;
  end ;

  -- ************************************************************

  function "*" (M1,M2: DynMatrix) return DynMatrix is
     -- Performs matrix multiplication M1 * M2
     Prod: DynMatrix (M1.Row_Size, M2.Col_Size);
  begin
     if Mat_Multiply_OK (M1,M2) then
        for Row in M1.Mat'Range(1) loop
           for Col in M2.Mat'Range(2) loop
              Prod.Mat(Row,Col) := Dot (Extract_Row(M1,Row), Extract_Col(M2,Col));
           end loop;
        end loop;
        return Prod;
     else
        raise Matrix_Mismatch_Error;
     end if;
  end "*";

  -- ************************************************************

  function Vec_Mat_OK (V: DynVector;
                       M: DynMatrix) return Boolean is
     -- Determines if V * M is defined
  begin
     return (V.Vec'Length = M.Mat'Length(1));
  end Vec_Mat_OK;

  -- ************************************************************

  function Mat_Vec_OK (M: DynMatrix;
                       V: DynVector) return Boolean is
     -- Determines if M * V is defined
  begin
     return (V.Vec'Length = M.Mat'Length(2));
  end Mat_Vec_OK;

  -- ************************************************************

  function "*" (V: DynVector;
                M: DynMatrix) return DynVector is
     -- Performs matrix multiplication V * M where V is considered to
     -- be a 1 by V.Vec'Length matrix
     M_Vec: DynMatrix(1,V.Size);
  begin
     if Vec_Mat_OK (V, M) then
        M_Vec := Make_Mat(V,2);
        return Extract_Row (M_Vec * M, 1);
     else
        raise Matrix_Mismatch_Error;
     end if;
  end "*";

  -- ************************************************************

  function "*" (M: DynMatrix;
                V: DynVector) return DynVector is
     -- Performs matrix multiplication M * V where V is considered to
     -- be a V.Vec'Length by 1 matrix
     M_Vec: DynMatrix(V.Size,1);
  begin
     if Mat_Vec_OK (M, V) then
        M_Vec := Make_Mat(V,1);
        return Extract_Col (M * M_Vec, 1);
     else
        raise Matrix_Mismatch_Error;
     end if;
  end "*";

  -- ************************************************************

  function Unit_Mat(Size: in IndexType) return DynMatrix is
     Unitary : DynMatrix(Size,Size):=(Size,Size,(others=>(others=>0.0)));
  begin
     for RowCol in Unitary.Mat'Range(1) loop
        Unitary.Mat(RowCol,RowCol) := 1.0;
     end loop;
     return Unitary;
  end;

   -- ************************************************************

   function Invert_Mat   (M       : in DynMatrix) return DynMatrix is

    Size :constant IndexType  := M.Mat'Last(1);
    type IndexVector is array (IndexType range <>) of IndexType;
    subtype RowIndex is IndexType range 1.. Size;
    Unit        : DynMatrix(Size,Size):= Unit_Mat(Size);
    Unitary     : DynMatrix(Size,Size):= Unit_Mat(Size);
    Local       : DynMatrix(Size,Size):= M;
    Permut      : IndexVector(1..Size);
    Temp        : DynFloat;
    Norm        : DynFloat;
    Pivot       : DynFloat;
    Virtual_Row : RowIndex ;
    Actual_Row  : RowIndex ;
    Temp_Row    : RowIndex ;
    Found_Pivot : Boolean ;
begin

    if (M.Row_Size /= M.Col_Size) then
       raise Matrix_Mismatch_Error;
    end if;

    for I in Permut'Range loop
      Permut(I) := I;
    end loop;

    for IJ in 1..M.Col_Size loop
      Pivot := 0.0;
      Found_Pivot := False;

          -- Search for Pivot Point in Column IJ
      for I in IJ .. M.Row_Size loop
        Temp := Abs(Local.Mat(Permut(I) , IJ));
        if Temp > Pivot then
           Pivot := Temp;
           Virtual_Row := i;
           Found_Pivot := True;
        end if;
      end loop;

           -- Check for zero Pivot
      if Found_Pivot then
         Pivot := Local.Mat(Permut(Virtual_Row) , IJ);
      end if;
      if (Abs(Pivot) < 1.0E-7 ) then
          raise Matrix_Inversion_Error;
      end if;


           -- Do a Virtual Swapping of Rows by swapping Permut array.

      if Found_Pivot then
         Temp_Row := Permut(IJ);
         Permut(IJ) := Permut(Virtual_Row);
         Permut(Virtual_Row) := Temp_Row;
      end if;

            -- Get the actual row of Local.Mat of the new pivot( now
            --     the virtual row of 'IJ'
      Actual_Row := Permut(IJ);

            -- Divide pivot row by Pivot value.
                          -- (Note: items to left of IJ are Zero!)
      for Run_Col  in IJ.. Local.Col_Size loop
         Temp := Local.Mat(Actual_Row,Run_Col);
         Local.Mat(Actual_Row,Run_Col) := Temp / Pivot;
      end loop;

      for Run_Col in 1.. Local.Col_Size loop
         Temp := Unit.Mat(Actual_Row,Run_Col);
         Unit.Mat(Actual_Row,Run_Col) := Temp / Pivot;
      end loop;

            -- Zero out current column except for actual pivot row
      for Run_Row in 1.. Local.Row_Size loop
         if Run_Row = Actual_Row then
             null;
         else
            Norm := Local.Mat( Run_Row , IJ);
            if Norm = 0.0 then
               null;
            else
               for Run_Col in IJ .. Local.Col_Size loop
                  Temp := Local.Mat(Run_Row,Run_Col);
                  Local.Mat(Run_Row,Run_Col) :=  Temp - Norm *
                                     Local.Mat(Actual_Row,Run_Col);
               end loop;
               for Run_Col in 1 .. Local.Col_Size loop
                  Temp := Unit.Mat(Run_Row,Run_Col);
                  Unit.Mat(Run_Row,Run_Col) := Temp - Norm *
                             Unit.Mat(Actual_Row,Run_Col);
               end loop;
            end if;
         end if;
      end loop;

              -- Unit Matrix now has inverse of Local.Mat. Copy
              -- Unit.Mat into Unitary matrix with re-indexing.

      Unitary := (Unit.Row_Size,Unit.Col_Size,(others=>(others=>0.0)));
      for Row in 1.. M.Row_Size loop
         Actual_Row := Permut(Row);
         for Col in 1..M.Col_Size loop
           Unitary.Mat(Row,Col) := Unit.Mat(Actual_Row,Col);
         end loop;
     end loop;
   end loop;
   return Unitary  ;
end Invert_Mat;


end Gen_Dyn_Mat;
with Network_Parameters; use Network_Parameters;
--**********************************************
package Global_Types is
--==============================================================
--     Defines Constants and Types used globally in QSAP system.
--==============================================================

  Nth_Order : constant Natural := Max_Moment_Order;

  Max_Index : constant Natural  :=Max_Index_Size;

  subtype NumNodes         is Integer   range 0..Max_Index ;
  subtype NumJobs          is Integer   range 0..Max_Index ;
  subtype JobIndex         is Integer   range 1..Max_Index + 1;
  subtype NumErlangStages  is Integer   range 1..Integer'Last;
  subtype NumCoxianStages  is Integer   range 1..Max_Coxian_Stages;
  subtype NumServers       is Integer   range 1.. NumJobs'Last;
  subtype NumMoments       is Integer   range 1.. Nth_Order;

  type Real             is digits Max_Float_Digits;
  subtype MIndex is Natural range 0..Max_Index + 1;

  subtype ExponRate        is Real  range 1.0E-5 .. Real'Last;
  subtype ErlangRate       is Real  range 1.0E-5 .. Real'Last;
  subtype CoxianRate       is Real  range 1.0E-5 .. Real'Last;
  subtype Probs            is Real digits 3  range 0.0 .. 1.0;
  subtype MomentValue   is Real ;

  type CoxianRates  is array (NumCoxianStages range <>) of CoxianRate;
  type ContinProbs  is array (NumCoxianStages range <>) of Probs;
  type NodeMoments  is array (NumMoments range <>) of MomentValue;
  type ServDist     is (Exponential, Erlang, Coxian);
  type ServMode     is (FCFS, P_Share, PR_LCFS, NQ);

  function Map (Ith_Job : NumJobs) return JobIndex;
  --==================Note===========================================
  -- Many Modules require a matrix where the Column index(NumJobs)
  -- must have a range from 0 .. NumJobs'Last. However, the indices in
  -- RealMatrix have a range 1 .. NumJobs'Last+1. Function Map provides
  -- this transformation.  Mat(I,Map(Ith_Job)) --> Mat(I, Ith_Job+1).
  --=================================================================

  subtype NodeName is String(1..15);

  type CoxianDist  (Num_Coxian_Stages: NumCoxianStages :=
                                       NumCoxianStages'First) is
     record
        Contin_Probs: ContinProbs (NumCoxianStages'First ..
                                   Num_Coxian_Stages);
        Coxian_Rates: CoxianRates (NumCoxianStages'First ..
                                   Num_Coxian_Stages);
     end record;

  type ServFunct (Serv_Dist:  ServDist
                              := ServDist'First) is
     record
        case Serv_Dist is
           when Exponential     =>
              Expon_Rate        : ExponRate;
           when Erlang          =>
              Num_Erlang_Stages : NumErlangStages;
              Erlang_Rate       : ErlangRate;
           when Coxian          =>
              Coxian_Dist       : CoxianDist;
        end case;
     end record;

  type ServDisc is
     record
        Serv_Mode     : ServMode;
        Num_Servers   : NumServers;
        Serv_Funct    : ServFunct;
     end record;

end Global_Types;


package body Global_Types is
   function Map ( Ith_Job : NumJobs) return JobIndex is
   begin
     return JobIndex(Ith_Job + 1);
   end Map;
end Global_Types;
with Global_types;
with Gen_Text_Handler;
package TEXT_HANDLER is new GEN_TEXT_HANDLER(Global_Types.Real);

with Gen_Dyn_Mat;
with Global_Types;use Global_Types;
--***********************************************
package Real_Mat_Pak is
--=============================================================
--     Exports a RealVector and RealMatrix which are dynamic vectors
--     and matrices whose indices are of type MIndex and whose
--     components are of type Real(as defined in package Global_types).
--     Useful DynMatrix and DynVectors operators defined in Gen_Dyn_Mat
--     are also made visible(exported).
--=============================================================
   package Mat_Pak is new Gen_Dyn_Mat(
                          Global_Types.Real, Global_Types.Mindex);
   type    Vector  is  new Mat_Pak.Vect;
   type    Matrix  is  new Mat_Pak.Matrx;

   type RealVector is  new Mat_Pak.DynVector;
   type RealMatrix is  new Mat_Pak.DynMatrix;

    -- ******************* DynVector Primitives  **************
   function Allocate (Size : Mindex) return RealVector
                           renames Real_Mat_Pak.Allocate;

   function Value_Of(DV:RealVector; At_Index: Mindex) return Real
                           renames Real_Mat_Pak.Value_Of;

   function Last_Index_Of(DV:RealVector) return Mindex
                           renames Real_Mat_Pak.Last_Index_Of;

   function Real_Vector_Of(V:Vector) return RealVector;

   function Vector_Of(DV:RealVector) return Vector;

   procedure Assign(DV       : in out RealVector;
                    At_Index : Mindex ;
                    Value    : Real) renames Real_Mat_Pak.Assign;

   function Allocate(Row_Size , Col_Size : Mindex) return RealMatrix
                           renames Real_Mat_Pak.Allocate;

   function Value_Of(DM : RealMatrix ;
                      At_Row, At_Col : Mindex) return Real
                           renames Real_Mat_Pak.Value_Of;

   function Last_Row_Of(DM : RealMatrix) return Mindex
                           renames Real_Mat_Pak.Last_Row_Of;

   function Last_Col_Of(DM : RealMatrix) return Mindex
                           renames Real_Mat_Pak.Last_Col_Of;

   function Real_Matrix_Of(M : Matrix) return RealMatrix;

   function Matrix_Of(DM : RealMatrix) return Matrix;

   procedure Assign( DM             : in out RealMatrix;
                     At_Row, At_Col : Mindex;
                     Value          : Real)
                      renames Real_Mat_Pak.Assign;
--****************************** Matrix Library **************

--          **** Vector Operations ****

      function Vectors_OK      (V1,V2: RealVector)      return Boolean
                           renames Real_Mat_Pak.Vectors_Ok;

      function "*"  (I : Integer ; V : RealVector) return RealVector
                           renames Real_Mat_Pak."*";

      function "*"  (R : Real; V : RealVector) return RealVector
                           renames Real_Mat_Pak."*";

      function "+"  (V1,V2: RealVector)      return RealVector
                           renames Real_Mat_Pak."+";

      function "-"  (V:     RealVector)      return RealVector
                           renames Real_Mat_Pak."-";

      function "-"  (V1,V2: RealVector)      return RealVector
                           renames Real_Mat_Pak."-";

      function Dot  (V1,V2: RealVector)      return Real
                           renames Real_Mat_Pak.Dot;

      function Sum_Vec     (V:     RealVector)      return Real
                           renames Real_Mat_Pak.Sum_Vec;

      function Make_Mat    (V:     RealVector;
                           Dim:   Positive)       return RealMatrix;
   -- **********   MATRIX operations   **********

      function Mat_Multiply_OK (M1,M2: RealMatrix) return Boolean
                           renames Real_Mat_Pak.Mat_Multiply_Ok;

      function Mat_Match  (M1,M2: RealMatrix) return Boolean
                           renames Real_Mat_Pak.Mat_Match;

      function "*"    (I : Integer ; M : RealMatrix) return RealMatrix
                           renames Real_Mat_Pak."*";

      function "*"    (R : Real; M : RealMatrix) return RealMatrix
                           renames Real_Mat_Pak."*";

      function "+"    (M1,M2: RealMatrix) return RealMatrix
                           renames Real_Mat_Pak."+";

      function "-"    (M:     RealMatrix) return RealMatrix
                           renames Real_Mat_Pak."-";

      function "*"    (M1,M2: RealMatrix) return RealMatrix
                           renames Real_Mat_Pak."*";

      function "-"    (M1,M2: RealMatrix) return RealMatrix
                           renames Real_Mat_Pak."-";

      function Transpose_Mat   (M: RealMatrix) return RealMatrix
                           renames Real_Mat_Pak.Transpose_Mat;

      function Sum_Mat_By_Row  (M: RealMatrix; Row: Mindex) return Real
                           renames Real_Mat_Pak.Sum_Mat_By_Row;

      function Sum_Mat_By_Col  (M: RealMatrix; Col: Mindex) return Real
                           renames Real_Mat_Pak.Sum_Mat_By_Col;
      function Extract_Row     (M:   RealMatrix;
                                Row: Mindex)     return RealVector;

      function Extract_Col     (M:   RealMatrix;
                                Col: Mindex)     return RealVector;

      procedure Replace_Row (In_Mat : in out RealMatrix; Row : Mindex;
                             Value : in RealVector);

      procedure Replace_Col (In_Mat : in out RealMatrix; Col : Mindex;
                             Value : in RealVector);


      function Unit_Mat (Size: Mindex)    return RealMatrix
                           renames Real_Mat_Pak.Unit_Mat;

      function Invert_Mat  (M: in  RealMatrix) return RealMatrix
                           renames Real_Mat_Pak.Invert_Mat;

   -- **********   MATRIX and VECTOR operations   **********

      function Vec_Mat_OK      (V:   RealVector;
                                M:   RealMatrix) return Boolean;

      function Mat_Vec_OK      (M:   RealMatrix;
                                V:   RealVector) return Boolean;

      function "*"             (V:   RealVector;
                                M:   RealMatrix) return RealVector;

      function "*"             (M:   RealMatrix;
                                V:   RealVector) return RealVector;

      Matrix_Inversion_Error : exception renames
                                    Mat_Pak.Matrix_Inversion_Error;
      Matrix_Mismatch_Error  : exception renames
                                    Mat_Pak.Matrix_Mismatch_Error;


end Real_Mat_Pak;

package body Real_Mat_Pak is
   use Mat_Pak;

   function Real_Vector_Of(V:Vector) return RealVector is
   begin
        return RealVector(Mat_Pak.Dyn_Vector_Of(Vect(V)));
   end Real_Vector_Of;

   function Vector_Of(DV:RealVector) return Vector is
   begin
        return Vector(Mat_Pak.Vector_Of(DynVector(DV)));
   end Vector_Of;

   function Real_Matrix_Of(M : Matrix) return RealMatrix is
   begin
      return RealMatrix(Mat_Pak.Dyn_Matrix_Of(Matrx(M)));
   end Real_Matrix_Of;

   function Matrix_Of(DM : RealMatrix) return Matrix is
   begin
      return Matrix(Mat_Pak.Matrix_Of(DynMatrix(DM)));
   end Matrix_Of;

   function Make_Mat  (V:     RealVector;
                       Dim:   Positive)  return RealMatrix is
   begin
      return RealMatrix(Mat_Pak.Make_Mat( DynVector(V) , Dim));
   end Make_Mat;


  function Extract_Row    (M  : RealMatrix;
                           Row: Mindex)     return RealVector is
  begin
     return RealVector(Mat_Pak.Extract_Row( DynMatrix(M),Row));
  end Extract_Row;

  function Extract_Col     (M  : RealMatrix;
                            Col: Mindex)     return RealVector is
  begin
     return RealVector(Mat_Pak.Extract_Col( DynMatrix(M), Col));
  end Extract_Col;


  procedure Replace_Row (In_Mat : in out RealMatrix; Row : Mindex;
                          Value : in RealVector) is
  begin
     Replace_Row(In_Mat, Row, DynVector(Value));
  end Replace_Row;

  procedure Replace_Col (In_Mat : in out RealMatrix; Col : Mindex;
                          Value : in RealVector)  is
  begin
     Replace_Col(In_Mat, Col, DynVector(Value));
  end Replace_Col;

  function Vec_Mat_OK      (V:   RealVector;
                            M:   RealMatrix) return Boolean is
  begin
     return Vec_Mat_OK(DynVector(V),M);
  end Vec_Mat_OK;

  function Mat_Vec_OK      (M:   RealMatrix;
                            V:   RealVector) return Boolean is
  begin
     return Mat_Vec_OK(M,DynVector(V));
  end Mat_Vec_OK;

  function "*"             (V:   RealVector;
                            M:   RealMatrix) return RealVector is
  begin
     return RealVector(DynVector(V) * M);
  end "*";

  function "*"             (M:   RealMatrix;
                            V:   RealVector) return RealVector is
  begin
     return RealVector(M * DynVector(V));
  end "*";

end Real_Mat_Pak;
--  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
--*********************************
package FLOATING_CHARACTERISTICS is
--================MACHINE INDEPENDENT FLOATING POINT=================
--  This package is a floating mantissa definition of a binary FLOAT
--  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
--  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
  type EXPONENT_TYPE is new 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;
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**integer (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**integer (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;
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);
  procedure PUT(ITEM : in INTEGER; WIDTH : in FIELD);
  procedure PUT(ITEM : in INTEGER);
  procedure PUT(FILE : in FILE_TYPE; ITEM : in FLOAT);
  procedure PUT(ITEM : in FLOAT);

end NUMERIC_IO;


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 int_io is new text_io.integer_io (integer);
package flt_io is new text_io.float_io (float);
use INT_IO; use FLT_IO;

  procedure GET(FILE : in FILE_TYPE; ITEM : out INTEGER) is
  begin
INT_IO.GET(FILE, ITEM);
  end GET;

  procedure GET(ITEM : out INTEGER) is
  begin
INT_IO.GET(ITEM);
  end GET;

  procedure GET(FILE : in FILE_TYPE; ITEM : out FLOAT) is
  begin
FLT_IO.GET(FILE, ITEM);
  end GET;

  procedure GET(ITEM : out FLOAT) is
  begin
FLT_IO.GET(ITEM);
  end GET;

  procedure PUT(FILE : in FILE_TYPE; ITEM : in INTEGER) is
  begin
INT_IO.PUT(FILE, ITEM);
  end PUT;

  procedure PUT(ITEM : in INTEGER; WIDTH : in FIELD) is
    J, K, M : INTEGER := 0;
  begin
    if WIDTH = 1  then
      case ITEM is
        when 0  => PUT('0');
        when 1  => PUT('1');
        when 2  => PUT('2');
        when 3  => PUT('3');
        when 4  => PUT('4');
        when 5  => PUT('5');
        when 6  => PUT('6');
        when 7  => PUT('7');
        when 8  => PUT('8');
        when 9  => PUT('9');
        when others  => PUT('*');
      end case;
    else
      if ITEM < 0  then
        PUT('-');
        J := -ITEM;
      else
        PUT(' ');
        J := ITEM;
      end if;
      for I in 1..WIDTH-1  loop
        M := 10**(WIDTH - 1 - I);
        K := J / M;
        J := J - K*M;
        NUMERIC_IO.PUT(K, 1);
      end loop;
    end if;
  end PUT;

  procedure PUT(ITEM : in INTEGER) is
  begin
INT_IO.PUT(ITEM);
  end PUT;

  procedure PUT(FILE : in FILE_TYPE; ITEM : in FLOAT) is
  begin
FLT_IO.PUT(FILE, ITEM);
  end PUT;

  procedure PUT(ITEM : in FLOAT) is
  begin
FLT_IO.PUT(ITEM);
  end PUT;

end NUMERIC_IO;
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;



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
--================================================
--      Machine independent basic Math functions.
--===============================================

  EXP_LARGE : FLOAT;
  EXP_SMALL : FLOAT;

  function SQRT(X : FLOAT) return FLOAT;
  function LOG10(X : FLOAT) return FLOAT;
  function EXP(X : FLOAT) return FLOAT;
  function "**"(X, Y : FLOAT) return FLOAT;
  function ATAN(X : FLOAT) return FLOAT;

  ill_neg_SQRT_used_abs,
  ill_SQRT_used_1,
  ill_neg_LOG_used_abs,
  ill_zero_LOG_val,
  ill_LOG_ret_zero,
  ill_large_val_EXP,
  ill_neg_val_EXP,
  ill_EXP_ret_one,
  ill_EXPONENT_used_abs,
  ill_EXPONENT_val,
  ill_large_val_EXPONENT,
  ill_small_val_EXPONENT : exception;

end CORE_FUNCTIONS;




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
      raise ill_neg_SQRT_used_abs;
      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 =>
    raise ill_SQRT_used_1;
    return ONE;
  end SQRT;


    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
      raise ill_neg_LOG_used_abs;
      RESULT := LOG(ABS(X));
    elsif X = ZERO  then
      raise ill_zero_LOG_val;
      RESULT := -XMAX;      --  SUPPOSED TO BE -LARGE
    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 =>
    raise ill_LOG_ret_zero;
    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
      raise ill_large_val_EXP;
      RESULT := XMAX;
    elsif X < SMALLX  then
      raise ill_neg_val_EXP;
      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 =>
    raise ill_EXP_ret_one;
    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;
    raise ill_EXPONENT_used_abs;
      else
        if Y <= ZERO then
          if Y = ZERO then
            RESULT := ZERO;
          else
            RESULT := XMAX;
          end if;
      raise ill_EXPONENT_val;
        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;
    raise ill_large_val_EXPONENT;
      elsif W < FLOAT(ISMALLX) then
        RESULT := ZERO;
    raise ill_small_val_EXPONENT;
      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 "**";



--  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 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;



begin
  EXP_LARGE := LOG(XMAX) * (ONE - EPS);
  EXP_SMALL := LOG(XMIN) * (ONE - EPS);
end CORE_FUNCTIONS;
generic
   type FltType is digits <>;
   type IntType is range <>;
--******************************************************
package Gen_Math is
--=============GENERIC MATH ROUTINES =================================
--     Exports basic math functions used by QSAP tool
--     Installation Notes:
--       o Two versions of package body are supplied:
--          Ada Version                   : Gen_Math_Body_Ada.ada
--          Data General Assembly Version : Gen_Math_Body_DG.ada
--                 (See User's Manual for accessing DG Math Library)
--
--       o Ada Version is portable but very SLOW( >15 times) than DG Ver.
--       o Installer should develop new package body for his particular
--                system.
--===================================================================


   function Log( X : FltType) return FltType;

   function Sqrt( X : FltType ) return FltType ;

   function Exp ( X : FltType ) return FltType;

   pragma INLINE (Log,Sqrt,Exp);

end Gen_Math;
with Core_Functions ;
package body Gen_Math is
--===================================================================

              -- UNIVERSAL MATH VERSION -- Very Slow!

--   Universal version of math library(routines written in Ada lang).
--   Approximately 10-15 times slower than corresponding routines
--   written in Assembly language.
--===================================================================

 function LOGARITHM_10(X:FLOAT) return FLOAT renames CORE_Functions.LOG10;
 function EXPONENTIAL(X:Float) return FLOAT renames CORE_Functions.EXP;
 function SQUARE_ROOT(X:FLOAT) return FLOAT renames CORE_Functions.SQRT;

   --*******************************************
   function Log( X : FltType) return FltType is
      -- Natural Log
   begin
     return FltType(Logarithm_10(Float(X)))/0.4342945;
   end Log;

   --*******************************************
   function Sqrt( X : FltType ) return FltType is
   begin
     return FltType(Square_Root(Float(X)));
   end Sqrt;

    --*******************************************
   function Exp ( X : FltType ) return FltType is
   begin
     return FltType(Exponential(Float(X)));
   end Exp;
end Gen_Math;
generic
   type FltType is digits <>;
   type IntType is range <>;
package Gen_Factorials is
--================Table-Based Generic Factorial Functions ==============
--     Factorial Values up to LARGEST_FACT are computed during package
--     elaboration and are stored in a look-up table (for efficiency
--     purposes).
--======================================================================

   LARGEST_FACT : constant := 50;

   function Fact( I: IntType) return FltType;
     -- Exception FACTORIAL_TOO_LARGE is raised if I > LARGEST_FACT.

   function Log_Fact(I:IntType) return FltType;
     -- Returns the Log of the Factorial. For Factorials greater than
     -- LARGEST_FACT Stirlings Approximation Formula is used.

   function Bin_Coeff( Left:IntType; Right: IntType) return FltType;
     --            Left ! / ( Right ! * (Left - Right) ! )

   FACTORIAL_TOO_LARGE : exception;

end Gen_Factorials;

with Gen_Math;
package body Gen_Factorials is

    package Math_Pak is new Gen_Math(FltType,IntType); use Math_Pak;

    Fact_Table : array (IntType range 0.. Largest_Fact) of FltType;

    --*******************************************
    procedure Initialize_Table is
    begin
      Fact_Table(0) := 1.0;
      for I in 1 .. IntType'(Largest_Fact) loop
         Fact_Table(I) := FltType(I) * Fact_Table(I-1);
      end loop;
    end Initialize_Table;

    --*******************************************
    function Fact(I : IntType) return FltType is
    begin
       if I > LARGEST_FACT then
         raise FACTORIAL_TOO_LARGE;
       end if;
       return Fact_Table(I);
    end Fact;

   function Log_Fact(I : IntType) return FltType is
      F:FltType := FltType(I);
   begin
       if I < Largest_Fact then
           return Log(Fact(I));
       else
               -- Stirlings Formula
           return 0.91894 + (F + 0.5) * Log(F) - F;
       end if;
   end Log_Fact;


    --*******************************************
   function Bin_Coeff( Left:IntType ; Right: IntType ) return FltType is
   begin
      if Left > Right then
         return Fact(Left) / (Fact(Right)* Fact(Left-Right));
      elsif Left=Right then
         return 1.0;
      else
         return 0.0;
      end if;
   end Bin_Coeff;

begin
  Initialize_Table;
end Gen_Factorials;
  with Global_Types; use Global_Types;
  with Real_Mat_Pak; use Real_Mat_Pak;
  --**********************
  package Node_Servicer is
  --=====================================================
  --    Package exports an abstract data type NodeDef which
  --    contains information about a node. Functions are provided
  --    to access and modify this information.
  --=====================================================

    --======================
    type NodeDef is private;
    --======================

    function Create_Node  ( Node_Name          : in NodeName;
                            Status             : in Boolean;
                            Serv_Disc          : in ServDisc;
                            Connect_Probs      : in RealVector)
                                                  return NodeDef;

    function Modify_Node(Node          : in NodeDef;
                         Node_Name     : in NodeName) return NodeDef;

    function Modify_Node(Node          : in NodeDef;
                         Connect_Probs : RealVector) return Nodedef;

    function Modify_Node(Node          : in NodeDef;
                         Serv_Disc     : ServDisc) return Nodedef;

       -- Attributes of NodeDef

    function Name_Of_Node(     Node : in NodeDef) return NodeName;

    function Node_Complete    (Node : in NodeDef) return Boolean;

    function Node_Serv_Disc(   Node : in NodeDef) return ServDisc;

    function Node_Num_Servers ( Node : in NodeDef) return NumServers;

    function Node_Serv_Mode   ( Node : in NodeDef) return ServMode;

    function Node_Serv_Funct(  Node : in NodeDef) return ServFunct;

    function Node_Cox_Dist(    Node : in NodeDef) return CoxianDist;

    function Node_Connect_Prob(Node : in NodeDef) return RealVector;

    Node_Access_Exception : Exception;

  private
     type NodeDef is record
        Node_Name       : NodeName;
        Complete        : Boolean;
        Serv_Disc       : ServDisc;
        Connect_Probs   : RealVector;
     end record;
  end Node_Servicer;
  with Text_Io; use Text_Io;
  package body Node_Servicer is


    --**************************************************************
    function Create_Node  ( Node_Name          : in NodeName;
                            Status             : in Boolean;
                            Serv_Disc          : in ServDisc;
                            Connect_Probs      : in RealVector)
                                                  return NodeDef is
      Node : NodeDef ;
    begin
       Node.Node_Name     := Node_Name;
       Node.Complete      := Status;
       Node.Serv_Disc     := Serv_Disc;
       Node.Connect_Probs := Connect_Probs;
             --***** Compiler Bug-- Compiler dies very painfully
       --Node := (Node_Name,Serv_Disc, Connect_Probs);
       return Node;
    end Create_Node;


    --**************************************************************
    function Modify_Node(Node : in NodeDef ; Node_Name: in NodeName)
                                                    return NodeDef is
       Local_Node :NodeDef := Node;
    begin
       Local_Node.Node_Name := Node_Name;
       return Local_Node;
    end Modify_Node;

    --**************************************************************
    function Modify_Node(Node : in NodeDef ; Connect_Probs : RealVector)
                                                           return Nodedef is
       Local_Node : NodeDef:=Node;
    begin
       Local_Node.Connect_Probs := Connect_Probs;
       return Local_Node;
    end Modify_Node;


    --**************************************************************
    function Modify_Node(Node : in NodeDef ;  Serv_Disc: ServDisc)
                                             return Nodedef is
       Local_Node : NodeDef:=Node;
    begin
       Local_Node.Serv_Disc := Serv_Disc;
       return Local_Node;
    end Modify_Node;



    --**************************************************************
    function Name_Of_Node(    Node  : in NodeDef) return NodeName is
    begin
      return Node.Node_Name;
    end Name_Of_Node;

    --**************************************************************

    function Node_Complete   (Node: in NodeDef) return Boolean is

    begin

      return Node.Complete;

    end Node_Complete;

    --**************************************************************
    function Node_Serv_Disc(   Node : in NodeDef) return ServDisc is
    begin
      return Node.Serv_Disc;
    end Node_Serv_Disc;

    --**************************************************************
    function Node_Num_Servers ( Node : in NodeDef) return NumServers is
    begin
       return Node.Serv_Disc.Num_Servers;
    end Node_Num_Servers;

    --**************************************************************
    function Node_Serv_Mode   ( Node : in NodeDef) return ServMode is
    begin
       return Node.Serv_Disc.Serv_Mode;
    end Node_Serv_Mode;

    --**************************************************************
    function Node_Serv_Funct(   Node : in NodeDef)return ServFunct is
    begin
      return Node.Serv_Disc.Serv_Funct;
    end Node_Serv_Funct;

    --**************************************************************
    function Node_Cox_Dist(    Node : in NodeDef) return CoxianDist is
      Serv_Disc    : ServDisc renames Node.Serv_Disc;
      Serv_Mode : ServMode renames Serv_Disc.Serv_Mode;

    begin
      case Serv_Mode is
         when FCFS =>
           raise Node_Access_Exception;
         when P_Share .. NQ=>
           case Node.Serv_Disc.Serv_Funct.Serv_Dist is
             when Coxian =>
               return Node.Serv_Disc.Serv_Funct.Coxian_Dist;
             when others =>
                raise Node_Access_Exception;
           end case;
      end case;
    end Node_Cox_Dist;

    --**************************************************************
    function Node_Connect_Prob(Node : in NodeDef) return RealVector is
    begin
       return Node.Connect_Probs;
    end  Node_Connect_Prob;


 end Node_Servicer;
with Global_types;use Global_types;
with Node_Servicer; use Node_Servicer;
--***********************************************
package Network is
--====================================================================
-- Provides a storage facility for the MMI subsystem. Nodes are stored
-- as a linked list('Network'). Facilities are provided to access this
-- network(i.e., insert, delete, and replace nodes). Movement along
-- list can be done by position or by searching for a node_name.
--====================================================================

     type BeforeAfter is (Before,After);

     procedure Set_Up_New_Network;

     procedure Move_To ( Find_Node : in NodeName; Found: out Boolean );

     procedure Move_To_First_Node(End_Of_Network : out Boolean);

     procedure Move_To_Next_Node ( End_Of_Network: out Boolean);
       -- Note: above movement routines will ignore empty networks.

     -- ****  Service Function at current Node.

     procedure Insert_Node  ( New_Node : in NodeDef ;
                              Where    : in BeforeAfter);

     procedure Replace_Node ( New_Node : in NodeDef );

     procedure Remove_Node  ;

     procedure Get_Node     ( Node : out NodeDef);

     function Insert_Node ( Find_Node       : in NodeName ;
                            New_Node        : in NodeDef;
                            Where : BeforeAfter   ) return Boolean ;

     function Replace_Node ( Find_Node  : in NodeName;
                             New_Node   : in NodeDef )return Boolean;

     function Remove_Node (Find_Node : in NodeName) return Boolean;

     procedure Get_Node ( Find_Node : in NodeName;
                          Node      : out NodeDef;
                          Found     : out Boolean );

     procedure Get_Node ( Find_Node : in NodeName;
                          Node      : out NodeDef);

      --**** Network Attributes
     function Node_Is_Complete (Find_Node: in NodeName) return Boolean;
     function Is_Empty_Network return Boolean;
     function Is_Last_Node     return Boolean;
     function Count_Nodes      return NumNodes ;

     Network_Access_Exception : Exception;
end Network;

with Text_Io; use Text_Io;
with Unchecked_deallocation;
package body Network is

     type NodeCell;

     type NodePointer is access NodeCell;

     type NodeCell is
        record
          Node : NodeDef;
          Next_Node : NodePointer;
          Prev_Node : NodePointer;
        end record;


     Num_Nodes : NumNodes := 0;
     First_Node      : NodePointer ;
     Current_Node    : NodePointer ;

     The_Network : NodePointer;

      procedure Free is new Unchecked_Deallocation(
                                      NodeCell, NodePointer);


    --**************************************************************
     function Locate_Name (Search_Name : NodeName) return Boolean is
       Ref_Node : NodePointer:= Current_Node;
       Walker   : NodePointer:= First_Node;
     begin
       if First_Node = null then
           return False;
       end if;
       while Walker /= null loop
         if Search_Name = Name_Of_Node(Walker.Node) then
           Current_Node := Walker;
           return True;
         end if;
         Walker := Walker.Next_Node;
       end loop;
       Current_Node := Ref_Node;
       return False;
     end Locate_Name;

    --****************************************
     function Count_Nodes return NumNodes  is
       Ref_Node : NodePointer := Current_Node;
       Walker   : NodePointer := First_Node;
       Num_Nodes : NumNodes :=0;
    begin
      while Walker /= null loop
         Num_Nodes := Num_Nodes + 1;
         Walker := Walker.Next_Node;
      end loop;
      Current_Node := Ref_Node;
      return Num_Nodes;
    end Count_Nodes;

    --******************************
     procedure Set_Up_New_Network is
     begin
         if First_Node = null  then   -- Handle No nodes
            return;
         elsif First_Node.Next_Node = null then  -- Handle only one node
            free(First_Node);
            return;
         end if;

         Current_Node := First_Node.Next_Node;    -- Handle two or more
         while Current_Node/= null loop
           Free(Current_Node.Prev_Node);
           Current_Node := Current_Node.Next_Node;
         end loop;

         Free(Current_Node);
         Free(First_Node);
         Num_Nodes := 0;
     end Set_Up_New_Network;

     -- ****  Movement Operators

     --********************************************************
     procedure Move_To ( Find_Node : in NodeName;
                         Found     : out Boolean ) is
        Walker : NodePointer;
     begin
        Current_Node := First_Node;
        loop
          if Current_Node = null then
              Found := False;
              exit;
          elsif  Find_Node = Name_Of_Node(Current_Node.Node) then
              Found := True;
              exit;
          else
             Current_Node := Current_Node.Next_Node;
          end if;
        end loop;
        return;
     end Move_To;

     --********************************************************
     procedure Move_To_First_Node( End_Of_Network : out Boolean) is
     begin
        if First_Node = null then
           End_Of_Network := True;
        else
           Current_Node := First_Node;
           End_Of_Network := False;
        end if;
     end Move_To_First_Node;

     --********************************************************
     procedure Move_To_Next_Node ( End_Of_Network: out Boolean) is
     begin
        End_Of_Network := False;
        if Current_Node.Next_Node = null then
           End_Of_Network := True;
           return;
        end if;
        Current_Node := Current_Node.Next_Node;
     end Move_To_Next_Node;

     -- ****  Service Functions at current Node.

     --********************************************************
     procedure Insert_Node  ( New_Node : in NodeDef ;
                              Where : in BeforeAfter) is
        Temp_Node : NodePointer;
     begin
        if First_Node = null  then
           First_Node := new NodeCell'(New_Node,null,null);
           First_Node.Node := New_Node;
           Current_Node := First_Node;
           Num_Nodes := 1;

                       -- Handle Single Node Case
        elsif First_Node.Next_Node = null then
          case Where is
             when Before =>
                 Temp_Node := First_Node;
                 First_Node := new NodeCell'( New_Node,
                                              Next_Node => First_Node,
                                              Prev_Node => null);
                 First_Node.Next_Node := Temp_Node;
                 Current_Node := First_Node;

             when After =>
                 Temp_Node := Current_Node;
                 Current_Node:= new NodeCell'( New_Node ,
                                              Next_Node => null,
                                              Prev_Node => First_Node);
                      -- Aggragate Assignment doesnt work properly
                      -- Discriminant records of Node and Prev_Node
                      -- pointer are not working
                 Current_Node.Node:= New_Node;
                 Current_Node.Next_Node := null;
                 Current_Node.Prev_Node := First_Node;
                 Current_Node.Prev_Node.Next_Node := Current_Node;
           end case;
           Num_Nodes := 2;

        else    -- Multi-Nodes
                       -- Handle case where current node is first node
           if Current_Node.Prev_Node = null then
               case Where is
                 when Before =>
                    Temp_Node := First_Node;
                    First_Node := new NodeCell'(New_Node,
                                                Next_Node => First_Node,
                                                Prev_Node => null);
                    First_Node.Node:= New_Node;
                    First_Node.Next_Node := Temp_Node;
                    Current_Node := First_Node;
                    Current_Node.Next_Node.Prev_Node := Current_Node;
                 when After =>
                    Temp_Node := Current_Node;
                    Current_Node := new NodeCell'(
                                    Node      => New_Node,
                                    Next_Node => Current_Node.Next_Node,
                                    Prev_Node => Current_Node);
                    Current_Node.Node := New_Node;
                    Current_Node.Next_Node:=Temp_Node.Next_Node;
                    Current_Node.Prev_Node:=Temp_Node;
                    Current_Node.Prev_Node.Next_Node := Current_Node;
                    Current_Node.Next_Node.Prev_Node := Current_Node;
                 end case;
                       -- Handle case where current node is last node
            elsif  Current_Node.Next_Node = null then
                case Where is
                  when Before =>
                    Temp_Node := Current_Node;
                    Current_Node := new NodeCell'(
                                    Node      => New_Node,
                                    Next_Node => Current_Node,
                                    Prev_Node => Current_Node.Prev_Node);
                    Current_Node.Node := New_Node;
                    Current_Node.Next_Node := Temp_Node;
                    Current_Node.Prev_Node := Temp_Node.Prev_Node;
                    Current_Node.Prev_Node.Next_Node := Current_Node;
                    Current_Node.Next_Node.Prev_Node := Current_Node;
                  when After =>
                    Temp_Node := Current_Node;
                    Current_Node := new NodeCell'(
                                       Node      => New_Node,
                                       Next_Node => null,  -- see note
                                       Prev_Node => Current_Node);
                    Current_Node.Node:= New_Node;
                    Current_Node.Next_Node := null;
                    Current_Node.Prev_Node := Temp_Node;
                    Current_Node.Prev_Node.Next_Node := Current_Node;
                end case;

                     -- Handle case where current node is middle
             else
                case Where is
                   when Before =>
                     Temp_Node := Current_Node;
                     Current_Node := new NodeCell'(
                                    Node      => New_Node,
                                    Next_Node => Current_Node,
                                    Prev_Node => Current_Node.Prev_Node);
                     Current_Node.Node:= New_Node;
                     Current_Node.Next_Node := Temp_Node;
                     Current_Node.Prev_Node := Temp_Node.Prev_Node;
                     Current_Node.Prev_Node.Next_Node := Current_Node;
                     Current_Node.Next_Node.Prev_Node := Current_Node;
                   when After =>
                     Temp_Node := Current_Node;
                     Current_Node := new NodeCell'(
                                    Node      => New_Node,
                                    Next_Node => Current_Node.Next_Node,
                                    Prev_Node => Current_Node);
                     Current_Node.Node:= New_Node;
                     Current_Node.Next_Node := Temp_Node.Next_Node;
                     Current_Node.Prev_Node := Temp_Node;
                     Current_Node.Prev_Node.Next_Node := Current_Node;
                     Current_Node.Next_Node.Prev_Node := Current_Node;
                end case;
             end if;
             Num_Nodes := Num_Nodes + 1;
         end if;
     end Insert_Node;

     --********************************************************
     procedure Replace_Node (New_Node: in NodeDef) is
     begin
        if Current_Node = null then
            raise Network_Access_Exception;
        else
           Current_Node.Node := New_Node;
        end if;
     end Replace_Node;

     --********************************************************
     procedure Remove_Node   is
       Temp_Pointer : NodePointer;
     begin

       if (Current_Node = null) or (First_Node = null) then
          null;

       elsif First_Node.Next_Node = null then
                                  --Remove first in list (1 node)
          First_Node := null;
          Free(Current_Node);

       elsif Current_Node = First_Node then
                                  --Remove first in list (>1 nodes)
          First_Node := First_Node.Next_Node;
          First_Node.Prev_Node := null;
          Free(Current_Node);
          Current_Node := First_Node;

       elsif Current_Node.Next_Node = null then
                                  --Remove last in list (>1 nodes)
          Current_Node := Current_Node.Prev_Node;
          Free(Current_Node.Next_Node);
          Current_Node.Next_Node := null;

       else                       -- Remove from middle of list
          Current_Node.Prev_Node.Next_Node := Current_node.Next_Node;
          Current_Node.Next_Node.Prev_Node := Current_Node.Prev_Node;
          Temp_Pointer  := Current_Node.Next_Node;
          Free(Current_Node);
          Current_Node := Temp_Pointer;
       end if;

       if Num_Nodes /=0 then
          Num_Nodes := Num_Nodes - 1;
       end if;
     end Remove_Node;

     --*****************************************
     procedure Get_Node ( Node : out NodeDef) is
     begin
       if (First_Node = null)  or ( Current_Node = null)  then
          raise Network_Access_Exception ;
       end if;
       Node := Current_Node.Node;
     end Get_Node;


      -- **** Search and Service Functions

     --************************************************
     function Insert_Node ( Find_Node   : in NodeName ;
                            New_Node    : in NodeDef;
                            Where : BeforeAfter   ) return Boolean is
        Found : Boolean := False;
     begin
        Found := Locate_Name (Find_Node);
        if Found then
           Insert_Node ( New_Node , Where);
        end if;
        return Found;
     end Insert_Node;

     --********************************************************
     function Replace_Node ( Find_Node  : in NodeName;
                             New_Node   : in NodeDef ) return Boolean is
        Found : Boolean := False;
     begin
        Found := Locate_Name ( Find_Node);
        if Found then
           Replace_Node (New_Node);
        end if;
        return Found;
     end Replace_Node;

     --********************************************************
     function Remove_Node (Find_Node : in NodeName) return Boolean is
        Found : Boolean := False;
     begin
        Found := Locate_Name( Find_Node);
        if Found then
           Remove_Node ;
        end if;
        return Found;
     end Remove_Node;

     --******************************************
     procedure Get_Node ( Find_Node : in NodeName;
                          Node      : out NodeDef;
                          Found     : out Boolean ) is
     begin
        Found := False;
        if Locate_Name( Find_Node) then
           Get_Node( Node);
           Found := True;
        end if;
     end Get_Node;

     --*******************************************

     procedure Get_Node ( Find_Node : in NodeName;
                          Node      : out NodeDef) is
     begin
        if Locate_Name( Find_Node) then
           Get_Node( Node);
        else
           raise Network_Access_Exception;
        end if;
     end Get_Node;

     --********************************************************

     function Node_Is_Complete (Find_Node: NodeName) return Boolean is

     ND   : NodeDef;
     Found: Boolean;

     begin

        Get_Node (Find_Node, ND, Found);
        if Found then
           return Node_Complete(ND) = True;
        else
           return False;
        end if;

     end Node_Is_Complete;

      --**** Network Attributes

     --*****************************************
     function Is_Empty_Network return Boolean is
     begin
       return First_Node = null;
     end Is_Empty_Network;

     --*************************************

     function Is_Last_Node return Boolean is
     begin
      return Current_Node.Next_Node = null;
     end Is_Last_Node;
 end Network;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--qsap2.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--===========================================================
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date   : June 1985
--===========================================================



with Text_Handler; use Text_Handler;
with Global_Types;

package Mmi_Io is

------------------------------------------------------------------------
-- Input/Output package servicing MMI package and Edit procedure.
-- Command input can be either the terminal or a file via IOmedia
-- type. If input is from a file, then it is echoed on the terminal.
-- Report  output can also be either directed to the terminal,
-- a file, or both.
--
-- The command input line is all characters between consequtive
-- carriage returns.
--
-- A token is all characters of the command input line between
-- consequetive spaces after the characters, ",", "=", ";" are
-- converted to spaces. A token cannot be null.
--
-- Objects are arranged in alphabetical order by class where possible.
------------------------------------------------------------------------


type      IOmedia          is (Terminal, File);
type      IOmode           is (Help, Input, Report, Save, Terminal_Out);
subtype   TerminalFileMode is IOmode range Input  .. Report;
subtype   OutMode          is IOmode range Report .. Terminal_Out;
subtype   FileMode         is IOmode range Help   .. Save;

EOF:      exception;      -- End Of File

procedure Closef       (Mode    : FileMode);

function  Delimit      (From    : Text)            return Text;
  ----------------------------------------------------------------------
  -- Lets \ act as a character delete. Example, Delimit(`abc\`)= `ab`
  ----------------------------------------------------------------------

procedure Flush_Input;
  ----------------------------------------------------------------------
  -- Empties out the current command input line.
  ----------------------------------------------------------------------

procedure Flush_Next_Token;
  ----------------------------------------------------------------------
  -- Removes the next token from the command input line.
  ----------------------------------------------------------------------
--LINEFEED
function  Get_Media    (Mode    : TerminalFileMode) return IOmedia;
  ----------------------------------------------------------------------
  -- Returns the current media setting (terminal or file) for Mode.
  ----------------------------------------------------------------------

function Input_Line return Text;
  ----------------------------------------------------------------------
  -- Returns the current remainder of the input command line.
  ----------------------------------------------------------------------

function Line_Number return Positive;
  ----------------------------------------------------------------------
  -- Returns the current line number.
  ----------------------------------------------------------------------

procedure Openf        (Mode    : FileMode;
                        Name    : String);
  ----------------------------------------------------------------------
  -- Opens file 'Name' according to Mode.
  ----------------------------------------------------------------------

procedure New_Page;
  ----------------------------------------------------------------------
  -- Puts a new page mark onto a report output file. Puts a new
  -- page mark onto the terminal if Terminal_Paging is set.
  ----------------------------------------------------------------------

function  Next_Token_Exists  return Boolean;
  ----------------------------------------------------------------------
  -- Returns True if there is another token in the current command
  -- input line.
  ----------------------------------------------------------------------

function  Page_Length return Positive;
  ----------------------------------------------------------------------
  -- Returns variable Length_Of_Page if either the report output media
  -- is a file or if the variable Terminal_Paging is true. Otherwise it
  -- returns Positive'Last.
  ----------------------------------------------------------------------

function  Page_Number return Positive;
  ----------------------------------------------------------------------
  -- Returns variable Number_Of_Page if either the report output media
  -- is a file or if the variable Terminal_Paging is true. Otherwise it
  -- returns Positive'Last.
  ----------------------------------------------------------------------

procedure Read (Line: out String);
  ----------------------------------------------------------------------
  -- Reads the next line of the Help file.
  ----------------------------------------------------------------------

procedure Replace_Token(Token   : Text);
  ----------------------------------------------------------------------
  -- Puts back a Token into the current command input line.
  ----------------------------------------------------------------------
--LINEFEED
procedure Set_Column   (Column  : Positive);
  ----------------------------------------------------------------------
  -- Sets the Column on the output file and/or the terminal.
  ----------------------------------------------------------------------

procedure Set_Report_Echo (Setting: Boolean);
  ----------------------------------------------------------------------
  -- Sets the Echoing of reports to the terminal in addition to
  -- writing them to the report file.
  ----------------------------------------------------------------------

procedure Set_Media    (Mode    : TerminalFileMode;
                        Media   : IOmedia);
  ----------------------------------------------------------------------
  -- Sets the media to either terminal or file.
  ----------------------------------------------------------------------

procedure Set_Terminal_Paging (On_Off: in Boolean);
  ----------------------------------------------------------------------
  -- Sets the boolean Terminal_Paging which determines whether or not
  -- output to the terminal is to have a paged format.
  ----------------------------------------------------------------------

function  Token         return String;
  ----------------------------------------------------------------------
  -- Returns the next Token wherever it can get it, either the current
  -- command input line or the next one.
  ----------------------------------------------------------------------

procedure Write        (Message : String;
                        Mode    : OutMode := Terminal_Out;
                        Spacing : Natural := 0);
  ----------------------------------------------------------------------
  -- Outputs 'Message' to the output stream identified by Mode.
  ----------------------------------------------------------------------

end MMI_IO;


with Text_Io;      use Text_Io;
package body Mmi_Io is

   Blank         :  constant Text := Txt(" ");
   Blank_Line    :  constant String(1 .. 240) := (others => ' ');
   Help_File     :           File_Type;
   Input_File    :           File_Type;
   Input_Text    :           Text := Txt("");
   Input_Media   :           IOmedia;
   Length_Of_Page:  constant Positive:= 60;
   Mark          :           Natural;
   Report_File   :           File_Type;
   Report_Echo   :           Boolean;
   Report_Media  :           IOmedia;
   Save_File     :           File_Type;
   Terminal_Paging:          Boolean:= False;
--LINEFEED
procedure Closef       (Mode: FileMode) is

begin

   if    Mode = Input then
      Close (Input_File);
   elsif Mode = Report then
      Close (Report_File);
   elsif Mode = Save then
      Close (Save_File);
   elsif Mode = Help then
      Close (Help_File);
   end if;

end Closef;

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

function Delimit (From: Text)   return Text is

   To  : Text    := From & Txt(" ");   -- add a blank for ease of use
   Idx : Integer := 1;

begin

   loop
      exit when Idx > Length(To);

      if Substr (To,Idx,1) = Txt('\') then
         if Idx = 1 then
            To := Substr (To,2);
         elsif Idx = 2 then
            To := Substr (To,3);
            Idx := 1;
         else
            To  := Substr (To,1,Idx-2) & Substr (To,Idx+1);
            Idx := Idx - 1;
         end if;
      else
         Idx := Idx + 1;
      end if;

   end loop;

   return Substr (To,1,Length(To)-1);       -- don't include that blank

end Delimit;
--LINEFEED
procedure Flush_Next_Token is

   Dummy : Text := Txt(Token);

begin

   null;

end Flush_Next_Token;

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

procedure Flush_Input is

begin

   Input_Text := Txt("");

end Flush_Input;

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

function  Get_Media    (Mode : TerminalFileMode) return IOmedia is

begin

   if Mode = Input then
      return Input_Media;
   else
      return Report_Media;
   end if;

end Get_Media;
--LINEFEED
function Input_Line return Text is

   Value: Text := Input_Text;

begin

   Flush_Input;
   return Value;

end Input_Line;

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

function Line_Number return Positive is

begin

   if Report_Media = File then
      return Positive(Text_IO.Line(Report_File));
   else
      return Positive(Text_IO.Line(Standard_Output));
   end if;

end Line_Number;
--LINEFEED
procedure New_Page is

begin

   if Report_Media = File then
      Text_Io.New_Page (Report_File);
   end if;

   if Report_Echo then
      if Terminal_Paging then
         Text_io.New_Page (Standard_Output);
      else
         New_Line (Standard_Output, 2);
      end if;
   end if;

end New_Page;

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

function  Next_Token_Exists return Boolean is

begin

   return not (Remove_Leading (Input_Text, " ") = Txt(""));

end Next_Token_Exists;
--LINEFEED
procedure Openf        (Mode    : FileMode;
                        Name    : String) is

begin

   if    Mode = Input then
      open   (Input_File, In_File, Name);
   elsif Mode = Report then
      create (Report_File, Out_File, Name);
      Set_Page_Length (Report_File, Count(Length_Of_Page));
   elsif Mode = Save then
      create (Save_File, Out_File, Name);
   elsif Mode = Help then
      open   (Help_File, In_File, Name);
   end if;

end Openf;

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

function Page_Length return Positive is

begin

   if (Report_Media = File) or Terminal_Paging then
      return Length_Of_Page;
   else
      return Positive'Last;
   end if;

end Page_Length;

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

function Page_Number return Positive is

begin

   if Report_Media = File then
      return Positive(Text_IO.Page(Report_File));
   else
      return Positive(Text_IO.Page(Standard_Output));
   end if;

end Page_Number;
--LINEFEED
procedure Read (Line: out String) is

begin

   if End_Of_File (Help_File) then
      raise EOF;
   end if;

   Get_Line (Help_File, Line, Mark);

end Read;

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

procedure Replace_Token (Token : Text) is

begin

   Input_Text := Token & Txt(" ") & Input_Text;

end Replace_Token;

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

procedure Set_Column (Column: in Positive) is

begin

   if Report_Media = File then
      Set_Col (Report_File, Positive_Count(Column));
   end if;

   if Report_Echo then
      Set_Col (Standard_Output, Positive_Count(Column));
   end if;

end Set_Column;
--LINEFEED
procedure Set_Report_Echo (Setting: Boolean) is

begin

   Report_Echo := Setting;
   if Report_Media = File and Terminal_Paging then
      Set_Line (Standard_Output, Count(Line_Number));
   end if;

end Set_Report_Echo;

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

procedure Set_Media    (Mode    : TerminalFileMode;
                        Media   : IOmedia) is

begin

   if Mode = Input then
      if Media = Terminal then
         Set_Input (Standard_Input);
         Input_Media := Terminal;
      else
         Set_Input (Input_File);
         Input_Media := File;
      end if;
   else
      if Media = Terminal then
         Report_Media := Terminal;
      else
         if Report_Echo and Terminal_Paging then
            Set_Line (Report_File, Count(Line_Number));
         end if;
         Report_Media := File;
      end if;
   end if;

end Set_Media;
--LINEFEED
procedure Set_Terminal_Paging (On_Off: in Boolean) is

begin

   Terminal_Paging := On_Off;

   if On_Off then
      Set_Page_Length (Standard_Output, Count(Length_Of_Page));
      if Report_Media = File and Report_Echo then
         Set_Line (Standard_Output, Count(Line_Number));
      end if;
   else
      Set_Page_Length (Standard_Output, 0);
   end if;

end Set_Terminal_Paging;
--LINEFEED
function Token  return String is

   Input_String:  String (1 .. 240) := (others => ' ');
   Result      :  Text;
   Leng        :  Integer;

begin

   Input_Text := Remove_Leading (Input_Text, " ");

   while Length(Input_Text) = 0 loop
      if Input_Media = File and then End_Of_File  then
         raise EOF;
      end if;

      Input_String := Blank_Line;
      Get_Line (Input_String, Mark);

      if Mark > 0 then
         Input_Text := Delimit (Translate (Remove_Leading (
            Remove_Trailing(Substr(Txt (Input_String),1,Mark), " "),
            " "),Txt("  "), Txt(",=")));
      end if;

      if Input_Media = File then
         Put_Line (Standard_Output, Strng(Input_Text));
      end if;

   end loop;

   Result := Before (Input_Text, Blank);
   Leng   := Length(Result);

   if Leng > 1 then
      if    Substr(Result,1,1) = Txt("(") then
         Result := Txt("(");
      elsif Substr(Result,Leng,1) = Txt(")")  then
         Result := Substr(Result,1,Leng-1);
      end if;
   end if;

   Input_Text := After  (Input_Text, Result);
   return Strng(Up_Case(Result));

end Token;
--LINEFEED
procedure Write        (Message : String;
                        Mode    : OutMode := Terminal_Out;
                        Spacing:  Natural := 0) is

   procedure Write_It (F: in out File_Type) is

   begin

      Put (F, Message);
      if Spacing > 0 then
         New_line (F, Positive_Count(Spacing));
      end if;

   end Write_It;

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

   procedure Write_It_Standard is

   begin

      Put (Standard_Output, Message);
      if Spacing > 0 then
         New_line (Standard_Output, Positive_Count(Spacing));
      end if;

   end Write_It_Standard;

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

begin

   if    Mode = Save then
      Write_It (Save_File);
   elsif Mode = Terminal_Out then
      Write_It_Standard;
   elsif Mode = Report then
      if Report_Media = File then
         Write_It (Report_File);
      end if;
      if Report_Echo then
         Write_It_Standard;
      end if;
   end if;

end Write;

end MMI_IO;
with Global_Types; use Global_Types;
with Real_Mat_Pak; use Real_Mat_Pak;
package  Report_Types is
--=======================================================
--   Data Types passed to and used by Report procedures.
--=======================================================

    type PBranchData is
       record
          Node_Name  : NodeName;
          PBranch    : RealVector;
       end record;

    type QLengthDistData is
       record
          Node_Name  : NodeName;
          Queue_Dist : RealVector;
       end record;

     type RoutingData is
        record
          By_Node         : NodeName;
          Node_Mean_Tours : Real;
          Node_Var_Tours  : Real;
        end record;

     type  ServiceData is
        record
          By_Node        : NodeName;
          Serv_Reqt_Mean : Real;
          Serv_Reqt_Var  : Real;
          Mean_Residence : Real;
        end record;

     type ArrivalData is
        record
          Node_Name        : NodeName;
          Num_Servers      : NumServers;
          Serv_Mode        : ServMode;
          Rel_Arrival_Freq : Real;
        end record;

      type ServTimeData is
         record
            Node_Name       : NodeName;
            Mean_Serv_Time  : Real;
            Serv_Time_Var   : Real;
            Coeff_Var       : Real;
            Serv_Funct      : ServFunct;
         end record;

--LINEFEED
      type QLengthData is
         record
            Node_Name        : NodeName;
            Q_Length_Mean    : Real;
            Q_Length_Var     : Real;
            Coeff_Var        : Real;
            Thru_Put         : Real;
            Util             : Real;
         end record;

       type ServResponseTime(Serv_Mode: ServMode:=FCFS) is
          record
             Node_Name        : NodeName;
             Resp_Time_Mean   : Real;
             case Serv_Mode is
                when FCFS | NQ =>
                   Resp_Time_Var    : Real;
                   Coeff_Var        : Real;
                when others    =>
                   null;
             end case;
          end record;

       type ResponseTimeData is
          record
             Value : ServResponseTime;
          end record;

end Report_Types;
with Gen_List_Handler;
with Report_Types; use Report_Types;
package Report_Lists is
--===========================================================
--  Instantiations of List Handler packages order to process
--  varying amount of data sent to the Report procedures.
--============================================================

     --********** Procedure Report_PBranch *************************
    package PBranch_List_Handler is new Gen_List_Handler(PBranchData);
    type PBranchList is new PBranch_List_Handler.ListType;

     --********** Procedure Report_Q_Length_Dists ***************
    package Q_Length_Dist_List_Handler is new Gen_List_Handler(QLengthDistData);
    type QLengthDistList is new Q_Length_Dist_List_Handler.ListType;

     --********** Procedure Report_Routing **********************
     package Routing_List_Handler is new Gen_List_Handler(RoutingData);
     type RoutingList  is new Routing_List_Handler.ListType;

     --********** Procedure Report_Service **********************
     package Service_List_Handler is new Gen_List_Handler(ServiceData);
     type ServiceList is new Service_List_Handler.ListType;

     --********** Procedure Report_Arrival_Freqs ****************
     package Arrival_List_Handler is new Gen_List_Handler(ArrivalData);
     type ArrivalList is new Arrival_List_Handler.ListType;

     --********** Procedure Report_Serv_Times *******************
     package Serv_Time_List_Handler is new
                                      Gen_List_Handler(ServTimeData);
     type ServTimeList is new Serv_Time_List_Handler.ListType;

     --********** Procedure Report_Q_Lengths ********************
     package Q_Length_List_Handler is new Gen_List_Handler(QLengthData);
     type QLengthList is new Q_Length_List_Handler.ListType;

     --********** Procedure Report_Response_Times ***************
     package Response_List_Handler is new
                               Gen_List_Handler(ResponseTimeData);
     type ResponseTimeList is new Response_List_Handler.ListType;

end Report_Lists;
--LINEFEED
with MMI_IO       ; use MMI_IO;
with Report_Lists ; use Report_Lists;
with Global_Types ; use Global_Types;
with Real_Mat_Pak ; use Real_Mat_Pak;
with Calendar     ; use Calendar;

package Reports is


   procedure Print_Title (Report_Title: String;
                          Page_Info   : String;
                          T           : Time);

   procedure Report_Arrival_Freqs  (List      : in out ArrivalList);

   procedure Report_GNorms         (GNorms    : in RealVector);

   procedure Report_PBranch        (List      : in out PbranchList);

   procedure Report_Q_Length_Dists (List      : in out QLengthDistList);

   procedure Report_Q_Lengths  (List      : in out QLengthList);

   procedure Report_Response_Times (List     : in out ResponseTimeList);

   procedure Report_Routing     (Starting_Name: in     NodeName;
                                 Return_Name  : in     NodeName;
                                 Mean_Tours   : in     Real;
                                 Var_Tours    : in     Real;
                                 List         : in out RoutingList;
                                 Page_It      : in     Boolean:= False);

   procedure Report_Service     (Starting_name: in     NodeName;
                                 Return_Name  : in     NodeName;
                                 Tot_Mean_Serv: in     Real;
                                 Tot_Residence: in     Real;
                                 List         : in out ServiceList;
                                 Page_It      : in     Boolean:=False);

   procedure Report_Serv_Times  (List         : in out ServTimeList);

   procedure Set_Title          (Title        : in String);

end Reports;
--LINEFEED
with Report_Types ; use Report_Types;
with Text_Handler ; use Text_Handler;
with Gen_Text_Handler;

package body Reports is


   Model_Title   : Text := Txt("");
   Single        : Positive := 1;
   Double        : Positive := 2;
   Report_Width  : constant Positive := 80;

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

   procedure Header_Separator (Length: in Positive) is

   begin

      Write (Strng(Duplicate("_",Length)), Report, Double);

   end Header_Separator;

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

   function Page_Number (Starting_Page: Positive) return Natural is

   begin

      return MMI_IO.Page_Number - Starting_Page;

   end Page_Number;
--LINEFEED
function Pretty_Natural (Int_Value: Natural) return String is

-- Makes a string of length 4 with Int_Value right justified, if it can.

begin

   if Int_Value < 10000 then
      return (Strng(Txt(Int_Value,4)));
   else
      return Strng(Txt(Int_Value));
   end if;

end Pretty_Natural;

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

function Pretty_Float (Float_Value: Real) return String is

   -- Makes a string of length 12 with the decimal point in pos 5.

   type        ReportFloat is digits 4;
   package     RText       is new Gen_Text_Handler(ReportFloat); use RText;
   Val:        RText.Text;
   Idx:        Integer;

begin

   if Float_Value < 1.0e-10 then
      Val := RText.Txt(ReportFloat(0.0));
   else
      Val := RText.Txt(ReportFloat(Float_Value));
   end if;

   Idx := RText.Index(Val,RText.Txt("."));

   return RText.Strng(RText.Duplicate(" ", 5 - Idx) & Val
      & RText.Duplicate(" ", 7 + Idx - RText.Length(Val)));

end Pretty_Float;

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

function Pretty_Prob (Prob_Value  : in Probs) return String is

   -- returns a prob string with the decimal point in position 3

   package    RText is new Gen_Text_Handler(Probs); use RText;

begin

   if    Prob_Value = 1.0 then
      return " 1.0  ";
   elsif Prob_Value < 0.001 then
      return " 0.0  ";
   else
      return "  ." & Strng(After(RText.Txt(Prob_Value),RText.Txt(".")));
   end if;

end Pretty_Prob;
--LINEFEED
procedure Print_Title (Report_Title: String;
                       Page_Info   : String;
                       T           : Time) is

   Title1_Col: Integer:= Abs(Report_Width/2 - (Length(Model_Title)/2));
   Title2_Col: Integer := Abs(Report_Width/2 - (Report_Title'Length/2));
   Date      : Text:= Substr(Txt(Year(T)),3,2) & Txt("/") &
               Txt(Month(T)) & Txt("/") & Txt(Day(T));
   Mil_Time  : Text:= Translate (Txt(Integer(Seconds(T))/3600,2),
               Txt("0"),Txt(" ")) & Txt(":") & Translate (
       Txt((Integer(Seconds(T)) mod 3600) /60,2),Txt("0"),Txt(" "));

begin

   Set_Column (1);
   Write (Page_Info, Report);
   Set_Column (Title1_Col);
   Write (Strng(Model_Title), Report);
   Set_Column (Report_Width - 8);
   Write (Strng(Date), Report);

   Set_Column (Title2_Col);
   Write (Report_Title, Report);
   Set_Column (Report_Width - 8);
   Write (Strng(Mil_Time), Report, Double);

end Print_Title;

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

function Short (Node_Name: NodeName) return String is

begin

   return Strng(Remove_Trailing(Txt(Node_Name)," "));

end Short;
--LINEFEED
procedure Report_Arrival_Freqs (List: in out ArrivalList) is

   Rec            : ArrivalData;
   Leng_NumServers: Integer := Length(Txt(NumServers'Last))+1;
   Within_List    : Boolean;
   T              : Time := Clock;
   Start_Page     : Positive := Positive(MMI_IO.Page_Number);

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

procedure Header is

begin

   Print_Title ("Relative Arrival Frequencies", "Page " &
      Strng(Txt(Page_Number(Start_Page))), T);
   Write ("Node             Number of           Queue      " &
          "     Relative Arrival", Report, Single);
   Write ("Name              Servers          Discipline   " &
          "        Frequency    ", Report, Single);
   Header_Separator (69);

end Header;

begin

   New_Page;
   Header;

   Move_To_First_Item (List, Within_List);
   while Within_List loop
      Get (List, Rec);

      if Line_Number < 5 then
         Header;
      end if;

      Set_Column (1);
      Write (Rec.Node_Name, Report);

      Set_Column (18);
      Write (Strng(Txt(Integer(Rec.Num_Servers),Leng_NumServers)),
             Report);
      Set_Column (38);
      Write (ServMode'Image(Rec.Serv_Mode), Report);

      Set_Column (57);
      Write (Pretty_Float(Rec.Rel_Arrival_Freq), Report, Single);

      Move_To_Next_Item (List, Within_List);
   end loop;

   Write ("", Report, Double);

end Report_Arrival_Freqs;
--LINEFEED
procedure Report_GNorms        (GNorms: in RealVector) is

   T              : Time := Clock;
   Start_Page     : Positive := Positive(MMI_IO.Page_Number);

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

   procedure Header is

   begin

      Print_Title ("Normalization Constants", "Page " &
         Strng(Txt(Page_Number(Start_Page))), T);
      Write ("   m              G (m)", Report, Single);
      Header_Separator (23);

   end Header;

begin

   New_Page;
   Header;

   for Idx in 1 .. Last_Index_Of(Gnorms) loop
      if Line_Number < 5 then
         Header;
      end if;

      Set_Column (1);
      Write (Pretty_Natural(Idx-1), Report);

      Set_Column (17);
      Write (Pretty_Float(Value_Of(GNorms,Idx)), Report, Single);
   end loop;

   Write ("", Report, Double);

end Report_GNorms;

--LINEFEED
procedure Report_PBranch    (List: in out PBranchList) is

  v_length    : Mindex;
  maxval1     : constant integer := 4;
  maxval2     : constant integer := 6;
  rvalue      : real;
  Within_List : Boolean;
  node        : PBranchData;
  T           : Time := clock;
  k           : integer;
  Start_Page  : Positive := Positive(MMI_IO.Page_Number);

  procedure header is

  begin
    Print_Title ("Branch Probabilities", "Page " &
       Strng(Txt(Page_Number(Start_Page))),T);
    Write ("  ------------------------------------------------" &
        "-------------------------", report,single);
    Write ("  ",report,double);
  end header;

  function mult_of_val(i: in integer; val: in integer) return Boolean is

     m,n,j : real;

  begin
    m := real(i);
    n := real(val);
    j := m - ( (real(integer(m/n))) *n);

    if j = real(0.0) then
      return TRUE;
    else
      return FALSE;
    end if;
  end mult_of_val;

  procedure print_legend(size : in integer) is

  begin
    Write("   LEGEND ",report,double);
    Move_To_First_Item(List,Within_List);
    for i in 1..size loop
    Get (List,node);
      Write(Pretty_Natural(i) & "=" & node.Node_Name, Report);
      if mult_of_val(i,maxval1) then
         Set_Column(1);
      end if;
          Move_To_Next_Item (List, Within_List);
    end loop;
    Write(" ",report,single);
    Write ("  ------------------------------------------------" &
        "-------------------------", report,single);
    Write(" ",report,double);
  end print_legend;
--LINEFEED
    -- Report_PBranch begin

begin

  Move_To_First_Item(List,Within_List);
  Get (List,node);
  v_length := Last_Index_Of(node.PBranch);

  New_Page;
  header;
  print_legend(integer(v_length));

  Move_To_First_Item(List,Within_List);

  while Within_List loop
    Get (List,node);
    if Line_Number <= 5 then
    header;
    end if;
    Set_Column(1);
    Write (node.Node_Name,report,single);

    k := 1;
    for i in 1..v_length loop
    rvalue := Value_Of(node.PBranch,mindex(i));
        if Line_Number <= 5 then
       k := 1;
       Set_Column(1);
       header;
         Write (node.Node_Name,report,single);
    end if;
    Write(Pretty_Natural(i) & ")" & Pretty_Prob(rvalue),report);
    Set_Column(k*13);
    k := k+1;
    if mult_of_val(i,maxval2) then
       k := 1;
       Set_Column(1);
    end if;
    end loop;

    Move_To_Next_Item(List, Within_List);
  end loop;
end Report_PBranch;

--LINEFEED
procedure Report_Q_Length_Dists (List   : in out QLengthDistList) is

   T           : Time := Clock;
   Rec         : QLengthDistData;
   Within_List : Boolean;
   Report_Start: Constant Positive := 7;
   Last_Index  : Positive;
   First_Time  : Boolean := True;
   Start_Page  : Positive := Positive(MMI_IO.Page_Number);

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

   procedure Sub_Header is

   begin

      Write ("   m           P {Q = m}      Node: " & Rec.Node_Name,
         Report, Single);
      Header_Separator (24);

   end Sub_Header;

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

   procedure Header is

   begin

      Print_Title ("Queue Length Distributions", "Page " &
         Strng(Txt(Page_Number(Start_Page))), T);
      Sub_Header;

   end Header;
--LINEFEED
begin

   New_Page;

   Move_To_First_Item (List, Within_List);
   While Within_List loop
      Get (List, Rec);
      Last_Index := Last_Index_Of(Rec.Queue_Dist);

      if Line_Number < 5 or First_Time then
         Header;
         First_Time := False;
      elsif Line_Number+10 > Page_Length then
         New_Page;
         Header;
      else
         Sub_Header;
      end if;

      for Idx in 1 .. Last_Index loop
         if Line_Number < 5 then
            Header;
         end if;

         Set_Column (1);
         Write (Pretty_Natural(Idx-1), Report);

         Set_Column (17);
         Write (Pretty_Float(Value_Of(Rec.Queue_Dist,Idx)), Report,
            Single);
      end loop;

      Move_To_Next_Item (List, Within_List);

      Write ("", Report, Double);
   end loop;

end Report_Q_Length_Dists;
--LINEFEED
procedure Report_Q_Lengths  (List: in out QLengthList) is

   Rec            : QLengthData;
   Within_List    : Boolean;
   T              : Time := Clock;
   Start_Page     : Positive := Positive(MMI_IO.Page_Number);

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

   procedure Header is

   begin

      Print_Title ("Queue Lengths", "Page " &
         Strng(Txt(Page_Number(Start_Page))), T);
      Write ("Node          Mean Queue  Queue Length  " &
             "Coefficient of  Throughput  Utilization", Report, Single);
      Write ("Name            Length      Variance    " &
             "  Variation", Report, Single);
      Header_Separator (79);

   end Header;

begin

   New_Page;
   Header;

   Move_To_First_Item (List, Within_List);
   while Within_List loop
      Get (List, Rec);

      if Line_Number < 5 then
         Header;
      end if;

      Set_Column (1);
      Write (Rec.Node_Name, Report);

      Set_Column (16);
      Write (Pretty_Float(Rec.Q_Length_Mean), Report);

      Set_Column (29);
      Write (Pretty_Float(Rec.Q_Length_Var), Report);

      Set_Column (43);
      Write (Pretty_Float(Rec.Coeff_Var), Report);

      Set_Column (57);
      Write (Pretty_Float(Rec.Thru_Put), Report);

      Set_Column (69);
      Write (Pretty_Float(Rec.Util), Report, Single);

      Move_To_Next_Item (List, Within_List);
   end loop;
   Write ("", Report, Double);
end Report_Q_Lengths;
--LINEFEED
procedure Report_Response_Times (List: in out ResponseTimeList) is

   Rec            : ResponseTimeData;
   Within_List    : Boolean;
   T              : Time := Clock;
   Start_Page     : Positive := Positive(MMI_IO.Page_Number);

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

   procedure Header is

   begin

      Print_Title ("Response Times", "Page " &
         Strng(Txt(Page_Number(Start_Page))), T);
      Write ("Node            Mean Response    Response Time" &
             "     Coefficient of", Report, Single);
      Write ("Name                Time           Variance   " &
             "       Variation", Report, Single);
      Header_Separator (65);

   end Header;
--LINEFEED
begin

   New_Page;
   Header;

   Move_To_First_Item (List, Within_List);
   while Within_List loop
      Get (List, Rec);

      Set_Column (1);
      if Line_Number < 5 then
         Header;
      end if;
      Write (Rec.Value.Node_Name, Report);

      Set_Column (18);
      Write (Pretty_Float(Rec.Value.Resp_Time_Mean), Report);

      Set_Column (35);
      case Rec.Value.Serv_Mode is
         when FCFS | NQ =>
            Write (Pretty_Float(Rec.Value.Resp_Time_Var), Report);
         when others    =>
            null;
      end case;

      Set_Column (53);
      case Rec.Value.Serv_Mode is
         when FCFS | NQ =>
            Write (Pretty_Float(Rec.Value.Coeff_Var), Report);
         when others    =>
            null;
      end case;

      Move_To_Next_Item (List, Within_List);
   end loop;

   Write ("", Report, Double);

end Report_Response_Times;
--LINEFEED
procedure Report_Routing  (Starting_Name: in     NodeName;
                           Return_Name  : in     NodeName;
                           Mean_Tours   : in     Real;
                           Var_Tours    : in     Real;
                           List         : in out RoutingList;
                           Page_It      : in     Boolean:= False) is

   T           : Time := Clock;
   Rec         : RoutingData;
   Within_List : Boolean;
   Start_Page  : Positive := Positive(MMI_IO.Page_Number);

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

   procedure Sub_Header is

   begin

      Write ("Start At Node: " & Short(Starting_Name) &
         "  Return To Node: " & Short(Return_Name), Report, Double);
      Write ("Node              Service Tour Mean    " &
      " Service Tour Variance", Report, Single);
      Header_Separator (61);

   end Sub_Header;

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

   procedure Header is

   begin

      Print_Title ("Routing Behavior", "Page " &
         Strng(Txt(Page_Number(Start_Page))), T);
      Sub_Header;

   end Header;
--LINEFEED
begin

   if Page_It or Line_Number+10 > Page_Length then
      New_Page;
      Header;
   else
      Sub_Header;
   end if;

   Move_To_First_Item (List, Within_List);
   While Within_List loop
      Get (List, Rec);

      if Line_Number < 5 then
         Header;
      end if;

      Set_Column (1);
      Write (Rec.By_Node, Report);

      Set_Column (23);
      Write (Pretty_Float(Rec.Node_Mean_Tours), Report);

      Set_Column (47);
      Write (Pretty_Float(Rec.Node_Var_Tours), Report, Single);

      Move_To_Next_Item (List, Within_List);
   end loop;

   Write ("", Report, Single);

   Set_Column (1);
   Write ("Total", Report);

   Set_Column (23);
   Write (Pretty_Float(Mean_Tours), Report);

   Set_Column (47);
   Write (Pretty_Float(Var_Tours), Report);

   Write (" ", Report, Double);

end Report_Routing;
--LINEFEED
procedure Report_Service  (Starting_name  : in     NodeName;
                           Return_Name    : in     NodeName;
                           Tot_Mean_Serv  : in     Real;
                           Tot_Residence  : in     Real;
                           List           : in out ServiceList;
                           Page_It        : Boolean:= False) is

   T           : Time := Clock;
   Rec         : ServiceData;
   Within_List : Boolean;
   Start_Page  : Positive := Positive(MMI_IO.Page_Number);

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

   procedure Sub_Header is

   begin

      Write ("Start At Node: " & Short(Starting_Name) &
         "  Return To Node: " & Short(Return_Name), Report, Double);
      Write ("Node            Service Requirement   " &
         " Service Requirement   Residence Time", Report, Single);
      Write ("Name                   Mean           " &
         "      Variance              Mean     ", Report, Single);
      Header_Separator (75);

   end Sub_Header;

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

   procedure Header is

   begin

      Print_Title ("Service Requirements", "Page " &
         Strng(Txt(Page_Number(Start_Page))), T);
      Sub_Header;

   end Header;
--LINEFEED
begin

   if Page_It or Line_Number+10 > Page_Length then
      New_Page;
      Header;
   else
      Sub_Header;
   end if;

   Move_To_First_Item (List, Within_List);
   While Within_List loop
      Get (List, Rec);

      if Line_Number < 5 then
         Header;
      end if;

      Set_Column (1);
      Write (Rec.By_Node, Report);

      Set_Column (21);
      Write (Pretty_Float(Rec.Serv_Reqt_Mean), Report);

      Set_Column (44);
      Write (Pretty_Float(Rec.Serv_Reqt_Var), Report);

      Set_Column (64);
      Write (Pretty_Float(Rec.Mean_Residence), Report, Single);

      Move_To_Next_Item (List, Within_List);
   end loop;

   Write ("", Report, Single);

   Set_Column (1);
   Write ("Total", Report);

   Set_Column (21);
   Write (Pretty_Float(Tot_Mean_Serv), Report);

   Set_Column (64);
   Write (Pretty_Float(Tot_Residence), Report);

   Write (" ", Report, Double);

end Report_Service;
--LINEFEED
procedure Report_Serv_Times  (List: in out ServTimeList) is

   Rec            : ServTimeData;
   Within_List    : Boolean;
   T              : Time := Clock;
   C              : CoxianDist;
   type             IntArray is array (1 .. 3) of Integer;
   Coxian_Col     : IntArray := (61, 35, 48);
   Start_Page     : Positive := Positive(MMI_IO.Page_Number);

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

   procedure Header is

   begin

      Print_Title ("Service Time", "Page " &
         Strng(Txt(Page_Number(Start_Page))), T);
      Write ("Node              Service        Mean Service  " &
             "  Service Time    Coefficient of", Report, Single);
      Write ("Name            Distribution         Time       " &
          "    Variance        Variation", Report, Single);
      Header_Separator (79);

   end Header;
--LINEFEED
begin

   New_Page;
   Header;

   Move_To_First_Item (List, Within_List);
   while Within_List loop
      Get (List, Rec);

      if Rec.Serv_Funct.Serv_Dist = Coxian and then
         ((Rec.Serv_Funct.Coxian_Dist.Num_Coxian_Stages/3)+1)*2 +
         3 + Line_Number >= Page_Length then
            New_Page;
      elsif Line_Number + 4 >= Page_Length then
            New_Page;
      end if;

      if Line_Number < 5 then
         Header;
      end if;

      Set_Column (1);
      Write (Rec.Node_Name, Report);

      Set_Column (17);
      Write (ServDist'Image(Rec.Serv_Funct.Serv_Dist), Report);

      Set_Column (35);
      Write (Pretty_Float(Rec.Mean_Serv_Time), Report);

      Set_Column (52);
      Write (Pretty_Float(Rec.Serv_Time_Var), Report);

      Set_Column (68);
      Write (Pretty_Float(Rec.Coeff_Var), Report, Double);
--LINEFEED
    Set_Column (17);
      case Rec.Serv_Funct.Serv_Dist is
         when Exponential =>
            Write ("Service Rate:", Report);
            Set_Column (35);
            Write (Pretty_Float(Real(Rec.Serv_Funct.Expon_Rate)),
                   Report, Single);
         when Erlang      =>
            Write ("Number of Stages:", Report);

            Set_Column (35);
            Write (Pretty_Natural(Rec.Serv_Funct.Num_Erlang_Stages),
                   Report, Single);
            Set_Column (17);
            Write ("Service Rate    :", Report);

            Set_Column (35);
            Write (Pretty_Float(Real(Rec.Serv_Funct.Erlang_Rate)),
                   Report, Single);
         when Coxian      =>
            C := Rec.Serv_Funct.Coxian_Dist;
            Write ("Number of Stages:", Report);

            Set_Column (35);
            Write (Pretty_Natural(C.Num_Coxian_Stages), Report, Single);

            Set_Column (17);
            Write ("Service Rates   :", Report);
            For Stagex in 1 .. C.Num_Coxian_Stages loop
               Set_Column (Coxian_Col((Stagex Mod 3)+1));
               Write (Pretty_Float(Real(C.Coxian_Rates(Stagex))),
                      Report);
               if (Stagex mod 3) = 0 then
                  Write (" ", Report, Single);
               end if;
            end loop;

            Set_Column (17);
            Write ("Cbranch Probs   :", Report);
            For Stagex in 1 .. C.Num_Coxian_Stages-1 loop
               Set_Column (Coxian_Col((Stagex Mod 3)+1)+2);
               Write (Pretty_Prob(C.Contin_Probs(Stagex)), Report);
               if (Stagex mod 3) = 0 then
                  Write (" ", Report, Single);
               end if;
            end loop;

      end case;

      Write ("", Report, Double);
      Move_To_Next_Item (List, Within_List);

   end loop;

   Write ("", Report, Double);

end Report_Serv_Times;
--LINEFEED
procedure Set_Title  (Title : in String) is

begin

   Model_Title := Txt(Title);

end Set_Title;

end Reports;
--LINEFEED
with Gen_List_Handler;
with Global_Types; use Global_Types;
--**********************************************************************
package Net_Stats is
--======================================================================
--     ****    CLOSED MODEL STATISTICAL PACKAGE  ****
-- Computational and Display Modules for the QSAP program. Calculate_Stats
--  must be invoked prior to calling any of the Display Modules in order
--  to setup intermediate results required by these display Modules.
--  Each Display module will perform further calculations and then
--======================================================================

  UNSTABLE_SOLUTION : exception;
--=====================================================================
--   UNSTABLE_SOLUTION exception is raised when any equation produces
--     a result that is unrealistic or causes a numeric_error. Many
--     equations will produce very small or very large numbers. If these
--     numbers are beyond the machines capability, then no corrective
--     action is attempted. Decreasing Num_Jobs or changing Serv_Rates
--     seem to help avoid these situations.
--=====================================================================

    package Node_List_Handler is new Gen_List_Handler(NodeName);
    type NodeList is new Node_List_Handler.ListType;
        -- Creates a Linked-List of Node_Names that are passed to
        --   several of the Display routines.

    --**********************************************************
    procedure Calculate_Stats( Num_Jobs : NumJobs);
         -- Restructures and Copies model data from package Network to
         -- package Net_Data_Pak (Global Data Storage). Calculates
         -- intermediate results which are stored in Net_Data_Pak.

    --*********************************************************
    procedure Display_PBranch;
         -- Displays Branching Probabilities.

    --*********************************************************
    procedure Display_Arrival_Freqs ( Node_List : NodeList);
      -- Calculates and displays Arrival Freqs for nodes specified in
      -- Nodelist.

    --********************************************************
    procedure Display_Serv_Times( Node_List : NodeList);
      -- Calculate and displays Service Times Report for nodes specified
      -- in NodeList.

    --*******************************************************
    procedure Display_Response_Times (Node_List : NodeList);
      -- Calculates and displays Response Times for nodes specified in
      -- Nodelist.
--LINEFEED

    --******************************************************
    procedure Display_Q_Lengths ( Node_List : NodeList);
      -- Calculates and displays Q_Lengths, thru_put, and Util.

    --*****************************************************
    procedure Display_GNorms;
      -- Displays all calculated normalization constants.

    --****************************************************
    procedure Display_Q_Length_Dists( Node_List : NodeList);
      -- Calculates and displays Q Length Distributions for nodes
      -- specified in Nodelist.

    --***************************************************
    procedure Display_Routing (From: NodeList;
                                To : NodeList;
                                By : NodeList);
      --  Calculates and displays routing behavior between nodes
      --  specified in the FROM list to nodes specified in the TO
      --  list and traveling by nodes specified in the BY list.

    --**************************************************
    procedure Display_Service(From : NodeList;
                              To   : NodeList;
                              By   : NodeList);
      --  Calculates and displays service behavior between nodes
      --  specified in the FROM list to nodes specified in the
      --  TO list and traveling by nodes specified in the BY list.
end Net_Stats;
--LINEFEED
    with Global_Types; use Global_Types;
    with Real_Mat_Pak; use Real_Mat_Pak;
    with Node_Servicer; use Node_Servicer;
    package Net_Data_Pak is

      -- Global Data used by Statistics and Display Packages

       type NodeStats is
          record
             Node_Def      : Nodedef;
             Moments       : NodeMoments(1..Nth_Order);
             Alpha         : Real      ;          -- Job Flow at Node
             Psi           : RealVector;          -- Equil Probability
             Aux           : RealVector;          -- Auxiliary Distribution
             Phi           : RealVector;          -- Queue Length Distribution
             Thru_Put      : Real;                -- ThroughPut
             Util          : Real ;               -- Utilization
             Mean_Response : Real;
          end record;

       type NodesVector is array(NumNodes range <>) of NodeStats;

       type DynNetwork(Num_Nodes : NumNodes := 1) is
          record
            Nodes : NodesVector(1..Num_Nodes);
          end record;

      -- *** Network Global Data used in Statiscal Modules.

       Num_Jobs    : NumJobs;     -- Current Number of Jobs.
       Num_Nodes   : NumNodes;    -- Current Number of Nodes.
       PB          : RealMatrix;  -- RealMatrix of Branching Probs.
       Net         : DynNetwork;  -- Dyn Array of Nodal Data.
       GNorm       : RealVector;  -- RealVector of Normalization Consts.

       Scal_K      : Real := 0.0; -- Const. used for Betas and Thru_Put.

       procedure Allocate_PB;
       procedure Allocate_GNorm ;
       procedure Allocate_Net ;

--LINEFEED

       function Node_Def_Of(At_Index : NumNodes) return NodeDef;
       procedure Assign_Node_Def (At_Index : NumNodes; Value : NodeDef);

       function Alpha  (At_Index : NumNodes) return Real;
       procedure Assign_Alpha(At_Index : NumNodes; Value : Real);

       function Psi        (At_Index : NumNodes ;
                            At_Job   : JobIndex) return Real;
       procedure Assign_Psi(At_Index : NumNodes;
                            At_Job   : JobIndex;
                            Value    : Real);


       function Aux ( At_Index   : NumNodes ;
                      At_Job     : JobIndex) return Real;
       procedure Assign_Aux(At_Index : NumNodes;
                            At_Job   : JobIndex;
                            Value    : Real);

       function Phi (At_Index    : NumNodes ;
                     At_Job      : JobIndex) return Real;
       procedure Assign_Phi(At_Index : NumNodes;
                            At_Job   : JobIndex;
                            Value    : Real);

       function Thru_Put        (At_Index : NumNodes) return Real;
       procedure Assign_Thru_Put(At_Index : NumNodes;
                             Value        : Real);

       function Util   (At_Index : NumNodes) return Real;
       procedure Assign_Util(At_Index : NumNodes;
                             Value    : Real);

       function Mean_Response (At_Index : NumNodes) return Real;
       procedure Assign_Mean_Response(At_Index : NumNodes;
                                      Value    : Real);

       function Index_To_Name ( Ith_Node  : NumNodes) return NodeName;
       function Name_To_Index ( Node_Name : NodeName) return NumNodes;

       function GNorm_Value  ( At_Index : JobIndex) return Real;
       procedure Assign_GNorm( At_Index : JobIndex; Value : in Real);

       pragma InLine (Node_Def_Of,Assign_Node_Def);
       pragma InLine (Alpha,Assign_Alpha);
       pragma InLine (Psi,Assign_Psi);
       pragma InLine (Phi,Assign_Phi);
       pragma InLine (Aux,Assign_Aux);
       pragma InLine (Thru_Put,Assign_Thru_Put);
       pragma InLine (Util,Assign_Util);
       pragma InLine (Mean_Response,Assign_Mean_Response);
       pragma InLine (GNorm_Value,Assign_GNorm);

       Nodes_Array_Access_Exception : exception;
    end Net_Data_Pak;

    --************************************************************
--LINEFEED
    with Text_IO; use Text_IO;
    package body Net_Data_Pak is
       Net_Index : NumNodes;

       --******************************************************
       procedure Allocate_PB is
       begin
         PB := Allocate(Num_Nodes,Num_Nodes);
       end Allocate_PB;

       --******************************************************
       procedure Allocate_GNorm is
       begin
         GNorm :=  Allocate(Map(Num_Jobs));
       end Allocate_Gnorm;

       --******************************************************
       procedure Allocate_Net is
         Dummy_Node : NodeDef;
         Empty_Node_Stats: NodeStats :=(Node_Def => Dummy_Node,
                                        Moments  => (1..Nth_Order => 0.0),
                                        Alpha    => 0.0,
                                        Psi      => Allocate(Map(Num_Jobs)),
                                        Aux      => Allocate(Map(Num_Jobs)),
                                        Phi      => Allocate(Map(Num_Jobs)),
                                        Thru_Put => 0.0,
                                        Util     => 0.0,
                                        Mean_Response => 0.0);
       begin
           Net := (Num_Nodes,(1..Num_Nodes => Empty_Node_Stats));
       end Allocate_Net;

       --******************************************************
       function Node_Def_Of(At_Index : NumNodes) return NodeDef is
       begin
         return Net.Nodes(At_Index).Node_Def;
       end Node_Def_Of;

       --******************************************************
       procedure Assign_Node_Def (At_Index : NumNodes; Value : NodeDef) is
       begin
         Net.Nodes(At_Index).Node_Def := Value;
       end Assign_Node_Def;

       --******************************************************
       function Alpha  (At_Index : NumNodes) return Real is
       begin
          return Net.Nodes(At_Index).Alpha;
       end Alpha;

       --******************************************************
       procedure Assign_Alpha(At_Index : NumNodes; Value : Real) is
       begin
          Net.Nodes(At_Index).Alpha := Value;
       end Assign_Alpha;

       --******************************************************
       function Psi    (At_Index : NumNodes ;
                        At_Job   : JobIndex) return Real is
       begin
          return Net.Nodes(At_Index).Psi.Vec(At_Job);
       end Psi;

       --******************************************************
       procedure Assign_Psi(At_Index : NumNodes;
                            At_Job   : JobIndex;
                            Value    : Real) is
       begin
          Net.Nodes(At_Index).Psi.Vec(At_Job) := Value;
       end Assign_Psi;

       --******************************************************
       function Phi (At_Index    : NumNodes ;
                     At_Job      : JobIndex) return Real is
       begin
          return Net.Nodes(At_Index).Phi.Vec(At_Job);
       end Phi;

       --******************************************************
       procedure Assign_Phi(At_Index : NumNodes;
                            At_Job   : JobIndex;
                            Value    : Real) is
       begin
          Net.Nodes(At_Index).Phi.Vec(At_Job) := Value;
       end Assign_Phi;
--LINEFEED

       --******************************************************
       function Aux ( At_Index   : NumNodes ;
                      At_Job     : JobIndex) return Real is
       begin
          return Net.Nodes(At_Index).Aux.Vec(At_Job);
       end Aux;

       --******************************************************
       procedure Assign_Aux(At_Index : NumNodes;
                            At_Job   : JobIndex;
                            Value    : Real) is
       begin
          Net.Nodes(At_Index).Aux.Vec(At_Job) := Value;
       end Assign_Aux;

       --******************************************************
       function Thru_Put        (At_Index : NumNodes) return Real is
       begin
          return Net.Nodes(At_Index).Thru_Put;
       end Thru_Put;

       --******************************************************
       procedure Assign_Thru_Put(At_Index : NumNodes;
                             Value        : Real) is
       begin
          Net.Nodes(At_Index).Thru_Put := Value;
       end Assign_Thru_Put;

       --******************************************************
       function Util   (At_Index : NumNodes) return Real is
       begin
          return Net.Nodes(At_Index).Util;
       end Util;

       --******************************************************
       procedure Assign_Util(At_Index : NumNodes;
                             Value    : Real) is
       begin
          Net.Nodes(At_Index).Util := Value;
       end Assign_Util;
--LINEFEED

       --******************************************************
       function Mean_Response (At_Index : NumNodes) return Real is
       begin
          return Net.Nodes(At_Index).Mean_Response;
       end Mean_Response;

       --******************************************************
       procedure Assign_Mean_Response(At_Index : NumNodes;
                                      Value    : Real) is
       begin
          Net.Nodes(At_Index).Mean_Response := Value;
       end Assign_Mean_Response;


       --******************************************************
       function GNorm_Value  ( At_Index : JobIndex) return Real is
       begin
          return Value_Of(GNorm,At_Index);
       end GNorm_Value;

       --******************************************************
       procedure Assign_GNorm ( At_Index : JobIndex; Value : in Real) is
       begin
          Assign(GNorm, At_Index, Value);
       end Assign_GNorm;
--LINEFEED

       --******************************************************
       procedure Move_To_Next_Index is
       begin
         if Net_Index in Net.Nodes'first .. Net.Nodes'Last -1 then
           Net_Index := Net_Index + 1;
         else
           Net_Index := Net.Nodes'first;
         end if;
       end Move_To_Next_Index;

       --******************************************************
       function Index_To_Name ( Ith_Node : NumNodes) return NodeName is
       begin
         return Name_Of_Node(Net.Nodes(Ith_Node).Node_Def);
       end Index_To_Name;


       --******************************************************
       function Name_To_Index ( Node_Name : NodeName) return NumNodes is
         Old_Index : NumNodes := Net_Index;
       begin
         if Net_Index not in Net.Nodes'range then
           Net_Index := Net.Nodes'first;
         end if;
         for I in 1 .. Num_Nodes loop
           if Name_Of_Node(Node_Def_Of(Net_Index)) = Node_Name then
              return Net_Index;
           end if;
           Move_To_Next_Index;
         end loop;
         Net_Index := Old_Index;
         Put("Node_Name : "); Put(Node_Name); Put_Line("not found in Network");
         raise Constraint_Error;
       end Name_To_Index;
   end Net_Data_Pak;
--LINEFEED
with Network;use Network;
with Node_Servicer; use Node_Servicer;
with Report_Types ; use Report_Types;
with Report_Lists; use Report_Lists;
with Reports; use Reports;
with Net_Data_Pak; use Net_Data_Pak;
with Gen_Math;
with Gen_Factorials;
with Text_IO; use Text_Io;
with Real_Mat_Pak; use Real_Mat_Pak;
--************************************************************
package body Net_Stats is



    package Math_Pak is new Gen_Math(Real,Integer); use Math_Pak;
    package Fact_Pak is new Gen_Factorials(Real,Integer); use Fact_Pak;

    -- Many routines receive a list of Node_Names. The following type
    -- and associated routines provide a quick matching mechanism
    -- between the Node_Names and the corresponding Indices of the
    -- array Nodes (stored in Net_Data_Pak).

    type NodeIndexData is
        record
           Node_Name  : NodeName;
           Index      : NumNodes;
        end record;

     package Node_Index_List_Handler is new Gen_List_Handler(NodeIndexData);
     type NodeIndexList is new Node_Index_List_Handler.ListType;

    --**************************************************************
    function Make_Index_List ( Node_List : NodeList)
                                   return NodeIndexList is separate;

    --**************************************************************
    function Is_Match (Search_The_List: NodeIndexList ;
                       For_Node_Index : NumNodes)
                                        return Boolean is separate;

              -- Special SUMMATION Routines
    --************************************************************
    function Queue_Sigma ( Start_Index : NumJobs;
                           End_Index   : NumJobs;
                           Order       : NumMoments;
                           Q_Lengths   : RealVector)
                                           return Real is separate;



    --************************************************************
    function FCFS_Sigma1 (Jobs        : NumJobs;
                          Num_Servers : NumServers ;
                          FCFS_Phi    : RealVector )
                                         return Real is separate;

    --************************************************************
    function FCFS_Sigma2 (Jobs        : NumJobs;
                          Num_Servers : NumServers ;
                          FCFS_Phi    : RealVector )
                                          return Real is separate;

    --************************************************************
    function Calculate_FCFS_Phi(Ith_Node: NumNodes ; Jobs: NumJobs )
                                     return RealVector is separate;

                 -- Bodies for Visible Subprograms

    procedure Calculate_Stats( Num_Jobs:NumJobs) is separate;

    procedure Display_Pbranch is separate;

    procedure Display_Arrival_Freqs ( Node_List : NodeList)
                                                   is separate;

    procedure Display_Serv_Times(Node_List: NodeList) is separate;

    procedure Display_GNorms is separate;

    procedure Display_Response_Times (Node_List : NodeList)
                                                    is separate;

    procedure Display_Q_Length_Dists( Node_List : NodeList)
                                                    is separate;

    procedure Display_Q_Lengths(Node_List: NodeList) is separate;

    procedure Display_Routing (From: NodeList;
                                To : NodeList;
                                By : NodeList) is separate;

    procedure Display_Service(From: NodeList;
                               To : NodeList;
                               By : NodeList) is separate;


end Net_Stats;
--LINEFEED
separate (Net_Stats)
--**************************************************************
function Is_Match (Search_The_List: NodeIndexList ;
                   For_Node_Index : NumNodes) return Boolean is
   --=============================================================
   -- Searchs the NodeIndexList for a match between For_Node_Index
   -- and the list of indices stored in NodeIndexList.
   --=============================================================

     Is_Within_List  : Boolean;
     Node_Index_Data : NodeIndexData;
     Local_Node_List : NodeIndexList := Search_The_List;
     --==========================
     use Node_Index_List_Handler;
  begin
     Move_To_First_Item(Local_Node_List,Is_Within_List);
     while Is_Within_List loop
       Get(From => Local_Node_List , The_Value => Node_Index_Data);
       if For_Node_Index = Node_Index_Data.Index then
          return True;
       end if;
       Move_To_Next_Item(Local_Node_List,Is_Within_List);
     end loop;
     return False;
end Is_Match;
--LINEFEED

separate (Net_Stats)
 --*********************************************************
function Make_Index_List ( Node_List : NodeList)
                                     return NodeIndexList is
   --=======================================================
   -- Makes a NodeIndexList containing Node_Names and the
   -- Corresponding indices of the array Nodes.
   --======================================================
     Node_Index_Data : NodeIndexData;
     Node_Index_List : NodeIndexList;
     Is_Within_List  : Boolean;
     Node_Name       : NodeName;
     Ith_Node        : NumNodes;
     Local_Node_List : NodeList := Node_List;
   --=========================
   use Node_Index_List_Handler;
begin

    Move_To_First_Item(Local_Node_List,Is_Within_List);
    while Is_Within_List loop
      Get(From => Local_Node_List, The_Value =>Node_Name);
      Ith_Node       := Name_To_Index(Node_Name);
      Node_Index_Data := (Node_Name , Ith_Node);

      Insert (Onto         => Node_Index_List,
              The_Value    => Node_Index_Data,
              Where        => After);


      Move_To_Next_Item ( On           => Local_Node_List,
                          Within_List  => Is_Within_List);
   end loop;
   return Node_Index_List;
end Make_Index_List;
--LINEFEED
separate (Net_Stats)
--************************************************************
function Queue_Sigma ( Start_Index : NumJobs;
                       End_Index   : NumJobs;
                       Order       : NumMoments;
                       Q_Lengths   : RealVector) return Real is
   --=========================================================
   -- Summation Operator used in calculating Mean Queue
   -- Length (Eq. 1.2.0.12).
   --=========================================================
   Sum : Real := 0.0;
   Kth : NumMoments renames Order;
   --===============
   use Net_Data_Pak;
begin
   for Mth_Job  in Start_Index .. End_Index loop
       Sum := Sum+ Real(Mth_Job** Kth) *
                          Value_Of(Q_Lengths,Map(Mth_Job));
   end loop;
   return Sum;
end Queue_Sigma;

separate (Net_Stats)
--***************************************************************
function FCFS_Sigma1 (Jobs         : NumJobs;
                       Num_Servers : NumServers ;
                       FCFS_Phi    : RealVector ) return Real is
   --====================================================
   -- Summation Operator used in calculating First Moment
   -- Response time (Eq. 1.2.0.18)
   --====================================================

    Sum : Real:=0.0;
    --=====================
    use Net_Data_Pak;
begin
     for  Ith_Job in 0 .. (Jobs -  Num_Servers) loop
        Sum := Sum + Real(Ith_Job + 1) /Real(Num_Servers) *
                   Value_Of(FCFS_Phi, Map(Ith_Job + Num_Servers));
     end loop;
     return Sum;
end FCFS_Sigma1;

separate (Net_Stats)
--******************************************************
function FCFS_Sigma2 (Jobs         : NumJobs;
                       Num_Servers : NumServers ;
                       FCFS_Phi    : RealVector ) return Real is
   --=====================================================
   -- Summation Operator used in calculating Second Moment
   --   Response  1.2.0.19)
   --====================================================

    Sum : Real:=0.0;
    --======================
    use Net_Data_Pak;
begin
    for  Ith_Job in 0 .. (Jobs - Num_Servers) loop
       Sum := Sum + Real(Ith_Job + 1) /Real(Num_Servers) *
                Value_Of(FCFS_Phi,Map(Ith_Job + Num_Servers)) *
                (Real(Ith_Job + 2)/ Real(Num_Servers) + 2.0);
    end loop;
    return Sum;
end FCFS_Sigma2;
--LINEFEED
separate (Net_Stats)
--*******************************************************
function Calculate_FCFS_Phi(Ith_Node : NumNodes ;
                             Jobs    : NumJobs )
                                    return RealVector is
--==================================================
--   Calculates Phis used in Eq. 1.2.0.18
--==================================================
   FCFS_Phi: RealVector(Map(Jobs));
   Psi_Value : Real;
   Aux_Value : Real;
   G_Value   : Real;
   --=======================
   use Net_Data_Pak;
begin
   for Ith_Job in 0 .. Jobs loop
      Psi_Value := Psi(Ith_Node,Map(Ith_Job));
      Aux_Value := Aux(Ith_Node,Map(Jobs - Ith_Job));
      G_Value := GNorm_Value(Map(Jobs));
      begin
         FCFS_Phi.Vec(Map(Ith_Job)) := Psi_Value* Aux_Value/ G_Value;
      exception
         when others =>
            FCFS_Phi.Vec(Map(Ith_Job)):= Psi_Value/G_Value*Aux_Value;
      end;
   end loop;
   return FCFS_Phi;
end Calculate_FCFS_Phi;
--LINEFEED
separate (Net_Stats)
--***************************************************************
procedure Display_PBranch is
  --=============================================================
  -- Extracts Branching Probs from Net_Data_Pak and sends results
  -- to Reports.Report_Arrival_Freqs.
  --=============================================================
   PBranch_List : PBranchList;
   PBranch_Data : PBranchData;
   --=======================
   use PBranch_List_Handler;
   use Net_Data_Pak;

begin
   for Ith_Node in 1 .. Num_Nodes loop
     PBranch_Data.Node_Name := Index_To_Name(Ith_Node);
     PBranch_Data.PBranch := Extract_Row(PB,Ith_Node);

     Insert ( Onto      => PBranch_List ,
              The_Value => PBranch_Data ,
              Where     => After);
   end loop;

   Reports.Report_PBranch(PBranch_List);
   Dispose (PBranch_List);
end Display_PBranch;
--LINEFEED
 separate (Net_Stats)
--***************************************************************
 procedure Display_Arrival_Freqs ( Node_List : NodeList) is
  --==============================================================
  -- Extracts Alphas from Net_Data_Pak, calculates Relative Arrival
  -- Frequencies and sends results to Reports.Report_Arrival_Freqs.
  --===============================================================
   Node_Name        : NodeName;
   Node_Def         : NodeDef;
   Ith_Node         : NumNodes;
   Serv_Disc        : ServDisc;
   Arrival_List     : ArrivalList;
   Arrival_Data     : ArrivalData;
   Is_Within_List   : Boolean;
   Alpha_Sum        : Real;
   Local_Node_List  : NodeList := Node_List;
   --=============================
   use Arrival_List_Handler;
   use Net_Data_Pak;

   function Sum_Alphas(N_Nodes:NumNodes) return Real is separate;

 begin

    Move_To_First_Item(Local_Node_List,Is_Within_List);
    while Is_Within_List loop
        Get(From => Local_Node_List, The_Value =>Node_Name);
        Ith_Node  := Name_To_Index( Node_Name );
        Node_Def  := Node_Def_Of(Ith_Node);
        Serv_Disc := Node_Serv_Disc(Node_Def);

        Alpha_Sum := Sum_Alphas(Num_Nodes);

        Arrival_Data:=(Node_Name        => Node_Name,
                       Num_Servers      => Serv_Disc.Num_Servers,
                       Serv_Mode        => Serv_Disc.Serv_Mode,
                       Rel_Arrival_Freq => Alpha(Ith_Node)/ Alpha_Sum );

        Insert ( Onto      => Arrival_List ,
                 The_Value => Arrival_Data,
                 Where     => After);

        Move_To_Next_Item (On          => Local_Node_List,
                           Within_List => Is_Within_List);
   end loop;
   Report_Arrival_Freqs( Arrival_List);
   Dispose(Arrival_List);
exception
    when Numeric_Error =>
       Put_Line("Numeric Error raised in Display_Arrival_Freqs");
       raise UNSTABLE_SOLUTION;
    when others =>
       Put_Line("Exception raised in Display_Arrival_Freqs");
       raise;
end Display_Arrival_Freqs;


 separate (Net_Stats.Display_Arrival_Freqs)
 --*****************************************
 function Sum_Alphas(N_Nodes:NumNodes) return Real is
   Sum : Real := 0.0;
   --====================
     use Net_Data_Pak;
 begin
   for Ith_Node in 1 .. N_Nodes loop
      Sum := Sum + Alpha(Ith_Node);
   end loop;
   return Sum;
 end Sum_Alphas;
--LINEFEED
 separate (Net_Stats)
--***************************************************************
 procedure Display_Serv_Times( Node_List : NodeList) is
  --=============================================================
  -- Extracts Service Times for requested nodes and sends results
  -- to Reports.Report_Serv_Times.
  --=============================================================
    Is_Within_List :  Boolean;
    Node_Name      : NodeName;
    Node_Def       : NodeDef;
    Ith_Node       : NumNodes;
    Serv_Funct     : ServFunct;
    M1,M2,Var      : Real;
    Serv_Time_List : ServTimeList;
    Serv_Time_Data : ServTimeData;
    Local_Node_List: NodeList := Node_List;
    --=========================
    use Serv_Time_List_Handler;
    use Net_Data_Pak;
 begin
    Move_To_First_Item(Local_Node_List,Is_Within_List);
    while Is_Within_List loop
       Get(From => Local_Node_List, The_Value =>Node_Name);
       Ith_Node       := Name_To_Index(Node_Name);
       Node_Def       := Node_Def_Of(Ith_Node);
       Serv_Funct     := Node_Serv_Funct(Node_Def);
       M1             := Net.Nodes(Ith_Node).Moments(1);
       M2             := Net.Nodes(Ith_Node).Moments(2);
       Var            := M2 - M1 * M1;

       Serv_Time_Data := (Node_Name       => Node_Name,
                          Serv_Funct      => Serv_Funct,
                          Mean_Serv_Time  => M1,
                          Serv_Time_Var   => Var,
                          Coeff_Var       => Sqrt(Var)/M1);

       Insert (Onto         => Serv_Time_List,
               The_Value    => Serv_Time_Data,
               Where        => After);

       Move_To_Next_Item ( On           => Local_Node_List,
                           Within_List  => Is_Within_List);
    end loop;
    Report_Serv_Times( Serv_Time_List );
    Dispose(Serv_Time_List);
exception
    when Numeric_Error =>
       Put_Line("Numeric Error raised in Display_Serv_Times");
       raise UNSTABLE_SOLUTION;
    when others =>
       Put_Line("Exception raised in Display_Serv_Times");
       raise;
end Display_Serv_Times;
--LINEFEED
 separate (Net_Stats)
 --**********************************************************
 procedure Display_Q_Lengths( Node_List : NodeList) is
  --===========================================================
  -- Calculates Q_Lengths (Mean and Variance) and sends results
  -- to Reports.Report_Q_Lengths.
  --===========================================================
   Is_Within_List   : Boolean;
   Ith_Node         : NumNodes;
   Node_Name        : NodeName;
   Phi_Values       : RealVector;
   Q_L1, Q_L2,Q_Var : Real;
   Q_Length_Data    : QLengthData;
   Q_Length_List    : QLengthList;
   Local_Node_List  : NodeList := Node_List ;
   --==============================
   use Q_Length_List_Handler;
   use Net_Data_Pak;
begin
    Move_To_First_Item(Local_Node_List,Is_Within_List);
    while Is_Within_List loop
       Get(From => Local_Node_List, The_Value =>Node_Name);
       Ith_Node       := Name_To_Index(Node_Name);
       Phi_Values     := Net.Nodes(Ith_Node).Phi;
                                --**************           1
                                -- Eq. 1.2.1.12   E([Q (M)] )
                                --**************      i
       Q_L1           := Queue_Sigma ( Start_Index=> 1 ,
                                       End_Index  => Num_Jobs ,
                                       Order      => 1,
                                       Q_Lengths  => Phi_Values);

                                --**************           2
                                -- Eq. 1.2.1.12   E([Q (M)] )
                                --**************      i
       Q_L2           := Queue_Sigma ( Start_Index=> 1 ,
                                       End_Index  => Num_Jobs ,
                                       Order      => 2,
                                       Q_Lengths  => Phi_Values);

                                --**************
                                -- Eq. 1.2.1.13   Var([Q (M)] )
                                --**************        i
       Q_Var          := Q_L2 - Q_L1 * Q_L1;

       Q_Length_Data := ( Node_Name     => Node_Name ,
                          Q_Length_Mean => Q_L1 ,
                          Q_Length_Var  => Q_Var,
                          Coeff_Var     => Sqrt(Abs(Q_Var))/Q_L1,
                          Thru_Put      => Thru_Put(Ith_Node),
                          Util          => Util(Ith_Node));
       Insert (Onto         => Q_Length_List,
               The_Value    => Q_Length_Data,
               Where        => After);

       Move_To_Next_Item ( On           => Local_Node_List,
                           Within_List  => Is_Within_List);
    end loop;
    Report_Q_Lengths( Q_Length_List);
    Dispose(Q_Length_List);
exception
    when Numeric_Error =>
       Put_Line("Numeric Error raised in Display_Q_Lengths");
       raise UNSTABLE_SOLUTION;
    when others =>
       Put_Line("Exception raised in Display_Q_Lengths");
       raise;
end Display_Q_Lengths;
--LINEFEED
separate (Net_Stats)
--**********************************************************
procedure Display_Response_Times (Node_List : NodeList) is
  --========================================================
  -- Calculates Response Times (Mean and Variance) and sends
  -- results to Reports.Report_Response_Times.
  --========================================================
    Is_Within_List : Boolean;
    Node_Name      : NodeName;
    Node_Def       : NodeDef;
    Ith_Node       : NumNodes;
    Serv_Funct     : ServFunct;
    Serv_Mode      : ServMode;
    Num_Servers    : Numservers;
    M1,M2,Var      : Real;
    FCFS_Phi       : RealVector;
    QL_1           : Real;
    Mean           : Real;
    Resp_M1        : Real;
    Resp_M2        : Real;
    Jobs           : NumJobs;
    Response_Time_Data : ResponseTimeData;
    Response_Time_List : ResponseTimeList;
    Local_Node_List    : NodeList := Node_List;
    --=======================
    use Response_List_Handler;
    use Net_Data_Pak;

--LINEFEED
 begin
    Move_To_First_Item(Local_Node_List,Is_Within_List);
    while Is_Within_List loop
       Get(From => Local_Node_List, The_Value =>Node_Name);
       Ith_Node       := Name_To_Index(Node_Name);
       Node_Def       := Node_Def_Of(Ith_Node);
       Serv_Mode      := Node_Serv_Mode(Node_Def);

       case Serv_Mode is
         when P_Share | PR_LCFS =>

                                --**************           k
                                -- Eq. 1.2.1.12   E([Q (M)] )
                                --**************      i
            QL_1      := Net_Stats.Queue_Sigma
                           ( Start_Index=> 1 ,
                             End_Index  => Num_Jobs ,
                             Order      => 1,
                             Q_Lengths  => Net.Nodes(Ith_Node).Phi);

                                --**************
                                -- Eq. 1.2.1.15   E[T ]
                                --**************     i
            Mean      := QL_1 /Thru_Put(Ith_Node);

            if Serv_Mode = P_Share then
                  Response_Time_Data.Value :=
                                 ( Serv_Mode      => P_Share,
                                   Node_Name      => Node_Name,
                                   Resp_Time_Mean => Mean   );
            elsif Serv_Mode = PR_LCFS then
                  Response_Time_Data.Value :=
                                 ( Serv_Mode      => PR_LCFS,
                                   Node_Name      => Node_Name,
                                   Resp_Time_Mean => Mean   );
            end if;
         when  NQ =>

                                --**************        r
                                -- Eq. 1.2.1.17   E[(T ) ]
                                --**************      i
            Resp_M1 := Net.Nodes(Ith_Node).Moments(1);
            Resp_M2 := Net.Nodes(Ith_Node).Moments(2);
            Var := Resp_M2 - Resp_M1 * Resp_M1;

            Response_Time_Data.Value :=
                          ( Serv_Mode     => NQ,
                            Node_Name     => Node_Name,
                            Resp_Time_Mean=> Resp_M1,
                            Resp_Time_Var => Var,
                            Coeff_Var     => Sqrt(Var)/ Resp_M1);
          when FCFS =>
            Jobs := Num_Jobs - 1 ;
            FCFS_Phi := Calculate_FCFS_Phi(Ith_Node, Jobs );
            M1 := Net.Nodes(Ith_Node).Moments(1);
            Num_Servers := Node_Num_Servers(Node_Def);

                                --**************
                                -- Eq. 1.2.1.18   E[T ]
                                --**************     i
            Resp_M1 := M1 * (1.0 + FCFS_Sigma1(Jobs,
                                               Num_Servers,
                                               FCFS_Phi   ));

                                --**************        2
                                -- Eq. 1.2.1.19   E[(T )  ]
                                --**************      i
            Resp_M2 := M1 * M1 * (2.0+ FCFS_Sigma2(
                                                Jobs,
                                                Num_Servers,
                                                FCFS_Phi  ));
            Var := Resp_M2 - Resp_M1 * Resp_M1;

            Response_Time_Data.Value :=
                          ( Serv_Mode     => FCFS,
                            Node_Name     => Node_Name,
                            Resp_Time_Mean=> Resp_M1,
                            Resp_Time_Var => Var,
                            Coeff_Var     => Sqrt(Var)/ Resp_M1);
       end case;
       Insert ( Onto           => Response_Time_List ,
                The_Value      => Response_Time_Data ,
                Where          => After);

       Move_To_Next_Item ( On           => Local_Node_List,
                           Within_List  => Is_Within_List);
    end loop;
    Report_Response_Times( Response_Time_List );
    Dispose(Response_Time_List);
exception
    when Numeric_Error =>
       Put_Line("Numeric Error raised in Display_Response_Times");
       raise UNSTABLE_SOLUTION;
    when others =>
       Put_Line("Exception raised in Display_Response_Times");
       raise;
end Display_Response_Times;
--LINEFEED

separate (Net_Stats)
--*************************************************************
procedure Display_GNorms is
  --===========================================================
  -- Extracts  Normalization Constants (GNorm) from
  -- Net_Data_Pak and sends results to Reports.Report_Q_Length.
  --==========================================================
  --==================
    use Net_Data_Pak;
begin
    Report_GNorms ( GNorms => GNorm);
end Display_GNorms;
--LINEFEED

separate (Net_Stats)
--***************************************************************
procedure Display_Q_Length_Dists( Node_List : NodeList) is
  --=============================================================
  -- Extracts  Q_Length_Distribution (Phi)for selected nodes from
  -- Net_Data_Pak and sends results to Reports.Report_Q_Length.
  --=============================================================
    Is_Within_List : Boolean;
    Node_Name      : NodeName;
    Ith_Node       : NumNodes;
    Q_Length_Dist_Data : QLengthDistData;
    Q_Length_Dist_List : QLengthDistList;
    Local_Node_List     : NodeList := Node_List;
    --=============================
    use Q_Length_Dist_List_Handler;
    use Net_Data_Pak;

 begin
    Move_To_First_Item(Local_Node_List,Is_Within_List);
    while Is_Within_List loop
       Get(From => Local_Node_List, The_Value =>Node_Name);
       Ith_Node       := Name_To_Index(Node_Name);

       Q_Length_Dist_Data := (Node_Name  => Node_Name,
                              Queue_Dist => Net.Nodes(Ith_Node).Phi);

       Insert (Onto         => Q_Length_Dist_List,
               The_Value    => Q_Length_Dist_Data,
               Where        => After);

       Move_To_Next_Item ( Local_Node_List, Is_Within_List);
    end loop;
    Report_Q_Length_Dists( Q_Length_Dist_List);
    Dispose(Q_Length_Dist_List);
 end Display_Q_Length_Dists;
--LINEFEED
separate (Net_Stats)
--***************************************************************
procedure Display_Routing (From : NodeList;
                            To  : NodeList;
                             By : NodeList) is
  --============================================================
  --   Calculates Routing quantities:
  --          m(i,k) [m(i,j)*] :   mean[variance] service tours
  --
  --          M(i,j) [V (i,j)] :   mean[variance] number of visits
  --                               by a job starting at i ending at
  --                               k and traveling thru j.

  --   Results  are sent to procedure Reports.Report_Service.
  --===========================================================

     By_Node_Index_List   : NodeIndexList;
     From_List            : NodeList := From;
     To_List              : NodeList := To;
     By_List              : NodeList := By;

     Page_It              : Boolean := True;
     Is_Within_To_List    : Boolean;
     Is_Within_From_List  : Boolean;
     Node_Name            : NodeName;
     To_Name         : NodeName;
     To_Index        : NumNodes;

     From_Name       : NodeName;
     From_Index      : NumNodes;
     By_Index        : NumNodes;
     Col_Vec         : RealVector ;
     B               : RealMatrix;
     Mean_Tours      : RealVector:=Allocate(Num_Nodes);
     Routing_Data    : RoutingData;
     Routing_List    : RoutingList;
     Node_Mean_Tours : Real;
     Mean_Tours_Value: Real;
     Serv_Tours_Var  : Real;
     Sum             : Real;
     Var             : Real;
     --==========================
     use Routing_List_Handler;
     use Real_Mat_Pak;
     use Net_Data_Pak;
begin
    By_Node_Index_List := Make_Index_List(By_List);

    Move_To_First_Item(On          => From_List,
                       Within_List => Is_Within_From_List);
    Move_To_First_Item(On          => To_List,
                       Within_List => Is_Within_To_List);

    while Is_Within_From_List loop
       Get(From => From_List, The_Value =>From_Name);
       From_Index     := Name_To_Index(From_Name);
--LINEFEED

       while Is_Within_To_List loop
          Get(From => To_List, The_Value =>To_Name);
          To_Index    := Name_To_Index(To_Name);

          Col_Vec     := Extract_Col ( PB, To_Index);

          Replace_Col( PB, To_Index,
                       Value=> RealVector'(Num_Nodes,
                                          (1..Num_Nodes => 0.0)));

                                --**************
                                -- Eq. 1.2.1.21   B(k)
                                --**************
          B:= Invert_Mat(Unit_Mat(Num_Nodes) - PB );

          for Jth_Row in 1 .. Num_Nodes loop

                                --**************
                                -- Eq. 1.2.1.22   m (i,k)
                                --**************
             Mean_Tours_Value := Sum_Mat_By_Row(B,Row=> Jth_Row);
             Assign(Mean_Tours, At_Index => Jth_Row,
                    Value => Mean_Tours_Value);
          end loop;
          for Jth_Col in 1 .. Num_Nodes loop

                                --**************   k
                                -- Eq. 1.2.1.25   V (i,j)
                                --**************
             Var := Value_Of(B , From_Index , Jth_Col) *
                     (2.0 * Value_Of(B , Jth_Col , Jth_Col)
                       - 1.0 - Value_Of (B, From_Index, Jth_Col));

             if Jth_Col /= To_Index and then
                          Is_Match (By_Node_Index_List,Jth_Col) then

                Node_Mean_Tours := Value_Of(B, From_Index, Jth_Col);

                Routing_Data :=
                       ( By_Node         => Index_To_Name(Jth_Col) ,
                         Node_Mean_Tours => Node_Mean_Tours,
                         Node_Var_Tours  => Var );

                Insert (Onto            => Routing_List,
                        The_Value       => Routing_Data,
                        Where           => After);
             end if;
          end loop;
--LINEFEED
          Replace_Col (PB, To_Index, Value => Col_Vec);

                                --**************   *
                                -- Eq. 1.2.1.23   m (i,k)
                                --**************
          Serv_Tours_Var := 0.0;
          for J in 1 .. Num_Nodes loop
             Sum := 0.0;
             for L in 1 .. Num_Nodes loop
                 if (L /= To_Index) then
                    Sum := Sum + Value_Of(PB, J, L) *
                                 Value_Of( Mean_Tours, L);
                 end if;
             end loop;
             Sum := 1.0 + 2.0 * Sum;
             Serv_Tours_Var := Serv_Tours_Var +
                                 Value_Of(B,From_Index,J) * Sum;
          end loop;
          Node_Mean_Tours:= Value_Of (Mean_Tours , From_Index);
          Report_Routing (Starting_Name  => From_Name ,
                           Return_Name   => To_Name   ,
                           Mean_Tours    => Node_Mean_Tours,
                           Var_Tours     => Serv_Tours_Var,
                           List          => Routing_List ,
                           Page_It       => Page_It);
          Page_It := False;

          Dispose( Routing_List);
          Move_To_Next_Item (On          => To_List,
                             Within_List => Is_Within_To_List);

       end loop;
       exit when Is_Last_Item(From_List);
       Move_To_First_Item( On          => To_List,
                           Within_List => Is_Within_To_list);
       Move_To_Next_Item ( On          => From_List,
                           Within_List => Is_Within_From_List);
   end loop;
   Dispose (By_Node_Index_List);
exception
     when Numeric_Error =>
         Put_Line("Numeric_Error raised in Display_Routing");
         raise UNSTABLE_SOLUTION;
     when others =>
         Put_Line("Exception raised in Display_Routing");
         raise;
end Display_Routing;
--LINEFEED
separate (Net_Stats)
--***************************************************************
procedure Display_Service ( From: NodeList;
                              To: NodeList;
                              By: NodeList) is
  --==========================================================
  --   Calculates Service Requirements S, S*, R, R* and sends
  --   results to procedure Reports.Report_Service.
  --==========================================================
     Page_It             : Boolean := True;
     Is_Within_From_List : Boolean;
     Is_Within_To_List   : Boolean;
     From_List           : NodeList := From;
     To_List             : NodeList := To;
     By_List             : NodeList := By;
     By_Node_Index_List  : NodeIndexList;
     To_Name         : NodeName;
     To_Index        : NumNodes;
     From_Name       : NodeName;
     From_Index      : NumNodes;
     By_Index        : NumNodes;
     Col_Vec         : RealVector ;
     B               : RealMatrix;
     Service_Data    : ServiceData;
     Service_List    : ServiceList;
     M1,M2,Var       : Real;
     Serv_Reqt_Mean  : Real;
     Tot_Mean_Serv_Reqt : Real;
     Serv_Reqt_Var   : Real;
     Mean_Residence  : Real;
     Tot_Residence   : Real;

     --==========================
     use Service_List_Handler;
     use Real_Mat_Pak;
     use Net_Data_Pak;

--LINEFEED
begin

    By_Node_Index_List := Make_Index_List(By_List);

    Move_To_First_Item(On          => From_List,
                       Within_List => Is_Within_From_List);

    Move_To_First_Item(On          => To_List,
                       Within_List => Is_Within_To_List);

    while Is_Within_From_list loop
       Get(From => From_List, The_Value =>From_Name);
       From_Index     := Name_To_Index(From_Name);
       Tot_Mean_Serv_Reqt := 0.0;
       while Is_Within_To_list loop
          Get(From => To_List, The_Value =>To_Name);
          To_Index    := Name_To_Index(To_Name);

          Col_Vec     := Extract_Col ( PB, To_Index);
          Replace_Col ( PB, To_Index,
                        Value => RealVector'(Num_Nodes,
                                      (1..Num_Nodes => 0.0)));

                                --**************
                                -- Eq. 1.2.1.21   B(k)
                                --**************
          B := Invert_Mat ( Unit_Mat(Num_Nodes) - PB );

          Tot_Mean_Serv_Reqt := 0.0;
          Tot_Residence :=0.0;
          for J in 1 .. Num_Nodes loop
            M1  := Net.Nodes(J).Moments(1);
            M2  := Net.Nodes(J).Moments(2);

                                --**************
                                -- Eq. 1.2.1.26   S(i,k)
                                --**************
            Serv_Reqt_Mean     :=  Value_Of(B,From_Index,J) * M1;

                                --**************        *
                                -- Eq. 1.2.1.30   S(i,k)
                                --**************
            Tot_Mean_Serv_Reqt := Tot_Mean_Serv_Reqt + Serv_Reqt_Mean;

                                --**************   k
                                -- Eq. 1.2.1.25   V (i,j)
                                --**************
            Var := Value_Of(B,From_Index,J) * ( 2.0 * Value_Of(B,J,J)
                              - 1.0 - Value_Of(B,From_Index,J));

                                --**************   k
                                -- Eq. 1.2.1.27   W (i,j)
                                --**************
            Serv_Reqt_Var  := Value_Of(B,From_Index,J) * (M2 - M1*M1)
                                + Var * M1 * M1;
--LINEFEED

                                --**************   k
                                -- Eq. 1.2.1.28   R (i,j)
                                --**************
            Mean_Residence :=Value_Of(B,From_Index,J) *
                                           Mean_Response(J);

                                --**************   *
                                -- Eq. 1.2.1.30   R (i,j)
                                --**************
            Tot_Residence  := Tot_Residence + Mean_Residence;

            if J /= To_Index and then
                           Is_Match (By_Node_Index_List,J) then

                Service_Data :=
                          ( By_Node         => Index_To_Name(J) ,
                            Serv_Reqt_Mean  => Serv_Reqt_Mean,
                            Serv_Reqt_Var   => Serv_Reqt_Var,
                            Mean_Residence  => Mean_Residence);

                Insert (Onto            => Service_List,
                        The_Value       => Service_Data,
                        Where           => After);
             end if;
          end loop;


          Report_Service (Starting_Name => From_Name ,
                          Return_Name   => To_Name   ,
                          Tot_Mean_Serv => Tot_Mean_Serv_Reqt,
                          Tot_Residence => Tot_Residence,
                          List          => Service_List ,
                          Page_It       => Page_It);

          Page_It := False;

          Replace_Col ( PB, To_Index , Value => Col_Vec);
          Dispose( Service_List);
          Move_To_Next_Item ( On           => To_List,
                              Within_List  => Is_Within_To_List);
       end loop;

       Move_To_First_Item( On           => To_List,
                           Within_List  => Is_Within_To_List);

       Move_To_Next_Item ( On           => From_List,
                           Within_List  => Is_Within_From_List);
   end loop;
   Dispose (By_Node_Index_List);
exception
      when Numeric_Error =>
         Put_Line("Numeric_Error raised in Display_Service");
         raise UNSTABLE_SOLUTION;
     when others =>
         Put_Line("Exception raised in Display_Service");
         raise;
end Display_Service;
--LINEFEED
    separate (Net_Stats)
    --*****************************************************
    procedure Calculate_Stats( Num_Jobs:NumJobs) is
    --===============================================================
    --     Calculates Intermediate results and stores results in
    --     Net_Data_Pak. Must be Called prior to invoking the display
    --     routines.
    --===============================================================
        procedure Initialize_PB_Mat is separate;
        procedure Initialize_Node_Array  is separate;
        procedure Calculate_Network_Moments is separate;
        procedure Calculate_Steady_State_Flow is separate;
        procedure Calculate_Equilb is separate;
        procedure Calculate_GNorms is separate;
        procedure Calculate_Aux_Array is separate;
        procedure Calculate_Q_Length_Dist is separate;
        procedure Calculate_Thru_Put is separate;
        procedure Calculate_Utilization is separate;
        procedure Calculate_Mean_Response is separate;


    begin

        -- Initialize global data in Net_Data_Pak

         Net_Data_Pak.Num_Nodes := Network.Count_Nodes;
         Net_Data_Pak.Num_Jobs  := Num_Jobs;
         Initialize_PB_Mat ;         -- Build PBranch Matrix
         Initialize_Node_Array ;     -- Build Array of Nodes

         --  Intermediate Calculations  Stored in Net_Data_Pak

         Calculate_Network_Moments ;          -- Moments
         Calculate_Steady_State_Flow ;        -- Alphas
         Calculate_Equilb ;                   -- PSIs
         Calculate_GNorms ;                   -- GNorms
         Calculate_Aux_Array ;                -- Auxs
         Calculate_Q_Length_Dist ;            -- PHIs
         Calculate_Thru_Put ;                 -- Thru_Put
         Calculate_Utilization ;              -- Util
         Calculate_Mean_Response ;           -- Mean_Response
  end Calculate_Stats;
--LINEFEED
   with Network;
   with Node_Servicer;
   separate (Net_Stats.Calculate_Stats)
--*****************************************************
   procedure Initialize_PB_Mat is
 --===============================================================
 --    Builds the Probability Branching Matrix which is stored in
 --    Net_Data_Pak. Branching Probabilities are obtained from the
 --    Network package.
 --===============================================================
        Row            : NumNodes;
        End_Of_Network : Boolean;
        Node           : NodeDef;
        Mat_Init_Exception : exception;
        --=============================================
        use Real_Mat_Pak , Node_Servicer, Net_Data_Pak;
   begin
        Allocate_PB;
        Move_To_First_Node(End_Of_Network);
        Row := 1;
        loop
           Get_Node(Node);
           if Last_Index_Of(Node_Connect_Prob(Node)) /= Num_Nodes then
             raise Mat_Init_Exception;
           end if;
           Replace_Row( In_Mat=> PB,
                        Row   => Row,
                        Value => RealVector(Node_Connect_Prob(Node)));
           exit when Row = Num_Nodes;
           if End_Of_Network then
             raise Mat_Init_Exception;
           end if;
           Move_To_Next_Node(End_Of_Network);
           Row := Row + 1;
        end loop;
        if Row /= Num_Nodes then
           raise Mat_Init_Exception;
        end if;
     exception
        when Mat_Init_Exception =>
          Put_Line("Error in Initializing PB_Matrix");
          raise;
   end Initialize_PB_Mat;
--LINEFEED

   with Network;
   with Node_Servicer;
   separate (Net_Stats.Calculate_Stats)
--*****************************************************
   procedure Initialize_Node_Array is
 --===============================================================
 --    Builds the data structure 'Net' which is an array of Nodal
 --    data. Each array element contains the Node_Def and Intermediate
 --    Results for a node(see package Net_Data_Pak). This routine
 --    initializes each component with Node_Def obtained from the
 --    package Network.
 --================================================================
        use Network ; use Node_Servicer;

        Row            : NumNodes;
        End_Of_Network : Boolean;
        Node           : NodeDef;
   begin
        Allocate_Net;
        Move_To_First_Node(End_Of_Network);
        Row := 1;
        loop
           Get_Node(Node);
           Net.Nodes(Row).Node_Def := Node;
           exit when Row = Num_Nodes;
           if End_Of_Network then
             raise Network_Access_Exception;
           end if;
           Move_To_Next_Node(End_Of_Network);
           Row := Row + 1;
        end loop;
        if Row /= Num_Nodes then
           raise Network_Access_Exception;
        end if;
   exception
        when Network_Access_Exception =>
          Put_Line("Error in Initializing Nodes_Array");
          raise;
   end Initialize_Node_Array;
--LINEFEED
separate (Net_Stats.Calculate_Stats)
--*****************************************************
procedure Calculate_Network_Moments is
--==============================================================
--      Calculates the Moments for all the nodes defined in the
--      array 'Net'. The results are stored in array 'Net'.
--==============================================================
      use Node_Servicer; use Net_Data_Pak;

      Node : NodeDef;

      Moments : NodeMoments(1..Nth_Order);

      function  Exp_Moments(Node    : in NodeDef)
                                        return NodeMoments is separate;

      function  Erlang_Moments(Node    : in NodeDef)
                                        return NodeMoments is separate;

      function  Coxian_Moments(Node    : in NodeDef) return NodeMoments
                                                        is separate;
   begin
     for Ith_Node in 1.. Num_Nodes loop
        Node := Node_Def_Of(Ith_Node);
         case Node_Serv_Disc(Node).Serv_Mode is
            when FCFS =>
               Moments := Exp_Moments(Node);
            when others =>
               case Node_Serv_Funct(Node).Serv_Dist is
                   when Exponential =>
                       Moments := Exp_Moments(Node);
                   when Erlang =>
                       Moments := Erlang_Moments(Node);
                   when Coxian =>
                       Moments := Coxian_Moments(Node);
               end case;
         end case;
         Net.Nodes(Ith_Node).Moments := Moments;
      end loop;
  end Calculate_Network_Moments;

--LINEFEED
separate (Net_Stats.Calculate_Stats.Calculate_Network_Moments)
--*****************************************************
function  Exp_Moments(Node    : in NodeDef)
                                   return NodeMoments is
--=============================================================
--     Calculate Moments for a node of Exponential Distribution
--      according --     to Eq. 1.1.1.1
--=============================================================
       use Node_Servicer ;


       Node_Moments:NodeMoments(1..Nth_Order);
       Mu : Real;


    begin
         -- Get ServiceRate Mu from the node.
       if Node_Serv_Funct(Node).Serv_Dist = Exponential then
           Mu :=  Node_Serv_Funct(Node).Expon_Rate ;
       else
           raise Node_Access_Exception;
       end if;
       for Order in 1..Nth_Order loop
                --*********************
                --   Eq. 1.1.1.1
                --*********************
          Node_Moments(NumMoments(Order)) := Fact(Order) *
                                                Mu **(- Order);
       end loop;
       return Node_Moments;
   exception
       when Numeric_Error =>
          Put_Line("Numeric Error in Exp_Moments");
          raise UNSTABLE_SOLUTION;
       when others =>
          Put_Line("Exception raised in Exp_Moments");
          raise;
   end Exp_Moments;
--LINEFEED
    separate (Net_Stats.Calculate_Stats.Calculate_Network_Moments)
--*****************************************************
    function  Erlang_Moments(Node    : in NodeDef)
                                      return NodeMoments is
--=============================================================
--     Calculate Moments for a node of Erlang Distribution
--      according to Eq. 1.1.2.1
--=============================================================
       use Node_Servicer;


       Node_Moments : NodeMoments(1..Nth_Order);
       Mu           : Real ;
        R           : Integer;


    begin
       if Node_Serv_Funct(Node).Serv_Dist = Erlang then
          Mu :=  Node_Serv_Funct(Node).Erlang_Rate ;
          R  :=  Node_Serv_Funct(Node).Num_Erlang_Stages ;
       else
          raise Node_Access_Exception;
       end if;

       for Order in 1 .. Nth_Order loop
                --*********************
                --   Eq. 1.1.2.1
                --*********************
          Node_Moments(Order) := Mu**(-Order) *
                                   Fact(R+ Order- 1)/ Fact(R-1);
       end loop;
       return Node_Moments;
   exception
       when Numeric_Error =>
          Put_Line("Numeric Error in Erlang_Moments");
          raise UNSTABLE_SOLUTION;
       when others =>
          Put_Line("Exception raised in Erlang_Moments");
          raise;
   end Erlang_Moments;
--LINEFEED
separate (Net_Stats.Calculate_Stats.Calculate_Network_Moments)
--*****************************************************
function Coxian_Moments (Node        : in NodeDef)
                                         return NodeMoments is
--======================================================================
--     Computes Moments for a Node with a Coxian Distribution as defined
--     in Eq. 1.1.3.1
--======================================================================
   use Node_Servicer;

   type VectorOfStages is array(Natural range 0..Nth_Order) of RealVector;

   Coxian_Dist: CoxianDist               := Node_Cox_Dist(Node);
   R_Stages   : constant NumCoxianStages := Coxian_Dist.Num_Coxian_Stages;
   Col           : NumCoxianStages;
   V_Delta       : RealVector:= Allocate(R_Stages);
   P_Star        : RealMatrix;
   IMP_Inv       : RealMatrix;  -- [[I] - [P]] Inverted
   Node_Moments  : NodeMoments(1..Nth_Order);
   B             : VectorOfStages;

   function Make_V_Delta(Ith_Order : NumMoments)
                                 return RealVector is separate;
   function Coxian_Sigma ( N : NumMoments; B : VectorOfStages )
                                 return RealVector is separate;
begin   -- **** Coxian_Moments
   -- Build P_Star Matrix
   P_Star := Real_Matrix_Of((1..R_Stages => (1..R_stages => 0.0)));
   for Row in 1.. R_Stages - 1 loop
     Col := Row + 1;
     Assign(P_Star, Row , Col , Value  =>  Coxian_Dist.Contin_Probs(Row));
   end loop;

    -- Calculate [ [I] - [P*] ]
   IMP_Inv :=Invert_Mat ( Unit_Mat(R_Stages) - P_Star);

   B(0) := Real_Vector_Of((1..R_Stages => 1.0));

   for Ith_Order in NumMoments range 1.. Nth_Order loop
     V_Delta := Make_V_Delta(Ith_Order);

                --*********************
                --   Eq. 1.1.3.1
                --*********************
     B(Ith_Order):= IMP_Inv * (V_Delta + Coxian_Sigma(Ith_Order, B));
   end loop;
      -- return  overall moments ( First row of B);
   for I in NumMoments(1) .. Nth_Order loop
       Node_Moments(I) := Value_Of(B(I),1);
   end loop;
   return Node_Moments;
 exception
   when Numeric_Error =>
          Put_Line("Numeric Error in Erlang_Moments");
          raise UNSTABLE_SOLUTION;
   when Matrix_Inversion_Error =>
       Put_Line(" Trouble with Inverting Matrix in Coxian Moments");
       raise UNSTABLE_SOLUTION;
   when others =>
       Put_Line(" Exception raised in Coxian Moments Routine");
       raise;
 end Coxian_Moments;
--LINEFEED
separate (Net_Stats.Calculate_Stats.
                    Calculate_Network_Moments.Coxian_Moments)
--***********************************************************
function Make_V_Delta(Ith_Order : NumMoments) return RealVector is
--===========================================================
--     Function makes V_Delta as defined in Eq. 1.1.3.3 and used in
--         Eq. 1.1.3.3
--===========================================================
   Mu      : Real;
   V_Delta : RealVector(R_Stages);
   Temp    : Real;
   Q       : Real;
begin
     for I in 1..R_Stages loop
         Mu := Coxian_Dist.Coxian_Rates(I);
         if I = R_Stages then
             Q := 1.0;
         else
             Q  := 1.0 - Coxian_Dist.Contin_Probs(I);
         end if;
         Temp:= Fact(Ith_Order) * (Q) * Mu ** ( - Ith_Order);
         Assign (V_Delta, At_Index => I , Value => Temp);
     end loop;
     return V_Delta;
 end Make_V_Delta;

separate (Net_Stats.Calculate_Stats.Calculate_Network_Moments.Coxian_Moments)
--****************************************
function Coxian_Sigma ( N     : NumMoments;
                        B     : VectorOfStages ) return RealVector is
--=================================================
--     Function calculates Summation used in moments Eq. 1.1.3.1
--       for Coxian Distribution.
--=================================================

   Sum : RealVector := Real_Vector_Of((1..R_Stages => 0.0));

   --**************************************************************
   function Make_D_Mat(Ith_Order : NumMoments) return RealMatrix is
   --==============================================================
   --    Builds Ith_Order D Matrix as defined in Eq. 1.1.3.4 and
   --       used in Eq. 1.1.3.1
   --==============================================================
        D : RealMatrix(R_Stages,R_Stages);
        Temp : Real;
        Mu   : Real;
   begin
      for I in 1.. R_Stages loop
         Mu := Coxian_Dist.Coxian_Rates(I);
         for J in 1.. R_Stages loop
            Temp := Fact(Ith_Order) * Value_Of(P_Star,I,J) *
                                          Mu **(-Ith_Order);
            Assign( D, At_Row=>I , At_Col=>J , Value => Temp);
         end loop;
      end loop;
      return D;
   end Make_D_Mat;

begin
   for I in 1.. N loop
     Sum := Sum  + Bin_Coeff(N , I)  * Make_D_Mat(I) * B(N - I);
   end loop;
   return Sum ;
end Coxian_Sigma;
--LINEFEED
separate (Net_Stats.Calculate_Stats)
--*****************************************************
procedure Calculate_Steady_State_Flow  is
--=====================================================
--     Calculates Steady_State_Flow (Alphas) as defined by
--     Homogenous equation 1.2.0.1  Alpha[I - P ] = 0
--     (See user's manual for algorithm). Alphas are stored
--     in array 'Net'in package Net_Data_Pak.
--=====================================================

    PM_Star    : RealMatrix   := Allocate (Num_Nodes - 1,Num_Nodes - 1);
    Alpha_Star : RealVector   := Allocate (Num_Nodes - 1);
    PV_Star    : RealVector   := Allocate (Num_Nodes - 1);
    Sum        : Real;
    --*********************************************************
    function Build_P_Star return RealMatrix is separate;

begin
   PM_Star    := Build_P_Star;
   PV_Star    := Real_Vector_Of(Vector_Of( RealVector'
                     (Extract_Row(PB, Num_Nodes))) (1..Num_Nodes-1));

   Alpha_Star := PV_Star * Invert_Mat(Unit_Mat(Num_Nodes-1) - PM_Star);

   Sum        := Sum_Vec(Alpha_Star);

   for Ith_Node in 1 .. Num_Nodes-1 loop
       Assign_Alpha(Ith_Node,
            Value => Value_Of(Alpha_Star,Ith_Node)/(1.0 + Sum));
   end loop;
   Assign_Alpha(Num_Nodes, Value => 1.0/(1.0 + Sum) );
 exception
   when Numeric_Error =>
          Put_Line("Numeric Error in Calculate_Steady_State_Flow");
          raise UNSTABLE_SOLUTION;
   when Matrix_Inversion_Error =>
       Put_Line(" Trouble with Inverting Matrix in" &
                   " Calculate_Steady_State_Flow");
       raise UNSTABLE_SOLUTION;
   when others =>
       Put_Line(" Exception raised in Calculate_Steady_State_Flow");
       raise;
end Calculate_Steady_State_Flow;

separate (Net_Stats.Calculate_Stats.Calculate_Steady_State_Flow)
--**************************************************************
function Build_P_Star return RealMatrix is
--==============================================================
--      Builds P_Star as defined in Eq. 1.1.3.2
--==============================================================
    PM_Star : RealMatrix (Num_Nodes - 1,Num_Nodes - 1);
    V       : Real_Mat_Pak.Vector(1..Num_Nodes - 1);
begin
    for Ith_Row in 1 .. Num_Nodes - 1 loop
       V := Vector_Of(
                RealVector'(Extract_Row(PB,Ith_Row)))(1..Num_Nodes- 1);
    Replace_Row(PM_Star,
                Row   => Ith_Row,
                Value => Real_Vector_Of(V));
    end loop;
    return PM_Star;
end Build_P_Star;
--LINEFEED
  separate (Net_Stats.Calculate_Stats)
--************************************************************
  procedure Calculate_Equilb is
--============================================================
--  Routine calculates the steady-state(equilibrium) probability PSI as
--    defined in Eq. 1.2.0.7.   Note: Logarithmic operations are defined
--    and used during the calculations in order to avoid numeric overflows.
--============================================================

     type LogReal is new Real;
     subtype LogInt is NumJobs;

     Scal_K    : Real renames Net_Data_Pak.Scal_K;
     Thetas    : RealVector(Num_Nodes);
     Mus       : RealVector(Num_Nodes) ;
     Alphas    : RealVector(Num_Nodes) ;
     Betas     : RealVector(Num_Nodes) ;
     Beta      : LogReal;
     Psi       : Real;
     Servers   : LogInt;
     Kth_Job   : LogInt;

--*****************************************************
   function Log_Factorial(I:LogInt) return LogReal is
   begin
      return LogReal(Log_Fact(Integer(I)));
   end Log_Factorial;

--*****************************************************
   function "**"(Left:LogReal; Right: LogInt) return LogReal is
             --  Performs Logarithmic Multiplication  -->   J * Log10(X)
   begin
      return LogReal(Real(Right) * Log(Real(Left)));
   end "**";

--*****************************************************
   function "/"  (Left: LogReal; Right: LogReal)return LogReal is
             --  Exp(Log(Left) - Log10(Right))
   begin
        return LogReal( Left - Right);
   end "/";

--*****************************************************
   function "**"(Left: LogInt ; Right: LogInt) return LogReal is
           -- Performs Logarithmic Multiplication --> Right * Log(Left)
   begin
    return LogReal(Real(Right) * Log(Real(Left))) ;
   end "**";

   --*****************************************************
    function "*" (Left: LogReal; Right: LogReal)return LogReal is
           -- Performs Logarithmic Addition  --> Left + Right
    begin
       return LogReal(Real(Left + Right));
    end "*";
--LINEFEED
    --******************************************************
    function "/"(Left,Right:RealVector) return RealVector is
      -- Divides corresponding Components.
      Size : constant Natural := Last_Index_Of(Left);
      RV : RealVector(Size);
    begin
      for I in 1 .. Size  loop
         Assign (RV , I , Value_Of(Left,I) / Value_Of(Right,I)) ;
      end loop;
    return RV;
    end "/";

--******************************************************
    function "*"(Left,Right:RealVector) return RealVector is
      -- Multiplies corresponding Components.
    Size : constant Natural := Last_Index_Of(Left);
        RV : RealVector(Size);
    begin
        for I in 1 .. Size loop
          Assign (RV , I , (Value_Of(Left,I)) * Value_Of(Right,I) );
        end loop;
        return RV;
    end "*";

     function Sigma(DV:RealVector) return Real is separate;
     function Select_Mus  return RealVector is separate;
     function Select_Alphas return RealVector is separate;

     pragma Inline("*", "/", "**",  Sigma);

   begin
      Mus    := Select_Mus;
      Alphas := Select_Alphas;

                --*********************
                --   Eq. 1.2.0.2
                --*********************
      Thetas := Alphas / Mus;

                --*********************
                --   Eq. 1.2.0.3
                --*********************
      Scal_K := Sigma(Thetas) / Sigma(Thetas*Thetas);

                --*********************
                --   Eq. 1.2.0.4
                --*********************
      Betas  := Scal_K * Thetas;
      for Ith_Node in 1.. Num_Nodes loop
        for K in 0 .. Num_Jobs loop
          Kth_Job := LogInt(K);
          Servers := LogInt(Node_Serv_Disc(
                            Node_Def_Of(Ith_Node)).Num_Servers);

          Beta    := LogReal( Value_Of(Betas,Ith_Node));

                --*********************
                --   Eq. 1.2.0.7
                --*********************
          if Kth_Job <= Servers then

                    -- Note: **,/,* perform Logarithmic operations
              Psi :=  Exp(Real (Beta** Kth_Job / Log_Factorial(Kth_Job)));
          else
              Psi :=  Exp(Real (Beta** Kth_Job /( Log_Factorial(Servers) *
                                  (Servers**(Kth_Job - Servers)))));
          end if;
          Assign_Psi(Ith_Node, Map(NumJobs(Kth_Job)), Value => Psi);
       end loop;
     end loop;
 exception
   when others =>
       Put_Line(" Calculated steady_state probability is too small." &
                  " TRY reducing bottleneck or njobs:");
       raise;
 end Calculate_Equilb;
--LINEFEED
separate (Net_Stats.Calculate_Stats.Calculate_Equilb)
--*****************************************************
function Sigma(DV : RealVector) return Real is
--========================================================
--       This Sigma reduces down to summing over a vector.
--========================================================
begin
   return  Sum_Vec(DV);
end Sigma;

separate (Net_Stats.Calculate_Stats.Calculate_Equilb)
--*****************************************************
function Select_Mus return RealVector is
--========================================================
--       Builds a RealVector of Mus from array 'Net'in Net_Data_Pak
--       . This Vector is used in Eq. 1.2.0.2
--========================================================
  use Net_Data_Pak;

  Mus : RealVector := Allocate(Num_Nodes);
  M1  : Real;
begin
  for Ith_Node in 1..Num_Nodes loop
    M1 := Net.Nodes(Ith_Node).Moments(1);
    Assign( Mus, Ith_Node, Value => 1.0 / M1);
  end loop;
  return Mus;
end Select_Mus;

separate (Net_Stats.Calculate_Stats.Calculate_Equilb)
--*****************************************************
function Select_Alphas return RealVector is
--========================================================
--       Builds a RealVector of Alphas  from array 'Net'in
--       Net_Data_Pak . This Vector is used in Eq. 1.2.0.2
--========================================================
  use Net_Data_Pak;
  Alphas : RealVector := Allocate(Num_Nodes);
  Alpha_Value : Real;
begin
  for Ith_Node in 1..Num_Nodes loop
    Alpha_Value := Alpha(Ith_Node);
    Assign( Alphas, Ith_Node, Value => Alpha_Value );
  end loop;
  return Alphas;
end Select_Alphas;
--LINEFEED

  separate (Net_Stats.Calculate_Stats)
--*****************************************************
  procedure Calculate_GNorms is
--========================================================
--     Calculates Normalizations Constants as defined in
--     Eq. 1.2.0.9. Results are stored in RealVector GNorm
--     in package Net_Data_Pak.
--========================================================
      use Net_Data_Pak;

      Sum : Real;
  begin
     Allocate_GNorm;

                --*********************
                --   Eq. 1.2.0.9
                --*********************
     Assign_Gnorm( At_Index => (Map( 0)),
                    Value   =>  1.0);

     for Mth_Job in 1 .. Num_Jobs loop
        Assign_Gnorm( At_Index => Map(Mth_Job),
                      Value    => Psi(1, Map(Mth_Job)));
     end loop;

     for Nth_Node in 2..Num_Nodes loop
       for Mth_Job in reverse 1 .. Num_Jobs loop
          Sum := 0.0;
          for K in 0 .. Mth_Job loop
            Sum:= Sum+ Psi(Nth_Node,Map(K))* GNorm_Value(Map(Mth_Job -K));
          end loop;
          Assign_GNorm(Map(Mth_Job), Value => Sum);
       end loop;
     end loop;
 exception
   when Numeric_Error =>
          Put_Line("Numeric Error in Calculate_GNorm");
          raise UNSTABLE_SOLUTION;
  end Calculate_GNorms;
--LINEFEED

  separate (Net_Stats.Calculate_Stats)
--*****************************************************
  procedure Calculate_Aux_Array is
--============================================================
--     Calculates Aux_Array (l's) as defined in eq. 1.2.0.11.
--     Results are stored in array 'Net' in package Net_Data_Pak.
--=============================================================
     use Net_Data_Pak;
     First_Time_For_Node : Boolean;
     Aux_Value           : Real;
     Sum                 : Real;
  begin
                --*********************
                --   Eq. 1.2.0.11
                --*********************
     for Ith_Node in 1..Num_Nodes loop
       Assign_Aux(Ith_Node , Map(0) , Value => 1.0);
     end loop;

     for Ith_Node in 1.. Num_Nodes loop
       First_Time_For_Node := True;
       for Kth_Job in 1.. Num_Jobs loop
         Sum := 0.0;
         for J in 1.. Kth_Job loop
           Sum := Sum + Psi(Ith_Node, Map(J)) *
                         Aux(Ith_Node,Map(Kth_Job-J));
         end loop;

         Aux_Value := GNorm_Value(Map(Kth_Job)) - Sum;
         if Aux_Value < 0.0 then
            Aux_Value := 0.0;   -- Corrective Action
               if First_Time_for_Node then
                  Put("UNSTABLE_SOLUTION for (Eq.1.2.0.11) For Node: ");
                  Put_Line(Name_Of_Node(Node_Def_Of(Ith_Node)));
                  Put_Line("[Type 'Help Fix_ql'] ");
                  First_Time_For_Node := False;
               end if;
         end if;

         Assign_Aux(Ith_Node, Map(Kth_Job),
                     Value => Aux_Value);
       end loop;
     end loop;
 exception
   when Numeric_Error =>
          Put_Line("Numeric Error in Calculate_Aux_Array");
          raise UNSTABLE_SOLUTION;
   when others =>
       Put_Line(" Exception raised in Calculate_Aux_Array");
       raise;
 end Calculate_Aux_Array;
--LINEFEED

 separate (Net_Stats.Calculate_Stats)
--*****************************************************
 procedure Calculate_Q_Length_Dist is
--================================================================
--      Calculates Phi for the Ith Node according to Eq. 1.2.0.10.
--      Results are stored in array 'Net' in package Net_data_Pak.
--================================================================
   use Net_Data_Pak;

   Aux_Value : Real;
   Psi_Value : Real;
 begin
    for Ith_Node in 1.. Num_Nodes loop
      for Ith_Job in 0 .. Num_Jobs loop
        Psi_Value := Psi(Ith_Node,Map(Ith_Job));
        Aux_Value := Aux(Ith_Node, Map(Num_Jobs - Ith_Job));
                --*********************
                --   Eq. 1.2.0.10
                --*********************
        begin
            Assign_Phi(Ith_Node, Map(Ith_Job), Value =>
                    Psi_Value/GNorm_Value(Map(Num_Jobs)) * Aux_Value);
        exception
            when numeric_error =>
               Assign_Phi(Ith_Node, Map(Ith_Job), Value =>
                    Psi_Value * Aux_Value /GNorm_Value(Map(Num_Jobs)) );
        end ;
      end loop;
    end loop;
 exception
   when Numeric_Error =>
          Put_Line("Numeric Error in Calculate_Q_Length_Dist");
          raise UNSTABLE_SOLUTION;
   when others =>
       Put_Line(" Exception raised in Calculate_Q_Length_Dist");
       raise;
 end Calculate_Q_Length_Dist;
--LINEFEED

 separate (Net_Stats.Calculate_Stats)
--*****************************************************
 procedure Calculate_Thru_Put is
--================================================================
--      Calculates Thru_Put for the Ith Node according to Eq. 1.2.0.16.
--      Results are stored in array 'Net' in package Net_data_Pak.
--================================================================
    use Net_Data_Pak;

   Scal_K  : Real renames Net_Data_Pak.Scal_K;
   G_Ratio : Real:= GNorm_Value(Map(Num_Jobs - 1)) /
                         GNorm_Value(Map(Num_Jobs));
   Tao     : Real ;
 begin
   for Ith_Node in 1 .. Num_Nodes loop
                --*********************
                --   Eq. 1.2.0.16
                --*********************
     Tao := Scal_K * Alpha(Ith_Node) * G_Ratio;
     Assign_Thru_Put(Ith_Node, Value => Tao);
   end loop;
 exception
   when Numeric_Error =>
          Put_Line("Numeric Error in Calculate_Thru_Put");
          raise UNSTABLE_SOLUTION;
 end Calculate_Thru_Put;
--LINEFEED

 separate (Net_Stats.Calculate_Stats)
--*****************************************************
 procedure Calculate_Utilization is
--================================================================
--   Calculates Utilization for the Ith Node according to Eq. 1.2.0.14.
--   Results are stored in array 'Net' in package Net_data_Pak.
--================================================================

   Util_Value : Real;

 begin
   for Ith_Node in 1 .. Num_Nodes loop
                --*********************
                --   Eq. 1.2.0.14
                --*********************
     Util_Value := 1.0 - Aux(Ith_Node,Map(Num_Jobs))/
                            GNorm_Value(Map(Num_Jobs));
     Assign_Util(Ith_Node , Value => Util_Value);
     if Util_Value < 0.0 then
        raise Numeric_Error;
     end if;
   end loop;
 exception
   when Numeric_Error =>
          Put_Line("Numeric Error in Calculate_Utilization");
          raise UNSTABLE_SOLUTION;
end Calculate_Utilization;
--LINEFEED

separate (Net_Stats.Calculate_Stats)
--*****************************************************
procedure Calculate_Mean_Response  is
--================================================================
--   Calculates Mean_Response  for the Ith Node according to
--   Eq. 1.2.0.14. Results are stored in array 'Net' in package
--   Net_data_Pak.
--================================================================
    use Net_Data_Pak; use Node_Servicer;

    Node_Def     : NodeDef;
    Ith_Node     : NumNodes;
    Serv_Mode    : ServMode;
    Num_Servers  : Numservers;
    M1           : Real;
    FCFS_Phi     : RealVector;
    QL_1         : Real;
    Mean         : Real;

 begin
    for Ith_Node in 1.. Num_Nodes loop
       Node_Def := Node_Def_Of(Ith_Node);
       Serv_Mode:= Node_Serv_Disc(Node_Def).Serv_Mode;
       case Serv_Mode is
         when P_Share | PR_LCFS =>

                --*********************        k
                --   Eq. 1.2.0.12       E[Q (M) ]
                --*********************    i
            QL_1      := Queue_Sigma (
                             Start_Index=> 1 ,
                             End_Index  => Num_Jobs ,
                             Order      => 1,
                             Q_Lengths  => Net.Nodes(Ith_Node).Phi);

                --*********************
                --   Eq. 1.2.0.15       E[T ]
                --*********************    i
            Mean      := QL_1 /Thru_Put(Ith_Node);

         when  NQ =>

                --*********************      r
                --   Eq. 1.2.0.17       E[(T) ]
                --*********************      i
            Mean := Net.Nodes(Ith_Node).Moments(1);
          when FCFS =>
            FCFS_Phi := Calculate_FCFS_Phi(Ith_Node,Num_Jobs - 1);
            M1 := Net.Nodes(Ith_Node).Moments(1);
            Num_Servers := Node_Serv_Disc(Node_Def).Num_Servers;

                --*********************
                --   Eq. 1.2.0.18       E[T ]
                --*********************    i
            Mean := M1 * (1.0 + FCFS_Sigma1(Num_Jobs-1,
                                            Num_Servers, FCFS_Phi));
       end case;
       Assign_Mean_Response(Ith_Node, Value => Mean);
       if Mean < 0.0 then
           raise Numeric_Error;
       end if;
    end loop;
 exception
   when Numeric_Error =>
          Put_Line("Numeric Error in Calculate_Mean_Response");
          raise UNSTABLE_SOLUTION;
end Calculate_Mean_Response;
--LINEFEED
with Text_Handler; use Text_Handler;
package Help_Setup is
--===========================================================
--     Contains Help Facility Parameters Likely to be altered
--     system installation. To avoid complete recompilation,
--     parameter values are located in the package body.
--============================================================


       --==========Setup Parameters ========================

    Help_Directory     : Text ;

    Help_File_Name_Ext : Text;

end Help_Setup;


package body Help_Setup is
begin
     Help_Directory := Txt("");
     Help_File_Name_Ext := Txt( ".hlp");
end Help_Setup;
with Text_Handler ; use Text_Handler;
with Global_Types ; use Global_Types;
with MMI_Io       ; use MMI_Io;
with Net_Stats    ; use Net_Stats;
with Node_Servicer ; use Node_Servicer;

package MMI  is

------------------------------------------------------------------------
-- This Package contains constants, exceptions, types, functions
-- and procedures that are used by the procedure, Edit.
-- Each of these categories has its members arranged in
-- alphabetical order when possible.
--
------------------------------------------------------------------------


------------------------------------------------------------------------
--                       Constants
------------------------------------------------------------------------

Double         :  Constant Natural := 2;
Is_Prompt_Mode :  Constant Boolean := True;
No_Query       :  Constant Text    := Txt("");
Single         :  Constant Natural := 1;

------------------------------------------------------------------------
--                       Exceptions
------------------------------------------------------------------------

Command_Error    : Exception;
Unstable_Solution: Exception renames Net_Stats.Unstable_Solution;

------------------------------------------------------------------------
--                       Super Types - Those that other types depend on.
------------------------------------------------------------------------

type    BooleanArray    is array (NumNodes range <>) of Boolean;

type    NodesArray      is array (NumNodes range <>) of NodeName;

type    NodesType (Number: NumNodes := NumNodes'First) is
   record
      Name    : NodesArray   (1 .. Number);
   end record;

type    One             is new Integer range 1 .. 1;

type    ProbArray       is array (NumNodes range <>) of Probs;

type    PbranchType (Number: NumNodes := NumNodes'First) is
   record
      Val:  ProbArray (1 .. Number);
   end record;

--LINEFEED
------------------------------------------------------------------------
--                       Types
------------------------------------------------------------------------

type    CommandType      is (Help, Run, Prompt, Njobs, Nnodes, Order,
                             Node, Discipline, Nservers, Distribution,
                             Endnode, Pbranch, Nstages, Rates, Cbranch,
                             Save, Show, Quit, Infile, Outfile, Reset,
                             Report, Title, Echo, Paging);

type    ExponRates       is array (One range <>) of ExponRate;

type    ErlangRates      is array (One range <>) of ErlangRate;

type    GlobalStatusType is
   record
      Title          : Boolean;
      N_Nodes        : Boolean;
      Order          : Boolean;
      N_Jobs         : Boolean;
   end record;

type    GlobalValueType is
   record
      N_Nodes        : NumNodes;
      Nodes          : NodesType;
      N_Jobs         : NumJobs;
      Title          : Text;
   end record;

type    MmiMode         is (Edit, Prompt, Infile);

subtype NodeSubcommandType is CommandType range Discipline .. Cbranch;

type    NodeStatusType  is
   record
      Node           : Boolean;
      P_Branch       : Boolean;
      Discip         : Boolean;
      Dist           : Boolean;
      N_Servers      : Boolean;
      N_Erlang_Stages: Boolean;
      N_Coxian_Stages: Boolean;
      C_Branch       : Boolean;
      Expon_Rate     : Boolean;
      Erlang_Rate    : Boolean;
      Coxian_Rates   : Boolean;
   end record;

--LINEFEED
type    NodeValueType   is
   record
      Name            : Text;
      Discip          : ServMode;
      N_Servers       : NumServers;
      P_Branch        : PbranchType;
      Dist            : ServDist;
      N_Erlang_Stages : NumErlangStages;
      N_Coxian_Stages : NumCoxianStages;
      Expon_Rates     : ExponRates (1 .. 1);
      Erlang_Rates    : ErlangRates(1 .. 1);
      Coxian_Dist     : CoxianDist;
   end record;

type    ReportType      is (Routing, Arrival_Frequencies, Serv_Times,
                            Serv_Requirements, Response_Times,
                            Throughput, Qlength_Distributions,
                            Normalizations, Pbranch, Model);

type    ShowType        is (Title, Nnodes, Order, Njobs, Node, Model);

type    YesNo           is (Yes, No);

--LINEFEED
------------------------------------------------------------------------
--                   Procedures and Functions
------------------------------------------------------------------------

procedure Check_Dist_Set           (Dist_Set: in Boolean);
  ----------------------------------------------------------------------
  -- Checks that the Distribution command has been issued.
  -- Raises Command_Error if not.
  ----------------------------------------------------------------------

procedure Check_Nnodes_Set         (Nnodes_Set: in Boolean);
  ----------------------------------------------------------------------
  -- Checks that the Nnode Command has been issued.
  -- Raises Command_Error if not.
  ----------------------------------------------------------------------

procedure Check_Nnodes_Not_Set     (Nnodes_Set: in Boolean);
  ----------------------------------------------------------------------
  -- Checks that the Nnode Command has not been issued.
  -- Raises Command_Error if it has.
  ----------------------------------------------------------------------

procedure Check_Node_Subcommand_Ok (Node_Set  : in Boolean;
                                    Global_Set: in GlobalStatusType);
  ----------------------------------------------------------------------
  -- Checks that Nnodes, Order, Njobs, Node commands have been issued.
  -- Raises Command_Error if not.
  ----------------------------------------------------------------------

procedure Check_Order_Not_Set      (Order_Set: in Boolean);
  ----------------------------------------------------------------------
  -- Checks that the Order Command has not been issued.
  -- Raises Command_Error if it has.
  ----------------------------------------------------------------------

procedure Check_N_Stages_Set       (N_Stages_Set: in Boolean);
  ----------------------------------------------------------------------
  -- Checks that the Nstages command has been issued.
  -- Raises Command_Error if not.
  ----------------------------------------------------------------------

procedure Display (Message       : in String;
                   Is_Prompt_Mode: in Boolean := False);
  ----------------------------------------------------------------------
  -- Outputs Message to the output media and then outputs the prompt,
  -- whether it be E> (edit mode), P> (prompt mode), or
  -- I> (Infile mode). These correspond to MMImodes.
  ----------------------------------------------------------------------

--LINEFEED
function  Equal (V1: in Real;
                 V2: in Real) return Boolean;
  ----------------------------------------------------------------------
  -- Declares two floating point numbers equal if they are within some
  -- delta of each other.
  ----------------------------------------------------------------------

procedure Error   (Message: in String);
  ----------------------------------------------------------------------
  -- Outputs Message to the output media as an error.
  ----------------------------------------------------------------------

procedure Get_Cbranch (C_Branch: in out ContinProbs;
                       Mode    : in     MMImode := Edit;
                       Query   : in     Text := No_Query);
  ----------------------------------------------------------------------
  -- Gets from the user the continuation branching probabilites
  -- between stages of a Coxian distribution. If there is an input
  -- error, then if (a) mode = prompt, the user must reenter, (b)
  -- otherwise Command_Error is raised.
  ----------------------------------------------------------------------

procedure Get_Infile;
  ----------------------------------------------------------------------
  -- Sets the command input stream to a file.
  ----------------------------------------------------------------------

generic
   type Item is range <>;
procedure Get_Integer (Target     : out Item;
                       Target_Type: in  String;
                       Mode       : in  MMImode := Edit;
                       Query      : in  Text := No_Query);
  ----------------------------------------------------------------------
  -- Gets from the user either Nnodes, Njobs, Nservers, Nstages(Erlang),
  -- or Nstages(Coxian) depending on the instantiation. Input error is
  -- handled similarly to Get_Cbranch.
  ----------------------------------------------------------------------

procedure Get_Node_Info  (Val : in out NodeValueType;
                          Set :    out NodeStatusType);
  ----------------------------------------------------------------------
  -- Sets the records Val (except Val.Name) and Set depending on the
  -- characteristics of the node which is obtained from the network.
  ----------------------------------------------------------------------

procedure Get_Node_List  (Node_List: in out NodeList;
                          Nodes    : in     NodesType);
  ----------------------------------------------------------------------
  -- Builds a nodelist from a parsing of the report command.
  ----------------------------------------------------------------------

--LINEFEED
procedure Get_Order (Nodes  : in out NodesType;
                     N_Nodes: in     NumNodes;
                     Mode   : in     MMImode := Edit;
                     Query  : in     Text    := No_Query);
  ----------------------------------------------------------------------
  -- Gets from the user the nodes in the correct order. Input error is
  -- handled similarly to Get_Cbranch.
  ----------------------------------------------------------------------

procedure Get_Outfile;
  ----------------------------------------------------------------------
  -- Sets the message output to the appropriate media (terminal/file).
  ----------------------------------------------------------------------

Function  Get_Pbranch (Node_Def: in NodeDef) return PbranchType;
  ----------------------------------------------------------------------
  -- Converts Pbranch (branching probabilities from a node to all nodes)
  -- from the format of the Network package to the format of this pack.
  ----------------------------------------------------------------------

procedure Get_Pbranch (Nnodes   : in  NumNodes;
                       P_Branch : out PbranchType;
                       Mode     : in  MMImode := Edit;
                       Query    : in  Text := No_Query);
  ----------------------------------------------------------------------
  -- Gets from the user Pbranch as described in the previous function.
  -- Input error is handled similarly to Get_Cbranch.
  ----------------------------------------------------------------------

generic
   type IndexTyp is range <>;
   type Floating is digits <>;
   type Vector   is array (IndexTyp range <>) of Floating;
procedure Get_Rates (Rates: in out Vector;
                     Mode : in     MMImode := Edit;
                     Query: in     Text    := No_Query);
  ----------------------------------------------------------------------
  -- Gets from the user either Exponential, Erlang, or Coxian rates,
  -- depending on the instantiation. Input error is
  -- handled similarly to Get_Cbranch.
  ----------------------------------------------------------------------

generic
   type Item is (<>);
procedure Get_Text    (Target     : out Item;
                       Target_Type: in  String;
                       Mode       : in  MMImode := Edit;
                       Query      : in  Text := No_Query);
  ----------------------------------------------------------------------
  -- Gets from the user either a command, the discipline, the
  -- distribution, a yes/no, or any other response which is an
  -- enumeration type. Input error is handled similary to Get_Cbranch.
  ----------------------------------------------------------------------

--LINEFEED
procedure Get_Title (Model_Title: out Text;
                     Mode       : in  MMImode := Edit;
                     Query      : in  Text := No_Query);
  ----------------------------------------------------------------------
  -- Gets the Title which will appear on all reports.
  ----------------------------------------------------------------------

procedure Help (Topic_Short: in Text);
  ----------------------------------------------------------------------
  -- Outputs the topic in the system help file to the output media.
  ----------------------------------------------------------------------

function  Index       (Node_Name: in Text;
                       Nodes    : in NodesType) return integer;
  ----------------------------------------------------------------------
  -- Finds the index of Node_Name in the array Nodes.Name.
  ----------------------------------------------------------------------

procedure Insert_Dummy_Nodes  (Nodes: in NodesType);
  ----------------------------------------------------------------------
  -- Inserts template nodes into the network after the order
  -- command is issued.
  ----------------------------------------------------------------------

function  Make_Float (From: in Text) return Text;
  ----------------------------------------------------------------------
  -- Converts ADA unacceptable float values to acceptable values.
  -- examples - 20, .55
  ----------------------------------------------------------------------

function  Missing_Global_Commands  (Set: in GlobalStatusType)
                                    return String;
  ----------------------------------------------------------------------
  -- Provides a list of the following commands that have not been
  -- issued: Nnodes, Order, Njobs.
  ----------------------------------------------------------------------

function  Missing_Node_Commands    (Set  : in NodeStatusType;
                                    Dist : in ServDist)
                                    return String;
  ----------------------------------------------------------------------
  -- Provides a list of the following commands that have not been
  -- issued: Pbranch, Discipline, Distribution, Nservers, Rates,
  -- Nstages (Erlang or Coxian), Cbranch (Coxian).
  ----------------------------------------------------------------------

function  Mode (Is_Prompt_Mode: in Boolean := False) return MMImode;
  ----------------------------------------------------------------------
  -- Returns the MMImode (either edit, prompt, or infile).
  ----------------------------------------------------------------------

--LINEFEED
procedure Put_Node_Info (Val: in NodeValueType;
                         Set: in NodeStatusType);
  ----------------------------------------------------------------------
  -- The reverse of Get_Node_Info. Replaces a node in the network
  -- with the new values in Val.
  ----------------------------------------------------------------------

function  Quote   (From: in Text)  return String;
  ----------------------------------------------------------------------
  -- puts From in single quotes.
  ----------------------------------------------------------------------

procedure Report_Set_Up (Report_Type: in ReportType;
                         N_Jobs     : NumJobs;
                         Nodes      : in NodesType);
  ----------------------------------------------------------------------
  -- Parses report command line and calls appropriate report program.
  ----------------------------------------------------------------------

procedure Run     (Nodes : in NodesType;
                   N_Jobs: in NumJobs);
  ----------------------------------------------------------------------
  -- Checks that all nodes have complete info and then runs the
  -- simulation.
  ----------------------------------------------------------------------

--LINEFEED
procedure Set_Exponential (Dist: out ServDist);
  ----------------------------------------------------------------------
  -- Sets Dist to Exponential.
  ----------------------------------------------------------------------

procedure Set_Nservers    (N_Servers: out NumServers;
                           Discip   : in  ServMode;
                           N_Jobs   : in  NumJobs);
  ----------------------------------------------------------------------
  -- Sets Nservers when discipline is not Fcfs.
  ----------------------------------------------------------------------

function  Short           (Node_Name: NodeName) return String;
  ----------------------------------------------------------------------
  -- Converts Node_Name into text with no trailing blanks.
  ----------------------------------------------------------------------

------------------------------------------------------------------------
-- The following Show procedures show their value(s) to the output
-- stream specified in Outmode.
------------------------------------------------------------------------

procedure Show_All    (Val      : in GlobalValueType;
                       Set      : in GlobalStatusType;
                       Out_Mode : in Outmode);

procedure Show_Njobs  (N_Jobs   : in NumJobs;
                       Set      : in Boolean;
                       Out_Mode : in OutMode);

procedure Show_Nnodes (N_Nodes  : in NumNodes;
                       Set      : in Boolean;
                       Out_Mode : in OutMode);

procedure Show_Node   (Node_Name: in Text;
                       Out_Mode : in OutMode);

procedure Show_Node   (ND       : in NodeDef;
                       Out_Mode : in OutMode);

procedure Show_Order  (Nodes    : in NodesType;
                       Set      : in Boolean;
                       Out_Mode : in OutMode);

procedure Show_Title  (Title    : in Text;
                       Set      : in Boolean;
                       Out_Mode : in Outmode);

procedure Update_NoQueue_Nodes (N_Jobs: in NumJobs);
  ----------------------------------------------------------------------
  -- Updates the nodes in the network which have a No_Queue discipline
  -- so that Nservers = Njobs.
  ----------------------------------------------------------------------

function  Verified (Query: Text) return Boolean;
  ----------------------------------------------------------------------
  -- Lets the user verify an action with yes/no.
  ----------------------------------------------------------------------

procedure Welcome;
  ----------------------------------------------------------------------
  -- Displays the program welcome banner.
  ----------------------------------------------------------------------

end MMI;
--LINEFEED
with Network      ; use Network;
with Real_Mat_Pak ; use Real_Mat_Pak;
with Help_Setup   ;

package body MMI is

   Help_Directory  : Text :=  Help_Setup.Help_Directory ;

   Help_Ext        : Text := Help_Setup.Help_File_Name_Ext;

   Title_Max_Length: Constant Positive:= 50;

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

   procedure Check_Dist_Set (Dist_Set: in Boolean) is

   begin

      if not Dist_Set then
         Error ("The Distribution has not been set.");
         raise Command_Error;
      end if;

   end Check_Dist_Set;

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

   procedure Check_Nnodes_Set (Nnodes_Set: in Boolean) is

   begin

      if not Nnodes_Set then
         Error ("Nnodes has not been set.");
         raise Command_Error;
      end if;

   end Check_Nnodes_Set;

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

   procedure Check_Nnodes_Not_Set (Nnodes_Set: in Boolean) is

   begin

      if Nnodes_Set then
         Error ("Nnodes has already been set. Use 'Reset'.");
         raise Command_Error;
      end if;

   end Check_Nnodes_Not_Set;
--LINEFEED
procedure Check_Node_Subcommand_Ok (Node_Set  : in Boolean;
                                    Global_Set: in GlobalStatusType) is

begin

   if not Node_Set then
      Error ("The following command(s) must first be issued: " &
         Missing_Global_Commands(Global_Set) & " Node.");
      raise Command_Error;
   end if;

end Check_Node_Subcommand_Ok;

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

procedure Check_N_Stages_Set (N_Stages_Set: in Boolean) is

begin

   if not N_Stages_Set then
      Error ("Nstages has not been set.");
      raise Command_Error;
   end if;

end Check_N_Stages_Set;

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

procedure Check_Order_Not_Set (Order_Set: in Boolean) is

begin

   if Order_Set then
      Error ("Order has already been set. Use 'Reset'.");
      raise Command_Error;
   end if;

end Check_Order_Not_Set;

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

procedure Display (Message       : in String;
                   Is_Prompt_Mode: in Boolean := False) is
begin

   if Is_Prompt_Mode then
      Write ("", Spacing => Single);
   end if;

   Write (Message, Spacing => Single);
   Write (MMImode'Image(Mode(Is_Prompt_Mode))(1 .. 1) & "> ");

end Display;
--LINEFEED
function Equal (V1: in Real;
                V2: in Real) return Boolean is

begin

   return Abs(V1-V2) < 1.0E-3;

end Equal;

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

procedure Error (Message: in String) is

begin

   Write("Error. " & Message & " Rest of input line ignored.",
      Terminal_Out, Single);
   Flush_Input;

end Error;
--LINEFEED
procedure Get_Cbranch (C_Branch: in out ContinProbs;
                       Mode    : in     MMImode := Edit;
                       Query   : in     Text    := No_Query) is

   Response : Text;
   Zero_Prob: Boolean;

begin

   loop
      begin
         if Mode = Prompt and C_Branch'Length > 1 then
            Display (Strng(Query), Is_Prompt_Mode);
         end if;

         Zero_Prob := False;
         for Idx in NumCoxianStages(1) .. C_Branch'Length-1 loop
            Response := Txt(Token);
            Set (C_Branch(Idx), Make_Float(Response));
            if C_Branch(Idx) = 0.0 then
               Zero_Prob := True;
               exit;
            end if;
         end loop;

         if Zero_Prob then
            Error ("A Cbranch value is 0.0");
            if Mode /= Prompt then
               raise Command_Error;
            end if;
         else
            return;
         end if;

      exception
         when EOF | Command_Error =>
            raise;
         when others              =>
            Error ("Cbranch value" & Quote(Response) &
               "not in range 0.0 .. 1.0, excluding 0.0");
            if Mode /= Prompt then
               raise Command_Error;
            end if;
      end;
   end loop;

end Get_Cbranch;
--LINEFEED
procedure Get_Infile is

   Name: Text := Txt(Token);

begin

   if Get_Media(Input) = Terminal then
      Openf (Input, Strng(Name));
      Set_Media (Input, File);
   else
      Error ("Nested infiles are not allowed.");
   end if;

exception
   when others =>
      Error ("Input file '" & Strng(Name) & "' could not be opened.");

end Get_Infile;

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

procedure Get_Integer (Target     : out Item;
                       Target_Type: in  String;
                       Mode       : in  MMImode := Edit;
                       Query      : in  Text    := No_Query) is
   Response: Text;

begin

loop
   begin
      if Mode = Prompt then
         Display (Strng(Query), Is_Prompt_Mode);
      end if;

      Response := Txt(Token);
      Target   := Item'Value (Strng(Response));
      exit;

   exception
      when EOF    =>
         raise;
      when others =>
         Error (Target_Type & Quote(Response) & "not in range " &
            Item'Image(Item'First) & " .. " & Item'Image(Item'Last));
         if Mode /= Prompt then
            raise Command_Error;
         end if;
   end;
end loop;

end Get_Integer;
--LINEFEED
procedure Get_Node_Info  (Val : in out NodeValueType;
                          Set :    out NodeStatusType) is

   ND      : NodeDef;
   SD      : ServDisc;

begin

   Get_Node (Strng(Val.Name,NodeName'Length), ND);

   Set := (Discip    => True,
           P_Branch  => True,
           Dist      => True,
           N_Servers => True,
           others    => False);

   SD := Node_Serv_Disc (ND);

   Val.P_Branch  := Get_Pbranch (ND);
   Val.Discip    := SD.Serv_Mode;
   Val.N_Servers := SD.Num_Servers;
   Val.Dist      := SD.Serv_Funct.Serv_Dist;

   case Val.Dist is
      when Exponential =>
         Val.Expon_Rates(1)  := SD.Serv_Funct.Expon_Rate;
         Set.Expon_Rate      := True;
      when Erlang      =>
         Val.N_Erlang_Stages := SD.Serv_Funct.Num_Erlang_Stages;
         Set.N_Erlang_Stages := True;
         Val.Erlang_Rates(1) := SD.Serv_Funct.Erlang_Rate;
         Set.Erlang_Rate     := True;
      when Coxian      =>
         Val.Coxian_Dist     := SD.Serv_Funct.Coxian_Dist;
         Val.N_Coxian_Stages := Val.Coxian_Dist.Num_Coxian_Stages;
         Set.N_Coxian_Stages := True;
         Set.Coxian_Rates    := True;
         Set.C_Branch        := True;
   end case;

exception
   when others =>
      Error ("Node" & Quote(Val.Name) & "is not found.");

end Get_Node_Info;
--LINEFEED
procedure Get_Node_List  (Node_List: in out NodeList;
                          Nodes    : in     NodesType) is

   Tok:      Text;
   Idx:      Positive;
   use Net_Stats.Node_List_Handler;

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

   procedure Check_Node (Tok: in Text) is

   begin

      if Index (Tok, Nodes) = 0 then
         Error ("Node name" & Quote(Tok) & "is invalid.");
         raise Command_Error;
      end if;

   end Check_Node;

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

begin

   Dispose (Node_List);
   Tok := Txt(Token);

   if Tok = Txt("(") then
      Tok := Txt(Token);
      Idx := 1;
      while (Tok /= Txt(")")) loop
         Check_Node (Tok);

         Insert (Node_List, Strng(Tok,NodeName'Length), After);

         if Idx > Nodes.Name'Length then
            Error ("More nodes have been specified than in the model.");
            raise Command_Error;
         end if;

         Tok := Txt(Token);
         Idx := Idx + 1;
      end loop;
   elsif Up_Case(Tok) = Txt("ALL") then
      for Nodex in Nodes.Name'Range loop
         Insert (Node_List, Nodes.Name(Nodex), After);
      end loop;
   else
      Check_Node (Tok);
      Insert (Node_List, Strng(Tok,NodeName'Length), After);
   end if;
end Get_Node_List;

--LINEFEED
procedure Get_Order (Nodes:   in out NodesType;
                     N_Nodes: in     NumNodes;
                     Mode   : in     MMImode := Edit;
                     Query  : in     Text    := No_Query)   is

   Bad_Nodes: Exception;
   Blank    : NodeName := (others => ' ');
   Save     : Text;
   Node     : Text;

begin

   Nodes := (N_Nodes, (others => Blank));
   loop
      begin
         if Mode = Prompt then
            Display (Strng(Query), Is_Prompt_Mode);
         end if;

         for Nodex in 1 .. N_Nodes loop
            Node := Txt(Token);

            if (Nodex = 1 and Next_Token_Exists) and then
               Node = Txt("(") then
                  Node := Txt(Token);
            end if;

            if Nodex = N_Nodes and Next_Token_Exists then
               Save := Txt(Token);
               if Save /= Txt(")") then
                  Replace_Token(Save);
               end if;
            end if;

            if Length(Node) > NodeName'Length then
               Error("Node name" & Quote(Node) & "exceeds " &
                  Strng(Txt(NodeName'Length)) & " characters.");
               raise Bad_Nodes;
            end if;

            Save := Up_Case(Node);
            if Save = Txt("ALL") or Save = Txt("FROM") or
               Save = Txt("BY")  or Save = Txt("TO") then
                  Error("A node name cannot be one of: " &
                     "all, by, from, to.");
                  raise Bad_Nodes;
            end if;

            if Index(Node,Txt("(")) > 0 or Index(Node,Txt(")")) > 0 then
               Error("A node name cannot contain '(' or ')'.");
            end if;

            Nodes.Name(Nodex) := Strng(Node,NodeName'Length);

         end loop;
--LINEFEED
       for Nodex1 in 1 .. N_Nodes loop
            for Nodex2 in Nodex1+1 .. N_Nodes  loop
               if Nodes.Name (Nodex1) = Nodes.Name (Nodex2) then
                  Error ("Node name '" & Short(Nodes.Name(Nodex1)) &
                     "' is not unique.");
                  raise Bad_Nodes;
               end if;
            end loop;
         end loop;

         return;

      exception
         when Bad_Nodes =>
            if Mode /= Prompt then
               raise Command_Error;
            end if;
         when others    =>
            raise;
      end;
   end loop;

end Get_Order;
--LINEFEED
procedure Get_Outfile is

   Name: Text := Txt(Token);

begin

   If Get_Media (Report) = File then
      Closef    (Report);
      Set_Media (Report, Terminal);
   end if;

   if not Equal (Up_Case(Name), Txt("TERMINAL")) then
      Openf     (Report, Strng(Name));
      Set_Media (Report, File);
   end if;

exception
   when EOF    =>
      raise;
   when others =>
      Error ("Output file could not be opened.");

end Get_Outfile;

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

Function  Get_Pbranch (Node_Def: in NodeDef) return PbranchType is

   Pbranch : RealVector;
   P_Branch: PbranchType;

begin

   Pbranch := Node_Connect_Prob (Node_Def);
   P_Branch:= (Last_Index_Of(Pbranch), (others => 0.0));

   for Nodex in P_Branch.Val'Range loop
      P_Branch.Val(Nodex) := Probs (Real'(Value_Of(Pbranch,Nodex)));
   end loop;

   return P_Branch;

end Get_Pbranch;
--LINEFEED
procedure Get_Pbranch (Nnodes   : in  NumNodes;
                       P_Branch : out PbranchType;
                       Mode     : in  MMImode := Edit;
                       Query    : in  Text    := No_Query) is

   Sum     : Real;
   Response: Text;
   Pbranch : PbranchType := (Nnodes, (others => 0.0));

begin

   loop
      begin
         if Mode = Prompt then
            Display (Strng(Query), Is_Prompt_Mode);
         end if;

         Sum := 0.0;
         for Nodex in 1 .. Nnodes loop
            Response := Txt(Token);
            Set (Pbranch.Val(Nodex), Make_Float(Response));
            Sum := Sum + Real (Pbranch.Val(Nodex));
         end loop;

         if Equal (Sum, 1.0) then
            P_Branch := Pbranch;
            exit;
         else
            Error ("The branching probabilities do not sum to 1.0");
            if Mode /= Prompt then
               raise Command_Error;
            end if;
         end if;

      exception
         when EOF           =>
            raise;
         when Command_Error =>
            raise;
         when others        =>
            Error ("Pbranch value" & Quote(Response) &
               "not in range 0.0 .. 1.0");
            if Mode /= Prompt then
               raise Command_Error;
            end if;
      end;
   end loop;

end Get_Pbranch;
--LINEFEED
procedure Get_Rates (Rates: in out Vector;
                     Mode : in     MMImode := Edit;
                     Query: in     Text    := No_Query) is

   Sum     : Real;
   Response: Text;

begin

   loop
      begin
         if Mode = Prompt then
            Display (Strng(Query), Is_Prompt_Mode);
         end if;

         for Ratex in Rates'Range loop
            Response := Txt(Token);
            Set (Real(Rates(Ratex)), Make_Float(Response));
         end loop;

         exit;

      exception
         when EOF    =>
            raise;
         when others =>
            Error ("Rate" & Quote(Response) & "not in range " &
                  Strng(Txt(Floating'Small)) & " .. " &
                  Strng(Txt(Floating'Large)));
            if Mode /= Prompt then
               raise Command_Error;
            end if;
      end;
   end loop;

end Get_Rates;
--LINEFEED
procedure Get_Text    (Target     : out Item;
                       Target_Type: in  String;
                       Mode       : in  MMImode := Edit;
                       Query      : in  Text    := No_Query) is

   Response: Text;
   Sum     : Integer;
   Match   : Item;

begin

loop
   begin
      if Mode = Prompt then
         Display (Strng(Query), Is_Prompt_Mode);
      end if;

      Response := Txt(Token);

      Sum := 0;
      For Val in Item'First .. Item'Last loop
         if Index (Up_Case(Txt(Item'Image(Val))),
                   Up_Case(Response))                = 1 then
            Match := Val;
            Sum   := Sum + 1;
         end if;
      end loop;

      if    Sum = 0 then
         Error (Target_Type & Quote(Response) & "is invalid.");
         if Mode /= Prompt then
            raise Command_Error;
         end if;
      elsif Sum = 1 then
         Target := Match;
         return;
      else
         Error (Target_Type & Quote(Response) & "is not unique.");
         if Mode /= Prompt then
            raise Command_Error;
         end if;
      end if;
   end;
end loop;

end Get_Text;
--LINEFEED
procedure Get_Title (Model_Title: out Text;
                     Mode       : in  MMImode := Edit;
                     Query      : in  Text := No_Query) is

   Response: Text;

begin

   loop
      begin
         if Mode = Prompt then
            Display (Strng(Query), Is_Prompt_Mode);
            Response := Txt(Token);
            Replace_Token (Response);
         end if;

         Response := Remove_Leading (Remove_Trailing (
            Input_Line," ")," ");

         if Length(Response) <= Title_Max_Length then
            Model_Title := Response;
            return;
         else
            Error ("The title exceeds " & Strng(Txt(Title_Max_Length)) &
               " characters.");
            if Mode /= Prompt then
               raise Command_Error;
            end if;
         end if;
      end;
   end loop;

end Get_Title;
--LINEFEED
procedure Help (Topic_Short: in Text) is

   Topic_Long: Text;

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

   procedure Open_Help_File (Path: in String) is

   begin

      Openf (Help, Path);

   exception
      when others =>
         Error ("The file '" & Path & "' could not be opened.");
         raise Command_Error;

   end Open_Help_File;

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

   procedure Read_Line (Line: out String) is

   begin

      Line := (Line'Range => ' ');
      Read (Line);

   exception
      when EOF    =>
         Closef (Help);
         raise;
      when others =>
         Error ("An error has been encountered while reading the " &
                "help file.");
         Closef (Help);
         raise Command_Error;
   end Read_Line;
--LINEFEED
   procedure Find_Index_Keyword is

      Line: String (1..80) := (others => ' ');

   begin

      while Line(1) /= '%' loop
         Read_Line (Line);
      end loop;

   exception
      when EOF    =>
         Error ("The help index is invalid.");
         raise Command_Error;
      when others =>
         raise;

   end Find_Index_Keyword;
--LINEFEED
   procedure Check_Topic_In_Index (Topic_Short: in  Text;
                                   Topic_Long : out Text) is

      Line          : String (1..80);
      Topic_To_Check: Text;
      Count         : Integer := 0;

   begin

      loop
         Read_Line (Line);
         exit when Line(1) = '%';

         Topic_To_Check := Up_Case(Before(Txt(Line),Txt(" ")));
         if Index (Topic_To_Check, Up_Case(Topic_Short)) = 1 then
            Topic_Long := Topic_To_Check;
            Count      := Count + 1;
         end if;
      end loop;

      if    Count = 0 then
         Error (Quote(Topic_Short) & "is not a help topic.");
         Closef (Help);
         raise Command_Error;
      elsif Count > 1 then
         Error (Quote(Topic_Short) & "is not a unique help topic.");
         Closef (Help);
         raise Command_Error;
      end if;

   exception
      when EOF    =>
         Error ("End of file was reached while reading the help " &
                "index.");
         raise Command_Error;
      when others =>
         raise;

   end Check_Topic_In_Index;
--LINEFEED
   procedure Display_Index is

      Column     : Positive := 61;
      Index_Topic: Text;
      Line       : String (1..80);

   begin

      Write ("Help is available on the following topics:",
         Terminal_Out, Double);

      loop
         Read_Line (Line);
         exit when Line(1) = '%';

         Index_Topic := Before(Txt(Line),Txt(" "));
         Column := ((Column + 19) mod 80) + 1;
         Set_Column (Column);
         Write (Strng(Index_Topic));
      end loop;

      Write (" ", Spacing=>Single);

   exception
      when EOF    =>
         Error ("End of file was reached while reading the help " &
                "index.");
         raise Command_Error;
      when others =>
         raise;

   end Display_Index;
--LINEFEED
   procedure Display_Topic (Topic_Long: in Text) is

      Line: String (1..80);

   begin

      begin
         loop
            Read_Line (Line);
            exit when Equal (Up_Case (Before (Txt(Line), Txt(" "))),
                             Txt('%') & Topic_Long);
         end loop;

      exception
         when EOF    =>
            Error ("The topic has no information available.");
            raise Command_Error;
         when others =>
            raise;
      end;

      begin
         loop
            Read_Line (Line);
            exit when Line(1) = '%';
            Write (Strng(Remove_Trailing(Txt(Line)," ")),
               Spacing=>Single);
         end loop;

      end;

   end Display_Topic;

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

begin

   Open_Help_File (Strng(Help_Directory) & "index" & Strng(Help_Ext));
   Find_Index_Keyword;

   if Up_Case(Topic_Short) = Txt("INDEX") then
      Display_Index;
   else
      Check_Topic_In_Index (Topic_Short, Topic_Long);
      Closef (Help);
      Open_Help_File (Strng(Help_Directory & Topic_Long & Help_Ext));
      Display_Topic (Topic_Long);
   end if;

   Closef (Help);

exception
   when EOF     =>
      null;
   when others  =>
      raise;

end Help;
--LINEFEED
function  Index       (Node_Name: in Text;
                       Nodes    : in NodesType) return integer is

begin

   for Nodex in Nodes.Name'Range loop
      if Strng(Node_Name,NodeName'Length) = Nodes.Name(Nodex) then
         return Nodex;
      end if;
   end loop;

   return 0;

end Index;

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

procedure Insert_Dummy_Nodes (Nodes: in NodesType) is

   Connect_Probs : RealVector := Allocate(Nodes.Name'Length);
   ND            : NodeDef;

begin

   Set_Up_New_Network;

   for Nodex in Nodes.Name'Range loop
      Assign (Connect_Probs, Nodex, 0.0);
   end loop;

   for Nodex in Nodes.Name'Range loop
      Insert_Node (Create_Node (Nodes.Name(Nodex), False, (Fcfs, 1,
         (Exponential, 1.0)), Connect_Probs), After);
   end loop;

end Insert_Dummy_Nodes;

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

function Make_Float (From: in Text) return Text is

begin

   if Index (From, Txt(".")) = 0 then
      return Txt("0") & From & Txt(".0");
   else
      return Txt("0") & From;
   end if;

end Make_Float;
--LINEFEED
function Missing_Global_Commands (Set: in GlobalStatusType)
                                  return String is

   List : Text := Txt("");

begin

   if not Set.N_Nodes then
      List := List & Txt("Nnodes,");
   end if;

   if not Set.Order then
      List := List & Txt("Order,");
   end if;

   if not Set.N_Jobs then
      List := List & Txt("Njobs,");
   end if;

   return Strng (List);

end Missing_Global_Commands;
--LINEFEED
function  Missing_Node_Commands (Set : NodeStatusType;
                                 Dist: ServDist)
                                                       return String is

   List          : Text := Txt("");

begin

   if not Set.P_Branch then
      List := List & Txt("Pbranch,");
   end if;

   if not Set.Discip then
      List := List & Txt("Discipline,");
   end if;

   if not Set.Dist then
      List := List & Txt("Distribution,");
   end if;

   if not Set.N_Servers then
      List := List & Txt("Nservers,");
   end if;

   case Dist is
      when Exponential =>
         if not Set.Expon_Rate then
            List := List & Txt("Rate,");
         end if;
      when Erlang      =>
         if not Set.N_Erlang_Stages then
            List := List & Txt("Nstages,");
         end if;

         if not Set.Erlang_Rate then
            List := List & Txt("Rate,");
         end if;
      when Coxian      =>
         if not Set.N_Coxian_Stages then
            List := List & Txt("Nstages,");
         end if;

         if not Set.C_Branch then
            List := List & Txt("Cbranch,");
         end if;

         if not Set.Coxian_Rates then
            List := List & Txt("Rates,");
         end if;
   end case;

   return Strng(List);

end Missing_Node_Commands;
--LINEFEED
function Mode (Is_Prompt_Mode: in Boolean := False)  return MmiMode is

begin
   if Is_Prompt_Mode then
      return Prompt;
   elsif Get_Media(Input) = File then
      return Infile;
   else
      return Edit;
   end if;

end Mode;

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

procedure Put_Node_Info  (Val  : in NodeValueType;
                          Set  : in NodeStatusType) is

   Connect_Probs : RealVector;
   List          : Text := Txt (Missing_Node_Commands(Set, Val.Dist));
   Found         : Boolean;
   Node_Name     : NodeName := Strng(Val.Name, NodeName'Length);

begin

   if Length(List) > 0 then
      Error ("The following command(s) have not been issued: " &
             Strng(List));
      raise Command_Error;
   end if;

   Connect_Probs := Allocate (Val.P_Branch.Val'Length);
   for Nodex in Val.P_Branch.Val'Range loop
      Assign (Connect_Probs, Nodex, Val.P_Branch.Val(Nodex));
   end loop;

   case Val.Dist is
      when Exponential =>
         Found := Replace_Node (Node_Name, Create_Node (Node_Name, True,
            (Val.Discip, Val.N_Servers, (Exponential,
            Val.Expon_Rates(1))), Connect_Probs));
      when Erlang      =>
         Found := Replace_Node (Node_Name, Create_Node (Node_Name, True,
            (Val.Discip, Val.N_Servers, (Erlang, Val.N_Erlang_Stages,
            Val.Erlang_Rates(1))), Connect_Probs));
      when Coxian      =>
         Found := Replace_Node (Node_Name, Create_Node (Node_Name, True,
            (Val.Discip, Val.N_Servers, (Coxian, Val.Coxian_Dist)),
            Connect_Probs));
   end case;

end Put_Node_Info;
--LINEFEED
function Quote (From: in Text)  return String is

begin

   return " '" & Strng(From) & "' ";

end Quote;
--LINEFEED
procedure Report_Set_Up (Report_Type: in ReportType;
                         N_Jobs     : NumJobs;
                         Nodes      : in NodesType) is

   Node_List : NodeList;
   type        FromToBy is (From, To, By);
   From_To_By: FromToBy;
   type        ListArray is array (FromToBy) of NodeList;
   Lists     : ListArray;
   type        NaturalArray is array (FromToBy) of Natural;
   Naturals  : NaturalArray;

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

   procedure Get_From_To_By (Lists: in out ListArray) is

      Tok: Text;

   begin

      for Idx in Lists'Range loop
         Tok := Txt(Token);
         if Up_Case(Tok) = Up_Case(Txt(FromToBy'Image(Idx))) then
            Get_Node_List (Lists(Idx), Nodes);
         else
            Replace_Token (Tok);
            Get_Node_List (Lists(Idx), Nodes);
         end if;
      end loop;

   end Get_From_To_By;

--LINEFEED
   begin

   case Report_Type is
      when Arrival_Frequencies =>
         Get_Node_List (Node_List, Nodes);
         Display_Arrival_Freqs (Node_List);
      when Routing             =>
         Get_From_To_By (Lists);
         Display_Routing (Lists(From), Lists(To), Lists(By));
      when Serv_Times          =>
         Get_Node_List (Node_List, Nodes);
         Display_Serv_Times (Node_List);
      when Serv_Requirements   =>
         Get_From_To_By (Lists);
         Display_Service (Lists(From), Lists(To), Lists(By));
      when Response_Times      =>
         Get_Node_List (Node_List, Nodes);
         Display_Response_Times (Node_List);
      when Throughput          =>
         Get_Node_List (Node_List, Nodes);
         Display_Q_Lengths (Node_List);
      when Qlength_Distributions =>
         Get_Node_List (Node_List, Nodes);
         Display_Q_Length_Dists (Node_List);
      when Normalizations      =>
         null;
         Display_GNorms;
      when Pbranch             =>
         null;
         Display_Pbranch;
      when Model               =>
         null;                 -- this was done in main routine.
   end case;

   Dispose(Node_List);
   for Idx in Lists'Range loop
      Dispose (Lists(Idx));
   end loop;

end Report_Set_Up;
--LINEFEED
procedure Run (Nodes : in NodesType;
               N_Jobs: in NumJobs) is

   Bad_Node: Boolean := False;

begin

   if Nodes.Name'Length = 0 then
      Error ("The model has no nodes.");
      Bad_Node := True;
   end if;

   for Nodex in Nodes.Name'Range loop
      if not Node_Is_Complete(Nodes.Name(Nodex)) then
         Error ("Node '" & Short(Nodes.Name(Nodex)) & "' is not set.");
         Bad_Node := True;
      end if;
   end loop;

   if Bad_Node then
      Error("The run command has aborted.");
      raise Command_Error;
   else
      null;
      Calculate_Stats( N_Jobs);
   end if;

end Run;

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

procedure Set_Exponential (Dist : out ServDist) is

begin

   Dist := Exponential;
   Write ("The Distribution is EXPONENTIAL, " &
      "since the Discipline is FCFS.", Spacing=>Single);

end Set_Exponential;
--LINEFEED
procedure Set_Nservers (N_Servers  : out NumServers;
                        Discip     : in  ServMode;
                        N_Jobs     : in  NumJobs) is
begin

      Write("The number of servers is ");
      case Discip is
         when NQ       =>
            Write(Strng(Txt(N_Jobs)) &
               ", since the Discipline is NQ.", Spacing=>Single);
            N_Servers := NumServers(N_Jobs);
         when P_Share  =>
            Write("1, since the Discipline is P_SHARE.",
               Spacing => Single);
            N_Servers := 1;
         when PR_LCFS  =>
            Write("1, since the Discipline is PR_LCFS.",
               Spacing => Single);
            N_Servers := 1;
         when others   =>
            null;                       -- can't get here
      end case;

end Set_Nservers;

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

function Short (Node_Name: NodeName) return String is

begin

   return Strng(Remove_Trailing(Txt(Node_Name)," "));

end Short;

--LINEFEED
procedure Show_All    (Val      : in GlobalValueType;
                       Set      : in GlobalStatusType;
                       Out_Mode : in Outmode) is

   End_Of_Network: Boolean;
   ND            : NodeDef;

begin

   Show_Title   (Val.Title  , Set.Title  , Out_Mode);
   Show_Nnodes  (Val.N_Nodes, Set.N_Nodes, Out_Mode);
   Show_Order   (Val.Nodes  , Set.Order  , Out_Mode);
   Show_Njobs   (Val.N_Jobs , Set.N_Jobs , Out_Mode);

   Move_To_First_Node (End_Of_Network);
   while not End_Of_Network loop
      Get_Node (ND);
      Show_Node (Txt(Short(Name_Of_Node(ND))), Out_Mode);
      Move_To_Next_Node (End_Of_Network);
   end loop;

end Show_All;

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

procedure Show_Njobs  (N_Jobs   : NumJobs;
                       Set      : Boolean;
                       Out_Mode : Outmode)    is

begin

   if Set then
      Write("Njobs = " & Strng(Txt(N_Jobs)), Out_Mode, Single);
   else
      Write("Njobs is not set.", Spacing=>Single);
   end if;


end Show_Njobs;
--LINEFEED
procedure Show_Nnodes (N_Nodes  : in NumNodes;
                       Set      : in Boolean;
                       Out_Mode : in Outmode) is

begin

   if Set then
      Write ("Nnodes = " & Strng(Txt(N_Nodes)), Out_Mode, Single);
   else
      Write ("Nodes is not set.", Spacing=>Single);
   end if;

end Show_Nnodes;

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

procedure Show_Node   (Node_Name: in Text;
                       Out_Mode : in Outmode) is

   ND : NodeDef;

begin

   Get_Node  (Strng(Node_Name,NodeName'Length), ND);
   if Node_Complete(ND) then
      Show_Node (ND, Out_Mode);
   else
      Write("Node" & Quote(Node_Name) &
         "is not set.", Spacing=>Single);
   end if;

exception
   when others  =>
      Error ("Node" & Quote(Node_Name) & "is not in the model.");
      raise Command_Error;

end Show_Node;

--LINEFEED
procedure  Show_Node (ND       : in NodeDef;
                      Out_Mode : in OutMode) is

   SD         : ServDisc       := Node_Serv_Disc (ND);
   SF         : ServFunct      := Node_Serv_Funct(ND);
   P_Branch   : PbranchType    := Get_Pbranch (ND);
   CD         : CoxianDist;

begin

   Write("Node = " & Name_Of_Node(ND), Out_Mode, Single);

   Write(" Pbranch =  ", Out_Mode);
   for Nodex in P_Branch.Val'Range loop
      if Nodex mod 10 = 0 then
         Write ("", Out_Mode, Single);
         Write ("            ", Out_Mode);
      end if;
      Write (Strng(Txt(P_Branch.Val(Nodex))) & " ", Out_Mode);
   end loop;
   Write("", Out_Mode, Single);

   Write(" Discipline = " & ServMode'Image(SD.Serv_Mode), Out_Mode,
      Single);
   Write(" Nservers  = " & Strng(Txt(SD.Num_Servers)),
      Out_Mode, Single);
   Write(" Distribution  = " & ServDist'Image(
      SF.Serv_Dist), Out_Mode, Single);

--LINEFEED
   case SF.Serv_Dist is
      when Exponential =>
         Write("  Rate = " & Strng(Txt(SF.Expon_Rate)),
            Out_Mode, Single);
      when Erlang      =>
         Write("  Nstages = "& Strng(Txt(SF.Num_Erlang_Stages))
            ,Out_Mode, Single);
         Write("  Rate = " & Strng(Txt(SF.Erlang_Rate)),
            Out_Mode, Single);
      when COXIAN =>
         CD := Node_Cox_Dist (ND);

         Write("  Nstages = "& Strng(Txt(
            CD.Num_Coxian_Stages)), Out_Mode, Single);

         Write("  Cbranch = ", Out_Mode);
         for Idx in 1 .. CD.Num_Coxian_Stages-1 loop
            if Idx mod 10 = 0 then
               Write ("", Out_Mode, Single);
               Write ("            ", Out_Mode);
            end if;
            Write(Strng(Txt(CD.Contin_Probs(Idx))) &
               " ", Out_Mode);
         end loop;
         Write("", Out_Mode, Single);

         Write("  Rates =   ", Out_Mode);
         for Idx in 1 .. CD.Num_Coxian_Stages loop
            if Idx mod 8 = 0 then
               Write ("", Out_Mode, Single);
               Write ("            ", Out_Mode);
            end if;
            Write(Strng(Txt(CD.Coxian_Rates(Idx))) &
               " ", Out_Mode);
         end loop;
         Write("", Out_Mode, Single);
   end case;

   Write("Endnode", Out_Mode, Single);

end Show_Node;
--LINEFEED
procedure Show_Order  (Nodes    : in NodesType;
                       Set      : in Boolean;
                       Out_Mode : in Outmode)    is

begin

   if Set then
      Write("Order  = ", Out_Mode);

      for Nodex in Nodes.Name'Range loop
         if Nodex mod 8 = 0 then
            Write ("", Out_Mode, Single);
            Write ("         ", Out_Mode);
         end if;
         Write(Short(Nodes.Name(Nodex)) & " ", Out_Mode);
      end loop;

      Write("", Out_Mode, Single);
   else
      Write("Order is not set.", Spacing=>Single);
   end if;

end Show_Order;

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

procedure Show_Title  (Title    : in Text;
                       Set      : in Boolean;
                       Out_Mode : in Outmode)    is

begin

   if Set then
      Write("Title  = " & Strng(Title), Out_Mode, Single);
   end if;

end Show_Title;
--LINEFEED
procedure  Update_NoQueue_Nodes (N_Jobs: in NumJobs) is

   End_Of_Network: Boolean;
   ND            : NodeDef;
   SD            : ServDisc;
   Found         : Boolean;

begin

   Move_To_First_Node (End_Of_Network);

   while not End_Of_Network loop
      Get_Node (ND);
      SD := Node_Serv_Disc (ND);

      if SD.Serv_Mode = NQ and then
         SD.Num_Servers /= NumServers(N_Jobs) then

            SD.Num_Servers := NumServers(N_Jobs);
            Found := Replace_Node (Name_Of_Node(ND),
                                   Modify_Node (ND,SD));
            Write("Node '" & Short(Name_Of_Node(ND))
               & "' now has Nservers = " & Strng(Txt(N_Jobs)) &
               ", since the Discipline is NQ.", Spacing => Single);
      end if;

      Move_To_Next_Node (End_Of_Network);
   end loop;

end Update_Noqueue_Nodes;
--LINEFEED
function  Verified (Query: in Text) return Boolean is

   Answer:   YesNo;

   procedure Get_YesNo        is new Get_Text (YesNo);

begin

   Get_YesNo (Answer, "Response", Prompt, Query);
   return (Answer = Yes);

end Verified;

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

procedure Welcome is

begin

   Write("Welcome to QSAP version 6/20/85. Please type " &
      "'help new_user'.", Spacing => Double);

end Welcome;

end MMI;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--qsap.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--===========================================================
-- Source:     Division Software Technology and Support
--             Western Development Laboratories
--             Ford Aerospace & Communications Corporation
--             ATTN:  Ada Tools Group
-- Date   : June 1985
--===========================================================



with Text_Handler; use Text_Handler;
with Global_Types; use Global_Types;
with MMI_Io      ; use MMI_Io;
with MMI         ; use MMI;
with Network     ; use Network;
with Reports     ; use Reports;
with Calendar    ; use Calendar;

procedure Qsap is
------------------------------------------------------------------------
-- Main procedure for the MMI. It consists of: local procedures which
-- correspond to commands, external calls to procedures in MMI
-- and MMI_Io packages which correspond to commands, external calls to
-- Network package for storing and retrieving node information in the
-- network, and a body which is a loop that is iterated once for each
-- command that is entered.
--
-- There are three modes corresponding to MMI.mmimodes. Edit mode
-- is the normal one in which the E> prompt is displayed and the
-- user supplies a command. Prompt mode is entered when the user
-- issues the Prompt command. This puts the user into a subsystem
-- in which he or she must answer all questions to make up a complete
-- model. The prompt is P>. Infile mode is entered when the user
-- issues the Infile command which redirects user input to a file
-- instead of the terminal. The prompt is I>.
------------------------------------------------------------------------


procedure Get_Command        is new Get_Text    (CommandType);
procedure Get_Coxian_Nstages is new Get_Integer (NumCoxianStages);
procedure Get_Coxian_Rates   is new Get_Rates   (NumCoxianStages,
                                                 CoxianRate,
                                                 CoxianRates);
procedure Get_Discipline     is new Get_Text    (ServMode);
procedure Get_Distribution   is new Get_Text    (ServDist);
procedure Get_Erlang_Nstages is new Get_Integer (NumErlangStages);
procedure Get_Erlang_Rate    is new Get_Rates   (One,
                                                 ErlangRate,
                                                 ErlangRates);
procedure Get_Expon_Rate     is new Get_Rates   (One,
                                                 ExponRate,
                                                 ExponRates);
procedure Get_Njobs          is new Get_Integer (Numjobs);
procedure Get_Nnodes         is new Get_Integer (NumNodes);
procedure Get_Nservers       is new Get_Integer (NumServers);
procedure Get_Report_Type    is new Get_Text    (ReportType);
procedure Get_YesNo          is new Get_Text    (YesNo);
procedure Show_What          is new Get_Text    (ShowType);
Command               :  CommandType := Reset;
Found                 :  Boolean;
Dummy                 :  Boolean;

Global_Settings       :  GlobalStatusType := (others => False);
   Title_Set          :  Boolean   renames Global_Settings.Title;
   N_Jobs_Set         :  Boolean   renames Global_Settings.N_Jobs;
   N_Nodes_Set        :  Boolean   renames Global_Settings.N_Nodes;
   Order_Set          :  Boolean   renames Global_Settings.Order;
   Run_Set            :  Boolean := False;

Global_Values         :  GlobalValueType;
   N_Nodes            :  NumNodes  renames Global_Values.N_Nodes;
   N_Jobs             :  NumJobs   renames Global_Values.N_Jobs;
   Nodes              :  NodesType renames Global_Values.Nodes;
   Model_Title        :  Text      renames Global_Values.Title;

Node_Settings         :  NodeStatusType := (others => False);
   C_Branch_Set       :  Boolean   renames Node_Settings.C_Branch;
   Coxian_Rates_Set   :  Boolean   renames Node_Settings.Coxian_Rates;
   Discip_Set         :  Boolean   renames Node_Settings.Discip;
   Dist_Set           :  Boolean   renames Node_Settings.Dist;
   Erlang_Rate_Set    :  Boolean   renames Node_Settings.Erlang_Rate;
   Expon_Rate_Set     :  Boolean   renames Node_Settings.Expon_Rate;
   N_Coxian_Stages_Set:  Boolean  renames Node_Settings.N_Coxian_Stages;
   N_Erlang_Stages_Set:  Boolean  renames Node_Settings.N_Erlang_Stages;
   Node_Set           :  Boolean   renames Node_Settings.Node;
   N_Servers_Set      :  Boolean   renames Node_Settings.N_Servers;
   P_Branch_Set       :  Boolean   renames Node_Settings.P_Branch;

Node_Values           :  NodeValueType;
   Coxian_Dist        :  CoxianDist  renames Node_Values.Coxian_Dist;
   Discip             :  ServMode    renames Node_Values.Discip;
   Dist               :  ServDist    renames Node_Values.Dist;
   Erlang_Rates       :  ErlangRates renames Node_Values.Erlang_Rates;
   Expon_Rates        :  ExponRates  renames Node_Values.Expon_Rates;
   N_Servers          :  NumServers  renames Node_Values.N_Servers;
   N_Coxian_Stages    :  NumCoxianStages
                                    renames Node_Values.N_Coxian_Stages;
   N_Erlang_Stages    :  NumErlangStages  renames
                                    Node_Values.N_Erlang_Stages;
   Node_Name          :  Text        renames Node_Values.Name;
   P_Branch           :  PbranchType renames Node_Values.P_Branch;

To_Show               :  ShowType;
------------------------------------------------------------------------
-- Procedures internal to Edit which share its variables.
-- In alphabetical order.
------------------------------------------------------------------------

procedure Cbranch_Command is

begin

   Check_Dist_Set (Dist_Set);

   if Dist = Coxian then
      Check_N_Stages_Set (N_Coxian_Stages_Set);
      Get_Cbranch (Coxian_Dist.Contin_Probs);
      C_Branch_Set := True;
   else
      Error ("The Distribution is not COXIAN.");
   end if;

end Cbranch_Command;

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

procedure Default_IO_Settings is

begin

   Set_Media (Input,  Terminal);
   Set_Media (Report, Terminal);
   Set_Report_Echo     (True);
   Set_Terminal_Paging (False);

end Default_IO_Settings;
procedure Discipline_Command is

   Prior_Non_Fcfs : Boolean := Discip_Set and (Discip /= Fcfs);

begin

   Get_Discipline (Discip, "Discipline");

   if Discip = Fcfs then
      if Prior_Non_Fcfs then
         N_Servers_Set := False;
      end if;
      Set_Exponential (Dist);
      Dist_Set := True;
   else
      Set_Nservers (N_Servers, Discip, N_Jobs);
      N_Servers_Set := True;
   end if;

   Discip_Set := True;

end Discipline_Command;

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

procedure Distribution_Command is

begin

   if Discip_Set and (Discip = Fcfs) then
      Set_Exponential (Dist);
      Flush_Next_Token;
   else
      Get_Distribution (Dist,"Distribution");
   end if;
   Dist_Set := True;

end Distribution_Command;
procedure Echo_Command is

   Answer: YesNo;

begin

   Get_YesNo (Answer, "Yes/No response");
   Set_Report_Echo (Answer = Yes);

end Echo_Command;

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

procedure End_Node_Command is

begin

   Put_Node_Info (Node_Values, Node_Settings);
   Node_Settings := (others => False);
   Write("Node"& Quote(Node_Name) & "has been stored into the model.",
      Spacing => Single);
end End_Node_Command;

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

procedure Help_Command is

begin

   if Next_Token_Exists then
      Help (Txt(Token));
   else
      Help (Txt("INDEX"));
   end if;

end Help_Command;
function Model_Reset return Boolean is

begin

   if Verified (Txt("This will cause the current model definition to " &
      "be lost. Continue? (Yes, No)")) then
          Set_Up_New_Network;
          Global_Settings := (others => False);
          Run_Set         := False;
          Node_Settings   := (others => False);
          return True;
   else
          return False;
   end if;

end Model_Reset;

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

procedure Njobs_Command is

begin

    Get_Njobs (N_Jobs, "Njobs");
    Update_NoQueue_Nodes (N_Jobs);
    N_Jobs_Set := True;

end Njobs_Command;

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

procedure Nnodes_Command is

begin

   Check_Nnodes_Not_Set (N_Nodes_Set);
   Get_Nnodes  (N_Nodes, "Nnodes");
   N_Nodes_Set := True;

end Nnodes_Command;
procedure Node_Command is

   Nodex : Integer;
   Missing_Commands: Text := Txt(Missing_Global_Commands(Global_Settings));

begin

   if Length(Missing_Commands) > 0 then
      Error ("The following command(s) must first be issued: " &
         Strng(Missing_Commands));
      raise Command_Error;
   end if;

   Node_Name := Txt(Token);
   Nodex     := Index (Node_Name, Nodes);

   if Nodex > 0 then
      if Node_Is_Complete (Strng(Node_Name,NodeName'Length)) then
         Get_Node_Info (Node_Values, Node_Settings);
         Node_Set := True;
      else
         Node_Settings := (Node => True, others => False);
      end if;
   else
      Error ("Node '" & Strng(Node_Name) &
         "' was not specified in the order command.");
   end if;

end Node_Command;

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

procedure Nservers_Command is

begin

   if Discip_Set then
      if Discip = Fcfs then
         Get_Nservers (N_Servers, "Nservers");
      else
         Set_Nservers (N_Servers, Discip, N_Jobs);
         Flush_Next_Token;
      end if;
   else
      Get_Nservers (N_Servers, "Nservers");
   end if;

   N_Servers_Set := True;

end Nservers_Command;
procedure Nstages_Command is

   Old_Nstages : NumCoxianStages := N_Coxian_Stages;
   Old_Coxian  : CoxianDist      := Coxian_Dist;

begin

   Check_Dist_Set (Dist_Set);
   case Dist is
      when Erlang =>
         Get_Erlang_Nstages (N_Erlang_Stages,"Nstages");
         N_Erlang_Stages_Set := True;
      when Coxian =>
         Get_Coxian_Nstages (N_Coxian_Stages, "Nstages");
         Coxian_Dist := (N_Coxian_Stages, (others=>1.0),(others=>1.0));

         if N_Coxian_Stages_Set and N_Coxian_Stages <= Old_Nstages then
            if C_Branch_Set then
               for Stagex in 1 .. N_Coxian_Stages-1 loop
                  Coxian_Dist.Contin_Probs(Stagex) :=
                     Old_Coxian.Contin_Probs(Stagex);
               end loop;
            end if;
            if Coxian_Rates_Set then
               for Stagex in 1 .. N_Coxian_Stages loop
                  Coxian_Dist.Coxian_Rates(Stagex) :=
                     Old_Coxian.Coxian_Rates(Stagex);
               end loop;
            end if;
         else
            N_Coxian_Stages_Set := True;
            C_Branch_Set        := False;
            Coxian_Rates_Set    := False;
         end if;
      when others =>
         Error ("The Distribution is not ERLANG or COXIAN.");
   end case;

end Nstages_Command;
procedure Order_Command is

begin

   Check_Nnodes_Set (N_Nodes_Set);
   Check_Order_Not_Set (Order_Set);
   Get_Order (Nodes, N_Nodes);
   Insert_Dummy_Nodes (Nodes);
   Order_Set := True;

end Order_Command;

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

procedure Paging_Command is

   Answer: YesNo;

begin

   Get_YesNo (Answer, "Yes/No response");
   Set_Terminal_Paging (Answer = Yes);

end Paging_Command;

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

procedure Pbranch_Command is

begin

   Get_Pbranch (N_Nodes, P_Branch);
   P_Branch_Set := True;

end Pbranch_Command;
procedure Prompt_Command is

   Node_Id: Text;

begin

   if not Model_Reset then
      return;
   end if;

   Get_Title (Model_Title, Prompt,
      Txt("Enter the title (up to 50 characters) on one line."));
   Set_Title (Strng(Model_Title));

   Get_Nnodes (N_Nodes, "Nnodes", Prompt,
      Txt("Enter the number of nodes: "));
   Get_Order (Nodes, N_Nodes, Prompt, Txt("Enter the ") &
      Txt(Integer(N_Nodes)) & Txt(" node names in order: "));

   Insert_Dummy_Nodes (Nodes);

   Get_Njobs(N_Jobs, "Njobs", Prompt, Txt("Enter the number of jobs:"));

   Global_Settings := (others => True);

   for Nodex in Nodes.Name'Range loop
      Node_Name := Txt(Short(Nodes.Name (Nodex)));
      Node_Id   := Txt("For node ") & Node_Name & Txt(", ");

      Show_Order (Nodes, True, Terminal_Out);
      Get_Pbranch (N_Nodes,P_Branch,Prompt,Node_Id & Txt("enter the ")
         & Txt(Integer(N_Nodes)) & Txt(" branching probabilities ") &
         Txt("to all nodes:"));

      Get_Discipline (Discip, "Discipline", Prompt, Node_Id &
         Txt("enter the discipline (Fcfs, P_share, PR_lcfs, "  &
             "Nq): "));
      if Discip = FCFS then
         Get_Nservers (N_Servers, "Nservers", Prompt,
            Node_Id & Txt("enter the number of servers: "));
         Set_Exponential (Dist);
         Get_Expon_Rate (Expon_Rates, Prompt, Node_Id &
            Txt("Enter the service rate: "));
      else
         Set_Nservers (N_Servers, Discip, N_Jobs);
         Get_Distribution (Dist, "Distribution", Prompt, Node_Id & Txt(
            "Enter the distribution (EXponential, ERlang, Coxian): "));
         case Dist is
            when Exponential =>
               Get_Expon_Rate (Expon_Rates, Prompt, Node_Id &
                  Txt("enter the service rate: "));
            when ERLANG =>
               Get_Erlang_Nstages (N_Erlang_Stages, "Nstages", Prompt,
                  Node_Id & Txt("enter the number of stages:"));
               Get_Erlang_Rate (Erlang_Rates, Prompt, Node_Id &
                  Txt("enter 1 service rate for all stages: "));
            when COXIAN =>
               Get_Coxian_Nstages (N_Coxian_Stages, "Nstages", Prompt,
                  Node_Id & Txt("enter the number of stages: "));
               Coxian_Dist := (N_Coxian_Stages,
                              (others=>1.0), (others=>1.0));
               Get_Cbranch (Coxian_Dist.Contin_Probs, Prompt, Node_Id &
                  Txt("enter the ") & Txt(Integer(N_Coxian_Stages)-1) &
                  Txt(" continuation probabilities between stages: "));
               Get_Coxian_Rates (Coxian_Dist.Coxian_Rates,Prompt,Node_Id
                  & Txt("enter the ") & Txt(Integer(N_Coxian_Stages)) &
                  Txt(" service rates for each stage: "));
         end case;
      end if;

      Put_Node_Info (Node_Values, (others => True));

   end loop;

end Prompt_Command;
procedure Rates_Command is

begin

   Check_Dist_Set (Dist_Set);
   case Dist is
      when Exponential =>
         Get_Expon_Rate   (Expon_Rates);
         Expon_Rate_Set := True;
      when Erlang      =>
         Get_Erlang_Rate  (Erlang_Rates);
         Erlang_Rate_Set := True;
      when Coxian      =>
         Check_N_Stages_Set (N_Coxian_Stages_Set);
         Get_Coxian_Rates (Coxian_Dist.Coxian_Rates);
         Coxian_Rates_Set := True;
   end case;

end Rates_Command;

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

procedure Report_Command is

   Report_Type: ReportType;
   T          : Time := Clock;

begin

      Get_Report_Type (Report_Type, "report type");
      if Report_Type = Model then
         New_Page;
         Print_Title ("Model Definition", " ", T);
         Write (" ", Report, Double);
         Show_All (Global_Values, Global_Settings, Report);
      else
         if Run_Set then
            Report_Set_Up (Report_Type, N_Jobs, Nodes);
         else
            Error ("The Run command must first be issued.");
         end if;
      end if;

end Report_Command;
procedure Run_Command is

begin

   Run (Nodes, N_Jobs);
   Run_Set := True;

end Run_Command;

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

procedure Save_Command is

begin

   Openf (Save, Strng(Txt(Token)));
   Show_All (Global_Values, Global_Settings, Save);
   Closef (Save);

end Save_Command;
procedure Show_Command is

   Node_Show  : Text;
   Nodex      : Integer;

begin

   Show_What (To_Show, "Item to show");
   case To_Show is
      when Title    =>
         Show_Title  (Model_Title, Title_Set, Terminal_Out);
      when Nnodes   =>
         Show_Nnodes (N_Nodes,   N_Nodes_Set, Terminal_Out);
      when Order    =>
         Show_Order  (Nodes,       Order_Set, Terminal_Out);
      when Njobs    =>
         Show_Njobs  (N_Jobs,     N_Jobs_Set, Terminal_Out);
      when Node     =>
         Node_Show := Txt(Token);
         Nodex     := Index (Node_Show, Nodes);
         if Nodex > 0 then
            Show_Node (Node_Show, Terminal_Out);
         else
            Write("Node" & Quote(Node_Show) & "was not specified" &
               " in the order command.", Spacing => Single);
         end if;
      when Model    =>
         Show_All (Global_Values, Global_Settings, Terminal_Out);
   end case;

end Show_Command;

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

procedure Title_Command is

begin

   Get_Title (Model_Title);
   Title_Set := True;
   Set_Title (Strng(Model_Title));

end Title_Command;
------------------------------------------------------------------------
--                     Main Procedure
------------------------------------------------------------------------

begin

   Default_IO_Settings;
   Model_Title := Txt("Main Model");
   Welcome;

   loop
      begin
         Display ("");
         Get_Command (Command, "Command");

         if Command in NodeSubcommandType then
            Check_Node_Subcommand_Ok (Node_Set, Global_Settings);
         end if;

         case Command is
            when Quit         =>
               if Mode = Edit and then
                  Verified(Txt("Do you want to quit (Yes,No)?")) then
                     exit;
               end if;
            when Prompt       => Prompt_Command;
            when Help         => Help_Command;
            when Run          => Run_Command;
            when Title        => Title_Command;
            when Njobs        => Njobs_Command;
            when Nnodes       => Nnodes_Command;
            when Order        => Order_Command;
            when Node         => Node_Command;
            when Pbranch      => Pbranch_Command;
            when Discipline   => Discipline_Command;
            when Nservers     => Nservers_Command;
            when Distribution => Distribution_Command;
            when Nstages      => Nstages_Command;
            when Rates        => Rates_Command;
            when Cbranch      => Cbranch_Command;
            when Infile       => Get_Infile;
            when Outfile      => Get_Outfile;
            when Endnode      => End_Node_Command;
            when Save         => Save_Command;
            when Show         => Show_Command;
            when Report       => Report_Command;
            when Reset        => Dummy := Model_Reset;
            when Echo         => Echo_Command;
            when Paging       => Paging_Command;
         end case;

         if Command in NodeSubcommandType and then
            Missing_Node_Commands (Node_Settings,Dist) = "" then
               Write("Node " & Quote(Node_Name) & " is complete. Use " &
                  "'Endnode' to store into the model.", Terminal_Out,
                  Single);
         end if;

      exception
         when EOF               =>
            Closef (Input);
            Set_Media (Input, Terminal);
         when Command_Error     =>
            null;
         when Unstable_Solution =>
            Write("A Unstable_Solution_Exception has occurred." &
                                      " Type 'help excepts'.");
         when others            =>
            Write("Unhandled exception raised.");
      end;
   end loop;

   if Get_Media(Report) = File then
      Closef (Report);
   end if;
end QSAP;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--help.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

package body Help_Setup is
begin
     Help_Directory := Txt(":udd:facc_krg:demo:help:");
     Help_File_Name_Ext := Txt( ".hlp");
end Help_Setup;