(FILECREATED "29-Aug-86 15:55:35" {QV}<PEDERSEN>LISP>MATRIXTIMES.;1
 9608   

      changes to:  (VARS MATRIXTIMESCOMS)
                   (FUNCTIONS MATRIX-* MATRIX-VECTOR-* VECTOR-MATRIX-* VECTOR-VECTOR-* 
                          MATRIX-MATRIX-*))


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT MATRIXTIMESCOMS)

(RPAQQ MATRIXTIMESCOMS
 ((* File created by Coms Manager.)
                        (FUNCTIONS MATRIX-* MATRIX-MATRIX-* MATRIX-VECTOR-* VECTOR-MATRIX-* 
                               VECTOR-VECTOR-*)
                        (PROP FILETYPE MATRIXTIMES)
                        (DECLARE: DONTCOPY EVAL@COMPILE (LOCALVARS . T))))



(* File created by Coms Manager.)


(DEFUN MATRIX-*
 (MATRIX-A MATRIX-B &OPTIONAL MATRIX-RESULT) (CL:IF (VECTORP MATRIX-A)
                                                                   (CL:IF (VECTORP MATRIX-B)
                                                                          (VECTOR-VECTOR-* MATRIX-A 
                                                                                 MATRIX-B)
                                                                          (VECTOR-MATRIX-* MATRIX-A 
                                                                                 MATRIX-B 
                                                                                 MATRIX-RESULT))
                                                                   (CL:IF (VECTORP MATRIX-B)
                                                                          (MATRIX-VECTOR-* MATRIX-A 
                                                                                 MATRIX-B 
                                                                                 MATRIX-RESULT)
                                                                          (MATRIX-MATRIX-* MATRIX-A 
                                                                                 MATRIX-B 
                                                                                 MATRIX-RESULT))))

(DEFUN MATRIX-MATRIX-*
 (MATRIX-A MATRIX-B &OPTIONAL MATRIX-RESULT)
   (CL:IF (NOT (TYPEP MATRIX-A (QUOTE (ARRAY SINGLE-FLOAT (CL:* CL:*)))))
          (CL:ERROR "Not a float matrix: ~S" MATRIX-A))
   (CL:IF (NOT (TYPEP MATRIX-B (QUOTE (ARRAY SINGLE-FLOAT (CL:* CL:*)))))
          (CL:ERROR "Not a float matrix: ~S" MATRIX-B))
   (LET ((M (ARRAY-DIMENSION MATRIX-A 0))
         (N (ARRAY-DIMENSION MATRIX-A 1))
         (P (ARRAY-DIMENSION MATRIX-B 1)))
        (CL:IF (NOT (EQL N (ARRAY-DIMENSION MATRIX-B 0)))
               (CL:ERROR "Dimensionality mismatch"))
        (CL:IF MATRIX-RESULT (CL:IF (AND (TYPEP MATRIX-RESULT (QUOTE (ARRAY SINGLE-FLOAT (CL:* CL:*))
                                                                     ))
                                         (EQL M (ARRAY-DIMENSION MATRIX-RESULT 0))
                                         (EQL P (ARRAY-DIMENSION MATRIX-RESULT 1)))
                                    MATRIX-RESULT
                                    (CL:ERROR "Result array of incorrect type: ~s" MATRIX-RESULT))
               (SETQ MATRIX-RESULT (MAKE-ARRAY (LIST M P)
                                          :ELEMENT-TYPE
                                          (QUOTE SINGLE-FLOAT))))
        (CL:DO ((A-BASE (%%GET-FLOAT-ARRAY-BASE MATRIX-A))
                (B-BASE (%%GET-FLOAT-ARRAY-BASE MATRIX-B))
                (R-BASE (%%GET-FLOAT-ARRAY-BASE MATRIX-RESULT))
                (TWICE-M (LLSH M 1))
                (TWICE-N (LLSH N 1))
                (TWICE-P (LLSH P 1))
                (A-START 0 (+ A-START TWICE-N))
                (R-START 0 (+ R-START TWICE-P))
                (I 0 (1+ I)))
               ((EQL I M)
                MATRIX-RESULT)
               (CL:DO ((B-START 0 (+ B-START 2))
                       (R-INDEX R-START (+ R-INDEX 2))
                       (K 0 (1+ K)))
                      ((EQL K P))
                      (CL:DO ((A-INDEX A-START (+ A-INDEX 2))
                              (B-INDEX B-START (+ B-INDEX TWICE-P))
                              (J 0 (1+ J))
                              (PRODUCT 0.0))
                             ((EQL J N)
                              (\PUTBASEFLOATP R-BASE R-INDEX PRODUCT))
                             (DECLARE
 (TYPE FLOATP PRODUCT))
                             (SETQ PRODUCT (+ PRODUCT (CL:* (\GETBASEFLOATP A-BASE A-INDEX)
                                                            (\GETBASEFLOATP B-BASE B-INDEX)))))))))

(DEFUN MATRIX-VECTOR-*
 (MATRIX VECTOR &OPTIONAL VECTOR-RESULT) "Multiply a matrix times a vector"
   (CL:IF (NOT (TYPEP MATRIX (QUOTE (ARRAY SINGLE-FLOAT (CL:* CL:*)))))
          (CL:ERROR "Not a float matrix: ~S" MATRIX))
   (CL:IF (NOT (TYPEP VECTOR (QUOTE (VECTOR SINGLE-FLOAT))))
          (CL:ERROR "Not a float vector: ~S" VECTOR))
   (LET ((M (ARRAY-DIMENSION MATRIX 0))
         (N (ARRAY-DIMENSION MATRIX 1)))
        (CL:IF (NOT (EQL N (ARRAY-TOTAL-SIZE VECTOR)))
               (CL:ERROR "Dimensionality mismatch"))
        (CL:IF VECTOR-RESULT (CL:IF (AND (TYPEP VECTOR-RESULT (QUOTE (VECTOR SINGLE-FLOAT)))
                                         (EQL M (ARRAY-TOTAL-SIZE VECTOR-RESULT)))
                                    VECTOR-RESULT
                                    (CL:ERROR "Result array of incorrect type: ~s" VECTOR-RESULT))
               (SETQ VECTOR-RESULT (MAKE-VECTOR M :ELEMENT-TYPE (QUOTE SINGLE-FLOAT))))
        (CL:DO ((MATRIX-BASE (%%GET-FLOAT-ARRAY-BASE MATRIX))
                (VECTOR-BASE (%%GET-FLOAT-ARRAY-BASE VECTOR))
                (RESULT-BASE (%%GET-FLOAT-ARRAY-BASE VECTOR-RESULT))
                (TWICE-M (LLSH M 1))
                (TWICE-N (LLSH N 1))
                (MATRIX-START 0 (+ MATRIX-START TWICE-N))
                (R-INDEX 0 (+ R-INDEX 2))
                (I 0 (1+ I)))
               ((EQL I M)
                VECTOR-RESULT)
               (CL:DO ((M-INDEX MATRIX-START (+ M-INDEX 2))
                       (V-INDEX 0 (+ V-INDEX 2))
                       (PRODUCT 0.0)
                       (J 0 (1+ J)))
                      ((EQL J N)
                       (\PUTBASEFLOATP RESULT-BASE R-INDEX PRODUCT))
                      (DECLARE
 (TYPE FLOATP PRODUCT))
                      (SETQ PRODUCT (+ PRODUCT (CL:* (\GETBASEFLOATP MATRIX-BASE M-INDEX)
                                                     (\GETBASEFLOATP VECTOR-BASE V-INDEX))))))))

(DEFUN VECTOR-MATRIX-*
 (VECTOR MATRIX &OPTIONAL VECTOR-RESULT) "Multiply a vector and a matrix"
   (CL:IF (NOT (TYPEP VECTOR (QUOTE (VECTOR SINGLE-FLOAT))))
          (CL:ERROR "Not a float vector: ~S" VECTOR))
   (CL:IF (NOT (TYPEP MATRIX (QUOTE (ARRAY SINGLE-FLOAT (CL:* CL:*)))))
          (CL:ERROR "Not a float matrix: ~S" MATRIX))
   (LET ((N (ARRAY-TOTAL-SIZE VECTOR))
         (P (ARRAY-DIMENSION MATRIX 1)))
        (CL:IF (NOT (EQL N (ARRAY-DIMENSION MATRIX 0)))
               (CL:ERROR "Dimensionality mismatch"))
        (CL:IF VECTOR-RESULT (CL:IF (AND (TYPEP VECTOR-RESULT (QUOTE (VECTOR SINGLE-FLOAT)))
                                         (EQL P (ARRAY-TOTAL-SIZE VECTOR-RESULT)))
                                    VECTOR-RESULT
                                    (CL:ERROR "Result array of incorrect type: ~s" VECTOR-RESULT))
               (SETQ VECTOR-RESULT (MAKE-VECTOR P :ELEMENT-TYPE (QUOTE SINGLE-FLOAT))))
        (CL:DO ((VECTOR-BASE (%%GET-FLOAT-ARRAY-BASE VECTOR))
                (MATRIX-BASE (%%GET-FLOAT-ARRAY-BASE MATRIX))
                (RESULT-BASE (%%GET-FLOAT-ARRAY-BASE VECTOR-RESULT))
                (TWICE-N (LLSH N 1))
                (TWICE-P (LLSH P 1))
                (R-INDEX 0 (+ R-INDEX 2))
                (MATRIX-START 0 (+ MATRIX-START 2))
                (I 0 (1+ I)))
               ((EQL I P)
                VECTOR-RESULT)
               (DECLARE
 (TYPE FLOATP VECTOR-ELT))
               (CL:DO ((V-INDEX 0 (+ V-INDEX 2))
                       (M-INDEX MATRIX-START (+ M-INDEX TWICE-P))
                       (PRODUCT 0.0)
                       (J 0 (1+ J)))
                      ((EQL J N)
                       (\PUTBASEFLOATP RESULT-BASE R-INDEX PRODUCT))
                      (DECLARE
 (TYPE FLOATP PRODUCT))
                      (SETQ PRODUCT (+ PRODUCT (CL:* (\GETBASEFLOATP VECTOR-BASE V-INDEX)
                                                     (\GETBASEFLOATP MATRIX-BASE M-INDEX))))))))

(DEFUN VECTOR-VECTOR-*
 (VECTOR-A VECTOR-B) "Multiply two vectors"
   (CL:IF (NOT (TYPEP VECTOR-A (QUOTE (VECTOR SINGLE-FLOAT))))
          (CL:ERROR "Not a float vector: ~S" VECTOR-A))
   (CL:IF (NOT (TYPEP VECTOR-B (QUOTE (VECTOR SINGLE-FLOAT))))
          (CL:ERROR "Not a float vector: ~S" VECTOR-B))
   (LET ((N (ARRAY-TOTAL-SIZE VECTOR-A)))
        (CL:IF (NOT (EQL N (ARRAY-TOTAL-SIZE VECTOR-B)))
               (CL:ERROR "Dimensionality mismatch"))
        (CL:DO ((A-BASE (%%GET-FLOAT-ARRAY-BASE VECTOR-A))
                (B-BASE (%%GET-FLOAT-ARRAY-BASE VECTOR-B))
                (PRODUCT 0.0)
                (LIMIT (LLSH N 1))
                (I 0 (+ I 2)))
               ((EQL I LIMIT)
                PRODUCT)
               (DECLARE
 (TYPE FLOATP PRODUCT))
               (SETQ PRODUCT (+ PRODUCT (CL:* (\GETBASEFLOATP A-BASE I)
                                              (\GETBASEFLOATP B-BASE I)))))))


(PUTPROPS MATRIXTIMES FILETYPE
 COMPILE-FILE)
(DECLARE: DONTCOPY EVAL@COMPILE 
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
)
(PUTPROPS MATRIXTIMES COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL)))
STOP