LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
slatb9.f
Go to the documentation of this file.
1 *> \brief \b SLATB9
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA,
12 * KLB, KUB, ANORM, BNORM, MODEA, MODEB,
13 * CNDNMA, CNDNMB, DISTA, DISTB )
14 *
15 * .. Scalar Arguments ..
16 * CHARACTER DISTA, DISTB, TYPE
17 * CHARACTER*3 PATH
18 * INTEGER IMAT, KLA, KUA, KLB, KUB, M, P, MODEA, MODEB, N
19 * REAL ANORM, BNORM, CNDNMA, CNDNMB
20 * ..
21 *
22 *
23 *> \par Purpose:
24 * =============
25 *>
26 *> \verbatim
27 *>
28 *> SLATB9 sets parameters for the matrix generator based on the type of
29 *> matrix to be generated.
30 *> \endverbatim
31 *
32 * Arguments:
33 * ==========
34 *
35 *> \param[in] PATH
36 *> \verbatim
37 *> PATH is CHARACTER*3
38 *> The LAPACK path name.
39 *> \endverbatim
40 *>
41 *> \param[in] IMAT
42 *> \verbatim
43 *> IMAT is INTEGER
44 *> An integer key describing which matrix to generate for this
45 *> path.
46 *> = 1: A: diagonal, B: upper triangular
47 *> = 2: A: upper triangular, B: upper triangular
48 *> = 3: A: lower triangular, B: upper triangular
49 *> Else: A: general dense, B: general dense
50 *> \endverbatim
51 *>
52 *> \param[in] M
53 *> \verbatim
54 *> M is INTEGER
55 *> The number of rows in the matrix to be generated.
56 *> \endverbatim
57 *>
58 *> \param[in] P
59 *> \verbatim
60 *> P is INTEGER
61 *> \endverbatim
62 *>
63 *> \param[in] N
64 *> \verbatim
65 *> N is INTEGER
66 *> The number of columns in the matrix to be generated.
67 *> \endverbatim
68 *>
69 *> \param[out] TYPE
70 *> \verbatim
71 *> TYPE is CHARACTER*1
72 *> The type of the matrix to be generated:
73 *> = 'S': symmetric matrix;
74 *> = 'P': symmetric positive (semi)definite matrix;
75 *> = 'N': nonsymmetric matrix.
76 *> \endverbatim
77 *>
78 *> \param[out] KLA
79 *> \verbatim
80 *> KLA is INTEGER
81 *> The lower band width of the matrix to be generated.
82 *> \endverbatim
83 *>
84 *> \param[out] KUA
85 *> \verbatim
86 *> KUA is INTEGER
87 *> The upper band width of the matrix to be generated.
88 *> \endverbatim
89 *>
90 *> \param[out] KLB
91 *> \verbatim
92 *> KLB is INTEGER
93 *> The lower band width of the matrix to be generated.
94 *> \endverbatim
95 *>
96 *> \param[out] KUB
97 *> \verbatim
98 *> KUA is INTEGER
99 *> The upper band width of the matrix to be generated.
100 *> \endverbatim
101 *>
102 *> \param[out] ANORM
103 *> \verbatim
104 *> ANORM is REAL
105 *> The desired norm of the matrix to be generated. The diagonal
106 *> matrix of singular values or eigenvalues is scaled by this
107 *> value.
108 *> \endverbatim
109 *>
110 *> \param[out] BNORM
111 *> \verbatim
112 *> BNORM is REAL
113 *> The desired norm of the matrix to be generated. The diagonal
114 *> matrix of singular values or eigenvalues is scaled by this
115 *> value.
116 *> \endverbatim
117 *>
118 *> \param[out] MODEA
119 *> \verbatim
120 *> MODEA is INTEGER
121 *> A key indicating how to choose the vector of eigenvalues.
122 *> \endverbatim
123 *>
124 *> \param[out] MODEB
125 *> \verbatim
126 *> MODEB is INTEGER
127 *> A key indicating how to choose the vector of eigenvalues.
128 *> \endverbatim
129 *>
130 *> \param[out] CNDNMA
131 *> \verbatim
132 *> CNDNMA is REAL
133 *> The desired condition number.
134 *> \endverbatim
135 *>
136 *> \param[out] CNDNMB
137 *> \verbatim
138 *> CNDNMB is REAL
139 *> The desired condition number.
140 *> \endverbatim
141 *>
142 *> \param[out] DISTA
143 *> \verbatim
144 *> DISTA is CHARACTER*1
145 *> The type of distribution to be used by the random number
146 *> generator.
147 *> \endverbatim
148 *>
149 *> \param[out] DISTB
150 *> \verbatim
151 *> DISTB is CHARACTER*1
152 *> The type of distribution to be used by the random number
153 *> generator.
154 *> \endverbatim
155 *
156 * Authors:
157 * ========
158 *
159 *> \author Univ. of Tennessee
160 *> \author Univ. of California Berkeley
161 *> \author Univ. of Colorado Denver
162 *> \author NAG Ltd.
163 *
164 *> \date November 2011
165 *
166 *> \ingroup single_eig
167 *
168 * =====================================================================
169  SUBROUTINE slatb9( PATH, IMAT, M, P, N, TYPE, KLA, KUA,
170  $ klb, kub, anorm, bnorm, modea, modeb,
171  $ cndnma, cndnmb, dista, distb )
172 *
173 * -- LAPACK test routine (version 3.4.0) --
174 * -- LAPACK is a software package provided by Univ. of Tennessee, --
175 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
176 * November 2011
177 *
178 * .. Scalar Arguments ..
179  CHARACTER dista, distb, type
180  CHARACTER*3 path
181  INTEGER imat, kla, kua, klb, kub, m, p, modea, modeb, n
182  REAL anorm, bnorm, cndnma, cndnmb
183 * ..
184 *
185 * =====================================================================
186 *
187 * .. Parameters ..
188  REAL shrink, tenth
189  parameter( shrink = 0.25e0, tenth = 0.1e+0 )
190  REAL one, ten
191  parameter( one = 1.0e+0, ten = 1.0e+1 )
192 * ..
193 * .. Local Scalars ..
194  LOGICAL first
195  REAL badc1, badc2, eps, large, small
196 * ..
197 * .. External Functions ..
198  LOGICAL lsamen
199  REAL slamch
200  EXTERNAL lsamen, slamch
201 * ..
202 * .. Intrinsic Functions ..
203  INTRINSIC max, sqrt
204 * ..
205 * .. External Subroutines ..
206  EXTERNAL slabad
207 * ..
208 * .. Save statement ..
209  SAVE eps, small, large, badc1, badc2, first
210 * ..
211 * .. Data statements ..
212  DATA first / .true. /
213 * ..
214 * .. Executable Statements ..
215 *
216 * Set some constants for use in the subroutine.
217 *
218  IF( first ) THEN
219  first = .false.
220  eps = slamch( 'Precision' )
221  badc2 = tenth / eps
222  badc1 = sqrt( badc2 )
223  small = slamch( 'Safe minimum' )
224  large = one / small
225 *
226 * If it looks like we're on a Cray, take the square root of
227 * SMALL and LARGE to avoid overflow and underflow problems.
228 *
229  CALL slabad( small, large )
230  small = shrink*( small / eps )
231  large = one / small
232  END IF
233 *
234 * Set some parameters we don't plan to change.
235 *
236  TYPE = 'N'
237  dista = 'S'
238  distb = 'S'
239  modea = 3
240  modeb = 4
241 *
242 * Set the lower and upper bandwidths.
243 *
244  IF( lsamen( 3, path, 'GRQ') .OR. lsamen( 3, path, 'LSE') .OR.
245  $ lsamen( 3, path, 'GSV') )THEN
246 *
247 * A: M by N, B: P by N
248 *
249  IF( imat.EQ.1 ) THEN
250 *
251 * A: diagonal, B: upper triangular
252 *
253  kla = 0
254  kua = 0
255  klb = 0
256  kub = max( n-1,0 )
257 *
258  ELSE IF( imat.EQ.2 ) THEN
259 *
260 * A: upper triangular, B: upper triangular
261 *
262  kla = 0
263  kua = max( n-1, 0 )
264  klb = 0
265  kub = max( n-1, 0 )
266 *
267  ELSE IF( imat.EQ.3 ) THEN
268 *
269 * A: lower triangular, B: upper triangular
270 *
271  kla = max( m-1, 0 )
272  kua = 0
273  klb = 0
274  kub = max( n-1, 0 )
275 *
276  ELSE
277 *
278 * A: general dense, B: general dense
279 *
280  kla = max( m-1, 0 )
281  kua = max( n-1, 0 )
282  klb = max( p-1, 0 )
283  kub = max( n-1, 0 )
284 *
285  END IF
286 *
287  ELSE IF( lsamen( 3, path, 'GQR' ) .OR.
288  $ lsamen( 3, path, 'GLM') )THEN
289 *
290 * A: N by M, B: N by P
291 *
292  IF( imat.EQ.1 ) THEN
293 *
294 * A: diagonal, B: lower triangular
295 *
296  kla = 0
297  kua = 0
298  klb = max( n-1,0 )
299  kub = 0
300  ELSE IF( imat.EQ.2 ) THEN
301 *
302 * A: lower triangular, B: diagonal
303 *
304  kla = max( n-1, 0 )
305  kua = 0
306  klb = 0
307  kub = 0
308 *
309  ELSE IF( imat.EQ.3 ) THEN
310 *
311 * A: lower triangular, B: upper triangular
312 *
313  kla = max( n-1, 0 )
314  kua = 0
315  klb = 0
316  kub = max( p-1, 0 )
317 *
318  ELSE
319 *
320 * A: general dense, B: general dense
321 *
322  kla = max( n-1, 0 )
323  kua = max( m-1, 0 )
324  klb = max( n-1, 0 )
325  kub = max( p-1, 0 )
326  END IF
327 *
328  END IF
329 *
330 * Set the condition number and norm.
331 *
332  cndnma = ten*ten
333  cndnmb = ten
334  IF( lsamen( 3, path, 'GQR') .OR. lsamen( 3, path, 'GRQ') .OR.
335  $ lsamen( 3, path, 'GSV') )THEN
336  IF( imat.EQ.5 ) THEN
337  cndnma = badc1
338  cndnmb = badc1
339  ELSE IF( imat.EQ.6 ) THEN
340  cndnma = badc2
341  cndnmb = badc2
342  ELSE IF( imat.EQ.7 ) THEN
343  cndnma = badc1
344  cndnmb = badc2
345  ELSE IF( imat.EQ.8 ) THEN
346  cndnma = badc2
347  cndnmb = badc1
348  END IF
349  END IF
350 *
351  anorm = ten
352  bnorm = ten*ten*ten
353  IF( lsamen( 3, path, 'GQR') .OR. lsamen( 3, path, 'GRQ') )THEN
354  IF( imat.EQ.7 ) THEN
355  anorm = small
356  bnorm = large
357  ELSE IF( imat.EQ.8 ) THEN
358  anorm = large
359  bnorm = small
360  END IF
361  END IF
362 *
363  IF( n.LE.1 )THEN
364  cndnma = one
365  cndnmb = one
366  END IF
367 *
368  return
369 *
370 * End of SLATB9
371 *
372  END