LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine dtrsv ( character  UPLO,
character  TRANS,
character  DIAG,
integer  N,
double precision, dimension(lda,*)  A,
integer  LDA,
double precision, dimension(*)  X,
integer  INCX 
)

DTRSV

Purpose:
 DTRSV  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 DOUBLE PRECISION 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 DOUBLE PRECISION 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.

  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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 145 of file dtrsv.f.

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