1*> \brief \b ZTRT06
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 ZTRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, RWORK,
12*                          RAT )
13*
14*       .. Scalar Arguments ..
15*       CHARACTER          DIAG, UPLO
16*       INTEGER            LDA, N
17*       DOUBLE PRECISION   RAT, RCOND, RCONDC
18*       ..
19*       .. Array Arguments ..
20*       DOUBLE PRECISION   RWORK( * )
21*       COMPLEX*16         A( LDA, * )
22*       ..
23*
24*
25*> \par Purpose:
26*  =============
27*>
28*> \verbatim
29*>
30*> ZTRT06 computes a test ratio comparing RCOND (the reciprocal
31*> condition number of a triangular matrix A) and RCONDC, the estimate
32*> computed by ZTRCON.  Information about the triangular matrix A is
33*> used if one estimate is zero and the other is non-zero to decide if
34*> underflow in the estimate is justified.
35*> \endverbatim
36*
37*  Arguments:
38*  ==========
39*
40*> \param[in] RCOND
41*> \verbatim
42*>          RCOND is DOUBLE PRECISION
43*>          The estimate of the reciprocal condition number obtained by
44*>          forming the explicit inverse of the matrix A and computing
45*>          RCOND = 1/( norm(A) * norm(inv(A)) ).
46*> \endverbatim
47*>
48*> \param[in] RCONDC
49*> \verbatim
50*>          RCONDC is DOUBLE PRECISION
51*>          The estimate of the reciprocal condition number computed by
52*>          ZTRCON.
53*> \endverbatim
54*>
55*> \param[in] UPLO
56*> \verbatim
57*>          UPLO is CHARACTER
58*>          Specifies whether the matrix A is upper or lower triangular.
59*>          = 'U':  Upper triangular
60*>          = 'L':  Lower triangular
61*> \endverbatim
62*>
63*> \param[in] DIAG
64*> \verbatim
65*>          DIAG is CHARACTER
66*>          Specifies whether or not the matrix A is unit triangular.
67*>          = 'N':  Non-unit triangular
68*>          = 'U':  Unit triangular
69*> \endverbatim
70*>
71*> \param[in] N
72*> \verbatim
73*>          N is INTEGER
74*>          The order of the matrix A.  N >= 0.
75*> \endverbatim
76*>
77*> \param[in] A
78*> \verbatim
79*>          A is COMPLEX*16 array, dimension (LDA,N)
80*>          The triangular matrix A.  If UPLO = 'U', the leading n by n
81*>          upper triangular part of the array A contains the upper
82*>          triangular matrix, and the strictly lower triangular part of
83*>          A is not referenced.  If UPLO = 'L', the leading n by n lower
84*>          triangular part of the array A contains the lower triangular
85*>          matrix, and the strictly upper triangular part of A is not
86*>          referenced.  If DIAG = 'U', the diagonal elements of A are
87*>          also not referenced and are assumed to be 1.
88*> \endverbatim
89*>
90*> \param[in] LDA
91*> \verbatim
92*>          LDA is INTEGER
93*>          The leading dimension of the array A.  LDA >= max(1,N).
94*> \endverbatim
95*>
96*> \param[out] RWORK
97*> \verbatim
98*>          RWORK is DOUBLE PRECISION array, dimension (N)
99*> \endverbatim
100*>
101*> \param[out] RAT
102*> \verbatim
103*>          RAT is DOUBLE PRECISION
104*>          The test ratio.  If both RCOND and RCONDC are nonzero,
105*>             RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1.
106*>          If RAT = 0, the two estimates are exactly the same.
107*> \endverbatim
108*
109*  Authors:
110*  ========
111*
112*> \author Univ. of Tennessee
113*> \author Univ. of California Berkeley
114*> \author Univ. of Colorado Denver
115*> \author NAG Ltd.
116*
117*> \date November 2011
118*
119*> \ingroup complex16_lin
120*
121*  =====================================================================
122      SUBROUTINE ZTRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, RWORK,
123     $                   RAT )
124*
125*  -- LAPACK test routine (version 3.4.0) --
126*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
127*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
128*     November 2011
129*
130*     .. Scalar Arguments ..
131      CHARACTER          DIAG, UPLO
132      INTEGER            LDA, N
133      DOUBLE PRECISION   RAT, RCOND, RCONDC
134*     ..
135*     .. Array Arguments ..
136      DOUBLE PRECISION   RWORK( * )
137      COMPLEX*16         A( LDA, * )
138*     ..
139*
140*  =====================================================================
141*
142*     .. Parameters ..
143      DOUBLE PRECISION   ZERO, ONE
144      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
145*     ..
146*     .. Local Scalars ..
147      DOUBLE PRECISION   ANORM, BIGNUM, EPS, RMAX, RMIN
148*     ..
149*     .. External Functions ..
150      DOUBLE PRECISION   DLAMCH, ZLANTR
151      EXTERNAL           DLAMCH, ZLANTR
152*     ..
153*     .. Intrinsic Functions ..
154      INTRINSIC          MAX, MIN
155*     ..
156*     .. Executable Statements ..
157*
158      EPS = DLAMCH( 'Epsilon' )
159      RMAX = MAX( RCOND, RCONDC )
160      RMIN = MIN( RCOND, RCONDC )
161*
162*     Do the easy cases first.
163*
164      IF( RMIN.LT.ZERO ) THEN
165*
166*        Invalid value for RCOND or RCONDC, return 1/EPS.
167*
168         RAT = ONE / EPS
169*
170      ELSE IF( RMIN.GT.ZERO ) THEN
171*
172*        Both estimates are positive, return RMAX/RMIN - 1.
173*
174         RAT = RMAX / RMIN - ONE
175*
176      ELSE IF( RMAX.EQ.ZERO ) THEN
177*
178*        Both estimates zero.
179*
180         RAT = ZERO
181*
182      ELSE
183*
184*        One estimate is zero, the other is non-zero.  If the matrix is
185*        ill-conditioned, return the nonzero estimate multiplied by
186*        1/EPS; if the matrix is badly scaled, return the nonzero
187*        estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum
188*        element in absolute value in A.
189*
190         BIGNUM = ONE / DLAMCH( 'Safe minimum' )
191         ANORM = ZLANTR( 'M', UPLO, DIAG, N, N, A, LDA, RWORK )
192*
193         RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) )
194      END IF
195*
196      RETURN
197*
198*     End of ZTRT06
199*
200      END
201