213 lines
		
	
	
		
			5.8 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			213 lines
		
	
	
		
			5.8 KiB
		
	
	
	
		
			Fortran
		
	
	
	
*> \brief \b ZTRTI2 computes the inverse of a triangular matrix (unblocked algorithm).
 | 
						|
*
 | 
						|
*  =========== DOCUMENTATION ===========
 | 
						|
*
 | 
						|
* Online html documentation available at 
 | 
						|
*            http://www.netlib.org/lapack/explore-html/ 
 | 
						|
*
 | 
						|
*> \htmlonly
 | 
						|
*> Download ZTRTI2 + dependencies 
 | 
						|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztrti2.f"> 
 | 
						|
*> [TGZ]</a> 
 | 
						|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztrti2.f"> 
 | 
						|
*> [ZIP]</a> 
 | 
						|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztrti2.f"> 
 | 
						|
*> [TXT]</a>
 | 
						|
*> \endhtmlonly 
 | 
						|
*
 | 
						|
*  Definition:
 | 
						|
*  ===========
 | 
						|
*
 | 
						|
*       SUBROUTINE ZTRTI2( UPLO, DIAG, N, A, LDA, INFO )
 | 
						|
* 
 | 
						|
*       .. Scalar Arguments ..
 | 
						|
*       CHARACTER          DIAG, UPLO
 | 
						|
*       INTEGER            INFO, LDA, N
 | 
						|
*       ..
 | 
						|
*       .. Array Arguments ..
 | 
						|
*       COMPLEX*16         A( LDA, * )
 | 
						|
*       ..
 | 
						|
*  
 | 
						|
*
 | 
						|
*> \par Purpose:
 | 
						|
*  =============
 | 
						|
*>
 | 
						|
*> \verbatim
 | 
						|
*>
 | 
						|
*> ZTRTI2 computes the inverse of a complex 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 COMPLEX*16 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 September 2012
 | 
						|
*
 | 
						|
*> \ingroup complex16OTHERcomputational
 | 
						|
*
 | 
						|
*  =====================================================================
 | 
						|
      SUBROUTINE ZTRTI2( UPLO, DIAG, N, A, LDA, INFO )
 | 
						|
*
 | 
						|
*  -- LAPACK computational routine (version 3.4.2) --
 | 
						|
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 | 
						|
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 | 
						|
*     September 2012
 | 
						|
*
 | 
						|
*     .. Scalar Arguments ..
 | 
						|
      CHARACTER          DIAG, UPLO
 | 
						|
      INTEGER            INFO, LDA, N
 | 
						|
*     ..
 | 
						|
*     .. Array Arguments ..
 | 
						|
      COMPLEX*16         A( LDA, * )
 | 
						|
*     ..
 | 
						|
*
 | 
						|
*  =====================================================================
 | 
						|
*
 | 
						|
*     .. Parameters ..
 | 
						|
      COMPLEX*16         ONE
 | 
						|
      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
 | 
						|
*     ..
 | 
						|
*     .. Local Scalars ..
 | 
						|
      LOGICAL            NOUNIT, UPPER
 | 
						|
      INTEGER            J
 | 
						|
      COMPLEX*16         AJJ
 | 
						|
*     ..
 | 
						|
*     .. External Functions ..
 | 
						|
      LOGICAL            LSAME
 | 
						|
      EXTERNAL           LSAME
 | 
						|
*     ..
 | 
						|
*     .. External Subroutines ..
 | 
						|
      EXTERNAL           XERBLA, ZSCAL, ZTRMV
 | 
						|
*     ..
 | 
						|
*     .. 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( 'ZTRTI2', -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 ZTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
 | 
						|
     $                  A( 1, J ), 1 )
 | 
						|
            CALL ZSCAL( 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 ZTRMV( 'Lower', 'No transpose', DIAG, N-J,
 | 
						|
     $                     A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
 | 
						|
               CALL ZSCAL( N-J, AJJ, A( J+1, J ), 1 )
 | 
						|
            END IF
 | 
						|
   20    CONTINUE
 | 
						|
      END IF
 | 
						|
*
 | 
						|
      RETURN
 | 
						|
*
 | 
						|
*     End of ZTRTI2
 | 
						|
*
 | 
						|
      END
 |