LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
clacon.f
Go to the documentation of this file.
00001 *> \brief \b CLACON
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CLACON + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clacon.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clacon.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clacon.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE CLACON( N, V, X, EST, KASE )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       INTEGER            KASE, N
00025 *       REAL               EST
00026 *       ..
00027 *       .. Array Arguments ..
00028 *       COMPLEX            V( N ), X( N )
00029 *       ..
00030 *  
00031 *
00032 *> \par Purpose:
00033 *  =============
00034 *>
00035 *> \verbatim
00036 *>
00037 *> CLACON estimates the 1-norm of a square, complex matrix A.
00038 *> Reverse communication is used for evaluating matrix-vector products.
00039 *> \endverbatim
00040 *
00041 *  Arguments:
00042 *  ==========
00043 *
00044 *> \param[in] N
00045 *> \verbatim
00046 *>          N is INTEGER
00047 *>         The order of the matrix.  N >= 1.
00048 *> \endverbatim
00049 *>
00050 *> \param[out] V
00051 *> \verbatim
00052 *>          V is COMPLEX array, dimension (N)
00053 *>         On the final return, V = A*W,  where  EST = norm(V)/norm(W)
00054 *>         (W is not returned).
00055 *> \endverbatim
00056 *>
00057 *> \param[in,out] X
00058 *> \verbatim
00059 *>          X is COMPLEX array, dimension (N)
00060 *>         On an intermediate return, X should be overwritten by
00061 *>               A * X,   if KASE=1,
00062 *>               A**H * X,  if KASE=2,
00063 *>         where A**H is the conjugate transpose of A, and CLACON must be
00064 *>         re-called with all the other parameters unchanged.
00065 *> \endverbatim
00066 *>
00067 *> \param[in,out] EST
00068 *> \verbatim
00069 *>          EST is REAL
00070 *>         On entry with KASE = 1 or 2 and JUMP = 3, EST should be
00071 *>         unchanged from the previous call to CLACON.
00072 *>         On exit, EST is an estimate (a lower bound) for norm(A). 
00073 *> \endverbatim
00074 *>
00075 *> \param[in,out] KASE
00076 *> \verbatim
00077 *>          KASE is INTEGER
00078 *>         On the initial call to CLACON, KASE should be 0.
00079 *>         On an intermediate return, KASE will be 1 or 2, indicating
00080 *>         whether X should be overwritten by A * X  or A**H * X.
00081 *>         On the final return from CLACON, KASE will again be 0.
00082 *> \endverbatim
00083 *
00084 *  Authors:
00085 *  ========
00086 *
00087 *> \author Univ. of Tennessee 
00088 *> \author Univ. of California Berkeley 
00089 *> \author Univ. of Colorado Denver 
00090 *> \author NAG Ltd. 
00091 *
00092 *> \date November 2011
00093 *
00094 *> \ingroup complexOTHERauxiliary
00095 *
00096 *> \par Further Details:
00097 *  =====================
00098 *>
00099 *>  Originally named CONEST, dated March 16, 1988. \n
00100 *>  Last modified:  April, 1999
00101 *
00102 *> \par Contributors:
00103 *  ==================
00104 *>
00105 *>     Nick Higham, University of Manchester
00106 *
00107 *> \par References:
00108 *  ================
00109 *>
00110 *>  N.J. Higham, "FORTRAN codes for estimating the one-norm of
00111 *>  a real or complex matrix, with applications to condition estimation",
00112 *>  ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988.
00113 *>
00114 *  =====================================================================
00115       SUBROUTINE CLACON( N, V, X, EST, KASE )
00116 *
00117 *  -- LAPACK auxiliary routine (version 3.4.0) --
00118 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00119 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00120 *     November 2011
00121 *
00122 *     .. Scalar Arguments ..
00123       INTEGER            KASE, N
00124       REAL               EST
00125 *     ..
00126 *     .. Array Arguments ..
00127       COMPLEX            V( N ), X( N )
00128 *     ..
00129 *
00130 *  =====================================================================
00131 *
00132 *     .. Parameters ..
00133       INTEGER            ITMAX
00134       PARAMETER          ( ITMAX = 5 )
00135       REAL               ONE, TWO
00136       PARAMETER          ( ONE = 1.0E0, TWO = 2.0E0 )
00137       COMPLEX            CZERO, CONE
00138       PARAMETER          ( CZERO = ( 0.0E0, 0.0E0 ),
00139      $                   CONE = ( 1.0E0, 0.0E0 ) )
00140 *     ..
00141 *     .. Local Scalars ..
00142       INTEGER            I, ITER, J, JLAST, JUMP
00143       REAL               ABSXI, ALTSGN, ESTOLD, SAFMIN, TEMP
00144 *     ..
00145 *     .. External Functions ..
00146       INTEGER            ICMAX1
00147       REAL               SCSUM1, SLAMCH
00148       EXTERNAL           ICMAX1, SCSUM1, SLAMCH
00149 *     ..
00150 *     .. External Subroutines ..
00151       EXTERNAL           CCOPY
00152 *     ..
00153 *     .. Intrinsic Functions ..
00154       INTRINSIC          ABS, AIMAG, CMPLX, REAL
00155 *     ..
00156 *     .. Save statement ..
00157       SAVE
00158 *     ..
00159 *     .. Executable Statements ..
00160 *
00161       SAFMIN = SLAMCH( 'Safe minimum' )
00162       IF( KASE.EQ.0 ) THEN
00163          DO 10 I = 1, N
00164             X( I ) = CMPLX( ONE / REAL( N ) )
00165    10    CONTINUE
00166          KASE = 1
00167          JUMP = 1
00168          RETURN
00169       END IF
00170 *
00171       GO TO ( 20, 40, 70, 90, 120 )JUMP
00172 *
00173 *     ................ ENTRY   (JUMP = 1)
00174 *     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X.
00175 *
00176    20 CONTINUE
00177       IF( N.EQ.1 ) THEN
00178          V( 1 ) = X( 1 )
00179          EST = ABS( V( 1 ) )
00180 *        ... QUIT
00181          GO TO 130
00182       END IF
00183       EST = SCSUM1( N, X, 1 )
00184 *
00185       DO 30 I = 1, N
00186          ABSXI = ABS( X( I ) )
00187          IF( ABSXI.GT.SAFMIN ) THEN
00188             X( I ) = CMPLX( REAL( X( I ) ) / ABSXI,
00189      $               AIMAG( X( I ) ) / ABSXI )
00190          ELSE
00191             X( I ) = CONE
00192          END IF
00193    30 CONTINUE
00194       KASE = 2
00195       JUMP = 2
00196       RETURN
00197 *
00198 *     ................ ENTRY   (JUMP = 2)
00199 *     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
00200 *
00201    40 CONTINUE
00202       J = ICMAX1( N, X, 1 )
00203       ITER = 2
00204 *
00205 *     MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
00206 *
00207    50 CONTINUE
00208       DO 60 I = 1, N
00209          X( I ) = CZERO
00210    60 CONTINUE
00211       X( J ) = CONE
00212       KASE = 1
00213       JUMP = 3
00214       RETURN
00215 *
00216 *     ................ ENTRY   (JUMP = 3)
00217 *     X HAS BEEN OVERWRITTEN BY A*X.
00218 *
00219    70 CONTINUE
00220       CALL CCOPY( N, X, 1, V, 1 )
00221       ESTOLD = EST
00222       EST = SCSUM1( N, V, 1 )
00223 *
00224 *     TEST FOR CYCLING.
00225       IF( EST.LE.ESTOLD )
00226      $   GO TO 100
00227 *
00228       DO 80 I = 1, N
00229          ABSXI = ABS( X( I ) )
00230          IF( ABSXI.GT.SAFMIN ) THEN
00231             X( I ) = CMPLX( REAL( X( I ) ) / ABSXI,
00232      $               AIMAG( X( I ) ) / ABSXI )
00233          ELSE
00234             X( I ) = CONE
00235          END IF
00236    80 CONTINUE
00237       KASE = 2
00238       JUMP = 4
00239       RETURN
00240 *
00241 *     ................ ENTRY   (JUMP = 4)
00242 *     X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
00243 *
00244    90 CONTINUE
00245       JLAST = J
00246       J = ICMAX1( N, X, 1 )
00247       IF( ( ABS( X( JLAST ) ).NE.ABS( X( J ) ) ) .AND.
00248      $    ( ITER.LT.ITMAX ) ) THEN
00249          ITER = ITER + 1
00250          GO TO 50
00251       END IF
00252 *
00253 *     ITERATION COMPLETE.  FINAL STAGE.
00254 *
00255   100 CONTINUE
00256       ALTSGN = ONE
00257       DO 110 I = 1, N
00258          X( I ) = CMPLX( ALTSGN*( ONE+REAL( I-1 ) / REAL( N-1 ) ) )
00259          ALTSGN = -ALTSGN
00260   110 CONTINUE
00261       KASE = 1
00262       JUMP = 5
00263       RETURN
00264 *
00265 *     ................ ENTRY   (JUMP = 5)
00266 *     X HAS BEEN OVERWRITTEN BY A*X.
00267 *
00268   120 CONTINUE
00269       TEMP = TWO*( SCSUM1( N, X, 1 ) / REAL( 3*N ) )
00270       IF( TEMP.GT.EST ) THEN
00271          CALL CCOPY( N, X, 1, V, 1 )
00272          EST = TEMP
00273       END IF
00274 *
00275   130 CONTINUE
00276       KASE = 0
00277       RETURN
00278 *
00279 *     End of CLACON
00280 *
00281       END
 All Files Functions