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 REAL RWORK( * )
153 COMPLEX AB( LDAB, * ), B( * ), WORK( * )
154
155
156
157
158
159 REAL ONE, TWO, ZERO
160 parameter( one = 1.0e+0, two = 2.0e+0, zero = 0.0e+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 REAL ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP,
168 $ SFAC, SMLNUM, TEXP, TLEFT, TNORM, TSCAL, ULP,
169 $ UNFL
170 COMPLEX PLUS1, PLUS2, STAR1
171
172
173 LOGICAL LSAME
174 INTEGER ICAMAX
175 REAL SLAMCH, SLARND
176 COMPLEX CLARND
178
179
182
183
184 INTRINSIC abs, cmplx, max, min, real, sqrt
185
186
187
188 path( 1: 1 ) = 'Complex precision'
189 path( 2: 3 ) = 'TB'
190 unfl =
slamch(
'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 clatb4( 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 clatb4( 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 clatms( 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 ) = real( 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 ) = real( 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*
clarnd( 5, iseed )
286 lenj = ( n-3 ) / 2
287 CALL clarnv( 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*
clarnd( 5, iseed )
293 lenj = ( n-3 ) / 2
294 CALL clarnv( 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*
clarnd( 5, iseed )
318 sfac = sqrt( tnorm )
319 plus1 = sfac*
clarnd( 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 )*
clarnd( 5, iseed )
335 ELSE
336 star1 = sfac**( one+rexp )*
clarnd( 5, iseed )
337 END IF
338 END IF
339 110 CONTINUE
340
341
342
343 IF( upper ) THEN
344 CALL ccopy( n-1, work, 1, ab( kd, 2 ), ldab )
345 CALL ccopy( n-2, work( n+1 ), 1, ab( kd-1, 3 ), ldab )
346 ELSE
347 CALL ccopy( n-1, work, 1, ab( 2, 1 ), ldab )
348 CALL ccopy( 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 clarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
366 ab( kd+1, j ) =
clarnd( 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 clarnv( 4, iseed, lenj, ab( 2, j ) )
373 ab( 1, j ) =
clarnd( 5, iseed )*two
374 130 CONTINUE
375 END IF
376
377
378
379 CALL clarnv( 2, iseed, n, b )
381 bnorm = abs( b( iy ) )
382 bscal = bignum / max( one, bnorm )
383 CALL csscal( n, bscal, b, 1 )
384
385 ELSE IF( imat.EQ.11 ) THEN
386
387
388
389
390
391 CALL clarnv( 2, iseed, n, b )
392 tscal = one / real( 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 clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
398 CALL csscal( lenj, tscal, ab( kd+2-lenj, j ), 1 )
399 END IF
400 ab( kd+1, j ) =
clarnd( 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 clarnv( 4, iseed, lenj, ab( 2, j ) )
408 CALL csscal( lenj, tscal, ab( 2, j ), 1 )
409 END IF
410 ab( 1, j ) =
clarnd( 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 clarnv( 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 clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
427 ab( kd+1, j ) =
clarnd( 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 clarnv( 4, iseed, lenj, ab( 2, j ) )
435 ab( 1, j ) =
clarnd( 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*
clarnd( 5, iseed )
454 ELSE
455 ab( kd+1, j ) =
clarnd( 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*
clarnd( 5, iseed )
469 ELSE
470 ab( 1, j ) =
clarnd( 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*
clarnd( 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*
clarnd( 5, iseed )
491 230 CONTINUE
492 END IF
493
494 ELSE IF( imat.EQ.14 ) THEN
495
496
497
498
499
500 texp = one / real( kd+1 )
501 tscal = smlnum**texp
502 CALL clarnv( 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 ) = cmplx( -one, -one )
510 ab( kd+1, j ) = tscal*
clarnd( 5, iseed )
511 250 CONTINUE
512 b( n ) = cmplx( 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 ) = cmplx( -one, -one )
520 ab( 1, j ) = tscal*
clarnd( 5, iseed )
521 270 CONTINUE
522 b( 1 ) = cmplx( 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 clarnv( 4, iseed, lenj, ab( kd+2-lenj, j ) )
534 IF( j.NE.iy ) THEN
535 ab( kd+1, j ) =
clarnd( 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 clarnv( 4, iseed, lenj, ab( 1, j ) )
544 IF( j.NE.iy ) THEN
545 ab( 1, j ) =
clarnd( 5, iseed )*two
546 ELSE
547 ab( 1, j ) = zero
548 END IF
549 290 CONTINUE
550 END IF
551 CALL clarnv( 2, iseed, n, b )
552 CALL csscal( 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 / real( 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 / real( kd+2 ) )
578 $ / real( kd+3 )
579 ab( kd+1, i-1 ) = one
580 b( i-1 ) = texp*real( ( kd+1 )*( kd+1 )+kd )
581 END IF
582 texp = texp*two
583 320 CONTINUE
584 b( max( 1, j-kd+1 ) ) = ( real( kd+2 ) /
585 $ real( 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 / real( 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 $ real( kd+2 ) ) / real( kd+3 )
598 ab( 1, i+1 ) = one
599 b( i+1 ) = texp*real( ( kd+1 )*( kd+1 )+kd )
600 END IF
601 texp = texp*two
602 340 CONTINUE
603 b( min( n, j+kd-1 ) ) = ( real( kd+2 ) /
604 $ real( 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 clarnv( 4, iseed, lenj, ab( kd+1-lenj, j ) )
619 ab( kd+1, j ) = real( 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 clarnv( 4, iseed, lenj, ab( 2, j ) )
626 ab( 1, j ) = real( j )
627 370 CONTINUE
628 END IF
629
630
631
632 CALL clarnv( 2, iseed, n, b )
634 bnorm = abs( b( iy ) )
635 bscal = bignum / max( one, bnorm )
636 CALL csscal( n, bscal, b, 1 )
637
638 ELSE IF( imat.EQ.18 ) THEN
639
640
641
642
643
644
645 tleft = bignum / real( kd+1 )
646 tscal = bignum*( real( kd+1 ) / real( kd+2 ) )
647 IF( upper ) THEN
648 DO 390 j = 1, n
649 lenj = min( j, kd+1 )
650 CALL clarnv( 5, iseed, lenj, ab( kd+2-lenj, j ) )
651 CALL slarnv( 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 clarnv( 5, iseed, lenj, ab( 1, j ) )
660 CALL slarnv( 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 clarnv( 2, iseed, n, b )
667 CALL csscal( 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 cswap( 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 cswap( 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
complex function clarnd(idist, iseed)
CLARND
subroutine clatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
CLATB4
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
integer function icamax(n, cx, incx)
ICAMAX
real function slamch(cmach)
SLAMCH
subroutine slarnv(idist, iseed, n, x)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine clarnv(idist, iseed, n, x)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
logical function lsame(ca, cb)
LSAME
subroutine csscal(n, sa, cx, incx)
CSSCAL
subroutine cswap(n, cx, incx, cy, incy)
CSWAP
real function slarnd(idist, iseed)
SLARND