1 SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, 2 $ INFO ) 3* 4* -- LAPACK routine (version 3.0) -- 5* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 6* Courant Institute, Argonne National Lab, and Rice University 7* September 30, 1994 8* 9* .. Scalar Arguments .. 10 CHARACTER JOB, SIDE 11 INTEGER IHI, ILO, INFO, LDV, M, N 12* .. 13* .. Array Arguments .. 14 DOUBLE PRECISION SCALE( * ), V( LDV, * ) 15* .. 16* 17* Purpose 18* ======= 19* 20* DGEBAK forms the right or left eigenvectors of a real general matrix 21* by backward transformation on the computed eigenvectors of the 22* balanced matrix output by DGEBAL. 23* 24* Arguments 25* ========= 26* 27* JOB (input) CHARACTER*1 28* Specifies the type of backward transformation required: 29* = 'N', do nothing, return immediately; 30* = 'P', do backward transformation for permutation only; 31* = 'S', do backward transformation for scaling only; 32* = 'B', do backward transformations for both permutation and 33* scaling. 34* JOB must be the same as the argument JOB supplied to DGEBAL. 35* 36* SIDE (input) CHARACTER*1 37* = 'R': V contains right eigenvectors; 38* = 'L': V contains left eigenvectors. 39* 40* N (input) INTEGER 41* The number of rows of the matrix V. N >= 0. 42* 43* ILO (input) INTEGER 44* IHI (input) INTEGER 45* The integers ILO and IHI determined by DGEBAL. 46* 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. 47* 48* SCALE (input) DOUBLE PRECISION array, dimension (N) 49* Details of the permutation and scaling factors, as returned 50* by DGEBAL. 51* 52* M (input) INTEGER 53* The number of columns of the matrix V. M >= 0. 54* 55* V (input/output) DOUBLE PRECISION array, dimension (LDV,M) 56* On entry, the matrix of right or left eigenvectors to be 57* transformed, as returned by DHSEIN or DTREVC. 58* On exit, V is overwritten by the transformed eigenvectors. 59* 60* LDV (input) INTEGER 61* The leading dimension of the array V. LDV >= max(1,N). 62* 63* INFO (output) INTEGER 64* = 0: successful exit 65* < 0: if INFO = -i, the i-th argument had an illegal value. 66* 67* ===================================================================== 68* 69* .. Parameters .. 70 DOUBLE PRECISION ONE 71 PARAMETER ( ONE = 1.0D+0 ) 72* .. 73* .. Local Scalars .. 74 LOGICAL LEFTV, RIGHTV 75 INTEGER I, II, K 76 DOUBLE PRECISION S 77* .. 78* .. External Functions .. 79 LOGICAL LSAME 80 EXTERNAL LSAME 81* .. 82* .. External Subroutines .. 83 EXTERNAL DSCAL, DSWAP, XERBLA 84* .. 85* .. Intrinsic Functions .. 86 INTRINSIC MAX, MIN 87* .. 88* .. Executable Statements .. 89* 90* Decode and Test the input parameters 91* 92 RIGHTV = LSAME( SIDE, 'R' ) 93 LEFTV = LSAME( SIDE, 'L' ) 94* 95 INFO = 0 96 IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND. 97 $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN 98 INFO = -1 99 ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN 100 INFO = -2 101 ELSE IF( N.LT.0 ) THEN 102 INFO = -3 103 ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN 104 INFO = -4 105 ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN 106 INFO = -5 107 ELSE IF( M.LT.0 ) THEN 108 INFO = -7 109 ELSE IF( LDV.LT.MAX( 1, N ) ) THEN 110 INFO = -9 111 END IF 112 IF( INFO.NE.0 ) THEN 113 CALL XERBLA( 'DGEBAK', -INFO ) 114 RETURN 115 END IF 116* 117* Quick return if possible 118* 119 IF( N.EQ.0 ) 120 $ RETURN 121 IF( M.EQ.0 ) 122 $ RETURN 123 IF( LSAME( JOB, 'N' ) ) 124 $ RETURN 125* 126 IF( ILO.EQ.IHI ) 127 $ GO TO 30 128* 129* Backward balance 130* 131 IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN 132* 133 IF( RIGHTV ) THEN 134 DO 10 I = ILO, IHI 135 S = SCALE( I ) 136 CALL DSCAL( M, S, V( I, 1 ), LDV ) 137 10 CONTINUE 138 END IF 139* 140 IF( LEFTV ) THEN 141 DO 20 I = ILO, IHI 142 S = ONE / SCALE( I ) 143 CALL DSCAL( M, S, V( I, 1 ), LDV ) 144 20 CONTINUE 145 END IF 146* 147 END IF 148* 149* Backward permutation 150* 151* For I = ILO-1 step -1 until 1, 152* IHI+1 step 1 until N do -- 153* 154 30 CONTINUE 155 IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN 156 IF( RIGHTV ) THEN 157 DO 40 II = 1, N 158 I = II 159 IF( I.GE.ILO .AND. I.LE.IHI ) 160 $ GO TO 40 161 IF( I.LT.ILO ) 162 $ I = ILO - II 163 K = SCALE( I ) 164 IF( K.EQ.I ) 165 $ GO TO 40 166 CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 167 40 CONTINUE 168 END IF 169* 170 IF( LEFTV ) THEN 171 DO 50 II = 1, N 172 I = II 173 IF( I.GE.ILO .AND. I.LE.IHI ) 174 $ GO TO 50 175 IF( I.LT.ILO ) 176 $ I = ILO - II 177 K = SCALE( I ) 178 IF( K.EQ.I ) 179 $ GO TO 50 180 CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 181 50 CONTINUE 182 END IF 183 END IF 184* 185 RETURN 186* 187* End of DGEBAK 188* 189 END 190