LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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 of 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 of 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.
Date
November 2011
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 151 of file strsv.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: