LAPACK 3.11.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. .NOT.lsame(trans,'T') .AND.
190 + .NOT.lsame(trans,'C')) THEN
191 info = 2
192 ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
193 info = 3
194 ELSE IF (n.LT.0) THEN
195 info = 4
196 ELSE IF (lda.LT.max(1,n)) THEN
197 info = 6
198 ELSE IF (incx.EQ.0) THEN
199 info = 8
200 END IF
201 IF (info.NE.0) THEN
202 CALL xerbla('STRSV ',info)
203 RETURN
204 END IF
205*
206* Quick return if possible.
207*
208 IF (n.EQ.0) RETURN
209*
210 nounit = lsame(diag,'N')
211*
212* Set up the start point in X if the increment is not unity. This
213* will be ( N - 1 )*INCX too small for descending loops.
214*
215 IF (incx.LE.0) THEN
216 kx = 1 - (n-1)*incx
217 ELSE IF (incx.NE.1) THEN
218 kx = 1
219 END IF
220*
221* Start the operations. In this version the elements of A are
222* accessed sequentially with one pass through A.
223*
224 IF (lsame(trans,'N')) THEN
225*
226* Form x := inv( A )*x.
227*
228 IF (lsame(uplo,'U')) THEN
229 IF (incx.EQ.1) THEN
230 DO 20 j = n,1,-1
231 IF (x(j).NE.zero) THEN
232 IF (nounit) x(j) = x(j)/a(j,j)
233 temp = x(j)
234 DO 10 i = j - 1,1,-1
235 x(i) = x(i) - temp*a(i,j)
236 10 CONTINUE
237 END IF
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)/a(j,j)
244 temp = x(jx)
245 ix = jx
246 DO 30 i = j - 1,1,-1
247 ix = ix - incx
248 x(ix) = x(ix) - temp*a(i,j)
249 30 CONTINUE
250 END IF
251 jx = jx - incx
252 40 CONTINUE
253 END IF
254 ELSE
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)/a(j,j)
259 temp = x(j)
260 DO 50 i = j + 1,n
261 x(i) = x(i) - temp*a(i,j)
262 50 CONTINUE
263 END IF
264 60 CONTINUE
265 ELSE
266 jx = kx
267 DO 80 j = 1,n
268 IF (x(jx).NE.zero) THEN
269 IF (nounit) x(jx) = x(jx)/a(j,j)
270 temp = x(jx)
271 ix = jx
272 DO 70 i = j + 1,n
273 ix = ix + incx
274 x(ix) = x(ix) - temp*a(i,j)
275 70 CONTINUE
276 END IF
277 jx = jx + incx
278 80 CONTINUE
279 END IF
280 END IF
281 ELSE
282*
283* Form x := inv( A**T )*x.
284*
285 IF (lsame(uplo,'U')) THEN
286 IF (incx.EQ.1) THEN
287 DO 100 j = 1,n
288 temp = x(j)
289 DO 90 i = 1,j - 1
290 temp = temp - a(i,j)*x(i)
291 90 CONTINUE
292 IF (nounit) temp = temp/a(j,j)
293 x(j) = temp
294 100 CONTINUE
295 ELSE
296 jx = kx
297 DO 120 j = 1,n
298 temp = x(jx)
299 ix = kx
300 DO 110 i = 1,j - 1
301 temp = temp - a(i,j)*x(ix)
302 ix = ix + incx
303 110 CONTINUE
304 IF (nounit) temp = temp/a(j,j)
305 x(jx) = temp
306 jx = jx + incx
307 120 CONTINUE
308 END IF
309 ELSE
310 IF (incx.EQ.1) THEN
311 DO 140 j = n,1,-1
312 temp = x(j)
313 DO 130 i = n,j + 1,-1
314 temp = temp - a(i,j)*x(i)
315 130 CONTINUE
316 IF (nounit) temp = temp/a(j,j)
317 x(j) = temp
318 140 CONTINUE
319 ELSE
320 kx = kx + (n-1)*incx
321 jx = kx
322 DO 160 j = n,1,-1
323 temp = x(jx)
324 ix = kx
325 DO 150 i = n,j + 1,-1
326 temp = temp - a(i,j)*x(ix)
327 ix = ix - incx
328 150 CONTINUE
329 IF (nounit) temp = temp/a(j,j)
330 x(jx) = temp
331 jx = jx - incx
332 160 CONTINUE
333 END IF
334 END IF
335 END IF
336*
337 RETURN
338*
339* End of STRSV
340*
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: