001:       SUBROUTINE SGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
002:      $                   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:       REAL               V( LDV, * ), SCALE( * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  SGEBAK forms the right or left eigenvectors of a real general matrix
020: *  by backward transformation on the computed eigenvectors of the
021: *  balanced matrix output by SGEBAL.
022: *
023: *  Arguments
024: *  =========
025: *
026: *  JOB     (input) CHARACTER*1
027: *          Specifies the type of backward transformation required:
028: *          = 'N', do nothing, return immediately;
029: *          = 'P', do backward transformation for permutation only;
030: *          = 'S', do backward transformation for scaling only;
031: *          = 'B', do backward transformations for both permutation and
032: *                 scaling.
033: *          JOB must be the same as the argument JOB supplied to SGEBAL.
034: *
035: *  SIDE    (input) CHARACTER*1
036: *          = 'R':  V contains right eigenvectors;
037: *          = 'L':  V contains left eigenvectors.
038: *
039: *  N       (input) INTEGER
040: *          The number of rows of the matrix V.  N >= 0.
041: *
042: *  ILO     (input) INTEGER
043: *  IHI     (input) INTEGER
044: *          The integers ILO and IHI determined by SGEBAL.
045: *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
046: *
047: *  SCALE   (input) REAL array, dimension (N)
048: *          Details of the permutation and scaling factors, as returned
049: *          by SGEBAL.
050: *
051: *  M       (input) INTEGER
052: *          The number of columns of the matrix V.  M >= 0.
053: *
054: *  V       (input/output) REAL array, dimension (LDV,M)
055: *          On entry, the matrix of right or left eigenvectors to be
056: *          transformed, as returned by SHSEIN or STREVC.
057: *          On exit, V is overwritten by the transformed eigenvectors.
058: *
059: *  LDV     (input) INTEGER
060: *          The leading dimension of the array V. LDV >= max(1,N).
061: *
062: *  INFO    (output) INTEGER
063: *          = 0:  successful exit
064: *          < 0:  if INFO = -i, the i-th argument had an illegal value.
065: *
066: *  =====================================================================
067: *
068: *     .. Parameters ..
069:       REAL               ONE
070:       PARAMETER          ( ONE = 1.0E+0 )
071: *     ..
072: *     .. Local Scalars ..
073:       LOGICAL            LEFTV, RIGHTV
074:       INTEGER            I, II, K
075:       REAL               S
076: *     ..
077: *     .. External Functions ..
078:       LOGICAL            LSAME
079:       EXTERNAL           LSAME
080: *     ..
081: *     .. External Subroutines ..
082:       EXTERNAL           SSCAL, SSWAP, XERBLA
083: *     ..
084: *     .. Intrinsic Functions ..
085:       INTRINSIC          MAX, MIN
086: *     ..
087: *     .. Executable Statements ..
088: *
089: *     Decode and Test the input parameters
090: *
091:       RIGHTV = LSAME( SIDE, 'R' )
092:       LEFTV = LSAME( SIDE, 'L' )
093: *
094:       INFO = 0
095:       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
096:      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
097:          INFO = -1
098:       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
099:          INFO = -2
100:       ELSE IF( N.LT.0 ) THEN
101:          INFO = -3
102:       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
103:          INFO = -4
104:       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
105:          INFO = -5
106:       ELSE IF( M.LT.0 ) THEN
107:          INFO = -7
108:       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
109:          INFO = -9
110:       END IF
111:       IF( INFO.NE.0 ) THEN
112:          CALL XERBLA( 'SGEBAK', -INFO )
113:          RETURN
114:       END IF
115: *
116: *     Quick return if possible
117: *
118:       IF( N.EQ.0 )
119:      $   RETURN
120:       IF( M.EQ.0 )
121:      $   RETURN
122:       IF( LSAME( JOB, 'N' ) )
123:      $   RETURN
124: *
125:       IF( ILO.EQ.IHI )
126:      $   GO TO 30
127: *
128: *     Backward balance
129: *
130:       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
131: *
132:          IF( RIGHTV ) THEN
133:             DO 10 I = ILO, IHI
134:                S = SCALE( I )
135:                CALL SSCAL( M, S, V( I, 1 ), LDV )
136:    10       CONTINUE
137:          END IF
138: *
139:          IF( LEFTV ) THEN
140:             DO 20 I = ILO, IHI
141:                S = ONE / SCALE( I )
142:                CALL SSCAL( M, S, V( I, 1 ), LDV )
143:    20       CONTINUE
144:          END IF
145: *
146:       END IF
147: *
148: *     Backward permutation
149: *
150: *     For  I = ILO-1 step -1 until 1,
151: *              IHI+1 step 1 until N do --
152: *
153:    30 CONTINUE
154:       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
155:          IF( RIGHTV ) THEN
156:             DO 40 II = 1, N
157:                I = II
158:                IF( I.GE.ILO .AND. I.LE.IHI )
159:      $            GO TO 40
160:                IF( I.LT.ILO )
161:      $            I = ILO - II
162:                K = SCALE( I )
163:                IF( K.EQ.I )
164:      $            GO TO 40
165:                CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
166:    40       CONTINUE
167:          END IF
168: *
169:          IF( LEFTV ) THEN
170:             DO 50 II = 1, N
171:                I = II
172:                IF( I.GE.ILO .AND. I.LE.IHI )
173:      $            GO TO 50
174:                IF( I.LT.ILO )
175:      $            I = ILO - II
176:                K = SCALE( I )
177:                IF( K.EQ.I )
178:      $            GO TO 50
179:                CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
180:    50       CONTINUE
181:          END IF
182:       END IF
183: *
184:       RETURN
185: *
186: *     End of SGEBAK
187: *
188:       END
189: