LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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 = int( 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 = int( 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 = int( 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 = int( 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