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