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