src/LAPACK/dtrti2.f

   1       SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO )
   2 *
   3 *  -- LAPACK routine (version 3.1) --
   4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
   5 *     November 2006
   6 *
   7 *     .. Scalar Arguments ..
   8       CHARACTER          DIAG, UPLO
   9       INTEGER            INFO, LDA, N
  10 *     ..
  11 *     .. Array Arguments ..
  12       DOUBLE PRECISION   A( LDA, * )
  13 *     ..
  14 *
  15 *  Purpose
  16 *  =======
  17 *
  18 *  DTRTI2 computes the inverse of a real upper or lower triangular
  19 *  matrix.
  20 *
  21 *  This is the Level 2 BLAS version of the algorithm.
  22 *
  23 *  Arguments
  24 *  =========
  25 *
  26 *  UPLO    (input) CHARACTER*1
  27 *          Specifies whether the matrix A is upper or lower triangular.
  28 *          = 'U':  Upper triangular
  29 *          = 'L':  Lower triangular
  30 *
  31 *  DIAG    (input) CHARACTER*1
  32 *          Specifies whether or not the matrix A is unit triangular.
  33 *          = 'N':  Non-unit triangular
  34 *          = 'U':  Unit triangular
  35 *
  36 *  N       (input) INTEGER
  37 *          The order of the matrix A.  N >= 0.
  38 *
  39 *  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
  40 *          On entry, the triangular matrix A.  If UPLO = 'U', the
  41 *          leading n by n upper triangular part of the array A contains
  42 *          the upper triangular matrix, and the strictly lower
  43 *          triangular part of A is not referenced.  If UPLO = 'L', the
  44 *          leading n by n lower triangular part of the array A contains
  45 *          the lower triangular matrix, and the strictly upper
  46 *          triangular part of A is not referenced.  If DIAG = 'U', the
  47 *          diagonal elements of A are also not referenced and are
  48 *          assumed to be 1.
  49 *
  50 *          On exit, the (triangular) inverse of the original matrix, in
  51 *          the same storage format.
  52 *
  53 *  LDA     (input) INTEGER
  54 *          The leading dimension of the array A.  LDA >= max(1,N).
  55 *
  56 *  INFO    (output) INTEGER
  57 *          = 0: successful exit
  58 *          < 0: if INFO = -k, the k-th argument had an illegal value
  59 *
  60 *  =====================================================================
  61 *
  62 *     .. Parameters ..
  63       DOUBLE PRECISION   ONE
  64       PARAMETER          ( ONE = 1.0D+0 )
  65 *     ..
  66 *     .. Local Scalars ..
  67       LOGICAL            NOUNIT, UPPER
  68       INTEGER            J
  69       DOUBLE PRECISION   AJJ
  70 *     ..
  71 *     .. External Functions ..
  72       LOGICAL            LSAME
  73       EXTERNAL           LSAME
  74 *     ..
  75 *     .. External Subroutines ..
  76       EXTERNAL           DSCAL, DTRMV, XERBLA
  77 *     ..
  78 *     .. Intrinsic Functions ..
  79       INTRINSIC          MAX
  80 *     ..
  81 *     .. Executable Statements ..
  82 *
  83 *     Test the input parameters.
  84 *
  85       INFO = 0
  86       UPPER = LSAME( UPLO, 'U' )
  87       NOUNIT = LSAME( DIAG, 'N' )
  88       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  89          INFO = -1
  90       ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
  91          INFO = -2
  92       ELSE IF( N.LT.0 ) THEN
  93          INFO = -3
  94       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  95          INFO = -5
  96       END IF
  97       IF( INFO.NE.0 ) THEN
  98          CALL XERBLA( 'DTRTI2', -INFO )
  99          RETURN
 100       END IF
 101 *
 102       IF( UPPER ) THEN
 103 *
 104 *        Compute inverse of upper triangular matrix.
 105 *
 106          DO 10 J = 1, N
 107             IF( NOUNIT ) THEN
 108                A( J, J ) = ONE / A( J, J )
 109                AJJ = -A( J, J )
 110             ELSE
 111                AJJ = -ONE
 112             END IF
 113 *
 114 *           Compute elements 1:j-1 of j-th column.
 115 *
 116             CALL DTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
 117      $                  A( 1, J ), 1 )
 118             CALL DSCAL( J-1, AJJ, A( 1, J ), 1 )
 119    10    CONTINUE
 120       ELSE
 121 *
 122 *        Compute inverse of lower triangular matrix.
 123 *
 124          DO 20 J = N, 1, -1
 125             IF( NOUNIT ) THEN
 126                A( J, J ) = ONE / A( J, J )
 127                AJJ = -A( J, J )
 128             ELSE
 129                AJJ = -ONE
 130             END IF
 131             IF( J.LT.N ) THEN
 132 *
 133 *              Compute elements j+1:n of j-th column.
 134 *
 135                CALL DTRMV( 'Lower', 'No transpose', DIAG, N-J,
 136      $                     A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
 137                CALL DSCAL( N-J, AJJ, A( J+1, J ), 1 )
 138             END IF
 139    20    CONTINUE
 140       END IF
 141 *
 142       RETURN
 143 *
 144 *     End of DTRTI2
 145 *
 146       END