LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ ctpsv()

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

CTPSV

Purpose:
 CTPSV  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 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 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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
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 ctpsv.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 AP(*),X(*)
158 * ..
159 *
160 * =====================================================================
161 *
162 * .. Parameters ..
163  COMPLEX ZERO
164  parameter(zero= (0.0e+0,0.0e+0))
165 * ..
166 * .. Local Scalars ..
167  COMPLEX 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 conjg
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('CTPSV ',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 - conjg(ap(k))*x(i)
307  k = k + 1
308  100 CONTINUE
309  IF (nounit) temp = temp/conjg(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 - conjg(ap(k))*x(ix)
328  ix = ix + incx
329  130 CONTINUE
330  IF (nounit) temp = temp/conjg(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 - conjg(ap(k))*x(i)
352  k = k - 1
353  160 CONTINUE
354  IF (nounit) temp = temp/conjg(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 - conjg(ap(k))*x(ix)
374  ix = ix - incx
375  190 CONTINUE
376  IF (nounit) temp = temp/conjg(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 CTPSV .
389 *
Here is the call graph for this function:
Here is the caller graph for this function:
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55