LAPACK  3.10.0 LAPACK: Linear Algebra PACKage
dgebak.f
Go to the documentation of this file.
1 *> \brief \b DGEBAK
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgebak.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgebak.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgebak.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE DGEBAK( 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 * DOUBLE PRECISION SCALE( * ), V( LDV, * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> DGEBAK 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 DGEBAL.
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 DGEBAL.
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 DGEBAL.
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 DOUBLE PRECISION array, dimension (N)
86 *> Details of the permutation and scaling factors, as returned
87 *> by DGEBAL.
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 DOUBLE PRECISION array, dimension (LDV,M)
99 *> On entry, the matrix of right or left eigenvectors to be
100 *> transformed, as returned by DHSEIN or DTREVC.
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 doubleGEcomputational
126 *
127 * =====================================================================
128  SUBROUTINE dgebak( 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  DOUBLE PRECISION SCALE( * ), V( LDV, * )
141 * ..
142 *
143 * =====================================================================
144 *
145 * .. Parameters ..
146  DOUBLE PRECISION ONE
147  parameter( one = 1.0d+0 )
148 * ..
149 * .. Local Scalars ..
150  LOGICAL LEFTV, RIGHTV
151  INTEGER I, II, K
152  DOUBLE PRECISION S
153 * ..
154 * .. External Functions ..
155  LOGICAL LSAME
156  EXTERNAL lsame
157 * ..
158 * .. External Subroutines ..
159  EXTERNAL dscal, dswap, 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( 'DGEBAK', -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 dscal( 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 dscal( 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 dswap( 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 dswap( 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 DGEBAK
264 *
265  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine dscal(N, DA, DX, INCX)
DSCAL
Definition: dscal.f:79
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
Definition: dswap.f:82
subroutine dgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
DGEBAK
Definition: dgebak.f:130