1: SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
2: $ INFO )
3: *
4: * -- LAPACK routine (version 3.2) --
5: * -- LAPACK is a software package provided by Univ. of Tennessee, --
6: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7: * November 2006
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
CVSweb interface <joel.bertrand@systella.fr>