 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE SGGBAK( 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( * ), V( LDV, * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * SGGBAK forms the right or left eigenvectors of a real generalized 00021 * eigenvalue problem A*x = lambda*B*x, by backward transformation on 00022 * the computed eigenvectors of the balanced pair of matrices output by 00023 * SGGBAL. 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * JOB (input) CHARACTER*1 00029 * Specifies the type of backward transformation required: 00030 * = 'N': do nothing, return immediately; 00031 * = 'P': do backward transformation for permutation only; 00032 * = 'S': do backward transformation for scaling only; 00033 * = 'B': do backward transformations for both permutation and 00034 * scaling. 00035 * JOB must be the same as the argument JOB supplied to SGGBAL. 00036 * 00037 * SIDE (input) CHARACTER*1 00038 * = 'R': V contains right eigenvectors; 00039 * = 'L': V contains left eigenvectors. 00040 * 00041 * N (input) INTEGER 00042 * The number of rows of the matrix V. N >= 0. 00043 * 00044 * ILO (input) INTEGER 00045 * IHI (input) INTEGER 00046 * The integers ILO and IHI determined by SGGBAL. 00047 * 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. 00048 * 00049 * LSCALE (input) REAL array, dimension (N) 00050 * Details of the permutations and/or scaling factors applied 00051 * to the left side of A and B, as returned by SGGBAL. 00052 * 00053 * RSCALE (input) REAL array, dimension (N) 00054 * Details of the permutations and/or scaling factors applied 00055 * to the right side of A and B, as returned by SGGBAL. 00056 * 00057 * M (input) INTEGER 00058 * The number of columns of the matrix V. M >= 0. 00059 * 00060 * V (input/output) REAL array, dimension (LDV,M) 00061 * On entry, the matrix of right or left eigenvectors to be 00062 * transformed, as returned by STGEVC. 00063 * On exit, V is overwritten by the transformed eigenvectors. 00064 * 00065 * LDV (input) INTEGER 00066 * The leading dimension of the matrix V. LDV >= max(1,N). 00067 * 00068 * INFO (output) INTEGER 00069 * = 0: successful exit. 00070 * < 0: if INFO = -i, the i-th argument had an illegal value. 00071 * 00072 * Further Details 00073 * =============== 00074 * 00075 * See R.C. Ward, Balancing the generalized eigenvalue problem, 00076 * SIAM J. Sci. Stat. Comp. 2 (1981), 141-152. 00077 * 00078 * ===================================================================== 00079 * 00080 * .. Local Scalars .. 00081 LOGICAL LEFTV, RIGHTV 00082 INTEGER I, K 00083 * .. 00084 * .. External Functions .. 00085 LOGICAL LSAME 00086 EXTERNAL LSAME 00087 * .. 00088 * .. External Subroutines .. 00089 EXTERNAL SSCAL, SSWAP, XERBLA 00090 * .. 00091 * .. Intrinsic Functions .. 00092 INTRINSIC MAX 00093 * .. 00094 * .. Executable Statements .. 00095 * 00096 * Test the input parameters 00097 * 00098 RIGHTV = LSAME( SIDE, 'R' ) 00099 LEFTV = LSAME( SIDE, 'L' ) 00100 * 00101 INFO = 0 00102 IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. 00103 $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN 00104 INFO = -1 00105 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN 00106 INFO = -2 00107 ELSE IF( N.LT.0 ) THEN 00108 INFO = -3 00109 ELSE IF( ILO.LT.1 ) THEN 00110 INFO = -4 00111 ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN 00112 INFO = -4 00113 ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) ) 00114 $ THEN 00115 INFO = -5 00116 ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN 00117 INFO = -5 00118 ELSE IF( M.LT.0 ) THEN 00119 INFO = -8 00120 ELSE IF( LDV.LT.MAX( 1, N ) ) THEN 00121 INFO = -10 00122 END IF 00123 IF( INFO.NE.0 ) THEN 00124 CALL XERBLA( 'SGGBAK', -INFO ) 00125 RETURN 00126 END IF 00127 * 00128 * Quick return if possible 00129 * 00130 IF( N.EQ.0 ) 00131 $ RETURN 00132 IF( M.EQ.0 ) 00133 $ RETURN 00134 IF( LSAME( JOB, 'N' ) ) 00135 $ RETURN 00136 * 00137 IF( ILO.EQ.IHI ) 00138 $ GO TO 30 00139 * 00140 * Backward balance 00141 * 00142 IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN 00143 * 00144 * Backward transformation on right eigenvectors 00145 * 00146 IF( RIGHTV ) THEN 00147 DO 10 I = ILO, IHI 00148 CALL SSCAL( M, RSCALE( I ), V( I, 1 ), LDV ) 00149 10 CONTINUE 00150 END IF 00151 * 00152 * Backward transformation on left eigenvectors 00153 * 00154 IF( LEFTV ) THEN 00155 DO 20 I = ILO, IHI 00156 CALL SSCAL( M, LSCALE( I ), V( I, 1 ), LDV ) 00157 20 CONTINUE 00158 END IF 00159 END IF 00160 * 00161 * Backward permutation 00162 * 00163 30 CONTINUE 00164 IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN 00165 * 00166 * Backward permutation on right eigenvectors 00167 * 00168 IF( RIGHTV ) THEN 00169 IF( ILO.EQ.1 ) 00170 $ GO TO 50 00171 * 00172 DO 40 I = ILO - 1, 1, -1 00173 K = RSCALE( I ) 00174 IF( K.EQ.I ) 00175 $ GO TO 40 00176 CALL SSWAP( 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 SSWAP( 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 SSWAP( 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 SSWAP( 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 SGGBAK 00220 * 00221 END
1.7.3 
