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