LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dlacn2()

subroutine dlacn2 ( integer n,
double precision, dimension( * ) v,
double precision, dimension( * ) x,
integer, dimension( * ) isgn,
double precision est,
integer kase,
integer, dimension( 3 ) isave )

DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vector products.

Download DLACN2 + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!> DLACN2 estimates the 1-norm of a square, real matrix A.
!> Reverse communication is used for evaluating matrix-vector products.
!>
Parameters
[in]N
!>          N is INTEGER
!>         The order of the matrix.  N >= 1.
!>
[out]V
!>          V is DOUBLE PRECISION array, dimension (N)
!>         On the final return, V = A*W,  where  EST = norm(V)/norm(W)
!>         (W is not returned).
!>
[in,out]X
!>          X is DOUBLE PRECISION array, dimension (N)
!>         On an intermediate return, X should be overwritten by
!>               A * X,   if KASE=1,
!>               A**T * X,  if KASE=2,
!>         and DLACN2 must be re-called with all the other parameters
!>         unchanged.
!>
[out]ISGN
!>          ISGN is INTEGER array, dimension (N)
!>
[in,out]EST
!>          EST is DOUBLE PRECISION
!>         On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be
!>         unchanged from the previous call to DLACN2.
!>         On exit, EST is an estimate (a lower bound) for norm(A).
!>
[in,out]KASE
!>          KASE is INTEGER
!>         On the initial call to DLACN2, KASE should be 0.
!>         On an intermediate return, KASE will be 1 or 2, indicating
!>         whether X should be overwritten by A * X  or A**T * X.
!>         On the final return from DLACN2, KASE will again be 0.
!>
[in,out]ISAVE
!>          ISAVE is INTEGER array, dimension (3)
!>         ISAVE is used to save variables between calls to DLACN2
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Originally named SONEST, dated March 16, 1988.
!>
!>  This is a thread safe version of DLACON, which uses the array ISAVE
!>  in place of a SAVE statement, as follows:
!>
!>     DLACON     DLACN2
!>      JUMP     ISAVE(1)
!>      J        ISAVE(2)
!>      ITER     ISAVE(3)
!>
Contributors:
Nick Higham, University of Manchester
References:
N.J. Higham, "FORTRAN codes for estimating the one-norm of a real or complex matrix, with applications to condition estimation", ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.

Definition at line 133 of file dlacn2.f.

134*
135* -- LAPACK auxiliary routine --
136* -- LAPACK is a software package provided by Univ. of Tennessee, --
137* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
138*
139* .. Scalar Arguments ..
140 INTEGER KASE, N
141 DOUBLE PRECISION EST
142* ..
143* .. Array Arguments ..
144 INTEGER ISGN( * ), ISAVE( 3 )
145 DOUBLE PRECISION V( * ), X( * )
146* ..
147*
148* =====================================================================
149*
150* .. Parameters ..
151 INTEGER ITMAX
152 parameter( itmax = 5 )
153 DOUBLE PRECISION ZERO, ONE, TWO
154 parameter( zero = 0.0d+0, one = 1.0d+0, two = 2.0d+0 )
155* ..
156* .. Local Scalars ..
157 INTEGER I, JLAST
158 DOUBLE PRECISION ALTSGN, ESTOLD, TEMP, XS
159* ..
160* .. External Functions ..
161 INTEGER IDAMAX
162 DOUBLE PRECISION DASUM
163 EXTERNAL idamax, dasum
164* ..
165* .. External Subroutines ..
166 EXTERNAL dcopy
167* ..
168* .. Intrinsic Functions ..
169 INTRINSIC abs, dble, nint
170* ..
171* .. Executable Statements ..
172*
173 IF( kase.EQ.0 ) THEN
174 DO 10 i = 1, n
175 x( i ) = one / dble( n )
176 10 CONTINUE
177 kase = 1
178 isave( 1 ) = 1
179 RETURN
180 END IF
181*
182 GO TO ( 20, 40, 70, 110, 140 )isave( 1 )
183*
184* ................ ENTRY (ISAVE( 1 ) = 1)
185* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
186*
187 20 CONTINUE
188 IF( n.EQ.1 ) THEN
189 v( 1 ) = x( 1 )
190 est = abs( v( 1 ) )
191* ... QUIT
192 GO TO 150
193 END IF
194 est = dasum( n, x, 1 )
195*
196 DO 30 i = 1, n
197 IF( x(i).GE.zero ) THEN
198 x(i) = one
199 ELSE
200 x(i) = -one
201 END IF
202 isgn( i ) = nint( x( i ) )
203 30 CONTINUE
204 kase = 2
205 isave( 1 ) = 2
206 RETURN
207*
208* ................ ENTRY (ISAVE( 1 ) = 2)
209* FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
210*
211 40 CONTINUE
212 isave( 2 ) = idamax( n, x, 1 )
213 isave( 3 ) = 2
214*
215* MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
216*
217 50 CONTINUE
218 DO 60 i = 1, n
219 x( i ) = zero
220 60 CONTINUE
221 x( isave( 2 ) ) = one
222 kase = 1
223 isave( 1 ) = 3
224 RETURN
225*
226* ................ ENTRY (ISAVE( 1 ) = 3)
227* X HAS BEEN OVERWRITTEN BY A*X.
228*
229 70 CONTINUE
230 CALL dcopy( n, x, 1, v, 1 )
231 estold = est
232 est = dasum( n, v, 1 )
233 DO 80 i = 1, n
234 IF( x(i).GE.zero ) THEN
235 xs = one
236 ELSE
237 xs = -one
238 END IF
239 IF( nint( xs ).NE.isgn( i ) )
240 $ GO TO 90
241 80 CONTINUE
242* REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
243 GO TO 120
244*
245 90 CONTINUE
246* TEST FOR CYCLING.
247 IF( est.LE.estold )
248 $ GO TO 120
249*
250 DO 100 i = 1, n
251 IF( x(i).GE.zero ) THEN
252 x(i) = one
253 ELSE
254 x(i) = -one
255 END IF
256 isgn( i ) = nint( x( i ) )
257 100 CONTINUE
258 kase = 2
259 isave( 1 ) = 4
260 RETURN
261*
262* ................ ENTRY (ISAVE( 1 ) = 4)
263* X HAS BEEN OVERWRITTEN BY TRANSPOSE(A)*X.
264*
265 110 CONTINUE
266 jlast = isave( 2 )
267 isave( 2 ) = idamax( n, x, 1 )
268 IF( ( x( jlast ).NE.abs( x( isave( 2 ) ) ) ) .AND.
269 $ ( isave( 3 ).LT.itmax ) ) THEN
270 isave( 3 ) = isave( 3 ) + 1
271 GO TO 50
272 END IF
273*
274* ITERATION COMPLETE. FINAL STAGE.
275*
276 120 CONTINUE
277 altsgn = one
278 DO 130 i = 1, n
279 x( i ) = altsgn*( one+dble( i-1 ) / dble( n-1 ) )
280 altsgn = -altsgn
281 130 CONTINUE
282 kase = 1
283 isave( 1 ) = 5
284 RETURN
285*
286* ................ ENTRY (ISAVE( 1 ) = 5)
287* X HAS BEEN OVERWRITTEN BY A*X.
288*
289 140 CONTINUE
290 temp = two*( dasum( n, x, 1 ) / dble( 3*n ) )
291 IF( temp.GT.est ) THEN
292 CALL dcopy( n, x, 1, v, 1 )
293 est = temp
294 END IF
295*
296 150 CONTINUE
297 kase = 0
298 RETURN
299*
300* End of DLACN2
301*
dasum
double precision function dasum(n, dx, incx)
DASUM
Definition dasum.f:71
dcopy
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
Definition dcopy.f:82
idamax
integer function idamax(n, dx, incx)
IDAMAX
Definition idamax.f:71
Here is the call graph for this function:
Here is the caller graph for this function: