clacn2()

subroutine clacn2	(	integer	n,
		complex, dimension( * )	v,
		complex, dimension( * )	x,
		real	est,
		integer	kase,
		integer, dimension( 3 )	isave
	)

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

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

Purpose:

 CLACN2 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 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 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 CLACN2 must be re-called with all the other parameters unchanged.
[in,out]	EST	EST is REAL On entry with KASE = 1 or 2 and ISAVE(1) = 3, EST should be unchanged from the previous call to CLACN2. On exit, EST is an estimate (a lower bound) for norm(A).
[in,out]	KASE	KASE is INTEGER On the initial call to CLACN2, 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 CLACN2, KASE will again be 0.
[in,out]	ISAVE	ISAVE is INTEGER array, dimension (3) ISAVE is used to save variables between calls to SLACN2

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Further Details:

  Originally named CONEST, dated March 16, 1988.

  Last modified:  April, 1999

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

     CLACON     CLACN2
      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 132 of file clacn2.f.

*
*  -- LAPACK auxiliary routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      INTEGER            KASE, N
      REAL               EST
*     ..
*     .. Array Arguments ..
      INTEGER            ISAVE( 3 )
      COMPLEX            V( * ), X( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER              ITMAX
      parameter( itmax = 5 )
      REAL                 ONE,         TWO
      parameter( one = 1.0e0, two = 2.0e0 )
      COMPLEX              CZERO, CONE
      parameter( czero = ( 0.0e0, 0.0e0 ),
     $                            cone = ( 1.0e0, 0.0e0 ) )
*     ..
*     .. Local Scalars ..
      INTEGER            I, JLAST
      REAL               ABSXI, ALTSGN, ESTOLD, SAFMIN, TEMP
*     ..
*     .. External Functions ..
      INTEGER            ICMAX1
      REAL               SCSUM1, SLAMCH
      EXTERNAL           icmax1, scsum1, slamch
*     ..
*     .. External Subroutines ..
      EXTERNAL           ccopy
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, aimag, cmplx, real
*     ..
*     .. Executable Statements ..
*
      safmin = slamch( 'Safe minimum' )
      IF( kase.EQ.0 ) THEN
         DO 10 i = 1, n
            x( i ) = cmplx( one / real( 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 = scsum1( n, x, 1 )
*
      DO 30 i = 1, n
         absxi = abs( x( i ) )
         IF( absxi.GT.safmin ) THEN
            x( i ) = cmplx( real( x( i ) ) / absxi,
     $               aimag( 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 ) = icmax1( 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 ccopy( n, x, 1, v, 1 )
      estold = est
      est = scsum1( 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 ) = cmplx( real( x( i ) ) / absxi,
     $               aimag( 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 ) = icmax1( 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 ) = cmplx( altsgn*( one + real( i-1 ) / real( 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*( scsum1( n, x, 1 ) / real( 3*n ) )
      IF( temp.GT.est ) THEN
         CALL ccopy( n, x, 1, v, 1 )
         est = temp
      END IF
*
  130 CONTINUE
      kase = 0
      RETURN
*
*     End of CLACN2
*

Here is the call graph for this function:

Here is the caller graph for this function: