zlacn2()

subroutine zlacn2	(	integer	N,
		complex*16, dimension( * )	V,
		complex*16, dimension( * )	X,
		double precision	EST,
		integer	KASE,
		integer, dimension( 3 )	ISAVE
	)

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

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

Purpose:

 ZLACN2 estimates the 1-norm of a square, complex 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 COMPLEX*16 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 COMPLEX*16 array, dimension (N) On an intermediate return, X should be overwritten by A * X, if KASE=1, A**H * X, if KASE=2, where A**H is the conjugate transpose of A, and ZLACN2 must be re-called with all the other parameters unchanged.
[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 ZLACN2. On exit, EST is an estimate (a lower bound) for norm(A).
[in,out]	KASE	KASE is INTEGER On the initial call to ZLACN2, 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**H * X. On the final return from ZLACN2, KASE will again be 0.
[in,out]	ISAVE	ISAVE is INTEGER array, dimension (3) ISAVE is used to save variables between calls to ZLACN2

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Date

December 2016

Further Details:

  Originally named CONEST, dated March 16, 1988.

  Last modified:  April, 1999

  This is a thread safe version of ZLACON, which uses the array ISAVE
  in place of a SAVE statement, as follows:

     ZLACON     ZLACN2
      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 zlacn2.f.

*
*  -- LAPACK auxiliary routine (version 3.7.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     December 2016
*
*     .. Scalar Arguments ..
      INTEGER            KASE, N
      DOUBLE PRECISION   EST
*     ..
*     .. Array Arguments ..
      INTEGER            ISAVE( 3 )
      COMPLEX*16         V( * ), X( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER              ITMAX
      parameter( itmax = 5 )
      DOUBLE PRECISION     ONE,         TWO
      parameter( one = 1.0d0, two = 2.0d0 )
      COMPLEX*16           CZERO, CONE
      parameter( czero = ( 0.0d0, 0.0d0 ),
     $                            cone = ( 1.0d0, 0.0d0 ) )
*     ..
*     .. Local Scalars ..
      INTEGER            I, JLAST
      DOUBLE PRECISION   ABSXI, ALTSGN, ESTOLD, SAFMIN, TEMP
*     ..
*     .. External Functions ..
      INTEGER            IZMAX1
      DOUBLE PRECISION   DLAMCH, DZSUM1
      EXTERNAL           izmax1, dlamch, dzsum1
*     ..
*     .. External Subroutines ..
      EXTERNAL           zcopy
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, dble, dcmplx, dimag
*     ..
*     .. Executable Statements ..
*
      safmin = dlamch( 'Safe minimum' )
      IF( kase.EQ.0 ) THEN
         DO 10 i = 1, n
            x( i ) = dcmplx( one / dble( n ) )
   10    CONTINUE
         kase = 1
         isave( 1 ) = 1
         RETURN
      END IF
*
      GO TO ( 20, 40, 70, 90, 120 )isave( 1 )
*
*     ................ ENTRY   (ISAVE( 1 ) = 1)
*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X.
*
   20 CONTINUE
      IF( n.EQ.1 ) THEN
         v( 1 ) = x( 1 )
         est = abs( v( 1 ) )
*        ... QUIT
         GO TO 130
      END IF
      est = dzsum1( n, x, 1 )
*
      DO 30 i = 1, n
         absxi = abs( x( i ) )
         IF( absxi.GT.safmin ) THEN
            x( i ) = dcmplx( dble( x( i ) ) / absxi,
     $               dimag( x( i ) ) / absxi )
         ELSE
            x( i ) = cone
         END IF
   30 CONTINUE
      kase = 2
      isave( 1 ) = 2
      RETURN
*
*     ................ ENTRY   (ISAVE( 1 ) = 2)
*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
*
   40 CONTINUE
      isave( 2 ) = izmax1( n, x, 1 )
      isave( 3 ) = 2
*
*     MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
*
   50 CONTINUE
      DO 60 i = 1, n
         x( i ) = czero
   60 CONTINUE
      x( isave( 2 ) ) = cone
      kase = 1
      isave( 1 ) = 3
      RETURN
*
*     ................ ENTRY   (ISAVE( 1 ) = 3)
*     X HAS BEEN OVERWRITTEN BY A*X.
*
   70 CONTINUE
      CALL zcopy( n, x, 1, v, 1 )
      estold = est
      est = dzsum1( n, v, 1 )
*
*     TEST FOR CYCLING.
      IF( est.LE.estold )
     $   GO TO 100
*
      DO 80 i = 1, n
         absxi = abs( x( i ) )
         IF( absxi.GT.safmin ) THEN
            x( i ) = dcmplx( dble( x( i ) ) / absxi,
     $               dimag( x( i ) ) / absxi )
         ELSE
            x( i ) = cone
         END IF
   80 CONTINUE
      kase = 2
      isave( 1 ) = 4
      RETURN
*
*     ................ ENTRY   (ISAVE( 1 ) = 4)
*     X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
*
   90 CONTINUE
      jlast = isave( 2 )
      isave( 2 ) = izmax1( n, x, 1 )
      IF( ( abs( x( jlast ) ).NE.abs( x( isave( 2 ) ) ) ) .AND.
     $    ( isave( 3 ).LT.itmax ) ) THEN
         isave( 3 ) = isave( 3 ) + 1
         GO TO 50
      END IF
*
*     ITERATION COMPLETE.  FINAL STAGE.
*
  100 CONTINUE
      altsgn = one
      DO 110 i = 1, n
         x( i ) = dcmplx( altsgn*( one+dble( i-1 ) / dble( n-1 ) ) )
         altsgn = -altsgn
  110 CONTINUE
      kase = 1
      isave( 1 ) = 5
      RETURN
*
*     ................ ENTRY   (ISAVE( 1 ) = 5)
*     X HAS BEEN OVERWRITTEN BY A*X.
*
  120 CONTINUE
      temp = two*( dzsum1( n, x, 1 ) / dble( 3*n ) )
      IF( temp.GT.est ) THEN
         CALL zcopy( n, x, 1, v, 1 )
         est = temp
      END IF
*
  130 CONTINUE
      kase = 0
      RETURN
*
*     End of ZLACN2
*

Here is the call graph for this function:

Here is the caller graph for this function: