00001 SUBROUTINE SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, 00002 $ INFO ) 00003 * 00004 * -- LAPACK routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER TRANS 00011 INTEGER INFO, LDB, N, NRHS 00012 * .. 00013 * .. Array Arguments .. 00014 INTEGER IPIV( * ) 00015 REAL B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * SGTTRS solves one of the systems of equations 00022 * A*X = B or A'*X = B, 00023 * with a tridiagonal matrix A using the LU factorization computed 00024 * by SGTTRF. 00025 * 00026 * Arguments 00027 * ========= 00028 * 00029 * TRANS (input) CHARACTER*1 00030 * Specifies the form of the system of equations. 00031 * = 'N': A * X = B (No transpose) 00032 * = 'T': A'* X = B (Transpose) 00033 * = 'C': A'* X = B (Conjugate transpose = Transpose) 00034 * 00035 * N (input) INTEGER 00036 * The order of the matrix A. 00037 * 00038 * NRHS (input) INTEGER 00039 * The number of right hand sides, i.e., the number of columns 00040 * of the matrix B. NRHS >= 0. 00041 * 00042 * DL (input) REAL array, dimension (N-1) 00043 * The (n-1) multipliers that define the matrix L from the 00044 * LU factorization of A. 00045 * 00046 * D (input) REAL array, dimension (N) 00047 * The n diagonal elements of the upper triangular matrix U from 00048 * the LU factorization of A. 00049 * 00050 * DU (input) REAL array, dimension (N-1) 00051 * The (n-1) elements of the first super-diagonal of U. 00052 * 00053 * DU2 (input) REAL array, dimension (N-2) 00054 * The (n-2) elements of the second super-diagonal of U. 00055 * 00056 * IPIV (input) INTEGER array, dimension (N) 00057 * The pivot indices; for 1 <= i <= n, row i of the matrix was 00058 * interchanged with row IPIV(i). IPIV(i) will always be either 00059 * i or i+1; IPIV(i) = i indicates a row interchange was not 00060 * required. 00061 * 00062 * B (input/output) REAL array, dimension (LDB,NRHS) 00063 * On entry, the matrix of right hand side vectors B. 00064 * On exit, B is overwritten by the solution vectors X. 00065 * 00066 * LDB (input) INTEGER 00067 * The leading dimension of the array B. LDB >= max(1,N). 00068 * 00069 * INFO (output) INTEGER 00070 * = 0: successful exit 00071 * < 0: if INFO = -i, the i-th argument had an illegal value 00072 * 00073 * ===================================================================== 00074 * 00075 * .. Local Scalars .. 00076 LOGICAL NOTRAN 00077 INTEGER ITRANS, J, JB, NB 00078 * .. 00079 * .. External Functions .. 00080 INTEGER ILAENV 00081 EXTERNAL ILAENV 00082 * .. 00083 * .. External Subroutines .. 00084 EXTERNAL SGTTS2, XERBLA 00085 * .. 00086 * .. Intrinsic Functions .. 00087 INTRINSIC MAX, MIN 00088 * .. 00089 * .. Executable Statements .. 00090 * 00091 INFO = 0 00092 NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' ) 00093 IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ. 00094 $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN 00095 INFO = -1 00096 ELSE IF( N.LT.0 ) THEN 00097 INFO = -2 00098 ELSE IF( NRHS.LT.0 ) THEN 00099 INFO = -3 00100 ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN 00101 INFO = -10 00102 END IF 00103 IF( INFO.NE.0 ) THEN 00104 CALL XERBLA( 'SGTTRS', -INFO ) 00105 RETURN 00106 END IF 00107 * 00108 * Quick return if possible 00109 * 00110 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 00111 $ RETURN 00112 * 00113 * Decode TRANS 00114 * 00115 IF( NOTRAN ) THEN 00116 ITRANS = 0 00117 ELSE 00118 ITRANS = 1 00119 END IF 00120 * 00121 * Determine the number of right-hand sides to solve at a time. 00122 * 00123 IF( NRHS.EQ.1 ) THEN 00124 NB = 1 00125 ELSE 00126 NB = MAX( 1, ILAENV( 1, 'SGTTRS', TRANS, N, NRHS, -1, -1 ) ) 00127 END IF 00128 * 00129 IF( NB.GE.NRHS ) THEN 00130 CALL SGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB ) 00131 ELSE 00132 DO 10 J = 1, NRHS, NB 00133 JB = MIN( NRHS-J+1, NB ) 00134 CALL SGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ), 00135 $ LDB ) 00136 10 CONTINUE 00137 END IF 00138 * 00139 * End of SGTTRS 00140 * 00141 END
1.7.2