From baba851215b44ac3b60b9248eb02bcce7eb76247 Mon Sep 17 00:00:00 2001 From: jason Date: Tue, 28 Oct 2008 01:38:50 +0000 Subject: Move LAPACK trunk into position. --- SRC/dpttrs.f | 114 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 114 insertions(+) create mode 100644 SRC/dpttrs.f (limited to 'SRC/dpttrs.f') diff --git a/SRC/dpttrs.f b/SRC/dpttrs.f new file mode 100644 index 00000000..9a2a4771 --- /dev/null +++ b/SRC/dpttrs.f @@ -0,0 +1,114 @@ + SUBROUTINE DPTTRS( N, NRHS, D, E, B, LDB, INFO ) +* +* -- LAPACK routine (version 3.1) -- +* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +* November 2006 +* +* .. Scalar Arguments .. + INTEGER INFO, LDB, N, NRHS +* .. +* .. Array Arguments .. + DOUBLE PRECISION B( LDB, * ), D( * ), E( * ) +* .. +* +* Purpose +* ======= +* +* DPTTRS solves a tridiagonal system of the form +* A * X = B +* using the L*D*L' factorization of A computed by DPTTRF. 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) DOUBLE PRECISION array, dimension (N) +* The n diagonal elements of the diagonal matrix D from the +* L*D*L' factorization of A. +* +* E (input) DOUBLE PRECISION 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) DOUBLE PRECISION 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). +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -k, the k-th argument had an illegal value +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER J, JB, NB +* .. +* .. External Functions .. + INTEGER ILAENV + EXTERNAL ILAENV +* .. +* .. External Subroutines .. + EXTERNAL DPTTS2, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input arguments. +* + INFO = 0 + IF( N.LT.0 ) THEN + INFO = -1 + ELSE IF( NRHS.LT.0 ) THEN + INFO = -2 + ELSE IF( LDB.LT.MAX( 1, N ) ) THEN + INFO = -6 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DPTTRS', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 .OR. NRHS.EQ.0 ) + $ RETURN +* +* Determine the number of right-hand sides to solve at a time. +* + IF( NRHS.EQ.1 ) THEN + NB = 1 + ELSE + NB = MAX( 1, ILAENV( 1, 'DPTTRS', ' ', N, NRHS, -1, -1 ) ) + END IF +* + IF( NB.GE.NRHS ) THEN + CALL DPTTS2( N, NRHS, D, E, B, LDB ) + ELSE + DO 10 J = 1, NRHS, NB + JB = MIN( NRHS-J+1, NB ) + CALL DPTTS2( N, JB, D, E, B( 1, J ), LDB ) + 10 CONTINUE + END IF +* + RETURN +* +* End of DPTTRS +* + END -- cgit v1.2.3