|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, 00002 $ LDV, INFO ) 00003 * 00004 * -- LAPACK routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER JOB, SIDE 00011 INTEGER IHI, ILO, INFO, LDV, M, N 00012 * .. 00013 * .. Array Arguments .. 00014 REAL LSCALE( * ), RSCALE( * ) 00015 COMPLEX V( LDV, * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * CGGBAK forms the right or left eigenvectors of a complex generalized 00022 * eigenvalue problem A*x = lambda*B*x, by backward transformation on 00023 * the computed eigenvectors of the balanced pair of matrices output by 00024 * CGGBAL. 00025 * 00026 * Arguments 00027 * ========= 00028 * 00029 * JOB (input) CHARACTER*1 00030 * Specifies the type of backward transformation required: 00031 * = 'N': do nothing, return immediately; 00032 * = 'P': do backward transformation for permutation only; 00033 * = 'S': do backward transformation for scaling only; 00034 * = 'B': do backward transformations for both permutation and 00035 * scaling. 00036 * JOB must be the same as the argument JOB supplied to CGGBAL. 00037 * 00038 * SIDE (input) CHARACTER*1 00039 * = 'R': V contains right eigenvectors; 00040 * = 'L': V contains left eigenvectors. 00041 * 00042 * N (input) INTEGER 00043 * The number of rows of the matrix V. N >= 0. 00044 * 00045 * ILO (input) INTEGER 00046 * IHI (input) INTEGER 00047 * The integers ILO and IHI determined by CGGBAL. 00048 * 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. 00049 * 00050 * LSCALE (input) REAL array, dimension (N) 00051 * Details of the permutations and/or scaling factors applied 00052 * to the left side of A and B, as returned by CGGBAL. 00053 * 00054 * RSCALE (input) REAL array, dimension (N) 00055 * Details of the permutations and/or scaling factors applied 00056 * to the right side of A and B, as returned by CGGBAL. 00057 * 00058 * M (input) INTEGER 00059 * The number of columns of the matrix V. M >= 0. 00060 * 00061 * V (input/output) COMPLEX array, dimension (LDV,M) 00062 * On entry, the matrix of right or left eigenvectors to be 00063 * transformed, as returned by CTGEVC. 00064 * On exit, V is overwritten by the transformed eigenvectors. 00065 * 00066 * LDV (input) INTEGER 00067 * The leading dimension of the matrix V. LDV >= max(1,N). 00068 * 00069 * INFO (output) INTEGER 00070 * = 0: successful exit. 00071 * < 0: if INFO = -i, the i-th argument had an illegal value. 00072 * 00073 * Further Details 00074 * =============== 00075 * 00076 * See R.C. Ward, Balancing the generalized eigenvalue problem, 00077 * SIAM J. Sci. Stat. Comp. 2 (1981), 141-152. 00078 * 00079 * ===================================================================== 00080 * 00081 * .. Local Scalars .. 00082 LOGICAL LEFTV, RIGHTV 00083 INTEGER I, K 00084 * .. 00085 * .. External Functions .. 00086 LOGICAL LSAME 00087 EXTERNAL LSAME 00088 * .. 00089 * .. External Subroutines .. 00090 EXTERNAL CSSCAL, CSWAP, XERBLA 00091 * .. 00092 * .. Intrinsic Functions .. 00093 INTRINSIC MAX 00094 * .. 00095 * .. Executable Statements .. 00096 * 00097 * Test the input parameters 00098 * 00099 RIGHTV = LSAME( SIDE, 'R' ) 00100 LEFTV = LSAME( SIDE, 'L' ) 00101 * 00102 INFO = 0 00103 IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. 00104 $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN 00105 INFO = -1 00106 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN 00107 INFO = -2 00108 ELSE IF( N.LT.0 ) THEN 00109 INFO = -3 00110 ELSE IF( ILO.LT.1 ) THEN 00111 INFO = -4 00112 ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN 00113 INFO = -4 00114 ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) ) 00115 $ THEN 00116 INFO = -5 00117 ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN 00118 INFO = -5 00119 ELSE IF( M.LT.0 ) THEN 00120 INFO = -8 00121 ELSE IF( LDV.LT.MAX( 1, N ) ) THEN 00122 INFO = -10 00123 END IF 00124 IF( INFO.NE.0 ) THEN 00125 CALL XERBLA( 'CGGBAK', -INFO ) 00126 RETURN 00127 END IF 00128 * 00129 * Quick return if possible 00130 * 00131 IF( N.EQ.0 ) 00132 $ RETURN 00133 IF( M.EQ.0 ) 00134 $ RETURN 00135 IF( LSAME( JOB, 'N' ) ) 00136 $ RETURN 00137 * 00138 IF( ILO.EQ.IHI ) 00139 $ GO TO 30 00140 * 00141 * Backward balance 00142 * 00143 IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN 00144 * 00145 * Backward transformation on right eigenvectors 00146 * 00147 IF( RIGHTV ) THEN 00148 DO 10 I = ILO, IHI 00149 CALL CSSCAL( M, RSCALE( I ), V( I, 1 ), LDV ) 00150 10 CONTINUE 00151 END IF 00152 * 00153 * Backward transformation on left eigenvectors 00154 * 00155 IF( LEFTV ) THEN 00156 DO 20 I = ILO, IHI 00157 CALL CSSCAL( M, LSCALE( I ), V( I, 1 ), LDV ) 00158 20 CONTINUE 00159 END IF 00160 END IF 00161 * 00162 * Backward permutation 00163 * 00164 30 CONTINUE 00165 IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN 00166 * 00167 * Backward permutation on right eigenvectors 00168 * 00169 IF( RIGHTV ) THEN 00170 IF( ILO.EQ.1 ) 00171 $ GO TO 50 00172 DO 40 I = ILO - 1, 1, -1 00173 K = RSCALE( I ) 00174 IF( K.EQ.I ) 00175 $ GO TO 40 00176 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 00177 40 CONTINUE 00178 * 00179 50 CONTINUE 00180 IF( IHI.EQ.N ) 00181 $ GO TO 70 00182 DO 60 I = IHI + 1, N 00183 K = RSCALE( I ) 00184 IF( K.EQ.I ) 00185 $ GO TO 60 00186 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 00187 60 CONTINUE 00188 END IF 00189 * 00190 * Backward permutation on left eigenvectors 00191 * 00192 70 CONTINUE 00193 IF( LEFTV ) THEN 00194 IF( ILO.EQ.1 ) 00195 $ GO TO 90 00196 DO 80 I = ILO - 1, 1, -1 00197 K = LSCALE( I ) 00198 IF( K.EQ.I ) 00199 $ GO TO 80 00200 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 00201 80 CONTINUE 00202 * 00203 90 CONTINUE 00204 IF( IHI.EQ.N ) 00205 $ GO TO 110 00206 DO 100 I = IHI + 1, N 00207 K = LSCALE( I ) 00208 IF( K.EQ.I ) 00209 $ GO TO 100 00210 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 00211 100 CONTINUE 00212 END IF 00213 END IF 00214 * 00215 110 CONTINUE 00216 * 00217 RETURN 00218 * 00219 * End of CGGBAK 00220 * 00221 END
1.7.3 
