![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DTPTRS 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download DTPTRS + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtptrs.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtptrs.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtptrs.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER DIAG, TRANS, UPLO 00025 * INTEGER INFO, LDB, N, NRHS 00026 * .. 00027 * .. Array Arguments .. 00028 * DOUBLE PRECISION AP( * ), B( LDB, * ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> DTPTRS solves a triangular system of the form 00038 *> 00039 *> A * X = B or A**T * X = B, 00040 *> 00041 *> where A is a triangular matrix of order N stored in packed format, 00042 *> and B is an N-by-NRHS matrix. A check is made to verify that A is 00043 *> nonsingular. 00044 *> \endverbatim 00045 * 00046 * Arguments: 00047 * ========== 00048 * 00049 *> \param[in] UPLO 00050 *> \verbatim 00051 *> UPLO is CHARACTER*1 00052 *> = 'U': A is upper triangular; 00053 *> = 'L': A is lower triangular. 00054 *> \endverbatim 00055 *> 00056 *> \param[in] TRANS 00057 *> \verbatim 00058 *> TRANS is CHARACTER*1 00059 *> Specifies the form of the system of equations: 00060 *> = 'N': A * X = B (No transpose) 00061 *> = 'T': A**T * X = B (Transpose) 00062 *> = 'C': A**H * X = B (Conjugate transpose = Transpose) 00063 *> \endverbatim 00064 *> 00065 *> \param[in] DIAG 00066 *> \verbatim 00067 *> DIAG is CHARACTER*1 00068 *> = 'N': A is non-unit triangular; 00069 *> = 'U': A is unit triangular. 00070 *> \endverbatim 00071 *> 00072 *> \param[in] N 00073 *> \verbatim 00074 *> N is INTEGER 00075 *> The order of the matrix A. N >= 0. 00076 *> \endverbatim 00077 *> 00078 *> \param[in] NRHS 00079 *> \verbatim 00080 *> NRHS is INTEGER 00081 *> The number of right hand sides, i.e., the number of columns 00082 *> of the matrix B. NRHS >= 0. 00083 *> \endverbatim 00084 *> 00085 *> \param[in] AP 00086 *> \verbatim 00087 *> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2) 00088 *> The upper or lower triangular matrix A, packed columnwise in 00089 *> a linear array. The j-th column of A is stored in the array 00090 *> AP as follows: 00091 *> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j; 00092 *> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n. 00093 *> \endverbatim 00094 *> 00095 *> \param[in,out] B 00096 *> \verbatim 00097 *> B is DOUBLE PRECISION array, dimension (LDB,NRHS) 00098 *> On entry, the right hand side matrix B. 00099 *> On exit, if INFO = 0, the solution matrix X. 00100 *> \endverbatim 00101 *> 00102 *> \param[in] LDB 00103 *> \verbatim 00104 *> LDB is INTEGER 00105 *> The leading dimension of the array B. LDB >= max(1,N). 00106 *> \endverbatim 00107 *> 00108 *> \param[out] INFO 00109 *> \verbatim 00110 *> INFO is INTEGER 00111 *> = 0: successful exit 00112 *> < 0: if INFO = -i, the i-th argument had an illegal value 00113 *> > 0: if INFO = i, the i-th diagonal element of A is zero, 00114 *> indicating that the matrix is singular and the 00115 *> solutions X have not been computed. 00116 *> \endverbatim 00117 * 00118 * Authors: 00119 * ======== 00120 * 00121 *> \author Univ. of Tennessee 00122 *> \author Univ. of California Berkeley 00123 *> \author Univ. of Colorado Denver 00124 *> \author NAG Ltd. 00125 * 00126 *> \date November 2011 00127 * 00128 *> \ingroup doubleOTHERcomputational 00129 * 00130 * ===================================================================== 00131 SUBROUTINE DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO ) 00132 * 00133 * -- LAPACK computational routine (version 3.4.0) -- 00134 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00135 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00136 * November 2011 00137 * 00138 * .. Scalar Arguments .. 00139 CHARACTER DIAG, TRANS, UPLO 00140 INTEGER INFO, LDB, N, NRHS 00141 * .. 00142 * .. Array Arguments .. 00143 DOUBLE PRECISION AP( * ), B( LDB, * ) 00144 * .. 00145 * 00146 * ===================================================================== 00147 * 00148 * .. Parameters .. 00149 DOUBLE PRECISION ZERO 00150 PARAMETER ( ZERO = 0.0D+0 ) 00151 * .. 00152 * .. Local Scalars .. 00153 LOGICAL NOUNIT, UPPER 00154 INTEGER J, JC 00155 * .. 00156 * .. External Functions .. 00157 LOGICAL LSAME 00158 EXTERNAL LSAME 00159 * .. 00160 * .. External Subroutines .. 00161 EXTERNAL DTPSV, XERBLA 00162 * .. 00163 * .. Intrinsic Functions .. 00164 INTRINSIC MAX 00165 * .. 00166 * .. Executable Statements .. 00167 * 00168 * Test the input parameters. 00169 * 00170 INFO = 0 00171 UPPER = LSAME( UPLO, 'U' ) 00172 NOUNIT = LSAME( DIAG, 'N' ) 00173 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00174 INFO = -1 00175 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. 00176 $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN 00177 INFO = -2 00178 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN 00179 INFO = -3 00180 ELSE IF( N.LT.0 ) THEN 00181 INFO = -4 00182 ELSE IF( NRHS.LT.0 ) THEN 00183 INFO = -5 00184 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00185 INFO = -8 00186 END IF 00187 IF( INFO.NE.0 ) THEN 00188 CALL XERBLA( 'DTPTRS', -INFO ) 00189 RETURN 00190 END IF 00191 * 00192 * Quick return if possible 00193 * 00194 IF( N.EQ.0 ) 00195 $ RETURN 00196 * 00197 * Check for singularity. 00198 * 00199 IF( NOUNIT ) THEN 00200 IF( UPPER ) THEN 00201 JC = 1 00202 DO 10 INFO = 1, N 00203 IF( AP( JC+INFO-1 ).EQ.ZERO ) 00204 $ RETURN 00205 JC = JC + INFO 00206 10 CONTINUE 00207 ELSE 00208 JC = 1 00209 DO 20 INFO = 1, N 00210 IF( AP( JC ).EQ.ZERO ) 00211 $ RETURN 00212 JC = JC + N - INFO + 1 00213 20 CONTINUE 00214 END IF 00215 END IF 00216 INFO = 0 00217 * 00218 * Solve A * x = b or A**T * x = b. 00219 * 00220 DO 30 J = 1, NRHS 00221 CALL DTPSV( UPLO, TRANS, DIAG, N, AP, B( 1, J ), 1 ) 00222 30 CONTINUE 00223 * 00224 RETURN 00225 * 00226 * End of DTPTRS 00227 * 00228 END