LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
dlatmr.f
Go to the documentation of this file.
1 *> \brief \b DLATMR
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 DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
12 * RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
13 * CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
14 * PACK, A, LDA, IWORK, INFO )
15 *
16 * .. Scalar Arguments ..
17 * CHARACTER DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
18 * INTEGER INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
19 * DOUBLE PRECISION ANORM, COND, CONDL, CONDR, DMAX, SPARSE
20 * ..
21 * .. Array Arguments ..
22 * INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
23 * DOUBLE PRECISION A( LDA, * ), D( * ), DL( * ), DR( * )
24 * ..
25 *
26 *
27 *> \par Purpose:
28 * =============
29 *>
30 *> \verbatim
31 *>
32 *> DLATMR generates random matrices of various types for testing
33 *> LAPACK programs.
34 *>
35 *> DLATMR operates by applying the following sequence of
36 *> operations:
37 *>
38 *> Generate a matrix A with random entries of distribution DIST
39 *> which is symmetric if SYM='S', and nonsymmetric
40 *> if SYM='N'.
41 *>
42 *> Set the diagonal to D, where D may be input or
43 *> computed according to MODE, COND, DMAX and RSIGN
44 *> as described below.
45 *>
46 *> Grade the matrix, if desired, from the left and/or right
47 *> as specified by GRADE. The inputs DL, MODEL, CONDL, DR,
48 *> MODER and CONDR also determine the grading as described
49 *> below.
50 *>
51 *> Permute, if desired, the rows and/or columns as specified by
52 *> PIVTNG and IPIVOT.
53 *>
54 *> Set random entries to zero, if desired, to get a random sparse
55 *> matrix as specified by SPARSE.
56 *>
57 *> Make A a band matrix, if desired, by zeroing out the matrix
58 *> outside a band of lower bandwidth KL and upper bandwidth KU.
59 *>
60 *> Scale A, if desired, to have maximum entry ANORM.
61 *>
62 *> Pack the matrix if desired. Options specified by PACK are:
63 *> no packing
64 *> zero out upper half (if symmetric)
65 *> zero out lower half (if symmetric)
66 *> store the upper half columnwise (if symmetric or
67 *> square upper triangular)
68 *> store the lower half columnwise (if symmetric or
69 *> square lower triangular)
70 *> same as upper half rowwise if symmetric
71 *> store the lower triangle in banded format (if symmetric)
72 *> store the upper triangle in banded format (if symmetric)
73 *> store the entire matrix in banded format
74 *>
75 *> Note: If two calls to DLATMR differ only in the PACK parameter,
76 *> they will generate mathematically equivalent matrices.
77 *>
78 *> If two calls to DLATMR both have full bandwidth (KL = M-1
79 *> and KU = N-1), and differ only in the PIVTNG and PACK
80 *> parameters, then the matrices generated will differ only
81 *> in the order of the rows and/or columns, and otherwise
82 *> contain the same data. This consistency cannot be and
83 *> is not maintained with less than full bandwidth.
84 *> \endverbatim
85 *
86 * Arguments:
87 * ==========
88 *
89 *> \param[in] M
90 *> \verbatim
91 *> M is INTEGER
92 *> Number of rows of A. Not modified.
93 *> \endverbatim
94 *>
95 *> \param[in] N
96 *> \verbatim
97 *> N is INTEGER
98 *> Number of columns of A. Not modified.
99 *> \endverbatim
100 *>
101 *> \param[in] DIST
102 *> \verbatim
103 *> DIST is CHARACTER*1
104 *> On entry, DIST specifies the type of distribution to be used
105 *> to generate a random matrix .
106 *> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform )
107 *> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric )
108 *> 'N' => NORMAL( 0, 1 ) ( 'N' for normal )
109 *> Not modified.
110 *> \endverbatim
111 *>
112 *> \param[in,out] ISEED
113 *> \verbatim
114 *> ISEED is INTEGER array, dimension (4)
115 *> On entry ISEED specifies the seed of the random number
116 *> generator. They should lie between 0 and 4095 inclusive,
117 *> and ISEED(4) should be odd. The random number generator
118 *> uses a linear congruential sequence limited to small
119 *> integers, and so should produce machine independent
120 *> random numbers. The values of ISEED are changed on
121 *> exit, and can be used in the next call to DLATMR
122 *> to continue the same random number sequence.
123 *> Changed on exit.
124 *> \endverbatim
125 *>
126 *> \param[in] SYM
127 *> \verbatim
128 *> SYM is CHARACTER*1
129 *> If SYM='S' or 'H', generated matrix is symmetric.
130 *> If SYM='N', generated matrix is nonsymmetric.
131 *> Not modified.
132 *> \endverbatim
133 *>
134 *> \param[in,out] D
135 *> \verbatim
136 *> D is DOUBLE PRECISION array, dimension (min(M,N))
137 *> On entry this array specifies the diagonal entries
138 *> of the diagonal of A. D may either be specified
139 *> on entry, or set according to MODE and COND as described
140 *> below. May be changed on exit if MODE is nonzero.
141 *> \endverbatim
142 *>
143 *> \param[in] MODE
144 *> \verbatim
145 *> MODE is INTEGER
146 *> On entry describes how D is to be used:
147 *> MODE = 0 means use D as input
148 *> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
149 *> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
150 *> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
151 *> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
152 *> MODE = 5 sets D to random numbers in the range
153 *> ( 1/COND , 1 ) such that their logarithms
154 *> are uniformly distributed.
155 *> MODE = 6 set D to random numbers from same distribution
156 *> as the rest of the matrix.
157 *> MODE < 0 has the same meaning as ABS(MODE), except that
158 *> the order of the elements of D is reversed.
159 *> Thus if MODE is positive, D has entries ranging from
160 *> 1 to 1/COND, if negative, from 1/COND to 1,
161 *> Not modified.
162 *> \endverbatim
163 *>
164 *> \param[in] COND
165 *> \verbatim
166 *> COND is DOUBLE PRECISION
167 *> On entry, used as described under MODE above.
168 *> If used, it must be >= 1. Not modified.
169 *> \endverbatim
170 *>
171 *> \param[in] DMAX
172 *> \verbatim
173 *> DMAX is DOUBLE PRECISION
174 *> If MODE neither -6, 0 nor 6, the diagonal is scaled by
175 *> DMAX / max(abs(D(i))), so that maximum absolute entry
176 *> of diagonal is abs(DMAX). If DMAX is negative (or zero),
177 *> diagonal will be scaled by a negative number (or zero).
178 *> \endverbatim
179 *>
180 *> \param[in] RSIGN
181 *> \verbatim
182 *> RSIGN is CHARACTER*1
183 *> If MODE neither -6, 0 nor 6, specifies sign of diagonal
184 *> as follows:
185 *> 'T' => diagonal entries are multiplied by 1 or -1
186 *> with probability .5
187 *> 'F' => diagonal unchanged
188 *> Not modified.
189 *> \endverbatim
190 *>
191 *> \param[in] GRADE
192 *> \verbatim
193 *> GRADE is CHARACTER*1
194 *> Specifies grading of matrix as follows:
195 *> 'N' => no grading
196 *> 'L' => matrix premultiplied by diag( DL )
197 *> (only if matrix nonsymmetric)
198 *> 'R' => matrix postmultiplied by diag( DR )
199 *> (only if matrix nonsymmetric)
200 *> 'B' => matrix premultiplied by diag( DL ) and
201 *> postmultiplied by diag( DR )
202 *> (only if matrix nonsymmetric)
203 *> 'S' or 'H' => matrix premultiplied by diag( DL ) and
204 *> postmultiplied by diag( DL )
205 *> ('S' for symmetric, or 'H' for Hermitian)
206 *> 'E' => matrix premultiplied by diag( DL ) and
207 *> postmultiplied by inv( diag( DL ) )
208 *> ( 'E' for eigenvalue invariance)
209 *> (only if matrix nonsymmetric)
210 *> Note: if GRADE='E', then M must equal N.
211 *> Not modified.
212 *> \endverbatim
213 *>
214 *> \param[in,out] DL
215 *> \verbatim
216 *> DL is DOUBLE PRECISION array, dimension (M)
217 *> If MODEL=0, then on entry this array specifies the diagonal
218 *> entries of a diagonal matrix used as described under GRADE
219 *> above. If MODEL is not zero, then DL will be set according
220 *> to MODEL and CONDL, analogous to the way D is set according
221 *> to MODE and COND (except there is no DMAX parameter for DL).
222 *> If GRADE='E', then DL cannot have zero entries.
223 *> Not referenced if GRADE = 'N' or 'R'. Changed on exit.
224 *> \endverbatim
225 *>
226 *> \param[in] MODEL
227 *> \verbatim
228 *> MODEL is INTEGER
229 *> This specifies how the diagonal array DL is to be computed,
230 *> just as MODE specifies how D is to be computed.
231 *> Not modified.
232 *> \endverbatim
233 *>
234 *> \param[in] CONDL
235 *> \verbatim
236 *> CONDL is DOUBLE PRECISION
237 *> When MODEL is not zero, this specifies the condition number
238 *> of the computed DL. Not modified.
239 *> \endverbatim
240 *>
241 *> \param[in,out] DR
242 *> \verbatim
243 *> DR is DOUBLE PRECISION array, dimension (N)
244 *> If MODER=0, then on entry this array specifies the diagonal
245 *> entries of a diagonal matrix used as described under GRADE
246 *> above. If MODER is not zero, then DR will be set according
247 *> to MODER and CONDR, analogous to the way D is set according
248 *> to MODE and COND (except there is no DMAX parameter for DR).
249 *> Not referenced if GRADE = 'N', 'L', 'H', 'S' or 'E'.
250 *> Changed on exit.
251 *> \endverbatim
252 *>
253 *> \param[in] MODER
254 *> \verbatim
255 *> MODER is INTEGER
256 *> This specifies how the diagonal array DR is to be computed,
257 *> just as MODE specifies how D is to be computed.
258 *> Not modified.
259 *> \endverbatim
260 *>
261 *> \param[in] CONDR
262 *> \verbatim
263 *> CONDR is DOUBLE PRECISION
264 *> When MODER is not zero, this specifies the condition number
265 *> of the computed DR. Not modified.
266 *> \endverbatim
267 *>
268 *> \param[in] PIVTNG
269 *> \verbatim
270 *> PIVTNG is CHARACTER*1
271 *> On entry specifies pivoting permutations as follows:
272 *> 'N' or ' ' => none.
273 *> 'L' => left or row pivoting (matrix must be nonsymmetric).
274 *> 'R' => right or column pivoting (matrix must be
275 *> nonsymmetric).
276 *> 'B' or 'F' => both or full pivoting, i.e., on both sides.
277 *> In this case, M must equal N
278 *>
279 *> If two calls to DLATMR both have full bandwidth (KL = M-1
280 *> and KU = N-1), and differ only in the PIVTNG and PACK
281 *> parameters, then the matrices generated will differ only
282 *> in the order of the rows and/or columns, and otherwise
283 *> contain the same data. This consistency cannot be
284 *> maintained with less than full bandwidth.
285 *> \endverbatim
286 *>
287 *> \param[in] IPIVOT
288 *> \verbatim
289 *> IPIVOT is INTEGER array, dimension (N or M)
290 *> This array specifies the permutation used. After the
291 *> basic matrix is generated, the rows, columns, or both
292 *> are permuted. If, say, row pivoting is selected, DLATMR
293 *> starts with the *last* row and interchanges the M-th and
294 *> IPIVOT(M)-th rows, then moves to the next-to-last row,
295 *> interchanging the (M-1)-th and the IPIVOT(M-1)-th rows,
296 *> and so on. In terms of "2-cycles", the permutation is
297 *> (1 IPIVOT(1)) (2 IPIVOT(2)) ... (M IPIVOT(M))
298 *> where the rightmost cycle is applied first. This is the
299 *> *inverse* of the effect of pivoting in LINPACK. The idea
300 *> is that factoring (with pivoting) an identity matrix
301 *> which has been inverse-pivoted in this way should
302 *> result in a pivot vector identical to IPIVOT.
303 *> Not referenced if PIVTNG = 'N'. Not modified.
304 *> \endverbatim
305 *>
306 *> \param[in] SPARSE
307 *> \verbatim
308 *> SPARSE is DOUBLE PRECISION
309 *> On entry specifies the sparsity of the matrix if a sparse
310 *> matrix is to be generated. SPARSE should lie between
311 *> 0 and 1. To generate a sparse matrix, for each matrix entry
312 *> a uniform ( 0, 1 ) random number x is generated and
313 *> compared to SPARSE; if x is larger the matrix entry
314 *> is unchanged and if x is smaller the entry is set
315 *> to zero. Thus on the average a fraction SPARSE of the
316 *> entries will be set to zero.
317 *> Not modified.
318 *> \endverbatim
319 *>
320 *> \param[in] KL
321 *> \verbatim
322 *> KL is INTEGER
323 *> On entry specifies the lower bandwidth of the matrix. For
324 *> example, KL=0 implies upper triangular, KL=1 implies upper
325 *> Hessenberg, and KL at least M-1 implies the matrix is not
326 *> banded. Must equal KU if matrix is symmetric.
327 *> Not modified.
328 *> \endverbatim
329 *>
330 *> \param[in] KU
331 *> \verbatim
332 *> KU is INTEGER
333 *> On entry specifies the upper bandwidth of the matrix. For
334 *> example, KU=0 implies lower triangular, KU=1 implies lower
335 *> Hessenberg, and KU at least N-1 implies the matrix is not
336 *> banded. Must equal KL if matrix is symmetric.
337 *> Not modified.
338 *> \endverbatim
339 *>
340 *> \param[in] ANORM
341 *> \verbatim
342 *> ANORM is DOUBLE PRECISION
343 *> On entry specifies maximum entry of output matrix
344 *> (output matrix will by multiplied by a constant so that
345 *> its largest absolute entry equal ANORM)
346 *> if ANORM is nonnegative. If ANORM is negative no scaling
347 *> is done. Not modified.
348 *> \endverbatim
349 *>
350 *> \param[in] PACK
351 *> \verbatim
352 *> PACK is CHARACTER*1
353 *> On entry specifies packing of matrix as follows:
354 *> 'N' => no packing
355 *> 'U' => zero out all subdiagonal entries (if symmetric)
356 *> 'L' => zero out all superdiagonal entries (if symmetric)
357 *> 'C' => store the upper triangle columnwise
358 *> (only if matrix symmetric or square upper triangular)
359 *> 'R' => store the lower triangle columnwise
360 *> (only if matrix symmetric or square lower triangular)
361 *> (same as upper half rowwise if symmetric)
362 *> 'B' => store the lower triangle in band storage scheme
363 *> (only if matrix symmetric)
364 *> 'Q' => store the upper triangle in band storage scheme
365 *> (only if matrix symmetric)
366 *> 'Z' => store the entire matrix in band storage scheme
367 *> (pivoting can be provided for by using this
368 *> option to store A in the trailing rows of
369 *> the allocated storage)
370 *>
371 *> Using these options, the various LAPACK packed and banded
372 *> storage schemes can be obtained:
373 *> GB - use 'Z'
374 *> PB, SB or TB - use 'B' or 'Q'
375 *> PP, SP or TP - use 'C' or 'R'
376 *>
377 *> If two calls to DLATMR differ only in the PACK parameter,
378 *> they will generate mathematically equivalent matrices.
379 *> Not modified.
380 *> \endverbatim
381 *>
382 *> \param[out] A
383 *> \verbatim
384 *> A is DOUBLE PRECISION array, dimension (LDA,N)
385 *> On exit A is the desired test matrix. Only those
386 *> entries of A which are significant on output
387 *> will be referenced (even if A is in packed or band
388 *> storage format). The 'unoccupied corners' of A in
389 *> band format will be zeroed out.
390 *> \endverbatim
391 *>
392 *> \param[in] LDA
393 *> \verbatim
394 *> LDA is INTEGER
395 *> on entry LDA specifies the first dimension of A as
396 *> declared in the calling program.
397 *> If PACK='N', 'U' or 'L', LDA must be at least max ( 1, M ).
398 *> If PACK='C' or 'R', LDA must be at least 1.
399 *> If PACK='B', or 'Q', LDA must be MIN ( KU+1, N )
400 *> If PACK='Z', LDA must be at least KUU+KLL+1, where
401 *> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, N-1 )
402 *> Not modified.
403 *> \endverbatim
404 *>
405 *> \param[out] IWORK
406 *> \verbatim
407 *> IWORK is INTEGER array, dimension ( N or M)
408 *> Workspace. Not referenced if PIVTNG = 'N'. Changed on exit.
409 *> \endverbatim
410 *>
411 *> \param[out] INFO
412 *> \verbatim
413 *> INFO is INTEGER
414 *> Error parameter on exit:
415 *> 0 => normal return
416 *> -1 => M negative or unequal to N and SYM='S' or 'H'
417 *> -2 => N negative
418 *> -3 => DIST illegal string
419 *> -5 => SYM illegal string
420 *> -7 => MODE not in range -6 to 6
421 *> -8 => COND less than 1.0, and MODE neither -6, 0 nor 6
422 *> -10 => MODE neither -6, 0 nor 6 and RSIGN illegal string
423 *> -11 => GRADE illegal string, or GRADE='E' and
424 *> M not equal to N, or GRADE='L', 'R', 'B' or 'E' and
425 *> SYM = 'S' or 'H'
426 *> -12 => GRADE = 'E' and DL contains zero
427 *> -13 => MODEL not in range -6 to 6 and GRADE= 'L', 'B', 'H',
428 *> 'S' or 'E'
429 *> -14 => CONDL less than 1.0, GRADE='L', 'B', 'H', 'S' or 'E',
430 *> and MODEL neither -6, 0 nor 6
431 *> -16 => MODER not in range -6 to 6 and GRADE= 'R' or 'B'
432 *> -17 => CONDR less than 1.0, GRADE='R' or 'B', and
433 *> MODER neither -6, 0 nor 6
434 *> -18 => PIVTNG illegal string, or PIVTNG='B' or 'F' and
435 *> M not equal to N, or PIVTNG='L' or 'R' and SYM='S'
436 *> or 'H'
437 *> -19 => IPIVOT contains out of range number and
438 *> PIVTNG not equal to 'N'
439 *> -20 => KL negative
440 *> -21 => KU negative, or SYM='S' or 'H' and KU not equal to KL
441 *> -22 => SPARSE not in range 0. to 1.
442 *> -24 => PACK illegal string, or PACK='U', 'L', 'B' or 'Q'
443 *> and SYM='N', or PACK='C' and SYM='N' and either KL
444 *> not equal to 0 or N not equal to M, or PACK='R' and
445 *> SYM='N', and either KU not equal to 0 or N not equal
446 *> to M
447 *> -26 => LDA too small
448 *> 1 => Error return from DLATM1 (computing D)
449 *> 2 => Cannot scale diagonal to DMAX (max. entry is 0)
450 *> 3 => Error return from DLATM1 (computing DL)
451 *> 4 => Error return from DLATM1 (computing DR)
452 *> 5 => ANORM is positive, but matrix constructed prior to
453 *> attempting to scale it to have norm ANORM, is zero
454 *> \endverbatim
455 *
456 * Authors:
457 * ========
458 *
459 *> \author Univ. of Tennessee
460 *> \author Univ. of California Berkeley
461 *> \author Univ. of Colorado Denver
462 *> \author NAG Ltd.
463 *
464 *> \date November 2011
465 *
466 *> \ingroup double_matgen
467 *
468 * =====================================================================
469  SUBROUTINE dlatmr( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
470  $ rsign, grade, dl, model, condl, dr, moder,
471  $ condr, pivtng, ipivot, kl, ku, sparse, anorm,
472  $ pack, a, lda, iwork, info )
473 *
474 * -- LAPACK computational routine (version 3.4.0) --
475 * -- LAPACK is a software package provided by Univ. of Tennessee, --
476 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
477 * November 2011
478 *
479 * .. Scalar Arguments ..
480  CHARACTER dist, grade, pack, pivtng, rsign, sym
481  INTEGER info, kl, ku, lda, m, mode, model, moder, n
482  DOUBLE PRECISION anorm, cond, condl, condr, dmax, sparse
483 * ..
484 * .. Array Arguments ..
485  INTEGER ipivot( * ), iseed( 4 ), iwork( * )
486  DOUBLE PRECISION a( lda, * ), d( * ), dl( * ), dr( * )
487 * ..
488 *
489 * =====================================================================
490 *
491 * .. Parameters ..
492  DOUBLE PRECISION zero
493  parameter( zero = 0.0d0 )
494  DOUBLE PRECISION one
495  parameter( one = 1.0d0 )
496 * ..
497 * .. Local Scalars ..
498  LOGICAL badpvt, dzero, fulbnd
499  INTEGER i, idist, igrade, iisub, ipack, ipvtng, irsign,
500  $ isub, isym, j, jjsub, jsub, k, kll, kuu, mnmin,
501  $ mnsub, mxsub, npvts
502  DOUBLE PRECISION alpha, onorm, temp
503 * ..
504 * .. Local Arrays ..
505  DOUBLE PRECISION tempa( 1 )
506 * ..
507 * .. External Functions ..
508  LOGICAL lsame
509  DOUBLE PRECISION dlangb, dlange, dlansb, dlansp, dlansy, dlatm2,
510  $ dlatm3
511  EXTERNAL lsame, dlangb, dlange, dlansb, dlansp, dlansy,
512  $ dlatm2, dlatm3
513 * ..
514 * .. External Subroutines ..
515  EXTERNAL dlatm1, dscal, xerbla
516 * ..
517 * .. Intrinsic Functions ..
518  INTRINSIC abs, max, min, mod
519 * ..
520 * .. Executable Statements ..
521 *
522 * 1) Decode and Test the input parameters.
523 * Initialize flags & seed.
524 *
525  info = 0
526 *
527 * Quick return if possible
528 *
529  IF( m.EQ.0 .OR. n.EQ.0 )
530  $ return
531 *
532 * Decode DIST
533 *
534  IF( lsame( dist, 'U' ) ) THEN
535  idist = 1
536  ELSE IF( lsame( dist, 'S' ) ) THEN
537  idist = 2
538  ELSE IF( lsame( dist, 'N' ) ) THEN
539  idist = 3
540  ELSE
541  idist = -1
542  END IF
543 *
544 * Decode SYM
545 *
546  IF( lsame( sym, 'S' ) ) THEN
547  isym = 0
548  ELSE IF( lsame( sym, 'N' ) ) THEN
549  isym = 1
550  ELSE IF( lsame( sym, 'H' ) ) THEN
551  isym = 0
552  ELSE
553  isym = -1
554  END IF
555 *
556 * Decode RSIGN
557 *
558  IF( lsame( rsign, 'F' ) ) THEN
559  irsign = 0
560  ELSE IF( lsame( rsign, 'T' ) ) THEN
561  irsign = 1
562  ELSE
563  irsign = -1
564  END IF
565 *
566 * Decode PIVTNG
567 *
568  IF( lsame( pivtng, 'N' ) ) THEN
569  ipvtng = 0
570  ELSE IF( lsame( pivtng, ' ' ) ) THEN
571  ipvtng = 0
572  ELSE IF( lsame( pivtng, 'L' ) ) THEN
573  ipvtng = 1
574  npvts = m
575  ELSE IF( lsame( pivtng, 'R' ) ) THEN
576  ipvtng = 2
577  npvts = n
578  ELSE IF( lsame( pivtng, 'B' ) ) THEN
579  ipvtng = 3
580  npvts = min( n, m )
581  ELSE IF( lsame( pivtng, 'F' ) ) THEN
582  ipvtng = 3
583  npvts = min( n, m )
584  ELSE
585  ipvtng = -1
586  END IF
587 *
588 * Decode GRADE
589 *
590  IF( lsame( grade, 'N' ) ) THEN
591  igrade = 0
592  ELSE IF( lsame( grade, 'L' ) ) THEN
593  igrade = 1
594  ELSE IF( lsame( grade, 'R' ) ) THEN
595  igrade = 2
596  ELSE IF( lsame( grade, 'B' ) ) THEN
597  igrade = 3
598  ELSE IF( lsame( grade, 'E' ) ) THEN
599  igrade = 4
600  ELSE IF( lsame( grade, 'H' ) .OR. lsame( grade, 'S' ) ) THEN
601  igrade = 5
602  ELSE
603  igrade = -1
604  END IF
605 *
606 * Decode PACK
607 *
608  IF( lsame( pack, 'N' ) ) THEN
609  ipack = 0
610  ELSE IF( lsame( pack, 'U' ) ) THEN
611  ipack = 1
612  ELSE IF( lsame( pack, 'L' ) ) THEN
613  ipack = 2
614  ELSE IF( lsame( pack, 'C' ) ) THEN
615  ipack = 3
616  ELSE IF( lsame( pack, 'R' ) ) THEN
617  ipack = 4
618  ELSE IF( lsame( pack, 'B' ) ) THEN
619  ipack = 5
620  ELSE IF( lsame( pack, 'Q' ) ) THEN
621  ipack = 6
622  ELSE IF( lsame( pack, 'Z' ) ) THEN
623  ipack = 7
624  ELSE
625  ipack = -1
626  END IF
627 *
628 * Set certain internal parameters
629 *
630  mnmin = min( m, n )
631  kll = min( kl, m-1 )
632  kuu = min( ku, n-1 )
633 *
634 * If inv(DL) is used, check to see if DL has a zero entry.
635 *
636  dzero = .false.
637  IF( igrade.EQ.4 .AND. model.EQ.0 ) THEN
638  DO 10 i = 1, m
639  IF( dl( i ).EQ.zero )
640  $ dzero = .true.
641  10 continue
642  END IF
643 *
644 * Check values in IPIVOT
645 *
646  badpvt = .false.
647  IF( ipvtng.GT.0 ) THEN
648  DO 20 j = 1, npvts
649  IF( ipivot( j ).LE.0 .OR. ipivot( j ).GT.npvts )
650  $ badpvt = .true.
651  20 continue
652  END IF
653 *
654 * Set INFO if an error
655 *
656  IF( m.LT.0 ) THEN
657  info = -1
658  ELSE IF( m.NE.n .AND. isym.EQ.0 ) THEN
659  info = -1
660  ELSE IF( n.LT.0 ) THEN
661  info = -2
662  ELSE IF( idist.EQ.-1 ) THEN
663  info = -3
664  ELSE IF( isym.EQ.-1 ) THEN
665  info = -5
666  ELSE IF( mode.LT.-6 .OR. mode.GT.6 ) THEN
667  info = -7
668  ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
669  $ cond.LT.one ) THEN
670  info = -8
671  ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
672  $ irsign.EQ.-1 ) THEN
673  info = -10
674  ELSE IF( igrade.EQ.-1 .OR. ( igrade.EQ.4 .AND. m.NE.n ) .OR.
675  $ ( ( igrade.GE.1 .AND. igrade.LE.4 ) .AND. isym.EQ.0 ) )
676  $ THEN
677  info = -11
678  ELSE IF( igrade.EQ.4 .AND. dzero ) THEN
679  info = -12
680  ELSE IF( ( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR.
681  $ igrade.EQ.5 ) .AND. ( model.LT.-6 .OR. model.GT.6 ) )
682  $ THEN
683  info = -13
684  ELSE IF( ( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR.
685  $ igrade.EQ.5 ) .AND. ( model.NE.-6 .AND. model.NE.0 .AND.
686  $ model.NE.6 ) .AND. condl.LT.one ) THEN
687  info = -14
688  ELSE IF( ( igrade.EQ.2 .OR. igrade.EQ.3 ) .AND.
689  $ ( moder.LT.-6 .OR. moder.GT.6 ) ) THEN
690  info = -16
691  ELSE IF( ( igrade.EQ.2 .OR. igrade.EQ.3 ) .AND.
692  $ ( moder.NE.-6 .AND. moder.NE.0 .AND. moder.NE.6 ) .AND.
693  $ condr.LT.one ) THEN
694  info = -17
695  ELSE IF( ipvtng.EQ.-1 .OR. ( ipvtng.EQ.3 .AND. m.NE.n ) .OR.
696  $ ( ( ipvtng.EQ.1 .OR. ipvtng.EQ.2 ) .AND. isym.EQ.0 ) )
697  $ THEN
698  info = -18
699  ELSE IF( ipvtng.NE.0 .AND. badpvt ) THEN
700  info = -19
701  ELSE IF( kl.LT.0 ) THEN
702  info = -20
703  ELSE IF( ku.LT.0 .OR. ( isym.EQ.0 .AND. kl.NE.ku ) ) THEN
704  info = -21
705  ELSE IF( sparse.LT.zero .OR. sparse.GT.one ) THEN
706  info = -22
707  ELSE IF( ipack.EQ.-1 .OR. ( ( ipack.EQ.1 .OR. ipack.EQ.2 .OR.
708  $ ipack.EQ.5 .OR. ipack.EQ.6 ) .AND. isym.EQ.1 ) .OR.
709  $ ( ipack.EQ.3 .AND. isym.EQ.1 .AND. ( kl.NE.0 .OR. m.NE.
710  $ n ) ) .OR. ( ipack.EQ.4 .AND. isym.EQ.1 .AND. ( ku.NE.
711  $ 0 .OR. m.NE.n ) ) ) THEN
712  info = -24
713  ELSE IF( ( ( ipack.EQ.0 .OR. ipack.EQ.1 .OR. ipack.EQ.2 ) .AND.
714  $ lda.LT.max( 1, m ) ) .OR. ( ( ipack.EQ.3 .OR. ipack.EQ.
715  $ 4 ) .AND. lda.LT.1 ) .OR. ( ( ipack.EQ.5 .OR. ipack.EQ.
716  $ 6 ) .AND. lda.LT.kuu+1 ) .OR.
717  $ ( ipack.EQ.7 .AND. lda.LT.kll+kuu+1 ) ) THEN
718  info = -26
719  END IF
720 *
721  IF( info.NE.0 ) THEN
722  CALL xerbla( 'DLATMR', -info )
723  return
724  END IF
725 *
726 * Decide if we can pivot consistently
727 *
728  fulbnd = .false.
729  IF( kuu.EQ.n-1 .AND. kll.EQ.m-1 )
730  $ fulbnd = .true.
731 *
732 * Initialize random number generator
733 *
734  DO 30 i = 1, 4
735  iseed( i ) = mod( abs( iseed( i ) ), 4096 )
736  30 continue
737 *
738  iseed( 4 ) = 2*( iseed( 4 ) / 2 ) + 1
739 *
740 * 2) Set up D, DL, and DR, if indicated.
741 *
742 * Compute D according to COND and MODE
743 *
744  CALL dlatm1( mode, cond, irsign, idist, iseed, d, mnmin, info )
745  IF( info.NE.0 ) THEN
746  info = 1
747  return
748  END IF
749  IF( mode.NE.0 .AND. mode.NE.-6 .AND. mode.NE.6 ) THEN
750 *
751 * Scale by DMAX
752 *
753  temp = abs( d( 1 ) )
754  DO 40 i = 2, mnmin
755  temp = max( temp, abs( d( i ) ) )
756  40 continue
757  IF( temp.EQ.zero .AND. dmax.NE.zero ) THEN
758  info = 2
759  return
760  END IF
761  IF( temp.NE.zero ) THEN
762  alpha = dmax / temp
763  ELSE
764  alpha = one
765  END IF
766  DO 50 i = 1, mnmin
767  d( i ) = alpha*d( i )
768  50 continue
769 *
770  END IF
771 *
772 * Compute DL if grading set
773 *
774  IF( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR. igrade.EQ.
775  $ 5 ) THEN
776  CALL dlatm1( model, condl, 0, idist, iseed, dl, m, info )
777  IF( info.NE.0 ) THEN
778  info = 3
779  return
780  END IF
781  END IF
782 *
783 * Compute DR if grading set
784 *
785  IF( igrade.EQ.2 .OR. igrade.EQ.3 ) THEN
786  CALL dlatm1( moder, condr, 0, idist, iseed, dr, n, info )
787  IF( info.NE.0 ) THEN
788  info = 4
789  return
790  END IF
791  END IF
792 *
793 * 3) Generate IWORK if pivoting
794 *
795  IF( ipvtng.GT.0 ) THEN
796  DO 60 i = 1, npvts
797  iwork( i ) = i
798  60 continue
799  IF( fulbnd ) THEN
800  DO 70 i = 1, npvts
801  k = ipivot( i )
802  j = iwork( i )
803  iwork( i ) = iwork( k )
804  iwork( k ) = j
805  70 continue
806  ELSE
807  DO 80 i = npvts, 1, -1
808  k = ipivot( i )
809  j = iwork( i )
810  iwork( i ) = iwork( k )
811  iwork( k ) = j
812  80 continue
813  END IF
814  END IF
815 *
816 * 4) Generate matrices for each kind of PACKing
817 * Always sweep matrix columnwise (if symmetric, upper
818 * half only) so that matrix generated does not depend
819 * on PACK
820 *
821  IF( fulbnd ) THEN
822 *
823 * Use DLATM3 so matrices generated with differing PIVOTing only
824 * differ only in the order of their rows and/or columns.
825 *
826  IF( ipack.EQ.0 ) THEN
827  IF( isym.EQ.0 ) THEN
828  DO 100 j = 1, n
829  DO 90 i = 1, j
830  temp = dlatm3( m, n, i, j, isub, jsub, kl, ku,
831  $ idist, iseed, d, igrade, dl, dr, ipvtng,
832  $ iwork, sparse )
833  a( isub, jsub ) = temp
834  a( jsub, isub ) = temp
835  90 continue
836  100 continue
837  ELSE IF( isym.EQ.1 ) THEN
838  DO 120 j = 1, n
839  DO 110 i = 1, m
840  temp = dlatm3( m, n, i, j, isub, jsub, kl, ku,
841  $ idist, iseed, d, igrade, dl, dr, ipvtng,
842  $ iwork, sparse )
843  a( isub, jsub ) = temp
844  110 continue
845  120 continue
846  END IF
847 *
848  ELSE IF( ipack.EQ.1 ) THEN
849 *
850  DO 140 j = 1, n
851  DO 130 i = 1, j
852  temp = dlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
853  $ iseed, d, igrade, dl, dr, ipvtng, iwork,
854  $ sparse )
855  mnsub = min( isub, jsub )
856  mxsub = max( isub, jsub )
857  a( mnsub, mxsub ) = temp
858  IF( mnsub.NE.mxsub )
859  $ a( mxsub, mnsub ) = zero
860  130 continue
861  140 continue
862 *
863  ELSE IF( ipack.EQ.2 ) THEN
864 *
865  DO 160 j = 1, n
866  DO 150 i = 1, j
867  temp = dlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
868  $ iseed, d, igrade, dl, dr, ipvtng, iwork,
869  $ sparse )
870  mnsub = min( isub, jsub )
871  mxsub = max( isub, jsub )
872  a( mxsub, mnsub ) = temp
873  IF( mnsub.NE.mxsub )
874  $ a( mnsub, mxsub ) = zero
875  150 continue
876  160 continue
877 *
878  ELSE IF( ipack.EQ.3 ) THEN
879 *
880  DO 180 j = 1, n
881  DO 170 i = 1, j
882  temp = dlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
883  $ iseed, d, igrade, dl, dr, ipvtng, iwork,
884  $ sparse )
885 *
886 * Compute K = location of (ISUB,JSUB) entry in packed
887 * array
888 *
889  mnsub = min( isub, jsub )
890  mxsub = max( isub, jsub )
891  k = mxsub*( mxsub-1 ) / 2 + mnsub
892 *
893 * Convert K to (IISUB,JJSUB) location
894 *
895  jjsub = ( k-1 ) / lda + 1
896  iisub = k - lda*( jjsub-1 )
897 *
898  a( iisub, jjsub ) = temp
899  170 continue
900  180 continue
901 *
902  ELSE IF( ipack.EQ.4 ) THEN
903 *
904  DO 200 j = 1, n
905  DO 190 i = 1, j
906  temp = dlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
907  $ iseed, d, igrade, dl, dr, ipvtng, iwork,
908  $ sparse )
909 *
910 * Compute K = location of (I,J) entry in packed array
911 *
912  mnsub = min( isub, jsub )
913  mxsub = max( isub, jsub )
914  IF( mnsub.EQ.1 ) THEN
915  k = mxsub
916  ELSE
917  k = n*( n+1 ) / 2 - ( n-mnsub+1 )*( n-mnsub+2 ) /
918  $ 2 + mxsub - mnsub + 1
919  END IF
920 *
921 * Convert K to (IISUB,JJSUB) location
922 *
923  jjsub = ( k-1 ) / lda + 1
924  iisub = k - lda*( jjsub-1 )
925 *
926  a( iisub, jjsub ) = temp
927  190 continue
928  200 continue
929 *
930  ELSE IF( ipack.EQ.5 ) THEN
931 *
932  DO 220 j = 1, n
933  DO 210 i = j - kuu, j
934  IF( i.LT.1 ) THEN
935  a( j-i+1, i+n ) = zero
936  ELSE
937  temp = dlatm3( m, n, i, j, isub, jsub, kl, ku,
938  $ idist, iseed, d, igrade, dl, dr, ipvtng,
939  $ iwork, sparse )
940  mnsub = min( isub, jsub )
941  mxsub = max( isub, jsub )
942  a( mxsub-mnsub+1, mnsub ) = temp
943  END IF
944  210 continue
945  220 continue
946 *
947  ELSE IF( ipack.EQ.6 ) THEN
948 *
949  DO 240 j = 1, n
950  DO 230 i = j - kuu, j
951  temp = dlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
952  $ iseed, d, igrade, dl, dr, ipvtng, iwork,
953  $ sparse )
954  mnsub = min( isub, jsub )
955  mxsub = max( isub, jsub )
956  a( mnsub-mxsub+kuu+1, mxsub ) = temp
957  230 continue
958  240 continue
959 *
960  ELSE IF( ipack.EQ.7 ) THEN
961 *
962  IF( isym.EQ.0 ) THEN
963  DO 260 j = 1, n
964  DO 250 i = j - kuu, j
965  temp = dlatm3( m, n, i, j, isub, jsub, kl, ku,
966  $ idist, iseed, d, igrade, dl, dr, ipvtng,
967  $ iwork, sparse )
968  mnsub = min( isub, jsub )
969  mxsub = max( isub, jsub )
970  a( mnsub-mxsub+kuu+1, mxsub ) = temp
971  IF( i.LT.1 )
972  $ a( j-i+1+kuu, i+n ) = zero
973  IF( i.GE.1 .AND. mnsub.NE.mxsub )
974  $ a( mxsub-mnsub+1+kuu, mnsub ) = temp
975  250 continue
976  260 continue
977  ELSE IF( isym.EQ.1 ) THEN
978  DO 280 j = 1, n
979  DO 270 i = j - kuu, j + kll
980  temp = dlatm3( m, n, i, j, isub, jsub, kl, ku,
981  $ idist, iseed, d, igrade, dl, dr, ipvtng,
982  $ iwork, sparse )
983  a( isub-jsub+kuu+1, jsub ) = temp
984  270 continue
985  280 continue
986  END IF
987 *
988  END IF
989 *
990  ELSE
991 *
992 * Use DLATM2
993 *
994  IF( ipack.EQ.0 ) THEN
995  IF( isym.EQ.0 ) THEN
996  DO 300 j = 1, n
997  DO 290 i = 1, j
998  a( i, j ) = dlatm2( m, n, i, j, kl, ku, idist,
999  $ iseed, d, igrade, dl, dr, ipvtng,
1000  $ iwork, sparse )
1001  a( j, i ) = a( i, j )
1002  290 continue
1003  300 continue
1004  ELSE IF( isym.EQ.1 ) THEN
1005  DO 320 j = 1, n
1006  DO 310 i = 1, m
1007  a( i, j ) = dlatm2( m, n, i, j, kl, ku, idist,
1008  $ iseed, d, igrade, dl, dr, ipvtng,
1009  $ iwork, sparse )
1010  310 continue
1011  320 continue
1012  END IF
1013 *
1014  ELSE IF( ipack.EQ.1 ) THEN
1015 *
1016  DO 340 j = 1, n
1017  DO 330 i = 1, j
1018  a( i, j ) = dlatm2( m, n, i, j, kl, ku, idist, iseed,
1019  $ d, igrade, dl, dr, ipvtng, iwork, sparse )
1020  IF( i.NE.j )
1021  $ a( j, i ) = zero
1022  330 continue
1023  340 continue
1024 *
1025  ELSE IF( ipack.EQ.2 ) THEN
1026 *
1027  DO 360 j = 1, n
1028  DO 350 i = 1, j
1029  a( j, i ) = dlatm2( m, n, i, j, kl, ku, idist, iseed,
1030  $ d, igrade, dl, dr, ipvtng, iwork, sparse )
1031  IF( i.NE.j )
1032  $ a( i, j ) = zero
1033  350 continue
1034  360 continue
1035 *
1036  ELSE IF( ipack.EQ.3 ) THEN
1037 *
1038  isub = 0
1039  jsub = 1
1040  DO 380 j = 1, n
1041  DO 370 i = 1, j
1042  isub = isub + 1
1043  IF( isub.GT.lda ) THEN
1044  isub = 1
1045  jsub = jsub + 1
1046  END IF
1047  a( isub, jsub ) = dlatm2( m, n, i, j, kl, ku, idist,
1048  $ iseed, d, igrade, dl, dr, ipvtng,
1049  $ iwork, sparse )
1050  370 continue
1051  380 continue
1052 *
1053  ELSE IF( ipack.EQ.4 ) THEN
1054 *
1055  IF( isym.EQ.0 ) THEN
1056  DO 400 j = 1, n
1057  DO 390 i = 1, j
1058 *
1059 * Compute K = location of (I,J) entry in packed array
1060 *
1061  IF( i.EQ.1 ) THEN
1062  k = j
1063  ELSE
1064  k = n*( n+1 ) / 2 - ( n-i+1 )*( n-i+2 ) / 2 +
1065  $ j - i + 1
1066  END IF
1067 *
1068 * Convert K to (ISUB,JSUB) location
1069 *
1070  jsub = ( k-1 ) / lda + 1
1071  isub = k - lda*( jsub-1 )
1072 *
1073  a( isub, jsub ) = dlatm2( m, n, i, j, kl, ku,
1074  $ idist, iseed, d, igrade, dl, dr,
1075  $ ipvtng, iwork, sparse )
1076  390 continue
1077  400 continue
1078  ELSE
1079  isub = 0
1080  jsub = 1
1081  DO 420 j = 1, n
1082  DO 410 i = j, m
1083  isub = isub + 1
1084  IF( isub.GT.lda ) THEN
1085  isub = 1
1086  jsub = jsub + 1
1087  END IF
1088  a( isub, jsub ) = dlatm2( m, n, i, j, kl, ku,
1089  $ idist, iseed, d, igrade, dl, dr,
1090  $ ipvtng, iwork, sparse )
1091  410 continue
1092  420 continue
1093  END IF
1094 *
1095  ELSE IF( ipack.EQ.5 ) THEN
1096 *
1097  DO 440 j = 1, n
1098  DO 430 i = j - kuu, j
1099  IF( i.LT.1 ) THEN
1100  a( j-i+1, i+n ) = zero
1101  ELSE
1102  a( j-i+1, i ) = dlatm2( m, n, i, j, kl, ku, idist,
1103  $ iseed, d, igrade, dl, dr, ipvtng,
1104  $ iwork, sparse )
1105  END IF
1106  430 continue
1107  440 continue
1108 *
1109  ELSE IF( ipack.EQ.6 ) THEN
1110 *
1111  DO 460 j = 1, n
1112  DO 450 i = j - kuu, j
1113  a( i-j+kuu+1, j ) = dlatm2( m, n, i, j, kl, ku, idist,
1114  $ iseed, d, igrade, dl, dr, ipvtng,
1115  $ iwork, sparse )
1116  450 continue
1117  460 continue
1118 *
1119  ELSE IF( ipack.EQ.7 ) THEN
1120 *
1121  IF( isym.EQ.0 ) THEN
1122  DO 480 j = 1, n
1123  DO 470 i = j - kuu, j
1124  a( i-j+kuu+1, j ) = dlatm2( m, n, i, j, kl, ku,
1125  $ idist, iseed, d, igrade, dl,
1126  $ dr, ipvtng, iwork, sparse )
1127  IF( i.LT.1 )
1128  $ a( j-i+1+kuu, i+n ) = zero
1129  IF( i.GE.1 .AND. i.NE.j )
1130  $ a( j-i+1+kuu, i ) = a( i-j+kuu+1, j )
1131  470 continue
1132  480 continue
1133  ELSE IF( isym.EQ.1 ) THEN
1134  DO 500 j = 1, n
1135  DO 490 i = j - kuu, j + kll
1136  a( i-j+kuu+1, j ) = dlatm2( m, n, i, j, kl, ku,
1137  $ idist, iseed, d, igrade, dl,
1138  $ dr, ipvtng, iwork, sparse )
1139  490 continue
1140  500 continue
1141  END IF
1142 *
1143  END IF
1144 *
1145  END IF
1146 *
1147 * 5) Scaling the norm
1148 *
1149  IF( ipack.EQ.0 ) THEN
1150  onorm = dlange( 'M', m, n, a, lda, tempa )
1151  ELSE IF( ipack.EQ.1 ) THEN
1152  onorm = dlansy( 'M', 'U', n, a, lda, tempa )
1153  ELSE IF( ipack.EQ.2 ) THEN
1154  onorm = dlansy( 'M', 'L', n, a, lda, tempa )
1155  ELSE IF( ipack.EQ.3 ) THEN
1156  onorm = dlansp( 'M', 'U', n, a, tempa )
1157  ELSE IF( ipack.EQ.4 ) THEN
1158  onorm = dlansp( 'M', 'L', n, a, tempa )
1159  ELSE IF( ipack.EQ.5 ) THEN
1160  onorm = dlansb( 'M', 'L', n, kll, a, lda, tempa )
1161  ELSE IF( ipack.EQ.6 ) THEN
1162  onorm = dlansb( 'M', 'U', n, kuu, a, lda, tempa )
1163  ELSE IF( ipack.EQ.7 ) THEN
1164  onorm = dlangb( 'M', n, kll, kuu, a, lda, tempa )
1165  END IF
1166 *
1167  IF( anorm.GE.zero ) THEN
1168 *
1169  IF( anorm.GT.zero .AND. onorm.EQ.zero ) THEN
1170 *
1171 * Desired scaling impossible
1172 *
1173  info = 5
1174  return
1175 *
1176  ELSE IF( ( anorm.GT.one .AND. onorm.LT.one ) .OR.
1177  $ ( anorm.LT.one .AND. onorm.GT.one ) ) THEN
1178 *
1179 * Scale carefully to avoid over / underflow
1180 *
1181  IF( ipack.LE.2 ) THEN
1182  DO 510 j = 1, n
1183  CALL dscal( m, one / onorm, a( 1, j ), 1 )
1184  CALL dscal( m, anorm, a( 1, j ), 1 )
1185  510 continue
1186 *
1187  ELSE IF( ipack.EQ.3 .OR. ipack.EQ.4 ) THEN
1188 *
1189  CALL dscal( n*( n+1 ) / 2, one / onorm, a, 1 )
1190  CALL dscal( n*( n+1 ) / 2, anorm, a, 1 )
1191 *
1192  ELSE IF( ipack.GE.5 ) THEN
1193 *
1194  DO 520 j = 1, n
1195  CALL dscal( kll+kuu+1, one / onorm, a( 1, j ), 1 )
1196  CALL dscal( kll+kuu+1, anorm, a( 1, j ), 1 )
1197  520 continue
1198 *
1199  END IF
1200 *
1201  ELSE
1202 *
1203 * Scale straightforwardly
1204 *
1205  IF( ipack.LE.2 ) THEN
1206  DO 530 j = 1, n
1207  CALL dscal( m, anorm / onorm, a( 1, j ), 1 )
1208  530 continue
1209 *
1210  ELSE IF( ipack.EQ.3 .OR. ipack.EQ.4 ) THEN
1211 *
1212  CALL dscal( n*( n+1 ) / 2, anorm / onorm, a, 1 )
1213 *
1214  ELSE IF( ipack.GE.5 ) THEN
1215 *
1216  DO 540 j = 1, n
1217  CALL dscal( kll+kuu+1, anorm / onorm, a( 1, j ), 1 )
1218  540 continue
1219  END IF
1220 *
1221  END IF
1222 *
1223  END IF
1224 *
1225 * End of DLATMR
1226 *
1227  END