ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pzblas1tim.f
Go to the documentation of this file.
1  BLOCK DATA
2  INTEGER NSUBS
3  parameter(nsubs = 10)
4  CHARACTER*7 SNAMES( NSUBS )
5  COMMON /snamec/snames
6  DATA snames/'PZSWAP ', 'PZSCAL ',
7  $ 'PZDSCAL', 'PZCOPY', 'PZAXPY ',
8  $ 'PZDOTU ', 'PZDOTC' , 'PDZNRM2',
9  $ 'PDZASUM', 'PZAMAX '/
10  END BLOCK DATA
11 
12  PROGRAM pzbla1tim
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 * PZBLA1TIM is the main timing program for the Level 1 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 42 lines:
26 * 'Level 1 PBLAS, Timing input file'
27 * 'Intel iPSC/860 hypercube, gamma model.'
28 * 'PZBLAS1TIM.SUMM' output file name (if any)
29 * 6 device out
30 * 1 number of process grids (ordered pairs of P & Q)
31 * 2 2 1 4 2 3 8 values of P
32 * 2 2 4 1 3 2 1 values of Q
33 * (1.0D0, 0.0D0) value of ALPHA
34 * 2 number of tests problems
35 * 3 4 values of N
36 * 6 10 values of M_X
37 * 6 10 values of N_X
38 * 2 5 values of IMB_X
39 * 2 5 values of INB_X
40 * 2 5 values of MB_X
41 * 2 5 values of NB_X
42 * 0 1 values of RSRC_X
43 * 0 0 values of CSRC_X
44 * 1 1 values of IX
45 * 1 1 values of JX
46 * 1 1 values of INCX
47 * 6 10 values of M_Y
48 * 6 10 values of N_Y
49 * 2 5 values of IMB_Y
50 * 2 5 values of INB_Y
51 * 2 5 values of MB_Y
52 * 2 5 values of NB_Y
53 * 0 1 values of RSRC_Y
54 * 0 0 values of CSRC_Y
55 * 1 1 values of IY
56 * 1 1 values of JY
57 * 6 1 values of INCY
58 * PZSWAP T put F for no test in the same column
59 * PZSCAL T put F for no test in the same column
60 * PZDSCAL T put F for no test in the same column
61 * PZCOPY T put F for no test in the same column
62 * PZAXPY T put F for no test in the same column
63 * PZDOTU T put F for no test in the same column
64 * PZDOTC T put F for no test in the same column
65 * PDZNRM2 T put F for no test in the same column
66 * PDZASUM T put F for no test in the same column
67 * PZAMAX T put F for no test in the same column
68 *
69 * Internal Parameters
70 * ===================
71 *
72 * TOTMEM INTEGER
73 * TOTMEM is a machine-specific parameter indicating the maxi-
74 * mum amount of available memory per process in bytes. The
75 * user should customize TOTMEM to his platform. Remember to
76 * leave room in memory for the operating system, the BLACS
77 * buffer, etc. For example, on a system with 8 MB of memory
78 * per process (e.g., one processor on an Intel iPSC/860), the
79 * parameters we use are TOTMEM=6200000 (leaving 1.8 MB for OS,
80 * code, BLACS buffer, etc). However, for PVM, we usually set
81 * TOTMEM = 2000000. Some experimenting with the maximum value
82 * of TOTMEM may be required. By default, TOTMEM is 2000000.
83 *
84 * DBLESZ INTEGER
85 * ZPLXSZ INTEGER
86 * DBLESZ and ZPLXSZ indicate the length in bytes on the given
87 * platform for a double precision real and a double precision
88 * complex. By default, DBLESZ is set to eight and ZPLXSZ is set
89 * to sixteen.
90 *
91 * MEM COMPLEX*16 array
92 * MEM is an array of dimension TOTMEM / ZPLXSZ.
93 * All arrays used by SCALAPACK routines are allocated from this
94 * array MEM and referenced by pointers. The integer IPA, for
95 * example, is a pointer to the starting element of MEM for the
96 * matrix A.
97 *
98 * -- Written on April 1, 1998 by
99 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
100 *
101 * =====================================================================
102 *
103 * .. Parameters ..
104  INTEGER maxtests, maxgrids, zplxsz, totmem, memsiz,
105  $ nsubs
106  parameter( maxtests = 20, maxgrids = 20, zplxsz = 16,
107  $ totmem = 2000000, nsubs = 10,
108  $ memsiz = totmem / zplxsz )
109  INTEGER block_cyclic_2d_inb, csrc_, ctxt_, dlen_,
110  $ dtype_, imb_, inb_, lld_, mb_, m_, nb_, n_,
111  $ rsrc_
112  parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
113  $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
114  $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
115  $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
116 * ..
117 * .. Local Scalars ..
118  INTEGER csrcx, csrcy, i, iam, ictxt, imbx, imby, imidx,
119  $ imidy, inbx, inby, incx, incy, ipostx, iposty,
120  $ iprex, iprey, ipx, ipy, ix, ixseed, iy, iyseed,
121  $ j, jx, jy, k, mbx, mby, memreqd, mpx, mpy, mx,
122  $ my, mycol, myrow, n, nbx, nby, ngrids, nout,
123  $ npcol, nprocs, nprow, nqx, nqy, ntests, nx, ny,
124  $ pisclr, rsrcx, rsrcy
125  DOUBLE PRECISION adds, cflops, mults, nops, pusclr, wflops
126  COMPLEX*16 alpha, psclr
127 * ..
128 * .. Local Arrays ..
129  CHARACTER*80 outfile
130  LOGICAL ltest( nsubs ), ycheck( nsubs )
131  INTEGER cscxval( maxtests ), cscyval( maxtests ),
132  $ descx( dlen_ ), descy( dlen_ ), ierr( 2 ),
133  $ imbxval( maxtests ), imbyval( maxtests ),
134  $ inbxval( maxtests ), inbyval( maxtests ),
135  $ incxval( maxtests ), incyval( maxtests ),
136  $ ixval( maxtests ), iyval( maxtests ),
137  $ jxval( maxtests ), jyval( maxtests ),
138  $ mbxval( maxtests ), mbyval( maxtests ),
139  $ mxval( maxtests ), myval( maxtests ),
140  $ nbxval( maxtests ), nbyval( maxtests ),
141  $ nval( maxtests ), nxval( maxtests ),
142  $ nyval( maxtests ), pval( maxtests ),
143  $ qval( maxtests ), rscxval( maxtests ),
144  $ rscyval( maxtests )
145  DOUBLE PRECISION ctime( 1 ), wtime( 1 )
146  COMPLEX*16 mem( memsiz )
147 * ..
148 * .. External Subroutines ..
149  EXTERNAL blacs_barrier, blacs_exit, blacs_get,
150  $ blacs_gridexit, blacs_gridinfo, blacs_gridinit,
151  $ blacs_pinfo, igsum2d, pb_boot, pb_combine,
152  $ pb_timer, pdzasum, pdznrm2, pvdescchk,
153  $ pvdimchk, pzamax, pzaxpy, pzbla1timinfo,
154  $ pzcopy, pzdotc, pzdotu, pzdscal, pzlagen,
155  $ pzscal, pzswap
156 * ..
157 * .. Intrinsic Functions ..
158  INTRINSIC dble
159 * ..
160 * .. Common Blocks ..
161  CHARACTER*7 snames( nsubs )
162  LOGICAL abrtflg
163  INTEGER info, nblog
164  COMMON /snamec/snames
165  COMMON /infoc/info, nblog
166  COMMON /pberrorc/nout, abrtflg
167 * ..
168 * .. Data Statements ..
169  DATA ycheck/.true., .false., .false., .true.,
170  $ .true., .true., .true., .false., .false.,
171  $ .false./
172 * ..
173 * .. Executable Statements ..
174 *
175 * Initialization
176 *
177 * Set flag so that the PBLAS error handler won't abort on errors, so
178 * that the tester will detect unsupported operations.
179 *
180  abrtflg = .false.
181 *
182 * Seeds for random matrix generations.
183 *
184  ixseed = 100
185  iyseed = 200
186 *
187 * Get starting information
188 *
189  CALL blacs_pinfo( iam, nprocs )
190  CALL pzbla1timinfo( outfile, nout, ntests, nval, mxval, nxval,
191  $ imbxval, mbxval, inbxval, nbxval, rscxval,
192  $ cscxval, ixval, jxval, incxval, myval,
193  $ nyval, imbyval, mbyval, inbyval, nbyval,
194  $ rscyval, cscyval, iyval, jyval, incyval,
195  $ maxtests, ngrids, pval, maxgrids, qval,
196  $ maxgrids, ltest, iam, nprocs, alpha, mem )
197 *
198  IF( iam.EQ.0 )
199  $ WRITE( nout, fmt = 9986 )
200 *
201 * Loop over different process grids
202 *
203  DO 60 i = 1, ngrids
204 *
205  nprow = pval( i )
206  npcol = qval( i )
207 *
208 * Make sure grid information is correct
209 *
210  ierr( 1 ) = 0
211  IF( nprow.LT.1 ) THEN
212  IF( iam.EQ.0 )
213  $ WRITE( nout, fmt = 9999 ) 'GRID SIZE', 'NPROW', nprow
214  ierr( 1 ) = 1
215  ELSE IF( npcol.LT.1 ) THEN
216  IF( iam.EQ.0 )
217  $ WRITE( nout, fmt = 9999 ) 'GRID SIZE', 'NPCOL', npcol
218  ierr( 1 ) = 1
219  ELSE IF( nprow*npcol.GT.nprocs ) THEN
220  IF( iam.EQ.0 )
221  $ WRITE( nout, fmt = 9998 ) nprow*npcol, nprocs
222  ierr( 1 ) = 1
223  END IF
224 *
225  IF( ierr( 1 ).GT.0 ) THEN
226  IF( iam.EQ.0 )
227  $ WRITE( nout, fmt = 9997 ) 'GRID'
228  GO TO 60
229  END IF
230 *
231 * Define process grid
232 *
233  CALL blacs_get( -1, 0, ictxt )
234  CALL blacs_gridinit( ictxt, 'Row-major', nprow, npcol )
235  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
236 *
237 * Go to bottom of process grid loop if this case doesn't use my
238 * process
239 *
240  IF( myrow.GE.nprow .OR. mycol.GE.npcol )
241  $ GO TO 60
242 *
243 * Loop over number of tests
244 *
245  DO 50 j = 1, ntests
246 *
247 * Get the test parameters
248 *
249  n = nval( j )
250  mx = mxval( j )
251  nx = nxval( j )
252  imbx = imbxval( j )
253  mbx = mbxval( j )
254  inbx = inbxval( j )
255  nbx = nbxval( j )
256  rsrcx = rscxval( j )
257  csrcx = cscxval( j )
258  ix = ixval( j )
259  jx = jxval( j )
260  incx = incxval( j )
261  my = myval( j )
262  ny = nyval( j )
263  imby = imbyval( j )
264  mby = mbyval( j )
265  inby = inbyval( j )
266  nby = nbyval( j )
267  rsrcy = rscyval( j )
268  csrcy = cscyval( j )
269  iy = iyval( j )
270  jy = jyval( j )
271  incy = incyval( j )
272 *
273  IF( iam.EQ.0 ) THEN
274  WRITE( nout, fmt = * )
275  WRITE( nout, fmt = 9996 ) j, nprow, npcol
276  WRITE( nout, fmt = * )
277 *
278  WRITE( nout, fmt = 9995 )
279  WRITE( nout, fmt = 9994 )
280  WRITE( nout, fmt = 9995 )
281  WRITE( nout, fmt = 9993 ) n, ix, jx, mx, nx, imbx, inbx,
282  $ mbx, nbx, rsrcx, csrcx, incx
283 *
284  WRITE( nout, fmt = 9995 )
285  WRITE( nout, fmt = 9992 )
286  WRITE( nout, fmt = 9995 )
287  WRITE( nout, fmt = 9993 ) n, iy, jy, my, ny, imby, inby,
288  $ mby, nby, rsrcy, csrcy, incy
289  WRITE( nout, fmt = 9995 )
290  WRITE( nout, fmt = 9983 )
291  END IF
292 *
293 * Check the validity of the input and initialize DESC_
294 *
295  CALL pvdescchk( ictxt, nout, 'X', descx,
296  $ block_cyclic_2d_inb, mx, nx, imbx, inbx,
297  $ mbx, nbx, rsrcx, csrcx, incx, mpx, nqx,
298  $ iprex, imidx, ipostx, 0, 0, ierr( 1 ) )
299  CALL pvdescchk( ictxt, nout, 'Y', descy,
300  $ block_cyclic_2d_inb, my, ny, imby, inby,
301  $ mby, nby, rsrcy, csrcy, incy, mpy, nqy,
302  $ iprey, imidy, iposty, 0, 0, ierr( 2 ) )
303 *
304  IF( ierr( 1 ).GT.0 .OR. ierr( 2 ).GT.0 )
305  $ GO TO 40
306 *
307 * Assign pointers into MEM for matrices corresponding to
308 * vectors X and Y. Ex: IPX starts at position MEM( 1 ).
309 *
310  ipx = 1
311  ipy = ipx + descx( lld_ ) * nqx
312 *
313 * Check if sufficient memory.
314 *
315  memreqd = ipy + descy( lld_ ) * nqy - 1
316  ierr( 1 ) = 0
317  IF( memreqd.GT.memsiz ) THEN
318  IF( iam.EQ.0 )
319  $ WRITE( nout, fmt = 9990 ) memreqd*zplxsz
320  ierr( 1 ) = 1
321  END IF
322 *
323 * Check all processes for an error
324 *
325  CALL igsum2d( ictxt, 'All', ' ', 1, 1, ierr, 1, -1, 0 )
326 *
327  IF( ierr( 1 ).GT.0 ) THEN
328  IF( iam.EQ.0 )
329  $ WRITE( nout, fmt = 9991 )
330  GO TO 40
331  END IF
332 *
333 * Loop over all PBLAS 1 routines
334 *
335  DO 30 k = 1, nsubs
336 *
337 * Continue only if this sub has to be tested.
338 *
339  IF( .NOT.ltest( k ) )
340  $ GO TO 30
341 *
342 * Check the validity of the operand sizes
343 *
344  CALL pvdimchk( ictxt, nout, n, 'X', ix, jx, descx, incx,
345  $ ierr( 1 ) )
346  CALL pvdimchk( ictxt, nout, n, 'Y', iy, jy, descy, incy,
347  $ ierr( 2 ) )
348 *
349  IF( ierr( 1 ).NE.0 .OR. ierr( 2 ).NE.0 )
350  $ GO TO 30
351 *
352 * Generate distributed matrices X and Y
353 *
354  CALL pzlagen( .false., 'None', 'No diag', 0, mx, nx, 1,
355  $ 1, descx, ixseed, mem( ipx ),
356  $ descx( lld_ ) )
357  IF( ycheck( k ) )
358  $ CALL pzlagen( .false., 'None', 'No diag', 0, my, ny,
359  $ 1, 1, descy, iyseed, mem( ipy ),
360  $ descy( lld_ ) )
361 *
362  info = 0
363  CALL pb_boot()
364  CALL blacs_barrier( ictxt, 'All' )
365 *
366 * Call the PBLAS routine
367 *
368  IF( k.EQ.1 ) THEN
369 *
370 * Test PZSWAP
371 *
372  adds = 0.0d+0
373  mults = 0.0d+0
374  CALL pb_timer( 1 )
375  CALL pzswap( n, mem( ipx ), ix, jx, descx, incx,
376  $ mem( ipy ), iy, jy, descy, incy )
377  CALL pb_timer( 1 )
378 *
379  ELSE IF( k.EQ.2 ) THEN
380 *
381 * Test PZSCAL
382 *
383  adds = 0.0d+0
384  mults = dble( 6*n )
385  CALL pb_timer( 1 )
386  CALL pzscal( n, alpha, mem( ipx ), ix, jx, descx,
387  $ incx )
388  CALL pb_timer( 1 )
389 *
390  ELSE IF( k.EQ.3 ) THEN
391 *
392 * Test PZDSCAL
393 *
394  adds = 0.0d+0
395  mults = dble( 2*n )
396  CALL pb_timer( 1 )
397  CALL pzdscal( n, dble( alpha ), mem( ipx ), ix, jx,
398  $ descx, incx )
399  CALL pb_timer( 1 )
400 *
401  ELSE IF( k.EQ.4 ) THEN
402 *
403 * Test PZCOPY
404 *
405  adds = 0.0d+0
406  mults = 0.0d+0
407  CALL pb_timer( 1 )
408  CALL pzcopy( n, mem( ipx ), ix, jx, descx, incx,
409  $ mem( ipy ), iy, jy, descy, incy )
410  CALL pb_timer( 1 )
411 *
412  ELSE IF( k.EQ.5 ) THEN
413 *
414 * Test PZAXPY
415 *
416  adds = dble( 2*n )
417  mults = dble( 6*n )
418  CALL pb_timer( 1 )
419  CALL pzaxpy( n, alpha, mem( ipx ), ix, jx, descx,
420  $ incx, mem( ipy ), iy, jy, descy, incy )
421  CALL pb_timer( 1 )
422 *
423  ELSE IF( k.EQ.6 ) THEN
424 *
425 * Test PZDOTU
426 *
427  adds = dble( 2 * ( n - 1 ) )
428  mults = dble( 6*n )
429  CALL pb_timer( 1 )
430  CALL pzdotu( n, psclr, mem( ipx ), ix, jx, descx,
431  $ incx, mem( ipy ), iy, jy, descy, incy )
432  CALL pb_timer( 1 )
433 *
434  ELSE IF( k.EQ.7 ) THEN
435 *
436 * Test PZDOTC
437 *
438  adds = dble( 2 * ( n - 1 ) )
439  mults = dble( 6*n )
440  CALL pb_timer( 1 )
441  CALL pzdotc( n, psclr, mem( ipx ), ix, jx, descx,
442  $ incx, mem( ipy ), iy, jy, descy, incy )
443  CALL pb_timer( 1 )
444 *
445  ELSE IF( k.EQ.8 ) THEN
446 *
447 * Test PDZNRM2
448 *
449  adds = dble( 2 * ( n - 1 ) )
450  mults = dble( 6*n )
451  CALL pb_timer( 1 )
452  CALL pdznrm2( n, pusclr, mem( ipx ), ix, jx, descx,
453  $ incx )
454  CALL pb_timer( 1 )
455 *
456  ELSE IF( k.EQ.9 ) THEN
457 *
458 * Test PDZASUM
459 *
460  adds = dble( 2 * ( n - 1 ) )
461  mults = 0.0d+0
462  CALL pb_timer( 1 )
463  CALL pdzasum( n, pusclr, mem( ipx ), ix, jx, descx,
464  $ incx )
465  CALL pb_timer( 1 )
466 *
467  ELSE IF( k.EQ.10 ) THEN
468 *
469  adds = 0.0d+0
470  mults = 0.0d+0
471  CALL pb_timer( 1 )
472  CALL pzamax( n, psclr, pisclr, mem( ipx ), ix, jx,
473  $ descx, incx )
474  CALL pb_timer( 1 )
475 *
476  END IF
477 *
478 * Check if the operation has been performed.
479 *
480  IF( info.NE.0 ) THEN
481  IF( iam.EQ.0 )
482  $ WRITE( nout, fmt = 9985 ) info
483  GO TO 30
484  END IF
485 *
486  CALL pb_combine( ictxt, 'All', '>', 'W', 1, 1, wtime )
487  CALL pb_combine( ictxt, 'All', '>', 'C', 1, 1, ctime )
488 *
489 * Only node 0 prints timing test result
490 *
491  IF( iam.EQ.0 ) THEN
492 *
493 * Calculate total flops
494 *
495  nops = adds + mults
496 *
497 * Print WALL time if machine supports it
498 *
499  IF( wtime( 1 ).GT.0.0d+0 ) THEN
500  wflops = nops / ( wtime( 1 ) * 1.0d+6 )
501  ELSE
502  wflops = 0.0d+0
503  END IF
504 *
505 * Print CPU time if machine supports it
506 *
507  IF( ctime( 1 ).GT.0.0d+0 ) THEN
508  cflops = nops / ( ctime( 1 ) * 1.0d+6 )
509  ELSE
510  cflops = 0.0d+0
511  END IF
512 *
513  WRITE( nout, fmt = 9984 ) snames( k ), wtime( 1 ),
514  $ wflops, ctime( 1 ), cflops
515 *
516  END IF
517 *
518  30 CONTINUE
519 *
520  40 IF( iam.EQ.0 ) THEN
521  WRITE( nout, fmt = 9995 )
522  WRITE( nout, fmt = * )
523  WRITE( nout, fmt = 9988 ) j
524  END IF
525 *
526  50 CONTINUE
527 *
528  IF( iam.EQ.0 ) THEN
529  WRITE( nout, fmt = * )
530  WRITE( nout, fmt = 9987 )
531  WRITE( nout, fmt = * )
532  END IF
533 *
534  CALL blacs_gridexit( ictxt )
535 *
536  60 CONTINUE
537 *
538  CALL blacs_exit( 0 )
539 *
540  9999 FORMAT( 'ILLEGAL ', a, ': ', a, ' = ', i10,
541  $ ' should be at least 1' )
542  9998 FORMAT( 'ILLEGAL GRID: NPROW*NPCOL = ', i4,
543  $ '. It can be at most', i4 )
544  9997 FORMAT( 'Bad ', a, ' parameters: going on to next test case.' )
545  9996 FORMAT( 2x, 'Test number ', i2 , ' started on a ', i4, ' x ',
546  $ i4, ' process grid.' )
547  9995 FORMAT( 2x, '---------------------------------------------------',
548  $ '--------------------------' )
549  9994 FORMAT( 2x, ' N IX JX MX NX IMBX INBX',
550  $ ' MBX NBX RSRCX CSRCX INCX' )
551  9993 FORMAT( 2x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i5,1x,i5,1x,i5,1x,i5,1x,
552  $ i5,1x,i5,1x,i6 )
553  9992 FORMAT( 2x, ' N IY JY MY NY IMBY INBY',
554  $ ' MBY NBY RSRCY CSRCY INCY' )
555  9991 FORMAT( 'Not enough memory for this test: going on to',
556  $ ' next test case.' )
557  9990 FORMAT( 'Not enough memory. Need: ', i12 )
558  9988 FORMAT( 2x, 'Test number ', i2, ' completed.' )
559  9987 FORMAT( 2x, 'End of Tests.' )
560  9986 FORMAT( 2x, 'Tests started.' )
561  9985 FORMAT( 2x, ' ***** Operation not supported, error code: ',
562  $ i5, ' *****' )
563  9984 FORMAT( 2x, '| ', a, 2x, f13.3, 2x, f13.3, 2x, f13.3, 2x, f13.3 )
564  9983 FORMAT( 2x, ' WALL time (s) WALL Mflops ',
565  $ ' CPU time (s) CPU Mflops' )
566 *
567  stop
568 *
569 * End of PZBLA1TIM
570 *
571  END
572  SUBROUTINE pzbla1timinfo( SUMMRY, NOUT, NMAT, NVAL, MXVAL, NXVAL,
573  $ IMBXVAL, MBXVAL, INBXVAL, NBXVAL,
574  $ RSCXVAL, CSCXVAL, IXVAL, JXVAL,
575  $ INCXVAL, MYVAL, NYVAL, IMBYVAL, MBYVAL,
576  $ INBYVAL, NBYVAL, RSCYVAL, CSCYVAL,
577  $ IYVAL, JYVAL, INCYVAL, LDVAL, NGRIDS,
578  $ PVAL, LDPVAL, QVAL, LDQVAL, LTEST, IAM,
579  $ NPROCS, ALPHA, WORK )
580 *
581 * -- PBLAS test routine (version 2.0) --
582 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
583 * and University of California, Berkeley.
584 * April 1, 1998
585 *
586 * .. Scalar Arguments ..
587  INTEGER IAM, LDPVAL, LDQVAL, LDVAL, NGRIDS, NMAT, NOUT,
588  $ NPROCS
589  COMPLEX*16 ALPHA
590 * ..
591 * .. Array Arguments ..
592  CHARACTER*( * ) SUMMRY
593  LOGICAL LTEST( * )
594  INTEGER CSCXVAL( LDVAL ), CSCYVAL( LDVAL ),
595  $ IMBXVAL( LDVAL ), IMBYVAL( LDVAL ),
596  $ inbxval( ldval ), inbyval( ldval ),
597  $ incxval( ldval ), incyval( ldval ),
598  $ ixval( ldval ), iyval( ldval ), jxval( ldval ),
599  $ jyval( ldval ), mbxval( ldval ),
600  $ mbyval( ldval ), mxval( ldval ),
601  $ myval( ldval ), nbxval( ldval ),
602  $ nbyval( ldval ), nval( ldval ), nxval( ldval ),
603  $ nyval( ldval ), pval( ldpval ), qval( ldqval ),
604  $ rscxval( ldval ), rscyval( ldval ), work( * )
605 * ..
606 *
607 * Purpose
608 * =======
609 *
610 * PZBLA1TIMINFO get the needed startup information for timing various
611 * Level 1 PBLAS routines, and transmits it to all processes.
612 *
613 * Notes
614 * =====
615 *
616 * For packing the information we assumed that the length in bytes of an
617 * integer is equal to the length in bytes of a real single precision.
618 *
619 * Arguments
620 * =========
621 *
622 * SUMMRY (global output) CHARACTER*(*)
623 * On exit, SUMMRY is the name of output (summary) file (if
624 * any). SUMMRY is only defined for process 0.
625 *
626 * NOUT (global output) INTEGER
627 * On exit, NOUT specifies the unit number for the output file.
628 * When NOUT is 6, output to screen, when NOUT is 0, output to
629 * stderr. NOUT is only defined for process 0.
630 *
631 * NMAT (global output) INTEGER
632 * On exit, NMAT specifies the number of different test cases.
633 *
634 * NVAL (global output) INTEGER array
635 * On entry, NVAL is an array of dimension LDVAL. On exit, this
636 * array contains the values of N to run the code with.
637 *
638 * MXVAL (global output) INTEGER array
639 * On entry, MXVAL is an array of dimension LDVAL. On exit, this
640 * array contains the values of DESCX( M_ ) to run the code
641 * with.
642 *
643 * NXVAL (global output) INTEGER array
644 * On entry, NXVAL is an array of dimension LDVAL. On exit, this
645 * array contains the values of DESCX( N_ ) to run the code
646 * with.
647 *
648 * IMBXVAL (global output) INTEGER array
649 * On entry, IMBXVAL is an array of dimension LDVAL. On exit,
650 * this array contains the values of DESCX( IMB_ ) to run the
651 * code with.
652 *
653 * MBXVAL (global output) INTEGER array
654 * On entry, MBXVAL is an array of dimension LDVAL. On exit,
655 * this array contains the values of DESCX( MB_ ) to run the
656 * code with.
657 *
658 * INBXVAL (global output) INTEGER array
659 * On entry, INBXVAL is an array of dimension LDVAL. On exit,
660 * this array contains the values of DESCX( INB_ ) to run the
661 * code with.
662 *
663 * NBXVAL (global output) INTEGER array
664 * On entry, NBXVAL is an array of dimension LDVAL. On exit,
665 * this array contains the values of DESCX( NB_ ) to run the
666 * code with.
667 *
668 * RSCXVAL (global output) INTEGER array
669 * On entry, RSCXVAL is an array of dimension LDVAL. On exit,
670 * this array contains the values of DESCX( RSRC_ ) to run the
671 * code with.
672 *
673 * CSCXVAL (global output) INTEGER array
674 * On entry, CSCXVAL is an array of dimension LDVAL. On exit,
675 * this array contains the values of DESCX( CSRC_ ) to run the
676 * code with.
677 *
678 * IXVAL (global output) INTEGER array
679 * On entry, IXVAL is an array of dimension LDVAL. On exit, this
680 * array contains the values of IX to run the code with.
681 *
682 * JXVAL (global output) INTEGER array
683 * On entry, JXVAL is an array of dimension LDVAL. On exit, this
684 * array contains the values of JX to run the code with.
685 *
686 * INCXVAL (global output) INTEGER array
687 * On entry, INCXVAL is an array of dimension LDVAL. On exit,
688 * this array contains the values of INCX to run the code with.
689 *
690 * MYVAL (global output) INTEGER array
691 * On entry, MYVAL is an array of dimension LDVAL. On exit, this
692 * array contains the values of DESCY( M_ ) to run the code
693 * with.
694 *
695 * NYVAL (global output) INTEGER array
696 * On entry, NYVAL is an array of dimension LDVAL. On exit, this
697 * array contains the values of DESCY( N_ ) to run the code
698 * with.
699 *
700 * IMBYVAL (global output) INTEGER array
701 * On entry, IMBYVAL is an array of dimension LDVAL. On exit,
702 * this array contains the values of DESCY( IMB_ ) to run the
703 * code with.
704 *
705 * MBYVAL (global output) INTEGER array
706 * On entry, MBYVAL is an array of dimension LDVAL. On exit,
707 * this array contains the values of DESCY( MB_ ) to run the
708 * code with.
709 *
710 * INBYVAL (global output) INTEGER array
711 * On entry, INBYVAL is an array of dimension LDVAL. On exit,
712 * this array contains the values of DESCY( INB_ ) to run the
713 * code with.
714 *
715 * NBYVAL (global output) INTEGER array
716 * On entry, NBYVAL is an array of dimension LDVAL. On exit,
717 * this array contains the values of DESCY( NB_ ) to run the
718 * code with.
719 *
720 * RSCYVAL (global output) INTEGER array
721 * On entry, RSCYVAL is an array of dimension LDVAL. On exit,
722 * this array contains the values of DESCY( RSRC_ ) to run the
723 * code with.
724 *
725 * CSCYVAL (global output) INTEGER array
726 * On entry, CSCYVAL is an array of dimension LDVAL. On exit,
727 * this array contains the values of DESCY( CSRC_ ) to run the
728 * code with.
729 *
730 * IYVAL (global output) INTEGER array
731 * On entry, IYVAL is an array of dimension LDVAL. On exit, this
732 * array contains the values of IY to run the code with.
733 *
734 * JYVAL (global output) INTEGER array
735 * On entry, JYVAL is an array of dimension LDVAL. On exit, this
736 * array contains the values of JY to run the code with.
737 *
738 * INCYVAL (global output) INTEGER array
739 * On entry, INCYVAL is an array of dimension LDVAL. On exit,
740 * this array contains the values of INCY to run the code with.
741 *
742 * LDVAL (global input) INTEGER
743 * On entry, LDVAL specifies the maximum number of different va-
744 * lues that can be used for DESCX(:), IX, JX, INCX, DESCY(:),
745 * IY, JY and INCY. This is also the maximum number of test
746 * cases.
747 *
748 * NGRIDS (global output) INTEGER
749 * On exit, NGRIDS specifies the number of different values that
750 * can be used for P and Q.
751 *
752 * PVAL (global output) INTEGER array
753 * On entry, PVAL is an array of dimension LDPVAL. On exit, this
754 * array contains the values of P to run the code with.
755 *
756 * LDPVAL (global input) INTEGER
757 * On entry, LDPVAL specifies the maximum number of different
758 * values that can be used for P.
759 *
760 * QVAL (global output) INTEGER array
761 * On entry, QVAL is an array of dimension LDQVAL. On exit, this
762 * array contains the values of Q to run the code with.
763 *
764 * LDQVAL (global input) INTEGER
765 * On entry, LDQVAL specifies the maximum number of different
766 * values that can be used for Q.
767 *
768 * LTEST (global output) LOGICAL array
769 * On entry, LTEST is an array of dimension at least ten. On
770 * exit, if LTEST( i ) is .TRUE., the i-th Level 1 PBLAS routine
771 * will be tested. See the input file for the ordering of the
772 * routines.
773 *
774 * IAM (local input) INTEGER
775 * On entry, IAM specifies the number of the process executing
776 * this routine.
777 *
778 * NPROCS (global input) INTEGER
779 * On entry, NPROCS specifies the total number of processes.
780 *
781 * ALPHA (global output) COMPLEX*16
782 * On exit, ALPHA specifies the value of alpha to be used in all
783 * the test cases.
784 *
785 * WORK (local workspace) INTEGER array
786 * On entry, WORK is an array of dimension at least
787 * MAX( 2, 2*NGRIDS+23*NMAT+NSUBS ) with NSUBS = 10. This array
788 * is used to pack all output arrays in order to send info in
789 * one message.
790 *
791 * -- Written on April 1, 1998 by
792 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
793 *
794 * =====================================================================
795 *
796 * .. Parameters ..
797  INTEGER NIN, NSUBS
798  PARAMETER ( NIN = 11, nsubs = 10 )
799 * ..
800 * .. Local Scalars ..
801  LOGICAL LTESTT
802  INTEGER I, ICTXT, J
803 * ..
804 * .. Local Arrays ..
805  CHARACTER*7 SNAMET
806  CHARACTER*79 USRINFO
807 * ..
808 * .. External Subroutines ..
809  EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
810  $ blacs_gridinit, blacs_setup, icopy, igebr2d,
811  $ igebs2d, sgebr2d, sgebs2d, zgebr2d, zgebs2d
812 * ..
813 * .. Intrinsic Functions ..
814  INTRINSIC max, min
815 * ..
816 * .. Common Blocks ..
817  CHARACTER*7 SNAMES( NSUBS )
818  COMMON /SNAMEC/SNAMES
819 * ..
820 * .. Executable Statements ..
821 *
822 *
823 * Process 0 reads the input data, broadcasts to other processes and
824 * writes needed information to NOUT
825 *
826  IF( iam.EQ.0 ) THEN
827 *
828 * Open file and skip data file header
829 *
830  OPEN( nin, file='PZBLAS1TIM.dat', status='OLD' )
831  READ( nin, fmt = * ) summry
832  summry = ' '
833 *
834 * Read in user-supplied info about machine type, compiler, etc.
835 *
836  READ( nin, fmt = 9999 ) usrinfo
837 *
838 * Read name and unit number for summary output file
839 *
840  READ( nin, fmt = * ) summry
841  READ( nin, fmt = * ) nout
842  IF( nout.NE.0 .AND. nout.NE.6 )
843  $ OPEN( nout, file = summry, status = 'UNKNOWN' )
844 *
845 * Read and check the parameter values for the tests.
846 *
847 * Get number of grids
848 *
849  READ( nin, fmt = * ) ngrids
850  IF( ngrids.LT.1 .OR. ngrids.GT.ldpval ) THEN
851  WRITE( nout, fmt = 9998 ) 'Grids', ldpval
852  GO TO 100
853  ELSE IF( ngrids.GT.ldqval ) THEN
854  WRITE( nout, fmt = 9998 ) 'Grids', ldqval
855  GO TO 100
856  END IF
857 *
858 * Get values of P and Q
859 *
860  READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
861  READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
862 *
863 * Read ALPHA
864 *
865  READ( nin, fmt = * ) alpha
866 *
867 * Read number of tests.
868 *
869  READ( nin, fmt = * ) nmat
870  IF( nmat.LT.1 .OR. nmat.GT.ldval ) THEN
871  WRITE( nout, fmt = 9998 ) 'Tests', ldval
872  GO TO 100
873  END IF
874 *
875 * Read in input data into arrays.
876 *
877  READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
878  READ( nin, fmt = * ) ( mxval( i ), i = 1, nmat )
879  READ( nin, fmt = * ) ( nxval( i ), i = 1, nmat )
880  READ( nin, fmt = * ) ( imbxval( i ), i = 1, nmat )
881  READ( nin, fmt = * ) ( inbxval( i ), i = 1, nmat )
882  READ( nin, fmt = * ) ( mbxval( i ), i = 1, nmat )
883  READ( nin, fmt = * ) ( nbxval( i ), i = 1, nmat )
884  READ( nin, fmt = * ) ( rscxval( i ), i = 1, nmat )
885  READ( nin, fmt = * ) ( cscxval( i ), i = 1, nmat )
886  READ( nin, fmt = * ) ( ixval( i ), i = 1, nmat )
887  READ( nin, fmt = * ) ( jxval( i ), i = 1, nmat )
888  READ( nin, fmt = * ) ( incxval( i ), i = 1, nmat )
889  READ( nin, fmt = * ) ( myval( i ), i = 1, nmat )
890  READ( nin, fmt = * ) ( nyval( i ), i = 1, nmat )
891  READ( nin, fmt = * ) ( imbyval( i ), i = 1, nmat )
892  READ( nin, fmt = * ) ( inbyval( i ), i = 1, nmat )
893  READ( nin, fmt = * ) ( mbyval( i ), i = 1, nmat )
894  READ( nin, fmt = * ) ( nbyval( i ), i = 1, nmat )
895  READ( nin, fmt = * ) ( rscyval( i ), i = 1, nmat )
896  READ( nin, fmt = * ) ( cscyval( i ), i = 1, nmat )
897  READ( nin, fmt = * ) ( iyval( i ), i = 1, nmat )
898  READ( nin, fmt = * ) ( jyval( i ), i = 1, nmat )
899  READ( nin, fmt = * ) ( incyval( i ), i = 1, nmat )
900 *
901 * Read names of subroutines and flags which indicate
902 * whether they are to be tested.
903 *
904  DO 10 i = 1, nsubs
905  ltest( i ) = .false.
906  10 CONTINUE
907  20 CONTINUE
908  READ( nin, fmt = 9996, END = 50 ) SNAMET, ltestt
909  DO 30 i = 1, nsubs
910  IF( snamet.EQ.snames( i ) )
911  $ GO TO 40
912  30 CONTINUE
913 *
914  WRITE( nout, fmt = 9995 )snamet
915  GO TO 100
916 *
917  40 CONTINUE
918  ltest( i ) = ltestt
919  GO TO 20
920 *
921  50 CONTINUE
922 *
923 * Close input file
924 *
925  CLOSE ( nin )
926 *
927 * For pvm only: if virtual machine not set up, allocate it and
928 * spawn the correct number of processes.
929 *
930  IF( nprocs.LT.1 ) THEN
931  nprocs = 0
932  DO 60 i = 1, ngrids
933  nprocs = max( nprocs, pval( i )*qval( i ) )
934  60 CONTINUE
935  CALL blacs_setup( iam, nprocs )
936  END IF
937 *
938 * Temporarily define blacs grid to include all processes so
939 * information can be broadcast to all processes
940 *
941  CALL blacs_get( -1, 0, ictxt )
942  CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
943 *
944 * Pack information arrays and broadcast
945 *
946  CALL zgebs2d( ictxt, 'All', ' ', 1, 1, alpha, 1 )
947 *
948  work( 1 ) = ngrids
949  work( 2 ) = nmat
950  CALL igebs2d( ictxt, 'All', ' ', 2, 1, work, 2 )
951 *
952  i = 1
953  CALL icopy( ngrids, pval, 1, work( i ), 1 )
954  i = i + ngrids
955  CALL icopy( ngrids, qval, 1, work( i ), 1 )
956  i = i + ngrids
957  CALL icopy( nmat, nval, 1, work( i ), 1 )
958  i = i + nmat
959  CALL icopy( nmat, mxval, 1, work( i ), 1 )
960  i = i + nmat
961  CALL icopy( nmat, nxval, 1, work( i ), 1 )
962  i = i + nmat
963  CALL icopy( nmat, imbxval, 1, work( i ), 1 )
964  i = i + nmat
965  CALL icopy( nmat, inbxval, 1, work( i ), 1 )
966  i = i + nmat
967  CALL icopy( nmat, mbxval, 1, work( i ), 1 )
968  i = i + nmat
969  CALL icopy( nmat, nbxval, 1, work( i ), 1 )
970  i = i + nmat
971  CALL icopy( nmat, rscxval, 1, work( i ), 1 )
972  i = i + nmat
973  CALL icopy( nmat, cscxval, 1, work( i ), 1 )
974  i = i + nmat
975  CALL icopy( nmat, ixval, 1, work( i ), 1 )
976  i = i + nmat
977  CALL icopy( nmat, jxval, 1, work( i ), 1 )
978  i = i + nmat
979  CALL icopy( nmat, incxval, 1, work( i ), 1 )
980  i = i + nmat
981  CALL icopy( nmat, myval, 1, work( i ), 1 )
982  i = i + nmat
983  CALL icopy( nmat, nyval, 1, work( i ), 1 )
984  i = i + nmat
985  CALL icopy( nmat, imbyval, 1, work( i ), 1 )
986  i = i + nmat
987  CALL icopy( nmat, inbyval, 1, work( i ), 1 )
988  i = i + nmat
989  CALL icopy( nmat, mbyval, 1, work( i ), 1 )
990  i = i + nmat
991  CALL icopy( nmat, nbyval, 1, work( i ), 1 )
992  i = i + nmat
993  CALL icopy( nmat, rscyval, 1, work( i ), 1 )
994  i = i + nmat
995  CALL icopy( nmat, cscyval, 1, work( i ), 1 )
996  i = i + nmat
997  CALL icopy( nmat, iyval, 1, work( i ), 1 )
998  i = i + nmat
999  CALL icopy( nmat, jyval, 1, work( i ), 1 )
1000  i = i + nmat
1001  CALL icopy( nmat, incyval, 1, work( i ), 1 )
1002  i = i + nmat
1003 *
1004  DO 70 j = 1, nsubs
1005  IF( ltest( j ) ) THEN
1006  work( i ) = 1
1007  ELSE
1008  work( i ) = 0
1009  END IF
1010  i = i + 1
1011  70 CONTINUE
1012  i = i - 1
1013  CALL igebs2d( ictxt, 'All', ' ', i, 1, work, i )
1014 *
1015 * regurgitate input
1016 *
1017  WRITE( nout, fmt = 9999 )
1018  $ 'Level 1 PBLAS timing program.'
1019  WRITE( nout, fmt = 9999 ) usrinfo
1020  WRITE( nout, fmt = * )
1021  WRITE( nout, fmt = 9999 )
1022  $ 'Timing of the complex double precision '//
1023  $ 'Level 1 PBLAS'
1024  WRITE( nout, fmt = * )
1025  WRITE( nout, fmt = 9999 )
1026  $ 'The following parameter values will be used:'
1027  WRITE( nout, fmt = * )
1028  WRITE( nout, fmt = 9993 ) nmat
1029  WRITE( nout, fmt = 9992 ) ngrids
1030  WRITE( nout, fmt = 9990 )
1031  $ 'P', ( pval(i), i = 1, min(ngrids, 5) )
1032  IF( ngrids.GT.5 )
1033  $ WRITE( nout, fmt = 9991 ) ( pval(i), i = 6,
1034  $ min( 10, ngrids ) )
1035  IF( ngrids.GT.10 )
1036  $ WRITE( nout, fmt = 9991 ) ( pval(i), i = 11,
1037  $ min( 15, ngrids ) )
1038  IF( ngrids.GT.15 )
1039  $ WRITE( nout, fmt = 9991 ) ( pval(i), i = 16, ngrids )
1040  WRITE( nout, fmt = 9990 )
1041  $ 'Q', ( qval(i), i = 1, min(ngrids, 5) )
1042  IF( ngrids.GT.5 )
1043  $ WRITE( nout, fmt = 9991 ) ( qval(i), i = 6,
1044  $ min( 10, ngrids ) )
1045  IF( ngrids.GT.10 )
1046  $ WRITE( nout, fmt = 9991 ) ( qval(i), i = 11,
1047  $ min( 15, ngrids ) )
1048  IF( ngrids.GT.15 )
1049  $ WRITE( nout, fmt = 9991 ) ( qval(i), i = 16, ngrids )
1050  WRITE( nout, fmt = 9994 ) alpha
1051  IF( ltest( 1 ) ) THEN
1052  WRITE( nout, fmt = 9989 ) snames( 1 ), ' ... Yes'
1053  ELSE
1054  WRITE( nout, fmt = 9989 ) snames( 1 ), ' ... No '
1055  END IF
1056  DO 80 i = 2, nsubs
1057  IF( ltest( i ) ) THEN
1058  WRITE( nout, fmt = 9988 ) snames( i ), ' ... Yes'
1059  ELSE
1060  WRITE( nout, fmt = 9988 ) snames( i ), ' ... No '
1061  END IF
1062  80 CONTINUE
1063  WRITE( nout, fmt = * )
1064 *
1065  ELSE
1066 *
1067 * If in pvm, must participate setting up virtual machine
1068 *
1069  IF( nprocs.LT.1 )
1070  $ CALL blacs_setup( iam, nprocs )
1071 *
1072 * Temporarily define blacs grid to include all processes so
1073 * information can be broadcast to all processes
1074 *
1075  CALL blacs_get( -1, 0, ictxt )
1076  CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
1077 *
1078  CALL zgebr2d( ictxt, 'All', ' ', 1, 1, alpha, 1, 0, 0 )
1079 *
1080  CALL igebr2d( ictxt, 'All', ' ', 2, 1, work, 2, 0, 0 )
1081  ngrids = work( 1 )
1082  nmat = work( 2 )
1083 *
1084  i = 2*ngrids + 23*nmat + nsubs
1085  CALL igebr2d( ictxt, 'All', ' ', i, 1, work, i, 0, 0 )
1086 *
1087  i = 1
1088  CALL icopy( ngrids, work( i ), 1, pval, 1 )
1089  i = i + ngrids
1090  CALL icopy( ngrids, work( i ), 1, qval, 1 )
1091  i = i + ngrids
1092  CALL icopy( nmat, work( i ), 1, nval, 1 )
1093  i = i + nmat
1094  CALL icopy( nmat, work( i ), 1, mxval, 1 )
1095  i = i + nmat
1096  CALL icopy( nmat, work( i ), 1, nxval, 1 )
1097  i = i + nmat
1098  CALL icopy( nmat, work( i ), 1, imbxval, 1 )
1099  i = i + nmat
1100  CALL icopy( nmat, work( i ), 1, inbxval, 1 )
1101  i = i + nmat
1102  CALL icopy( nmat, work( i ), 1, mbxval, 1 )
1103  i = i + nmat
1104  CALL icopy( nmat, work( i ), 1, nbxval, 1 )
1105  i = i + nmat
1106  CALL icopy( nmat, work( i ), 1, rscxval, 1 )
1107  i = i + nmat
1108  CALL icopy( nmat, work( i ), 1, cscxval, 1 )
1109  i = i + nmat
1110  CALL icopy( nmat, work( i ), 1, ixval, 1 )
1111  i = i + nmat
1112  CALL icopy( nmat, work( i ), 1, jxval, 1 )
1113  i = i + nmat
1114  CALL icopy( nmat, work( i ), 1, incxval, 1 )
1115  i = i + nmat
1116  CALL icopy( nmat, work( i ), 1, myval, 1 )
1117  i = i + nmat
1118  CALL icopy( nmat, work( i ), 1, nyval, 1 )
1119  i = i + nmat
1120  CALL icopy( nmat, work( i ), 1, imbyval, 1 )
1121  i = i + nmat
1122  CALL icopy( nmat, work( i ), 1, inbyval, 1 )
1123  i = i + nmat
1124  CALL icopy( nmat, work( i ), 1, mbyval, 1 )
1125  i = i + nmat
1126  CALL icopy( nmat, work( i ), 1, nbyval, 1 )
1127  i = i + nmat
1128  CALL icopy( nmat, work( i ), 1, rscyval, 1 )
1129  i = i + nmat
1130  CALL icopy( nmat, work( i ), 1, cscyval, 1 )
1131  i = i + nmat
1132  CALL icopy( nmat, work( i ), 1, iyval, 1 )
1133  i = i + nmat
1134  CALL icopy( nmat, work( i ), 1, jyval, 1 )
1135  i = i + nmat
1136  CALL icopy( nmat, work( i ), 1, incyval, 1 )
1137  i = i + nmat
1138 *
1139  DO 90 j = 1, nsubs
1140  IF( work( i ).EQ.1 ) THEN
1141  ltest( j ) = .true.
1142  ELSE
1143  ltest( j ) = .false.
1144  END IF
1145  i = i + 1
1146  90 CONTINUE
1147 *
1148  END IF
1149 *
1150  CALL blacs_gridexit( ictxt )
1151 *
1152  RETURN
1153 *
1154  100 WRITE( nout, fmt = 9997 )
1155  CLOSE( nin )
1156  IF( nout.NE.6 .AND. nout.NE.0 )
1157  $ CLOSE( nout )
1158  CALL blacs_abort( ictxt, 1 )
1159 *
1160  stop
1161 *
1162  9999 FORMAT( a )
1163  9998 FORMAT( ' Number of values of ',5a, ' is less than 1 or greater ',
1164  $ 'than ', i2 )
1165  9997 FORMAT( ' Illegal input in file ',40a,'. Aborting run.' )
1166  9996 FORMAT( a7, l2 )
1167  9995 FORMAT( ' Subprogram name ', a7, ' not recognized',
1168  $ /' ******* TESTS ABANDONED *******' )
1169  9994 FORMAT( 2x, 'Alpha : (', g16.6,
1170  $ ',', g16.6, ')' )
1171  9993 FORMAT( 2x, 'Number of Tests : ', i6 )
1172  9992 FORMAT( 2x, 'Number of process grids : ', i6 )
1173  9991 FORMAT( 2x, ' : ', 5i6 )
1174  9990 FORMAT( 2x, a1, ' : ', 5i6 )
1175  9989 FORMAT( 2x, 'Routines to be tested : ', a, a8 )
1176  9988 FORMAT( 2x, ' ', a, a8 )
1177 *
1178 * End of PZBLA1TIMINFO
1179 *
1180  END
max
#define max(A, B)
Definition: pcgemr.c:180
pb_timer
subroutine pb_timer(I)
Definition: pblastim.f:2976
pb_boot
subroutine pb_boot()
Definition: pblastim.f:2927
pb_combine
subroutine pb_combine(ICTXT, SCOPE, OP, TMTYPE, N, IBEG, TIMES)
Definition: pblastim.f:3211
pzbla1timinfo
subroutine pzbla1timinfo(SUMMRY, NOUT, NMAT, NVAL, MXVAL, NXVAL, IMBXVAL, MBXVAL, INBXVAL, NBXVAL, RSCXVAL, CSCXVAL, IXVAL, JXVAL, INCXVAL, MYVAL, NYVAL, IMBYVAL, MBYVAL, INBYVAL, NBYVAL, RSCYVAL, CSCYVAL, IYVAL, JYVAL, INCYVAL, LDVAL, NGRIDS, PVAL, LDPVAL, QVAL, LDQVAL, LTEST, IAM, NPROCS, ALPHA, WORK)
Definition: pzblas1tim.f:580
pzlagen
subroutine pzlagen(INPLACE, AFORM, DIAG, OFFA, M, N, IA, JA, DESCA, IASEED, A, LDA)
Definition: pzblastst.f:8492
icopy
subroutine icopy(N, SX, INCX, SY, INCY)
Definition: pblastst.f:1525
pzbla1tim
program pzbla1tim
Definition: pzblas1tim.f:12
pvdescchk
subroutine pvdescchk(ICTXT, NOUT, MATRIX, DESCX, DTX, MX, NX, IMBX, INBX, MBX, NBX, RSRCX, CSRCX, INCX, MPX, NQX, IPREX, IMIDX, IPOSTX, IGAP, GAPMUL, INFO)
Definition: pblastst.f:388
pvdimchk
subroutine pvdimchk(ICTXT, NOUT, N, MATRIX, IX, JX, DESCX, INCX, INFO)
Definition: pblastst.f:3
min
#define min(A, B)
Definition: pcgemr.c:181