bool generalizedsymmetricdefiniteevdreduce(ap::real_2d_array& a, int n, bool isuppera, const ap::real_2d_array& b, bool isupperb, int problemtype, ap::real_2d_array& r, bool& isupperr) { bool result; ap::real_2d_array t; ap::real_1d_array w1; ap::real_1d_array w2; ap::real_1d_array w3; int i; int j; double v; ap::ap_error::make_assertion(n>0, "GeneralizedSymmetricDefiniteEVDReduce: N<=0!"); ap::ap_error::make_assertion(problemtype==1||problemtype==2||problemtype==3, "GeneralizedSymmetricDefiniteEVDReduce: incorrect ProblemType!"); result = true; // // Problem 1: A*x = lambda*B*x // // Reducing to: // C*y = lambda*y // C = L^(-1) * A * L^(-T) // x = L^(-T) * y // if( problemtype==1 ) { // // Factorize B in T: B = LL' // t.setbounds(1, n, 1, n); if( isupperb ) { for(i = 1; i <= n; i++) { ap::vmove(t.getcolumn(i, i, n), b.getrow(i, i, n)); } } else { for(i = 1; i <= n; i++) { ap::vmove(&t(i, 1), &b(i, 1), ap::vlen(1,i)); } } if( !choleskydecomposition(t, n, false) ) { result = false; return result; } // // Invert L in T // if( !invtriangular(t, n, false, false) ) { result = false; return result; } // // Build L^(-1) * A * L^(-T) in R // w1.setbounds(1, n); w2.setbounds(1, n); r.setbounds(1, n, 1, n); for(j = 1; j <= n; j++) { // // Form w2 = A * l'(j) (here l'(j) is j-th column of L^(-T)) // ap::vmove(&w1(1), &t(j, 1), ap::vlen(1,j)); symmetricmatrixvectormultiply(a, isuppera, 1, j, w1, 1.0, w2); if( isuppera ) { matrixvectormultiply(a, 1, j, j+1, n, true, w1, 1, j, 1.0, w2, j+1, n, 0.0); } else { matrixvectormultiply(a, j+1, n, 1, j, false, w1, 1, j, 1.0, w2, j+1, n, 0.0); } // // Form l(i)*w2 (here l(i) is i-th row of L^(-1)) // for(i = 1; i <= n; i++) { v = ap::vdotproduct(&t(i, 1), &w2(1), ap::vlen(1,i)); r(i,j) = v; } } // // Copy R to A // for(i = 1; i <= n; i++) { ap::vmove(&a(i, 1), &r(i, 1), ap::vlen(1,n)); } // // Copy L^(-1) from T to R and transpose // isupperr = true; for(i = 1; i <= n; i++) { for(j = 1; j <= i-1; j++) { r(i,j) = 0; } } for(i = 1; i <= n; i++) { ap::vmove(r.getrow(i, i, n), t.getcolumn(i, i, n)); } return result; } // // Problem 2: A*B*x = lambda*x // or // problem 3: B*A*x = lambda*x // // Reducing to: // C*y = lambda*y // C = U * A * U' // B = U'* U // if( problemtype==2||problemtype==3 ) { // // Factorize B in T: B = U'*U // t.setbounds(1, n, 1, n); if( isupperb ) { for(i = 1; i <= n; i++) { ap::vmove(&t(i, i), &b(i, i), ap::vlen(i,n)); } } else { for(i = 1; i <= n; i++) { ap::vmove(t.getrow(i, i, n), b.getcolumn(i, i, n)); } } if( !choleskydecomposition(t, n, true) ) { result = false; return result; } // // Build U * A * U' in R // w1.setbounds(1, n); w2.setbounds(1, n); w3.setbounds(1, n); r.setbounds(1, n, 1, n); for(j = 1; j <= n; j++) { // // Form w2 = A * u'(j) (here u'(j) is j-th column of U') // ap::vmove(&w1(1), &t(j, j), ap::vlen(1,n-j+1)); symmetricmatrixvectormultiply(a, isuppera, j, n, w1, 1.0, w3); ap::vmove(&w2(j), &w3(1), ap::vlen(j,n)); ap::vmove(&w1(j), &t(j, j), ap::vlen(j,n)); if( isuppera ) { matrixvectormultiply(a, 1, j-1, j, n, false, w1, j, n, 1.0, w2, 1, j-1, 0.0); } else { matrixvectormultiply(a, j, n, 1, j-1, true, w1, j, n, 1.0, w2, 1, j-1, 0.0); } // // Form u(i)*w2 (here u(i) is i-th row of U) // for(i = 1; i <= n; i++) { v = ap::vdotproduct(&t(i, i), &w2(i), ap::vlen(i,n)); r(i,j) = v; } } // // Copy R to A // for(i = 1; i <= n; i++) { ap::vmove(&a(i, 1), &r(i, 1), ap::vlen(1,n)); } if( problemtype==2 ) { // // Invert U in T // if( !invtriangular(t, n, true, false) ) { result = false; return result; } // // Copy U^-1 from T to R // isupperr = true; for(i = 1; i <= n; i++) { for(j = 1; j <= i-1; j++) { r(i,j) = 0; } } for(i = 1; i <= n; i++) { ap::vmove(&r(i, i), &t(i, i), ap::vlen(i,n)); } } else { // // Copy U from T to R and transpose // isupperr = false; for(i = 1; i <= n; i++) { for(j = i+1; j <= n; j++) { r(i,j) = 0; } } for(i = 1; i <= n; i++) { ap::vmove(r.getcolumn(i, i, n), t.getrow(i, i, n)); } } } return result; }
/************************************************************************* Reduction of a symmetric matrix which is given by its higher or lower triangular part to a tridiagonal matrix using orthogonal similarity transformation: Q'*A*Q=T. Input parameters: A - matrix to be transformed array with elements [0..N-1, 0..N-1]. N - size of matrix A. IsUpper - storage format. If IsUpper = True, then matrix A is given by its upper triangle, and the lower triangle is not used and not modified by the algorithm, and vice versa if IsUpper = False. Output parameters: A - matrices T and Q in compact form (see lower) Tau - array of factors which are forming matrices H(i) array with elements [0..N-2]. D - main diagonal of symmetric matrix T. array with elements [0..N-1]. E - secondary diagonal of symmetric matrix T. array with elements [0..N-2]. If IsUpper=True, the matrix Q is represented as a product of elementary reflectors Q = H(n-2) . . . H(2) H(0). 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(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in A(0:i-1,i+1), and tau in TAU(i). If IsUpper=False, the matrix Q is represented as a product of elementary reflectors Q = H(0) H(2) . . . H(n-2). 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(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i), and tau in TAU(i). The contents of A on exit are illustrated by the following examples with n = 5: if UPLO = 'U': if UPLO = 'L': ( d e v1 v2 v3 ) ( d ) ( d e v2 v3 ) ( e d ) ( d e v3 ) ( v0 e d ) ( d e ) ( v0 v1 e d ) ( d ) ( v0 v1 v2 e d ) where d and e denote diagonal and off-diagonal elements of T, and vi denotes an element of the vector defining H(i). -- LAPACK routine (version 3.0) -- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab, and Rice University October 31, 1992 *************************************************************************/ void smatrixtd(ap::real_2d_array& a, int n, bool isupper, ap::real_1d_array& tau, ap::real_1d_array& d, ap::real_1d_array& e) { int i; double alpha; double taui; double v; ap::real_1d_array t; ap::real_1d_array t2; ap::real_1d_array t3; if( n<=0 ) { return; } t.setbounds(1, n); t2.setbounds(1, n); t3.setbounds(1, n); if( n>1 ) { tau.setbounds(0, n-2); } d.setbounds(0, n-1); if( n>1 ) { e.setbounds(0, n-2); } if( isupper ) { // // Reduce the upper triangle of A // for(i = n-2; i >= 0; i--) { // // Generate elementary reflector H() = E - tau * v * v' // if( i>=1 ) { ap::vmove(t.getvector(2, i+1), a.getcolumn(i+1, 0, i-1)); } t(1) = a(i,i+1); generatereflection(t, i+1, taui); if( i>=1 ) { ap::vmove(a.getcolumn(i+1, 0, i-1), t.getvector(2, i+1)); } a(i,i+1) = t(1); e(i) = a(i,i+1); if( taui!=0 ) { // // Apply H from both sides to A // a(i,i+1) = 1; // // Compute x := tau * A * v storing x in TAU // ap::vmove(t.getvector(1, i+1), a.getcolumn(i+1, 0, i)); symmetricmatrixvectormultiply(a, isupper, 0, i, t, taui, t3); ap::vmove(&tau(0), &t3(1), ap::vlen(0,i)); // // Compute w := x - 1/2 * tau * (x'*v) * v // v = ap::vdotproduct(tau.getvector(0, i), a.getcolumn(i+1, 0, i)); alpha = -0.5*taui*v; ap::vadd(tau.getvector(0, i), a.getcolumn(i+1, 0, i), alpha); // // Apply the transformation as a rank-2 update: // A := A - v * w' - w * v' // ap::vmove(t.getvector(1, i+1), a.getcolumn(i+1, 0, i)); ap::vmove(&t3(1), &tau(0), ap::vlen(1,i+1)); symmetricrank2update(a, isupper, 0, i, t, t3, t2, double(-1)); a(i,i+1) = e(i); } d(i+1) = a(i+1,i+1); tau(i) = taui; } d(0) = a(0,0); } else { // // Reduce the lower triangle of A // for(i = 0; i <= n-2; i++) { // // Generate elementary reflector H = E - tau * v * v' // ap::vmove(t.getvector(1, n-i-1), a.getcolumn(i, i+1, n-1)); generatereflection(t, n-i-1, taui); ap::vmove(a.getcolumn(i, i+1, n-1), t.getvector(1, n-i-1)); e(i) = a(i+1,i); if( taui!=0 ) { // // Apply H from both sides to A // a(i+1,i) = 1; // // Compute x := tau * A * v storing y in TAU // ap::vmove(t.getvector(1, n-i-1), a.getcolumn(i, i+1, n-1)); symmetricmatrixvectormultiply(a, isupper, i+1, n-1, t, taui, t2); ap::vmove(&tau(i), &t2(1), ap::vlen(i,n-2)); // // Compute w := x - 1/2 * tau * (x'*v) * v // v = ap::vdotproduct(tau.getvector(i, n-2), a.getcolumn(i, i+1, n-1)); alpha = -0.5*taui*v; ap::vadd(tau.getvector(i, n-2), a.getcolumn(i, i+1, n-1), alpha); // // Apply the transformation as a rank-2 update: // A := A - v * w' - w * v' // // ap::vmove(t.getvector(1, n-i-1), a.getcolumn(i, i+1, n-1)); ap::vmove(&t2(1), &tau(i), ap::vlen(1,n-i-1)); symmetricrank2update(a, isupper, i+1, n-1, t, t2, t3, double(-1)); a(i+1,i) = e(i); } d(i) = a(i,i); tau(i) = taui; } d(n-1) = a(n-1,n-1); } }
/************************************************************************* Obsolete 1-based subroutine *************************************************************************/ void totridiagonal(ap::real_2d_array& a, int n, bool isupper, ap::real_1d_array& tau, ap::real_1d_array& d, ap::real_1d_array& e) { int i; int ip1; int im1; int nmi; int nm1; double alpha; double taui; double v; ap::real_1d_array t; ap::real_1d_array t2; ap::real_1d_array t3; if( n<=0 ) { return; } t.setbounds(1, n); t2.setbounds(1, n); t3.setbounds(1, n); tau.setbounds(1, ap::maxint(1, n-1)); d.setbounds(1, n); e.setbounds(1, ap::maxint(1, n-1)); if( isupper ) { // // Reduce the upper triangle of A // for(i = n-1; i >= 1; i--) { // // Generate elementary reflector H(i) = I - tau * v * v' // to annihilate A(1:i-1,i+1) // // DLARFG( I, A( I, I+1 ), A( 1, I+1 ), 1, TAUI ); // ip1 = i+1; im1 = i-1; if( i>=2 ) { ap::vmove(t.getvector(2, i), a.getcolumn(ip1, 1, im1)); } t(1) = a(i,ip1); generatereflection(t, i, taui); if( i>=2 ) { ap::vmove(a.getcolumn(ip1, 1, im1), t.getvector(2, i)); } a(i,ip1) = t(1); e(i) = a(i,i+1); if( taui!=0 ) { // // Apply H(i) from both sides to A(1:i,1:i) // a(i,i+1) = 1; // // Compute x := tau * A * v storing x in TAU(1:i) // // DSYMV( UPLO, I, TAUI, A, LDA, A( 1, I+1 ), 1, ZERO, TAU, 1 ); // ip1 = i+1; ap::vmove(t.getvector(1, i), a.getcolumn(ip1, 1, i)); symmetricmatrixvectormultiply(a, isupper, 1, i, t, taui, tau); // // Compute w := x - 1/2 * tau * (x'*v) * v // ip1 = i+1; v = ap::vdotproduct(tau.getvector(1, i), a.getcolumn(ip1, 1, i)); alpha = -0.5*taui*v; ap::vadd(tau.getvector(1, i), a.getcolumn(ip1, 1, i), alpha); // // Apply the transformation as a rank-2 update: // A := A - v * w' - w * v' // // DSYR2( UPLO, I, -ONE, A( 1, I+1 ), 1, TAU, 1, A, LDA ); // ap::vmove(t.getvector(1, i), a.getcolumn(ip1, 1, i)); symmetricrank2update(a, isupper, 1, i, t, tau, t2, double(-1)); a(i,i+1) = e(i); } d(i+1) = a(i+1,i+1); tau(i) = taui; } d(1) = a(1,1); } else { // // Reduce the lower triangle of A // for(i = 1; i <= n-1; i++) { // // Generate elementary reflector H(i) = I - tau * v * v' // to annihilate A(i+2:n,i) // //DLARFG( N-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1, TAUI ); // nmi = n-i; ip1 = i+1; ap::vmove(t.getvector(1, nmi), a.getcolumn(i, ip1, n)); generatereflection(t, nmi, taui); ap::vmove(a.getcolumn(i, ip1, n), t.getvector(1, nmi)); e(i) = a(i+1,i); if( taui!=0 ) { // // Apply H(i) from both sides to A(i+1:n,i+1:n) // a(i+1,i) = 1; // // Compute x := tau * A * v storing y in TAU(i:n-1) // //DSYMV( UPLO, N-I, TAUI, A( I+1, I+1 ), LDA, A( I+1, I ), 1, ZERO, TAU( I ), 1 ); // ip1 = i+1; nmi = n-i; nm1 = n-1; ap::vmove(t.getvector(1, nmi), a.getcolumn(i, ip1, n)); symmetricmatrixvectormultiply(a, isupper, i+1, n, t, taui, t2); ap::vmove(&tau(i), &t2(1), ap::vlen(i,nm1)); // // Compute w := x - 1/2 * tau * (x'*v) * v // nm1 = n-1; ip1 = i+1; v = ap::vdotproduct(tau.getvector(i, nm1), a.getcolumn(i, ip1, n)); alpha = -0.5*taui*v; ap::vadd(tau.getvector(i, nm1), a.getcolumn(i, ip1, n), alpha); // // Apply the transformation as a rank-2 update: // A := A - v * w' - w * v' // //DSYR2( UPLO, N-I, -ONE, A( I+1, I ), 1, TAU( I ), 1, A( I+1, I+1 ), LDA ); // nm1 = n-1; nmi = n-i; ip1 = i+1; ap::vmove(t.getvector(1, nmi), a.getcolumn(i, ip1, n)); ap::vmove(&t2(1), &tau(i), ap::vlen(1,nmi)); symmetricrank2update(a, isupper, i+1, n, t, t2, t3, double(-1)); a(i+1,i) = e(i); } d(i) = a(i,i); tau(i) = taui; } d(n) = a(n,n); } }
bool testsblas(bool silent) { bool result; ap::real_2d_array a; ap::real_2d_array ua; ap::real_2d_array la; ap::real_1d_array x; ap::real_1d_array y1; ap::real_1d_array y2; ap::real_1d_array y3; int n; int maxn; int i; int j; int i1; int i2; int gpass; bool waserrors; double mverr; double threshold; double alpha; double v; mverr = 0; waserrors = false; maxn = 10; threshold = 1000*ap::machineepsilon; // // Test MV // for(n = 2; n <= maxn; n++) { a.setbounds(1, n, 1, n); ua.setbounds(1, n, 1, n); la.setbounds(1, n, 1, n); x.setbounds(1, n); y1.setbounds(1, n); y2.setbounds(1, n); y3.setbounds(1, n); // // fill A, UA, LA // for(i = 1; i <= n; i++) { a(i,i) = 2*ap::randomreal()-1; for(j = i+1; j <= n; j++) { a(i,j) = 2*ap::randomreal()-1; a(j,i) = a(i,j); } } for(i = 1; i <= n; i++) { for(j = 1; j <= n; j++) { ua(i,j) = 0; } } for(i = 1; i <= n; i++) { for(j = i; j <= n; j++) { ua(i,j) = a(i,j); } } for(i = 1; i <= n; i++) { for(j = 1; j <= n; j++) { la(i,j) = 0; } } for(i = 1; i <= n; i++) { for(j = 1; j <= i; j++) { la(i,j) = a(i,j); } } // // test on different I1, I2 // for(i1 = 1; i1 <= n; i1++) { for(i2 = i1; i2 <= n; i2++) { // // Fill X, choose Alpha // for(i = 1; i <= i2-i1+1; i++) { x(i) = 2*ap::randomreal()-1; } alpha = 2*ap::randomreal()-1; // // calculate A*x, UA*x, LA*x // for(i = i1; i <= i2; i++) { v = ap::vdotproduct(&a(i, i1), 1, &x(1), 1, ap::vlen(i1,i2)); y1(i-i1+1) = alpha*v; } symmetricmatrixvectormultiply(ua, true, i1, i2, x, alpha, y2); symmetricmatrixvectormultiply(la, false, i1, i2, x, alpha, y3); // // Calculate error // ap::vsub(&y2(1), 1, &y1(1), 1, ap::vlen(1,i2-i1+1)); v = ap::vdotproduct(&y2(1), 1, &y2(1), 1, ap::vlen(1,i2-i1+1)); mverr = ap::maxreal(mverr, sqrt(v)); ap::vsub(&y3(1), 1, &y1(1), 1, ap::vlen(1,i2-i1+1)); v = ap::vdotproduct(&y3(1), 1, &y3(1), 1, ap::vlen(1,i2-i1+1)); mverr = ap::maxreal(mverr, sqrt(v)); } } } // // report // waserrors = ap::fp_greater(mverr,threshold); if( !silent ) { printf("TESTING SYMMETRIC BLAS\n"); printf("MV error: %5.3le\n", double(mverr)); printf("Threshold: %5.3le\n", double(threshold)); if( waserrors ) { printf("TEST FAILED\n"); } else { printf("TEST PASSED\n"); } printf("\n\n"); } result = !waserrors; return result; }