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

◆ 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*
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
lsame
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: