;;; 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 (f2cl-lib:cmplx 1.0 0.0)) (zero (f2cl-lib:cmplx 0.0 0.0))) (declare (type (f2cl-lib:complex16) one) (type (f2cl-lib:complex16) zero)) (defun zgemm (transa transb m n k alpha a lda b ldb$ beta c ldc) (declare (type (array f2cl-lib:complex16 (*)) c b a) (type (f2cl-lib:complex16) beta alpha) (type (f2cl-lib:integer4) ldc ldb$ lda k n m) (type (simple-array character (*)) transb transa)) (f2cl-lib:with-multi-array-data ((transa character transa-%data% transa-%offset%) (transb character transb-%data% transb-%offset%) (a f2cl-lib:complex16 a-%data% a-%offset%) (b f2cl-lib:complex16 b-%data% b-%offset%) (c f2cl-lib:complex16 c-%data% c-%offset%)) (prog ((temp #C(0.0 0.0)) (i 0) (info 0) (j 0) (l 0) (ncola 0) (nrowa 0) (nrowb 0) (conja nil) (conjb nil) (nota nil) (notb nil)) (declare (type (f2cl-lib:complex16) temp) (type (f2cl-lib:integer4) i info j l ncola nrowa nrowb) (type f2cl-lib:logical conja conjb nota notb)) (setf nota (lsame transa "N")) (setf notb (lsame transb "N")) (setf conja (lsame transa "C")) (setf conjb (lsame transb "C")) (cond (nota (setf nrowa m) (setf ncola k)) (t (setf nrowa k) (setf ncola m))) (cond (notb (setf nrowb k)) (t (setf nrowb n))) (setf info 0) (cond ((and (not nota) (not conja) (not (lsame transa "T"))) (setf info 1)) ((and (not notb) (not conjb) (not (lsame transb "T"))) (setf info 2)) ((< m 0) (setf info 3)) ((< n 0) (setf info 4)) ((< k 0) (setf info 5)) ((< lda (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 nrowa))) (setf info 8)) ((< ldb$ (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 nrowb))) (setf info 10)) ((< ldc (max (the f2cl-lib:integer4 1) (the f2cl-lib:integer4 m))) (setf info 13))) (cond ((/= info 0) (xerbla "ZGEMM " info) (go end_label))) (if (or (= m 0) (= n 0) (and (or (= alpha zero) (= k 0)) (= 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 (notb (cond (nota (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody (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%) zero) label50))) ((/= beta one) (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%))) label60)))) (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) ((> l k) nil) (tagbody (cond ((/= (f2cl-lib:fref b (l j) ((1 ldb$) (1 *))) zero) (setf temp (* alpha (f2cl-lib:fref b-%data% (l j) ((1 ldb$) (1 *)) b-%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%) (* temp (f2cl-lib:fref a-%data% (i l) ((1 lda) (1 *)) a-%offset%)))) label70)))) label80)) label90))) (conja (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 temp zero) (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) ((> l k) nil) (tagbody (setf temp (+ temp (* (f2cl-lib:dconjg (f2cl-lib:fref a-%data% (l i) ((1 lda) (1 *)) a-%offset%)) (f2cl-lib:fref b-%data% (l j) ((1 ldb$) (1 *)) b-%offset%)))) label100)) (cond ((= beta zero) (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (* alpha temp))) (t (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (* alpha temp) (* beta (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%)))))) label110)) label120))) (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 temp zero) (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) ((> l k) nil) (tagbody (setf temp (+ temp (* (f2cl-lib:fref a-%data% (l i) ((1 lda) (1 *)) a-%offset%) (f2cl-lib:fref b-%data% (l j) ((1 ldb$) (1 *)) b-%offset%)))) label130)) (cond ((= beta zero) (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (* alpha temp))) (t (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (* alpha temp) (* beta (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%)))))) label140)) label150))))) (nota (cond (conjb (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody (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%) zero) label160))) ((/= beta one) (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%))) label170)))) (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) ((> l k) nil) (tagbody (cond ((/= (f2cl-lib:fref b (j l) ((1 ldb$) (1 *))) zero) (setf temp (* alpha (f2cl-lib:dconjg (f2cl-lib:fref b-%data% (j l) ((1 ldb$) (1 *)) b-%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%) (* temp (f2cl-lib:fref a-%data% (i l) ((1 lda) (1 *)) a-%offset%)))) label180)))) label190)) label200))) (t (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody (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%) zero) label210))) ((/= beta one) (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%))) label220)))) (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) ((> l k) nil) (tagbody (cond ((/= (f2cl-lib:fref b (j l) ((1 ldb$) (1 *))) zero) (setf temp (* alpha (f2cl-lib:fref b-%data% (j l) ((1 ldb$) (1 *)) b-%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%) (* temp (f2cl-lib:fref a-%data% (i l) ((1 lda) (1 *)) a-%offset%)))) label230)))) label240)) label250))))) (conja (cond (conjb (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 temp zero) (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) ((> l k) nil) (tagbody (setf temp (+ temp (* (f2cl-lib:dconjg (f2cl-lib:fref a-%data% (l i) ((1 lda) (1 *)) a-%offset%)) (f2cl-lib:dconjg (f2cl-lib:fref b-%data% (j l) ((1 ldb$) (1 *)) b-%offset%))))) label260)) (cond ((= beta zero) (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (* alpha temp))) (t (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (* alpha temp) (* beta (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%)))))) label270)) label280))) (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 temp zero) (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) ((> l k) nil) (tagbody (setf temp (+ temp (* (f2cl-lib:dconjg (f2cl-lib:fref a-%data% (l i) ((1 lda) (1 *)) a-%offset%)) (f2cl-lib:fref b-%data% (j l) ((1 ldb$) (1 *)) b-%offset%)))) label290)) (cond ((= beta zero) (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (* alpha temp))) (t (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (* alpha temp) (* beta (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%)))))) label300)) label310))))) (t (cond (conjb (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 temp zero) (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) ((> l k) nil) (tagbody (setf temp (+ temp (* (f2cl-lib:fref a-%data% (l i) ((1 lda) (1 *)) a-%offset%) (f2cl-lib:dconjg (f2cl-lib:fref b-%data% (j l) ((1 ldb$) (1 *)) b-%offset%))))) label320)) (cond ((= beta zero) (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (* alpha temp))) (t (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (* alpha temp) (* beta (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%)))))) label330)) label340))) (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 temp zero) (f2cl-lib:fdo (l 1 (f2cl-lib:int-add l 1)) ((> l k) nil) (tagbody (setf temp (+ temp (* (f2cl-lib:fref a-%data% (l i) ((1 lda) (1 *)) a-%offset%) (f2cl-lib:fref b-%data% (j l) ((1 ldb$) (1 *)) b-%offset%)))) label350)) (cond ((= beta zero) (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (* alpha temp))) (t (setf (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%) (+ (* alpha temp) (* beta (f2cl-lib:fref c-%data% (i j) ((1 ldc) (1 *)) c-%offset%)))))) label360)) label370)))))) (go end_label) end_label (return (values nil 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::zgemm 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) (fortran-to-lisp::integer4) (fortran-to-lisp::complex16) (array fortran-to-lisp::complex16 (*)) (fortran-to-lisp::integer4) (array fortran-to-lisp::complex16 (*)) (fortran-to-lisp::integer4) (fortran-to-lisp::complex16) (array fortran-to-lisp::complex16 (*)) (fortran-to-lisp::integer4)) :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil) :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))))