1 SUBROUTINE ZLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
2 $ AMAX, EQUED )
3 *
4 * -- LAPACK auxiliary 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 EQUED
11 INTEGER KL, KU, LDAB, M, N
12 DOUBLE PRECISION AMAX, COLCND, ROWCND
13 * ..
14 * .. Array Arguments ..
15 DOUBLE PRECISION C( * ), R( * )
16 COMPLEX*16 AB( LDAB, * )
17 * ..
18 *
19 * Purpose
20 * =======
21 *
22 * ZLAQGB equilibrates a general M by N band matrix A with KL
23 * subdiagonals and KU superdiagonals using the row and scaling factors
24 * in the vectors R and C.
25 *
26 * Arguments
27 * =========
28 *
29 * M (input) INTEGER
30 * The number of rows of the matrix A. M >= 0.
31 *
32 * N (input) INTEGER
33 * The number of columns of the matrix A. N >= 0.
34 *
35 * KL (input) INTEGER
36 * The number of subdiagonals within the band of A. KL >= 0.
37 *
38 * KU (input) INTEGER
39 * The number of superdiagonals within the band of A. KU >= 0.
40 *
41 * AB (input/output) COMPLEX*16 array, dimension (LDAB,N)
42 * On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
43 * The j-th column of A is stored in the j-th column of the
44 * array AB as follows:
45 * AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
46 *
47 * On exit, the equilibrated matrix, in the same storage format
48 * as A. See EQUED for the form of the equilibrated matrix.
49 *
50 * LDAB (input) INTEGER
51 * The leading dimension of the array AB. LDA >= KL+KU+1.
52 *
53 * R (input) DOUBLE PRECISION array, dimension (M)
54 * The row scale factors for A.
55 *
56 * C (input) DOUBLE PRECISION array, dimension (N)
57 * The column scale factors for A.
58 *
59 * ROWCND (input) DOUBLE PRECISION
60 * Ratio of the smallest R(i) to the largest R(i).
61 *
62 * COLCND (input) DOUBLE PRECISION
63 * Ratio of the smallest C(i) to the largest C(i).
64 *
65 * AMAX (input) DOUBLE PRECISION
66 * Absolute value of largest matrix entry.
67 *
68 * EQUED (output) CHARACTER*1
69 * Specifies the form of equilibration that was done.
70 * = 'N': No equilibration
71 * = 'R': Row equilibration, i.e., A has been premultiplied by
72 * diag(R).
73 * = 'C': Column equilibration, i.e., A has been postmultiplied
74 * by diag(C).
75 * = 'B': Both row and column equilibration, i.e., A has been
76 * replaced by diag(R) * A * diag(C).
77 *
78 * Internal Parameters
79 * ===================
80 *
81 * THRESH is a threshold value used to decide if row or column scaling
82 * should be done based on the ratio of the row or column scaling
83 * factors. If ROWCND < THRESH, row scaling is done, and if
84 * COLCND < THRESH, column scaling is done.
85 *
86 * LARGE and SMALL are threshold values used to decide if row scaling
87 * should be done based on the absolute size of the largest matrix
88 * element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
89 *
90 * =====================================================================
91 *
92 * .. Parameters ..
93 DOUBLE PRECISION ONE, THRESH
94 PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 )
95 * ..
96 * .. Local Scalars ..
97 INTEGER I, J
98 DOUBLE PRECISION CJ, LARGE, SMALL
99 * ..
100 * .. External Functions ..
101 DOUBLE PRECISION DLAMCH
102 EXTERNAL DLAMCH
103 * ..
104 * .. Intrinsic Functions ..
105 INTRINSIC MAX, MIN
106 * ..
107 * .. Executable Statements ..
108 *
109 * Quick return if possible
110 *
111 IF( M.LE.0 .OR. N.LE.0 ) THEN
112 EQUED = 'N'
113 RETURN
114 END IF
115 *
116 * Initialize LARGE and SMALL.
117 *
118 SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
119 LARGE = ONE / SMALL
120 *
121 IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
122 $ THEN
123 *
124 * No row scaling
125 *
126 IF( COLCND.GE.THRESH ) THEN
127 *
128 * No column scaling
129 *
130 EQUED = 'N'
131 ELSE
132 *
133 * Column scaling
134 *
135 DO 20 J = 1, N
136 CJ = C( J )
137 DO 10 I = MAX( 1, J-KU ), MIN( M, J+KL )
138 AB( KU+1+I-J, J ) = CJ*AB( KU+1+I-J, J )
139 10 CONTINUE
140 20 CONTINUE
141 EQUED = 'C'
142 END IF
143 ELSE IF( COLCND.GE.THRESH ) THEN
144 *
145 * Row scaling, no column scaling
146 *
147 DO 40 J = 1, N
148 DO 30 I = MAX( 1, J-KU ), MIN( M, J+KL )
149 AB( KU+1+I-J, J ) = R( I )*AB( KU+1+I-J, J )
150 30 CONTINUE
151 40 CONTINUE
152 EQUED = 'R'
153 ELSE
154 *
155 * Row and column scaling
156 *
157 DO 60 J = 1, N
158 CJ = C( J )
159 DO 50 I = MAX( 1, J-KU ), MIN( M, J+KL )
160 AB( KU+1+I-J, J ) = CJ*R( I )*AB( KU+1+I-J, J )
161 50 CONTINUE
162 60 CONTINUE
163 EQUED = 'B'
164 END IF
165 *
166 RETURN
167 *
168 * End of ZLAQGB
169 *
170 END
2 $ AMAX, EQUED )
3 *
4 * -- LAPACK auxiliary 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 EQUED
11 INTEGER KL, KU, LDAB, M, N
12 DOUBLE PRECISION AMAX, COLCND, ROWCND
13 * ..
14 * .. Array Arguments ..
15 DOUBLE PRECISION C( * ), R( * )
16 COMPLEX*16 AB( LDAB, * )
17 * ..
18 *
19 * Purpose
20 * =======
21 *
22 * ZLAQGB equilibrates a general M by N band matrix A with KL
23 * subdiagonals and KU superdiagonals using the row and scaling factors
24 * in the vectors R and C.
25 *
26 * Arguments
27 * =========
28 *
29 * M (input) INTEGER
30 * The number of rows of the matrix A. M >= 0.
31 *
32 * N (input) INTEGER
33 * The number of columns of the matrix A. N >= 0.
34 *
35 * KL (input) INTEGER
36 * The number of subdiagonals within the band of A. KL >= 0.
37 *
38 * KU (input) INTEGER
39 * The number of superdiagonals within the band of A. KU >= 0.
40 *
41 * AB (input/output) COMPLEX*16 array, dimension (LDAB,N)
42 * On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
43 * The j-th column of A is stored in the j-th column of the
44 * array AB as follows:
45 * AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
46 *
47 * On exit, the equilibrated matrix, in the same storage format
48 * as A. See EQUED for the form of the equilibrated matrix.
49 *
50 * LDAB (input) INTEGER
51 * The leading dimension of the array AB. LDA >= KL+KU+1.
52 *
53 * R (input) DOUBLE PRECISION array, dimension (M)
54 * The row scale factors for A.
55 *
56 * C (input) DOUBLE PRECISION array, dimension (N)
57 * The column scale factors for A.
58 *
59 * ROWCND (input) DOUBLE PRECISION
60 * Ratio of the smallest R(i) to the largest R(i).
61 *
62 * COLCND (input) DOUBLE PRECISION
63 * Ratio of the smallest C(i) to the largest C(i).
64 *
65 * AMAX (input) DOUBLE PRECISION
66 * Absolute value of largest matrix entry.
67 *
68 * EQUED (output) CHARACTER*1
69 * Specifies the form of equilibration that was done.
70 * = 'N': No equilibration
71 * = 'R': Row equilibration, i.e., A has been premultiplied by
72 * diag(R).
73 * = 'C': Column equilibration, i.e., A has been postmultiplied
74 * by diag(C).
75 * = 'B': Both row and column equilibration, i.e., A has been
76 * replaced by diag(R) * A * diag(C).
77 *
78 * Internal Parameters
79 * ===================
80 *
81 * THRESH is a threshold value used to decide if row or column scaling
82 * should be done based on the ratio of the row or column scaling
83 * factors. If ROWCND < THRESH, row scaling is done, and if
84 * COLCND < THRESH, column scaling is done.
85 *
86 * LARGE and SMALL are threshold values used to decide if row scaling
87 * should be done based on the absolute size of the largest matrix
88 * element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
89 *
90 * =====================================================================
91 *
92 * .. Parameters ..
93 DOUBLE PRECISION ONE, THRESH
94 PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 )
95 * ..
96 * .. Local Scalars ..
97 INTEGER I, J
98 DOUBLE PRECISION CJ, LARGE, SMALL
99 * ..
100 * .. External Functions ..
101 DOUBLE PRECISION DLAMCH
102 EXTERNAL DLAMCH
103 * ..
104 * .. Intrinsic Functions ..
105 INTRINSIC MAX, MIN
106 * ..
107 * .. Executable Statements ..
108 *
109 * Quick return if possible
110 *
111 IF( M.LE.0 .OR. N.LE.0 ) THEN
112 EQUED = 'N'
113 RETURN
114 END IF
115 *
116 * Initialize LARGE and SMALL.
117 *
118 SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
119 LARGE = ONE / SMALL
120 *
121 IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
122 $ THEN
123 *
124 * No row scaling
125 *
126 IF( COLCND.GE.THRESH ) THEN
127 *
128 * No column scaling
129 *
130 EQUED = 'N'
131 ELSE
132 *
133 * Column scaling
134 *
135 DO 20 J = 1, N
136 CJ = C( J )
137 DO 10 I = MAX( 1, J-KU ), MIN( M, J+KL )
138 AB( KU+1+I-J, J ) = CJ*AB( KU+1+I-J, J )
139 10 CONTINUE
140 20 CONTINUE
141 EQUED = 'C'
142 END IF
143 ELSE IF( COLCND.GE.THRESH ) THEN
144 *
145 * Row scaling, no column scaling
146 *
147 DO 40 J = 1, N
148 DO 30 I = MAX( 1, J-KU ), MIN( M, J+KL )
149 AB( KU+1+I-J, J ) = R( I )*AB( KU+1+I-J, J )
150 30 CONTINUE
151 40 CONTINUE
152 EQUED = 'R'
153 ELSE
154 *
155 * Row and column scaling
156 *
157 DO 60 J = 1, N
158 CJ = C( J )
159 DO 50 I = MAX( 1, J-KU ), MIN( M, J+KL )
160 AB( KU+1+I-J, J ) = CJ*R( I )*AB( KU+1+I-J, J )
161 50 CONTINUE
162 60 CONTINUE
163 EQUED = 'B'
164 END IF
165 *
166 RETURN
167 *
168 * End of ZLAQGB
169 *
170 END