Contents


NAME

     ctrrfs - provide error bounds and backward  error  estimates
     for the solution to a system of linear equations with a tri-
     angular coefficient matrix

SYNOPSIS

     SUBROUTINE CTRRFS(UPLO, TRANSA, DIAG, N, NRHS, A, LDA, B, LDB, X,
           LDX, FERR, BERR, WORK, WORK2, INFO)

     CHARACTER * 1 UPLO, TRANSA, DIAG
     COMPLEX A(LDA,*), B(LDB,*), X(LDX,*), WORK(*)
     INTEGER N, NRHS, LDA, LDB, LDX, INFO
     REAL FERR(*), BERR(*), WORK2(*)

     SUBROUTINE CTRRFS_64(UPLO, TRANSA, DIAG, N, NRHS, A, LDA, B, LDB, X,
           LDX, FERR, BERR, WORK, WORK2, INFO)

     CHARACTER * 1 UPLO, TRANSA, DIAG
     COMPLEX A(LDA,*), B(LDB,*), X(LDX,*), WORK(*)
     INTEGER*8 N, NRHS, LDA, LDB, LDX, INFO
     REAL FERR(*), BERR(*), WORK2(*)

  F95 INTERFACE
     SUBROUTINE TRRFS(UPLO, [TRANSA], DIAG, [N], [NRHS], A, [LDA], B, [LDB],
            X, [LDX], FERR, BERR, [WORK], [WORK2], [INFO])

     CHARACTER(LEN=1) :: UPLO, TRANSA, DIAG
     COMPLEX, DIMENSION(:) :: WORK
     COMPLEX, DIMENSION(:,:) :: A, B, X
     INTEGER :: N, NRHS, LDA, LDB, LDX, INFO
     REAL, DIMENSION(:) :: FERR, BERR, WORK2

     SUBROUTINE TRRFS_64(UPLO, [TRANSA], DIAG, [N], [NRHS], A, [LDA], B,
            [LDB], X, [LDX], FERR, BERR, [WORK], [WORK2], [INFO])

     CHARACTER(LEN=1) :: UPLO, TRANSA, DIAG
     COMPLEX, DIMENSION(:) :: WORK
     COMPLEX, DIMENSION(:,:) :: A, B, X
     INTEGER(8) :: N, NRHS, LDA, LDB, LDX, INFO
     REAL, DIMENSION(:) :: FERR, BERR, WORK2

  C INTERFACE
     #include <sunperf.h>

     void ctrrfs(char uplo, char transa, char diag,  int  n,  int
               nrhs,  complex  *a,  int lda, complex *b, int ldb,
               complex *x, int ldx, float *ferr, float *berr, int
               *info);

     void ctrrfs_64(char uplo, char transa, char  diag,  long  n,
               long  nrhs, complex *a, long lda, complex *b, long
               ldb, complex *x,  long  ldx,  float  *ferr,  float
               *berr, long *info);

PURPOSE

     ctrrfs provides error bounds and  backward  error  estimates
     for the solution to a system of linear equations with a tri-
     angular coefficient matrix.

     The solution matrix X must be computed  by  CTRTRS  or  some
     other  means  before entering this routine.  CTRRFS does not
     do iterative refinement because doing so cannot improve  the
     backward error.

ARGUMENTS

     UPLO (input)
               = 'U':  A is upper triangular;
               = 'L':  A is lower triangular.

     TRANSA (input)
               Specifies the form of the system of equations:
               = 'N':  A * X = B     (No transpose)
               = 'T':  A**T * X = B  (Transpose)
               = 'C':  A**H * X = B  (Conjugate transpose)

               TRANSA is defaulted to 'N' for F95 INTERFACE.

     DIAG (input)
               = 'N':  A is non-unit triangular;
               = 'U':  A is unit triangular.

     N (input) The order of the matrix A.  N >= 0.

     NRHS (input)
               The number of right hand sides, i.e.,  the  number
               of columns of the matrices B and X.  NRHS >= 0.

     A (input) The triangular matrix A.  If UPLO = 'U', the lead-
               ing  N-by-N  upper  triangular part of the array A
               contains the  upper  triangular  matrix,  and  the
               strictly   lower  triangular  part  of  A  is  not
               referenced.  If UPLO =  'L',  the  leading  N-by-N
               lower  triangular part of the array A contains the
               lower triangular matrix, and  the  strictly  upper
               triangular part of A is not referenced.  If DIAG =
               'U', the diagonal  elements  of  A  are  also  not
               referenced and are assumed to be 1.

     LDA (input)
               The leading dimension of  the  array  A.   LDA  >=
               max(1,N).

     B (input) The right hand side matrix B.

     LDB (input)
               The leading dimension of  the  array  B.   LDB  >=
               max(1,N).

     X (input) The solution matrix X.

     LDX (input)
               The leading dimension of  the  array  X.   LDX  >=
               max(1,N).

     FERR (output)
               The estimated forward error bound for  each  solu-
               tion  vector X(j) (the j-th column of the solution
               matrix  X).   If  XTRUE  is  the   true   solution
               corresponding  to  X(j),  FERR(j)  is an estimated
               upper bound for the magnitude of the largest  ele-
               ment in (X(j) - XTRUE) divided by the magnitude of
               the largest element in X(j).  The estimate  is  as
               reliable  as the estimate for RCOND, and is almost
               always a slight overestimate of the true error.

     BERR (output)
               The componentwise relative backward error of  each
               solution  vector X(j) (i.e., the smallest relative
               change in any element of A or B that makes X(j) an
               exact solution).

     WORK (workspace)
               dimension(2*N)

     WORK2 (workspace)
               dimension(N)

     INFO (output)
               = 0:  successful exit
               < 0:  if INFO = -i, the i-th argument had an ille-
               gal value