001:       SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
002:      $                   INFO )
003: *
004: *  -- LAPACK routine (version 3.2) --
005: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
006: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
007: *     November 2006
008: *
009: *     .. Scalar Arguments ..
010:       CHARACTER          JOB, SIDE
011:       INTEGER            IHI, ILO, INFO, LDV, M, N
012: *     ..
013: *     .. Array Arguments ..
014:       DOUBLE PRECISION   SCALE( * )
015:       COMPLEX*16         V( LDV, * )
016: *     ..
017: *
018: *  Purpose
019: *  =======
020: *
021: *  ZGEBAK forms the right or left eigenvectors of a complex general
022: *  matrix by backward transformation on the computed eigenvectors of the
023: *  balanced matrix output by ZGEBAL.
024: *
025: *  Arguments
026: *  =========
027: *
028: *  JOB     (input) CHARACTER*1
029: *          Specifies the type of backward transformation required:
030: *          = 'N', do nothing, return immediately;
031: *          = 'P', do backward transformation for permutation only;
032: *          = 'S', do backward transformation for scaling only;
033: *          = 'B', do backward transformations for both permutation and
034: *                 scaling.
035: *          JOB must be the same as the argument JOB supplied to ZGEBAL.
036: *
037: *  SIDE    (input) CHARACTER*1
038: *          = 'R':  V contains right eigenvectors;
039: *          = 'L':  V contains left eigenvectors.
040: *
041: *  N       (input) INTEGER
042: *          The number of rows of the matrix V.  N >= 0.
043: *
044: *  ILO     (input) INTEGER
045: *  IHI     (input) INTEGER
046: *          The integers ILO and IHI determined by ZGEBAL.
047: *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
048: *
049: *  SCALE   (input) DOUBLE PRECISION array, dimension (N)
050: *          Details of the permutation and scaling factors, as returned
051: *          by ZGEBAL.
052: *
053: *  M       (input) INTEGER
054: *          The number of columns of the matrix V.  M >= 0.
055: *
056: *  V       (input/output) COMPLEX*16 array, dimension (LDV,M)
057: *          On entry, the matrix of right or left eigenvectors to be
058: *          transformed, as returned by ZHSEIN or ZTREVC.
059: *          On exit, V is overwritten by the transformed eigenvectors.
060: *
061: *  LDV     (input) INTEGER
062: *          The leading dimension of the array V. LDV >= max(1,N).
063: *
064: *  INFO    (output) INTEGER
065: *          = 0:  successful exit
066: *          < 0:  if INFO = -i, the i-th argument had an illegal value.
067: *
068: *  =====================================================================
069: *
070: *     .. Parameters ..
071:       DOUBLE PRECISION   ONE
072:       PARAMETER          ( ONE = 1.0D+0 )
073: *     ..
074: *     .. Local Scalars ..
075:       LOGICAL            LEFTV, RIGHTV
076:       INTEGER            I, II, K
077:       DOUBLE PRECISION   S
078: *     ..
079: *     .. External Functions ..
080:       LOGICAL            LSAME
081:       EXTERNAL           LSAME
082: *     ..
083: *     .. External Subroutines ..
084:       EXTERNAL           XERBLA, ZDSCAL, ZSWAP
085: *     ..
086: *     .. Intrinsic Functions ..
087:       INTRINSIC          MAX, MIN
088: *     ..
089: *     .. Executable Statements ..
090: *
091: *     Decode and Test the input parameters
092: *
093:       RIGHTV = LSAME( SIDE, 'R' )
094:       LEFTV = LSAME( SIDE, 'L' )
095: *
096:       INFO = 0
097:       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
098:      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
099:          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: