8
9
10
11
12
13
14
15 CHARACTER SUBTESTS, UPLO
16 INTEGER IBTYPE, INFO, IPOSTPAD, IPREPAD, LDA, LIWORK,
17 $ LWORK, MATTYPE, N, NOUT, ORDER
18 DOUBLE PRECISION ABSTOL, THRESH
19
20
21 INTEGER DESCA( * ), ICLUSTR( * ), IFAIL( * ),
22 $ ISEED( 4 ), IWORK( * )
23 DOUBLE PRECISION A( LDA, * ), B( LDA, * ), COPYA( LDA, * ),
24 $ COPYB( LDA, * ), GAP( * ), WIN( * ), WNEW( * ),
25 $ WORK( * ), Z( LDA, * )
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212 INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
213 $ MB_, NB_, RSRC_, CSRC_, LLD_
214 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
215 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
216 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
217 DOUBLE PRECISION ZERO, ONE, TEN, HALF
218 parameter( zero = 0.0d+0, one = 1.0d+0, ten = 10.0d+0,
219 $ half = 0.5d+0 )
220 DOUBLE PRECISION PADVAL
221 parameter( padval = 19.25d+0 )
222 INTEGER MAXTYP
223 parameter( maxtyp = 22 )
224
225
226
227 LOGICAL WKNOWN
228 CHARACTER JOBZ, RANGE
229 CHARACTER*14 PASSED
230 INTEGER CONTEXT, I, IAM, IINFO, IL, IMODE, IN, INDD,
231 $ INDWORK, ISIZESUBTST, ISIZESYEVX, ISIZETST,
232 $ ITYPE, IU, J, LLWORK, LSYEVXSIZE, MAXSIZE,
233 $ MYCOL, MYROW, NB, NGEN, NLOC, NNODES, NP,
234 $ NPCOL, NPROW, NQ, RES, SIZECHK, SIZEMQRLEFT,
235 $ SIZEMQRRIGHT, SIZEQRF, SIZEQTQ, SIZESUBTST,
236 $ SIZESYEVX, SIZETMS, SIZETST, VALSIZE, VECSIZE
237 DOUBLE PRECISION ANINV, ANORM, COND, MAXQTQNRM, MAXTSTNRM, OVFL,
238 $ QTQNRM, RTOVFL, RTUNFL, TEMP1, TSTNRM, ULP,
239 $ ULPINV, UNFL, VL, VU
240
241
242 INTEGER ISEEDIN( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
243 $ KTYPE( MAXTYP )
244 DOUBLE PRECISION CTIME( 10 ), WTIME( 10 )
245
246
247 LOGICAL LSAME
248 INTEGER NUMROC
249 DOUBLE PRECISION DLARAN, PDLAMCH
251
252
253 EXTERNAL blacs_gridinfo, blacs_pinfo, dlabad, dlasrt,
258
259
260 INTRINSIC abs, dble, int,
max,
min, mod, sqrt
261
262
263 DATA ktype / 1, 2, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 8,
264 $ 8, 8, 9, 9, 9, 9, 9, 10, 11 /
265 DATA kmagn / 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
266 $ 2, 3, 1, 1, 1, 2, 3, 1, 1 /
267 DATA kmode / 0, 0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
268 $ 0, 0, 4, 3, 1, 4, 4, 3, 0 /
269
270
271
272 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
273 $ rsrc_.LT.0 )RETURN
274
275 info = 0
276 passed = 'PASSED '
277 context = desca( ctxt_ )
278 nb = desca( nb_ )
279
280 CALL blacs_pinfo( iam, nnodes )
281 CALL blacs_gridinfo( context, nprow, npcol, myrow, mycol )
282
283
284
285
286
287 CALL pdlasizegsep( desca, iprepad, ipostpad, sizemqrleft,
288 $ sizemqrright, sizeqrf, sizetms, sizeqtq,
289 $ sizechk, sizesyevx, isizesyevx, sizesubtst,
290 $ isizesubtst, sizetst, isizetst )
291
292 IF( lwork.LT.sizetst ) THEN
293 info = 3
294 END IF
295
296 CALL igamx2d( context, 'a', ' ', 1, 1, info, 1, 1, 1, -1, -1, 0 )
297
298 IF( info.EQ.0 ) THEN
299
300 indd = 1
301 indwork = indd + n
302 llwork = lwork - indwork + 1
303
305 ulpinv = one / ulp
306 unfl =
pdlamch( context,
'Safe min' )
307 ovfl = one / unfl
308 CALL dlabad( unfl, ovfl )
309 rtunfl = sqrt( unfl )
310 rtovfl = sqrt( ovfl )
311 aninv = one / dble(
max( 1, n ) )
312
313
314
315 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
316 CALL igebs2d( context, 'a', ' ', 4, 1, iseed, 4 )
317 ELSE
318 CALL igebr2d( context, 'a', ' ', 4, 1, iseed, 4, 0, 0 )
319 END IF
320 iseedin( 1 ) = iseed( 1 )
321 iseedin( 2 ) = iseed( 2 )
322 iseedin( 3 ) = iseed( 3 )
323 iseedin( 4 ) = iseed( 4 )
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342 itype = ktype( mattype )
343 imode = kmode( mattype )
344
345
346
347 GO TO ( 10, 20, 30 )kmagn( mattype )
348
349 10 CONTINUE
350 anorm = one
351 GO TO 40
352
353 20 CONTINUE
354 anorm = ( rtovfl*ulp )*aninv
355 GO TO 40
356
357 30 CONTINUE
358 anorm = rtunfl*n*ulpinv
359 GO TO 40
360
361 40 CONTINUE
362 IF( mattype.LE.15 ) THEN
363 cond = ulpinv
364 ELSE
365 cond = ulpinv*aninv / ten
366 END IF
367
368
369
370
371
372
373 IF( itype.EQ.1 ) THEN
374
375
376
377 DO 50 i = 1, n
378 work( indd+i-1 ) = zero
379 50 CONTINUE
380 CALL pdlaset(
'All', n, n, zero, zero, copya, 1, 1, desca )
381 wknown = .true.
382
383 ELSE IF( itype.EQ.2 ) THEN
384
385
386
387 DO 60 i = 1, n
388 work( indd+i-1 ) = one
389 60 CONTINUE
390 CALL pdlaset(
'All', n, n, zero, one, copya, 1, 1, desca )
391 wknown = .true.
392
393 ELSE IF( itype.EQ.4 ) THEN
394
395
396
397 CALL pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
398 $ sizetms, iprepad, ipostpad, padval+1.0d+0 )
399
400 CALL pdlatms( n, n,
'S', iseed,
'S', work( indd ), imode,
401 $ cond, anorm, 0, 0, 'N', copya, 1, 1, desca,
402 $ order, work( indwork+iprepad ), sizetms,
403 $ iinfo )
404 wknown = .true.
405
406 CALL pdchekpad( desca( ctxt_ ),
'PDLATMS1-WORK', sizetms, 1,
407 $ work( indwork ), sizetms, iprepad, ipostpad,
408 $ padval+1.0d+0 )
409
410 ELSE IF( itype.EQ.5 ) THEN
411
412
413
414 CALL pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
415 $ sizetms, iprepad, ipostpad, padval+2.0d+0 )
416
417 CALL pdlatms( n, n,
'S', iseed,
'S', work( indd ), imode,
418 $ cond, anorm, n, n, 'N', copya, 1, 1, desca,
419 $ order, work( indwork+iprepad ), sizetms,
420 $ iinfo )
421
422 CALL pdchekpad( desca( ctxt_ ),
'PDLATMS2-WORK', sizetms, 1,
423 $ work( indwork ), sizetms, iprepad, ipostpad,
424 $ padval+2.0d+0 )
425
426 wknown = .true.
427
428 ELSE IF( itype.EQ.8 ) THEN
429
430
431
432 np =
numroc( n, desca( mb_ ), myrow, 0, nprow )
433 nq =
numroc( n, desca( nb_ ), mycol, 0, npcol )
434 CALL pdmatgen( desca( ctxt_ ),
'S',
'N', n, n, desca( mb_ ),
435 $ desca( nb_ ), copya, desca( lld_ ),
436 $ desca( rsrc_ ), desca( csrc_ ), iseed( 1 ),
437 $ 0, np, 0, nq, myrow, mycol, nprow, npcol )
438 info = 0
439 wknown = .false.
440
441 ELSE IF( itype.EQ.9 ) THEN
442
443
444
445
446 CALL pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
447 $ sizetms, iprepad, ipostpad, padval+3.0d+0 )
448
449 CALL pdlatms( n, n,
'S', iseed,
'S', work( indd ), imode,
450 $ cond, anorm, n, n, 'N', copya, 1, 1, desca,
451 $ order, work( indwork+iprepad ), sizetms,
452 $ iinfo )
453
454 wknown = .true.
455
456 CALL pdchekpad( desca( ctxt_ ),
'PDLATMS3-WORK', sizetms, 1,
457 $ work( indwork ), sizetms, iprepad, ipostpad,
458 $ padval+3.0d+0 )
459
460 ELSE IF( itype.EQ.10 ) THEN
461
462
463
464
465 CALL pdlaset(
'All', n, n, zero, zero, copya, 1, 1, desca )
466 np =
numroc( n, desca( mb_ ), 0, 0, nprow )
467 nq =
numroc( n, desca( nb_ ), 0, 0, npcol )
469 ngen = 0
470 70 CONTINUE
471
472 IF( ngen.LT.n ) THEN
473 in =
min( 1+int(
dlaran( iseed )*dble( nloc ) ), n-ngen )
474
475 CALL dlatms( in, in,
'S', iseed,
'P', work( indd ),
476 $ imode, cond, anorm, 1, 1, 'N', a, lda,
477 $ work( indwork ), iinfo )
478
479 DO 80 i = 2, in
480 temp1 = abs( a( i-1, i ) ) /
481 $ sqrt( abs( a( i-1, i-1 )*a( i, i ) ) )
482 IF( temp1.GT.half ) THEN
483 a( i-1, i ) = half*sqrt( abs( a( i-1, i-1 )*a( i,
484 $ i ) ) )
485 a( i, i-1 ) = a( i-1, i )
486 END IF
487 80 CONTINUE
488 CALL pdelset( copya, ngen+1, ngen+1, desca, a( 1, 1 ) )
489 DO 90 i = 2, in
490 CALL pdelset( copya, ngen+i, ngen+i, desca,
491 $ a( i, i ) )
492 CALL pdelset( copya, ngen+i-1, ngen+i, desca,
493 $ a( i-1, i ) )
494 CALL pdelset( copya, ngen+i, ngen+i-1, desca,
495 $ a( i, i-1 ) )
496 90 CONTINUE
497 ngen = ngen + in
498 GO TO 70
499 END IF
500 wknown = .false.
501
502 ELSE IF( itype.EQ.11 ) THEN
503
504
505
506 ngen = 0
507 j = 1
508 temp1 = zero
509 100 CONTINUE
510 IF( ngen.LT.n ) THEN
511 in =
min( j, n-ngen )
512 DO 110 i = 0, in - 1
513 work( indd+ngen+i ) = temp1
514 110 CONTINUE
515 temp1 = temp1 + one
516 j = 2*j
517 ngen = ngen + in
518 GO TO 100
519 END IF
520
521
522 CALL pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
523 $ sizetms, iprepad, ipostpad, padval+4.0d+0 )
524
525 CALL pdlatms( n, n,
'S', iseed,
'S', work( indd ), imode,
526 $ cond, anorm, 0, 0, 'N', copya, 1, 1, desca,
527 $ order, work( indwork+iprepad ), sizetms,
528 $ iinfo )
529
530 CALL pdchekpad( desca( ctxt_ ),
'PDLATMS4-WORK', sizetms, 1,
531 $ work( indwork ), sizetms, iprepad, ipostpad,
532 $ padval+4.0d+0 )
533
534
535
536
537 wknown = .true.
538 ELSE
539 iinfo = 1
540 END IF
541
542 IF( wknown )
543 $ CALL dlasrt( 'I', n, work( indd ), iinfo )
544
545
546
547 CALL pdfillpad( desca( ctxt_ ), sizetms, 1, work( indwork ),
548 $ sizetms, iprepad, ipostpad, padval+3.3d+0 )
549
550 anorm = one
551
552
553
554 iseed( 4 ) = mod( iseed( 4 )+257, 4096 )
555 iseed( 3 ) = mod( iseed( 3 )+192, 4096 )
556 iseed( 2 ) = mod( iseed( 2 )+35, 4096 )
557 iseed( 1 ) = mod( iseed( 1 )+128, 4096 )
558 CALL pdlatms( n, n,
'S', iseed,
'P', work( indd ), 3, ten,
559 $ anorm, n, n, 'N', copyb, 1, 1, desca, order,
560 $ work( indwork+iprepad ), sizetms, iinfo )
561
562 CALL pdchekpad( desca( ctxt_ ),
'PDLATMS5-WORK', sizetms, 1,
563 $ work( indwork ), sizetms, iprepad, ipostpad,
564 $ padval+3.3d+0 )
565
566
567
568
569 il = -1
570 iu = -2
571 vl = one
572 vu = -one
573
575 $ iseed, work( indd ), maxsize, vecsize,
576 $ valsize )
577
578 lsyevxsize =
min( maxsize, lwork )
579 wknown = .false.
580
581 CALL pdgsepsubtst( wknown, ibtype,
'v',
'a', uplo, n, vl, vu,
582 $ il, iu, thresh, abstol, a, copya, b, copyb,
583 $ z, 1, 1, desca, work( indd ), win, ifail,
584 $ iclustr, gap, iprepad, ipostpad,
585 $ work( indwork ), llwork, lsyevxsize, iwork,
586 $ isizesyevx, res, tstnrm, qtqnrm, nout )
587
588
589
590 maxtstnrm = tstnrm
591 maxqtqnrm = qtqnrm
592
593 IF( thresh.LE.zero ) THEN
594 passed = 'SKIPPED '
595 info = 2
596 ELSE IF( res.NE.0 ) THEN
597 passed = 'FAILED '
598 info = 1
599 END IF
600 END IF
601
602 IF( thresh.GT.zero .AND.
lsame( subtests,
'Y' ) )
THEN
603
604
605
606 IF( info.EQ.0 ) THEN
607
608 jobz = 'V'
609 range = 'A'
611 $ iseed, win( 1+iprepad ), maxsize,
612 $ vecsize, valsize )
613
614 lsyevxsize = vecsize
615
616 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
617 $ vu, il, iu, thresh, abstol, a, copya, b,
618 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
619 $ wnew, ifail, iclustr, gap, iprepad,
620 $ ipostpad, work( indwork ), llwork,
621 $ lsyevxsize, iwork, isizesyevx, res,
622 $ tstnrm, qtqnrm, nout )
623
624 IF( res.NE.0 ) THEN
625 passed = 'FAILED stest 1'
626 maxtstnrm =
max( tstnrm, maxtstnrm )
627 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
628 info = 1
629 END IF
630 END IF
631
632
633
634 IF( info.EQ.0 ) THEN
635 jobz = 'V'
636 range = 'A'
638 $ iseed, win( 1+iprepad ), maxsize,
639 $ vecsize, valsize )
640
641 lsyevxsize = vecsize + int(
dlaran( iseed )*
642 $ dble( maxsize-vecsize ) )
643
644 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
645 $ vu, il, iu, thresh, abstol, a, copya, b,
646 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
647 $ wnew, ifail, iclustr, gap, iprepad,
648 $ ipostpad, work( indwork ), llwork,
649 $ lsyevxsize, iwork, isizesyevx, res,
650 $ tstnrm, qtqnrm, nout )
651
652 IF( res.NE.0 ) THEN
653 passed = 'FAILED stest 2'
654 maxtstnrm =
max( tstnrm, maxtstnrm )
655 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
656 info = 1
657 END IF
658 END IF
659
660
661
662 IF( info.EQ.0 ) THEN
663
664 jobz = 'N'
665 range = 'A'
667 $ iseed, win( 1+iprepad ), maxsize,
668 $ vecsize, valsize )
669
670 lsyevxsize = valsize
671 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
672 $ vu, il, iu, thresh, abstol, a, copya, b,
673 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
674 $ wnew, ifail, iclustr, gap, iprepad,
675 $ ipostpad, work( indwork ), llwork,
676 $ lsyevxsize, iwork, isizesyevx, res,
677 $ tstnrm, qtqnrm, nout )
678
679 IF( res.NE.0 ) THEN
680 maxtstnrm =
max( tstnrm, maxtstnrm )
681 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
682 passed = 'FAILED stest 3'
683 info = 1
684 END IF
685 END IF
686
687
688
689 IF( info.EQ.0 ) THEN
690
691 il = -1
692 iu = -1
693 jobz = 'N'
694 range = 'I'
695
696
697
699 $ iseed, win( 1+iprepad ), maxsize,
700 $ vecsize, valsize )
701
702 lsyevxsize = valsize
703
704 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
705 $ vu, il, iu, thresh, abstol, a, copya, b,
706 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
707 $ wnew, ifail, iclustr, gap, iprepad,
708 $ ipostpad, work( indwork ), llwork,
709 $ lsyevxsize, iwork, isizesyevx, res,
710 $ tstnrm, qtqnrm, nout )
711
712 IF( res.NE.0 ) THEN
713 maxtstnrm =
max( tstnrm, maxtstnrm )
714 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
715 passed = 'FAILED stest 4'
716 info = 1
717 END IF
718 END IF
719
720
721
722 IF( info.EQ.0 ) THEN
723
724 il = -1
725 iu = -1
726 jobz = 'V'
727 range = 'I'
728
729
730
732 $ iseed, win( 1+iprepad ), maxsize,
733 $ vecsize, valsize )
734
735 lsyevxsize = maxsize
736
737 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
738 $ vu, il, iu, thresh, abstol, a, copya, b,
739 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
740 $ wnew, ifail, iclustr, gap, iprepad,
741 $ ipostpad, work( indwork ), llwork,
742 $ lsyevxsize, iwork, isizesyevx, res,
743 $ tstnrm, qtqnrm, nout )
744
745 IF( res.NE.0 ) THEN
746 maxtstnrm =
max( tstnrm, maxtstnrm )
747 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
748 passed = 'FAILED stest 5'
749 info = 1
750 END IF
751 END IF
752
753
754
755 IF( info.EQ.0 ) THEN
756 il = -1
757 iu = -1
758 jobz = 'V'
759 range = 'I'
760
761
762
764 $ iseed, win( 1+iprepad ), maxsize,
765 $ vecsize, valsize )
766
767 lsyevxsize = vecsize
768
769 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
770 $ vu, il, iu, thresh, abstol, a, copya, b,
771 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
772 $ wnew, ifail, iclustr, gap, iprepad,
773 $ ipostpad, work( indwork ), llwork,
774 $ lsyevxsize, iwork, isizesyevx, res,
775 $ tstnrm, qtqnrm, nout )
776
777 IF( res.NE.0 ) THEN
778 maxtstnrm =
max( tstnrm, maxtstnrm )
779 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
780 passed = 'FAILED stest 6'
781 info = 1
782 END IF
783 END IF
784
785
786
787 IF( info.EQ.0 ) THEN
788 il = -1
789 iu = -1
790 jobz = 'V'
791 range = 'I'
792
793
794
796 $ iseed, win( 1+iprepad ), maxsize,
797 $ vecsize, valsize )
798 lsyevxsize = vecsize + int(
dlaran( iseed )*
799 $ dble( maxsize-vecsize ) )
800
801 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
802 $ vu, il, iu, thresh, abstol, a, copya, b,
803 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
804 $ wnew, ifail, iclustr, gap, iprepad,
805 $ ipostpad, work( indwork ), llwork,
806 $ lsyevxsize, iwork, isizesyevx, res,
807 $ tstnrm, qtqnrm, nout )
808
809 IF( res.NE.0 ) THEN
810 maxtstnrm =
max( tstnrm, maxtstnrm )
811 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
812 passed = 'FAILED stest 7'
813 info = 1
814 END IF
815 END IF
816
817
818
819 IF( info.EQ.0 ) THEN
820 vl = one
821 vu = -one
822 jobz = 'N'
823 range = 'V'
824
825
826
828 $ iseed, win( 1+iprepad ), maxsize,
829 $ vecsize, valsize )
830
831 lsyevxsize = valsize
832
833 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
834 $ vu, il, iu, thresh, abstol, a, copya, b,
835 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
836 $ wnew, ifail, iclustr, gap, iprepad,
837 $ ipostpad, work( indwork ), llwork,
838 $ lsyevxsize, iwork, isizesyevx, res,
839 $ tstnrm, qtqnrm, nout )
840
841 IF( res.NE.0 ) THEN
842 maxtstnrm =
max( tstnrm, maxtstnrm )
843 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
844 passed = 'FAILED stest 8'
845 info = 1
846 END IF
847 END IF
848
849
850
851 IF( info.EQ.0 ) THEN
852 vl = one
853 vu = -one
854 jobz = 'V'
855 range = 'V'
856
857
858
860 $ iseed, win( 1+iprepad ), maxsize,
861 $ vecsize, valsize )
862
863 lsyevxsize = maxsize
864
865 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
866 $ vu, il, iu, thresh, abstol, a, copya, b,
867 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
868 $ wnew, ifail, iclustr, gap, iprepad,
869 $ ipostpad, work( indwork ), llwork,
870 $ lsyevxsize, iwork, isizesyevx, res,
871 $ tstnrm, qtqnrm, nout )
872
873 IF( res.NE.0 ) THEN
874 maxtstnrm =
max( tstnrm, maxtstnrm )
875 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
876 passed = 'FAILED stest 9'
877 info = 1
878 END IF
879 END IF
880
881
882
883
884 IF( info.EQ.0 ) THEN
885 vl = one
886 vu = -one
887 jobz = 'V'
888 range = 'V'
889
890
891
893 $ iseed, win( 1+iprepad ), maxsize,
894 $ vecsize, valsize )
895
896 lsyevxsize = vecsize
897
898 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
899 $ vu, il, iu, thresh, abstol, a, copya, b,
900 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
901 $ wnew, ifail, iclustr, gap, iprepad,
902 $ ipostpad, work( indwork ), llwork,
903 $ lsyevxsize, iwork, isizesyevx, res,
904 $ tstnrm, qtqnrm, nout )
905
906 IF( res.NE.0 ) THEN
907 maxtstnrm =
max( tstnrm, maxtstnrm )
908 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
909 passed = 'FAILED stest10'
910 info = 1
911 END IF
912 END IF
913
914
915
916
917
918 IF( info.EQ.0 ) THEN
919 vl = one
920 vu = -one
921 jobz = 'V'
922 range = 'V'
923
924
925
927 $ iseed, win( 1+iprepad ), maxsize,
928 $ vecsize, valsize )
929
930 lsyevxsize = vecsize + int(
dlaran( iseed )*
931 $ dble( maxsize-vecsize ) )
932
933 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
934 $ vu, il, iu, thresh, abstol, a, copya, b,
935 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
936 $ wnew, ifail, iclustr, gap, iprepad,
937 $ ipostpad, work( indwork ), llwork,
938 $ lsyevxsize, iwork, isizesyevx, res,
939 $ tstnrm, qtqnrm, nout )
940
941 IF( res.NE.0 ) THEN
942 maxtstnrm =
max( tstnrm, maxtstnrm )
943 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
944 passed = 'FAILED stest11'
945 info = 1
946 END IF
947 END IF
948
949
950
951
952 IF( info.EQ.0 ) THEN
953 vl = one
954 vu = -one
955 jobz = 'V'
956 range = 'V'
957
958
959
961 $ iseed, win( 1+iprepad ), maxsize,
962 $ vecsize, valsize )
963
964 lsyevxsize = valsize
965
966 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
967 $ vu, il, iu, thresh, abstol, a, copya, b,
968 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
969 $ wnew, ifail, iclustr, gap, iprepad,
970 $ ipostpad, work( indwork ), llwork,
971 $ lsyevxsize, iwork, isizesyevx, res,
972 $ tstnrm, qtqnrm, nout )
973
974 IF( res.NE.0 ) THEN
975 maxtstnrm =
max( tstnrm, maxtstnrm )
976 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
977 passed = 'FAILED stest12'
978 info = 1
979 END IF
980 END IF
981
982
983
984
985
986 IF( info.EQ.0 ) THEN
987 vl = one
988 vu = -one
989 jobz = 'V'
990 range = 'V'
991
992
993
995 $ iseed, win( 1+iprepad ), maxsize,
996 $ vecsize, valsize )
997
998 lsyevxsize = valsize + int(
dlaran( iseed )*
999 $ dble( vecsize-valsize ) )
1000
1001 CALL pdgsepsubtst( .true., ibtype, jobz, range, uplo, n, vl,
1002 $ vu, il, iu, thresh, abstol, a, copya, b,
1003 $ copyb, z, 1, 1, desca, win( 1+iprepad ),
1004 $ wnew, ifail, iclustr, gap, iprepad,
1005 $ ipostpad, work( indwork ), llwork,
1006 $ lsyevxsize, iwork, isizesyevx, res,
1007 $ tstnrm, qtqnrm, nout )
1008
1009 IF( res.NE.0 ) THEN
1010 maxtstnrm =
max( tstnrm, maxtstnrm )
1011 maxqtqnrm =
max( qtqnrm, maxqtqnrm )
1012 passed = 'FAILED stest13'
1013 info = 1
1014 END IF
1015 END IF
1016 END IF
1017
1018
1019
1020 CALL igamx2d( context, 'All', ' ', 1, 1, info, 1, -1, -1, -1, -1,
1021 $ -1 )
1022
1023 IF( info.EQ.1 ) THEN
1024 IF( iam.EQ.0 ) THEN
1025 WRITE( nout, fmt = 9994 )'C '
1026 WRITE( nout, fmt = 9993 )iseedin( 1 )
1027 WRITE( nout, fmt = 9992 )iseedin( 2 )
1028 WRITE( nout, fmt = 9991 )iseedin( 3 )
1029 WRITE( nout, fmt = 9990 )iseedin( 4 )
1030 IF(
lsame( uplo,
'L' ) )
THEN
1031 WRITE( nout, fmt = 9994 )' UPLO= ''L'' '
1032 ELSE
1033 WRITE( nout, fmt = 9994 )' UPLO= ''U'' '
1034 END IF
1035 IF(
lsame( subtests,
'Y' ) )
THEN
1036 WRITE( nout, fmt = 9994 )' SUBTESTS= ''Y'' '
1037 ELSE
1038 WRITE( nout, fmt = 9994 )' SUBTESTS= ''N'' '
1039 END IF
1040 WRITE( nout, fmt = 9989 )n
1041 WRITE( nout, fmt = 9988 )nprow
1042 WRITE( nout, fmt = 9987 )npcol
1043 WRITE( nout, fmt = 9986 )nb
1044 WRITE( nout, fmt = 9985 )mattype
1045 WRITE( nout, fmt = 9984 )ibtype
1046 WRITE( nout, fmt = 9982 )abstol
1047 WRITE( nout, fmt = 9981 )thresh
1048 WRITE( nout, fmt = 9994 )'C '
1049 END IF
1050 END IF
1051
1052 CALL slcombine( context,
'All',
'>',
'W', 6, 1, wtime )
1053 CALL slcombine( context,
'All',
'>',
'C', 6, 1, ctime )
1054 IF( iam.EQ.0 ) THEN
1055 IF( info.EQ.0 .OR. info.EQ.1 ) THEN
1056 IF( wtime( 1 ).GE.0.0 ) THEN
1057 WRITE( nout, fmt = 9999 )n, nb, nprow, npcol, mattype,
1058 $ ibtype, subtests, wtime( 1 ), ctime( 1 ), maxtstnrm,
1059 $ passed
1060 ELSE
1061 WRITE( nout, fmt = 9998 )n, nb, nprow, npcol, mattype,
1062 $ ibtype, subtests, ctime( 1 ), maxtstnrm, passed
1063 END IF
1064 ELSE IF( info.EQ.2 ) THEN
1065 IF( wtime( 1 ).GE.0.0 ) THEN
1066 WRITE( nout, fmt = 9997 )n, nb, nprow, npcol, mattype,
1067 $ ibtype, subtests, wtime( 1 ), ctime( 1 )
1068 ELSE
1069 WRITE( nout, fmt = 9996 )n, nb, nprow, npcol, mattype,
1070 $ ibtype, subtests, ctime( 1 )
1071 END IF
1072 ELSE IF( info.EQ.3 ) THEN
1073 WRITE( nout, fmt = 9995 )n, nb, nprow, npcol, mattype,
1074 $ ibtype, subtests
1075 END IF
1076 END IF
1077
1078 120 CONTINUE
1079
1080 RETURN
1081 9999 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1082 $ 1x, f8.2, 1x, f8.2, 1x, g9.2, 1x, a14 )
1083 9998 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1084 $ 1x, 8x, 1x, f8.2, 1x, g9.2, a14 )
1085 9997 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1086 $ 1x, f8.2, 1x, f8.2, 11x, 'Bypassed' )
1087 9996 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1088 $ 1x, 8x, 1x, f8.2, 11x, 'Bypassed' )
1089 9995 FORMAT( 1x, i5, 1x, i3, 1x, i3, 1x, i3, 1x, i3, 3x, i3, 4x, a1,
1090 $ 22x, 'Bad MEMORY parameters' )
1091 9994 FORMAT( a )
1092 9993 FORMAT( ' ISEED( 1 ) =', i8 )
1093 9992 FORMAT( ' ISEED( 2 ) =', i8 )
1094 9991 FORMAT( ' ISEED( 3 ) =', i8 )
1095 9990 FORMAT( ' ISEED( 4 ) =', i8 )
1096 9989 FORMAT( ' N=', i8 )
1097 9988 FORMAT( ' NPROW=', i8 )
1098 9987 FORMAT( ' NPCOL=', i8 )
1099 9986 FORMAT( ' NB=', i8 )
1100 9985 FORMAT( ' MATTYPE=', i8 )
1101 9984 FORMAT( ' IBTYPE=', i8 )
1102 9983 FORMAT( ' SUBTESTS=', a1 )
1103 9982 FORMAT( ' ABSTOL=', d16.6 )
1104 9981 FORMAT( ' THRESH=', d16.6 )
1105 9980 FORMAT( ' Increase TOTMEM in PDGSEPDRIVER' )
1106
1107
1108
subroutine pdmatgen(ictxt, aform, diag, m, n, mb, nb, a, lda, iarow, iacol, iseed, iroff, irnum, icoff, icnum, myrow, mycol, nprow, npcol)
subroutine dlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
integer function numroc(n, nb, iproc, isrcproc, nprocs)
subroutine pdlaset(uplo, m, n, alpha, beta, a, ia, ja, desca)
double precision function pdlamch(ictxt, cmach)
subroutine pdchekpad(ictxt, mess, m, n, a, lda, ipre, ipost, chkval)
subroutine pdelset(a, ia, ja, desca, alpha)
subroutine pdfillpad(ictxt, m, n, a, lda, ipre, ipost, chkval)
subroutine pdgsepsubtst(wknown, ibtype, jobz, range, uplo, n, vl, vu, il, iu, thresh, abstol, a, copya, b, copyb, z, ia, ja, desca, win, wnew, ifail, iclustr, gap, iprepad, ipostpad, work, lwork, lwork1, iwork, liwork, result, tstnrm, qtqnrm, nout)
subroutine pdlasizegsep(desca, iprepad, ipostpad, sizemqrleft, sizemqrright, sizeqrf, sizetms, sizeqtq, sizechk, sizesyevx, isizesyevx, sizesubtst, isizesubtst, sizetst, isizetst)
subroutine pdlasizesyevx(wknown, range, n, desca, vl, vu, il, iu, iseed, win, maxsize, vecsize, valsize)
subroutine pdlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, ia, ja, desca, order, work, lwork, info)
subroutine slcombine(ictxt, scope, op, timetype, n, ibeg, times)