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