# HG changeset patch # User Jaroslav Hajek # Date 1208699422 14400 # Node ID 7c9ba697a479f8edf0fe638976f923542993315d # Parent 932b0cf518341bb527091f005648944104ef9845 cosmetic fixes in QR & Cholesky updating codes diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/ChangeLog --- a/libcruft/ChangeLog Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/ChangeLog Sun Apr 20 09:50:22 2008 -0400 @@ -1,3 +1,14 @@ +2008-04-20 Jaroslav Hajek + + * qrupdate/dch1dn.f, qrupdate/dchdex.f, qrupdate/dchinx.f, + qrupdate/dqhqr.f, qrupdate/dqrdec.f, qrupdate/dqrinc.f, + qrupdate/dqrqhu.f, qrupdate/dqrqhv.f, qrupdate/dqrshc.f, + qrupdate/zch1dn.f, qrupdate/zchdex.f, qrupdate/zchinx.f, + qrupdate/zqhqr.f, qrupdate/zqrdec.f, qrupdate/zqrder.f, + qrupdate/zqrinc.f, qrupdate/zqrinr.f, qrupdate/zqrqhu.f, + qrupdate/zqrqhv.f, qrupdate/zqrshc.f: + Fix external declarations, XERBLA calls, and docs. + 2008-04-07 Jaroslav Hajek * qrupdate/dqrqhu.f, qrupdate/zqrqhu.f, diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/dch1dn.f --- a/libcruft/qrupdate/dch1dn.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/dch1dn.f Sun Apr 20 09:50:22 2008 -0400 @@ -36,7 +36,7 @@ integer n,info double precision R(n,n),u(n) double precision w(n) - external dtrsv,dcopy,dlartg,dnrm2 + external dtrsv,dlartg,dnrm2 double precision rho,dnrm2 double precision rr,ui,t integer i,j diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/dchdex.f --- a/libcruft/qrupdate/dchdex.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/dchdex.f Sun Apr 20 09:50:22 2008 -0400 @@ -31,7 +31,7 @@ integer n,j,info double precision R(n,n),R1(n-1,n-1) double precision Qdum,c,s,rr - external dlacpy,dqhqr,dlartg + external xerbla,dlacpy,dqhqr,dlartg c quick return if possible if (n == 1) return @@ -44,7 +44,7 @@ info = 4 end if if (info /= 0) then - call xerbla('DQRDEX',info) + call xerbla('DCHDEX',info) end if c setup the new matrix R1 diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/dchinx.f --- a/libcruft/qrupdate/dchinx.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/dchinx.f Sun Apr 20 09:50:22 2008 -0400 @@ -36,7 +36,7 @@ integer n,j,info double precision R(n,n),R1(n+1,n+1),u(n+1) double precision rho,Qdum,w,dnrm2 - external dcopy,dlacpy,dtrsv,dnrm2 + external xerbla,dcopy,dlacpy,dtrsv,dnrm2,dqrqhu integer jj c quick return if possible @@ -57,7 +57,7 @@ info = 4 end if if (info /= 0) then - call xerbla('DQRINX',info) + call xerbla('DCHINX',info) end if c copy shifted vector diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/dqhqr.f --- a/libcruft/qrupdate/dqhqr.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/dqhqr.f Sun Apr 20 09:50:22 2008 -0400 @@ -38,7 +38,7 @@ double precision Q(ldq,*),R(ldr,*) double precision c double precision s,rr - external dlartg,drot + external xerbla,dlartg,drot integer info,i c quick return if possible. if (n <= 0 .or. k <= 1) return diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/dqrdec.f --- a/libcruft/qrupdate/dqrdec.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/dqrdec.f Sun Apr 20 09:50:22 2008 -0400 @@ -39,7 +39,7 @@ c integer m,n,k,j double precision Q(m,k),R(k,n),R1(k,n-1) - external dcopy,dqhqr + external xerbla,dcopy,dqhqr integer info c quick return if possible if (m <= 0 .or. k <= 0 .or. n == 1) return diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/dqrinc.f --- a/libcruft/qrupdate/dqrinc.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/dqrinc.f Sun Apr 20 09:50:22 2008 -0400 @@ -22,8 +22,8 @@ c i.e., given an m-by-k orthogonal matrix Q, an m-by-n c upper trapezoidal matrix R and index j in the range c 1:n+1, this subroutine updates the matrix Q -> Q1 and -c forms an m-by-(n+1) matrix R1 so that Q1 is again unitary, -c R1 upper trapezoidal, and +c forms an m-by-(n+1) matrix R1 so that Q1 is again +c orthogonal, R1 upper trapezoidal, and c Q1*R1 = [A(:,1:j-1); Q*Q'*x; A(:,j:n-1)], where A = Q*R. c (real version) c arguments: @@ -52,7 +52,7 @@ info = 6 end if if (info /= 0) then - call xerbla('DQRDER',info) + call xerbla('DQRINC',info) end if c copy leading portion of R call dcopy(k*(j-1),R,1,R1,1) diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/dqrqhu.f --- a/libcruft/qrupdate/dqrqhu.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/dqrqhu.f Sun Apr 20 09:50:22 2008 -0400 @@ -42,7 +42,7 @@ double precision Q(ldq,*),R(ldr,*),u(*),rr double precision c double precision s,w - external dlartg,drot + external xerbla,dlartg,drot integer i,info c quick return if possible. if (k <= 0) return diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/dqrqhv.f --- a/libcruft/qrupdate/dqrqhv.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/dqrqhv.f Sun Apr 20 09:50:22 2008 -0400 @@ -42,7 +42,7 @@ double precision Q(ldq,*),R(ldr,*),u(*),rr double precision c double precision s,w,w1,ddot - external ddot,dlartg,drot + external xerbla,ddot,dlartg,drot integer i,info c quick return if possible. if (k <= 0) return diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/dqrshc.f --- a/libcruft/qrupdate/dqrshc.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/dqrshc.f Sun Apr 20 09:50:22 2008 -0400 @@ -22,8 +22,8 @@ c i.e., given an m-by-k orthogonal matrix Q, an k-by-n c upper trapezoidal matrix R and index j in the range c 1:n+1, this subroutine updates the matrix Q -> Q1 and -c R -> R1 so that Q1 is again unitary, R1 upper trapezoidal, -c and +c R -> R1 so that Q1 is again orthogonal, R1 upper +c trapezoidal, and c Q1*R1 = A(:,p), where A = Q*R and p is the permutation c [1:i-1,shift(i:j,-1),j+1:n] if i < j or c [1:j-1,shift(j:i,+1),i+1:n] if j > i. @@ -42,7 +42,7 @@ c integer m,n,k,i,j double precision Q(m,k),R(k,n) - external dswap,dqhqr + external xerbla,dswap,dqhqr,dqrqhu double precision w integer l,jj,kk,info diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/zch1dn.f --- a/libcruft/qrupdate/zch1dn.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/zch1dn.f Sun Apr 20 09:50:22 2008 -0400 @@ -36,7 +36,7 @@ integer n,info double complex R(n,n),u(n) double precision w(n) - external ztrsv,zcopy,zlartg,dznrm2 + external ztrsv,zlartg,dznrm2 double precision rho,dznrm2 double complex crho,rr,ui,t integer i,j diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/zchdex.f --- a/libcruft/qrupdate/zchdex.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/zchdex.f Sun Apr 20 09:50:22 2008 -0400 @@ -22,7 +22,7 @@ c factor of a symmetric positive definite matrix A, i.e. c A = R'*R, this subroutine updates R -> R1 so that c R1'*R1 = A(jj,jj), where jj = [1:j-1,j+1:n+1]. -c (real version) +c (complex version) c arguments: c n (in) the order of matrix R c R (in) the original upper trapezoidal matrix R @@ -32,7 +32,7 @@ double complex R(n,n),R1(n-1,n-1) double precision c double complex Qdum,s,rr - external zlacpy,zqhqr,zlartg + external xerbla,zlacpy,zqhqr,zlartg c quick return if possible if (n == 1) return @@ -45,7 +45,7 @@ info = 4 end if if (info /= 0) then - call xerbla('ZQRDEX',info) + call xerbla('ZCHDEX',info) end if c setup the new matrix R1 diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/zchinx.f --- a/libcruft/qrupdate/zchinx.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/zchinx.f Sun Apr 20 09:50:22 2008 -0400 @@ -37,7 +37,7 @@ double complex R(n,n),R1(n+1,n+1),u(n+1) double precision rho,dznrm2 double complex Qdum,w - external zcopy,zlacpy,ztrsv,dznrm2 + external xerbla,zcopy,zlacpy,ztrsv,dznrm2,zqrqhu integer jj c quick return if possible @@ -58,7 +58,7 @@ info = 4 end if if (info /= 0) then - call xerbla('ZQRINX',info) + call xerbla('ZCHINX',info) end if c copy shifted vector diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/zqhqr.f --- a/libcruft/qrupdate/zqhqr.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/zqhqr.f Sun Apr 20 09:50:22 2008 -0400 @@ -38,7 +38,7 @@ double complex Q(ldq,*),R(ldr,*) double precision c double complex s,rr - external zlartg,zrot + external xerbla,zlartg,zrot integer info,i c quick return if possible. if (n <= 0 .or. k <= 1) return diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/zqrdec.f --- a/libcruft/qrupdate/zqrdec.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/zqrdec.f Sun Apr 20 09:50:22 2008 -0400 @@ -39,7 +39,7 @@ c integer m,n,k,j double complex Q(m,k),R(k,n),R1(k,n-1) - external zcopy,zqhqr + external xerbla,zcopy,zqhqr integer info c quick return if possible if (m <= 0 .or. k <= 0 .or. n == 1) return @@ -51,7 +51,7 @@ info = 7 end if if (info /= 0) then - call xerbla('DQRDEC',info) + call xerbla('ZQRDEC',info) end if c copy leading portion call zcopy(k*(j-1),R,1,R1,1) diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/zqrder.f --- a/libcruft/qrupdate/zqrder.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/zqrder.f Sun Apr 20 09:50:22 2008 -0400 @@ -39,7 +39,7 @@ double complex Q(m,m),Q1(m-1,m-1),R(m,n),R1(m-1,n) double precision c double complex s,rr,w - external xerbla,zlacpy,zcopy,zlartg,zrot,zdscal,zaxpy + external xerbla,zlacpy,zlartg,zrot,zdscal,zaxpy integer i c quick return if possible if (m == 1) return diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/zqrinc.f --- a/libcruft/qrupdate/zqrinc.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/zqrinc.f Sun Apr 20 09:50:22 2008 -0400 @@ -52,7 +52,7 @@ info = 6 end if if (info /= 0) then - call xerbla('ZQRDER',info) + call xerbla('ZQRINC',info) end if c copy leading portion of R call zcopy(k*(j-1),R,1,R1,1) diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/zqrinr.f --- a/libcruft/qrupdate/zqrinr.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/zqrinr.f Sun Apr 20 09:50:22 2008 -0400 @@ -29,7 +29,7 @@ c arguments: c m (in) number of rows of the matrix R. c n (in) number of columns of the matrix R -c Q (in) the orthogonal matrix Q +c Q (in) the unitary matrix Q c Q1 (out) the updated matrix Q1 c R (in) the upper trapezoidal matrix R c R1 (out) the updated matrix R1 @@ -38,7 +38,7 @@ c integer m,n,j double complex Q(m,m),Q1(m+1,m+1),R(m,n),R1(m+1,n),x(n) - external xerbla,zlacpy,dcopy,dqhqr + external xerbla,zlacpy,zcopy,zqhqr integer i c check arguments info = 0 diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/zqrqhu.f --- a/libcruft/qrupdate/zqrqhu.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/zqrqhu.f Sun Apr 20 09:50:22 2008 -0400 @@ -27,7 +27,7 @@ c m (in) number of rows of the matrix Q. c n (in) number of columns of the matrix R. c k (in) number of columns of Q and rows of R. -c Q (io) on entry, the orthogonal matrix Q. +c Q (io) on entry, the unitary matrix Q. c on exit, the updated matrix Q1. c ldq (in) leading dimension of Q. c R (io) on entry, the upper triangular matrix R. @@ -36,13 +36,13 @@ c u (in) the k-vector u. c rr (out) the first element of Q1'*u on exit. c -c if Q is orthogonal, so is Q1. It is not strictly +c if Q is unitary, so is Q1. It is not strictly c necessary, however. integer m,n,k,ldq,ldr double complex Q(ldq,*),R(ldr,*),u(*),rr double precision c double complex s,w - external zlartg,zrot + external xerbla,zlartg,zrot integer i,info c quick return if possible. if (k <= 0) return diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/zqrqhv.f --- a/libcruft/qrupdate/zqrqhv.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/zqrqhv.f Sun Apr 20 09:50:22 2008 -0400 @@ -27,7 +27,7 @@ c m (in) number of rows of the matrix Q. c n (in) number of columns of the matrix R. c k (in) number of columns of Q and rows of R. k <= m. -c Q (io) on entry, the orthogonal matrix Q. +c Q (io) on entry, the unitary matrix Q. c on exit, the updated matrix Q1. c ldq (in) leading dimension of Q. c R (io) on entry, the upper triangular matrix R. @@ -36,13 +36,13 @@ c u (in) the m-vector u. c rr (out) the first element of Q1'*u on exit. c -c if Q is orthogonal, so is Q1. It is not strictly +c if Q is unitary, so is Q1. It is not strictly c necessary, however. integer m,n,k,ldq,ldr double complex Q(ldq,*),R(ldr,*),u(*),rr double precision c double complex s,w,w1,zdotc - external zdotc,zlartg,zrot + external xerbla,zdotc,zlartg,zrot integer i,info c quick return if possible. if (k <= 0) return diff -r 932b0cf51834 -r 7c9ba697a479 libcruft/qrupdate/zqrshc.f --- a/libcruft/qrupdate/zqrshc.f Sun Apr 20 09:04:47 2008 -0400 +++ b/libcruft/qrupdate/zqrshc.f Sun Apr 20 09:50:22 2008 -0400 @@ -19,7 +19,7 @@ subroutine zqrshc(m,n,k,Q,R,i,j) c purpose: updates a QR factorization after circular shift of c columns. -c i.e., given an m-by-k orthogonal matrix Q, an k-by-n +c i.e., given an m-by-k unitary matrix Q, an k-by-n c upper trapezoidal matrix R and index j in the range c 1:n+1, this subroutine updates the matrix Q -> Q1 and c R -> R1 so that Q1 is again unitary, R1 upper trapezoidal, @@ -28,7 +28,7 @@ c [1:i-1,shift(i:j,-1),j+1:n] if i < j or c [1:j-1,shift(j:i,+1),i+1:n] if j > i. c if m == 0, the matrix Q is ignored. -c (real version) +c (complex version) c arguments: c m (in) number of rows of the matrix Q, or 0 if Q is not needed. c n (in) number of columns of the matrix R. @@ -42,7 +42,7 @@ c integer m,n,k,i,j double complex Q(m,k),R(k,n) - external zswap,zqhqr + external xerbla,zswap,zqhqr,zqrqhu double complex w integer l,jj,kk,info diff -r 932b0cf51834 -r 7c9ba697a479 liboctave/ChangeLog --- a/liboctave/ChangeLog Sun Apr 20 09:04:47 2008 -0400 +++ b/liboctave/ChangeLog Sun Apr 20 09:50:22 2008 -0400 @@ -1,3 +1,7 @@ +2008-04-19 Jaroslav Hajek + + * CmplxCHOL.cc, CmplxQR.cc, dbleCHOL.cc, dbleQR.cc: Fix calls to error() + 2008-04-16 David Bateman * Sparse.h (Sparse& operator = (Sparse&)): Move definition diff -r 932b0cf51834 -r 7c9ba697a479 liboctave/CmplxCHOL.cc --- a/liboctave/CmplxCHOL.cc Sun Apr 20 09:04:47 2008 -0400 +++ b/liboctave/CmplxCHOL.cc Sun Apr 20 09:50:22 2008 -0400 @@ -251,7 +251,7 @@ octave_idx_type n = chol_mat.rows (); if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("CHOL insert index out of range"); + (*current_liboctave_error_handler) ("CHOL delete index out of range"); else { ComplexMatrix chol_mat1 (n-1, n-1); diff -r 932b0cf51834 -r 7c9ba697a479 liboctave/CmplxQR.cc --- a/liboctave/CmplxQR.cc Sun Apr 20 09:04:47 2008 -0400 +++ b/liboctave/CmplxQR.cc Sun Apr 20 09:50:22 2008 -0400 @@ -259,7 +259,7 @@ octave_idx_type n = r.columns (); if (! q.is_square ()) - (*current_liboctave_error_handler) ("QR insert dimensions mismatch"); + (*current_liboctave_error_handler) ("QR delete dimensions mismatch"); else if (j < 0 || j > m-1) (*current_liboctave_error_handler) ("QR delete index out of range"); else diff -r 932b0cf51834 -r 7c9ba697a479 liboctave/dbleCHOL.cc --- a/liboctave/dbleCHOL.cc Sun Apr 20 09:04:47 2008 -0400 +++ b/liboctave/dbleCHOL.cc Sun Apr 20 09:50:22 2008 -0400 @@ -255,7 +255,7 @@ octave_idx_type n = chol_mat.rows (); if (j < 0 || j > n-1) - (*current_liboctave_error_handler) ("CHOL insert index out of range"); + (*current_liboctave_error_handler) ("CHOL delete index out of range"); else { Matrix chol_mat1 (n-1, n-1); diff -r 932b0cf51834 -r 7c9ba697a479 liboctave/dbleQR.cc --- a/liboctave/dbleQR.cc Sun Apr 20 09:04:47 2008 -0400 +++ b/liboctave/dbleQR.cc Sun Apr 20 09:50:22 2008 -0400 @@ -248,7 +248,7 @@ octave_idx_type n = r.columns (); if (! q.is_square ()) - (*current_liboctave_error_handler) ("QR insert dimensions mismatch"); + (*current_liboctave_error_handler) ("QR delete dimensions mismatch"); else if (j < 0 || j > m-1) (*current_liboctave_error_handler) ("QR delete index out of range"); else