LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
dtptrs.f
Go to the documentation of this file.
1 *> \brief \b DTPTRS
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download DTPTRS + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtptrs.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtptrs.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtptrs.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER DIAG, TRANS, UPLO
25 * INTEGER INFO, LDB, N, NRHS
26 * ..
27 * .. Array Arguments ..
28 * DOUBLE PRECISION AP( * ), B( LDB, * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> DTPTRS solves a triangular system of the form
38 *>
39 *> A * X = B or A**T * X = B,
40 *>
41 *> where A is a triangular matrix of order N stored in packed format,
42 *> and B is an N-by-NRHS matrix. A check is made to verify that A is
43 *> nonsingular.
44 *> \endverbatim
45 *
46 * Arguments:
47 * ==========
48 *
49 *> \param[in] UPLO
50 *> \verbatim
51 *> UPLO is CHARACTER*1
52 *> = 'U': A is upper triangular;
53 *> = 'L': A is lower triangular.
54 *> \endverbatim
55 *>
56 *> \param[in] TRANS
57 *> \verbatim
58 *> TRANS is CHARACTER*1
59 *> Specifies the form of the system of equations:
60 *> = 'N': A * X = B (No transpose)
61 *> = 'T': A**T * X = B (Transpose)
62 *> = 'C': A**H * X = B (Conjugate transpose = Transpose)
63 *> \endverbatim
64 *>
65 *> \param[in] DIAG
66 *> \verbatim
67 *> DIAG is CHARACTER*1
68 *> = 'N': A is non-unit triangular;
69 *> = 'U': A is unit triangular.
70 *> \endverbatim
71 *>
72 *> \param[in] N
73 *> \verbatim
74 *> N is INTEGER
75 *> The order of the matrix A. N >= 0.
76 *> \endverbatim
77 *>
78 *> \param[in] NRHS
79 *> \verbatim
80 *> NRHS is INTEGER
81 *> The number of right hand sides, i.e., the number of columns
82 *> of the matrix B. NRHS >= 0.
83 *> \endverbatim
84 *>
85 *> \param[in] AP
86 *> \verbatim
87 *> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
88 *> The upper or lower triangular matrix A, packed columnwise in
89 *> a linear array. The j-th column of A is stored in the array
90 *> AP as follows:
91 *> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
92 *> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
93 *> \endverbatim
94 *>
95 *> \param[in,out] B
96 *> \verbatim
97 *> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
98 *> On entry, the right hand side matrix B.
99 *> On exit, if INFO = 0, the solution matrix X.
100 *> \endverbatim
101 *>
102 *> \param[in] LDB
103 *> \verbatim
104 *> LDB is INTEGER
105 *> The leading dimension of the array B. LDB >= max(1,N).
106 *> \endverbatim
107 *>
108 *> \param[out] INFO
109 *> \verbatim
110 *> INFO is INTEGER
111 *> = 0: successful exit
112 *> < 0: if INFO = -i, the i-th argument had an illegal value
113 *> > 0: if INFO = i, the i-th diagonal element of A is zero,
114 *> indicating that the matrix is singular and the
115 *> solutions X have not been computed.
116 *> \endverbatim
117 *
118 * Authors:
119 * ========
120 *
121 *> \author Univ. of Tennessee
122 *> \author Univ. of California Berkeley
123 *> \author Univ. of Colorado Denver
124 *> \author NAG Ltd.
125 *
126 *> \ingroup doubleOTHERcomputational
127 *
128 * =====================================================================
129  SUBROUTINE dtptrs( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO )
130 *
131 * -- LAPACK computational routine --
132 * -- LAPACK is a software package provided by Univ. of Tennessee, --
133 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134 *
135 * .. Scalar Arguments ..
136  CHARACTER DIAG, TRANS, UPLO
137  INTEGER INFO, LDB, N, NRHS
138 * ..
139 * .. Array Arguments ..
140  DOUBLE PRECISION AP( * ), B( LDB, * )
141 * ..
142 *
143 * =====================================================================
144 *
145 * .. Parameters ..
146  DOUBLE PRECISION ZERO
147  parameter( zero = 0.0d+0 )
148 * ..
149 * .. Local Scalars ..
150  LOGICAL NOUNIT, UPPER
151  INTEGER J, JC
152 * ..
153 * .. External Functions ..
154  LOGICAL LSAME
155  EXTERNAL lsame
156 * ..
157 * .. External Subroutines ..
158  EXTERNAL dtpsv, xerbla
159 * ..
160 * .. Intrinsic Functions ..
161  INTRINSIC max
162 * ..
163 * .. Executable Statements ..
164 *
165 * Test the input parameters.
166 *
167  info = 0
168  upper = lsame( uplo, 'U' )
169  nounit = lsame( diag, 'N' )
170  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
171  info = -1
172  ELSE IF( .NOT.lsame( trans, 'N' ) .AND. .NOT.
173  $ lsame( trans, 'T' ) .AND. .NOT.lsame( trans, 'C' ) ) THEN
174  info = -2
175  ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag, 'U' ) ) THEN
176  info = -3
177  ELSE IF( n.LT.0 ) THEN
178  info = -4
179  ELSE IF( nrhs.LT.0 ) THEN
180  info = -5
181  ELSE IF( ldb.LT.max( 1, n ) ) THEN
182  info = -8
183  END IF
184  IF( info.NE.0 ) THEN
185  CALL xerbla( 'DTPTRS', -info )
186  RETURN
187  END IF
188 *
189 * Quick return if possible
190 *
191  IF( n.EQ.0 )
192  $ RETURN
193 *
194 * Check for singularity.
195 *
196  IF( nounit ) THEN
197  IF( upper ) THEN
198  jc = 1
199  DO 10 info = 1, n
200  IF( ap( jc+info-1 ).EQ.zero )
201  $ RETURN
202  jc = jc + info
203  10 CONTINUE
204  ELSE
205  jc = 1
206  DO 20 info = 1, n
207  IF( ap( jc ).EQ.zero )
208  $ RETURN
209  jc = jc + n - info + 1
210  20 CONTINUE
211  END IF
212  END IF
213  info = 0
214 *
215 * Solve A * x = b or A**T * x = b.
216 *
217  DO 30 j = 1, nrhs
218  CALL dtpsv( uplo, trans, diag, n, ap, b( 1, j ), 1 )
219  30 CONTINUE
220 *
221  RETURN
222 *
223 * End of DTPTRS
224 *
225  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine dtpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
DTPSV
Definition: dtpsv.f:144
subroutine dtptrs(UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO)
DTPTRS
Definition: dtptrs.f:130