1*> \brief \b SGEBAK 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download SGEBAK + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgebak.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgebak.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgebak.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE SGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, 22* INFO ) 23* 24* .. Scalar Arguments .. 25* CHARACTER JOB, SIDE 26* INTEGER IHI, ILO, INFO, LDV, M, N 27* .. 28* .. Array Arguments .. 29* REAL V( LDV, * ), SCALE( * ) 30* .. 31* 32* 33*> \par Purpose: 34* ============= 35*> 36*> \verbatim 37*> 38*> SGEBAK forms the right or left eigenvectors of a real general matrix 39*> by backward transformation on the computed eigenvectors of the 40*> balanced matrix output by SGEBAL. 41*> \endverbatim 42* 43* Arguments: 44* ========== 45* 46*> \param[in] JOB 47*> \verbatim 48*> JOB is CHARACTER*1 49*> Specifies the type of backward transformation required: 50*> = 'N', do nothing, return immediately; 51*> = 'P', do backward transformation for permutation only; 52*> = 'S', do backward transformation for scaling only; 53*> = 'B', do backward transformations for both permutation and 54*> scaling. 55*> JOB must be the same as the argument JOB supplied to SGEBAL. 56*> \endverbatim 57*> 58*> \param[in] SIDE 59*> \verbatim 60*> SIDE is CHARACTER*1 61*> = 'R': V contains right eigenvectors; 62*> = 'L': V contains left eigenvectors. 63*> \endverbatim 64*> 65*> \param[in] N 66*> \verbatim 67*> N is INTEGER 68*> The number of rows of the matrix V. N >= 0. 69*> \endverbatim 70*> 71*> \param[in] ILO 72*> \verbatim 73*> ILO is INTEGER 74*> \endverbatim 75*> 76*> \param[in] IHI 77*> \verbatim 78*> IHI is INTEGER 79*> The integers ILO and IHI determined by SGEBAL. 80*> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. 81*> \endverbatim 82*> 83*> \param[in] SCALE 84*> \verbatim 85*> SCALE is REAL array, dimension (N) 86*> Details of the permutation and scaling factors, as returned 87*> by SGEBAL. 88*> \endverbatim 89*> 90*> \param[in] M 91*> \verbatim 92*> M is INTEGER 93*> The number of columns of the matrix V. M >= 0. 94*> \endverbatim 95*> 96*> \param[in,out] V 97*> \verbatim 98*> V is REAL array, dimension (LDV,M) 99*> On entry, the matrix of right or left eigenvectors to be 100*> transformed, as returned by SHSEIN or STREVC. 101*> On exit, V is overwritten by the transformed eigenvectors. 102*> \endverbatim 103*> 104*> \param[in] LDV 105*> \verbatim 106*> LDV is INTEGER 107*> The leading dimension of the array V. LDV >= max(1,N). 108*> \endverbatim 109*> 110*> \param[out] INFO 111*> \verbatim 112*> INFO is INTEGER 113*> = 0: successful exit 114*> < 0: if INFO = -i, the i-th argument had an illegal value. 115*> \endverbatim 116* 117* Authors: 118* ======== 119* 120*> \author Univ. of Tennessee 121*> \author Univ. of California Berkeley 122*> \author Univ. of Colorado Denver 123*> \author NAG Ltd. 124* 125*> \date November 2011 126* 127*> \ingroup realGEcomputational 128* 129* ===================================================================== 130 SUBROUTINE SGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, 131 $ INFO ) 132* 133* -- LAPACK computational routine (version 3.4.0) -- 134* -- LAPACK is a software package provided by Univ. of Tennessee, -- 135* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 136* November 2011 137* 138* .. Scalar Arguments .. 139 CHARACTER JOB, SIDE 140 INTEGER IHI, ILO, INFO, LDV, M, N 141* .. 142* .. Array Arguments .. 143 REAL V( LDV, * ), SCALE( * ) 144* .. 145* 146* ===================================================================== 147* 148* .. Parameters .. 149 REAL ONE 150 PARAMETER ( ONE = 1.0E+0 ) 151* .. 152* .. Local Scalars .. 153 LOGICAL LEFTV, RIGHTV 154 INTEGER I, II, K 155 REAL S 156* .. 157* .. External Functions .. 158 LOGICAL LSAME 159 EXTERNAL LSAME 160* .. 161* .. External Subroutines .. 162 EXTERNAL SSCAL, SSWAP, XERBLA 163* .. 164* .. Intrinsic Functions .. 165 INTRINSIC MAX, MIN 166* .. 167* .. Executable Statements .. 168* 169* Decode and Test the input parameters 170* 171 RIGHTV = LSAME( SIDE, 'R' ) 172 LEFTV = LSAME( SIDE, 'L' ) 173* 174 INFO = 0 175 IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. 176 $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN 177 INFO = -1 178 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN 179 INFO = -2 180 ELSE IF( N.LT.0 ) THEN 181 INFO = -3 182 ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN 183 INFO = -4 184 ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN 185 INFO = -5 186 ELSE IF( M.LT.0 ) THEN 187 INFO = -7 188 ELSE IF( LDV.LT.MAX( 1, N ) ) THEN 189 INFO = -9 190 END IF 191 IF( INFO.NE.0 ) THEN 192 CALL XERBLA( 'SGEBAK', -INFO ) 193 RETURN 194 END IF 195* 196* Quick return if possible 197* 198 IF( N.EQ.0 ) 199 $ RETURN 200 IF( M.EQ.0 ) 201 $ RETURN 202 IF( LSAME( JOB, 'N' ) ) 203 $ RETURN 204* 205 IF( ILO.EQ.IHI ) 206 $ GO TO 30 207* 208* Backward balance 209* 210 IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN 211* 212 IF( RIGHTV ) THEN 213 DO 10 I = ILO, IHI 214 S = SCALE( I ) 215 CALL SSCAL( M, S, V( I, 1 ), LDV ) 216 10 CONTINUE 217 END IF 218* 219 IF( LEFTV ) THEN 220 DO 20 I = ILO, IHI 221 S = ONE / SCALE( I ) 222 CALL SSCAL( M, S, V( I, 1 ), LDV ) 223 20 CONTINUE 224 END IF 225* 226 END IF 227* 228* Backward permutation 229* 230* For I = ILO-1 step -1 until 1, 231* IHI+1 step 1 until N do -- 232* 233 30 CONTINUE 234 IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN 235 IF( RIGHTV ) THEN 236 DO 40 II = 1, N 237 I = II 238 IF( I.GE.ILO .AND. I.LE.IHI ) 239 $ GO TO 40 240 IF( I.LT.ILO ) 241 $ I = ILO - II 242 K = SCALE( I ) 243 IF( K.EQ.I ) 244 $ GO TO 40 245 CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 246 40 CONTINUE 247 END IF 248* 249 IF( LEFTV ) THEN 250 DO 50 II = 1, N 251 I = II 252 IF( I.GE.ILO .AND. I.LE.IHI ) 253 $ GO TO 50 254 IF( I.LT.ILO ) 255 $ I = ILO - II 256 K = SCALE( I ) 257 IF( K.EQ.I ) 258 $ GO TO 50 259 CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 260 50 CONTINUE 261 END IF 262 END IF 263* 264 RETURN 265* 266* End of SGEBAK 267* 268 END 269