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