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