ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
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,
186  $ pb_timer, pmdescchk, pmdimchk, pzbla3timinfo,
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
max
#define max(A, B)
Definition: pcgemr.c:180
pb_timer
subroutine pb_timer(I)
Definition: pblastim.f:2976
lsame
logical function lsame(CA, CB)
Definition: tools.f:1724
pb_boot
subroutine pb_boot()
Definition: pblastim.f:2927
pzbla3tim
program pzbla3tim
Definition: pzblas3tim.f:12
pb_combine
subroutine pb_combine(ICTXT, SCOPE, OP, TMTYPE, N, IBEG, TIMES)
Definition: pblastim.f:3211
pzlascal
subroutine pzlascal(TYPE, M, N, ALPHA, A, IA, JA, DESCA)
Definition: pzblastst.f:7984
pmdescchk
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
pzbla3timinfo
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
pzlagen
subroutine pzlagen(INPLACE, AFORM, DIAG, OFFA, M, N, IA, JA, DESCA, IASEED, A, LDA)
Definition: pzblastst.f:8492
pdopbl3
double precision function pdopbl3(SUBNAM, M, N, K)
Definition: pblastim.f:1313
icopy
subroutine icopy(N, SX, INCX, SY, INCY)
Definition: pblastst.f:1525
pmdimchk
subroutine pmdimchk(ICTXT, NOUT, M, N, MATRIX, IA, JA, DESCA, INFO)
Definition: pblastst.f:202
min
#define min(A, B)
Definition: pcgemr.c:181