Lots of trailing whitespaces in the files of Syd. Cleaning this. No big deal.
[platform/upstream/lapack.git] / SRC / dgebak.f
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
9 *> Download DGEBAK + dependencies
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 *> \date November 2011
126 *
127 *> \ingroup doubleGEcomputational
128 *
129 *  =====================================================================
130       SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
131      $                   INFO )
132 *
133 *  -- LAPACK computational routine (version 3.4.0) --
134 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
135 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
136 *     November 2011
137 *
138 *     .. Scalar Arguments ..
139       CHARACTER          JOB, SIDE
140       INTEGER            IHI, ILO, INFO, LDV, M, N
141 *     ..
142 *     .. Array Arguments ..
143       DOUBLE PRECISION   SCALE( * ), V( LDV, * )
144 *     ..
145 *
146 *  =====================================================================
147 *
148 *     .. Parameters ..
149       DOUBLE PRECISION   ONE
150       PARAMETER          ( ONE = 1.0D+0 )
151 *     ..
152 *     .. Local Scalars ..
153       LOGICAL            LEFTV, RIGHTV
154       INTEGER            I, II, K
155       DOUBLE PRECISION   S
156 *     ..
157 *     .. External Functions ..
158       LOGICAL            LSAME
159       EXTERNAL           LSAME
160 *     ..
161 *     .. External Subroutines ..
162       EXTERNAL           DSCAL, DSWAP, XERBLA
163 *     ..
164 *     .. Intrinsic Functions ..
165       INTRINSIC          MAX, MIN
166 *     ..
167 *     .. Executable Statements ..
168 *
169 *     Decode and Test the input parameters
170 *
171       RIGHTV = LSAME( SIDE, 'R' )
172       LEFTV = LSAME( SIDE, 'L' )
173 *
174       INFO = 0
175       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
176      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
177          INFO = -1
178       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
179          INFO = -2
180       ELSE IF( N.LT.0 ) THEN
181          INFO = -3
182       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
183          INFO = -4
184       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
185          INFO = -5
186       ELSE IF( M.LT.0 ) THEN
187          INFO = -7
188       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
189          INFO = -9
190       END IF
191       IF( INFO.NE.0 ) THEN
192          CALL XERBLA( 'DGEBAK', -INFO )
193          RETURN
194       END IF
195 *
196 *     Quick return if possible
197 *
198       IF( N.EQ.0 )
199      $   RETURN
200       IF( M.EQ.0 )
201      $   RETURN
202       IF( LSAME( JOB, 'N' ) )
203      $   RETURN
204 *
205       IF( ILO.EQ.IHI )
206      $   GO TO 30
207 *
208 *     Backward balance
209 *
210       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
211 *
212          IF( RIGHTV ) THEN
213             DO 10 I = ILO, IHI
214                S = SCALE( I )
215                CALL DSCAL( M, S, V( I, 1 ), LDV )
216    10       CONTINUE
217          END IF
218 *
219          IF( LEFTV ) THEN
220             DO 20 I = ILO, IHI
221                S = ONE / SCALE( I )
222                CALL DSCAL( M, S, V( I, 1 ), LDV )
223    20       CONTINUE
224          END IF
225 *
226       END IF
227 *
228 *     Backward permutation
229 *
230 *     For  I = ILO-1 step -1 until 1,
231 *              IHI+1 step 1 until N do --
232 *
233    30 CONTINUE
234       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
235          IF( RIGHTV ) THEN
236             DO 40 II = 1, N
237                I = II
238                IF( I.GE.ILO .AND. I.LE.IHI )
239      $            GO TO 40
240                IF( I.LT.ILO )
241      $            I = ILO - II
242                K = SCALE( I )
243                IF( K.EQ.I )
244      $            GO TO 40
245                CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
246    40       CONTINUE
247          END IF
248 *
249          IF( LEFTV ) THEN
250             DO 50 II = 1, N
251                I = II
252                IF( I.GE.ILO .AND. I.LE.IHI )
253      $            GO TO 50
254                IF( I.LT.ILO )
255      $            I = ILO - II
256                K = SCALE( I )
257                IF( K.EQ.I )
258      $            GO TO 50
259                CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
260    50       CONTINUE
261          END IF
262       END IF
263 *
264       RETURN
265 *
266 *     End of DGEBAK
267 *
268       END