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