LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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 135 of file dlacn2.f.

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 *
integer function idamax(N, DX, INCX)
IDAMAX
Definition: idamax.f:71
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
Definition: dcopy.f:82
double precision function dasum(N, DX, INCX)
DASUM
Definition: dasum.f:71
Here is the call graph for this function:
Here is the caller graph for this function: