;;; Compiled by f2cl version 2.0 beta Date: 2006/12/21 03:42:11 ;;; Using Lisp CMU Common Lisp CVS Head 2006-12-02 00:15:46 (19D) ;;; ;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t) ;;; (:coerce-assigns :as-needed) (:array-type ':array) ;;; (:array-slicing t) (:declare-common nil) ;;; (:float-format double-float)) (in-package :blas) (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) (type (double-float 0.0 0.0) zero)) (defun dsymm (side uplo m n alpha a lda b ldb$ beta c ldc) (declare (type (array double-float (*)) c b a) (type (double-float) beta alpha) (type (f2cl-lib:integer4) ldc ldb$ lda n m) (type (simple-array character (*)) uplo side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (uplo character uplo-%data% uplo-%offset%) (a double-float a-%data% a-%offset%) (b double-float b-%data% b-%offset%) (c double-float c-%data% c-%offset%)) (prog ((temp1 0.0) (temp2 0.0) (i 0) (info 0) (j 0) (k 0) (nrowa 0) (upper nil)) (declare (type (double-float) temp1 temp2) (type (f2cl-lib:integer4) i info j k nrowa) (type f2cl-lib:logical upper)) (cond ((lsame side "L") (setf nrowa m)) (t (setf nrowa n))) (setf upper (lsame uplo "U")) (setf info 0) (cond ((and (not (lsame side "L")) (not (lsame side "R"))) (setf info 1)) ((and (not upper) (not (lsame uplo "L"))) (setf info 2)) ((< m 0) (setf info 3)) ((< n 0) (setf info 4)) ((< lda (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 nrowa))) (setf info 7)) ((< ldb$ (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 m))) (setf info 9)) ((< ldc (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 m))) (setf info 12))) (cond ((/= info 0) (xerbla "DSYMM " info) (go end_label))) (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) (cond ((= alpha zero) (cond ((= beta zero) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i m) nil) (tagbody (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) zero) label10)) label20))) (t (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i m) nil) (tagbody (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (* beta (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%))) label30)) label40)))) (go end_label))) (cond ((lsame side "L") (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i m) nil) (tagbody (setf temp1 (* alpha (f2cl-lib:fref b-%data% (i j) ((1 ldb$) (1 *)) b-%offset%))) (setf temp2 zero) (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1)) ((> k (f2cl-lib:int-add i (f2cl-lib:int-sub 1))) nil) (tagbody (setf (f2cl-lib:fref c-%data% (k j) ((1 ldc) (1 *)) c-%offset%) (+ (f2cl-lib:fref c-%data% (k j) ((1 ldc) (1 *)) c-%offset%) (* temp1 (f2cl-lib:fref a-%data% (k i) ((1 lda) (1 *)) a-%offset%)))) (setf temp2 (+ temp2 (* (f2cl-lib:fref b-%data% (k j) ((1 ldb$) (1 *)) b-%offset%) (f2cl-lib:fref a-%data% (k i) ((1 lda) (1 *)) a-%offset%)))) label50)) (cond ((= beta zero) (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (* temp1 (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)) (* alpha temp2)))) (t (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (* beta (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%)) (* temp1 (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)) (* alpha temp2))))) label60)) label70))) (t (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody (f2cl-lib:fdo (i m (f2cl-lib:int-add i (f2cl-lib:int-sub 1))) ((> i 1) nil) (tagbody (setf temp1 (* alpha (f2cl-lib:fref b-%data% (i j) ((1 ldb$) (1 *)) b-%offset%))) (setf temp2 zero) (f2cl-lib:fdo (k (f2cl-lib:int-add i 1) (f2cl-lib:int-add k 1)) ((> k m) nil) (tagbody (setf (f2cl-lib:fref c-%data% (k j) ((1 ldc) (1 *)) c-%offset%) (+ (f2cl-lib:fref c-%data% (k j) ((1 ldc) (1 *)) c-%offset%) (* temp1 (f2cl-lib:fref a-%data% (k i) ((1 lda) (1 *)) a-%offset%)))) (setf temp2 (+ temp2 (* (f2cl-lib:fref b-%data% (k j) ((1 ldb$) (1 *)) b-%offset%) (f2cl-lib:fref a-%data% (k i) ((1 lda) (1 *)) a-%offset%)))) label80)) (cond ((= beta zero) (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (* temp1 (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)) (* alpha temp2)))) (t (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (* beta (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%)) (* temp1 (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%)) (* alpha temp2))))) label90)) label100))))) (t (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody (setf temp1 (* alpha (f2cl-lib:fref a-%data% (j j) ((1 lda) (1 *)) a-%offset%))) (cond ((= beta zero) (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i m) nil) (tagbody (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (* temp1 (f2cl-lib:fref b-%data% (i j) ((1 ldb$) (1 *)) b-%offset%))) label110))) (t (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i m) nil) (tagbody (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (* beta (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%)) (* temp1 (f2cl-lib:fref b-%data% (i j) ((1 ldb$) (1 *)) b-%offset%)))) label120)))) (f2cl-lib:fdo (k 1 (f2cl-lib:int-add k 1)) ((> k (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) nil) (tagbody (cond (upper (setf temp1 (* alpha (f2cl-lib:fref a-%data% (k j) ((1 lda) (1 *)) a-%offset%)))) (t (setf temp1 (* alpha (f2cl-lib:fref a-%data% (j k) ((1 lda) (1 *)) a-%offset%))))) (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i m) nil) (tagbody (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (* temp1 (f2cl-lib:fref b-%data% (i k) ((1 ldb$) (1 *)) b-%offset%)))) label130)) label140)) (f2cl-lib:fdo (k (f2cl-lib:int-add j 1) (f2cl-lib:int-add k 1)) ((> k n) nil) (tagbody (cond (upper (setf temp1 (* alpha (f2cl-lib:fref a-%data% (j k) ((1 lda) (1 *)) a-%offset%)))) (t (setf temp1 (* alpha (f2cl-lib:fref a-%data% (k j) ((1 lda) (1 *)) a-%offset%))))) (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i m) nil) (tagbody (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (* temp1 (f2cl-lib:fref b-%data% (i k) ((1 ldb$) (1 *)) b-%offset%)))) label150)) label160)) label170)))) (go end_label) end_label (return (values nil nil nil nil nil nil nil nil nil nil nil nil)))))) (in-package #-gcl #:cl-user #+gcl "CL-USER") #+#.(cl:if (cl:find-package '#:f2cl) '(and) '(or)) (eval-when (:load-toplevel :compile-toplevel :execute) (setf (gethash 'fortran-to-lisp::dsymm fortran-to-lisp::*f2cl-function-info*) (fortran-to-lisp::make-f2cl-finfo :arg-types '((simple-array character (1)) (simple-array character (1)) (fortran-to-lisp::integer4) (fortran-to-lisp::integer4) (double-float) (array double-float (*)) (fortran-to-lisp::integer4) (array double-float (*)) (fortran-to-lisp::integer4) (double-float) (array double-float (*)) (fortran-to-lisp::integer4)) :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil) :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))