![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLACON 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SLACON + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slacon.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slacon.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slacon.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SLACON( N, V, X, ISGN, EST, KASE ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER KASE, N 00025 * REAL EST 00026 * .. 00027 * .. Array Arguments .. 00028 * INTEGER ISGN( * ) 00029 * REAL V( * ), X( * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> SLACON 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 SLACON 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 JUMP = 3, EST should be 00077 *> unchanged from the previous call to SLACON. 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 SLACON, 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 SLACON, 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 realOTHERauxiliary 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 SLACON( 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 REAL EST 00126 * .. 00127 * .. Array Arguments .. 00128 INTEGER ISGN( * ) 00129 REAL V( * ), X( * ) 00130 * .. 00131 * 00132 * ===================================================================== 00133 * 00134 * .. Parameters .. 00135 INTEGER ITMAX 00136 PARAMETER ( ITMAX = 5 ) 00137 REAL ZERO, ONE, TWO 00138 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 ) 00139 * .. 00140 * .. Local Scalars .. 00141 INTEGER I, ITER, J, JLAST, JUMP 00142 REAL ALTSGN, ESTOLD, TEMP 00143 * .. 00144 * .. External Functions .. 00145 INTEGER ISAMAX 00146 REAL SASUM 00147 EXTERNAL ISAMAX, SASUM 00148 * .. 00149 * .. External Subroutines .. 00150 EXTERNAL SCOPY 00151 * .. 00152 * .. Intrinsic Functions .. 00153 INTRINSIC ABS, NINT, REAL, 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 / REAL( 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 = SASUM( 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 = ISAMAX( 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 SCOPY( N, X, 1, V, 1 ) 00214 ESTOLD = EST 00215 EST = SASUM( 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 = ISAMAX( 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+REAL( I-1 ) / REAL( 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*( SASUM( N, X, 1 ) / REAL( 3*N ) ) 00264 IF( TEMP.GT.EST ) THEN 00265 CALL SCOPY( N, X, 1, V, 1 ) 00266 EST = TEMP 00267 END IF 00268 * 00269 150 CONTINUE 00270 KASE = 0 00271 RETURN 00272 * 00273 * End of SLACON 00274 * 00275 END