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