KTH framework for Nek5000 toolboxes; testing version  0.0.1
dgebak.f
Go to the documentation of this file.
1  SUBROUTINE dgebak( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
2  $ INFO )
3 *
4 * -- LAPACK routine (version 3.0) --
5 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
6 * Courant Institute, Argonne National Lab, and Rice University
7 * September 30, 1994
8 *
9 * .. Scalar Arguments ..
10  CHARACTER JOB, SIDE
11  INTEGER IHI, ILO, INFO, LDV, M, N
12 * ..
13 * .. Array Arguments ..
14  DOUBLE PRECISION SCALE( * ), V( LDV, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * DGEBAK forms the right or left eigenvectors of a real general matrix
21 * by backward transformation on the computed eigenvectors of the
22 * balanced matrix output by DGEBAL.
23 *
24 * Arguments
25 * =========
26 *
27 * JOB (input) CHARACTER*1
28 * Specifies the type of backward transformation required:
29 * = 'N', do nothing, return immediately;
30 * = 'P', do backward transformation for permutation only;
31 * = 'S', do backward transformation for scaling only;
32 * = 'B', do backward transformations for both permutation and
33 * scaling.
34 * JOB must be the same as the argument JOB supplied to DGEBAL.
35 *
36 * SIDE (input) CHARACTER*1
37 * = 'R': V contains right eigenvectors;
38 * = 'L': V contains left eigenvectors.
39 *
40 * N (input) INTEGER
41 * The number of rows of the matrix V. N >= 0.
42 *
43 * ILO (input) INTEGER
44 * IHI (input) INTEGER
45 * The integers ILO and IHI determined by DGEBAL.
46 * 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
47 *
48 * SCALE (input) DOUBLE PRECISION array, dimension (N)
49 * Details of the permutation and scaling factors, as returned
50 * by DGEBAL.
51 *
52 * M (input) INTEGER
53 * The number of columns of the matrix V. M >= 0.
54 *
55 * V (input/output) DOUBLE PRECISION array, dimension (LDV,M)
56 * On entry, the matrix of right or left eigenvectors to be
57 * transformed, as returned by DHSEIN or DTREVC.
58 * On exit, V is overwritten by the transformed eigenvectors.
59 *
60 * LDV (input) INTEGER
61 * The leading dimension of the array V. LDV >= max(1,N).
62 *
63 * INFO (output) INTEGER
64 * = 0: successful exit
65 * < 0: if INFO = -i, the i-th argument had an illegal value.
66 *
67 * =====================================================================
68 *
69 * .. Parameters ..
70  DOUBLE PRECISION ONE
71  parameter( one = 1.0d+0 )
72 * ..
73 * .. Local Scalars ..
74  LOGICAL LEFTV, RIGHTV
75  INTEGER I, II, K
76  DOUBLE PRECISION S
77 * ..
78 * .. External Functions ..
79  LOGICAL LSAME
80  EXTERNAL lsame
81 * ..
82 * .. External Subroutines ..
83  EXTERNAL dscal, dswap, xerbla
84 * ..
85 * .. Intrinsic Functions ..
86  INTRINSIC max, min
87 * ..
88 * .. Executable Statements ..
89 *
90 * Decode and Test the input parameters
91 *
92  rightv = lsame( side, 'R' )
93  leftv = lsame( side, 'L' )
94 *
95  info = 0
96  IF( .NOT.lsame( job, 'N' ) .AND. .NOT.lsame( job, 'P' ) .AND.
97  $ .NOT.lsame( job, 'S' ) .AND. .NOT.lsame( job, 'B' ) ) THEN
98  info = -1
99  ELSE IF( .NOT.rightv .AND. .NOT.leftv ) THEN
100  info = -2
101  ELSE IF( n.LT.0 ) THEN
102  info = -3
103  ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) ) THEN
104  info = -4
105  ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n ) THEN
106  info = -5
107  ELSE IF( m.LT.0 ) THEN
108  info = -7
109  ELSE IF( ldv.LT.max( 1, n ) ) THEN
110  info = -9
111  END IF
112  IF( info.NE.0 ) THEN
113  CALL xerbla( 'DGEBAK', -info )
114  RETURN
115  END IF
116 *
117 * Quick return if possible
118 *
119  IF( n.EQ.0 )
120  $ RETURN
121  IF( m.EQ.0 )
122  $ RETURN
123  IF( lsame( job, 'N' ) )
124  $ RETURN
125 *
126  IF( ilo.EQ.ihi )
127  $ GO TO 30
128 *
129 * Backward balance
130 *
131  IF( lsame( job, 'S' ) .OR. lsame( job, 'B' ) ) THEN
132 *
133  IF( rightv ) THEN
134  DO 10 i = ilo, ihi
135  s = scale( i )
136  CALL dscal( m, s, v( i, 1 ), ldv )
137  10 CONTINUE
138  END IF
139 *
140  IF( leftv ) THEN
141  DO 20 i = ilo, ihi
142  s = one / scale( i )
143  CALL dscal( m, s, v( i, 1 ), ldv )
144  20 CONTINUE
145  END IF
146 *
147  END IF
148 *
149 * Backward permutation
150 *
151 * For I = ILO-1 step -1 until 1,
152 * IHI+1 step 1 until N do --
153 *
154  30 CONTINUE
155  IF( lsame( job, 'P' ) .OR. lsame( job, 'B' ) ) THEN
156  IF( rightv ) THEN
157  DO 40 ii = 1, n
158  i = ii
159  IF( i.GE.ilo .AND. i.LE.ihi )
160  $ GO TO 40
161  IF( i.LT.ilo )
162  $ i = ilo - ii
163  k = scale( i )
164  IF( k.EQ.i )
165  $ GO TO 40
166  CALL dswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
167  40 CONTINUE
168  END IF
169 *
170  IF( leftv ) THEN
171  DO 50 ii = 1, n
172  i = ii
173  IF( i.GE.ilo .AND. i.LE.ihi )
174  $ GO TO 50
175  IF( i.LT.ilo )
176  $ i = ilo - ii
177  k = scale( i )
178  IF( k.EQ.i )
179  $ GO TO 50
180  CALL dswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
181  50 CONTINUE
182  END IF
183  END IF
184 *
185  RETURN
186 *
187 * End of DGEBAK
188 *
189  END
subroutine dgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
Definition: dgebak.f:3
subroutine dscal(n, da, dx, incx)
Definition: dscal.f:2
subroutine dswap(n, dx, incx, dy, incy)
Definition: dswap.f:2
subroutine xerbla(SRNAME, INFO)
Definition: xerbla.f:2