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