LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sgebak.f
Go to the documentation of this file.
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 = int( 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 = int( 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
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine sgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
SGEBAK
Definition: sgebak.f:130
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
Definition: sswap.f:82
subroutine sscal(N, SA, SX, INCX)
SSCAL
Definition: sscal.f:79