LAPACK 3.3.0

strtri.f

Go to the documentation of this file.
00001       SUBROUTINE STRTRI( UPLO, DIAG, N, A, LDA, INFO )
00002 *
00003 *  -- LAPACK routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       CHARACTER          DIAG, UPLO
00010       INTEGER            INFO, LDA, N
00011 *     ..
00012 *     .. Array Arguments ..
00013       REAL               A( LDA, * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  STRTRI computes the inverse of a real upper or lower triangular
00020 *  matrix A.
00021 *
00022 *  This is the Level 3 BLAS version of the algorithm.
00023 *
00024 *  Arguments
00025 *  =========
00026 *
00027 *  UPLO    (input) CHARACTER*1
00028 *          = 'U':  A is upper triangular;
00029 *          = 'L':  A is lower triangular.
00030 *
00031 *  DIAG    (input) CHARACTER*1
00032 *          = 'N':  A is non-unit triangular;
00033 *          = 'U':  A is unit triangular.
00034 *
00035 *  N       (input) INTEGER
00036 *          The order of the matrix A.  N >= 0.
00037 *
00038 *  A       (input/output) REAL array, dimension (LDA,N)
00039 *          On entry, the triangular matrix A.  If UPLO = 'U', the
00040 *          leading N-by-N upper triangular part of the array A contains
00041 *          the upper triangular matrix, and the strictly lower
00042 *          triangular part of A is not referenced.  If UPLO = 'L', the
00043 *          leading N-by-N lower triangular part of the array A contains
00044 *          the lower triangular matrix, and the strictly upper
00045 *          triangular part of A is not referenced.  If DIAG = 'U', the
00046 *          diagonal elements of A are also not referenced and are
00047 *          assumed to be 1.
00048 *          On exit, the (triangular) inverse of the original matrix, in
00049 *          the same storage format.
00050 *
00051 *  LDA     (input) INTEGER
00052 *          The leading dimension of the array A.  LDA >= max(1,N).
00053 *
00054 *  INFO    (output) INTEGER
00055 *          = 0: successful exit
00056 *          < 0: if INFO = -i, the i-th argument had an illegal value
00057 *          > 0: if INFO = i, A(i,i) is exactly zero.  The triangular
00058 *               matrix is singular and its inverse can not be computed.
00059 *
00060 *  =====================================================================
00061 *
00062 *     .. Parameters ..
00063       REAL               ONE, ZERO
00064       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00065 *     ..
00066 *     .. Local Scalars ..
00067       LOGICAL            NOUNIT, UPPER
00068       INTEGER            J, JB, NB, NN
00069 *     ..
00070 *     .. External Functions ..
00071       LOGICAL            LSAME
00072       INTEGER            ILAENV
00073       EXTERNAL           LSAME, ILAENV
00074 *     ..
00075 *     .. External Subroutines ..
00076       EXTERNAL           STRMM, STRSM, STRTI2, XERBLA
00077 *     ..
00078 *     .. Intrinsic Functions ..
00079       INTRINSIC          MAX, MIN
00080 *     ..
00081 *     .. Executable Statements ..
00082 *
00083 *     Test the input parameters.
00084 *
00085       INFO = 0
00086       UPPER = LSAME( UPLO, 'U' )
00087       NOUNIT = LSAME( DIAG, 'N' )
00088       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00089          INFO = -1
00090       ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
00091          INFO = -2
00092       ELSE IF( N.LT.0 ) THEN
00093          INFO = -3
00094       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00095          INFO = -5
00096       END IF
00097       IF( INFO.NE.0 ) THEN
00098          CALL XERBLA( 'STRTRI', -INFO )
00099          RETURN
00100       END IF
00101 *
00102 *     Quick return if possible
00103 *
00104       IF( N.EQ.0 )
00105      $   RETURN
00106 *
00107 *     Check for singularity if non-unit.
00108 *
00109       IF( NOUNIT ) THEN
00110          DO 10 INFO = 1, N
00111             IF( A( INFO, INFO ).EQ.ZERO )
00112      $         RETURN
00113    10    CONTINUE
00114          INFO = 0
00115       END IF
00116 *
00117 *     Determine the block size for this environment.
00118 *
00119       NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 )
00120       IF( NB.LE.1 .OR. NB.GE.N ) THEN
00121 *
00122 *        Use unblocked code
00123 *
00124          CALL STRTI2( UPLO, DIAG, N, A, LDA, INFO )
00125       ELSE
00126 *
00127 *        Use blocked code
00128 *
00129          IF( UPPER ) THEN
00130 *
00131 *           Compute inverse of upper triangular matrix
00132 *
00133             DO 20 J = 1, N, NB
00134                JB = MIN( NB, N-J+1 )
00135 *
00136 *              Compute rows 1:j-1 of current block column
00137 *
00138                CALL STRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1,
00139      $                     JB, ONE, A, LDA, A( 1, J ), LDA )
00140                CALL STRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1,
00141      $                     JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA )
00142 *
00143 *              Compute inverse of current diagonal block
00144 *
00145                CALL STRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO )
00146    20       CONTINUE
00147          ELSE
00148 *
00149 *           Compute inverse of lower triangular matrix
00150 *
00151             NN = ( ( N-1 ) / NB )*NB + 1
00152             DO 30 J = NN, 1, -NB
00153                JB = MIN( NB, N-J+1 )
00154                IF( J+JB.LE.N ) THEN
00155 *
00156 *                 Compute rows j+jb:n of current block column
00157 *
00158                   CALL STRMM( 'Left', 'Lower', 'No transpose', DIAG,
00159      $                        N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA,
00160      $                        A( J+JB, J ), LDA )
00161                   CALL STRSM( 'Right', 'Lower', 'No transpose', DIAG,
00162      $                        N-J-JB+1, JB, -ONE, A( J, J ), LDA,
00163      $                        A( J+JB, J ), LDA )
00164                END IF
00165 *
00166 *              Compute inverse of current diagonal block
00167 *
00168                CALL STRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO )
00169    30       CONTINUE
00170          END IF
00171       END IF
00172 *
00173       RETURN
00174 *
00175 *     End of STRTRI
00176 *
00177       END
 All Files Functions