Commit becbc9ce authored by Raymond Toy's avatar Raymond Toy
Browse files

Add support for test-op for lapack.

o Define test system

o Add test infrastructure
o Add deftest for dgeev
parent 2b26abe6
......@@ -310,3 +310,23 @@
:description "LAPACK - Linear Algebra PACKage for double-float matrices"
:pathname "lapack/"
:depends-on ("lapack-package" "lapack-real" "lapack-complex"))
(defmethod perform ((op test-op) (c (eql (find-system "lapack"))))
(oos 'test-op "lapack-tests"))
(defpackage lapack-tests
(:use #:cl))
(defsystem lapack-tests
:depends-on ("lapack" "rt")
:in-order-to ((compile-op (load-op :lapack :rt))
(test-op (load-op :lapack :rt)))
((:module lapack
((:file "lapack-tests")))))
(defmethod perform ((op test-op) (c (eql (find-system "lapack-tests"))))
(or (funcall (intern "DO-TESTS" (find-package '#:rt)))
(error "TEST-OP filed for quadpack-tests")))
\ No newline at end of file
......@@ -88,6 +88,23 @@
(format t "~A~%" (aref e-vec row k)))
(defun check-eigen-val-vec (n e-val e-vec true-val true-vec &key (tol 1d-14))
(flet ((relerr-ok (est true)
(let* ((re (/ (abs (- est true))
(abs true)))
(ok (<= re tol)))
;; Return NIL if it's ok. Otherwise return a list to
;; indicate what failed.
(unless ok
(format t "est = ~S~%true = ~S~% rel = ~S~%"
est true re)
(list est true re)))))
(or (relerr-ok (aref e-val n) true-val)
(dotimes (k n t)
(let ((res (relerr-ok (aref e-vec k n) (aref true-vec k))))
(when res
(return res)))))))
;; DGEEV example based on the example from
(defun test-dgeev ()
......@@ -116,15 +133,49 @@
(dgeev "N" "V" n a-mat n wr wi vl n vr n work lwork 0)
(declare (ignore z-jobvl z-jobvr z-n z-a z-lda z-wr z-wi z-vl z-ldvl z-vr
z-ldvr z-work z-lwork))
(let ((e-val (make-eigval wr wi))
(e-vec (make-eigvec n vr wi)))
;; Display solution
(cond ((zerop info)
(print-dgeev-results (make-eigval wr wi)
(make-eigvec n vr wi)))
(print-dgeev-results e-val
(format t "Failure in DGEEV. INFO = ~D~%" info)))
;; Display workspace info
(format t "Optimum workspace required = ~D~%" (truncate (aref work 0)))
(format t "Workspace provided = ~D~%" lwork))))
(format t "Workspace provided = ~D~%" lwork)
(values e-val e-vec)))))
(rt:deftest dgeev.1
(multiple-value-bind (e-val e-vec)
(list (check-eigen-val-vec 0 e-val e-vec
(check-eigen-val-vec 1 e-val e-vec
#c(-0.0994124532950747d0 0.4007924719897546d0)
#(#c(-0.193301548264222d0 0.254631571927584d0)
#c(0.251856531726740d0 -0.522404734711629d0)
#c(0.097182458443282d0 -0.308383755897228d0)
#c(0.675954054254748 0d0)))
(check-eigen-val-vec 2 e-val e-vec
#c(-0.0994124532950747d0 -0.4007924719897546d0)
#(#c(-0.193301548264222d0 -0.254631571927584d0)
#c(0.251856531726740d0 0.522404734711629d0)
#c(0.097182458443282d0 0.308383755897228d0)
#c(0.675954054254748 0d0)))
(check-eigen-val-vec 3 e-val e-vec
(t t t t))
;; Expected results
......@@ -572,7 +623,8 @@
;;; $Log$
;;; Revision 1.11 2006/12/01 04:29:29 rtoy
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