001:       SUBROUTINE ZGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
002:      $                   LDV, 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   LSCALE( * ), RSCALE( * )
015:       COMPLEX*16         V( LDV, * )
016: *     ..
017: *
018: *  Purpose
019: *  =======
020: *
021: *  ZGGBAK forms the right or left eigenvectors of a complex generalized
022: *  eigenvalue problem A*x = lambda*B*x, by backward transformation on
023: *  the computed eigenvectors of the balanced pair of matrices output by
024: *  ZGGBAL.
025: *
026: *  Arguments
027: *  =========
028: *
029: *  JOB     (input) CHARACTER*1
030: *          Specifies the type of backward transformation required:
031: *          = 'N':  do nothing, return immediately;
032: *          = 'P':  do backward transformation for permutation only;
033: *          = 'S':  do backward transformation for scaling only;
034: *          = 'B':  do backward transformations for both permutation and
035: *                  scaling.
036: *          JOB must be the same as the argument JOB supplied to ZGGBAL.
037: *
038: *  SIDE    (input) CHARACTER*1
039: *          = 'R':  V contains right eigenvectors;
040: *          = 'L':  V contains left eigenvectors.
041: *
042: *  N       (input) INTEGER
043: *          The number of rows of the matrix V.  N >= 0.
044: *
045: *  ILO     (input) INTEGER
046: *  IHI     (input) INTEGER
047: *          The integers ILO and IHI determined by ZGGBAL.
048: *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
049: *
050: *  LSCALE  (input) DOUBLE PRECISION array, dimension (N)
051: *          Details of the permutations and/or scaling factors applied
052: *          to the left side of A and B, as returned by ZGGBAL.
053: *
054: *  RSCALE  (input) DOUBLE PRECISION array, dimension (N)
055: *          Details of the permutations and/or scaling factors applied
056: *          to the right side of A and B, as returned by ZGGBAL.
057: *
058: *  M       (input) INTEGER
059: *          The number of columns of the matrix V.  M >= 0.
060: *
061: *  V       (input/output) COMPLEX*16 array, dimension (LDV,M)
062: *          On entry, the matrix of right or left eigenvectors to be
063: *          transformed, as returned by ZTGEVC.
064: *          On exit, V is overwritten by the transformed eigenvectors.
065: *
066: *  LDV     (input) INTEGER
067: *          The leading dimension of the matrix V. LDV >= max(1,N).
068: *
069: *  INFO    (output) INTEGER
070: *          = 0:  successful exit.
071: *          < 0:  if INFO = -i, the i-th argument had an illegal value.
072: *
073: *  Further Details
074: *  ===============
075: *
076: *  See R.C. Ward, Balancing the generalized eigenvalue problem,
077: *                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
078: *
079: *  =====================================================================
080: *
081: *     .. Local Scalars ..
082:       LOGICAL            LEFTV, RIGHTV
083:       INTEGER            I, K
084: *     ..
085: *     .. External Functions ..
086:       LOGICAL            LSAME
087:       EXTERNAL           LSAME
088: *     ..
089: *     .. External Subroutines ..
090:       EXTERNAL           XERBLA, ZDSCAL, ZSWAP
091: *     ..
092: *     .. Intrinsic Functions ..
093:       INTRINSIC          MAX
094: *     ..
095: *     .. Executable Statements ..
096: *
097: *     Test the input parameters
098: *
099:       RIGHTV = LSAME( SIDE, 'R' )
100:       LEFTV = LSAME( SIDE, 'L' )
101: *
102:       INFO = 0
103:       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
104:      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
105:          INFO = -1
106:       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
107:          INFO = -2
108:       ELSE IF( N.LT.0 ) THEN
109:          INFO = -3
110:       ELSE IF( ILO.LT.1 ) THEN
111:          INFO = -4
112:       ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
113:          INFO = -4
114:       ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
115:      $   THEN
116:          INFO = -5
117:       ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
118:          INFO = -5
119:       ELSE IF( M.LT.0 ) THEN
120:          INFO = -8
121:       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
122:          INFO = -10
123:       END IF
124:       IF( INFO.NE.0 ) THEN
125:          CALL XERBLA( 'ZGGBAK', -INFO )
126:          RETURN
127:       END IF
128: *
129: *     Quick return if possible
130: *
131:       IF( N.EQ.0 )
132:      $   RETURN
133:       IF( M.EQ.0 )
134:      $   RETURN
135:       IF( LSAME( JOB, 'N' ) )
136:      $   RETURN
137: *
138:       IF( ILO.EQ.IHI )
139:      $   GO TO 30
140: *
141: *     Backward balance
142: *
143:       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
144: *
145: *        Backward transformation on right eigenvectors
146: *
147:          IF( RIGHTV ) THEN
148:             DO 10 I = ILO, IHI
149:                CALL ZDSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
150:    10       CONTINUE
151:          END IF
152: *
153: *        Backward transformation on left eigenvectors
154: *
155:          IF( LEFTV ) THEN
156:             DO 20 I = ILO, IHI
157:                CALL ZDSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
158:    20       CONTINUE
159:          END IF
160:       END IF
161: *
162: *     Backward permutation
163: *
164:    30 CONTINUE
165:       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
166: *
167: *        Backward permutation on right eigenvectors
168: *
169:          IF( RIGHTV ) THEN
170:             IF( ILO.EQ.1 )
171:      $         GO TO 50
172:             DO 40 I = ILO - 1, 1, -1
173:                K = RSCALE( I )
174:                IF( K.EQ.I )
175:      $            GO TO 40
176:                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
177:    40       CONTINUE
178: *
179:    50       CONTINUE
180:             IF( IHI.EQ.N )
181:      $         GO TO 70
182:             DO 60 I = IHI + 1, N
183:                K = RSCALE( I )
184:                IF( K.EQ.I )
185:      $            GO TO 60
186:                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
187:    60       CONTINUE
188:          END IF
189: *
190: *        Backward permutation on left eigenvectors
191: *
192:    70    CONTINUE
193:          IF( LEFTV ) THEN
194:             IF( ILO.EQ.1 )
195:      $         GO TO 90
196:             DO 80 I = ILO - 1, 1, -1
197:                K = LSCALE( I )
198:                IF( K.EQ.I )
199:      $            GO TO 80
200:                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
201:    80       CONTINUE
202: *
203:    90       CONTINUE
204:             IF( IHI.EQ.N )
205:      $         GO TO 110
206:             DO 100 I = IHI + 1, N
207:                K = LSCALE( I )
208:                IF( K.EQ.I )
209:      $            GO TO 100
210:                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
211:   100       CONTINUE
212:          END IF
213:       END IF
214: *
215:   110 CONTINUE
216: *
217:       RETURN
218: *
219: *     End of ZGGBAK
220: *
221:       END
222: