SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
pzblas3tim.f
Go to the documentation of this file.
1 BLOCK DATA
2 INTEGER NSUBS
3 parameter(nsubs = 11)
4 CHARACTER*7 SNAMES( NSUBS )
5 COMMON /snamec/snames
6 DATA snames/'PZGEMM ', 'PZSYMM ', 'PZHEMM ',
7 $ 'PZSYRK ', 'PZHERK ', 'PZSYR2K',
8 $ 'PZHER2K', 'PZTRMM ', 'PZTRSM ',
9 $ 'PZGEADD', 'PZTRADD'/
10 END BLOCK DATA
11
12 PROGRAM pzbla3tim
13*
14* -- PBLAS timing driver (version 2.0.2) --
15* Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver
16* May 1 2012
17*
18* Purpose
19* =======
20*
21* PZBLA3TIM is the main timing program for the Level 3 PBLAS routines.
22*
23* The program must be driven by a short data file. An annotated exam-
24* ple of a data file can be obtained by deleting the first 3 characters
25* from the following 59 lines:
26* 'Level 3 PBLAS, Timing input file'
27* 'Intel iPSC/860 hypercube, gamma model.'
28* 'PZBLAS3TIM.SUMM' output file name (if any)
29* 6 device out
30* 10 value of the logical computational blocksize NB
31* 1 number of process grids (ordered pairs of P & Q)
32* 2 2 1 4 2 3 8 values of P
33* 2 2 4 1 3 2 1 values of Q
34* (1.0D0, 0.0D0) value of ALPHA
35* (1.0D0, 0.0D0) value of BETA
36* 2 number of tests problems
37* 'N' 'U' values of DIAG
38* 'L' 'R' values of SIDE
39* 'N' 'T' values of TRANSA
40* 'N' 'T' values of TRANSB
41* 'U' 'L' values of UPLO
42* 3 4 values of M
43* 3 4 values of N
44* 3 4 values of K
45* 6 10 values of M_A
46* 6 10 values of N_A
47* 2 5 values of IMB_A
48* 2 5 values of INB_A
49* 2 5 values of MB_A
50* 2 5 values of NB_A
51* 0 1 values of RSRC_A
52* 0 0 values of CSRC_A
53* 1 1 values of IA
54* 1 1 values of JA
55* 6 10 values of M_B
56* 6 10 values of N_B
57* 2 5 values of IMB_B
58* 2 5 values of INB_B
59* 2 5 values of MB_B
60* 2 5 values of NB_B
61* 0 1 values of RSRC_B
62* 0 0 values of CSRC_B
63* 1 1 values of IB
64* 1 1 values of JB
65* 6 10 values of M_C
66* 6 10 values of N_C
67* 2 5 values of IMB_C
68* 2 5 values of INB_C
69* 2 5 values of MB_C
70* 2 5 values of NB_C
71* 0 1 values of RSRC_C
72* 0 0 values of CSRC_C
73* 1 1 values of IC
74* 1 1 values of JC
75* PZGEMM T put F for no test in the same column
76* PZSYMM T put F for no test in the same column
77* PZHEMM T put F for no test in the same column
78* PZSYRK T put F for no test in the same column
79* PZHERK T put F for no test in the same column
80* PZSYR2K T put F for no test in the same column
81* PZHER2K T put F for no test in the same column
82* PZTRMM T put F for no test in the same column
83* PZTRSM T put F for no test in the same column
84* PZGEADD T put F for no test in the same column
85* PZTRADD T put F for no test in the same column
86*
87* Internal Parameters
88* ===================
89*
90* TOTMEM INTEGER
91* TOTMEM is a machine-specific parameter indicating the maxi-
92* mum amount of available memory per process in bytes. The
93* user should customize TOTMEM to his platform. Remember to
94* leave room in memory for the operating system, the BLACS
95* buffer, etc. For example, on a system with 8 MB of memory
96* per process (e.g., one processor on an Intel iPSC/860), the
97* parameters we use are TOTMEM=6200000 (leaving 1.8 MB for OS,
98* code, BLACS buffer, etc). However, for PVM, we usually set
99* TOTMEM = 2000000. Some experimenting with the maximum value
100* of TOTMEM may be required. By default, TOTMEM is 2000000.
101*
102* DBLESZ INTEGER
103* ZPLXSZ INTEGER
104* DBLESZ and ZPLXSZ indicate the length in bytes on the given
105* platform for a double precision real and a double precision
106* complex. By default, DBLESZ is set to eight and ZPLXSZ is set
107* to sixteen.
108*
109* MEM COMPLEX*16 array
110* MEM is an array of dimension TOTMEM / ZPLXSZ.
111* All arrays used by SCALAPACK routines are allocated from this
112* array MEM and referenced by pointers. The integer IPA, for
113* example, is a pointer to the starting element of MEM for the
114* matrix A.
115*
116* -- Written on April 1, 1998 by
117* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
118*
119* =====================================================================
120*
121* .. Parameters ..
122 INTEGER maxtests, maxgrids, zplxsz, totmem, memsiz,
123 $ nsubs
124 COMPLEX*16 one
125 parameter( maxtests = 20, maxgrids = 20, zplxsz = 16,
126 $ one = ( 1.0d+0, 0.0d+0 ), totmem = 2000000,
127 $ nsubs = 11, memsiz = totmem / zplxsz )
128 INTEGER block_cyclic_2d_inb, csrc_, ctxt_, dlen_,
129 $ dtype_, imb_, inb_, lld_, mb_, m_, nb_, n_,
130 $ rsrc_
131 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
132 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
133 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
134 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
135* ..
136* .. Local Scalars ..
137 CHARACTER*1 adiagdo, aform, cform, diag, side, transa,
138 $ transb, uplo
139 INTEGER csrca, csrcb, csrcc, i, ia, iam, iaseed, ib,
140 $ ibseed, ic, icseed, ictxt, imba, imbb, imbc,
141 $ imida, imidb, imidc, inba, inbb, inbc, ipa,
142 $ ipb, ipc, iposta, ipostb, ipostc, iprea, ipreb,
143 $ iprec, j, ja, jb, jc, k, l, m, ma, mb, mba,
144 $ mbb, mbc, mc, memreqd, mpa, mpb, mpc, mycol,
145 $ myrow, n, na, nb, nba, nbb, nbc, nc, ncola,
146 $ ncolb, ncolc, ngrids, nout, npcol, nprocs,
147 $ nprow, nqa, nqb, nqc, nrowa, nrowb, nrowc,
148 $ ntests, offda, offdc, rsrca, rsrcb, rsrcc
149 DOUBLE PRECISION cflops, nops, wflops
150 COMPLEX*16 alpha, beta, scale
151* ..
152* .. Local Arrays ..
153 LOGICAL ltest( nsubs ), bcheck( nsubs ),
154 $ ccheck( nsubs )
155 CHARACTER*1 diagval( maxtests ), sideval( maxtests ),
156 $ trnaval( maxtests ), trnbval( maxtests ),
157 $ uploval( maxtests )
158 CHARACTER*80 outfile
159 INTEGER cscaval( maxtests ), cscbval( maxtests ),
160 $ csccval( maxtests ), desca( dlen_ ),
161 $ descb( dlen_ ), descc( dlen_ ),
162 $ iaval( maxtests ), ibval( maxtests ),
163 $ icval( maxtests ), ierr( 3 ),
164 $ imbaval( maxtests ), imbbval( maxtests ),
165 $ imbcval( maxtests ), inbaval( maxtests ),
166 $ inbbval( maxtests ), inbcval( maxtests ),
167 $ javal( maxtests ), jbval( maxtests ),
168 $ jcval( maxtests ), kval( maxtests ),
169 $ maval( maxtests ), mbaval( maxtests ),
170 $ mbbval( maxtests ), mbcval( maxtests ),
171 $ mbval( maxtests ), mcval( maxtests ),
172 $ mval( maxtests ), naval( maxtests ),
173 $ nbaval( maxtests ), nbbval( maxtests ),
174 $ nbcval( maxtests ), nbval( maxtests ),
175 $ ncval( maxtests ), nval( maxtests ),
176 $ pval( maxtests ), qval( maxtests ),
177 $ rscaval( maxtests ), rscbval( maxtests ),
178 $ rsccval( maxtests )
179 DOUBLE PRECISION ctime( 1 ), wtime( 1 )
180 COMPLEX*16 mem( memsiz )
181* ..
182* .. External Subroutines ..
183 EXTERNAL blacs_barrier, blacs_exit, blacs_get,
184 $ blacs_gridexit, blacs_gridinfo, blacs_gridinit,
185 $ blacs_pinfo, igsum2d, pb_boot, pb_combine,
187 $ pzgeadd, pzgemm, pzhemm, pzher2k, pzherk,
188 $ pzlagen, pzlascal, pzsymm, pzsyr2k, pzsyrk,
189 $ pztradd, pztrmm, pztrsm
190* ..
191* .. External Functions ..
192 LOGICAL lsame
193 DOUBLE PRECISION pdopbl3
194 EXTERNAL lsame, pdopbl3
195* ..
196* .. Intrinsic Functions ..
197 INTRINSIC dble, dcmplx, max
198* ..
199* .. Common Blocks ..
200 CHARACTER*7 snames( nsubs )
201 LOGICAL abrtflg
202 INTEGER info, nblog
203 COMMON /snamec/snames
204 COMMON /infoc/info, nblog
205 COMMON /pberrorc/nout, abrtflg
206* ..
207* .. Data Statements ..
208 DATA bcheck/.true., .true., .true., .false.,
209 $ .false., .true., .true., .true., .true.,
210 $ .false., .false./
211 DATA ccheck/.true., .true., .true., .true., .true.,
212 $ .true., .true., .false., .false., .true.,
213 $ .true./
214* ..
215* .. Executable Statements ..
216*
217* Initialization
218*
219* Set flag so that the PBLAS error handler won't abort on errors, so
220* that the tester will detect unsupported operations.
221*
222 abrtflg = .false.
223*
224* Seeds for random matrix generations.
225*
226 iaseed = 100
227 ibseed = 200
228 icseed = 300
229*
230* Get starting information
231*
232 CALL blacs_pinfo( iam, nprocs )
233 CALL pzbla3timinfo( outfile, nout, ntests, diagval, sideval,
234 $ trnaval, trnbval, uploval, mval, nval,
235 $ kval, maval, naval, imbaval, mbaval,
236 $ inbaval, nbaval, rscaval, cscaval, iaval,
237 $ javal, mbval, nbval, imbbval, mbbval,
238 $ inbbval, nbbval, rscbval, cscbval, ibval,
239 $ jbval, mcval, ncval, imbcval, mbcval,
240 $ inbcval, nbcval, rsccval, csccval, icval,
241 $ jcval, maxtests, ngrids, pval, maxgrids,
242 $ qval, maxgrids, nblog, ltest, iam, nprocs,
243 $ alpha, beta, mem )
244*
245 IF( iam.EQ.0 )
246 $ WRITE( nout, fmt = 9984 )
247*
248* Loop over different process grids
249*
250 DO 60 i = 1, ngrids
251*
252 nprow = pval( i )
253 npcol = qval( i )
254*
255* Make sure grid information is correct
256*
257 ierr( 1 ) = 0
258 IF( nprow.LT.1 ) THEN
259 IF( iam.EQ.0 )
260 $ WRITE( nout, fmt = 9999 ) 'GRID SIZE', 'NPROW', nprow
261 ierr( 1 ) = 1
262 ELSE IF( npcol.LT.1 ) THEN
263 IF( iam.EQ.0 )
264 $ WRITE( nout, fmt = 9999 ) 'GRID SIZE', 'NPCOL', npcol
265 ierr( 1 ) = 1
266 ELSE IF( nprow*npcol.GT.nprocs ) THEN
267 IF( iam.EQ.0 )
268 $ WRITE( nout, fmt = 9998 ) nprow*npcol, nprocs
269 ierr( 1 ) = 1
270 END IF
271*
272 IF( ierr( 1 ).GT.0 ) THEN
273 IF( iam.EQ.0 )
274 $ WRITE( nout, fmt = 9997 ) 'GRID'
275 GO TO 60
276 END IF
277*
278* Define process grid
279*
280 CALL blacs_get( -1, 0, ictxt )
281 CALL blacs_gridinit( ictxt, 'Row-major', nprow, npcol )
282 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
283*
284* Go to bottom of process grid loop if this case doesn't use my
285* process
286*
287 IF( myrow.GE.nprow .OR. mycol.GE.npcol )
288 $ GO TO 60
289*
290* Loop over number of tests
291*
292 DO 50 j = 1, ntests
293*
294* Get the test parameters
295*
296 diag = diagval( j )
297 side = sideval( j )
298 transa = trnaval( j )
299 transb = trnbval( j )
300 uplo = uploval( j )
301*
302 m = mval( j )
303 n = nval( j )
304 k = kval( j )
305*
306 ma = maval( j )
307 na = naval( j )
308 imba = imbaval( j )
309 mba = mbaval( j )
310 inba = inbaval( j )
311 nba = nbaval( j )
312 rsrca = rscaval( j )
313 csrca = cscaval( j )
314 ia = iaval( j )
315 ja = javal( j )
316*
317 mb = mbval( j )
318 nb = nbval( j )
319 imbb = imbbval( j )
320 mbb = mbbval( j )
321 inbb = inbbval( j )
322 nbb = nbbval( j )
323 rsrcb = rscbval( j )
324 csrcb = cscbval( j )
325 ib = ibval( j )
326 jb = jbval( j )
327*
328 mc = mcval( j )
329 nc = ncval( j )
330 imbc = imbcval( j )
331 mbc = mbcval( j )
332 inbc = inbcval( j )
333 nbc = nbcval( j )
334 rsrcc = rsccval( j )
335 csrcc = csccval( j )
336 ic = icval( j )
337 jc = jcval( j )
338*
339 IF( iam.EQ.0 ) THEN
340*
341 WRITE( nout, fmt = * )
342 WRITE( nout, fmt = 9996 ) j, nprow, npcol
343 WRITE( nout, fmt = * )
344*
345 WRITE( nout, fmt = 9995 )
346 WRITE( nout, fmt = 9994 )
347 WRITE( nout, fmt = 9995 )
348 WRITE( nout, fmt = 9993 ) m, n, k, side, uplo, transa,
349 $ transb, diag
350*
351 WRITE( nout, fmt = 9995 )
352 WRITE( nout, fmt = 9992 )
353 WRITE( nout, fmt = 9995 )
354 WRITE( nout, fmt = 9991 ) ia, ja, ma, na, imba, inba,
355 $ mba, nba, rsrca, csrca
356*
357 WRITE( nout, fmt = 9995 )
358 WRITE( nout, fmt = 9990 )
359 WRITE( nout, fmt = 9995 )
360 WRITE( nout, fmt = 9991 ) ib, jb, mb, nb, imbb, inbb,
361 $ mbb, nbb, rsrcb, csrcb
362*
363 WRITE( nout, fmt = 9995 )
364 WRITE( nout, fmt = 9989 )
365 WRITE( nout, fmt = 9995 )
366 WRITE( nout, fmt = 9991 ) ic, jc, mc, nc, imbc, inbc,
367 $ mbc, nbc, rsrcc, csrcc
368*
369 WRITE( nout, fmt = 9995 )
370 WRITE( nout, fmt = 9980 )
371*
372 END IF
373*
374* Check the validity of the input test parameters
375*
376 IF( .NOT.lsame( side, 'L' ).AND.
377 $ .NOT.lsame( side, 'R' ) ) THEN
378 IF( iam.EQ.0 )
379 $ WRITE( nout, fmt = 9997 ) 'SIDE'
380 GO TO 40
381 END IF
382*
383 IF( .NOT.lsame( uplo, 'U' ).AND.
384 $ .NOT.lsame( uplo, 'L' ) ) THEN
385 IF( iam.EQ.0 )
386 $ WRITE( nout, fmt = 9997 ) 'UPLO'
387 GO TO 40
388 END IF
389*
390 IF( .NOT.lsame( transa, 'N' ).AND.
391 $ .NOT.lsame( transa, 'T' ).AND.
392 $ .NOT.lsame( transa, 'C' ) ) THEN
393 IF( iam.EQ.0 )
394 $ WRITE( nout, fmt = 9997 ) 'TRANSA'
395 GO TO 40
396 END IF
397*
398 IF( .NOT.lsame( transb, 'N' ).AND.
399 $ .NOT.lsame( transb, 'T' ).AND.
400 $ .NOT.lsame( transb, 'C' ) ) THEN
401 IF( iam.EQ.0 )
402 $ WRITE( nout, fmt = 9997 ) 'TRANSB'
403 GO TO 40
404 END IF
405*
406 IF( .NOT.lsame( diag , 'U' ).AND.
407 $ .NOT.lsame( diag , 'N' ) )THEN
408 IF( iam.EQ.0 )
409 $ WRITE( nout, fmt = 9997 ) 'DIAG'
410 GO TO 40
411 END IF
412*
413* Check and initialize the matrix descriptors
414*
415 CALL pmdescchk( ictxt, nout, 'A', desca,
416 $ block_cyclic_2d_inb, ma, na, imba, inba,
417 $ mba, nba, rsrca, csrca, mpa, nqa, iprea,
418 $ imida, iposta, 0, 0, ierr( 1 ) )
419*
420 CALL pmdescchk( ictxt, nout, 'B', descb,
421 $ block_cyclic_2d_inb, mb, nb, imbb, inbb,
422 $ mbb, nbb, rsrcb, csrcb, mpb, nqb, ipreb,
423 $ imidb, ipostb, 0, 0, ierr( 2 ) )
424*
425 CALL pmdescchk( ictxt, nout, 'C', descc,
426 $ block_cyclic_2d_inb, mc, nc, imbc, inbc,
427 $ mbc, nbc, rsrcc, csrcc, mpc, nqc, iprec,
428 $ imidc, ipostc, 0, 0, ierr( 3 ) )
429*
430 IF( ierr( 1 ).GT.0 .OR. ierr( 2 ).GT.0 .OR.
431 $ ierr( 3 ).GT.0 ) THEN
432 GO TO 40
433 END IF
434*
435* Assign pointers into MEM for matrices corresponding to
436* the distributed matrices A, X and Y.
437*
438 ipa = iprea + 1
439 ipb = ipa + desca( lld_ )*nqa
440 ipc = ipb + descb( lld_ )*nqb
441*
442* Check if sufficient memory.
443*
444 memreqd = ipc + descc( lld_ )*nqc - 1
445 ierr( 1 ) = 0
446 IF( memreqd.GT.memsiz ) THEN
447 IF( iam.EQ.0 )
448 $ WRITE( nout, fmt = 9987 ) memreqd*zplxsz
449 ierr( 1 ) = 1
450 END IF
451*
452* Check all processes for an error
453*
454 CALL igsum2d( ictxt, 'All', ' ', 1, 1, ierr, 1, -1, 0 )
455*
456 IF( ierr( 1 ).GT.0 ) THEN
457 IF( iam.EQ.0 )
458 $ WRITE( nout, fmt = 9988 )
459 GO TO 40
460 END IF
461*
462* Loop over all PBLAS 3 routines
463*
464 DO 30 l = 1, nsubs
465*
466* Continue only if this subroutine has to be tested.
467*
468 IF( .NOT.ltest( l ) )
469 $ GO TO 30
470*
471* Define the size of the operands
472*
473 IF( l.EQ.1 ) THEN
474*
475* PZGEMM
476*
477 nrowc = m
478 ncolc = n
479 IF( lsame( transa, 'N' ) ) THEN
480 nrowa = m
481 ncola = k
482 ELSE
483 nrowa = k
484 ncola = m
485 END IF
486 IF( lsame( transb, 'N' ) ) THEN
487 nrowb = k
488 ncolb = n
489 ELSE
490 nrowb = n
491 ncolb = k
492 END IF
493 ELSE IF( l.EQ.2 .OR. l.EQ.3 ) THEN
494*
495* PZSYMM, PZHEMM
496*
497 nrowc = m
498 ncolc = n
499 nrowb = m
500 ncolb = n
501 IF( lsame( side, 'L' ) ) THEN
502 nrowa = m
503 ncola = m
504 ELSE
505 nrowa = n
506 ncola = n
507 END IF
508 ELSE IF( l.EQ.4 .OR. l.EQ.5 ) THEN
509*
510* PZSYRK, PZHERK
511*
512 nrowc = n
513 ncolc = n
514 IF( lsame( transa, 'N' ) ) THEN
515 nrowa = n
516 ncola = k
517 ELSE
518 nrowa = k
519 ncola = n
520 END IF
521 nrowb = 0
522 ncolb = 0
523 ELSE IF( l.EQ.6 .OR. l.EQ.7 ) THEN
524*
525* PZSYR2K, PZHER2K
526*
527 nrowc = n
528 ncolc = n
529 IF( lsame( transa, 'N' ) ) THEN
530 nrowa = n
531 ncola = k
532 nrowb = n
533 ncolb = k
534 ELSE
535 nrowa = k
536 ncola = n
537 nrowb = k
538 ncolb = n
539 END IF
540 ELSE IF( l.EQ.8 .OR. l.EQ.9 ) THEN
541*
542* PZTRMM, PZTRSM
543*
544 nrowb = m
545 ncolb = n
546 IF( lsame( side, 'L' ) ) THEN
547 nrowa = m
548 ncola = m
549 ELSE
550 nrowa = n
551 ncola = n
552 END IF
553 nrowc = 0
554 ncolc = 0
555 ELSE IF( l.EQ.10 .OR. l.EQ.11 ) THEN
556*
557* PZGEADD, PZTRADD
558*
559 IF( lsame( transa, 'N' ) ) THEN
560 nrowa = m
561 ncola = n
562 ELSE
563 nrowa = n
564 ncola = m
565 END IF
566 nrowc = m
567 ncolc = n
568 nrowb = 0
569 ncolb = 0
570*
571 END IF
572*
573* Check the validity of the operand sizes
574*
575 CALL pmdimchk( ictxt, nout, nrowa, ncola, 'A', ia, ja,
576 $ desca, ierr( 1 ) )
577 CALL pmdimchk( ictxt, nout, nrowb, ncolb, 'B', ib, jb,
578 $ descb, ierr( 2 ) )
579 CALL pmdimchk( ictxt, nout, nrowc, ncolc, 'C', ic, jc,
580 $ descc, ierr( 3 ) )
581*
582 IF( ierr( 1 ).NE.0 .OR. ierr( 2 ).NE.0 .OR.
583 $ ierr( 3 ).NE.0 ) THEN
584 GO TO 30
585 END IF
586*
587* Check special values of TRANSA for symmetric and
588* hermitian rank-k and rank-2k updates.
589*
590 IF( l.EQ.4 .OR. l.EQ.6 ) THEN
591 IF( .NOT.lsame( transa, 'N' ).AND.
592 $ .NOT.lsame( transa, 'T' ) ) THEN
593 IF( iam.EQ.0 )
594 $ WRITE( nout, fmt = 9983 ) snames( l ), 'TRANSA'
595 GO TO 30
596 END IF
597 ELSE IF( l.EQ.5 .OR. l.EQ.7 ) THEN
598 IF( .NOT.lsame( transa, 'N' ).AND.
599 $ .NOT.lsame( transa, 'C' ) ) THEN
600 IF( iam.EQ.0 )
601 $ WRITE( nout, fmt = 9983 ) snames( l ), 'TRANSA'
602 GO TO 30
603 END IF
604 END IF
605*
606* Generate distributed matrices A, B and C
607*
608 IF( l.EQ.2 ) THEN
609*
610* PZSYMM
611*
612 aform = 'S'
613 adiagdo = 'N'
614 offda = ia - ja
615 cform = 'N'
616 offdc = 0
617*
618 ELSE IF( l.EQ.3 ) THEN
619*
620* PZHEMM
621*
622 aform = 'H'
623 adiagdo = 'N'
624 offda = ia - ja
625 cform = 'N'
626 offdc = 0
627*
628 ELSE IF( l.EQ.4 .OR. l.EQ.6 ) THEN
629*
630* PZSYRK, PZSYR2K
631*
632 aform = 'N'
633 adiagdo = 'N'
634 offda = 0
635 cform = 'S'
636 offdc = ic - jc
637*
638 ELSE IF( l.EQ.5 .OR. l.EQ.7 ) THEN
639*
640* PZHERK, PZHER2K
641*
642 aform = 'N'
643 adiagdo = 'N'
644 offda = 0
645 cform = 'H'
646 offdc = ic - jc
647*
648 ELSE IF( ( l.EQ.9 ).AND.( lsame( diag, 'N' ) ) ) THEN
649*
650* PZTRSM
651*
652 aform = 'N'
653 adiagdo = 'D'
654 offda = ia - ja
655 cform = 'N'
656 offdc = 0
657*
658 ELSE
659*
660* Default values
661*
662 aform = 'N'
663 adiagdo = 'N'
664 offda = 0
665 cform = 'N'
666 offdc = 0
667*
668 END IF
669*
670 CALL pzlagen( .false., aform, adiagdo, offda, ma, na,
671 $ 1, 1, desca, iaseed, mem( ipa ),
672 $ desca( lld_ ) )
673 IF( ( l.EQ.9 ).AND.( .NOT.( lsame( diag, 'N' ) ) ).AND.
674 $ ( max( nrowa, ncola ).GT.1 ) ) THEN
675 scale = one / dcmplx( dble( max( nrowa, ncola ) ) )
676 IF( lsame( uplo, 'L' ) ) THEN
677 CALL pzlascal( 'Lower', nrowa-1, ncola-1, scale,
678 $ mem( ipa ), ia+1, ja, desca )
679 ELSE
680 CALL pzlascal( 'Upper', nrowa-1, ncola-1, scale,
681 $ mem( ipa ), ia, ja+1, desca )
682 END IF
683*
684 END IF
685*
686 IF( bcheck( l ) )
687 $ CALL pzlagen( .false., 'None', 'No diag', 0, mb, nb,
688 $ 1, 1, descb, ibseed, mem( ipb ),
689 $ descb( lld_ ) )
690*
691 IF( ccheck( l ) )
692 $ CALL pzlagen( .false., cform, 'No diag', offdc, mc,
693 $ nc, 1, 1, descc, icseed, mem( ipc ),
694 $ descc( lld_ ) )
695*
696 info = 0
697 CALL pb_boot()
698 CALL blacs_barrier( ictxt, 'All' )
699*
700* Call the Level 3 PBLAS routine
701*
702 IF( l.EQ.1 ) THEN
703*
704* Test PZGEMM
705*
706 nops = pdopbl3( snames( l ), m, n, k )
707*
708 CALL pb_timer( 1 )
709 CALL pzgemm( transa, transb, m, n, k, alpha,
710 $ mem( ipa ), ia, ja, desca, mem( ipb ),
711 $ ib, jb, descb, beta, mem( ipc ), ic, jc,
712 $ descc )
713 CALL pb_timer( 1 )
714*
715 ELSE IF( l.EQ.2 ) THEN
716*
717* Test PZSYMM
718*
719 IF( lsame( side, 'L' ) ) THEN
720 nops = pdopbl3( snames( l ), m, n, 0 )
721 ELSE
722 nops = pdopbl3( snames( l ), m, n, 1 )
723 END IF
724*
725 CALL pb_timer( 1 )
726 CALL pzsymm( side, uplo, m, n, alpha, mem( ipa ), ia,
727 $ ja, desca, mem( ipb ), ib, jb, descb,
728 $ beta, mem( ipc ), ic, jc, descc )
729 CALL pb_timer( 1 )
730*
731 ELSE IF( l.EQ.3 ) THEN
732*
733* Test PZHEMM
734*
735 IF( lsame( side, 'L' ) ) THEN
736 nops = pdopbl3( snames( l ), m, n, 0 )
737 ELSE
738 nops = pdopbl3( snames( l ), m, n, 1 )
739 END IF
740*
741 CALL pb_timer( 1 )
742 CALL pzhemm( side, uplo, m, n, alpha, mem( ipa ), ia,
743 $ ja, desca, mem( ipb ), ib, jb, descb,
744 $ beta, mem( ipc ), ic, jc, descc )
745 CALL pb_timer( 1 )
746*
747 ELSE IF( l.EQ.4 ) THEN
748*
749* Test PZSYRK
750*
751 nops = pdopbl3( snames( l ), n, n, k )
752*
753 CALL pb_timer( 1 )
754 CALL pzsyrk( uplo, transa, n, k, alpha, mem( ipa ),
755 $ ia, ja, desca, beta, mem( ipc ), ic, jc,
756 $ descc )
757 CALL pb_timer( 1 )
758*
759 ELSE IF( l.EQ.5 ) THEN
760*
761* Test PZHERK
762*
763 nops = pdopbl3( snames( l ), n, n, k )
764*
765 CALL pb_timer( 1 )
766 CALL pzherk( uplo, transa, n, k, dble( alpha ),
767 $ mem( ipa ), ia, ja, desca, dble( beta ),
768 $ mem( ipc ), ic, jc, descc )
769 CALL pb_timer( 1 )
770*
771 ELSE IF( l.EQ.6 ) THEN
772*
773* Test PZSYR2K
774*
775 nops = pdopbl3( snames( l ), n, n, k )
776*
777 CALL pb_timer( 1 )
778 CALL pzsyr2k( uplo, transa, n, k, alpha, mem( ipa ),
779 $ ia, ja, desca, mem( ipb ), ib, jb,
780 $ descb, beta, mem( ipc ), ic, jc,
781 $ descc )
782 CALL pb_timer( 1 )
783*
784 ELSE IF( l.EQ.7 ) THEN
785*
786* Test PZHER2K
787*
788 nops = pdopbl3( snames( l ), n, n, k )
789*
790 CALL pb_timer( 1 )
791 CALL pzher2k( uplo, transa, n, k, alpha, mem( ipa ),
792 $ ia, ja, desca, mem( ipb ), ib, jb,
793 $ descb, dble( beta ), mem( ipc ), ic, jc,
794 $ descc )
795 CALL pb_timer( 1 )
796*
797 ELSE IF( l.EQ.8 ) THEN
798*
799* Test PZTRMM
800*
801 IF( lsame( side, 'L' ) ) THEN
802 nops = pdopbl3( snames( l ), m, n, 0 )
803 ELSE
804 nops = pdopbl3( snames( l ), m, n, 1 )
805 END IF
806*
807 CALL pb_timer( 1 )
808 CALL pztrmm( side, uplo, transa, diag, m, n, alpha,
809 $ mem( ipa ), ia, ja, desca, mem( ipb ),
810 $ ib, jb, descb )
811 CALL pb_timer( 1 )
812*
813 ELSE IF( l.EQ.9 ) THEN
814*
815* Test PZTRSM
816*
817 IF( lsame( side, 'L' ) ) THEN
818 nops = pdopbl3( snames( l ), m, n, 0 )
819 ELSE
820 nops = pdopbl3( snames( l ), m, n, 1 )
821 END IF
822*
823 CALL pb_timer( 1 )
824 CALL pztrsm( side, uplo, transa, diag, m, n, alpha,
825 $ mem( ipa ), ia, ja, desca, mem( ipb ),
826 $ ib, jb, descb )
827 CALL pb_timer( 1 )
828*
829 ELSE IF( l.EQ.10 ) THEN
830*
831* Test PZGEADD
832*
833 nops = pdopbl3( snames( l ), m, n, m )
834*
835 CALL pb_timer( 1 )
836 CALL pzgeadd( transa, m, n, alpha, mem( ipa ), ia, ja,
837 $ desca, beta, mem( ipc ), ic, jc, descc )
838 CALL pb_timer( 1 )
839*
840 ELSE IF( l.EQ.11 ) THEN
841*
842* Test PZTRADD
843*
844 IF( lsame( uplo, 'U' ) ) THEN
845 nops = pdopbl3( snames( l ), m, n, 0 )
846 ELSE
847 nops = pdopbl3( snames( l ), m, n, 1 )
848 END IF
849*
850 CALL pb_timer( 1 )
851 CALL pztradd( uplo, transa, m, n, alpha, mem( ipa ),
852 $ ia, ja, desca, beta, mem( ipc ), ic, jc,
853 $ descc )
854 CALL pb_timer( 1 )
855*
856 END IF
857*
858* Check if the operation has been performed.
859*
860 IF( info.NE.0 ) THEN
861 IF( iam.EQ.0 )
862 $ WRITE( nout, fmt = 9982 ) info
863 GO TO 30
864 END IF
865*
866 CALL pb_combine( ictxt, 'All', '>', 'W', 1, 1, wtime )
867 CALL pb_combine( ictxt, 'All', '>', 'C', 1, 1, ctime )
868*
869* Only node 0 prints timing test result
870*
871 IF( iam.EQ.0 ) THEN
872*
873* Print WALL time if machine supports it
874*
875 IF( wtime( 1 ).GT.0.0d+0 ) THEN
876 wflops = nops / ( wtime( 1 ) * 1.0d+6 )
877 ELSE
878 wflops = 0.0d+0
879 END IF
880*
881* Print CPU time if machine supports it
882*
883 IF( ctime( 1 ).GT.0.0d+0 ) THEN
884 cflops = nops / ( ctime( 1 ) * 1.0d+6 )
885 ELSE
886 cflops = 0.0d+0
887 END IF
888*
889 WRITE( nout, fmt = 9981 ) snames( l ), wtime( 1 ),
890 $ wflops, ctime( 1 ), cflops
891*
892 END IF
893*
894 30 CONTINUE
895*
896 40 IF( iam.EQ.0 ) THEN
897 WRITE( nout, fmt = 9995 )
898 WRITE( nout, fmt = * )
899 WRITE( nout, fmt = 9986 ) j
900 END IF
901*
902 50 CONTINUE
903*
904 CALL blacs_gridexit( ictxt )
905*
906 60 CONTINUE
907*
908 IF( iam.EQ.0 ) THEN
909 WRITE( nout, fmt = * )
910 WRITE( nout, fmt = 9985 )
911 WRITE( nout, fmt = * )
912 END IF
913*
914 CALL blacs_exit( 0 )
915*
916 9999 FORMAT( 'ILLEGAL ', a, ': ', a, ' = ', i10,
917 $ ' should be at least 1' )
918 9998 FORMAT( 'ILLEGAL GRID: NPROW*NPCOL = ', i4,
919 $ '. It can be at most', i4 )
920 9997 FORMAT( 'Bad ', a, ' parameters: going on to next test case.' )
921 9996 FORMAT( 2x, 'Test number ', i2 , ' started on a ', i4, ' x ',
922 $ i4, ' process grid.' )
923 9995 FORMAT( 2x, ' ------------------------------------------------',
924 $ '-------------------' )
925 9994 FORMAT( 2x, ' M N K SIDE UPLO TRANSA ',
926 $ 'TRANSB DIAG' )
927 9993 FORMAT( 5x,i6,1x,i6,1x,i6,6x,a1,5x,a1,7x,a1,7x,a1,5x,a1 )
928 9992 FORMAT( 2x, ' IA JA MA NA IMBA INBA',
929 $ ' MBA NBA RSRCA CSRCA' )
930 9991 FORMAT( 5x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,
931 $ 1x,i5,1x,i5 )
932 9990 FORMAT( 2x, ' IB JB MB NB IMBB INBB',
933 $ ' MBB NBB RSRCB CSRCB' )
934 9989 FORMAT( 2x, ' IC JC MC NC IMBC INBC',
935 $ ' MBC NBC RSRCC CSRCC' )
936 9988 FORMAT( 'Not enough memory for this test: going on to',
937 $ ' next test case.' )
938 9987 FORMAT( 'Not enough memory. Need: ', i12 )
939 9986 FORMAT( 2x, 'Test number ', i2, ' completed.' )
940 9985 FORMAT( 2x, 'End of Tests.' )
941 9984 FORMAT( 2x, 'Tests started.' )
942 9983 FORMAT( 5x, a, ' ***** ', a, ' has an incorrect value: ',
943 $ ' BYPASS *****' )
944 9982 FORMAT( 2x, ' ***** Operation not supported, error code: ',
945 $ i5, ' *****' )
946 9981 FORMAT( 2x, '| ', a, 2x, f13.3, 2x, f13.3, 2x, f13.3, 2x, f13.3 )
947 9980 FORMAT( 2x, ' WALL time (s) WALL Mflops ',
948 $ ' CPU time (s) CPU Mflops' )
949*
950 stop
951*
952* End of PZBLA3TIM
953*
954 END
955 SUBROUTINE pzbla3timinfo( SUMMRY, NOUT, NMAT, DIAGVAL, SIDEVAL,
956 $ TRNAVAL, TRNBVAL, UPLOVAL, MVAL,
957 $ NVAL, KVAL, MAVAL, NAVAL, IMBAVAL,
958 $ MBAVAL, INBAVAL, NBAVAL, RSCAVAL,
959 $ CSCAVAL, IAVAL, JAVAL, MBVAL, NBVAL,
960 $ IMBBVAL, MBBVAL, INBBVAL, NBBVAL,
961 $ RSCBVAL, CSCBVAL, IBVAL, JBVAL,
962 $ MCVAL, NCVAL, IMBCVAL, MBCVAL,
963 $ INBCVAL, NBCVAL, RSCCVAL, CSCCVAL,
964 $ ICVAL, JCVAL, LDVAL, NGRIDS, PVAL,
965 $ LDPVAL, QVAL, LDQVAL, NBLOG, LTEST,
966 $ IAM, NPROCS, ALPHA, BETA, WORK )
967*
968* -- PBLAS test routine (version 2.0) --
969* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
970* and University of California, Berkeley.
971* April 1, 1998
972*
973* .. Scalar Arguments ..
974 INTEGER IAM, LDPVAL, LDQVAL, LDVAL, NBLOG, NGRIDS,
975 $ NMAT, NOUT, NPROCS
976 COMPLEX*16 ALPHA, BETA
977* ..
978* .. Array Arguments ..
979 CHARACTER*( * ) SUMMRY
980 CHARACTER*1 DIAGVAL( LDVAL ), SIDEVAL( LDVAL ),
981 $ TRNAVAL( LDVAL ), TRNBVAL( LDVAL ),
982 $ UPLOVAL( LDVAL )
983 LOGICAL LTEST( * )
984 INTEGER CSCAVAL( LDVAL ), CSCBVAL( LDVAL ),
985 $ csccval( ldval ), iaval( ldval ),
986 $ ibval( ldval ), icval( ldval ),
987 $ imbaval( ldval ), imbbval( ldval ),
988 $ imbcval( ldval ), inbaval( ldval ),
989 $ inbbval( ldval ), inbcval( ldval ),
990 $ javal( ldval ), jbval( ldval ), jcval( ldval ),
991 $ kval( ldval ), maval( ldval ), mbaval( ldval ),
992 $ mbbval( ldval ), mbcval( ldval ),
993 $ mbval( ldval ), mcval( ldval ), mval( ldval ),
994 $ naval( ldval ), nbaval( ldval ),
995 $ nbbval( ldval ), nbcval( ldval ),
996 $ nbval( ldval ), ncval( ldval ), nval( ldval ),
997 $ pval( ldpval ), qval( ldqval ),
998 $ rscaval( ldval ), rscbval( ldval ),
999 $ rsccval( ldval ), work( * )
1000* ..
1001*
1002* Purpose
1003* =======
1004*
1005* PZBLA3TIMINFO get the needed startup information for timing various
1006* Level 3 PBLAS routines, and transmits it to all processes.
1007*
1008* Notes
1009* =====
1010*
1011* For packing the information we assumed that the length in bytes of an
1012* integer is equal to the length in bytes of a real single precision.
1013*
1014* Arguments
1015* =========
1016*
1017* SUMMRY (global output) CHARACTER*(*)
1018* On exit, SUMMRY is the name of output (summary) file (if
1019* any). SUMMRY is only defined for process 0.
1020*
1021* NOUT (global output) INTEGER
1022* On exit, NOUT specifies the unit number for the output file.
1023* When NOUT is 6, output to screen, when NOUT is 0, output to
1024* stderr. NOUT is only defined for process 0.
1025*
1026* NMAT (global output) INTEGER
1027* On exit, NMAT specifies the number of different test cases.
1028*
1029* DIAGVAL (global output) CHARACTER array
1030* On entry, DIAGVAL is an array of dimension LDVAL. On exit,
1031* this array contains the values of DIAG to run the code with.
1032*
1033* SIDEVAL (global output) CHARACTER array
1034* On entry, SIDEVAL is an array of dimension LDVAL. On exit,
1035* this array contains the values of SIDE to run the code with.
1036*
1037* TRNAVAL (global output) CHARACTER array
1038* On entry, TRNAVAL is an array of dimension LDVAL. On exit,
1039* this array contains the values of TRANSA to run the code
1040* with.
1041*
1042* TRNBVAL (global output) CHARACTER array
1043* On entry, TRNBVAL is an array of dimension LDVAL. On exit,
1044* this array contains the values of TRANSB to run the code
1045* with.
1046*
1047* UPLOVAL (global output) CHARACTER array
1048* On entry, UPLOVAL is an array of dimension LDVAL. On exit,
1049* this array contains the values of UPLO to run the code with.
1050*
1051* MVAL (global output) INTEGER array
1052* On entry, MVAL is an array of dimension LDVAL. On exit, this
1053* array contains the values of M to run the code with.
1054*
1055* NVAL (global output) INTEGER array
1056* On entry, NVAL is an array of dimension LDVAL. On exit, this
1057* array contains the values of N to run the code with.
1058*
1059* KVAL (global output) INTEGER array
1060* On entry, KVAL is an array of dimension LDVAL. On exit, this
1061* array contains the values of K to run the code with.
1062*
1063* MAVAL (global output) INTEGER array
1064* On entry, MAVAL is an array of dimension LDVAL. On exit, this
1065* array contains the values of DESCA( M_ ) to run the code
1066* with.
1067*
1068* NAVAL (global output) INTEGER array
1069* On entry, NAVAL is an array of dimension LDVAL. On exit, this
1070* array contains the values of DESCA( N_ ) to run the code
1071* with.
1072*
1073* IMBAVAL (global output) INTEGER array
1074* On entry, IMBAVAL is an array of dimension LDVAL. On exit,
1075* this array contains the values of DESCA( IMB_ ) to run the
1076* code with.
1077*
1078* MBAVAL (global output) INTEGER array
1079* On entry, MBAVAL is an array of dimension LDVAL. On exit,
1080* this array contains the values of DESCA( MB_ ) to run the
1081* code with.
1082*
1083* INBAVAL (global output) INTEGER array
1084* On entry, INBAVAL is an array of dimension LDVAL. On exit,
1085* this array contains the values of DESCA( INB_ ) to run the
1086* code with.
1087*
1088* NBAVAL (global output) INTEGER array
1089* On entry, NBAVAL is an array of dimension LDVAL. On exit,
1090* this array contains the values of DESCA( NB_ ) to run the
1091* code with.
1092*
1093* RSCAVAL (global output) INTEGER array
1094* On entry, RSCAVAL is an array of dimension LDVAL. On exit,
1095* this array contains the values of DESCA( RSRC_ ) to run the
1096* code with.
1097*
1098* CSCAVAL (global output) INTEGER array
1099* On entry, CSCAVAL is an array of dimension LDVAL. On exit,
1100* this array contains the values of DESCA( CSRC_ ) to run the
1101* code with.
1102*
1103* IAVAL (global output) INTEGER array
1104* On entry, IAVAL is an array of dimension LDVAL. On exit, this
1105* array contains the values of IA to run the code with.
1106*
1107* JAVAL (global output) INTEGER array
1108* On entry, JAVAL is an array of dimension LDVAL. On exit, this
1109* array contains the values of JA to run the code with.
1110*
1111* MBVAL (global output) INTEGER array
1112* On entry, MBVAL is an array of dimension LDVAL. On exit, this
1113* array contains the values of DESCB( M_ ) to run the code
1114* with.
1115*
1116* NBVAL (global output) INTEGER array
1117* On entry, NBVAL is an array of dimension LDVAL. On exit, this
1118* array contains the values of DESCB( N_ ) to run the code
1119* with.
1120*
1121* IMBBVAL (global output) INTEGER array
1122* On entry, IMBBVAL is an array of dimension LDVAL. On exit,
1123* this array contains the values of DESCB( IMB_ ) to run the
1124* code with.
1125*
1126* MBBVAL (global output) INTEGER array
1127* On entry, MBBVAL is an array of dimension LDVAL. On exit,
1128* this array contains the values of DESCB( MB_ ) to run the
1129* code with.
1130*
1131* INBBVAL (global output) INTEGER array
1132* On entry, INBBVAL is an array of dimension LDVAL. On exit,
1133* this array contains the values of DESCB( INB_ ) to run the
1134* code with.
1135*
1136* NBBVAL (global output) INTEGER array
1137* On entry, NBBVAL is an array of dimension LDVAL. On exit,
1138* this array contains the values of DESCB( NB_ ) to run the
1139* code with.
1140*
1141* RSCBVAL (global output) INTEGER array
1142* On entry, RSCBVAL is an array of dimension LDVAL. On exit,
1143* this array contains the values of DESCB( RSRC_ ) to run the
1144* code with.
1145*
1146* CSCBVAL (global output) INTEGER array
1147* On entry, CSCBVAL is an array of dimension LDVAL. On exit,
1148* this array contains the values of DESCB( CSRC_ ) to run the
1149* code with.
1150*
1151* IBVAL (global output) INTEGER array
1152* On entry, IBVAL is an array of dimension LDVAL. On exit, this
1153* array contains the values of IB to run the code with.
1154*
1155* JBVAL (global output) INTEGER array
1156* On entry, JBVAL is an array of dimension LDVAL. On exit, this
1157* array contains the values of JB to run the code with.
1158*
1159* MCVAL (global output) INTEGER array
1160* On entry, MCVAL is an array of dimension LDVAL. On exit, this
1161* array contains the values of DESCC( M_ ) to run the code
1162* with.
1163*
1164* NCVAL (global output) INTEGER array
1165* On entry, NCVAL is an array of dimension LDVAL. On exit, this
1166* array contains the values of DESCC( N_ ) to run the code
1167* with.
1168*
1169* IMBCVAL (global output) INTEGER array
1170* On entry, IMBCVAL is an array of dimension LDVAL. On exit,
1171* this array contains the values of DESCC( IMB_ ) to run the
1172* code with.
1173*
1174* MBCVAL (global output) INTEGER array
1175* On entry, MBCVAL is an array of dimension LDVAL. On exit,
1176* this array contains the values of DESCC( MB_ ) to run the
1177* code with.
1178*
1179* INBCVAL (global output) INTEGER array
1180* On entry, INBCVAL is an array of dimension LDVAL. On exit,
1181* this array contains the values of DESCC( INB_ ) to run the
1182* code with.
1183*
1184* NBCVAL (global output) INTEGER array
1185* On entry, NBCVAL is an array of dimension LDVAL. On exit,
1186* this array contains the values of DESCC( NB_ ) to run the
1187* code with.
1188*
1189* RSCCVAL (global output) INTEGER array
1190* On entry, RSCCVAL is an array of dimension LDVAL. On exit,
1191* this array contains the values of DESCC( RSRC_ ) to run the
1192* code with.
1193*
1194* CSCCVAL (global output) INTEGER array
1195* On entry, CSCCVAL is an array of dimension LDVAL. On exit,
1196* this array contains the values of DESCC( CSRC_ ) to run the
1197* code with.
1198*
1199* ICVAL (global output) INTEGER array
1200* On entry, ICVAL is an array of dimension LDVAL. On exit, this
1201* array contains the values of IC to run the code with.
1202*
1203* JCVAL (global output) INTEGER array
1204* On entry, JCVAL is an array of dimension LDVAL. On exit, this
1205* array contains the values of JC to run the code with.
1206*
1207* LDVAL (global input) INTEGER
1208* On entry, LDVAL specifies the maximum number of different va-
1209* lues that can be used for DIAG, SIDE, TRANSA, TRANSB, UPLO,
1210* M, N, K, DESCA(:), IA, JA, DESCB(:), IB, JB, DESCC(:), IC,
1211* JC. This is also the maximum number of test cases.
1212*
1213* NGRIDS (global output) INTEGER
1214* On exit, NGRIDS specifies the number of different values that
1215* can be used for P and Q.
1216*
1217* PVAL (global output) INTEGER array
1218* On entry, PVAL is an array of dimension LDPVAL. On exit, this
1219* array contains the values of P to run the code with.
1220*
1221* LDPVAL (global input) INTEGER
1222* On entry, LDPVAL specifies the maximum number of different
1223* values that can be used for P.
1224*
1225* QVAL (global output) INTEGER array
1226* On entry, QVAL is an array of dimension LDQVAL. On exit, this
1227* array contains the values of Q to run the code with.
1228*
1229* LDQVAL (global input) INTEGER
1230* On entry, LDQVAL specifies the maximum number of different
1231* values that can be used for Q.
1232*
1233* NBLOG (global output) INTEGER
1234* On exit, NBLOG specifies the logical computational block size
1235* to run the tests with. NBLOG must be at least one.
1236*
1237* LTEST (global output) LOGICAL array
1238* On entry, LTEST is an array of dimension at least eleven. On
1239* exit, if LTEST( i ) is .TRUE., the i-th Level 3 PBLAS routine
1240* will be tested. See the input file for the ordering of the
1241* routines.
1242*
1243* IAM (local input) INTEGER
1244* On entry, IAM specifies the number of the process executing
1245* this routine.
1246*
1247* NPROCS (global input) INTEGER
1248* On entry, NPROCS specifies the total number of processes.
1249*
1250* ALPHA (global output) COMPLEX*16
1251* On exit, ALPHA specifies the value of alpha to be used in all
1252* the test cases.
1253*
1254* BETA (global output) COMPLEX*16
1255* On exit, BETA specifies the value of beta to be used in all
1256* the test cases.
1257*
1258* WORK (local workspace) INTEGER array
1259* On entry, WORK is an array of dimension at least
1260* MAX( 3, 2*NGRIDS+38*NMAT+NSUBS ) with NSUBS = 11. This array
1261* is used to pack all output arrays in order to send info in
1262* one message.
1263*
1264* -- Written on April 1, 1998 by
1265* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
1266*
1267* =====================================================================
1268*
1269* .. Parameters ..
1270 INTEGER NIN, NSUBS
1271 PARAMETER ( NIN = 11, nsubs = 11 )
1272* ..
1273* .. Local Scalars ..
1274 LOGICAL LTESTT
1275 INTEGER I, ICTXT, J
1276* ..
1277* .. Local Arrays ..
1278 CHARACTER*7 SNAMET
1279 CHARACTER*79 USRINFO
1280* ..
1281* .. External Subroutines ..
1282 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
1283 $ blacs_gridinit, blacs_setup, icopy, igebr2d,
1284 $ igebs2d, sgebr2d, sgebs2d, zgebr2d, zgebs2d
1285* ..
1286* .. Intrinsic Functions ..
1287 INTRINSIC char, ichar, max, min
1288* ..
1289* .. Common Blocks ..
1290 CHARACTER*7 SNAMES( NSUBS )
1291 COMMON /SNAMEC/SNAMES
1292* ..
1293* .. Executable Statements ..
1294*
1295* Process 0 reads the input data, broadcasts to other processes and
1296* writes needed information to NOUT
1297*
1298 IF( iam.EQ.0 ) THEN
1299*
1300* Open file and skip data file header
1301*
1302 OPEN( nin, file='PZBLAS3TIM.dat', status='OLD' )
1303 READ( nin, fmt = * ) summry
1304 summry = ' '
1305*
1306* Read in user-supplied info about machine type, compiler, etc.
1307*
1308 READ( nin, fmt = 9999 ) usrinfo
1309*
1310* Read name and unit number for summary output file
1311*
1312 READ( nin, fmt = * ) summry
1313 READ( nin, fmt = * ) nout
1314 IF( nout.NE.0 .AND. nout.NE.6 )
1315 $ OPEN( nout, file = summry, status = 'UNKNOWN' )
1316*
1317* Read and check the parameter values for the tests.
1318*
1319* Get logical computational block size
1320*
1321 READ( nin, fmt = * ) nblog
1322 IF( nblog.LT.1 )
1323 $ nblog = 32
1324*
1325* Get number of grids
1326*
1327 READ( nin, fmt = * ) ngrids
1328 IF( ngrids.LT.1 .OR. ngrids.GT.ldpval ) THEN
1329 WRITE( nout, fmt = 9998 ) 'Grids', ldpval
1330 GO TO 120
1331 ELSE IF( ngrids.GT.ldqval ) THEN
1332 WRITE( nout, fmt = 9998 ) 'Grids', ldqval
1333 GO TO 120
1334 END IF
1335*
1336* Get values of P and Q
1337*
1338 READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
1339 READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
1340*
1341* Read ALPHA, BETA
1342*
1343 READ( nin, fmt = * ) alpha
1344 READ( nin, fmt = * ) beta
1345*
1346* Read number of tests.
1347*
1348 READ( nin, fmt = * ) nmat
1349 IF( nmat.LT.1 .OR. nmat.GT.ldval ) THEN
1350 WRITE( nout, fmt = 9998 ) 'Tests', ldval
1351 GO TO 120
1352 ENDIF
1353*
1354* Read in input data into arrays.
1355*
1356 READ( nin, fmt = * ) ( diagval( i ), i = 1, nmat )
1357 READ( nin, fmt = * ) ( sideval( i ), i = 1, nmat )
1358 READ( nin, fmt = * ) ( trnaval( i ), i = 1, nmat )
1359 READ( nin, fmt = * ) ( trnbval( i ), i = 1, nmat )
1360 READ( nin, fmt = * ) ( uploval( i ), i = 1, nmat )
1361 READ( nin, fmt = * ) ( mval( i ), i = 1, nmat )
1362 READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
1363 READ( nin, fmt = * ) ( kval( i ), i = 1, nmat )
1364 READ( nin, fmt = * ) ( maval( i ), i = 1, nmat )
1365 READ( nin, fmt = * ) ( naval( i ), i = 1, nmat )
1366 READ( nin, fmt = * ) ( imbaval( i ), i = 1, nmat )
1367 READ( nin, fmt = * ) ( inbaval( i ), i = 1, nmat )
1368 READ( nin, fmt = * ) ( mbaval( i ), i = 1, nmat )
1369 READ( nin, fmt = * ) ( nbaval( i ), i = 1, nmat )
1370 READ( nin, fmt = * ) ( rscaval( i ), i = 1, nmat )
1371 READ( nin, fmt = * ) ( cscaval( i ), i = 1, nmat )
1372 READ( nin, fmt = * ) ( iaval( i ), i = 1, nmat )
1373 READ( nin, fmt = * ) ( javal( i ), i = 1, nmat )
1374 READ( nin, fmt = * ) ( mbval( i ), i = 1, nmat )
1375 READ( nin, fmt = * ) ( nbval( i ), i = 1, nmat )
1376 READ( nin, fmt = * ) ( imbbval( i ), i = 1, nmat )
1377 READ( nin, fmt = * ) ( inbbval( i ), i = 1, nmat )
1378 READ( nin, fmt = * ) ( mbbval( i ), i = 1, nmat )
1379 READ( nin, fmt = * ) ( nbbval( i ), i = 1, nmat )
1380 READ( nin, fmt = * ) ( rscbval( i ), i = 1, nmat )
1381 READ( nin, fmt = * ) ( cscbval( i ), i = 1, nmat )
1382 READ( nin, fmt = * ) ( ibval( i ), i = 1, nmat )
1383 READ( nin, fmt = * ) ( jbval( i ), i = 1, nmat )
1384 READ( nin, fmt = * ) ( mcval( i ), i = 1, nmat )
1385 READ( nin, fmt = * ) ( ncval( i ), i = 1, nmat )
1386 READ( nin, fmt = * ) ( imbcval( i ), i = 1, nmat )
1387 READ( nin, fmt = * ) ( inbcval( i ), i = 1, nmat )
1388 READ( nin, fmt = * ) ( mbcval( i ), i = 1, nmat )
1389 READ( nin, fmt = * ) ( nbcval( i ), i = 1, nmat )
1390 READ( nin, fmt = * ) ( rsccval( i ), i = 1, nmat )
1391 READ( nin, fmt = * ) ( csccval( i ), i = 1, nmat )
1392 READ( nin, fmt = * ) ( icval( i ), i = 1, nmat )
1393 READ( nin, fmt = * ) ( jcval( i ), i = 1, nmat )
1394*
1395* Read names of subroutines and flags which indicate
1396* whether they are to be tested.
1397*
1398 DO 10 i = 1, nsubs
1399 ltest( i ) = .false.
1400 10 CONTINUE
1401 20 CONTINUE
1402 READ( nin, fmt = 9996, END = 50 ) SNAMET, ltestt
1403 DO 30 i = 1, nsubs
1404 IF( snamet.EQ.snames( i ) )
1405 $ GO TO 40
1406 30 CONTINUE
1407*
1408 WRITE( nout, fmt = 9995 )snamet
1409 GO TO 120
1410*
1411 40 CONTINUE
1412 ltest( i ) = ltestt
1413 GO TO 20
1414*
1415 50 CONTINUE
1416*
1417* Close input file
1418*
1419 CLOSE ( nin )
1420*
1421* For pvm only: if virtual machine not set up, allocate it and
1422* spawn the correct number of processes.
1423*
1424 IF( nprocs.LT.1 ) THEN
1425 nprocs = 0
1426 DO 60 i = 1, ngrids
1427 nprocs = max( nprocs, pval( i )*qval( i ) )
1428 60 CONTINUE
1429 CALL blacs_setup( iam, nprocs )
1430 END IF
1431*
1432* Temporarily define blacs grid to include all processes so
1433* information can be broadcast to all processes
1434*
1435 CALL blacs_get( -1, 0, ictxt )
1436 CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
1437*
1438* Pack information arrays and broadcast
1439*
1440 CALL zgebs2d( ictxt, 'All', ' ', 1, 1, alpha, 1 )
1441 CALL zgebs2d( ictxt, 'All', ' ', 1, 1, beta, 1 )
1442*
1443 work( 1 ) = ngrids
1444 work( 2 ) = nmat
1445 work( 3 ) = nblog
1446 CALL igebs2d( ictxt, 'All', ' ', 3, 1, work, 3 )
1447*
1448 i = 1
1449 DO 70 j = 1, nmat
1450 work( i ) = ichar( diagval( j ) )
1451 work( i+1 ) = ichar( sideval( j ) )
1452 work( i+2 ) = ichar( trnaval( j ) )
1453 work( i+3 ) = ichar( trnbval( j ) )
1454 work( i+4 ) = ichar( uploval( j ) )
1455 i = i + 5
1456 70 CONTINUE
1457 CALL icopy( ngrids, pval, 1, work( i ), 1 )
1458 i = i + ngrids
1459 CALL icopy( ngrids, qval, 1, work( i ), 1 )
1460 i = i + ngrids
1461 CALL icopy( nmat, mval, 1, work( i ), 1 )
1462 i = i + nmat
1463 CALL icopy( nmat, nval, 1, work( i ), 1 )
1464 i = i + nmat
1465 CALL icopy( nmat, kval, 1, work( i ), 1 )
1466 i = i + nmat
1467 CALL icopy( nmat, maval, 1, work( i ), 1 )
1468 i = i + nmat
1469 CALL icopy( nmat, naval, 1, work( i ), 1 )
1470 i = i + nmat
1471 CALL icopy( nmat, imbaval, 1, work( i ), 1 )
1472 i = i + nmat
1473 CALL icopy( nmat, inbaval, 1, work( i ), 1 )
1474 i = i + nmat
1475 CALL icopy( nmat, mbaval, 1, work( i ), 1 )
1476 i = i + nmat
1477 CALL icopy( nmat, nbaval, 1, work( i ), 1 )
1478 i = i + nmat
1479 CALL icopy( nmat, rscaval, 1, work( i ), 1 )
1480 i = i + nmat
1481 CALL icopy( nmat, cscaval, 1, work( i ), 1 )
1482 i = i + nmat
1483 CALL icopy( nmat, iaval, 1, work( i ), 1 )
1484 i = i + nmat
1485 CALL icopy( nmat, javal, 1, work( i ), 1 )
1486 i = i + nmat
1487 CALL icopy( nmat, mbval, 1, work( i ), 1 )
1488 i = i + nmat
1489 CALL icopy( nmat, nbval, 1, work( i ), 1 )
1490 i = i + nmat
1491 CALL icopy( nmat, imbbval, 1, work( i ), 1 )
1492 i = i + nmat
1493 CALL icopy( nmat, inbbval, 1, work( i ), 1 )
1494 i = i + nmat
1495 CALL icopy( nmat, mbbval, 1, work( i ), 1 )
1496 i = i + nmat
1497 CALL icopy( nmat, nbbval, 1, work( i ), 1 )
1498 i = i + nmat
1499 CALL icopy( nmat, rscbval, 1, work( i ), 1 )
1500 i = i + nmat
1501 CALL icopy( nmat, cscbval, 1, work( i ), 1 )
1502 i = i + nmat
1503 CALL icopy( nmat, ibval, 1, work( i ), 1 )
1504 i = i + nmat
1505 CALL icopy( nmat, jbval, 1, work( i ), 1 )
1506 i = i + nmat
1507 CALL icopy( nmat, mcval, 1, work( i ), 1 )
1508 i = i + nmat
1509 CALL icopy( nmat, ncval, 1, work( i ), 1 )
1510 i = i + nmat
1511 CALL icopy( nmat, imbcval, 1, work( i ), 1 )
1512 i = i + nmat
1513 CALL icopy( nmat, inbcval, 1, work( i ), 1 )
1514 i = i + nmat
1515 CALL icopy( nmat, mbcval, 1, work( i ), 1 )
1516 i = i + nmat
1517 CALL icopy( nmat, nbcval, 1, work( i ), 1 )
1518 i = i + nmat
1519 CALL icopy( nmat, rsccval, 1, work( i ), 1 )
1520 i = i + nmat
1521 CALL icopy( nmat, csccval, 1, work( i ), 1 )
1522 i = i + nmat
1523 CALL icopy( nmat, icval, 1, work( i ), 1 )
1524 i = i + nmat
1525 CALL icopy( nmat, jcval, 1, work( i ), 1 )
1526 i = i + nmat
1527*
1528 DO 80 j = 1, nsubs
1529 IF( ltest( j ) ) THEN
1530 work( i ) = 1
1531 ELSE
1532 work( i ) = 0
1533 END IF
1534 i = i + 1
1535 80 CONTINUE
1536 i = i - 1
1537 CALL igebs2d( ictxt, 'All', ' ', i, 1, work, i )
1538*
1539* regurgitate input
1540*
1541 WRITE( nout, fmt = 9999 )
1542 $ 'Level 3 PBLAS timing program.'
1543 WRITE( nout, fmt = 9999 ) usrinfo
1544 WRITE( nout, fmt = * )
1545 WRITE( nout, fmt = 9999 )
1546 $ 'Tests of the complex double precision '//
1547 $ 'Level 3 PBLAS'
1548 WRITE( nout, fmt = * )
1549 WRITE( nout, fmt = 9992 ) nmat
1550 WRITE( nout, fmt = 9986 ) nblog
1551 WRITE( nout, fmt = 9991 ) ngrids
1552 WRITE( nout, fmt = 9989 )
1553 $ 'P', ( pval(i), i = 1, min(ngrids, 5) )
1554 IF( ngrids.GT.5 )
1555 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 6,
1556 $ min( 10, ngrids ) )
1557 IF( ngrids.GT.10 )
1558 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 11,
1559 $ min( 15, ngrids ) )
1560 IF( ngrids.GT.15 )
1561 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 16, ngrids )
1562 WRITE( nout, fmt = 9989 )
1563 $ 'Q', ( qval(i), i = 1, min(ngrids, 5) )
1564 IF( ngrids.GT.5 )
1565 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 6,
1566 $ min( 10, ngrids ) )
1567 IF( ngrids.GT.10 )
1568 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 11,
1569 $ min( 15, ngrids ) )
1570 IF( ngrids.GT.15 )
1571 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 16, ngrids )
1572 WRITE( nout, fmt = 9994 ) alpha
1573 WRITE( nout, fmt = 9993 ) beta
1574 IF( ltest( 1 ) ) THEN
1575 WRITE( nout, fmt = 9988 ) snames( 1 ), ' ... Yes'
1576 ELSE
1577 WRITE( nout, fmt = 9988 ) snames( 1 ), ' ... No '
1578 END IF
1579 DO 90 i = 2, nsubs
1580 IF( ltest( i ) ) THEN
1581 WRITE( nout, fmt = 9987 ) snames( i ), ' ... Yes'
1582 ELSE
1583 WRITE( nout, fmt = 9987 ) snames( i ), ' ... No '
1584 END IF
1585 90 CONTINUE
1586 WRITE( nout, fmt = * )
1587*
1588 ELSE
1589*
1590* If in pvm, must participate setting up virtual machine
1591*
1592 IF( nprocs.LT.1 )
1593 $ CALL blacs_setup( iam, nprocs )
1594*
1595* Temporarily define blacs grid to include all processes so
1596* information can be broadcast to all processes
1597*
1598 CALL blacs_get( -1, 0, ictxt )
1599 CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
1600*
1601 CALL zgebr2d( ictxt, 'All', ' ', 1, 1, alpha, 1, 0, 0 )
1602 CALL zgebr2d( ictxt, 'All', ' ', 1, 1, beta, 1, 0, 0 )
1603*
1604 CALL igebr2d( ictxt, 'All', ' ', 3, 1, work, 3, 0, 0 )
1605 ngrids = work( 1 )
1606 nmat = work( 2 )
1607 nblog = work( 3 )
1608*
1609 i = 2*ngrids + 38*nmat + nsubs
1610 CALL igebr2d( ictxt, 'All', ' ', i, 1, work, i, 0, 0 )
1611*
1612 i = 1
1613 DO 100 j = 1, nmat
1614 diagval( j ) = char( work( i ) )
1615 sideval( j ) = char( work( i+1 ) )
1616 trnaval( j ) = char( work( i+2 ) )
1617 trnbval( j ) = char( work( i+3 ) )
1618 uploval( j ) = char( work( i+4 ) )
1619 i = i + 5
1620 100 CONTINUE
1621 CALL icopy( ngrids, work( i ), 1, pval, 1 )
1622 i = i + ngrids
1623 CALL icopy( ngrids, work( i ), 1, qval, 1 )
1624 i = i + ngrids
1625 CALL icopy( nmat, work( i ), 1, mval, 1 )
1626 i = i + nmat
1627 CALL icopy( nmat, work( i ), 1, nval, 1 )
1628 i = i + nmat
1629 CALL icopy( nmat, work( i ), 1, kval, 1 )
1630 i = i + nmat
1631 CALL icopy( nmat, work( i ), 1, maval, 1 )
1632 i = i + nmat
1633 CALL icopy( nmat, work( i ), 1, naval, 1 )
1634 i = i + nmat
1635 CALL icopy( nmat, work( i ), 1, imbaval, 1 )
1636 i = i + nmat
1637 CALL icopy( nmat, work( i ), 1, inbaval, 1 )
1638 i = i + nmat
1639 CALL icopy( nmat, work( i ), 1, mbaval, 1 )
1640 i = i + nmat
1641 CALL icopy( nmat, work( i ), 1, nbaval, 1 )
1642 i = i + nmat
1643 CALL icopy( nmat, work( i ), 1, rscaval, 1 )
1644 i = i + nmat
1645 CALL icopy( nmat, work( i ), 1, cscaval, 1 )
1646 i = i + nmat
1647 CALL icopy( nmat, work( i ), 1, iaval, 1 )
1648 i = i + nmat
1649 CALL icopy( nmat, work( i ), 1, javal, 1 )
1650 i = i + nmat
1651 CALL icopy( nmat, work( i ), 1, mbval, 1 )
1652 i = i + nmat
1653 CALL icopy( nmat, work( i ), 1, nbval, 1 )
1654 i = i + nmat
1655 CALL icopy( nmat, work( i ), 1, imbbval, 1 )
1656 i = i + nmat
1657 CALL icopy( nmat, work( i ), 1, inbbval, 1 )
1658 i = i + nmat
1659 CALL icopy( nmat, work( i ), 1, mbbval, 1 )
1660 i = i + nmat
1661 CALL icopy( nmat, work( i ), 1, nbbval, 1 )
1662 i = i + nmat
1663 CALL icopy( nmat, work( i ), 1, rscbval, 1 )
1664 i = i + nmat
1665 CALL icopy( nmat, work( i ), 1, cscbval, 1 )
1666 i = i + nmat
1667 CALL icopy( nmat, work( i ), 1, ibval, 1 )
1668 i = i + nmat
1669 CALL icopy( nmat, work( i ), 1, jbval, 1 )
1670 i = i + nmat
1671 CALL icopy( nmat, work( i ), 1, mcval, 1 )
1672 i = i + nmat
1673 CALL icopy( nmat, work( i ), 1, ncval, 1 )
1674 i = i + nmat
1675 CALL icopy( nmat, work( i ), 1, imbcval, 1 )
1676 i = i + nmat
1677 CALL icopy( nmat, work( i ), 1, inbcval, 1 )
1678 i = i + nmat
1679 CALL icopy( nmat, work( i ), 1, mbcval, 1 )
1680 i = i + nmat
1681 CALL icopy( nmat, work( i ), 1, nbcval, 1 )
1682 i = i + nmat
1683 CALL icopy( nmat, work( i ), 1, rsccval, 1 )
1684 i = i + nmat
1685 CALL icopy( nmat, work( i ), 1, csccval, 1 )
1686 i = i + nmat
1687 CALL icopy( nmat, work( i ), 1, icval, 1 )
1688 i = i + nmat
1689 CALL icopy( nmat, work( i ), 1, jcval, 1 )
1690 i = i + nmat
1691*
1692 DO 110 j = 1, nsubs
1693 IF( work( i ).EQ.1 ) THEN
1694 ltest( j ) = .true.
1695 ELSE
1696 ltest( j ) = .false.
1697 END IF
1698 i = i + 1
1699 110 CONTINUE
1700*
1701 END IF
1702*
1703 CALL blacs_gridexit( ictxt )
1704*
1705 RETURN
1706*
1707 120 WRITE( nout, fmt = 9997 )
1708 CLOSE( nin )
1709 IF( nout.NE.6 .AND. nout.NE.0 )
1710 $ CLOSE( nout )
1711 CALL blacs_abort( ictxt, 1 )
1712*
1713 stop
1714*
1715 9999 FORMAT( a )
1716 9998 FORMAT( ' Number of values of ',5a, ' is less than 1 or greater ',
1717 $ 'than ', i2 )
1718 9997 FORMAT( ' Illegal input in file ',40a,'. Aborting run.' )
1719 9996 FORMAT( a7, l2 )
1720 9995 FORMAT( ' Subprogram name ', a7, ' not recognized',
1721 $ /' ******* TESTS ABANDONED *******' )
1722 9994 FORMAT( 2x, 'Alpha : (', g16.6,
1723 $ ',', g16.6, ')' )
1724 9993 FORMAT( 2x, 'Beta : (', g16.6,
1725 $ ',', g16.6, ')' )
1726 9992 FORMAT( 2x, 'Number of Tests : ', i6 )
1727 9991 FORMAT( 2x, 'Number of process grids : ', i6 )
1728 9990 FORMAT( 2x, ' : ', 5i6 )
1729 9989 FORMAT( 2x, a1, ' : ', 5i6 )
1730 9988 FORMAT( 2x, 'Routines to be tested : ', a, a8 )
1731 9987 FORMAT( 2x, ' ', a, a8 )
1732 9986 FORMAT( 2x, 'Logical block size : ', i6 )
1733*
1734* End of PZBLA3TIMINFO
1735*
1736 END
subroutine pb_combine(ictxt, scope, op, tmtype, n, ibeg, times)
Definition pblastim.f:3211
subroutine pb_boot()
Definition pblastim.f:2927
double precision function pdopbl3(subnam, m, n, k)
Definition pblastim.f:1313
subroutine pb_timer(i)
Definition pblastim.f:2976
subroutine pmdimchk(ictxt, nout, m, n, matrix, ia, ja, desca, info)
Definition pblastst.f:202
subroutine icopy(n, sx, incx, sy, incy)
Definition pblastst.f:1525
subroutine pmdescchk(ictxt, nout, matrix, desca, dta, ma, na, imba, inba, mba, nba, rsrca, csrca, mpa, nqa, iprea, imida, iposta, igap, gapmul, info)
Definition pblastst.f:746
#define max(A, B)
Definition pcgemr.c:180
#define min(A, B)
Definition pcgemr.c:181
program pzbla3tim
Definition pzblas3tim.f:12
subroutine pzbla3timinfo(summry, nout, nmat, diagval, sideval, trnaval, trnbval, uploval, mval, nval, kval, maval, naval, imbaval, mbaval, inbaval, nbaval, rscaval, cscaval, iaval, javal, mbval, nbval, imbbval, mbbval, inbbval, nbbval, rscbval, cscbval, ibval, jbval, mcval, ncval, imbcval, mbcval, inbcval, nbcval, rsccval, csccval, icval, jcval, ldval, ngrids, pval, ldpval, qval, ldqval, nblog, ltest, iam, nprocs, alpha, beta, work)
Definition pzblas3tim.f:967
subroutine pzlascal(type, m, n, alpha, a, ia, ja, desca)
Definition pzblastst.f:7984
subroutine pzlagen(inplace, aform, diag, offa, m, n, ia, ja, desca, iaseed, a, lda)
Definition pzblastst.f:8492
logical function lsame(ca, cb)
Definition tools.f:1724