Annotation of rpl/lapack/lapack/dlaqgb.f, revision 1.7
1.1 bertrand 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
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlaqgb.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack