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

◆ stpsv()

subroutine stpsv ( character  uplo,
character  trans,
character  diag,
integer  n,
real, dimension(*)  ap,
real, dimension(*)  x,
integer  incx 
)

STPSV

Purpose:
 STPSV  solves one of the systems of equations

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