 LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ dtpsv()

 subroutine dtpsv ( character UPLO, character TRANS, character DIAG, integer N, double precision, dimension(*) AP, double precision, dimension(*) X, integer INCX )

DTPSV

Purpose:
``` DTPSV  solves one of the systems of equations

A*x = b,   or   A**T*x = b,

where b and x are n element vectors and A is an n by n unit, or
non-unit, upper or lower triangular matrix, supplied in packed form.

No test for singularity or near-singularity is included in this
routine. Such tests must be performed before calling this routine.```
Parameters
 [in] UPLO ``` UPLO is CHARACTER*1 On entry, UPLO specifies whether the matrix is an upper or lower triangular matrix as follows: UPLO = 'U' or 'u' A is an upper triangular matrix. UPLO = 'L' or 'l' A is a lower triangular matrix.``` [in] TRANS ``` TRANS is CHARACTER*1 On entry, TRANS specifies the equations to be solved as follows: TRANS = 'N' or 'n' A*x = b. TRANS = 'T' or 't' A**T*x = b. TRANS = 'C' or 'c' A**T*x = b.``` [in] DIAG ``` DIAG is CHARACTER*1 On entry, DIAG specifies whether or not A is unit triangular as follows: DIAG = 'U' or 'u' A is assumed to be unit triangular. DIAG = 'N' or 'n' A is not assumed to be unit triangular.``` [in] N ``` N is INTEGER On entry, N specifies the order of the matrix A. N must be at least zero.``` [in] AP ``` AP is DOUBLE PRECISION array, dimension at least ( ( n*( n + 1 ) )/2 ). Before entry with UPLO = 'U' or 'u', the array AP must contain the upper triangular matrix packed sequentially, column by column, so that AP( 1 ) contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 ) respectively, and so on. Before entry with UPLO = 'L' or 'l', the array AP must contain the lower triangular matrix packed sequentially, column by column, so that AP( 1 ) contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 ) respectively, and so on. Note that when DIAG = 'U' or 'u', the diagonal elements of A are not referenced, but are assumed to be unity.``` [in,out] X ``` X is DOUBLE PRECISION array, dimension at least ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented array X must contain the n element right-hand side vector b. On exit, X is overwritten with the solution vector x.``` [in] INCX ``` INCX is INTEGER On entry, INCX specifies the increment for the elements of X. INCX must not be zero.```
Further Details:
```  Level 2 Blas routine.

-- Written on 22-October-1986.
Jack Dongarra, Argonne National Lab.
Jeremy Du Croz, Nag Central Office.
Sven Hammarling, Nag Central Office.
Richard Hanson, Sandia National Labs.```

Definition at line 143 of file dtpsv.f.

144*
145* -- Reference BLAS level2 routine --
146* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
147* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
148*
149* .. Scalar Arguments ..
150 INTEGER INCX,N
151 CHARACTER DIAG,TRANS,UPLO
152* ..
153* .. Array Arguments ..
154 DOUBLE PRECISION AP(*),X(*)
155* ..
156*
157* =====================================================================
158*
159* .. Parameters ..
160 DOUBLE PRECISION ZERO
161 parameter(zero=0.0d+0)
162* ..
163* .. Local Scalars ..
164 DOUBLE PRECISION TEMP
165 INTEGER I,INFO,IX,J,JX,K,KK,KX
166 LOGICAL NOUNIT
167* ..
168* .. External Functions ..
169 LOGICAL LSAME
170 EXTERNAL lsame
171* ..
172* .. External Subroutines ..
173 EXTERNAL xerbla
174* ..
175*
176* Test the input parameters.
177*
178 info = 0
179 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
180 info = 1
181 ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
182 + .NOT.lsame(trans,'C')) THEN
183 info = 2
184 ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
185 info = 3
186 ELSE IF (n.LT.0) THEN
187 info = 4
188 ELSE IF (incx.EQ.0) THEN
189 info = 7
190 END IF
191 IF (info.NE.0) THEN
192 CALL xerbla('DTPSV ',info)
193 RETURN
194 END IF
195*
196* Quick return if possible.
197*
198 IF (n.EQ.0) RETURN
199*
200 nounit = lsame(diag,'N')
201*
202* Set up the start point in X if the increment is not unity. This
203* will be ( N - 1 )*INCX too small for descending loops.
204*
205 IF (incx.LE.0) THEN
206 kx = 1 - (n-1)*incx
207 ELSE IF (incx.NE.1) THEN
208 kx = 1
209 END IF
210*
211* Start the operations. In this version the elements of AP are
212* accessed sequentially with one pass through AP.
213*
214 IF (lsame(trans,'N')) THEN
215*
216* Form x := inv( A )*x.
217*
218 IF (lsame(uplo,'U')) THEN
219 kk = (n* (n+1))/2
220 IF (incx.EQ.1) THEN
221 DO 20 j = n,1,-1
222 IF (x(j).NE.zero) THEN
223 IF (nounit) x(j) = x(j)/ap(kk)
224 temp = x(j)
225 k = kk - 1
226 DO 10 i = j - 1,1,-1
227 x(i) = x(i) - temp*ap(k)
228 k = k - 1
229 10 CONTINUE
230 END IF
231 kk = kk - j
232 20 CONTINUE
233 ELSE
234 jx = kx + (n-1)*incx
235 DO 40 j = n,1,-1
236 IF (x(jx).NE.zero) THEN
237 IF (nounit) x(jx) = x(jx)/ap(kk)
238 temp = x(jx)
239 ix = jx
240 DO 30 k = kk - 1,kk - j + 1,-1
241 ix = ix - incx
242 x(ix) = x(ix) - temp*ap(k)
243 30 CONTINUE
244 END IF
245 jx = jx - incx
246 kk = kk - j
247 40 CONTINUE
248 END IF
249 ELSE
250 kk = 1
251 IF (incx.EQ.1) THEN
252 DO 60 j = 1,n
253 IF (x(j).NE.zero) THEN
254 IF (nounit) x(j) = x(j)/ap(kk)
255 temp = x(j)
256 k = kk + 1
257 DO 50 i = j + 1,n
258 x(i) = x(i) - temp*ap(k)
259 k = k + 1
260 50 CONTINUE
261 END IF
262 kk = kk + (n-j+1)
263 60 CONTINUE
264 ELSE
265 jx = kx
266 DO 80 j = 1,n
267 IF (x(jx).NE.zero) THEN
268 IF (nounit) x(jx) = x(jx)/ap(kk)
269 temp = x(jx)
270 ix = jx
271 DO 70 k = kk + 1,kk + n - j
272 ix = ix + incx
273 x(ix) = x(ix) - temp*ap(k)
274 70 CONTINUE
275 END IF
276 jx = jx + incx
277 kk = kk + (n-j+1)
278 80 CONTINUE
279 END IF
280 END IF
281 ELSE
282*
283* Form x := inv( A**T )*x.
284*
285 IF (lsame(uplo,'U')) THEN
286 kk = 1
287 IF (incx.EQ.1) THEN
288 DO 100 j = 1,n
289 temp = x(j)
290 k = kk
291 DO 90 i = 1,j - 1
292 temp = temp - ap(k)*x(i)
293 k = k + 1
294 90 CONTINUE
295 IF (nounit) temp = temp/ap(kk+j-1)
296 x(j) = temp
297 kk = kk + j
298 100 CONTINUE
299 ELSE
300 jx = kx
301 DO 120 j = 1,n
302 temp = x(jx)
303 ix = kx
304 DO 110 k = kk,kk + j - 2
305 temp = temp - ap(k)*x(ix)
306 ix = ix + incx
307 110 CONTINUE
308 IF (nounit) temp = temp/ap(kk+j-1)
309 x(jx) = temp
310 jx = jx + incx
311 kk = kk + j
312 120 CONTINUE
313 END IF
314 ELSE
315 kk = (n* (n+1))/2
316 IF (incx.EQ.1) THEN
317 DO 140 j = n,1,-1
318 temp = x(j)
319 k = kk
320 DO 130 i = n,j + 1,-1
321 temp = temp - ap(k)*x(i)
322 k = k - 1
323 130 CONTINUE
324 IF (nounit) temp = temp/ap(kk-n+j)
325 x(j) = temp
326 kk = kk - (n-j+1)
327 140 CONTINUE
328 ELSE
329 kx = kx + (n-1)*incx
330 jx = kx
331 DO 160 j = n,1,-1
332 temp = x(jx)
333 ix = kx
334 DO 150 k = kk,kk - (n- (j+1)),-1
335 temp = temp - ap(k)*x(ix)
336 ix = ix - incx
337 150 CONTINUE
338 IF (nounit) temp = temp/ap(kk-n+j)
339 x(jx) = temp
340 jx = jx - incx
341 kk = kk - (n-j+1)
342 160 CONTINUE
343 END IF
344 END IF
345 END IF
346*
347 RETURN
348*
349* End of DTPSV
350*
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
Here is the call graph for this function:
Here is the caller graph for this function: