![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CGEBAK 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CGEBAK + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgebak.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgebak.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgebak.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE CGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, 00022 * INFO ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER JOB, SIDE 00026 * INTEGER IHI, ILO, INFO, LDV, M, N 00027 * .. 00028 * .. Array Arguments .. 00029 * REAL SCALE( * ) 00030 * COMPLEX V( LDV, * ) 00031 * .. 00032 * 00033 * 00034 *> \par Purpose: 00035 * ============= 00036 *> 00037 *> \verbatim 00038 *> 00039 *> CGEBAK forms the right or left eigenvectors of a complex general 00040 *> matrix by backward transformation on the computed eigenvectors of the 00041 *> balanced matrix output by CGEBAL. 00042 *> \endverbatim 00043 * 00044 * Arguments: 00045 * ========== 00046 * 00047 *> \param[in] JOB 00048 *> \verbatim 00049 *> JOB is CHARACTER*1 00050 *> Specifies the type of backward transformation required: 00051 *> = 'N', do nothing, return immediately; 00052 *> = 'P', do backward transformation for permutation only; 00053 *> = 'S', do backward transformation for scaling only; 00054 *> = 'B', do backward transformations for both permutation and 00055 *> scaling. 00056 *> JOB must be the same as the argument JOB supplied to CGEBAL. 00057 *> \endverbatim 00058 *> 00059 *> \param[in] SIDE 00060 *> \verbatim 00061 *> SIDE is CHARACTER*1 00062 *> = 'R': V contains right eigenvectors; 00063 *> = 'L': V contains left eigenvectors. 00064 *> \endverbatim 00065 *> 00066 *> \param[in] N 00067 *> \verbatim 00068 *> N is INTEGER 00069 *> The number of rows of the matrix V. N >= 0. 00070 *> \endverbatim 00071 *> 00072 *> \param[in] ILO 00073 *> \verbatim 00074 *> ILO is INTEGER 00075 *> \endverbatim 00076 *> 00077 *> \param[in] IHI 00078 *> \verbatim 00079 *> IHI is INTEGER 00080 *> The integers ILO and IHI determined by CGEBAL. 00081 *> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. 00082 *> \endverbatim 00083 *> 00084 *> \param[in] SCALE 00085 *> \verbatim 00086 *> SCALE is REAL array, dimension (N) 00087 *> Details of the permutation and scaling factors, as returned 00088 *> by CGEBAL. 00089 *> \endverbatim 00090 *> 00091 *> \param[in] M 00092 *> \verbatim 00093 *> M is INTEGER 00094 *> The number of columns of the matrix V. M >= 0. 00095 *> \endverbatim 00096 *> 00097 *> \param[in,out] V 00098 *> \verbatim 00099 *> V is COMPLEX array, dimension (LDV,M) 00100 *> On entry, the matrix of right or left eigenvectors to be 00101 *> transformed, as returned by CHSEIN or CTREVC. 00102 *> On exit, V is overwritten by the transformed eigenvectors. 00103 *> \endverbatim 00104 *> 00105 *> \param[in] LDV 00106 *> \verbatim 00107 *> LDV is INTEGER 00108 *> The leading dimension of the array V. LDV >= max(1,N). 00109 *> \endverbatim 00110 *> 00111 *> \param[out] INFO 00112 *> \verbatim 00113 *> INFO is INTEGER 00114 *> = 0: successful exit 00115 *> < 0: if INFO = -i, the i-th argument had an illegal value. 00116 *> \endverbatim 00117 * 00118 * Authors: 00119 * ======== 00120 * 00121 *> \author Univ. of Tennessee 00122 *> \author Univ. of California Berkeley 00123 *> \author Univ. of Colorado Denver 00124 *> \author NAG Ltd. 00125 * 00126 *> \date November 2011 00127 * 00128 *> \ingroup complexGEcomputational 00129 * 00130 * ===================================================================== 00131 SUBROUTINE CGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, 00132 $ INFO ) 00133 * 00134 * -- LAPACK computational routine (version 3.4.0) -- 00135 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00136 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00137 * November 2011 00138 * 00139 * .. Scalar Arguments .. 00140 CHARACTER JOB, SIDE 00141 INTEGER IHI, ILO, INFO, LDV, M, N 00142 * .. 00143 * .. Array Arguments .. 00144 REAL SCALE( * ) 00145 COMPLEX V( LDV, * ) 00146 * .. 00147 * 00148 * ===================================================================== 00149 * 00150 * .. Parameters .. 00151 REAL ONE 00152 PARAMETER ( ONE = 1.0E+0 ) 00153 * .. 00154 * .. Local Scalars .. 00155 LOGICAL LEFTV, RIGHTV 00156 INTEGER I, II, K 00157 REAL S 00158 * .. 00159 * .. External Functions .. 00160 LOGICAL LSAME 00161 EXTERNAL LSAME 00162 * .. 00163 * .. External Subroutines .. 00164 EXTERNAL CSSCAL, CSWAP, XERBLA 00165 * .. 00166 * .. Intrinsic Functions .. 00167 INTRINSIC MAX, MIN 00168 * .. 00169 * .. Executable Statements .. 00170 * 00171 * Decode and Test the input parameters 00172 * 00173 RIGHTV = LSAME( SIDE, 'R' ) 00174 LEFTV = LSAME( SIDE, 'L' ) 00175 * 00176 INFO = 0 00177 IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. 00178 $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN 00179 INFO = -1 00180 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN 00181 INFO = -2 00182 ELSE IF( N.LT.0 ) THEN 00183 INFO = -3 00184 ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN 00185 INFO = -4 00186 ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN 00187 INFO = -5 00188 ELSE IF( M.LT.0 ) THEN 00189 INFO = -7 00190 ELSE IF( LDV.LT.MAX( 1, N ) ) THEN 00191 INFO = -9 00192 END IF 00193 IF( INFO.NE.0 ) THEN 00194 CALL XERBLA( 'CGEBAK', -INFO ) 00195 RETURN 00196 END IF 00197 * 00198 * Quick return if possible 00199 * 00200 IF( N.EQ.0 ) 00201 $ RETURN 00202 IF( M.EQ.0 ) 00203 $ RETURN 00204 IF( LSAME( JOB, 'N' ) ) 00205 $ RETURN 00206 * 00207 IF( ILO.EQ.IHI ) 00208 $ GO TO 30 00209 * 00210 * Backward balance 00211 * 00212 IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN 00213 * 00214 IF( RIGHTV ) THEN 00215 DO 10 I = ILO, IHI 00216 S = SCALE( I ) 00217 CALL CSSCAL( M, S, V( I, 1 ), LDV ) 00218 10 CONTINUE 00219 END IF 00220 * 00221 IF( LEFTV ) THEN 00222 DO 20 I = ILO, IHI 00223 S = ONE / SCALE( I ) 00224 CALL CSSCAL( M, S, V( I, 1 ), LDV ) 00225 20 CONTINUE 00226 END IF 00227 * 00228 END IF 00229 * 00230 * Backward permutation 00231 * 00232 * For I = ILO-1 step -1 until 1, 00233 * IHI+1 step 1 until N do -- 00234 * 00235 30 CONTINUE 00236 IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN 00237 IF( RIGHTV ) THEN 00238 DO 40 II = 1, N 00239 I = II 00240 IF( I.GE.ILO .AND. I.LE.IHI ) 00241 $ GO TO 40 00242 IF( I.LT.ILO ) 00243 $ I = ILO - II 00244 K = SCALE( I ) 00245 IF( K.EQ.I ) 00246 $ GO TO 40 00247 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 00248 40 CONTINUE 00249 END IF 00250 * 00251 IF( LEFTV ) THEN 00252 DO 50 II = 1, N 00253 I = II 00254 IF( I.GE.ILO .AND. I.LE.IHI ) 00255 $ GO TO 50 00256 IF( I.LT.ILO ) 00257 $ I = ILO - II 00258 K = SCALE( I ) 00259 IF( K.EQ.I ) 00260 $ GO TO 50 00261 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 00262 50 CONTINUE 00263 END IF 00264 END IF 00265 * 00266 RETURN 00267 * 00268 * End of CGEBAK 00269 * 00270 END