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

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