 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE CPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO ) 00002 * 00003 * -- LAPACK routine (version 3.3.1) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * -- April 2011 -- 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER UPLO 00010 INTEGER INFO, LDB, N, NRHS 00011 * .. 00012 * .. Array Arguments .. 00013 REAL D( * ) 00014 COMPLEX B( LDB, * ), E( * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * CPTTRS solves a tridiagonal system of the form 00021 * A * X = B 00022 * using the factorization A = U**H*D*U or A = L*D*L**H computed by CPTTRF. 00023 * D is a diagonal matrix specified in the vector D, U (or L) is a unit 00024 * bidiagonal matrix whose superdiagonal (subdiagonal) is specified in 00025 * the vector E, and X and B are N by NRHS matrices. 00026 * 00027 * Arguments 00028 * ========= 00029 * 00030 * UPLO (input) CHARACTER*1 00031 * Specifies the form of the factorization and whether the 00032 * vector E is the superdiagonal of the upper bidiagonal factor 00033 * U or the subdiagonal of the lower bidiagonal factor L. 00034 * = 'U': A = U**H*D*U, E is the superdiagonal of U 00035 * = 'L': A = L*D*L**H, E is the subdiagonal of L 00036 * 00037 * N (input) INTEGER 00038 * The order of the tridiagonal matrix A. N >= 0. 00039 * 00040 * NRHS (input) INTEGER 00041 * The number of right hand sides, i.e., the number of columns 00042 * of the matrix B. NRHS >= 0. 00043 * 00044 * D (input) REAL array, dimension (N) 00045 * The n diagonal elements of the diagonal matrix D from the 00046 * factorization A = U**H*D*U or A = L*D*L**H. 00047 * 00048 * E (input) COMPLEX array, dimension (N-1) 00049 * If UPLO = 'U', the (n-1) superdiagonal elements of the unit 00050 * bidiagonal factor U from the factorization A = U**H*D*U. 00051 * If UPLO = 'L', the (n-1) subdiagonal elements of the unit 00052 * bidiagonal factor L from the factorization A = L*D*L**H. 00053 * 00054 * B (input/output) REAL array, dimension (LDB,NRHS) 00055 * On entry, the right hand side vectors B for the system of 00056 * linear equations. 00057 * On exit, the solution vectors, X. 00058 * 00059 * LDB (input) INTEGER 00060 * The leading dimension of the array B. LDB >= max(1,N). 00061 * 00062 * INFO (output) INTEGER 00063 * = 0: successful exit 00064 * < 0: if INFO = -k, the k-th argument had an illegal value 00065 * 00066 * ===================================================================== 00067 * 00068 * .. Local Scalars .. 00069 LOGICAL UPPER 00070 INTEGER IUPLO, J, JB, NB 00071 * .. 00072 * .. External Functions .. 00073 INTEGER ILAENV 00074 EXTERNAL ILAENV 00075 * .. 00076 * .. External Subroutines .. 00077 EXTERNAL CPTTS2, XERBLA 00078 * .. 00079 * .. Intrinsic Functions .. 00080 INTRINSIC MAX, MIN 00081 * .. 00082 * .. Executable Statements .. 00083 * 00084 * Test the input arguments. 00085 * 00086 INFO = 0 00087 UPPER = ( UPLO.EQ.'U' .OR. UPLO.EQ.'u' ) 00088 IF( .NOT.UPPER .AND. .NOT.( UPLO.EQ.'L' .OR. UPLO.EQ.'l' ) ) THEN 00089 INFO = -1 00090 ELSE IF( N.LT.0 ) THEN 00091 INFO = -2 00092 ELSE IF( NRHS.LT.0 ) THEN 00093 INFO = -3 00094 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00095 INFO = -7 00096 END IF 00097 IF( INFO.NE.0 ) THEN 00098 CALL XERBLA( 'CPTTRS', -INFO ) 00099 RETURN 00100 END IF 00101 * 00102 * Quick return if possible 00103 * 00104 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 00105 $ RETURN 00106 * 00107 * Determine the number of right-hand sides to solve at a time. 00108 * 00109 IF( NRHS.EQ.1 ) THEN 00110 NB = 1 00111 ELSE 00112 NB = MAX( 1, ILAENV( 1, 'CPTTRS', UPLO, N, NRHS, -1, -1 ) ) 00113 END IF 00114 * 00115 * Decode UPLO 00116 * 00117 IF( UPPER ) THEN 00118 IUPLO = 1 00119 ELSE 00120 IUPLO = 0 00121 END IF 00122 * 00123 IF( NB.GE.NRHS ) THEN 00124 CALL CPTTS2( IUPLO, N, NRHS, D, E, B, LDB ) 00125 ELSE 00126 DO 10 J = 1, NRHS, NB 00127 JB = MIN( NRHS-J+1, NB ) 00128 CALL CPTTS2( IUPLO, N, JB, D, E, B( 1, J ), LDB ) 00129 10 CONTINUE 00130 END IF 00131 * 00132 RETURN 00133 * 00134 * End of CPTTRS 00135 * 00136 END
1.7.3 
