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