Mercurial > octave-nkf
diff libcruft/lapack/sptts2.f @ 7789:82be108cc558
First attempt at single precision tyeps
* * *
corrections to qrupdate single precision routines
* * *
prefer demotion to single over promotion to double
* * *
Add single precision support to log2 function
* * *
Trivial PROJECT file update
* * *
Cache optimized hermitian/transpose methods
* * *
Add tests for tranpose/hermitian and ChangeLog entry for new transpose code
author | David Bateman <dbateman@free.fr> |
---|---|
date | Sun, 27 Apr 2008 22:34:17 +0200 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libcruft/lapack/sptts2.f Sun Apr 27 22:34:17 2008 +0200 @@ -0,0 +1,93 @@ + SUBROUTINE SPTTS2( N, NRHS, D, E, B, LDB ) +* +* -- LAPACK routine (version 3.1) -- +* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +* November 2006 +* +* .. Scalar Arguments .. + INTEGER LDB, N, NRHS +* .. +* .. Array Arguments .. + REAL B( LDB, * ), D( * ), E( * ) +* .. +* +* Purpose +* ======= +* +* SPTTS2 solves a tridiagonal system of the form +* A * X = B +* using the L*D*L' factorization of A computed by SPTTRF. D is a +* diagonal matrix specified in the vector D, L is a unit bidiagonal +* matrix whose subdiagonal is specified in the vector E, and X and B +* are N by NRHS matrices. +* +* Arguments +* ========= +* +* N (input) INTEGER +* The order of the tridiagonal 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. +* +* D (input) REAL array, dimension (N) +* The n diagonal elements of the diagonal matrix D from the +* L*D*L' factorization of A. +* +* E (input) REAL array, dimension (N-1) +* The (n-1) subdiagonal elements of the unit bidiagonal factor +* L from the L*D*L' factorization of A. E can also be regarded +* as the superdiagonal of the unit bidiagonal factor U from the +* factorization A = U'*D*U. +* +* B (input/output) REAL array, dimension (LDB,NRHS) +* On entry, the right hand side vectors B for the system of +* linear equations. +* On exit, the solution vectors, X. +* +* LDB (input) INTEGER +* The leading dimension of the array B. LDB >= max(1,N). +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I, J +* .. +* .. External Subroutines .. + EXTERNAL SSCAL +* .. +* .. Executable Statements .. +* +* Quick return if possible +* + IF( N.LE.1 ) THEN + IF( N.EQ.1 ) + $ CALL SSCAL( NRHS, 1. / D( 1 ), B, LDB ) + RETURN + END IF +* +* Solve A * X = B using the factorization A = L*D*L', +* overwriting each right hand side vector with its solution. +* + DO 30 J = 1, NRHS +* +* Solve L * x = b. +* + DO 10 I = 2, N + B( I, J ) = B( I, J ) - B( I-1, J )*E( I-1 ) + 10 CONTINUE +* +* Solve D * L' * x = b. +* + B( N, J ) = B( N, J ) / D( N ) + DO 20 I = N - 1, 1, -1 + B( I, J ) = B( I, J ) / D( I ) - B( I+1, J )*E( I ) + 20 CONTINUE + 30 CONTINUE +* + RETURN +* +* End of SPTTS2 +* + END