001:       SUBROUTINE SGGBAK( 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:       REAL               LSCALE( * ), RSCALE( * ), V( LDV, * )
015: *     ..
016: *
017: *  Purpose
018: *  =======
019: *
020: *  SGGBAK forms the right or left eigenvectors of a real generalized
021: *  eigenvalue problem A*x = lambda*B*x, by backward transformation on
022: *  the computed eigenvectors of the balanced pair of matrices output by
023: *  SGGBAL.
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 SGGBAL.
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 SGGBAL.
047: *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
048: *
049: *  LSCALE  (input) REAL array, dimension (N)
050: *          Details of the permutations and/or scaling factors applied
051: *          to the left side of A and B, as returned by SGGBAL.
052: *
053: *  RSCALE  (input) REAL array, dimension (N)
054: *          Details of the permutations and/or scaling factors applied
055: *          to the right side of A and B, as returned by SGGBAL.
056: *
057: *  M       (input) INTEGER
058: *          The number of columns of the matrix V.  M >= 0.
059: *
060: *  V       (input/output) REAL array, dimension (LDV,M)
061: *          On entry, the matrix of right or left eigenvectors to be
062: *          transformed, as returned by STGEVC.
063: *          On exit, V is overwritten by the transformed eigenvectors.
064: *
065: *  LDV     (input) INTEGER
066: *          The leading dimension of the matrix V. LDV >= max(1,N).
067: *
068: *  INFO    (output) INTEGER
069: *          = 0:  successful exit.
070: *          < 0:  if INFO = -i, the i-th argument had an illegal value.
071: *
072: *  Further Details
073: *  ===============
074: *
075: *  See R.C. Ward, Balancing the generalized eigenvalue problem,
076: *                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
077: *
078: *  =====================================================================
079: *
080: *     .. Local Scalars ..
081:       LOGICAL            LEFTV, RIGHTV
082:       INTEGER            I, K
083: *     ..
084: *     .. External Functions ..
085:       LOGICAL            LSAME
086:       EXTERNAL           LSAME
087: *     ..
088: *     .. External Subroutines ..
089:       EXTERNAL           SSCAL, SSWAP, XERBLA
090: *     ..
091: *     .. Intrinsic Functions ..
092:       INTRINSIC          MAX
093: *     ..
094: *     .. Executable Statements ..
095: *
096: *     Test the input parameters
097: *
098:       RIGHTV = LSAME( SIDE, 'R' )
099:       LEFTV = LSAME( SIDE, 'L' )
100: *
101:       INFO = 0
102:       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
103:      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
104:          INFO = -1
105:       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
106:          INFO = -2
107:       ELSE IF( N.LT.0 ) THEN
108:          INFO = -3
109:       ELSE IF( ILO.LT.1 ) THEN
110:          INFO = -4
111:       ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
112:          INFO = -4
113:       ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
114:      $   THEN
115:          INFO = -5
116:       ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
117:          INFO = -5
118:       ELSE IF( M.LT.0 ) THEN
119:          INFO = -8
120:       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
121:          INFO = -10
122:       END IF
123:       IF( INFO.NE.0 ) THEN
124:          CALL XERBLA( 'SGGBAK', -INFO )
125:          RETURN
126:       END IF
127: *
128: *     Quick return if possible
129: *
130:       IF( N.EQ.0 )
131:      $   RETURN
132:       IF( M.EQ.0 )
133:      $   RETURN
134:       IF( LSAME( JOB, 'N' ) )
135:      $   RETURN
136: *
137:       IF( ILO.EQ.IHI )
138:      $   GO TO 30
139: *
140: *     Backward balance
141: *
142:       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
143: *
144: *        Backward transformation on right eigenvectors
145: *
146:          IF( RIGHTV ) THEN
147:             DO 10 I = ILO, IHI
148:                CALL SSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
149:    10       CONTINUE
150:          END IF
151: *
152: *        Backward transformation on left eigenvectors
153: *
154:          IF( LEFTV ) THEN
155:             DO 20 I = ILO, IHI
156:                CALL SSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
157:    20       CONTINUE
158:          END IF
159:       END IF
160: *
161: *     Backward permutation
162: *
163:    30 CONTINUE
164:       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
165: *
166: *        Backward permutation on right eigenvectors
167: *
168:          IF( RIGHTV ) THEN
169:             IF( ILO.EQ.1 )
170:      $         GO TO 50
171: *
172:             DO 40 I = ILO - 1, 1, -1
173:                K = RSCALE( I )
174:                IF( K.EQ.I )
175:      $            GO TO 40
176:                CALL SSWAP( 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 SSWAP( 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 SSWAP( 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 SSWAP( 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 SGGBAK
220: *
221:       END
222: