$ ADA  REAL_MATRIX_ARITHMETIC_   ! file name is REAL_MATRIX_ARITHMETIC_.ADA

with DEFINE_REAL ; use DEFINE_REAL ;

package REAL_MATRIX_ARITHMETIC is

--   This is just a partial example of a full matrix arithmetic package


--   Establish the type ( data structure) REAL_MATRIX
  type REAL_MATRIX is array ( INTEGER range <> , INTEGER range <> ) of REAL ;

--   The first subscript is the row , the second subscript is the column
--   Declare the matrix multiply function, parameters and return
  function "*" ( A , B : REAL_MATRIX ) return REAL_MATRIX ;

--   Declare the PUT procedure
  procedure PUT ( A : REAL_MATRIX ;
                  WIDTH : INTEGER := 3 ;
                  FORE : INTEGER := 2 ; 
                  AFT : INTEGER := REAL'DIGITS - 1 ;
                  EXP : INTEGER := 3 ) ;

--   Declare that MATRIX_ERROR is an exception
  MATRIX_ERROR : exception ;

end REAL_MATRIX_ARITHMETIC ;


$ ADA  REAL_MATRIX_ARITHMETIC  ! file name is REAL_MATRIX_ARITHMETIC.ADA

with TEXT_IO ; use TEXT_IO ;
with INT_IO ; use INT_IO ;
with REAL_IO ; use REAL_IO ;

package body REAL_MATRIX_ARITHMETIC is

  function "*" ( A , B : REAL_MATRIX ) return REAL_MATRIX is

--       Create an object C for temporary use
--       The size is based on the formal parameters A and B when called
    C : REAL_MATRIX ( A'FIRST(1) .. A'LAST(1) , B'FIRST(2) .. B'LAST(2)) ;
  begin

--              check for legal matricies to multiply 
    if A'LENGTH ( 2 ) /= B'LENGTH ( 1 ) then
      raise MATRIX_ERROR ;
    end if ;

-- now, compute the product
    for I in A'RANGE ( 1 ) loop
      for J in B'RANGE ( 2 ) loop
        C ( I , J ) := 0.0 ;
        for K in A'RANGE ( 2 ) loop
          C ( I , J ) := C ( I , J ) + A ( I , K ) * 
                         B ( K - A'FIRST(2) + B'FIRST(1) , J) ;
--                             <-- offset subscript ---> 
--                       all other subscripts are in correct range
        end loop ;
      end loop ;
    end loop ;
    return C ;
  end ;

  procedure PUT ( A : REAL_MATRIX ;
                  WIDTH : INTEGER := 3 ;
                  FORE : INTEGER := 2 ; 
                  AFT : INTEGER := REAL'DIGITS - 1 ;
                  EXP : INTEGER := 3 ) is
  begin
    for I in A'RANGE ( 1 ) loop
      for J in A'RANGE ( 2 ) loop
        PUT ( "MAT(" ) ;
        PUT ( I , WIDTH ) ;
        PUT ( "," ) ;
        PUT ( J , WIDTH ) ;
        PUT ( " ) = " ) ;
        PUT ( A( I , J ) , FORE , AFT , EXP ) ;
        NEW_LINE ;
      end loop ;
    end loop ;
  end PUT ;
end REAL_MATRIX_ARITHMETIC ;