LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
dlacn2.f
Go to the documentation of this file.
1 *> \brief \b DLACN2 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 DLACN2 + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlacn2.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlacn2.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlacn2.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE DLACN2( N, V, X, ISGN, EST, KASE, ISAVE )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER KASE, N
25 * DOUBLE PRECISION EST
26 * ..
27 * .. Array Arguments ..
28 * INTEGER ISGN( * ), ISAVE( 3 )
29 * DOUBLE PRECISION V( * ), X( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> DLACN2 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DLACN2 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 DOUBLE PRECISION
76 *> On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
77 *> unchanged from the previous call to DLACN2.
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 DLACN2, 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 DLACN2, KASE will again be 0.
88 *> \endverbatim
89 *>
90 *> \param[in,out] ISAVE
91 *> \verbatim
92 *> ISAVE is INTEGER array, dimension (3)
93 *> ISAVE is used to save variables between calls to DLACN2
94 *> \endverbatim
95 *
96 * Authors:
97 * ========
98 *
99 *> \author Univ. of Tennessee
100 *> \author Univ. of California Berkeley
101 *> \author Univ. of Colorado Denver
102 *> \author NAG Ltd.
103 *
104 *> \ingroup doubleOTHERauxiliary
105 *
106 *> \par Further Details:
107 * =====================
108 *>
109 *> \verbatim
110 *>
111 *> Originally named SONEST, dated March 16, 1988.
112 *>
113 *> This is a thread safe version of DLACON, which uses the array ISAVE
114 *> in place of a SAVE statement, as follows:
115 *>
116 *> DLACON DLACN2
117 *> JUMP ISAVE(1)
118 *> J ISAVE(2)
119 *> ITER ISAVE(3)
120 *> \endverbatim
121 *
122 *> \par Contributors:
123 * ==================
124 *>
125 *> Nick Higham, University of Manchester
126 *
127 *> \par References:
128 * ================
129 *>
130 *> N.J. Higham, "FORTRAN codes for estimating the one-norm of
131 *> a real or complex matrix, with applications to condition estimation",
132 *> ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
133 *>
134 * =====================================================================
135  SUBROUTINE dlacn2( N, V, X, ISGN, EST, KASE, ISAVE )
136 *
137 * -- LAPACK auxiliary routine --
138 * -- LAPACK is a software package provided by Univ. of Tennessee, --
139 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
140 *
141 * .. Scalar Arguments ..
142  INTEGER KASE, N
143  DOUBLE PRECISION EST
144 * ..
145 * .. Array Arguments ..
146  INTEGER ISGN( * ), ISAVE( 3 )
147  DOUBLE PRECISION V( * ), X( * )
148 * ..
149 *
150 * =====================================================================
151 *
152 * .. Parameters ..
153  INTEGER ITMAX
154  parameter( itmax = 5 )
155  DOUBLE PRECISION ZERO, ONE, TWO
156  parameter( zero = 0.0d+0, one = 1.0d+0, two = 2.0d+0 )
157 * ..
158 * .. Local Scalars ..
159  INTEGER I, JLAST
160  DOUBLE PRECISION ALTSGN, ESTOLD, TEMP, XS
161 * ..
162 * .. External Functions ..
163  INTEGER IDAMAX
164  DOUBLE PRECISION DASUM
165  EXTERNAL idamax, dasum
166 * ..
167 * .. External Subroutines ..
168  EXTERNAL dcopy
169 * ..
170 * .. Intrinsic Functions ..
171  INTRINSIC abs, dble, nint
172 * ..
173 * .. Executable Statements ..
174 *
175  IF( kase.EQ.0 ) THEN
176  DO 10 i = 1, n
177  x( i ) = one / dble( n )
178  10 CONTINUE
179  kase = 1
180  isave( 1 ) = 1
181  RETURN
182  END IF
183 *
184  GO TO ( 20, 40, 70, 110, 140 )isave( 1 )
185 *
186 * ................ ENTRY (ISAVE( 1 ) = 1)
187 * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
188 *
189  20 CONTINUE
190  IF( n.EQ.1 ) THEN
191  v( 1 ) = x( 1 )
192  est = abs( v( 1 ) )
193 * ... QUIT
194  GO TO 150
195  END IF
196  est = dasum( n, x, 1 )
197 *
198  DO 30 i = 1, n
199  IF( x(i).GE.zero ) THEN
200  x(i) = one
201  ELSE
202  x(i) = -one
203  END IF
204  isgn( i ) = nint( x( i ) )
205  30 CONTINUE
206  kase = 2
207  isave( 1 ) = 2
208  RETURN
209 *
210 * ................ ENTRY (ISAVE( 1 ) = 2)
211 * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
212 *
213  40 CONTINUE
214  isave( 2 ) = idamax( n, x, 1 )
215  isave( 3 ) = 2
216 *
217 * MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
218 *
219  50 CONTINUE
220  DO 60 i = 1, n
221  x( i ) = zero
222  60 CONTINUE
223  x( isave( 2 ) ) = one
224  kase = 1
225  isave( 1 ) = 3
226  RETURN
227 *
228 * ................ ENTRY (ISAVE( 1 ) = 3)
229 * X HAS BEEN OVERWRITTEN BY A*X.
230 *
231  70 CONTINUE
232  CALL dcopy( n, x, 1, v, 1 )
233  estold = est
234  est = dasum( n, v, 1 )
235  DO 80 i = 1, n
236  IF( x(i).GE.zero ) THEN
237  xs = one
238  ELSE
239  xs = -one
240  END IF
241  IF( nint( xs ).NE.isgn( i ) )
242  $ GO TO 90
243  80 CONTINUE
244 * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
245  GO TO 120
246 *
247  90 CONTINUE
248 * TEST FOR CYCLING.
249  IF( est.LE.estold )
250  $ GO TO 120
251 *
252  DO 100 i = 1, n
253  IF( x(i).GE.zero ) THEN
254  x(i) = one
255  ELSE
256  x(i) = -one
257  END IF
258  isgn( i ) = nint( x( i ) )
259  100 CONTINUE
260  kase = 2
261  isave( 1 ) = 4
262  RETURN
263 *
264 * ................ ENTRY (ISAVE( 1 ) = 4)
265 * X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
266 *
267  110 CONTINUE
268  jlast = isave( 2 )
269  isave( 2 ) = idamax( n, x, 1 )
270  IF( ( x( jlast ).NE.abs( x( isave( 2 ) ) ) ) .AND.
271  $ ( isave( 3 ).LT.itmax ) ) THEN
272  isave( 3 ) = isave( 3 ) + 1
273  GO TO 50
274  END IF
275 *
276 * ITERATION COMPLETE. FINAL STAGE.
277 *
278  120 CONTINUE
279  altsgn = one
280  DO 130 i = 1, n
281  x( i ) = altsgn*( one+dble( i-1 ) / dble( n-1 ) )
282  altsgn = -altsgn
283  130 CONTINUE
284  kase = 1
285  isave( 1 ) = 5
286  RETURN
287 *
288 * ................ ENTRY (ISAVE( 1 ) = 5)
289 * X HAS BEEN OVERWRITTEN BY A*X.
290 *
291  140 CONTINUE
292  temp = two*( dasum( n, x, 1 ) / dble( 3*n ) )
293  IF( temp.GT.est ) THEN
294  CALL dcopy( n, x, 1, v, 1 )
295  est = temp
296  END IF
297 *
298  150 CONTINUE
299  kase = 0
300  RETURN
301 *
302 * End of DLACN2
303 *
304  END
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
Definition: dcopy.f:82
subroutine dlacn2(N, V, X, ISGN, EST, KASE, ISAVE)
DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
Definition: dlacn2.f:136