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