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