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