1*> \brief \b SGGBAK
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SGGBAK + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggbak.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggbak.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggbak.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
22*                          LDV, INFO )
23*
24*       .. Scalar Arguments ..
25*       CHARACTER          JOB, SIDE
26*       INTEGER            IHI, ILO, INFO, LDV, M, N
27*       ..
28*       .. Array Arguments ..
29*       REAL               LSCALE( * ), RSCALE( * ), V( LDV, * )
30*       ..
31*
32*
33*> \par Purpose:
34*  =============
35*>
36*> \verbatim
37*>
38*> SGGBAK forms the right or left eigenvectors of a real generalized
39*> eigenvalue problem A*x = lambda*B*x, by backward transformation on
40*> the computed eigenvectors of the balanced pair of matrices output by
41*> SGGBAL.
42*> \endverbatim
43*
44*  Arguments:
45*  ==========
46*
47*> \param[in] JOB
48*> \verbatim
49*>          JOB is CHARACTER*1
50*>          Specifies the type of backward transformation required:
51*>          = 'N':  do nothing, return immediately;
52*>          = 'P':  do backward transformation for permutation only;
53*>          = 'S':  do backward transformation for scaling only;
54*>          = 'B':  do backward transformations for both permutation and
55*>                  scaling.
56*>          JOB must be the same as the argument JOB supplied to SGGBAL.
57*> \endverbatim
58*>
59*> \param[in] SIDE
60*> \verbatim
61*>          SIDE is CHARACTER*1
62*>          = 'R':  V contains right eigenvectors;
63*>          = 'L':  V contains left eigenvectors.
64*> \endverbatim
65*>
66*> \param[in] N
67*> \verbatim
68*>          N is INTEGER
69*>          The number of rows of the matrix V.  N >= 0.
70*> \endverbatim
71*>
72*> \param[in] ILO
73*> \verbatim
74*>          ILO is INTEGER
75*> \endverbatim
76*>
77*> \param[in] IHI
78*> \verbatim
79*>          IHI is INTEGER
80*>          The integers ILO and IHI determined by SGGBAL.
81*>          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
82*> \endverbatim
83*>
84*> \param[in] LSCALE
85*> \verbatim
86*>          LSCALE is REAL array, dimension (N)
87*>          Details of the permutations and/or scaling factors applied
88*>          to the left side of A and B, as returned by SGGBAL.
89*> \endverbatim
90*>
91*> \param[in] RSCALE
92*> \verbatim
93*>          RSCALE is REAL array, dimension (N)
94*>          Details of the permutations and/or scaling factors applied
95*>          to the right side of A and B, as returned by SGGBAL.
96*> \endverbatim
97*>
98*> \param[in] M
99*> \verbatim
100*>          M is INTEGER
101*>          The number of columns of the matrix V.  M >= 0.
102*> \endverbatim
103*>
104*> \param[in,out] V
105*> \verbatim
106*>          V is REAL array, dimension (LDV,M)
107*>          On entry, the matrix of right or left eigenvectors to be
108*>          transformed, as returned by STGEVC.
109*>          On exit, V is overwritten by the transformed eigenvectors.
110*> \endverbatim
111*>
112*> \param[in] LDV
113*> \verbatim
114*>          LDV is INTEGER
115*>          The leading dimension of the matrix V. LDV >= max(1,N).
116*> \endverbatim
117*>
118*> \param[out] INFO
119*> \verbatim
120*>          INFO is INTEGER
121*>          = 0:  successful exit.
122*>          < 0:  if INFO = -i, the i-th argument had an illegal value.
123*> \endverbatim
124*
125*  Authors:
126*  ========
127*
128*> \author Univ. of Tennessee
129*> \author Univ. of California Berkeley
130*> \author Univ. of Colorado Denver
131*> \author NAG Ltd.
132*
133*> \ingroup realGBcomputational
134*
135*> \par Further Details:
136*  =====================
137*>
138*> \verbatim
139*>
140*>  See R.C. Ward, Balancing the generalized eigenvalue problem,
141*>                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
142*> \endverbatim
143*>
144*  =====================================================================
145      SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
146     $                   LDV, INFO )
147*
148*  -- LAPACK computational routine --
149*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
150*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
151*
152*     .. Scalar Arguments ..
153      CHARACTER          JOB, SIDE
154      INTEGER            IHI, ILO, INFO, LDV, M, N
155*     ..
156*     .. Array Arguments ..
157      REAL               LSCALE( * ), RSCALE( * ), V( LDV, * )
158*     ..
159*
160*  =====================================================================
161*
162*     .. Local Scalars ..
163      LOGICAL            LEFTV, RIGHTV
164      INTEGER            I, K
165*     ..
166*     .. External Functions ..
167      LOGICAL            LSAME
168      EXTERNAL           LSAME
169*     ..
170*     .. External Subroutines ..
171      EXTERNAL           SSCAL, SSWAP, XERBLA
172*     ..
173*     .. Intrinsic Functions ..
174      INTRINSIC          MAX
175*     ..
176*     .. Executable Statements ..
177*
178*     Test the input parameters
179*
180      RIGHTV = LSAME( SIDE, 'R' )
181      LEFTV = LSAME( SIDE, 'L' )
182*
183      INFO = 0
184      IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
185     $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
186         INFO = -1
187      ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
188         INFO = -2
189      ELSE IF( N.LT.0 ) THEN
190         INFO = -3
191      ELSE IF( ILO.LT.1 ) THEN
192         INFO = -4
193      ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
194         INFO = -4
195      ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
196     $   THEN
197         INFO = -5
198      ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
199         INFO = -5
200      ELSE IF( M.LT.0 ) THEN
201         INFO = -8
202      ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
203         INFO = -10
204      END IF
205      IF( INFO.NE.0 ) THEN
206         CALL XERBLA( 'SGGBAK', -INFO )
207         RETURN
208      END IF
209*
210*     Quick return if possible
211*
212      IF( N.EQ.0 )
213     $   RETURN
214      IF( M.EQ.0 )
215     $   RETURN
216      IF( LSAME( JOB, 'N' ) )
217     $   RETURN
218*
219      IF( ILO.EQ.IHI )
220     $   GO TO 30
221*
222*     Backward balance
223*
224      IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
225*
226*        Backward transformation on right eigenvectors
227*
228         IF( RIGHTV ) THEN
229            DO 10 I = ILO, IHI
230               CALL SSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
231   10       CONTINUE
232         END IF
233*
234*        Backward transformation on left eigenvectors
235*
236         IF( LEFTV ) THEN
237            DO 20 I = ILO, IHI
238               CALL SSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
239   20       CONTINUE
240         END IF
241      END IF
242*
243*     Backward permutation
244*
245   30 CONTINUE
246      IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
247*
248*        Backward permutation on right eigenvectors
249*
250         IF( RIGHTV ) THEN
251            IF( ILO.EQ.1 )
252     $         GO TO 50
253*
254            DO 40 I = ILO - 1, 1, -1
255               K = RSCALE( I )
256               IF( K.EQ.I )
257     $            GO TO 40
258               CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
259   40       CONTINUE
260*
261   50       CONTINUE
262            IF( IHI.EQ.N )
263     $         GO TO 70
264            DO 60 I = IHI + 1, N
265               K = RSCALE( I )
266               IF( K.EQ.I )
267     $            GO TO 60
268               CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
269   60       CONTINUE
270         END IF
271*
272*        Backward permutation on left eigenvectors
273*
274   70    CONTINUE
275         IF( LEFTV ) THEN
276            IF( ILO.EQ.1 )
277     $         GO TO 90
278            DO 80 I = ILO - 1, 1, -1
279               K = LSCALE( I )
280               IF( K.EQ.I )
281     $            GO TO 80
282               CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
283   80       CONTINUE
284*
285   90       CONTINUE
286            IF( IHI.EQ.N )
287     $         GO TO 110
288            DO 100 I = IHI + 1, N
289               K = LSCALE( I )
290               IF( K.EQ.I )
291     $            GO TO 100
292               CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
293  100       CONTINUE
294         END IF
295      END IF
296*
297  110 CONTINUE
298*
299      RETURN
300*
301*     End of SGGBAK
302*
303      END
304