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