tebdol

commit e07a73fb30c01b3040c0e12095e5192fc70b0cbe
parent 2eb5beb3c8b51d6c7b88f6d88f68e502c7884a89
Author: Miroslav Urbanek <mu@miroslavurbanek.com>
Date:   Wed, 28 Jun 2017 13:29:23 +0200

Raise an error if ZGESDD does not converge

ZGESDD returns its status in the output parameter INFO. Check its
value and raise an error if ZGESDD does not finish successfully.

Diffstat:
tebdol/array.lisp
 | 
12
+++++++++---

1 file changed, 9 insertions(+), 3 deletions(-)
diff --git a/tebdol/array.lisp b/tebdol/array.lisp
@@ -203,10 +203,16 @@
 	      (brwork (blas-array-alien rwork))
 	      (biwork (blas-array-alien iwork)))
 	  (macrolet ((f ()
-		       ;; todo: zgesdd returns info parameter, check it
 		       `(sb-sys:with-pinned-objects ((array-storage-vector work))
-			  (zgesdd "s" m n ba m bs bu m bvt min (blas-array-alien work)
-				  lwork brwork biwork))))
+			  (let ((info
+				 (nth-value
+				  1
+				  (zgesdd "s" m n ba m bs bu m bvt min (blas-array-alien work)
+					  lwork brwork biwork))))
+			    (unless (zerop info)
+			      (if (< info 0)
+				  (error "Illegal value of parameter ~A in ZGESDD." (- info))
+				  (error "ZGESDD did not converge (INFO = ~A)." info)))))))
 	    (f)
 	    (setf lwork (floor (realpart (aref work 0))))
 	    (setf work (make-blas-array lwork))