LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

## ◆ ztpsv()

 subroutine ztpsv ( character UPLO, character TRANS, character DIAG, integer N, complex*16, dimension(*) AP, complex*16, dimension(*) X, integer INCX )

ZTPSV

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

A*x = b,   or   A**T*x = b,   or   A**H*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**H*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 COMPLEX*16 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 COMPLEX*16 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.```
Date
December 2016
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 146 of file ztpsv.f.

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