141
142
143
144
145
146
147 CHARACTER DIAG, TRANS, UPLO
148 INTEGER IMAT, INFO, KD, LDAB, N
149
150
151 INTEGER ISEED( 4 )
152 DOUBLE PRECISION RWORK( * )
153 COMPLEX*16 AB( LDAB, * ), B( * ), WORK( * )
154
155
156
157
158
159 DOUBLE PRECISION ONE, TWO, ZERO
160 parameter( one = 1.0d+0, two = 2.0d+0, zero = 0.0d+0 )
161
162
163 LOGICAL UPPER
164 CHARACTER DIST, PACKIT, TYPE
165 CHARACTER*3 PATH
166 INTEGER I, IOFF, IY, J, JCOUNT, KL, KU, LENJ, MODE
167 DOUBLE PRECISION ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP,
168 $ SFAC, SMLNUM, TEXP, TLEFT, TNORM, TSCAL, ULP,
169 $ UNFL
170 COMPLEX*16 PLUS1, PLUS2, STAR1
171
172
173 LOGICAL LSAME
174 INTEGER IZAMAX
175 DOUBLE PRECISION DLAMCH, DLARND
176 COMPLEX*16 ZLARND
178
179
182
183
184 INTRINSIC abs, dble, dcmplx, max, min, sqrt
185
186
187
188 path( 1: 1 ) = 'Zomplex precision'
189 path( 2: 3 ) = 'TB'
190 unfl =
dlamch(
'Safe minimum' )
192 smlnum = unfl
193 bignum = ( one-ulp ) / smlnum
194 IF( ( imat.GE.6 .AND. imat.LE.9 ) .OR. imat.EQ.17 ) THEN
195 diag = 'U'
196 ELSE
197 diag = 'N'
198 END IF
199 info = 0
200
201
202
203 IF( n.LE.0 )
204 $ RETURN
205
206
207
208 upper =
lsame( uplo,
'U' )
209 IF( upper ) THEN
210 CALL zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
211 $ CNDNUM, DIST )
212 ku = kd
213 ioff = 1 + max( 0, kd-n+1 )
214 kl = 0
215 packit = 'Q'
216 ELSE
217 CALL zlatb4( path, -imat, n, n,
TYPE, KL, KU, ANORM, MODE,
218 $ CNDNUM, DIST )
219 kl = kd
220 ioff = 1
221 ku = 0
222 packit = 'B'
223 END IF
224
225
226
227 IF( imat.LE.5 ) THEN
228 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE, CNDNUM,
229 $ ANORM, KL, KU, PACKIT, AB( IOFF, 1 ), LDAB, WORK,
230 $ INFO )
231
232
233
234
235
236
237 ELSE IF( imat.EQ.6 ) THEN
238 IF( upper ) THEN
239 DO 20 j = 1, n
240 DO 10 i = max( 1, kd+2-j ), kd
241 ab( i, j ) = zero
242 10 CONTINUE
243 ab( kd+1, j ) = j
244 20 CONTINUE
245 ELSE
246 DO 40 j = 1, n
247 ab( 1, j ) = j
248 DO 30 i = 2, min( kd+1, n-j+1 )
249 ab( i, j ) = zero
250 30 CONTINUE
251 40 CONTINUE
252 END IF
253
254
255
256
257
258
259 ELSE IF( imat.LE.9 ) THEN
260 tnorm = sqrt( cndnum )
261
262
263
264 IF( upper ) THEN
265 DO 60 j = 1, n
266 DO 50 i = max( 1, kd+2-j ), kd
267 ab( i, j ) = zero
268 50 CONTINUE
269 ab( kd+1, j ) = dble( j )
270 60 CONTINUE
271 ELSE
272 DO 80 j = 1, n
273 DO 70 i = 2, min( kd+1, n-j+1 )
274 ab( i, j ) = zero
275 70 CONTINUE
276 ab( 1, j ) = dble( j )
277 80 CONTINUE
278 END IF
279
280
281
282
283 IF( kd.EQ.1 ) THEN
284 IF( upper ) THEN
285 ab( 1, 2 ) = tnorm*
zlarnd( 5, iseed )
286 lenj = ( n-3 ) / 2
287 CALL zlarnv( 2, iseed, lenj, work )
288 DO 90 j = 1, lenj
289 ab( 1, 2*( j+1 ) ) = tnorm*work( j )
290 90 CONTINUE
291 ELSE
292 ab( 2, 1 ) = tnorm*
zlarnd( 5, iseed )
293 lenj = ( n-3 ) / 2
294 CALL zlarnv( 2, iseed, lenj, work )
295 DO 100 j = 1, lenj
296 ab( 2, 2*j+1 ) = tnorm*work( j )
297 100 CONTINUE
298 END IF
299 ELSE IF( kd.GT.1 ) THEN
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317 star1 = tnorm*
zlarnd( 5, iseed )
318 sfac = sqrt( tnorm )
319 plus1 = sfac*
zlarnd( 5, iseed )
320 DO 110 j = 1, n, 2
321 plus2 = star1 / plus1
322 work( j ) = plus1
323 work( n+j ) = star1
324 IF( j+1.LE.n ) THEN
325 work( j+1 ) = plus2
326 work( n+j+1 ) = zero
327 plus1 = star1 / plus2
328
329
330
331
333 IF( rexp.LT.zero ) THEN
334 star1 = -sfac**( one-rexp )*
zlarnd( 5, iseed )
335 ELSE
336 star1 = sfac**( one+rexp )*
zlarnd( 5, iseed )
337 END IF
338 END IF
339 110 CONTINUE
340
341
342
343 IF( upper ) THEN
344 CALL zcopy( n-1, work, 1, ab( kd, 2 ), ldab )
345 CALL zcopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
346 ELSE
347 CALL zcopy( n-1, work, 1, ab( 2, 1 ), ldab )
348 CALL zcopy( n-2, work( n+1 ), 1, ab( 3, 1 ), ldab )
349 END IF
350 END IF
351
352
353
354
355
356 ELSE IF( imat.EQ.10 ) THEN
357
358
359
360
361
362 IF( upper ) THEN
363 DO 120 j = 1, n
364 lenj = min( j-1, kd )
365 CALL zlarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
366 ab( kd+1, j ) =
zlarnd( 5, iseed )*two
367 120 CONTINUE
368 ELSE
369 DO 130 j = 1, n
370 lenj = min( n-j, kd )
371 IF( lenj.GT.0 )
372 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
373 ab( 1, j ) =
zlarnd( 5, iseed )*two
374 130 CONTINUE
375 END IF
376
377
378
379 CALL zlarnv( 2, iseed, n, b )
381 bnorm = abs( b( iy ) )
382 bscal = bignum / max( one, bnorm )
383 CALL zdscal( n, bscal, b, 1 )
384
385 ELSE IF( imat.EQ.11 ) THEN
386
387
388
389
390
391 CALL zlarnv( 2, iseed, n, b )
392 tscal = one / dble( kd+1 )
393 IF( upper ) THEN
394 DO 140 j = 1, n
395 lenj = min( j-1, kd )
396 IF( lenj.GT.0 ) THEN
397 CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
398 CALL zdscal( lenj, tscal, ab( kd+2-lenj, j ), 1 )
399 END IF
400 ab( kd+1, j ) =
zlarnd( 5, iseed )
401 140 CONTINUE
402 ab( kd+1, n ) = smlnum*ab( kd+1, n )
403 ELSE
404 DO 150 j = 1, n
405 lenj = min( n-j, kd )
406 IF( lenj.GT.0 ) THEN
407 CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
408 CALL zdscal( lenj, tscal, ab( 2, j ), 1 )
409 END IF
410 ab( 1, j ) =
zlarnd( 5, iseed )
411 150 CONTINUE
412 ab( 1, 1 ) = smlnum*ab( 1, 1 )
413 END IF
414
415 ELSE IF( imat.EQ.12 ) THEN
416
417
418
419
420
421 CALL zlarnv( 2, iseed, n, b )
422 IF( upper ) THEN
423 DO 160 j = 1, n
424 lenj = min( j-1, kd )
425 IF( lenj.GT.0 )
426 $
CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
427 ab( kd+1, j ) =
zlarnd( 5, iseed )
428 160 CONTINUE
429 ab( kd+1, n ) = smlnum*ab( kd+1, n )
430 ELSE
431 DO 170 j = 1, n
432 lenj = min( n-j, kd )
433 IF( lenj.GT.0 )
434 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
435 ab( 1, j ) =
zlarnd( 5, iseed )
436 170 CONTINUE
437 ab( 1, 1 ) = smlnum*ab( 1, 1 )
438 END IF
439
440 ELSE IF( imat.EQ.13 ) THEN
441
442
443
444
445
446 IF( upper ) THEN
447 jcount = 1
448 DO 190 j = n, 1, -1
449 DO 180 i = max( 1, kd+1-( j-1 ) ), kd
450 ab( i, j ) = zero
451 180 CONTINUE
452 IF( jcount.LE.2 ) THEN
453 ab( kd+1, j ) = smlnum*
zlarnd( 5, iseed )
454 ELSE
455 ab( kd+1, j ) =
zlarnd( 5, iseed )
456 END IF
457 jcount = jcount + 1
458 IF( jcount.GT.4 )
459 $ jcount = 1
460 190 CONTINUE
461 ELSE
462 jcount = 1
463 DO 210 j = 1, n
464 DO 200 i = 2, min( n-j+1, kd+1 )
465 ab( i, j ) = zero
466 200 CONTINUE
467 IF( jcount.LE.2 ) THEN
468 ab( 1, j ) = smlnum*
zlarnd( 5, iseed )
469 ELSE
470 ab( 1, j ) =
zlarnd( 5, iseed )
471 END IF
472 jcount = jcount + 1
473 IF( jcount.GT.4 )
474 $ jcount = 1
475 210 CONTINUE
476 END IF
477
478
479
480 IF( upper ) THEN
481 b( 1 ) = zero
482 DO 220 i = n, 2, -2
483 b( i ) = zero
484 b( i-1 ) = smlnum*
zlarnd( 5, iseed )
485 220 CONTINUE
486 ELSE
487 b( n ) = zero
488 DO 230 i = 1, n - 1, 2
489 b( i ) = zero
490 b( i+1 ) = smlnum*
zlarnd( 5, iseed )
491 230 CONTINUE
492 END IF
493
494 ELSE IF( imat.EQ.14 ) THEN
495
496
497
498
499
500 texp = one / dble( kd+1 )
501 tscal = smlnum**texp
502 CALL zlarnv( 4, iseed, n, b )
503 IF( upper ) THEN
504 DO 250 j = 1, n
505 DO 240 i = max( 1, kd+2-j ), kd
506 ab( i, j ) = zero
507 240 CONTINUE
508 IF( j.GT.1 .AND. kd.GT.0 )
509 $ ab( kd, j ) = dcmplx( -one, -one )
510 ab( kd+1, j ) = tscal*
zlarnd( 5, iseed )
511 250 CONTINUE
512 b( n ) = dcmplx( one, one )
513 ELSE
514 DO 270 j = 1, n
515 DO 260 i = 3, min( n-j+1, kd+1 )
516 ab( i, j ) = zero
517 260 CONTINUE
518 IF( j.LT.n .AND. kd.GT.0 )
519 $ ab( 2, j ) = dcmplx( -one, -one )
520 ab( 1, j ) = tscal*
zlarnd( 5, iseed )
521 270 CONTINUE
522 b( 1 ) = dcmplx( one, one )
523 END IF
524
525 ELSE IF( imat.EQ.15 ) THEN
526
527
528
529 iy = n / 2 + 1
530 IF( upper ) THEN
531 DO 280 j = 1, n
532 lenj = min( j, kd+1 )
533 CALL zlarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
534 IF( j.NE.iy ) THEN
535 ab( kd+1, j ) =
zlarnd( 5, iseed )*two
536 ELSE
537 ab( kd+1, j ) = zero
538 END IF
539 280 CONTINUE
540 ELSE
541 DO 290 j = 1, n
542 lenj = min( n-j+1, kd+1 )
543 CALL zlarnv( 4, iseed, lenj, ab( 1, j ) )
544 IF( j.NE.iy ) THEN
545 ab( 1, j ) =
zlarnd( 5, iseed )*two
546 ELSE
547 ab( 1, j ) = zero
548 END IF
549 290 CONTINUE
550 END IF
551 CALL zlarnv( 2, iseed, n, b )
552 CALL zdscal( n, two, b, 1 )
553
554 ELSE IF( imat.EQ.16 ) THEN
555
556
557
558
559
560
561 tscal = unfl / ulp
562 tscal = ( one-ulp ) / tscal
563 DO 310 j = 1, n
564 DO 300 i = 1, kd + 1
565 ab( i, j ) = zero
566 300 CONTINUE
567 310 CONTINUE
568 texp = one
569 IF( kd.GT.0 ) THEN
570 IF( upper ) THEN
571 DO 330 j = n, 1, -kd
572 DO 320 i = j, max( 1, j-kd+1 ), -2
573 ab( 1+( j-i ), i ) = -tscal / dble( kd+2 )
574 ab( kd+1, i ) = one
575 b( i ) = texp*( one-ulp )
576 IF( i.GT.max( 1, j-kd+1 ) ) THEN
577 ab( 2+( j-i ), i-1 ) = -( tscal / dble( kd+2 ) )
578 $ / dble( kd+3 )
579 ab( kd+1, i-1 ) = one
580 b( i-1 ) = texp*dble( ( kd+1 )*( kd+1 )+kd )
581 END IF
582 texp = texp*two
583 320 CONTINUE
584 b( max( 1, j-kd+1 ) ) = ( dble( kd+2 ) /
585 $ dble( kd+3 ) )*tscal
586 330 CONTINUE
587 ELSE
588 DO 350 j = 1, n, kd
589 texp = one
590 lenj = min( kd+1, n-j+1 )
591 DO 340 i = j, min( n, j+kd-1 ), 2
592 ab( lenj-( i-j ), j ) = -tscal / dble( kd+2 )
593 ab( 1, j ) = one
594 b( j ) = texp*( one-ulp )
595 IF( i.LT.min( n, j+kd-1 ) ) THEN
596 ab( lenj-( i-j+1 ), i+1 ) = -( tscal /
597 $ dble( kd+2 ) ) / dble( kd+3 )
598 ab( 1, i+1 ) = one
599 b( i+1 ) = texp*dble( ( kd+1 )*( kd+1 )+kd )
600 END IF
601 texp = texp*two
602 340 CONTINUE
603 b( min( n, j+kd-1 ) ) = ( dble( kd+2 ) /
604 $ dble( kd+3 ) )*tscal
605 350 CONTINUE
606 END IF
607 END IF
608
609 ELSE IF( imat.EQ.17 ) THEN
610
611
612
613
614
615 IF( upper ) THEN
616 DO 360 j = 1, n
617 lenj = min( j-1, kd )
618 CALL zlarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
619 ab( kd+1, j ) = dble( j )
620 360 CONTINUE
621 ELSE
622 DO 370 j = 1, n
623 lenj = min( n-j, kd )
624 IF( lenj.GT.0 )
625 $
CALL zlarnv( 4, iseed, lenj, ab( 2, j ) )
626 ab( 1, j ) = dble( j )
627 370 CONTINUE
628 END IF
629
630
631
632 CALL zlarnv( 2, iseed, n, b )
634 bnorm = abs( b( iy ) )
635 bscal = bignum / max( one, bnorm )
636 CALL zdscal( n, bscal, b, 1 )
637
638 ELSE IF( imat.EQ.18 ) THEN
639
640
641
642
643
644
645 tleft = bignum / dble( kd+1 )
646 tscal = bignum*( dble( kd+1 ) / dble( kd+2 ) )
647 IF( upper ) THEN
648 DO 390 j = 1, n
649 lenj = min( j, kd+1 )
650 CALL zlarnv( 5, iseed, lenj, ab( kd+2-lenj, j ) )
651 CALL dlarnv( 1, iseed, lenj, rwork( kd+2-lenj ) )
652 DO 380 i = kd + 2 - lenj, kd + 1
653 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
654 380 CONTINUE
655 390 CONTINUE
656 ELSE
657 DO 410 j = 1, n
658 lenj = min( n-j+1, kd+1 )
659 CALL zlarnv( 5, iseed, lenj, ab( 1, j ) )
660 CALL dlarnv( 1, iseed, lenj, rwork )
661 DO 400 i = 1, lenj
662 ab( i, j ) = ab( i, j )*( tleft+rwork( i )*tscal )
663 400 CONTINUE
664 410 CONTINUE
665 END IF
666 CALL zlarnv( 2, iseed, n, b )
667 CALL zdscal( n, two, b, 1 )
668 END IF
669
670
671
672 IF( .NOT.
lsame( trans,
'N' ) )
THEN
673 IF( upper ) THEN
674 DO 420 j = 1, n / 2
675 lenj = min( n-2*j+1, kd+1 )
676 CALL zswap( lenj, ab( kd+1, j ), ldab-1,
677 $ ab( kd+2-lenj, n-j+1 ), -1 )
678 420 CONTINUE
679 ELSE
680 DO 430 j = 1, n / 2
681 lenj = min( n-2*j+1, kd+1 )
682 CALL zswap( lenj, ab( 1, j ), 1, ab( lenj, n-j+2-lenj ),
683 $ -ldab+1 )
684 430 CONTINUE
685 END IF
686 END IF
687
688 RETURN
689
690
691
double precision function dlarnd(idist, iseed)
DLARND
subroutine zcopy(n, zx, incx, zy, incy)
ZCOPY
integer function izamax(n, zx, incx)
IZAMAX
double precision function dlamch(cmach)
DLAMCH
subroutine zlarnv(idist, iseed, n, x)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine dlarnv(idist, iseed, n, x)
DLARNV returns a vector of random numbers from a uniform or normal distribution.
logical function lsame(ca, cb)
LSAME
subroutine zdscal(n, da, zx, incx)
ZDSCAL
subroutine zswap(n, zx, incx, zy, incy)
ZSWAP
complex *16 function zlarnd(idist, iseed)
ZLARND
subroutine zlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
ZLATB4
subroutine zlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
ZLATMS