1*> \brief \b STRT06
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 STRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, WORK,
12*                          RAT )
13*
14*       .. Scalar Arguments ..
15*       CHARACTER          DIAG, UPLO
16*       INTEGER            LDA, N
17*       REAL               RAT, RCOND, RCONDC
18*       ..
19*       .. Array Arguments ..
20*       REAL               A( LDA, * ), WORK( * )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*> STRT06 computes a test ratio comparing RCOND (the reciprocal
30*> condition number of a triangular matrix A) and RCONDC, the estimate
31*> computed by STRCON.  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 REAL
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 REAL
50*>          The estimate of the reciprocal condition number computed by
51*>          STRCON.
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 REAL 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 REAL array, dimension (N)
98*> \endverbatim
99*>
100*> \param[out] RAT
101*> \verbatim
102*>          RAT is REAL
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*> \date November 2011
117*
118*> \ingroup single_lin
119*
120*  =====================================================================
121      SUBROUTINE STRT06( RCOND, RCONDC, UPLO, DIAG, N, A, LDA, WORK,
122     $                   RAT )
123*
124*  -- LAPACK test routine (version 3.4.0) --
125*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
126*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
127*     November 2011
128*
129*     .. Scalar Arguments ..
130      CHARACTER          DIAG, UPLO
131      INTEGER            LDA, N
132      REAL               RAT, RCOND, RCONDC
133*     ..
134*     .. Array Arguments ..
135      REAL               A( LDA, * ), WORK( * )
136*     ..
137*
138*  =====================================================================
139*
140*     .. Parameters ..
141      REAL               ZERO, ONE
142      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
143*     ..
144*     .. Local Scalars ..
145      REAL               ANORM, BIGNUM, EPS, RMAX, RMIN, SMLNUM
146*     ..
147*     .. External Functions ..
148      REAL               SLAMCH, SLANTR
149      EXTERNAL           SLAMCH, SLANTR
150*     ..
151*     .. Intrinsic Functions ..
152      INTRINSIC          MAX, MIN
153*     ..
154*     .. External Subroutines ..
155      EXTERNAL           SLABAD
156*     ..
157*     .. Executable Statements ..
158*
159      EPS = SLAMCH( 'Epsilon' )
160      RMAX = MAX( RCOND, RCONDC )
161      RMIN = MIN( RCOND, RCONDC )
162*
163*     Do the easy cases first.
164*
165      IF( RMIN.LT.ZERO ) THEN
166*
167*        Invalid value for RCOND or RCONDC, return 1/EPS.
168*
169         RAT = ONE / EPS
170*
171      ELSE IF( RMIN.GT.ZERO ) THEN
172*
173*        Both estimates are positive, return RMAX/RMIN - 1.
174*
175         RAT = RMAX / RMIN - ONE
176*
177      ELSE IF( RMAX.EQ.ZERO ) THEN
178*
179*        Both estimates zero.
180*
181         RAT = ZERO
182*
183      ELSE
184*
185*        One estimate is zero, the other is non-zero.  If the matrix is
186*        ill-conditioned, return the nonzero estimate multiplied by
187*        1/EPS; if the matrix is badly scaled, return the nonzero
188*        estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum
189*        element in absolute value in A.
190*
191         SMLNUM = SLAMCH( 'Safe minimum' )
192         BIGNUM = ONE / SMLNUM
193         CALL SLABAD( SMLNUM, BIGNUM )
194         ANORM = SLANTR( 'M', UPLO, DIAG, N, N, A, LDA, WORK )
195*
196         RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) )
197      END IF
198*
199      RETURN
200*
201*     End of STRT06
202*
203      END
204