1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141
|
SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
$ INFO )
*
* -- LAPACK routine (version 3.0) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* June 30, 1999
*
* .. Scalar Arguments ..
CHARACTER TRANS
INTEGER INFO, LDB, N, NRHS
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
* ..
*
* Purpose
* =======
*
* DGTTRS solves one of the systems of equations
* A*X = B or A'*X = B,
* with a tridiagonal matrix A using the LU factorization computed
* by DGTTRF.
*
* Arguments
* =========
*
* TRANS (input) CHARACTER
* 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.
*
* NRHS (input) INTEGER
* The number of right hand sides, i.e., the number of columns
* of the matrix B. NRHS >= 0.
*
* DL (input) DOUBLE PRECISION array, dimension (N-1)
* The (n-1) multipliers that define the matrix L from the
* LU factorization of A.
*
* D (input) DOUBLE PRECISION array, dimension (N)
* The n diagonal elements of the upper triangular matrix U from
* the LU factorization of A.
*
* DU (input) DOUBLE PRECISION array, dimension (N-1)
* The (n-1) elements of the first super-diagonal of U.
*
* DU2 (input) DOUBLE PRECISION array, dimension (N-2)
* The (n-2) elements of the second super-diagonal of U.
*
* IPIV (input) INTEGER array, dimension (N)
* The pivot indices; for 1 <= i <= n, row i of the matrix was
* interchanged with row IPIV(i). IPIV(i) will always be either
* i or i+1; IPIV(i) = i indicates a row interchange was not
* required.
*
* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
* On entry, the matrix of right hand side vectors B.
* On exit, B is overwritten by 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 = -i, the i-th argument had an illegal value
*
* =====================================================================
*
* .. Local Scalars ..
LOGICAL NOTRAN
INTEGER ITRANS, J, JB, NB
* ..
* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
* ..
* .. External Subroutines ..
EXTERNAL DGTTS2, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
* ..
* .. Executable Statements ..
*
INFO = 0
NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' )
IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ.
$ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( NRHS.LT.0 ) THEN
INFO = -3
ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
INFO = -10
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGTTRS', -INFO )
RETURN
END IF
*
* Quick return if possible
*
IF( N.EQ.0 .OR. NRHS.EQ.0 )
$ RETURN
*
* Decode TRANS
*
IF( NOTRAN ) THEN
ITRANS = 0
ELSE
ITRANS = 1
END IF
*
* 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, 'DGTTRS', TRANS, N, NRHS, -1, -1 ) )
END IF
*
IF( NB.GE.NRHS ) THEN
CALL DGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
ELSE
DO 10 J = 1, NRHS, NB
JB = MIN( NRHS-J+1, NB )
CALL DGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ),
$ LDB )
10 CONTINUE
END IF
*
* End of DGTTRS
*
END
|