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