LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
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 *> \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
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine sggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
SGGBAK
Definition: sggbak.f:147
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
Definition: sswap.f:82
subroutine sscal(N, SA, SX, INCX)
SSCAL
Definition: sscal.f:79