Contents


NAME

     strti2 - compute the inverse of a real upper or  lower  tri-
     angular matrix

SYNOPSIS

     SUBROUTINE STRTI2(UPLO, DIAG, N, A, LDA, INFO)

     CHARACTER * 1 UPLO, DIAG
     INTEGER N, LDA, INFO
     REAL A(LDA,*)

     SUBROUTINE STRTI2_64(UPLO, DIAG, N, A, LDA, INFO)

     CHARACTER * 1 UPLO, DIAG
     INTEGER*8 N, LDA, INFO
     REAL A(LDA,*)

  F95 INTERFACE
     SUBROUTINE TRTI2(UPLO, DIAG, [N], A, [LDA], [INFO])

     CHARACTER(LEN=1) :: UPLO, DIAG
     INTEGER :: N, LDA, INFO
     REAL, DIMENSION(:,:) :: A

     SUBROUTINE TRTI2_64(UPLO, DIAG, [N], A, [LDA], [INFO])

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

  C INTERFACE
     #include <sunperf.h>

     void strti2(char uplo, char diag, int n, float *a, int  lda,
               int *info);

     void strti2_64(char uplo, char diag, long n, float *a,  long
               lda, long *info);

PURPOSE

     strti2 computes the inverse of a real upper  or  lower  tri-
     angular matrix.

     This is the Level 2 BLAS version of the algorithm.

ARGUMENTS

     UPLO (input)
               Specifies whether the matrix A is upper  or  lower
               triangular.  = 'U':  Upper triangular
               = 'L':  Lower triangular

     DIAG (input)
               Specifies whether or not the matrix A is unit tri-
               angular.  = 'N':  Non-unit triangular
               = 'U':  Unit triangular

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

     A (input/output)
               On entry, the triangular matrix A.  If UPLO = 'U',
               the  leading  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.

               On exit, the (triangular) inverse of the  original
               matrix, in the same storage format.

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

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