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