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