SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
psblas2tim.f
Go to the documentation of this file.
1 BLOCK DATA
2 INTEGER NSUBS
3 parameter(nsubs = 7)
4 CHARACTER*7 SNAMES( NSUBS )
5 COMMON /snamec/snames
6 DATA snames/'PSGEMV ', 'PSSYMV ', 'PSTRMV ',
7 $ 'PSTRSV ', 'PSGER ', 'PSSYR ',
8 $ 'PSSYR2 '/
9 END BLOCK DATA
10
11 PROGRAM psbla2tim
12*
13* -- PBLAS timing driver (version 2.0.2) --
14* Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver
15* May 1 2012
16*
17* Purpose
18* =======
19*
20* PSBLA2TIM is the main timing program for the Level 2 PBLAS routines.
21*
22* The program must be driven by a short data file. An annotated exam-
23* ple of a data file can be obtained by deleting the first 3 characters
24* from the following 55 lines:
25* 'Level 2 PBLAS, Timing input file'
26* 'Intel iPSC/860 hypercube, gamma model.'
27* 'PSBLAS2TIM.SUMM' output file name (if any)
28* 6 device out
29* 10 value of the logical computational blocksize NB
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 value of ALPHA
34* 1.0E0 value of BETA
35* 2 number of tests problems
36* 'U' 'L' values of UPLO
37* 'N' 'T' values of TRANS
38* 'N' 'U' values of DIAG
39* 3 4 values of M
40* 3 4 values of N
41* 6 10 values of M_A
42* 6 10 values of N_A
43* 2 5 values of IMB_A
44* 2 5 values of INB_A
45* 2 5 values of MB_A
46* 2 5 values of NB_A
47* 0 1 values of RSRC_A
48* 0 0 values of CSRC_A
49* 1 1 values of IA
50* 1 1 values of JA
51* 6 10 values of M_X
52* 6 10 values of N_X
53* 2 5 values of IMB_X
54* 2 5 values of INB_X
55* 2 5 values of MB_X
56* 2 5 values of NB_X
57* 0 1 values of RSRC_X
58* 0 0 values of CSRC_X
59* 1 1 values of IX
60* 1 1 values of JX
61* 1 1 values of INCX
62* 6 10 values of M_Y
63* 6 10 values of N_Y
64* 2 5 values of IMB_Y
65* 2 5 values of INB_Y
66* 2 5 values of MB_Y
67* 2 5 values of NB_Y
68* 0 1 values of RSRC_Y
69* 0 0 values of CSRC_Y
70* 1 1 values of IY
71* 1 1 values of JY
72* 6 1 values of INCY
73* PSGEMV T put F for no test in the same column
74* PSSYMV T put F for no test in the same column
75* PSTRMV T put F for no test in the same column
76* PSTRSV T put F for no test in the same column
77* PSGER T put F for no test in the same column
78* PSSYR T put F for no test in the same column
79* PSSYR2 T put F for no test in the same column
80*
81* Internal Parameters
82* ===================
83*
84* TOTMEM INTEGER
85* TOTMEM is a machine-specific parameter indicating the maxi-
86* mum amount of available memory per process in bytes. The
87* user should customize TOTMEM to his platform. Remember to
88* leave room in memory for the operating system, the BLACS
89* buffer, etc. For example, on a system with 8 MB of memory
90* per process (e.g., one processor on an Intel iPSC/860), the
91* parameters we use are TOTMEM=6200000 (leaving 1.8 MB for OS,
92* code, BLACS buffer, etc). However, for PVM, we usually set
93* TOTMEM = 2000000. Some experimenting with the maximum value
94* of TOTMEM may be required. By default, TOTMEM is 2000000.
95*
96* REALSZ INTEGER
97* REALSZ indicates the length in bytes on the given platform
98* for a single precision real. By default, REALSZ is set to
99* four.
100*
101* MEM REAL array
102* MEM is an array of dimension TOTMEM / REALSZ.
103* All arrays used by SCALAPACK routines are allocated from this
104* array MEM and referenced by pointers. The integer IPA, for
105* example, is a pointer to the starting element of MEM for the
106* matrix A.
107*
108* -- Written on April 1, 1998 by
109* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
110*
111* =====================================================================
112*
113* .. Parameters ..
114 INTEGER maxtests, maxgrids, realsz, totmem, memsiz,
115 $ nsubs
116 REAL one
117 parameter( maxtests = 20, maxgrids = 20, realsz = 4,
118 $ one = 1.0e+0, totmem = 2000000, nsubs = 7,
119 $ memsiz = totmem / realsz )
120 INTEGER block_cyclic_2d_inb, csrc_, ctxt_, dlen_,
121 $ dtype_, imb_, inb_, lld_, mb_, m_, nb_, n_,
122 $ rsrc_
123 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
124 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
125 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
126 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
127* ..
128* .. Local Scalars ..
129 CHARACTER*1 aform, diag, diagdo, trans, uplo
130 INTEGER csrca, csrcx, csrcy, i, ia, iam, iaseed, ictxt,
131 $ imba, imbx, imby, imida, imidx, imidy, inba,
132 $ inbx, inby, incx, incy, ipa, iposta, ipostx,
133 $ iposty, iprea, iprex, iprey, ipx, ipy, ix,
134 $ ixseed, iy, iyseed, j, ja, jx, jy, k, m, ma,
135 $ mba, mbx, mby, memreqd, mpa, mpx, mpy, mx, my,
136 $ mycol, myrow, n, na, nba, nbx, nby, ncola,
137 $ ngrids, nlx, nly, nout, npcol, nprocs, nprow,
138 $ nqa, nqx, nqy, nrowa, ntests, nx, ny, offd,
139 $ rsrca, rsrcx, rsrcy
140 REAL alpha, beta, scale
141 DOUBLE PRECISION cflops, nops, wflops
142* ..
143* .. Local Arrays ..
144 LOGICAL ltest( nsubs ), ycheck( nsubs )
145 CHARACTER*1 diagval( maxtests ), tranval( maxtests ),
146 $ uploval( maxtests )
147 CHARACTER*80 outfile
148 INTEGER cscaval( maxtests ), cscxval( maxtests ),
149 $ cscyval( maxtests ), desca( dlen_ ),
150 $ descx( dlen_ ), descy( dlen_ ),
151 $ iaval( maxtests ), ierr( 3 ),
152 $ imbaval( maxtests ), imbxval( maxtests ),
153 $ imbyval( maxtests ), inbaval( maxtests ),
154 $ inbxval( maxtests ), inbyval( maxtests ),
155 $ incxval( maxtests ), incyval( maxtests ),
156 $ ixval( maxtests ), iyval( maxtests ),
157 $ javal( maxtests ), jxval( maxtests ),
158 $ jyval( maxtests ), maval( maxtests ),
159 $ mbaval( maxtests ), mbxval( maxtests ),
160 $ mbyval( maxtests ), mval( maxtests ),
161 $ mxval( maxtests ), myval( maxtests ),
162 $ naval( maxtests ), nbaval( maxtests ),
163 $ nbxval( maxtests ), nbyval( maxtests ),
164 $ nval( maxtests ), nxval( maxtests ),
165 $ nyval( maxtests ), pval( maxtests ),
166 $ qval( maxtests ), rscaval( maxtests ),
167 $ rscxval( maxtests ), rscyval( maxtests )
168 REAL mem( memsiz )
169 DOUBLE PRECISION ctime( 1 ), wtime( 1 )
170* ..
171* .. External Subroutines ..
172 EXTERNAL blacs_barrier, blacs_exit, blacs_get,
173 $ blacs_gridexit, blacs_gridinfo, blacs_gridinit,
174 $ blacs_pinfo, igsum2d, pb_boot, pb_combine,
175 $ pb_timer, pmdescchk, pmdimchk, psbla2timinfo,
176 $ psgemv, psger, pslagen, pslascal, pssymv,
177 $ pssyr, pssyr2, pstrmv, pstrsv, pvdescchk,
178 $ pvdimchk
179* ..
180* .. External Functions ..
181 LOGICAL lsame
182 DOUBLE PRECISION pdopbl2
183 EXTERNAL lsame, pdopbl2
184* ..
185* .. Intrinsic Functions ..
186 INTRINSIC dble, max, real
187* ..
188* .. Common Blocks ..
189 CHARACTER*7 snames( nsubs )
190 LOGICAL abrtflg
191 INTEGER info, nblog
192 COMMON /snamec/snames
193 COMMON /infoc/info, nblog
194 COMMON /pberrorc/nout, abrtflg
195* ..
196* .. Data Statements ..
197 DATA ycheck/.true., .true., .false., .false.,
198 $ .true., .false., .true./
199* ..
200* .. Executable Statements ..
201*
202* Initialization
203*
204* Set flag so that the PBLAS error handler won't abort on errors, so
205* that the tester will detect unsupported operations.
206*
207 abrtflg = .true.
208*
209* Seeds for random matrix generations.
210*
211 iaseed = 100
212 ixseed = 200
213 iyseed = 300
214*
215* Get starting information
216*
217 CALL blacs_pinfo( iam, nprocs )
218 CALL psbla2timinfo( outfile, nout, ntests, diagval, tranval,
219 $ uploval, mval, nval, maval, naval, imbaval,
220 $ mbaval, inbaval, nbaval, rscaval, cscaval,
221 $ iaval, javal, mxval, nxval, imbxval, mbxval,
222 $ inbxval, nbxval, rscxval, cscxval, ixval,
223 $ jxval, incxval, myval, nyval, imbyval,
224 $ mbyval, inbyval, nbyval, rscyval,
225 $ cscyval, iyval, jyval, incyval, maxtests,
226 $ ngrids, pval, maxgrids, qval, maxgrids,
227 $ nblog, ltest, iam, nprocs, alpha, beta, mem )
228*
229 IF( iam.EQ.0 )
230 $ WRITE( nout, fmt = 9983 )
231*
232* Loop over different process grids
233*
234 DO 60 i = 1, ngrids
235*
236 nprow = pval( i )
237 npcol = qval( i )
238*
239* Make sure grid information is correct
240*
241 ierr( 1 ) = 0
242 IF( nprow.LT.1 ) THEN
243 IF( iam.EQ.0 )
244 $ WRITE( nout, fmt = 9999 ) 'GRID SIZE', 'NPROW', nprow
245 ierr( 1 ) = 1
246 ELSE IF( npcol.LT.1 ) THEN
247 IF( iam.EQ.0 )
248 $ WRITE( nout, fmt = 9999 ) 'GRID SIZE', 'NPCOL', npcol
249 ierr( 1 ) = 1
250 ELSE IF( nprow*npcol.GT.nprocs ) THEN
251 IF( iam.EQ.0 )
252 $ WRITE( nout, fmt = 9998 ) nprow*npcol, nprocs
253 ierr( 1 ) = 1
254 END IF
255*
256 IF( ierr( 1 ).GT.0 ) THEN
257 IF( iam.EQ.0 )
258 $ WRITE( nout, fmt = 9997 ) 'GRID'
259 GO TO 60
260 END IF
261*
262* Define process grid
263*
264 CALL blacs_get( -1, 0, ictxt )
265 CALL blacs_gridinit( ictxt, 'Row-major', nprow, npcol )
266 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
267*
268* Go to bottom of process grid loop if this case doesn't use my
269* process
270*
271 IF( myrow.GE.nprow .OR. mycol.GE.npcol )
272 $ GO TO 60
273*
274* Loop over number of tests
275*
276 DO 50 j = 1, ntests
277*
278* Get the test parameters
279*
280 diag = diagval( j )
281 trans = tranval( j )
282 uplo = uploval( j )
283*
284 m = mval( j )
285 n = nval( j )
286*
287 ma = maval( j )
288 na = naval( j )
289 imba = imbaval( j )
290 mba = mbaval( j )
291 inba = inbaval( j )
292 nba = nbaval( j )
293 rsrca = rscaval( j )
294 csrca = cscaval( j )
295 ia = iaval( j )
296 ja = javal( j )
297*
298 mx = mxval( j )
299 nx = nxval( j )
300 imbx = imbxval( j )
301 mbx = mbxval( j )
302 inbx = inbxval( j )
303 nbx = nbxval( j )
304 rsrcx = rscxval( j )
305 csrcx = cscxval( j )
306 ix = ixval( j )
307 jx = jxval( j )
308 incx = incxval( j )
309*
310 my = myval( j )
311 ny = nyval( j )
312 imby = imbyval( j )
313 mby = mbyval( j )
314 inby = inbyval( j )
315 nby = nbyval( j )
316 rsrcy = rscyval( j )
317 csrcy = cscyval( j )
318 iy = iyval( j )
319 jy = jyval( j )
320 incy = incyval( j )
321*
322 IF( iam.EQ.0 ) THEN
323*
324 WRITE( nout, fmt = * )
325 WRITE( nout, fmt = 9996 ) j, nprow, npcol
326 WRITE( nout, fmt = * )
327*
328 WRITE( nout, fmt = 9995 )
329 WRITE( nout, fmt = 9994 )
330 WRITE( nout, fmt = 9995 )
331 WRITE( nout, fmt = 9993 ) m, n, uplo, trans, diag
332*
333 WRITE( nout, fmt = 9995 )
334 WRITE( nout, fmt = 9992 )
335 WRITE( nout, fmt = 9995 )
336 WRITE( nout, fmt = 9991 ) ia, ja, ma, na, imba, inba,
337 $ mba, nba, rsrca, csrca
338*
339 WRITE( nout, fmt = 9995 )
340 WRITE( nout, fmt = 9990 )
341 WRITE( nout, fmt = 9995 )
342 WRITE( nout, fmt = 9989 ) ix, jx, mx, nx, imbx, inbx,
343 $ mbx, nbx, rsrcx, csrcx, incx
344*
345 WRITE( nout, fmt = 9995 )
346 WRITE( nout, fmt = 9988 )
347 WRITE( nout, fmt = 9995 )
348 WRITE( nout, fmt = 9989 ) iy, jy, my, ny, imby, inby,
349 $ mby, nby, rsrcy, csrcy, incy
350*
351 WRITE( nout, fmt = 9995 )
352 WRITE( nout, fmt = 9980 )
353*
354 END IF
355*
356* Check the validity of the input test parameters
357*
358 IF( .NOT.lsame( uplo, 'U' ).AND.
359 $ .NOT.lsame( uplo, 'L' ) ) THEN
360 IF( iam.EQ.0 )
361 $ WRITE( nout, fmt = 9997 ) 'UPLO'
362 GO TO 40
363 END IF
364*
365 IF( .NOT.lsame( trans, 'N' ).AND.
366 $ .NOT.lsame( trans, 'T' ).AND.
367 $ .NOT.lsame( trans, 'C' ) ) THEN
368 IF( iam.EQ.0 )
369 $ WRITE( nout, fmt = 9997 ) 'TRANS'
370 GO TO 40
371 END IF
372*
373 IF( .NOT.lsame( diag , 'U' ).AND.
374 $ .NOT.lsame( diag , 'N' ) )THEN
375 IF( iam.EQ.0 )
376 $ WRITE( nout, fmt = 9997 ) trans
377 WRITE( nout, fmt = 9997 ) 'DIAG'
378 GO TO 40
379 END IF
380*
381* Check and initialize the matrix descriptors
382*
383 CALL pmdescchk( ictxt, nout, 'A', desca,
384 $ block_cyclic_2d_inb, ma, na, imba, inba,
385 $ mba, nba, rsrca, csrca, mpa, nqa, iprea,
386 $ imida, iposta, 0, 0, ierr( 1 ) )
387 CALL pvdescchk( ictxt, nout, 'X', descx,
388 $ block_cyclic_2d_inb, mx, nx, imbx, inbx,
389 $ mbx, nbx, rsrcx, csrcx, incx, mpx, nqx,
390 $ iprex, imidx, ipostx, 0, 0, ierr( 2 ) )
391 CALL pvdescchk( ictxt, nout, 'Y', descy,
392 $ block_cyclic_2d_inb, my, ny, imby, inby,
393 $ mby, nby, rsrcy, csrcy, incy, mpy, nqy,
394 $ iprey, imidy, iposty, 0, 0, ierr( 3 ) )
395*
396 IF( ierr( 1 ).GT.0 .OR. ierr( 2 ).GT.0 .OR.
397 $ ierr( 3 ).GT.0 ) THEN
398 GO TO 40
399 END IF
400*
401* Assign pointers into MEM for matrices corresponding to
402* the distributed matrices A, X and Y.
403*
404 ipa = 1
405 ipx = ipa + desca( lld_ ) * nqa
406 ipy = ipx + descx( lld_ ) * nqx
407*
408* Check if sufficient memory.
409*
410 memreqd = ipy + descy( lld_ ) * nqy - 1
411 ierr( 1 ) = 0
412 IF( memreqd.GT.memsiz ) THEN
413 IF( iam.EQ.0 )
414 $ WRITE( nout, fmt = 9986 ) memreqd*realsz
415 ierr( 1 ) = 1
416 END IF
417*
418* Check all processes for an error
419*
420 CALL igsum2d( ictxt, 'All', ' ', 1, 1, ierr, 1, -1, 0 )
421*
422 IF( ierr( 1 ).GT.0 ) THEN
423 IF( iam.EQ.0 )
424 $ WRITE( nout, fmt = 9987 )
425 GO TO 40
426 END IF
427*
428* Loop over all PBLAS 2 routines
429*
430 DO 30 k = 1, nsubs
431*
432* Continue only if this subroutine has to be tested.
433*
434 IF( .NOT.ltest( k ) )
435 $ GO TO 30
436*
437* Define the size of the operands
438*
439 IF( k.EQ.1 ) THEN
440 nrowa = m
441 ncola = n
442 IF( lsame( trans, 'N' ) ) THEN
443 nlx = n
444 nly = m
445 ELSE
446 nlx = m
447 nly = n
448 END IF
449 ELSE IF( k.EQ.5 ) THEN
450 nrowa = m
451 ncola = n
452 nlx = m
453 nly = n
454 ELSE
455 nrowa = n
456 ncola = n
457 nlx = n
458 nly = n
459 END IF
460*
461* Check the validity of the operand sizes
462*
463 CALL pmdimchk( ictxt, nout, nrowa, ncola, 'A', ia, ja,
464 $ desca, ierr( 1 ) )
465 CALL pvdimchk( ictxt, nout, nlx, 'X', ix, jx, descx,
466 $ incx, ierr( 2 ) )
467 CALL pvdimchk( ictxt, nout, nly, 'Y', iy, jy, descy,
468 $ incy, ierr( 3 ) )
469*
470 IF( ierr( 1 ).NE.0 .OR. ierr( 2 ).NE.0 .OR.
471 $ ierr( 3 ).NE.0 ) THEN
472 GO TO 30
473 END IF
474*
475* Generate distributed matrices A, X and Y
476*
477 IF( k.EQ.2 .OR. k.EQ.6 .OR. k.EQ.7 ) THEN
478 aform = 'S'
479 diagdo = 'N'
480 offd = ia - ja
481 ELSE IF( ( k.EQ.4 ).AND.( lsame( diag, 'N' ) ) ) THEN
482 aform = 'N'
483 diagdo = 'D'
484 offd = ia - ja
485 ELSE
486 aform = 'N'
487 diagdo = 'N'
488 offd = 0
489 END IF
490*
491 CALL pslagen( .false., aform, diagdo, offd, ma, na,
492 $ 1, 1, desca, iaseed, mem( ipa ),
493 $ desca( lld_ ) )
494 CALL pslagen( .false., 'None', 'No diag', 0, mx, nx,
495 $ 1, 1, descx, ixseed, mem( ipx ),
496 $ descx( lld_ ) )
497 IF( ycheck( k ) )
498 $ CALL pslagen( .false., 'None', 'No diag', 0, my,
499 $ ny, 1, 1, descy, iyseed, mem( ipy ),
500 $ descy( lld_ ) )
501*
502 IF( ( k.EQ.4 ).AND.( .NOT.( lsame( diag, 'N' ) ) ).AND.
503 $ ( max( nrowa, ncola ).GT.1 ) ) THEN
504 scale = one / real( max( nrowa, ncola ) )
505 IF( lsame( uplo, 'L' ) ) THEN
506 CALL pslascal( 'Lower', nrowa-1, ncola-1, scale,
507 $ mem( ipa ), ia+1, ja, desca )
508 ELSE
509 CALL pslascal( 'Upper', nrowa-1, ncola-1, scale,
510 $ mem( ipa ), ia, ja+1, desca )
511 END IF
512 END IF
513*
514 info = 0
515 CALL pb_boot()
516 CALL blacs_barrier( ictxt, 'All' )
517*
518* Call the Level 2 PBLAS routine
519*
520 IF( k.EQ.1 ) THEN
521*
522* Test PSGEMV
523*
524 CALL pb_timer( 1 )
525 CALL psgemv( trans, m, n, alpha, mem( ipa ), ia, ja,
526 $ desca, mem( ipx ), ix, jx, descx, incx,
527 $ beta, mem( ipy ), iy, jy, descy, incy )
528 CALL pb_timer( 1 )
529*
530 ELSE IF( k.EQ.2 ) THEN
531*
532* Test PSSYMV
533*
534 CALL pb_timer( 1 )
535 CALL pssymv( uplo, n, alpha, mem( ipa ), ia, ja,
536 $ desca, mem( ipx ), ix, jx, descx, incx,
537 $ beta, mem( ipy ), iy, jy, descy, incy )
538 CALL pb_timer( 1 )
539*
540 ELSE IF( k.EQ.3 ) THEN
541*
542* Test PSTRMV
543*
544 CALL pb_timer( 1 )
545 CALL pstrmv( uplo, trans, diag, n, mem( ipa ), ia, ja,
546 $ desca, mem( ipx ), ix, jx, descx, incx )
547 CALL pb_timer( 1 )
548*
549 ELSE IF( k.EQ.4 ) THEN
550*
551* Test PSTRSV
552*
553 CALL pb_timer( 1 )
554 CALL pstrsv( uplo, trans, diag, n, mem( ipa ), ia, ja,
555 $ desca, mem( ipx ), ix, jx, descx, incx )
556 CALL pb_timer( 1 )
557*
558 ELSE IF( k.EQ.5 ) THEN
559*
560* Test PSGER
561*
562 CALL pb_timer( 1 )
563 CALL psger( m, n, alpha, mem( ipx ), ix, jx, descx,
564 $ incx, mem( ipy ), iy, jy, descy, incy,
565 $ mem( ipa ), ia, ja, desca )
566 CALL pb_timer( 1 )
567*
568 ELSE IF( k.EQ.6 ) THEN
569*
570* Test PSSYR
571*
572 CALL pb_timer( 1 )
573 CALL pssyr( uplo, n, alpha, mem( ipx ), ix, jx, descx,
574 $ incx, mem( ipa ), ia, ja, desca )
575 CALL pb_timer( 1 )
576*
577 ELSE IF( k.EQ.7 ) THEN
578*
579* Test PSSYR2
580*
581 CALL pb_timer( 1 )
582 CALL pssyr2( uplo, n, alpha, mem( ipx ), ix, jx,
583 $ descx, incx, mem( ipy ), iy, jy, descy,
584 $ incy, mem( ipa ), ia, ja, desca )
585 CALL pb_timer( 1 )
586*
587 END IF
588*
589* Check if the operation has been performed.
590*
591 IF( info.NE.0 ) THEN
592 IF( iam.EQ.0 )
593 $ WRITE( nout, fmt = 9982 ) info
594 GO TO 30
595 END IF
596*
597 CALL pb_combine( ictxt, 'All', '>', 'W', 1, 1, wtime )
598 CALL pb_combine( ictxt, 'All', '>', 'C', 1, 1, ctime )
599*
600* Only node 0 prints timing test result
601*
602 IF( iam.EQ.0 ) THEN
603*
604* Calculate total flops
605*
606 nops = pdopbl2( snames( k ), nrowa, ncola, 0, 0 )
607*
608* Print WALL time if machine supports it
609*
610 IF( wtime( 1 ).GT.0.0d+0 ) THEN
611 wflops = nops / ( wtime( 1 ) * 1.0d+6 )
612 ELSE
613 wflops = 0.0d+0
614 END IF
615*
616* Print CPU time if machine supports it
617*
618 IF( ctime( 1 ).GT.0.0d+0 ) THEN
619 cflops = nops / ( ctime( 1 ) * 1.0d+6 )
620 ELSE
621 cflops = 0.0d+0
622 END IF
623*
624 WRITE( nout, fmt = 9981 ) snames( k ), wtime( 1 ),
625 $ wflops, ctime( 1 ), cflops
626*
627 END IF
628*
629 30 CONTINUE
630*
631 40 IF( iam.EQ.0 ) THEN
632 WRITE( nout, fmt = 9995 )
633 WRITE( nout, fmt = * )
634 WRITE( nout, fmt = 9985 ) j
635 END IF
636*
637 50 CONTINUE
638*
639 CALL blacs_gridexit( ictxt )
640*
641 60 CONTINUE
642*
643* Print results
644*
645 IF( iam.EQ.0 ) THEN
646 WRITE( nout, fmt = * )
647 WRITE( nout, fmt = 9984 )
648 WRITE( nout, fmt = * )
649 END IF
650*
651 CALL blacs_exit( 0 )
652*
653 9999 FORMAT( 'ILLEGAL ', a, ': ', a, ' = ', i10,
654 $ ' should be at least 1' )
655 9998 FORMAT( 'ILLEGAL GRID: NPROW*NPCOL = ', i4,
656 $ '. It can be at most', i4 )
657 9997 FORMAT( 'Bad ', a, ' parameters: going on to next test case.' )
658 9996 FORMAT( 2x, 'Test number ', i2 , ' started on a ', i4, ' x ',
659 $ i4, ' process grid.' )
660 9995 FORMAT( 2x, ' ------------------------------------------------',
661 $ '--------------------------' )
662 9994 FORMAT( 2x, ' M N UPLO TRANS DIAG' )
663 9993 FORMAT( 5x,i6,1x,i6,9x,a1,11x,a1,10x,a1 )
664 9992 FORMAT( 2x, ' IA JA MA NA IMBA INBA',
665 $ ' MBA NBA RSRCA CSRCA' )
666 9991 FORMAT( 5x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,
667 $ 1x,i5,1x,i5 )
668 9990 FORMAT( 2x, ' IX JX MX NX IMBX INBX',
669 $ ' MBX NBX RSRCX CSRCX INCX' )
670 9989 FORMAT( 5x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,
671 $ 1x,i5,1x,i5,1x,i6 )
672 9988 FORMAT( 2x, ' IY JY MY NY IMBY INBY',
673 $ ' MBY NBY RSRCY CSRCY INCY' )
674 9987 FORMAT( 'Not enough memory for this test: going on to',
675 $ ' next test case.' )
676 9986 FORMAT( 'Not enough memory. Need: ', i12 )
677 9985 FORMAT( 2x, 'Test number ', i2, ' completed.' )
678 9984 FORMAT( 2x, 'End of Tests.' )
679 9983 FORMAT( 2x, 'Tests started.' )
680 9982 FORMAT( 2x, ' ***** Operation not supported, error code: ',
681 $ i5, ' *****' )
682 9981 FORMAT( 2x, '| ', a, 2x, f13.3, 2x, f13.3, 2x, f13.3, 2x, f13.3 )
683 9980 FORMAT( 2x, ' WALL time (s) WALL Mflops ',
684 $ ' CPU time (s) CPU Mflops' )
685*
686 stop
687*
688* End of PSBLA2TIM
689*
690 END
691 SUBROUTINE psbla2timinfo( SUMMRY, NOUT, NMAT, DIAGVAL, TRANVAL,
692 $ UPLOVAL, MVAL, NVAL, MAVAL, NAVAL,
693 $ IMBAVAL, MBAVAL, INBAVAL, NBAVAL,
694 $ RSCAVAL, CSCAVAL, IAVAL, JAVAL,
695 $ MXVAL, NXVAL, IMBXVAL, MBXVAL,
696 $ INBXVAL, NBXVAL, RSCXVAL, CSCXVAL,
697 $ IXVAL, JXVAL, INCXVAL, MYVAL, NYVAL,
698 $ IMBYVAL, MBYVAL, INBYVAL, NBYVAL,
699 $ RSCYVAL, CSCYVAL, IYVAL, JYVAL,
700 $ INCYVAL, LDVAL, NGRIDS, PVAL, LDPVAL,
701 $ QVAL, LDQVAL, NBLOG, LTEST, IAM, NPROCS,
702 $ ALPHA, BETA, WORK )
703*
704* -- PBLAS test routine (version 2.0) --
705* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
706* and University of California, Berkeley.
707* April 1, 1998
708*
709* .. Scalar Arguments ..
710 INTEGER IAM, LDPVAL, LDQVAL, LDVAL, NBLOG, NGRIDS,
711 $ NMAT, NOUT, NPROCS
712 REAL ALPHA, BETA
713* ..
714* .. Array Arguments ..
715 CHARACTER*( * ) SUMMRY
716 CHARACTER*1 DIAGVAL( LDVAL ), TRANVAL( LDVAL ),
717 $ UPLOVAL( LDVAL )
718 LOGICAL LTEST( * )
719 INTEGER CSCAVAL( LDVAL ), CSCXVAL( LDVAL ),
720 $ CSCYVAL( LDVAL ), IAVAL( LDVAL ),
721 $ imbaval( ldval ), imbxval( ldval ),
722 $ imbyval( ldval ), inbaval( ldval ),
723 $ inbxval( ldval ), inbyval( ldval ),
724 $ incxval( ldval ), incyval( ldval ),
725 $ ixval( ldval ), iyval( ldval ), javal( ldval ),
726 $ jxval( ldval ), jyval( ldval ), maval( ldval ),
727 $ mbaval( ldval ), mbxval( ldval ),
728 $ mbyval( ldval ), mval( ldval ), mxval( ldval ),
729 $ myval( ldval ), naval( ldval ),
730 $ nbaval( ldval ), nbxval( ldval ),
731 $ nbyval( ldval ), nval( ldval ), nxval( ldval ),
732 $ nyval( ldval ), pval( ldpval ), qval( ldqval ),
733 $ rscaval( ldval ), rscxval( ldval ),
734 $ rscyval( ldval ), work( * )
735* ..
736*
737* Purpose
738* =======
739*
740* PSBLA2TIMINFO get the needed startup information for timing various
741* Level 2 PBLAS routines, and transmits it to all processes.
742*
743* Notes
744* =====
745*
746* For packing the information we assumed that the length in bytes of an
747* integer is equal to the length in bytes of a real single precision.
748*
749* Arguments
750* =========
751*
752* SUMMRY (global output) CHARACTER*(*)
753* On exit, SUMMRY is the name of output (summary) file (if
754* any). SUMMRY is only defined for process 0.
755*
756* NOUT (global output) INTEGER
757* On exit, NOUT specifies the unit number for the output file.
758* When NOUT is 6, output to screen, when NOUT is 0, output to
759* stderr. NOUT is only defined for process 0.
760*
761* NMAT (global output) INTEGER
762* On exit, NMAT specifies the number of different test cases.
763*
764* DIAGVAL (global output) CHARACTER array
765* On entry, DIAGVAL is an array of dimension LDVAL. On exit,
766* this array contains the values of DIAG to run the code with.
767*
768* TRANVAL (global output) CHARACTER array
769* On entry, TRANVAL is an array of dimension LDVAL. On exit,
770* this array contains the values of TRANS to run the code
771* with.
772*
773* UPLOVAL (global output) CHARACTER array
774* On entry, UPLOVAL is an array of dimension LDVAL. On exit,
775* this array contains the values of UPLO to run the code with.
776*
777* MVAL (global output) INTEGER array
778* On entry, MVAL is an array of dimension LDVAL. On exit, this
779* array contains the values of M to run the code with.
780*
781* NVAL (global output) INTEGER array
782* On entry, NVAL is an array of dimension LDVAL. On exit, this
783* array contains the values of N to run the code with.
784*
785* MAVAL (global output) INTEGER array
786* On entry, MAVAL is an array of dimension LDVAL. On exit, this
787* array contains the values of DESCA( M_ ) to run the code
788* with.
789*
790* NAVAL (global output) INTEGER array
791* On entry, NAVAL is an array of dimension LDVAL. On exit, this
792* array contains the values of DESCA( N_ ) to run the code
793* with.
794*
795* IMBAVAL (global output) INTEGER array
796* On entry, IMBAVAL is an array of dimension LDVAL. On exit,
797* this array contains the values of DESCA( IMB_ ) to run the
798* code with.
799*
800* MBAVAL (global output) INTEGER array
801* On entry, MBAVAL is an array of dimension LDVAL. On exit,
802* this array contains the values of DESCA( MB_ ) to run the
803* code with.
804*
805* INBAVAL (global output) INTEGER array
806* On entry, INBAVAL is an array of dimension LDVAL. On exit,
807* this array contains the values of DESCA( INB_ ) to run the
808* code with.
809*
810* NBAVAL (global output) INTEGER array
811* On entry, NBAVAL is an array of dimension LDVAL. On exit,
812* this array contains the values of DESCA( NB_ ) to run the
813* code with.
814*
815* RSCAVAL (global output) INTEGER array
816* On entry, RSCAVAL is an array of dimension LDVAL. On exit,
817* this array contains the values of DESCA( RSRC_ ) to run the
818* code with.
819*
820* CSCAVAL (global output) INTEGER array
821* On entry, CSCAVAL is an array of dimension LDVAL. On exit,
822* this array contains the values of DESCA( CSRC_ ) to run the
823* code with.
824*
825* IAVAL (global output) INTEGER array
826* On entry, IAVAL is an array of dimension LDVAL. On exit, this
827* array contains the values of IA to run the code with.
828*
829* JAVAL (global output) INTEGER array
830* On entry, JAVAL is an array of dimension LDVAL. On exit, this
831* array contains the values of JA to run the code with.
832*
833* MXVAL (global output) INTEGER array
834* On entry, MXVAL is an array of dimension LDVAL. On exit, this
835* array contains the values of DESCX( M_ ) to run the code
836* with.
837*
838* NXVAL (global output) INTEGER array
839* On entry, NXVAL is an array of dimension LDVAL. On exit, this
840* array contains the values of DESCX( N_ ) to run the code
841* with.
842*
843* IMBXVAL (global output) INTEGER array
844* On entry, IMBXVAL is an array of dimension LDVAL. On exit,
845* this array contains the values of DESCX( IMB_ ) to run the
846* code with.
847*
848* MBXVAL (global output) INTEGER array
849* On entry, MBXVAL is an array of dimension LDVAL. On exit,
850* this array contains the values of DESCX( MB_ ) to run the
851* code with.
852*
853* INBXVAL (global output) INTEGER array
854* On entry, INBXVAL is an array of dimension LDVAL. On exit,
855* this array contains the values of DESCX( INB_ ) to run the
856* code with.
857*
858* NBXVAL (global output) INTEGER array
859* On entry, NBXVAL is an array of dimension LDVAL. On exit,
860* this array contains the values of DESCX( NB_ ) to run the
861* code with.
862*
863* RSCXVAL (global output) INTEGER array
864* On entry, RSCXVAL is an array of dimension LDVAL. On exit,
865* this array contains the values of DESCX( RSRC_ ) to run the
866* code with.
867*
868* CSCXVAL (global output) INTEGER array
869* On entry, CSCXVAL is an array of dimension LDVAL. On exit,
870* this array contains the values of DESCX( CSRC_ ) to run the
871* code with.
872*
873* IXVAL (global output) INTEGER array
874* On entry, IXVAL is an array of dimension LDVAL. On exit, this
875* array contains the values of IX to run the code with.
876*
877* JXVAL (global output) INTEGER array
878* On entry, JXVAL is an array of dimension LDVAL. On exit, this
879* array contains the values of JX to run the code with.
880*
881* INCXVAL (global output) INTEGER array
882* On entry, INCXVAL is an array of dimension LDVAL. On exit,
883* this array contains the values of INCX to run the code with.
884*
885* MYVAL (global output) INTEGER array
886* On entry, MYVAL is an array of dimension LDVAL. On exit, this
887* array contains the values of DESCY( M_ ) to run the code
888* with.
889*
890* NYVAL (global output) INTEGER array
891* On entry, NYVAL is an array of dimension LDVAL. On exit, this
892* array contains the values of DESCY( N_ ) to run the code
893* with.
894*
895* IMBYVAL (global output) INTEGER array
896* On entry, IMBYVAL is an array of dimension LDVAL. On exit,
897* this array contains the values of DESCY( IMB_ ) to run the
898* code with.
899*
900* MBYVAL (global output) INTEGER array
901* On entry, MBYVAL is an array of dimension LDVAL. On exit,
902* this array contains the values of DESCY( MB_ ) to run the
903* code with.
904*
905* INBYVAL (global output) INTEGER array
906* On entry, INBYVAL is an array of dimension LDVAL. On exit,
907* this array contains the values of DESCY( INB_ ) to run the
908* code with.
909*
910* NBYVAL (global output) INTEGER array
911* On entry, NBYVAL is an array of dimension LDVAL. On exit,
912* this array contains the values of DESCY( NB_ ) to run the
913* code with.
914*
915* RSCYVAL (global output) INTEGER array
916* On entry, RSCYVAL is an array of dimension LDVAL. On exit,
917* this array contains the values of DESCY( RSRC_ ) to run the
918* code with.
919*
920* CSCYVAL (global output) INTEGER array
921* On entry, CSCYVAL is an array of dimension LDVAL. On exit,
922* this array contains the values of DESCY( CSRC_ ) to run the
923* code with.
924*
925* IYVAL (global output) INTEGER array
926* On entry, IYVAL is an array of dimension LDVAL. On exit, this
927* array contains the values of IY to run the code with.
928*
929* JYVAL (global output) INTEGER array
930* On entry, JYVAL is an array of dimension LDVAL. On exit, this
931* array contains the values of JY to run the code with.
932*
933* INCYVAL (global output) INTEGER array
934* On entry, INCYVAL is an array of dimension LDVAL. On exit,
935* this array contains the values of INCY to run the code with.
936*
937* LDVAL (global input) INTEGER
938* On entry, LDVAL specifies the maximum number of different va-
939* lues that can be used for DIAG, TRANS, UPLO, M, N, DESCA(:),
940* IA, JA, DESCX(:), IX, JX, INCX, DESCY(:), IY, JY and INCY.
941* This is also the maximum number of test cases.
942*
943* NGRIDS (global output) INTEGER
944* On exit, NGRIDS specifies the number of different values that
945* can be used for P and Q.
946*
947* PVAL (global output) INTEGER array
948* On entry, PVAL is an array of dimension LDPVAL. On exit, this
949* array contains the values of P to run the code with.
950*
951* LDPVAL (global input) INTEGER
952* On entry, LDPVAL specifies the maximum number of different
953* values that can be used for P.
954*
955* QVAL (global output) INTEGER array
956* On entry, QVAL is an array of dimension LDQVAL. On exit, this
957* array contains the values of Q to run the code with.
958*
959* LDQVAL (global input) INTEGER
960* On entry, LDQVAL specifies the maximum number of different
961* values that can be used for Q.
962*
963* NBLOG (global output) INTEGER
964* On exit, NBLOG specifies the logical computational block size
965* to run the tests with. NBLOG must be at least one.
966*
967* LTEST (global output) LOGICAL array
968* On entry, LTEST is an array of dimension at least seven. On
969* exit, if LTEST( i ) is .TRUE., the i-th Level 2 PBLAS routine
970* will be tested. See the input file for the ordering of the
971* routines.
972*
973* IAM (local input) INTEGER
974* On entry, IAM specifies the number of the process executing
975* this routine.
976*
977* NPROCS (global input) INTEGER
978* On entry, NPROCS specifies the total number of processes.
979*
980* ALPHA (global output) REAL
981* On exit, ALPHA specifies the value of alpha to be used in all
982* the test cases.
983*
984* BETA (global output) REAL
985* On exit, BETA specifies the value of beta to be used in all
986* the test cases.
987*
988* WORK (local workspace) INTEGER array
989* On entry, WORK is an array of dimension at least
990* MAX( 3, 2*NGRIDS+37*NMAT+NSUBS ) with NSUBS = 7. This array
991* is used to pack all output arrays in order to send info in
992* one message.
993*
994* -- Written on April 1, 1998 by
995* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
996*
997* =====================================================================
998*
999* .. Parameters ..
1000 INTEGER NIN, NSUBS
1001 PARAMETER ( NIN = 11, nsubs = 7 )
1002* ..
1003* .. Local Scalars ..
1004 LOGICAL LTESTT
1005 INTEGER I, ICTXT, J
1006* ..
1007* .. Local Arrays ..
1008 CHARACTER*7 SNAMET
1009 CHARACTER*79 USRINFO
1010* ..
1011* .. External Subroutines ..
1012 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
1013 $ blacs_gridinit, blacs_setup, icopy, igebr2d,
1014 $ igebs2d, sgebr2d, sgebs2d
1015* ..
1016* .. Intrinsic Functions ..
1017 INTRINSIC char, ichar, max, min
1018* ..
1019* .. Common Blocks ..
1020 CHARACTER*7 SNAMES( NSUBS )
1021 COMMON /SNAMEC/SNAMES
1022* ..
1023* .. Executable Statements ..
1024*
1025* Process 0 reads the input data, broadcasts to other processes and
1026* writes needed information to NOUT
1027*
1028 IF( iam.EQ.0 ) THEN
1029*
1030* Open file and skip data file header
1031*
1032 OPEN( nin, file='PSBLAS2TIM.dat', status='OLD' )
1033 READ( nin, fmt = * ) summry
1034 summry = ' '
1035*
1036* Read in user-supplied info about machine type, compiler, etc.
1037*
1038 READ( nin, fmt = 9999 ) usrinfo
1039*
1040* Read name and unit number for summary output file
1041*
1042 READ( nin, fmt = * ) summry
1043 READ( nin, fmt = * ) nout
1044 IF( nout.NE.0 .AND. nout.NE.6 )
1045 $ OPEN( nout, file = summry, status = 'UNKNOWN' )
1046*
1047* Read and check the parameter values for the tests.
1048*
1049* Get logical computational block size
1050*
1051 READ( nin, fmt = * ) nblog
1052 IF( nblog.LT.1 )
1053 $ nblog = 32
1054*
1055* Get number of grids
1056*
1057 READ( nin, fmt = * ) ngrids
1058 IF( ngrids.LT.1 .OR. ngrids.GT.ldpval ) THEN
1059 WRITE( nout, fmt = 9998 ) 'Grids', ldpval
1060 GO TO 120
1061 ELSE IF( ngrids.GT.ldqval ) THEN
1062 WRITE( nout, fmt = 9998 ) 'Grids', ldqval
1063 GO TO 120
1064 END IF
1065*
1066* Get values of P and Q
1067*
1068 READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
1069 READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
1070*
1071* Read ALPHA, BETA
1072*
1073 READ( nin, fmt = * ) alpha
1074 READ( nin, fmt = * ) beta
1075*
1076* Read number of tests.
1077*
1078 READ( nin, fmt = * ) nmat
1079 IF( nmat.LT.1 .OR. nmat.GT.ldval ) THEN
1080 WRITE( nout, fmt = 9998 ) 'Tests', ldval
1081 GO TO 120
1082 END IF
1083*
1084* Read in input data into arrays.
1085*
1086 READ( nin, fmt = * ) ( uploval( i ), i = 1, nmat )
1087 READ( nin, fmt = * ) ( tranval( i ), i = 1, nmat )
1088 READ( nin, fmt = * ) ( diagval( i ), i = 1, nmat )
1089 READ( nin, fmt = * ) ( mval( i ), i = 1, nmat )
1090 READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
1091 READ( nin, fmt = * ) ( maval( i ), i = 1, nmat )
1092 READ( nin, fmt = * ) ( naval( i ), i = 1, nmat )
1093 READ( nin, fmt = * ) ( imbaval( i ), i = 1, nmat )
1094 READ( nin, fmt = * ) ( inbaval( i ), i = 1, nmat )
1095 READ( nin, fmt = * ) ( mbaval( i ), i = 1, nmat )
1096 READ( nin, fmt = * ) ( nbaval( i ), i = 1, nmat )
1097 READ( nin, fmt = * ) ( rscaval( i ), i = 1, nmat )
1098 READ( nin, fmt = * ) ( cscaval( i ), i = 1, nmat )
1099 READ( nin, fmt = * ) ( iaval( i ), i = 1, nmat )
1100 READ( nin, fmt = * ) ( javal( i ), i = 1, nmat )
1101 READ( nin, fmt = * ) ( mxval( i ), i = 1, nmat )
1102 READ( nin, fmt = * ) ( nxval( i ), i = 1, nmat )
1103 READ( nin, fmt = * ) ( imbxval( i ), i = 1, nmat )
1104 READ( nin, fmt = * ) ( inbxval( i ), i = 1, nmat )
1105 READ( nin, fmt = * ) ( mbxval( i ), i = 1, nmat )
1106 READ( nin, fmt = * ) ( nbxval( i ), i = 1, nmat )
1107 READ( nin, fmt = * ) ( rscxval( i ), i = 1, nmat )
1108 READ( nin, fmt = * ) ( cscxval( i ), i = 1, nmat )
1109 READ( nin, fmt = * ) ( ixval( i ), i = 1, nmat )
1110 READ( nin, fmt = * ) ( jxval( i ), i = 1, nmat )
1111 READ( nin, fmt = * ) ( incxval( i ), i = 1, nmat )
1112 READ( nin, fmt = * ) ( myval( i ), i = 1, nmat )
1113 READ( nin, fmt = * ) ( nyval( i ), i = 1, nmat )
1114 READ( nin, fmt = * ) ( imbyval( i ), i = 1, nmat )
1115 READ( nin, fmt = * ) ( inbyval( i ), i = 1, nmat )
1116 READ( nin, fmt = * ) ( mbyval( i ), i = 1, nmat )
1117 READ( nin, fmt = * ) ( nbyval( i ), i = 1, nmat )
1118 READ( nin, fmt = * ) ( rscyval( i ), i = 1, nmat )
1119 READ( nin, fmt = * ) ( cscyval( i ), i = 1, nmat )
1120 READ( nin, fmt = * ) ( iyval( i ), i = 1, nmat )
1121 READ( nin, fmt = * ) ( jyval( i ), i = 1, nmat )
1122 READ( nin, fmt = * ) ( incyval( i ), i = 1, nmat )
1123*
1124* Read names of subroutines and flags which indicate
1125* whether they are to be tested.
1126*
1127 DO 10 i = 1, nsubs
1128 ltest( i ) = .false.
1129 10 CONTINUE
1130 20 CONTINUE
1131 READ( nin, fmt = 9996, END = 50 ) SNAMET, ltestt
1132 DO 30 i = 1, nsubs
1133 IF( snamet.EQ.snames( i ) )
1134 $ GO TO 40
1135 30 CONTINUE
1136*
1137 WRITE( nout, fmt = 9995 )snamet
1138 GO TO 120
1139*
1140 40 CONTINUE
1141 ltest( i ) = ltestt
1142 GO TO 20
1143*
1144 50 CONTINUE
1145*
1146* Close input file
1147*
1148 CLOSE ( nin )
1149*
1150* For pvm only: if virtual machine not set up, allocate it and
1151* spawn the correct number of processes.
1152*
1153 IF( nprocs.LT.1 ) THEN
1154 nprocs = 0
1155 DO 60 i = 1, ngrids
1156 nprocs = max( nprocs, pval( i )*qval( i ) )
1157 60 CONTINUE
1158 CALL blacs_setup( iam, nprocs )
1159 END IF
1160*
1161* Temporarily define blacs grid to include all processes so
1162* information can be broadcast to all processes
1163*
1164 CALL blacs_get( -1, 0, ictxt )
1165 CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
1166*
1167* Pack information arrays and broadcast
1168*
1169 CALL sgebs2d( ictxt, 'All', ' ', 1, 1, alpha, 1 )
1170 CALL sgebs2d( ictxt, 'All', ' ', 1, 1, beta, 1 )
1171*
1172 work( 1 ) = ngrids
1173 work( 2 ) = nmat
1174 work( 3 ) = nblog
1175 CALL igebs2d( ictxt, 'All', ' ', 3, 1, work, 3 )
1176*
1177 i = 1
1178 DO 70 j = 1, nmat
1179 work( i ) = ichar( diagval( j ) )
1180 work( i+1 ) = ichar( tranval( j ) )
1181 work( i+2 ) = ichar( uploval( j ) )
1182 i = i + 3
1183 70 CONTINUE
1184 CALL icopy( ngrids, pval, 1, work( i ), 1 )
1185 i = i + ngrids
1186 CALL icopy( ngrids, qval, 1, work( i ), 1 )
1187 i = i + ngrids
1188 CALL icopy( nmat, mval, 1, work( i ), 1 )
1189 i = i + nmat
1190 CALL icopy( nmat, nval, 1, work( i ), 1 )
1191 i = i + nmat
1192 CALL icopy( nmat, maval, 1, work( i ), 1 )
1193 i = i + nmat
1194 CALL icopy( nmat, naval, 1, work( i ), 1 )
1195 i = i + nmat
1196 CALL icopy( nmat, imbaval, 1, work( i ), 1 )
1197 i = i + nmat
1198 CALL icopy( nmat, inbaval, 1, work( i ), 1 )
1199 i = i + nmat
1200 CALL icopy( nmat, mbaval, 1, work( i ), 1 )
1201 i = i + nmat
1202 CALL icopy( nmat, nbaval, 1, work( i ), 1 )
1203 i = i + nmat
1204 CALL icopy( nmat, rscaval, 1, work( i ), 1 )
1205 i = i + nmat
1206 CALL icopy( nmat, cscaval, 1, work( i ), 1 )
1207 i = i + nmat
1208 CALL icopy( nmat, iaval, 1, work( i ), 1 )
1209 i = i + nmat
1210 CALL icopy( nmat, javal, 1, work( i ), 1 )
1211 i = i + nmat
1212 CALL icopy( nmat, mxval, 1, work( i ), 1 )
1213 i = i + nmat
1214 CALL icopy( nmat, nxval, 1, work( i ), 1 )
1215 i = i + nmat
1216 CALL icopy( nmat, imbxval, 1, work( i ), 1 )
1217 i = i + nmat
1218 CALL icopy( nmat, inbxval, 1, work( i ), 1 )
1219 i = i + nmat
1220 CALL icopy( nmat, mbxval, 1, work( i ), 1 )
1221 i = i + nmat
1222 CALL icopy( nmat, nbxval, 1, work( i ), 1 )
1223 i = i + nmat
1224 CALL icopy( nmat, rscxval, 1, work( i ), 1 )
1225 i = i + nmat
1226 CALL icopy( nmat, cscxval, 1, work( i ), 1 )
1227 i = i + nmat
1228 CALL icopy( nmat, ixval, 1, work( i ), 1 )
1229 i = i + nmat
1230 CALL icopy( nmat, jxval, 1, work( i ), 1 )
1231 i = i + nmat
1232 CALL icopy( nmat, incxval, 1, work( i ), 1 )
1233 i = i + nmat
1234 CALL icopy( nmat, myval, 1, work( i ), 1 )
1235 i = i + nmat
1236 CALL icopy( nmat, nyval, 1, work( i ), 1 )
1237 i = i + nmat
1238 CALL icopy( nmat, imbyval, 1, work( i ), 1 )
1239 i = i + nmat
1240 CALL icopy( nmat, inbyval, 1, work( i ), 1 )
1241 i = i + nmat
1242 CALL icopy( nmat, mbyval, 1, work( i ), 1 )
1243 i = i + nmat
1244 CALL icopy( nmat, nbyval, 1, work( i ), 1 )
1245 i = i + nmat
1246 CALL icopy( nmat, rscyval, 1, work( i ), 1 )
1247 i = i + nmat
1248 CALL icopy( nmat, cscyval, 1, work( i ), 1 )
1249 i = i + nmat
1250 CALL icopy( nmat, iyval, 1, work( i ), 1 )
1251 i = i + nmat
1252 CALL icopy( nmat, jyval, 1, work( i ), 1 )
1253 i = i + nmat
1254 CALL icopy( nmat, incyval, 1, work( i ), 1 )
1255 i = i + nmat
1256*
1257 DO 80 j = 1, nsubs
1258 IF( ltest( j ) ) THEN
1259 work( i ) = 1
1260 ELSE
1261 work( i ) = 0
1262 END IF
1263 i = i + 1
1264 80 CONTINUE
1265 i = i - 1
1266 CALL igebs2d( ictxt, 'All', ' ', i, 1, work, i )
1267*
1268* regurgitate input
1269*
1270 WRITE( nout, fmt = 9999 )
1271 $ 'Level 2 PBLAS timing program.'
1272 WRITE( nout, fmt = 9999 ) usrinfo
1273 WRITE( nout, fmt = * )
1274 WRITE( nout, fmt = 9999 )
1275 $ 'Tests of the real single precision '//
1276 $ 'Level 2 PBLAS'
1277 WRITE( nout, fmt = * )
1278 WRITE( nout, fmt = 9992 ) nmat
1279 WRITE( nout, fmt = 9986 ) nblog
1280 WRITE( nout, fmt = 9991 ) ngrids
1281 WRITE( nout, fmt = 9989 )
1282 $ 'P', ( pval(i), i = 1, min(ngrids, 5) )
1283 IF( ngrids.GT.5 )
1284 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 6,
1285 $ min( 10, ngrids ) )
1286 IF( ngrids.GT.10 )
1287 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 11,
1288 $ min( 15, ngrids ) )
1289 IF( ngrids.GT.15 )
1290 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 16, ngrids )
1291 WRITE( nout, fmt = 9989 )
1292 $ 'Q', ( qval(i), i = 1, min(ngrids, 5) )
1293 IF( ngrids.GT.5 )
1294 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 6,
1295 $ min( 10, ngrids ) )
1296 IF( ngrids.GT.10 )
1297 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 11,
1298 $ min( 15, ngrids ) )
1299 IF( ngrids.GT.15 )
1300 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 16, ngrids )
1301 WRITE( nout, fmt = 9994 ) alpha
1302 WRITE( nout, fmt = 9993 ) beta
1303 IF( ltest( 1 ) ) THEN
1304 WRITE( nout, fmt = 9988 ) snames( 1 ), ' ... Yes'
1305 ELSE
1306 WRITE( nout, fmt = 9988 ) snames( 1 ), ' ... No '
1307 END IF
1308 DO 90 i = 1, nsubs
1309 IF( ltest( i ) ) THEN
1310 WRITE( nout, fmt = 9987 ) snames( i ), ' ... Yes'
1311 ELSE
1312 WRITE( nout, fmt = 9987 ) snames( i ), ' ... No '
1313 END IF
1314 90 CONTINUE
1315 WRITE( nout, fmt = * )
1316*
1317 ELSE
1318*
1319* If in pvm, must participate setting up virtual machine
1320*
1321 IF( nprocs.LT.1 )
1322 $ CALL blacs_setup( iam, nprocs )
1323*
1324* Temporarily define blacs grid to include all processes so
1325* information can be broadcast to all processes
1326*
1327 CALL blacs_get( -1, 0, ictxt )
1328 CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
1329*
1330 CALL sgebr2d( ictxt, 'All', ' ', 1, 1, alpha, 1, 0, 0 )
1331 CALL sgebr2d( ictxt, 'All', ' ', 1, 1, beta, 1, 0, 0 )
1332*
1333 CALL igebr2d( ictxt, 'All', ' ', 3, 1, work, 3, 0, 0 )
1334 ngrids = work( 1 )
1335 nmat = work( 2 )
1336 nblog = work( 3 )
1337*
1338 i = 2*ngrids + 37*nmat + nsubs
1339 CALL igebr2d( ictxt, 'All', ' ', i, 1, work, i, 0, 0 )
1340*
1341 i = 1
1342 DO 100 j = 1, nmat
1343 diagval( j ) = char( work( i ) )
1344 tranval( j ) = char( work( i+1 ) )
1345 uploval( j ) = char( work( i+2 ) )
1346 i = i + 3
1347 100 CONTINUE
1348 CALL icopy( ngrids, work( i ), 1, pval, 1 )
1349 i = i + ngrids
1350 CALL icopy( ngrids, work( i ), 1, qval, 1 )
1351 i = i + ngrids
1352 CALL icopy( nmat, work( i ), 1, mval, 1 )
1353 i = i + nmat
1354 CALL icopy( nmat, work( i ), 1, nval, 1 )
1355 i = i + nmat
1356 CALL icopy( nmat, work( i ), 1, maval, 1 )
1357 i = i + nmat
1358 CALL icopy( nmat, work( i ), 1, naval, 1 )
1359 i = i + nmat
1360 CALL icopy( nmat, work( i ), 1, imbaval, 1 )
1361 i = i + nmat
1362 CALL icopy( nmat, work( i ), 1, inbaval, 1 )
1363 i = i + nmat
1364 CALL icopy( nmat, work( i ), 1, mbaval, 1 )
1365 i = i + nmat
1366 CALL icopy( nmat, work( i ), 1, nbaval, 1 )
1367 i = i + nmat
1368 CALL icopy( nmat, work( i ), 1, rscaval, 1 )
1369 i = i + nmat
1370 CALL icopy( nmat, work( i ), 1, cscaval, 1 )
1371 i = i + nmat
1372 CALL icopy( nmat, work( i ), 1, iaval, 1 )
1373 i = i + nmat
1374 CALL icopy( nmat, work( i ), 1, javal, 1 )
1375 i = i + nmat
1376 CALL icopy( nmat, work( i ), 1, mxval, 1 )
1377 i = i + nmat
1378 CALL icopy( nmat, work( i ), 1, nxval, 1 )
1379 i = i + nmat
1380 CALL icopy( nmat, work( i ), 1, imbxval, 1 )
1381 i = i + nmat
1382 CALL icopy( nmat, work( i ), 1, inbxval, 1 )
1383 i = i + nmat
1384 CALL icopy( nmat, work( i ), 1, mbxval, 1 )
1385 i = i + nmat
1386 CALL icopy( nmat, work( i ), 1, nbxval, 1 )
1387 i = i + nmat
1388 CALL icopy( nmat, work( i ), 1, rscxval, 1 )
1389 i = i + nmat
1390 CALL icopy( nmat, work( i ), 1, cscxval, 1 )
1391 i = i + nmat
1392 CALL icopy( nmat, work( i ), 1, ixval, 1 )
1393 i = i + nmat
1394 CALL icopy( nmat, work( i ), 1, jxval, 1 )
1395 i = i + nmat
1396 CALL icopy( nmat, work( i ), 1, incxval, 1 )
1397 i = i + nmat
1398 CALL icopy( nmat, work( i ), 1, myval, 1 )
1399 i = i + nmat
1400 CALL icopy( nmat, work( i ), 1, nyval, 1 )
1401 i = i + nmat
1402 CALL icopy( nmat, work( i ), 1, imbyval, 1 )
1403 i = i + nmat
1404 CALL icopy( nmat, work( i ), 1, inbyval, 1 )
1405 i = i + nmat
1406 CALL icopy( nmat, work( i ), 1, mbyval, 1 )
1407 i = i + nmat
1408 CALL icopy( nmat, work( i ), 1, nbyval, 1 )
1409 i = i + nmat
1410 CALL icopy( nmat, work( i ), 1, rscyval, 1 )
1411 i = i + nmat
1412 CALL icopy( nmat, work( i ), 1, cscyval, 1 )
1413 i = i + nmat
1414 CALL icopy( nmat, work( i ), 1, iyval, 1 )
1415 i = i + nmat
1416 CALL icopy( nmat, work( i ), 1, jyval, 1 )
1417 i = i + nmat
1418 CALL icopy( nmat, work( i ), 1, incyval, 1 )
1419 i = i + nmat
1420*
1421 DO 110 j = 1, nsubs
1422 IF( work( i ).EQ.1 ) THEN
1423 ltest( j ) = .true.
1424 ELSE
1425 ltest( j ) = .false.
1426 END IF
1427 i = i + 1
1428 110 CONTINUE
1429*
1430 END IF
1431*
1432 CALL blacs_gridexit( ictxt )
1433*
1434 RETURN
1435*
1436 120 WRITE( nout, fmt = 9997 )
1437 CLOSE( nin )
1438 IF( nout.NE.6 .AND. nout.NE.0 )
1439 $ CLOSE( nout )
1440 CALL blacs_abort( ictxt, 1 )
1441*
1442 stop
1443*
1444 9999 FORMAT( a )
1445 9998 FORMAT( ' Number of values of ',5a, ' is less than 1 or greater ',
1446 $ 'than ', i2 )
1447 9997 FORMAT( ' Illegal input in file ',40a,'. Aborting run.' )
1448 9996 FORMAT( a7, l2 )
1449 9995 FORMAT( ' Subprogram name ', a7, ' not recognized',
1450 $ /' ******* TESTS ABANDONED *******' )
1451 9994 FORMAT( 2x, 'Alpha : ', g16.6 )
1452 9993 FORMAT( 2x, 'Beta : ', g16.6 )
1453 9992 FORMAT( 2x, 'Number of Tests : ', i6 )
1454 9991 FORMAT( 2x, 'Number of process grids : ', i6 )
1455 9990 FORMAT( 2x, ' : ', 5i6 )
1456 9989 FORMAT( 2x, a1, ' : ', 5i6 )
1457 9988 FORMAT( 2x, 'Routines to be tested : ', a, a8 )
1458 9987 FORMAT( 2x, ' ', a, a8 )
1459 9986 FORMAT( 2x, 'Logical block size : ', i6 )
1460*
1461* End of PSBLA2TIMINFO
1462*
1463 END
pb_combine
subroutine pb_combine(ictxt, scope, op, tmtype, n, ibeg, times)
Definition pblastim.f:3211
pb_boot
subroutine pb_boot()
Definition pblastim.f:2927
pdopbl2
double precision function pdopbl2(subnam, m, n, kkl, kku)
Definition pblastim.f:1084
pb_timer
subroutine pb_timer(i)
Definition pblastim.f:2976
pmdimchk
subroutine pmdimchk(ictxt, nout, m, n, matrix, ia, ja, desca, info)
Definition pblastst.f:202
pvdimchk
subroutine pvdimchk(ictxt, nout, n, matrix, ix, jx, descx, incx, info)
Definition pblastst.f:3
icopy
subroutine icopy(n, sx, incx, sy, incy)
Definition pblastst.f:1525
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
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
max
#define max(A, B)
Definition pcgemr.c:180
min
#define min(A, B)
Definition pcgemr.c:181
psbla2tim
program psbla2tim
Definition psblas2tim.f:11
psbla2timinfo
subroutine psbla2timinfo(summry, nout, nmat, diagval, tranval, uploval, mval, nval, maval, naval, imbaval, mbaval, inbaval, nbaval, rscaval, cscaval, iaval, javal, 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, nblog, ltest, iam, nprocs, alpha, beta, work)
Definition psblas2tim.f:703
pslagen
subroutine pslagen(inplace, aform, diag, offa, m, n, ia, ja, desca, iaseed, a, lda)
Definition psblastst.f:7846
pslascal
subroutine pslascal(type, m, n, alpha, a, ia, ja, desca)
Definition psblastst.f:7338
lsame
logical function lsame(ca, cb)
Definition tools.f:1724