LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
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
subroutine clatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
CLATMR
Definition: clatmr.f:492
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine clatm1(MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO)
CLATM1
Definition: clatm1.f:139
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:54