1*> \brief \b CTPT06
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 CTPT06( RCOND, RCONDC, UPLO, DIAG, N, AP, RWORK, RAT )
12*
13*       .. Scalar Arguments ..
14*       CHARACTER          DIAG, UPLO
15*       INTEGER            N
16*       REAL               RAT, RCOND, RCONDC
17*       ..
18*       .. Array Arguments ..
19*       REAL               RWORK( * )
20*       COMPLEX            AP( * )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*> CTPT06 computes a test ratio comparing RCOND (the reciprocal
30*> condition number of the triangular matrix A) and RCONDC, the estimate
31*> computed by CTPCON.  Information about the triangular matrix is used
32*> 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*>          CTPCON.
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] AP
77*> \verbatim
78*>          AP is COMPLEX array, dimension (N*(N+1)/2)
79*>          The upper or lower triangular matrix A, packed columnwise in
80*>          a linear array.  The j-th column of A is stored in the array
81*>          AP as follows:
82*>          if UPLO = 'U', AP((j-1)*j/2 + i) = A(i,j) for 1<=i<=j;
83*>          if UPLO = 'L',
84*>             AP((j-1)*(n-j) + j*(j+1)/2 + i-j) = A(i,j) for j<=i<=n.
85*> \endverbatim
86*>
87*> \param[out] RWORK
88*> \verbatim
89*>          RWORK is REAL array, dimension (N)
90*> \endverbatim
91*>
92*> \param[out] RAT
93*> \verbatim
94*>          RAT is REAL
95*>          The test ratio.  If both RCOND and RCONDC are nonzero,
96*>             RAT = MAX( RCOND, RCONDC )/MIN( RCOND, RCONDC ) - 1.
97*>          If RAT = 0, the two estimates are exactly the same.
98*> \endverbatim
99*
100*  Authors:
101*  ========
102*
103*> \author Univ. of Tennessee
104*> \author Univ. of California Berkeley
105*> \author Univ. of Colorado Denver
106*> \author NAG Ltd.
107*
108*> \ingroup complex_lin
109*
110*  =====================================================================
111      SUBROUTINE CTPT06( RCOND, RCONDC, UPLO, DIAG, N, AP, RWORK, RAT )
112*
113*  -- LAPACK test routine --
114*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
115*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
116*
117*     .. Scalar Arguments ..
118      CHARACTER          DIAG, UPLO
119      INTEGER            N
120      REAL               RAT, RCOND, RCONDC
121*     ..
122*     .. Array Arguments ..
123      REAL               RWORK( * )
124      COMPLEX            AP( * )
125*     ..
126*
127*  =====================================================================
128*
129*     .. Parameters ..
130      REAL               ZERO, ONE
131      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
132*     ..
133*     .. Local Scalars ..
134      REAL               ANORM, BIGNUM, EPS, RMAX, RMIN
135*     ..
136*     .. External Functions ..
137      REAL               CLANTP, SLAMCH
138      EXTERNAL           CLANTP, SLAMCH
139*     ..
140*     .. Intrinsic Functions ..
141      INTRINSIC          MAX, MIN
142*     ..
143*     .. Executable Statements ..
144*
145      EPS = SLAMCH( 'Epsilon' )
146      RMAX = MAX( RCOND, RCONDC )
147      RMIN = MIN( RCOND, RCONDC )
148*
149*     Do the easy cases first.
150*
151      IF( RMIN.LT.ZERO ) THEN
152*
153*        Invalid value for RCOND or RCONDC, return 1/EPS.
154*
155         RAT = ONE / EPS
156*
157      ELSE IF( RMIN.GT.ZERO ) THEN
158*
159*        Both estimates are positive, return RMAX/RMIN - 1.
160*
161         RAT = RMAX / RMIN - ONE
162*
163      ELSE IF( RMAX.EQ.ZERO ) THEN
164*
165*        Both estimates zero.
166*
167         RAT = ZERO
168*
169      ELSE
170*
171*        One estimate is zero, the other is non-zero.  If the matrix is
172*        ill-conditioned, return the nonzero estimate multiplied by
173*        1/EPS; if the matrix is badly scaled, return the nonzero
174*        estimate multiplied by BIGNUM/TMAX, where TMAX is the maximum
175*        element in absolute value in A.
176*
177         BIGNUM = ONE / SLAMCH( 'Safe minimum' )
178         ANORM = CLANTP( 'M', UPLO, DIAG, N, AP, RWORK )
179*
180         RAT = RMAX*( MIN( BIGNUM / MAX( ONE, ANORM ), ONE / EPS ) )
181      END IF
182*
183      RETURN
184*
185*     End of CTPT06
186*
187      END
188