1*> \brief \b ZTRT01 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE ZTRT01( UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND, 12* RWORK, RESID ) 13* 14* .. Scalar Arguments .. 15* CHARACTER DIAG, UPLO 16* INTEGER LDA, LDAINV, N 17* DOUBLE PRECISION RCOND, RESID 18* .. 19* .. Array Arguments .. 20* DOUBLE PRECISION RWORK( * ) 21* COMPLEX*16 A( LDA, * ), AINV( LDAINV, * ) 22* .. 23* 24* 25*> \par Purpose: 26* ============= 27*> 28*> \verbatim 29*> 30*> ZTRT01 computes the residual for a triangular matrix A times its 31*> inverse: 32*> RESID = norm( A*AINV - I ) / ( N * norm(A) * norm(AINV) * EPS ), 33*> where EPS is the machine epsilon. 34*> \endverbatim 35* 36* Arguments: 37* ========== 38* 39*> \param[in] UPLO 40*> \verbatim 41*> UPLO is CHARACTER*1 42*> Specifies whether the matrix A is upper or lower triangular. 43*> = 'U': Upper triangular 44*> = 'L': Lower triangular 45*> \endverbatim 46*> 47*> \param[in] DIAG 48*> \verbatim 49*> DIAG is CHARACTER*1 50*> Specifies whether or not the matrix A is unit triangular. 51*> = 'N': Non-unit triangular 52*> = 'U': Unit triangular 53*> \endverbatim 54*> 55*> \param[in] N 56*> \verbatim 57*> N is INTEGER 58*> The order of the matrix A. N >= 0. 59*> \endverbatim 60*> 61*> \param[in] A 62*> \verbatim 63*> A is COMPLEX*16 array, dimension (LDA,N) 64*> The triangular matrix A. If UPLO = 'U', the leading n by n 65*> upper triangular part of the array A contains the upper 66*> triangular matrix, and the strictly lower triangular part of 67*> A is not referenced. If UPLO = 'L', the leading n by n lower 68*> triangular part of the array A contains the lower triangular 69*> matrix, and the strictly upper triangular part of A is not 70*> referenced. If DIAG = 'U', the diagonal elements of A are 71*> also not referenced and are assumed to be 1. 72*> \endverbatim 73*> 74*> \param[in] LDA 75*> \verbatim 76*> LDA is INTEGER 77*> The leading dimension of the array A. LDA >= max(1,N). 78*> \endverbatim 79*> 80*> \param[in] AINV 81*> \verbatim 82*> AINV is COMPLEX*16 array, dimension (LDAINV,N) 83*> On entry, the (triangular) inverse of the matrix A, in the 84*> same storage format as A. 85*> On exit, the contents of AINV are destroyed. 86*> \endverbatim 87*> 88*> \param[in] LDAINV 89*> \verbatim 90*> LDAINV is INTEGER 91*> The leading dimension of the array AINV. LDAINV >= max(1,N). 92*> \endverbatim 93*> 94*> \param[out] RCOND 95*> \verbatim 96*> RCOND is DOUBLE PRECISION 97*> The reciprocal condition number of A, computed as 98*> 1/(norm(A) * norm(AINV)). 99*> \endverbatim 100*> 101*> \param[out] RWORK 102*> \verbatim 103*> RWORK is DOUBLE PRECISION array, dimension (N) 104*> \endverbatim 105*> 106*> \param[out] RESID 107*> \verbatim 108*> RESID is DOUBLE PRECISION 109*> norm(A*AINV - I) / ( N * norm(A) * norm(AINV) * EPS ) 110*> \endverbatim 111* 112* Authors: 113* ======== 114* 115*> \author Univ. of Tennessee 116*> \author Univ. of California Berkeley 117*> \author Univ. of Colorado Denver 118*> \author NAG Ltd. 119* 120*> \date November 2011 121* 122*> \ingroup complex16_lin 123* 124* ===================================================================== 125 SUBROUTINE ZTRT01( UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND, 126 $ RWORK, RESID ) 127* 128* -- LAPACK test routine (version 3.4.0) -- 129* -- LAPACK is a software package provided by Univ. of Tennessee, -- 130* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 131* November 2011 132* 133* .. Scalar Arguments .. 134 CHARACTER DIAG, UPLO 135 INTEGER LDA, LDAINV, N 136 DOUBLE PRECISION RCOND, RESID 137* .. 138* .. Array Arguments .. 139 DOUBLE PRECISION RWORK( * ) 140 COMPLEX*16 A( LDA, * ), AINV( LDAINV, * ) 141* .. 142* 143* ===================================================================== 144* 145* .. Parameters .. 146 DOUBLE PRECISION ZERO, ONE 147 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 148* .. 149* .. Local Scalars .. 150 INTEGER J 151 DOUBLE PRECISION AINVNM, ANORM, EPS 152* .. 153* .. External Functions .. 154 LOGICAL LSAME 155 DOUBLE PRECISION DLAMCH, ZLANTR 156 EXTERNAL LSAME, DLAMCH, ZLANTR 157* .. 158* .. External Subroutines .. 159 EXTERNAL ZTRMV 160* .. 161* .. Intrinsic Functions .. 162 INTRINSIC DBLE 163* .. 164* .. Executable Statements .. 165* 166* Quick exit if N = 0 167* 168 IF( N.LE.0 ) THEN 169 RCOND = ONE 170 RESID = ZERO 171 RETURN 172 END IF 173* 174* Exit with RESID = 1/EPS if ANORM = 0 or AINVNM = 0. 175* 176 EPS = DLAMCH( 'Epsilon' ) 177 ANORM = ZLANTR( '1', UPLO, DIAG, N, N, A, LDA, RWORK ) 178 AINVNM = ZLANTR( '1', UPLO, DIAG, N, N, AINV, LDAINV, RWORK ) 179 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 180 RCOND = ZERO 181 RESID = ONE / EPS 182 RETURN 183 END IF 184 RCOND = ( ONE / ANORM ) / AINVNM 185* 186* Set the diagonal of AINV to 1 if AINV has unit diagonal. 187* 188 IF( LSAME( DIAG, 'U' ) ) THEN 189 DO 10 J = 1, N 190 AINV( J, J ) = ONE 191 10 CONTINUE 192 END IF 193* 194* Compute A * AINV, overwriting AINV. 195* 196 IF( LSAME( UPLO, 'U' ) ) THEN 197 DO 20 J = 1, N 198 CALL ZTRMV( 'Upper', 'No transpose', DIAG, J, A, LDA, 199 $ AINV( 1, J ), 1 ) 200 20 CONTINUE 201 ELSE 202 DO 30 J = 1, N 203 CALL ZTRMV( 'Lower', 'No transpose', DIAG, N-J+1, A( J, J ), 204 $ LDA, AINV( J, J ), 1 ) 205 30 CONTINUE 206 END IF 207* 208* Subtract 1 from each diagonal element to form A*AINV - I. 209* 210 DO 40 J = 1, N 211 AINV( J, J ) = AINV( J, J ) - ONE 212 40 CONTINUE 213* 214* Compute norm(A*AINV - I) / (N * norm(A) * norm(AINV) * EPS) 215* 216 RESID = ZLANTR( '1', UPLO, 'Non-unit', N, N, AINV, LDAINV, RWORK ) 217* 218 RESID = ( ( RESID*RCOND ) / DBLE( N ) ) / EPS 219* 220 RETURN 221* 222* End of ZTRT01 223* 224 END 225