1*> \brief \b CLA_SYRCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for symmetric indefinite matrices.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CLA_SYRCOND_C + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cla_syrcond_c.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cla_syrcond_c.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cla_syrcond_c.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       REAL FUNCTION CLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, C,
22*                                    CAPPLY, INFO, WORK, RWORK )
23*
24*       .. Scalar Arguments ..
25*       CHARACTER          UPLO
26*       LOGICAL            CAPPLY
27*       INTEGER            N, LDA, LDAF, INFO
28*       ..
29*       .. Array Arguments ..
30*       INTEGER            IPIV( * )
31*       COMPLEX            A( LDA, * ), AF( LDAF, * ), WORK( * )
32*       REAL               C( * ), RWORK( * )
33*       ..
34*
35*
36*> \par Purpose:
37*  =============
38*>
39*> \verbatim
40*>
41*>    CLA_SYRCOND_C Computes the infinity norm condition number of
42*>    op(A) * inv(diag(C)) where C is a REAL vector.
43*> \endverbatim
44*
45*  Arguments:
46*  ==========
47*
48*> \param[in] UPLO
49*> \verbatim
50*>          UPLO is CHARACTER*1
51*>       = 'U':  Upper triangle of A is stored;
52*>       = 'L':  Lower triangle of A is stored.
53*> \endverbatim
54*>
55*> \param[in] N
56*> \verbatim
57*>          N is INTEGER
58*>     The number of linear equations, i.e., the order of the
59*>     matrix A.  N >= 0.
60*> \endverbatim
61*>
62*> \param[in] A
63*> \verbatim
64*>          A is COMPLEX array, dimension (LDA,N)
65*>     On entry, the N-by-N matrix A
66*> \endverbatim
67*>
68*> \param[in] LDA
69*> \verbatim
70*>          LDA is INTEGER
71*>     The leading dimension of the array A.  LDA >= max(1,N).
72*> \endverbatim
73*>
74*> \param[in] AF
75*> \verbatim
76*>          AF is COMPLEX array, dimension (LDAF,N)
77*>     The block diagonal matrix D and the multipliers used to
78*>     obtain the factor U or L as computed by CSYTRF.
79*> \endverbatim
80*>
81*> \param[in] LDAF
82*> \verbatim
83*>          LDAF is INTEGER
84*>     The leading dimension of the array AF.  LDAF >= max(1,N).
85*> \endverbatim
86*>
87*> \param[in] IPIV
88*> \verbatim
89*>          IPIV is INTEGER array, dimension (N)
90*>     Details of the interchanges and the block structure of D
91*>     as determined by CSYTRF.
92*> \endverbatim
93*>
94*> \param[in] C
95*> \verbatim
96*>          C is REAL array, dimension (N)
97*>     The vector C in the formula op(A) * inv(diag(C)).
98*> \endverbatim
99*>
100*> \param[in] CAPPLY
101*> \verbatim
102*>          CAPPLY is LOGICAL
103*>     If .TRUE. then access the vector C in the formula above.
104*> \endverbatim
105*>
106*> \param[out] INFO
107*> \verbatim
108*>          INFO is INTEGER
109*>       = 0:  Successful exit.
110*>     i > 0:  The ith argument is invalid.
111*> \endverbatim
112*>
113*> \param[in] WORK
114*> \verbatim
115*>          WORK is COMPLEX array, dimension (2*N).
116*>     Workspace.
117*> \endverbatim
118*>
119*> \param[in] RWORK
120*> \verbatim
121*>          RWORK is REAL array, dimension (N).
122*>     Workspace.
123*> \endverbatim
124*
125*  Authors:
126*  ========
127*
128*> \author Univ. of Tennessee
129*> \author Univ. of California Berkeley
130*> \author Univ. of Colorado Denver
131*> \author NAG Ltd.
132*
133*> \date September 2012
134*
135*> \ingroup complexSYcomputational
136*
137*  =====================================================================
138      REAL FUNCTION CLA_SYRCOND_C( UPLO, N, A, LDA, AF, LDAF, IPIV, C,
139     $                             CAPPLY, INFO, WORK, RWORK )
140*
141*  -- LAPACK computational routine (version 3.4.2) --
142*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
143*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
144*     September 2012
145*
146*     .. Scalar Arguments ..
147      CHARACTER          UPLO
148      LOGICAL            CAPPLY
149      INTEGER            N, LDA, LDAF, INFO
150*     ..
151*     .. Array Arguments ..
152      INTEGER            IPIV( * )
153      COMPLEX            A( LDA, * ), AF( LDAF, * ), WORK( * )
154      REAL               C( * ), RWORK( * )
155*     ..
156*
157*  =====================================================================
158*
159*     .. Local Scalars ..
160      INTEGER            KASE
161      REAL               AINVNM, ANORM, TMP
162      INTEGER            I, J
163      LOGICAL            UP, UPPER
164      COMPLEX            ZDUM
165*     ..
166*     .. Local Arrays ..
167      INTEGER            ISAVE( 3 )
168*     ..
169*     .. External Functions ..
170      LOGICAL            LSAME
171      EXTERNAL           LSAME
172*     ..
173*     .. External Subroutines ..
174      EXTERNAL           CLACN2, CSYTRS, XERBLA
175*     ..
176*     .. Intrinsic Functions ..
177      INTRINSIC          ABS, MAX
178*     ..
179*     .. Statement Functions ..
180      REAL CABS1
181*     ..
182*     .. Statement Function Definitions ..
183      CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
184*     ..
185*     .. Executable Statements ..
186*
187      CLA_SYRCOND_C = 0.0E+0
188*
189      INFO = 0
190      UPPER = LSAME( UPLO, 'U' )
191      IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
192         INFO = -1
193      ELSE IF( N.LT.0 ) THEN
194         INFO = -2
195      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
196         INFO = -4
197      ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
198         INFO = -6
199      END IF
200      IF( INFO.NE.0 ) THEN
201         CALL XERBLA( 'CLA_SYRCOND_C', -INFO )
202         RETURN
203      END IF
204      UP = .FALSE.
205      IF ( LSAME( UPLO, 'U' ) ) UP = .TRUE.
206*
207*     Compute norm of op(A)*op2(C).
208*
209      ANORM = 0.0E+0
210      IF ( UP ) THEN
211         DO I = 1, N
212            TMP = 0.0E+0
213            IF ( CAPPLY ) THEN
214               DO J = 1, I
215                  TMP = TMP + CABS1( A( J, I ) ) / C( J )
216               END DO
217               DO J = I+1, N
218                  TMP = TMP + CABS1( A( I, J ) ) / C( J )
219               END DO
220            ELSE
221               DO J = 1, I
222                  TMP = TMP + CABS1( A( J, I ) )
223               END DO
224               DO J = I+1, N
225                  TMP = TMP + CABS1( A( I, J ) )
226               END DO
227            END IF
228            RWORK( I ) = TMP
229            ANORM = MAX( ANORM, TMP )
230         END DO
231      ELSE
232         DO I = 1, N
233            TMP = 0.0E+0
234            IF ( CAPPLY ) THEN
235               DO J = 1, I
236                  TMP = TMP + CABS1( A( I, J ) ) / C( J )
237               END DO
238               DO J = I+1, N
239                  TMP = TMP + CABS1( A( J, I ) ) / C( J )
240               END DO
241            ELSE
242               DO J = 1, I
243                  TMP = TMP + CABS1( A( I, J ) )
244               END DO
245               DO J = I+1, N
246                  TMP = TMP + CABS1( A( J, I ) )
247               END DO
248            END IF
249            RWORK( I ) = TMP
250            ANORM = MAX( ANORM, TMP )
251         END DO
252      END IF
253*
254*     Quick return if possible.
255*
256      IF( N.EQ.0 ) THEN
257         CLA_SYRCOND_C = 1.0E+0
258         RETURN
259      ELSE IF( ANORM .EQ. 0.0E+0 ) THEN
260         RETURN
261      END IF
262*
263*     Estimate the norm of inv(op(A)).
264*
265      AINVNM = 0.0E+0
266*
267      KASE = 0
268   10 CONTINUE
269      CALL CLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
270      IF( KASE.NE.0 ) THEN
271         IF( KASE.EQ.2 ) THEN
272*
273*           Multiply by R.
274*
275            DO I = 1, N
276               WORK( I ) = WORK( I ) * RWORK( I )
277            END DO
278*
279            IF ( UP ) THEN
280               CALL CSYTRS( 'U', N, 1, AF, LDAF, IPIV,
281     $            WORK, N, INFO )
282            ELSE
283               CALL CSYTRS( 'L', N, 1, AF, LDAF, IPIV,
284     $            WORK, N, INFO )
285            ENDIF
286*
287*           Multiply by inv(C).
288*
289            IF ( CAPPLY ) THEN
290               DO I = 1, N
291                  WORK( I ) = WORK( I ) * C( I )
292               END DO
293            END IF
294         ELSE
295*
296*           Multiply by inv(C**T).
297*
298            IF ( CAPPLY ) THEN
299               DO I = 1, N
300                  WORK( I ) = WORK( I ) * C( I )
301               END DO
302            END IF
303*
304            IF ( UP ) THEN
305               CALL CSYTRS( 'U', N, 1, AF, LDAF, IPIV,
306     $            WORK, N, INFO )
307            ELSE
308               CALL CSYTRS( 'L', N, 1, AF, LDAF, IPIV,
309     $            WORK, N, INFO )
310            END IF
311*
312*           Multiply by R.
313*
314            DO I = 1, N
315               WORK( I ) = WORK( I ) * RWORK( I )
316            END DO
317         END IF
318         GO TO 10
319      END IF
320*
321*     Compute the estimate of the reciprocal condition number.
322*
323      IF( AINVNM .NE. 0.0E+0 )
324     $   CLA_SYRCOND_C = 1.0E+0 / AINVNM
325*
326      RETURN
327*
328      END
329