diff --git a/books/bookvol10.5.pamphlet b/books/bookvol10.5.pamphlet index 7b635b5..2743689 100644 --- a/books/bookvol10.5.pamphlet +++ b/books/bookvol10.5.pamphlet @@ -80,7 +80,7 @@ Jonathan\ Steinbach & Robert\ Sutor & Barry\ Trager \\ Stephen\ Watt & Jim\ Wen & Clifton\ Williamson \end{array} $$ -\center{\large{Volume 10: Axiom Algebra: Numerical Routines}} +\center{\large{Volume 10: Axiom Algebra: Numerics}} \end{titlepage} \pagenumbering{roman} \begin{verbatim} @@ -447,11 +447,6 @@ o )show BlasLevelOne \pagehead{BlasLevelOne}{BLAS1} %\pagepic{ps/v104blaslevelone.ps}{BLAS1}{1.00} -{\bf Exports:}\\ -\begin{tabular}{lllll} -\cross{AF}{?**?} & -\end{tabular} - <>= )abbrev package BLAS1 BlasLevelOne ++ Author: Timothy Daly @@ -488,26 +483,166 @@ BlasLevelOne() : Exports == Implementation where "BLAS1" -> "RADCAT" @ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\chapter{BLAS Support Code} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{dcabs1 BLAS} %\pagehead{dcabs1}{dcabs1} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dcabs1.output +)spool dcabs1.output +)set message test on +)set message auto off +)clear all + +--S 1 of 10 +t1:Complex DoubleFloat := complex(1.0,0) +--R +--R +--R (1) 1. +--R Type: Complex DoubleFloat +--E 1 + +--S 2 of 10 +dcabs1(t1) +--R +--R +--R (2) 1. +--R Type: DoubleFloat +--E 2 + +--S 3 of 10 +t2:Complex DoubleFloat := complex(1.0,1.0) +--R +--R +--R (3) 1. + %i +--R Type: Complex DoubleFloat +--E 3 + +--S 4 of 10 +dcabs1(t2) +--R +--R +--R (4) 2. +--R Type: DoubleFloat +--E 4 + +--S 5 of 10 +t3:Complex DoubleFloat := complex(1.0,-1.0) +--R +--R +--R (5) 1. - %i +--R Type: Complex DoubleFloat +--E 5 + +--S 6 of 10 +dcabs1(t3) +--R +--R +--R (6) 2. +--R Type: DoubleFloat +--E 6 + +--S 7 of 10 +t4:Complex DoubleFloat := complex(-1.0,-1.0) +--R +--R +--R (7) - 1. - %i +--R Type: Complex DoubleFloat +--E 7 + +--S 8 of 10 +dcabs1(t4) +--R +--R +--R (8) 2. +--R Type: DoubleFloat +--E 8 + +--S 9 of 10 +t5:Complex DoubleFloat := complex(-2.0,-2.0) +--R +--R +--R (9) - 2. - 2. %i +--R Type: Complex DoubleFloat +--E 9 + +--S 10 of 10 +dcabs1(t5) +--R +--R +--R (10) 4. +--R Type: DoubleFloat +--E 10 + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dcabs1 examples +==================================================================== + +The dcabs1 routine computes the sum of the absolute value of the +real and imaginary parts of a complex number. + +t1:Complex DoubleFloat := complex(1.0,0) + 1. + +dcabs1(t1) + 1. + +t2:Complex DoubleFloat := complex(1.0,1.0) + 1. + %i + +dcabs1(t2) + 2. + +t3:Complex DoubleFloat := complex(1.0,-1.0) + 1. - %i + +dcabs1(t3) + 2. + +t4:Complex DoubleFloat := complex(-1.0,-1.0) + - 1. - %i + +dcabs1(t4) + 2. + +t5:Complex DoubleFloat := complex(-2.0,-2.0) + - 2. - 2. %i + +dcabs1(t5) + 4. + +==================================================================== +Man Page Details +==================================================================== The argument is: \begin{itemize} -\item z - (complex double-float) +\item z - Complex DoubleFloat \end{itemize} The result is \begin{itemize} \item (+ (abs (realpart z)) (abs (imagpart z))) -\item nil \end{itemize} +See Also: +o )show BlasLevelOne +o )display operations dcabs1 +o )help dcabs1 + +@ + Axiom represents the type Complex(DoubleFloat) as a pair whose car is -the real part and whose cdr is the imaginary part. +the real part and whose cdr is the imaginary part. This fact is used +in this implementation. + +This should really be a macro. + <>= (defun dcabs1 (z) "Complex(DoubleFloat) z is a pair where (realpart . imaginarypart). @@ -523,86 +658,24 @@ the real part and whose cdr is the imaginary part. %\pagehead{lsame}{lsame} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} -<>= -(defun lsame (ca cb) - (declare (type (simple-array character (*)) cb ca)) - (f2cl-lib:with-multi-array-data - ((ca character ca-%data% ca-%offset%) - (cb character cb-%data% cb-%offset%)) - (prog ((inta 0) (intb 0) (zcode 0) (lsame nil)) - (declare (type (member t nil) lsame) - (type fixnum zcode intb inta)) - (setf lsame (coerce (f2cl-lib:fstring-= ca cb) '(member t nil))) - (unless lsame - (setf zcode (f2cl-lib:ichar "Z")) - (setf inta (f2cl-lib:ichar ca)) - (setf intb (f2cl-lib:ichar cb)) - (cond - ((or (= zcode 90) (= zcode 122)) - (if (and (>= inta 97) (<= inta 122)) - (setf inta (f2cl-lib:int-sub inta 32))) - (if (and (>= intb 97) (<= intb 122)) - (setf intb (f2cl-lib:int-sub intb 32)))) - ((or (= zcode 233) (= zcode 169)) - (if - (or (and (>= inta 129) (<= inta 137)) - (and (>= inta 145) (<= inta 153)) - (and (>= inta 162) (<= inta 169))) - (setf inta (f2cl-lib:int-add inta 64))) - (if - (or (and (>= intb 129) (<= intb 137)) - (and (>= intb 145) (<= intb 153)) - (and (>= intb 162) (<= intb 169))) - (setf intb (f2cl-lib:int-add intb 64)))) - ((or (= zcode 218) (= zcode 250)) - (if (and (>= inta 225) (<= inta 250)) - (setf inta (f2cl-lib:int-sub inta 32))) - (if (and (>= intb 225) (<= intb 250)) - (setf intb (f2cl-lib:int-sub intb 32))))) - (setf lsame (coerce (= inta intb) '(member t nil)))) - (return (values lsame 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::lsame fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1))) -; :return-values '(nil nil) -; :calls 'nil))) +The {\tt lsame} function returns t if {\tt ca} and {\\ cb} +represent the same letter regardless of case. + +This has been replaced everywhere with common lisp's char-equal function +which compares characters ignoring case. The type +(simple-array character (*)) has been replaced everywhere which character. -@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{xerbla BLAS} %\pagehead{xerbla}{xerbla} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} -<>= -(defun xerbla (srname info) - (declare (type fixnum info) - (type (simple-array character (*)) srname)) - (f2cl-lib:with-multi-array-data - ((srname character srname-%data% srname-%offset%)) - (prog () - (declare) - (format t - " ** On entry to ~a parameter number ~a had an illegal value~%" - srname info) - (return (values 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::xerbla -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (6)) -; fixnum) -; :return-values '(nil nil) -; :calls 'nil))) +The {\tt xerbla} routine is an error handler. +It is called if an input parameter has an invalid value. + +This function has been rewritten everywhere to use the common lisp error +function. -@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{BLAS Level 1} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -610,6 +683,26 @@ the real part and whose cdr is the imaginary part. %\pagehead{dasum}{dasum} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dasum.output +)spool dasum.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dasum examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + Computes doublefloat $asum \leftarrow ||re(x)||_1 + ||im(x)||_1$ Arguments are: @@ -626,6 +719,50 @@ Return values are: \item 3 nil \end{itemize} +NAME + DASUM - BLAS level one, sums the absolute values of the elements of a + double precision vector + +SYNOPSIS + DOUBLE PRECISION FUNCTION DASUM ( n, x, incx ) + + INTEGER n, incx + + DOUBLE PRECISION x + + +DESCRIPTION + This routine performs the following vector operation: + + n + DASUM <-- Sum abs(x(i)) + i=1 + +ARGUMENTS + n INTEGER. (input) + Number of vector elements to be summed. + + x DOUBLE PRECISION. (input) + Array of dimension (n-1) * abs(incx)+ 1. + Vector that contains elements to be summed. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + +RETURN VALUES + DASUM DOUBLE PRECISION. (output) + Sum of the absolute values of the elements of the vector x. + If n <= 0, DASUM is set to 0. + +NOTES + When working backward (incx < 0), each routine starts at the end of the + vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + +@ + <>= (defun dasum (n dx incx) (declare (type (array double-float (*)) dx) @@ -705,6 +842,93 @@ Return values are: %\pagehead{daxpy}{daxpy} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f daxpy.output +)spool daxpy.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +daxpy examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DAXPY - BLAS level one axpy subroutine + +SYNOPSIS + SUBROUTINE DAXPY ( n, alpha, x, incx, y, incy ) + + INTEGER n, incx, incy + + DOUBLE PRECISION alpha, x, y + + +DESCRIPTION + DAXPY adds a scalar multiple of a double precision vector to another + double precision vector. + + DAXPY computes a constant alpha times a vector x plus a vector y. The + result overwrites the initial values of vector y. + + This routine performs the following vector operation: + + y <-- alpha*x + y + + incx and incy specify the increment between two consecutive + elements of respectively vector x and y. + +ARGUMENTS + n INTEGER. (input) + Number of elements in the vectors. If n <= 0, these routines + return without any computation. + + alpha DOUBLE PRECISION. (input) + If alpha = 0 this routine returns without any computation. + + x DOUBLE PRECISION, (input) + Array of dimension (n-1) * |incx| + 1. Contains the vector to + be scaled before summation. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + + y DOUBLE PRECISION, (input and output) + array of dimension (n-1) * |incy| + 1. + Before calling the routine, y contains the vector to be summed. + After the routine ends, y contains the result of the summation. + + incy INTEGER. (input) + Increment between elements of y. + If incy = 0, the results will be unpredictable. + +NOTES + This routine is Level 1 Basic Linear Algebra Subprograms (Level 1 + BLAS). + + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + y(1-incy * (n-1)), y(1-incy * (n-2)), ..., y(1) + +RETURN VALUES + When n <= 0, double precision alpha = 0., this routine returns immedi- + ately with no change in its arguments. + +@ + Computes doublefloat $y \leftarrow \alpha{}x + y$ Arguments are: @@ -802,6 +1026,79 @@ Return values are: %\pagehead{dcopy}{dcopy} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dcopy.output +)spool dcopy.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dcopy examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DCOPY - BLAS level one, copies a double precision vector into another + double precision vector + +SYNOPSIS + SUBROUTINE DCOPY ( n, x, incx, y, incy ) + + INTEGER n, incx, incy + + DOUBLE PRECISION x, y + + +DESCRIPTION + DCOPY copies a double precision vector into another double precision + vector. DCOPY copies a vector x, whose length is n to a vector y. incx + and incy specify the increment between two consecutive elements of + respectively vector x and y. + + This routine performs the following vector operation: + + y <-- x + + where x and y are double precision vectors. + +ARGUMENTS + n INTEGER. (input) + Number of vector elements to be copied. + If n <= 0, this routine returns without computation. + + x DOUBLE PRECISION, (input) + Vector from which to copy. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + + y DOUBLE PRECISION, (output) + array of dimension (n-1) * |incy| + 1, result vector. + + incy INTEGER. (input) + Increment between elements of y. If incy = 0, the results will + be unpredictable. + +NOTES + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + y(1-incy * (n-1)), y(1-incy * (n-2)), ..., y(1) + +@ + <>= (defun dcopy (n dx incx dy incy) (declare (type (array double-float (*)) dy dx) @@ -900,23 +1197,91 @@ Return values are: end_label (return (values 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::dcopy fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ddot BLAS} %\pagehead{ddot}{ddot} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ddot.output +)spool ddot.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ddot examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DDOT - BLAS level one, computes a dot product (inner product) of two + double precision vectors + +SYNOPSIS + DOUBLE PRECISION FUNCTION DDOT ( n, x, incx, y, incy ) + + INTEGER n, incx, incy + + DOUBLE PRECISION x, y + + +DESCRIPTION + DDOT computes a dot product of two double precision vectors (l double + precision inner product). + 2 + + This routine performs the following vector operation: + + n + DDOT <-- (transpose of x) * y = Sum x(i)*y(i) + i=1 + where x and y are double precision vectors. + + If n <= 0, DDOT is set to 0. + +ARGUMENTS + n INTEGER. (input) + Number of elements in each vector. + + x DOUBLE PRECISION. (input) + Array of dimension (n-1) * |incx| + 1. + Array x contains the first vector operand. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + + y DOUBLE PRECISION, (input) + Array of dimension (n-1) * |incy| + 1. + Array y contains the second vector operand. + + incy INTEGER. (input) + Increment between elements of y. If incy = 0, the results will + be unpredictable. + +RETURN VALUES + DDOT DOUBLE PRECISION. Result (dot product). (output) + +NOTES + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + y(1-incy * (n-1)), y(1-incy * (n-2)), ..., y(1) + +@ + <>= (defun ddot (n dx incx dy incy) (declare (type (array double-float (*)) dy dx) @@ -1015,23 +1380,76 @@ Return values are: end_label (return (values ddot 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::ddot fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dnrm2 BLAS} %\pagehead{dnrm2}{dnrm2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dnrm2.output +)spool dnrm2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dnrm2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DNRM2 - BLAS level one, computes the Euclidean norm of a vector + +SYNOPSIS + DOUBLE PRECISION FUNCTION DNRM2 ( n, x, incx ) + + INTEGER n, incx + + DOUBLE PRECISION x + + +DESCRIPTION + DNRM2 computes the Euclidean (L2) norm of a double precision real vec- + tor, as follows: + + DNRM2 <-- ||x|| + 2 + + where x is a double precision real vector. + +ARGUMENTS + n INTEGER. (input) + Number of elements in the operand vector. + + x DOUBLE PRECISION. (input) + Array of dimension (n-1) * |incx| + 1. + Array x contains the operand vector. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + +RETURN VALUES + DNRM2 DOUBLE PRECISION. Result (Euclidean norm). (output) + If n <= 0, DNRM2 is set to 0d0. + +NOTES + When working backward (incx < 0), each routine starts at the end of the + vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -1078,22 +1496,111 @@ Return values are: end_label (return (values dnrm2 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::dnrm2 fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{drotg BLAS} %\pagehead{drotg}{drotg} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f drotg.output +)spool drotg.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +drotg examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGROTG - BLAS level one rotation subroutines + +SYNOPSIS + SUBROUTINE DROTG ( a, b, c, s ) + + DOUBLE PRECISION a, b, c, s + + +DESCRIPTION + DROTG computes the elements of a Givens plane rotation matrix such + that: + + _ _ _ _ _ _ + | c s | | a | | r | + |-s c | * | b | = | 0 | + - - - - - - + + where r = +- sqrt ( a**2 + b**2 ) and c**2 + s**2 =1. + + The Givens plane rotation can be used to introduce zero elements into + a matrix selectively. + + + +ARGUMENTS + a (input and output) DOUBLE PRECISION + + First vector component. On input, the first component of the + vector to be rotated. On output, a is overwritten by by r, the + first component of the vector in the rotated coordinate system + where: + + r = sign(sqrt(a**2 + b**2),a), if |a| > |b| + + r = sign(sqrt(a**2 + b**2),b), if |a| <= |b| + + b (input and output) DOUBLE PRECISION + Second vector component. + + On input, the second component of the vector to be rotated. On + output, b contains z, where: + + z=s if |a| > |b| + z=1/c if |a| <= |b| and c != 0 and r != 0 + z=1 if |a| <= |b| and c = 0 and r != 0 + z=0 if r = 0 + + c (output) DOUBLE PRECISION + Cosine of the angle of rotation: + + c = a/r if r != 0 + c = 1 if r = 0 + + s (output) DOUBLE PRECISION + Sine of the angle of rotation: + + s = b/r if r != 0 + s = 0 if r = 0 + + +NOTE + The value of z, returned in b by DROTG, gives a compact representation + of the rotation matrix, which can be used later to reconstruct c and s + as in the following example: + + IF (B .EQ. 1. ) THEN + C = 0. + S = 1. + ELSEIF( ABS( B) .LT. 1) THEN + C = SQRT( 1. - B * B) + S = B + ELSE + C = 1. / B + S = SQRT( 1 - C * C) + ENDIF + +@ + Double precision. Computes plane rotation. Arguments are: \begin{itemize} @@ -1142,23 +1649,108 @@ Returns multiple values where: (setf db z) (return (values da db c s)))) -;(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::drotg fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((double-float) (double-float) (double-float) -; (double-float)) -; :return-values '(fortran-to-lisp::da fortran-to-lisp::db -; fortran-to-lisp::c fortran-to-lisp::s) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{drot BLAS} %\pagehead{drot}{drot} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f drot.output +)spool drot.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +drot examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DROT - BLAS level one, plane rotation subroutines + +SYNOPSIS + SUBROUTINE DROT ( n, x, incx, y, incy, c, s ) + + INTEGER n, incx, incy + + DOUBLE PRECISION x, y, c, s + + +DESCRIPTION + DROT applies a plane rotation matrix to a real sequence of ordered + pairs: + + (x , y ), for all i = 1, 2, ..., n. + i i + +ARGUMENTS + n INTEGER. (input) + Number of ordered pairs (planar points in DROT) to be rotated. + If n <= 0, this routine returns without computation. + + x DOUBLE PRECISION, (input and output) + Array of dimension (n-1) * |incx| + 1. On input, array x con- + tains the x-coordinate of each planar point to be rotated. On + output, array x contains the x-coordinate of each rotated pla- + nar point. + + incx INTEGER. (input) + Increment between elements of x. If incx = 0, the results will + be unpredictable. + + y DOUBLE PRECISION, (input and output) + array of dimension (n-1) * |incy| + 1. + On input, array y contains the y-coordinate of each planar + point to be rotated. On output, array y contains the y-coordi- + nate of each rotated planar point. + + incy INTEGER. (input) + Increment between elements of y. If incy = 0, the results will + be unpredictable. + + c DOUBLE PRECISION, Cosine of the angle of rotation. + (input) + + s DOUBLE PRECISION, Sine of the angle of rotation. (input) + +NOTES + This routine applies the following plane rotation to each pair + of elements (x , y): + i i + _ _ _ _ _ _ + | x(i) | <-- | c s | . | x(i) | + | y(i) | |-s c | | y(i) | + - - - - - - + + for i = 1,...,n + 2 2 + If coefficients c and s satisfy c + s = 1.0, the rotation matrix + is orthogonal, and the transformation is called a Givens plane + rotation. If c = 1 and s = 0, DROT returns without modifying any + input parameters. + + To calculate the Givens coefficients c and s from a two-element + vector to determine the angle of rotation, use SROTG(3S). + + When working backward (incx < 0 or incy < 0), each routine starts + at the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + y(1-incy * (n-1)), y(1-incy * (n-2)), ..., y(1) + +@ + <>= (defun drot (n dx incx dy incy c s) (declare (type (double-float) s c) @@ -1210,24 +1802,77 @@ Returns multiple values where: end_label (return (values 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::drot fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (double-float) -; (double-float)) -; :return-values '(nil nil nil nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dscal BLAS} %\pagehead{dscal}{dscal} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dscal.output +)spool dscal.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dscal examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DSCAL - BLAS level one, scales a double precision vector + +SYNOPSIS + SUBROUTINE DSCAL ( n, alpha, x, incx ) + + INTEGER n, incx + + DOUBLE PRECISION alpha, x + + +DESCRIPTION + DSCAL scales a double precision vector with a double precision scalar. + DSCAL scales the vector x of length n and increment incx by the con- + stant a. + + This routine performs the following vector operation: + + x <-- alpha x + + where alpha is a double precisoin scalar, and x is a double precision + vector. + +ARGUMENTS + n INTEGER. (input) + Number of elements in the vector. + If n <= 0, this routine returns without computation. + + alpha DOUBLE PRECISION scalar alpha. (input) + + x DOUBLE PRECISION, (input and output) + Array of dimension (n-1) * |incx| + 1. Vector to be scaled. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + +NOTES + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + +@ + <>= (defun dscal (n da dx incx) (declare (type (array double-float (*)) dx) @@ -1301,22 +1946,84 @@ Returns multiple values where: end_label (return (values 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::dscal fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (double-float) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dswap BLAS} %\pagehead{dswap}{dswap} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dswap.output +)spool dswap.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dswap examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DSWAP - BLAS level one, Swaps two double precision vectors + +SYNOPSIS + SUBROUTINE DSWAP ( n, x, incx, y, incy ) + + INTEGER n, incx, incy + + DOUBLE PRECISION x, y + + +DESCRIPTION + DSWAP swaps two double precision vectors, it interchanges n values of + vector x and vector y. incx and incy specify the increment between two + consecutive elements of respectively vector x and y. + + + This routine performs the following vector operation: + + x <-> y + + where x and y are double precision vectors. + +ARGUMENTS + n INTEGER. (input) + Number of vector elements to be swapped. + If n <= 0, this routine returns without computation. + + x DOUBLE PRECISION, (input and output) + Array of dimension (n-1) * |incx| + 1. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + + y DOUBLE PRECISION, (input and output) + array of dimension (n-1) * |incy| + 1. Vector to be swapped. + + incy INTEGER. (input) + Increment between elements of y. If incy = 0, the results will + be unpredictable. + +NOTES + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + y(1-incy * (n-1)), y(1-incy * (n-2)), ..., y(1) + +@ + <>= (defun dswap (n dx incx dy incy) (declare (type (array double-float (*)) dy dx) @@ -1410,23 +2117,77 @@ Returns multiple values where: end_label (return (values 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::dswap fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dzasum BLAS} %\pagehead{dzasum}{dzasum} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dzasum.output +)spool dzasum.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dzasum examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DZASUM - BLAS level one, sums the absolute values of the real and imag- + inary parts of the elements of a double complex vector + +SYNOPSIS + DOUBLE PRECISION FUNCTION DZASUM ( n, x, incx ) + + INTEGER n, incx + + DOUBLE COMPLEX x + + +DESCRIPTION + This routine performs the following vector operation: + + n + DZASUM <-- Sum abs( real(x(i)) ) + abs( aimag(x(i)) ) + i=1 + +ARGUMENTS + n INTEGER. (input) + Number of vector elements to be summed. + + x DOUBLE COMPLEX. (input) + Array of dimension (n-1) * abs(incx) + 1. + Vector that contains elements to be summed. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + +RETURN VALUES + DZASUM DOUBLE PRECISION. (output) + Sum of the absolute values of the real and imaginary parts of + the elements of the vector x. + If n <= 0, DZASUM is set to 0. + +NOTES + When working backward (incx < 0), each routine starts at the end of the + vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + +@ + Computes (complex double-float) $asum \leftarrow ||re(x)||_1 + ||im(x)||_1$ Arguments are: @@ -1479,24 +2240,77 @@ Return values are: end_label (return (values dzasum 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::dzasum -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil) -; :calls '(fortran-to-lisp::dcabs1)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dznrm2 BLAS} %\pagehead{dznrm2}{dznrm2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dznrm2.output +)spool dznrm2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dznrm2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DZNRM2 - BLAS level one, computes the Euclidean norm of a vector + +SYNOPSIS + DOUBLE PRECISION FUNCTION DZNRM2 ( n, x, incx ) + + INTEGER n, incx + + DOUBLE COMPLEX x + + +DESCRIPTION + DZNRM2 computes the Euclidean (L2) norm of a double precision complex + vector: + + DZNRM2 <-- ||x|| + 2 + + where x is a double precision complex vector. + + +ARGUMENTS + n INTEGER (input) + Number of elements in the operand vector. + + x DOUBLE COMPLEX (input) + Array of dimension (n-1) * |incx| + 1. + Array x contains the operand vector. + + incx INTEGER (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + +RETURN VALUES + DZNRM2 DOUBLE PRECISION Result (Euclidean norm). (output) + If n <= 0, DZNRM2 is set to 0d0. + +NOTES + When working backward (incx < 0), DZNRM2 starts at the end of the vec- + tor and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -1556,24 +2370,85 @@ Return values are: end_label (return (values dznrm2 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::dznrm2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{icamax BLAS} %\pagehead{icamax}{icamax} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f icamax.output +)spool icamax.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +icamax examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ICAMAX - BLAS level one, maximum index function + +SYNOPSIS + INTEGER FUNCTION ICAMAX ( n, x, incx ) + + INTEGER n, incx + + COMPLEX x + + +DESCRIPTION + ICAMAX searches a complex vector for the first occurrence of the maxi- + mum absolute value. + + ICAMAX determines the first index i such that + + |Real(x )|+ |Imag(x ) | = MAX(|Real(x )| + | Imag(x )|): j = 1, ..., n + i i j j + where x is an element of a complex vector. + j + +ARGUMENTS + n INTEGER. (input) + Number of elements to process in the vector to be searched. If + n <= 0, these routines return 0. + + x COMPLEX. (input) + Array of dimension (n-1) * |incx| + 1. + Array x contains the vector to be searched. + + incx INTEGER. (input) + Increment between elements of x. + +RETURN VALUES + ICAMAX INTEGER. (output) + Return the first index of the maximum absolute value of vector + x. The vector x has length n and increment incx. + +NOTES + When working backward (incx < 0), each routine starts at the end of the + vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + The largest absolute value is: + + ABS (x(1+(index-1) * incx)) when incx > 0 + + ABS (x(1+(n-index) * |incx|)) when incx < 0 + +@ + <>= (defun icamax (n cx incx) (declare (type (array (complex single-float) (*)) cx) @@ -1627,24 +2502,79 @@ Return values are: end_label (return (values icamax 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::icamax -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; (array (complex single-float) (*)) -; fixnum) -; :return-values '(nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{idamax BLAS} %\pagehead{idamax}{idamax} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f idamax.output +)spool idamax.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +idamax examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + IDAMAX - BLAS level one, maximum index function + +SYNOPSIS + INTEGER FUNCTION IDAMAX ( n, x, incx ) + + INTEGER n, incx + + DOUBLE PRECISION x + + +DESCRIPTION + IDAMAX searches a double precision vector for the first occurrence of + the the maximum absolute value. The vector x has length n and increment + incx. + +ARGUMENTS + n INTEGER. (input) + Number of elements to process in the vector to be searched. If + n <= 0, these routines return 0. + + x DOUBLE PRECISION. (input) + Array of dimension (n-1) * |incx| + 1. + Array x contains the vector to be searched. + + incx INTEGER. (input) + Increment between elements of x. + +RETURN VALUES + IDAMAX INTEGER. (output) + Return the first index of the maximum absolute value of vector + x. The vector x has length n and increment incx. + +NOTES + When working backward (incx < 0), each routine starts at the end of the + vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + The largest absolute value is: + + ABS (x(1+(index-1) * incx)) when incx > 0 + + ABS (x(1+(n-index) * |incx|)) when incx < 0 + +@ + <>= (defun idamax (n dx incx) (declare (type (array double-float (*)) dx) @@ -1707,23 +2637,84 @@ Return values are: end_label (return (values idamax 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::idamax -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{isamax BLAS} %\pagehead{isamax}{isamax} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f isamax.output +)spool isamax.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +isamax examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ISAMAX - BLAS level one, maximum index function + +SYNOPSIS + INTEGER FUNCTION ISAMAX ( n, x, incx ) + + INTEGER n, incx + + REAL x + + +DESCRIPTION + ISAMAX searches a real vector for the first occurrence of the the maxi- + mum absolute value. The vector x has length n and increment incx. + + ISAMAX returns the first index i such that + |x | = MAX |x | : j = 1, ..., n + i j + where x is an element of a real vector. + j + +ARGUMENTS + n INTEGER. (input) + Number of elements to process in the vector to be searched. If + n <= 0, these routines return 0. + + x REAL. (input) + Array of dimension (n-1) * |incx| + 1. + Array x contains the vector to be searched. + + incx INTEGER. (input) + Increment between elements of x. + +RETURN VALUES + ISAMAX INTEGER. (output) + Return the first index of the maximum absolute value of vector + x. The vector x has length n and increment incx. + +NOTES + When working backward (incx < 0), each routine starts at the end of the + vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + The largest absolute value is: + + ABS (x(1+(index-1) * incx)) when incx > 0 + + ABS (x(1+(n-index) * |incx|)) when incx < 0 + +@ + <>= (defun isamax (n sx incx) (declare (type (array single-float (*)) sx) @@ -1765,23 +2756,85 @@ Return values are: end_label (return (values isamax 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::isamax -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array single-float (*)) -; fixnum) -; :return-values '(nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{izamax BLAS} %\pagehead{izamax}{izamax} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f izamax.output +)spool izamax.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +izamax examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + IZAMAX - BLAS level one, maximum index function + +SYNOPSIS + INTEGER FUNCTION IZAMAX ( n, x, incx ) + + INTEGER n, incx + + DOUBLE COMPLEX x + + +DESCRIPTION + IZAMAX searches a double complex vector for the first occurrence of the + maximum absolute value. + + IZAMAX determines the first index i such that + + |Real(x )|+ |Imag(x ) | = MAX(|Real(x )| + | Imag(x )|): j = 1, ..., n + i i j j + where x is an element of a double complex vector. + j + +ARGUMENTS + n INTEGER. (input) + Number of elements to process in the vector to be searched. If + n <= 0, these routines return 0. + + x DOUBLE COMPLEX. (input) + Array of dimension (n-1) * |incx| + 1. + Array x contains the vector to be searched. + + incx INTEGER. (input) + Increment between elements of x. + +RETURN VALUES + IZAMAX INTEGER. (output) + Return the first index of the maximum absolute value of vector + x. The vector x has length n and increment incx. + +NOTES + When working backward (incx < 0), each routine starts at the end of the + vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + The largest absolute value is: + + ABS (x(1+(index-1) * incx)) when incx > 0 + + ABS (x(1+(n-index) * |incx|)) when incx < 0 + +@ + <>= (defun izamax (n zx incx) (declare (type (array (complex double-float) (*)) zx) @@ -1827,24 +2880,99 @@ Return values are: end_label (return (values izamax 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::izamax -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil) -; :calls '(fortran-to-lisp::dcabs1)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zaxpy BLAS} %\pagehead{zaxpy}{zaxpy} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zaxpy.output +)spool zaxpy.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zaxpy examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ZAXPY - BLAS level one axpy subroutine + +SYNOPSIS + SUBROUTINE ZAXPY ( n, alpha, x, incx, y, incy ) + + INTEGER n, incx, incy + + DOUBLE COMPLEX alpha, x, y + + +DESCRIPTION + ZAXPY adds a scalar multiple of a double complex vector to another dou- + ble complex vector. + + ZAXPY computes a constant alpha times a vector x plus a vector y. The + result overwrites the initial values of vector y. + + This routine performs the following vector operation: + + y <-- alpha*x + y + + incx and incy specify the increment between two consecutive + elements of respectively vector x and y. + +ARGUMENTS + n INTEGER. (input) + Number of elements in the vectors. If n <= 0, these routines + return without any computation. + + alpha DOUBLE COMPLEX. (input) + If alpha = 0 this routine returns without any computation. + + x DOUBLE COMPLEX. (input) + Array of dimension (n-1) * |incx| + 1. Contains the vector to + be scaled before summation. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + + y DOUBLE COMPLEX. (input and output) + array of dimension (n-1) * |incy| + 1. + Before calling the routine, y contains the vector to be summed. + After the routine ends, y contains the result of the summation. + + incy INTEGER. (input) + Increment between elements of y. + If incy = 0, the results will be unpredictable. + +NOTES + This routine is Level 1 Basic Linear Algebra Subprograms (Level 1 + BLAS). + + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + y(1-incy * (n-1)), y(1-incy * (n-2)), ..., y(1) + +RETURN VALUES + When n <= 0, double complex alpha = 0 = 0.+0.i, this routine returns + immediately with no change in its arguments. + +@ + Computes (complex double-float) $y \leftarrow \alpha{}x + y$ Arguments are: @@ -1912,26 +3040,85 @@ Return values are: end_label (return (values 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::zaxpy fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::dcabs1)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zcopy BLAS} %\pagehead{zcopy}{zcopy} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zcopy.output +)spool zcopy.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zcopy examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ZCOPY - BLAS level one, copies a double complex vector into another + double complex vector + +SYNOPSIS + SUBROUTINE ZCOPY ( n, x, incx, y, incy ) + + INTEGER n, incx, incy + + DOUBLE COMPLEX x, y + + +DESCRIPTION + ZCOPY copies a double complex vector into another double complex vec- + tor. ZCOPY copies a vector x, whose length is n to a vector y. incx + and incy specify the increment between two consecutive elements of + respectively vector x and y. + + This routine performs the following vector operation: + + y <-- x + + where x and y are double complex vectors. + +ARGUMENTS + n INTEGER. (input) + Number of vector elements to be copied. + If n <= 0, this routine returns without computation. + + x DOUBLE COMPLEX, (input) + Vector from which to copy. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + + y DOUBLE COMPLEX, (output) + array of dimension (n-1) * |incy| + 1, result vector. + + incy INTEGER. (input) + Increment between elements of y. If incy = 0, the results will + be unpredictable. + +NOTES + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + y(1-incy * (n-1)), y(1-incy * (n-2)), ..., y(1) + +@ + <>= (defun zcopy (n zx incx zy incy) (declare (type (array (complex double-float) (*)) zy zx) @@ -1972,25 +3159,98 @@ Return values are: end_label (return (values 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::zcopy fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zdotc BLAS} %\pagehead{zdotc}{zdotc} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zdotc.output +)spool zdotc.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zdotc examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ZDOTC - BLAS level one, computes the hermitian dot product of vector x + and vector y. + +SYNOPSIS + DOUBLE COMPLEX FUNCTION ZDOTC ( n, x, incx, y, incy ) + + INTEGER n, incx, incy + + COMPLEX*16 x, y + + +DESCRIPTION + ZDOTC computes a dot product of the conjugate of a complex vector and + another complex vector (l complex inner product). + 2 + + ZDOTC computes a dot product of the conjugate of a complex vector and + another complex vector (l complex inner product). + 2 + + This routine performs the following vector operation: + + ZDOTC <-- (conjugate transpose of x) * y + n + = Sum (complex conjugate of x(i))*y(i) + i=1 + H + where x and y are complex vectors, and x is the conjugate + transpose of x. + + If n <= 0, ZDOTC is set to 0. + +ARGUMENTS + n INTEGER. (input) + Number of elements in each vector. + + x COMPLEX*16. (input) + Array of dimension (n-1) * |incx| + 1. + Array x contains the first vector operand. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + + y COMPLEX*16. (input) + Array of dimension (n-1) * |incy| + 1. + Array y contains the second vector operand. + + incy INTEGER. (input) + Increment between elements of y. + If incy = 0, the results will be unpredictable. + +RETURN VALUES + ZDOTC DOUBLE COMPLEX. Result (dot product). (output) + +NOTES + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + y(1-incy * (n-1)), y(1-incy * (n-2)), ..., y(1) + +@ + <>= (defun zdotc (n zx incx zy incy) (declare (type (array (complex double-float) (*)) zy zx) @@ -2044,25 +3304,91 @@ Return values are: end_label (return (values zdotc 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::zdotc fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zdotu BLAS} %\pagehead{zdotu}{zdotu} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zdotu.output +)spool zdotu.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zdotu examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ZDOTU - BLAS level one, computes computes a dot product (inner product) + of two complex vectors + +SYNOPSIS + DOUBLE COMPLEX FUNCTION ZDOTU ( n, x, incx, y, incy ) + + INTEGER n, incx, incy + + COMPLEX*16 x, y + + +DESCRIPTION + ZDOTU computes a dot product of two complex vectors. + + This routine performs the following vector operation: + + n + ZDOTU <-- (transpose of x) * y = Sum x(i)*y(i) + i=1 + T + where x and y are real vectors, and x is the transpose of + x. + + If n <= 0, ZDOTU is set to 0. + +ARGUMENTS + n INTEGER. (input) + Number of elements in each vector. + + x COMPLEX*16. (input) + Array of dimension (n-1) * |incx| + 1. + Array x contains the first vector operand. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + + y COMPLEX*16. (input) + Array of dimension (n-1) * |incy| + 1. + Array y contains the second vector operand. + + incy INTEGER. (input) + Increment between elements of y. + If incy = 0, the results will be unpredictable. + +RETURN VALUES + ZDOTU DOUBLE COMPLEX. Result (dot product). (output) + +NOTES + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + y(1-incy * (n-1)), y(1-incy * (n-2)), ..., y(1) + +@ + <>= (defun zdotu (n zx incx zy incy) (declare (type (array (complex double-float) (*)) zy zx) @@ -2112,25 +3438,80 @@ Return values are: end_label (return (values zdotu 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::zdotu fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zdscal BLAS} %\pagehead{zdscal}{zdscal} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zdscal.output +)spool zdscal.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zdscal examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ZDSCAL - BLAS level one, Scales a double complex vector + +SYNOPSIS + SUBROUTINE ZDSCAL ( n, alpha, x, incx ) + + INTEGER n, incx + + DOUBLE COMPLEX x + + DOUBLE PRECISION alpha + + +DESCRIPTION + ZDSCAL scales a double complex vector with a double precision scalar. + ZDSCAL scales the vector x of length n and increment incx by the con- + stant alpha. + + This routine performs the following vector operation: + + x <-- alpha x + + where alpha is a double precision scalar, and x is a double complex + vector. + +ARGUMENTS + n INTEGER. (input) + Number of elements in the vector. + If n <= 0, this routine returns without computation. + + alpha DOUBLE PRECISION. (input) + Value used to scale vector + + x DOUBLE COMPLEX. (input and output) + Array of dimension (n-1) * abs(incx) + 1. Vector to be scaled. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + +NOTES + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + +@ + <>= (defun zdscal (n da zx incx) (declare (type (array (complex double-float) (*)) zx) @@ -2161,24 +3542,107 @@ Return values are: end_label (return (values 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::zdscal -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (double-float) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zrotg BLAS} %\pagehead{zrotg}{zrotg} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zrotg.output +)spool zrotg.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zrotg examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ZROTG - Extensions to BLAS level one rotation subroutines + + +SYNOPSIS + SUBROUTINE ZROTG ( a, b, c, s ) + + DOUBLE COMPLEX + a, b, s + + DOUBLE PRECISION + c + +DESCRIPTION + ZROTG computes the elements of a Givens plane rotation matrix such + that: + + _ _ _ _ _ _ + | c s | | a | | r | + |-congj(s) c | * | b | = | 0 | + - - - - - - + + where r = (a / sqrt(conjg(a)*a)) * sqrt ( conjg(a)*a + conjg(b)*b ) , + and the notation conjg(z) represents the complex conjugate of z. + + The Givens plane rotation can be used to introduce zero elements into + a matrix selectively. + + + +ARGUMENTS + a (input and output) DOUBLE COMPLEX + + First vector component. + + On input, the first component of the vector to be rotated. On + output, a is overwritten by the unique complex number r, whose + size in the complex plane is the Euclidean norm of the complex + vector (a,b), and whose direction in the complex plane is the + same as that of the original complex element a. + + if |a| != 0 + r = a / |a| * sqrt( conjg(a)*a + conjg(b)*b ) + + if |a| = 0 + r = b + + b (input) DOUBLE COMPLEX + + Second vector component. + + The second component of the vector to be rotated. + + + + c (output) DOUBLE PRECISION + + Cosine of the angle of rotation. + + if |a| != 0 + c = |a| / sqrt( conjg(a)*a + conjg(b)*b ) + + if |a| = 0 + c = 0 + + s (output) DOUBLE COMPLEX + Sine of the angle of rotation. + + if |a| != 0 + c=a/|a|*conjg(b)/sqrt(conjg(a)*a+conjg(b)*b) + + if |a| = 0 + s = ( 1.0 , 0.0 ) + +@ (Complex Double-Float). Computes plane rotation. Arguments are: @@ -2225,24 +3689,78 @@ Returns multiple values where: label20 (return (values ca nil c s)))) -;(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::zrotg fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(((complex double-float)) -; ((complex double-float)) (double-float) -; ((complex double-float))) -; :return-values '(fortran-to-lisp::ca nil fortran-to-lisp::c -; fortran-to-lisp::s) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zscal BLAS} %\pagehead{zscal}{zscal} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zscal.output +)spool zscal.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zscal examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ZSCAL - BLAS level one, Scales a double complex vector + +SYNOPSIS + SUBROUTINE ZSCAL ( n, alpha, x, incx ) + + INTEGER n, incx + + DOUBLE COMPLEX x, alpha + + +DESCRIPTION + ZSCAL scales a double complex vector with a double complex scalar. + ZSCAL scales the vector x of length n and increment incx by the con- + stant alpha. + + This routine performs the following vector operation: + + x <-- alpha x + + where alpha is a double complex scalar, and x is a double complex + vector. + +ARGUMENTS + n INTEGER. (input) + Number of elements in the vector. + If n <= 0, this routine returns without computation. + + alpha DOUBLE COMPLEX. (input) + Value used to scale vector + + x DOUBLE COMPLEX. (input and output) + Array of dimension (n-1) * abs(incx) + 1. Vector to be scaled. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + +NOTES + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + +@ + <>= (defun zscal (n za zx incx) (declare (type (array (complex double-float) (*)) zx) @@ -2271,24 +3789,84 @@ Returns multiple values where: end_label (return (values 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::zscal fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zswap BLAS} %\pagehead{zswap}{zswap} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zswap.output +)spool zswap.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zswap examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ZSWAP - BLAS level one, Swaps two double complex vectors + +SYNOPSIS + SUBROUTINE ZSWAP ( n, x, incx, y, incy ) + + INTEGER n, incx, incy + + DOUBLE COMPLEX x, y + + +DESCRIPTION + ZSWAP swaps two double complex vectors, it interchanges n values of + vector x and vector y. incx and incy specify the increment between two + consecutive elements of respectively vector x and y. + + + This routine performs the following vector operation: + + x <-> y + + where x and y are double complex vectors. + +ARGUMENTS + n INTEGER. (input) + Number of vector elements to be swapped. + If n <= 0, this routine returns without computation. + + x DOUBLE COMPLEX, (input and output) + Array of dimension (n-1) * |incx| + 1. + + incx INTEGER. (input) + Increment between elements of x. + If incx = 0, the results will be unpredictable. + + y DOUBLE COMPLEX, (input and output) + array of dimension (n-1) * |incy| + 1. Vector to be swapped. + + incy INTEGER. (input) + Increment between elements of y. If incy = 0, the results will + be unpredictable. + +NOTES + When working backward (incx < 0 or incy < 0), each routine starts at + the end of the vector and moves backward, as follows: + + x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + + y(1-incy * (n-1)), y(1-incy * (n-2)), ..., y(1) + +@ + <>= (defun zswap (n zx incx zy incy) (declare (type (array (complex double-float) (*)) zy zx) @@ -2334,19 +3912,6 @@ Returns multiple values where: end_label (return (values 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::zswap fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{BLAS Level 2} @@ -2355,6 +3920,142 @@ Returns multiple values where: %\pagehead{dgbmv}{dgbmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgbmv.output +)spool dgbmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgbmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DGBMV - perform one of the matrix-vector operations y := + alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, + + SYNOPSIS + SUBROUTINE DGBMV ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, + INCX, BETA, Y, INCY ) + + DOUBLE PRECISION ALPHA, BETA + + INTEGER INCX, INCY, KL, KU, LDA, M, N + + CHARACTER*1 TRANS + + DOUBLE PRECISION A( LDA, * ), X( * ), Y( * ) + + PURPOSE + DGBMV performs one of the matrix-vector operations + + where alpha and beta are scalars, x and y are vectors and A + is an m by n band matrix, with kl sub-diagonals and ku + super-diagonals. + + PARAMETERS + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' y := alpha*A*x + beta*y. + + TRANS = 'T' or 't' y := alpha*A'*x + beta*y. + + TRANS = 'C' or 'c' y := alpha*A'*x + beta*y. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of the + matrix A. M must be at least zero. Unchanged on + exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix A. N must be at least zero. Unchanged on + exit. + + KL - INTEGER. + On entry, KL specifies the number of sub-diagonals of + the matrix A. KL must satisfy 0 .le. KL. Unchanged + on exit. + + KU - INTEGER. + On entry, KU specifies the number of super-diagonals + of the matrix A. KU must satisfy 0 .le. KU. + Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). + Before entry, the leading ( kl + ku + 1 ) by n part + of the array A must contain the matrix of coeffi- + cients, supplied column by column, with the leading + diagonal of the matrix in row ( ku + 1 ) of the + array, the first super-diagonal starting at position + 2 in row ku, the first sub-diagonal starting at posi- + tion 1 in row ( ku + 2 ), and so on. Elements in the + array A that do not correspond to elements in the + band matrix (such as the top left ku by ku triangle) + are not referenced. The following program segment + will transfer a band matrix from conventional full + matrix storage to band storage: + + DO 20, J = 1, N K = KU + 1 - J DO 10, I = MAX( 1, J - + KU ), MIN( M, J + KL ) A( K + I, J ) = matrix( I, J ) + 10 CONTINUE 20 CONTINUE + + Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least ( kl + ku + 1 ). Unchanged on exit. + + X - DOUBLE PRECISION array of DIMENSION at least + ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' + and at least ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. + Before entry, the incremented array X must contain + the vector x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + BETA - DOUBLE PRECISION. + On entry, BETA specifies the scalar beta. When BETA + is supplied as zero then Y need not be set on input. + Unchanged on exit. + + Y - DOUBLE PRECISION array of DIMENSION at least + ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' + + and at least ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. + Before entry, the incremented array Y must contain + the vector y. On exit, Y is overwritten by the + updated vector y. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -2363,7 +4064,7 @@ Returns multiple values where: (declare (type (array double-float (*)) y x a) (type (double-float) beta alpha) (type fixnum incy incx lda ku kl n m) - (type (simple-array character (*)) trans)) + (type character trans)) (f2cl-lib:with-multi-array-data ((trans character trans-%data% trans-%offset%) (a double-float a-%data% a-%offset%) @@ -2376,9 +4077,9 @@ Returns multiple values where: (type (double-float) temp)) (setf info 0) (cond - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 1)) ((< m 0) (setf info 2)) @@ -2396,12 +4097,14 @@ Returns multiple values where: (setf info 13))) (cond ((/= info 0) - (xerbla "DGBMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGBMV" info) (go end_label))) (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf lenx n) (setf leny m)) (t @@ -2470,7 +4173,7 @@ Returns multiple values where: (if (= alpha zero) (go end_label)) (setf kup1 (f2cl-lib:int-add ku 1)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf jx kx) (cond ((= incy 1) @@ -2630,28 +4333,122 @@ Returns multiple values where: (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::dgbmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; fixnum fixnum -; (double-float) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (double-float) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil -; nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgemv BLAS} %\pagehead{dgemv}{dgemv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgemv.output +)spool dgemv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgemv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DGEMV - perform one of the matrix-vector operations y := + alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, + + SYNOPSIS + SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, + BETA, Y, INCY ) + + DOUBLE PRECISION ALPHA, BETA + + INTEGER INCX, INCY, LDA, M, N + + CHARACTER*1 TRANS + + DOUBLE PRECISION A( LDA, * ), X( * ), Y( * ) + + PURPOSE + DGEMV performs one of the matrix-vector operations + + where alpha and beta are scalars, x and y are vectors and A + is an m by n matrix. + + PARAMETERS + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' y := alpha*A*x + beta*y. + + TRANS = 'T' or 't' y := alpha*A'*x + beta*y. + + TRANS = 'C' or 'c' y := alpha*A'*x + beta*y. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of the + matrix A. M must be at least zero. Unchanged on + exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix A. N must be at least zero. Unchanged on + exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). + Before entry, the leading m by n part of the array A + + must contain the matrix of coefficients. Unchanged + on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, m ). Unchanged on exit. + + X - DOUBLE PRECISION array of DIMENSION at least + ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' + and at least ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. + Before entry, the incremented array X must contain + the vector x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + BETA - DOUBLE PRECISION. + On entry, BETA specifies the scalar beta. When BETA + is supplied as zero then Y need not be set on input. + Unchanged on exit. + + Y - DOUBLE PRECISION array of DIMENSION at least + ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' + and at least ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. + Before entry with BETA non-zero, the incremented + array Y must contain the vector y. On exit, Y is + overwritten by the updated vector y. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -2660,7 +4457,7 @@ Returns multiple values where: (declare (type (array double-float (*)) y x a) (type (double-float) beta alpha) (type fixnum incy incx lda n m) - (type (simple-array character (*)) trans)) + (type character trans)) (f2cl-lib:with-multi-array-data ((trans character trans-%data% trans-%offset%) (a double-float a-%data% a-%offset%) @@ -2673,9 +4470,9 @@ Returns multiple values where: (type (double-float) temp)) (setf info 0) (cond - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 1)) ((< m 0) (setf info 2)) @@ -2689,12 +4486,14 @@ Returns multiple values where: (setf info 11))) (cond ((/= info 0) - (xerbla "DGEMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEMV" info) (go end_label))) (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf lenx n) (setf leny m)) (t @@ -2762,7 +4561,7 @@ Returns multiple values where: (setf iy (f2cl-lib:int-add iy incy)))))))))) (if (= alpha zero) (go end_label)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf jx kx) (cond ((= incy 1) @@ -2875,26 +4674,98 @@ Returns multiple values where: end_label (return (values 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::dgemv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (double-float) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (double-float) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dger BLAS} %\pagehead{dger}{dger} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dger.output +)spool dger.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dger examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DGER - perform the rank 1 operation A := alpha*x*y' + A, + + SYNOPSIS + SUBROUTINE DGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA ) + + DOUBLE PRECISION ALPHA + + INTEGER INCX, INCY, LDA, M, N + + DOUBLE PRECISION A( LDA, * ), X( * ), Y( * ) + + PURPOSE + DGER performs the rank 1 operation + + where alpha is a scalar, x is an m element vector, y is an n + element vector and A is an m by n matrix. + + PARAMETERS + M - INTEGER. + On entry, M specifies the number of rows of the + matrix A. M must be at least zero. Unchanged on + exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix A. N must be at least zero. Unchanged on + exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( m - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the m element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + Y - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the n element vector + y. Unchanged on exit. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + + exit. + + A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). + Before entry, the leading m by n part of the array A + must contain the matrix of coefficients. On exit, A + is overwritten by the updated matrix. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, m ). Unchanged on exit. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -2923,7 +4794,9 @@ Returns multiple values where: (setf info 9))) (cond ((/= info 0) - (xerbla "DGER " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DYER" info) (go end_label))) (if (or (= m 0) (= n 0) (= alpha zero)) (go end_label)) (cond @@ -3002,25 +4875,149 @@ Returns multiple values where: end_label (return (values 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::dger fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (double-float) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dsbmv BLAS} %\pagehead{dsbmv}{dsbmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dsbmv.output +)spool dsbmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dsbmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DSBMV - perform the matrix-vector operation y := alpha*A*x + + beta*y, + + SYNOPSIS + SUBROUTINE DSBMV ( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, + Y, INCY ) + + DOUBLE PRECISION ALPHA, BETA + + INTEGER INCX, INCY, K, LDA, N + + CHARACTER*1 UPLO + + DOUBLE PRECISION A( LDA, * ), X( * ), Y( * ) + + PURPOSE + DSBMV performs the matrix-vector operation + + where alpha and beta are scalars, x and y are n element vec- + tors and A is an n by n symmetric band matrix, with k + super-diagonals. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the band matrix A is being sup- + plied as follows: + + UPLO = 'U' or 'u' The upper triangular part of A is + being supplied. + + UPLO = 'L' or 'l' The lower triangular part of A is + being supplied. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry, K specifies the number of super-diagonals + of the matrix A. K must satisfy 0 .le. K. Unchanged + on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). + + Before entry with UPLO = 'U' or 'u', the leading ( k + + 1 ) by n part of the array A must contain the upper + triangular band part of the symmetric matrix, sup- + plied column by column, with the leading diagonal of + the matrix in row ( k + 1 ) of the array, the first + super-diagonal starting at position 2 in row k, and + so on. The top left k by k triangle of the array A is + not referenced. The following program segment will + transfer the upper triangular part of a symmetric + band matrix from conventional full matrix storage to + band storage: + + DO 20, J = 1, N M = K + 1 - J DO 10, I = MAX( 1, J - + K ), J A( M + I, J ) = matrix( I, J ) 10 CONTINUE + 20 CONTINUE + + Before entry with UPLO = 'L' or 'l', the leading ( k + + 1 ) by n part of the array A must contain the lower + triangular band part of the symmetric matrix, sup- + plied column by column, with the leading diagonal of + the matrix in row 1 of the array, the first sub- + diagonal starting at position 1 in row 2, and so on. + The bottom right k by k triangle of the array A is + not referenced. The following program segment will + transfer the lower triangular part of a symmetric + band matrix from conventional full matrix storage to + band storage: + + DO 20, J = 1, N M = 1 - J DO 10, I = J, MIN( N, J + K + ) A( M + I, J ) = matrix( I, J ) 10 CONTINUE 20 + CONTINUE + + Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least ( k + 1 ). Unchanged on exit. + + X - DOUBLE PRECISION array of DIMENSION at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the vector x. + Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + BETA - DOUBLE PRECISION. + On entry, BETA specifies the scalar beta. Unchanged + on exit. + + Y - DOUBLE PRECISION array of DIMENSION at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the vector y. On + exit, Y is overwritten by the updated vector y. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -3029,7 +5026,7 @@ Returns multiple values where: (declare (type (array double-float (*)) y x a) (type (double-float) beta alpha) (type fixnum incy incx lda k n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (a double-float a-%data% a-%offset%) @@ -3041,7 +5038,7 @@ Returns multiple values where: (type (double-float) temp1 temp2)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -3055,7 +5052,9 @@ Returns multiple values where: (setf info 11))) (cond ((/= info 0) - (xerbla "DSBMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DSBMV" info) (go end_label))) (if (or (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) (cond @@ -3118,7 +5117,7 @@ Returns multiple values where: (setf iy (f2cl-lib:int-add iy incy)))))))))) (if (= alpha zero) (go end_label)) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kplus1 (f2cl-lib:int-add k 1)) (cond ((and (= incx 1) (= incy 1)) @@ -3332,26 +5331,118 @@ Returns multiple values where: end_label (return (values 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::dsbmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (double-float) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (double-float) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dspmv BLAS} %\pagehead{dspmv}{dspmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dspmv.output +)spool dspmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dspmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DSPMV - perform the matrix-vector operation y := alpha*A*x + + beta*y, + + SYNOPSIS + SUBROUTINE DSPMV ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, + INCY ) + + DOUBLE PRECISION ALPHA, BETA + + INTEGER INCX, INCY, N + + CHARACTER*1 UPLO + + DOUBLE PRECISION AP( * ), X( * ), Y( * ) + + PURPOSE + DSPMV performs the matrix-vector operation + + where alpha and beta are scalars, x and y are n element vec- + tors and A is an n by n symmetric matrix, supplied in packed + form. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the matrix A is supplied in the + packed array AP as follows: + + UPLO = 'U' or 'u' The upper triangular part of A is + supplied in AP. + + UPLO = 'L' or 'l' The lower triangular part of A is + supplied in AP. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + AP - DOUBLE PRECISION array of DIMENSION at least + ( ( n*( n + 1 ) )/2 ). Before entry with UPLO = 'U' + or 'u', the array AP must contain the upper triangu- + lar part of the symmetric matrix packed sequentially, + column by column, so that AP( 1 ) contains a( 1, 1 ), + AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 ) + + respectively, and so on. Before entry with UPLO = + 'L' or 'l', the array AP must contain the lower tri- + angular part of the symmetric matrix packed sequen- + tially, column by column, so that AP( 1 ) contains a( + 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( + 3, 1 ) respectively, and so on. Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + BETA - DOUBLE PRECISION. + On entry, BETA specifies the scalar beta. When BETA + is supplied as zero then Y need not be set on input. + Unchanged on exit. + + Y - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the n element vector + y. On exit, Y is overwritten by the updated vector y. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -3360,7 +5451,7 @@ Returns multiple values where: (declare (type (array double-float (*)) y x ap) (type (double-float) beta alpha) (type fixnum incy incx n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (ap double-float ap-%data% ap-%offset%) @@ -3372,7 +5463,7 @@ Returns multiple values where: (type (double-float) temp1 temp2)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -3382,7 +5473,9 @@ Returns multiple values where: (setf info 9))) (cond ((/= info 0) - (xerbla "DSPMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DSPMV" info) (go end_label))) (if (or (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) (cond @@ -3446,7 +5539,7 @@ Returns multiple values where: (if (= alpha zero) (go end_label)) (setf kk 1) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((and (= incx 1) (= incy 1)) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -3657,25 +5750,115 @@ Returns multiple values where: end_label (return (values 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::dspmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (double-float) -; (array double-float (*)) (array double-float (*)) -; fixnum (double-float) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dspr2 BLAS} %\pagehead{dspr2}{dspr2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dspr2.output +)spool dspr2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dspr2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DSPR2 - perform the symmetric rank 2 operation A := + alpha*x*y' + alpha*y*x' + A, + + SYNOPSIS + SUBROUTINE DSPR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, AP ) + + DOUBLE PRECISION ALPHA + + INTEGER INCX, INCY, N + + CHARACTER*1 UPLO + + DOUBLE PRECISION AP( * ), X( * ), Y( * ) + + PURPOSE + DSPR2 performs the symmetric rank 2 operation + + where alpha is a scalar, x and y are n element vectors and A + is an n by n symmetric matrix, supplied in packed form. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the matrix A is supplied in the + packed array AP as follows: + + UPLO = 'U' or 'u' The upper triangular part of A is + supplied in AP. + + UPLO = 'L' or 'l' The lower triangular part of A is + supplied in AP. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + + exit. + + Y - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the n element vector + y. Unchanged on exit. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + + AP - DOUBLE PRECISION array of DIMENSION at least + ( ( n*( n + 1 ) )/2 ). Before entry with UPLO = 'U' + or 'u', the array AP must contain the upper triangu- + lar part of the symmetric matrix packed sequentially, + column by column, so that AP( 1 ) contains a( 1, 1 ), + AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 ) + respectively, and so on. On exit, the array AP is + overwritten by the upper triangular part of the + updated matrix. Before entry with UPLO = 'L' or 'l', + the array AP must contain the lower triangular part + of the symmetric matrix packed sequentially, column + by column, so that AP( 1 ) contains a( 1, 1 ), AP( 2 + ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 ) respec- + tively, and so on. On exit, the array AP is overwrit- + ten by the lower triangular part of the updated + matrix. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -3683,7 +5866,7 @@ Returns multiple values where: (declare (type (array double-float (*)) ap y x) (type (double-float) alpha) (type fixnum incy incx n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (x double-float x-%data% x-%offset%) @@ -3695,7 +5878,7 @@ Returns multiple values where: (type (double-float) temp1 temp2)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -3705,7 +5888,9 @@ Returns multiple values where: (setf info 7))) (cond ((/= info 0) - (xerbla "DSPR2 " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DSPR2" info) (go end_label))) (if (or (= n 0) (= alpha zero)) (go end_label)) (cond @@ -3732,7 +5917,7 @@ Returns multiple values where: (setf jy ky))) (setf kk 1) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((and (= incx 1) (= incy 1)) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -3945,25 +6130,105 @@ Returns multiple values where: end_label (return (values 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::dspr2 fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (double-float) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; (array double-float (*))) -; :return-values '(nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dspr BLAS} %%\pagehead{dspr}{dspr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dspr.output +)spool dspr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dspr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DSPR - perform the symmetric rank 1 operation A := + alpha*x*x' + A, + + SYNOPSIS + SUBROUTINE DSPR ( UPLO, N, ALPHA, X, INCX, AP ) + + DOUBLE PRECISION ALPHA + + INTEGER INCX, N + + CHARACTER*1 UPLO + + DOUBLE PRECISION AP( * ), X( * ) + + PURPOSE + DSPR performs the symmetric rank 1 operation + + where alpha is a real scalar, x is an n element vector and A + is an n by n symmetric matrix, supplied in packed form. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the matrix A is supplied in the + packed array AP as follows: + + UPLO = 'U' or 'u' The upper triangular part of A is + supplied in AP. + + UPLO = 'L' or 'l' The lower triangular part of A is + supplied in AP. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + + exit. + + AP - DOUBLE PRECISION array of DIMENSION at least + ( ( n*( n + 1 ) )/2 ). Before entry with UPLO = 'U' + or 'u', the array AP must contain the upper triangu- + lar part of the symmetric matrix packed sequentially, + column by column, so that AP( 1 ) contains a( 1, 1 ), + AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 ) + respectively, and so on. On exit, the array AP is + overwritten by the upper triangular part of the + updated matrix. Before entry with UPLO = 'L' or 'l', + the array AP must contain the lower triangular part + of the symmetric matrix packed sequentially, column + by column, so that AP( 1 ) contains a( 1, 1 ), AP( 2 + ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 ) respec- + tively, and so on. On exit, the array AP is overwrit- + ten by the lower triangular part of the updated + matrix. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -3971,7 +6236,7 @@ Returns multiple values where: (declare (type (array double-float (*)) ap x) (type (double-float) alpha) (type fixnum incx n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (x double-float x-%data% x-%offset%) @@ -3981,7 +6246,7 @@ Returns multiple values where: (type (double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -3989,7 +6254,9 @@ Returns multiple values where: (setf info 5))) (cond ((/= info 0) - (xerbla "DSPR " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DSPR" info) (go end_label))) (if (or (= n 0) (= alpha zero)) (go end_label)) (cond @@ -4002,7 +6269,7 @@ Returns multiple values where: (setf kx 1))) (setf kk 1) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -4159,24 +6426,120 @@ Returns multiple values where: end_label (return (values 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::dspr fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (double-float) -; (array double-float (*)) fixnum -; (array double-float (*))) -; :return-values '(nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dsymv BLAS} %\pagehead{dsymv}{dsymv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dsymv.output +)spool dsymv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dsymv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DSYMV - perform the matrix-vector operation y := alpha*A*x + + beta*y, + + SYNOPSIS + SUBROUTINE DSYMV ( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, + INCY ) + + DOUBLE PRECISION ALPHA, BETA + + INTEGER INCX, INCY, LDA, N + + CHARACTER*1 UPLO + + DOUBLE PRECISION A( LDA, * ), X( * ), Y( * ) + + PURPOSE + DSYMV performs the matrix-vector operation + + where alpha and beta are scalars, x and y are n element vec- + tors and A is an n by n symmetric matrix. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the array A is to be referenced as + follows: + + UPLO = 'U' or 'u' Only the upper triangular part of + A is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part of + A is to be referenced. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading n + by n upper triangular part of the array A must con- + tain the upper triangular part of the symmetric + matrix and the strictly lower triangular part of A is + not referenced. Before entry with UPLO = 'L' or 'l', + the leading n by n lower triangular part of the array + + A must contain the lower triangular part of the sym- + metric matrix and the strictly upper triangular part + of A is not referenced. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, n ). Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + BETA - DOUBLE PRECISION. + On entry, BETA specifies the scalar beta. When BETA + is supplied as zero then Y need not be set on input. + Unchanged on exit. + + Y - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the n element vector + y. On exit, Y is overwritten by the updated vector y. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -4185,7 +6548,7 @@ Returns multiple values where: (declare (type (array double-float (*)) y x a) (type (double-float) beta alpha) (type fixnum incy incx lda n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (a double-float a-%data% a-%offset%) @@ -4197,7 +6560,7 @@ Returns multiple values where: (type (double-float) temp1 temp2)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -4209,7 +6572,9 @@ Returns multiple values where: (setf info 10))) (cond ((/= info 0) - (xerbla "DSYMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DSYMV" info) (go end_label))) (if (or (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) (cond @@ -4272,7 +6637,7 @@ Returns multiple values where: (setf iy (f2cl-lib:int-add iy incy)))))))))) (if (= alpha zero) (go end_label)) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((and (= incx 1) (= incy 1)) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -4457,26 +6822,119 @@ Returns multiple values where: end_label (return (values 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::dsymv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (double-float) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; (double-float) (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dsyr2 BLAS} %\pagehead{dsyr2}{dsyr2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dsyr2.output +)spool dsyr2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dsyr2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DSYR2 - perform the symmetric rank 2 operation A := + alpha*x*y' + alpha*y*x' + A, + + SYNOPSIS + SUBROUTINE DSYR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA + ) + + DOUBLE PRECISION ALPHA + + INTEGER INCX, INCY, LDA, N + + CHARACTER*1 UPLO + + DOUBLE PRECISION A( LDA, * ), X( * ), Y( * ) + + PURPOSE + DSYR2 performs the symmetric rank 2 operation + + where alpha is a scalar, x and y are n element vectors and A + is an n by n symmetric matrix. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the array A is to be referenced as + follows: + + UPLO = 'U' or 'u' Only the upper triangular part of + A is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part of + A is to be referenced. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the + + elements of X. INCX must not be zero. Unchanged on + exit. + + Y - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the n element vector + y. Unchanged on exit. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + + A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading n + by n upper triangular part of the array A must con- + tain the upper triangular part of the symmetric + matrix and the strictly lower triangular part of A is + not referenced. On exit, the upper triangular part of + the array A is overwritten by the upper triangular + part of the updated matrix. Before entry with UPLO = + 'L' or 'l', the leading n by n lower triangular part + of the array A must contain the lower triangular part + of the symmetric matrix and the strictly upper tri- + angular part of A is not referenced. On exit, the + lower triangular part of the array A is overwritten + by the lower triangular part of the updated matrix. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, n ). Unchanged on exit. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -4484,7 +6942,7 @@ Returns multiple values where: (declare (type (array double-float (*)) a y x) (type (double-float) alpha) (type fixnum lda incy incx n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (x double-float x-%data% x-%offset%) @@ -4496,7 +6954,7 @@ Returns multiple values where: (type (double-float) temp1 temp2)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -4508,7 +6966,9 @@ Returns multiple values where: (setf info 9))) (cond ((/= info 0) - (xerbla "DSYR2 " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DSYR2" info) (go end_label))) (if (or (= n 0) (= alpha zero)) (go end_label)) (cond @@ -4534,7 +6994,7 @@ Returns multiple values where: (setf jx kx) (setf jy ky))) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((and (= incx 1) (= incy 1)) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -4725,25 +7185,108 @@ Returns multiple values where: end_label (return (values 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::dsyr2 fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (double-float) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dsyr BLAS} %\pagehead{dsyr}{dsyr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dsyr.output +)spool dsyr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dsyr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DSYR - perform the symmetric rank 1 operation A := + alpha*x*x' + A, + + SYNOPSIS + SUBROUTINE DSYR ( UPLO, N, ALPHA, X, INCX, A, LDA ) + + DOUBLE PRECISION ALPHA + + INTEGER INCX, LDA, N + + CHARACTER*1 UPLO + + DOUBLE PRECISION A( LDA, * ), X( * ) + + PURPOSE + DSYR performs the symmetric rank 1 operation + + where alpha is a real scalar, x is an n element vector and A + is an n by n symmetric matrix. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the array A is to be referenced as + follows: + + UPLO = 'U' or 'u' Only the upper triangular part of + A is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part of + A is to be referenced. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + + exit. + + A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading n + by n upper triangular part of the array A must con- + tain the upper triangular part of the symmetric + matrix and the strictly lower triangular part of A is + not referenced. On exit, the upper triangular part of + the array A is overwritten by the upper triangular + part of the updated matrix. Before entry with UPLO = + 'L' or 'l', the leading n by n lower triangular part + of the array A must contain the lower triangular part + of the symmetric matrix and the strictly upper tri- + angular part of A is not referenced. On exit, the + lower triangular part of the array A is overwritten + by the lower triangular part of the updated matrix. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, n ). Unchanged on exit. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -4751,7 +7294,7 @@ Returns multiple values where: (declare (type (array double-float (*)) a x) (type (double-float) alpha) (type fixnum lda incx n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (x double-float x-%data% x-%offset%) @@ -4761,7 +7304,7 @@ Returns multiple values where: (type (double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -4771,7 +7314,9 @@ Returns multiple values where: (setf info 7))) (cond ((/= info 0) - (xerbla "DSYR " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DSYR" info) (go end_label))) (if (or (= n 0) (= alpha zero)) (go end_label)) (cond @@ -4783,7 +7328,7 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -4918,31 +7463,160 @@ Returns multiple values where: end_label (return (values 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::dsyr fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (double-float) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dtbmv BLAS} %\pagehead{dtbmv}{dtbmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dtbmv.output +)spool dtbmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dtbmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DTBMV - perform one of the matrix-vector operations x := + A*x, or x := A'*x, + + SYNOPSIS + SUBROUTINE DTBMV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX + ) + + INTEGER INCX, K, LDA, N + + CHARACTER*1 DIAG, TRANS, UPLO + + DOUBLE PRECISION A( LDA, * ), X( * ) + + PURPOSE + DTBMV performs one of the matrix-vector operations + + where x is an n element vector and A is an n by n unit, or + non-unit, upper or lower triangular band matrix, with ( k + + 1 ) diagonals. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' x := A*x. + + TRANS = 'T' or 't' x := A'*x. + + TRANS = 'C' or 'c' x := A'*x. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry with UPLO = 'U' or 'u', K specifies the + number of super-diagonals of the matrix A. On entry + with UPLO = 'L' or 'l', K specifies the number of + sub-diagonals of the matrix A. K must satisfy 0 + .le. K. Unchanged on exit. + + A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading ( k + + 1 ) by n part of the array A must contain the upper + triangular band part of the matrix of coefficients, + supplied column by column, with the leading diagonal + of the matrix in row ( k + 1 ) of the array, the + first super-diagonal starting at position 2 in row k, + and so on. The top left k by k triangle of the array + A is not referenced. The following program segment + will transfer an upper triangular band matrix from + conventional full matrix storage to band storage: + + DO 20, J = 1, N M = K + 1 - J DO 10, I = MAX( 1, J - + K ), J A( M + I, J ) = matrix( I, J ) 10 CONTINUE + 20 CONTINUE + + Before entry with UPLO = 'L' or 'l', the leading ( k + + 1 ) by n part of the array A must contain the lower + triangular band part of the matrix of coefficients, + supplied column by column, with the leading diagonal + of the matrix in row 1 of the array, the first sub- + diagonal starting at position 1 in row 2, and so on. + The bottom right k by k triangle of the array A is + not referenced. The following program segment will + transfer a lower triangular band matrix from conven- + tional full matrix storage to band storage: + + DO 20, J = 1, N M = 1 - J DO 10, I = J, MIN( N, J + K + ) A( M + I, J ) = matrix( I, J ) 10 CONTINUE 20 + CONTINUE + + Note that when DIAG = 'U' or 'u' the elements of the + array A corresponding to the diagonal elements of the + matrix are not referenced, but are assumed to be + unity. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least ( k + 1 ). Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. On exit, X is overwritten with the transformed + vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) (defun dtbmv (uplo trans diag n k a lda x incx) (declare (type (array double-float (*)) x a) (type fixnum incx lda k n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -4956,13 +7630,13 @@ Returns multiple values where: (type (double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -4974,10 +7648,12 @@ Returns multiple values where: (setf info 9))) (cond ((/= info 0) - (xerbla "DTBMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DTBMV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf nounit (lsame diag "N")) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -4987,9 +7663,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kplus1 (f2cl-lib:int-add k 1)) (cond ((= incx 1) @@ -5212,7 +7888,7 @@ Returns multiple values where: (setf kx (f2cl-lib:int-sub kx incx)))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kplus1 (f2cl-lib:int-add k 1)) (cond ((= incx 1) @@ -5379,33 +8055,165 @@ Returns multiple values where: end_label (return (values 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::dtbmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dtbsv BLAS} %\pagehead{dtbsv}{dtbsv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dtbsv.output +)spool dtbsv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dtbsv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DTBSV - solve one of the systems of equations A*x = b, or + A'*x = b, + + SYNOPSIS + SUBROUTINE DTBSV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX + ) + + INTEGER INCX, K, LDA, N + + CHARACTER*1 DIAG, TRANS, UPLO + + DOUBLE PRECISION A( LDA, * ), X( * ) + + PURPOSE + DTBSV solves one of the systems of equations + + where b and x are n element vectors and A is an n by n unit, + or non-unit, upper or lower triangular band matrix, with ( k + + 1 ) diagonals. + + No test for singularity or near-singularity is included in + this routine. Such tests must be performed before calling + this routine. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the equations to be solved + as follows: + + TRANS = 'N' or 'n' A*x = b. + + TRANS = 'T' or 't' A'*x = b. + + TRANS = 'C' or 'c' A'*x = b. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry with UPLO = 'U' or 'u', K specifies the + number of super-diagonals of the matrix A. On entry + with UPLO = 'L' or 'l', K specifies the number of + sub-diagonals of the matrix A. K must satisfy 0 + .le. K. Unchanged on exit. + + A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading ( k + + 1 ) by n part of the array A must contain the upper + triangular band part of the matrix of coefficients, + supplied column by column, with the leading diagonal + of the matrix in row ( k + 1 ) of the array, the + first super-diagonal starting at position 2 in row k, + and so on. The top left k by k triangle of the array + A is not referenced. The following program segment + will transfer an upper triangular band matrix from + conventional full matrix storage to band storage: + + DO 20, J = 1, N M = K + 1 - J DO 10, I = MAX( 1, J - + K ), J A( M + I, J ) = matrix( I, J ) 10 CONTINUE + 20 CONTINUE + + Before entry with UPLO = 'L' or 'l', the leading ( k + + 1 ) by n part of the array A must contain the lower + triangular band part of the matrix of coefficients, + supplied column by column, with the leading diagonal + of the matrix in row 1 of the array, the first sub- + diagonal starting at position 1 in row 2, and so on. + The bottom right k by k triangle of the array A is + not referenced. The following program segment will + transfer a lower triangular band matrix from conven- + tional full matrix storage to band storage: + + DO 20, J = 1, N M = 1 - J DO 10, I = J, MIN( N, J + K + ) A( M + I, J ) = matrix( I, J ) 10 CONTINUE 20 + CONTINUE + + Note that when DIAG = 'U' or 'u' the elements of the + array A corresponding to the diagonal elements of the + + matrix are not referenced, but are assumed to be + unity. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least ( k + 1 ). Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element + right-hand side vector b. On exit, X is overwritten + with the solution vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) (defun dtbsv (uplo trans diag n k a lda x incx) (declare (type (array double-float (*)) x a) (type fixnum incx lda k n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -5419,13 +8227,13 @@ Returns multiple values where: (type (double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -5437,10 +8245,12 @@ Returns multiple values where: (setf info 9))) (cond ((/= info 0) - (xerbla "DTBSV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DTBSV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf nounit (lsame diag "N")) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -5450,9 +8260,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kplus1 (f2cl-lib:int-add k 1)) (cond ((= incx 1) @@ -5674,7 +8484,7 @@ Returns multiple values where: (setf jx (f2cl-lib:int-add jx incx))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kplus1 (f2cl-lib:int-add k 1)) (cond ((= incx 1) @@ -5844,33 +8654,127 @@ Returns multiple values where: end_label (return (values 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::dtbsv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dtpmv BLAS} %\pagehead{dtpmv}{dtpmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dtpmv.output +)spool dtpmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dtpmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DTPMV - perform one of the matrix-vector operations x := + A*x, or x := A'*x, + + SYNOPSIS + SUBROUTINE DTPMV ( UPLO, TRANS, DIAG, N, AP, X, INCX ) + + INTEGER INCX, N + + CHARACTER*1 DIAG, TRANS, UPLO + + DOUBLE PRECISION AP( * ), X( * ) + + PURPOSE + DTPMV performs one of the matrix-vector operations + + where x is an n element vector and A is an n by n unit, or + non-unit, upper or lower triangular matrix, supplied in + packed form. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' x := A*x. + + TRANS = 'T' or 't' x := A'*x. + + TRANS = 'C' or 'c' x := A'*x. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit + + triangular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + AP - DOUBLE PRECISION array of DIMENSION at least + ( ( n*( n + 1 ) )/2 ). Before entry with UPLO = 'U' + or 'u', the array AP must contain the upper triangu- + lar matrix packed sequentially, column by column, so + that AP( 1 ) contains a( 1, 1 ), AP( 2 ) and AP( 3 ) + contain a( 1, 2 ) and a( 2, 2 ) respectively, and so + on. Before entry with UPLO = 'L' or 'l', the array + AP must contain the lower triangular matrix packed + sequentially, column by column, so that AP( 1 ) con- + tains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 + ) and a( 3, 1 ) respectively, and so on. Note that + when DIAG = 'U' or 'u', the diagonal elements of A + are not referenced, but are assumed to be unity. + Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. On exit, X is overwritten with the transformed + vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) (defun dtpmv (uplo trans diag n ap x incx) (declare (type (array double-float (*)) x ap) (type fixnum incx n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -5884,13 +8788,13 @@ Returns multiple values where: (type (double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -5898,10 +8802,12 @@ Returns multiple values where: (setf info 7))) (cond ((/= info 0) - (xerbla "DTPMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DTPMV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf nounit (lsame diag "N")) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -5911,9 +8817,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kk 1) (cond ((= incx 1) @@ -6142,7 +9048,7 @@ Returns multiple values where: 1)))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kk (the fixnum (truncate (* n (+ n 1)) 2))) (cond ((= incx 1) @@ -6308,32 +9214,130 @@ Returns multiple values where: end_label (return (values 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::dtpmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dtpsv BLAS} %\pagehead{dtpsv}{dtpsv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dtpsv.output +)spool dtpsv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dtpsv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DTPSV - solve one of the systems of equations A*x = b, or + A'*x = b, + + SYNOPSIS + SUBROUTINE DTPSV ( UPLO, TRANS, DIAG, N, AP, X, INCX ) + + INTEGER INCX, N + + CHARACTER*1 DIAG, TRANS, UPLO + + DOUBLE PRECISION AP( * ), X( * ) + + PURPOSE + DTPSV solves one of the systems of equations + + where b and x are n element vectors and A is an n by n unit, + or non-unit, upper or lower triangular matrix, supplied in + packed form. + + No test for singularity or near-singularity is included in + this routine. Such tests must be performed before calling + this routine. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the equations to be solved + as follows: + + TRANS = 'N' or 'n' A*x = b. + + TRANS = 'T' or 't' A'*x = b. + + TRANS = 'C' or 'c' A'*x = b. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + AP - DOUBLE PRECISION array of DIMENSION at least + ( ( n*( n + 1 ) )/2 ). Before entry with UPLO = 'U' + or 'u', the array AP must contain the upper triangu- + lar matrix packed sequentially, column by column, so + that AP( 1 ) contains a( 1, 1 ), AP( 2 ) and AP( 3 ) + contain a( 1, 2 ) and a( 2, 2 ) respectively, and so + on. Before entry with UPLO = 'L' or 'l', the array + AP must contain the lower triangular matrix packed + sequentially, column by column, so that AP( 1 ) con- + tains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 + ) and a( 3, 1 ) respectively, and so on. Note that + when DIAG = 'U' or 'u', the diagonal elements of A + are not referenced, but are assumed to be unity. + Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element + right-hand side vector b. On exit, X is overwritten + with the solution vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) (defun dtpsv (uplo trans diag n ap x incx) (declare (type (array double-float (*)) x ap) (type fixnum incx n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -6347,13 +9351,13 @@ Returns multiple values where: (type (double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -6361,10 +9365,12 @@ Returns multiple values where: (setf info 7))) (cond ((/= info 0) - (xerbla "DTPSV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DTPSV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf nounit (lsame diag "N")) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -6374,9 +9380,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kk (the fixnum (truncate (* n (+ n 1)) 2))) (cond ((= incx 1) @@ -6594,7 +9600,7 @@ Returns multiple values where: 1)))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kk 1) (cond ((= incx 1) @@ -6773,32 +9779,128 @@ Returns multiple values where: end_label (return (values 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::dtpsv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dtrmv BLAS} %\pagehead{dtrmv}{dtrmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dtrmv.output +)spool dtrmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dtrmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DTRMV - perform one of the matrix-vector operations x := + A*x, or x := A'*x, + + SYNOPSIS + SUBROUTINE DTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX ) + + INTEGER INCX, LDA, N + + CHARACTER*1 DIAG, TRANS, UPLO + + DOUBLE PRECISION A( LDA, * ), X( * ) + + PURPOSE + DTRMV performs one of the matrix-vector operations + + where x is an n element vector and A is an n by n unit, or + non-unit, upper or lower triangular matrix. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' x := A*x. + + TRANS = 'T' or 't' x := A'*x. + + TRANS = 'C' or 'c' x := A'*x. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading n + by n upper triangular part of the array A must con- + tain the upper triangular matrix and the strictly + lower triangular part of A is not referenced. Before + entry with UPLO = 'L' or 'l', the leading n by n + lower triangular part of the array A must contain the + lower triangular matrix and the strictly upper tri- + angular part of A is not referenced. Note that when + DIAG = 'U' or 'u', the diagonal elements of A are not + referenced either, but are assumed to be unity. + Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, n ). Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. On exit, X is overwritten with the transformed + vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) (defun dtrmv (uplo trans diag n a lda x incx) (declare (type (array double-float (*)) x a) (type fixnum incx lda n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -6811,13 +9913,13 @@ Returns multiple values where: (type (double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -6827,10 +9929,12 @@ Returns multiple values where: (setf info 8))) (cond ((/= info 0) - (xerbla "DTRMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DTRMV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf nounit (lsame diag "N")) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -6840,9 +9944,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -7035,7 +10139,7 @@ Returns multiple values where: (setf jx (f2cl-lib:int-sub jx incx))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) @@ -7174,33 +10278,133 @@ Returns multiple values where: end_label (return (values 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::dtrmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dtrsv BLAS} %\pagehead{dtrsv}{dtrsv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dtrsv.output +)spool dtrsv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dtrsv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DTRSV - solve one of the systems of equations A*x = b, or + A'*x = b, + + SYNOPSIS + SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX ) + + INTEGER INCX, LDA, N + + CHARACTER*1 DIAG, TRANS, UPLO + + DOUBLE PRECISION A( LDA, * ), X( * ) + + PURPOSE + DTRSV solves one of the systems of equations + + where b and x are n element vectors and A is an n by n unit, + or non-unit, upper or lower triangular matrix. + + No test for singularity or near-singularity is included in + this routine. Such tests must be performed before calling + this routine. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the equations to be solved + as follows: + + TRANS = 'N' or 'n' A*x = b. + + TRANS = 'T' or 't' A'*x = b. + + TRANS = 'C' or 'c' A'*x = b. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit + + triangular. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading n + by n upper triangular part of the array A must con- + tain the upper triangular matrix and the strictly + lower triangular part of A is not referenced. Before + entry with UPLO = 'L' or 'l', the leading n by n + lower triangular part of the array A must contain the + lower triangular matrix and the strictly upper tri- + angular part of A is not referenced. Note that when + DIAG = 'U' or 'u', the diagonal elements of A are not + referenced either, but are assumed to be unity. + Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, n ). Unchanged on exit. + + X - DOUBLE PRECISION array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element + right-hand side vector b. On exit, X is overwritten + with the solution vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) (defun dtrsv (uplo trans diag n a lda x incx) (declare (type (array double-float (*)) x a) (type fixnum incx lda n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -7213,13 +10417,13 @@ Returns multiple values where: (type (double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -7229,10 +10433,12 @@ Returns multiple values where: (setf info 8))) (cond ((/= info 0) - (xerbla "DTRSV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DTRSV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf nounit (lsame diag "N")) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -7242,9 +10448,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) @@ -7434,7 +10640,7 @@ Returns multiple values where: (setf jx (f2cl-lib:int-add jx incx))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -7578,26 +10784,150 @@ Returns multiple values where: end_label (return (values 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::dtrsv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zgbmv BLAS} %\pagehead{zgbmv}{zgbmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zgbmv.output +)spool zgbmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zgbmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZGBMV - perform one of the matrix-vector operations y := + alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, or y := + alpha*conjg( A' )*x + beta*y, + + SYNOPSIS + SUBROUTINE ZGBMV ( TRANS, M, N, KL, KU, ALPHA, A, LDA, X, + INCX, BETA, Y, INCY ) + + COMPLEX*16 ALPHA, BETA + + INTEGER INCX, INCY, KL, KU, LDA, M, N + + CHARACTER*1 TRANS + + COMPLEX*16 A( LDA, * ), X( * ), Y( * ) + + PURPOSE + ZGBMV performs one of the matrix-vector operations + + where alpha and beta are scalars, x and y are vectors and A + is an m by n band matrix, with kl sub-diagonals and ku + super-diagonals. + + PARAMETERS + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' y := alpha*A*x + beta*y. + + TRANS = 'T' or 't' y := alpha*A'*x + beta*y. + + TRANS = 'C' or 'c' y := alpha*conjg( A' )*x + + beta*y. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of the + matrix A. M must be at least zero. Unchanged on + exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix A. N must be at least zero. Unchanged on + exit. + + KL - INTEGER. + On entry, KL specifies the number of sub-diagonals of + the matrix A. KL must satisfy 0 .le. KL. Unchanged + + on exit. + + KU - INTEGER. + On entry, KU specifies the number of super-diagonals + of the matrix A. KU must satisfy 0 .le. KU. + Unchanged on exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + Before entry, the leading ( kl + ku + 1 ) by n part + of the array A must contain the matrix of coeffi- + cients, supplied column by column, with the leading + diagonal of the matrix in row ( ku + 1 ) of the + array, the first super-diagonal starting at position + 2 in row ku, the first sub-diagonal starting at posi- + tion 1 in row ( ku + 2 ), and so on. Elements in the + array A that do not correspond to elements in the + band matrix (such as the top left ku by ku triangle) + are not referenced. The following program segment + will transfer a band matrix from conventional full + matrix storage to band storage: + + DO 20, J = 1, N K = KU + 1 - J DO 10, I = MAX( 1, J - + KU ), MIN( M, J + KL ) A( K + I, J ) = matrix( I, J ) + 10 CONTINUE 20 CONTINUE + + Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least ( kl + ku + 1 ). Unchanged on exit. + + X - COMPLEX*16 array of DIMENSION at least + ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' + and at least ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. + Before entry, the incremented array X must contain + the vector x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + BETA - COMPLEX*16 . + On entry, BETA specifies the scalar beta. When BETA + is supplied as zero then Y need not be set on input. + Unchanged on exit. + + Y - COMPLEX*16 array of DIMENSION at least + ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' + and at least ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. + Before entry, the incremented array Y must contain + the vector y. On exit, Y is overwritten by the + updated vector y. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -7605,7 +10935,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) y x a) (type (complex double-float) beta alpha) (type fixnum incy incx lda ku kl n m) - (type (simple-array character (*)) trans)) + (type character trans)) (f2cl-lib:with-multi-array-data ((trans character trans-%data% trans-%offset%) (a (complex double-float) a-%data% a-%offset%) @@ -7619,9 +10949,9 @@ Returns multiple values where: (type (complex double-float) temp)) (setf info 0) (cond - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 1)) ((< m 0) (setf info 2)) @@ -7639,13 +10969,15 @@ Returns multiple values where: (setf info 13))) (cond ((/= info 0) - (xerbla "ZGBMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZGBMV" info) (go end_label))) (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) - (setf noconj (lsame trans "T")) + (setf noconj (char-equal trans #\T)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf lenx n) (setf leny m)) (t @@ -7714,7 +11046,7 @@ Returns multiple values where: (if (= alpha zero) (go end_label)) (setf kup1 (f2cl-lib:int-add ku 1)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf jx kx) (cond ((= incy 1) @@ -7931,32 +11263,123 @@ Returns multiple values where: (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::zgbmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil -; nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zgemv BLAS} %\pagehead{zgemv}{zgemv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zgemv.output +)spool zgemv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zgemv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZGEMV - perform one of the matrix-vector operations y := + alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, or y := + alpha*conjg( A' )*x + beta*y, + + SYNOPSIS + SUBROUTINE ZGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, + BETA, Y, INCY ) + + COMPLEX*16 ALPHA, BETA + + INTEGER INCX, INCY, LDA, M, N + + CHARACTER*1 TRANS + + COMPLEX*16 A( LDA, * ), X( * ), Y( * ) + + PURPOSE + ZGEMV performs one of the matrix-vector operations + + where alpha and beta are scalars, x and y are vectors and A + is an m by n matrix. + + PARAMETERS + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' y := alpha*A*x + beta*y. + + TRANS = 'T' or 't' y := alpha*A'*x + beta*y. + + TRANS = 'C' or 'c' y := alpha*conjg( A' )*x + + beta*y. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of the + matrix A. M must be at least zero. Unchanged on + exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix A. N must be at least zero. Unchanged on + exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + Before entry, the leading m by n part of the array A + must contain the matrix of coefficients. Unchanged + on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, m ). Unchanged on exit. + + X - COMPLEX*16 array of DIMENSION at least + ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' + and at least ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. + Before entry, the incremented array X must contain + the vector x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + BETA - COMPLEX*16 . + On entry, BETA specifies the scalar beta. When BETA + is supplied as zero then Y need not be set on input. + Unchanged on exit. + + Y - COMPLEX*16 array of DIMENSION at least + ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' + and at least ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. + Before entry with BETA non-zero, the incremented + array Y must contain the vector y. On exit, Y is + overwritten by the updated vector y. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -7964,7 +11387,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) y x a) (type (complex double-float) beta alpha) (type fixnum incy incx lda n m) - (type (simple-array character (*)) trans)) + (type character trans)) (f2cl-lib:with-multi-array-data ((trans character trans-%data% trans-%offset%) (a (complex double-float) a-%data% a-%offset%) @@ -7978,9 +11401,9 @@ Returns multiple values where: (type (complex double-float) temp)) (setf info 0) (cond - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 1)) ((< m 0) (setf info 2)) @@ -7994,13 +11417,15 @@ Returns multiple values where: (setf info 11))) (cond ((/= info 0) - (xerbla "ZGEMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZGEMV" info) (go end_label))) (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) - (setf noconj (lsame trans "T")) + (setf noconj (char-equal trans #\T)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf lenx n) (setf leny m)) (t @@ -8068,7 +11493,7 @@ Returns multiple values where: (setf iy (f2cl-lib:int-add iy incy)))))))))) (if (= alpha zero) (go end_label)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf jx kx) (cond ((= incy 1) @@ -8218,30 +11643,99 @@ Returns multiple values where: end_label (return (values 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::zgemv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zgerc BLAS} %\pagehead{zgerc}{zgerc} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zgerc.output +)spool zgerc.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zgerc examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZGERC - perform the rank 1 operation A := alpha*x*conjg( + y' ) + A, + + SYNOPSIS + SUBROUTINE ZGERC ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA ) + + COMPLEX*16 ALPHA + + INTEGER INCX, INCY, LDA, M, N + + COMPLEX*16 A( LDA, * ), X( * ), Y( * ) + + PURPOSE + ZGERC performs the rank 1 operation + + where alpha is a scalar, x is an m element vector, y is an n + element vector and A is an m by n matrix. + + PARAMETERS + M - INTEGER. + On entry, M specifies the number of rows of the + matrix A. M must be at least zero. Unchanged on + exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix A. N must be at least zero. Unchanged on + exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( m - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the m element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + Y - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the n element vector + y. Unchanged on exit. + + INCY - INTEGER. + On entry, INCY specifies the increment for the + + elements of Y. INCY must not be zero. Unchanged on + exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + Before entry, the leading m by n part of the array A + must contain the matrix of coefficients. On exit, A + is overwritten by the updated matrix. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, m ). Unchanged on exit. + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) @@ -8270,7 +11764,9 @@ Returns multiple values where: (setf info 9))) (cond ((/= info 0) - (xerbla "ZGERC " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZGERC" info) (go end_label))) (if (or (= m 0) (= n 0) (= alpha zero)) (go end_label)) (cond @@ -8357,28 +11853,98 @@ Returns multiple values where: end_label (return (values 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::zgerc fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zgeru BLAS} %\pagehead{zgeru}{zgeru} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zgeru.output +)spool zgeru.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zgeru examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZGERU - perform the rank 1 operation A := alpha*x*y' + A, + + SYNOPSIS + SUBROUTINE ZGERU ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA ) + + COMPLEX*16 ALPHA + + INTEGER INCX, INCY, LDA, M, N + + COMPLEX*16 A( LDA, * ), X( * ), Y( * ) + + PURPOSE + ZGERU performs the rank 1 operation + + where alpha is a scalar, x is an m element vector, y is an n + element vector and A is an m by n matrix. + + PARAMETERS + M - INTEGER. + On entry, M specifies the number of rows of the + matrix A. M must be at least zero. Unchanged on + exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix A. N must be at least zero. Unchanged on + exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( m - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the m element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + Y - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the n element vector + y. Unchanged on exit. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + + exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + Before entry, the leading m by n part of the array A + must contain the matrix of coefficients. On exit, A + is overwritten by the updated matrix. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, m ). Unchanged on exit. + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) @@ -8407,7 +11973,9 @@ Returns multiple values where: (setf info 9))) (cond ((/= info 0) - (xerbla "ZGERU " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZGERU" info) (go end_label))) (if (or (= m 0) (= n 0) (= alpha zero)) (go end_label)) (cond @@ -8486,28 +12054,152 @@ Returns multiple values where: end_label (return (values 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::zgeru fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zhbmv BLAS} %\pagehead{zhbmv}{zhbmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zhbmv.output +)spool zhbmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zhbmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZHBMV - perform the matrix-vector operation y := alpha*A*x + + beta*y, + + SYNOPSIS + SUBROUTINE ZHBMV ( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, + Y, INCY ) + + COMPLEX*16 ALPHA, BETA + + INTEGER INCX, INCY, K, LDA, N + + CHARACTER*1 UPLO + + COMPLEX*16 A( LDA, * ), X( * ), Y( * ) + + PURPOSE + ZHBMV performs the matrix-vector operation + + where alpha and beta are scalars, x and y are n element vec- + tors and A is an n by n hermitian band matrix, with k + super-diagonals. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the band matrix A is being sup- + plied as follows: + + UPLO = 'U' or 'u' The upper triangular part of A is + being supplied. + + UPLO = 'L' or 'l' The lower triangular part of A is + being supplied. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry, K specifies the number of super-diagonals + of the matrix A. K must satisfy 0 .le. K. Unchanged + on exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + + Before entry with UPLO = 'U' or 'u', the leading ( k + + 1 ) by n part of the array A must contain the upper + triangular band part of the hermitian matrix, sup- + plied column by column, with the leading diagonal of + the matrix in row ( k + 1 ) of the array, the first + super-diagonal starting at position 2 in row k, and + so on. The top left k by k triangle of the array A is + not referenced. The following program segment will + transfer the upper triangular part of a hermitian + band matrix from conventional full matrix storage to + band storage: + + DO 20, J = 1, N M = K + 1 - J DO 10, I = MAX( 1, J - + K ), J A( M + I, J ) = matrix( I, J ) 10 CONTINUE + 20 CONTINUE + + Before entry with UPLO = 'L' or 'l', the leading ( k + + 1 ) by n part of the array A must contain the lower + triangular band part of the hermitian matrix, sup- + plied column by column, with the leading diagonal of + the matrix in row 1 of the array, the first sub- + diagonal starting at position 1 in row 2, and so on. + The bottom right k by k triangle of the array A is + not referenced. The following program segment will + transfer the lower triangular part of a hermitian + band matrix from conventional full matrix storage to + band storage: + + DO 20, J = 1, N M = 1 - J DO 10, I = J, MIN( N, J + K + ) A( M + I, J ) = matrix( I, J ) 10 CONTINUE 20 + CONTINUE + + Note that the imaginary parts of the diagonal ele- + ments need not be set and are assumed to be zero. + Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least ( k + 1 ). Unchanged on exit. + + X - COMPLEX*16 array of DIMENSION at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the vector x. + Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + BETA - COMPLEX*16 . + + On entry, BETA specifies the scalar beta. Unchanged + on exit. + + Y - COMPLEX*16 array of DIMENSION at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the vector y. On + exit, Y is overwritten by the updated vector y. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -8515,7 +12207,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) y x a) (type (complex double-float) beta alpha) (type fixnum incy incx lda k n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (a (complex double-float) a-%data% a-%offset%) @@ -8527,7 +12219,7 @@ Returns multiple values where: (type (complex double-float) temp1 temp2)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -8541,7 +12233,9 @@ Returns multiple values where: (setf info 11))) (cond ((/= info 0) - (xerbla "ZHBMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZHBMV" info) (go end_label))) (if (or (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) (cond @@ -8604,7 +12298,7 @@ Returns multiple values where: (setf iy (f2cl-lib:int-add iy incy)))))))))) (if (= alpha zero) (go end_label)) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kplus1 (f2cl-lib:int-add k 1)) (cond ((and (= incx 1) (= incy 1)) @@ -8826,30 +12520,122 @@ Returns multiple values where: end_label (return (values 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::zhbmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zhemv BLAS} %\pagehead{zhemv}{zhemv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zhemv.output +)spool zhemv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zhemv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZHEMV - perform the matrix-vector operation y := alpha*A*x + + beta*y, + + SYNOPSIS + SUBROUTINE ZHEMV ( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, + INCY ) + + COMPLEX*16 ALPHA, BETA + + INTEGER INCX, INCY, LDA, N + + CHARACTER*1 UPLO + + COMPLEX*16 A( LDA, * ), X( * ), Y( * ) + + PURPOSE + ZHEMV performs the matrix-vector operation + + where alpha and beta are scalars, x and y are n element vec- + tors and A is an n by n hermitian matrix. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the array A is to be referenced as + follows: + + UPLO = 'U' or 'u' Only the upper triangular part of + A is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part of + A is to be referenced. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading n + by n upper triangular part of the array A must con- + tain the upper triangular part of the hermitian + matrix and the strictly lower triangular part of A is + not referenced. Before entry with UPLO = 'L' or 'l', + the leading n by n lower triangular part of the array + + A must contain the lower triangular part of the her- + mitian matrix and the strictly upper triangular part + of A is not referenced. Note that the imaginary + parts of the diagonal elements need not be set and + are assumed to be zero. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, n ). Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + BETA - COMPLEX*16 . + On entry, BETA specifies the scalar beta. When BETA + is supplied as zero then Y need not be set on input. + Unchanged on exit. + + Y - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the n element vector + y. On exit, Y is overwritten by the updated vector y. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -8857,7 +12643,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) y x a) (type (complex double-float) beta alpha) (type fixnum incy incx lda n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (a (complex double-float) a-%data% a-%offset%) @@ -8869,7 +12655,7 @@ Returns multiple values where: (type (complex double-float) temp1 temp2)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -8881,7 +12667,9 @@ Returns multiple values where: (setf info 10))) (cond ((/= info 0) - (xerbla "ZHEMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZHEMV" info) (go end_label))) (if (or (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) (cond @@ -8944,7 +12732,7 @@ Returns multiple values where: (setf iy (f2cl-lib:int-add iy incy)))))))))) (if (= alpha zero) (go end_label)) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((and (= incx 1) (= incy 1)) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -9137,30 +12925,122 @@ Returns multiple values where: end_label (return (values 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::zhemv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zher2 BLAS} %\pagehead{zher2}{zher2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zher2.output +)spool zher2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zher2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZHER2 - perform the hermitian rank 2 operation A := + alpha*x*conjg( y' ) + conjg( alpha )*y*conjg( x' ) + A, + + SYNOPSIS + SUBROUTINE ZHER2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA + ) + + COMPLEX*16 ALPHA + + INTEGER INCX, INCY, LDA, N + + CHARACTER*1 UPLO + + COMPLEX*16 A( LDA, * ), X( * ), Y( * ) + + PURPOSE + ZHER2 performs the hermitian rank 2 operation + + where alpha is a scalar, x and y are n element vectors and A + is an n by n hermitian matrix. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the array A is to be referenced as + follows: + + UPLO = 'U' or 'u' Only the upper triangular part of + A is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part of + A is to be referenced. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the + + elements of X. INCX must not be zero. Unchanged on + exit. + + Y - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the n element vector + y. Unchanged on exit. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading n + by n upper triangular part of the array A must con- + tain the upper triangular part of the hermitian + matrix and the strictly lower triangular part of A is + not referenced. On exit, the upper triangular part of + the array A is overwritten by the upper triangular + part of the updated matrix. Before entry with UPLO = + 'L' or 'l', the leading n by n lower triangular part + of the array A must contain the lower triangular part + of the hermitian matrix and the strictly upper tri- + angular part of A is not referenced. On exit, the + lower triangular part of the array A is overwritten + by the lower triangular part of the updated matrix. + Note that the imaginary parts of the diagonal ele- + ments need not be set, they are assumed to be zero, + and on exit they are set to zero. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, n ). Unchanged on exit. + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) @@ -9168,7 +13048,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) a y x) (type (complex double-float) alpha) (type fixnum lda incy incx n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (x (complex double-float) x-%data% x-%offset%) @@ -9180,7 +13060,7 @@ Returns multiple values where: (type (complex double-float) temp1 temp2)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -9192,7 +13072,9 @@ Returns multiple values where: (setf info 9))) (cond ((/= info 0) - (xerbla "ZHER2 " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZHER2" info) (go end_label))) (if (or (= n 0) (= alpha zero)) (go end_label)) (cond @@ -9218,7 +13100,7 @@ Returns multiple values where: (setf jx kx) (setf jy ky))) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((and (= incx 1) (= incy 1)) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -9585,29 +13467,111 @@ Returns multiple values where: end_label (return (values 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::zher2 fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zher BLAS} %\pagehead{zher}{zher} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zher.output +)spool zher.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zher examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZHER - perform the hermitian rank 1 operation A := + alpha*x*conjg( x' ) + A, + + SYNOPSIS + SUBROUTINE ZHER ( UPLO, N, ALPHA, X, INCX, A, LDA ) + + DOUBLE PRECISION ALPHA + + INTEGER INCX, LDA, N + + CHARACTER*1 UPLO + + COMPLEX*16 A( LDA, * ), X( * ) + + PURPOSE + ZHER performs the hermitian rank 1 operation + + where alpha is a real scalar, x is an n element vector and A + is an n by n hermitian matrix. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the array A is to be referenced as + follows: + + UPLO = 'U' or 'u' Only the upper triangular part of + A is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part of + A is to be referenced. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + + exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading n + by n upper triangular part of the array A must con- + tain the upper triangular part of the hermitian + matrix and the strictly lower triangular part of A is + not referenced. On exit, the upper triangular part of + the array A is overwritten by the upper triangular + part of the updated matrix. Before entry with UPLO = + 'L' or 'l', the leading n by n lower triangular part + of the array A must contain the lower triangular part + of the hermitian matrix and the strictly upper tri- + angular part of A is not referenced. On exit, the + lower triangular part of the array A is overwritten + by the lower triangular part of the updated matrix. + Note that the imaginary parts of the diagonal ele- + ments need not be set, they are assumed to be zero, + and on exit they are set to zero. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, n ). Unchanged on exit. + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) @@ -9615,7 +13579,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) a x) (type (double-float) alpha) (type fixnum lda incx n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (x (complex double-float) x-%data% x-%offset%) @@ -9625,7 +13589,7 @@ Returns multiple values where: (type (complex double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -9635,7 +13599,9 @@ Returns multiple values where: (setf info 7))) (cond ((/= info 0) - (xerbla "ZHER " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZHER" info) (go end_label))) (if (or (= n 0) (= alpha (coerce (realpart zero) 'double-float))) (go end_label)) @@ -9648,7 +13614,7 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -9925,26 +13891,120 @@ Returns multiple values where: end_label (return (values 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::zher fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (double-float) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zhpmv BLAS} %\pagehead{zhpmv}{zhpmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zhpmv.output +)spool zhpmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zhpmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZHPMV - perform the matrix-vector operation y := alpha*A*x + + beta*y, + + SYNOPSIS + SUBROUTINE ZHPMV ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, + INCY ) + + COMPLEX*16 ALPHA, BETA + + INTEGER INCX, INCY, N + + CHARACTER*1 UPLO + + COMPLEX*16 AP( * ), X( * ), Y( * ) + + PURPOSE + ZHPMV performs the matrix-vector operation + + where alpha and beta are scalars, x and y are n element vec- + tors and A is an n by n hermitian matrix, supplied in packed + form. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the matrix A is supplied in the + packed array AP as follows: + + UPLO = 'U' or 'u' The upper triangular part of A is + supplied in AP. + + UPLO = 'L' or 'l' The lower triangular part of A is + supplied in AP. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + AP - COMPLEX*16 array of DIMENSION at least + ( ( n*( n + 1 ) )/2 ). Before entry with UPLO = 'U' + or 'u', the array AP must contain the upper triangu- + lar part of the hermitian matrix packed sequentially, + column by column, so that AP( 1 ) contains a( 1, 1 ), + AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 ) + + respectively, and so on. Before entry with UPLO = + 'L' or 'l', the array AP must contain the lower tri- + angular part of the hermitian matrix packed sequen- + tially, column by column, so that AP( 1 ) contains a( + 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( + 3, 1 ) respectively, and so on. Note that the ima- + ginary parts of the diagonal elements need not be set + and are assumed to be zero. Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + + BETA - COMPLEX*16 . + On entry, BETA specifies the scalar beta. When BETA + is supplied as zero then Y need not be set on input. + Unchanged on exit. + + Y - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the n element vector + y. On exit, Y is overwritten by the updated vector y. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -9952,7 +14012,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) y x ap) (type (complex double-float) beta alpha) (type fixnum incy incx n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (ap (complex double-float) ap-%data% ap-%offset%) @@ -9964,7 +14024,7 @@ Returns multiple values where: (type (complex double-float) temp1 temp2)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -9974,7 +14034,9 @@ Returns multiple values where: (setf info 9))) (cond ((/= info 0) - (xerbla "ZHPMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZHPMV" info) (go end_label))) (if (or (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) (cond @@ -10038,7 +14100,7 @@ Returns multiple values where: (if (= alpha zero) (go end_label)) (setf kk 1) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((and (= incx 1) (= incy 1)) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -10257,29 +14319,275 @@ Returns multiple values where: end_label (return (values 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::zhpmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; (array (complex double-float) (*)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zhpr2 BLAS} %\pagehead{zhpr2}{zhpr2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zhpr2.output +)spool zhpr2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zhpr2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZHPR2 - perform the hermitian rank 2 operation A := + alpha*x*conjg( y' ) + conjg( alpha )*y*conjg( x' ) + A, + + SYNOPSIS + SUBROUTINE ZHPR2 ( UPLO, N, ALPHA, X, INCX, Y, INCY, AP ) + + COMPLEX*16 ALPHA + + INTEGER INCX, INCY, N + + CHARACTER*1 UPLO + + COMPLEX*16 AP( * ), X( * ), Y( * ) + + PURPOSE + ZHPR2 performs the hermitian rank 2 operation + + where alpha is a scalar, x and y are n element vectors and A + is an n by n hermitian matrix, supplied in packed form. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the matrix A is supplied in the + packed array AP as follows: + + UPLO = 'U' or 'u' The upper triangular part of A is + supplied in AP. + + UPLO = 'L' or 'l' The lower triangular part of A is + supplied in AP. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + + exit. + + Y - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the + incremented array Y must contain the n element vector + y. Unchanged on exit. + + INCY - INTEGER. + On entry, INCY specifies the increment for the ele- + ments of Y. INCY must not be zero. Unchanged on + exit. + + AP - COMPLEX*16 array of DIMENSION at least + ( ( n*( n + 1 ) )/2 ). Before entry with UPLO = 'U' + or 'u', the array AP must contain the upper triangu- + lar part of the hermitian matrix packed sequentially, + column by column, so that AP( 1 ) contains a( 1, 1 ), + AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 ) + respectively, and so on. On exit, the array AP is + overwritten by the upper triangular part of the + updated matrix. Before entry with UPLO = 'L' or 'l', + the array AP must contain the lower triangular part + of the hermitian matrix packed sequentially, column + by column, so that AP( 1 ) contains a( 1, 1 ), AP( 2 + ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 ) respec- + tively, and so on. On exit, the array AP is overwrit- + ten by the lower triangular part of the updated + matrix. Note that the imaginary parts of the diago- + nal elements need not be set, they are assumed to be + zero, and on exit they are set to zero. + + Level 2 Blas routine. + + -- Written on 22-October-1986. Jack Dongarra, + Argonne National Lab. Jeremy Du Croz, Nag Central + Office. Sven Hammarling, Nag Central Office. + Richard Hanson, Sandia National Labs. + NAME + + SYNOPSIS + + rou- + tine + zrotg(ca,cb,c,s) + sub- + ble + dou- complex + ca,cb,s + ble + dou- precision + c + ble + dou- precision + norm,scale + ble + dou- complex + alpha + if (cdabs(ca) + .ne. + 0.0d0) + go + to + 10 + c = + 0.0d0 + s = + (1.0d0,0.0d0) + ca = + cb + go to + 20 + 10 con- + tinue + scale = + cdabs(ca) + + + cdabs(cb) + norm = + scale*dsqrt((cdabs(ca/dcmplx(scale,0.0d0)))**2 + + + * (cdabs(cb/dcmplx(scale,0.0d0)))**2) + alpha = + ca + /cdabs(ca) + c = + cdabs(ca) + / + norm + s = + alpha + * + dconjg(cb) + / + norm + ca = + alpha + * + norm + 20 continue + return + end + PUR- + POSE + NAME + + SYNOPSIS + + rou- + tine + zscal(n,za,zx,incx) + sub- + c scales + a + vec- + tor + by + a + con- + stant. + c jack + dongarra, + 3/11/78. + c modified + to + correct + prob- + lem + with + nega- + tive + incre- + ment, + 8/21/90. + ble + dou- complex + za,zx(1) + integer i,incx,ix,n + if(n.le.0)return + if(incx.eq.1)go to + 20 + c code + for + incre- + ment + not + equal + to + 1 + ix = + 1 + if(incx.lt.0)ix = + (- + n+1)*incx + + + 1 + do 10 + i + = + 1,n + zx(ix) = + za*zx(ix) + ix = + ix + + + incx + 10 con- + tinue + return + c code + for + incre- + ment + equal + to + 1 + 20 do + 30 + i + = + 1,n + zx(i) = + za*zx(i) + 30 con- + tinue + return + end + PUR- + POSE + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) @@ -10287,7 +14595,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) ap y x) (type (complex double-float) alpha) (type fixnum incy incx n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (x (complex double-float) x-%data% x-%offset%) @@ -10299,7 +14607,7 @@ Returns multiple values where: (type (complex double-float) temp1 temp2)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -10309,7 +14617,9 @@ Returns multiple values where: (setf info 7))) (cond ((/= info 0) - (xerbla "ZHPR2 " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZHPR2" info) (go end_label))) (if (or (= n 0) (= alpha zero)) (go end_label)) (cond @@ -10336,7 +14646,7 @@ Returns multiple values where: (setf jy ky))) (setf kk 1) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((and (= incx 1) (= incy 1)) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -10726,28 +15036,107 @@ Returns multiple values where: end_label (return (values 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::zhpr2 fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*))) -; :return-values '(nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zhpr BLAS} %\pagehead{zhpr}{zhpr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zhpr.output +)spool zhpr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zhpr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZHPR - perform the hermitian rank 1 operation A := + alpha*x*conjg( x' ) + A, + + SYNOPSIS + SUBROUTINE ZHPR ( UPLO, N, ALPHA, X, INCX, AP ) + + DOUBLE PRECISION ALPHA + + INTEGER INCX, N + + CHARACTER*1 UPLO + + COMPLEX*16 AP( * ), X( * ) + + PURPOSE + ZHPR performs the hermitian rank 1 operation + + where alpha is a real scalar, x is an n element vector and A + is an n by n hermitian matrix, supplied in packed form. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or lower + triangular part of the matrix A is supplied in the + packed array AP as follows: + + UPLO = 'U' or 'u' The upper triangular part of A is + supplied in AP. + + UPLO = 'L' or 'l' The lower triangular part of A is + supplied in AP. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. Unchanged on exit. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + + exit. + + AP - COMPLEX*16 array of DIMENSION at least + ( ( n*( n + 1 ) )/2 ). Before entry with UPLO = 'U' + or 'u', the array AP must contain the upper triangu- + lar part of the hermitian matrix packed sequentially, + column by column, so that AP( 1 ) contains a( 1, 1 ), + AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 ) + respectively, and so on. On exit, the array AP is + overwritten by the upper triangular part of the + updated matrix. Before entry with UPLO = 'L' or 'l', + the array AP must contain the lower triangular part + of the hermitian matrix packed sequentially, column + by column, so that AP( 1 ) contains a( 1, 1 ), AP( 2 + ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 ) respec- + tively, and so on. On exit, the array AP is overwrit- + ten by the lower triangular part of the updated + matrix. Note that the imaginary parts of the diago- + nal elements need not be set, they are assumed to be + zero, and on exit they are set to zero. + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) @@ -10755,7 +15144,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) ap x) (type (double-float) alpha) (type fixnum incx n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (x (complex double-float) x-%data% x-%offset%) @@ -10766,7 +15155,7 @@ Returns multiple values where: (type (complex double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) ((< n 0) (setf info 2)) @@ -10774,7 +15163,9 @@ Returns multiple values where: (setf info 5))) (cond ((/= info 0) - (xerbla "ZHPR " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZHPR" info) (go end_label))) (if (or (= n 0) (= alpha (coerce (realpart zero) 'double-float))) (go end_label)) @@ -10788,7 +15179,7 @@ Returns multiple values where: (setf kx 1))) (setf kk 1) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -11088,32 +15479,160 @@ Returns multiple values where: end_label (return (values 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::zhpr fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (double-float) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*))) -; :return-values '(nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ztbmv BLAS} %\pagehead{ztbmv}{ztbmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ztbmv.output +)spool ztbmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ztbmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZTBMV - perform one of the matrix-vector operations x := + A*x, or x := A'*x, or x := conjg( A' )*x, + + SYNOPSIS + SUBROUTINE ZTBMV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX + ) + + INTEGER INCX, K, LDA, N + + CHARACTER*1 DIAG, TRANS, UPLO + + COMPLEX*16 A( LDA, * ), X( * ) + + PURPOSE + ZTBMV performs one of the matrix-vector operations + + where x is an n element vector and A is an n by n unit, or + non-unit, upper or lower triangular band matrix, with ( k + + 1 ) diagonals. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' x := A*x. + + TRANS = 'T' or 't' x := A'*x. + + TRANS = 'C' or 'c' x := conjg( A' )*x. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry with UPLO = 'U' or 'u', K specifies the + number of super-diagonals of the matrix A. On entry + with UPLO = 'L' or 'l', K specifies the number of + sub-diagonals of the matrix A. K must satisfy 0 + .le. K. Unchanged on exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading ( k + + 1 ) by n part of the array A must contain the upper + triangular band part of the matrix of coefficients, + supplied column by column, with the leading diagonal + of the matrix in row ( k + 1 ) of the array, the + first super-diagonal starting at position 2 in row k, + and so on. The top left k by k triangle of the array + A is not referenced. The following program segment + will transfer an upper triangular band matrix from + conventional full matrix storage to band storage: + + DO 20, J = 1, N M = K + 1 - J DO 10, I = MAX( 1, J - + K ), J A( M + I, J ) = matrix( I, J ) 10 CONTINUE + 20 CONTINUE + + Before entry with UPLO = 'L' or 'l', the leading ( k + + 1 ) by n part of the array A must contain the lower + triangular band part of the matrix of coefficients, + supplied column by column, with the leading diagonal + of the matrix in row 1 of the array, the first sub- + diagonal starting at position 1 in row 2, and so on. + The bottom right k by k triangle of the array A is + not referenced. The following program segment will + transfer a lower triangular band matrix from conven- + tional full matrix storage to band storage: + + DO 20, J = 1, N M = 1 - J DO 10, I = J, MIN( N, J + K + ) A( M + I, J ) = matrix( I, J ) 10 CONTINUE 20 + CONTINUE + + Note that when DIAG = 'U' or 'u' the elements of the + array A corresponding to the diagonal elements of the + matrix are not referenced, but are assumed to be + unity. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least ( k + 1 ). Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. On exit, X is overwritten with the transformed + vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) (defun ztbmv (uplo trans diag n k a lda x incx) (declare (type (array (complex double-float) (*)) x a) (type fixnum incx lda k n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -11127,13 +15646,13 @@ Returns multiple values where: (type (complex double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -11145,11 +15664,13 @@ Returns multiple values where: (setf info 9))) (cond ((/= info 0) - (xerbla "ZTBMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZTBMV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf noconj (lsame trans "T")) - (setf nounit (lsame diag "N")) + (setf noconj (char-equal trans #\T)) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -11159,9 +15680,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kplus1 (f2cl-lib:int-add k 1)) (cond ((= incx 1) @@ -11384,7 +15905,7 @@ Returns multiple values where: (setf kx (f2cl-lib:int-sub kx incx)))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kplus1 (f2cl-lib:int-add k 1)) (cond ((= incx 1) @@ -11701,35 +16222,165 @@ Returns multiple values where: end_label (return (values 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::ztbmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ztbsv BLAS} %\pagehead{ztbsv}{ztbsv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ztbsv.output +)spool ztbsv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ztbsv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZTBSV - solve one of the systems of equations A*x = b, or + A'*x = b, or conjg( A' )*x = b, + + SYNOPSIS + SUBROUTINE ZTBSV ( UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX + ) + + INTEGER INCX, K, LDA, N + + CHARACTER*1 DIAG, TRANS, UPLO + + COMPLEX*16 A( LDA, * ), X( * ) + + PURPOSE + ZTBSV solves one of the systems of equations + + where b and x are n element vectors and A is an n by n unit, + or non-unit, upper or lower triangular band matrix, with ( k + + 1 ) diagonals. + + No test for singularity or near-singularity is included in + this routine. Such tests must be performed before calling + this routine. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the equations to be solved + as follows: + + TRANS = 'N' or 'n' A*x = b. + + TRANS = 'T' or 't' A'*x = b. + + TRANS = 'C' or 'c' conjg( A' )*x = b. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry with UPLO = 'U' or 'u', K specifies the + number of super-diagonals of the matrix A. On entry + with UPLO = 'L' or 'l', K specifies the number of + sub-diagonals of the matrix A. K must satisfy 0 + .le. K. Unchanged on exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading ( k + + 1 ) by n part of the array A must contain the upper + triangular band part of the matrix of coefficients, + supplied column by column, with the leading diagonal + of the matrix in row ( k + 1 ) of the array, the + first super-diagonal starting at position 2 in row k, + and so on. The top left k by k triangle of the array + A is not referenced. The following program segment + will transfer an upper triangular band matrix from + conventional full matrix storage to band storage: + + DO 20, J = 1, N M = K + 1 - J DO 10, I = MAX( 1, J - + K ), J A( M + I, J ) = matrix( I, J ) 10 CONTINUE + 20 CONTINUE + + Before entry with UPLO = 'L' or 'l', the leading ( k + + 1 ) by n part of the array A must contain the lower + triangular band part of the matrix of coefficients, + supplied column by column, with the leading diagonal + of the matrix in row 1 of the array, the first sub- + diagonal starting at position 1 in row 2, and so on. + The bottom right k by k triangle of the array A is + not referenced. The following program segment will + transfer a lower triangular band matrix from conven- + tional full matrix storage to band storage: + + DO 20, J = 1, N M = 1 - J DO 10, I = J, MIN( N, J + K + ) A( M + I, J ) = matrix( I, J ) 10 CONTINUE 20 + CONTINUE + + Note that when DIAG = 'U' or 'u' the elements of the + array A corresponding to the diagonal elements of the + + matrix are not referenced, but are assumed to be + unity. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least ( k + 1 ). Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element + right-hand side vector b. On exit, X is overwritten + with the solution vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) (defun ztbsv (uplo trans diag n k a lda x incx) (declare (type (array (complex double-float) (*)) x a) (type fixnum incx lda k n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -11743,13 +16394,13 @@ Returns multiple values where: (type (complex double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -11761,11 +16412,13 @@ Returns multiple values where: (setf info 9))) (cond ((/= info 0) - (xerbla "ZTBSV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZTBSV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf noconj (lsame trans "T")) - (setf nounit (lsame diag "N")) + (setf noconj (char-equal trans #\T)) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -11775,9 +16428,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kplus1 (f2cl-lib:int-add k 1)) (cond ((= incx 1) @@ -11999,7 +16652,7 @@ Returns multiple values where: (setf jx (f2cl-lib:int-add jx incx))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kplus1 (f2cl-lib:int-add k 1)) (cond ((= incx 1) @@ -12317,35 +16970,127 @@ Returns multiple values where: end_label (return (values 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::ztbsv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ztpmv BLAS} %\pagehead{ztpmv}{ztpmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ztpmv.output +)spool ztpmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ztpmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZTPMV - perform one of the matrix-vector operations x := + A*x, or x := A'*x, or x := conjg( A' )*x, + + SYNOPSIS + SUBROUTINE ZTPMV ( UPLO, TRANS, DIAG, N, AP, X, INCX ) + + INTEGER INCX, N + + CHARACTER*1 DIAG, TRANS, UPLO + + COMPLEX*16 AP( * ), X( * ) + + PURPOSE + ZTPMV performs one of the matrix-vector operations + + where x is an n element vector and A is an n by n unit, or + non-unit, upper or lower triangular matrix, supplied in + packed form. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' x := A*x. + + TRANS = 'T' or 't' x := A'*x. + + TRANS = 'C' or 'c' x := conjg( A' )*x. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit + + triangular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + AP - COMPLEX*16 array of DIMENSION at least + ( ( n*( n + 1 ) )/2 ). Before entry with UPLO = 'U' + or 'u', the array AP must contain the upper triangu- + lar matrix packed sequentially, column by column, so + that AP( 1 ) contains a( 1, 1 ), AP( 2 ) and AP( 3 ) + contain a( 1, 2 ) and a( 2, 2 ) respectively, and so + on. Before entry with UPLO = 'L' or 'l', the array + AP must contain the lower triangular matrix packed + sequentially, column by column, so that AP( 1 ) con- + tains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 + ) and a( 3, 1 ) respectively, and so on. Note that + when DIAG = 'U' or 'u', the diagonal elements of A + are not referenced, but are assumed to be unity. + Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. On exit, X is overwritten with the transformed + vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) (defun ztpmv (uplo trans diag n ap x incx) (declare (type (array (complex double-float) (*)) x ap) (type fixnum incx n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -12359,13 +17104,13 @@ Returns multiple values where: (type (complex double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -12373,11 +17118,13 @@ Returns multiple values where: (setf info 7))) (cond ((/= info 0) - (xerbla "ZTPMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZTPMV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf noconj (lsame trans "T")) - (setf nounit (lsame diag "N")) + (setf noconj (char-equal trans #\T)) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -12387,9 +17134,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kk 1) (cond ((= incx 1) @@ -12618,7 +17365,7 @@ Returns multiple values where: 1)))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kk (the fixnum (truncate (* n (+ n 1)) 2))) (cond ((= incx 1) @@ -12919,34 +17666,130 @@ Returns multiple values where: end_label (return (values 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::ztpmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum -; (array (complex double-float) (*)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ztpsv BLAS} %\pagehead{ztpsv}{ztpsv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ztpsv.output +)spool ztpsv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ztpsv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZTPSV - solve one of the systems of equations A*x = b, or + A'*x = b, or conjg( A' )*x = b, + + SYNOPSIS + SUBROUTINE ZTPSV ( UPLO, TRANS, DIAG, N, AP, X, INCX ) + + INTEGER INCX, N + + CHARACTER*1 DIAG, TRANS, UPLO + + COMPLEX*16 AP( * ), X( * ) + + PURPOSE + ZTPSV solves one of the systems of equations + + where b and x are n element vectors and A is an n by n unit, + or non-unit, upper or lower triangular matrix, supplied in + packed form. + + No test for singularity or near-singularity is included in + this routine. Such tests must be performed before calling + this routine. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the equations to be solved + as follows: + + TRANS = 'N' or 'n' A*x = b. + + TRANS = 'T' or 't' A'*x = b. + + TRANS = 'C' or 'c' conjg( A' )*x = b. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + AP - COMPLEX*16 array of DIMENSION at least + ( ( n*( n + 1 ) )/2 ). Before entry with UPLO = 'U' + or 'u', the array AP must contain the upper triangu- + lar matrix packed sequentially, column by column, so + that AP( 1 ) contains a( 1, 1 ), AP( 2 ) and AP( 3 ) + contain a( 1, 2 ) and a( 2, 2 ) respectively, and so + on. Before entry with UPLO = 'L' or 'l', the array + AP must contain the lower triangular matrix packed + sequentially, column by column, so that AP( 1 ) con- + tains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 + ) and a( 3, 1 ) respectively, and so on. Note that + when DIAG = 'U' or 'u', the diagonal elements of A + are not referenced, but are assumed to be unity. + Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element + right-hand side vector b. On exit, X is overwritten + with the solution vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) (defun ztpsv (uplo trans diag n ap x incx) (declare (type (array (complex double-float) (*)) x ap) (type fixnum incx n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -12960,13 +17803,13 @@ Returns multiple values where: (type (complex double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -12974,11 +17817,13 @@ Returns multiple values where: (setf info 7))) (cond ((/= info 0) - (xerbla "ZTPSV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZTPSV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf noconj (lsame trans "T")) - (setf nounit (lsame diag "N")) + (setf noconj (char-equal trans #\T)) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -12988,9 +17833,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kk (the fixnum (truncate (* n (+ n 1)) 2))) (cond ((= incx 1) @@ -13208,7 +18053,7 @@ Returns multiple values where: 1)))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (setf kk 1) (cond ((= incx 1) @@ -13534,34 +18379,128 @@ Returns multiple values where: end_label (return (values 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::ztpsv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum -; (array (complex double-float) (*)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ztrmv BLAS} %\pagehead{ztrmv}{ztrmv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ztrmv.output +)spool ztrmv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ztrmv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZTRMV - perform one of the matrix-vector operations x := + A*x, or x := A'*x, or x := conjg( A' )*x, + + SYNOPSIS + SUBROUTINE ZTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX ) + + INTEGER INCX, LDA, N + + CHARACTER*1 DIAG, TRANS, UPLO + + COMPLEX*16 A( LDA, * ), X( * ) + + PURPOSE + ZTRMV performs one of the matrix-vector operations + + where x is an n element vector and A is an n by n unit, or + non-unit, upper or lower triangular matrix. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' x := A*x. + + TRANS = 'T' or 't' x := A'*x. + + TRANS = 'C' or 'c' x := conjg( A' )*x. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading n + by n upper triangular part of the array A must con- + tain the upper triangular matrix and the strictly + lower triangular part of A is not referenced. Before + entry with UPLO = 'L' or 'l', the leading n by n + lower triangular part of the array A must contain the + lower triangular matrix and the strictly upper tri- + angular part of A is not referenced. Note that when + DIAG = 'U' or 'u', the diagonal elements of A are not + referenced either, but are assumed to be unity. + Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, n ). Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element vector + x. On exit, X is overwritten with the transformed + vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) (defun ztrmv (uplo trans diag n a lda x incx) (declare (type (array (complex double-float) (*)) x a) (type fixnum incx lda n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -13575,13 +18514,13 @@ Returns multiple values where: (type (complex double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -13591,11 +18530,13 @@ Returns multiple values where: (setf info 8))) (cond ((/= info 0) - (xerbla "ZTRMV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZTRMV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf noconj (lsame trans "T")) - (setf nounit (lsame diag "N")) + (setf noconj (char-equal trans #\T)) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -13605,9 +18546,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -13800,7 +18741,7 @@ Returns multiple values where: (setf jx (f2cl-lib:int-sub jx incx))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) @@ -14061,35 +19002,133 @@ Returns multiple values where: end_label (return (values 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::ztrmv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ztrsv BLAS} %\pagehead{ztrsv}{ztrsv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ztrsv.output +)spool ztrsv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ztrsv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZTRSV - solve one of the systems of equations A*x = b, or + A'*x = b, or conjg( A' )*x = b, + + SYNOPSIS + SUBROUTINE ZTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX ) + + INTEGER INCX, LDA, N + + CHARACTER*1 DIAG, TRANS, UPLO + + COMPLEX*16 A( LDA, * ), X( * ) + + PURPOSE + ZTRSV solves one of the systems of equations + + where b and x are n element vectors and A is an n by n unit, + or non-unit, upper or lower triangular matrix. + + No test for singularity or near-singularity is included in + this routine. Such tests must be performed before calling + this routine. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the equations to be solved + as follows: + + TRANS = 'N' or 'n' A*x = b. + + TRANS = 'T' or 't' A'*x = b. + + TRANS = 'C' or 'c' conjg( A' )*x = b. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit + + triangular. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix A. N + must be at least zero. Unchanged on exit. + + A - COMPLEX*16 array of DIMENSION ( LDA, n ). + Before entry with UPLO = 'U' or 'u', the leading n + by n upper triangular part of the array A must con- + tain the upper triangular matrix and the strictly + lower triangular part of A is not referenced. Before + entry with UPLO = 'L' or 'l', the leading n by n + lower triangular part of the array A must contain the + lower triangular matrix and the strictly upper tri- + angular part of A is not referenced. Note that when + DIAG = 'U' or 'u', the diagonal elements of A are not + referenced either, but are assumed to be unity. + Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. LDA must be at + least max( 1, n ). Unchanged on exit. + + X - COMPLEX*16 array of dimension at least + ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the + incremented array X must contain the n element + right-hand side vector b. On exit, X is overwritten + with the solution vector x. + + INCX - INTEGER. + On entry, INCX specifies the increment for the ele- + ments of X. INCX must not be zero. Unchanged on + exit. + +@ + <>= (let* ((zero (complex 0.0 0.0))) (declare (type (complex double-float) zero)) (defun ztrsv (uplo trans diag n a lda x incx) (declare (type (array (complex double-float) (*)) x a) (type fixnum incx lda n) - (type (simple-array character (*)) diag trans uplo)) + (type character diag trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -14103,13 +19142,13 @@ Returns multiple values where: (type (complex double-float) temp)) (setf info 0) (cond - ((and (not (lsame uplo "U")) (not (lsame uplo "L"))) + ((and (not (char-equal uplo #\U)) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 3)) ((< n 0) (setf info 4)) @@ -14119,11 +19158,13 @@ Returns multiple values where: (setf info 8))) (cond ((/= info 0) - (xerbla "ZTRSV " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZTRSV" info) (go end_label))) (if (= n 0) (go end_label)) - (setf noconj (lsame trans "T")) - (setf nounit (lsame diag "N")) + (setf noconj (char-equal trans #\T)) + (setf nounit (char-equal diag #\N)) (cond ((<= incx 0) (setf kx @@ -14133,9 +19174,9 @@ Returns multiple values where: ((/= incx 1) (setf kx 1))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) @@ -14325,7 +19366,7 @@ Returns multiple values where: (setf jx (f2cl-lib:int-add jx incx))))))))) (t (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (cond ((= incx 1) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -14591,22 +19632,6 @@ Returns multiple values where: end_label (return (values 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::ztrsv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{BLAS Level 3} @@ -14615,6 +19640,152 @@ Returns multiple values where: %\pagehead{dgemm}{dgemm} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgemm.output +)spool dgemm.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgemm examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DGEMM - perform one of the matrix-matrix operations C := + alpha*op( A )*op( B ) + beta*C, + + SYNOPSIS + SUBROUTINE DGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, + B, LDB, BETA, C, LDC ) + + CHARACTER*1 TRANSA, TRANSB + + INTEGER M, N, K, LDA, LDB, LDC + + DOUBLE PRECISION ALPHA, BETA + + DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, + * ) + + PURPOSE + DGEMM performs one of the matrix-matrix operations + + where op( X ) is one of + + op( X ) = X or op( X ) = X', + + alpha and beta are scalars, and A, B and C are matrices, + with op( A ) an m by k matrix, op( B ) a k by n matrix + and C an m by n matrix. + + PARAMETERS + TRANSA - CHARACTER*1. On entry, TRANSA specifies the form + of op( A ) to be used in the matrix multiplication as fol- + lows: + + TRANSA = 'N' or 'n', op( A ) = A. + + TRANSA = 'T' or 't', op( A ) = A'. + + TRANSA = 'C' or 'c', op( A ) = A'. + + Unchanged on exit. + + TRANSB - CHARACTER*1. On entry, TRANSB specifies the form + of op( B ) to be used in the matrix multiplication as fol- + lows: + + TRANSB = 'N' or 'n', op( B ) = B. + + TRANSB = 'T' or 't', op( B ) = B'. + + TRANSB = 'C' or 'c', op( B ) = B'. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of the + matrix op( A ) and of the matrix C. M must be + at least zero. Unchanged on exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix op( B ) and the number of columns of the + matrix C. N must be at least zero. Unchanged on + exit. + + K - INTEGER. + On entry, K specifies the number of columns of the + matrix op( A ) and the number of rows of the matrix + op( B ). K must be at least zero. Unchanged on + exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + ka is + A - + DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where + k when TRANSA = 'N' or 'n', and is m otherwise. + Before entry with TRANSA = 'N' or 'n', the leading + m by k part of the array A must contain the matrix + A, otherwise the leading k by m part of the array + A must contain the matrix A. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When TRANSA = + 'N' or 'n' then LDA must be at least max( 1, m ), + otherwise LDA must be at least max( 1, k ). + Unchanged on exit. + + kb is + B - + DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where + n when TRANSB = 'N' or 'n', and is k otherwise. + Before entry with TRANSB = 'N' or 'n', the leading + k by n part of the array B must contain the matrix + B, otherwise the leading n by k part of the array + B must contain the matrix B. Unchanged on exit. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. When TRANSB = + 'N' or 'n' then LDB must be at least max( 1, k ), + + otherwise LDB must be at least max( 1, n ). + Unchanged on exit. + + BETA - DOUBLE PRECISION. + On entry, BETA specifies the scalar beta. When + BETA is supplied as zero then C need not be set on + input. Unchanged on exit. + + C - DOUBLE PRECISION array of DIMENSION ( LDC, n ). + Before entry, the leading m by n part of the array + C must contain the matrix C, except when beta is + zero, in which case C need not be set on entry. On + exit, the array C is overwritten by the m by n + matrix ( alpha*op( A )*op( B ) + beta*C ). + + LDC - INTEGER. + On entry, LDC specifies the first dimension of C as + declared in the calling (sub) program. LDC + must be at least max( 1, m ). Unchanged on exit. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -14623,7 +19794,7 @@ Returns multiple values where: (declare (type (array double-float (*)) c b a) (type (double-float) beta alpha) (type fixnum ldc ldb$ lda k n m) - (type (simple-array character (*)) transb transa)) + (type character transb transa)) (f2cl-lib:with-multi-array-data ((transa character transa-%data% transa-%offset%) (transb character transb-%data% transb-%offset%) @@ -14635,8 +19806,8 @@ Returns multiple values where: (declare (type (double-float) temp) (type fixnum i info j l ncola nrowa nrowb) (type (member t nil) nota notb)) - (setf nota (lsame transa "N")) - (setf notb (lsame transb "N")) + (setf nota (char-equal transa #\N)) + (setf notb (char-equal transb #\N)) (cond (nota (setf nrowa m) @@ -14651,9 +19822,9 @@ Returns multiple values where: (setf nrowb n))) (setf info 0) (cond - ((and (not nota) (not (lsame transa "C")) (not (lsame transa "T"))) + ((and (not nota) (not (char-equal transa #\C)) (not (char-equal transa #\T))) (setf info 1)) - ((and (not notb) (not (lsame transb "C")) (not (lsame transb "T"))) + ((and (not notb) (not (char-equal transb #\C)) (not (char-equal transb #\T))) (setf info 2)) ((< m 0) (setf info 3)) @@ -14670,7 +19841,9 @@ Returns multiple values where: (setf info 13))) (cond ((/= info 0) - (xerbla "DGEMM " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEMM" info) (go end_label))) (if (or (= m 0) (= n 0) (and (or (= alpha zero) (= k 0)) (= beta one))) (go end_label)) @@ -14905,29 +20078,163 @@ Returns multiple values where: (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::dgemm fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; fixnum (double-float) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; (double-float) (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil -; nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dsymm BLAS} %\pagehead{dsymm}{dsymm} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dsymm.output +)spool dsymm.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dsymm examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DSYMM - perform one of the matrix-matrix operations C := + alpha*A*B + beta*C, + + SYNOPSIS + SUBROUTINE DSYMM ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, + BETA, C, LDC ) + + CHARACTER*1 SIDE, UPLO + + INTEGER M, N, LDA, LDB, LDC + + DOUBLE PRECISION ALPHA, BETA + + DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, + * ) + + PURPOSE + DSYMM performs one of the matrix-matrix operations + + or + + C := alpha*B*A + beta*C, + + where alpha and beta are scalars, A is a symmetric matrix + and B and C are m by n matrices. + + PARAMETERS + SIDE - CHARACTER*1. + On entry, SIDE specifies whether the symmetric + matrix A appears on the left or right in the + operation as follows: + + SIDE = 'L' or 'l' C := alpha*A*B + beta*C, + + SIDE = 'R' or 'r' C := alpha*B*A + beta*C, + + Unchanged on exit. + + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or + lower triangular part of the symmetric matrix + A is to be referenced as follows: + + UPLO = 'U' or 'u' Only the upper triangular part of + the symmetric matrix is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part of + the symmetric matrix is to be referenced. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of the + matrix C. M must be at least zero. Unchanged on + exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix C. N must be at least zero. Unchanged on + exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + ka is + A - + DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where + m when SIDE = 'L' or 'l' and is n otherwise. + Before entry with SIDE = 'L' or 'l', the m by m + part of the array A must contain the symmetric + matrix, such that when UPLO = 'U' or 'u', the lead- + ing m by m upper triangular part of the array A + must contain the upper triangular part of the sym- + metric matrix and the strictly lower triangular + part of A is not referenced, and when UPLO = 'L' + or 'l', the leading m by m lower triangular part + of the array A must contain the lower triangular + part of the symmetric matrix and the strictly + upper triangular part of A is not referenced. + Before entry with SIDE = 'R' or 'r', the n by n + part of the array A must contain the symmetric + matrix, such that when UPLO = 'U' or 'u', the lead- + ing n by n upper triangular part of the array A + must contain the upper triangular part of the sym- + metric matrix and the strictly lower triangular + part of A is not referenced, and when UPLO = 'L' + or 'l', the leading n by n lower triangular part + of the array A must contain the lower triangular + part of the symmetric matrix and the strictly + upper triangular part of A is not referenced. + Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When SIDE = + 'L' or 'l' then LDA must be at least max( 1, m ), + otherwise LDA must be at least max( 1, n ). + Unchanged on exit. + + B - DOUBLE PRECISION array of DIMENSION ( LDB, n ). + Before entry, the leading m by n part of the array + B must contain the matrix B. Unchanged on exit. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. LDB + must be at least max( 1, m ). Unchanged on exit. + + BETA - DOUBLE PRECISION. + On entry, BETA specifies the scalar beta. When + BETA is supplied as zero then C need not be set on + input. Unchanged on exit. + + C - DOUBLE PRECISION array of DIMENSION ( LDC, n ). + Before entry, the leading m by n part of the array + C must contain the matrix C, except when beta is + zero, in which case C need not be set on entry. On + exit, the array C is overwritten by the m by n + updated matrix. + + LDC - INTEGER. + On entry, LDC specifies the first dimension of C as + declared in the calling (sub) program. LDC + must be at least max( 1, m ). Unchanged on exit. + + Level 3 Blas routine. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -14936,7 +20243,7 @@ Returns multiple values where: (declare (type (array double-float (*)) c b a) (type (double-float) beta alpha) (type fixnum ldc ldb$ lda n m) - (type (simple-array character (*)) uplo side)) + (type character uplo side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (uplo character uplo-%data% uplo-%offset%) @@ -14949,16 +20256,16 @@ Returns multiple values where: (type fixnum i info j k nrowa) (type (member t nil) upper)) (cond - ((lsame side "L") + ((char-equal side #\L) (setf nrowa m)) (t (setf nrowa n))) - (setf upper (lsame uplo "U")) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not (lsame side "L")) (not (lsame side "R"))) + ((and (not (char-equal side #\L)) (not (char-equal side #\R))) (setf info 1)) - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 2)) ((< m 0) (setf info 3)) @@ -14972,7 +20279,9 @@ Returns multiple values where: (setf info 12))) (cond ((/= info 0) - (xerbla "DSYMM " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DSYMM" info) (go end_label))) (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) @@ -15009,7 +20318,7 @@ Returns multiple values where: c-%offset%))))))))) (go end_label))) (cond - ((lsame side "L") + ((char-equal side #\L) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -15277,27 +20586,163 @@ Returns multiple values where: 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)) -; fixnum fixnum -; (double-float) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (double-float) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dsyr2k BLAS} %\pagehead{dsyr2k}{dsyr2k} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dsyr2k.output +)spool dsyr2k.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dsyr2k examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DSYR2K - perform one of the symmetric rank 2k operations C + := alpha*A*B' + alpha*B*A' + beta*C, + + SYNOPSIS + SUBROUTINE DSYR2K( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, + BETA, C, LDC ) + + CHARACTER*1 UPLO, TRANS + + INTEGER N, K, LDA, LDB, LDC + + DOUBLE PRECISION ALPHA, BETA + + DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( + LDC, * ) + + PURPOSE + DSYR2K performs one of the symmetric rank 2k operations + + or + + C := alpha*A'*B + alpha*B'*A + beta*C, + + where alpha and beta are scalars, C is an n by n sym- + metric matrix and A and B are n by k matrices in the + first case and k by n matrices in the second case. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or + lower triangular part of the array C is to be + referenced as follows: + + UPLO = 'U' or 'u' Only the upper triangular part + of C is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part + of C is to be referenced. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' C := alpha*A*B' + alpha*B*A' + + beta*C. + + TRANS = 'T' or 't' C := alpha*A'*B + alpha*B'*A + + beta*C. + + TRANS = 'C' or 'c' C := alpha*A'*B + alpha*B'*A + + beta*C. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix C. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry with TRANS = 'N' or 'n', K specifies the + number of columns of the matrices A and B, and + on entry with TRANS = 'T' or 't' or 'C' or 'c', K + specifies the number of rows of the matrices A and + B. K must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + ka is + A - + DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where + k when TRANS = 'N' or 'n', and is n otherwise. + Before entry with TRANS = 'N' or 'n', the leading + n by k part of the array A must contain the matrix + A, otherwise the leading k by n part of the array + A must contain the matrix A. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When + TRANS = 'N' or 'n' then LDA must be at least max( + 1, n ), otherwise LDA must be at least max( 1, k ). + Unchanged on exit. + + kb is + B - + DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where + k when TRANS = 'N' or 'n', and is n otherwise. + Before entry with TRANS = 'N' or 'n', the leading + n by k part of the array B must contain the matrix + B, otherwise the leading k by n part of the array + B must contain the matrix B. Unchanged on exit. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. When + TRANS = 'N' or 'n' then LDB must be at least max( + 1, n ), otherwise LDB must be at least max( 1, k ). + Unchanged on exit. + + BETA - DOUBLE PRECISION. + On entry, BETA specifies the scalar beta. Unchanged + on exit. + + C - DOUBLE PRECISION array of DIMENSION ( LDC, n ). + Before entry with UPLO = 'U' or 'u', the leading + n by n upper triangular part of the array C must con- + tain the upper triangular part of the symmetric + matrix and the strictly lower triangular part of C + is not referenced. On exit, the upper triangular + part of the array C is overwritten by the upper tri- + angular part of the updated matrix. Before entry + with UPLO = 'L' or 'l', the leading n by n lower + triangular part of the array C must contain the lower + triangular part of the symmetric matrix and the + strictly upper triangular part of C is not refer- + enced. On exit, the lower triangular part of the + array C is overwritten by the lower triangular part + of the updated matrix. + + LDC - INTEGER. + On entry, LDC specifies the first dimension of C as + declared in the calling (sub) program. LDC + must be at least max( 1, n ). Unchanged on exit. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -15306,7 +20751,7 @@ Returns multiple values where: (declare (type (array double-float (*)) c b a) (type (double-float) beta alpha) (type fixnum ldc ldb$ lda k n) - (type (simple-array character (*)) trans uplo)) + (type character trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -15319,18 +20764,18 @@ Returns multiple values where: (type fixnum i info j l nrowa) (type (member t nil) upper)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf nrowa n)) (t (setf nrowa k))) - (setf upper (lsame uplo "U")) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) ((< n 0) (setf info 3)) @@ -15345,7 +20790,9 @@ Returns multiple values where: (setf info 12))) (cond ((/= info 0) - (xerbla "DSYR2K" info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DSYR2K" info) (go end_label))) (if (or (= n 0) (and (or (= alpha zero) (= k 0)) (= beta one))) (go end_label)) @@ -15414,7 +20861,7 @@ Returns multiple values where: c-%offset%))))))))))) (go end_label))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -15667,28 +21114,143 @@ Returns multiple values where: 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::dsyr2k -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (double-float) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (double-float) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dsyrk BLAS} %\pagehead{dsyrk}{dsyrk} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dsyrk.output +)spool dsyrk.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dsyrk examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DSYRK - perform one of the symmetric rank k operations C + := alpha*A*A' + beta*C, + + SYNOPSIS + SUBROUTINE DSYRK ( UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, + C, LDC ) + + CHARACTER*1 UPLO, TRANS + + INTEGER N, K, LDA, LDC + + DOUBLE PRECISION ALPHA, BETA + + DOUBLE PRECISION A( LDA, * ), C( LDC, * ) + + PURPOSE + DSYRK performs one of the symmetric rank k operations + + or + + C := alpha*A'*A + beta*C, + + where alpha and beta are scalars, C is an n by n sym- + metric matrix and A is an n by k matrix in the first + case and a k by n matrix in the second case. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or + lower triangular part of the array C is to be + referenced as follows: + + UPLO = 'U' or 'u' Only the upper triangular part + of C is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part + of C is to be referenced. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' C := alpha*A*A' + beta*C. + + TRANS = 'T' or 't' C := alpha*A'*A + beta*C. + + TRANS = 'C' or 'c' C := alpha*A'*A + beta*C. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix C. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry with TRANS = 'N' or 'n', K specifies the + number of columns of the matrix A, and on + entry with TRANS = 'T' or 't' or 'C' or 'c', K + specifies the number of rows of the matrix A. K + must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + ka is + A - + DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where + k when TRANS = 'N' or 'n', and is n otherwise. + Before entry with TRANS = 'N' or 'n', the leading + n by k part of the array A must contain the matrix + A, otherwise the leading k by n part of the array + A must contain the matrix A. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When + TRANS = 'N' or 'n' then LDA must be at least max( + 1, n ), otherwise LDA must be at least max( 1, k ). + Unchanged on exit. + + BETA - DOUBLE PRECISION. + On entry, BETA specifies the scalar beta. Unchanged + on exit. + + C - DOUBLE PRECISION array of DIMENSION ( LDC, n ). + Before entry with UPLO = 'U' or 'u', the leading + n by n upper triangular part of the array C must con- + tain the upper triangular part of the symmetric + matrix and the strictly lower triangular part of C + is not referenced. On exit, the upper triangular + part of the array C is overwritten by the upper tri- + angular part of the updated matrix. Before entry + with UPLO = 'L' or 'l', the leading n by n lower + triangular part of the array C must contain the lower + triangular part of the symmetric matrix and the + strictly upper triangular part of C is not refer- + enced. On exit, the lower triangular part of the + array C is overwritten by the lower triangular part + of the updated matrix. + + LDC - INTEGER. + On entry, LDC specifies the first dimension of C as + declared in the calling (sub) program. LDC + must be at least max( 1, n ). Unchanged on exit. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -15697,7 +21259,7 @@ Returns multiple values where: (declare (type (array double-float (*)) c a) (type (double-float) beta alpha) (type fixnum ldc lda k n) - (type (simple-array character (*)) trans uplo)) + (type character trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -15708,18 +21270,18 @@ Returns multiple values where: (type fixnum i info j l nrowa) (type (member t nil) upper)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf nrowa n)) (t (setf nrowa k))) - (setf upper (lsame uplo "U")) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) - (not (lsame trans "T")) - (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) + (not (char-equal trans #\T)) + (not (char-equal trans #\C))) (setf info 2)) ((< n 0) (setf info 3)) @@ -15731,7 +21293,9 @@ Returns multiple values where: (setf info 10))) (cond ((/= info 0) - (xerbla "DSYRK " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DSYRK" info) (go end_label))) (if (or (= n 0) (and (or (= alpha zero) (= k 0)) (= beta one))) (go end_label)) @@ -15800,7 +21364,7 @@ Returns multiple values where: c-%offset%))))))))))) (go end_label))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -15997,26 +21561,151 @@ Returns multiple values where: end_label (return (values 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::dsyrk fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (double-float) (array double-float (*)) -; fixnum (double-float) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dtrmm BLAS} %\pagehead{dtrmm}{dtrmm} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dtrmm.output +)spool dtrmm.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dtrmm examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DTRMM - perform one of the matrix-matrix operations B := + alpha*op( A )*B, or B := alpha*B*op( A ), + + SYNOPSIS + SUBROUTINE DTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, + LDA, B, LDB ) + + CHARACTER*1 SIDE, UPLO, TRANSA, DIAG + + INTEGER M, N, LDA, LDB + + DOUBLE PRECISION ALPHA + + DOUBLE PRECISION A( LDA, * ), B( LDB, * ) + + PURPOSE + DTRMM performs one of the matrix-matrix operations + + where alpha is a scalar, B is an m by n matrix, A is a + unit, or non-unit, upper or lower triangular matrix and + op( A ) is one of + + op( A ) = A or op( A ) = A'. + + PARAMETERS + SIDE - CHARACTER*1. + On entry, SIDE specifies whether op( A ) multiplies + B from the left or right as follows: + + SIDE = 'L' or 'l' B := alpha*op( A )*B. + + SIDE = 'R' or 'r' B := alpha*B*op( A ). + + Unchanged on exit. + + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix A is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANSA - CHARACTER*1. On entry, TRANSA specifies the + form of op( A ) to be used in the matrix multiplica- + tion as follows: + + TRANSA = 'N' or 'n' op( A ) = A. + + TRANSA = 'T' or 't' op( A ) = A'. + + TRANSA = 'C' or 'c' op( A ) = A'. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of B. M must + be at least zero. Unchanged on exit. + + N - INTEGER. + On entry, N specifies the number of columns of B. N + must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. When + alpha is zero then A is not referenced and B need + not be set before entry. Unchanged on exit. + + is m + A - + DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k + when SIDE = 'L' or 'l' and is n when SIDE = 'R' + or 'r'. Before entry with UPLO = 'U' or 'u', the + leading k by k upper triangular part of the array A + must contain the upper triangular matrix and the + strictly lower triangular part of A is not refer- + enced. Before entry with UPLO = 'L' or 'l', the + leading k by k lower triangular part of the array A + must contain the lower triangular matrix and the + strictly upper triangular part of A is not refer- + enced. Note that when DIAG = 'U' or 'u', the diag- + onal elements of A are not referenced either, but + are assumed to be unity. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When SIDE = + 'L' or 'l' then LDA must be at least max( 1, m ), + when SIDE = 'R' or 'r' then LDA must be at least + + max( 1, n ). Unchanged on exit. + + B - DOUBLE PRECISION array of DIMENSION ( LDB, n ). + Before entry, the leading m by n part of the array + B must contain the matrix B, and on exit is + overwritten by the transformed matrix. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. LDB + must be at least max( 1, m ). Unchanged on exit. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -16025,7 +21714,7 @@ Returns multiple values where: (declare (type (array double-float (*)) b a) (type (double-float) alpha) (type fixnum ldb$ lda n m) - (type (simple-array character (*)) diag transa uplo side)) + (type character diag transa uplo side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (uplo character uplo-%data% uplo-%offset%) @@ -16038,25 +21727,25 @@ Returns multiple values where: (declare (type (double-float) temp) (type fixnum i info j k nrowa) (type (member t nil) lside nounit upper)) - (setf lside (lsame side "L")) + (setf lside (char-equal side #\L)) (cond (lside (setf nrowa m)) (t (setf nrowa n))) - (setf nounit (lsame diag "N")) - (setf upper (lsame uplo "U")) + (setf nounit (char-equal diag #\N)) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not lside) (not (lsame side "R"))) + ((and (not lside) (not (char-equal side #\R))) (setf info 1)) - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 2)) - ((and (not (lsame transa "N")) - (not (lsame transa "T")) - (not (lsame transa "C"))) + ((and (not (char-equal transa #\N)) + (not (char-equal transa #\T)) + (not (char-equal transa #\C))) (setf info 3)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 4)) ((< m 0) (setf info 5)) @@ -16068,7 +21757,9 @@ Returns multiple values where: (setf info 11))) (cond ((/= info 0) - (xerbla "DTRMM " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DTRMM" info) (go end_label))) (if (= n 0) (go end_label)) (cond @@ -16088,7 +21779,7 @@ Returns multiple values where: (cond (lside (cond - ((lsame transa "N") + ((char-equal transa #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -16277,7 +21968,7 @@ Returns multiple values where: (* alpha temp))))))))))) (t (cond - ((lsame transa "N") + ((char-equal transa #\N) (cond (upper (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) @@ -16504,28 +22195,154 @@ Returns multiple values where: end_label (return (values 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::dtrmm fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (double-float) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dtrsm BLAS} %\pagehead{dtrsm}{dtrsm} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dtrsm.output +)spool dtrsm.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dtrsm examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + DTRSM - solve one of the matrix equations op( A )*X = + alpha*B, or X*op( A ) = alpha*B, + + SYNOPSIS + SUBROUTINE DTRSM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, + LDA, B, LDB ) + + CHARACTER*1 SIDE, UPLO, TRANSA, DIAG + + INTEGER M, N, LDA, LDB + + DOUBLE PRECISION ALPHA + + DOUBLE PRECISION A( LDA, * ), B( LDB, * ) + + PURPOSE + DTRSM solves one of the matrix equations + + where alpha is a scalar, X and B are m by n matrices, A is a + unit, or non-unit, upper or lower triangular matrix and + op( A ) is one of + + op( A ) = A or op( A ) = A'. + + The matrix X is overwritten on B. + + PARAMETERS + SIDE - CHARACTER*1. + On entry, SIDE specifies whether op( A ) appears on + the left or right of X as follows: + + SIDE = 'L' or 'l' op( A )*X = alpha*B. + + SIDE = 'R' or 'r' X*op( A ) = alpha*B. + + Unchanged on exit. + + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix A is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANSA - CHARACTER*1. On entry, TRANSA specifies the + form of op( A ) to be used in the matrix multiplica- + tion as follows: + + TRANSA = 'N' or 'n' op( A ) = A. + + TRANSA = 'T' or 't' op( A ) = A'. + + TRANSA = 'C' or 'c' op( A ) = A'. + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of B. M must + be at least zero. Unchanged on exit. + + N - INTEGER. + On entry, N specifies the number of columns of B. N + must be at least zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. When + alpha is zero then A is not referenced and B need + not be set before entry. Unchanged on exit. + + is m + A - + DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k + when SIDE = 'L' or 'l' and is n when SIDE = 'R' + or 'r'. Before entry with UPLO = 'U' or 'u', the + leading k by k upper triangular part of the array A + must contain the upper triangular matrix and the + strictly lower triangular part of A is not refer- + enced. Before entry with UPLO = 'L' or 'l', the + leading k by k lower triangular part of the array A + must contain the lower triangular matrix and the + strictly upper triangular part of A is not refer- + enced. Note that when DIAG = 'U' or 'u', the diag- + onal elements of A are not referenced either, but + are assumed to be unity. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When SIDE = + + 'L' or 'l' then LDA must be at least max( 1, m ), + when SIDE = 'R' or 'r' then LDA must be at least + max( 1, n ). Unchanged on exit. + + B - DOUBLE PRECISION array of DIMENSION ( LDB, n ). + Before entry, the leading m by n part of the array + B must contain the right-hand side matrix B, + and on exit is overwritten by the solution matrix + X. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. LDB + must be at least max( 1, m ). Unchanged on exit. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -16534,7 +22351,7 @@ Returns multiple values where: (declare (type (array double-float (*)) b a) (type (double-float) alpha) (type fixnum ldb$ lda n m) - (type (simple-array character (*)) diag transa uplo side)) + (type character diag transa uplo side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (uplo character uplo-%data% uplo-%offset%) @@ -16547,25 +22364,25 @@ Returns multiple values where: (declare (type (double-float) temp) (type fixnum i info j k nrowa) (type (member t nil) lside nounit upper)) - (setf lside (lsame side "L")) + (setf lside (char-equal side #\L)) (cond (lside (setf nrowa m)) (t (setf nrowa n))) - (setf nounit (lsame diag "N")) - (setf upper (lsame uplo "U")) + (setf nounit (char-equal diag #\N)) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not lside) (not (lsame side "R"))) + ((and (not lside) (not (char-equal side #\R))) (setf info 1)) - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 2)) - ((and (not (lsame transa "N")) - (not (lsame transa "T")) - (not (lsame transa "C"))) + ((and (not (char-equal transa #\N)) + (not (char-equal transa #\T)) + (not (char-equal transa #\C))) (setf info 3)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 4)) ((< m 0) (setf info 5)) @@ -16577,7 +22394,9 @@ Returns multiple values where: (setf info 11))) (cond ((/= info 0) - (xerbla "DTRSM " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DTRSM" info) (go end_label))) (if (= n 0) (go end_label)) (cond @@ -16597,7 +22416,7 @@ Returns multiple values where: (cond (lside (cond - ((lsame transa "N") + ((char-equal transa #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -16809,7 +22628,7 @@ Returns multiple values where: temp)))))))))) (t (cond - ((lsame transa "N") + ((char-equal transa #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -17082,28 +22901,158 @@ Returns multiple values where: end_label (return (values 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::dtrsm fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (double-float) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zgemm BLAS} %\pagehead{zgemm}{zgemm} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zgemm.output +)spool zgemm.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zgemm examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZGEMM - perform one of the matrix-matrix operations C := + alpha*op( A )*op( B ) + beta*C, + + SYNOPSIS + SUBROUTINE ZGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, + B, LDB, BETA, C, LDC ) + + CHARACTER*1 TRANSA, TRANSB + + INTEGER M, N, K, LDA, LDB, LDC + + COMPLEX*16 ALPHA, BETA + + COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ) + + PURPOSE + ZGEMM performs one of the matrix-matrix operations + + where op( X ) is one of + + op( X ) = X or op( X ) = X' or op( X ) = conjg( + X' ), + + alpha and beta are scalars, and A, B and C are matrices, + with op( A ) an m by k matrix, op( B ) a k by n matrix + and C an m by n matrix. + + PARAMETERS + TRANSA - CHARACTER*1. On entry, TRANSA specifies the form + of op( A ) to be used in the matrix multiplication as fol- + lows: + + TRANSA = 'N' or 'n', op( A ) = A. + + TRANSA = 'T' or 't', op( A ) = A'. + + TRANSA = 'C' or 'c', op( A ) = conjg( A' ). + + Unchanged on exit. + + TRANSB - CHARACTER*1. On entry, TRANSB specifies the form + of op( B ) to be used in the matrix multiplication as fol- + lows: + + TRANSB = 'N' or 'n', op( B ) = B. + + TRANSB = 'T' or 't', op( B ) = B'. + + TRANSB = 'C' or 'c', op( B ) = conjg( B' ). + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of the + matrix op( A ) and of the matrix C. M must be + at least zero. Unchanged on exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix op( B ) and the number of columns of the + matrix C. N must be at least zero. Unchanged on + exit. + + K - INTEGER. + On entry, K specifies the number of columns of the + matrix op( A ) and the number of rows of the matrix + op( B ). K must be at least zero. Unchanged on + exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + ka is + A - + COMPLEX*16 array of DIMENSION ( LDA, ka ), where + k when TRANSA = 'N' or 'n', and is m otherwise. + Before entry with TRANSA = 'N' or 'n', the leading + m by k part of the array A must contain the matrix + A, otherwise the leading k by m part of the array + A must contain the matrix A. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When TRANSA = + 'N' or 'n' then LDA must be at least max( 1, m ), + otherwise LDA must be at least max( 1, k ). + Unchanged on exit. + + kb is + B - + COMPLEX*16 array of DIMENSION ( LDB, kb ), where + n when TRANSB = 'N' or 'n', and is k otherwise. + Before entry with TRANSB = 'N' or 'n', the leading + k by n part of the array B must contain the matrix + B, otherwise the leading n by k part of the array + B must contain the matrix B. Unchanged on exit. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. When TRANSB = + 'N' or 'n' then LDB must be at least max( 1, k ), + + otherwise LDB must be at least max( 1, n ). + Unchanged on exit. + + BETA - COMPLEX*16 . + On entry, BETA specifies the scalar beta. When + BETA is supplied as zero then C need not be set on + input. Unchanged on exit. + + C - COMPLEX*16 array of DIMENSION ( LDC, n ). + Before entry, the leading m by n part of the array + C must contain the matrix C, except when beta is + zero, in which case C need not be set on entry. On + exit, the array C is overwritten by the m by n + matrix ( alpha*op( A )*op( B ) + beta*C ). + + LDC - INTEGER. + On entry, LDC specifies the first dimension of C as + declared in the calling (sub) program. LDC + must be at least max( 1, m ). Unchanged on exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -17111,7 +23060,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) c b a) (type (complex double-float) beta alpha) (type fixnum ldc ldb$ lda k n m) - (type (simple-array character (*)) transb transa)) + (type character transb transa)) (f2cl-lib:with-multi-array-data ((transa character transa-%data% transa-%offset%) (transb character transb-%data% transb-%offset%) @@ -17123,10 +23072,10 @@ Returns multiple values where: (declare (type (complex double-float) temp) (type fixnum i info j l ncola nrowa nrowb) (type (member t nil) conja conjb nota notb)) - (setf nota (lsame transa "N")) - (setf notb (lsame transb "N")) - (setf conja (lsame transa "C")) - (setf conjb (lsame transb "C")) + (setf nota (char-equal transa #\N)) + (setf notb (char-equal transb #\N)) + (setf conja (char-equal transa #\C)) + (setf conjb (char-equal transb #\C)) (cond (nota (setf nrowa m) @@ -17141,9 +23090,9 @@ Returns multiple values where: (setf nrowb n))) (setf info 0) (cond - ((and (not nota) (not conja) (not (lsame transa "T"))) + ((and (not nota) (not conja) (not (char-equal transa #\T))) (setf info 1)) - ((and (not notb) (not conjb) (not (lsame transb "T"))) + ((and (not notb) (not conjb) (not (char-equal transb #\T))) (setf info 2)) ((< m 0) (setf info 3)) @@ -17160,7 +23109,9 @@ Returns multiple values where: (setf info 13))) (cond ((/= info 0) - (xerbla "ZGEMM " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZGEMM" info) (go end_label))) (if (or (= m 0) (= n 0) (and (or (= alpha zero) (= k 0)) (= beta one))) (go end_label)) @@ -17620,33 +23571,163 @@ Returns multiple values where: (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)) -; fixnum fixnum -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil -; nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zhemm BLAS} %\pagehead{zhemm}{zhemm} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zhemm.output +)spool zhemm.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zhemm examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZHEMM - perform one of the matrix-matrix operations C := + alpha*A*B + beta*C, + + SYNOPSIS + SUBROUTINE ZHEMM ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, + BETA, C, LDC ) + + CHARACTER*1 SIDE, UPLO + + INTEGER M, N, LDA, LDB, LDC + + COMPLEX*16 ALPHA, BETA + + COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ) + + PURPOSE + ZHEMM performs one of the matrix-matrix operations + + or + + C := alpha*B*A + beta*C, + + where alpha and beta are scalars, A is an hermitian matrix + and B and C are m by n matrices. + + PARAMETERS + SIDE - CHARACTER*1. + On entry, SIDE specifies whether the hermitian + matrix A appears on the left or right in the + operation as follows: + + SIDE = 'L' or 'l' C := alpha*A*B + beta*C, + + SIDE = 'R' or 'r' C := alpha*B*A + beta*C, + + Unchanged on exit. + + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or + lower triangular part of the hermitian matrix + A is to be referenced as follows: + + UPLO = 'U' or 'u' Only the upper triangular part of + the hermitian matrix is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part of + the hermitian matrix is to be referenced. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of the + matrix C. M must be at least zero. Unchanged on + exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix C. N must be at least zero. Unchanged on + exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + ka is + A - + COMPLEX*16 array of DIMENSION ( LDA, ka ), where + m when SIDE = 'L' or 'l' and is n otherwise. + Before entry with SIDE = 'L' or 'l', the m by m + part of the array A must contain the hermitian + matrix, such that when UPLO = 'U' or 'u', the lead- + ing m by m upper triangular part of the array A + must contain the upper triangular part of the hermi- + tian matrix and the strictly lower triangular part + of A is not referenced, and when UPLO = 'L' or + 'l', the leading m by m lower triangular part of + the array A must contain the lower triangular + part of the hermitian matrix and the strictly + upper triangular part of A is not referenced. + Before entry with SIDE = 'R' or 'r', the n by n + part of the array A must contain the hermitian + matrix, such that when UPLO = 'U' or 'u', the lead- + ing n by n upper triangular part of the array A + must contain the upper triangular part of the hermi- + tian matrix and the strictly lower triangular part + of A is not referenced, and when UPLO = 'L' or + 'l', the leading n by n lower triangular part of + the array A must contain the lower triangular + part of the hermitian matrix and the strictly + upper triangular part of A is not referenced. Note + that the imaginary parts of the diagonal elements + need not be set, they are assumed to be zero. + Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When SIDE = + 'L' or 'l' then LDA must be at least max( 1, m ), + otherwise LDA must be at least max( 1, n ). + Unchanged on exit. + + B - COMPLEX*16 array of DIMENSION ( LDB, n ). + + Before entry, the leading m by n part of the array + B must contain the matrix B. Unchanged on exit. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. LDB + must be at least max( 1, m ). Unchanged on exit. + + BETA - COMPLEX*16 . + On entry, BETA specifies the scalar beta. When + BETA is supplied as zero then C need not be set on + input. Unchanged on exit. + + C - COMPLEX*16 array of DIMENSION ( LDC, n ). + Before entry, the leading m by n part of the array + C must contain the matrix C, except when beta is + zero, in which case C need not be set on entry. On + exit, the array C is overwritten by the m by n + updated matrix. + + LDC - INTEGER. + On entry, LDC specifies the first dimension of C as + declared in the calling (sub) program. LDC + must be at least max( 1, m ). Unchanged on exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -17654,7 +23735,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) c b a) (type (complex double-float) beta alpha) (type fixnum ldc ldb$ lda n m) - (type (simple-array character (*)) uplo side)) + (type character uplo side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (uplo character uplo-%data% uplo-%offset%) @@ -17667,16 +23748,16 @@ Returns multiple values where: (type fixnum i info j k nrowa) (type (member t nil) upper)) (cond - ((lsame side "L") + ((char-equal side #\L) (setf nrowa m)) (t (setf nrowa n))) - (setf upper (lsame uplo "U")) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not (lsame side "L")) (not (lsame side "R"))) + ((and (not (char-equal side #\L)) (not (char-equal side #\R))) (setf info 1)) - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 2)) ((< m 0) (setf info 3)) @@ -17690,7 +23771,9 @@ Returns multiple values where: (setf info 12))) (cond ((/= info 0) - (xerbla "ZHEMM " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZHEMM" info) (go end_label))) (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) @@ -17727,7 +23810,7 @@ Returns multiple values where: c-%offset%))))))))) (go end_label))) (cond - ((lsame side "L") + ((char-equal side #\L) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -18003,31 +24086,169 @@ Returns multiple values where: 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::zhemm fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zher2k BLAS} %\pagehead{zher2k}{zher2k} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zher2k.output +)spool zher2k.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zher2k examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZHER2K - perform one of the hermitian rank 2k operations C + := alpha*A*conjg( B' ) + conjg( alpha )*B*conjg( A' ) + + beta*C, + + SYNOPSIS + SUBROUTINE ZHER2K( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, + BETA, C, LDC ) + + CHARACTER*1 UPLO, TRANS + + INTEGER N, K, LDA, LDB, LDC + + DOUBLE PRECISION BETA + + COMPLEX*16 ALPHA + + COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ) + + PURPOSE + ZHER2K performs one of the hermitian rank 2k operations + + or + + C := alpha*conjg( A' )*B + conjg( alpha )*conjg( B' )*A + + beta*C, + + where alpha and beta are scalars with beta real, C is + an n by n hermitian matrix and A and B are n by k + matrices in the first case and k by n matrices in the + second case. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or + lower triangular part of the array C is to be + referenced as follows: + + UPLO = 'U' or 'u' Only the upper triangular part + of C is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part + of C is to be referenced. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' C := alpha*A*conjg( B' ) + + + conjg( alpha )*B*conjg( A' ) + beta*C. + + TRANS = 'C' or 'c' C := alpha*conjg( A' )*B + + conjg( alpha )*conjg( B' )*A + beta*C. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix C. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry with TRANS = 'N' or 'n', K specifies the + number of columns of the matrices A and B, and + on entry with TRANS = 'C' or 'c', K specifies + the number of rows of the matrices A and B. K must + be at least zero. Unchanged on exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + ka is + A - + COMPLEX*16 array of DIMENSION ( LDA, ka ), where + k when TRANS = 'N' or 'n', and is n otherwise. + Before entry with TRANS = 'N' or 'n', the leading + n by k part of the array A must contain the matrix + A, otherwise the leading k by n part of the array + A must contain the matrix A. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When + TRANS = 'N' or 'n' then LDA must be at least max( + 1, n ), otherwise LDA must be at least max( 1, k ). + Unchanged on exit. + + kb is + B - + COMPLEX*16 array of DIMENSION ( LDB, kb ), where + k when TRANS = 'N' or 'n', and is n otherwise. + Before entry with TRANS = 'N' or 'n', the leading + n by k part of the array B must contain the matrix + B, otherwise the leading k by n part of the array + B must contain the matrix B. Unchanged on exit. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. When + TRANS = 'N' or 'n' then LDB must be at least max( + 1, n ), otherwise LDB must be at least max( 1, k ). + + Unchanged on exit. + + BETA - DOUBLE PRECISION. + On entry, BETA specifies the scalar beta. Unchanged + on exit. + + C - COMPLEX*16 array of DIMENSION ( LDC, n ). + Before entry with UPLO = 'U' or 'u', the leading + n by n upper triangular part of the array C must con- + tain the upper triangular part of the hermitian + matrix and the strictly lower triangular part of C + is not referenced. On exit, the upper triangular + part of the array C is overwritten by the upper tri- + angular part of the updated matrix. Before entry + with UPLO = 'L' or 'l', the leading n by n lower + triangular part of the array C must contain the lower + triangular part of the hermitian matrix and the + strictly upper triangular part of C is not refer- + enced. On exit, the lower triangular part of the + array C is overwritten by the lower triangular part + of the updated matrix. Note that the imaginary parts + of the diagonal elements need not be set, they are + assumed to be zero, and on exit they are set to + zero. + + LDC - INTEGER. + On entry, LDC specifies the first dimension of C as + declared in the calling (sub) program. LDC + must be at least max( 1, n ). Unchanged on exit. + +@ + <>= (let* ((one 1.0) (zero (complex 0.0 0.0))) (declare (type (double-float 1.0 1.0) one) (type (complex double-float) zero)) @@ -18036,7 +24257,7 @@ Returns multiple values where: (type (array (complex double-float) (*)) c b a) (type (complex double-float) alpha) (type fixnum ldc ldb$ lda k n) - (type (simple-array character (*)) trans uplo)) + (type character trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -18049,16 +24270,16 @@ Returns multiple values where: (type fixnum i info j l nrowa) (type (member t nil) upper)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf nrowa n)) (t (setf nrowa k))) - (setf upper (lsame uplo "U")) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) (not (char-equal trans #\C))) (setf info 2)) ((< n 0) (setf info 3)) @@ -18073,7 +24294,9 @@ Returns multiple values where: (setf info 12))) (cond ((/= info 0) - (xerbla "ZHER2K" info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZHER2K" info) (go end_label))) (if (or (= n 0) (and (or (= alpha zero) (= k 0)) (= beta one))) (go end_label)) @@ -18170,7 +24393,7 @@ Returns multiple values where: c-%offset%))))))))))) (go end_label))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -18614,31 +24837,147 @@ Returns multiple values where: 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::zher2k -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum (double-float) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zherk BLAS} %\pagehead{zherk}{zherk} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zherk.output +)spool zherk.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zherk examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZHERK - perform one of the hermitian rank k operations C + := alpha*A*conjg( A' ) + beta*C, + + SYNOPSIS + SUBROUTINE ZHERK ( UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, + C, LDC ) + + CHARACTER*1 UPLO, TRANS + + INTEGER N, K, LDA, LDC + + DOUBLE PRECISION ALPHA, BETA + + COMPLEX*16 A( LDA, * ), C( LDC, * ) + + PURPOSE + ZHERK performs one of the hermitian rank k operations + + or + + C := alpha*conjg( A' )*A + beta*C, + + where alpha and beta are real scalars, C is an n by n + hermitian matrix and A is an n by k matrix in the first + case and a k by n matrix in the second case. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or + lower triangular part of the array C is to be + referenced as follows: + + UPLO = 'U' or 'u' Only the upper triangular part + of C is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part + of C is to be referenced. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' C := alpha*A*conjg( A' ) + + beta*C. + + TRANS = 'C' or 'c' C := alpha*conjg( A' )*A + + beta*C. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix C. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry with TRANS = 'N' or 'n', K specifies the + number of columns of the matrix A, and on + entry with TRANS = 'C' or 'c', K specifies the + number of rows of the matrix A. K must be at least + zero. Unchanged on exit. + + ALPHA - DOUBLE PRECISION. + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + ka is + A - + COMPLEX*16 array of DIMENSION ( LDA, ka ), where + k when TRANS = 'N' or 'n', and is n otherwise. + Before entry with TRANS = 'N' or 'n', the leading + n by k part of the array A must contain the matrix + A, otherwise the leading k by n part of the array + A must contain the matrix A. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When + TRANS = 'N' or 'n' then LDA must be at least max( + 1, n ), otherwise LDA must be at least max( 1, k ). + Unchanged on exit. + + BETA - DOUBLE PRECISION. + On entry, BETA specifies the scalar beta. Unchanged + on exit. + + C - COMPLEX*16 array of DIMENSION ( LDC, n ). + Before entry with UPLO = 'U' or 'u', the leading + n by n upper triangular part of the array C must con- + tain the upper triangular part of the hermitian + matrix and the strictly lower triangular part of C + is not referenced. On exit, the upper triangular + part of the array C is overwritten by the upper tri- + angular part of the updated matrix. Before entry + with UPLO = 'L' or 'l', the leading n by n lower + triangular part of the array C must contain the lower + triangular part of the hermitian matrix and the + strictly upper triangular part of C is not refer- + enced. On exit, the lower triangular part of the + array C is overwritten by the lower triangular part + of the updated matrix. Note that the imaginary parts + + of the diagonal elements need not be set, they are + assumed to be zero, and on exit they are set to + zero. + + LDC - INTEGER. + On entry, LDC specifies the first dimension of C as + declared in the calling (sub) program. LDC + must be at least max( 1, n ). Unchanged on exit. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -18647,7 +24986,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) c a) (type (double-float) beta alpha) (type fixnum ldc lda k n) - (type (simple-array character (*)) trans uplo)) + (type character trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -18660,16 +24999,16 @@ Returns multiple values where: (type fixnum i info j l nrowa) (type (member t nil) upper)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf nrowa n)) (t (setf nrowa k))) - (setf upper (lsame uplo "U")) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) (not (lsame trans "C"))) + ((and (not (char-equal trans #\N)) (not (char-equal trans #\C))) (setf info 2)) ((< n 0) (setf info 3)) @@ -18681,7 +25020,9 @@ Returns multiple values where: (setf info 10))) (cond ((/= info 0) - (xerbla "ZHERK " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZHERK" info) (go end_label))) (if (or (= n 0) (and (or (= alpha zero) (= k 0)) (= beta one))) (go end_label)) @@ -18778,7 +25119,7 @@ Returns multiple values where: c-%offset%))))))))))) (go end_label))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -19165,27 +25506,160 @@ Returns multiple values where: end_label (return (values 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::zherk fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (double-float) (array (complex double-float) (*)) -; fixnum (double-float) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zsymm BLAS} %\pagehead{zsymm}{zsymm} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zsymm.output +)spool zsymm.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zsymm examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZSYMM - perform one of the matrix-matrix operations C := + alpha*A*B + beta*C, + + SYNOPSIS + SUBROUTINE ZSYMM ( SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, + BETA, C, LDC ) + + CHARACTER*1 SIDE, UPLO + + INTEGER M, N, LDA, LDB, LDC + + COMPLEX*16 ALPHA, BETA + + COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ) + + PURPOSE + ZSYMM performs one of the matrix-matrix operations + + or + + C := alpha*B*A + beta*C, + + where alpha and beta are scalars, A is a symmetric matrix + and B and C are m by n matrices. + + PARAMETERS + SIDE - CHARACTER*1. + On entry, SIDE specifies whether the symmetric + matrix A appears on the left or right in the + operation as follows: + + SIDE = 'L' or 'l' C := alpha*A*B + beta*C, + + SIDE = 'R' or 'r' C := alpha*B*A + beta*C, + + Unchanged on exit. + + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or + lower triangular part of the symmetric matrix + A is to be referenced as follows: + + UPLO = 'U' or 'u' Only the upper triangular part of + the symmetric matrix is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part of + the symmetric matrix is to be referenced. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of the + matrix C. M must be at least zero. Unchanged on + exit. + + N - INTEGER. + On entry, N specifies the number of columns of the + matrix C. N must be at least zero. Unchanged on + exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + ka is + A - + COMPLEX*16 array of DIMENSION ( LDA, ka ), where + m when SIDE = 'L' or 'l' and is n otherwise. + Before entry with SIDE = 'L' or 'l', the m by m + part of the array A must contain the symmetric + matrix, such that when UPLO = 'U' or 'u', the lead- + ing m by m upper triangular part of the array A + must contain the upper triangular part of the sym- + metric matrix and the strictly lower triangular + part of A is not referenced, and when UPLO = 'L' + or 'l', the leading m by m lower triangular part + of the array A must contain the lower triangular + part of the symmetric matrix and the strictly + upper triangular part of A is not referenced. + Before entry with SIDE = 'R' or 'r', the n by n + part of the array A must contain the symmetric + matrix, such that when UPLO = 'U' or 'u', the lead- + ing n by n upper triangular part of the array A + must contain the upper triangular part of the sym- + metric matrix and the strictly lower triangular + part of A is not referenced, and when UPLO = 'L' + or 'l', the leading n by n lower triangular part + of the array A must contain the lower triangular + part of the symmetric matrix and the strictly + upper triangular part of A is not referenced. + Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When SIDE = + 'L' or 'l' then LDA must be at least max( 1, m ), + otherwise LDA must be at least max( 1, n ). + Unchanged on exit. + + B - COMPLEX*16 array of DIMENSION ( LDB, n ). + Before entry, the leading m by n part of the array + B must contain the matrix B. Unchanged on exit. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. LDB + must be at least max( 1, m ). Unchanged on exit. + + BETA - COMPLEX*16 . + On entry, BETA specifies the scalar beta. When + BETA is supplied as zero then C need not be set on + input. Unchanged on exit. + + C - COMPLEX*16 array of DIMENSION ( LDC, n ). + Before entry, the leading m by n part of the array + C must contain the matrix C, except when beta is + zero, in which case C need not be set on entry. On + exit, the array C is overwritten by the m by n + updated matrix. + + LDC - INTEGER. + On entry, LDC specifies the first dimension of C as + declared in the calling (sub) program. LDC + must be at least max( 1, m ). Unchanged on exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -19193,7 +25667,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) c b a) (type (complex double-float) beta alpha) (type fixnum ldc ldb$ lda n m) - (type (simple-array character (*)) uplo side)) + (type character uplo side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (uplo character uplo-%data% uplo-%offset%) @@ -19206,16 +25680,16 @@ Returns multiple values where: (type fixnum i info j k nrowa) (type (member t nil) upper)) (cond - ((lsame side "L") + ((char-equal side #\L) (setf nrowa m)) (t (setf nrowa n))) - (setf upper (lsame uplo "U")) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not (lsame side "L")) (not (lsame side "R"))) + ((and (not (char-equal side #\L)) (not (char-equal side #\R))) (setf info 1)) - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 2)) ((< m 0) (setf info 3)) @@ -19229,7 +25703,9 @@ Returns multiple values where: (setf info 12))) (cond ((/= info 0) - (xerbla "ZSYMM " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZSYMM" info) (go end_label))) (if (or (= m 0) (= n 0) (and (= alpha zero) (= beta one))) (go end_label)) @@ -19266,7 +25742,7 @@ Returns multiple values where: c-%offset%))))))))) (go end_label))) (cond - ((lsame side "L") + ((char-equal side #\L) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -19534,31 +26010,159 @@ Returns multiple values where: 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::zsymm fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zsyr2k BLAS} %\pagehead{zsyr2k}{zsyr2k} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zsyr2k.output +)spool zsyr2k.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zsyr2k examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZSYR2K - perform one of the symmetric rank 2k operations C + := alpha*A*B' + alpha*B*A' + beta*C, + + SYNOPSIS + SUBROUTINE ZSYR2K( UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, + BETA, C, LDC ) + + CHARACTER*1 UPLO, TRANS + + INTEGER N, K, LDA, LDB, LDC + + COMPLEX*16 ALPHA, BETA + + COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * ) + + PURPOSE + ZSYR2K performs one of the symmetric rank 2k operations + + or + + C := alpha*A'*B + alpha*B'*A + beta*C, + + where alpha and beta are scalars, C is an n by n sym- + metric matrix and A and B are n by k matrices in the + first case and k by n matrices in the second case. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or + lower triangular part of the array C is to be + referenced as follows: + + UPLO = 'U' or 'u' Only the upper triangular part + of C is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part + of C is to be referenced. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' C := alpha*A*B' + alpha*B*A' + + beta*C. + + TRANS = 'T' or 't' C := alpha*A'*B + alpha*B'*A + + beta*C. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix C. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry with TRANS = 'N' or 'n', K specifies the + number of columns of the matrices A and B, and + on entry with TRANS = 'T' or 't', K specifies + the number of rows of the matrices A and B. K must + be at least zero. Unchanged on exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + ka is + A - + COMPLEX*16 array of DIMENSION ( LDA, ka ), where + k when TRANS = 'N' or 'n', and is n otherwise. + Before entry with TRANS = 'N' or 'n', the leading + n by k part of the array A must contain the matrix + A, otherwise the leading k by n part of the array + A must contain the matrix A. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When + TRANS = 'N' or 'n' then LDA must be at least max( + 1, n ), otherwise LDA must be at least max( 1, k ). + Unchanged on exit. + + kb is + B - + COMPLEX*16 array of DIMENSION ( LDB, kb ), where + k when TRANS = 'N' or 'n', and is n otherwise. + Before entry with TRANS = 'N' or 'n', the leading + n by k part of the array B must contain the matrix + B, otherwise the leading k by n part of the array + B must contain the matrix B. Unchanged on exit. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. When + TRANS = 'N' or 'n' then LDB must be at least max( + 1, n ), otherwise LDB must be at least max( 1, k ). + Unchanged on exit. + + BETA - COMPLEX*16 . + On entry, BETA specifies the scalar beta. Unchanged + on exit. + + C - COMPLEX*16 array of DIMENSION ( LDC, n ). + Before entry with UPLO = 'U' or 'u', the leading + n by n upper triangular part of the array C must con- + tain the upper triangular part of the symmetric + matrix and the strictly lower triangular part of C + is not referenced. On exit, the upper triangular + part of the array C is overwritten by the upper tri- + angular part of the updated matrix. Before entry + with UPLO = 'L' or 'l', the leading n by n lower + triangular part of the array C must contain the lower + triangular part of the symmetric matrix and the + strictly upper triangular part of C is not refer- + enced. On exit, the lower triangular part of the + array C is overwritten by the lower triangular part + of the updated matrix. + + LDC - INTEGER. + On entry, LDC specifies the first dimension of C as + declared in the calling (sub) program. LDC + must be at least max( 1, n ). Unchanged on exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -19566,7 +26170,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) c b a) (type (complex double-float) beta alpha) (type fixnum ldc ldb$ lda k n) - (type (simple-array character (*)) trans uplo)) + (type character trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -19579,16 +26183,16 @@ Returns multiple values where: (type fixnum i info j l nrowa) (type (member t nil) upper)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf nrowa n)) (t (setf nrowa k))) - (setf upper (lsame uplo "U")) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) (not (lsame trans "T"))) + ((and (not (char-equal trans #\N)) (not (char-equal trans #\T))) (setf info 2)) ((< n 0) (setf info 3)) @@ -19603,7 +26207,9 @@ Returns multiple values where: (setf info 12))) (cond ((/= info 0) - (xerbla "ZSYR2K" info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZSYR2K" info) (go end_label))) (if (or (= n 0) (and (or (= alpha zero) (= k 0)) (= beta one))) (go end_label)) @@ -19672,7 +26278,7 @@ Returns multiple values where: c-%offset%))))))))))) (go end_label))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -19925,32 +26531,142 @@ Returns multiple values where: 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::zsyr2k -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zsyrk BLAS} %\pagehead{zsyrk}{zsyrk} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zsyrk.output +)spool zsyrk.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zsyrk examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZSYRK - perform one of the symmetric rank k operations C + := alpha*A*A' + beta*C, + + SYNOPSIS + SUBROUTINE ZSYRK ( UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, + C, LDC ) + + CHARACTER*1 UPLO, TRANS + + INTEGER N, K, LDA, LDC + + COMPLEX*16 ALPHA, BETA + + COMPLEX*16 A( LDA, * ), C( LDC, * ) + + PURPOSE + ZSYRK performs one of the symmetric rank k operations + + or + + C := alpha*A'*A + beta*C, + + where alpha and beta are scalars, C is an n by n sym- + metric matrix and A is an n by k matrix in the first + case and a k by n matrix in the second case. + + PARAMETERS + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the upper or + lower triangular part of the array C is to be + referenced as follows: + + UPLO = 'U' or 'u' Only the upper triangular part + of C is to be referenced. + + UPLO = 'L' or 'l' Only the lower triangular part + of C is to be referenced. + + Unchanged on exit. + + TRANS - CHARACTER*1. + On entry, TRANS specifies the operation to be per- + formed as follows: + + TRANS = 'N' or 'n' C := alpha*A*A' + beta*C. + + TRANS = 'T' or 't' C := alpha*A'*A + beta*C. + + Unchanged on exit. + + N - INTEGER. + On entry, N specifies the order of the matrix C. N + must be at least zero. Unchanged on exit. + + K - INTEGER. + On entry with TRANS = 'N' or 'n', K specifies the + number of columns of the matrix A, and on + entry with TRANS = 'T' or 't', K specifies the + number of rows of the matrix A. K must be at least + zero. Unchanged on exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. + Unchanged on exit. + + ka is + A - + COMPLEX*16 array of DIMENSION ( LDA, ka ), where + k when TRANS = 'N' or 'n', and is n otherwise. + Before entry with TRANS = 'N' or 'n', the leading + n by k part of the array A must contain the matrix + A, otherwise the leading k by n part of the array + A must contain the matrix A. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When + TRANS = 'N' or 'n' then LDA must be at least max( + 1, n ), otherwise LDA must be at least max( 1, k ). + Unchanged on exit. + + BETA - COMPLEX*16 . + On entry, BETA specifies the scalar beta. Unchanged + on exit. + + C - COMPLEX*16 array of DIMENSION ( LDC, n ). + Before entry with UPLO = 'U' or 'u', the leading + n by n upper triangular part of the array C must con- + tain the upper triangular part of the symmetric + matrix and the strictly lower triangular part of C + is not referenced. On exit, the upper triangular + part of the array C is overwritten by the upper tri- + angular part of the updated matrix. Before entry + with UPLO = 'L' or 'l', the leading n by n lower + triangular part of the array C must contain the lower + triangular part of the symmetric matrix and the + strictly upper triangular part of C is not refer- + enced. On exit, the lower triangular part of the + array C is overwritten by the lower triangular part + of the updated matrix. + + LDC - INTEGER. + + On entry, LDC specifies the first dimension of C as + declared in the calling (sub) program. LDC + must be at least max( 1, n ). Unchanged on exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -19958,7 +26674,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) c a) (type (complex double-float) beta alpha) (type fixnum ldc lda k n) - (type (simple-array character (*)) trans uplo)) + (type character trans uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (trans character trans-%data% trans-%offset%) @@ -19970,16 +26686,16 @@ Returns multiple values where: (type fixnum i info j l nrowa) (type (member t nil) upper)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (setf nrowa n)) (t (setf nrowa k))) - (setf upper (lsame uplo "U")) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 1)) - ((and (not (lsame trans "N")) (not (lsame trans "T"))) + ((and (not (char-equal trans #\N)) (not (char-equal trans #\T))) (setf info 2)) ((< n 0) (setf info 3)) @@ -19991,7 +26707,9 @@ Returns multiple values where: (setf info 10))) (cond ((/= info 0) - (xerbla "ZSYRK " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZSYRK" info) (go end_label))) (if (or (= n 0) (and (or (= alpha zero) (= k 0)) (= beta one))) (go end_label)) @@ -20060,7 +26778,7 @@ Returns multiple values where: c-%offset%))))))))))) (go end_label))) (cond - ((lsame trans "N") + ((char-equal trans #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -20257,29 +26975,147 @@ Returns multiple values where: end_label (return (values 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::zsyrk fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ztrmm BLAS} %\pagehead{ztrmm}{ztrmm} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ztrmm.output +)spool ztrmm.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ztrmm examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZTRMM - perform one of the matrix-matrix operations B := + alpha*op( A )*B, or B := alpha*B*op( A ) where alpha is a + scalar, B is an m by n matrix, A is a unit, or non-unit, + upper or lower triangular matrix and op( A ) is one of op( + A ) = A or op( A ) = A' or op( A ) = conjg( A' ) + + SYNOPSIS + SUBROUTINE ZTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, + LDA, B, LDB ) + + CHARACTER*1 SIDE, UPLO, TRANSA, DIAG + + INTEGER M, N, LDA, LDB + + COMPLEX*16 ALPHA + + COMPLEX*16 A( LDA, * ), B( LDB, * ) + + PURPOSE + ZTRMM performs one of the matrix-matrix operations + + PARAMETERS + SIDE - CHARACTER*1. + On entry, SIDE specifies whether op( A ) multiplies + B from the left or right as follows: + + SIDE = 'L' or 'l' B := alpha*op( A )*B. + + SIDE = 'R' or 'r' B := alpha*B*op( A ). + + Unchanged on exit. + + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix A is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANSA - CHARACTER*1. On entry, TRANSA specifies the + form of op( A ) to be used in the matrix multiplica- + tion as follows: + + TRANSA = 'N' or 'n' op( A ) = A. + + TRANSA = 'T' or 't' op( A ) = A'. + + TRANSA = 'C' or 'c' op( A ) = conjg( A' ). + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of B. M must + be at least zero. Unchanged on exit. + + N - INTEGER. + On entry, N specifies the number of columns of B. N + must be at least zero. Unchanged on exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. When + alpha is zero then A is not referenced and B need + not be set before entry. Unchanged on exit. + + is m + A - + COMPLEX*16 array of DIMENSION ( LDA, k ), where k + when SIDE = 'L' or 'l' and is n when SIDE = 'R' + or 'r'. Before entry with UPLO = 'U' or 'u', the + leading k by k upper triangular part of the array A + must contain the upper triangular matrix and the + strictly lower triangular part of A is not refer- + enced. Before entry with UPLO = 'L' or 'l', the + leading k by k lower triangular part of the array A + must contain the lower triangular matrix and the + strictly upper triangular part of A is not refer- + enced. Note that when DIAG = 'U' or 'u', the diag- + onal elements of A are not referenced either, but + are assumed to be unity. Unchanged on exit. + + LDA - INTEGER. + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When SIDE = + 'L' or 'l' then LDA must be at least max( 1, m ), + when SIDE = 'R' or 'r' then LDA must be at least + max( 1, n ). Unchanged on exit. + + B - COMPLEX*16 array of DIMENSION ( LDB, n ). + Before entry, the leading m by n part of the array + B must contain the matrix B, and on exit is + overwritten by the transformed matrix. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. LDB + must be at least max( 1, m ). Unchanged on exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -20287,7 +27123,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) b a) (type (complex double-float) alpha) (type fixnum ldb$ lda n m) - (type (simple-array character (*)) diag transa uplo side)) + (type character diag transa uplo side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (uplo character uplo-%data% uplo-%offset%) @@ -20300,26 +27136,26 @@ Returns multiple values where: (declare (type (complex double-float) temp) (type fixnum i info j k nrowa) (type (member t nil) lside noconj nounit upper)) - (setf lside (lsame side "L")) + (setf lside (char-equal side #\L)) (cond (lside (setf nrowa m)) (t (setf nrowa n))) - (setf noconj (lsame transa "T")) - (setf nounit (lsame diag "N")) - (setf upper (lsame uplo "U")) + (setf noconj (char-equal transa #\T)) + (setf nounit (char-equal diag #\N)) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not lside) (not (lsame side "R"))) + ((and (not lside) (not (char-equal side #\R))) (setf info 1)) - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 2)) - ((and (not (lsame transa "N")) - (not (lsame transa "T")) - (not (lsame transa "C"))) + ((and (not (char-equal transa #\N)) + (not (char-equal transa #\T)) + (not (char-equal transa #\C))) (setf info 3)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 4)) ((< m 0) (setf info 5)) @@ -20331,7 +27167,9 @@ Returns multiple values where: (setf info 11))) (cond ((/= info 0) - (xerbla "ZTRMM " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZTRMM" info) (go end_label))) (if (= n 0) (go end_label)) (cond @@ -20351,7 +27189,7 @@ Returns multiple values where: (cond (lside (cond - ((lsame transa "N") + ((char-equal transa #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -20597,7 +27435,7 @@ Returns multiple values where: (* alpha temp))))))))))) (t (cond - ((lsame transa "N") + ((char-equal transa #\N) (cond (upper (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) @@ -20866,30 +27704,156 @@ Returns multiple values where: end_label (return (values 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::ztrmm fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ztrsm BLAS} %\pagehead{ztrsm}{ztrsm} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ztrsm.output +)spool ztrsm.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ztrsm examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + NAME + ZTRSM - solve one of the matrix equations op( A )*X = + alpha*B, or X*op( A ) = alpha*B, + + SYNOPSIS + SUBROUTINE ZTRSM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, + LDA, B, LDB ) + + CHARACTER*1 SIDE, UPLO, TRANSA, DIAG + + INTEGER M, N, LDA, LDB + + COMPLEX*16 ALPHA + + COMPLEX*16 A( LDA, * ), B( LDB, * ) + + PURPOSE + ZTRSM solves one of the matrix equations + + where alpha is a scalar, X and B are m by n matrices, A is a + unit, or non-unit, upper or lower triangular matrix and + op( A ) is one of + + op( A ) = A or op( A ) = A' or op( A ) = conjg( + A' ). + + The matrix X is overwritten on B. + + PARAMETERS + SIDE - CHARACTER*1. + On entry, SIDE specifies whether op( A ) appears on + the left or right of X as follows: + + SIDE = 'L' or 'l' op( A )*X = alpha*B. + + SIDE = 'R' or 'r' X*op( A ) = alpha*B. + + Unchanged on exit. + + UPLO - CHARACTER*1. + On entry, UPLO specifies whether the matrix A is an + upper or lower triangular matrix as follows: + + UPLO = 'U' or 'u' A is an upper triangular matrix. + + UPLO = 'L' or 'l' A is a lower triangular matrix. + + Unchanged on exit. + + TRANSA - CHARACTER*1. On entry, TRANSA specifies the + form of op( A ) to be used in the matrix + + multiplication as follows: + + TRANSA = 'N' or 'n' op( A ) = A. + + TRANSA = 'T' or 't' op( A ) = A'. + + TRANSA = 'C' or 'c' op( A ) = conjg( A' ). + + Unchanged on exit. + + DIAG - CHARACTER*1. + On entry, DIAG specifies whether or not A is unit + triangular as follows: + + DIAG = 'U' or 'u' A is assumed to be unit triangu- + lar. + + DIAG = 'N' or 'n' A is not assumed to be unit tri- + angular. + + Unchanged on exit. + + M - INTEGER. + On entry, M specifies the number of rows of B. M must + be at least zero. Unchanged on exit. + + N - INTEGER. + On entry, N specifies the number of columns of B. N + must be at least zero. Unchanged on exit. + + ALPHA - COMPLEX*16 . + On entry, ALPHA specifies the scalar alpha. When + alpha is zero then A is not referenced and B need + not be set before entry. Unchanged on exit. + + is m + A - + COMPLEX*16 array of DIMENSION ( LDA, k ), where k + when SIDE = 'L' or 'l' and is n when SIDE = 'R' + or 'r'. Before entry with UPLO = 'U' or 'u', the + leading k by k upper triangular part of the array A + must contain the upper triangular matrix and the + strictly lower triangular part of A is not refer- + enced. Before entry with UPLO = 'L' or 'l', the + leading k by k lower triangular part of the array A + must contain the lower triangular matrix and the + strictly upper triangular part of A is not refer- + enced. Note that when DIAG = 'U' or 'u', the diag- + onal elements of A are not referenced either, but + are assumed to be unity. Unchanged on exit. + + LDA - INTEGER. + + On entry, LDA specifies the first dimension of A as + declared in the calling (sub) program. When SIDE = + 'L' or 'l' then LDA must be at least max( 1, m ), + when SIDE = 'R' or 'r' then LDA must be at least + max( 1, n ). Unchanged on exit. + + B - COMPLEX*16 array of DIMENSION ( LDB, n ). + Before entry, the leading m by n part of the array + B must contain the right-hand side matrix B, + and on exit is overwritten by the solution matrix + X. + + LDB - INTEGER. + On entry, LDB specifies the first dimension of B as + declared in the calling (sub) program. LDB + must be at least max( 1, m ). Unchanged on exit. + +@ + <>= (let* ((one (complex 1.0 0.0)) (zero (complex 0.0 0.0))) (declare (type (complex double-float) one) (type (complex double-float) zero)) @@ -20897,7 +27861,7 @@ Returns multiple values where: (declare (type (array (complex double-float) (*)) b a) (type (complex double-float) alpha) (type fixnum ldb$ lda n m) - (type (simple-array character (*)) diag transa uplo side)) + (type character diag transa uplo side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (uplo character uplo-%data% uplo-%offset%) @@ -20910,26 +27874,26 @@ Returns multiple values where: (declare (type (complex double-float) temp) (type fixnum i info j k nrowa) (type (member t nil) lside noconj nounit upper)) - (setf lside (lsame side "L")) + (setf lside (char-equal side #\L)) (cond (lside (setf nrowa m)) (t (setf nrowa n))) - (setf noconj (lsame transa "T")) - (setf nounit (lsame diag "N")) - (setf upper (lsame uplo "U")) + (setf noconj (char-equal transa #\T)) + (setf nounit (char-equal diag #\N)) + (setf upper (char-equal uplo #\U)) (setf info 0) (cond - ((and (not lside) (not (lsame side "R"))) + ((and (not lside) (not (char-equal side #\R))) (setf info 1)) - ((and (not upper) (not (lsame uplo "L"))) + ((and (not upper) (not (char-equal uplo #\L))) (setf info 2)) - ((and (not (lsame transa "N")) - (not (lsame transa "T")) - (not (lsame transa "C"))) + ((and (not (char-equal transa #\N)) + (not (char-equal transa #\T)) + (not (char-equal transa #\C))) (setf info 3)) - ((and (not (lsame diag "U")) (not (lsame diag "N"))) + ((and (not (char-equal diag #\U)) (not (char-equal diag #\N))) (setf info 4)) ((< m 0) (setf info 5)) @@ -20941,7 +27905,9 @@ Returns multiple values where: (setf info 11))) (cond ((/= info 0) - (xerbla "ZTRSM " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "ZTRSM" info) (go end_label))) (if (= n 0) (go end_label)) (cond @@ -20961,7 +27927,7 @@ Returns multiple values where: (cond (lside (cond - ((lsame transa "N") + ((char-equal transa #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -21230,7 +28196,7 @@ Returns multiple values where: temp)))))))))) (t (cond - ((lsame transa "N") + ((char-equal transa #\N) (cond (upper (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -21545,24 +28511,6 @@ Returns multiple values where: end_label (return (values 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::ztrsm fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; ((complex double-float)) -; (array (complex double-float) (*)) -; fixnum -; (array (complex double-float) (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{LAPACK} @@ -21571,6 +28519,142 @@ Returns multiple values where: %\pagehead{dbdsdc}{dbdsdc} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dbdsdc.output +)spool dbdsdc.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dbdsdc examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DBDSDC - the singular value decomposition (SVD) of a real N-by-N (upper + or lower) bidiagonal matrix B + +SYNOPSIS + SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, WORK, + IWORK, INFO ) + + CHARACTER COMPQ, UPLO + + INTEGER INFO, LDU, LDVT, N + + INTEGER IQ( * ), IWORK( * ) + + DOUBLE PRECISION D( * ), E( * ), Q( * ), U( LDU, * ), VT( + LDVT, * ), WORK( * ) + +PURPOSE + DBDSDC computes the singular value decomposition (SVD) of a real N-by-N + (upper or lower) bidiagonal matrix B: B = U * S * VT, using a divide + and conquer method, where S is a diagonal matrix with non-negative + diagonal elements (the singular values of B), and U and VT are orthogo- + nal matrices of left and right singular vectors, respectively. DBDSDC + can be used to compute all singular values, and optionally, singular + vectors or singular vectors in compact form. + + This code makes very mild assumptions about floating point arithmetic. + It will work on machines with a guard digit in add/subtract, or on + those binary machines without guard digits which subtract like the Cray + X-MP, Cray Y-MP, Cray C-90, or Cray-2. It could conceivably fail on + hexadecimal or decimal machines without guard digits, but we know of + none. See DLASD3 for details. + + The code currently calls DLASDQ if singular values only are desired. + However, it can be slightly modified to compute singular values using + the divide and conquer method. + + +ARGUMENTS + UPLO (input) CHARACTER*1 + = 'U': B is upper bidiagonal. + = 'L': B is lower bidiagonal. + + COMPQ (input) CHARACTER*1 + Specifies whether singular vectors are to be computed as fol- + lows: + = 'N': Compute singular values only; + = 'P': Compute singular values and compute singular vectors in + compact form; = 'I': Compute singular values and singular vec- + tors. + + N (input) INTEGER + The order of the matrix B. N >= 0. + + D (input/output) DOUBLE PRECISION array, dimension (N) + On entry, the n diagonal elements of the bidiagonal matrix B. + On exit, if INFO=0, the singular values of B. + + E (input/output) DOUBLE PRECISION array, dimension (N-1) + On entry, the elements of E contain the offdiagonal elements of + the bidiagonal matrix whose SVD is desired. On exit, E has + been destroyed. + + U (output) DOUBLE PRECISION array, dimension (LDU,N) + If COMPQ = 'I', then: On exit, if INFO = 0, U contains the + left singular vectors of the bidiagonal matrix. For other val- + ues of COMPQ, U is not referenced. + + LDU (input) INTEGER + The leading dimension of the array U. LDU >= 1. If singular + vectors are desired, then LDU >= max( 1, N ). + + VT (output) DOUBLE PRECISION array, dimension (LDVT,N) + If COMPQ = 'I', then: On exit, if INFO = 0, VT' contains the + right singular vectors of the bidiagonal matrix. For other + values of COMPQ, VT is not referenced. + + LDVT (input) INTEGER + The leading dimension of the array VT. LDVT >= 1. If singular + vectors are desired, then LDVT >= max( 1, N ). + + Q (output) DOUBLE PRECISION array, dimension (LDQ) + If COMPQ = 'P', then: On exit, if INFO = 0, Q and IQ contain + the left and right singular vectors in a compact form, requir- + ing O(N log N) space instead of 2*N**2. In particular, Q con- + tains all the DOUBLE PRECISION data in LDQ >= N*(11 + 2*SMLSIZ + + 8*INT(LOG_2(N/(SMLSIZ+1)))) words of memory, where SMLSIZ is + returned by ILAENV and is equal to the maximum size of the sub- + problems at the bottom of the computation tree (usually about + 25). For other values of COMPQ, Q is not referenced. + + IQ (output) INTEGER array, dimension (LDIQ) + If COMPQ = 'P', then: On exit, if INFO = 0, Q and IQ contain + the left and right singular vectors in a compact form, requir- + ing O(N log N) space instead of 2*N**2. In particular, IQ con- + tains all INTEGER data in LDIQ >= N*(3 + 3*INT(LOG_2(N/(SML- + SIZ+1)))) words of memory, where SMLSIZ is returned by ILAENV + and is equal to the maximum size of the subproblems at the bot- + tom of the computation tree (usually about 25). For other val- + ues of COMPQ, IQ is not referenced. + + WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) + If COMPQ = 'N' then LWORK >= (4 * N). If COMPQ = 'P' then + LWORK >= (6 * N). If COMPQ = 'I' then LWORK >= (3 * N**2 + 4 * + N). + + IWORK (workspace) INTEGER array, dimension (8*N) + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + > 0: The algorithm failed to compute an singular value. The + update process of divide and conquer failed. + +@ + The input arguments are: \begin{itemize} \item uplo - simple-array character (1) @@ -21620,7 +28704,7 @@ The return values are: \calls{dbdsdc}{dcopy} \calls{dbdsdc}{ilaenv} \calls{dbdsdc}{xerbla} -\calls{dbdsdc}{lsame} +\calls{dbdsdc}{char-equal} <>= (let* ((zero 0.0) (one 1.0) (two 2.0)) @@ -21631,7 +28715,7 @@ The return values are: (declare (type (array fixnum (*)) iwork iq) (type (array double-float (*)) work q vt u e d) (type fixnum info ldvt ldu n) - (type (simple-array character (*)) compq uplo)) + (type character compq uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (compq character compq-%data% compq-%offset%) @@ -21655,12 +28739,12 @@ The return values are: smlsiz smlszp sqre start wstart z)) (setf info 0) (setf iuplo 0) - (if (lsame uplo "U") (setf iuplo 1)) - (if (lsame uplo "L") (setf iuplo 2)) + (if (char-equal uplo #\U) (setf iuplo 1)) + (if (char-equal uplo #\L) (setf iuplo 2)) (cond - ((lsame compq "N") (setf icompq 0)) - ((lsame compq "P") (setf icompq 1)) - ((lsame compq "I") (setf icompq 2)) + ((char-equal compq #\N) (setf icompq 0)) + ((char-equal compq #\P) (setf icompq 1)) + ((char-equal compq #\I) (setf icompq 2)) (t (setf icompq -1))) (cond ((= iuplo 0) (setf info -1)) @@ -21670,7 +28754,9 @@ The return values are: ((or (< ldvt 1) (and (= icompq 2) (< ldvt n))) (setf info -9))) (cond ((/= info 0) - (xerbla "DBDSDC" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DBDSDC" (f2cl-lib:int-sub info)) (go end_label))) (if (= n 0) (go end_label)) (setf smlsiz (ilaenv 9 "DBDSDC" " " 0 0 0 0)) @@ -22053,6 +29139,160 @@ The return values are: %\pagehead{dbdsqr}{dbdsqr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dbdsqr.output +)spool dbdsqr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dbdsqr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DBDSQR - the singular values and, optionally, the right and/or left + singular vectors from the singular value decomposition (SVD) of a real + N-by-N (upper or lower) bidiagonal matrix B using the implicit zero- + shift QR algorithm + +SYNOPSIS + SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, + LDC, WORK, INFO ) + + CHARACTER UPLO + + INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU + + DOUBLE PRECISION C( LDC, * ), D( * ), E( * ), U( LDU, * ), + VT( LDVT, * ), WORK( * ) + +PURPOSE + DBDSQR computes the singular values and, optionally, the right and/or + left singular vectors from the singular value decomposition (SVD) of a + real N-by-N (upper or lower) bidiagonal matrix B using the implicit + zero-shift QR algorithm. The SVD of B has the form + + B = Q * S * P**T + + where S is the diagonal matrix of singular values, Q is an orthogonal + matrix of left singular vectors, and P is an orthogonal matrix of right + singular vectors. If left singular vectors are requested, this subrou- + tine actually returns U*Q instead of Q, and, if right singular vectors + are requested, this subroutine returns P**T*VT instead of P**T, for + given real input matrices U and VT. When U and VT are the orthogonal + matrices that reduce a general matrix A to bidiagonal form: A = + U*B*VT, as computed by DGEBRD, then + + A = (U*Q) * S * (P**T*VT) + + is the SVD of A. Optionally, the subroutine may also compute Q**T*C + for a given real input matrix C. + + See "Computing Small Singular Values of Bidiagonal Matrices With Guar- + anteed High Relative Accuracy," by J. Demmel and W. Kahan, LAPACK Work- + ing Note #3 (or SIAM J. Sci. Statist. Comput. vol. 11, no. 5, pp. + 873-912, Sept 1990) and + "Accurate singular values and differential qd algorithms," by B. Par- + lett and V. Fernando, Technical Report CPAM-554, Mathematics Depart- + ment, University of California at Berkeley, July 1992 for a detailed + description of the algorithm. + + +ARGUMENTS + UPLO (input) CHARACTER*1 + = 'U': B is upper bidiagonal; + = 'L': B is lower bidiagonal. + + N (input) INTEGER + The order of the matrix B. N >= 0. + + NCVT (input) INTEGER + The number of columns of the matrix VT. NCVT >= 0. + + NRU (input) INTEGER + The number of rows of the matrix U. NRU >= 0. + + NCC (input) INTEGER + The number of columns of the matrix C. NCC >= 0. + + D (input/output) DOUBLE PRECISION array, dimension (N) + On entry, the n diagonal elements of the bidiagonal matrix B. + On exit, if INFO=0, the singular values of B in decreasing + order. + + E (input/output) DOUBLE PRECISION array, dimension (N-1) + On entry, the N-1 offdiagonal elements of the bidiagonal matrix + B. On exit, if INFO = 0, E is destroyed; if INFO > 0, D and E + will contain the diagonal and superdiagonal elements of a bidi- + agonal matrix orthogonally equivalent to the one given as + input. + + VT (input/output) DOUBLE PRECISION array, dimension (LDVT, NCVT) + On entry, an N-by-NCVT matrix VT. On exit, VT is overwritten + by P**T * VT. Not referenced if NCVT = 0. + + LDVT (input) INTEGER + The leading dimension of the array VT. LDVT >= max(1,N) if + NCVT > 0; LDVT >= 1 if NCVT = 0. + + U (input/output) DOUBLE PRECISION array, dimension (LDU, N) + On entry, an NRU-by-N matrix U. On exit, U is overwritten by U + * Q. Not referenced if NRU = 0. + + LDU (input) INTEGER + The leading dimension of the array U. LDU >= max(1,NRU). + + C (input/output) DOUBLE PRECISION array, dimension (LDC, NCC) + On entry, an N-by-NCC matrix C. On exit, C is overwritten by + Q**T * C. Not referenced if NCC = 0. + + LDC (input) INTEGER + The leading dimension of the array C. LDC >= max(1,N) if NCC > + 0; LDC >=1 if NCC = 0. + + WORK (workspace) DOUBLE PRECISION array, dimension (2*N) + if NCVT = NRU = NCC = 0, (max(1, 4*N)) otherwise + + INFO (output) INTEGER + = 0: successful exit + < 0: If INFO = -i, the i-th argument had an illegal value + > 0: the algorithm did not converge; D and E contain the ele- + ments of a bidiagonal matrix which is orthogonally similar to + the input matrix B; if INFO = i, i elements of E have not con- + verged to zero. + +PARAMETERS + TOLMUL DOUBLE PRECISION, default = max(10,min(100,EPS**(-1/8))) + TOLMUL controls the convergence criterion of the QR loop. If + it is positive, TOLMUL*EPS is the desired relative precision in + the computed singular values. If it is negative, abs(TOL- + MUL*EPS*sigma_max) is the desired absolute accuracy in the com- + puted singular values (corresponds to relative accuracy + abs(TOLMUL*EPS) in the largest singular value. abs(TOLMUL) + should be between 1 and 1/EPS, and preferably between 10 (for + fast convergence) and .1/EPS (for there to be some accuracy in + the results). Default is to lose at either one eighth or 2 of + the available decimal digits in each computed singular value + (whichever is smaller). + + MAXITR INTEGER, default = 6 + MAXITR controls the maximum number of passes of the algorithm + through its inner loop. The algorithms stops (and so fails to + converge) if the number of passes through the inner loop + exceeds MAXITR*N**2. + +@ + <>= (let* ((zero 0.0) (one 1.0) @@ -22073,7 +29313,7 @@ The return values are: (defun dbdsqr (uplo n ncvt nru ncc d e vt ldvt u ldu c ldc work info) (declare (type (array double-float (*)) work c u vt e d) (type fixnum info ldc ldu ldvt ncc nru ncvt n) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (d double-float d-%data% d-%offset%) @@ -22098,9 +29338,9 @@ The return values are: nm1 nm12 nm13 oldll oldm) (type (member t nil) lower rotate)) (setf info 0) - (setf lower (lsame uplo "L")) + (setf lower (char-equal uplo #\L)) (cond - ((and (not (lsame uplo "U")) (not lower)) + ((and (not (char-equal uplo #\U)) (not lower)) (setf info -1)) ((< n 0) (setf info -2)) @@ -22126,7 +29366,9 @@ The return values are: (setf info -13))) (cond ((/= info 0) - (xerbla "DBDSQR" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DBDSQR" (f2cl-lib:int-sub info)) (go end_label))) (if (= n 0) (go end_label)) (if (= n 1) (go label160)) @@ -23181,42 +30423,104 @@ The return values are: nil info)))))) -;(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::dbdsqr -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; fixnum fixnum -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dswap fortran-to-lisp::dscal -; fortran-to-lisp::dlas2 fortran-to-lisp::drot -; fortran-to-lisp::dlasv2 fortran-to-lisp::dlasr -; fortran-to-lisp::dlartg fortran-to-lisp::dlamch -; fortran-to-lisp::dlasq1 fortran-to-lisp::xerbla -; fortran-to-lisp::lsame))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ddisna LAPACK} %\pagehead{ddisna}{ddisna} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ddisna.output +)spool ddisna.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ddisna examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DDISNA - the reciprocal condition numbers for the eigenvectors of a + real symmetric or complex Hermitian matrix or for the left or right + singular vectors of a general m-by-n matrix + +SYNOPSIS + SUBROUTINE DDISNA( JOB, M, N, D, SEP, INFO ) + + CHARACTER JOB + + INTEGER INFO, M, N + + DOUBLE PRECISION D( * ), SEP( * ) + +PURPOSE + DDISNA computes the reciprocal condition numbers for the eigenvectors + of a real symmetric or complex Hermitian matrix or for the left or + right singular vectors of a general m-by-n matrix. The reciprocal con- + dition number is the 'gap' between the corresponding eigenvalue or sin- + gular value and the nearest other one. + + The bound on the error, measured by angle in radians, in the I-th com- + puted vector is given by + + DLAMCH( 'E' ) * ( ANORM / SEP( I ) ) + + where ANORM = 2-norm(A) = max( abs( D(j) ) ). SEP(I) is not allowed to + be smaller than DLAMCH( 'E' )*ANORM in order to limit the size of the + error bound. + + DDISNA may also be used to compute error bounds for eigenvectors of the + generalized symmetric definite eigenproblem. + + +ARGUMENTS + JOB (input) CHARACTER*1 + Specifies for which problem the reciprocal condition numbers + should be computed: + = 'E': the eigenvectors of a symmetric/Hermitian matrix; + = 'L': the left singular vectors of a general matrix; + = 'R': the right singular vectors of a general matrix. + + M (input) INTEGER + The number of rows of the matrix. M >= 0. + + N (input) INTEGER + If JOB = 'L' or 'R', the number of columns of the matrix, in + which case N >= 0. Ignored if JOB = 'E'. + + D (input) DOUBLE PRECISION array, dimension (M) if JOB = 'E' + dimension (min(M,N)) if JOB = 'L' or 'R' The eigenvalues (if + JOB = 'E') or singular values (if JOB = 'L' or 'R') of the + matrix, in either increasing or decreasing order. If singular + values, they must be non-negative. + + SEP (output) DOUBLE PRECISION array, dimension (M) if JOB = 'E' + dimension (min(M,N)) if JOB = 'L' or 'R' The reciprocal condi- + tion numbers of the vectors. + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) (defun ddisna (job m n d sep info) (declare (type (array double-float (*)) sep d) (type fixnum info n m) - (type (simple-array character (*)) job)) + (type character job)) (f2cl-lib:with-multi-array-data ((job character job-%data% job-%offset%) (d double-float d-%data% d-%offset%) @@ -23228,9 +30532,9 @@ The return values are: (type fixnum i k) (type (member t nil) decr eigen incr left right sing)) (setf info 0) - (setf eigen (lsame job "E")) - (setf left (lsame job "L")) - (setf right (lsame job "R")) + (setf eigen (char-equal job #\E)) + (setf left (char-equal job #\L)) + (setf right (char-equal job #\R)) (setf sing (or left right)) (cond (eigen @@ -23293,7 +30597,9 @@ The return values are: (if (not (or incr decr)) (setf info -4)))) (cond ((/= info 0) - (xerbla "DDISNA" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DDISNA" (f2cl-lib:int-sub info)) (go end_label))) (if (= k 0) (go end_label)) (cond @@ -23357,33 +30663,101 @@ The return values are: end_label (return (values nil nil nil nil nil info)))))) -;(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::ddisna -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlamch fortran-to-lisp::xerbla -; fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgebak LAPACK} %\pagehead{dgebak}{dgebak} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgebak.output +)spool dgebak.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgebak examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGEBAK - the right or left eigenvectors of a real general matrix by + backward transformation on the computed eigenvectors of the balanced + matrix output by DGEBAL + +SYNOPSIS + SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO ) + + CHARACTER JOB, SIDE + + INTEGER IHI, ILO, INFO, LDV, M, N + + DOUBLE PRECISION SCALE( * ), V( LDV, * ) + +PURPOSE + DGEBAK forms the right or left eigenvectors of a real general matrix by + backward transformation on the computed eigenvectors of the balanced + matrix output by DGEBAL. + + +ARGUMENTS + JOB (input) CHARACTER*1 + Specifies the type of backward transformation required: = 'N', + do nothing, return immediately; = 'P', do backward transforma- + tion for permutation only; = 'S', do backward transformation + for scaling only; = 'B', do backward transformations for both + permutation and scaling. JOB must be the same as the argument + JOB supplied to DGEBAL. + + SIDE (input) CHARACTER*1 + = 'R': V contains right eigenvectors; + = 'L': V contains left eigenvectors. + + N (input) INTEGER + The number of rows of the matrix V. N >= 0. + + ILO (input) INTEGER + IHI (input) INTEGER The integers ILO and IHI determined by + DGEBAL. 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if + N=0. + + SCALE (input) DOUBLE PRECISION array, dimension (N) + Details of the permutation and scaling factors, as returned by + DGEBAL. + + M (input) INTEGER + The number of columns of the matrix V. M >= 0. + + V (input/output) DOUBLE PRECISION array, dimension (LDV,M) + On entry, the matrix of right or left eigenvectors to be trans- + formed, as returned by DHSEIN or DTREVC. On exit, V is over- + written by the transformed eigenvectors. + + LDV (input) INTEGER + The leading dimension of the array V. LDV >= max(1,N). + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value. + +@ + <>= (let* ((one 1.0)) (declare (type (double-float 1.0 1.0) one)) (defun dgebak (job side n ilo ihi scale m v ldv info) (declare (type (array double-float (*)) v scale) (type fixnum info ldv m ihi ilo n) - (type (simple-array character (*)) side job)) + (type character side job)) (f2cl-lib:with-multi-array-data ((job character job-%data% job-%offset%) (side character side-%data% side-%offset%) @@ -23393,14 +30767,14 @@ The return values are: (declare (type (double-float) s) (type fixnum i ii k) (type (member t nil) leftv rightv)) - (setf rightv (lsame side "R")) - (setf leftv (lsame side "L")) + (setf rightv (char-equal side #\R)) + (setf leftv (char-equal side #\L)) (setf info 0) (cond - ((and (not (lsame job "N")) - (not (lsame job "P")) - (not (lsame job "S")) - (not (lsame job "B"))) + ((and (not (char-equal job #\N)) + (not (char-equal job #\P)) + (not (char-equal job #\S)) + (not (char-equal job #\B))) (setf info -1)) ((and (not rightv) (not leftv)) (setf info -2)) @@ -23420,14 +30794,16 @@ The return values are: (setf info -9))) (cond ((/= info 0) - (xerbla "DGEBAK" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEBAK" (f2cl-lib:int-sub info)) (go end_label))) (if (= n 0) (go end_label)) (if (= m 0) (go end_label)) - (if (lsame job "N") (go end_label)) + (if (char-equal job #\N) (go end_label)) (if (= ilo ihi) (go label30)) (cond - ((or (lsame job "S") (lsame job "B")) + ((or (char-equal job #\S) (char-equal job #\B)) (cond (rightv (f2cl-lib:fdo (i ilo (f2cl-lib:int-add i 1)) @@ -23457,7 +30833,7 @@ The return values are: ldv))))))) label30 (cond - ((or (lsame job "P") (lsame job "B")) + ((or (char-equal job #\P) (char-equal job #\B)) (cond (rightv (f2cl-lib:fdo (ii 1 (f2cl-lib:int-add ii 1)) @@ -23503,30 +30879,117 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil nil nil info)))))) -;(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::dgebak -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dswap fortran-to-lisp::dscal -; fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgebal LAPACK} %\pagehead{dgebal}{dgebal} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgebal.output +)spool dgebal.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgebal examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGEBAL - a general real matrix A + +SYNOPSIS + SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO ) + + CHARACTER JOB + + INTEGER IHI, ILO, INFO, LDA, N + + DOUBLE PRECISION A( LDA, * ), SCALE( * ) + +PURPOSE + DGEBAL balances a general real matrix A. This involves, first, permut- + ing A by a similarity transformation to isolate eigenvalues in the + first 1 to ILO-1 and last IHI+1 to N elements on the diagonal; and sec- + ond, applying a diagonal similarity transformation to rows and columns + ILO to IHI to make the rows and columns as close in norm as possible. + Both steps are optional. + + Balancing may reduce the 1-norm of the matrix, and improve the accuracy + of the computed eigenvalues and/or eigenvectors. + + +ARGUMENTS + JOB (input) CHARACTER*1 + Specifies the operations to be performed on A: + = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0 for + i = 1,...,N; = 'P': permute only; + = 'S': scale only; + = 'B': both permute and scale. + + N (input) INTEGER + The order of the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the input matrix A. On exit, A is overwritten by + the balanced matrix. If JOB = 'N', A is not referenced. See + Further Details. LDA (input) INTEGER The leading dimension + of the array A. LDA >= max(1,N). + + ILO (output) INTEGER + IHI (output) INTEGER ILO and IHI are set to integers such + that on exit A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = + IHI+1,...,N. If JOB = 'N' or 'S', ILO = 1 and IHI = N. + + SCALE (output) DOUBLE PRECISION array, dimension (N) + Details of the permutations and scaling factors applied to A. + If P(j) is the index of the row and column interchanged with + row and column j and D(j) is the scaling factor applied to row + and column j, then SCALE(j) = P(j) for j = 1,...,ILO-1 = + D(j) for j = ILO,...,IHI = P(j) for j = IHI+1,...,N. The + order in which the interchanges are made is N to IHI+1, then 1 + to ILO-1. + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + +FURTHER DETAILS + The permutations consist of row and column interchanges which put the + matrix in the form + + ( T1 X Y ) + P A P = ( 0 B Z ) + ( 0 0 T2 ) + + where T1 and T2 are upper triangular matrices whose eigenvalues lie + along the diagonal. The column indices ILO and IHI mark the starting + and ending columns of the submatrix B. Balancing consists of applying a + diagonal similarity transformation inv(D) * B * D to make the 1-norms + of each row of B and its corresponding column nearly equal. The output + matrix is + + ( T1 X*D Y ) + ( 0 inv(D)*B*D inv(D)*Z ). + ( 0 0 T2 ) + + Information about the permutations P and the diagonal matrix D is + returned in the vector SCALE. + + This subroutine is based on the EISPACK routine BALANC. + +@ + <>= (let* ((zero 0.0) (one 1.0) (sclfac 8.0) (factor 0.95)) (declare (type (double-float 0.0 0.0) zero) @@ -23536,7 +30999,7 @@ The return values are: (defun dgebal (job n a lda ilo ihi scale info) (declare (type (array double-float (*)) scale a) (type fixnum info ihi ilo lda n) - (type (simple-array character (*)) job)) + (type character job)) (f2cl-lib:with-multi-array-data ((job character job-%data% job-%offset%) (a double-float a-%data% a-%offset%) @@ -23550,10 +31013,10 @@ The return values are: (type (member t nil) noconv)) (setf info 0) (cond - ((and (not (lsame job "N")) - (not (lsame job "P")) - (not (lsame job "S")) - (not (lsame job "B"))) + ((and (not (char-equal job #\N)) + (not (char-equal job #\P)) + (not (char-equal job #\S)) + (not (char-equal job #\B))) (setf info -1)) ((< n 0) (setf info -2)) @@ -23561,20 +31024,22 @@ The return values are: (setf info -4))) (cond ((/= info 0) - (xerbla "DGEBAL" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEBAL" (f2cl-lib:int-sub info)) (go end_label))) (setf k 1) (setf l n) (if (= n 0) (go label210)) (cond - ((lsame job "N") + ((char-equal job #\N) (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i n) nil) (tagbody (setf (f2cl-lib:fref scale-%data% (i) ((1 *)) scale-%offset%) one))) (go label210))) - (if (lsame job "S") (go label120)) + (if (char-equal job #\S) (go label120)) (go label50) label20 (setf (f2cl-lib:fref scale-%data% (m) ((1 *)) scale-%offset%) @@ -23632,7 +31097,7 @@ The return values are: ((> i l) nil) (tagbody (setf (f2cl-lib:fref scale-%data% (i) ((1 *)) scale-%offset%) one))) - (if (lsame job "P") (go label210)) + (if (char-equal job #\P) (go label210)) (setf sfmin1 (/ (dlamch "S") (dlamch "P"))) (setf sfmax1 (/ one sfmin1)) (setf sfmin2 (* sfmin1 sclfac)) @@ -23749,29 +31214,143 @@ The return values are: end_label (return (values nil nil nil nil ilo ihi nil info)))))) -;(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::dgebal -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (array double-float (*)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil fortran-to-lisp::ilo -; fortran-to-lisp::ihi nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dscal fortran-to-lisp::idamax -; fortran-to-lisp::dlamch fortran-to-lisp::dswap -; fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgebd2 LAPACK} %\pagehead{dgebd2}{dgebd2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgebd2.output +)spool dgebd2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgebd2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGEBD2 - a real general m by n matrix A to upper or lower bidiagonal + form B by an orthogonal transformation + +SYNOPSIS + SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO ) + + INTEGER INFO, LDA, M, N + + DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ), + TAUQ( * ), WORK( * ) + +PURPOSE + DGEBD2 reduces a real general m by n matrix A to upper or lower bidiag- + onal form B by an orthogonal transformation: Q' * A * P = B. + + If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. + + +ARGUMENTS + M (input) INTEGER + The number of rows in the matrix A. M >= 0. + + N (input) INTEGER + The number of columns in the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the m by n general matrix to be reduced. On exit, if + m >= n, the diagonal and the first superdiagonal are overwrit- + ten with the upper bidiagonal matrix B; the elements below the + diagonal, with the array TAUQ, represent the orthogonal matrix + Q as a product of elementary reflectors, and the elements above + the first superdiagonal, with the array TAUP, represent the + orthogonal matrix P as a product of elementary reflectors; if m + < n, the diagonal and the first subdiagonal are overwritten + with the lower bidiagonal matrix B; the elements below the + first subdiagonal, with the array TAUQ, represent the orthogo- + nal matrix Q as a product of elementary reflectors, and the + elements above the diagonal, with the array TAUP, represent the + orthogonal matrix P as a product of elementary reflectors. See + Further Details. LDA (input) INTEGER The leading dimension + of the array A. LDA >= max(1,M). + + D (output) DOUBLE PRECISION array, dimension (min(M,N)) + The diagonal elements of the bidiagonal matrix B: D(i) = + A(i,i). + + E (output) DOUBLE PRECISION array, dimension (min(M,N)-1) + The off-diagonal elements of the bidiagonal matrix B: if m >= + n, E(i) = A(i,i+1) for i = 1,2,...,n-1; if m < n, E(i) = + A(i+1,i) for i = 1,2,...,m-1. + + TAUQ (output) DOUBLE PRECISION array dimension (min(M,N)) + The scalar factors of the elementary reflectors which represent + the orthogonal matrix Q. See Further Details. TAUP (output) + DOUBLE PRECISION array, dimension (min(M,N)) The scalar factors + of the elementary reflectors which represent the orthogonal + matrix P. See Further Details. WORK (workspace) DOUBLE PRE- + CISION array, dimension (max(M,N)) + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + +FURTHER DETAILS + The matrices Q and P are represented as products of elementary reflec- + tors: + + If m >= n, + + Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1) + + Each H(i) and G(i) has the form: + + H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' + + where tauq and taup are real scalars, and v and u are real vectors; + v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i); + u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n); + tauq is stored in TAUQ(i) and taup in TAUP(i). + + If m < n, + + Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m) + + Each H(i) and G(i) has the form: + + H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' + + where tauq and taup are real scalars, and v and u are real vectors; + v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i); + u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n); + tauq is stored in TAUQ(i) and taup in TAUP(i). + + The contents of A on exit are illustrated by the following examples: + + m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n): + + ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 ) + ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 ) + ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 ) + ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 ) + ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 ) + ( v1 v2 v3 v4 v5 ) + + where d and e denote diagonal and off-diagonal elements of B, vi + denotes an element of the vector defining H(i), and ui an element of + the vector defining G(i). + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -23798,7 +31377,9 @@ The return values are: (setf info -4))) (cond ((< info 0) - (xerbla "DGEBD2" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEBD2" (f2cl-lib:int-sub info)) (go end_label))) (cond ((>= m n) @@ -23989,28 +31570,154 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil nil nil info)))))) -;(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::dgebd2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarf fortran-to-lisp::dlarfg -; fortran-to-lisp::xerbla)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgebrd LAPACK} %\pagehead{dgebrd}{dgebrd} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgebrd.output +)spool dgebrd.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgebrd examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGEBRD - a general real M-by-N matrix A to upper or lower bidiagonal + form B by an orthogonal transformation + +SYNOPSIS + SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO ) + + INTEGER INFO, LDA, LWORK, M, N + + DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ), + TAUQ( * ), WORK( * ) + +PURPOSE + DGEBRD reduces a general real M-by-N matrix A to upper or lower bidiag- + onal form B by an orthogonal transformation: Q**T * A * P = B. + + If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal. + + +ARGUMENTS + M (input) INTEGER + The number of rows in the matrix A. M >= 0. + + N (input) INTEGER + The number of columns in the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the M-by-N general matrix to be reduced. On exit, if + m >= n, the diagonal and the first superdiagonal are overwrit- + ten with the upper bidiagonal matrix B; the elements below the + diagonal, with the array TAUQ, represent the orthogonal matrix + Q as a product of elementary reflectors, and the elements above + the first superdiagonal, with the array TAUP, represent the + orthogonal matrix P as a product of elementary reflectors; if m + < n, the diagonal and the first subdiagonal are overwritten + with the lower bidiagonal matrix B; the elements below the + first subdiagonal, with the array TAUQ, represent the orthogo- + nal matrix Q as a product of elementary reflectors, and the + elements above the diagonal, with the array TAUP, represent the + orthogonal matrix P as a product of elementary reflectors. See + Further Details. LDA (input) INTEGER The leading dimension + of the array A. LDA >= max(1,M). + + D (output) DOUBLE PRECISION array, dimension (min(M,N)) + The diagonal elements of the bidiagonal matrix B: D(i) = + A(i,i). + + E (output) DOUBLE PRECISION array, dimension (min(M,N)-1) + The off-diagonal elements of the bidiagonal matrix B: if m >= + n, E(i) = A(i,i+1) for i = 1,2,...,n-1; if m < n, E(i) = + A(i+1,i) for i = 1,2,...,m-1. + + TAUQ (output) DOUBLE PRECISION array dimension (min(M,N)) + The scalar factors of the elementary reflectors which represent + the orthogonal matrix Q. See Further Details. TAUP (output) + DOUBLE PRECISION array, dimension (min(M,N)) The scalar factors + of the elementary reflectors which represent the orthogonal + matrix P. See Further Details. WORK (workspace/output) DOU- + BLE PRECISION array, dimension (MAX(1,LWORK)) On exit, if INFO + = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The length of the array WORK. LWORK >= max(1,M,N). For opti- + mum performance LWORK >= (M+N)*NB, where NB is the optimal + blocksize. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value. + +FURTHER DETAILS + The matrices Q and P are represented as products of elementary reflec- + tors: + + If m >= n, + + Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1) + + Each H(i) and G(i) has the form: + + H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' + + where tauq and taup are real scalars, and v and u are real vectors; + v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i); + u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n); + tauq is stored in TAUQ(i) and taup in TAUP(i). + + If m < n, + + Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m) + + Each H(i) and G(i) has the form: + + H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' + + where tauq and taup are real scalars, and v and u are real vectors; + v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i); + u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n); + tauq is stored in TAUQ(i) and taup in TAUP(i). + + The contents of A on exit are illustrated by the following examples: + + m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n): + + ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 ) + ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 ) + ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 ) + ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 ) + ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 ) + ( v1 v2 v3 v4 v5 ) + + where d and e denote diagonal and off-diagonal elements of B, vi + denotes an element of the vector defining H(i), and ui an element of + the vector defining G(i). + +@ + <>= (let* ((one 1.0)) (declare (type (double-float 1.0 1.0) one)) @@ -24055,7 +31762,9 @@ The return values are: (setf info -10))) (cond ((< info 0) - (xerbla "DGEBRD" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEBRD" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -24190,30 +31899,137 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dgebrd -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dgebd2 fortran-to-lisp::dgemm -; fortran-to-lisp::dlabrd fortran-to-lisp::xerbla -; fortran-to-lisp::ilaenv)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgeev LAPACK} %\pagehead{dgeev}{dgeev} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgeev.output +)spool dgeev.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgeev examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGEEV - for an N-by-N real nonsymmetric matrix A, the eigenvalues and, + optionally, the left and/or right eigenvectors + +SYNOPSIS + SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, + WORK, LWORK, INFO ) + + CHARACTER JOBVL, JOBVR + + INTEGER INFO, LDA, LDVL, LDVR, LWORK, N + + DOUBLE PRECISION A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + WI( * ), WORK( * ), WR( * ) + +PURPOSE + DGEEV computes for an N-by-N real nonsymmetric matrix A, the eigenval- + ues and, optionally, the left and/or right eigenvectors. + + The right eigenvector v(j) of A satisfies + A * v(j) = lambda(j) * v(j) + where lambda(j) is its eigenvalue. + The left eigenvector u(j) of A satisfies + u(j)**H * A = lambda(j) * u(j)**H + where u(j)**H denotes the conjugate transpose of u(j). + + The computed eigenvectors are normalized to have Euclidean norm equal + to 1 and largest component real. + + +ARGUMENTS + JOBVL (input) CHARACTER*1 + = 'N': left eigenvectors of A are not computed; + = 'V': left eigenvectors of A are computed. + + JOBVR (input) CHARACTER*1 + = 'N': right eigenvectors of A are not computed; + = 'V': right eigenvectors of A are computed. + + N (input) INTEGER + The order of the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the N-by-N matrix A. On exit, A has been overwrit- + ten. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,N). + + WR (output) DOUBLE PRECISION array, dimension (N) + WI (output) DOUBLE PRECISION array, dimension (N) WR and + WI contain the real and imaginary parts, respectively, of the + computed eigenvalues. Complex conjugate pairs of eigenvalues + appear consecutively with the eigenvalue having the positive + imaginary part first. + + VL (output) DOUBLE PRECISION array, dimension (LDVL,N) + If JOBVL = 'V', the left eigenvectors u(j) are stored one after + another in the columns of VL, in the same order as their eigen- + values. If JOBVL = 'N', VL is not referenced. If the j-th + eigenvalue is real, then u(j) = VL(:,j), the j-th column of VL. + If the j-th and (j+1)-st eigenvalues form a complex conjugate + pair, then u(j) = VL(:,j) + i*VL(:,j+1) and + u(j+1) = VL(:,j) - i*VL(:,j+1). + + LDVL (input) INTEGER + The leading dimension of the array VL. LDVL >= 1; if JOBVL = + 'V', LDVL >= N. + + VR (output) DOUBLE PRECISION array, dimension (LDVR,N) + If JOBVR = 'V', the right eigenvectors v(j) are stored one + after another in the columns of VR, in the same order as their + eigenvalues. If JOBVR = 'N', VR is not referenced. If the j- + th eigenvalue is real, then v(j) = VR(:,j), the j-th column of + VR. If the j-th and (j+1)-st eigenvalues form a complex conju- + gate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and + v(j+1) = VR(:,j) - i*VR(:,j+1). + + LDVR (input) INTEGER + The leading dimension of the array VR. LDVR >= 1; if JOBVR = + 'V', LDVR >= N. + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The dimension of the array WORK. LWORK >= max(1,3*N), and if + JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good perfor- + mance, LWORK must generally be larger. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value. + > 0: if INFO = i, the QR algorithm failed to compute all the + eigenvalues, and no eigenvectors have been computed; elements + i+1:N of WR and WI contain eigenvalues which have converged. + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -24221,7 +32037,7 @@ The return values are: (defun dgeev (jobvl jobvr n a lda wr wi vl ldvl vr ldvr work lwork info) (declare (type (array double-float (*)) work vr vl wi wr a) (type fixnum info lwork ldvr ldvl lda n) - (type (simple-array character (*)) jobvr jobvl)) + (type character jobvr jobvl)) (f2cl-lib:with-multi-array-data ((jobvl character jobvl-%data% jobvl-%offset%) (jobvr character jobvr-%data% jobvr-%offset%) @@ -24249,12 +32065,12 @@ The return values are: (type (member t nil) lquery scalea wantvl wantvr)) (setf info 0) (setf lquery (coerce (= lwork -1) '(member t nil))) - (setf wantvl (lsame jobvl "V")) - (setf wantvr (lsame jobvr "V")) + (setf wantvl (char-equal jobvl #\V)) + (setf wantvr (char-equal jobvr #\V)) (cond - ((and (not wantvl) (not (lsame jobvl "N"))) + ((and (not wantvl) (not (char-equal jobvl #\N))) (setf info -1)) - ((and (not wantvr) (not (lsame jobvr "N"))) + ((and (not wantvr) (not (char-equal jobvr #\N))) (setf info -2)) ((< n 0) (setf info -3)) @@ -24342,7 +32158,9 @@ The return values are: (setf info -13))) (cond ((/= info 0) - (xerbla "DGEEV " (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEEV " (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -24742,39 +32560,218 @@ The return values are: (return (values nil nil nil nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dgeev fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::drot fortran-to-lisp::dlartg -; fortran-to-lisp::idamax fortran-to-lisp::dlapy2 -; fortran-to-lisp::dscal fortran-to-lisp::dnrm2 -; fortran-to-lisp::dgebak fortran-to-lisp::dtrevc -; fortran-to-lisp::dhseqr fortran-to-lisp::dorghr -; fortran-to-lisp::dlacpy fortran-to-lisp::dgehrd -; fortran-to-lisp::dgebal fortran-to-lisp::dlascl -; fortran-to-lisp::dlange fortran-to-lisp::dlabad -; fortran-to-lisp::dlamch fortran-to-lisp::xerbla -; fortran-to-lisp::ilaenv fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgeevx LAPACK} %\pagehead{dgeevx}{dgeevx} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgeevx.output +)spool dgeevx.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgeevx examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGEEVX - for an N-by-N real nonsymmetric matrix A, the eigenvalues and, + optionally, the left and/or right eigenvectors + +SYNOPSIS + SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, VL, + LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, + RCONDV, WORK, LWORK, IWORK, INFO ) + + CHARACTER BALANC, JOBVL, JOBVR, SENSE + + INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N + + DOUBLE PRECISION ABNRM + + INTEGER IWORK( * ) + + DOUBLE PRECISION A( LDA, * ), RCONDE( * ), RCONDV( * ), + SCALE( * ), VL( LDVL, * ), VR( LDVR, * ), WI( * ), + WORK( * ), WR( * ) + +PURPOSE + DGEEVX computes for an N-by-N real nonsymmetric matrix A, the eigenval- + ues and, optionally, the left and/or right eigenvectors. + + Optionally also, it computes a balancing transformation to improve the + conditioning of the eigenvalues and eigenvectors (ILO, IHI, SCALE, and + ABNRM), reciprocal condition numbers for the eigenvalues (RCONDE), and + reciprocal condition numbers for the right + eigenvectors (RCONDV). + + The right eigenvector v(j) of A satisfies + A * v(j) = lambda(j) * v(j) + where lambda(j) is its eigenvalue. + The left eigenvector u(j) of A satisfies + u(j)**H * A = lambda(j) * u(j)**H + where u(j)**H denotes the conjugate transpose of u(j). + + The computed eigenvectors are normalized to have Euclidean norm equal + to 1 and largest component real. + + Balancing a matrix means permuting the rows and columns to make it more + nearly upper triangular, and applying a diagonal similarity transforma- + tion D * A * D**(-1), where D is a diagonal matrix, to make its rows + and columns closer in norm and the condition numbers of its eigenvalues + and eigenvectors smaller. The computed reciprocal condition numbers + correspond to the balanced matrix. Permuting rows and columns will not + change the condition numbers (in exact arithmetic) but diagonal scaling + will. For further explanation of balancing, see section 4.10.2 of the + LAPACK Users' Guide. + + +ARGUMENTS + BALANC (input) CHARACTER*1 + Indicates how the input matrix should be diagonally scaled + and/or permuted to improve the conditioning of its eigenvalues. + = 'N': Do not diagonally scale or permute; + = 'P': Perform permutations to make the matrix more nearly + upper triangular. Do not diagonally scale; = 'S': Diagonally + scale the matrix, i.e. replace A by D*A*D**(-1), where D is a + diagonal matrix chosen to make the rows and columns of A more + equal in norm. Do not permute; = 'B': Both diagonally scale and + permute A. + + Computed reciprocal condition numbers will be for the matrix + after balancing and/or permuting. Permuting does not change + condition numbers (in exact arithmetic), but balancing does. + + JOBVL (input) CHARACTER*1 + = 'N': left eigenvectors of A are not computed; + = 'V': left eigenvectors of A are computed. If SENSE = 'E' or + 'B', JOBVL must = 'V'. + + JOBVR (input) CHARACTER*1 + = 'N': right eigenvectors of A are not computed; + = 'V': right eigenvectors of A are computed. If SENSE = 'E' or + 'B', JOBVR must = 'V'. + + SENSE (input) CHARACTER*1 + Determines which reciprocal condition numbers are computed. = + 'N': None are computed; + = 'E': Computed for eigenvalues only; + = 'V': Computed for right eigenvectors only; + = 'B': Computed for eigenvalues and right eigenvectors. + + If SENSE = 'E' or 'B', both left and right eigenvectors must + also be computed (JOBVL = 'V' and JOBVR = 'V'). + + N (input) INTEGER + The order of the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the N-by-N matrix A. On exit, A has been overwrit- + ten. If JOBVL = 'V' or JOBVR = 'V', A contains the real Schur + form of the balanced version of the input matrix A. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,N). + + WR (output) DOUBLE PRECISION array, dimension (N) + WI (output) DOUBLE PRECISION array, dimension (N) WR and + WI contain the real and imaginary parts, respectively, of the + computed eigenvalues. Complex conjugate pairs of eigenvalues + will appear consecutively with the eigenvalue having the posi- + tive imaginary part first. + + VL (output) DOUBLE PRECISION array, dimension (LDVL,N) + If JOBVL = 'V', the left eigenvectors u(j) are stored one after + another in the columns of VL, in the same order as their eigen- + values. If JOBVL = 'N', VL is not referenced. If the j-th + eigenvalue is real, then u(j) = VL(:,j), the j-th column of VL. + If the j-th and (j+1)-st eigenvalues form a complex conjugate + pair, then u(j) = VL(:,j) + i*VL(:,j+1) and + u(j+1) = VL(:,j) - i*VL(:,j+1). + + LDVL (input) INTEGER + The leading dimension of the array VL. LDVL >= 1; if JOBVL = + 'V', LDVL >= N. + + VR (output) DOUBLE PRECISION array, dimension (LDVR,N) + If JOBVR = 'V', the right eigenvectors v(j) are stored one + after another in the columns of VR, in the same order as their + eigenvalues. If JOBVR = 'N', VR is not referenced. If the j- + th eigenvalue is real, then v(j) = VR(:,j), the j-th column of + VR. If the j-th and (j+1)-st eigenvalues form a complex conju- + gate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and + v(j+1) = VR(:,j) - i*VR(:,j+1). + + LDVR (input) INTEGER + The leading dimension of the array VR. LDVR >= 1, and if JOBVR + = 'V', LDVR >= N. + + ILO (output) INTEGER + IHI (output) INTEGER ILO and IHI are integer values deter- + mined when A was balanced. The balanced A(i,j) = 0 if I > J + and J = 1,...,ILO-1 or I = IHI+1,...,N. + + SCALE (output) DOUBLE PRECISION array, dimension (N) + Details of the permutations and scaling factors applied when + balancing A. If P(j) is the index of the row and column inter- + changed with row and column j, and D(j) is the scaling factor + applied to row and column j, then SCALE(J) = P(J), for J = + 1,...,ILO-1 = D(J), for J = ILO,...,IHI = P(J) for J = + IHI+1,...,N. The order in which the interchanges are made is N + to IHI+1, then 1 to ILO-1. + + ABNRM (output) DOUBLE PRECISION + The one-norm of the balanced matrix (the maximum of the sum of + absolute values of elements of any column). + + RCONDE (output) DOUBLE PRECISION array, dimension (N) + RCONDE(j) is the reciprocal condition number of the j-th eigen- + value. + + RCONDV (output) DOUBLE PRECISION array, dimension (N) + RCONDV(j) is the reciprocal condition number of the j-th right + eigenvector. + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The dimension of the array WORK. If SENSE = 'N' or 'E', LWORK + >= max(1,2*N), and if JOBVL = 'V' or JOBVR = 'V', LWORK >= 3*N. + If SENSE = 'V' or 'B', LWORK >= N*(N+6). For good performance, + LWORK must generally be larger. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + IWORK (workspace) INTEGER array, dimension (2*N-2) + If SENSE = 'N' or 'E', not referenced. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value. + > 0: if INFO = i, the QR algorithm failed to compute all the + eigenvalues, and no eigenvectors or condition numbers have been + computed; elements 1:ILO-1 and i+1:N of WR and WI contain + eigenvalues which have converged. + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -24787,7 +32784,7 @@ The return values are: (type (array double-float (*)) work rcondv rconde scale vr vl wi wr a) (type fixnum info lwork ihi ilo ldvr ldvl lda n) - (type (simple-array character (*)) sense jobvr jobvl balanc)) + (type character sense jobvr jobvl balanc)) (f2cl-lib:with-multi-array-data ((balanc character balanc-%data% balanc-%offset%) (jobvl character jobvl-%data% jobvl-%offset%) @@ -24825,22 +32822,22 @@ The return values are: wntsne wntsnn wntsnv)) (setf info 0) (setf lquery (coerce (= lwork -1) '(member t nil))) - (setf wantvl (lsame jobvl "V")) - (setf wantvr (lsame jobvr "V")) - (setf wntsnn (lsame sense "N")) - (setf wntsne (lsame sense "E")) - (setf wntsnv (lsame sense "V")) - (setf wntsnb (lsame sense "B")) + (setf wantvl (char-equal jobvl #\V)) + (setf wantvr (char-equal jobvr #\V)) + (setf wntsnn (char-equal sense #\N)) + (setf wntsne (char-equal sense #\E)) + (setf wntsnv (char-equal sense #\V)) + (setf wntsnb (char-equal sense #\B)) (cond ((not - (or (lsame balanc "N") - (lsame balanc "S") - (lsame balanc "P") - (lsame balanc "B"))) + (or (char-equal balanc #\N) + (char-equal balanc #\S) + (char-equal balanc #\P) + (char-equal balanc #\B))) (setf info -1)) - ((and (not wantvl) (not (lsame jobvl "N"))) + ((and (not wantvl) (not (char-equal jobvl #\N))) (setf info -2)) - ((and (not wantvr) (not (lsame jobvr "N"))) + ((and (not wantvr) (not (char-equal jobvr #\N))) (setf info -3)) ((or (not (or wntsnn wntsne wntsnb wntsnv)) (and (or wntsne wntsnb) (not (and wantvl wantvr)))) @@ -24971,7 +32968,9 @@ The return values are: (setf info -21))) (cond ((/= info 0) - (xerbla "DGEEVX" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEEVX" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -25410,49 +33409,110 @@ The return values are: nil info)))))) -;(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::dgeevx -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum fixnum -; fixnum (array double-float (*)) -; (double-float) (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; fixnum -; (array fixnum (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::ilo fortran-to-lisp::ihi nil -; fortran-to-lisp::abnrm nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dtrsna fortran-to-lisp::drot -; fortran-to-lisp::dlartg fortran-to-lisp::idamax -; fortran-to-lisp::dlapy2 fortran-to-lisp::dscal -; fortran-to-lisp::dnrm2 fortran-to-lisp::dgebak -; fortran-to-lisp::dtrevc fortran-to-lisp::dhseqr -; fortran-to-lisp::dorghr fortran-to-lisp::dlacpy -; fortran-to-lisp::dgehrd fortran-to-lisp::dgebal -; fortran-to-lisp::dlascl fortran-to-lisp::dlange -; fortran-to-lisp::dlabad fortran-to-lisp::dlamch -; fortran-to-lisp::xerbla fortran-to-lisp::ilaenv -; fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgehd2 LAPACK} %\pagehead{dgehd2}{dgehd2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgehd2.output +)spool dgehd2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgehd2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGEHD2 - a real general matrix A to upper Hessenberg form H by an + orthogonal similarity transformation + +SYNOPSIS + SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) + + INTEGER IHI, ILO, INFO, LDA, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DGEHD2 reduces a real general matrix A to upper Hessenberg form H by an + orthogonal similarity transformation: Q' * A * Q = H . + + +ARGUMENTS + N (input) INTEGER + The order of the matrix A. N >= 0. + + ILO (input) INTEGER + IHI (input) INTEGER It is assumed that A is already upper + triangular in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI + are normally set by a previous call to DGEBAL; otherwise they + should be set to 1 and N respectively. See Further Details. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the n by n general matrix to be reduced. On exit, + the upper triangle and the first subdiagonal of A are overwrit- + ten with the upper Hessenberg matrix H, and the elements below + the first subdiagonal, with the array TAU, represent the + orthogonal matrix Q as a product of elementary reflectors. See + Further Details. LDA (input) INTEGER The leading dimension + of the array A. LDA >= max(1,N). + + TAU (output) DOUBLE PRECISION array, dimension (N-1) + The scalar factors of the elementary reflectors (see Further + Details). + + WORK (workspace) DOUBLE PRECISION array, dimension (N) + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + +FURTHER DETAILS + The matrix Q is represented as a product of (ihi-ilo) elementary + reflectors + + Q = H(ilo) H(ilo+1) . . . H(ihi-1). + + Each H(i) has the form + + H(i) = I - tau * v * v' + + where tau is a real scalar, and v is a real vector with + v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on exit + in A(i+2:ihi,i), and tau in TAU(i). + + The contents of A are illustrated by the following example, with n = 7, + ilo = 2 and ihi = 6: + + on entry, on exit, + + ( a a a a a a a ) ( a a h h h h a ) ( a + a a a a a ) ( a h h h h a ) ( a a a + a a a ) ( h h h h h h ) ( a a a a a + a ) ( v2 h h h h h ) ( a a a a a a ) + ( v2 v3 h h h h ) ( a a a a a a ) ( + v2 v3 v4 h h h ) ( a ) ( + a ) + + where a denotes an element of the original matrix A, h denotes a modi- + fied element of the upper Hessenberg matrix H, and vi denotes an ele- + ment of the vector defining H(i). + +@ + <>= (let* ((one 1.0)) (declare (type (double-float 1.0 1.0) one)) @@ -25481,7 +33541,9 @@ The return values are: (setf info -5))) (cond ((/= info 0) - (xerbla "DGEHD2" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEHD2" (f2cl-lib:int-sub info)) (go end_label))) (f2cl-lib:fdo (i ilo (f2cl-lib:int-add i 1)) ((> i (f2cl-lib:int-add ihi (f2cl-lib:int-sub 1))) nil) @@ -25538,26 +33600,122 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil info)))))) -;(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::dgehd2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarf fortran-to-lisp::dlarfg -; fortran-to-lisp::xerbla)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgehrd LAPACK} %\pagehead{dgehrd}{dgehrd} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgehrd.output +)spool dgehrd.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgehrd examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGEHRD - Reduce a real general matrix A to upper Hessenberg form H by + an orthogonal similarity transformation + +SYNOPSIS + SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + + INTEGER IHI, ILO, INFO, LDA, LWORK, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DGEHRD reduces a real general matrix A to upper Hessenberg form H by an + orthogonal similarity transformation: Q' * A * Q = H . + + +ARGUMENTS + N (input) INTEGER + The order of the matrix A. N >= 0. + + ILO (input) INTEGER + IHI (input) INTEGER It is assumed that A is already upper + triangular in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI + are normally set by a previous call to DGEBAL; otherwise they + should be set to 1 and N respectively. See Further Details. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the N-by-N general matrix to be reduced. On exit, + the upper triangle and the first subdiagonal of A are overwrit- + ten with the upper Hessenberg matrix H, and the elements below + the first subdiagonal, with the array TAU, represent the + orthogonal matrix Q as a product of elementary reflectors. See + Further Details. LDA (input) INTEGER The leading dimension + of the array A. LDA >= max(1,N). + + TAU (output) DOUBLE PRECISION array, dimension (N-1) + The scalar factors of the elementary reflectors (see Further + Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to zero. + + WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The length of the array WORK. LWORK >= max(1,N). For optimum + performance LWORK >= N*NB, where NB is the optimal blocksize. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value. + +FURTHER DETAILS + The matrix Q is represented as a product of (ihi-ilo) elementary + reflectors + + Q = H(ilo) H(ilo+1) . . . H(ihi-1). + + Each H(i) has the form + + H(i) = I - tau * v * v' + + where tau is a real scalar, and v is a real vector with + v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on exit + in A(i+2:ihi,i), and tau in TAU(i). + + The contents of A are illustrated by the following example, with n = 7, + ilo = 2 and ihi = 6: + + on entry, on exit, + + ( a a a a a a a ) ( a a h h h h a ) ( a + a a a a a ) ( a h h h h a ) ( a a a + a a a ) ( h h h h h h ) ( a a a a a + a ) ( v2 h h h h h ) ( a a a a a a ) + ( v2 v3 h h h h ) ( a a a a a a ) ( + v2 v3 v4 h h h ) ( a ) ( + a ) + + where a denotes an element of the original matrix A, h denotes a modi- + fied element of the upper Hessenberg matrix H, and vi denotes an ele- + ment of the vector defining H(i). + + See Quintana-Orti and Van de Geijn (2005). + +@ + <>= (let* ((nbmax 64) (ldt (+ nbmax 1)) (zero 0.0) (one 1.0)) (declare (type (fixnum 64 64) nbmax) @@ -25609,7 +33767,9 @@ The return values are: (setf info -8))) (cond ((/= info 0) - (xerbla "DGEHRD" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEHRD" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -25732,29 +33892,88 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil nil info)))))) -;(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::dgehrd -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dgehd2 fortran-to-lisp::dlarfb -; fortran-to-lisp::dgemm fortran-to-lisp::dlahrd -; fortran-to-lisp::xerbla fortran-to-lisp::ilaenv)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgelq2 LAPACK} %\pagehead{dgelq2}{dgelq2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgelq2.output +)spool dgelq2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgelq2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGELQ2 - an LQ factorization of a real m by n matrix A + +SYNOPSIS + SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO ) + + INTEGER INFO, LDA, M, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DGELQ2 computes an LQ factorization of a real m by n matrix A: A = L * + Q. + + +ARGUMENTS + M (input) INTEGER + The number of rows of the matrix A. M >= 0. + + N (input) INTEGER + The number of columns of the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the m by n matrix A. On exit, the elements on and + below the diagonal of the array contain the m by min(m,n) lower + trapezoidal matrix L (L is lower triangular if m <= n); the + elements above the diagonal, with the array TAU, represent the + orthogonal matrix Q as a product of elementary reflectors (see + Further Details). LDA (input) INTEGER The leading dimen- + sion of the array A. LDA >= max(1,M). + + TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) + The scalar factors of the elementary reflectors (see Further + Details). + + WORK (workspace) DOUBLE PRECISION array, dimension (M) + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +FURTHER DETAILS + The matrix Q is represented as a product of elementary reflectors + + Q = H(k) . . . H(2) H(1), where k = min(m,n). + + Each H(i) has the form + + H(i) = I - tau * v * v' + + where tau is a real scalar, and v is a real vector with + v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n), + and tau in TAU(i). + +@ + <>= (let* ((one 1.0)) (declare (type (double-float 1.0 1.0) one)) @@ -25777,7 +33996,9 @@ The return values are: (setf info -4))) (cond ((/= info 0) - (xerbla "DGELQ2" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGELQ2" (f2cl-lib:int-sub info)) (go end_label))) (setf k (min (the fixnum m) (the fixnum n))) (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) @@ -25822,26 +34043,100 @@ The return values are: end_label (return (values nil nil nil nil nil nil info)))))) -;(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::dgelq2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarf fortran-to-lisp::dlarfg -; fortran-to-lisp::xerbla)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgelqf LAPACK} %\pagehead{dgelqf}{dgelqf} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgelqf.output +)spool dgelqf.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgelqf examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGELQF - an LQ factorization of a real M-by-N matrix A + +SYNOPSIS + SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) + + INTEGER INFO, LDA, LWORK, M, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DGELQF computes an LQ factorization of a real M-by-N matrix A: A = L * + Q. + + +ARGUMENTS + M (input) INTEGER + The number of rows of the matrix A. M >= 0. + + N (input) INTEGER + The number of columns of the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the M-by-N matrix A. On exit, the elements on and + below the diagonal of the array contain the m-by-min(m,n) lower + trapezoidal matrix L (L is lower triangular if m <= n); the + elements above the diagonal, with the array TAU, represent the + orthogonal matrix Q as a product of elementary reflectors (see + Further Details). LDA (input) INTEGER The leading dimen- + sion of the array A. LDA >= max(1,M). + + TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) + The scalar factors of the elementary reflectors (see Further + Details). + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The dimension of the array WORK. LWORK >= max(1,M). For opti- + mum performance LWORK >= M*NB, where NB is the optimal block- + size. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +FURTHER DETAILS + The matrix Q is represented as a product of elementary reflectors + + Q = H(k) . . . H(2) H(1), where k = min(m,n). + + Each H(i) has the form + + H(i) = I - tau * v * v' + + where tau is a real scalar, and v is a real vector with + v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n), + and tau in TAU(i). + +@ + <>= (defun dgelqf (m n a lda tau work lwork info) (declare (type (array double-float (*)) work tau a) @@ -25874,7 +34169,9 @@ The return values are: (setf info -7))) (cond ((/= info 0) - (xerbla "DGELQF" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGELQF" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -25955,28 +34252,88 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil info))))) -;(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::dgelqf -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) (array double-float (*)) -; fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarfb fortran-to-lisp::dlarft -; fortran-to-lisp::dgelq2 fortran-to-lisp::xerbla -; fortran-to-lisp::ilaenv)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgeqr2 LAPACK} %\pagehead{dgeqr2}{dgeqr2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgeqr2.output +)spool dgeqr2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgeqr2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGEQR2 - a QR factorization of a real m by n matrix A + +SYNOPSIS + SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO ) + + INTEGER INFO, LDA, M, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DGEQR2 computes a QR factorization of a real m by n matrix A: A = Q * + R. + + +ARGUMENTS + M (input) INTEGER + The number of rows of the matrix A. M >= 0. + + N (input) INTEGER + The number of columns of the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the m by n matrix A. On exit, the elements on and + above the diagonal of the array contain the min(m,n) by n upper + trapezoidal matrix R (R is upper triangular if m >= n); the + elements below the diagonal, with the array TAU, represent the + orthogonal matrix Q as a product of elementary reflectors (see + Further Details). LDA (input) INTEGER The leading dimen- + sion of the array A. LDA >= max(1,M). + + TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) + The scalar factors of the elementary reflectors (see Further + Details). + + WORK (workspace) DOUBLE PRECISION array, dimension (N) + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +FURTHER DETAILS + The matrix Q is represented as a product of elementary reflectors + + Q = H(1) H(2) . . . H(k), where k = min(m,n). + + Each H(i) has the form + + H(i) = I - tau * v * v' + + where tau is a real scalar, and v is a real vector with + v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), + and tau in TAU(i). + +@ + <>= (let* ((one 1.0)) (declare (type (double-float 1.0 1.0) one)) @@ -25999,7 +34356,9 @@ The return values are: (setf info -4))) (cond ((/= info 0) - (xerbla "DGEQR2" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEQR2" (f2cl-lib:int-sub info)) (go end_label))) (setf k (min (the fixnum m) (the fixnum n))) (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) @@ -26040,26 +34399,102 @@ The return values are: end_label (return (values nil nil nil nil nil nil info)))))) -;(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::dgeqr2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarf fortran-to-lisp::dlarfg -; fortran-to-lisp::xerbla))));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgeqrf LAPACK} %\pagehead{dgeqrf}{dgeqrf} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgeqrf.output +)spool dgeqrf.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgeqrf examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGEQRF - a QR factorization of a real M-by-N matrix A + +SYNOPSIS + SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) + + INTEGER INFO, LDA, LWORK, M, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DGEQRF computes a QR factorization of a real M-by-N matrix A: A = Q * + R. + + +ARGUMENTS + M (input) INTEGER + The number of rows of the matrix A. M >= 0. + + N (input) INTEGER + The number of columns of the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the M-by-N matrix A. On exit, the elements on and + above the diagonal of the array contain the min(M,N)-by-N upper + trapezoidal matrix R (R is upper triangular if m >= n); the + elements below the diagonal, with the array TAU, represent the + orthogonal matrix Q as a product of min(m,n) elementary reflec- + tors (see Further Details). + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,M). + + TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) + The scalar factors of the elementary reflectors (see Further + Details). + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The dimension of the array WORK. LWORK >= max(1,N). For opti- + mum performance LWORK >= N*NB, where NB is the optimal block- + size. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +FURTHER DETAILS + The matrix Q is represented as a product of elementary reflectors + + Q = H(1) H(2) . . . H(k), where k = min(m,n). + + Each H(i) has the form + + H(i) = I - tau * v * v' + + where tau is a real scalar, and v is a real vector with + v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), + and tau in TAU(i). + +@ + <>= (defun dgeqrf (m n a lda tau work lwork info) (declare (type (array double-float (*)) work tau a) @@ -26092,7 +34527,9 @@ The return values are: (setf info -7))) (cond ((/= info 0) - (xerbla "DGEQRF" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGEQRF" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -26173,28 +34610,155 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil info))))) -;(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::dgeqrf -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) (array double-float (*)) -; fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarfb fortran-to-lisp::dlarft -; fortran-to-lisp::dgeqr2 fortran-to-lisp::xerbla -; fortran-to-lisp::ilaenv)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgesdd LAPACK} %\pagehead{dgesdd}{dgesdd} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgesdd.output +)spool dgesdd.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgesdd examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGESDD - the singular value decomposition (SVD) of a real M-by-N matrix + A, optionally computing the left and right singular vectors + +SYNOPSIS + SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, + LWORK, IWORK, INFO ) + + CHARACTER JOBZ + + INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N + + INTEGER IWORK( * ) + + DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ), VT( + LDVT, * ), WORK( * ) + +PURPOSE + DGESDD computes the singular value decomposition (SVD) of a real M-by-N + matrix A, optionally computing the left and right singular vectors. If + singular vectors are desired, it uses a divide-and-conquer algorithm. + + The SVD is written + + A = U * SIGMA * transpose(V) + + where SIGMA is an M-by-N matrix which is zero except for its min(m,n) + diagonal elements, U is an M-by-M orthogonal matrix, and V is an N-by-N + orthogonal matrix. The diagonal elements of SIGMA are the singular + values of A; they are real and non-negative, and are returned in + descending order. The first min(m,n) columns of U and V are the left + and right singular vectors of A. + + Note that the routine returns VT = V**T, not V. + + The divide and conquer algorithm makes very mild assumptions about + floating point arithmetic. It will work on machines with a guard digit + in add/subtract, or on those binary machines without guard digits which + subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2. It could + conceivably fail on hexadecimal or decimal machines without guard dig- + its, but we know of none. + + +ARGUMENTS + JOBZ (input) CHARACTER*1 + Specifies options for computing all or part of the matrix U: + = 'A': all M columns of U and all N rows of V**T are returned + in the arrays U and VT; = 'S': the first min(M,N) columns of U + and the first min(M,N) rows of V**T are returned in the arrays + U and VT; = 'O': If M >= N, the first N columns of U are over- + written on the array A and all rows of V**T are returned in the + array VT; otherwise, all columns of U are returned in the array + U and the first M rows of V**T are overwritten in the array A; + = 'N': no columns of U or rows of V**T are computed. + + M (input) INTEGER + The number of rows of the input matrix A. M >= 0. + + N (input) INTEGER + The number of columns of the input matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the M-by-N matrix A. On exit, if JOBZ = 'O', A is + overwritten with the first N columns of U (the left singular + vectors, stored columnwise) if M >= N; A is overwritten with + the first M rows of V**T (the right singular vectors, stored + rowwise) otherwise. if JOBZ .ne. 'O', the contents of A are + destroyed. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,M). + + S (output) DOUBLE PRECISION array, dimension (min(M,N)) + The singular values of A, sorted so that S(i) >= S(i+1). + + U (output) DOUBLE PRECISION array, dimension (LDU,UCOL) + UCOL = M if JOBZ = 'A' or JOBZ = 'O' and M < N; UCOL = min(M,N) + if JOBZ = 'S'. If JOBZ = 'A' or JOBZ = 'O' and M < N, U con- + tains the M-by-M orthogonal matrix U; if JOBZ = 'S', U contains + the first min(M,N) columns of U (the left singular vectors, + stored columnwise); if JOBZ = 'O' and M >= N, or JOBZ = 'N', U + is not referenced. + + LDU (input) INTEGER + The leading dimension of the array U. LDU >= 1; if JOBZ = 'S' + or 'A' or JOBZ = 'O' and M < N, LDU >= M. + + VT (output) DOUBLE PRECISION array, dimension (LDVT,N) + If JOBZ = 'A' or JOBZ = 'O' and M >= N, VT contains the N-by-N + orthogonal matrix V**T; if JOBZ = 'S', VT contains the first + min(M,N) rows of V**T (the right singular vectors, stored row- + wise); if JOBZ = 'O' and M < N, or JOBZ = 'N', VT is not refer- + enced. + + LDVT (input) INTEGER + The leading dimension of the array VT. LDVT >= 1; if JOBZ = + 'A' or JOBZ = 'O' and M >= N, LDVT >= N; if JOBZ = 'S', LDVT >= + min(M,N). + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK; + + LWORK (input) INTEGER + The dimension of the array WORK. LWORK >= 1. If JOBZ = 'N', + LWORK >= 3*min(M,N) + max(max(M,N),7*min(M,N)). If JOBZ = 'O', + LWORK >= 3*min(M,N)*min(M,N) + + max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)). If JOBZ = 'S' or + 'A' LWORK >= 3*min(M,N)*min(M,N) + + max(max(M,N),4*min(M,N)*min(M,N)+4*min(M,N)). For good perfor- + mance, LWORK should generally be larger. If LWORK = -1 but + other input arguments are legal, WORK(1) returns the optimal + LWORK. + + IWORK (workspace) INTEGER array, dimension (8*min(M,N)) + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + > 0: DBDSDC did not converge, updating process failed. + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -26203,7 +34767,7 @@ The return values are: (declare (type (array fixnum (*)) iwork) (type (array double-float (*)) work vt u s a) (type fixnum info lwork ldvt ldu lda n m) - (type (simple-array character (*)) jobz)) + (type character jobz)) (f2cl-lib:with-multi-array-data ((jobz character jobz-%data% jobz-%offset%) (a double-float a-%data% a-%offset%) @@ -26231,11 +34795,11 @@ The return values are: (setf info 0) (setf minmn (min (the fixnum m) (the fixnum n))) (setf mnthr (f2cl-lib:int (/ (* minmn 11.0) 6.0))) - (setf wntqa (lsame jobz "A")) - (setf wntqs (lsame jobz "S")) + (setf wntqa (char-equal jobz #\A)) + (setf wntqs (char-equal jobz #\S)) (setf wntqas (or wntqa wntqs)) - (setf wntqo (lsame jobz "O")) - (setf wntqn (lsame jobz "N")) + (setf wntqo (char-equal jobz #\O)) + (setf wntqn (char-equal jobz #\N)) (setf minwrk 1) (setf maxwrk 1) (setf lquery (coerce (= lwork -1) '(member t nil))) @@ -27007,7 +35571,9 @@ The return values are: (setf info -12))) (cond ((/= info 0) - (xerbla "DGESDD" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGESDD" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -28198,39 +36764,155 @@ The return values are: (return (values nil nil nil nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dgesdd -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum -; (array fixnum (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dorglq fortran-to-lisp::dgelqf -; fortran-to-lisp::dorgbr fortran-to-lisp::dgemm -; fortran-to-lisp::dormbr fortran-to-lisp::dorgqr -; fortran-to-lisp::dlacpy fortran-to-lisp::dbdsdc -; fortran-to-lisp::dgebrd fortran-to-lisp::dlaset -; fortran-to-lisp::dgeqrf fortran-to-lisp::dlascl -; fortran-to-lisp::dlange fortran-to-lisp::dlamch -; fortran-to-lisp::xerbla fortran-to-lisp::ilaenv -; fortran-to-lisp::lsame))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgesvd LAPACK} %\pagehead{dgesvd}{dgesvd} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgesvd.output +)spool dgesvd.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgesvd examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGESVD - the singular value decomposition (SVD) of a real M-by-N matrix + A, optionally computing the left and/or right singular vectors + +SYNOPSIS + SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, + WORK, LWORK, INFO ) + + CHARACTER JOBU, JOBVT + + INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N + + DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ), VT( + LDVT, * ), WORK( * ) + +PURPOSE + DGESVD computes the singular value decomposition (SVD) of a real M-by-N + matrix A, optionally computing the left and/or right singular vectors. + The SVD is written + + A = U * SIGMA * transpose(V) + + where SIGMA is an M-by-N matrix which is zero except for its min(m,n) + diagonal elements, U is an M-by-M orthogonal matrix, and V is an N-by-N + orthogonal matrix. The diagonal elements of SIGMA are the singular + values of A; they are real and non-negative, and are returned in + descending order. The first min(m,n) columns of U and V are the left + and right singular vectors of A. + + Note that the routine returns V**T, not V. + + +ARGUMENTS + JOBU (input) CHARACTER*1 + Specifies options for computing all or part of the matrix U: + = 'A': all M columns of U are returned in array U: + = 'S': the first min(m,n) columns of U (the left singular vec- + tors) are returned in the array U; = 'O': the first min(m,n) + columns of U (the left singular vectors) are overwritten on the + array A; = 'N': no columns of U (no left singular vectors) are + computed. + + JOBVT (input) CHARACTER*1 + Specifies options for computing all or part of the matrix V**T: + = 'A': all N rows of V**T are returned in the array VT; + = 'S': the first min(m,n) rows of V**T (the right singular + vectors) are returned in the array VT; = 'O': the first + min(m,n) rows of V**T (the right singular vectors) are over- + written on the array A; = 'N': no rows of V**T (no right sin- + gular vectors) are computed. + + JOBVT and JOBU cannot both be 'O'. + + M (input) INTEGER + The number of rows of the input matrix A. M >= 0. + + N (input) INTEGER + The number of columns of the input matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the M-by-N matrix A. On exit, if JOBU = 'O', A is + overwritten with the first min(m,n) columns of U (the left + singular vectors, stored columnwise); if JOBVT = 'O', A is + overwritten with the first min(m,n) rows of V**T (the right + singular vectors, stored rowwise); if JOBU .ne. 'O' and JOBVT + .ne. 'O', the contents of A are destroyed. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,M). + + S (output) DOUBLE PRECISION array, dimension (min(M,N)) + The singular values of A, sorted so that S(i) >= S(i+1). + + U (output) DOUBLE PRECISION array, dimension (LDU,UCOL) + (LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'. If JOBU + = 'A', U contains the M-by-M orthogonal matrix U; if JOBU = + 'S', U contains the first min(m,n) columns of U (the left sin- + gular vectors, stored columnwise); if JOBU = 'N' or 'O', U is + not referenced. + + LDU (input) INTEGER + The leading dimension of the array U. LDU >= 1; if JOBU = 'S' + or 'A', LDU >= M. + + VT (output) DOUBLE PRECISION array, dimension (LDVT,N) + If JOBVT = 'A', VT contains the N-by-N orthogonal matrix V**T; + if JOBVT = 'S', VT contains the first min(m,n) rows of V**T + (the right singular vectors, stored rowwise); if JOBVT = 'N' or + 'O', VT is not referenced. + + LDVT (input) INTEGER + The leading dimension of the array VT. LDVT >= 1; if JOBVT = + 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N). + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK; if + INFO > 0, WORK(2:MIN(M,N)) contains the unconverged superdiago- + nal elements of an upper bidiagonal matrix B whose diagonal is + in S (not necessarily sorted). B satisfies A = U * B * VT, so + it has the same singular values as A, and singular vectors + related by U and VT. + + LWORK (input) INTEGER + The dimension of the array WORK. LWORK >= + MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)). For good performance, + LWORK should generally be larger. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + > 0: if DBDSQR did not converge, INFO specifies how many + superdiagonals of an intermediate bidiagonal form B did not + converge to zero. See the description of WORK above for + details. + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -28238,7 +36920,7 @@ The return values are: (defun dgesvd (jobu jobvt m n a lda s u ldu vt ldvt work lwork info) (declare (type (array double-float (*)) work vt u s a) (type fixnum info lwork ldvt ldu lda n m) - (type (simple-array character (*)) jobvt jobu)) + (type character jobvt jobu)) (f2cl-lib:with-multi-array-data ((jobu character jobu-%data% jobu-%offset%) (jobvt character jobvt-%data% jobvt-%offset%) @@ -28266,16 +36948,16 @@ The return values are: (setf info 0) (setf minmn (min (the fixnum m) (the fixnum n))) (setf mnthr (ilaenv 6 "DGESVD" (f2cl-lib:f2cl-// jobu jobvt) m n 0 0)) - (setf wntua (lsame jobu "A")) - (setf wntus (lsame jobu "S")) + (setf wntua (char-equal jobu #\A)) + (setf wntus (char-equal jobu #\S)) (setf wntuas (or wntua wntus)) - (setf wntuo (lsame jobu "O")) - (setf wntun (lsame jobu "N")) - (setf wntva (lsame jobvt "A")) - (setf wntvs (lsame jobvt "S")) + (setf wntuo (char-equal jobu #\O)) + (setf wntun (char-equal jobu #\N)) + (setf wntva (char-equal jobvt #\A)) + (setf wntvs (char-equal jobvt #\S)) (setf wntvas (or wntva wntvs)) - (setf wntvo (lsame jobvt "O")) - (setf wntvn (lsame jobvt "N")) + (setf wntvo (char-equal jobvt #\O)) + (setf wntvn (char-equal jobvt #\N)) (setf minwrk 1) (setf lquery (coerce (= lwork -1) '(member t nil))) (cond @@ -29505,7 +38187,9 @@ The return values are: (setf info -13))) (cond ((/= info 0) - (xerbla "DGESVD" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGESVD" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -34624,39 +43308,94 @@ The return values are: (return (values nil nil nil nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dgesvd -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dorglq fortran-to-lisp::dgelqf -; fortran-to-lisp::dormbr fortran-to-lisp::dgemm -; fortran-to-lisp::dorgqr fortran-to-lisp::dlacpy -; fortran-to-lisp::dbdsqr fortran-to-lisp::dorgbr -; fortran-to-lisp::dgebrd fortran-to-lisp::dlaset -; fortran-to-lisp::dgeqrf fortran-to-lisp::dlascl -; fortran-to-lisp::dlange fortran-to-lisp::dlamch -; fortran-to-lisp::xerbla fortran-to-lisp::lsame -; fortran-to-lisp::ilaenv))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgesv LAPACK} %\pagehead{dgesv}{dgesv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgesv.output +)spool dgesv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgesv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGESV - the solution to a real system of linear equations A * X = B, + +SYNOPSIS + SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO ) + + INTEGER INFO, LDA, LDB, N, NRHS + + INTEGER IPIV( * ) + + DOUBLE PRECISION A( LDA, * ), B( LDB, * ) + +PURPOSE + DGESV computes the solution to a real system of linear equations + A * X = B, where A is an N-by-N matrix and X and B are N-by-NRHS + matrices. + + The LU decomposition with partial pivoting and row interchanges is used + to factor A as + A = P * L * U, + where P is a permutation matrix, L is unit lower triangular, and U is + upper triangular. The factored form of A is then used to solve the + system of equations A * X = B. + + +ARGUMENTS + N (input) INTEGER + The number of linear equations, i.e., the order of the matrix + A. N >= 0. + + NRHS (input) INTEGER + The number of right hand sides, i.e., the number of columns of + the matrix B. NRHS >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the N-by-N coefficient matrix A. On exit, the fac- + tors L and U from the factorization A = P*L*U; the unit diago- + nal elements of L are not stored. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,N). + + IPIV (output) INTEGER array, dimension (N) + The pivot indices that define the permutation matrix P; row i + of the matrix was interchanged with row IPIV(i). + + B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) + On entry, the N-by-NRHS matrix of right hand side matrix B. On + exit, if INFO = 0, the N-by-NRHS solution matrix X. + + LDB (input) INTEGER + The leading dimension of the array B. LDB >= max(1,N). + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + > 0: if INFO = i, U(i,i) is exactly zero. The factorization + has been completed, but the factor U is exactly singular, so + the solution could not be computed. + +@ + <>= (defun dgesv (n nrhs a lda ipiv b ldb$ info) (declare (type (array fixnum (*)) ipiv) @@ -34680,7 +43419,9 @@ The return values are: (setf info -7))) (cond ((/= info 0) - (xerbla "DGESV " (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGESV " (f2cl-lib:int-sub info)) (go end_label))) (multiple-value-bind (var-0 var-1 var-2 var-3 var-4 var-5) (dgetrf n n a lda ipiv info) @@ -34697,26 +43438,87 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil info))))) -;(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::dgesv fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (array fixnum (*)) -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dgetrs fortran-to-lisp::dgetrf -; fortran-to-lisp::xerbla))));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgetf2 LAPACK} %\pagehead{dgetf2}{dgetf2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgetf2.output +)spool dgetf2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgetf2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGETF2 - an LU factorization of a general m-by-n matrix A using partial + pivoting with row interchanges + +SYNOPSIS + SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO ) + + INTEGER INFO, LDA, M, N + + INTEGER IPIV( * ) + + DOUBLE PRECISION A( LDA, * ) + +PURPOSE + DGETF2 computes an LU factorization of a general m-by-n matrix A using + partial pivoting with row interchanges. + + The factorization has the form + A = P * L * U + where P is a permutation matrix, L is lower triangular with unit diago- + nal elements (lower trapezoidal if m > n), and U is upper triangular + (upper trapezoidal if m < n). + + This is the right-looking Level 2 BLAS version of the algorithm. + + +ARGUMENTS + M (input) INTEGER + The number of rows of the matrix A. M >= 0. + + N (input) INTEGER + The number of columns of the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the m by n matrix to be factored. On exit, the fac- + tors L and U from the factorization A = P*L*U; the unit diago- + nal elements of L are not stored. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,M). + + IPIV (output) INTEGER array, dimension (min(M,N)) + The pivot indices; for 1 <= i <= min(M,N), row i of the matrix + was interchanged with row IPIV(i). + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -k, the k-th argument had an illegal value + > 0: if INFO = k, U(k,k) is exactly zero. The factorization has + been completed, but the factor U is exactly singular, and divi- + sion by zero will occur if it is used to solve a system of + equations. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -34740,7 +43542,9 @@ The return values are: (setf info -4))) (cond ((/= info 0) - (xerbla "DGETF2" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGETF2" (f2cl-lib:int-sub info)) (go end_label))) (if (or (= m 0) (= n 0)) (go end_label)) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -34807,27 +43611,87 @@ The return values are: end_label (return (values nil nil nil nil nil info)))))) -;(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::dgetf2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (array fixnum (*)) -; fixnum) -; :return-values '(nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dger fortran-to-lisp::dscal -; fortran-to-lisp::dswap fortran-to-lisp::idamax -; fortran-to-lisp::xerbla))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgetrf LAPACK} %\pagehead{dgetrf}{dgetrf} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgetrf.output +)spool dgetrf.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgetrf examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGETRF - an LU factorization of a general M-by-N matrix A using partial + pivoting with row interchanges + +SYNOPSIS + SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO ) + + INTEGER INFO, LDA, M, N + + INTEGER IPIV( * ) + + DOUBLE PRECISION A( LDA, * ) + +PURPOSE + DGETRF computes an LU factorization of a general M-by-N matrix A using + partial pivoting with row interchanges. + + The factorization has the form + A = P * L * U + where P is a permutation matrix, L is lower triangular with unit diago- + nal elements (lower trapezoidal if m > n), and U is upper triangular + (upper trapezoidal if m < n). + + This is the right-looking Level 3 BLAS version of the algorithm. + + +ARGUMENTS + M (input) INTEGER + The number of rows of the matrix A. M >= 0. + + N (input) INTEGER + The number of columns of the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the M-by-N matrix to be factored. On exit, the fac- + tors L and U from the factorization A = P*L*U; the unit diago- + nal elements of L are not stored. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,M). + + IPIV (output) INTEGER array, dimension (min(M,N)) + The pivot indices; for 1 <= i <= min(M,N), row i of the matrix + was interchanged with row IPIV(i). + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + > 0: if INFO = i, U(i,i) is exactly zero. The factorization + has been completed, but the factor U is exactly singular, and + division by zero will occur if it is used to solve a system of + equations. + +@ + <>= (let* ((one 1.0)) (declare (type (double-float 1.0 1.0) one)) @@ -34850,7 +43714,9 @@ The return values are: (setf info -4))) (cond ((/= info 0) - (xerbla "DGETRF" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGETRF" (f2cl-lib:int-sub info)) (go end_label))) (if (or (= m 0) (= n 0)) (go end_label)) (setf nb (ilaenv 1 "DGETRF" " " m n -1 -1)) @@ -34947,27 +43813,91 @@ The return values are: end_label (return (values nil nil nil nil nil info)))))) -;(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::dgetrf -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (array fixnum (*)) -; fixnum) -; :return-values '(nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dgemm fortran-to-lisp::dtrsm -; fortran-to-lisp::dlaswp fortran-to-lisp::dgetf2 -; fortran-to-lisp::ilaenv fortran-to-lisp::xerbla))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dgetrs LAPACK} %\pagehead{dgetrs}{dgetrs} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dgetrs.output +)spool dgetrs.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dgetrs examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DGETRS - a system of linear equations A * X = B or A' * X = B with a + general N-by-N matrix A using the LU factorization computed by DGETRF + +SYNOPSIS + SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) + + CHARACTER TRANS + + INTEGER INFO, LDA, LDB, N, NRHS + + INTEGER IPIV( * ) + + DOUBLE PRECISION A( LDA, * ), B( LDB, * ) + +PURPOSE + DGETRS solves a system of linear equations + A * X = B or A' * X = B with a general N-by-N matrix A using the + LU factorization computed by DGETRF. + + +ARGUMENTS + TRANS (input) CHARACTER*1 + Specifies the form of the system of equations: + = 'N': A * X = B (No transpose) + = 'T': A'* X = B (Transpose) + = 'C': A'* X = B (Conjugate transpose = Transpose) + + N (input) INTEGER + The order of the matrix A. N >= 0. + + NRHS (input) INTEGER + The number of right hand sides, i.e., the number of columns of + the matrix B. NRHS >= 0. + + A (input) DOUBLE PRECISION array, dimension (LDA,N) + The factors L and U from the factorization A = P*L*U as com- + puted by DGETRF. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,N). + + IPIV (input) INTEGER array, dimension (N) + The pivot indices from DGETRF; for 1<=i<=N, row i of the matrix + was interchanged with row IPIV(i). + + B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) + On entry, the right hand side matrix B. On exit, the solution + matrix X. + + LDB (input) INTEGER + The leading dimension of the array B. LDB >= max(1,N). + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +@ + <>= (let* ((one 1.0)) (declare (type (double-float 1.0 1.0) one)) @@ -34975,7 +43905,7 @@ The return values are: (declare (type (array fixnum (*)) ipiv) (type (array double-float (*)) b a) (type fixnum info ldb$ lda nrhs n) - (type (simple-array character (*)) trans)) + (type character trans)) (f2cl-lib:with-multi-array-data ((trans character trans-%data% trans-%offset%) (a double-float a-%data% a-%offset%) @@ -34984,9 +43914,9 @@ The return values are: (prog ((notran nil)) (declare (type (member t nil) notran)) (setf info 0) - (setf notran (lsame trans "N")) + (setf notran (char-equal trans #\N)) (cond - ((and (not notran) (not (lsame trans "T")) (not (lsame trans "C"))) + ((and (not notran) (not (char-equal trans #\T)) (not (char-equal trans #\C))) (setf info -1)) ((< n 0) (setf info -2)) @@ -34998,7 +43928,9 @@ The return values are: (setf info -8))) (cond ((/= info 0) - (xerbla "DGETRS" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DGETRS" (f2cl-lib:int-sub info)) (go end_label))) (if (or (= n 0) (= nrhs 0)) (go end_label)) (cond @@ -35015,29 +43947,177 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil nil info)))))) -;(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::dgetrs -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) fixnum -; (array fixnum (*)) -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dtrsm fortran-to-lisp::dlaswp -; fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dhseqr LAPACK} %\pagehead{dhseqr}{dhseqr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dhseqr.output +)spool dhseqr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dhseqr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DHSEQR - compute the eigenvalues of a Hessenberg matrix H and, option- + ally, the matrices T and Z from the Schur decomposition H = Z T Z**T, + where T is an upper quasi-triangular matrix (the Schur form), and Z is + the orthogonal matrix of Schur vectors + +SYNOPSIS + SUBROUTINE DHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, + WORK, LWORK, INFO ) + + INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N + + CHARACTER COMPZ, JOB + + DOUBLE PRECISION H( LDH, * ), WI( * ), WORK( * ), WR( * ), + Z( LDZ, * ) + +PURPOSE + DHSEQR computes the eigenvalues of a Hessenberg matrix H + and, optionally, the matrices T and Z from the Schur decomposition + H = Z T Z**T, where T is an upper quasi-triangular matrix (the + Schur form), and Z is the orthogonal matrix of Schur vectors. + + Optionally Z may be postmultiplied into an input orthogonal + matrix Q so that this routine can give the Schur factorization + of a matrix A which has been reduced to the Hessenberg form H + by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. + + +ARGUMENTS + JOB (input) CHARACTER*1 + = 'E': compute eigenvalues only; + = 'S': compute eigenvalues and the Schur form T. + + COMPZ (input) CHARACTER*1 + = 'N': no Schur vectors are computed; + = 'I': Z is initialized to the unit matrix and the matrix Z of + Schur vectors of H is returned; = 'V': Z must contain an orthog- + onal matrix Q on entry, and the product Q*Z is returned. + + N (input) INTEGER + The order of the matrix H. N .GE. 0. + + ILO (input) INTEGER + IHI (input) INTEGER It is assumed that H is already upper tri- + angular in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are + normally set by a previous call to DGEBAL, and then passed to + DGEHRD when the matrix output by DGEBAL is reduced to Hessenberg + form. Otherwise ILO and IHI should be set to 1 and N respec- + tively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. If N = 0, then + ILO = 1 and IHI = 0. + + H (input/output) DOUBLE PRECISION array, dimension (LDH,N) + On entry, the upper Hessenberg matrix H. On exit, if INFO = 0 + and JOB = 'S', then H contains the upper quasi-triangular matrix + T from the Schur decomposition (the Schur form); 2-by-2 diagonal + blocks (corresponding to complex conjugate pairs of eigenvalues) + are returned in standard form, with H(i,i) = H(i+1,i+1) and + H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the contents + of H are unspecified on exit. (The output value of H when + INFO.GT.0 is given under the description of INFO below.) + + Unlike earlier versions of DHSEQR, this subroutine may explicitly + H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1 or j = IHI+1, + IHI+2, ... N. + + LDH (input) INTEGER + The leading dimension of the array H. LDH .GE. max(1,N). + + WR (output) DOUBLE PRECISION array, dimension (N) + WI (output) DOUBLE PRECISION array, dimension (N) The real and + imaginary parts, respectively, of the computed eigenvalues. If + two eigenvalues are computed as a complex conjugate pair, they + are stored in consecutive elements of WR and WI, say the i-th and + (i+1)th, with WI(i) .GT. 0 and WI(i+1) .LT. 0. If JOB = 'S', the + eigenvalues are stored in the same order as on the diagonal of + the Schur form returned in H, with WR(i) = H(i,i) and, if + H(i:i+1,i:i+1) is a 2-by-2 diagonal block, WI(i) = + sqrt(-H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i). + + Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N) + If COMPZ = 'N', Z is not referenced. If COMPZ = 'I', on entry Z + need not be set and on exit, if INFO = 0, Z contains the orthogo- + nal matrix Z of the Schur vectors of H. If COMPZ = 'V', on entry + Z must contain an N-by-N matrix Q, which is assumed to be equal + to the unit matrix except for the submatrix Z(ILO:IHI,ILO:IHI). + On exit, if INFO = 0, Z contains Q*Z. Normally Q is the orthogo- + nal matrix generated by DORGHR after the call to DGEHRD which + formed the Hessenberg matrix H. (The output value of Z when + INFO.GT.0 is given under the description of INFO below.) + + LDZ (input) INTEGER + The leading dimension of the array Z. if COMPZ = 'I' or COMPZ = + 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1. + + WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) + On exit, if INFO = 0, WORK(1) returns an estimate of the optimal + value for LWORK. + + LWORK (input) INTEGER The dimension of the array WORK. LWORK + .GE. max(1,N) is sufficient, but LWORK typically as large as 6*N + may be required for optimal performance. A workspace query to + determine the optimal workspace size is recommended. + + If LWORK = -1, then DHSEQR does a workspace query. In this case, + DHSEQR checks the input parameters and estimates the optimal + workspace size for the given values of N, ILO and IHI. The esti- + mate is returned in WORK(1). No error message related to LWORK + is issued by XERBLA. Neither H nor Z are accessed. + + INFO (output) INTEGER + = 0: successful exit + value + the eigenvalues. Elements 1:ilo-1 and i+1:n of WR and WI contain + those eigenvalues which have been successfully computed. (Fail- + ures are rare.) + + If INFO .GT. 0 and JOB = 'E', then on exit, the remaining uncon- + verged eigenvalues are the eigen- values of the upper Hessenberg + matrix rows and columns ILO through INFO of the final, output + value of H. + + If INFO .GT. 0 and JOB = 'S', then on exit + + (*) (initial value of H)*U = U*(final value of H) + + where U is an orthogonal matrix. The final value of H is upper + Hessenberg and quasi-triangular in rows and columns INFO+1 through + IHI. + + If INFO .GT. 0 and COMPZ = 'V', then on exit + + (final value of Z) = (initial value of Z)*U + + where U is the orthogonal matrix in (*) (regard- less of the value + of JOB.) + + If INFO .GT. 0 and COMPZ = 'I', then on exit (final value of Z) = + U where U is the orthogonal matrix in (*) (regard- less of the + value of JOB.) + + If INFO .GT. 0 and COMPZ = 'N', then Z is not accessed. + +@ + <>= (let* ((zero 0.0) (one 1.0) (two 2.0) (const 1.5) (nsmax 15) (lds nsmax)) (declare (type (double-float 0.0 0.0) zero) @@ -35049,7 +44129,7 @@ The return values are: (defun dhseqr (job compz n ilo ihi h ldh wr wi z ldz work lwork info) (declare (type (array double-float (*)) work z wi wr h) (type fixnum info lwork ldz ldh ihi ilo n) - (type (simple-array character (*)) compz job)) + (type character compz job)) (f2cl-lib:with-multi-array-data ((job character job-%data% job-%offset%) (compz character compz-%data% compz-%offset%) @@ -35076,9 +44156,9 @@ The return values are: (type fixnum i i1 i2 ierr ii itemp itn its j k l maxb nh nr ns nv) (type (member t nil) initz lquery wantt wantz)) - (setf wantt (lsame job "S")) - (setf initz (lsame compz "I")) - (setf wantz (or initz (lsame compz "V"))) + (setf wantt (char-equal job #\S)) + (setf initz (char-equal compz #\I)) + (setf wantz (or initz (char-equal compz #\V))) (setf info 0) (setf (f2cl-lib:fref work-%data% (1) ((1 *)) work-%offset%) (coerce @@ -35088,9 +44168,9 @@ The return values are: 'double-float)) (setf lquery (coerce (= lwork -1) '(member t nil))) (cond - ((and (not (lsame job "E")) (not wantt)) + ((and (not (char-equal job #\E)) (not wantt)) (setf info -1)) - ((and (not (lsame compz "N")) (not wantz)) + ((and (not (char-equal compz #\N)) (not wantz)) (setf info -2)) ((< n 0) (setf info -3)) @@ -35116,7 +44196,9 @@ The return values are: (setf info -13))) (cond ((/= info 0) - (xerbla "DHSEQR" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DHSEQR" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -35491,38 +44573,66 @@ The return values are: (return (values nil nil nil nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dhseqr -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarfx fortran-to-lisp::dlarfg -; fortran-to-lisp::dlapy2 fortran-to-lisp::dscal -; fortran-to-lisp::idamax fortran-to-lisp::dgemv -; fortran-to-lisp::dcopy fortran-to-lisp::dlacpy -; fortran-to-lisp::dlanhs fortran-to-lisp::dlabad -; fortran-to-lisp::dlamch fortran-to-lisp::dlahqr -; fortran-to-lisp::ilaenv fortran-to-lisp::dlaset -; fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlabad LAPACK} %\pagehead{dlabad}{dlabad} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlabad.output +)spool dlabad.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlabad examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLABAD - a input the values computed by DLAMCH for underflow and over- + flow, and returns the square root of each of these values if the log of + LARGE is sufficiently large + +SYNOPSIS + SUBROUTINE DLABAD( SMALL, LARGE ) + + DOUBLE PRECISION LARGE, SMALL + +PURPOSE + DLABAD takes as input the values computed by DLAMCH for underflow and + overflow, and returns the square root of each of these values if the + log of LARGE is sufficiently large. This subroutine is intended to + identify machines with a large exponent range, such as the Crays, and + redefine the underflow and overflow limits to be the square roots of + the values computed by DLAMCH. This subroutine is needed because + DLAMCH does not compensate for poor arithmetic in the upper half of the + exponent range, as is found on a Cray. + + +ARGUMENTS + SMALL (input/output) DOUBLE PRECISION + On entry, the underflow threshold as computed by DLAMCH. On + exit, if LOG10(LARGE) is sufficiently large, the square root of + SMALL, otherwise unchanged. + + LARGE (input/output) DOUBLE PRECISION + On entry, the overflow threshold as computed by DLAMCH. On + exit, if LOG10(LARGE) is sufficiently large, the square root of + LARGE, otherwise unchanged. + +@ + <>= (defun dlabad (small large) (declare (type (double-float) large small)) @@ -35534,22 +44644,155 @@ The return values are: (setf large (f2cl-lib:fsqrt large)))) (return (values small large)))) -;(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::dlabad -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((double-float) (double-float)) -; :return-values '(fortran-to-lisp::small fortran-to-lisp::large) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlabrd LAPACK} %\pagehead{dlabrd}{dlabrd} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlabrd.output +)spool dlabrd.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlabrd examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLABRD - the first NB rows and columns of a real general m by n matrix + A to upper or lower bidiagonal form by an orthogonal transformation Q' + * A * P, and returns the matrices X and Y which are needed to apply the + transformation to the unreduced part of A + +SYNOPSIS + SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, LDY ) + + INTEGER LDA, LDX, LDY, M, N, NB + + DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ), + TAUQ( * ), X( LDX, * ), Y( LDY, * ) + +PURPOSE + DLABRD reduces the first NB rows and columns of a real general m by n + matrix A to upper or lower bidiagonal form by an orthogonal transforma- + tion Q' * A * P, and returns the matrices X and Y which are needed to + apply the transformation to the unreduced part of A. + + If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower + bidiagonal form. + + This is an auxiliary routine called by DGEBRD + + +ARGUMENTS + M (input) INTEGER + The number of rows in the matrix A. + + N (input) INTEGER + The number of columns in the matrix A. + + NB (input) INTEGER + The number of leading rows and columns of A to be reduced. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the m by n general matrix to be reduced. On exit, + the first NB rows and columns of the matrix are overwritten; + the rest of the array is unchanged. If m >= n, elements on and + below the diagonal in the first NB columns, with the array + TAUQ, represent the orthogonal matrix Q as a product of elemen- + tary reflectors; and elements above the diagonal in the first + NB rows, with the array TAUP, represent the orthogonal matrix P + as a product of elementary reflectors. If m < n, elements + below the diagonal in the first NB columns, with the array + TAUQ, represent the orthogonal matrix Q as a product of elemen- + tary reflectors, and elements on and above the diagonal in the + first NB rows, with the array TAUP, represent the orthogonal + matrix P as a product of elementary reflectors. See Further + Details. LDA (input) INTEGER The leading dimension of the + array A. LDA >= max(1,M). + + D (output) DOUBLE PRECISION array, dimension (NB) + The diagonal elements of the first NB rows and columns of the + reduced matrix. D(i) = A(i,i). + + E (output) DOUBLE PRECISION array, dimension (NB) + The off-diagonal elements of the first NB rows and columns of + the reduced matrix. + + TAUQ (output) DOUBLE PRECISION array dimension (NB) + The scalar factors of the elementary reflectors which represent + the orthogonal matrix Q. See Further Details. TAUP (output) + DOUBLE PRECISION array, dimension (NB) The scalar factors of + the elementary reflectors which represent the orthogonal matrix + P. See Further Details. X (output) DOUBLE PRECISION + array, dimension (LDX,NB) The m-by-nb matrix X required to + update the unreduced part of A. + + LDX (input) INTEGER + The leading dimension of the array X. LDX >= M. + + Y (output) DOUBLE PRECISION array, dimension (LDY,NB) + The n-by-nb matrix Y required to update the unreduced part of + A. + + LDY (input) INTEGER + The leading dimension of the array Y. LDY >= N. + +FURTHER DETAILS + The matrices Q and P are represented as products of elementary reflec- + tors: + + Q = H(1) H(2) . . . H(nb) and P = G(1) G(2) . . . G(nb) + + Each H(i) and G(i) has the form: + + H(i) = I - tauq * v * v' and G(i) = I - taup * u * u' + + where tauq and taup are real scalars, and v and u are real vectors. + + If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in + A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in + A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i). + + If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in + A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in + A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i). + + The elements of the vectors v and u together form the m-by-nb matrix V + and the nb-by-n matrix U' which are needed, with X and Y, to apply the + transformation to the unreduced part of the matrix, using a block + update of the form: A := A - V*Y' - X*U'. + + The contents of A on exit are illustrated by the following examples + with nb = 2: + + m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n): + + ( 1 1 u1 u1 u1 ) ( 1 u1 u1 u1 u1 u1 ) + ( v1 1 1 u2 u2 ) ( 1 1 u2 u2 u2 u2 ) + ( v1 v2 a a a ) ( v1 1 a a a a ) + ( v1 v2 a a a ) ( v1 v2 a a a a ) + ( v1 v2 a a a ) ( v1 v2 a a a a ) + ( v1 v2 a a a ) + + where a denotes an element of the original matrix which is unchanged, + vi denotes an element of the vector defining H(i), and ui an element of + the vector defining G(i). + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -36075,30 +45318,84 @@ The return values are: (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::dlabrd -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil -; nil) -; :calls '(fortran-to-lisp::dscal fortran-to-lisp::dlarfg -; fortran-to-lisp::dgemv)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlacon LAPACK} %\pagehead{dlacon}{dlacon} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlacon.output +)spool dlacon.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlacon examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLACON - the 1-norm of a square, real matrix A + +SYNOPSIS + SUBROUTINE DLACON( N, V, X, ISGN, EST, KASE ) + + INTEGER KASE, N + + DOUBLE PRECISION EST + + INTEGER ISGN( * ) + + DOUBLE PRECISION V( * ), X( * ) + +PURPOSE + DLACON estimates the 1-norm of a square, real matrix A. Reverse commu- + nication is used for evaluating matrix-vector products. + + +ARGUMENTS + N (input) INTEGER + The order of the matrix. N >= 1. + + V (workspace) DOUBLE PRECISION array, dimension (N) + On the final return, V = A*W, where EST = norm(V)/norm(W) (W + is not returned). + + X (input/output) DOUBLE PRECISION array, dimension (N) + On an intermediate return, X should be overwritten by A * X, + if KASE=1, A' * X, if KASE=2, and DLACON must be re-called with + all the other parameters unchanged. + + ISGN (workspace) INTEGER array, dimension (N) + + EST (input/output) DOUBLE PRECISION + On entry with KASE = 1 or 2 and JUMP = 3, EST should be + unchanged from the previous call to DLACON. On exit, EST is an + estimate (a lower bound) for norm(A). + + KASE (input/output) INTEGER + On the initial call to DLACON, KASE should be 0. On an interme- + diate return, KASE will be 1 or 2, indicating whether X should + be overwritten by A * X or A' * X. On the final return from + DLACON, KASE will again be 0. + +FURTHER DETAILS + Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of a + real or complex matrix, with applications to condition estimation", ACM + Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988. + +@ + <>= (let* ((itmax 5) (zero 0.0) (one 1.0) (two 2.0)) (declare (type (fixnum 5 5) itmax) @@ -36247,32 +45544,83 @@ The return values are: end_label (return (values nil nil nil nil est kase))))))) -;(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::dlacon -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (*)) -; (array double-float (*)) -; (array fixnum (*)) (double-float) -; fixnum) -; :return-values '(nil nil nil nil fortran-to-lisp::est -; fortran-to-lisp::kase) -; :calls '(fortran-to-lisp::dcopy fortran-to-lisp::idamax -; fortran-to-lisp::dasum))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlacpy LAPACK} %\pagehead{dlacpy}{dlacpy} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlacpy.output +)spool dlacpy.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlacpy examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLACPY - all or part of a two-dimensional matrix A to another matrix B + +SYNOPSIS + SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB ) + + CHARACTER UPLO + + INTEGER LDA, LDB, M, N + + DOUBLE PRECISION A( LDA, * ), B( LDB, * ) + +PURPOSE + DLACPY copies all or part of a two-dimensional matrix A to another + matrix B. + + +ARGUMENTS + UPLO (input) CHARACTER*1 + Specifies the part of the matrix A to be copied to B. = 'U': + Upper triangular part + = 'L': Lower triangular part + Otherwise: All of the matrix A + + M (input) INTEGER + The number of rows of the matrix A. M >= 0. + + N (input) INTEGER + The number of columns of the matrix A. N >= 0. + + A (input) DOUBLE PRECISION array, dimension (LDA,N) + The m by n matrix A. If UPLO = 'U', only the upper triangle or + trapezoid is accessed; if UPLO = 'L', only the lower triangle + or trapezoid is accessed. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,M). + + B (output) DOUBLE PRECISION array, dimension (LDB,N) + On exit, B = A in the locations specified by UPLO. + + LDB (input) INTEGER + The leading dimension of the array B. LDB >= max(1,M). + +@ + <>= (defun dlacpy (uplo m n a lda b ldb$) (declare (type (array double-float (*)) b a) (type fixnum ldb$ lda n m) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (a double-float a-%data% a-%offset%) @@ -36280,7 +45628,7 @@ The return values are: (prog ((i 0) (j 0)) (declare (type fixnum j i)) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody @@ -36298,7 +45646,7 @@ The return values are: (i j) ((1 lda) (1 *)) a-%offset%))))))) - ((lsame uplo "L") + ((char-equal uplo #\L) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody @@ -36331,25 +45679,58 @@ The return values are: end_label (return (values 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::dlacpy -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dladiv LAPACK} %\pagehead{dladiv}{dladiv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dladiv.output +)spool dladiv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dladiv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLADIV - complex division in real arithmetic a + i*b p + i*q = + --------- c + i*d The algorithm is due to Robert L + +SYNOPSIS + SUBROUTINE DLADIV( A, B, C, D, P, Q ) + + DOUBLE PRECISION A, B, C, D, P, Q + +PURPOSE + DLADIV performs complex division in real arithmetic in D. Knuth, The + art of Computer Programming, Vol.2, p.195 + + +ARGUMENTS + A (input) DOUBLE PRECISION + B (input) DOUBLE PRECISION C (input) DOUBLE PRECI- + SION D (input) DOUBLE PRECISION The scalars a, b, c, and + d in the above expression. + + P (output) DOUBLE PRECISION + Q (output) DOUBLE PRECISION The scalars p and q in the + above expression. + +@ + <>= (defun dladiv (a b c d p q) (declare (type (double-float) q p d c b a)) @@ -36368,24 +45749,92 @@ The return values are: (setf q (/ (- (* b e) a) f)))) (return (values nil nil nil nil p q)))) -;(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::dladiv -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((double-float) (double-float) (double-float) -; (double-float) (double-float) (double-float)) -; :return-values '(nil nil nil nil fortran-to-lisp::p -; fortran-to-lisp::q) -; :calls 'nil))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlaed6 LAPACK} %\pagehead{dlaed6}{dlaed6} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlaed6.output +)spool dlaed6.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlaed6 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLAED6 - the positive or negative root (closest to the origin) of z(1) + z(2) z(3) f(x) = rho + --------- + ---------- + --------- d(1)-x + d(2)-x d(3)-x It is assumed that if ORGATI = .true + +SYNOPSIS + SUBROUTINE DLAED6( KNITER, ORGATI, RHO, D, Z, FINIT, TAU, INFO ) + + LOGICAL ORGATI + + INTEGER INFO, KNITER + + DOUBLE PRECISION FINIT, RHO, TAU + + DOUBLE PRECISION D( 3 ), Z( 3 ) + +PURPOSE + DLAED6 computes the positive or negative root (closest to the origin) + of + z(1) z(2) z(3) f(x) = rho + --------- + + ---------- + --------- + d(1)-x d(2)-x d(3)-x + otherwise it is between d(1) and d(2) + + This routine will be called by DLAED4 when necessary. In most cases, + the root sought is the smallest in magnitude, though it might not be in + some extremely rare situations. + + +ARGUMENTS + KNITER (input) INTEGER + Refer to DLAED4 for its significance. + + ORGATI (input) LOGICAL + If ORGATI is true, the needed root is between d(2) and + d(3); otherwise it is between d(1) and d(2). See DLAED4 + for further details. + + RHO (input) DOUBLE PRECISION + Refer to the equation f(x) above. + + D (input) DOUBLE PRECISION array, dimension (3) + D satisfies d(1) < d(2) < d(3). + + Z (input) DOUBLE PRECISION array, dimension (3) + Each of the elements in z must be positive. + + FINIT (input) DOUBLE PRECISION + The value of f at 0. It is more accurate than the one + evaluated inside this routine (if someone wants to do so). + + TAU (output) DOUBLE PRECISION + The root of the equation f(x). + + INFO (output) INTEGER + = 0: successful exit + > 0: if INFO = 1, failure to converge + +@ + <>= (let* ((maxit 20) (zero 0.0) @@ -36697,26 +46146,99 @@ The return values are: end_label (return (values nil nil nil nil nil nil tau info))))))) -;(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::dlaed6 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (member t nil) -; (double-float) (array double-float (3)) -; (array double-float (3)) (double-float) (double-float) -; fixnum) -; :return-values '(nil nil nil nil nil nil fortran-to-lisp::tau -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlamch)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlaexc LAPACK} %\pagehead{dlaexc}{dlaexc} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlaexc.output +)spool dlaexc.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlaexc examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLAEXC - adjacent diagonal blocks T11 and T22 of order 1 or 2 in an + upper quasi-triangular matrix T by an orthogonal similarity transforma- + tion + +SYNOPSIS + SUBROUTINE DLAEXC( WANTQ, N, T, LDT, Q, LDQ, J1, N1, N2, WORK, INFO ) + + LOGICAL WANTQ + + INTEGER INFO, J1, LDQ, LDT, N, N1, N2 + + DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * ) + +PURPOSE + DLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in an + upper quasi-triangular matrix T by an orthogonal similarity transforma- + tion. + + T must be in Schur canonical form, that is, block upper triangular with + 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block has its + diagonal elemnts equal and its off-diagonal elements of opposite sign. + + +ARGUMENTS + WANTQ (input) LOGICAL + = .TRUE. : accumulate the transformation in the matrix Q; + = .FALSE.: do not accumulate the transformation. + + N (input) INTEGER + The order of the matrix T. N >= 0. + + T (input/output) DOUBLE PRECISION array, dimension (LDT,N) + On entry, the upper quasi-triangular matrix T, in Schur canoni- + cal form. On exit, the updated matrix T, again in Schur canon- + ical form. + + LDT (input) INTEGER + The leading dimension of the array T. LDT >= max(1,N). + + Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N) + On entry, if WANTQ is .TRUE., the orthogonal matrix Q. On + exit, if WANTQ is .TRUE., the updated matrix Q. If WANTQ is + .FALSE., Q is not referenced. + + LDQ (input) INTEGER + The leading dimension of the array Q. LDQ >= 1; and if WANTQ + is .TRUE., LDQ >= N. + + J1 (input) INTEGER + The index of the first row of the first block T11. + + N1 (input) INTEGER + The order of the first block T11. N1 = 0, 1 or 2. + + N2 (input) INTEGER + The order of the second block T22. N2 = 0, 1 or 2. + + WORK (workspace) DOUBLE PRECISION array, dimension (N) + + INFO (output) INTEGER + = 0: successful exit + = 1: the transformed matrix T would be too far from Schur form; + the blocks are not swapped and T and Q are unchanged. + +@ + <>= (let* ((zero 0.0) (one 1.0) (ten 10.0) (ldd 4) (ldx 2)) (declare (type (double-float 0.0 0.0) zero) @@ -37188,32 +46710,134 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dlaexc -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((member t nil) fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlanv2 fortran-to-lisp::dlarfx -; fortran-to-lisp::dlarfg fortran-to-lisp::dlasy2 -; fortran-to-lisp::dlamch fortran-to-lisp::dlange -; fortran-to-lisp::dlacpy fortran-to-lisp::drot -; fortran-to-lisp::dlartg)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlahqr LAPACK} %\pagehead{dlahqr}{dlahqr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlahqr.output +)spool dlahqr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlahqr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLAHQR - An auxiliary routine called by DHSEQR to update the eigenval- + ues and Schur decomposition already computed by DHSEQR, by dealing + with the Hessenberg submatrix in rows and columns ILO to IHI + +SYNOPSIS + SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI, ILOZ, + IHIZ, Z, LDZ, INFO ) + + INTEGER IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N + + LOGICAL WANTT, WANTZ + + DOUBLE PRECISION H( LDH, * ), WI( * ), WR( * ), Z( LDZ, * ) + +PURPOSE + DLAHQR is an auxiliary routine called by DHSEQR to update the + eigenvalues and Schur decomposition already computed by DHSEQR, by + dealing with the Hessenberg submatrix in rows and columns ILO to + IHI. + + +ARGUMENTS + WANTT (input) LOGICAL + = .TRUE. : the full Schur form T is required; + = .FALSE.: only eigenvalues are required. + + WANTZ (input) LOGICAL + = .TRUE. : the matrix of Schur vectors Z is required; + = .FALSE.: Schur vectors are not required. + + N (input) INTEGER + The order of the matrix H. N >= 0. + + ILO (input) INTEGER + IHI (input) INTEGER It is assumed that H is already upper + quasi-triangular in rows and columns IHI+1:N, and that + H(ILO,ILO-1) = 0 (unless ILO = 1). DLAHQR works primarily with + the Hessenberg submatrix in rows and columns ILO to IHI, but + applies transformations to all of H if WANTT is .TRUE.. 1 <= + ILO <= max(1,IHI); IHI <= N. + + H (input/output) DOUBLE PRECISION array, dimension (LDH,N) + On entry, the upper Hessenberg matrix H. On exit, if INFO is + zero and if WANTT is .TRUE., H is upper quasi-triangular in + rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in + standard form. If INFO is zero and WANTT is .FALSE., the con- + tents of H are unspecified on exit. The output state of H if + INFO is nonzero is given below under the description of INFO. + + LDH (input) INTEGER + The leading dimension of the array H. LDH >= max(1,N). + + WR (output) DOUBLE PRECISION array, dimension (N) + WI (output) DOUBLE PRECISION array, dimension (N) The real + and imaginary parts, respectively, of the computed eigenvalues + ILO to IHI are stored in the corresponding elements of WR and + WI. If two eigenvalues are computed as a complex conjugate + pair, they are stored in consecutive elements of WR and WI, say + the i-th and (i+1)th, with WI(i) > 0 and WI(i+1) < 0. If WANTT + is .TRUE., the eigenvalues are stored in the same order as on + the diagonal of the Schur form returned in H, with WR(i) = + H(i,i), and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal block, + WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i). + + ILOZ (input) INTEGER + IHIZ (input) INTEGER Specify the rows of Z to which trans- + formations must be applied if WANTZ is .TRUE.. 1 <= ILOZ <= + ILO; IHI <= IHIZ <= N. + + Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N) + If WANTZ is .TRUE., on entry Z must contain the current matrix + Z of transformations accumulated by DHSEQR, and on exit Z has + been updated; transformations are applied only to the submatrix + Z(ILOZ:IHIZ,ILO:IHI). If WANTZ is .FALSE., Z is not refer- + enced. + + LDZ (input) INTEGER + The leading dimension of the array Z. LDZ >= max(1,N). + + INFO (output) INTEGER + = 0: successful exit + eigenvalues ILO to IHI in a total of 30 iterations per eigen- + value; elements i+1:ihi of WR and WI contain those eigenvalues + which have been successfully computed. + + If INFO .GT. 0 and WANTT is .FALSE., then on exit, the remain- + ing unconverged eigenvalues are the eigenvalues of the upper + Hessenberg matrix rows and columns ILO thorugh INFO of the + final, output value of H. + + If INFO .GT. 0 and WANTT is .TRUE., then on exit (*) + (initial value of H)*U = U*(final value of H) where U is an + orthognal matrix. The final value of H is upper Hessenberg + and triangular in rows and columns INFO+1 through IHI. + + If INFO .GT. 0 and WANTZ is .TRUE., then on exit (final value + of Z) = (initial value of Z)*U where U is the orthogonal + matrix in (*) (regardless of the value of WANTT.) + +@ + <>= (let* ((zero 0.0) (one 1.0) (half 0.5) (dat1 0.75) (dat2 (- 0.4375))) (declare (type (double-float 0.0 0.0) zero) @@ -37877,33 +47501,128 @@ The return values are: (return (values nil nil nil nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dlahqr -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((member t nil) (member t nil) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; fixnum (array double-float (*)) -; fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::drot fortran-to-lisp::dlanv2 -; fortran-to-lisp::dlarfg fortran-to-lisp::dcopy -; fortran-to-lisp::dlanhs fortran-to-lisp::dlabad -; fortran-to-lisp::dlamch)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlahrd LAPACK} %\pagehead{dlahrd}{dlahrd} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlahrd.output +)spool dlahrd.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlahrd examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLAHRD - the first NB columns of a real general n-by-(n-k+1) matrix A + so that elements below the k-th subdiagonal are zero + +SYNOPSIS + SUBROUTINE DLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) + + INTEGER K, LDA, LDT, LDY, N, NB + + DOUBLE PRECISION A( LDA, * ), T( LDT, NB ), TAU( NB ), Y( + LDY, NB ) + +PURPOSE + DLAHRD reduces the first NB columns of a real general n-by-(n-k+1) + matrix A so that elements below the k-th subdiagonal are zero. The + reduction is performed by an orthogonal similarity transformation Q' * + A * Q. The routine returns the matrices V and T which determine Q as a + block reflector I - V*T*V', and also the matrix Y = A * V * T. + + This is an OBSOLETE auxiliary routine. + This routine will be 'deprecated' in a future release. + Please use the new routine DLAHR2 instead. + + +ARGUMENTS + N (input) INTEGER + The order of the matrix A. + + K (input) INTEGER + The offset for the reduction. Elements below the k-th subdiago- + nal in the first NB columns are reduced to zero. + + NB (input) INTEGER + The number of columns to be reduced. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N-K+1) + On entry, the n-by-(n-k+1) general matrix A. On exit, the ele- + ments on and above the k-th subdiagonal in the first NB columns + are overwritten with the corresponding elements of the reduced + matrix; the elements below the k-th subdiagonal, with the array + TAU, represent the matrix Q as a product of elementary reflec- + tors. The other columns of A are unchanged. See Further + Details. LDA (input) INTEGER The leading dimension of the + array A. LDA >= max(1,N). + + TAU (output) DOUBLE PRECISION array, dimension (NB) + The scalar factors of the elementary reflectors. See Further + Details. + + T (output) DOUBLE PRECISION array, dimension (LDT,NB) + The upper triangular matrix T. + + LDT (input) INTEGER + The leading dimension of the array T. LDT >= NB. + + Y (output) DOUBLE PRECISION array, dimension (LDY,NB) + The n-by-nb matrix Y. + + LDY (input) INTEGER + The leading dimension of the array Y. LDY >= N. + +FURTHER DETAILS + The matrix Q is represented as a product of nb elementary reflectors + + Q = H(1) H(2) . . . H(nb). + + Each H(i) has the form + + H(i) = I - tau * v * v' + + where tau is a real scalar, and v is a real vector with + v(1:i+k-1) = 0, v(i+k) = 1; v(i+k+1:n) is stored on exit in + A(i+k+1:n,i), and tau in TAU(i). + + The elements of the vectors v together form the (n-k+1)-by-nb matrix V + which is needed, with T and Y, to apply the transformation to the unre- + duced part of the matrix, using an update of the form: A := (I - + V*T*V') * (A - Y*V'). + + The contents of A on exit are illustrated by the following example with + n = 7, k = 3 and nb = 2: + + ( a h a a a ) + ( a h a a a ) + ( a h a a a ) + ( h h a a a ) + ( v1 h a a a ) + ( v1 v2 a a a ) + ( v1 v2 a a a ) + + where a denotes an element of the original matrix A, h denotes a modi- + fied element of the upper Hessenberg matrix H, and vi denotes an ele- + ment of the vector defining H(i). + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -38071,28 +47790,158 @@ The return values are: end_label (return (values 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::dlahrd -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::dscal fortran-to-lisp::dlarfg -; fortran-to-lisp::daxpy fortran-to-lisp::dtrmv -; fortran-to-lisp::dcopy fortran-to-lisp::dgemv)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlaln2 LAPACK} %\pagehead{dlaln2}{dlaln2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlaln2.output +)spool dlaln2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlaln2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLALN2 - a system of the form (ca A - w D ) X = s B or (ca A' - w D) X + = s B with possible scaling ("s") and perturbation of A + +SYNOPSIS + SUBROUTINE DLALN2( LTRANS, NA, NW, SMIN, CA, A, LDA, D1, D2, B, LDB, + WR, WI, X, LDX, SCALE, XNORM, INFO ) + + LOGICAL LTRANS + + INTEGER INFO, LDA, LDB, LDX, NA, NW + + DOUBLE PRECISION CA, D1, D2, SCALE, SMIN, WI, WR, XNORM + + DOUBLE PRECISION A( LDA, * ), B( LDB, * ), X( LDX, * ) + +PURPOSE + DLALN2 solves a system of the form (ca A - w D ) X = s B or (ca A' - w + D) X = s B with possible scaling ("s") and perturbation of A. (A' + means A-transpose.) + + A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA real + diagonal matrix, w is a real or complex value, and X and B are NA x 1 + matrices -- real if w is real, complex if w is complex. NA may be 1 or + 2. + + If w is complex, X and B are represented as NA x 2 matrices, the first + column of each being the real part and the second being the imaginary + part. + + "s" is a scaling factor (.LE. 1), computed by DLALN2, which is so cho- + sen that X can be computed without overflow. X is further scaled if + necessary to assure that norm(ca A - w D)*norm(X) is less than over- + flow. + + If both singular values of (ca A - w D) are less than SMIN, SMIN*iden- + tity will be used instead of (ca A - w D). If only one singular value + is less than SMIN, one element of (ca A - w D) will be perturbed enough + to make the smallest singular value roughly SMIN. If both singular + values are at least SMIN, (ca A - w D) will not be perturbed. In any + case, the perturbation will be at most some small multiple of max( + SMIN, ulp*norm(ca A - w D) ). The singular values are computed by + infinity-norm approximations, and thus will only be correct to a factor + of 2 or so. + + Note: all input quantities are assumed to be smaller than overflow by a + reasonable factor. (See BIGNUM.) + + +ARGUMENTS + LTRANS (input) LOGICAL + =.TRUE.: A-transpose will be used. + =.FALSE.: A will be used (not transposed.) + + NA (input) INTEGER + The size of the matrix A. It may (only) be 1 or 2. + + NW (input) INTEGER + 1 if "w" is real, 2 if "w" is complex. It may only be 1 or 2. + + SMIN (input) DOUBLE PRECISION + The desired lower bound on the singular values of A. This + should be a safe distance away from underflow or overflow, say, + between (underflow/machine precision) and (machine precision * + overflow ). (See BIGNUM and ULP.) + + CA (input) DOUBLE PRECISION + The coefficient c, which A is multiplied by. + + A (input) DOUBLE PRECISION array, dimension (LDA,NA) + The NA x NA matrix A. + + LDA (input) INTEGER + The leading dimension of A. It must be at least NA. + + D1 (input) DOUBLE PRECISION + The 1,1 element in the diagonal matrix D. + + D2 (input) DOUBLE PRECISION + The 2,2 element in the diagonal matrix D. Not used if NW=1. + + B (input) DOUBLE PRECISION array, dimension (LDB,NW) + The NA x NW matrix B (right-hand side). If NW=2 ("w" is com- + plex), column 1 contains the real part of B and column 2 con- + tains the imaginary part. + + LDB (input) INTEGER + The leading dimension of B. It must be at least NA. + + WR (input) DOUBLE PRECISION + The real part of the scalar "w". + + WI (input) DOUBLE PRECISION + The imaginary part of the scalar "w". Not used if NW=1. + + X (output) DOUBLE PRECISION array, dimension (LDX,NW) + The NA x NW matrix X (unknowns), as computed by DLALN2. If + NW=2 ("w" is complex), on exit, column 1 will contain the real + part of X and column 2 will contain the imaginary part. + + LDX (input) INTEGER + The leading dimension of X. It must be at least NA. + + SCALE (output) DOUBLE PRECISION + The scale factor that B must be multiplied by to insure that + overflow does not occur when computing X. Thus, (ca A - w D) X + will be SCALE*B, not B (ignoring perturbations of A.) It will + be at most 1. + + XNORM (output) DOUBLE PRECISION + The infinity-norm of X, when X is regarded as an NA x NW real + matrix. + + INFO (output) INTEGER + An error flag. It will be set to zero if no error occurs, a + negative number if an argument is in error, or a positive num- + ber if ca A - w D had to be perturbed. The possible values + are: + = 0: No error occurred, and (ca A - w D) did not have to be + perturbed. = 1: (ca A - w D) had to be perturbed to make its + smallest (or only) singular value greater than SMIN. NOTE: In + the interests of speed, this routine does not check the inputs + for errors. + +@ + <>= (let* ((zero 0.0) (one 1.0) (two 2.0)) (declare (type (double-float 0.0 0.0) zero) @@ -38794,32 +48643,70 @@ The return values are: xnorm info))))))) -;(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::dlaln2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((member t nil) fixnum -; fixnum (double-float) -; (double-float) (array double-float (*)) -; fixnum (double-float) -; (double-float) (array double-float (*)) -; fixnum (double-float) -; (double-float) (array double-float (*)) -; fixnum (double-float) -; (double-float) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; nil nil fortran-to-lisp::scale -; fortran-to-lisp::xnorm fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dladiv fortran-to-lisp::dlamch)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlamch LAPACK} %\pagehead{dlamch}{dlamch} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlamch.output +)spool dlamch.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlamch examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLAMCH - determine double precision machine parameters + +SYNOPSIS + DOUBLE PRECISION FUNCTION DLAMCH( CMACH ) + + CHARACTER CMACH + +PURPOSE + DLAMCH determines double precision machine parameters. + +ARGUMENTS + CMACH (input) CHARACTER*1 + Specifies the value to be returned by DLAMCH: + = 'E' or 'e', DLAMCH := eps + = 'S' or 's , DLAMCH := sfmin + = 'B' or 'b', DLAMCH := base + = 'P' or 'p', DLAMCH := eps*base + = 'N' or 'n', DLAMCH := t + = 'R' or 'r', DLAMCH := rnd + = 'M' or 'm', DLAMCH := emin + = 'U' or 'u', DLAMCH := rmin + = 'L' or 'l', DLAMCH := emax + = 'O' or 'o', DLAMCH := rmax + + where + + eps = relative machine precision + sfmin = safe minimum, such that 1/sfmin does not overflow base = + base of the machine prec = eps*base t = number of (base) + digits in the mantissa rnd = 1.0 when rounding occurs in addi- + tion, 0.0 otherwise emin = minimum exponent before (gradual) + underflow rmin = underflow threshold - base**(emin-1) emax = + largest exponent before overflow rmax = overflow threshold - + (base**emax)*(1-eps) + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -38840,7 +48727,7 @@ The return values are: (type (double-float) prec rmax emax rmin emin rnd base sfmin eps)) (setq first$ t) (defun dlamch (cmach) - (declare (type (simple-array character (*)) cmach)) + (declare (type character cmach)) (f2cl-lib:with-multi-array-data ((cmach character cmach-%data% cmach-%offset%)) (prog ((rmach 0.0) (small 0.0) (t$ 0.0) (beta 0) (imax 0) (imin 0) @@ -38881,46 +48768,103 @@ The return values are: ((>= small sfmin) (setf sfmin (* small (+ one eps))))))) (cond - ((lsame cmach "E") + ((char-equal cmach #\E) (setf rmach eps)) - ((lsame cmach "S") + ((char-equal cmach #\S) (setf rmach sfmin)) - ((lsame cmach "B") + ((char-equal cmach #\B) (setf rmach base)) - ((lsame cmach "P") + ((char-equal cmach #\P) (setf rmach prec)) - ((lsame cmach "N") + ((char-equal cmach #\N) (setf rmach t$)) - ((lsame cmach "R") + ((char-equal cmach #\R) (setf rmach rnd)) - ((lsame cmach "M") + ((char-equal cmach #\M) (setf rmach emin)) - ((lsame cmach "U") + ((char-equal cmach #\U) (setf rmach rmin)) - ((lsame cmach "L") + ((char-equal cmach #\L) (setf rmach emax)) - ((lsame cmach "O") + ((char-equal cmach #\O) (setf rmach rmax))) (setf dlamch rmach) end_label (return (values dlamch 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::dlamch -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1))) -; :return-values '(nil) -; :calls '(fortran-to-lisp::dlamc2 fortran-to-lisp::lsame))));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlamc1 LAPACK} %\pagehead{dlamc1}{dlamc1} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlamc1.output +)spool dlamc1.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlamc1 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + -- LAPACK auxiliary routine (version 1.1) -- + Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., + Courant Institute, Argonne National Lab, and Rice University + October 31, 1992 + + .. Scalar Arguments .. +< LOGICAL IEEE1, RND > +< INTEGER BETA, T > + .. + + Purpose + ======= + + DLAMC1 determines the machine parameters given by BETA, T, RND, and + IEEE1. + + Arguments + ========= + + BETA (output) INTEGER + The base of the machine. + + T (output) INTEGER + The number of ( BETA ) digits in the mantissa. + + RND (output) LOGICAL + Specifies whether proper rounding ( RND = .TRUE. ) or + chopping ( RND = .FALSE. ) occurs in addition. This may not + be a reliable guide to the way in which the machine performs + its arithmetic. + + IEEE1 (output) LOGICAL + Specifies whether rounding appears to be done in the IEEE + 'round to nearest' style. + + Further Details + =============== + + See Malcolm M. A. (1972) Algorithms to reveal properties of + floating-point arithmetic. Comms. of the ACM, 15, 949-951. + + See Gentleman W. M. and Marovich S. B. (1974) More on algorithms + that reveal properties of floating point arithmetic units. + Comms. of the ACM, 17, 276-277. + +@ + <>= (let ((lieee1 nil) (lbeta 0) (lrnd nil) (f2cl-lib:lt 0) (first$ nil)) (declare (type fixnum f2cl-lib:lt lbeta) @@ -39051,24 +48995,95 @@ The return values are: end_label (return (values beta t$ rnd ieee1))))) -;(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::dlamc1 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (member t nil) (member t nil)) -; :return-values '(fortran-to-lisp::beta fortran-to-lisp::t$ -; fortran-to-lisp::rnd fortran-to-lisp::ieee1) -; :calls '(fortran-to-lisp::dlamc3)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlamc2 LAPACK} %\pagehead{dlamc2}{dlamc2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlamc2.output +)spool dlamc2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlamc2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + -- LAPACK auxiliary routine (version 1.1) -- + Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., + Courant Institute, Argonne National Lab, and Rice University + October 31, 1992 + + .. Scalar Arguments .. +< LOGICAL RND > +< INTEGER BETA, EMAX, EMIN, T > +< DOUBLE PRECISION EPS, RMAX, RMIN > + .. + + Purpose + ======= + + DLAMC2 determines the machine parameters specified in its argument + list. + + Arguments + ========= + + BETA (output) INTEGER + The base of the machine. + + T (output) INTEGER + The number of ( BETA ) digits in the mantissa. + + RND (output) LOGICAL + Specifies whether proper rounding ( RND = .TRUE. ) or + chopping ( RND = .FALSE. ) occurs in addition. This may not + be a reliable guide to the way in which the machine performs + its arithmetic. + + EPS (output) DOUBLE PRECISION + The smallest positive number such that + + fl( 1.0 - EPS ) .LT. 1.0, + + where fl denotes the computed value. + + EMIN (output) INTEGER + The minimum exponent before (gradual) underflow occurs. + + RMIN (output) DOUBLE PRECISION + The smallest normalized number for the machine, given by + BASE**( EMIN - 1 ), where BASE is the floating point value + of BETA. + + EMAX (output) INTEGER + The maximum exponent before overflow occurs. + + RMAX (output) DOUBLE PRECISION + The largest positive number for the machine, given by + BASE**EMAX * ( 1 - EPS ), where BASE is the floating point + value of BETA. + + Further Details + =============== + + The computation of EPS is based on a routine PARANOIA by + W. Kahan of the University of California at Berkeley. + +@ + <>= (let ((lbeta 0) (lemax 0) @@ -39308,29 +49323,56 @@ The return values are: end_label (return (values beta t$ rnd eps emin rmin emax rmax))))) -;(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::dlamc2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (member t nil) (double-float) -; fixnum (double-float) -; fixnum (double-float)) -; :return-values '(fortran-to-lisp::beta fortran-to-lisp::t$ -; fortran-to-lisp::rnd fortran-to-lisp::eps -; fortran-to-lisp::emin fortran-to-lisp::rmin -; fortran-to-lisp::emax fortran-to-lisp::rmax) -; :calls '(fortran-to-lisp::dlamc5 fortran-to-lisp::dlamc4 -; fortran-to-lisp::dlamc3 fortran-to-lisp::dlamc1)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlamc3 LAPACK} %\pagehead{dlamc3}{dlamc3} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlamc3.output +)spool dlamc3.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlamc3 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + -- LAPACK auxiliary routine (version 1.1) -- + Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., + Courant Institute, Argonne National Lab, and Rice University + October 31, 1992 + + .. Scalar Arguments .. +< DOUBLE PRECISION A, B > + .. + + Purpose + ======= + + DLAMC3 is intended to force A and B to be stored prior to doing + the addition of A and B , for use in situations where optimizers + might hold one of these in a register. + + Arguments + ========= + + A, B (input) DOUBLE PRECISION + The values A and B. + +@ + <>= (defun dlamc3 (a b) (declare (type (double-float) b a)) @@ -39339,22 +49381,63 @@ The return values are: (setf dlamc3 (+ a b)) (return (values dlamc3 a b)))) -;(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::dlamc3 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((double-float) (double-float)) -; :return-values '(fortran-to-lisp::a fortran-to-lisp::b) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlamc4 LAPACK} %\pagehead{dlamc4}{dlamc4} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlamc4.output +)spool dlamc4.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlamc4 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + -- LAPACK auxiliary routine (version 1.1) -- + Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., + Courant Institute, Argonne National Lab, and Rice University + October 31, 1992 + + .. Scalar Arguments .. +< INTEGER BASE, EMIN > +< DOUBLE PRECISION START > + .. + + Purpose + ======= + + DLAMC4 is a service routine for DLAMC2. + + Arguments + ========= + + EMIN (output) EMIN + The minimum exponent before (gradual) underflow, computed by + setting A = START and dividing by BASE until the previous A + can not be recovered. + + START (input) DOUBLE PRECISION + The starting point for determining EMIN. + + BASE (input) INTEGER + The base of the machine. + +@ + <>= (defun dlamc4 (emin start base) (declare (type (double-float) start) (type fixnum base emin)) @@ -39418,23 +49501,78 @@ The return values are: end_label (return (values emin 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::dlamc4 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (double-float) -; fixnum) -; :return-values '(fortran-to-lisp::emin nil nil) -; :calls '(fortran-to-lisp::dlamc3))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlamc5 LAPACK} %\pagehead{dlamc5}{dlamc5} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlamc5.output +)spool dlamc5.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlamc5 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + + -- LAPACK auxiliary routine (version 1.1) -- + Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., + Courant Institute, Argonne National Lab, and Rice University + October 31, 1992 + + .. Scalar Arguments .. +< LOGICAL IEEE > +< INTEGER BETA, EMAX, EMIN, P > +< DOUBLE PRECISION RMAX > + .. + + Purpose + ======= + + DLAMC5 attempts to compute RMAX, the largest machine floating-point + number, without overflow. It assumes that EMAX + abs(EMIN) sum + approximately to a power of 2. It will fail on machines where this + assumption does not hold, for example, the Cyber 205 (EMIN = -28625, + EMAX = 28718). It will also fail if the value supplied for EMIN is + too large (i.e. too close to zero), probably with overflow. + + Arguments + ========= + + BETA (input) INTEGER + The base of floating-point arithmetic. + + P (input) INTEGER + The number of base BETA digits in the mantissa of a + floating-point value. + + EMIN (input) INTEGER + The minimum exponent before (gradual) underflow. + + IEEE (input) LOGICAL + A logical flag specifying whether or not the arithmetic + system is thought to comply with the IEEE standard. + + EMAX (output) INTEGER + The largest exponent before overflow + + RMAX (output) DOUBLE PRECISION + The largest machine floating-point number. + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -39505,26 +49643,75 @@ The return values are: end_label (return (values beta nil emin ieee emax rmax))))) -;(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::dlamc5 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum (member t nil) -; fixnum (double-float)) -; :return-values '(fortran-to-lisp::beta nil fortran-to-lisp::emin -; fortran-to-lisp::ieee fortran-to-lisp::emax -; fortran-to-lisp::rmax) -; :calls '(fortran-to-lisp::dlamc3))));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlamrg LAPACK} %\pagehead{dlamrg}{dlamrg} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlamrg.output +)spool dlamrg.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlamrg examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLAMRG - create a permutation list which will merge the elements of A + (which is composed of two independently sorted sets) into a single set + which is sorted in ascending order + +SYNOPSIS + SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX ) + + INTEGER DTRD1, DTRD2, N1, N2 + + INTEGER INDEX( * ) + + DOUBLE PRECISION A( * ) + +PURPOSE + DLAMRG will create a permutation list which will merge the elements of + A (which is composed of two independently sorted sets) into a single + set which is sorted in ascending order. + + +ARGUMENTS + N1 (input) INTEGER + N2 (input) INTEGER These arguements contain the respective + lengths of the two sorted lists to be merged. + + A (input) DOUBLE PRECISION array, dimension (N1+N2) + The first N1 elements of A contain a list of numbers which are + sorted in either ascending or descending order. Likewise for + the final N2 elements. + + DTRD1 (input) INTEGER + DTRD2 (input) INTEGER These are the strides to be taken through + the array A. Allowable strides are 1 and -1. They indicate + whether a subset of A is sorted in ascending (DTRDx = 1) or + descending (DTRDx = -1) order. + + INDEX (output) INTEGER array, dimension (N1+N2) + On exit this array will contain a permutation such that if B( I + ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be sorted in + ascending order. + +@ + <>= (defun dlamrg (n1 n2 a dtrd1 dtrd2 indx) (declare (type (array fixnum (*)) indx) @@ -39582,25 +49769,95 @@ The return values are: end_label (return (values 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::dlamrg -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; fixnum -; (array fixnum (*))) -; :return-values '(nil nil nil nil nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlange LAPACK} %\pagehead{dlange}{dlange} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlange.output +)spool dlange.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlange examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLANGE - the value of the one norm, or the Frobenius norm, or the + infinity norm, or the element of largest absolute value of a real + matrix A + +SYNOPSIS + DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK ) + + CHARACTER NORM + + INTEGER LDA, M, N + + DOUBLE PRECISION A( LDA, * ), WORK( * ) + +PURPOSE + DLANGE returns the value of the one norm, or the Frobenius norm, or + the infinity norm, or the element of largest absolute value of a + real matrix A. + + +DESCRIPTION + DLANGE returns the value + + DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm' + ( + ( norm1(A), NORM = '1', 'O' or 'o' + ( + ( normI(A), NORM = 'I' or 'i' + ( + ( normF(A), NORM = 'F', 'f', 'E' or 'e' + + where norm1 denotes the one norm of a matrix (maximum column sum), + normI denotes the infinity norm of a matrix (maximum row sum) and + normF denotes the Frobenius norm of a matrix (square root of sum of + squares). Note that max(abs(A(i,j))) is not a consistent matrix + norm. + + +ARGUMENTS + NORM (input) CHARACTER*1 + Specifies the value to be returned in DLANGE as described + above. + + M (input) INTEGER + The number of rows of the matrix A. M >= 0. When M = 0, + DLANGE is set to zero. + + N (input) INTEGER + The number of columns of the matrix A. N >= 0. When N = 0, + DLANGE is set to zero. + + A (input) DOUBLE PRECISION array, dimension (LDA,N) + The m by n matrix A. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(M,1). + + WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)), + where LWORK >= M when NORM = 'I'; otherwise, WORK is not refer- + enced. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -39608,7 +49865,7 @@ The return values are: (defun dlange (norm m n a lda work) (declare (type (array double-float (*)) work a) (type fixnum lda n m) - (type (simple-array character (*)) norm)) + (type character norm)) (f2cl-lib:with-multi-array-data ((norm character norm-%data% norm-%offset%) (a double-float a-%data% a-%offset%) @@ -39619,7 +49876,7 @@ The return values are: (cond ((= (min (the fixnum m) (the fixnum n)) 0) (setf value zero)) - ((lsame norm "M") + ((char-equal norm #\M) (setf value zero) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) @@ -39634,7 +49891,7 @@ The return values are: (i j) ((1 lda) (1 *)) a-%offset%))))))))) - ((or (lsame norm "O") (f2cl-lib:fstring-= norm "1")) + ((or (char-equal norm #\O) (f2cl-lib:fstring-= norm "1")) (setf value zero) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) @@ -39651,7 +49908,7 @@ The return values are: ((1 lda) (1 *)) a-%offset%)))))) (setf value (max value sum))))) - ((lsame norm "I") + ((char-equal norm #\I) (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i m) nil) (tagbody @@ -39684,7 +49941,7 @@ The return values are: (i) ((1 *)) work-%offset%)))))) - ((or (lsame norm "F") (lsame norm "E")) + ((or (char-equal norm #\F) (char-equal norm #\E)) (setf scale zero) (setf sum one) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -39702,25 +49959,92 @@ The return values are: end_label (return (values dlange 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::dlange -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*))) -; :return-values '(nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::dlassq fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlanhs LAPACK} %\pagehead{dlanhs}{dlanhs} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlanhs.output +)spool dlanhs.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlanhs examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLANHS - the value of the one norm, or the Frobenius norm, or the + infinity norm, or the element of largest absolute value of a Hessenberg + matrix A + +SYNOPSIS + DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK ) + + CHARACTER NORM + + INTEGER LDA, N + + DOUBLE PRECISION A( LDA, * ), WORK( * ) + +PURPOSE + DLANHS returns the value of the one norm, or the Frobenius norm, or + the infinity norm, or the element of largest absolute value of a + Hessenberg matrix A. + + +DESCRIPTION + DLANHS returns the value + + DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm' + ( + ( norm1(A), NORM = '1', 'O' or 'o' + ( + ( normI(A), NORM = 'I' or 'i' + ( + ( normF(A), NORM = 'F', 'f', 'E' or 'e' + + where norm1 denotes the one norm of a matrix (maximum column sum), + normI denotes the infinity norm of a matrix (maximum row sum) and + normF denotes the Frobenius norm of a matrix (square root of sum of + squares). Note that max(abs(A(i,j))) is not a consistent matrix + norm. + + +ARGUMENTS + NORM (input) CHARACTER*1 + Specifies the value to be returned in DLANHS as described + above. + + N (input) INTEGER + The order of the matrix A. N >= 0. When N = 0, DLANHS is set + to zero. + + A (input) DOUBLE PRECISION array, dimension (LDA,N) + The n by n upper Hessenberg matrix A; the part of A below the + first sub-diagonal is not referenced. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(N,1). + + WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)), + where LWORK >= N when NORM = 'I'; otherwise, WORK is not refer- + enced. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -39728,7 +50052,7 @@ The return values are: (defun dlanhs (norm n a lda work) (declare (type (array double-float (*)) work a) (type fixnum lda n) - (type (simple-array character (*)) norm)) + (type character norm)) (f2cl-lib:with-multi-array-data ((norm character norm-%data% norm-%offset%) (a double-float a-%data% a-%offset%) @@ -39739,7 +50063,7 @@ The return values are: (cond ((= n 0) (setf value zero)) - ((lsame norm "M") + ((char-equal norm #\M) (setf value zero) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) @@ -39758,7 +50082,7 @@ The return values are: (i j) ((1 lda) (1 *)) a-%offset%))))))))) - ((or (lsame norm "O") (f2cl-lib:fstring-= norm "1")) + ((or (char-equal norm #\O) (f2cl-lib:fstring-= norm "1")) (setf value zero) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) @@ -39779,7 +50103,7 @@ The return values are: ((1 lda) (1 *)) a-%offset%)))))) (setf value (max value sum))))) - ((lsame norm "I") + ((char-equal norm #\I) (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i n) nil) (tagbody @@ -39816,7 +50140,7 @@ The return values are: (i) ((1 *)) work-%offset%)))))) - ((or (lsame norm "F") (lsame norm "E")) + ((or (char-equal norm #\F) (char-equal norm #\E)) (setf scale zero) (setf sum one) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -39836,24 +50160,87 @@ The return values are: end_label (return (values dlanhs 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::dlanhs -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*))) -; :return-values '(nil nil nil nil nil) -; :calls '(fortran-to-lisp::dlassq fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlanst LAPACK} %\pagehead{dlanst}{dlanst} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlanst.output +)spool dlanst.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlanst examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLANST - the value of the one norm, or the Frobenius norm, or the + infinity norm, or the element of largest absolute value of a real sym- + metric tridiagonal matrix A + +SYNOPSIS + DOUBLE PRECISION FUNCTION DLANST( NORM, N, D, E ) + + CHARACTER NORM + + INTEGER N + + DOUBLE PRECISION D( * ), E( * ) + +PURPOSE + DLANST returns the value of the one norm, or the Frobenius norm, or + the infinity norm, or the element of largest absolute value of a + real symmetric tridiagonal matrix A. + + +DESCRIPTION + DLANST returns the value + + DLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm' + ( + ( norm1(A), NORM = '1', 'O' or 'o' + ( + ( normI(A), NORM = 'I' or 'i' + ( + ( normF(A), NORM = 'F', 'f', 'E' or 'e' + + where norm1 denotes the one norm of a matrix (maximum column sum), + normI denotes the infinity norm of a matrix (maximum row sum) and + normF denotes the Frobenius norm of a matrix (square root of sum of + squares). Note that max(abs(A(i,j))) is not a consistent matrix + norm. + + +ARGUMENTS + NORM (input) CHARACTER*1 + Specifies the value to be returned in DLANST as described + above. + + N (input) INTEGER + The order of the matrix A. N >= 0. When N = 0, DLANST is set + to zero. + + D (input) DOUBLE PRECISION array, dimension (N) + The diagonal elements of A. + + E (input) DOUBLE PRECISION array, dimension (N-1) + The (n-1) sub-diagonal or super-diagonal elements of A. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -39861,7 +50248,7 @@ The return values are: (defun dlanst (norm n d e) (declare (type (array double-float (*)) e d) (type fixnum n) - (type (simple-array character (*)) norm)) + (type character norm)) (f2cl-lib:with-multi-array-data ((norm character norm-%data% norm-%offset%) (d double-float d-%data% d-%offset%) @@ -39872,7 +50259,7 @@ The return values are: (cond ((<= n 0) (setf anorm zero)) - ((lsame norm "M") + ((char-equal norm #\M) (setf anorm (abs (f2cl-lib:fref d-%data% (n) ((1 *)) d-%offset%))) (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i (f2cl-lib:int-add n (f2cl-lib:int-sub 1))) nil) @@ -39885,7 +50272,7 @@ The return values are: (max anorm (abs (f2cl-lib:fref e-%data% (i) ((1 *)) e-%offset%))))))) - ((or (lsame norm "O") (f2cl-lib:fstring-= norm "1") (lsame norm "I")) + ((or (char-equal norm #\O) (f2cl-lib:fstring-= norm "1") (char-equal norm #\I)) (cond ((= n 1) (setf anorm @@ -39925,7 +50312,7 @@ The return values are: ((f2cl-lib:int-sub i 1)) ((1 *)) e-%offset%)))))))))) - ((or (lsame norm "F") (lsame norm "E")) + ((or (char-equal norm #\F) (char-equal norm #\E)) (setf scale zero) (setf sum one) (cond @@ -39946,24 +50333,73 @@ The return values are: end_label (return (values dlanst 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::dlanst -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (array double-float (*)) -; (array double-float (*))) -; :return-values '(nil nil nil nil) -; :calls '(fortran-to-lisp::dlassq fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlanv2 LAPACK} %\pagehead{dlanv2}{dlanv2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlanv2.output +)spool dlanv2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlanv2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLANV2 - the Schur factorization of a real 2-by-2 nonsymmetric matrix + in standard form + +SYNOPSIS + SUBROUTINE DLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN ) + + DOUBLE PRECISION A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN + +PURPOSE + DLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric + matrix in standard form: + + [ A B ] = [ CS -SN ] [ AA BB ] [ CS SN ] + [ C D ] [ SN CS ] [ CC DD ] [-SN CS ] + + where either + 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or 2) + AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex conju- + gate eigenvalues. + + +ARGUMENTS + A (input/output) DOUBLE PRECISION + B (input/output) DOUBLE PRECISION C (input/output) + DOUBLE PRECISION D (input/output) DOUBLE PRECISION On + entry, the elements of the input matrix. On exit, they are + overwritten by the elements of the standardised Schur form. + + RT1R (output) DOUBLE PRECISION + RT1I (output) DOUBLE PRECISION RT2R (output) DOUBLE PRE- + CISION RT2I (output) DOUBLE PRECISION The real and imaginary + parts of the eigenvalues. If the eigenvalues are a complex con- + jugate pair, RT1I > 0. + + CS (output) DOUBLE PRECISION + SN (output) DOUBLE PRECISION Parameters of the rotation + matrix. + +@ + <>= (let* ((zero 0.0) (half 0.5) (one 1.0) (multpl 4.0)) (declare (type (double-float 0.0 0.0) zero) @@ -40075,29 +50511,52 @@ The return values are: end_label (return (values a b c d rt1r rt1i rt2r rt2i cs sn))))) -;(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::dlanv2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((double-float) (double-float) (double-float) -; (double-float) (double-float) (double-float) -; (double-float) (double-float) (double-float) -; (double-float)) -; :return-values '(fortran-to-lisp::a fortran-to-lisp::b -; fortran-to-lisp::c fortran-to-lisp::d -; fortran-to-lisp::rt1r fortran-to-lisp::rt1i -; fortran-to-lisp::rt2r fortran-to-lisp::rt2i -; fortran-to-lisp::cs fortran-to-lisp::sn) -; :calls '(fortran-to-lisp::dlapy2 fortran-to-lisp::dlamch)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlapy2 LAPACK} %\pagehead{dlapy2}{dlapy2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlapy2.output +)spool dlapy2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlapy2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLAPY2 - sqrt(x**2+y**2), taking care not to cause unnecessary overflow + +SYNOPSIS + DOUBLE PRECISION FUNCTION DLAPY2( X, Y ) + + DOUBLE PRECISION X, Y + +PURPOSE + DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary + overflow. + + +ARGUMENTS + X (input) DOUBLE PRECISION + Y (input) DOUBLE PRECISION X and Y specify the values x + and y. + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -40117,22 +50576,124 @@ The return values are: (setf dlapy2 (* w (f2cl-lib:fsqrt (+ one (expt (/ z w) 2))))))) (return (values dlapy2 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::dlapy2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((double-float) (double-float)) -; :return-values '(nil nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlaqtr LAPACK} %\pagehead{dlaqtr}{dlaqtr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlaqtr.output +)spool dlaqtr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlaqtr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLAQTR - the real quasi-triangular system op(T)*p = scale*c, if LREAL + = .TRUE + +SYNOPSIS + SUBROUTINE DLAQTR( LTRAN, LREAL, N, T, LDT, B, W, SCALE, X, WORK, INFO + ) + + LOGICAL LREAL, LTRAN + + INTEGER INFO, LDT, N + + DOUBLE PRECISION SCALE, W + + DOUBLE PRECISION B( * ), T( LDT, * ), WORK( * ), X( * ) + +PURPOSE + DLAQTR solves the real quasi-triangular system + + or the complex quasi-triangular systems + + op(T + iB)*(p+iq) = scale*(c+id), if LREAL = .FALSE. + + in real arithmetic, where T is upper quasi-triangular. + If LREAL = .FALSE., then the first diagonal block of T must be 1 by 1, + B is the specially structured matrix + + B = [ b(1) b(2) ... b(n) ] + [ w ] + [ w ] + [ . ] + [ w ] + + op(A) = A or A', A' denotes the conjugate transpose of + matrix A. + + On input, X = [ c ]. On output, X = [ p ]. + [ d ] [ q ] + + This subroutine is designed for the condition number estimation in rou- + tine DTRSNA. + + +ARGUMENTS + LTRAN (input) LOGICAL + On entry, LTRAN specifies the option of conjugate transpose: = + .FALSE., op(T+i*B) = T+i*B, = .TRUE., op(T+i*B) = + (T+i*B)'. + + LREAL (input) LOGICAL + On entry, LREAL specifies the input matrix structure: = + .FALSE., the input is complex = .TRUE., the input is + real + + N (input) INTEGER + On entry, N specifies the order of T+i*B. N >= 0. + + T (input) DOUBLE PRECISION array, dimension (LDT,N) + On entry, T contains a matrix in Schur canonical form. If + LREAL = .FALSE., then the first diagonal block of T mu be 1 by + 1. + + LDT (input) INTEGER + The leading dimension of the matrix T. LDT >= max(1,N). + + B (input) DOUBLE PRECISION array, dimension (N) + On entry, B contains the elements to form the matrix B as + described above. If LREAL = .TRUE., B is not referenced. + + W (input) DOUBLE PRECISION + On entry, W is the diagonal element of the matrix B. If LREAL + = .TRUE., W is not referenced. + + SCALE (output) DOUBLE PRECISION + On exit, SCALE is the scale factor. + + X (input/output) DOUBLE PRECISION array, dimension (2*N) + On entry, X contains the right hand side of the system. On + exit, X is overwritten by the solution. + + WORK (workspace) DOUBLE PRECISION array, dimension (N) + + INFO (output) INTEGER + On exit, INFO is set to 0: successful exit. + 1: the some diagonal 1 by 1 block has been perturbed by a small + number SMIN to keep nonsingularity. 2: the some diagonal 2 by + 2 block has been perturbed by a small number in DLALN2 to keep + nonsingularity. NOTE: In the interests of speed, this routine + does not check the inputs for errors. + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -41269,38 +51830,121 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil scale nil nil info)))))) -;(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::dlaqtr -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((member t nil) (member t nil) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (double-float) (double-float) (array double-float (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::scale -; nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dladiv fortran-to-lisp::ddot -; fortran-to-lisp::dlaln2 fortran-to-lisp::daxpy -; fortran-to-lisp::dscal fortran-to-lisp::idamax -; fortran-to-lisp::dasum fortran-to-lisp::dlange -; fortran-to-lisp::dlamch))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlarfb LAPACK} %\pagehead{dlarfb}{dlarfb} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlarfb.output +)spool dlarfb.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlarfb examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLARFB - a real block reflector H or its transpose H' to a real m by n + matrix C, from either the left or the right + +SYNOPSIS + SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, + LDT, C, LDC, WORK, LDWORK ) + + CHARACTER DIRECT, SIDE, STOREV, TRANS + + INTEGER K, LDC, LDT, LDV, LDWORK, M, N + + DOUBLE PRECISION C( LDC, * ), T( LDT, * ), V( LDV, * ), + WORK( LDWORK, * ) + +PURPOSE + DLARFB applies a real block reflector H or its transpose H' to a real m + by n matrix C, from either the left or the right. + + +ARGUMENTS + SIDE (input) CHARACTER*1 + = 'L': apply H or H' from the Left + = 'R': apply H or H' from the Right + + TRANS (input) CHARACTER*1 + = 'N': apply H (No transpose) + = 'T': apply H' (Transpose) + + DIRECT (input) CHARACTER*1 + Indicates how H is formed from a product of elementary reflec- + tors = 'F': H = H(1) H(2) . . . H(k) (Forward) + = 'B': H = H(k) . . . H(2) H(1) (Backward) + + STOREV (input) CHARACTER*1 + Indicates how the vectors which define the elementary reflec- + tors are stored: + = 'C': Columnwise + = 'R': Rowwise + + M (input) INTEGER + The number of rows of the matrix C. + + N (input) INTEGER + The number of columns of the matrix C. + + K (input) INTEGER + The order of the matrix T (= the number of elementary reflec- + tors whose product defines the block reflector). + + V (input) DOUBLE PRECISION array, dimension + (LDV,K) if STOREV = 'C' (LDV,M) if STOREV = 'R' and SIDE = 'L' + (LDV,N) if STOREV = 'R' and SIDE = 'R' The matrix V. See fur- + ther details. + + LDV (input) INTEGER + The leading dimension of the array V. If STOREV = 'C' and SIDE + = 'L', LDV >= max(1,M); if STOREV = 'C' and SIDE = 'R', LDV >= + max(1,N); if STOREV = 'R', LDV >= K. + + T (input) DOUBLE PRECISION array, dimension (LDT,K) + The triangular k by k matrix T in the representation of the + block reflector. + + LDT (input) INTEGER + The leading dimension of the array T. LDT >= K. + + C (input/output) DOUBLE PRECISION array, dimension (LDC,N) + On entry, the m by n matrix C. On exit, C is overwritten by + H*C or H'*C or C*H or C*H'. + + LDC (input) INTEGER + The leading dimension of the array C. LDA >= max(1,M). + + WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,K) + + LDWORK (input) INTEGER + The leading dimension of the array WORK. If SIDE = 'L', LDWORK + >= max(1,N); if SIDE = 'R', LDWORK >= max(1,M). + +@ + <>= (let* ((one 1.0)) (declare (type (double-float 1.0 1.0) one)) (defun dlarfb (side trans direct storev m n k v ldv t$ ldt c ldc work ldwork) (declare (type (array double-float (*)) work c t$ v) (type fixnum ldwork ldc ldt ldv k n m) - (type (simple-array character (*)) storev direct trans side)) + (type character storev direct trans side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (trans character trans-%data% trans-%offset%) @@ -41317,16 +51961,16 @@ The return values are: (type (simple-array character (1)) transt)) (if (or (<= m 0) (<= n 0)) (go end_label)) (cond - ((lsame trans "N") + ((char-equal trans #\N) (f2cl-lib:f2cl-set-string transt "T" (string 1))) (t (f2cl-lib:f2cl-set-string transt "N" (string 1)))) (cond - ((lsame storev "C") + ((char-equal storev #\C) (cond - ((lsame direct "F") + ((char-equal direct #\F) (cond - ((lsame side "L") + ((char-equal side #\L) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j k) nil) (tagbody @@ -41394,7 +52038,7 @@ The return values are: (i j) ((1 ldwork) (1 *)) work-%offset%)))))))) - ((lsame side "R") + ((char-equal side #\R) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j k) nil) (tagbody @@ -41464,7 +52108,7 @@ The return values are: work-%offset%)))))))))) (t (cond - ((lsame side "L") + ((char-equal side #\L) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j k) nil) (tagbody @@ -41526,7 +52170,7 @@ The return values are: (i j) ((1 ldwork) (1 *)) work-%offset%)))))))) - ((lsame side "R") + ((char-equal side #\R) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j k) nil) (tagbody @@ -41591,11 +52235,11 @@ The return values are: (i j) ((1 ldwork) (1 *)) work-%offset%)))))))))))) - ((lsame storev "R") + ((char-equal storev #\R) (cond - ((lsame direct "F") + ((char-equal direct #\F) (cond - ((lsame side "L") + ((char-equal side #\L) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j k) nil) (tagbody @@ -41663,7 +52307,7 @@ The return values are: (i j) ((1 ldwork) (1 *)) work-%offset%)))))))) - ((lsame side "R") + ((char-equal side #\R) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j k) nil) (tagbody @@ -41733,7 +52377,7 @@ The return values are: work-%offset%)))))))))) (t (cond - ((lsame side "L") + ((char-equal side #\L) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j k) nil) (tagbody @@ -41801,7 +52445,7 @@ The return values are: (i j) ((1 ldwork) (1 *)) work-%offset%)))))))) - ((lsame side "R") + ((char-equal side #\R) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j k) nil) (tagbody @@ -41891,33 +52535,84 @@ The return values are: 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::dlarfb -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; nil nil) -; :calls '(fortran-to-lisp::dgemm fortran-to-lisp::dtrmm -; fortran-to-lisp::dcopy fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlarfg LAPACK} %\pagehead{dlarfg}{dlarfg} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlarfg.output +)spool dlarfg.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlarfg examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLARFG - a real elementary reflector H of order n, such that H * ( + alpha ) = ( beta ), H' * H = I + +SYNOPSIS + SUBROUTINE DLARFG( N, ALPHA, X, INCX, TAU ) + + INTEGER INCX, N + + DOUBLE PRECISION ALPHA, TAU + + DOUBLE PRECISION X( * ) + +PURPOSE + DLARFG generates a real elementary reflector H of order n, such that + ( x ) ( 0 ) + + where alpha and beta are scalars, and x is an (n-1)-element real vec- + tor. H is represented in the form + + H = I - tau * ( 1 ) * ( 1 v' ) , + ( v ) + + where tau is a real scalar and v is a real (n-1)-element + vector. + + If the elements of x are all zero, then tau = 0 and H is taken to be + the unit matrix. + + Otherwise 1 <= tau <= 2. + + +ARGUMENTS + N (input) INTEGER + The order of the elementary reflector. + + ALPHA (input/output) DOUBLE PRECISION + On entry, the value alpha. On exit, it is overwritten with the + value beta. + + X (input/output) DOUBLE PRECISION array, dimension + (1+(N-2)*abs(INCX)) On entry, the vector x. On exit, it is + overwritten with the vector v. + + INCX (input) INTEGER + The increment between elements of X. INCX > 0. + + TAU (output) DOUBLE PRECISION + The value tau. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -41968,26 +52663,92 @@ The return values are: end_label (return (values nil alpha nil nil tau)))))) -;(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::dlarfg -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (double-float) -; (array double-float (*)) fixnum -; (double-float)) -; :return-values '(nil fortran-to-lisp::alpha nil nil -; fortran-to-lisp::tau) -; :calls '(fortran-to-lisp::dscal fortran-to-lisp::dlamch -; fortran-to-lisp::dlapy2 fortran-to-lisp::dnrm2)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlarf LAPACK} %\pagehead{dlarf}{dlarf} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlarf.output +)spool dlarf.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlarf examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLARF - a real elementary reflector H to a real m by n matrix C, from + either the left or the right + +SYNOPSIS + SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) + + CHARACTER SIDE + + INTEGER INCV, LDC, M, N + + DOUBLE PRECISION TAU + + DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) + +PURPOSE + DLARF applies a real elementary reflector H to a real m by n matrix C, + from either the left or the right. H is represented in the form + + H = I - tau * v * v' + + where tau is a real scalar and v is a real vector. + + If tau = 0, then H is taken to be the unit matrix. + + +ARGUMENTS + SIDE (input) CHARACTER*1 + = 'L': form H * C + = 'R': form C * H + + M (input) INTEGER + The number of rows of the matrix C. + + N (input) INTEGER + The number of columns of the matrix C. + + V (input) DOUBLE PRECISION array, dimension + (1 + (M-1)*abs(INCV)) if SIDE = 'L' or (1 + (N-1)*abs(INCV)) if + SIDE = 'R' The vector v in the representation of H. V is not + used if TAU = 0. + + INCV (input) INTEGER + The increment between elements of v. INCV <> 0. + + TAU (input) DOUBLE PRECISION + The value tau in the representation of H. + + C (input/output) DOUBLE PRECISION array, dimension (LDC,N) + On entry, the m by n matrix C. On exit, C is overwritten by + the matrix H * C if SIDE = 'L', or C * H if SIDE = 'R'. + + LDC (input) INTEGER + The leading dimension of the array C. LDC >= max(1,M). + + WORK (workspace) DOUBLE PRECISION array, dimension + (N) if SIDE = 'L' or (M) if SIDE = 'R' + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -41996,7 +52757,7 @@ The return values are: (declare (type (double-float) tau) (type (array double-float (*)) work c v) (type fixnum ldc incv n m) - (type (simple-array character (*)) side)) + (type character side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (v double-float v-%data% v-%offset%) @@ -42005,7 +52766,7 @@ The return values are: (prog () (declare) (cond - ((lsame side "L") + ((char-equal side #\L) (cond ((/= tau zero) (dgemv "Transpose" m n one c ldc v incv zero work 1) @@ -42017,26 +52778,128 @@ The return values are: (dger m n (- tau) work 1 v incv c ldc))))) (return (values 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::dlarf fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) fixnum -; (double-float) (array double-float (*)) -; fixnum (array double-float (*))) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::dger fortran-to-lisp::dgemv -; fortran-to-lisp::lsame))));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlarft LAPACK} %\pagehead{dlarft}{dlarft} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlarft.output +)spool dlarft.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlarft examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLARFT - the triangular factor T of a real block reflector H of order + n, which is defined as a product of k elementary reflectors + +SYNOPSIS + SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) + + CHARACTER DIRECT, STOREV + + INTEGER K, LDT, LDV, N + + DOUBLE PRECISION T( LDT, * ), TAU( * ), V( LDV, * ) + +PURPOSE + DLARFT forms the triangular factor T of a real block reflector H of + order n, which is defined as a product of k elementary reflectors. + + If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; + + If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular. + + If STOREV = 'C', the vector which defines the elementary reflector H(i) + is stored in the i-th column of the array V, and + + H = I - V * T * V' + + If STOREV = 'R', the vector which defines the elementary reflector H(i) + is stored in the i-th row of the array V, and + + H = I - V' * T * V + + +ARGUMENTS + DIRECT (input) CHARACTER*1 + Specifies the order in which the elementary reflectors are mul- + tiplied to form the block reflector: + = 'F': H = H(1) H(2) . . . H(k) (Forward) + = 'B': H = H(k) . . . H(2) H(1) (Backward) + + STOREV (input) CHARACTER*1 + Specifies how the vectors which define the elementary reflec- + tors are stored (see also Further Details): + = 'R': rowwise + + N (input) INTEGER + The order of the block reflector H. N >= 0. + + K (input) INTEGER + The order of the triangular factor T (= the number of elemen- + tary reflectors). K >= 1. + + V (input/output) DOUBLE PRECISION array, dimension + (LDV,K) if STOREV = 'C' (LDV,N) if STOREV = 'R' The matrix V. + See further details. + + LDV (input) INTEGER + The leading dimension of the array V. If STOREV = 'C', LDV >= + max(1,N); if STOREV = 'R', LDV >= K. + + TAU (input) DOUBLE PRECISION array, dimension (K) + TAU(i) must contain the scalar factor of the elementary reflec- + tor H(i). + + T (output) DOUBLE PRECISION array, dimension (LDT,K) + The k by k triangular factor T of the block reflector. If + DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is + lower triangular. The rest of the array is not used. + + LDT (input) INTEGER + The leading dimension of the array T. LDT >= K. + +FURTHER DETAILS + The shape of the matrix V and the storage of the vectors which define + the H(i) is best illustrated by the following example with n = 5 and k + = 3. The elements equal to 1 are not stored; the corresponding array + elements are modified but restored on exit. The rest of the array is + not used. + + DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': + + V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) + ( v1 1 ) ( 1 v2 v2 v2 ) + ( v1 v2 1 ) ( 1 v3 v3 ) + ( v1 v2 v3 ) + ( v1 v2 v3 ) + + DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': + + V = ( v1 v2 v3 ) V = ( v1 v1 1 ) + ( v1 v2 v3 ) ( v2 v2 v2 1 ) + ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) + ( 1 v3 ) + ( 1 ) + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -42044,7 +52907,7 @@ The return values are: (defun dlarft (direct storev n k v ldv tau t$ ldt) (declare (type (array double-float (*)) t$ tau v) (type fixnum ldt ldv k n) - (type (simple-array character (*)) storev direct)) + (type character storev direct)) (f2cl-lib:with-multi-array-data ((direct character direct-%data% direct-%offset%) (storev character storev-%data% storev-%offset%) @@ -42055,7 +52918,7 @@ The return values are: (declare (type (double-float) vii) (type fixnum i j)) (if (= n 0) (go end_label)) (cond - ((lsame direct "F") + ((char-equal direct #\F) (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i k) nil) (tagbody @@ -42081,7 +52944,7 @@ The return values are: v-%offset%) one) (cond - ((lsame storev "C") + ((char-equal storev #\C) (dgemv "Transpose" (f2cl-lib:int-add (f2cl-lib:int-sub n i) 1) (f2cl-lib:int-sub i 1) @@ -42155,7 +53018,7 @@ The return values are: (cond ((< i k) (cond - ((lsame storev "C") + ((char-equal storev #\C) (setf vii (f2cl-lib:fref v-%data% ((f2cl-lib:int-add @@ -42267,28 +53130,90 @@ The return values are: end_label (return (values 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::dlarft -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::dtrmv fortran-to-lisp::dgemv -; fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlarfx LAPACK} %\pagehead{dlarfx}{dlarfx} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlarfx.output +)spool dlarfx.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlarfx examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLARFX - a real elementary reflector H to a real m by n matrix C, from + either the left or the right + +SYNOPSIS + SUBROUTINE DLARFX( SIDE, M, N, V, TAU, C, LDC, WORK ) + + CHARACTER SIDE + + INTEGER LDC, M, N + + DOUBLE PRECISION TAU + + DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) + +PURPOSE + DLARFX applies a real elementary reflector H to a real m by n matrix C, + from either the left or the right. H is represented in the form + + H = I - tau * v * v' + + where tau is a real scalar and v is a real vector. + + If tau = 0, then H is taken to be the unit matrix + + This version uses inline code if H has order < 11. + + +ARGUMENTS + SIDE (input) CHARACTER*1 + = 'L': form H * C + = 'R': form C * H + + M (input) INTEGER + The number of rows of the matrix C. + + N (input) INTEGER + The number of columns of the matrix C. + + V (input) DOUBLE PRECISION array, dimension (M) if SIDE = 'L' + or (N) if SIDE = 'R' The vector v in the representation of H. + + TAU (input) DOUBLE PRECISION + The value tau in the representation of H. + + C (input/output) DOUBLE PRECISION array, dimension (LDC,N) + On entry, the m by n matrix C. On exit, C is overwritten by + the matrix H * C if SIDE = 'L', or C * H if SIDE = 'R'. + + LDC (input) INTEGER + The leading dimension of the array C. LDA >= (1,M). + + WORK (workspace) DOUBLE PRECISION array, dimension + (N) if SIDE = 'L' or (M) if SIDE = 'R' WORK is not referenced + if H has order < 11. + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -42297,7 +53222,7 @@ The return values are: (declare (type (double-float) tau) (type (array double-float (*)) work c v) (type fixnum ldc n m) - (type (simple-array character (*)) side)) + (type character side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (v double-float v-%data% v-%offset%) @@ -42312,7 +53237,7 @@ The return values are: (type fixnum j)) (if (= tau zero) (go end_label)) (cond - ((lsame side "L") + ((char-equal side #\L) (tagbody (f2cl-lib:computed-goto (label10 label30 label50 label70 label90 label110 label130 @@ -44333,27 +55258,73 @@ The return values are: end_label (return (values 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::dlarfx -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) (double-float) -; (array double-float (*)) fixnum -; (array double-float (*))) -; :return-values '(nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::dger fortran-to-lisp::dgemv -; fortran-to-lisp::lsame))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlartg LAPACK} %\pagehead{dlartg}{dlartg} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlartg.output +)spool dlartg.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlartg examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLARTG - a plane rotation so that [ CS SN ] + +SYNOPSIS + SUBROUTINE DLARTG( F, G, CS, SN, R ) + + DOUBLE PRECISION CS, F, G, R, SN + +PURPOSE + DLARTG generate a plane rotation so that + [ -SN CS ] [ G ] [ 0 ] + + This is a slower, more accurate version of the BLAS1 routine DROTG, + with the following other differences: + F and G are unchanged on return. + If G=0, then CS=1 and SN=0. + If F=0 and (G .ne. 0), then CS=0 and SN=1 without doing any + floating point operations (saves work in DBDSQR when + there are zeros on the diagonal). + + If F exceeds G in magnitude, CS will be positive. + + +ARGUMENTS + F (input) DOUBLE PRECISION + The first component of vector to be rotated. + + G (input) DOUBLE PRECISION + The second component of vector to be rotated. + + CS (output) DOUBLE PRECISION + The cosine of the rotation. + + SN (output) DOUBLE PRECISION + The sine of the rotation. + + R (output) DOUBLE PRECISION + The nonzero component of the rotated vector. + +@ + <>= (let* ((zero 0.0) (one 1.0) (two 2.0)) (declare (type (double-float 0.0 0.0) zero) @@ -44437,24 +55408,82 @@ The return values are: end_label (return (values nil nil cs sn r)))))) -;(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::dlartg -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((double-float) (double-float) (double-float) -; (double-float) (double-float)) -; :return-values '(nil nil fortran-to-lisp::cs fortran-to-lisp::sn -; fortran-to-lisp::r) -; :calls '(fortran-to-lisp::dlamch)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlas2 LAPACK} %\pagehead{dlas2}{dlas2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlas2.output +)spool dlas2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlas2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLAS2 - the singular values of the 2-by-2 matrix [ F G ] [ 0 H ] + +SYNOPSIS + SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX ) + + DOUBLE PRECISION F, G, H, SSMAX, SSMIN + +PURPOSE + DLAS2 computes the singular values of the 2-by-2 matrix + [ F G ] + [ 0 H ]. On return, SSMIN is the smaller singular value and + SSMAX is the larger singular value. + + +ARGUMENTS + F (input) DOUBLE PRECISION + The (1,1) element of the 2-by-2 matrix. + + G (input) DOUBLE PRECISION + The (1,2) element of the 2-by-2 matrix. + + H (input) DOUBLE PRECISION + The (2,2) element of the 2-by-2 matrix. + + SSMIN (output) DOUBLE PRECISION + The smaller singular value. + + SSMAX (output) DOUBLE PRECISION + The larger singular value. + +FURTHER DETAILS + Barring over/underflow, all output quantities are correct to within a + few units in the last place (ulps), even in the absence of a guard + digit in addition/subtraction. + + In IEEE arithmetic, the code works correctly if one matrix element is + infinite. + + Overflow will not occur unless the largest singular value itself over- + flows, or is within a few ulps of overflow. (On machines with partial + overflow, like the Cray, overflow may occur if the largest singular + value is within a factor of 2 of overflow.) + + Underflow is harmless if underflow is gradual. Otherwise, results may + correspond to a matrix modified by perturbations of size near the + underflow threshold. + +@ + <>= (let* ((zero 0.0) (one 1.0) (two 2.0)) (declare (type (double-float 0.0 0.0) zero) @@ -44511,23 +55540,101 @@ The return values are: (setf ssmax (/ ga (+ c c))))))))) (return (values nil nil nil ssmin ssmax))))) -;(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::dlas2 fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((double-float) (double-float) (double-float) -; (double-float) (double-float)) -; :return-values '(nil nil nil fortran-to-lisp::ssmin -; fortran-to-lisp::ssmax) -; :calls 'nil)));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlascl LAPACK} %\pagehead{dlascl}{dlascl} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlascl.output +)spool dlascl.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlascl examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASCL - the M by N real matrix A by the real scalar CTO/CFROM + +SYNOPSIS + SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) + + CHARACTER TYPE + + INTEGER INFO, KL, KU, LDA, M, N + + DOUBLE PRECISION CFROM, CTO + + DOUBLE PRECISION A( LDA, * ) + +PURPOSE + DLASCL multiplies the M by N real matrix A by the real scalar + CTO/CFROM. This is done without over/underflow as long as the final + result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that A + may be full, upper triangular, lower triangular, upper Hessenberg, or + banded. + + +ARGUMENTS + TYPE (input) CHARACTER*1 + TYPE indices the storage type of the input matrix. = 'G': A + is a full matrix. + = 'L': A is a lower triangular matrix. + = 'U': A is an upper triangular matrix. + = 'H': A is an upper Hessenberg matrix. + = 'B': A is a symmetric band matrix with lower bandwidth KL + and upper bandwidth KU and with the only the lower half stored. + = 'Q': A is a symmetric band matrix with lower bandwidth KL + and upper bandwidth KU and with the only the upper half stored. + = 'Z': A is a band matrix with lower bandwidth KL and upper + bandwidth KU. + + KL (input) INTEGER + The lower bandwidth of A. Referenced only if TYPE = 'B', 'Q' + or 'Z'. + + KU (input) INTEGER + The upper bandwidth of A. Referenced only if TYPE = 'B', 'Q' + or 'Z'. + + CFROM (input) DOUBLE PRECISION + CTO (input) DOUBLE PRECISION The matrix A is multiplied by + CTO/CFROM. A(I,J) is computed without over/underflow if the + final result CTO*A(I,J)/CFROM can be represented without + over/underflow. CFROM must be nonzero. + + M (input) INTEGER + The number of rows of the matrix A. M >= 0. + + N (input) INTEGER + The number of columns of the matrix A. N >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + The matrix to be multiplied by CTO/CFROM. See TYPE for the + storage type. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,M). + + INFO (output) INTEGER + 0 - successful exit <0 - if INFO = -i, the i-th argument had + an illegal value. + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -44536,7 +55643,7 @@ The return values are: (declare (type (array double-float (*)) a) (type (double-float) cto cfrom) (type fixnum info lda n m ku kl) - (type (simple-array character (*)) type)) + (type character type)) (f2cl-lib:with-multi-array-data ((type double-float type-%data% type-%offset%) (a double-float a-%data% a-%offset%)) @@ -44549,19 +55656,19 @@ The return values are: (type (member t nil) done)) (setf info 0) (cond - ((lsame type "G") + ((char-equal type #\G) (setf itype 0)) - ((lsame type "L") + ((char-equal type #\L) (setf itype 1)) - ((lsame type "U") + ((char-equal type #\U) (setf itype 2)) - ((lsame type "H") + ((char-equal type #\H) (setf itype 3)) - ((lsame type "B") + ((char-equal type #\B) (setf itype 4)) - ((lsame type "Q") + ((char-equal type #\Q) (setf itype 5)) - ((lsame type "Z") + ((char-equal type #\Z) (setf itype 6)) (t (setf itype -1))) @@ -44602,7 +55709,9 @@ The return values are: (setf info -9))))) (cond ((/= info 0) - (xerbla "DLASCL" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASCL" (f2cl-lib:int-sub info)) (go end_label))) (if (or (= n 0) (= m 0)) (go end_label)) (setf smlnum (dlamch "S")) @@ -44786,29 +55895,105 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil nil nil info)))))) -;(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::dlascl -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (double-float) (double-float) -; fixnum fixnum -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlamch fortran-to-lisp::xerbla -; fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasd0 LAPACK} %\pagehead{dlasd0}{dlasd0} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasd0.output +)spool dlasd0.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasd0 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASD0 - divide and conquer approach, DLASD0 computes the singular + value decomposition (SVD) of a real upper bidiagonal N-by-M matrix B + with diagonal D and offdiagonal E, where M = N + SQRE + +SYNOPSIS + SUBROUTINE DLASD0( N, SQRE, D, E, U, LDU, VT, LDVT, SMLSIZ, IWORK, + WORK, INFO ) + + INTEGER INFO, LDU, LDVT, N, SMLSIZ, SQRE + + INTEGER IWORK( * ) + + DOUBLE PRECISION D( * ), E( * ), U( LDU, * ), VT( LDVT, * + ), WORK( * ) + +PURPOSE + Using a divide and conquer approach, DLASD0 computes the singular value + decomposition (SVD) of a real upper bidiagonal N-by-M matrix B with + diagonal D and offdiagonal E, where M = N + SQRE. The algorithm com- + putes orthogonal matrices U and VT such that B = U * S * VT. The singu- + lar values S are overwritten on D. + + A related subroutine, DLASDA, computes only the singular values, and + optionally, the singular vectors in compact form. + + +ARGUMENTS + N (input) INTEGER + On entry, the row dimension of the upper bidiagonal matrix. + This is also the dimension of the main diagonal array D. + + SQRE (input) INTEGER + Specifies the column dimension of the bidiagonal matrix. = 0: + The bidiagonal matrix has column dimension M = N; + = 1: The bidiagonal matrix has column dimension M = N+1; + + D (input/output) DOUBLE PRECISION array, dimension (N) + On entry D contains the main diagonal of the bidiagonal matrix. + On exit D, if INFO = 0, contains its singular values. + + E (input) DOUBLE PRECISION array, dimension (M-1) + Contains the subdiagonal entries of the bidiagonal matrix. On + exit, E has been destroyed. + + U (output) DOUBLE PRECISION array, dimension at least (LDQ, N) + On exit, U contains the left singular vectors. + + LDU (input) INTEGER + On entry, leading dimension of U. + + VT (output) DOUBLE PRECISION array, dimension at least (LDVT, M) + On exit, VT' contains the right singular vectors. + + LDVT (input) INTEGER + On entry, leading dimension of VT. + + SMLSIZ (input) INTEGER On entry, maximum size of the subproblems + at the bottom of the computation tree. + + IWORK (workspace) INTEGER work array. + Dimension must be at least (8 * N) + + WORK (workspace) DOUBLE PRECISION work array. + Dimension must be at least (3 * M**2 + 2 * M) + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + > 0: if INFO = 1, an singular value did not converge + +@ + <>= (defun dlasd0 (n sqre d e u ldu vt ldvt smlsiz iwork work info) (declare (type (array fixnum (*)) iwork) @@ -44846,7 +56031,9 @@ The return values are: (setf info -9))) (cond ((/= info 0) - (xerbla "DLASD0" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASD0" (f2cl-lib:int-sub info)) (go end_label))) (cond ((<= n smlsiz) @@ -45037,30 +56224,151 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil nil nil nil nil info))))) -;(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::dlasd0 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; fixnum -; (array fixnum (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlasd1 fortran-to-lisp::dlasdt -; fortran-to-lisp::dlasdq fortran-to-lisp::xerbla))));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasd1 LAPACK} %\pagehead{dlasd1}{dlasd1} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasd1.output +)spool dlasd1.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasd1 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASD1 - the SVD of an upper bidiagonal N-by-M matrix B, + +SYNOPSIS + SUBROUTINE DLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, + IDXQ, IWORK, WORK, INFO ) + + INTEGER INFO, LDU, LDVT, NL, NR, SQRE + + DOUBLE PRECISION ALPHA, BETA + + INTEGER IDXQ( * ), IWORK( * ) + + DOUBLE PRECISION D( * ), U( LDU, * ), VT( LDVT, * ), WORK( + * ) + +PURPOSE + DLASD1 computes the SVD of an upper bidiagonal N-by-M matrix B, where N + = NL + NR + 1 and M = N + SQRE. DLASD1 is called from DLASD0. + + A related subroutine DLASD7 handles the case in which the singular val- + ues (and the singular vectors in factored form) are desired. + + DLASD1 computes the SVD as follows: + + ( D1(in) 0 0 0 ) + B = U(in) * ( Z1' a Z2' b ) * VT(in) + ( 0 0 D2(in) 0 ) + + = U(out) * ( D(out) 0) * VT(out) + + where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M + with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros else- + where; and the entry b is empty if SQRE = 0. + + The left singular vectors of the original matrix are stored in U, and + the transpose of the right singular vectors are stored in VT, and the + singular values are in D. The algorithm consists of three stages: + + The first stage consists of deflating the size of the problem + when there are multiple singular values or when there are zeros in + the Z vector. For each such occurence the dimension of the + secular equation problem is reduced by one. This stage is + performed by the routine DLASD2. + + The second stage consists of calculating the updated + singular values. This is done by finding the square roots of the + roots of the secular equation via the routine DLASD4 (as called + by DLASD3). This routine also calculates the singular vectors of + the current problem. + + The final stage consists of computing the updated singular vectors + directly using the updated singular values. The singular vectors + for the current problem are multiplied with the singular vectors + from the overall problem. + + +ARGUMENTS + NL (input) INTEGER + The row dimension of the upper block. NL >= 1. + + NR (input) INTEGER + The row dimension of the lower block. NR >= 1. + + SQRE (input) INTEGER + = 0: the lower block is an NR-by-NR square matrix. + = 1: the lower block is an NR-by-(NR+1) rectangular matrix. + + The bidiagonal matrix has row dimension N = NL + NR + 1, and + column dimension M = N + SQRE. + + D (input/output) DOUBLE PRECISION array, + dimension (N = NL+NR+1). On entry D(1:NL,1:NL) contains the + singular values of the + upper block; and D(NL+2:N) contains the singular values of + the lower block. On exit D(1:N) contains the singular values of + the modified matrix. + + ALPHA (input/output) DOUBLE PRECISION + Contains the diagonal element associated with the added row. + + BETA (input/output) DOUBLE PRECISION + Contains the off-diagonal element associated with the added row. + + U (input/output) DOUBLE PRECISION array, dimension(LDU,N) + On entry U(1:NL, 1:NL) contains the left singular vectors of + the upper block; U(NL+2:N, NL+2:N) contains the left singular + vectors of the lower block. On exit U contains the left singular + vectors of the bidiagonal matrix. + + LDU (input) INTEGER + The leading dimension of the array U. LDU >= max( 1, N ). + + VT (input/output) DOUBLE PRECISION array, dimension(LDVT,M) + where M = N + SQRE. On entry VT(1:NL+1, 1:NL+1)' contains the + right singular + vectors of the upper block; VT(NL+2:M, NL+2:M)' contains the + right singular vectors of the lower block. On exit VT' contains + the right singular vectors of the bidiagonal matrix. + + LDVT (input) INTEGER + The leading dimension of the array VT. LDVT >= max( 1, M ). + + IDXQ (output) INTEGER array, dimension(N) + This contains the permutation which will reintegrate the subprob- + lem just solved back into sorted order, i.e. D( IDXQ( I = 1, N ) + ) will be in ascending order. + + IWORK (workspace) INTEGER array, dimension( 4 * N ) + + WORK (workspace) DOUBLE PRECISION array, dimension( 3*M**2 + 2*M ) + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + > 0: if INFO = 1, an singular value did not converge + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -45093,7 +56401,9 @@ The return values are: (setf info -3))) (cond ((/= info 0) - (xerbla "DLASD1" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASD1" (f2cl-lib:int-sub info)) (go end_label))) (setf n (f2cl-lib:int-add nl nr 1)) (setf m (f2cl-lib:int-add n sqre)) @@ -45195,33 +56505,186 @@ The return values are: nil info)))))) -;(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::dlasd1 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum (array double-float (*)) -; (double-float) (double-float) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum -; (array fixnum (*)) -; (array fixnum (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil fortran-to-lisp::alpha -; fortran-to-lisp::beta nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlamrg fortran-to-lisp::dlasd3 -; fortran-to-lisp::dlasd2 fortran-to-lisp::dlascl -; fortran-to-lisp::xerbla)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasd2 LAPACK} %\pagehead{dlasd2}{dlasd2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasd2.output +)spool dlasd2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasd2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASD2 - the two sets of singular values together into a single sorted + set + +SYNOPSIS + SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT, + LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX, IDXC, + IDXQ, COLTYP, INFO ) + + INTEGER INFO, K, LDU, LDU2, LDVT, LDVT2, NL, NR, SQRE + + DOUBLE PRECISION ALPHA, BETA + + INTEGER COLTYP( * ), IDX( * ), IDXC( * ), IDXP( * ), IDXQ( * + ) + + DOUBLE PRECISION D( * ), DSIGMA( * ), U( LDU, * ), U2( + LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ), Z( * ) + +PURPOSE + DLASD2 merges the two sets of singular values together into a single + sorted set. Then it tries to deflate the size of the problem. There + are two ways in which deflation can occur: when two or more singular + values are close together or if there is a tiny entry in the Z vector. + For each such occurrence the order of the related secular equation + problem is reduced by one. + + DLASD2 is called from DLASD1. + + +ARGUMENTS + NL (input) INTEGER + The row dimension of the upper block. NL >= 1. + + NR (input) INTEGER + The row dimension of the lower block. NR >= 1. + + SQRE (input) INTEGER + = 0: the lower block is an NR-by-NR square matrix. + = 1: the lower block is an NR-by-(NR+1) rectangular matrix. + + The bidiagonal matrix has N = NL + NR + 1 rows and M = N + SQRE + >= N columns. + + K (output) INTEGER + Contains the dimension of the non-deflated matrix, This is the + order of the related secular equation. 1 <= K <=N. + + D (input/output) DOUBLE PRECISION array, dimension(N) + On entry D contains the singular values of the two submatrices + to be combined. On exit D contains the trailing (N-K) updated + singular values (those which were deflated) sorted into increas- + ing order. + + Z (output) DOUBLE PRECISION array, dimension(N) + On exit Z contains the updating row vector in the secular equa- + tion. + + ALPHA (input) DOUBLE PRECISION + Contains the diagonal element associated with the added row. + + BETA (input) DOUBLE PRECISION + Contains the off-diagonal element associated with the added row. + + U (input/output) DOUBLE PRECISION array, dimension(LDU,N) + On entry U contains the left singular vectors of two submatrices + in the two square blocks with corners at (1,1), (NL, NL), and + (NL+2, NL+2), (N,N). On exit U contains the trailing (N-K) + updated left singular vectors (those which were deflated) in its + last N-K columns. + + LDU (input) INTEGER + The leading dimension of the array U. LDU >= N. + + VT (input/output) DOUBLE PRECISION array, dimension(LDVT,M) + On entry VT' contains the right singular vectors of two subma- + trices in the two square blocks with corners at (1,1), (NL+1, + NL+1), and (NL+2, NL+2), (M,M). On exit VT' contains the trail- + ing (N-K) updated right singular vectors (those which were + deflated) in its last N-K columns. In case SQRE =1, the last + row of VT spans the right null space. + + LDVT (input) INTEGER + The leading dimension of the array VT. LDVT >= M. + + DSIGMA (output) DOUBLE PRECISION array, dimension (N) Contains a + copy of the diagonal elements (K-1 singular values and one zero) + in the secular equation. + + U2 (output) DOUBLE PRECISION array, dimension(LDU2,N) + Contains a copy of the first K-1 left singular vectors which + will be used by DLASD3 in a matrix multiply (DGEMM) to solve for + the new left singular vectors. U2 is arranged into four blocks. + The first block contains a column with 1 at NL+1 and zero every- + where else; the second block contains non-zero entries only at + and above NL; the third contains non-zero entries only below + NL+1; and the fourth is dense. + + LDU2 (input) INTEGER + The leading dimension of the array U2. LDU2 >= N. + + VT2 (output) DOUBLE PRECISION array, dimension(LDVT2,N) + VT2' contains a copy of the first K right singular vectors which + will be used by DLASD3 in a matrix multiply (DGEMM) to solve for + the new right singular vectors. VT2 is arranged into three + blocks. The first block contains a row that corresponds to the + special 0 diagonal element in SIGMA; the second block contains + non-zeros only at and before NL +1; the third block contains + non-zeros only at and after NL +2. + + LDVT2 (input) INTEGER + The leading dimension of the array VT2. LDVT2 >= M. + + IDXP (workspace) INTEGER array dimension(N) + This will contain the permutation used to place deflated values + of D at the end of the array. On output IDXP(2:K) + points to the nondeflated D-values and IDXP(K+1:N) points to the + deflated singular values. + + IDX (workspace) INTEGER array dimension(N) + This will contain the permutation used to sort the contents of D + into ascending order. + + IDXC (output) INTEGER array dimension(N) + This will contain the permutation used to arrange the columns of + the deflated U matrix into three groups: the first group con- + tains non-zero entries only at and above NL, the second contains + non-zero entries only below NL+2, and the third is dense. + + IDXQ (input/output) INTEGER array dimension(N) + This contains the permutation which separately sorts the two + sub-problems in D into ascending order. Note that entries in + the first hlaf of this permutation must first be moved one posi- + tion backward; and entries in the second half must first have + NL+1 added to their values. + + COLTYP (workspace/output) INTEGER array dimension(N) As + workspace, this will contain a label which will indicate which + of the following types a column in the U2 matrix or a row in the + VT2 matrix is: + 1 : non-zero in the upper half only + 2 : non-zero in the lower half only + 3 : dense + 4 : deflated + + On exit, it is an array of dimension 4, with COLTYP(I) being the + dimension of the I-th type columns. + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + +@ + <>= (let* ((zero 0.0) (one 1.0) (two 2.0) (eight 8.0)) (declare (type (double-float 0.0 0.0) zero) @@ -45278,7 +56741,9 @@ The return values are: (setf info -17))) (cond ((/= info 0) - (xerbla "DLASD2" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASD2" (f2cl-lib:int-sub info)) (go end_label))) (setf nlp1 (f2cl-lib:int-add nl 1)) (setf nlp2 (f2cl-lib:int-add nl 2)) @@ -45699,40 +57164,148 @@ The return values are: nil info)))))) -;(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::dlasd2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum fixnum -; (array double-float (*)) (array double-float (*)) -; (double-float) (double-float) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; (array fixnum (*)) -; (array fixnum (*)) -; (array fixnum (*)) -; (array fixnum (*)) -; (array fixnum (*)) -; fixnum) -; :return-values '(nil nil nil fortran-to-lisp::k nil nil nil nil nil -; nil nil nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlacpy fortran-to-lisp::dlaset -; fortran-to-lisp::dcopy fortran-to-lisp::drot -; fortran-to-lisp::dlapy2 fortran-to-lisp::dlamch -; fortran-to-lisp::dlamrg fortran-to-lisp::xerbla)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasd3 LAPACK} %\pagehead{dlasd3}{dlasd3} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasd3.output +)spool dlasd3.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasd3 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASD3 - all the square roots of the roots of the secular equation, as + defined by the values in D and Z + +SYNOPSIS + SUBROUTINE DLASD3( NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, + LDU2, VT, LDVT, VT2, LDVT2, IDXC, CTOT, Z, INFO ) + + INTEGER INFO, K, LDQ, LDU, LDU2, LDVT, LDVT2, NL, NR, SQRE + + INTEGER CTOT( * ), IDXC( * ) + + DOUBLE PRECISION D( * ), DSIGMA( * ), Q( LDQ, * ), U( LDU, + * ), U2( LDU2, * ), VT( LDVT, * ), VT2( LDVT2, * ), + Z( * ) + +PURPOSE + DLASD3 finds all the square roots of the roots of the secular equation, + as defined by the values in D and Z. It makes the appropriate calls to + DLASD4 and then updates the singular vectors by matrix multiplication. + + This code makes very mild assumptions about floating point arithmetic. + It will work on machines with a guard digit in add/subtract, or on + those binary machines without guard digits which subtract like the Cray + XMP, Cray YMP, Cray C 90, or Cray 2. It could conceivably fail on hex- + adecimal or decimal machines without guard digits, but we know of none. + + DLASD3 is called from DLASD1. + + +ARGUMENTS + NL (input) INTEGER + The row dimension of the upper block. NL >= 1. + + NR (input) INTEGER + The row dimension of the lower block. NR >= 1. + + SQRE (input) INTEGER + = 0: the lower block is an NR-by-NR square matrix. + = 1: the lower block is an NR-by-(NR+1) rectangular matrix. + + The bidiagonal matrix has N = NL + NR + 1 rows and M = N + SQRE + >= N columns. + + K (input) INTEGER + The size of the secular equation, 1 =< K = < N. + + D (output) DOUBLE PRECISION array, dimension(K) + On exit the square roots of the roots of the secular equation, + in ascending order. + + Q (workspace) DOUBLE PRECISION array, + dimension at least (LDQ,K). + + LDQ (input) INTEGER + The leading dimension of the array Q. LDQ >= K. + + DSIGMA (input) DOUBLE PRECISION array, dimension(K) The first K + elements of this array contain the old roots of the deflated + updating problem. These are the poles of the secular equation. + + U (output) DOUBLE PRECISION array, dimension (LDU, N) + The last N - K columns of this matrix contain the deflated left + singular vectors. + + LDU (input) INTEGER + The leading dimension of the array U. LDU >= N. + + U2 (input/output) DOUBLE PRECISION array, dimension (LDU2, N) + The first K columns of this matrix contain the non-deflated left + singular vectors for the split problem. + + LDU2 (input) INTEGER + The leading dimension of the array U2. LDU2 >= N. + + VT (output) DOUBLE PRECISION array, dimension (LDVT, M) + The last M - K columns of VT' contain the deflated right singu- + lar vectors. + + LDVT (input) INTEGER + The leading dimension of the array VT. LDVT >= N. + + VT2 (input/output) DOUBLE PRECISION array, dimension (LDVT2, N) + The first K columns of VT2' contain the non-deflated right sin- + gular vectors for the split problem. + + LDVT2 (input) INTEGER + The leading dimension of the array VT2. LDVT2 >= N. + + IDXC (input) INTEGER array, dimension ( N ) + The permutation used to arrange the columns of U (and rows of + VT) into three groups: the first group contains non-zero + entries only at and above (or before) NL +1; the second contains + non-zero entries only at and below (or after) NL+2; and the + third is dense. The first column of U and the row of VT are + treated separately, however. + + The rows of the singular vectors found by DLASD4 must be like- + wise permuted before the matrix multiplies can take place. + + CTOT (input) INTEGER array, dimension ( 4 ) + A count of the total number of the various types of columns in U + (or rows in VT), as described in IDXC. The fourth column type is + any column which has been deflated. + + Z (input) DOUBLE PRECISION array, dimension (K) + The first K elements of this array contain the components of the + deflation-adjusted updating row vector. + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + > 0: if INFO = 1, an singular value did not converge + +@ + <>= (let* ((one 1.0) (zero 0.0) (negone (- 1.0))) (declare (type (double-float 1.0 1.0) one) @@ -45788,7 +57361,9 @@ The return values are: (setf info -16))) (cond ((/= info 0) - (xerbla "DLASD3" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASD3" (f2cl-lib:int-sub info)) (go end_label))) (cond ((= k 1) @@ -46230,36 +57805,109 @@ The return values are: nil info)))))) -;(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::dlasd3 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum fixnum -; (array double-float (*)) (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; (array fixnum (*)) -; (array fixnum (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; nil nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlacpy fortran-to-lisp::dgemm -; fortran-to-lisp::dlasd4 fortran-to-lisp::dlascl -; fortran-to-lisp::dnrm2 fortran-to-lisp::dlamc3 -; fortran-to-lisp::dcopy fortran-to-lisp::xerbla)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasd4 LAPACK} %\pagehead{dlasd4}{dlasd4} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasd4.output +)spool dlasd4.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasd4 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASD4 - compute the square root of the I-th updated eigenvalue of a + positive symmetric rank-one modification to a positive diagonal matrix + whose entries are given as the squares of the corresponding entries in + the array d, and that 0 <= D(i) < D(j) for i < j and that RHO > 0 + +SYNOPSIS + SUBROUTINE DLASD4( N, I, D, Z, DELTA, RHO, SIGMA, WORK, INFO ) + + INTEGER I, INFO, N + + DOUBLE PRECISION RHO, SIGMA + + DOUBLE PRECISION D( * ), DELTA( * ), WORK( * ), Z( * ) + +PURPOSE + This subroutine computes the square root of the I-th updated eigenvalue + of a positive symmetric rank-one modification to a positive diagonal + matrix whose entries are given as the squares of the corresponding + entries in the array d, and that no loss in generality. The rank-one + modified system is thus + + diag( D ) * diag( D ) + RHO * Z * Z_transpose. + + where we assume the Euclidean norm of Z is 1. + + The method consists of approximating the rational functions in the sec- + ular equation by simpler interpolating rational functions. + + +ARGUMENTS + N (input) INTEGER + The length of all arrays. + + I (input) INTEGER + The index of the eigenvalue to be computed. 1 <= I <= N. + + D (input) DOUBLE PRECISION array, dimension ( N ) + The original eigenvalues. It is assumed that they are in order, + 0 <= D(I) < D(J) for I < J. + + Z (input) DOUBLE PRECISION array, dimension ( N ) + The components of the updating vector. + + DELTA (output) DOUBLE PRECISION array, dimension ( N ) + If N .ne. 1, DELTA contains (D(j) - sigma_I) in its j-th compo- + nent. If N = 1, then DELTA(1) = 1. The vector DELTA contains + the information necessary to construct the (singular) eigenvec- + tors. + + RHO (input) DOUBLE PRECISION + The scalar in the symmetric updating formula. + + SIGMA (output) DOUBLE PRECISION + The computed sigma_I, the I-th updated eigenvalue. + + WORK (workspace) DOUBLE PRECISION array, dimension ( N ) + If N .ne. 1, WORK contains (D(j) + sigma_I) in its j-th compo- + nent. If N = 1, then WORK( 1 ) = 1. + + INFO (output) INTEGER + = 0: successful exit + > 0: if INFO = 1, the updating process failed. + +PARAMETERS + Logical variable ORGATI (origin-at-i?) is used for distinguishing + whether D(i) or D(i+1) is treated as the origin. + + ORGATI = .true. origin at i ORGATI = .false. origin at i+1 + + Logical variable SWTCH3 (switch-for-3-poles?) is for noting if we are + working with THREE poles! + + MAXIT is the maximum number of iterations allowed for each eigenvalue. + +@ + <>= (let* ((maxit 20) (zero 0.0) @@ -47784,27 +59432,81 @@ The return values are: end_label (return (values nil nil nil nil nil nil sigma nil info)))))) -;(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::dlasd4 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) (double-float) (double-float) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil fortran-to-lisp::sigma nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlaed6 fortran-to-lisp::dlamch -; fortran-to-lisp::dlasd5))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasd5 LAPACK} %\pagehead{dlasd5}{dlasd5} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasd5.output +)spool dlasd5.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasd5 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASD5 - compute the square root of the I-th eigenvalue of a positive + symmetric rank-one modification of a 2-by-2 diagonal matrix diag( D ) + * diag( D ) + RHO The diagonal entries in the array D are assumed to + satisfy 0 <= D(i) < D(j) for i < j + +SYNOPSIS + SUBROUTINE DLASD5( I, D, Z, DELTA, RHO, DSIGMA, WORK ) + + INTEGER I + + DOUBLE PRECISION DSIGMA, RHO + + DOUBLE PRECISION D( 2 ), DELTA( 2 ), WORK( 2 ), Z( 2 ) + +PURPOSE + This subroutine computes the square root of the I-th eigenvalue of a + positive symmetric rank-one modification of a 2-by-2 diagonal matrix + + We also assume RHO > 0 and that the Euclidean norm of the vector Z is + one. + + +ARGUMENTS + I (input) INTEGER + The index of the eigenvalue to be computed. I = 1 or I = 2. + + D (input) DOUBLE PRECISION array, dimension ( 2 ) + The original eigenvalues. We assume 0 <= D(1) < D(2). + + Z (input) DOUBLE PRECISION array, dimension ( 2 ) + The components of the updating vector. + + DELTA (output) DOUBLE PRECISION array, dimension ( 2 ) + Contains (D(j) - sigma_I) in its j-th component. The vector + DELTA contains the information necessary to construct the eigen- + vectors. + + RHO (input) DOUBLE PRECISION + The scalar in the symmetric updating formula. + + DSIGMA (output) DOUBLE PRECISION The computed sigma_I, the I-th + updated eigenvalue. + + WORK (workspace) DOUBLE PRECISION array, dimension ( 2 ) + WORK contains (D(j) + sigma_I) in its j-th component. + +@ + <>= (let* ((zero 0.0) (one 1.0) (two 2.0) (three 3.0) (four 4.0)) (declare (type (double-float 0.0 0.0) zero) @@ -48008,24 +59710,219 @@ The return values are: tau)))) (return (values nil nil nil nil nil dsigma 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::dlasd5 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (2)) -; (array double-float (2)) (array double-float (2)) -; (double-float) (double-float) (array double-float (2))) -; :return-values '(nil nil nil nil nil fortran-to-lisp::dsigma nil) -; :calls 'nil))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasd6 LAPACK} %\pagehead{dlasd6}{dlasd6} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasd6.output +)spool dlasd6.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasd6 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASD6 - the SVD of an updated upper bidiagonal matrix B obtained by + merging two smaller ones by appending a row + +SYNOPSIS + SUBROUTINE DLASD6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA, IDXQ, + PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, POLES, + DIFL, DIFR, Z, K, C, S, WORK, IWORK, INFO ) + + INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL, NR, + SQRE + + DOUBLE PRECISION ALPHA, BETA, C, S + + INTEGER GIVCOL( LDGCOL, * ), IDXQ( * ), IWORK( * ), PERM( * + ) + + DOUBLE PRECISION D( * ), DIFL( * ), DIFR( * ), GIVNUM( + LDGNUM, * ), POLES( LDGNUM, * ), VF( * ), VL( * ), + WORK( * ), Z( * ) + +PURPOSE + DLASD6 computes the SVD of an updated upper bidiagonal matrix B + obtained by merging two smaller ones by appending a row. This routine + is used only for the problem which requires all singular values and + optionally singular vector matrices in factored form. B is an N-by-M + matrix with N = NL + NR + 1 and M = N + SQRE. A related subroutine, + DLASD1, handles the case in which all singular values and singular vec- + tors of the bidiagonal matrix are desired. + + DLASD6 computes the SVD as follows: + + ( D1(in) 0 0 0 ) + B = U(in) * ( Z1' a Z2' b ) * VT(in) + ( 0 0 D2(in) 0 ) + + = U(out) * ( D(out) 0) * VT(out) + + where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M + with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros else- + where; and the entry b is empty if SQRE = 0. + + The singular values of B can be computed using D1, D2, the first compo- + nents of all the right singular vectors of the lower block, and the + last components of all the right singular vectors of the upper block. + These components are stored and updated in VF and VL, respectively, in + DLASD6. Hence U and VT are not explicitly referenced. + + The singular values are stored in D. The algorithm consists of two + stages: + + The first stage consists of deflating the size of the problem + when there are multiple singular values or if there is a zero + in the Z vector. For each such occurence the dimension of the + secular equation problem is reduced by one. This stage is + performed by the routine DLASD7. + + The second stage consists of calculating the updated + singular values. This is done by finding the roots of the + secular equation via the routine DLASD4 (as called by DLASD8). + This routine also updates VF and VL and computes the distances + between the updated singular values and the old singular + values. + + DLASD6 is called from DLASDA. + + +ARGUMENTS + ICOMPQ (input) INTEGER Specifies whether singular vectors are to be + computed in factored form: + = 0: Compute singular values only. + = 1: Compute singular vectors in factored form as well. + + NL (input) INTEGER + The row dimension of the upper block. NL >= 1. + + NR (input) INTEGER + The row dimension of the lower block. NR >= 1. + + SQRE (input) INTEGER + = 0: the lower block is an NR-by-NR square matrix. + = 1: the lower block is an NR-by-(NR+1) rectangular matrix. + + The bidiagonal matrix has row dimension N = NL + NR + 1, and + column dimension M = N + SQRE. + + D (input/output) DOUBLE PRECISION array, dimension ( NL+NR+1 ). + On entry D(1:NL,1:NL) contains the singular values of the + upper block, and D(NL+2:N) contains the singular values + of the lower block. On exit D(1:N) contains the singular values + of the modified matrix. + + VF (input/output) DOUBLE PRECISION array, dimension ( M ) + On entry, VF(1:NL+1) contains the first components of all + right singular vectors of the upper block; and VF(NL+2:M) con- + tains the first components of all right singular vectors of the + lower block. On exit, VF contains the first components of all + right singular vectors of the bidiagonal matrix. + + VL (input/output) DOUBLE PRECISION array, dimension ( M ) + On entry, VL(1:NL+1) contains the last components of all + right singular vectors of the upper block; and VL(NL+2:M) con- + tains the last components of all right singular vectors of the + lower block. On exit, VL contains the last components of all + right singular vectors of the bidiagonal matrix. + + ALPHA (input/output) DOUBLE PRECISION + Contains the diagonal element associated with the added row. + + BETA (input/output) DOUBLE PRECISION + Contains the off-diagonal element associated with the added row. + + IDXQ (output) INTEGER array, dimension ( N ) + This contains the permutation which will reintegrate the sub- + problem just solved back into sorted order, i.e. D( IDXQ( I = + 1, N ) ) will be in ascending order. + + PERM (output) INTEGER array, dimension ( N ) + The permutations (from deflation and sorting) to be applied to + each block. Not referenced if ICOMPQ = 0. + + GIVPTR (output) INTEGER The number of Givens rotations which + took place in this subproblem. Not referenced if ICOMPQ = 0. + + GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 ) Each pair + of numbers indicates a pair of columns to take place in a Givens + rotation. Not referenced if ICOMPQ = 0. + + LDGCOL (input) INTEGER leading dimension of GIVCOL, must be at + least N. + + GIVNUM (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 ) + Each number indicates the C or S value to be used in the corre- + sponding Givens rotation. Not referenced if ICOMPQ = 0. + + LDGNUM (input) INTEGER The leading dimension of GIVNUM and + POLES, must be at least N. + + POLES (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 ) + On exit, POLES(1,*) is an array containing the new singular val- + ues obtained from solving the secular equation, and POLES(2,*) + is an array containing the poles in the secular equation. Not + referenced if ICOMPQ = 0. + + DIFL (output) DOUBLE PRECISION array, dimension ( N ) + On exit, DIFL(I) is the distance between I-th updated (unde- + flated) singular value and the I-th (undeflated) old singular + value. + + DIFR (output) DOUBLE PRECISION array, + dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and dimension ( N ) if + ICOMPQ = 0. On exit, DIFR(I, 1) is the distance between I-th + updated (undeflated) singular value and the I+1-th (undeflated) + old singular value. + + If ICOMPQ = 1, DIFR(1:K,2) is an array containing the normaliz- + ing factors for the right singular vector matrix. + + See DLASD8 for details on DIFL and DIFR. + + Z (output) DOUBLE PRECISION array, dimension ( M ) + The first elements of this array contain the components of the + deflation-adjusted updating row vector. + + K (output) INTEGER + Contains the dimension of the non-deflated matrix, This is the + order of the related secular equation. 1 <= K <=N. + + C (output) DOUBLE PRECISION + C contains garbage if SQRE =0 and the C-value of a Givens rota- + tion related to the right null space if SQRE = 1. + + S (output) DOUBLE PRECISION + S contains garbage if SQRE =0 and the S-value of a Givens rota- + tion related to the right null space if SQRE = 1. + + WORK (workspace) DOUBLE PRECISION array, dimension ( 4 * M ) + + IWORK (workspace) INTEGER array, dimension ( 3 * N ) + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + > 0: if INFO = 1, an singular value did not converge + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -48076,7 +59973,9 @@ The return values are: (setf info -16))) (cond ((/= info 0) - (xerbla "DLASD6" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASD6" (f2cl-lib:int-sub info)) (go end_label))) (setf isigma 1) (setf iw (f2cl-lib:int-add isigma n)) @@ -48181,42 +60080,184 @@ The return values are: nil info)))))) -;(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::dlasd6 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum fixnum -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) (double-float) (double-float) -; (array fixnum (*)) -; (array fixnum (*)) -; fixnum -; (array fixnum (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) fixnum -; (double-float) (double-float) (array double-float (*)) -; (array fixnum (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::alpha -; fortran-to-lisp::beta nil nil -; fortran-to-lisp::givptr nil nil nil nil nil nil nil -; nil fortran-to-lisp::k fortran-to-lisp::c -; fortran-to-lisp::s nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlamrg fortran-to-lisp::dcopy -; fortran-to-lisp::dlasd8 fortran-to-lisp::dlasd7 -; fortran-to-lisp::dlascl fortran-to-lisp::xerbla))));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasd7 LAPACK} %\pagehead{dlasd7}{dlasd7} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasd7.output +)spool dlasd7.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasd7 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASD7 - the two sets of singular values together into a single sorted + set + +SYNOPSIS + SUBROUTINE DLASD7( ICOMPQ, NL, NR, SQRE, K, D, Z, ZW, VF, VFW, VL, VLW, + ALPHA, BETA, DSIGMA, IDX, IDXP, IDXQ, PERM, GIVPTR, + GIVCOL, LDGCOL, GIVNUM, LDGNUM, C, S, INFO ) + + INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL, NR, + SQRE + + DOUBLE PRECISION ALPHA, BETA, C, S + + INTEGER GIVCOL( LDGCOL, * ), IDX( * ), IDXP( * ), IDXQ( * ), + PERM( * ) + + DOUBLE PRECISION D( * ), DSIGMA( * ), GIVNUM( LDGNUM, * ), + VF( * ), VFW( * ), VL( * ), VLW( * ), Z( * ), ZW( * + ) + +PURPOSE + DLASD7 merges the two sets of singular values together into a single + sorted set. Then it tries to deflate the size of the problem. There are + two ways in which deflation can occur: when two or more singular val- + ues are close together or if there is a tiny entry in the Z vector. For + each such occurrence the order of the related secular equation problem + is reduced by one. + + DLASD7 is called from DLASD6. + + +ARGUMENTS + ICOMPQ (input) INTEGER + Specifies whether singular vectors are to be computed in com- + pact form, as follows: + = 0: Compute singular values only. + = 1: Compute singular vectors of upper bidiagonal matrix in + compact form. + + NL (input) INTEGER + The row dimension of the upper block. NL >= 1. + + NR (input) INTEGER + The row dimension of the lower block. NR >= 1. + + SQRE (input) INTEGER + = 0: the lower block is an NR-by-NR square matrix. + = 1: the lower block is an NR-by-(NR+1) rectangular matrix. + + The bidiagonal matrix has N = NL + NR + 1 rows and M = N + SQRE + >= N columns. + + K (output) INTEGER + Contains the dimension of the non-deflated matrix, this is the + order of the related secular equation. 1 <= K <=N. + + D (input/output) DOUBLE PRECISION array, dimension ( N ) + On entry D contains the singular values of the two submatrices + to be combined. On exit D contains the trailing (N-K) updated + singular values (those which were deflated) sorted into increas- + ing order. + + Z (output) DOUBLE PRECISION array, dimension ( M ) + On exit Z contains the updating row vector in the secular equa- + tion. + + ZW (workspace) DOUBLE PRECISION array, dimension ( M ) + Workspace for Z. + + VF (input/output) DOUBLE PRECISION array, dimension ( M ) + On entry, VF(1:NL+1) contains the first components of all + right singular vectors of the upper block; and VF(NL+2:M) con- + tains the first components of all right singular vectors of the + lower block. On exit, VF contains the first components of all + right singular vectors of the bidiagonal matrix. + + VFW (workspace) DOUBLE PRECISION array, dimension ( M ) + Workspace for VF. + + VL (input/output) DOUBLE PRECISION array, dimension ( M ) + On entry, VL(1:NL+1) contains the last components of all + right singular vectors of the upper block; and VL(NL+2:M) con- + tains the last components of all right singular vectors of the + lower block. On exit, VL contains the last components of all + right singular vectors of the bidiagonal matrix. + + VLW (workspace) DOUBLE PRECISION array, dimension ( M ) + Workspace for VL. + + ALPHA (input) DOUBLE PRECISION + Contains the diagonal element associated with the added row. + + BETA (input) DOUBLE PRECISION + Contains the off-diagonal element associated with the added row. + + DSIGMA (output) DOUBLE PRECISION array, dimension ( N ) Contains + a copy of the diagonal elements (K-1 singular values and one + zero) in the secular equation. + + IDX (workspace) INTEGER array, dimension ( N ) + This will contain the permutation used to sort the contents of D + into ascending order. + + IDXP (workspace) INTEGER array, dimension ( N ) + This will contain the permutation used to place deflated values + of D at the end of the array. On output IDXP(2:K) + points to the nondeflated D-values and IDXP(K+1:N) points to the + deflated singular values. + + IDXQ (input) INTEGER array, dimension ( N ) + This contains the permutation which separately sorts the two + sub-problems in D into ascending order. Note that entries in + the first half of this permutation must first be moved one posi- + tion backward; and entries in the second half must first have + NL+1 added to their values. + + PERM (output) INTEGER array, dimension ( N ) + The permutations (from deflation and sorting) to be applied to + each singular block. Not referenced if ICOMPQ = 0. + + GIVPTR (output) INTEGER The number of Givens rotations which + took place in this subproblem. Not referenced if ICOMPQ = 0. + + GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 ) Each pair + of numbers indicates a pair of columns to take place in a Givens + rotation. Not referenced if ICOMPQ = 0. + + LDGCOL (input) INTEGER The leading dimension of GIVCOL, must be + at least N. + + GIVNUM (output) DOUBLE PRECISION array, dimension ( LDGNUM, 2 ) + Each number indicates the C or S value to be used in the corre- + sponding Givens rotation. Not referenced if ICOMPQ = 0. + + LDGNUM (input) INTEGER The leading dimension of GIVNUM, must be + at least N. + + C (output) DOUBLE PRECISION + C contains garbage if SQRE =0 and the C-value of a Givens rota- + tion related to the right null space if SQRE = 1. + + S (output) DOUBLE PRECISION + S contains garbage if SQRE =0 and the S-value of a Givens rota- + tion related to the right null space if SQRE = 1. + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + +@ + <>= (let* ((zero 0.0) (one 1.0) (two 2.0) (eight 8.0)) (declare (type (double-float 0.0 0.0) zero) @@ -48270,7 +60311,9 @@ The return values are: (setf info -24))) (cond ((/= info 0) - (xerbla "DLASD7" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASD7" (f2cl-lib:int-sub info)) (go end_label))) (setf nlp1 (f2cl-lib:int-add nl 1)) (setf nlp2 (f2cl-lib:int-add nl 2)) @@ -48584,43 +60627,111 @@ The return values are: s info)))))) -;(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::dlasd7 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum fixnum -; fixnum (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; (double-float) (double-float) (array double-float (*)) -; (array fixnum (*)) -; (array fixnum (*)) -; (array fixnum (*)) -; (array fixnum (*)) -; fixnum -; (array fixnum (*)) -; fixnum (array double-float (*)) -; fixnum (double-float) -; (double-float) fixnum) -; :return-values '(nil nil nil nil fortran-to-lisp::k nil nil nil nil -; nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::givptr nil nil nil nil -; fortran-to-lisp::c fortran-to-lisp::s -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dcopy fortran-to-lisp::drot -; fortran-to-lisp::dlapy2 fortran-to-lisp::dlamch -; fortran-to-lisp::dlamrg fortran-to-lisp::xerbla))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasd8 LAPACK} %\pagehead{dlasd8}{dlasd8} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasd8.output +)spool dlasd8.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasd8 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASD8 - the square roots of the roots of the secular equation, + +SYNOPSIS + SUBROUTINE DLASD8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR, DSIGMA, + WORK, INFO ) + + INTEGER ICOMPQ, INFO, K, LDDIFR + + DOUBLE PRECISION D( * ), DIFL( * ), DIFR( LDDIFR, * ), + DSIGMA( * ), VF( * ), VL( * ), WORK( * ), Z( * ) + +PURPOSE + DLASD8 finds the square roots of the roots of the secular equation, as + defined by the values in DSIGMA and Z. It makes the appropriate calls + to DLASD4, and stores, for each element in D, the distance to its two + nearest poles (elements in DSIGMA). It also updates the arrays VF and + VL, the first and last components of all the right singular vectors of + the original bidiagonal matrix. + + DLASD8 is called from DLASD6. + + +ARGUMENTS + ICOMPQ (input) INTEGER + Specifies whether singular vectors are to be computed in fac- + tored form in the calling routine: + = 0: Compute singular values only. + = 1: Compute singular vectors in factored form as well. + + K (input) INTEGER + The number of terms in the rational function to be solved by + DLASD4. K >= 1. + + D (output) DOUBLE PRECISION array, dimension ( K ) + On output, D contains the updated singular values. + + Z (input) DOUBLE PRECISION array, dimension ( K ) + The first K elements of this array contain the components of + the deflation-adjusted updating row vector. + + VF (input/output) DOUBLE PRECISION array, dimension ( K ) + On entry, VF contains information passed through DBEDE8. On + exit, VF contains the first K components of the first compo- + nents of all right singular vectors of the bidiagonal matrix. + + VL (input/output) DOUBLE PRECISION array, dimension ( K ) + On entry, VL contains information passed through DBEDE8. On + exit, VL contains the first K components of the last components + of all right singular vectors of the bidiagonal matrix. + + DIFL (output) DOUBLE PRECISION array, dimension ( K ) + On exit, DIFL(I) = D(I) - DSIGMA(I). + + DIFR (output) DOUBLE PRECISION array, + dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and dimension ( K ) if + ICOMPQ = 0. On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) + is not defined and will not be referenced. + + If ICOMPQ = 1, DIFR(1:K,2) is an array containing the normaliz- + ing factors for the right singular vector matrix. + + LDDIFR (input) INTEGER + The leading dimension of DIFR, must be at least K. + + DSIGMA (input) DOUBLE PRECISION array, dimension ( K ) + The first K elements of this array contain the old roots of the + deflated updating problem. These are the poles of the secular + equation. + + WORK (workspace) DOUBLE PRECISION array, dimension at least 3 * K + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + > 0: if INFO = 1, an singular value did not converge + +@ + <>= (let* ((one 1.0)) (declare (type (double-float 1.0 1.0) one)) @@ -48651,7 +60762,9 @@ The return values are: (setf info -9))) (cond ((/= info 0) - (xerbla "DLASD8" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASD8" (f2cl-lib:int-sub info)) (go end_label))) (cond ((= k 1) @@ -48959,31 +61072,180 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dlasd8 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dcopy fortran-to-lisp::ddot -; fortran-to-lisp::dlasd4 fortran-to-lisp::dlaset -; fortran-to-lisp::dlascl fortran-to-lisp::dnrm2 -; fortran-to-lisp::dlamc3 fortran-to-lisp::xerbla))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasda LAPACK} %\pagehead{dlasda}{dlasda} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasda.output +)spool dlasda.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasda examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASDA - divide and conquer approach, DLASDA computes the singular + value decomposition (SVD) of a real upper bidiagonal N-by-M matrix B + with diagonal D and offdiagonal E, where M = N + SQRE + +SYNOPSIS + SUBROUTINE DLASDA( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, DIFL, + DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL, PERM, + GIVNUM, C, S, WORK, IWORK, INFO ) + + INTEGER ICOMPQ, INFO, LDGCOL, LDU, N, SMLSIZ, SQRE + + INTEGER GIVCOL( LDGCOL, * ), GIVPTR( * ), IWORK( * ), K( * + ), PERM( LDGCOL, * ) + + DOUBLE PRECISION C( * ), D( * ), DIFL( LDU, * ), DIFR( LDU, + * ), E( * ), GIVNUM( LDU, * ), POLES( LDU, * ), S( * + ), U( LDU, * ), VT( LDU, * ), WORK( * ), Z( LDU, * ) + +PURPOSE + Using a divide and conquer approach, DLASDA computes the singular value + decomposition (SVD) of a real upper bidiagonal N-by-M matrix B with + diagonal D and offdiagonal E, where M = N + SQRE. The algorithm com- + putes the singular values in the SVD B = U * S * VT. The orthogonal + matrices U and VT are optionally computed in compact form. + + A related subroutine, DLASD0, computes the singular values and the sin- + gular vectors in explicit form. + + +ARGUMENTS + ICOMPQ (input) INTEGER Specifies whether singular vectors are to be + computed in compact form, as follows = 0: Compute singular values only. + = 1: Compute singular vectors of upper bidiagonal matrix in compact + form. + + SMLSIZ (input) INTEGER The maximum size of the subproblems at the bot- + tom of the computation tree. + + N (input) INTEGER + The row dimension of the upper bidiagonal matrix. This is also + the dimension of the main diagonal array D. + + SQRE (input) INTEGER + Specifies the column dimension of the bidiagonal matrix. = 0: + The bidiagonal matrix has column dimension M = N; + = 1: The bidiagonal matrix has column dimension M = N + 1. + + D (input/output) DOUBLE PRECISION array, dimension ( N ) + On entry D contains the main diagonal of the bidiagonal matrix. + On exit D, if INFO = 0, contains its singular values. + + E (input) DOUBLE PRECISION array, dimension ( M-1 ) + Contains the subdiagonal entries of the bidiagonal matrix. On + exit, E has been destroyed. + + U (output) DOUBLE PRECISION array, + dimension ( LDU, SMLSIZ ) if ICOMPQ = 1, and not referenced if + ICOMPQ = 0. If ICOMPQ = 1, on exit, U contains the left singular + vector matrices of all subproblems at the bottom level. + + LDU (input) INTEGER, LDU = > N. + The leading dimension of arrays U, VT, DIFL, DIFR, POLES, + GIVNUM, and Z. + + VT (output) DOUBLE PRECISION array, + dimension ( LDU, SMLSIZ+1 ) if ICOMPQ = 1, and not referenced if + ICOMPQ = 0. If ICOMPQ = 1, on exit, VT' contains the right sin- + gular vector matrices of all subproblems at the bottom level. + + K (output) INTEGER array, + dimension ( N ) if ICOMPQ = 1 and dimension 1 if ICOMPQ = 0. If + ICOMPQ = 1, on exit, K(I) is the dimension of the I-th secular + equation on the computation tree. + + DIFL (output) DOUBLE PRECISION array, dimension ( LDU, NLVL ), + where NLVL = floor(log_2 (N/SMLSIZ))). + + DIFR (output) DOUBLE PRECISION array, + dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1 and dimension ( N ) if + ICOMPQ = 0. If ICOMPQ = 1, on exit, DIFL(1:N, I) and DIFR(1:N, + 2 * I - 1) record distances between singular values on the I-th + level and singular values on the (I -1)-th level, and DIFR(1:N, + 2 * I ) contains the normalizing factors for the right singular + vector matrix. See DLASD8 for details. + + Z (output) DOUBLE PRECISION array, + dimension ( LDU, NLVL ) if ICOMPQ = 1 and dimension ( N ) if + ICOMPQ = 0. The first K elements of Z(1, I) contain the compo- + nents of the deflation-adjusted updating row vector for subprob- + lems on the I-th level. + + POLES (output) DOUBLE PRECISION array, + dimension ( LDU, 2 * NLVL ) if ICOMPQ = 1, and not referenced if + ICOMPQ = 0. If ICOMPQ = 1, on exit, POLES(1, 2*I - 1) and + POLES(1, 2*I) contain the new and old singular values involved + in the secular equations on the I-th level. + + GIVPTR (output) INTEGER array, dimension ( N ) if ICOMPQ = 1, + and not referenced if ICOMPQ = 0. If ICOMPQ = 1, on exit, + GIVPTR( I ) records the number of Givens rotations performed on + the I-th problem on the computation tree. + + GIVCOL (output) INTEGER array, dimension ( LDGCOL, 2 * NLVL ) if + ICOMPQ = 1, and not referenced if ICOMPQ = 0. If ICOMPQ = 1, on + exit, for each I, GIVCOL(1, 2 *I - 1) and GIVCOL(1, 2 *I) record + the locations of Givens rotations performed on the I-th level on + the computation tree. + + LDGCOL (input) INTEGER, LDGCOL = > N. The leading dimension of + arrays GIVCOL and PERM. + + PERM (output) INTEGER array, + dimension ( LDGCOL, NLVL ) if ICOMPQ = 1, and not referenced if + ICOMPQ = 0. If ICOMPQ = 1, on exit, PERM(1, I) records permuta- + tions done on the I-th level of the computation tree. + + GIVNUM (output) DOUBLE PRECISION array, dimension ( LDU, 2 * + NLVL ) if ICOMPQ = 1, and not referenced if ICOMPQ = 0. If + ICOMPQ = 1, on exit, for each I, GIVNUM(1, 2 *I - 1) and + GIVNUM(1, 2 *I) record the C- and S- values of Givens rotations + performed on the I-th level on the computation tree. + + C (output) DOUBLE PRECISION array, + dimension ( N ) if ICOMPQ = 1, and dimension 1 if ICOMPQ = 0. + If ICOMPQ = 1 and the I-th subproblem is not square, on exit, C( + I ) contains the C-value of a Givens rotation related to the + right null space of the I-th subproblem. + + S (output) DOUBLE PRECISION array, dimension ( N ) if + ICOMPQ = 1, and dimension 1 if ICOMPQ = 0. If ICOMPQ = 1 and the + I-th subproblem is not square, on exit, S( I ) contains the S- + value of a Givens rotation related to the right null space of + the I-th subproblem. + + WORK (workspace) DOUBLE PRECISION array, dimension + (6 * N + (SMLSIZ + 1)*(SMLSIZ + 1)). + + IWORK (workspace) INTEGER array. + Dimension must be at least (7 * N). + + INFO (output) INTEGER + = 0: successful exit. + < 0: if INFO = -i, the i-th argument had an illegal value. + > 0: if INFO = 1, an singular value did not converge + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -49041,7 +61303,9 @@ The return values are: (setf info -17))) (cond ((/= info 0) - (xerbla "DLASDA" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASDA" (f2cl-lib:int-sub info)) (go end_label))) (setf m (f2cl-lib:int-add n sqre)) (cond @@ -49502,48 +61766,158 @@ The return values are: nil info)))))) -;(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::dlasda -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum fixnum -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) fixnum -; (array double-float (*)) -; (array fixnum (*)) -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; (array fixnum (*)) -; (array fixnum (*)) -; fixnum -; (array fixnum (*)) -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; (array fixnum (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlasdt fortran-to-lisp::dlasd6 -; fortran-to-lisp::dcopy fortran-to-lisp::dlaset -; fortran-to-lisp::dlasdq fortran-to-lisp::xerbla)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasdq LAPACK} %\pagehead{dlasdq}{dlasdq} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasdq.output +)spool dlasdq.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasdq examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASDQ - the singular value decomposition (SVD) of a real (upper or + lower) bidiagonal matrix with diagonal D and offdiagonal E, accumulat- + ing the transformations if desired + +SYNOPSIS + SUBROUTINE DLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, + LDU, C, LDC, WORK, INFO ) + + CHARACTER UPLO + + INTEGER INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU, SQRE + + DOUBLE PRECISION C( LDC, * ), D( * ), E( * ), U( LDU, * ), + VT( LDVT, * ), WORK( * ) + +PURPOSE + DLASDQ computes the singular value decomposition (SVD) of a real (upper + or lower) bidiagonal matrix with diagonal D and offdiagonal E, accumu- + lating the transformations if desired. Letting B denote the input bidi- + agonal matrix, the algorithm computes orthogonal matrices Q and P such + that B = Q * S * P' (P' denotes the transpose of P). The singular val- + ues S are overwritten on D. + + The input matrix U is changed to U * Q if desired. + The input matrix VT is changed to P' * VT if desired. + The input matrix C is changed to Q' * C if desired. + + See "Computing Small Singular Values of Bidiagonal Matrices With Guar- + anteed High Relative Accuracy," by J. Demmel and W. Kahan, LAPACK Work- + ing Note #3, for a detailed description of the algorithm. + + +ARGUMENTS + UPLO (input) CHARACTER*1 + On entry, UPLO specifies whether the input bidiagonal matrix is + upper or lower bidiagonal, and wether it is square are not. UPLO + = 'U' or 'u' B is upper bidiagonal. UPLO = 'L' or 'l' B is + lower bidiagonal. + + SQRE (input) INTEGER + = 0: then the input matrix is N-by-N. + = 1: then the input matrix is N-by-(N+1) if UPLU = 'U' and + (N+1)-by-N if UPLU = 'L'. + + The bidiagonal matrix has N = NL + NR + 1 rows and M = N + SQRE + >= N columns. + + N (input) INTEGER + On entry, N specifies the number of rows and columns in the + matrix. N must be at least 0. + + NCVT (input) INTEGER + On entry, NCVT specifies the number of columns of the matrix VT. + NCVT must be at least 0. + + NRU (input) INTEGER + On entry, NRU specifies the number of rows of the matrix U. NRU + must be at least 0. + + NCC (input) INTEGER + On entry, NCC specifies the number of columns of the matrix C. + NCC must be at least 0. + + D (input/output) DOUBLE PRECISION array, dimension (N) + On entry, D contains the diagonal entries of the bidiagonal + matrix whose SVD is desired. On normal exit, D contains the sin- + gular values in ascending order. + + E (input/output) DOUBLE PRECISION array. + dimension is (N-1) if SQRE = 0 and N if SQRE = 1. On entry, the + entries of E contain the offdiagonal entries of the bidiagonal + matrix whose SVD is desired. On normal exit, E will contain 0. If + the algorithm does not converge, D and E will contain the diago- + nal and superdiagonal entries of a bidiagonal matrix orthogonally + equivalent to the one given as input. + + VT (input/output) DOUBLE PRECISION array, dimension (LDVT, NCVT) + On entry, contains a matrix which on exit has been premultiplied + by P', dimension N-by-NCVT if SQRE = 0 and (N+1)-by-NCVT if SQRE + = 1 (not referenced if NCVT=0). + + LDVT (input) INTEGER + On entry, LDVT specifies the leading dimension of VT as declared + in the calling (sub) program. LDVT must be at least 1. If NCVT is + nonzero LDVT must also be at least N. + + U (input/output) DOUBLE PRECISION array, dimension (LDU, N) + On entry, contains a matrix which on exit has been postmulti- + plied by Q, dimension NRU-by-N if SQRE = 0 and NRU-by-(N+1) if + SQRE = 1 (not referenced if NRU=0). + + LDU (input) INTEGER + On entry, LDU specifies the leading dimension of U as declared + in the calling (sub) program. LDU must be at least max( 1, NRU ) + . + + C (input/output) DOUBLE PRECISION array, dimension (LDC, NCC) + On entry, contains an N-by-NCC matrix which on exit has been pre- + multiplied by Q' dimension N-by-NCC if SQRE = 0 and (N+1)-by-NCC + if SQRE = 1 (not referenced if NCC=0). + + LDC (input) INTEGER + On entry, LDC specifies the leading dimension of C as declared + in the calling (sub) program. LDC must be at least 1. If NCC is + nonzero, LDC must also be at least N. + + WORK (workspace) DOUBLE PRECISION array, dimension (4*N) + Workspace. Only referenced if one of NCVT, NRU, or NCC is + nonzero, and if N is at least 2. + + INFO (output) INTEGER + On exit, a value of 0 indicates a successful exit. If INFO < 0, + argument number -INFO is illegal. If INFO > 0, the algorithm did + not converge, and INFO specifies how many superdiagonals did not + converge. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) (defun dlasdq (uplo sqre n ncvt nru ncc d e vt ldvt u ldu c ldc work info) (declare (type (array double-float (*)) work c u vt e d) (type fixnum info ldc ldu ldvt ncc nru ncvt n sqre) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (d double-float d-%data% d-%offset%) @@ -49559,8 +61933,8 @@ The return values are: (type (member t nil) rotate)) (setf info 0) (setf iuplo 0) - (if (lsame uplo "U") (setf iuplo 1)) - (if (lsame uplo "L") (setf iuplo 2)) + (if (char-equal uplo #\U) (setf iuplo 1)) + (if (char-equal uplo #\L) (setf iuplo 2)) (cond ((= iuplo 0) (setf info -1)) @@ -49590,7 +61964,9 @@ The return values are: (setf info -14))) (cond ((/= info 0) - (xerbla "DLASDQ" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASDQ" (f2cl-lib:int-sub info)) (go end_label))) (if (= n 0) (go end_label)) (setf rotate (or (> ncvt 0) (> nru 0) (> ncc 0))) @@ -49810,33 +62186,72 @@ The return values are: nil info)))))) -;(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::dlasdq -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; fixnum fixnum -; fixnum (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dswap fortran-to-lisp::dbdsqr -; fortran-to-lisp::dlasr fortran-to-lisp::dlartg -; fortran-to-lisp::xerbla fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasdt LAPACK} %\pagehead{dlasdt}{dlasdt} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasdt.output +)spool dlasdt.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasdt examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASDT - a tree of subproblems for bidiagonal divide and conquer + +SYNOPSIS + SUBROUTINE DLASDT( N, LVL, ND, INODE, NDIML, NDIMR, MSUB ) + + INTEGER LVL, MSUB, N, ND + + INTEGER INODE( * ), NDIML( * ), NDIMR( * ) + +PURPOSE + DLASDT creates a tree of subproblems for bidiagonal divide and conquer. + + +ARGUMENTS + N (input) INTEGER + On entry, the number of diagonal elements of the bidiagonal + matrix. + + LVL (output) INTEGER + On exit, the number of levels on the computation tree. + + ND (output) INTEGER + On exit, the number of nodes on the tree. + + INODE (output) INTEGER array, dimension ( N ) + On exit, centers of subproblems. + + NDIML (output) INTEGER array, dimension ( N ) + On exit, row dimensions of left children. + + NDIMR (output) INTEGER array, dimension ( N ) + On exit, row dimensions of right children. + + MSUB (input) INTEGER. + On entry, the maximum row dimension each subproblem at the bot- + tom of the tree can be of. + +@ + <>= (let* ((two 2.0)) (declare (type (double-float 2.0 2.0) two)) @@ -49943,41 +62358,99 @@ The return values are: end_label (return (values nil lvl nd 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::dlasdt -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum -; (array fixnum (*)) -; (array fixnum (*)) -; (array fixnum (*)) -; fixnum) -; :return-values '(nil fortran-to-lisp::lvl fortran-to-lisp::nd nil -; nil nil nil) -; :calls 'nil))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlaset LAPACK} %\pagehead{dlaset}{dlaset} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlaset.output +)spool dlaset.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlaset examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASET - an m-by-n matrix A to BETA on the diagonal and ALPHA on the + offdiagonals + +SYNOPSIS + SUBROUTINE DLASET( UPLO, M, N, ALPHA, BETA, A, LDA ) + + CHARACTER UPLO + + INTEGER LDA, M, N + + DOUBLE PRECISION ALPHA, BETA + + DOUBLE PRECISION A( LDA, * ) + +PURPOSE + DLASET initializes an m-by-n matrix A to BETA on the diagonal and ALPHA + on the offdiagonals. + + +ARGUMENTS + UPLO (input) CHARACTER*1 + Specifies the part of the matrix A to be set. = 'U': + Upper triangular part is set; the strictly lower triangular + part of A is not changed. = 'L': Lower triangular part is + set; the strictly upper triangular part of A is not changed. + Otherwise: All of the matrix A is set. + + M (input) INTEGER + The number of rows of the matrix A. M >= 0. + + N (input) INTEGER + The number of columns of the matrix A. N >= 0. + + ALPHA (input) DOUBLE PRECISION + The constant to which the offdiagonal elements are to be set. + + BETA (input) DOUBLE PRECISION + The constant to which the diagonal elements are to be set. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On exit, the leading m-by-n submatrix of A is set as follows: + + if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n, if UPLO = + 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n, otherwise, A(i,j) + = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j, + + and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n). + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,M). + +@ + <>= (defun dlaset (uplo m n alpha beta a lda) (declare (type (array double-float (*)) a) (type (double-float) beta alpha) (type fixnum lda n m) - (type (simple-array character (*)) uplo)) + (type character uplo)) (f2cl-lib:with-multi-array-data ((uplo character uplo-%data% uplo-%offset%) (a double-float a-%data% a-%offset%)) (prog ((i 0) (j 0)) (declare (type fixnum j i)) (cond - ((lsame uplo "U") + ((char-equal uplo #\U) (f2cl-lib:fdo (j 2 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody @@ -49994,7 +62467,7 @@ The return values are: ((1 lda) (1 *)) a-%offset%) alpha)))))) - ((lsame uplo "L") + ((char-equal uplo #\L) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j (min (the fixnum m) @@ -50030,25 +62503,84 @@ The return values are: (setf (f2cl-lib:fref a-%data% (i i) ((1 lda) (1 *)) a-%offset%) beta))) (return (values 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::dlaset -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (double-float) (double-float) (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasq1 LAPACK} %\pagehead{dlasq1}{dlasq1} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasq1.output +)spool dlasq1.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasq1 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASQ1 - the singular values of a real N-by-N bidiagonal matrix with + diagonal D and off-diagonal E + +SYNOPSIS + SUBROUTINE DLASQ1( N, D, E, WORK, INFO ) + + INTEGER INFO, N + + DOUBLE PRECISION D( * ), E( * ), WORK( * ) + +PURPOSE + DLASQ1 computes the singular values of a real N-by-N bidiagonal matrix + with diagonal D and off-diagonal E. The singular values are computed to + high relative accuracy, in the absence of denormalization, underflow + and overflow. The algorithm was first presented in + + "Accurate singular values and differential qd algorithms" by K. V. + Fernando and B. N. Parlett, Numer. Math., Vol-67, No. 2, pp. 191-230, + 1994, + + and the present implementation is described in "An implementation of + the dqds Algorithm (Positive Case)", LAPACK Working Note. + + +ARGUMENTS + N (input) INTEGER + The number of rows and columns in the matrix. N >= 0. + + D (input/output) DOUBLE PRECISION array, dimension (N) + On entry, D contains the diagonal elements of the bidiagonal + matrix whose SVD is desired. On normal exit, D contains the sin- + gular values in decreasing order. + + E (input/output) DOUBLE PRECISION array, dimension (N) + On entry, elements E(1:N-1) contain the off-diagonal elements of + the bidiagonal matrix whose SVD is desired. On exit, E is over- + written. + + WORK (workspace) DOUBLE PRECISION array, dimension (4*N) + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + > 0: the algorithm failed = 1, a split was marked by a positive + value in E = 2, current block of Z not diagonalized after 30*N + iterations (in inner while loop) = 3, termination criterion of + outer while loop not met (program created more than N unreduced + blocks) + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -50067,7 +62599,9 @@ The return values are: (cond ((< n 0) (setf info -2) - (xerbla "DLASQ1" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASQ1" (f2cl-lib:int-sub info)) (go end_label)) ((= n 0) (go end_label)) @@ -50160,27 +62694,90 @@ The return values are: end_label (return (values nil nil nil nil info)))))) -;(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::dlasq1 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (*)) -; (array double-float (*)) (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlasq2 fortran-to-lisp::dlascl -; fortran-to-lisp::dcopy fortran-to-lisp::dlamch -; fortran-to-lisp::dlasrt fortran-to-lisp::dlas2 -; fortran-to-lisp::xerbla))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasq2 LAPACK} %\pagehead{dlasq2}{dlasq2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasq2.output +)spool dlasq2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasq2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASQ2 - all the eigenvalues of the symmetric positive definite tridi- + agonal matrix associated with the qd array Z to high relative accuracy + are computed to high relative accuracy, in the absence of denormaliza- + tion, underflow and overflow + +SYNOPSIS + SUBROUTINE DLASQ2( N, Z, INFO ) + + INTEGER INFO, N + + DOUBLE PRECISION Z( * ) + +PURPOSE + DLASQ2 computes all the eigenvalues of the symmetric positive definite + tridiagonal matrix associated with the qd array Z to high relative + accuracy are computed to high relative accuracy, in the absence of + denormalization, underflow and overflow. + + To see the relation of Z to the tridiagonal matrix, let L be a unit + lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and let U be an + upper bidiagonal matrix with 1's above and diagonal Z(1,3,5,,..). The + tridiagonal is L*U or, if you prefer, the symmetric tridiagonal to + which it is similar. + + Note : DLASQ2 defines a logical variable, IEEE, which is true on + machines which follow ieee-754 floating-point standard in their han- + dling of infinities and NaNs, and false otherwise. This variable is + passed to DLAZQ3. + + +ARGUMENTS + N (input) INTEGER + The number of rows and columns in the matrix. N >= 0. + + Z (workspace) DOUBLE PRECISION array, dimension ( 4*N ) + On entry Z holds the qd array. On exit, entries 1 to N hold the + eigenvalues in decreasing order, Z( 2*N+1 ) holds the trace, and + Z( 2*N+2 ) holds the sum of the eigenvalues. If N > 2, then Z( + 2*N+3 ) holds the iteration count, Z( 2*N+4 ) holds NDIVS/NIN^2, + and Z( 2*N+5 ) holds the percentage of shifts that failed. + + INFO (output) INTEGER + = 0: successful exit + < 0: if the i-th argument is a scalar and had an illegal value, + then INFO = -i, if the i-th argument is an array and the j-entry + had an illegal value, then INFO = -(i*100+j) > 0: the algorithm + failed = 1, a split was marked by a positive value in E = 2, cur- + rent block of Z not diagonalized after 30*N iterations (in inner + while loop) = 3, termination criterion of outer while loop not + met (program created more than N unreduced blocks) + +FURTHER DETAILS + The shifts are accumulated in SIGMA. Iteration count is in ITER. Ping- + pong is controlled by PP (alternates between 0 and 1). + +@ + <>= (let* ((cbias 1.5) (zero 0.0) @@ -50221,7 +62818,9 @@ The return values are: (cond ((< n 0) (setf info -1) - (xerbla "DLASQ2" 1) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASQ2" 1) (go end_label)) ((= n 0) (go end_label)) @@ -50229,14 +62828,18 @@ The return values are: (cond ((< (f2cl-lib:fref z (1) ((1 *))) zero) (setf info -201) - (xerbla "DLASQ2" 2))) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASQ2" 2))) (go end_label)) ((= n 2) (cond ((or (< (f2cl-lib:fref z (2) ((1 *))) zero) (< (f2cl-lib:fref z (3) ((1 *))) zero)) (setf info -2) - (xerbla "DLASQ2" 2) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASQ2" 2) (go end_label)) ((> (f2cl-lib:fref z (3) ((1 *))) (f2cl-lib:fref z (1) ((1 *)))) (setf d (f2cl-lib:fref z-%data% (3) ((1 *)) z-%offset%)) @@ -50309,11 +62912,15 @@ The return values are: (cond ((< (f2cl-lib:fref z (k) ((1 *))) zero) (setf info (f2cl-lib:int-sub (f2cl-lib:int-add 200 k))) - (xerbla "DLASQ2" 2) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASQ2" 2) (go end_label)) ((< (f2cl-lib:fref z ((f2cl-lib:int-add k 1)) ((1 *))) zero) (setf info (f2cl-lib:int-sub (f2cl-lib:int-add 200 k 1))) - (xerbla "DLASQ2" 2) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASQ2" 2) (go end_label))) (setf d (+ d (f2cl-lib:fref z-%data% (k) ((1 *)) z-%offset%))) (setf e @@ -50349,7 +62956,9 @@ The return values are: (f2cl-lib:int-sub (f2cl-lib:int-add 200 (f2cl-lib:int-mul 2 n)) 1))) - (xerbla "DLASQ2" 2) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASQ2" 2) (go end_label))) (setf d (+ d @@ -51039,25 +63648,95 @@ The return values are: end_label (return (values nil nil info)))))) -;(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::dlasq2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlasq3 fortran-to-lisp::ilaenv -; fortran-to-lisp::dlasrt fortran-to-lisp::xerbla -; fortran-to-lisp::dlamch)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasq3 LAPACK} %\pagehead{dlasq3}{dlasq3} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasq3.output +)spool dlasq3.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasq3 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASQ3 - for deflation, computes a shift (TAU) and calls dqds + +SYNOPSIS + SUBROUTINE DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL, + ITER, NDIV, IEEE ) + + LOGICAL IEEE + + INTEGER I0, ITER, N0, NDIV, NFAIL, PP + + DOUBLE PRECISION DESIG, DMIN, QMAX, SIGMA + + DOUBLE PRECISION Z( * ) + +PURPOSE + DLASQ3 checks for deflation, computes a shift (TAU) and calls dqds. In + case of failure it changes shifts, and tries again until output is pos- + itive. + + +ARGUMENTS + I0 (input) INTEGER + First index. + + N0 (input) INTEGER + Last index. + + Z (input) DOUBLE PRECISION array, dimension ( 4*N ) + Z holds the qd array. + + PP (input) INTEGER + PP=0 for ping, PP=1 for pong. + + DMIN (output) DOUBLE PRECISION + Minimum value of d. + + SIGMA (output) DOUBLE PRECISION + Sum of shifts used in current segment. + + DESIG (input/output) DOUBLE PRECISION + Lower order part of SIGMA + + QMAX (input) DOUBLE PRECISION + Maximum value of q. + + NFAIL (output) INTEGER + Number of times shift was too big. + + ITER (output) INTEGER + Number of iterations. + + NDIV (output) INTEGER + Number of divisions. + + TTYPE (output) INTEGER + Shift type. + + IEEE (input) LOGICAL + Flag for IEEE or non IEEE arithmetic (passed to DLASQ5). + +@ + <>= (let* ((cbias 1.5) (zero 0.0) @@ -51659,32 +64338,91 @@ The return values are: ndiv 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::dlasq3 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (double-float) (double-float) (double-float) -; (double-float) fixnum -; fixnum fixnum -; (member t nil)) -; :return-values '(nil fortran-to-lisp::n0 nil nil -; fortran-to-lisp::dmin fortran-to-lisp::sigma -; fortran-to-lisp::desig fortran-to-lisp::qmax -; fortran-to-lisp::nfail fortran-to-lisp::iter -; fortran-to-lisp::ndiv nil) -; :calls '(fortran-to-lisp::dlasq6 fortran-to-lisp::dlasq5 -; fortran-to-lisp::dlasq4 fortran-to-lisp::dlamch)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasq4 LAPACK} %\pagehead{dlasq4}{dlasq4} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasq4.output +)spool dlasq4.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasq4 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASQ4 - an approximation TAU to the smallest eigenvalue using values + of d from the previous transform + +SYNOPSIS + SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1, + DN2, TAU, TTYPE ) + + INTEGER I0, N0, N0IN, PP, TTYPE + + DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DN1, DN2, TAU + + DOUBLE PRECISION Z( * ) + +PURPOSE + DLASQ4 computes an approximation TAU to the smallest eigenvalue using + values of d from the previous transform. + + I0 (input) INTEGER + First index. + + N0 (input) INTEGER + Last index. + + Z (input) DOUBLE PRECISION array, dimension ( 4*N ) + Z holds the qd array. + + PP (input) INTEGER + PP=0 for ping, PP=1 for pong. + + N0IN (input) INTEGER + The value of N0 at start of EIGTEST. + + DMIN (input) DOUBLE PRECISION + Minimum value of d. + + DMIN1 (input) DOUBLE PRECISION + Minimum value of d, excluding D( N0 ). + + DMIN2 (input) DOUBLE PRECISION + Minimum value of d, excluding D( N0 ) and D( N0-1 ). + + DN (input) DOUBLE PRECISION + d(N) + + DN1 (input) DOUBLE PRECISION + d(N-1) + + DN2 (input) DOUBLE PRECISION + d(N-2) + + TAU (output) DOUBLE PRECISION + This is the shift. + + TTYPE (output) INTEGER + Shift type. + +@ + <>= (let* ((cnst1 0.563) (cnst2 1.01) @@ -52204,28 +64942,93 @@ The return values are: (return (values nil nil nil nil nil nil nil nil nil nil nil tau ttype))))))) -;(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::dlasq4 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; fixnum (double-float) -; (double-float) (double-float) (double-float) -; (double-float) (double-float) (double-float) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::tau fortran-to-lisp::ttype) -; :calls 'nil))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasq5 LAPACK} %\pagehead{dlasq5}{dlasq5} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasq5.output +)spool dlasq5.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasq5 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASQ5 - one dqds transform in ping-pong form, one version for IEEE + machines another for non IEEE machines + +SYNOPSIS + SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN, DNM1, + DNM2, IEEE ) + + LOGICAL IEEE + + INTEGER I0, N0, PP + + DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU + + DOUBLE PRECISION Z( * ) + +PURPOSE + DLASQ5 computes one dqds transform in ping-pong form, one version for + IEEE machines another for non IEEE machines. + + +ARGUMENTS + I0 (input) INTEGER + First index. + + N0 (input) INTEGER + Last index. + + Z (input) DOUBLE PRECISION array, dimension ( 4*N ) + Z holds the qd array. EMIN is stored in Z(4*N0) to avoid an extra + argument. + + PP (input) INTEGER + PP=0 for ping, PP=1 for pong. + + TAU (input) DOUBLE PRECISION + This is the shift. + + DMIN (output) DOUBLE PRECISION + Minimum value of d. + + DMIN1 (output) DOUBLE PRECISION Minimum value of d, excluding D( + N0 ). + + DMIN2 (output) DOUBLE PRECISION Minimum value of d, excluding D( + N0 ) and D( N0-1 ). + + DN (output) DOUBLE PRECISION + d(N0), the last value of d. + + DNM1 (output) DOUBLE PRECISION + d(N0-1). + + DNM2 (output) DOUBLE PRECISION + d(N0-2). + + IEEE (input) LOGICAL + Flag for IEEE or non IEEE arithmetic. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -52633,29 +65436,84 @@ The return values are: dnm2 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::dlasq5 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (double-float) (double-float) (double-float) -; (double-float) (double-float) (double-float) -; (double-float) (member t nil)) -; :return-values '(nil nil nil nil nil fortran-to-lisp::dmin -; fortran-to-lisp::dmin1 fortran-to-lisp::dmin2 -; fortran-to-lisp::dn fortran-to-lisp::dnm1 -; fortran-to-lisp::dnm2 nil) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasq6 LAPACK} %\pagehead{dlasq6}{dlasq6} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasq6.output +)spool dlasq6.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasq6 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASQ6 - one dqd (shift equal to zero) transform in ping-pong form, + with protection against underflow and overflow + +SYNOPSIS + SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DNM1, DNM2 ) + + INTEGER I0, N0, PP + + DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2 + + DOUBLE PRECISION Z( * ) + +PURPOSE + DLASQ6 computes one dqd (shift equal to zero) transform in ping-pong + form, with protection against underflow and overflow. + + +ARGUMENTS + I0 (input) INTEGER + First index. + + N0 (input) INTEGER + Last index. + + Z (input) DOUBLE PRECISION array, dimension ( 4*N ) + Z holds the qd array. EMIN is stored in Z(4*N0) to avoid an extra + argument. + + PP (input) INTEGER + PP=0 for ping, PP=1 for pong. + + DMIN (output) DOUBLE PRECISION + Minimum value of d. + + DMIN1 (output) DOUBLE PRECISION Minimum value of d, excluding D( + N0 ). + + DMIN2 (output) DOUBLE PRECISION Minimum value of d, excluding D( + N0 ) and D( N0-1 ). + + DN (output) DOUBLE PRECISION + d(N0), the last value of d. + + DNM1 (output) DOUBLE PRECISION + d(N0-1). + + DNM2 (output) DOUBLE PRECISION + d(N0-2). + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -53033,28 +65891,162 @@ The return values are: (return (values nil nil nil nil dmin f2cl-lib:dmin1 dmin2 dn dnm1 dnm2)))))) -;(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::dlasq6 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; (array double-float (*)) fixnum -; (double-float) (double-float) (double-float) -; (double-float) (double-float) (double-float)) -; :return-values '(nil nil nil nil fortran-to-lisp::dmin -; fortran-to-lisp::dmin1 fortran-to-lisp::dmin2 -; fortran-to-lisp::dn fortran-to-lisp::dnm1 -; fortran-to-lisp::dnm2) -; :calls '(fortran-to-lisp::dlamch)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasr LAPACK} %\pagehead{dlasr}{dlasr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasr.output +)spool dlasr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASR - a sequence of plane rotations to a real matrix A, + +SYNOPSIS + SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) + + CHARACTER DIRECT, PIVOT, SIDE + + INTEGER LDA, M, N + + DOUBLE PRECISION A( LDA, * ), C( * ), S( * ) + +PURPOSE + DLASR applies a sequence of plane rotations to a real matrix A, from + either the left or the right. + + When SIDE = 'L', the transformation takes the form + + A := P*A + + and when SIDE = 'R', the transformation takes the form + + A := A*P**T + + where P is an orthogonal matrix consisting of a sequence of z plane + rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R', and + P**T is the transpose of P. + + When DIRECT = 'F' (Forward sequence), then + + P = P(z-1) * ... * P(2) * P(1) + + and when DIRECT = 'B' (Backward sequence), then + + P = P(1) * P(2) * ... * P(z-1) + + where P(k) is a plane rotation matrix defined by the 2-by-2 rotation + + R(k) = ( c(k) s(k) ) + = ( -s(k) c(k) ). + + When PIVOT = 'V' (Variable pivot), the rotation is performed for the + plane (k,k+1), i.e., P(k) has the form + + P(k) = ( 1 ) + ( ... ) + ( 1 ) + ( c(k) s(k) ) + ( -s(k) c(k) ) + ( 1 ) + ( ... ) + ( 1 ) + + where R(k) appears as a rank-2 modification to the identity matrix in + rows and columns k and k+1. + + When PIVOT = 'T' (Top pivot), the rotation is performed for the plane + (1,k+1), so P(k) has the form + + P(k) = ( c(k) s(k) ) + ( 1 ) + ( ... ) + ( 1 ) + ( -s(k) c(k) ) + ( 1 ) + ( ... ) + ( 1 ) + + where R(k) appears in rows and columns 1 and k+1. + + Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is performed + for the plane (k,z), giving P(k) the form + + P(k) = ( 1 ) + ( ... ) + ( 1 ) + ( c(k) s(k) ) + ( 1 ) + ( ... ) + ( 1 ) + ( -s(k) c(k) ) + + where R(k) appears in rows and columns k and z. The rotations are per- + formed without ever forming P(k) explicitly. + + +ARGUMENTS + SIDE (input) CHARACTER*1 + Specifies whether the plane rotation matrix P is applied to A + on the left or the right. = 'L': Left, compute A := P*A + = 'R': Right, compute A:= A*P**T + + PIVOT (input) CHARACTER*1 + Specifies the plane for which P(k) is a plane rotation matrix. + = 'V': Variable pivot, the plane (k,k+1) + = 'T': Top pivot, the plane (1,k+1) + = 'B': Bottom pivot, the plane (k,z) + + DIRECT (input) CHARACTER*1 + Specifies whether P is a forward or backward sequence of plane + rotations. = 'F': Forward, P = P(z-1)*...*P(2)*P(1) + = 'B': Backward, P = P(1)*P(2)*...*P(z-1) + + M (input) INTEGER + The number of rows of the matrix A. If m <= 1, an immediate + return is effected. + + N (input) INTEGER + The number of columns of the matrix A. If n <= 1, an immediate + return is effected. + + C (input) DOUBLE PRECISION array, dimension + (M-1) if SIDE = 'L' (N-1) if SIDE = 'R' The cosines c(k) of the + plane rotations. + + S (input) DOUBLE PRECISION array, dimension + (M-1) if SIDE = 'L' (N-1) if SIDE = 'R' The sines s(k) of the + plane rotations. The 2-by-2 plane rotation part of the matrix + P(k), R(k), has the form R(k) = ( c(k) s(k) ) ( -s(k) c(k) + ). + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + The M-by-N matrix A. On exit, A is overwritten by P*A if SIDE + = 'R' or by A*P**T if SIDE = 'L'. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,M). + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -53062,7 +66054,7 @@ The return values are: (defun dlasr (side pivot direct m n c s a lda) (declare (type (array double-float (*)) a s c) (type fixnum lda n m) - (type (simple-array character (*)) direct pivot side)) + (type character direct pivot side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (pivot character pivot-%data% pivot-%offset%) @@ -53075,11 +66067,11 @@ The return values are: (type fixnum i info j)) (setf info 0) (cond - ((not (or (lsame side "L") (lsame side "R"))) + ((not (or (char-equal side #\L) (char-equal side #\R))) (setf info 1)) - ((not (or (lsame pivot "V") (lsame pivot "T") (lsame pivot "B"))) + ((not (or (char-equal pivot #\V) (char-equal pivot #\T) (char-equal pivot #\B))) (setf info 2)) - ((not (or (lsame direct "F") (lsame direct "B"))) + ((not (or (char-equal direct #\F) (char-equal direct #\B))) (setf info 3)) ((< m 0) (setf info 4)) @@ -53089,15 +66081,17 @@ The return values are: (setf info 9))) (cond ((/= info 0) - (xerbla "DLASR " info) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASR" info) (go end_label))) (if (or (= m 0) (= n 0)) (go end_label)) (cond - ((lsame side "L") + ((char-equal side #\L) (cond - ((lsame pivot "V") + ((char-equal pivot #\V) (cond - ((lsame direct "F") + ((char-equal direct #\F) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j (f2cl-lib:int-add m (f2cl-lib:int-sub 1))) nil) @@ -53136,7 +66130,7 @@ The return values are: (j i) ((1 lda) (1 *)) a-%offset%))))))))))) - ((lsame direct "B") + ((char-equal direct #\B) (f2cl-lib:fdo (j (f2cl-lib:int-add m (f2cl-lib:int-sub 1)) (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) ((> j 1) nil) @@ -53175,9 +66169,9 @@ The return values are: (j i) ((1 lda) (1 *)) a-%offset%))))))))))))) - ((lsame pivot "T") + ((char-equal pivot #\T) (cond - ((lsame direct "F") + ((char-equal direct #\F) (f2cl-lib:fdo (j 2 (f2cl-lib:int-add j 1)) ((> j m) nil) (tagbody @@ -53221,7 +66215,7 @@ The return values are: (1 i) ((1 lda) (1 *)) a-%offset%))))))))))) - ((lsame direct "B") + ((char-equal direct #\B) (f2cl-lib:fdo (j m (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) ((> j 2) nil) (tagbody @@ -53265,9 +66259,9 @@ The return values are: (1 i) ((1 lda) (1 *)) a-%offset%))))))))))))) - ((lsame pivot "B") + ((char-equal pivot #\B) (cond - ((lsame direct "F") + ((char-equal direct #\F) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j (f2cl-lib:int-add m (f2cl-lib:int-sub 1))) nil) @@ -53308,7 +66302,7 @@ The return values are: ((1 lda) (1 *)) a-%offset%)) (* stemp temp)))))))))) - ((lsame direct "B") + ((char-equal direct #\B) (f2cl-lib:fdo (j (f2cl-lib:int-add m (f2cl-lib:int-sub 1)) (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) ((> j 1) nil) @@ -53349,11 +66343,11 @@ The return values are: ((1 lda) (1 *)) a-%offset%)) (* stemp temp)))))))))))))) - ((lsame side "R") + ((char-equal side #\R) (cond - ((lsame pivot "V") + ((char-equal pivot #\V) (cond - ((lsame direct "F") + ((char-equal direct #\F) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j (f2cl-lib:int-add n (f2cl-lib:int-sub 1))) nil) @@ -53392,7 +66386,7 @@ The return values are: (i j) ((1 lda) (1 *)) a-%offset%))))))))))) - ((lsame direct "B") + ((char-equal direct #\B) (f2cl-lib:fdo (j (f2cl-lib:int-add n (f2cl-lib:int-sub 1)) (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) ((> j 1) nil) @@ -53431,9 +66425,9 @@ The return values are: (i j) ((1 lda) (1 *)) a-%offset%))))))))))))) - ((lsame pivot "T") + ((char-equal pivot #\T) (cond - ((lsame direct "F") + ((char-equal direct #\F) (f2cl-lib:fdo (j 2 (f2cl-lib:int-add j 1)) ((> j n) nil) (tagbody @@ -53477,7 +66471,7 @@ The return values are: (i 1) ((1 lda) (1 *)) a-%offset%))))))))))) - ((lsame direct "B") + ((char-equal direct #\B) (f2cl-lib:fdo (j n (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) ((> j 2) nil) (tagbody @@ -53521,9 +66515,9 @@ The return values are: (i 1) ((1 lda) (1 *)) a-%offset%))))))))))))) - ((lsame pivot "B") + ((char-equal pivot #\B) (cond - ((lsame direct "F") + ((char-equal direct #\F) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j (f2cl-lib:int-add n (f2cl-lib:int-sub 1))) nil) @@ -53564,7 +66558,7 @@ The return values are: ((1 lda) (1 *)) a-%offset%)) (* stemp temp)))))))))) - ((lsame direct "B") + ((char-equal direct #\B) (f2cl-lib:fdo (j (f2cl-lib:int-add n (f2cl-lib:int-sub 1)) (f2cl-lib:int-add j (f2cl-lib:int-sub 1))) ((> j 1) nil) @@ -53608,33 +66602,79 @@ The return values are: end_label (return (values 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::dlasr fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; (array double-float (*)) (array double-float (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame))));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasrt LAPACK} %\pagehead{dlasrt}{dlasrt} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasrt.output +)spool dlasrt.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasrt examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASRT - number in D in increasing order (if ID = 'I') or in decreasing + order (if ID = 'D' ) + +SYNOPSIS + SUBROUTINE DLASRT( ID, N, D, INFO ) + + CHARACTER ID + + INTEGER INFO, N + + DOUBLE PRECISION D( * ) + +PURPOSE + Sort the numbers in D in increasing order (if ID = 'I') or in decreas- + ing order (if ID = 'D' ). + + Use Quick Sort, reverting to Insertion sort on arrays of + size <= 20. Dimension of STACK limits N to about 2**32. + + +ARGUMENTS + ID (input) CHARACTER*1 + = 'I': sort D in increasing order; + = 'D': sort D in decreasing order. + + N (input) INTEGER + The length of the array D. + + D (input/output) DOUBLE PRECISION array, dimension (N) + On entry, the array to be sorted. On exit, D has been sorted + into increasing order (D(1) <= ... <= D(N) ) or into decreasing + order (D(1) >= ... >= D(N) ), depending on ID. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +@ + <>= (let* ((select 20)) (declare (type (fixnum 20 20) select)) (defun dlasrt (id n d info) (declare (type (array double-float (*)) d) (type fixnum info n) - (type (simple-array character (*)) id)) + (type character id)) (f2cl-lib:with-multi-array-data ((id character id-%data% id-%offset%) (d double-float d-%data% d-%offset%)) @@ -53647,9 +66687,9 @@ The return values are: (setf info 0) (setf dir -1) (cond - ((lsame id "D") + ((char-equal id #\D) (setf dir 0)) - ((lsame id "I") + ((char-equal id #\I) (setf dir 1))) (cond ((= dir (f2cl-lib:int-sub 1)) @@ -53658,7 +66698,9 @@ The return values are: (setf info -2))) (cond ((/= info 0) - (xerbla "DLASRT" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DLASRT" (f2cl-lib:int-sub info)) (go end_label))) (if (<= n 1) (go end_label)) (setf stkpnt 1) @@ -53844,24 +66886,83 @@ The return values are: end_label (return (values nil nil nil info)))))) -;(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::dlasrt -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::xerbla fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlassq LAPACK} %\pagehead{dlassq}{dlassq} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlassq.output +)spool dlassq.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlassq examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASSQ - the values scl and smsq such that ( scl**2 )*smsq = x( 1 + )**2 +...+ x( n )**2 + ( scale**2 )*sumsq, + +SYNOPSIS + SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ ) + + INTEGER INCX, N + + DOUBLE PRECISION SCALE, SUMSQ + + DOUBLE PRECISION X( * ) + +PURPOSE + DLASSQ returns the values scl and smsq such that + + where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is + assumed to be non-negative and scl returns the value + + scl = max( scale, abs( x( i ) ) ). + + scale and sumsq must be supplied in SCALE and SUMSQ and + scl and smsq are overwritten on SCALE and SUMSQ respectively. + + The routine makes only one pass through the vector x. + + +ARGUMENTS + N (input) INTEGER + The number of elements to be used from the vector X. + + X (input) DOUBLE PRECISION array, dimension (N) + The vector for which a scaled sum of squares is computed. x( i + ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. + + INCX (input) INTEGER + The increment between successive values of the vector X. INCX + > 0. + + SCALE (input/output) DOUBLE PRECISION + On entry, the value scale in the equation above. On exit, + SCALE is overwritten with scl , the scaling factor for the sum + of squares. + + SUMSQ (input/output) DOUBLE PRECISION + On entry, the value sumsq in the equation above. On exit, + SUMSQ is overwritten with smsq , the basic sum of squares from + which scl has been factored out. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -53897,25 +66998,99 @@ The return values are: (setf sumsq (+ sumsq (expt (/ absxi scale) 2))))))))))) (return (values nil nil nil scale sumsq)))))) -;(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::dlassq -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (*)) -; fixnum (double-float) -; (double-float)) -; :return-values '(nil nil nil fortran-to-lisp::scale -; fortran-to-lisp::sumsq) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasv2 LAPACK} %\pagehead{dlasv2}{dlasv2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasv2.output +)spool dlasv2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasv2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASV2 - the singular value decomposition of a 2-by-2 triangular matrix + [ F G ] [ 0 H ] + +SYNOPSIS + SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL ) + + DOUBLE PRECISION CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN + +PURPOSE + DLASV2 computes the singular value decomposition of a 2-by-2 triangular + matrix + [ F G ] + [ 0 H ]. On return, abs(SSMAX) is the larger singular value, + abs(SSMIN) is the smaller singular value, and (CSL,SNL) and (CSR,SNR) + are the left and right singular vectors for abs(SSMAX), giving the + decomposition + + [ CSL SNL ] [ F G ] [ CSR -SNR ] = [ SSMAX 0 ] + [-SNL CSL ] [ 0 H ] [ SNR CSR ] [ 0 SSMIN ]. + + +ARGUMENTS + F (input) DOUBLE PRECISION + The (1,1) element of the 2-by-2 matrix. + + G (input) DOUBLE PRECISION + The (1,2) element of the 2-by-2 matrix. + + H (input) DOUBLE PRECISION + The (2,2) element of the 2-by-2 matrix. + + SSMIN (output) DOUBLE PRECISION + abs(SSMIN) is the smaller singular value. + + SSMAX (output) DOUBLE PRECISION + abs(SSMAX) is the larger singular value. + + SNL (output) DOUBLE PRECISION + CSL (output) DOUBLE PRECISION The vector (CSL, SNL) is a + unit left singular vector for the singular value abs(SSMAX). + + SNR (output) DOUBLE PRECISION + CSR (output) DOUBLE PRECISION The vector (CSR, SNR) is a + unit right singular vector for the singular value abs(SSMAX). + +FURTHER DETAILS + Any input parameter may be aliased with any output parameter. + + Barring over/underflow and assuming a guard digit in subtraction, all + output quantities are correct to within a few units in the last place + (ulps). + + In IEEE arithmetic, the code works correctly if one matrix element is + infinite. + + Overflow will not occur unless the largest singular value itself over- + flows or is within a few ulps of overflow. (On machines with partial + overflow, like the Cray, overflow may occur if the largest singular + value is within a factor of 2 of overflow.) + + Underflow is harmless if underflow is gradual. Otherwise, results may + correspond to a matrix modified by perturbations of size near the + underflow threshold. + +@ + <>= (let* ((zero 0.0) (half 0.5) (one 1.0) (two 2.0) (four 4.0)) (declare (type (double-float 0.0 0.0) zero) @@ -54045,27 +67220,79 @@ The return values are: (f2cl-lib:sign one h)))) (return (values nil nil nil ssmin ssmax snr csr snl csl))))) -;(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::dlasv2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((double-float) (double-float) (double-float) -; (double-float) (double-float) (double-float) -; (double-float) (double-float) (double-float)) -; :return-values '(nil nil nil fortran-to-lisp::ssmin -; fortran-to-lisp::ssmax fortran-to-lisp::snr -; fortran-to-lisp::csr fortran-to-lisp::snl -; fortran-to-lisp::csl) -; :calls '(fortran-to-lisp::dlamch))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlaswp LAPACK} %\pagehead{dlaswp}{dlaswp} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlaswp.output +)spool dlaswp.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlaswp examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASWP - a series of row interchanges on the matrix A + +SYNOPSIS + SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX ) + + INTEGER INCX, K1, K2, LDA, N + + INTEGER IPIV( * ) + + DOUBLE PRECISION A( LDA, * ) + +PURPOSE + DLASWP performs a series of row interchanges on the matrix A. One row + interchange is initiated for each of rows K1 through K2 of A. + + +ARGUMENTS + N (input) INTEGER + The number of columns of the matrix A. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the matrix of column dimension N to which the row + interchanges will be applied. On exit, the permuted matrix. + + LDA (input) INTEGER + The leading dimension of the array A. + + K1 (input) INTEGER + The first element of IPIV for which a row interchange will be + done. + + K2 (input) INTEGER + The last element of IPIV for which a row interchange will be + done. + + IPIV (input) INTEGER array, dimension (K2*abs(INCX)) + The vector of pivot indices. Only the elements in positions K1 + through K2 of IPIV are accessed. IPIV(K) = L implies rows K + and L are to be interchanged. + + INCX (input) INTEGER + The increment between successive values of IPIV. If IPIV is + negative, the pivots are applied in reverse order. + +@ + <>= (defun dlaswp (n a lda k1 k2 ipiv incx) (declare (type (array fixnum (*)) ipiv) @@ -54168,26 +67395,117 @@ The return values are: end_label (return (values 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::dlaswp -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (array double-float (*)) -; fixnum fixnum -; fixnum -; (array fixnum (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil) -; :calls 'nil)));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dlasy2 LAPACK} %\pagehead{dlasy2}{dlasy2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dlasy2.output +)spool dlasy2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dlasy2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DLASY2 - for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in op(TL)*X + + ISGN*X*op(TR) = SCALE*B, + +SYNOPSIS + SUBROUTINE DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR, LDTR, B, + LDB, SCALE, X, LDX, XNORM, INFO ) + + LOGICAL LTRANL, LTRANR + + INTEGER INFO, ISGN, LDB, LDTL, LDTR, LDX, N1, N2 + + DOUBLE PRECISION SCALE, XNORM + + DOUBLE PRECISION B( LDB, * ), TL( LDTL, * ), TR( LDTR, * ), + X( LDX, * ) + +PURPOSE + DLASY2 solves for the N1 by N2 matrix X, 1 <= N1,N2 <= 2, in + + where TL is N1 by N1, TR is N2 by N2, B is N1 by N2, and ISGN = 1 or + -1. op(T) = T or T', where T' denotes the transpose of T. + + +ARGUMENTS + LTRANL (input) LOGICAL + On entry, LTRANL specifies the op(TL): = .FALSE., op(TL) = TL, + = .TRUE., op(TL) = TL'. + + LTRANR (input) LOGICAL + On entry, LTRANR specifies the op(TR): = .FALSE., op(TR) = TR, + = .TRUE., op(TR) = TR'. + + ISGN (input) INTEGER + On entry, ISGN specifies the sign of the equation as described + before. ISGN may only be 1 or -1. + + N1 (input) INTEGER + On entry, N1 specifies the order of matrix TL. N1 may only be + 0, 1 or 2. + + N2 (input) INTEGER + On entry, N2 specifies the order of matrix TR. N2 may only be + 0, 1 or 2. + + TL (input) DOUBLE PRECISION array, dimension (LDTL,2) + On entry, TL contains an N1 by N1 matrix. + + LDTL (input) INTEGER + The leading dimension of the matrix TL. LDTL >= max(1,N1). + + TR (input) DOUBLE PRECISION array, dimension (LDTR,2) + On entry, TR contains an N2 by N2 matrix. + + LDTR (input) INTEGER + The leading dimension of the matrix TR. LDTR >= max(1,N2). + + B (input) DOUBLE PRECISION array, dimension (LDB,2) + On entry, the N1 by N2 matrix B contains the right-hand side of + the equation. + + LDB (input) INTEGER + The leading dimension of the matrix B. LDB >= max(1,N1). + + SCALE (output) DOUBLE PRECISION + On exit, SCALE contains the scale factor. SCALE is chosen less + than or equal to 1 to prevent the solution overflowing. + + X (output) DOUBLE PRECISION array, dimension (LDX,2) + On exit, X contains the N1 by N2 solution. + + LDX (input) INTEGER + The leading dimension of the matrix X. LDX >= max(1,N1). + + XNORM (output) DOUBLE PRECISION + On exit, XNORM is the infinity-norm of the solution. + + INFO (output) INTEGER + On exit, INFO is set to 0: successful exit. + 1: TL and TR have too close eigenvalues, so TL or TR is per- + turbed to get a nonsingular equation. NOTE: In the interests + of speed, this routine does not check the inputs for errors. + +@ + <>= (let* ((zero 0.0) (one 1.0) (two 2.0) (half 0.5) (eight 8.0)) (declare (type (double-float 0.0 0.0) zero) @@ -54875,32 +68193,84 @@ The return values are: xnorm info))))))) -;(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::dlasy2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((member t nil) (member t nil) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (double-float) -; (array double-float (*)) fixnum -; (double-float) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::scale nil nil -; fortran-to-lisp::xnorm fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dswap fortran-to-lisp::dcopy -; fortran-to-lisp::idamax fortran-to-lisp::dlamch)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dorg2r LAPACK} %\pagehead{dorg2r}{dorg2r} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dorg2r.output +)spool dorg2r.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dorg2r examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DORG2R - an m by n real matrix Q with orthonormal columns, + +SYNOPSIS + SUBROUTINE DORG2R( M, N, K, A, LDA, TAU, WORK, INFO ) + + INTEGER INFO, K, LDA, M, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DORG2R generates an m by n real matrix Q with orthonormal columns, + which is defined as the first n columns of a product of k elementary + reflectors of order m + + Q = H(1) H(2) . . . H(k) + + as returned by DGEQRF. + + +ARGUMENTS + M (input) INTEGER + The number of rows of the matrix Q. M >= 0. + + N (input) INTEGER + The number of columns of the matrix Q. M >= N >= 0. + + K (input) INTEGER + The number of elementary reflectors whose product defines the + matrix Q. N >= K >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the i-th column must contain the vector which defines + the elementary reflector H(i), for i = 1,2,...,k, as returned + by DGEQRF in the first k columns of its array argument A. On + exit, the m-by-n matrix Q. + + LDA (input) INTEGER + The first dimension of the array A. LDA >= max(1,M). + + TAU (input) DOUBLE PRECISION array, dimension (K) + TAU(i) must contain the scalar factor of the elementary reflec- + tor H(i), as returned by DGEQRF. + + WORK (workspace) DOUBLE PRECISION array, dimension (N) + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument has an illegal value + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -54926,7 +68296,9 @@ The return values are: (setf info -5))) (cond ((/= info 0) - (xerbla "DORG2R" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DORG2R" (f2cl-lib:int-sub info)) (go end_label))) (if (<= n 0) (go end_label)) (f2cl-lib:fdo (j (f2cl-lib:int-add k 1) (f2cl-lib:int-add j 1)) @@ -54974,26 +68346,120 @@ The return values are: end_label (return (values nil nil nil nil nil nil nil info)))))) -;(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::dorg2r -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dscal fortran-to-lisp::dlarf -; fortran-to-lisp::xerbla))));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dorgbr LAPACK} %\pagehead{dorgbr}{dorgbr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dorgbr.output +)spool dorgbr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dorgbr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DORGBR - one of the real orthogonal matrices Q or P**T determined by + DGEBRD when reducing a real matrix A to bidiagonal form + +SYNOPSIS + SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) + + CHARACTER VECT + + INTEGER INFO, K, LDA, LWORK, M, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DORGBR generates one of the real orthogonal matrices Q or P**T deter- + mined by DGEBRD when reducing a real matrix A to bidiagonal form: A = Q + * B * P**T. Q and P**T are defined as products of elementary reflec- + tors H(i) or G(i) respectively. + + If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q is of + order M: + if m >= k, Q = H(1) H(2) . . . H(k) and DORGBR returns the first n + columns of Q, where m >= n >= k; + if m < k, Q = H(1) H(2) . . . H(m-1) and DORGBR returns Q as an M-by-M + matrix. + + If VECT = 'P', A is assumed to have been a K-by-N matrix, and P**T is + of order N: + if k < n, P**T = G(k) . . . G(2) G(1) and DORGBR returns the first m + rows of P**T, where n >= m >= k; + if k >= n, P**T = G(n-1) . . . G(2) G(1) and DORGBR returns P**T as an + N-by-N matrix. + + +ARGUMENTS + VECT (input) CHARACTER*1 + Specifies whether the matrix Q or the matrix P**T is required, + as defined in the transformation applied by DGEBRD: + = 'Q': generate Q; + = 'P': generate P**T. + + M (input) INTEGER + The number of rows of the matrix Q or P**T to be returned. M + >= 0. + + N (input) INTEGER + The number of columns of the matrix Q or P**T to be returned. + N >= 0. If VECT = 'Q', M >= N >= min(M,K); if VECT = 'P', N >= + M >= min(N,K). + + K (input) INTEGER + If VECT = 'Q', the number of columns in the original M-by-K + matrix reduced by DGEBRD. If VECT = 'P', the number of rows in + the original K-by-N matrix reduced by DGEBRD. K >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the vectors which define the elementary reflectors, + as returned by DGEBRD. On exit, the M-by-N matrix Q or P**T. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,M). + + TAU (input) DOUBLE PRECISION array, dimension + (min(M,K)) if VECT = 'Q' (min(N,K)) if VECT = 'P' TAU(i) must + contain the scalar factor of the elementary reflector H(i) or + G(i), which determines Q or P**T, as returned by DGEBRD in its + array argument TAUQ or TAUP. + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The dimension of the array WORK. LWORK >= max(1,min(M,N)). For + optimum performance LWORK >= min(M,N)*NB, where NB is the opti- + mal blocksize. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -55001,7 +68467,7 @@ The return values are: (defun dorgbr (vect m n k a lda tau work lwork info) (declare (type (array double-float (*)) work tau a) (type fixnum info lwork lda k n m) - (type (simple-array character (*)) vect)) + (type character vect)) (f2cl-lib:with-multi-array-data ((vect character vect-%data% vect-%offset%) (a double-float a-%data% a-%offset%) @@ -55012,11 +68478,11 @@ The return values are: (declare (type fixnum i iinfo j lwkopt mn nb) (type (member t nil) lquery wantq)) (setf info 0) - (setf wantq (lsame vect "Q")) + (setf wantq (char-equal vect #\Q)) (setf mn (min (the fixnum m) (the fixnum n))) (setf lquery (coerce (= lwork -1) '(member t nil))) (cond - ((and (not wantq) (not (lsame vect "P"))) + ((and (not wantq) (not (char-equal vect #\P))) (setf info -1)) ((< m 0) (setf info -2)) @@ -55056,7 +68522,9 @@ The return values are: (coerce (the fixnum lwkopt) 'double-float)))) p (cond ((/= info 0) - (xerbla "DORGBR" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DORGBR" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -55179,30 +68647,93 @@ p (cond end_label (return (values nil nil nil nil nil nil nil nil nil info)))))) -;(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::dorgbr -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dorglq fortran-to-lisp::dorgqr -; fortran-to-lisp::xerbla fortran-to-lisp::ilaenv -; fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dorghr LAPACK} %\pagehead{dorghr}{dorghr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dorghr.output +)spool dorghr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dorghr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DORGHR - a real orthogonal matrix Q which is defined as the product of + IHI-ILO elementary reflectors of order N, as returned by DGEHRD + +SYNOPSIS + SUBROUTINE DORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) + + INTEGER IHI, ILO, INFO, LDA, LWORK, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DORGHR generates a real orthogonal matrix Q which is defined as the + product of IHI-ILO elementary reflectors of order N, as returned by + DGEHRD: + + Q = H(ilo) H(ilo+1) . . . H(ihi-1). + + +ARGUMENTS + N (input) INTEGER + The order of the matrix Q. N >= 0. + + ILO (input) INTEGER + IHI (input) INTEGER ILO and IHI must have the same values + as in the previous call of DGEHRD. Q is equal to the unit + matrix except in the submatrix Q(ilo+1:ihi,ilo+1:ihi). 1 <= + ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the vectors which define the elementary reflectors, + as returned by DGEHRD. On exit, the N-by-N orthogonal matrix + Q. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,N). + + TAU (input) DOUBLE PRECISION array, dimension (N-1) + TAU(i) must contain the scalar factor of the elementary reflec- + tor H(i), as returned by DGEHRD. + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The dimension of the array WORK. LWORK >= IHI-ILO. For optimum + performance LWORK >= (IHI-ILO)*NB, where NB is the optimal + blocksize. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -55249,7 +68780,9 @@ p (cond (coerce (the fixnum lwkopt) 'double-float)))) (cond ((/= info 0) - (xerbla "DORGHR" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DORGHR" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -55317,28 +68850,84 @@ p (cond end_label (return (values nil nil nil nil nil nil nil nil info)))))) -;(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::dorghr -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dorgqr fortran-to-lisp::xerbla -; fortran-to-lisp::ilaenv)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dorgl2 LAPACK} %\pagehead{dorgl2}{dorgl2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dorgl2.output +)spool dorgl2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dorgl2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DORGL2 - an m by n real matrix Q with orthonormal rows, + +SYNOPSIS + SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO ) + + INTEGER INFO, K, LDA, M, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DORGL2 generates an m by n real matrix Q with orthonormal rows, which + is defined as the first m rows of a product of k elementary reflectors + of order n + + Q = H(k) . . . H(2) H(1) + + as returned by DGELQF. + + +ARGUMENTS + M (input) INTEGER + The number of rows of the matrix Q. M >= 0. + + N (input) INTEGER + The number of columns of the matrix Q. N >= M. + + K (input) INTEGER + The number of elementary reflectors whose product defines the + matrix Q. M >= K >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the i-th row must contain the vector which defines + the elementary reflector H(i), for i = 1,2,...,k, as returned + by DGELQF in the first k rows of its array argument A. On + exit, the m-by-n matrix Q. + + LDA (input) INTEGER + The first dimension of the array A. LDA >= max(1,M). + + TAU (input) DOUBLE PRECISION array, dimension (K) + TAU(i) must contain the scalar factor of the elementary reflec- + tor H(i), as returned by DGELQF. + + WORK (workspace) DOUBLE PRECISION array, dimension (M) + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument has an illegal value + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -55364,7 +68953,9 @@ p (cond (setf info -5))) (cond ((/= info 0) - (xerbla "DORGL2" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DORGL2" (f2cl-lib:int-sub info)) (go end_label))) (if (<= m 0) (go end_label)) (cond @@ -55425,26 +69016,96 @@ p (cond end_label (return (values nil nil nil nil nil nil nil info)))))) -;(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::dorgl2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dscal fortran-to-lisp::dlarf -; fortran-to-lisp::xerbla))));;; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dorglq LAPACK} %\pagehead{dorglq}{dorglq} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dorglq.output +)spool dorglq.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dorglq examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DORGLQ - an M-by-N real matrix Q with orthonormal rows, + +SYNOPSIS + SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) + + INTEGER INFO, K, LDA, LWORK, M, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DORGLQ generates an M-by-N real matrix Q with orthonormal rows, which + is defined as the first M rows of a product of K elementary reflectors + of order N + + Q = H(k) . . . H(2) H(1) + + as returned by DGELQF. + + +ARGUMENTS + M (input) INTEGER + The number of rows of the matrix Q. M >= 0. + + N (input) INTEGER + The number of columns of the matrix Q. N >= M. + + K (input) INTEGER + The number of elementary reflectors whose product defines the + matrix Q. M >= K >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the i-th row must contain the vector which defines + the elementary reflector H(i), for i = 1,2,...,k, as returned + by DGELQF in the first k rows of its array argument A. On + exit, the M-by-N matrix Q. + + LDA (input) INTEGER + The first dimension of the array A. LDA >= max(1,M). + + TAU (input) DOUBLE PRECISION array, dimension (K) + TAU(i) must contain the scalar factor of the elementary reflec- + tor H(i), as returned by DGELQF. + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The dimension of the array WORK. LWORK >= max(1,M). For opti- + mum performance LWORK >= M*NB, where NB is the optimal block- + size. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument has an illegal value + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -55484,7 +69145,9 @@ p (cond (setf info -8))) (cond ((/= info 0) - (xerbla "DORGLQ" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DORGLQ" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -55603,29 +69266,96 @@ p (cond end_label (return (values nil nil nil nil nil nil nil nil info)))))) -;(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::dorglq -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarfb fortran-to-lisp::dlarft -; fortran-to-lisp::dorgl2 fortran-to-lisp::xerbla -; fortran-to-lisp::ilaenv)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dorgqr LAPACK} %\pagehead{dorgqr}{dorgqr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dorgqr.output +)spool dorgqr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dorgqr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DORGQR - an M-by-N real matrix Q with orthonormal columns, + +SYNOPSIS + SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO ) + + INTEGER INFO, K, LDA, LWORK, M, N + + DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) + +PURPOSE + DORGQR generates an M-by-N real matrix Q with orthonormal columns, + which is defined as the first N columns of a product of K elementary + reflectors of order M + + Q = H(1) H(2) . . . H(k) + + as returned by DGEQRF. + + +ARGUMENTS + M (input) INTEGER + The number of rows of the matrix Q. M >= 0. + + N (input) INTEGER + The number of columns of the matrix Q. M >= N >= 0. + + K (input) INTEGER + The number of elementary reflectors whose product defines the + matrix Q. N >= K >= 0. + + A (input/output) DOUBLE PRECISION array, dimension (LDA,N) + On entry, the i-th column must contain the vector which defines + the elementary reflector H(i), for i = 1,2,...,k, as returned + by DGEQRF in the first k columns of its array argument A. On + exit, the M-by-N matrix Q. + + LDA (input) INTEGER + The first dimension of the array A. LDA >= max(1,M). + + TAU (input) DOUBLE PRECISION array, dimension (K) + TAU(i) must contain the scalar factor of the elementary reflec- + tor H(i), as returned by DGEQRF. + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The dimension of the array WORK. LWORK >= max(1,N). For opti- + mum performance LWORK >= N*NB, where NB is the optimal block- + size. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument has an illegal value + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -55665,7 +69395,9 @@ p (cond (setf info -8))) (cond ((/= info 0) - (xerbla "DORGQR" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DORGQR" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -55783,36 +69515,118 @@ p (cond end_label (return (values nil nil nil nil nil nil nil nil info)))))) -;(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::dorgqr -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarfb fortran-to-lisp::dlarft -; fortran-to-lisp::dorg2r fortran-to-lisp::xerbla -; fortran-to-lisp::ilaenv)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dorm2r LAPACK} %\pagehead{dorm2r}{dorm2r} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dorm2r.output +)spool dorm2r.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dorm2r examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DORM2R - the general real m by n matrix C with Q * C if SIDE = 'L' + and TRANS = 'N', or Q'* C if SIDE = 'L' and TRANS = 'T', or C * Q + if SIDE = 'R' and TRANS = 'N', or C * Q' if SIDE = 'R' and TRANS = + 'T', + +SYNOPSIS + SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + INFO ) + + CHARACTER SIDE, TRANS + + INTEGER INFO, K, LDA, LDC, M, N + + DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( + * ) + +PURPOSE + DORM2R overwrites the general real m by n matrix C with + + where Q is a real orthogonal matrix defined as the product of k elemen- + tary reflectors + + Q = H(1) H(2) . . . H(k) + + as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n if + SIDE = 'R'. + + +ARGUMENTS + SIDE (input) CHARACTER*1 + = 'L': apply Q or Q' from the Left + = 'R': apply Q or Q' from the Right + + TRANS (input) CHARACTER*1 + = 'N': apply Q (No transpose) + = 'T': apply Q' (Transpose) + + M (input) INTEGER + The number of rows of the matrix C. M >= 0. + + N (input) INTEGER + The number of columns of the matrix C. N >= 0. + + K (input) INTEGER + The number of elementary reflectors whose product defines the + matrix Q. If SIDE = 'L', M >= K >= 0; if SIDE = 'R', N >= K >= + 0. + + A (input) DOUBLE PRECISION array, dimension (LDA,K) + The i-th column must contain the vector which defines the ele- + mentary reflector H(i), for i = 1,2,...,k, as returned by DGE- + QRF in the first k columns of its array argument A. A is modi- + fied by the routine but restored on exit. + + LDA (input) INTEGER + The leading dimension of the array A. If SIDE = 'L', LDA >= + max(1,M); if SIDE = 'R', LDA >= max(1,N). + + TAU (input) DOUBLE PRECISION array, dimension (K) + TAU(i) must contain the scalar factor of the elementary reflec- + tor H(i), as returned by DGEQRF. + + C (input/output) DOUBLE PRECISION array, dimension (LDC,N) + On entry, the m by n matrix C. On exit, C is overwritten by + Q*C or Q'*C or C*Q' or C*Q. + + LDC (input) INTEGER + The leading dimension of the array C. LDC >= max(1,M). + + WORK (workspace) DOUBLE PRECISION array, dimension + (N) if SIDE = 'L', (M) if SIDE = 'R' + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +@ + <>= (let* ((one 1.0)) (declare (type (double-float 1.0 1.0) one)) (defun dorm2r (side trans m n k a lda tau c ldc work info) (declare (type (array double-float (*)) work c tau a) (type fixnum info ldc lda k n m) - (type (simple-array character (*)) trans side)) + (type character trans side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (trans character trans-%data% trans-%offset%) @@ -55826,17 +69640,17 @@ p (cond (type fixnum i i1 i2 i3 ic jc mi ni nq) (type (member t nil) left notran)) (setf info 0) - (setf left (lsame side "L")) - (setf notran (lsame trans "N")) + (setf left (char-equal side #\L)) + (setf notran (char-equal trans #\N)) (cond (left (setf nq m)) (t (setf nq n))) (cond - ((and (not left) (not (lsame side "R"))) + ((and (not left) (not (char-equal side #\R))) (setf info -1)) - ((and (not notran) (not (lsame trans "T"))) + ((and (not notran) (not (char-equal trans #\T))) (setf info -2)) ((< m 0) (setf info -3)) @@ -55850,7 +69664,9 @@ p (cond (setf info -10))) (cond ((/= info 0) - (xerbla "DORM2R" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DORM2R" (f2cl-lib:int-sub info)) (go end_label))) (if (or (= m 0) (= n 0) (= k 0)) (go end_label)) (cond @@ -55893,35 +69709,147 @@ p (cond end_label (return (values nil nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dorm2r -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarf fortran-to-lisp::xerbla -; fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dormbr LAPACK} %\pagehead{dormbr}{dormbr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dormbr.output +)spool dormbr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dormbr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DORMBR - = 'Q', DORMBR overwrites the general real M-by-N matrix C with + SIDE = 'L' SIDE = 'R' TRANS = 'N' + +SYNOPSIS + SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, + WORK, LWORK, INFO ) + + CHARACTER SIDE, TRANS, VECT + + INTEGER INFO, K, LDA, LDC, LWORK, M, N + + DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( + * ) + +PURPOSE + If VECT = 'Q', DORMBR overwrites the general real M-by-N matrix C with + SIDE = 'L' SIDE = 'R' TRANS = 'N': Q * C + C * Q TRANS = 'T': Q**T * C C * Q**T + + If VECT = 'P', DORMBR overwrites the general real M-by-N matrix C with + SIDE = 'L' SIDE = 'R' + TRANS = 'N': P * C C * P + TRANS = 'T': P**T * C C * P**T + + Here Q and P**T are the orthogonal matrices determined by DGEBRD when + reducing a real matrix A to bidiagonal form: A = Q * B * P**T. Q and + P**T are defined as products of elementary reflectors H(i) and G(i) + respectively. + + Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the order + of the orthogonal matrix Q or P**T that is applied. + + If VECT = 'Q', A is assumed to have been an NQ-by-K matrix: if nq >= k, + Q = H(1) H(2) . . . H(k); + if nq < k, Q = H(1) H(2) . . . H(nq-1). + + If VECT = 'P', A is assumed to have been a K-by-NQ matrix: if k < nq, P + = G(1) G(2) . . . G(k); + if k >= nq, P = G(1) G(2) . . . G(nq-1). + + +ARGUMENTS + VECT (input) CHARACTER*1 + = 'Q': apply Q or Q**T; + = 'P': apply P or P**T. + + SIDE (input) CHARACTER*1 + = 'L': apply Q, Q**T, P or P**T from the Left; + = 'R': apply Q, Q**T, P or P**T from the Right. + + TRANS (input) CHARACTER*1 + = 'N': No transpose, apply Q or P; + = 'T': Transpose, apply Q**T or P**T. + + M (input) INTEGER + The number of rows of the matrix C. M >= 0. + + N (input) INTEGER + The number of columns of the matrix C. N >= 0. + + K (input) INTEGER + If VECT = 'Q', the number of columns in the original matrix + reduced by DGEBRD. If VECT = 'P', the number of rows in the + original matrix reduced by DGEBRD. K >= 0. + + A (input) DOUBLE PRECISION array, dimension + (LDA,min(nq,K)) if VECT = 'Q' (LDA,nq) if VECT = 'P' The + vectors which define the elementary reflectors H(i) and G(i), + whose products determine the matrices Q and P, as returned by + DGEBRD. + + LDA (input) INTEGER + The leading dimension of the array A. If VECT = 'Q', LDA >= + max(1,nq); if VECT = 'P', LDA >= max(1,min(nq,K)). + + TAU (input) DOUBLE PRECISION array, dimension (min(nq,K)) + TAU(i) must contain the scalar factor of the elementary reflec- + tor H(i) or G(i) which determines Q or P, as returned by DGEBRD + in the array argument TAUQ or TAUP. + + C (input/output) DOUBLE PRECISION array, dimension (LDC,N) + On entry, the M-by-N matrix C. On exit, C is overwritten by + Q*C or Q**T*C or C*Q**T or C*Q or P*C or P**T*C or C*P or + C*P**T. + + LDC (input) INTEGER + The leading dimension of the array C. LDC >= max(1,M). + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The dimension of the array WORK. If SIDE = 'L', LWORK >= + max(1,N); if SIDE = 'R', LWORK >= max(1,M). For optimum per- + formance LWORK >= N*NB if SIDE = 'L', and LWORK >= M*NB if SIDE + = 'R', where NB is the optimal blocksize. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +@ + <>= (defun dormbr (vect side trans m n k a lda tau c ldc work lwork info) (declare (type (array double-float (*)) work c tau a) (type fixnum info lwork ldc lda k n m) - (type (simple-array character (*)) trans side vect)) + (type character trans side vect)) (f2cl-lib:with-multi-array-data ((vect character vect-%data% vect-%offset%) (side character side-%data% side-%offset%) @@ -55939,9 +69867,9 @@ p (cond (type (simple-array character (1)) transt) (type fixnum nw nq ni nb mi lwkopt iinfo i2 i1)) (setf info 0) - (setf applyq (lsame vect "Q")) - (setf left (lsame side "L")) - (setf notran (lsame trans "N")) + (setf applyq (char-equal vect #\Q)) + (setf left (char-equal side #\L)) + (setf notran (char-equal trans #\N)) (setf lquery (coerce (= lwork -1) '(member t nil))) (cond (left @@ -55951,11 +69879,11 @@ p (cond (setf nq n) (setf nw m))) (cond - ((and (not applyq) (not (lsame vect "P"))) + ((and (not applyq) (not (char-equal vect #\P))) (setf info -1)) - ((and (not left) (not (lsame side "R"))) + ((and (not left) (not (char-equal side #\R))) (setf info -2)) - ((and (not notran) (not (lsame trans "T"))) + ((and (not notran) (not (char-equal trans #\T))) (setf info -3)) ((< m 0) (setf info -4)) @@ -56011,7 +69939,9 @@ p (cond (coerce (the fixnum lwkopt) 'double-float)))) (cond ((/= info 0) - (xerbla "DORMBR" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DORMBR" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -56096,40 +70026,118 @@ p (cond (return (values nil nil nil nil nil nil nil nil nil nil nil nil nil info))))) -;(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::dormbr -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dormlq fortran-to-lisp::dormqr -; fortran-to-lisp::xerbla fortran-to-lisp::ilaenv -; fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dorml2 LAPACK} %\pagehead{dorml2}{dorml2} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dorml2.output +)spool dorml2.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dorml2 examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DORML2 - the general real m by n matrix C with Q * C if SIDE = 'L' + and TRANS = 'N', or Q'* C if SIDE = 'L' and TRANS = 'T', or C * Q + if SIDE = 'R' and TRANS = 'N', or C * Q' if SIDE = 'R' and TRANS = + 'T', + +SYNOPSIS + SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + INFO ) + + CHARACTER SIDE, TRANS + + INTEGER INFO, K, LDA, LDC, M, N + + DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( + * ) + +PURPOSE + DORML2 overwrites the general real m by n matrix C with + + where Q is a real orthogonal matrix defined as the product of k elemen- + tary reflectors + + Q = H(k) . . . H(2) H(1) + + as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n if + SIDE = 'R'. + + +ARGUMENTS + SIDE (input) CHARACTER*1 + = 'L': apply Q or Q' from the Left + = 'R': apply Q or Q' from the Right + + TRANS (input) CHARACTER*1 + = 'N': apply Q (No transpose) + = 'T': apply Q' (Transpose) + + M (input) INTEGER + The number of rows of the matrix C. M >= 0. + + N (input) INTEGER + The number of columns of the matrix C. N >= 0. + + K (input) INTEGER + The number of elementary reflectors whose product defines the + matrix Q. If SIDE = 'L', M >= K >= 0; if SIDE = 'R', N >= K >= + 0. + + A (input) DOUBLE PRECISION array, dimension + (LDA,M) if SIDE = 'L', (LDA,N) if SIDE = 'R' The i-th row must + contain the vector which defines the elementary reflector H(i), + for i = 1,2,...,k, as returned by DGELQF in the first k rows of + its array argument A. A is modified by the routine but + restored on exit. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,K). + + TAU (input) DOUBLE PRECISION array, dimension (K) + TAU(i) must contain the scalar factor of the elementary reflec- + tor H(i), as returned by DGELQF. + + C (input/output) DOUBLE PRECISION array, dimension (LDC,N) + On entry, the m by n matrix C. On exit, C is overwritten by + Q*C or Q'*C or C*Q' or C*Q. + + LDC (input) INTEGER + The leading dimension of the array C. LDC >= max(1,M). + + WORK (workspace) DOUBLE PRECISION array, dimension + (N) if SIDE = 'L', (M) if SIDE = 'R' + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +@ + <>= (let* ((one 1.0)) (declare (type (double-float 1.0 1.0) one)) (defun dorml2 (side trans m n k a lda tau c ldc work info) (declare (type (array double-float (*)) work c tau a) (type fixnum info ldc lda k n m) - (type (simple-array character (*)) trans side)) + (type character trans side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (trans character trans-%data% trans-%offset%) @@ -56143,17 +70151,17 @@ p (cond (type fixnum i i1 i2 i3 ic jc mi ni nq) (type (member t nil) left notran)) (setf info 0) - (setf left (lsame side "L")) - (setf notran (lsame trans "N")) + (setf left (char-equal side #\L)) + (setf notran (char-equal trans #\N)) (cond (left (setf nq m)) (t (setf nq n))) (cond - ((and (not left) (not (lsame side "R"))) + ((and (not left) (not (char-equal side #\R))) (setf info -1)) - ((and (not notran) (not (lsame trans "T"))) + ((and (not notran) (not (char-equal trans #\T))) (setf info -2)) ((< m 0) (setf info -3)) @@ -56167,7 +70175,9 @@ p (cond (setf info -10))) (cond ((/= info 0) - (xerbla "DORML2" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DORML2" (f2cl-lib:int-sub info)) (go end_label))) (if (or (= m 0) (= n 0) (= k 0)) (go end_label)) (cond @@ -56210,30 +70220,122 @@ p (cond end_label (return (values nil nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dorml2 -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarf fortran-to-lisp::xerbla -; fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dormlq LAPACK} %\pagehead{dormlq}{dormlq} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dormlq.output +)spool dormlq.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dormlq examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DORMLQ - the general real M-by-N matrix C with SIDE = 'L' SIDE = 'R' + TRANS = 'N' + +SYNOPSIS + SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + LWORK, INFO ) + + CHARACTER SIDE, TRANS + + INTEGER INFO, K, LDA, LDC, LWORK, M, N + + DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( + * ) + +PURPOSE + DORMLQ overwrites the general real M-by-N matrix C with TRANS = 'T': + Q**T * C C * Q**T + + where Q is a real orthogonal matrix defined as the product of k elemen- + tary reflectors + + Q = H(k) . . . H(2) H(1) + + as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N if + SIDE = 'R'. + + +ARGUMENTS + SIDE (input) CHARACTER*1 + = 'L': apply Q or Q**T from the Left; + = 'R': apply Q or Q**T from the Right. + + TRANS (input) CHARACTER*1 + = 'N': No transpose, apply Q; + = 'T': Transpose, apply Q**T. + + M (input) INTEGER + The number of rows of the matrix C. M >= 0. + + N (input) INTEGER + The number of columns of the matrix C. N >= 0. + + K (input) INTEGER + The number of elementary reflectors whose product defines the + matrix Q. If SIDE = 'L', M >= K >= 0; if SIDE = 'R', N >= K >= + 0. + + A (input) DOUBLE PRECISION array, dimension + (LDA,M) if SIDE = 'L', (LDA,N) if SIDE = 'R' The i-th row must + contain the vector which defines the elementary reflector H(i), + for i = 1,2,...,k, as returned by DGELQF in the first k rows of + its array argument A. A is modified by the routine but + restored on exit. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(1,K). + + TAU (input) DOUBLE PRECISION array, dimension (K) + TAU(i) must contain the scalar factor of the elementary reflec- + tor H(i), as returned by DGELQF. + + C (input/output) DOUBLE PRECISION array, dimension (LDC,N) + On entry, the M-by-N matrix C. On exit, C is overwritten by + Q*C or Q**T*C or C*Q**T or C*Q. + + LDC (input) INTEGER + The leading dimension of the array C. LDC >= max(1,M). + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The dimension of the array WORK. If SIDE = 'L', LWORK >= + max(1,N); if SIDE = 'R', LWORK >= max(1,M). For optimum per- + formance LWORK >= N*NB if SIDE = 'L', and LWORK >= M*NB if SIDE + = 'R', where NB is the optimal blocksize. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +@ + <>= (let* ((nbmax 64) (ldt (+ nbmax 1))) (declare (type (fixnum 64 64) nbmax) @@ -56241,7 +70343,7 @@ p (cond (defun dormlq (side trans m n k a lda tau c ldc work lwork info) (declare (type (array double-float (*)) work c tau a) (type fixnum info lwork ldc lda k n m) - (type (simple-array character (*)) trans side)) + (type character trans side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (trans character trans-%data% trans-%offset%) @@ -56263,8 +70365,8 @@ p (cond (type (simple-array character (1)) transt) (type (member t nil) left lquery notran)) (setf info 0) - (setf left (lsame side "L")) - (setf notran (lsame trans "N")) + (setf left (char-equal side #\L)) + (setf notran (char-equal trans #\N)) (setf lquery (coerce (= lwork -1) '(member t nil))) (cond (left @@ -56274,9 +70376,9 @@ p (cond (setf nq n) (setf nw m))) (cond - ((and (not left) (not (lsame side "R"))) + ((and (not left) (not (char-equal side #\R))) (setf info -1)) - ((and (not notran) (not (lsame trans "T"))) + ((and (not notran) (not (char-equal trans #\T))) (setf info -2)) ((< m 0) (setf info -3)) @@ -56308,7 +70410,9 @@ p (cond (coerce (the fixnum lwkopt) 'double-float)))) (cond ((/= info 0) - (xerbla "DORMLQ" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DORMLQ" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -56394,32 +70498,122 @@ p (cond (return (values nil nil nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dormlq -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarfb fortran-to-lisp::dlarft -; fortran-to-lisp::dorml2 fortran-to-lisp::xerbla -; fortran-to-lisp::ilaenv fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dormqr LAPACK} %\pagehead{dormqr}{dormqr} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dormqr.output +)spool dormqr.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dormqr examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DORMQR - the general real M-by-N matrix C with SIDE = 'L' SIDE = 'R' + TRANS = 'N' + +SYNOPSIS + SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, + LWORK, INFO ) + + CHARACTER SIDE, TRANS + + INTEGER INFO, K, LDA, LDC, LWORK, M, N + + DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( + * ) + +PURPOSE + DORMQR overwrites the general real M-by-N matrix C with TRANS = 'T': + Q**T * C C * Q**T + + where Q is a real orthogonal matrix defined as the product of k elemen- + tary reflectors + + Q = H(1) H(2) . . . H(k) + + as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N if + SIDE = 'R'. + + +ARGUMENTS + SIDE (input) CHARACTER*1 + = 'L': apply Q or Q**T from the Left; + = 'R': apply Q or Q**T from the Right. + + TRANS (input) CHARACTER*1 + = 'N': No transpose, apply Q; + = 'T': Transpose, apply Q**T. + + M (input) INTEGER + The number of rows of the matrix C. M >= 0. + + N (input) INTEGER + The number of columns of the matrix C. N >= 0. + + K (input) INTEGER + The number of elementary reflectors whose product defines the + matrix Q. If SIDE = 'L', M >= K >= 0; if SIDE = 'R', N >= K >= + 0. + + A (input) DOUBLE PRECISION array, dimension (LDA,K) + The i-th column must contain the vector which defines the ele- + mentary reflector H(i), for i = 1,2,...,k, as returned by DGE- + QRF in the first k columns of its array argument A. A is modi- + fied by the routine but restored on exit. + + LDA (input) INTEGER + The leading dimension of the array A. If SIDE = 'L', LDA >= + max(1,M); if SIDE = 'R', LDA >= max(1,N). + + TAU (input) DOUBLE PRECISION array, dimension (K) + TAU(i) must contain the scalar factor of the elementary reflec- + tor H(i), as returned by DGEQRF. + + C (input/output) DOUBLE PRECISION array, dimension (LDC,N) + On entry, the M-by-N matrix C. On exit, C is overwritten by + Q*C or Q**T*C or C*Q**T or C*Q. + + LDC (input) INTEGER + The leading dimension of the array C. LDC >= max(1,M). + + WORK (workspace/output) DOUBLE PRECISION array, dimension + (MAX(1,LWORK)) + On exit, if INFO = 0, WORK(1) returns the optimal LWORK. + + LWORK (input) INTEGER + The dimension of the array WORK. If SIDE = 'L', LWORK >= + max(1,N); if SIDE = 'R', LWORK >= max(1,M). For optimum per- + formance LWORK >= N*NB if SIDE = 'L', and LWORK >= M*NB if SIDE + = 'R', where NB is the optimal blocksize. + + If LWORK = -1, then a workspace query is assumed; the routine + only calculates the optimal size of the WORK array, returns + this value as the first entry of the WORK array, and no error + message related to LWORK is issued by XERBLA. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +@ + <>= (let* ((nbmax 64) (ldt (+ nbmax 1))) (declare (type (fixnum 64 64) nbmax) @@ -56427,7 +70621,7 @@ p (cond (defun dormqr (side trans m n k a lda tau c ldc work lwork info) (declare (type (array double-float (*)) work c tau a) (type fixnum info lwork ldc lda k n m) - (type (simple-array character (*)) trans side)) + (type character trans side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (trans character trans-%data% trans-%offset%) @@ -56446,8 +70640,8 @@ p (cond lwkopt mi nb nbmin ni nq nw) (type (member t nil) left lquery notran)) (setf info 0) - (setf left (lsame side "L")) - (setf notran (lsame trans "N")) + (setf left (char-equal side #\L)) + (setf notran (char-equal trans #\N)) (setf lquery (coerce (= lwork -1) '(member t nil))) (cond (left @@ -56457,9 +70651,9 @@ p (cond (setf nq n) (setf nw m))) (cond - ((and (not left) (not (lsame side "R"))) + ((and (not left) (not (char-equal side #\R))) (setf info -1)) - ((and (not notran) (not (lsame trans "T"))) + ((and (not notran) (not (char-equal trans #\T))) (setf info -2)) ((< m 0) (setf info -3)) @@ -56491,7 +70685,9 @@ p (cond (coerce (the fixnum lwkopt) 'double-float)))) (cond ((/= info 0) - (xerbla "DORMQR" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DORMQR" (f2cl-lib:int-sub info)) (go end_label)) (lquery (go end_label))) @@ -56572,32 +70768,163 @@ p (cond (return (values nil nil nil nil nil nil nil nil nil nil nil nil info)))))) -;(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::dormqr -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; (array double-float (*)) fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlarfb fortran-to-lisp::dlarft -; fortran-to-lisp::dorm2r fortran-to-lisp::xerbla -; fortran-to-lisp::ilaenv fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dtrevc LAPACK} %\pagehead{dtrevc}{dtrevc} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dtrevc.output +)spool dtrevc.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dtrevc examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DTREVC - some or all of the right and/or left eigenvectors of a real + upper quasi-triangular matrix T + +SYNOPSIS + SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, + MM, M, WORK, INFO ) + + CHARACTER HOWMNY, SIDE + + INTEGER INFO, LDT, LDVL, LDVR, M, MM, N + + LOGICAL SELECT( * ) + + DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), + WORK( * ) + +PURPOSE + DTREVC computes some or all of the right and/or left eigenvectors of a + real upper quasi-triangular matrix T. Matrices of this type are pro- + duced by the Schur factorization of a real general matrix: A = + Q*T*Q**T, as computed by DHSEQR. + + The right eigenvector x and the left eigenvector y of T corresponding + to an eigenvalue w are defined by: + + T*x = w*x, (y**H)*T = w*(y**H) + + where y**H denotes the conjugate transpose of y. + The eigenvalues are not input to this routine, but are read directly + from the diagonal blocks of T. + + This routine returns the matrices X and/or Y of right and left eigen- + vectors of T, or the products Q*X and/or Q*Y, where Q is an input + matrix. If Q is the orthogonal factor that reduces a matrix A to Schur + form T, then Q*X and Q*Y are the matrices of right and left eigenvec- + tors of A. + + +ARGUMENTS + SIDE (input) CHARACTER*1 + = 'R': compute right eigenvectors only; + = 'L': compute left eigenvectors only; + = 'B': compute both right and left eigenvectors. + + HOWMNY (input) CHARACTER*1 + = 'A': compute all right and/or left eigenvectors; + = 'B': compute all right and/or left eigenvectors, backtrans- + formed by the matrices in VR and/or VL; = 'S': compute + selected right and/or left eigenvectors, as indicated by the + logical array SELECT. + + SELECT (input/output) LOGICAL array, dimension (N) + If HOWMNY = 'S', SELECT specifies the eigenvectors to be com- + puted. If w(j) is a real eigenvalue, the corresponding real + eigenvector is computed if SELECT(j) is .TRUE.. If w(j) and + w(j+1) are the real and imaginary parts of a complex eigen- + value, the corresponding complex eigenvector is computed if + either SELECT(j) or SELECT(j+1) is .TRUE., and on exit + SELECT(j) is set to .TRUE. and SELECT(j+1) is set to Not refer- + enced if HOWMNY = 'A' or 'B'. + + N (input) INTEGER + The order of the matrix T. N >= 0. + + T (input) DOUBLE PRECISION array, dimension (LDT,N) + The upper quasi-triangular matrix T in Schur canonical form. + + LDT (input) INTEGER + The leading dimension of the array T. LDT >= max(1,N). + + VL (input/output) DOUBLE PRECISION array, dimension (LDVL,MM) + On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must con- + tain an N-by-N matrix Q (usually the orthogonal matrix Q of + Schur vectors returned by DHSEQR). On exit, if SIDE = 'L' or + 'B', VL contains: if HOWMNY = 'A', the matrix Y of left eigen- + vectors of T; if HOWMNY = 'B', the matrix Q*Y; if HOWMNY = 'S', + the left eigenvectors of T specified by SELECT, stored consecu- + tively in the columns of VL, in the same order as their eigen- + values. A complex eigenvector corresponding to a complex + eigenvalue is stored in two consecutive columns, the first + holding the real part, and the second the imaginary part. Not + referenced if SIDE = 'R'. + + LDVL (input) INTEGER + The leading dimension of the array VL. LDVL >= 1, and if SIDE + = 'L' or 'B', LDVL >= N. + + VR (input/output) DOUBLE PRECISION array, dimension (LDVR,MM) + On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must con- + tain an N-by-N matrix Q (usually the orthogonal matrix Q of + Schur vectors returned by DHSEQR). On exit, if SIDE = 'R' or + 'B', VR contains: if HOWMNY = 'A', the matrix X of right eigen- + vectors of T; if HOWMNY = 'B', the matrix Q*X; if HOWMNY = 'S', + the right eigenvectors of T specified by SELECT, stored consec- + utively in the columns of VR, in the same order as their eigen- + values. A complex eigenvector corresponding to a complex + eigenvalue is stored in two consecutive columns, the first + holding the real part and the second the imaginary part. Not + referenced if SIDE = 'L'. + + LDVR (input) INTEGER + The leading dimension of the array VR. LDVR >= 1, and if SIDE + = 'R' or 'B', LDVR >= N. + + MM (input) INTEGER + The number of columns in the arrays VL and/or VR. MM >= M. + + M (output) INTEGER + The number of columns in the arrays VL and/or VR actually used + to store the eigenvectors. If HOWMNY = 'A' or 'B', M is set to + N. Each selected real eigenvector occupies one column and each + selected complex eigenvector occupies two columns. + + WORK (workspace) DOUBLE PRECISION array, dimension (3*N) + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +FURTHER DETAILS + The algorithm used in this program is basically backward (forward) sub- + stitution, with scaling to make the the code robust against possible + overflow. + + Each eigenvector is normalized so that the element of largest magnitude + has magnitude 1; here the magnitude of a complex number (x,y) is taken + to be |x| + |y|. + +@ + <>= (let* ((zero 0.0) (one 1.0)) (declare (type (double-float 0.0 0.0) zero) @@ -56606,7 +70933,7 @@ p (cond (declare (type (array double-float (*)) work vr vl t$) (type fixnum info m mm ldvr ldvl ldt n) (type (array (member t nil) (*)) select) - (type (simple-array character (*)) howmny side)) + (type character howmny side)) (f2cl-lib:with-multi-array-data ((side character side-%data% side-%offset%) (howmny character howmny-%data% howmny-%offset%) @@ -56631,12 +70958,12 @@ p (cond n2) (type (member t nil) allv bothv leftv over pair rightv somev)) - (setf bothv (lsame side "B")) - (setf rightv (or (lsame side "R") bothv)) - (setf leftv (or (lsame side "L") bothv)) - (setf allv (lsame howmny "A")) - (setf over (lsame howmny "B")) - (setf somev (lsame howmny "S")) + (setf bothv (char-equal side #\B)) + (setf rightv (or (char-equal side #\R) bothv)) + (setf leftv (or (char-equal side #\L) bothv)) + (setf allv (char-equal howmny #\A)) + (setf over (char-equal howmny #\B)) + (setf somev (char-equal howmny #\S)) (setf info 0) (cond ((and (not rightv) (not leftv)) @@ -56709,7 +71036,9 @@ p (cond (setf info -11))))) (cond ((/= info 0) - (xerbla "DTREVC" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DTREVC" (f2cl-lib:int-sub info)) (go end_label))) (if (= n 0) (go end_label)) (setf unfl (dlamch "Safe minimum")) @@ -58542,43 +72871,114 @@ p (cond (return (values nil nil nil nil nil nil nil nil nil nil nil m nil info)))))) -;(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::dtrevc -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (array (member t nil) (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::m nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::ddot fortran-to-lisp::dgemv -; fortran-to-lisp::idamax fortran-to-lisp::dcopy -; fortran-to-lisp::daxpy fortran-to-lisp::dscal -; fortran-to-lisp::dlaln2 fortran-to-lisp::dlabad -; fortran-to-lisp::dlamch fortran-to-lisp::xerbla -; fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dtrexc LAPACK} %\pagehead{dtrexc}{dtrexc} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dtrexc.output +)spool dtrexc.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dtrexc examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DTREXC - the real Schur factorization of a real matrix A = Q*T*Q**T, so + that the diagonal block of T with row index IFST is moved to row ILST + +SYNOPSIS + SUBROUTINE DTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, WORK, INFO ) + + CHARACTER COMPQ + + INTEGER IFST, ILST, INFO, LDQ, LDT, N + + DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * ) + +PURPOSE + DTREXC reorders the real Schur factorization of a real matrix A = + Q*T*Q**T, so that the diagonal block of T with row index IFST is moved + to row ILST. + + The real Schur form T is reordered by an orthogonal similarity trans- + formation Z**T*T*Z, and optionally the matrix Q of Schur vectors is + updated by postmultiplying it with Z. + + T must be in Schur canonical form (as returned by DHSEQR), that is, + block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each + 2-by-2 diagonal block has its diagonal elements equal and its off-diag- + onal elements of opposite sign. + + +ARGUMENTS + COMPQ (input) CHARACTER*1 + = 'V': update the matrix Q of Schur vectors; + = 'N': do not update Q. + + N (input) INTEGER + The order of the matrix T. N >= 0. + + T (input/output) DOUBLE PRECISION array, dimension (LDT,N) + On entry, the upper quasi-triangular matrix T, in Schur Schur + canonical form. On exit, the reordered upper quasi-triangular + matrix, again in Schur canonical form. + + LDT (input) INTEGER + The leading dimension of the array T. LDT >= max(1,N). + + Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N) + On entry, if COMPQ = 'V', the matrix Q of Schur vectors. On + exit, if COMPQ = 'V', Q has been postmultiplied by the orthogo- + nal transformation matrix Z which reorders T. If COMPQ = 'N', + Q is not referenced. + + LDQ (input) INTEGER + The leading dimension of the array Q. LDQ >= max(1,N). + + IFST (input/output) INTEGER + ILST (input/output) INTEGER Specify the reordering of the + diagonal blocks of T. The block with row index IFST is moved + to row ILST, by a sequence of transpositions between adjacent + blocks. On exit, if IFST pointed on entry to the second row of + a 2-by-2 block, it is changed to point to the first row; ILST + always points to the first row of the block in its final posi- + tion (which may differ from its input value by +1 or -1). 1 <= + IFST <= N; 1 <= ILST <= N. + + WORK (workspace) DOUBLE PRECISION array, dimension (N) + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + = 1: two adjacent blocks were too close to swap (the problem + is very ill-conditioned); T may have been partially reordered, + and ILST points to the first row of the current position of the + block being moved. + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) (defun dtrexc (compq n t$ ldt q ldq ifst ilst work info) (declare (type (array double-float (*)) work q t$) (type fixnum info ilst ifst ldq ldt n) - (type (simple-array character (*)) compq)) + (type character compq)) (f2cl-lib:with-multi-array-data ((compq character compq-%data% compq-%offset%) (t$ double-float t$-%data% t$-%offset%) @@ -58588,9 +72988,9 @@ p (cond (declare (type fixnum here nbf nbl nbnext) (type (member t nil) wantq)) (setf info 0) - (setf wantq (lsame compq "V")) + (setf wantq (char-equal compq #\V)) (cond - ((and (not wantq) (not (lsame compq "N"))) + ((and (not wantq) (not (char-equal compq #\N))) (setf info -1)) ((< n 0) (setf info -2)) @@ -58608,7 +73008,9 @@ p (cond (setf info -8))) (cond ((/= info 0) - (xerbla "DTREXC" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DTREXC" (f2cl-lib:int-sub info)) (go end_label))) (if (<= n 1) (go end_label)) (cond @@ -58898,29 +73300,198 @@ p (cond end_label (return (values nil nil nil nil nil nil ifst ilst nil info)))))) -;(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::dtrexc -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum fixnum -; fixnum (array double-float (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil fortran-to-lisp::ifst -; fortran-to-lisp::ilst nil fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlaexc fortran-to-lisp::xerbla -; fortran-to-lisp::lsame)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{dtrsna LAPACK} %\pagehead{dtrsna}{dtrsna} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f dtrsna.output +)spool dtrsna.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +dtrsna examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + DTRSNA - reciprocal condition numbers for specified eigenvalues and/or + right eigenvectors of a real upper quasi-triangular matrix T (or of any + matrix Q*T*Q**T with Q orthogonal) + +SYNOPSIS + SUBROUTINE DTRSNA( JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, + S, SEP, MM, M, WORK, LDWORK, IWORK, INFO ) + + CHARACTER HOWMNY, JOB + + INTEGER INFO, LDT, LDVL, LDVR, LDWORK, M, MM, N + + LOGICAL SELECT( * ) + + INTEGER IWORK( * ) + + DOUBLE PRECISION S( * ), SEP( * ), T( LDT, * ), VL( LDVL, * + ), VR( LDVR, * ), WORK( LDWORK, * ) + +PURPOSE + DTRSNA estimates reciprocal condition numbers for specified eigenvalues + and/or right eigenvectors of a real upper quasi-triangular matrix T (or + of any matrix Q*T*Q**T with Q orthogonal). + + T must be in Schur canonical form (as returned by DHSEQR), that is, + block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; each + 2-by-2 diagonal block has its diagonal elements equal and its off-diag- + onal elements of opposite sign. + + +ARGUMENTS + JOB (input) CHARACTER*1 + Specifies whether condition numbers are required for eigenval- + ues (S) or eigenvectors (SEP): + = 'E': for eigenvalues only (S); + = 'V': for eigenvectors only (SEP); + = 'B': for both eigenvalues and eigenvectors (S and SEP). + + HOWMNY (input) CHARACTER*1 + = 'A': compute condition numbers for all eigenpairs; + = 'S': compute condition numbers for selected eigenpairs speci- + fied by the array SELECT. + + SELECT (input) LOGICAL array, dimension (N) + If HOWMNY = 'S', SELECT specifies the eigenpairs for which con- + dition numbers are required. To select condition numbers for + the eigenpair corresponding to a real eigenvalue w(j), + SELECT(j) must be set to .TRUE.. To select condition numbers + corresponding to a complex conjugate pair of eigenvalues w(j) + and w(j+1), either SELECT(j) or SELECT(j+1) or both, must be + set to .TRUE.. If HOWMNY = 'A', SELECT is not referenced. + + N (input) INTEGER + The order of the matrix T. N >= 0. + + T (input) DOUBLE PRECISION array, dimension (LDT,N) + The upper quasi-triangular matrix T, in Schur canonical form. + + LDT (input) INTEGER + The leading dimension of the array T. LDT >= max(1,N). + + VL (input) DOUBLE PRECISION array, dimension (LDVL,M) + If JOB = 'E' or 'B', VL must contain left eigenvectors of T (or + of any Q*T*Q**T with Q orthogonal), corresponding to the eigen- + pairs specified by HOWMNY and SELECT. The eigenvectors must be + stored in consecutive columns of VL, as returned by DHSEIN or + DTREVC. If JOB = 'V', VL is not referenced. + + LDVL (input) INTEGER + The leading dimension of the array VL. LDVL >= 1; and if JOB = + 'E' or 'B', LDVL >= N. + + VR (input) DOUBLE PRECISION array, dimension (LDVR,M) + If JOB = 'E' or 'B', VR must contain right eigenvectors of T + (or of any Q*T*Q**T with Q orthogonal), corresponding to the + eigenpairs specified by HOWMNY and SELECT. The eigenvectors + must be stored in consecutive columns of VR, as returned by + DHSEIN or DTREVC. If JOB = 'V', VR is not referenced. + + LDVR (input) INTEGER + The leading dimension of the array VR. LDVR >= 1; and if JOB = + 'E' or 'B', LDVR >= N. + + S (output) DOUBLE PRECISION array, dimension (MM) + If JOB = 'E' or 'B', the reciprocal condition numbers of the + selected eigenvalues, stored in consecutive elements of the + array. For a complex conjugate pair of eigenvalues two consecu- + tive elements of S are set to the same value. Thus S(j), + SEP(j), and the j-th columns of VL and VR all correspond to the + same eigenpair (but not in general the j-th eigenpair, unless + all eigenpairs are selected). If JOB = 'V', S is not refer- + enced. + + SEP (output) DOUBLE PRECISION array, dimension (MM) + If JOB = 'V' or 'B', the estimated reciprocal condition numbers + of the selected eigenvectors, stored in consecutive elements of + the array. For a complex eigenvector two consecutive elements + of SEP are set to the same value. If the eigenvalues cannot be + reordered to compute SEP(j), SEP(j) is set to 0; this can only + occur when the true value would be very small anyway. If JOB = + 'E', SEP is not referenced. + + MM (input) INTEGER + The number of elements in the arrays S (if JOB = 'E' or 'B') + and/or SEP (if JOB = 'V' or 'B'). MM >= M. + + M (output) INTEGER + The number of elements of the arrays S and/or SEP actually used + to store the estimated condition numbers. If HOWMNY = 'A', M + is set to N. + + WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,N+6) + If JOB = 'E', WORK is not referenced. + + LDWORK (input) INTEGER + The leading dimension of the array WORK. LDWORK >= 1; and if + JOB = 'V' or 'B', LDWORK >= N. + + IWORK (workspace) INTEGER array, dimension (2*(N-1)) + If JOB = 'E', IWORK is not referenced. + + INFO (output) INTEGER + = 0: successful exit + < 0: if INFO = -i, the i-th argument had an illegal value + +FURTHER DETAILS + The reciprocal of the condition number of an eigenvalue lambda is + defined as + + S(lambda) = |v'*u| / (norm(u)*norm(v)) + + where u and v are the right and left eigenvectors of T corresponding to + lambda; v' denotes the conjugate-transpose of v, and norm(u) denotes + the Euclidean norm. These reciprocal condition numbers always lie + between zero (very badly conditioned) and one (very well conditioned). + If n = 1, S(lambda) is defined to be 1. + + An approximate error bound for a computed eigenvalue W(i) is given by + + EPS * norm(T) / S(i) + + where EPS is the machine precision. + + The reciprocal of the condition number of the right eigenvector u cor- + responding to lambda is defined as follows. Suppose + + T = ( lambda c ) + ( 0 T22 ) + + Then the reciprocal condition number is + + SEP( lambda, T22 ) = sigma-min( T22 - lambda*I ) + + where sigma-min denotes the smallest singular value. We approximate the + smallest singular value by the reciprocal of an estimate of the one- + norm of the inverse of T22 - lambda*I. If n = 1, SEP(1) is defined to + be abs(T(1,1)). + + An approximate error bound for a computed right eigenvector VR(i) is + given by + + EPS * norm(T) / SEP(i) + +@ + <>= (let* ((zero 0.0) (one 1.0) (two 2.0)) (declare (type (double-float 0.0 0.0) zero) @@ -58933,7 +73504,7 @@ p (cond (type (array double-float (*)) work sep s vr vl t$) (type fixnum info ldwork m mm ldvr ldvl ldt n) (type (array (member t nil) (*)) select) - (type (simple-array character (*)) howmny job)) + (type character howmny job)) (f2cl-lib:with-multi-array-data ((job character job-%data% job-%offset%) (howmny character howmny-%data% howmny-%offset%) @@ -58957,15 +73528,15 @@ p (cond mu prod prod1 prod2 rnrm scale smlnum sn) (type fixnum i ierr ifst ilst j k kase ks n2 nn) (type (member t nil) pair somcon wantbh wants wantsp)) - (setf wantbh (lsame job "B")) - (setf wants (or (lsame job "E") wantbh)) - (setf wantsp (or (lsame job "V") wantbh)) - (setf somcon (lsame howmny "S")) + (setf wantbh (char-equal job #\B)) + (setf wants (or (char-equal job #\E) wantbh)) + (setf wantsp (or (char-equal job #\V) wantbh)) + (setf somcon (char-equal howmny #\S)) (setf info 0) (cond ((and (not wants) (not wantsp)) (setf info -1)) - ((and (not (lsame howmny "A")) (not somcon)) + ((and (not (char-equal howmny #\A)) (not somcon)) (setf info -2)) ((< n 0) (setf info -4)) @@ -59030,7 +73601,9 @@ p (cond (setf info -16))))) (cond ((/= info 0) - (xerbla "DTRSNA" (f2cl-lib:int-sub info)) + (error + " ** On entry to ~a parameter number ~a had an illegal value~%" + "DTRSNA" (f2cl-lib:int-sub info)) (go end_label))) (if (= n 0) (go end_label)) (cond @@ -59527,40 +74100,73 @@ p (cond nil info)))))) -;(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::dtrsna -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; (simple-array character (1)) -; (array (member t nil) (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; fixnum (array double-float (*)) -; (array double-float (*)) fixnum -; fixnum (array double-float (*)) -; fixnum -; (array fixnum (*)) -; fixnum) -; :return-values '(nil nil nil nil nil nil nil nil nil nil nil nil nil -; fortran-to-lisp::m nil nil nil -; fortran-to-lisp::info) -; :calls '(fortran-to-lisp::dlaqtr fortran-to-lisp::dlacon -; fortran-to-lisp::dtrexc fortran-to-lisp::dlacpy -; fortran-to-lisp::dlapy2 fortran-to-lisp::dnrm2 -; fortran-to-lisp::ddot fortran-to-lisp::dlabad -; fortran-to-lisp::dlamch fortran-to-lisp::xerbla -; fortran-to-lisp::lsame)))); - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ieeeck LAPACK} %\pagehead{ieeeck}{ieeeck} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ieeeck.output +)spool ieeeck.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ieeeck examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + IEEECK - called from the ILAENV to verify that Infinity and possibly + NaN arithmetic is safe (i.e + +SYNOPSIS + INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE ) + + INTEGER ISPEC + + REAL ONE, ZERO + +PURPOSE + IEEECK is called from the ILAENV to verify that Infinity and possibly + NaN arithmetic is safe (i.e. will not trap). + + +ARGUMENTS + ISPEC (input) INTEGER + Specifies whether to test just for inifinity arithmetic or + whether to test for infinity and NaN arithmetic. = 0: Verify + infinity arithmetic only. + = 1: Verify infinity and NaN arithmetic. + + ZERO (input) REAL + Must contain the value 0.0 This is passed to prevent the com- + piler from optimizing away this code. + + ONE (input) REAL + Must contain the value 1.0 This is passed to prevent the com- + piler from optimizing away this code. + + RETURN VALUE: INTEGER = 0: Arithmetic failed to produce the + correct answers + = 1: Arithmetic produced the correct answers + + + + Return if we were only asked to check infinity arithmetic + +@ + <>= (defun ieeeck (ispec zero one) (declare (type (single-float) one zero) (type fixnum ispec)) @@ -59645,26 +74251,129 @@ p (cond end_label (return (values ieeeck 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::ieeeck -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum (single-float) -; (single-float)) -; :return-values '(nil nil nil) -; :calls 'nil)));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ilaenv LAPACK} %\pagehead{ilaenv}{ilaenv} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f ilaenv.output +)spool ilaenv.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +ilaenv examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ILAENV - called from the LAPACK routines to choose problem-dependent + parameters for the local environment + +SYNOPSIS + INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) + + CHARACTER*( * ) NAME, OPTS + + INTEGER ISPEC, N1, N2, N3, N4 + +PURPOSE + ILAENV is called from the LAPACK routines to choose problem-dependent + parameters for the local environment. See ISPEC for a description of + the parameters. + + ILAENV returns an INTEGER + if ILAENV >= 0: ILAENV returns the value of the parameter specified by + ISPEC if ILAENV < 0: if ILAENV = -k, the k-th argument had an illegal + value. + + This version provides a set of parameters which should give good, but + not optimal, performance on many of the currently available computers. + Users are encouraged to modify this subroutine to set the tuning param- + eters for their particular machine using the option and problem size + information in the arguments. + + This routine will not function correctly if it is converted to all + lower case. Converting it to all upper case is allowed. + + +ARGUMENTS + ISPEC (input) INTEGER + Specifies the parameter to be returned as the value of ILAENV. + = 1: the optimal blocksize; if this value is 1, an unblocked + algorithm will give the best performance. = 2: the minimum + block size for which the block routine should be used; if the + usable block size is less than this value, an unblocked routine + should be used. = 3: the crossover point (in a block routine, + for N less than this value, an unblocked routine should be + used) = 4: the number of shifts, used in the nonsymmetric + eigenvalue routines (DEPRECATED) = 5: the minimum column dimen- + sion for blocking to be used; rectangular blocks must have + dimension at least k by m, where k is given by ILAENV(2,...) + and m by ILAENV(5,...) = 6: the crossover point for the SVD + (when reducing an m by n matrix to bidiagonal form, if + max(m,n)/min(m,n) exceeds this value, a QR factorization is + used first to reduce the matrix to a triangular form.) = 7: + the number of processors + = 8: the crossover point for the multishift QR method for non- + symmetric eigenvalue problems (DEPRECATED) = 9: maximum size of + the subproblems at the bottom of the computation tree in the + divide-and-conquer algorithm (used by xGELSD and xGESDD) =10: + ieee NaN arithmetic can be trusted not to trap + =11: infinity arithmetic can be trusted not to trap + 12 <= ISPEC <= 16: xHSEQR or one of its subroutines, see IPARMQ + for detailed explanation + + NAME (input) CHARACTER*(*) + The name of the calling subroutine, in either upper case or + lower case. + + OPTS (input) CHARACTER*(*) + The character options to the subroutine NAME, concatenated into + a single character string. For example, UPLO = 'U', TRANS = + 'T', and DIAG = 'N' for a triangular routine would be specified + as OPTS = 'UTN'. + + N1 (input) INTEGER + N2 (input) INTEGER N3 (input) INTEGER N4 (input) + INTEGER Problem dimensions for the subroutine NAME; these may + not all be required. + +FURTHER DETAILS + The following conventions have been used when calling ILAENV from the + LAPACK routines: + 1) OPTS is a concatenation of all of the character options to + subroutine NAME, in the same order that they appear in the + argument list for NAME, even if they are not used in determining + the value of the parameter specified by ISPEC. + 2) The problem dimensions N1, N2, N3, N4 are specified in the order + that they appear in the argument list for NAME. N1 is used + first, N2 second, and so on, and unused problem dimensions are + passed a value of -1. + 3) The parameter value returned by ILAENV is checked for validity in + the calling subroutine. For example, ILAENV is used to retrieve + the optimal blocksize for STRTRI as follows: + + NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) + IF( NB.LE.1 ) NB = MAX( 1, N ) + + +@ + <>= (defun ilaenv (ispec name opts n1 n2 n3 n4) - (declare (type (simple-array character (*)) opts name) + (declare (type character opts name) (type fixnum n4 n3 n2 n1 ispec)) (f2cl-lib:with-multi-array-data ((name character name-%data% name-%offset%) @@ -60107,27 +74816,97 @@ p (cond end_label (return (values ilaenv 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::ilaenv -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; (simple-array character (*)) -; (simple-array character (*)) -; fixnum fixnum -; fixnum -; fixnum) -; :return-values '(nil nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::ieeeck))));; - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zlange LAPACK} %\pagehead{zlange}{zlange} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zlange.output +)spool zlange.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zlange examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ZLANGE - the value of the one norm, or the Frobenius norm, or the + infinity norm, or the element of largest absolute value of a complex + matrix A + +SYNOPSIS + DOUBLE PRECISION FUNCTION ZLANGE( NORM, M, N, A, LDA, WORK ) + + CHARACTER NORM + + INTEGER LDA, M, N + + DOUBLE PRECISION WORK( * ) + + COMPLEX*16 A( LDA, * ) + +PURPOSE + ZLANGE returns the value of the one norm, or the Frobenius norm, or + the infinity norm, or the element of largest absolute value of a + complex matrix A. + + +DESCRIPTION + ZLANGE returns the value + + ZLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm' + ( + ( norm1(A), NORM = '1', 'O' or 'o' + ( + ( normI(A), NORM = 'I' or 'i' + ( + ( normF(A), NORM = 'F', 'f', 'E' or 'e' + + where norm1 denotes the one norm of a matrix (maximum column sum), + normI denotes the infinity norm of a matrix (maximum row sum) and + normF denotes the Frobenius norm of a matrix (square root of sum of + squares). Note that max(abs(A(i,j))) is not a consistent matrix + norm. + + +ARGUMENTS + NORM (input) CHARACTER*1 + Specifies the value to be returned in ZLANGE as described + above. + + M (input) INTEGER + The number of rows of the matrix A. M >= 0. When M = 0, + ZLANGE is set to zero. + + N (input) INTEGER + The number of columns of the matrix A. N >= 0. When N = 0, + ZLANGE is set to zero. + + A (input) COMPLEX*16 array, dimension (LDA,N) + The m by n matrix A. + + LDA (input) INTEGER + The leading dimension of the array A. LDA >= max(M,1). + + WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)), + where LWORK >= M when NORM = 'I'; otherwise, WORK is not refer- + enced. + +@ + <>= (let* ((one 1.0) (zero 0.0)) (declare (type (double-float 1.0 1.0) one) @@ -60136,7 +74915,7 @@ p (cond (declare (type (array double-float (*)) work) (type (array (complex double-float) (*)) a) (type fixnum lda n m) - (type (simple-array character (*)) norm)) + (type character norm)) (f2cl-lib:with-multi-array-data ((norm character norm-%data% norm-%offset%) (a (complex double-float) a-%data% a-%offset%) @@ -60147,7 +74926,7 @@ p (cond (cond ((= (min (the fixnum m) (the fixnum n)) 0) (setf value zero)) - ((lsame norm "M") + ((char-equal norm #\M) (setf value zero) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) @@ -60162,7 +74941,7 @@ p (cond (i j) ((1 lda) (1 *)) a-%offset%))))))))) - ((or (lsame norm "O") (f2cl-lib:fstring-= norm "1")) + ((or (char-equal norm #\O) (f2cl-lib:fstring-= norm "1")) (setf value zero) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) ((> j n) nil) @@ -60179,7 +74958,7 @@ p (cond ((1 lda) (1 *)) a-%offset%)))))) (setf value (max value sum))))) - ((lsame norm "I") + ((char-equal norm #\I) (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) ((> i m) nil) (tagbody @@ -60212,7 +74991,7 @@ p (cond (i) ((1 *)) work-%offset%)))))) - ((or (lsame norm "F") (lsame norm "E")) + ((or (char-equal norm #\F) (char-equal norm #\E)) (setf scale zero) (setf sum one) (f2cl-lib:fdo (j 1 (f2cl-lib:int-add j 1)) @@ -60232,25 +75011,86 @@ p (cond (setf zlange value) (return (values zlange 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::zlange -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '((simple-array character (1)) -; fixnum fixnum -; (array (complex double-float) (*)) -; fixnum (array double-float (*))) -; :return-values '(nil nil nil nil nil nil) -; :calls '(fortran-to-lisp::lsame fortran-to-lisp::zlassq)))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{zlassq LAPACK} %\pagehead{zlassq}{zlassq} %\pagepic{ps/v104algebraicfunction.ps}{AF}{1.00} +<>= +)set break resume +)sys rm -f zlassq.output +)spool zlassq.output +)set message test on +)set message auto off +)clear all + +)spool +)lisp (bye) +@ +<>= +==================================================================== +zlassq examples +==================================================================== + +==================================================================== +Man Page Details +==================================================================== + +NAME + ZLASSQ - the values scl and ssq such that ( scl**2 )*ssq = x( 1 )**2 + +...+ x( n )**2 + ( scale**2 )*sumsq, + +SYNOPSIS + SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ ) + + INTEGER INCX, N + + DOUBLE PRECISION SCALE, SUMSQ + + COMPLEX*16 X( * ) + +PURPOSE + ZLASSQ returns the values scl and ssq such that + + where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is + assumed to be at least unity and the value of ssq will then satisfy + + 1.0 .le. ssq .le. ( sumsq + 2*n ). + + scale is assumed to be non-negative and scl returns the value + + scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ), + i + + scale and sumsq must be supplied in SCALE and SUMSQ respectively. + SCALE and SUMSQ are overwritten by scl and ssq respectively. + + The routine makes only one pass through the vector X. + + +ARGUMENTS + N (input) INTEGER + The number of elements to be used from the vector X. + + X (input) COMPLEX*16 array, dimension (N) + The vector x as described above. x( i ) = X( 1 + ( i - 1 + )*INCX ), 1 <= i <= n. + + INCX (input) INTEGER + The increment between successive values of the vector X. INCX + > 0. + + SCALE (input/output) DOUBLE PRECISION + On entry, the value scale in the equation above. On exit, + SCALE is overwritten with the value scl . + + SUMSQ (input/output) DOUBLE PRECISION + On entry, the value sumsq in the equation above. On exit, + SUMSQ is overwritten with the value ssq . + +@ + <>= (let* ((zero 0.0)) (declare (type (double-float 0.0 0.0) zero)) @@ -60299,20 +75139,6 @@ p (cond (setf sumsq (+ sumsq (expt (/ temp1 scale) 2))))))))))) (return (values nil nil nil scale sumsq)))))) -;(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::zlassq -; fortran-to-lisp::*f2cl-function-info*) -; (fortran-to-lisp::make-f2cl-finfo -; :arg-types '(fixnum -; (array (complex double-float) (*)) -; fixnum (double-float) -; (double-float)) -; :return-values '(nil nil nil fortran-to-lisp::scale -; fortran-to-lisp::sumsq) -; :calls 'nil))) - @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chunk collections} @@ -60498,6 +75324,18 @@ p (cond <> @ +\begin{thebibliography}{99} +\bibitem{1} documentation source +\verb|ftp://ftp.netlib.org/lapack/manpages.tgz| +\bibitem{2} documentation source +\verb|http://www.math.utah.edu/software/lapack/lapack-blas.html| +\bibitem{3} documentation source +Written on 22-October-1986. +Jack Dongarra, Argonne National Lab. +Jeremy Du Croz, Nag Central Office. +Sven Hammarling, Nag Central Office. +Richard Hanson, Sandia National Labs. +\end{thebibliography} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Index} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/changelog b/changelog index ea029e2..5bb8610 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20100405 tpd src/axiom-website/patches.html 20100405.01.tpd.patch +20100405 tpd src/algebra/Makefile add dcabs1 regression and help +20100405 tpd books/bookvol10.5 add regression and help sections 20100404 tpd src/axiom-website/patches.html 20100404.03.tpd.patch 20100404 tpd src/axiom-website/documentation.html add Axiom Algebra Numerics 20100404 tpd books/Makefile add bookvol10.5 add Axiom Algebra Numerics diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index 385c70d..699b650 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -16558,7 +16558,8 @@ SPADHELP=\ ${HELP}/XPBWPolynomial.help \ ${HELP}/XPolynomial.help \ ${HELP}/XPolynomialRing.help \ - ${HELP}/ZeroDimensionalSolvePackage.help + ${HELP}/ZeroDimensionalSolvePackage.help \ + ${HELP}/dcabs1.help @ The algebra files contain input chunks in regress format. @@ -16692,7 +16693,8 @@ REGRESS= \ XPBWPolynomial.regress \ XPolynomial.regress \ XPolynomialRing.regress \ - ZeroDimensionalSolvePackage.regress + ZeroDimensionalSolvePackage.regress \ + dcabs1.regress # these requires graphics # TwoDimensionalViewport @@ -18149,6 +18151,14 @@ ${HELP}/ZeroDimensionalSolvePackage.help: ${BOOKS}/bookvol10.4.pamphlet >${INPUT}/ZeroDimensionalSolvePackage.input @echo "ZeroDimensionalSolvePackage (ZDSOLVE)" >>${HELPFILE} +${HELP}/dcabs1.help: ${BOOKS}/bookvol10.5.pamphlet + @echo 8270 create dcabs1.help from ${BOOKS}/bookvol10.5.pamphlet + @${TANGLE} -R"dcabs1.help" ${BOOKS}/bookvol10.5.pamphlet \ + >${HELP}/dcabs1.help + @${TANGLE} -R"dcabs1.input" ${BOOKS}/bookvol10.5.pamphlet \ + >${INPUT}/dcabs1.input + @echo "dcabs1" >>${HELPFILE} + @ \section{The Makefile} diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 064fa90..7663524 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2617,5 +2617,7 @@ books/bookvol5 change .spad.pamphlet to just .pamphlet
src/axiom-website/download.html update available binary list
20100404.03.tpd.patch books/Makefile add bookvol10.5 add Axiom Algebra Numerics
+20100405.01.tpd.patch +books/bookvol10.5 add regression and help sections