Contents


NAME

     dtrsv - solve one of the systems of equations A*x  =  b,  or
     A'*x = b

SYNOPSIS

     SUBROUTINE DTRSV(UPLO, TRANSA, DIAG, N, A, LDA, Y, INCY)

     CHARACTER * 1 UPLO, TRANSA, DIAG
     INTEGER N, LDA, INCY
     DOUBLE PRECISION A(LDA,*), Y(*)

     SUBROUTINE DTRSV_64(UPLO, TRANSA, DIAG, N, A, LDA, Y, INCY)

     CHARACTER * 1 UPLO, TRANSA, DIAG
     INTEGER*8 N, LDA, INCY
     DOUBLE PRECISION A(LDA,*), Y(*)

  F95 INTERFACE
     SUBROUTINE TRSV(UPLO, [TRANSA], DIAG, [N], A, [LDA], Y, [INCY])

     CHARACTER(LEN=1) :: UPLO, TRANSA, DIAG
     INTEGER :: N, LDA, INCY
     REAL(8), DIMENSION(:) :: Y
     REAL(8), DIMENSION(:,:) :: A

     SUBROUTINE TRSV_64(UPLO, [TRANSA], DIAG, [N], A, [LDA], Y, [INCY])

     CHARACTER(LEN=1) :: UPLO, TRANSA, DIAG
     INTEGER(8) :: N, LDA, INCY
     REAL(8), DIMENSION(:) :: Y
     REAL(8), DIMENSION(:,:) :: A

  C INTERFACE
     #include <sunperf.h>

     void dtrsv(char uplo, char transa, char diag, int n,  double
               *a, int lda, double *y, int incy);

     void dtrsv_64(char uplo, char transa,  char  diag,  long  n,
               double *a, long lda, double *y, long incy);

PURPOSE

     dtrsv solves one of the systems of equations  A*x  =  b,  or
     A'*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.

ARGUMENTS

     UPLO (input)
               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.

               Unchanged on exit.

     TRANSA (input)
               On entry, TRANSA specifies  the  equations  to  be
               solved as follows:

               TRANSA = 'N' or 'n'   A*x = b.

               TRANSA = 'T' or 't'   A'*x = b.

               TRANSA = 'C' or 'c'   A'*x = b.

               Unchanged on exit.

               TRANSA is defaulted to 'N' for F95 INTERFACE.

     DIAG (input)
               On entry, DIAG specifies whether or not A is  unit
               triangular as follows:

               DIAG = 'U' or 'u'   A is assumed to be  unit  tri-
               angular.

               DIAG = 'N' or 'n'   A is not assumed  to  be  unit
               triangular.

               Unchanged on exit.

     N (input)
               On entry, N specifies the order of the  matrix  A.
               N >= 0.  Unchanged on exit.
     A (input)
               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 refer-
               enced.  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 refer-
               enced.  Note that when  DIAG =  'U'  or  'u',  the
               diagonal  elements of A are not referenced either,
               but are assumed to be unity.  Unchanged on exit.

     LDA (input)
               On entry, LDA specifies the first dimension  of  A
               as  declared  in the calling (sub) program. LDA >=
               max( 1, n ).  Unchanged on exit.

     Y (input/output)
               ( 1 + ( n - 1 )*abs( INCY ) ).  Before entry,  the
               incremented  array  Y  must  contain the n element
               right-hand side vector b. On exit, Y is  overwrit-
               ten with the solution vector x.

     INCY (input)
               On entry, INCY specifies  the  increment  for  the
               elements of Y. INCY <> 0.  Unchanged on exit.