Commit 43a68f6f authored by Raymond Toy's avatar Raymond Toy
Browse files

Export all of the BLAS functions so LAPACK can use them without a packag

prefix.
parent e97cd145
(defpackage "BLAS"
(:use "COMMON-LISP")
(:export "DAXPY" "DCOPY" "DDOT" "DNRM2" "DSCAL" "IDAMAX" "DASUM"
"DCABS1" "DGBMV" "DGEMM" "DGEMV" "DGER" "DROT" "DROTG"
"DSBMV" "DSPMV" "DSPR" "DSPR2" "DSWAP" "DSYMM" "DSYMV"
"DSYR" "DSYR2" "DSYR2K" "DSYRK" "DTBMV" "DTBSV" "DTPMV"
"DTPSV" "DTRMM" "DTRMV" "DTRSM" "DTRSV" "DZASUM" "DZNRM2"
"ICAMAX" "ISAMAX" "IZAMAX" "LSAME" "XERBLA"))
\ No newline at end of file
(:export
;; blas hompack
"DAXPY"
"DCOPY"
"DDOT"
"DNRM2"
"DSCAL"
"IDAMAX"
;; blas real
"DASUM"
"DCABS1"
"DGBMV"
"DGEMM"
"DGEMV"
"DGER"
"DROT"
"DROTG"
"DSBMV"
"DSPMV"
"DSPR"
"DSPR2"
"DSWAP"
"DSYMM"
"DSYMV"
"DSYR"
"DSYR2"
"DSYR2K"
"DSYRK"
"DTBMV"
"DTBSV"
"DTPMV"
"DTPSV"
"DTRMM"
"DTRMV"
"DTRSM"
"DTRSV"
"DZASUM"
"DZNRM2"
"ICAMAX"
"ISAMAX"
"IZAMAX"
"LSAME"
"XERBLA"
;; blas complex
"ZAXPY"
"ZCOPY"
"ZDOTC"
"ZDOTU"
"ZDSCAL"
"ZGBMV"
"ZGEMM"
"ZGEMV"
"ZGERC"
"ZGERU"
"ZHBMV"
"ZHEMM"
"ZHEMV"
"ZHER"
"ZHER2"
"ZHER2K"
"ZHERK"
"ZHPMV"
"ZHPR"
"ZHPR2"
"ZROTG"
"ZSCAL"
"ZSWAP"
"ZSYMM"
"ZSYR2K"
"ZSYRK"
"ZTBMV"
"ZTBSV"
"ZTPMV"
"ZTPSV"
"ZTRMM"
"ZTRMV"
"ZTRSM"
"ZTRSV"
))
......@@ -250,7 +250,9 @@
:depends-on ("zladiv"))
(:file "zungqr"
:depends-on ("zung2r" "zlarft" "zlarfb"))
(:file "disnan")
(:file "disnan"
:depends-on ("dlaisnan"))
(:file "dlaisnan")
(:file "zlassq")
(:file "zladiv")
(:file "zung2r"
......@@ -279,15 +281,20 @@
:depends-on ("dlapy3"))
(:file "zlahqr"
:depends-on ("zlarfg"))
(:file "zgehrd")
(:file "zgehrd"
:depends-on ("zlahr2" "zgehd2"))
(:file "zunmhr"
:depends-on ("zunmqr"))
(:file "ztrexc"
:depends-on ("zlartg" "zrot"))
:depends-on ("zlartg" "zrot" "zunm2r"))
(:file "dlapy3")
(:file "zlartg")
(:file "zrot")
(:file "zunmqr")
(:file "zlahr2")
(:file "zgehd2"
:depends-on ("zlarfg" "zlarf"))
(:file "zunm2r")
))))
(defsystem "lapack-package"
......
......@@ -503,6 +503,70 @@
(format t "Optimum workspace required = ~D~%" (truncate (aref work 0)))
(format t "Workspace provided = ~D~%" lwork))))
(defun make-complex-eigvec (n vr)
(make-array (list n n)
:displaced-to vr
:element-type (array-element-type vr)))
(defun print-zgeev-results (e-val e-vec)
(format t "~2%ZGEEV Example Program Results~%")
(let ((n (length e-val)))
(dotimes (k n)
(format t "Eigenvalue(~D) = ~A~%" k (aref e-val k))
(format t "~%Eigenvector(~D)~%" k)
(dotimes (row n)
(format t "~A~%" (aref e-vec row k)))
(terpri))))
(defun test-zgeev ()
;; The matrix is
;;
;; #c(-3.97, -5.04) #c(-4.11, 3.70) #c(-0.34, 1.01) #c( 1.29, -0.86)
;; #c( 0.34, -1.50) #c( 1.52, -0.43) #c( 1.88, -5.38) #c( 3.36, 0.65)
;; #c( 3.31, -3.85) #c( 2.50, 3.45) #c( 0.88, -1.08) #c( 0.64, -1.48)
;; #c(-1.10, 0.82) #c( 1.81, -1.59) #c( 3.25, 1.33) #c( 1.57, -3.44)
;;
;; Recall that Fortran arrays are column-major order!
(let* ((n 4)
(a-mat (make-array (* n n)
:element-type '(complex double-float)
:initial-contents '(#c(-3.97d0 -5.04d0)
#c( 0.34d0 -1.50d0)
#c( 3.31d0 -3.85d0)
#c(-1.10d0 0.82d0)
#c(-4.11d0 3.70d0)
#c( 1.52d0 -0.43d0)
#c( 2.50d0 3.45d0)
#c( 1.81d0 -1.59d0)
#c(-0.34d0 1.01d0)
#c( 1.88d0 -5.38d0)
#c( 0.88d0 -1.08d0)
#c( 3.25d0 1.33d0)
#c( 1.29d0 -0.86d0)
#c( 3.36d0 0.65d0)
#c( 0.64d0 -1.48d0)
#c( 1.57d0 -3.44d0))))
(lwork 660)
(w (make-array n :element-type '(complex double-float)))
(rw (make-array lwork :element-type 'double-float))
(vl (make-array 0 :element-type '(complex double-float)))
(vr (make-array (* n n) :element-type '(complex double-float)))
(work (make-array lwork :element-type '(complex double-float))))
(multiple-value-bind (z-jobvl z-jobvr z-n z-a z-lda z-w z-vl z-ldvl z-vr
z-ldvr z-work z-lwork z-rwork info)
(zgeev "N" "V" n a-mat n w vl n vr n work lwork rw 0)
(declare (ignore z-jobvl z-jobvr z-n z-a z-lda z-w z-vl z-ldvl z-vr
z-ldvr z-work z-lwork z-rwork))
;; Display solution
(cond ((zerop info)
(print-zgeev-results w
(make-complex-eigvec n vr)))
(t
(format t "Failure in DGEEV. INFO = ~D~%" info)))
;; Display workspace info
(format t "Optimum workspace required = ~D~%" (truncate (realpart (aref work 0))))
(format t "Workspace provided = ~D~%" lwork))))
(defun do-all-lapack-tests ()
(test-dgeev)
(test-dgeevx)
......
......@@ -6,7 +6,7 @@
(in-package :f2cl-lib)
(defparameter *f2cl-macros-version*
"$Id: macros.l,v c4abe8cf9af0 2011/11/24 07:12:32 toy $")
"$Id: macros.l,v fceac530ef0c 2011/11/26 04:02:26 toy $")
(eval-when
#+gcl (compile load eval)
......@@ -384,7 +384,17 @@ is not included")
(double-float
(truncate (the (double-float #.(float most-negative-fixnum 1d0)
#.(float most-positive-fixnum 1d0))
x)))))
x)))
((complex single-float)
(the integer4
(truncate (the (single-float #.(float (- (ash 1 31)))
#.(float (1- (ash 1 31))))
(realpart x)))))
((complex double-float)
(the integer4
(truncate (the (double-float #.(float (- (ash 1 31)) 1d0)
#.(float (1- (ash 1 31)) 1d0))
(realpart x)))))))
#+(or cmu scl)
(defun int (x)
......@@ -404,7 +414,17 @@ is not included")
(the integer4
(truncate (the (double-float #.(float (- (ash 1 31)) 1d0)
#.(float (1- (ash 1 31)) 1d0))
x))))))
x))))
((complex single-float)
(the integer4
(truncate (the (single-float #.(float (- (ash 1 31)))
#.(float (1- (ash 1 31))))
(realpart x)))))
((complex double-float)
(the integer4
(truncate (the (double-float #.(float (- (ash 1 31)) 1d0)
#.(float (1- (ash 1 31)) 1d0))
(realpart x)))))))
(defun ifix (x)
......@@ -1530,7 +1550,7 @@ causing all pending operations to be flushed"
;;;-------------------------------------------------------------------------
;;; end of macros.l
;;;
;;; $Id: macros.l,v c4abe8cf9af0 2011/11/24 07:12:32 toy $
;;; $Id: macros.l,v fceac530ef0c 2011/11/26 04:02:26 toy $
;;; $Log$
;;; Revision 1.117 2011/02/28 22:21:07 rtoy
;;; When opening an old file, we should set :if-exists to :overwrite to
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment