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