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