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

◆ strsv()

subroutine strsv ( character  uplo,
character  trans,
character  diag,
integer  n,
real, dimension(lda,*)  a,
integer  lda,
real, dimension(*)  x,
integer  incx 
)

STRSV

Purpose:
 STRSV  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.

 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]A
          A is REAL array, dimension ( LDA, N )
           Before entry with  UPLO = 'U' or 'u', the leading n by n
           upper triangular part of the array A must contain the upper
           triangular matrix and the strictly lower triangular part of
           A is not referenced.
           Before entry with UPLO = 'L' or 'l', the leading n by n
           lower triangular part of the array A must contain the lower
           triangular matrix and the strictly upper triangular part of
           A is not referenced.
           Note that when  DIAG = 'U' or 'u', the diagonal elements of
           A are not referenced either, but are assumed to be unity.
[in]LDA
          LDA is INTEGER
           On entry, LDA specifies the first dimension of A as declared
           in the calling (sub) program. LDA must be at least
           max( 1, n ).
[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 148 of file strsv.f.

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