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