LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
slacon.f
Go to the documentation of this file.
1 *> \brief \b SLACON estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SLACON + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slacon.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slacon.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slacon.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SLACON( N, V, X, ISGN, EST, KASE )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER KASE, N
25 * REAL EST
26 * ..
27 * .. Array Arguments ..
28 * INTEGER ISGN( * )
29 * REAL V( * ), X( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> SLACON estimates the 1-norm of a square, real matrix A.
39 *> Reverse communication is used for evaluating matrix-vector products.
40 *> \endverbatim
41 *
42 * Arguments:
43 * ==========
44 *
45 *> \param[in] N
46 *> \verbatim
47 *> N is INTEGER
48 *> The order of the matrix. N >= 1.
49 *> \endverbatim
50 *>
51 *> \param[out] V
52 *> \verbatim
53 *> V is REAL array, dimension (N)
54 *> On the final return, V = A*W, where EST = norm(V)/norm(W)
55 *> (W is not returned).
56 *> \endverbatim
57 *>
58 *> \param[in,out] X
59 *> \verbatim
60 *> X is REAL array, dimension (N)
61 *> On an intermediate return, X should be overwritten by
62 *> A * X, if KASE=1,
63 *> A**T * X, if KASE=2,
64 *> and SLACON must be re-called with all the other parameters
65 *> unchanged.
66 *> \endverbatim
67 *>
68 *> \param[out] ISGN
69 *> \verbatim
70 *> ISGN is INTEGER array, dimension (N)
71 *> \endverbatim
72 *>
73 *> \param[in,out] EST
74 *> \verbatim
75 *> EST is REAL
76 *> On entry with KASE = 1 or 2 and JUMP = 3, EST should be
77 *> unchanged from the previous call to SLACON.
78 *> On exit, EST is an estimate (a lower bound) for norm(A).
79 *> \endverbatim
80 *>
81 *> \param[in,out] KASE
82 *> \verbatim
83 *> KASE is INTEGER
84 *> On the initial call to SLACON, KASE should be 0.
85 *> On an intermediate return, KASE will be 1 or 2, indicating
86 *> whether X should be overwritten by A * X or A**T * X.
87 *> On the final return from SLACON, KASE will again be 0.
88 *> \endverbatim
89 *
90 * Authors:
91 * ========
92 *
93 *> \author Univ. of Tennessee
94 *> \author Univ. of California Berkeley
95 *> \author Univ. of Colorado Denver
96 *> \author NAG Ltd.
97 *
98 *> \date September 2012
99 *
100 *> \ingroup realOTHERauxiliary
101 *
102 *> \par Contributors:
103 * ==================
104 *>
105 *> Nick Higham, University of Manchester. \n
106 *> Originally named SONEST, dated March 16, 1988.
107 *
108 *> \par References:
109 * ================
110 *>
111 *> N.J. Higham, "FORTRAN codes for estimating the one-norm of
112 *> a real or complex matrix, with applications to condition estimation",
113 *> ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
114 *>
115 * =====================================================================
116  SUBROUTINE slacon( N, V, X, ISGN, EST, KASE )
117 *
118 * -- LAPACK auxiliary routine (version 3.4.2) --
119 * -- LAPACK is a software package provided by Univ. of Tennessee, --
120 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
121 * September 2012
122 *
123 * .. Scalar Arguments ..
124  INTEGER kase, n
125  REAL est
126 * ..
127 * .. Array Arguments ..
128  INTEGER isgn( * )
129  REAL v( * ), x( * )
130 * ..
131 *
132 * =====================================================================
133 *
134 * .. Parameters ..
135  INTEGER itmax
136  parameter( itmax = 5 )
137  REAL zero, one, two
138  parameter( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
139 * ..
140 * .. Local Scalars ..
141  INTEGER i, iter, j, jlast, jump
142  REAL altsgn, estold, temp
143 * ..
144 * .. External Functions ..
145  INTEGER isamax
146  REAL sasum
147  EXTERNAL isamax, sasum
148 * ..
149 * .. External Subroutines ..
150  EXTERNAL scopy
151 * ..
152 * .. Intrinsic Functions ..
153  INTRINSIC abs, nint, REAL, sign
154 * ..
155 * .. Save statement ..
156  SAVE
157 * ..
158 * .. Executable Statements ..
159 *
160  IF( kase.EQ.0 ) THEN
161  DO 10 i = 1, n
162  x( i ) = one / REAL( n )
163  10 continue
164  kase = 1
165  jump = 1
166  return
167  END IF
168 *
169  go to( 20, 40, 70, 110, 140 )jump
170 *
171 * ................ ENTRY (JUMP = 1)
172 * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
173 *
174  20 continue
175  IF( n.EQ.1 ) THEN
176  v( 1 ) = x( 1 )
177  est = abs( v( 1 ) )
178 * ... QUIT
179  go to 150
180  END IF
181  est = sasum( n, x, 1 )
182 *
183  DO 30 i = 1, n
184  x( i ) = sign( one, x( i ) )
185  isgn( i ) = nint( x( i ) )
186  30 continue
187  kase = 2
188  jump = 2
189  return
190 *
191 * ................ ENTRY (JUMP = 2)
192 * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
193 *
194  40 continue
195  j = isamax( n, x, 1 )
196  iter = 2
197 *
198 * MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
199 *
200  50 continue
201  DO 60 i = 1, n
202  x( i ) = zero
203  60 continue
204  x( j ) = one
205  kase = 1
206  jump = 3
207  return
208 *
209 * ................ ENTRY (JUMP = 3)
210 * X HAS BEEN OVERWRITTEN BY A*X.
211 *
212  70 continue
213  CALL scopy( n, x, 1, v, 1 )
214  estold = est
215  est = sasum( n, v, 1 )
216  DO 80 i = 1, n
217  IF( nint( sign( one, x( i ) ) ).NE.isgn( i ) )
218  $ go to 90
219  80 continue
220 * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
221  go to 120
222 *
223  90 continue
224 * TEST FOR CYCLING.
225  IF( est.LE.estold )
226  $ go to 120
227 *
228  DO 100 i = 1, n
229  x( i ) = sign( one, x( i ) )
230  isgn( i ) = nint( x( i ) )
231  100 continue
232  kase = 2
233  jump = 4
234  return
235 *
236 * ................ ENTRY (JUMP = 4)
237 * X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
238 *
239  110 continue
240  jlast = j
241  j = isamax( n, x, 1 )
242  IF( ( x( jlast ).NE.abs( x( j ) ) ) .AND. ( iter.LT.itmax ) ) THEN
243  iter = iter + 1
244  go to 50
245  END IF
246 *
247 * ITERATION COMPLETE. FINAL STAGE.
248 *
249  120 continue
250  altsgn = one
251  DO 130 i = 1, n
252  x( i ) = altsgn*( one+REAL( I-1 ) / REAL( N-1 ) )
253  altsgn = -altsgn
254  130 continue
255  kase = 1
256  jump = 5
257  return
258 *
259 * ................ ENTRY (JUMP = 5)
260 * X HAS BEEN OVERWRITTEN BY A*X.
261 *
262  140 continue
263  temp = two*( sasum( n, x, 1 ) / REAL( 3*N ) )
264  IF( temp.GT.est ) THEN
265  CALL scopy( n, x, 1, v, 1 )
266  est = temp
267  END IF
268 *
269  150 continue
270  kase = 0
271  return
272 *
273 * End of SLACON
274 *
275  END