1*> \brief \b CGTCON
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CGTCON + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgtcon.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgtcon.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgtcon.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
22*                          WORK, INFO )
23*
24*       .. Scalar Arguments ..
25*       CHARACTER          NORM
26*       INTEGER            INFO, N
27*       REAL               ANORM, RCOND
28*       ..
29*       .. Array Arguments ..
30*       INTEGER            IPIV( * )
31*       COMPLEX            D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
32*       ..
33*
34*
35*> \par Purpose:
36*  =============
37*>
38*> \verbatim
39*>
40*> CGTCON estimates the reciprocal of the condition number of a complex
41*> tridiagonal matrix A using the LU factorization as computed by
42*> CGTTRF.
43*>
44*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
45*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
46*> \endverbatim
47*
48*  Arguments:
49*  ==========
50*
51*> \param[in] NORM
52*> \verbatim
53*>          NORM is CHARACTER*1
54*>          Specifies whether the 1-norm condition number or the
55*>          infinity-norm condition number is required:
56*>          = '1' or 'O':  1-norm;
57*>          = 'I':         Infinity-norm.
58*> \endverbatim
59*>
60*> \param[in] N
61*> \verbatim
62*>          N is INTEGER
63*>          The order of the matrix A.  N >= 0.
64*> \endverbatim
65*>
66*> \param[in] DL
67*> \verbatim
68*>          DL is COMPLEX array, dimension (N-1)
69*>          The (n-1) multipliers that define the matrix L from the
70*>          LU factorization of A as computed by CGTTRF.
71*> \endverbatim
72*>
73*> \param[in] D
74*> \verbatim
75*>          D is COMPLEX array, dimension (N)
76*>          The n diagonal elements of the upper triangular matrix U from
77*>          the LU factorization of A.
78*> \endverbatim
79*>
80*> \param[in] DU
81*> \verbatim
82*>          DU is COMPLEX array, dimension (N-1)
83*>          The (n-1) elements of the first superdiagonal of U.
84*> \endverbatim
85*>
86*> \param[in] DU2
87*> \verbatim
88*>          DU2 is COMPLEX array, dimension (N-2)
89*>          The (n-2) elements of the second superdiagonal of U.
90*> \endverbatim
91*>
92*> \param[in] IPIV
93*> \verbatim
94*>          IPIV is INTEGER array, dimension (N)
95*>          The pivot indices; for 1 <= i <= n, row i of the matrix was
96*>          interchanged with row IPIV(i).  IPIV(i) will always be either
97*>          i or i+1; IPIV(i) = i indicates a row interchange was not
98*>          required.
99*> \endverbatim
100*>
101*> \param[in] ANORM
102*> \verbatim
103*>          ANORM is REAL
104*>          If NORM = '1' or 'O', the 1-norm of the original matrix A.
105*>          If NORM = 'I', the infinity-norm of the original matrix A.
106*> \endverbatim
107*>
108*> \param[out] RCOND
109*> \verbatim
110*>          RCOND is REAL
111*>          The reciprocal of the condition number of the matrix A,
112*>          computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
113*>          estimate of the 1-norm of inv(A) computed in this routine.
114*> \endverbatim
115*>
116*> \param[out] WORK
117*> \verbatim
118*>          WORK is COMPLEX array, dimension (2*N)
119*> \endverbatim
120*>
121*> \param[out] INFO
122*> \verbatim
123*>          INFO is INTEGER
124*>          = 0:  successful exit
125*>          < 0:  if INFO = -i, the i-th argument had an illegal value
126*> \endverbatim
127*
128*  Authors:
129*  ========
130*
131*> \author Univ. of Tennessee
132*> \author Univ. of California Berkeley
133*> \author Univ. of Colorado Denver
134*> \author NAG Ltd.
135*
136*> \ingroup complexGTcomputational
137*
138*  =====================================================================
139      SUBROUTINE CGTCON( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
140     $                   WORK, INFO )
141*
142*  -- LAPACK computational routine --
143*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
144*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
145*
146*     .. Scalar Arguments ..
147      CHARACTER          NORM
148      INTEGER            INFO, N
149      REAL               ANORM, RCOND
150*     ..
151*     .. Array Arguments ..
152      INTEGER            IPIV( * )
153      COMPLEX            D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
154*     ..
155*
156*  =====================================================================
157*
158*     .. Parameters ..
159      REAL               ONE, ZERO
160      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
161*     ..
162*     .. Local Scalars ..
163      LOGICAL            ONENRM
164      INTEGER            I, KASE, KASE1
165      REAL               AINVNM
166*     ..
167*     .. Local Arrays ..
168      INTEGER            ISAVE( 3 )
169*     ..
170*     .. External Functions ..
171      LOGICAL            LSAME
172      EXTERNAL           LSAME
173*     ..
174*     .. External Subroutines ..
175      EXTERNAL           CGTTRS, CLACN2, XERBLA
176*     ..
177*     .. Intrinsic Functions ..
178      INTRINSIC          CMPLX
179*     ..
180*     .. Executable Statements ..
181*
182*     Test the input arguments.
183*
184      INFO = 0
185      ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
186      IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
187         INFO = -1
188      ELSE IF( N.LT.0 ) THEN
189         INFO = -2
190      ELSE IF( ANORM.LT.ZERO ) THEN
191         INFO = -8
192      END IF
193      IF( INFO.NE.0 ) THEN
194         CALL XERBLA( 'CGTCON', -INFO )
195         RETURN
196      END IF
197*
198*     Quick return if possible
199*
200      RCOND = ZERO
201      IF( N.EQ.0 ) THEN
202         RCOND = ONE
203         RETURN
204      ELSE IF( ANORM.EQ.ZERO ) THEN
205         RETURN
206      END IF
207*
208*     Check that D(1:N) is non-zero.
209*
210      DO 10 I = 1, N
211         IF( D( I ).EQ.CMPLX( ZERO ) )
212     $      RETURN
213   10 CONTINUE
214*
215      AINVNM = ZERO
216      IF( ONENRM ) THEN
217         KASE1 = 1
218      ELSE
219         KASE1 = 2
220      END IF
221      KASE = 0
222   20 CONTINUE
223      CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
224      IF( KASE.NE.0 ) THEN
225         IF( KASE.EQ.KASE1 ) THEN
226*
227*           Multiply by inv(U)*inv(L).
228*
229            CALL CGTTRS( 'No transpose', N, 1, DL, D, DU, DU2, IPIV,
230     $                   WORK, N, INFO )
231         ELSE
232*
233*           Multiply by inv(L**H)*inv(U**H).
234*
235            CALL CGTTRS( 'Conjugate transpose', N, 1, DL, D, DU, DU2,
236     $                   IPIV, WORK, N, INFO )
237         END IF
238         GO TO 20
239      END IF
240*
241*     Compute the estimate of the reciprocal condition number.
242*
243      IF( AINVNM.NE.ZERO )
244     $   RCOND = ( ONE / AINVNM ) / ANORM
245*
246      RETURN
247*
248*     End of CGTCON
249*
250      END
251