213 lines
		
	
	
		
			5.8 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			213 lines
		
	
	
		
			5.8 KiB
		
	
	
	
		
			Fortran
		
	
	
	
| *> \brief \b STRTI2 computes the inverse of a triangular matrix (unblocked algorithm).
 | |
| *
 | |
| *  =========== DOCUMENTATION ===========
 | |
| *
 | |
| * Online html documentation available at
 | |
| *            http://www.netlib.org/lapack/explore-html/
 | |
| *
 | |
| *> \htmlonly
 | |
| *> Download STRTI2 + dependencies
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strti2.f">
 | |
| *> [TGZ]</a>
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strti2.f">
 | |
| *> [ZIP]</a>
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strti2.f">
 | |
| *> [TXT]</a>
 | |
| *> \endhtmlonly
 | |
| *
 | |
| *  Definition:
 | |
| *  ===========
 | |
| *
 | |
| *       SUBROUTINE STRTI2( UPLO, DIAG, N, A, LDA, INFO )
 | |
| *
 | |
| *       .. Scalar Arguments ..
 | |
| *       CHARACTER          DIAG, UPLO
 | |
| *       INTEGER            INFO, LDA, N
 | |
| *       ..
 | |
| *       .. Array Arguments ..
 | |
| *       REAL               A( LDA, * )
 | |
| *       ..
 | |
| *
 | |
| *
 | |
| *> \par Purpose:
 | |
| *  =============
 | |
| *>
 | |
| *> \verbatim
 | |
| *>
 | |
| *> STRTI2 computes the inverse of a real upper or lower triangular
 | |
| *> matrix.
 | |
| *>
 | |
| *> This is the Level 2 BLAS version of the algorithm.
 | |
| *> \endverbatim
 | |
| *
 | |
| *  Arguments:
 | |
| *  ==========
 | |
| *
 | |
| *> \param[in] UPLO
 | |
| *> \verbatim
 | |
| *>          UPLO is CHARACTER*1
 | |
| *>          Specifies whether the matrix A is upper or lower triangular.
 | |
| *>          = 'U':  Upper triangular
 | |
| *>          = 'L':  Lower triangular
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] DIAG
 | |
| *> \verbatim
 | |
| *>          DIAG is CHARACTER*1
 | |
| *>          Specifies whether or not the matrix A is unit triangular.
 | |
| *>          = 'N':  Non-unit triangular
 | |
| *>          = 'U':  Unit triangular
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] N
 | |
| *> \verbatim
 | |
| *>          N is INTEGER
 | |
| *>          The order of the matrix A.  N >= 0.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in,out] A
 | |
| *> \verbatim
 | |
| *>          A is REAL array, dimension (LDA,N)
 | |
| *>          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.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] LDA
 | |
| *> \verbatim
 | |
| *>          LDA is INTEGER
 | |
| *>          The leading dimension of the array A.  LDA >= max(1,N).
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[out] INFO
 | |
| *> \verbatim
 | |
| *>          INFO is INTEGER
 | |
| *>          = 0: successful exit
 | |
| *>          < 0: if INFO = -k, the k-th argument had an illegal value
 | |
| *> \endverbatim
 | |
| *
 | |
| *  Authors:
 | |
| *  ========
 | |
| *
 | |
| *> \author Univ. of Tennessee
 | |
| *> \author Univ. of California Berkeley
 | |
| *> \author Univ. of Colorado Denver
 | |
| *> \author NAG Ltd.
 | |
| *
 | |
| *> \date December 2016
 | |
| *
 | |
| *> \ingroup realOTHERcomputational
 | |
| *
 | |
| *  =====================================================================
 | |
|       SUBROUTINE STRTI2( UPLO, DIAG, N, A, LDA, INFO )
 | |
| *
 | |
| *  -- LAPACK computational routine (version 3.7.0) --
 | |
| *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 | |
| *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 | |
| *     December 2016
 | |
| *
 | |
| *     .. Scalar Arguments ..
 | |
|       CHARACTER          DIAG, UPLO
 | |
|       INTEGER            INFO, LDA, N
 | |
| *     ..
 | |
| *     .. Array Arguments ..
 | |
|       REAL               A( LDA, * )
 | |
| *     ..
 | |
| *
 | |
| *  =====================================================================
 | |
| *
 | |
| *     .. Parameters ..
 | |
|       REAL               ONE
 | |
|       PARAMETER          ( ONE = 1.0E+0 )
 | |
| *     ..
 | |
| *     .. Local Scalars ..
 | |
|       LOGICAL            NOUNIT, UPPER
 | |
|       INTEGER            J
 | |
|       REAL               AJJ
 | |
| *     ..
 | |
| *     .. External Functions ..
 | |
|       LOGICAL            LSAME
 | |
|       EXTERNAL           LSAME
 | |
| *     ..
 | |
| *     .. External Subroutines ..
 | |
|       EXTERNAL           SSCAL, STRMV, XERBLA
 | |
| *     ..
 | |
| *     .. Intrinsic Functions ..
 | |
|       INTRINSIC          MAX
 | |
| *     ..
 | |
| *     .. Executable Statements ..
 | |
| *
 | |
| *     Test the input parameters.
 | |
| *
 | |
|       INFO = 0
 | |
|       UPPER = LSAME( UPLO, 'U' )
 | |
|       NOUNIT = LSAME( DIAG, 'N' )
 | |
|       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
 | |
|          INFO = -1
 | |
|       ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
 | |
|          INFO = -2
 | |
|       ELSE IF( N.LT.0 ) THEN
 | |
|          INFO = -3
 | |
|       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
 | |
|          INFO = -5
 | |
|       END IF
 | |
|       IF( INFO.NE.0 ) THEN
 | |
|          CALL XERBLA( 'STRTI2', -INFO )
 | |
|          RETURN
 | |
|       END IF
 | |
| *
 | |
|       IF( UPPER ) THEN
 | |
| *
 | |
| *        Compute inverse of upper triangular matrix.
 | |
| *
 | |
|          DO 10 J = 1, N
 | |
|             IF( NOUNIT ) THEN
 | |
|                A( J, J ) = ONE / A( J, J )
 | |
|                AJJ = -A( J, J )
 | |
|             ELSE
 | |
|                AJJ = -ONE
 | |
|             END IF
 | |
| *
 | |
| *           Compute elements 1:j-1 of j-th column.
 | |
| *
 | |
|             CALL STRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
 | |
|      $                  A( 1, J ), 1 )
 | |
|             CALL SSCAL( J-1, AJJ, A( 1, J ), 1 )
 | |
|    10    CONTINUE
 | |
|       ELSE
 | |
| *
 | |
| *        Compute inverse of lower triangular matrix.
 | |
| *
 | |
|          DO 20 J = N, 1, -1
 | |
|             IF( NOUNIT ) THEN
 | |
|                A( J, J ) = ONE / A( J, J )
 | |
|                AJJ = -A( J, J )
 | |
|             ELSE
 | |
|                AJJ = -ONE
 | |
|             END IF
 | |
|             IF( J.LT.N ) THEN
 | |
| *
 | |
| *              Compute elements j+1:n of j-th column.
 | |
| *
 | |
|                CALL STRMV( 'Lower', 'No transpose', DIAG, N-J,
 | |
|      $                     A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
 | |
|                CALL SSCAL( N-J, AJJ, A( J+1, J ), 1 )
 | |
|             END IF
 | |
|    20    CONTINUE
 | |
|       END IF
 | |
| *
 | |
|       RETURN
 | |
| *
 | |
| *     End of STRTI2
 | |
| *
 | |
|       END
 |