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