00001 SUBROUTINE DTRTI2( 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 DOUBLE PRECISION A( LDA, * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * DTRTI2 computes the inverse of a real upper or lower triangular 00020 * matrix. 00021 * 00022 * This is the Level 2 BLAS version of the algorithm. 00023 * 00024 * Arguments 00025 * ========= 00026 * 00027 * UPLO (input) CHARACTER*1 00028 * Specifies whether the matrix A is upper or lower triangular. 00029 * = 'U': Upper triangular 00030 * = 'L': Lower triangular 00031 * 00032 * DIAG (input) CHARACTER*1 00033 * Specifies whether or not the matrix A is unit triangular. 00034 * = 'N': Non-unit triangular 00035 * = 'U': Unit triangular 00036 * 00037 * N (input) INTEGER 00038 * The order of the matrix A. N >= 0. 00039 * 00040 * A (input/output) DOUBLE PRECISION array, dimension (LDA,N) 00041 * On entry, the triangular matrix A. If UPLO = 'U', the 00042 * leading n by n upper triangular part of the array A contains 00043 * the upper triangular matrix, and the strictly lower 00044 * triangular part of A is not referenced. If UPLO = 'L', the 00045 * leading n by n lower triangular part of the array A contains 00046 * the lower triangular matrix, and the strictly upper 00047 * triangular part of A is not referenced. If DIAG = 'U', the 00048 * diagonal elements of A are also not referenced and are 00049 * assumed to be 1. 00050 * 00051 * On exit, the (triangular) inverse of the original matrix, in 00052 * the same storage format. 00053 * 00054 * LDA (input) INTEGER 00055 * The leading dimension of the array A. LDA >= max(1,N). 00056 * 00057 * INFO (output) INTEGER 00058 * = 0: successful exit 00059 * < 0: if INFO = -k, the k-th argument had an illegal value 00060 * 00061 * ===================================================================== 00062 * 00063 * .. Parameters .. 00064 DOUBLE PRECISION ONE 00065 PARAMETER ( ONE = 1.0D+0 ) 00066 * .. 00067 * .. Local Scalars .. 00068 LOGICAL NOUNIT, UPPER 00069 INTEGER J 00070 DOUBLE PRECISION AJJ 00071 * .. 00072 * .. External Functions .. 00073 LOGICAL LSAME 00074 EXTERNAL LSAME 00075 * .. 00076 * .. External Subroutines .. 00077 EXTERNAL DSCAL, DTRMV, XERBLA 00078 * .. 00079 * .. Intrinsic Functions .. 00080 INTRINSIC MAX 00081 * .. 00082 * .. Executable Statements .. 00083 * 00084 * Test the input parameters. 00085 * 00086 INFO = 0 00087 UPPER = LSAME( UPLO, 'U' ) 00088 NOUNIT = LSAME( DIAG, 'N' ) 00089 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00090 INFO = -1 00091 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN 00092 INFO = -2 00093 ELSE IF( N.LT.0 ) THEN 00094 INFO = -3 00095 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00096 INFO = -5 00097 END IF 00098 IF( INFO.NE.0 ) THEN 00099 CALL XERBLA( 'DTRTI2', -INFO ) 00100 RETURN 00101 END IF 00102 * 00103 IF( UPPER ) THEN 00104 * 00105 * Compute inverse of upper triangular matrix. 00106 * 00107 DO 10 J = 1, N 00108 IF( NOUNIT ) THEN 00109 A( J, J ) = ONE / A( J, J ) 00110 AJJ = -A( J, J ) 00111 ELSE 00112 AJJ = -ONE 00113 END IF 00114 * 00115 * Compute elements 1:j-1 of j-th column. 00116 * 00117 CALL DTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA, 00118 $ A( 1, J ), 1 ) 00119 CALL DSCAL( J-1, AJJ, A( 1, J ), 1 ) 00120 10 CONTINUE 00121 ELSE 00122 * 00123 * Compute inverse of lower triangular matrix. 00124 * 00125 DO 20 J = N, 1, -1 00126 IF( NOUNIT ) THEN 00127 A( J, J ) = ONE / A( J, J ) 00128 AJJ = -A( J, J ) 00129 ELSE 00130 AJJ = -ONE 00131 END IF 00132 IF( J.LT.N ) THEN 00133 * 00134 * Compute elements j+1:n of j-th column. 00135 * 00136 CALL DTRMV( 'Lower', 'No transpose', DIAG, N-J, 00137 $ A( J+1, J+1 ), LDA, A( J+1, J ), 1 ) 00138 CALL DSCAL( N-J, AJJ, A( J+1, J ), 1 ) 00139 END IF 00140 20 CONTINUE 00141 END IF 00142 * 00143 RETURN 00144 * 00145 * End of DTRTI2 00146 * 00147 END
1.7.2