LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
stptrs.f
Go to the documentation of this file.
1 *> \brief \b STPTRS
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download STPTRS + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stptrs.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stptrs.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stptrs.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE STPTRS( 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 * REAL AP( * ), B( LDB, * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> STPTRS 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 REAL 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 REAL 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 *> \date November 2011
127 *
128 *> \ingroup realOTHERcomputational
129 *
130 * =====================================================================
131  SUBROUTINE stptrs( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO )
132 *
133 * -- LAPACK computational routine (version 3.4.0) --
134 * -- LAPACK is a software package provided by Univ. of Tennessee, --
135 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
136 * November 2011
137 *
138 * .. Scalar Arguments ..
139  CHARACTER diag, trans, uplo
140  INTEGER info, ldb, n, nrhs
141 * ..
142 * .. Array Arguments ..
143  REAL ap( * ), b( ldb, * )
144 * ..
145 *
146 * =====================================================================
147 *
148 * .. Parameters ..
149  REAL zero
150  parameter( zero = 0.0e+0 )
151 * ..
152 * .. Local Scalars ..
153  LOGICAL nounit, upper
154  INTEGER j, jc
155 * ..
156 * .. External Functions ..
157  LOGICAL lsame
158  EXTERNAL lsame
159 * ..
160 * .. External Subroutines ..
161  EXTERNAL stpsv, xerbla
162 * ..
163 * .. Intrinsic Functions ..
164  INTRINSIC max
165 * ..
166 * .. Executable Statements ..
167 *
168 * Test the input parameters.
169 *
170  info = 0
171  upper = lsame( uplo, 'U' )
172  nounit = lsame( diag, 'N' )
173  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
174  info = -1
175  ELSE IF( .NOT.lsame( trans, 'N' ) .AND. .NOT.
176  $ lsame( trans, 'T' ) .AND. .NOT.lsame( trans, 'C' ) ) THEN
177  info = -2
178  ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag, 'U' ) ) THEN
179  info = -3
180  ELSE IF( n.LT.0 ) THEN
181  info = -4
182  ELSE IF( nrhs.LT.0 ) THEN
183  info = -5
184  ELSE IF( ldb.LT.max( 1, n ) ) THEN
185  info = -8
186  END IF
187  IF( info.NE.0 ) THEN
188  CALL xerbla( 'STPTRS', -info )
189  return
190  END IF
191 *
192 * Quick return if possible
193 *
194  IF( n.EQ.0 )
195  $ return
196 *
197 * Check for singularity.
198 *
199  IF( nounit ) THEN
200  IF( upper ) THEN
201  jc = 1
202  DO 10 info = 1, n
203  IF( ap( jc+info-1 ).EQ.zero )
204  $ return
205  jc = jc + info
206  10 continue
207  ELSE
208  jc = 1
209  DO 20 info = 1, n
210  IF( ap( jc ).EQ.zero )
211  $ return
212  jc = jc + n - info + 1
213  20 continue
214  END IF
215  END IF
216  info = 0
217 *
218 * Solve A * x = b or A**T * x = b.
219 *
220  DO 30 j = 1, nrhs
221  CALL stpsv( uplo, trans, diag, n, ap, b( 1, j ), 1 )
222  30 continue
223 *
224  return
225 *
226 * End of STPTRS
227 *
228  END