1*> \brief \b ZTBCON
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZTBCON + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztbcon.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztbcon.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztbcon.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK,
22*                          RWORK, INFO )
23*
24*       .. Scalar Arguments ..
25*       CHARACTER          DIAG, NORM, UPLO
26*       INTEGER            INFO, KD, LDAB, N
27*       DOUBLE PRECISION   RCOND
28*       ..
29*       .. Array Arguments ..
30*       DOUBLE PRECISION   RWORK( * )
31*       COMPLEX*16         AB( LDAB, * ), WORK( * )
32*       ..
33*
34*
35*> \par Purpose:
36*  =============
37*>
38*> \verbatim
39*>
40*> ZTBCON estimates the reciprocal of the condition number of a
41*> triangular band matrix A, in either the 1-norm or the infinity-norm.
42*>
43*> The norm of A is computed and an estimate is obtained for
44*> norm(inv(A)), then the reciprocal of the condition number is
45*> computed as
46*>    RCOND = 1 / ( norm(A) * norm(inv(A)) ).
47*> \endverbatim
48*
49*  Arguments:
50*  ==========
51*
52*> \param[in] NORM
53*> \verbatim
54*>          NORM is CHARACTER*1
55*>          Specifies whether the 1-norm condition number or the
56*>          infinity-norm condition number is required:
57*>          = '1' or 'O':  1-norm;
58*>          = 'I':         Infinity-norm.
59*> \endverbatim
60*>
61*> \param[in] UPLO
62*> \verbatim
63*>          UPLO is CHARACTER*1
64*>          = 'U':  A is upper triangular;
65*>          = 'L':  A is lower triangular.
66*> \endverbatim
67*>
68*> \param[in] DIAG
69*> \verbatim
70*>          DIAG is CHARACTER*1
71*>          = 'N':  A is non-unit triangular;
72*>          = 'U':  A is unit triangular.
73*> \endverbatim
74*>
75*> \param[in] N
76*> \verbatim
77*>          N is INTEGER
78*>          The order of the matrix A.  N >= 0.
79*> \endverbatim
80*>
81*> \param[in] KD
82*> \verbatim
83*>          KD is INTEGER
84*>          The number of superdiagonals or subdiagonals of the
85*>          triangular band matrix A.  KD >= 0.
86*> \endverbatim
87*>
88*> \param[in] AB
89*> \verbatim
90*>          AB is COMPLEX*16 array, dimension (LDAB,N)
91*>          The upper or lower triangular band matrix A, stored in the
92*>          first kd+1 rows of the array. The j-th column of A is stored
93*>          in the j-th column of the array AB as follows:
94*>          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
95*>          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
96*>          If DIAG = 'U', the diagonal elements of A are not referenced
97*>          and are assumed to be 1.
98*> \endverbatim
99*>
100*> \param[in] LDAB
101*> \verbatim
102*>          LDAB is INTEGER
103*>          The leading dimension of the array AB.  LDAB >= KD+1.
104*> \endverbatim
105*>
106*> \param[out] RCOND
107*> \verbatim
108*>          RCOND is DOUBLE PRECISION
109*>          The reciprocal of the condition number of the matrix A,
110*>          computed as RCOND = 1/(norm(A) * norm(inv(A))).
111*> \endverbatim
112*>
113*> \param[out] WORK
114*> \verbatim
115*>          WORK is COMPLEX*16 array, dimension (2*N)
116*> \endverbatim
117*>
118*> \param[out] RWORK
119*> \verbatim
120*>          RWORK is DOUBLE PRECISION array, dimension (N)
121*> \endverbatim
122*>
123*> \param[out] INFO
124*> \verbatim
125*>          INFO is INTEGER
126*>          = 0:  successful exit
127*>          < 0:  if INFO = -i, the i-th argument had an illegal value
128*> \endverbatim
129*
130*  Authors:
131*  ========
132*
133*> \author Univ. of Tennessee
134*> \author Univ. of California Berkeley
135*> \author Univ. of Colorado Denver
136*> \author NAG Ltd.
137*
138*> \date November 2011
139*
140*> \ingroup complex16OTHERcomputational
141*
142*  =====================================================================
143      SUBROUTINE ZTBCON( NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK,
144     $                   RWORK, INFO )
145*
146*  -- LAPACK computational routine (version 3.4.0) --
147*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
148*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
149*     November 2011
150*
151*     .. Scalar Arguments ..
152      CHARACTER          DIAG, NORM, UPLO
153      INTEGER            INFO, KD, LDAB, N
154      DOUBLE PRECISION   RCOND
155*     ..
156*     .. Array Arguments ..
157      DOUBLE PRECISION   RWORK( * )
158      COMPLEX*16         AB( LDAB, * ), WORK( * )
159*     ..
160*
161*  =====================================================================
162*
163*     .. Parameters ..
164      DOUBLE PRECISION   ONE, ZERO
165      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
166*     ..
167*     .. Local Scalars ..
168      LOGICAL            NOUNIT, ONENRM, UPPER
169      CHARACTER          NORMIN
170      INTEGER            IX, KASE, KASE1
171      DOUBLE PRECISION   AINVNM, ANORM, SCALE, SMLNUM, XNORM
172      COMPLEX*16         ZDUM
173*     ..
174*     .. Local Arrays ..
175      INTEGER            ISAVE( 3 )
176*     ..
177*     .. External Functions ..
178      LOGICAL            LSAME
179      INTEGER            IZAMAX
180      DOUBLE PRECISION   DLAMCH, ZLANTB
181      EXTERNAL           LSAME, IZAMAX, DLAMCH, ZLANTB
182*     ..
183*     .. External Subroutines ..
184      EXTERNAL           XERBLA, ZDRSCL, ZLACN2, ZLATBS
185*     ..
186*     .. Intrinsic Functions ..
187      INTRINSIC          ABS, DBLE, DIMAG, MAX
188*     ..
189*     .. Statement Functions ..
190      DOUBLE PRECISION   CABS1
191*     ..
192*     .. Statement Function definitions ..
193      CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
194*     ..
195*     .. Executable Statements ..
196*
197*     Test the input parameters.
198*
199      INFO = 0
200      UPPER = LSAME( UPLO, 'U' )
201      ONENRM = NORM.EQ.'1' .OR. LSAME( NORM, 'O' )
202      NOUNIT = LSAME( DIAG, 'N' )
203*
204      IF( .NOT.ONENRM .AND. .NOT.LSAME( NORM, 'I' ) ) THEN
205         INFO = -1
206      ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
207         INFO = -2
208      ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
209         INFO = -3
210      ELSE IF( N.LT.0 ) THEN
211         INFO = -4
212      ELSE IF( KD.LT.0 ) THEN
213         INFO = -5
214      ELSE IF( LDAB.LT.KD+1 ) THEN
215         INFO = -7
216      END IF
217      IF( INFO.NE.0 ) THEN
218         CALL XERBLA( 'ZTBCON', -INFO )
219         RETURN
220      END IF
221*
222*     Quick return if possible
223*
224      IF( N.EQ.0 ) THEN
225         RCOND = ONE
226         RETURN
227      END IF
228*
229      RCOND = ZERO
230      SMLNUM = DLAMCH( 'Safe minimum' )*DBLE( MAX( N, 1 ) )
231*
232*     Compute the 1-norm of the triangular matrix A or A**H.
233*
234      ANORM = ZLANTB( NORM, UPLO, DIAG, N, KD, AB, LDAB, RWORK )
235*
236*     Continue only if ANORM > 0.
237*
238      IF( ANORM.GT.ZERO ) THEN
239*
240*        Estimate the 1-norm of the inverse of A.
241*
242         AINVNM = ZERO
243         NORMIN = 'N'
244         IF( ONENRM ) THEN
245            KASE1 = 1
246         ELSE
247            KASE1 = 2
248         END IF
249         KASE = 0
250   10    CONTINUE
251         CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
252         IF( KASE.NE.0 ) THEN
253            IF( KASE.EQ.KASE1 ) THEN
254*
255*              Multiply by inv(A).
256*
257               CALL ZLATBS( UPLO, 'No transpose', DIAG, NORMIN, N, KD,
258     $                      AB, LDAB, WORK, SCALE, RWORK, INFO )
259            ELSE
260*
261*              Multiply by inv(A**H).
262*
263               CALL ZLATBS( UPLO, 'Conjugate transpose', DIAG, NORMIN,
264     $                      N, KD, AB, LDAB, WORK, SCALE, RWORK, INFO )
265            END IF
266            NORMIN = 'Y'
267*
268*           Multiply by 1/SCALE if doing so will not cause overflow.
269*
270            IF( SCALE.NE.ONE ) THEN
271               IX = IZAMAX( N, WORK, 1 )
272               XNORM = CABS1( WORK( IX ) )
273               IF( SCALE.LT.XNORM*SMLNUM .OR. SCALE.EQ.ZERO )
274     $            GO TO 20
275               CALL ZDRSCL( N, SCALE, WORK, 1 )
276            END IF
277            GO TO 10
278         END IF
279*
280*        Compute the estimate of the reciprocal condition number.
281*
282         IF( AINVNM.NE.ZERO )
283     $      RCOND = ( ONE / ANORM ) / AINVNM
284      END IF
285*
286   20 CONTINUE
287      RETURN
288*
289*     End of ZTBCON
290*
291      END
292