|
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 SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
$ INFO ) * * -- LAPACK routine (version 3.2) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2006 * * .. Scalar Arguments .. CHARACTER TRANS INTEGER INFO, LDB, N, NRHS * .. * .. Array Arguments .. INTEGER IPIV( * ) REAL B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * ) * .. * * Purpose * ======= * * SGTTRS solves one of the systems of equations * A*X = B or A**T*X = B, * with a tridiagonal matrix A using the LU factorization computed * by SGTTRF. * * Arguments * ========= * * TRANS (input) CHARACTER*1 * Specifies the form of the system of equations. * = 'N': A * X = B (No transpose) * = 'T': A**T* X = B (Transpose) * = 'C': A**T* 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) REAL array, dimension (N-1) * The (n-1) multipliers that define the matrix L from the * LU factorization of A. * * D (input) REAL array, dimension (N) * The n diagonal elements of the upper triangular matrix U from * the LU factorization of A. * * DU (input) REAL array, dimension (N-1) * The (n-1) elements of the first super-diagonal of U. * * DU2 (input) REAL 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) REAL 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 SGTTS2, 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( 'SGTTRS', -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, 'SGTTRS', TRANS, N, NRHS, -1, -1 ) ) END IF * IF( NB.GE.NRHS ) THEN CALL SGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB ) ELSE DO 10 J = 1, NRHS, NB JB = MIN( NRHS-J+1, NB ) CALL SGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ), $ LDB ) 10 CONTINUE END IF * * End of SGTTRS * END |