![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
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