1*> \brief \b DTBT06
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 DTBT06( RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB,
12*                          WORK, RAT )
13*
14*       .. Scalar Arguments ..
15*       CHARACTER          DIAG, UPLO
16*       INTEGER            KD, LDAB, N
17*       DOUBLE PRECISION   RAT, RCOND, RCONDC
18*       ..
19*       .. Array Arguments ..
20*       DOUBLE PRECISION   AB( LDAB, * ), WORK( * )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*> DTBT06 computes a test ratio comparing RCOND (the reciprocal
30*> condition number of a triangular matrix A) and RCONDC, the estimate
31*> computed by DTBCON.  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*>          DTBCON.
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] KD
77*> \verbatim
78*>          KD is INTEGER
79*>          The number of superdiagonals or subdiagonals of the
80*>          triangular band matrix A.  KD >= 0.
81*> \endverbatim
82*>
83*> \param[in] AB
84*> \verbatim
85*>          AB is DOUBLE PRECISION array, dimension (LDAB,N)
86*>          The upper or lower triangular band matrix A, stored in the
87*>          first kd+1 rows of the array. The j-th column of A is stored
88*>          in the j-th column of the array AB as follows:
89*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
90*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
91*> \endverbatim
92*>
93*> \param[in] LDAB
94*> \verbatim
95*>          LDAB is INTEGER
96*>          The leading dimension of the array AB.  LDAB >= KD+1.
97*> \endverbatim
98*>
99*> \param[out] WORK
100*> \verbatim
101*>          WORK is DOUBLE PRECISION array, dimension (N)
102*> \endverbatim
103*>
104*> \param[out] RAT
105*> \verbatim
106*>          RAT is DOUBLE PRECISION
107*>          The test ratio.  If both RCOND and RCONDC are nonzero,
108*>             RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1.
109*>          If RAT = 0, the two estimates are exactly the same.
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*> \ingroup double_lin
121*
122*  =====================================================================
123      SUBROUTINE DTBT06( RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB,
124     $                   WORK, RAT )
125*
126*  -- LAPACK test routine --
127*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
128*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
129*
130*     .. Scalar Arguments ..
131      CHARACTER          DIAG, UPLO
132      INTEGER            KD, LDAB, N
133      DOUBLE PRECISION   RAT, RCOND, RCONDC
134*     ..
135*     .. Array Arguments ..
136      DOUBLE PRECISION   AB( LDAB, * ), WORK( * )
137*     ..
138*
139*  =====================================================================
140*
141*     .. Parameters ..
142      DOUBLE PRECISION   ZERO, ONE
143      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
144*     ..
145*     .. Local Scalars ..
146      DOUBLE PRECISION   ANORM, BIGNUM, EPS, RMAX, RMIN, SMLNUM
147*     ..
148*     .. External Functions ..
149      DOUBLE PRECISION   DLAMCH, DLANTB
150      EXTERNAL           DLAMCH, DLANTB
151*     ..
152*     .. Intrinsic Functions ..
153      INTRINSIC          MAX, MIN
154*     ..
155*     .. External Subroutines ..
156      EXTERNAL           DLABAD
157*     ..
158*     .. Executable Statements ..
159*
160      EPS = DLAMCH( 'Epsilon' )
161      RMAX = MAX( RCOND, RCONDC )
162      RMIN = MIN( RCOND, RCONDC )
163*
164*     Do the easy cases first.
165*
166      IF( RMIN.LT.ZERO ) THEN
167*
168*        Invalid value for RCOND or RCONDC, return 1/EPS.
169*
170         RAT = ONE / EPS
171*
172      ELSE IF( RMIN.GT.ZERO ) THEN
173*
174*        Both estimates are positive, return RMAX/RMIN - 1.
175*
176         RAT = RMAX / RMIN - ONE
177*
178      ELSE IF( RMAX.EQ.ZERO ) THEN
179*
180*        Both estimates zero.
181*
182         RAT = ZERO
183*
184      ELSE
185*
186*        One estimate is zero, the other is non-zero.  If the matrix is
187*        ill-conditioned, return the nonzero estimate multiplied by
188*        1/EPS; if the matrix is badly scaled, return the nonzero
189*        estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum
190*        element in absolute value in A.
191*
192         SMLNUM = DLAMCH( 'Safe minimum' )
193         BIGNUM = ONE / SMLNUM
194         CALL DLABAD( SMLNUM, BIGNUM )
195         ANORM = DLANTB( 'M', UPLO, DIAG, N, KD, AB, LDAB, WORK )
196*
197         RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) )
198      END IF
199*
200      RETURN
201*
202*     End of DTBT06
203*
204      END
205