ENH: Improving the travis dashboard name
[platform/upstream/lapack.git] / SRC / zspcon.f
1 *> \brief \b ZSPCON
2 *
3 *  =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 *            http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download ZSPCON + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zspcon.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zspcon.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zspcon.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 *  Definition:
19 *  ===========
20 *
21 *       SUBROUTINE ZSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO )
22 *
23 *       .. Scalar Arguments ..
24 *       CHARACTER          UPLO
25 *       INTEGER            INFO, N
26 *       DOUBLE PRECISION   ANORM, RCOND
27 *       ..
28 *       .. Array Arguments ..
29 *       INTEGER            IPIV( * )
30 *       COMPLEX*16         AP( * ), WORK( * )
31 *       ..
32 *
33 *
34 *> \par Purpose:
35 *  =============
36 *>
37 *> \verbatim
38 *>
39 *> ZSPCON estimates the reciprocal of the condition number (in the
40 *> 1-norm) of a complex symmetric packed matrix A using the
41 *> factorization A = U*D*U**T or A = L*D*L**T computed by ZSPTRF.
42 *>
43 *> An estimate is obtained for norm(inv(A)), and the reciprocal of the
44 *> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
45 *> \endverbatim
46 *
47 *  Arguments:
48 *  ==========
49 *
50 *> \param[in] UPLO
51 *> \verbatim
52 *>          UPLO is CHARACTER*1
53 *>          Specifies whether the details of the factorization are stored
54 *>          as an upper or lower triangular matrix.
55 *>          = 'U':  Upper triangular, form is A = U*D*U**T;
56 *>          = 'L':  Lower triangular, form is A = L*D*L**T.
57 *> \endverbatim
58 *>
59 *> \param[in] N
60 *> \verbatim
61 *>          N is INTEGER
62 *>          The order of the matrix A.  N >= 0.
63 *> \endverbatim
64 *>
65 *> \param[in] AP
66 *> \verbatim
67 *>          AP is COMPLEX*16 array, dimension (N*(N+1)/2)
68 *>          The block diagonal matrix D and the multipliers used to
69 *>          obtain the factor U or L as computed by ZSPTRF, stored as a
70 *>          packed triangular matrix.
71 *> \endverbatim
72 *>
73 *> \param[in] IPIV
74 *> \verbatim
75 *>          IPIV is INTEGER array, dimension (N)
76 *>          Details of the interchanges and the block structure of D
77 *>          as determined by ZSPTRF.
78 *> \endverbatim
79 *>
80 *> \param[in] ANORM
81 *> \verbatim
82 *>          ANORM is DOUBLE PRECISION
83 *>          The 1-norm of the original matrix A.
84 *> \endverbatim
85 *>
86 *> \param[out] RCOND
87 *> \verbatim
88 *>          RCOND is DOUBLE PRECISION
89 *>          The reciprocal of the condition number of the matrix A,
90 *>          computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
91 *>          estimate of the 1-norm of inv(A) computed in this routine.
92 *> \endverbatim
93 *>
94 *> \param[out] WORK
95 *> \verbatim
96 *>          WORK is COMPLEX*16 array, dimension (2*N)
97 *> \endverbatim
98 *>
99 *> \param[out] INFO
100 *> \verbatim
101 *>          INFO is INTEGER
102 *>          = 0:  successful exit
103 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
104 *> \endverbatim
105 *
106 *  Authors:
107 *  ========
108 *
109 *> \author Univ. of Tennessee
110 *> \author Univ. of California Berkeley
111 *> \author Univ. of Colorado Denver
112 *> \author NAG Ltd.
113 *
114 *> \date November 2011
115 *
116 *> \ingroup complex16OTHERcomputational
117 *
118 *  =====================================================================
119       SUBROUTINE ZSPCON( UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO )
120 *
121 *  -- LAPACK computational routine (version 3.4.0) --
122 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
123 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
124 *     November 2011
125 *
126 *     .. Scalar Arguments ..
127       CHARACTER          UPLO
128       INTEGER            INFO, N
129       DOUBLE PRECISION   ANORM, RCOND
130 *     ..
131 *     .. Array Arguments ..
132       INTEGER            IPIV( * )
133       COMPLEX*16         AP( * ), WORK( * )
134 *     ..
135 *
136 *  =====================================================================
137 *
138 *     .. Parameters ..
139       DOUBLE PRECISION   ONE, ZERO
140       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
141 *     ..
142 *     .. Local Scalars ..
143       LOGICAL            UPPER
144       INTEGER            I, IP, KASE
145       DOUBLE PRECISION   AINVNM
146 *     ..
147 *     .. Local Arrays ..
148       INTEGER            ISAVE( 3 )
149 *     ..
150 *     .. External Functions ..
151       LOGICAL            LSAME
152       EXTERNAL           LSAME
153 *     ..
154 *     .. External Subroutines ..
155       EXTERNAL           XERBLA, ZLACN2, ZSPTRS
156 *     ..
157 *     .. Executable Statements ..
158 *
159 *     Test the input parameters.
160 *
161       INFO = 0
162       UPPER = LSAME( UPLO, 'U' )
163       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
164          INFO = -1
165       ELSE IF( N.LT.0 ) THEN
166          INFO = -2
167       ELSE IF( ANORM.LT.ZERO ) THEN
168          INFO = -5
169       END IF
170       IF( INFO.NE.0 ) THEN
171          CALL XERBLA( 'ZSPCON', -INFO )
172          RETURN
173       END IF
174 *
175 *     Quick return if possible
176 *
177       RCOND = ZERO
178       IF( N.EQ.0 ) THEN
179          RCOND = ONE
180          RETURN
181       ELSE IF( ANORM.LE.ZERO ) THEN
182          RETURN
183       END IF
184 *
185 *     Check that the diagonal matrix D is nonsingular.
186 *
187       IF( UPPER ) THEN
188 *
189 *        Upper triangular storage: examine D from bottom to top
190 *
191          IP = N*( N+1 ) / 2
192          DO 10 I = N, 1, -1
193             IF( IPIV( I ).GT.0 .AND. AP( IP ).EQ.ZERO )
194      $         RETURN
195             IP = IP - I
196    10    CONTINUE
197       ELSE
198 *
199 *        Lower triangular storage: examine D from top to bottom.
200 *
201          IP = 1
202          DO 20 I = 1, N
203             IF( IPIV( I ).GT.0 .AND. AP( IP ).EQ.ZERO )
204      $         RETURN
205             IP = IP + N - I + 1
206    20    CONTINUE
207       END IF
208 *
209 *     Estimate the 1-norm of the inverse.
210 *
211       KASE = 0
212    30 CONTINUE
213       CALL ZLACN2( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
214       IF( KASE.NE.0 ) THEN
215 *
216 *        Multiply by inv(L*D*L**T) or inv(U*D*U**T).
217 *
218          CALL ZSPTRS( UPLO, N, 1, AP, IPIV, WORK, N, INFO )
219          GO TO 30
220       END IF
221 *
222 *     Compute the estimate of the reciprocal condition number.
223 *
224       IF( AINVNM.NE.ZERO )
225      $   RCOND = ( ONE / AINVNM ) / ANORM
226 *
227       RETURN
228 *
229 *     End of ZSPCON
230 *
231       END