LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
sggbak.f
Go to the documentation of this file.
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 *> \date November 2011
134 *
135 *> \ingroup realGBcomputational
136 *
137 *> \par Further Details:
138 * =====================
139 *>
140 *> \verbatim
141 *>
142 *> See R.C. Ward, Balancing the generalized eigenvalue problem,
143 *> SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
144 *> \endverbatim
145 *>
146 * =====================================================================
147  SUBROUTINE sggbak( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
148  $ ldv, info )
149 *
150 * -- LAPACK computational routine (version 3.4.0) --
151 * -- LAPACK is a software package provided by Univ. of Tennessee, --
152 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
153 * November 2011
154 *
155 * .. Scalar Arguments ..
156  CHARACTER job, side
157  INTEGER ihi, ilo, info, ldv, m, n
158 * ..
159 * .. Array Arguments ..
160  REAL lscale( * ), rscale( * ), v( ldv, * )
161 * ..
162 *
163 * =====================================================================
164 *
165 * .. Local Scalars ..
166  LOGICAL leftv, rightv
167  INTEGER i, k
168 * ..
169 * .. External Functions ..
170  LOGICAL lsame
171  EXTERNAL lsame
172 * ..
173 * .. External Subroutines ..
174  EXTERNAL sscal, sswap, xerbla
175 * ..
176 * .. Intrinsic Functions ..
177  INTRINSIC max
178 * ..
179 * .. Executable Statements ..
180 *
181 * Test the input parameters
182 *
183  rightv = lsame( side, 'R' )
184  leftv = lsame( side, 'L' )
185 *
186  info = 0
187  IF( .NOT.lsame( job, 'N' ) .AND. .NOT.lsame( job, 'P' ) .AND.
188  $ .NOT.lsame( job, 'S' ) .AND. .NOT.lsame( job, 'B' ) ) THEN
189  info = -1
190  ELSE IF( .NOT.rightv .AND. .NOT.leftv ) THEN
191  info = -2
192  ELSE IF( n.LT.0 ) THEN
193  info = -3
194  ELSE IF( ilo.LT.1 ) THEN
195  info = -4
196  ELSE IF( n.EQ.0 .AND. ihi.EQ.0 .AND. ilo.NE.1 ) THEN
197  info = -4
198  ELSE IF( n.GT.0 .AND. ( ihi.LT.ilo .OR. ihi.GT.max( 1, n ) ) )
199  $ THEN
200  info = -5
201  ELSE IF( n.EQ.0 .AND. ilo.EQ.1 .AND. ihi.NE.0 ) THEN
202  info = -5
203  ELSE IF( m.LT.0 ) THEN
204  info = -8
205  ELSE IF( ldv.LT.max( 1, n ) ) THEN
206  info = -10
207  END IF
208  IF( info.NE.0 ) THEN
209  CALL xerbla( 'SGGBAK', -info )
210  return
211  END IF
212 *
213 * Quick return if possible
214 *
215  IF( n.EQ.0 )
216  $ return
217  IF( m.EQ.0 )
218  $ return
219  IF( lsame( job, 'N' ) )
220  $ return
221 *
222  IF( ilo.EQ.ihi )
223  $ go to 30
224 *
225 * Backward balance
226 *
227  IF( lsame( job, 'S' ) .OR. lsame( job, 'B' ) ) THEN
228 *
229 * Backward transformation on right eigenvectors
230 *
231  IF( rightv ) THEN
232  DO 10 i = ilo, ihi
233  CALL sscal( m, rscale( i ), v( i, 1 ), ldv )
234  10 continue
235  END IF
236 *
237 * Backward transformation on left eigenvectors
238 *
239  IF( leftv ) THEN
240  DO 20 i = ilo, ihi
241  CALL sscal( m, lscale( i ), v( i, 1 ), ldv )
242  20 continue
243  END IF
244  END IF
245 *
246 * Backward permutation
247 *
248  30 continue
249  IF( lsame( job, 'P' ) .OR. lsame( job, 'B' ) ) THEN
250 *
251 * Backward permutation on right eigenvectors
252 *
253  IF( rightv ) THEN
254  IF( ilo.EQ.1 )
255  $ go to 50
256 *
257  DO 40 i = ilo - 1, 1, -1
258  k = rscale( i )
259  IF( k.EQ.i )
260  $ go to 40
261  CALL sswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
262  40 continue
263 *
264  50 continue
265  IF( ihi.EQ.n )
266  $ go to 70
267  DO 60 i = ihi + 1, n
268  k = rscale( i )
269  IF( k.EQ.i )
270  $ go to 60
271  CALL sswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
272  60 continue
273  END IF
274 *
275 * Backward permutation on left eigenvectors
276 *
277  70 continue
278  IF( leftv ) THEN
279  IF( ilo.EQ.1 )
280  $ go to 90
281  DO 80 i = ilo - 1, 1, -1
282  k = lscale( i )
283  IF( k.EQ.i )
284  $ go to 80
285  CALL sswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
286  80 continue
287 *
288  90 continue
289  IF( ihi.EQ.n )
290  $ go to 110
291  DO 100 i = ihi + 1, n
292  k = lscale( i )
293  IF( k.EQ.i )
294  $ go to 100
295  CALL sswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
296  100 continue
297  END IF
298  END IF
299 *
300  110 continue
301 *
302  return
303 *
304 * End of SGGBAK
305 *
306  END