147 lines
		
	
	
		
			4.1 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			147 lines
		
	
	
		
			4.1 KiB
		
	
	
	
		
			Fortran
		
	
	
	
|       SUBROUTINE CTRTI2F( UPLO, DIAG, N, A, LDA, INFO )
 | |
| *
 | |
| *  -- LAPACK routine (version 3.1) --
 | |
| *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
 | |
| *     November 2006
 | |
| *
 | |
| *     .. Scalar Arguments ..
 | |
|       CHARACTER          DIAG, UPLO
 | |
|       INTEGER            INFO, LDA, N
 | |
| *     ..
 | |
| *     .. Array Arguments ..
 | |
|       COMPLEX            A( LDA, * )
 | |
| *     ..
 | |
| *
 | |
| *  Purpose
 | |
| *  =======
 | |
| *
 | |
| *  CTRTI2 computes the inverse of a complex upper or lower triangular
 | |
| *  matrix.
 | |
| *
 | |
| *  This is the Level 2 BLAS version of the algorithm.
 | |
| *
 | |
| *  Arguments
 | |
| *  =========
 | |
| *
 | |
| *  UPLO    (input) CHARACTER*1
 | |
| *          Specifies whether the matrix A is upper or lower triangular.
 | |
| *          = 'U':  Upper triangular
 | |
| *          = 'L':  Lower triangular
 | |
| *
 | |
| *  DIAG    (input) CHARACTER*1
 | |
| *          Specifies whether or not the matrix A is unit triangular.
 | |
| *          = 'N':  Non-unit triangular
 | |
| *          = 'U':  Unit triangular
 | |
| *
 | |
| *  N       (input) INTEGER
 | |
| *          The order of the matrix A.  N >= 0.
 | |
| *
 | |
| *  A       (input/output) COMPLEX 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.
 | |
| *
 | |
| *  LDA     (input) INTEGER
 | |
| *          The leading dimension of the array A.  LDA >= max(1,N).
 | |
| *
 | |
| *  INFO    (output) INTEGER
 | |
| *          = 0: successful exit
 | |
| *          < 0: if INFO = -k, the k-th argument had an illegal value
 | |
| *
 | |
| *  =====================================================================
 | |
| *
 | |
| *     .. Parameters ..
 | |
|       COMPLEX            ONE
 | |
|       PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
 | |
| *     ..
 | |
| *     .. Local Scalars ..
 | |
|       LOGICAL            NOUNIT, UPPER
 | |
|       INTEGER            J
 | |
|       COMPLEX            AJJ
 | |
| *     ..
 | |
| *     .. External Functions ..
 | |
|       LOGICAL            LSAME
 | |
|       EXTERNAL           LSAME
 | |
| *     ..
 | |
| *     .. External Subroutines ..
 | |
|       EXTERNAL           CSCAL, CTRMV, 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( 'CTRTI2', -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 CTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
 | |
|      $                  A( 1, J ), 1 )
 | |
|             CALL CSCAL( 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 CTRMV( 'Lower', 'No transpose', DIAG, N-J,
 | |
|      $                     A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
 | |
|                CALL CSCAL( N-J, AJJ, A( J+1, J ), 1 )
 | |
|             END IF
 | |
|    20    CONTINUE
 | |
|       END IF
 | |
| *
 | |
|       RETURN
 | |
| *
 | |
| *     End of CTRTI2
 | |
| *
 | |
|       END
 |