OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pcblas3tim.f
Go to the documentation of this file.
1 BLOCK DATA
2 INTEGER NSUBS
3 parameter(nsubs = 11)
4 CHARACTER*7 SNAMES( NSUBS )
5 COMMON /snamec/snames
6 DATA snames/'PCGEMM ', 'pcsymm ', 'pchemm ',
7 $ 'pcsyrk ', 'pcherk ', 'pcsyr2k',
8 $ 'pcher2k', 'pctrmm ', 'pctrsm ',
9 $ 'pcgeadd', 'pctradd'/
10 END BLOCK DATA
11
12 PROGRAM PCBLA3TIM
13*
14* -- PBLAS timing driver (version 2.0.2) --
15* Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver
16* May 1 2012
17*
18* Purpose
19* =======
20*
21* PCBLA3TIM is the main timing program for the Level 3 PBLAS routines.
22*
23* The program must be driven by a short data file. An annotated exam-
24* ple of a data file can be obtained by deleting the first 3 characters
25* from the following 59 lines:
26* 'Level 3 PBLAS, Timing input file'
27* 'Intel iPSC/860 hypercube, gamma model.'
28* 'PCBLAS3TIM.SUMM' output file name (if any)
29* 6 device out
30* 10 value of the logical computational blocksize NB
31* 1 number of process grids (ordered pairs of P & Q)
32* 2 2 1 4 2 3 8 values of P
33* 2 2 4 1 3 2 1 values of Q
34* (1.0E0, 0.0E0) value of ALPHA
35* (1.0E0, 0.0E0) value of BETA
36* 2 number of tests problems
37* 'N' 'U' values of DIAG
38* 'L' 'R' values of SIDE
39* 'N' 'T' values of TRANSA
40* 'N' 'T' values of TRANSB
41* 'U' 'L' values of UPLO
42* 3 4 values of M
43* 3 4 values of N
44* 3 4 values of K
45* 6 10 values of M_A
46* 6 10 values of N_A
47* 2 5 values of IMB_A
48* 2 5 values of INB_A
49* 2 5 values of MB_A
50* 2 5 values of NB_A
51* 0 1 values of RSRC_A
52* 0 0 values of CSRC_A
53* 1 1 values of IA
54* 1 1 values of JA
55* 6 10 values of M_B
56* 6 10 values of N_B
57* 2 5 values of IMB_B
58* 2 5 values of INB_B
59* 2 5 values of MB_B
60* 2 5 values of NB_B
61* 0 1 values of RSRC_B
62* 0 0 values of CSRC_B
63* 1 1 values of IB
64* 1 1 values of JB
65* 6 10 values of M_C
66* 6 10 values of N_C
67* 2 5 values of IMB_C
68* 2 5 values of INB_C
69* 2 5 values of MB_C
70* 2 5 values of NB_C
71* 0 1 values of RSRC_C
72* 0 0 values of CSRC_C
73* 1 1 values of IC
74* 1 1 values of JC
75* PCGEMM T put F for no test in the same column
76* PCSYMM T put F for no test in the same column
77* PCHEMM T put F for no test in the same column
78* PCSYRK T put F for no test in the same column
79* PCHERK T put F for no test in the same column
80* PCSYR2K T put F for no test in the same column
81* PCHER2K T put F for no test in the same column
82* PCTRMM T put F for no test in the same column
83* PCTRSM T put F for no test in the same column
84* PCGEADD T put F for no test in the same column
85* PCTRADD T put F for no test in the same column
86*
87* Internal Parameters
88* ===================
89*
90* TOTMEM INTEGER
91* TOTMEM is a machine-specific parameter indicating the maxi-
92* mum amount of available memory per process in bytes. The
93* user should customize TOTMEM to his platform. Remember to
94* leave room in memory for the operating system, the BLACS
95* buffer, etc. For example, on a system with 8 MB of memory
96* per process (e.g., one processor on an Intel iPSC/860), the
97* parameters we use are TOTMEM=6200000 (leaving 1.8 MB for OS,
98* code, BLACS buffer, etc). However, for PVM, we usually set
99* TOTMEM = 2000000. Some experimenting with the maximum value
100* of TOTMEM may be required. By default, TOTMEM is 2000000.
101*
102* REALSZ INTEGER
103* CPLXSZ INTEGER
104* REALSZ and CPLXSZ indicate the length in bytes on the given
105* platform for a single precision real and a single precision
106* complex. By default, REALSZ is set to four and CPLXSZ is set
107* to eight.
108*
109* MEM COMPLEX array
110* MEM is an array of dimension TOTMEM / CPLXSZ.
111* All arrays used by SCALAPACK routines are allocated from this
112* array MEM and referenced by pointers. The integer IPA, for
113* example, is a pointer to the starting element of MEM for the
114* matrix A.
115*
116* -- Written on April 1, 1998 by
117* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
118*
119* =====================================================================
120*
121* .. Parameters ..
122 INTEGER MAXTESTS, MAXGRIDS, CPLXSZ, TOTMEM, MEMSIZ,
123 $ NSUBS
124 COMPLEX ONE
125 PARAMETER ( MAXTESTS = 20, MAXGRIDS = 20, CPLXSZ = 8,
126 $ ONE = ( 1.0E+0, 0.0E+0 ), TOTMEM = 2000000,
127 $ NSUBS = 11, MEMSIZ = TOTMEM / CPLXSZ )
128 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
129 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
130 $ RSRC_
131 PARAMETER ( BLOCK_CYCLIC_2D_INB = 2, DLEN_ = 11,
132 $ DTYPE_ = 1, CTXT_ = 2, M_ = 3, N_ = 4,
133 $ IMB_ = 5, INB_ = 6, MB_ = 7, NB_ = 8,
134 $ RSRC_ = 9, CSRC_ = 10, LLD_ = 11 )
135* ..
136* .. Local Scalars ..
137 CHARACTER*1 ADIAGDO, AFORM, CFORM, DIAG, SIDE, TRANSA,
138 $ TRANSB, UPLO
139 INTEGER CSRCA, CSRCB, CSRCC, I, IA, IAM, IASEED, IB,
140 $ IBSEED, IC, ICSEED, ICTXT, IMBA, IMBB, IMBC,
141 $ IMIDA, IMIDB, IMIDC, INBA, INBB, INBC, IPA,
142 $ IPB, IPC, IPOSTA, IPOSTB, IPOSTC, IPREA, IPREB,
143 $ IPREC, J, JA, JB, JC, K, L, M, MA, MB, MBA,
144 $ MBB, MBC, MC, MEMREQD, MPA, MPB, MPC, MYCOL,
145 $ MYROW, N, NA, NB, NBA, NBB, NBC, NC, NCOLA,
146 $ NCOLB, NCOLC, NGRIDS, NOUT, NPCOL, NPROCS,
147 $ NPROW, NQA, NQB, NQC, NROWA, NROWB, NROWC,
148 $ NTESTS, OFFDA, OFFDC, RSRCA, RSRCB, RSRCC
149 DOUBLE PRECISION CFLOPS, NOPS, WFLOPS
150 COMPLEX ALPHA, BETA, SCALE
151* ..
152* .. Local Arrays ..
153 LOGICAL LTEST( NSUBS ), BCHECK( NSUBS ),
154 $ CCHECK( NSUBS )
155 CHARACTER*1 DIAGVAL( MAXTESTS ), SIDEVAL( MAXTESTS ),
156 $ TRNAVAL( MAXTESTS ), TRNBVAL( MAXTESTS ),
157 $ UPLOVAL( MAXTESTS )
158 CHARACTER*80 OUTFILE
159 INTEGER CSCAVAL( MAXTESTS ), CSCBVAL( MAXTESTS ),
160 $ CSCCVAL( MAXTESTS ), DESCA( DLEN_ ),
161 $ DESCB( DLEN_ ), DESCC( DLEN_ ),
162 $ IAVAL( MAXTESTS ), IBVAL( MAXTESTS ),
163 $ ICVAL( MAXTESTS ), IERR( 3 ),
164 $ IMBAVAL( MAXTESTS ), IMBBVAL( MAXTESTS ),
165 $ IMBCVAL( MAXTESTS ), INBAVAL( MAXTESTS ),
166 $ INBBVAL( MAXTESTS ), INBCVAL( MAXTESTS ),
167 $ JAVAL( MAXTESTS ), JBVAL( MAXTESTS ),
168 $ JCVAL( MAXTESTS ), KVAL( MAXTESTS ),
169 $ MAVAL( MAXTESTS ), MBAVAL( MAXTESTS ),
170 $ MBBVAL( MAXTESTS ), MBCVAL( MAXTESTS ),
171 $ MBVAL( MAXTESTS ), MCVAL( MAXTESTS ),
172 $ MVAL( MAXTESTS ), NAVAL( MAXTESTS ),
173 $ NBAVAL( MAXTESTS ), NBBVAL( MAXTESTS ),
174 $ NBCVAL( MAXTESTS ), NBVAL( MAXTESTS ),
175 $ NCVAL( MAXTESTS ), NVAL( MAXTESTS ),
176 $ PVAL( MAXTESTS ), QVAL( MAXTESTS ),
177 $ RSCAVAL( MAXTESTS ), RSCBVAL( MAXTESTS ),
178 $ RSCCVAL( MAXTESTS )
179 DOUBLE PRECISION CTIME( 1 ), WTIME( 1 )
180 COMPLEX MEM( MEMSIZ )
181* ..
182* .. External Subroutines ..
183 EXTERNAL BLACS_BARRIER, BLACS_EXIT, BLACS_GET,
184 $ BLACS_GRIDEXIT, BLACS_GRIDINFO, BLACS_GRIDINIT,
185 $ BLACS_PINFO, IGSUM2D, PB_BOOT, PB_COMBINE,
186 $ PB_TIMER, PCBLA3TIMINFO, PCGEADD, PCGEMM,
187 $ PCHEMM, PCHER2K, PCHERK, PCLAGEN, PCLASCAL,
188 $ PCSYMM, PCSYR2K, PCSYRK, PCTRADD, PCTRMM,
189 $ PCTRSM, PMDESCCHK, PMDIMCHK
190* ..
191* .. External Functions ..
192 LOGICAL LSAME
193 DOUBLE PRECISION PDOPBL3
194 EXTERNAL LSAME, PDOPBL3
195* ..
196* .. Intrinsic Functions ..
197 INTRINSIC CMPLX, DBLE, MAX, REAL
198* ..
199* .. Common Blocks ..
200 CHARACTER*7 SNAMES( NSUBS )
201 LOGICAL ABRTFLG
202 INTEGER INFO, NBLOG
203 COMMON /SNAMEC/SNAMES
204 COMMON /INFOC/INFO, NBLOG
205 COMMON /PBERRORC/NOUT, ABRTFLG
206* ..
207* .. Data Statements ..
208 DATA BCHECK/.TRUE., .TRUE., .TRUE., .FALSE.,
209 $ .FALSE., .TRUE., .TRUE., .TRUE., .TRUE.,
210 $ .FALSE., .FALSE./
211 DATA CCHECK/.TRUE., .TRUE., .TRUE., .TRUE., .TRUE.,
212 $ .TRUE., .TRUE., .FALSE., .FALSE., .TRUE.,
213 $ .TRUE./
214* ..
215* .. Executable Statements ..
216*
217* Initialization
218*
219* Set flag so that the PBLAS error handler won't abort on errors, so
220* that the tester will detect unsupported operations.
221*
222 ABRTFLG = .FALSE.
223*
224* Seeds for random matrix generations.
225*
226 IASEED = 100
227 IBSEED = 200
228 ICSEED = 300
229*
230* Get starting information
231*
232 CALL BLACS_PINFO( IAM, NPROCS )
233 CALL PCBLA3TIMINFO( OUTFILE, NOUT, NTESTS, DIAGVAL, SIDEVAL,
234 $ TRNAVAL, TRNBVAL, UPLOVAL, MVAL, NVAL,
235 $ KVAL, MAVAL, NAVAL, IMBAVAL, MBAVAL,
236 $ INBAVAL, NBAVAL, RSCAVAL, CSCAVAL, IAVAL,
237 $ JAVAL, MBVAL, NBVAL, IMBBVAL, MBBVAL,
238 $ INBBVAL, NBBVAL, RSCBVAL, CSCBVAL, IBVAL,
239 $ JBVAL, MCVAL, NCVAL, IMBCVAL, MBCVAL,
240 $ INBCVAL, NBCVAL, RSCCVAL, CSCCVAL, ICVAL,
241 $ JCVAL, MAXTESTS, NGRIDS, PVAL, MAXGRIDS,
242 $ QVAL, MAXGRIDS, NBLOG, LTEST, IAM, NPROCS,
243 $ ALPHA, BETA, MEM )
244*
245.EQ. IF( IAM0 )
246 $ WRITE( NOUT, FMT = 9984 )
247*
248* Loop over different process grids
249*
250 DO 60 I = 1, NGRIDS
251*
252 NPROW = PVAL( I )
253 NPCOL = QVAL( I )
254*
255* Make sure grid information is correct
256*
257 IERR( 1 ) = 0
258.LT. IF( NPROW1 ) THEN
259.EQ. IF( IAM0 )
260 $ WRITE( NOUT, FMT = 9999 ) 'grid size', 'nprow', NPROW
261 IERR( 1 ) = 1
262.LT. ELSE IF( NPCOL1 ) THEN
263.EQ. IF( IAM0 )
264 $ WRITE( NOUT, FMT = 9999 ) 'grid size', 'npcol', NPCOL
265 IERR( 1 ) = 1
266.GT. ELSE IF( NPROW*NPCOLNPROCS ) THEN
267.EQ. IF( IAM0 )
268 $ WRITE( NOUT, FMT = 9998 ) NPROW*NPCOL, NPROCS
269 IERR( 1 ) = 1
270 END IF
271*
272.GT. IF( IERR( 1 )0 ) THEN
273.EQ. IF( IAM0 )
274 $ WRITE( NOUT, FMT = 9997 ) 'grid'
275 GO TO 60
276 END IF
277*
278* Define process grid
279*
280 CALL BLACS_GET( -1, 0, ICTXT )
281 CALL BLACS_GRIDINIT( ICTXT, 'row-major', NPROW, NPCOL )
282 CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
283*
284* Go to bottom of process grid loop if this case doesn't use my
285* process
286*
287.GE..OR..GE. IF( MYROWNPROW MYCOLNPCOL )
288 $ GO TO 60
289*
290* Loop over number of tests
291*
292 DO 50 J = 1, NTESTS
293*
294* Get the test parameters
295*
296 DIAG = DIAGVAL( J )
297 SIDE = SIDEVAL( J )
298 TRANSA = TRNAVAL( J )
299 TRANSB = TRNBVAL( J )
300 UPLO = UPLOVAL( J )
301*
302 M = MVAL( J )
303 N = NVAL( J )
304 K = KVAL( J )
305*
306 MA = MAVAL( J )
307 NA = NAVAL( J )
308 IMBA = IMBAVAL( J )
309 MBA = MBAVAL( J )
310 INBA = INBAVAL( J )
311 NBA = NBAVAL( J )
312 RSRCA = RSCAVAL( J )
313 CSRCA = CSCAVAL( J )
314 IA = IAVAL( J )
315 JA = JAVAL( J )
316*
317 MB = MBVAL( J )
318 NB = NBVAL( J )
319 IMBB = IMBBVAL( J )
320 MBB = MBBVAL( J )
321 INBB = INBBVAL( J )
322 NBB = NBBVAL( J )
323 RSRCB = RSCBVAL( J )
324 CSRCB = CSCBVAL( J )
325 IB = IBVAL( J )
326 JB = JBVAL( J )
327*
328 MC = MCVAL( J )
329 NC = NCVAL( J )
330 IMBC = IMBCVAL( J )
331 MBC = MBCVAL( J )
332 INBC = INBCVAL( J )
333 NBC = NBCVAL( J )
334 RSRCC = RSCCVAL( J )
335 CSRCC = CSCCVAL( J )
336 IC = ICVAL( J )
337 JC = JCVAL( J )
338*
339.EQ. IF( IAM0 ) THEN
340*
341 WRITE( NOUT, FMT = * )
342 WRITE( NOUT, FMT = 9996 ) J, NPROW, NPCOL
343 WRITE( NOUT, FMT = * )
344*
345 WRITE( NOUT, FMT = 9995 )
346 WRITE( NOUT, FMT = 9994 )
347 WRITE( NOUT, FMT = 9995 )
348 WRITE( NOUT, FMT = 9993 ) M, N, K, SIDE, UPLO, TRANSA,
349 $ TRANSB, DIAG
350*
351 WRITE( NOUT, FMT = 9995 )
352 WRITE( NOUT, FMT = 9992 )
353 WRITE( NOUT, FMT = 9995 )
354 WRITE( NOUT, FMT = 9991 ) IA, JA, MA, NA, IMBA, INBA,
355 $ MBA, NBA, RSRCA, CSRCA
356*
357 WRITE( NOUT, FMT = 9995 )
358 WRITE( NOUT, FMT = 9990 )
359 WRITE( NOUT, FMT = 9995 )
360 WRITE( NOUT, FMT = 9991 ) IB, JB, MB, NB, IMBB, INBB,
361 $ MBB, NBB, RSRCB, CSRCB
362*
363 WRITE( NOUT, FMT = 9995 )
364 WRITE( NOUT, FMT = 9989 )
365 WRITE( NOUT, FMT = 9995 )
366 WRITE( NOUT, FMT = 9991 ) IC, JC, MC, NC, IMBC, INBC,
367 $ MBC, NBC, RSRCC, CSRCC
368*
369 WRITE( NOUT, FMT = 9995 )
370 WRITE( NOUT, FMT = 9980 )
371*
372 END IF
373*
374* Check the validity of the input test parameters
375*
376.NOT. IF( LSAME( SIDE, 'l.AND.' )
377.NOT. $ LSAME( SIDE, 'r' ) ) THEN
378.EQ. IF( IAM0 )
379 $ WRITE( NOUT, FMT = 9997 ) 'side'
380 GO TO 40
381 END IF
382*
383.NOT. IF( LSAME( UPLO, 'u.AND.' )
384.NOT. $ LSAME( UPLO, 'l' ) ) THEN
385.EQ. IF( IAM0 )
386 $ WRITE( NOUT, FMT = 9997 ) 'uplo'
387 GO TO 40
388 END IF
389*
390.NOT. IF( LSAME( TRANSA, 'n.AND.' )
391.NOT. $ LSAME( TRANSA, 't.AND.' )
392.NOT. $ LSAME( TRANSA, 'c' ) ) THEN
393.EQ. IF( IAM0 )
394 $ WRITE( NOUT, FMT = 9997 ) 'transa'
395 GO TO 40
396 END IF
397*
398.NOT. IF( LSAME( TRANSB, 'n.AND.' )
399.NOT. $ LSAME( TRANSB, 't.AND.' )
400.NOT. $ LSAME( TRANSB, 'c' ) ) THEN
401.EQ. IF( IAM0 )
402 $ WRITE( NOUT, FMT = 9997 ) 'transb'
403 GO TO 40
404 END IF
405*
406.NOT. IF( LSAME( DIAG , 'u.AND.' )
407.NOT. $ LSAME( DIAG , 'n' ) )THEN
408.EQ. IF( IAM0 )
409 $ WRITE( NOUT, FMT = 9997 ) 'diag'
410 GO TO 40
411 END IF
412*
413* Check and initialize the matrix descriptors
414*
415 CALL PMDESCCHK( ICTXT, NOUT, 'a', DESCA,
416 $ BLOCK_CYCLIC_2D_INB, MA, NA, IMBA, INBA,
417 $ MBA, NBA, RSRCA, CSRCA, MPA, NQA, IPREA,
418 $ IMIDA, IPOSTA, 0, 0, IERR( 1 ) )
419*
420 CALL PMDESCCHK( ICTXT, NOUT, 'b', DESCB,
421 $ BLOCK_CYCLIC_2D_INB, MB, NB, IMBB, INBB,
422 $ MBB, NBB, RSRCB, CSRCB, MPB, NQB, IPREB,
423 $ IMIDB, IPOSTB, 0, 0, IERR( 2 ) )
424*
425 CALL PMDESCCHK( ICTXT, NOUT, 'c', DESCC,
426 $ BLOCK_CYCLIC_2D_INB, MC, NC, IMBC, INBC,
427 $ MBC, NBC, RSRCC, CSRCC, MPC, NQC, IPREC,
428 $ IMIDC, IPOSTC, 0, 0, IERR( 3 ) )
429*
430.GT..OR..GT..OR. IF( IERR( 1 )0 IERR( 2 )0
431.GT. $ IERR( 3 )0 ) THEN
432 GO TO 40
433 END IF
434*
435* Assign pointers into MEM for matrices corresponding to
436* the distributed matrices A, X and Y.
437*
438 IPA = IPREA + 1
439 IPB = IPA + DESCA( LLD_ )*NQA
440 IPC = IPB + DESCB( LLD_ )*NQB
441*
442* Check if sufficient memory.
443*
444 MEMREQD = IPC + DESCC( LLD_ )*NQC - 1
445 IERR( 1 ) = 0
446.GT. IF( MEMREQDMEMSIZ ) THEN
447.EQ. IF( IAM0 )
448 $ WRITE( NOUT, FMT = 9987 ) MEMREQD*CPLXSZ
449 IERR( 1 ) = 1
450 END IF
451*
452* Check all processes for an error
453*
454 CALL IGSUM2D( ICTXT, 'all', ' ', 1, 1, IERR, 1, -1, 0 )
455*
456.GT. IF( IERR( 1 )0 ) THEN
457.EQ. IF( IAM0 )
458 $ WRITE( NOUT, FMT = 9988 )
459 GO TO 40
460 END IF
461*
462* Loop over all PBLAS 3 routines
463*
464 DO 30 L = 1, NSUBS
465*
466* Continue only if this subroutine has to be tested.
467*
468.NOT. IF( LTEST( L ) )
469 $ GO TO 30
470*
471* Define the size of the operands
472*
473.EQ. IF( L1 ) THEN
474*
475* PCGEMM
476*
477 NROWC = M
478 NCOLC = N
479 IF( LSAME( TRANSA, 'n' ) ) THEN
480 NROWA = M
481 NCOLA = K
482 ELSE
483 NROWA = K
484 NCOLA = M
485 END IF
486 IF( LSAME( TRANSB, 'n' ) ) THEN
487 NROWB = K
488 NCOLB = N
489 ELSE
490 NROWB = N
491 NCOLB = K
492 END IF
493.EQ..OR..EQ. ELSE IF( L2 L3 ) THEN
494*
495* PCSYMM, PCHEMM
496*
497 NROWC = M
498 NCOLC = N
499 NROWB = M
500 NCOLB = N
501 IF( LSAME( SIDE, 'l' ) ) THEN
502 NROWA = M
503 NCOLA = M
504 ELSE
505 NROWA = N
506 NCOLA = N
507 END IF
508.EQ..OR..EQ. ELSE IF( L4 L5 ) THEN
509*
510* PCSYRK, PCHERK
511*
512 NROWC = N
513 NCOLC = N
514 IF( LSAME( TRANSA, 'n' ) ) THEN
515 NROWA = N
516 NCOLA = K
517 ELSE
518 NROWA = K
519 NCOLA = N
520 END IF
521 NROWB = 0
522 NCOLB = 0
523.EQ..OR..EQ. ELSE IF( L6 L7 ) THEN
524*
525* PCSYR2K, PCHER2K
526*
527 NROWC = N
528 NCOLC = N
529 IF( LSAME( TRANSA, 'n' ) ) THEN
530 NROWA = N
531 NCOLA = K
532 NROWB = N
533 NCOLB = K
534 ELSE
535 NROWA = K
536 NCOLA = N
537 NROWB = K
538 NCOLB = N
539 END IF
540.EQ..OR..EQ. ELSE IF( L8 L9 ) THEN
541*
542* PCTRMM, PCTRSM
543*
544 NROWB = M
545 NCOLB = N
546 IF( LSAME( SIDE, 'l' ) ) THEN
547 NROWA = M
548 NCOLA = M
549 ELSE
550 NROWA = N
551 NCOLA = N
552 END IF
553 NROWC = 0
554 NCOLC = 0
555.EQ..OR..EQ. ELSE IF( L10 L11 ) THEN
556*
557* PCGEADD, PCTRADD
558*
559 IF( LSAME( TRANSA, 'n' ) ) THEN
560 NROWA = M
561 NCOLA = N
562 ELSE
563 NROWA = N
564 NCOLA = M
565 END IF
566 NROWC = M
567 NCOLC = N
568 NROWB = 0
569 NCOLB = 0
570*
571 END IF
572*
573* Check the validity of the operand sizes
574*
575 CALL PMDIMCHK( ICTXT, NOUT, NROWA, NCOLA, 'a', IA, JA,
576 $ DESCA, IERR( 1 ) )
577 CALL PMDIMCHK( ICTXT, NOUT, NROWB, NCOLB, 'b', IB, JB,
578 $ DESCB, IERR( 2 ) )
579 CALL PMDIMCHK( ICTXT, NOUT, NROWC, NCOLC, 'c', IC, JC,
580 $ DESCC, IERR( 3 ) )
581*
582.NE..OR..NE..OR. IF( IERR( 1 )0 IERR( 2 )0
583.NE. $ IERR( 3 )0 ) THEN
584 GO TO 30
585 END IF
586*
587* Check special values of TRANSA for symmetric and
588* hermitian rank-k and rank-2k updates.
589*
590.EQ..OR..EQ. IF( L4 L6 ) THEN
591.NOT. IF( LSAME( TRANSA, 'n.AND.' )
592.NOT. $ LSAME( TRANSA, 't' ) ) THEN
593.EQ. IF( IAM0 )
594 $ WRITE( NOUT, FMT = 9983 ) SNAMES( L ), 'transa'
595 GO TO 30
596 END IF
597.EQ..OR..EQ. ELSE IF( L5 L7 ) THEN
598.NOT. IF( LSAME( TRANSA, 'n.AND.' )
599.NOT. $ LSAME( TRANSA, 'c' ) ) THEN
600.EQ. IF( IAM0 )
601 $ WRITE( NOUT, FMT = 9983 ) SNAMES( L ), 'transa'
602 GO TO 30
603 END IF
604 END IF
605*
606* Generate distributed matrices A, B and C
607*
608.EQ. IF( L2 ) THEN
609*
610* PCSYMM
611*
612 AFORM = 's'
613 ADIAGDO = 'n'
614 OFFDA = IA - JA
615 CFORM = 'n'
616 OFFDC = 0
617*
618.EQ. ELSE IF( L3 ) THEN
619*
620* PCHEMM
621*
622 AFORM = 'h'
623 ADIAGDO = 'n'
624 OFFDA = IA - JA
625 CFORM = 'n'
626 OFFDC = 0
627*
628.EQ..OR..EQ. ELSE IF( L4 L6 ) THEN
629*
630* PCSYRK, PCSYR2K
631*
632 AFORM = 'n'
633 ADIAGDO = 'n'
634 OFFDA = 0
635 CFORM = 's'
636 OFFDC = IC - JC
637*
638.EQ..OR..EQ. ELSE IF( L5 L7 ) THEN
639*
640* PCHERK, PCHER2K
641*
642 AFORM = 'n'
643 ADIAGDO = 'n'
644 OFFDA = 0
645 CFORM = 'h'
646 OFFDC = IC - JC
647*
648.EQ..AND. ELSE IF( ( L9 )( LSAME( DIAG, 'n' ) ) ) THEN
649*
650* PCTRSM
651*
652 AFORM = 'n'
653 ADIAGDO = 'd'
654 OFFDA = IA - JA
655 CFORM = 'n'
656 OFFDC = 0
657*
658 ELSE
659*
660* Default values
661*
662 AFORM = 'n'
663 ADIAGDO = 'n'
664 OFFDA = 0
665 CFORM = 'n'
666 OFFDC = 0
667*
668 END IF
669*
670 CALL PCLAGEN( .FALSE., AFORM, ADIAGDO, OFFDA, MA, NA,
671 $ 1, 1, DESCA, IASEED, MEM( IPA ),
672 $ DESCA( LLD_ ) )
673.EQ..AND..NOT. IF( ( L9 )( ( LSAME( DIAG, 'n' ) ) ).AND.
674 $ ( max( nrowa, ncola ).GT.1 ) ) THEN
675 scale = one / cmplx( real( max( nrowa, ncola ) ) )
676 IF( lsame( uplo, 'L' ) ) THEN
677 CALL pclascal( 'Lower', nrowa-1, ncola-1, scale,
678 $ mem( ipa ), ia+1, ja, desca )
679 ELSE
680 CALL pclascal( 'Upper', nrowa-1, ncola-1, scale,
681 $ mem( ipa ), ia, ja+1, desca )
682 END IF
683*
684 END IF
685*
686 IF( bcheck( l ) )
687 $ CALL pclagen( .false., 'None', 'No diag', 0, mb, nb,
688 $ 1, 1, descb, ibseed, mem( ipb ),
689 $ descb( lld_ ) )
690*
691 IF( ccheck( l ) )
692 $ CALL pclagen( .false., cform, 'No diag', offdc, mc,
693 $ nc, 1, 1, descc, icseed, mem( ipc ),
694 $ descc( lld_ ) )
695*
696 info = 0
697 CALL pb_boot()
698 CALL blacs_barrier( ictxt, 'All' )
699*
700* Call the Level 3 PBLAS routine
701*
702 IF( l.EQ.1 ) THEN
703*
704* Test PCGEMM
705*
706 nops = pdopbl3( snames( l ), m, n, k )
707*
708 CALL pb_timer( 1 )
709 CALL pcgemm( transa, transb, m, n, k, alpha,
710 $ mem( ipa ), ia, ja, desca, mem( ipb ),
711 $ ib, jb, descb, beta, mem( ipc ), ic, jc,
712 $ descc )
713 CALL pb_timer( 1 )
714*
715 ELSE IF( l.EQ.2 ) THEN
716*
717* Test PCSYMM
718*
719 IF( lsame( side, 'L' ) ) THEN
720 nops = pdopbl3( snames( l ), m, n, 0 )
721 ELSE
722 nops = pdopbl3( snames( l ), m, n, 1 )
723 END IF
724*
725 CALL pb_timer( 1 )
726 CALL pcsymm( side, uplo, m, n, alpha, mem( ipa ), ia,
727 $ ja, desca, mem( ipb ), ib, jb, descb,
728 $ beta, mem( ipc ), ic, jc, descc )
729 CALL pb_timer( 1 )
730*
731 ELSE IF( l.EQ.3 ) THEN
732*
733* Test PCHEMM
734*
735 IF( lsame( side, 'L' ) ) THEN
736 nops = pdopbl3( snames( l ), m, n, 0 )
737 ELSE
738 nops = pdopbl3( snames( l ), m, n, 1 )
739 END IF
740*
741 CALL pb_timer( 1 )
742 CALL pchemm( side, uplo, m, n, alpha, mem( ipa ), ia,
743 $ ja, desca, mem( ipb ), ib, jb, descb,
744 $ beta, mem( ipc ), ic, jc, descc )
745 CALL pb_timer( 1 )
746*
747 ELSE IF( l.EQ.4 ) THEN
748*
749* Test PCSYRK
750*
751 nops = pdopbl3( snames( l ), n, n, k )
752*
753 CALL pb_timer( 1 )
754 CALL pcsyrk( uplo, transa, n, k, alpha, mem( ipa ),
755 $ ia, ja, desca, beta, mem( ipc ), ic, jc,
756 $ descc )
757 CALL pb_timer( 1 )
758*
759 ELSE IF( l.EQ.5 ) THEN
760*
761* Test PCHERK
762*
763 nops = pdopbl3( snames( l ), n, n, k )
764*
765 CALL pb_timer( 1 )
766 CALL pcherk( uplo, transa, n, k, real( alpha ),
767 $ mem( ipa ), ia, ja, desca, real( beta ),
768 $ mem( ipc ), ic, jc, descc )
769 CALL pb_timer( 1 )
770*
771 ELSE IF( l.EQ.6 ) THEN
772*
773* Test PCSYR2K
774*
775 nops = pdopbl3( snames( l ), n, n, k )
776*
777 CALL pb_timer( 1 )
778 CALL pcsyr2k( uplo, transa, n, k, alpha, mem( ipa ),
779 $ ia, ja, desca, mem( ipb ), ib, jb,
780 $ descb, beta, mem( ipc ), ic, jc,
781 $ descc )
782 CALL pb_timer( 1 )
783*
784 ELSE IF( l.EQ.7 ) THEN
785*
786* Test PCHER2K
787*
788 nops = pdopbl3( snames( l ), n, n, k )
789*
790 CALL pb_timer( 1 )
791 CALL pcher2k( uplo, transa, n, k, alpha, mem( ipa ),
792 $ ia, ja, desca, mem( ipb ), ib, jb,
793 $ descb, real( beta ), mem( ipc ), ic, jc,
794 $ descc )
795 CALL pb_timer( 1 )
796*
797 ELSE IF( l.EQ.8 ) THEN
798*
799* Test PCTRMM
800*
801 IF( lsame( side, 'L' ) ) THEN
802 nops = pdopbl3( snames( l ), m, n, 0 )
803 ELSE
804 nops = pdopbl3( snames( l ), m, n, 1 )
805 END IF
806*
807 CALL pb_timer( 1 )
808 CALL pctrmm( side, uplo, transa, diag, m, n, alpha,
809 $ mem( ipa ), ia, ja, desca, mem( ipb ),
810 $ ib, jb, descb )
811 CALL pb_timer( 1 )
812*
813 ELSE IF( l.EQ.9 ) THEN
814*
815* Test PCTRSM
816*
817 IF( lsame( side, 'L' ) ) THEN
818 nops = pdopbl3( snames( l ), m, n, 0 )
819 ELSE
820 nops = pdopbl3( snames( l ), m, n, 1 )
821 END IF
822*
823 CALL pb_timer( 1 )
824 CALL pctrsm( side, uplo, transa, diag, m, n, alpha,
825 $ mem( ipa ), ia, ja, desca, mem( ipb ),
826 $ ib, jb, descb )
827 CALL pb_timer( 1 )
828*
829 ELSE IF( l.EQ.10 ) THEN
830*
831* Test PCGEADD
832*
833 nops = pdopbl3( snames( l ), m, n, m )
834*
835 CALL pb_timer( 1 )
836 CALL pcgeadd( transa, m, n, alpha, mem( ipa ), ia, ja,
837 $ desca, beta, mem( ipc ), ic, jc, descc )
838 CALL pb_timer( 1 )
839*
840 ELSE IF( l.EQ.11 ) THEN
841*
842* Test PCTRADD
843*
844 IF( lsame( uplo, 'U' ) ) THEN
845 nops = pdopbl3( snames( l ), m, n, 0 )
846 ELSE
847 nops = pdopbl3( snames( l ), m, n, 1 )
848 END IF
849*
850 CALL pb_timer( 1 )
851 CALL pctradd( uplo, transa, m, n, alpha, mem( ipa ),
852 $ ia, ja, desca, beta, mem( ipc ), ic, jc,
853 $ descc )
854 CALL pb_timer( 1 )
855*
856 END IF
857*
858* Check if the operation has been performed.
859*
860 IF( info.NE.0 ) THEN
861 IF( iam.EQ.0 )
862 $ WRITE( nout, fmt = 9982 ) info
863 GO TO 30
864 END IF
865*
866 CALL pb_combine( ictxt, 'All', '>', 'W', 1, 1, wtime )
867 CALL pb_combine( ictxt, 'All', '>', 'C', 1, 1, ctime )
868*
869* Only node 0 prints timing test result
870*
871 IF( iam.EQ.0 ) THEN
872*
873* Print WALL time if machine supports it
874*
875 IF( wtime( 1 ).GT.0.0d+0 ) THEN
876 wflops = nops / ( wtime( 1 ) * 1.0d+6 )
877 ELSE
878 wflops = 0.0d+0
879 END IF
880*
881* Print CPU time if machine supports it
882*
883 IF( ctime( 1 ).GT.0.0d+0 ) THEN
884 cflops = nops / ( ctime( 1 ) * 1.0d+6 )
885 ELSE
886 cflops = 0.0d+0
887 END IF
888*
889 WRITE( nout, fmt = 9981 ) snames( l ), wtime( 1 ),
890 $ wflops, ctime( 1 ), cflops
891*
892 END IF
893*
894 30 CONTINUE
895*
896 40 IF( iam.EQ.0 ) THEN
897 WRITE( nout, fmt = 9995 )
898 WRITE( nout, fmt = * )
899 WRITE( nout, fmt = 9986 ) j
900 END IF
901*
902 50 CONTINUE
903*
904 CALL blacs_gridexit( ictxt )
905*
906 60 CONTINUE
907*
908 IF( iam.EQ.0 ) THEN
909 WRITE( nout, fmt = * )
910 WRITE( nout, fmt = 9985 )
911 WRITE( nout, fmt = * )
912 END IF
913*
914 CALL blacs_exit( 0 )
915*
916 9999 FORMAT( 'ILLEGAL ', a, ': ', a, ' = ', i10,
917 $ ' should be at least 1' )
918 9998 FORMAT( 'ILLEGAL GRID: NPROW*NPCOL = ', i4,
919 $ '. It can be at most', i4 )
920 9997 FORMAT( 'Bad ', a, ' parameters: going on to next test case.' )
921 9996 FORMAT( 2x, 'Test number ', i2 , ' started on a ', i4, ' x ',
922 $ i4, ' process grid.' )
923 9995 FORMAT( 2x, ' ------------------------------------------------',
924 $ '-------------------' )
925 9994 FORMAT( 2x, ' M N K SIDE UPLO TRANSA ',
926 $ 'TRANSB DIAG' )
927 9993 FORMAT( 5x,i6,1x,i6,1x,i6,6x,a1,5x,a1,7x,a1,7x,a1,5x,a1 )
928 9992 FORMAT( 2x, ' IA JA MA NA IMBA INBA',
929 $ ' MBA NBA RSRCA CSRCA' )
930 9991 FORMAT( 5x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,1x,i6,
931 $ 1x,i5,1x,i5 )
932 9990 FORMAT( 2x, ' IB JB MB NB IMBB INBB',
933 $ ' MBB NBB RSRCB CSRCB' )
934 9989 FORMAT( 2x, ' IC JC MC NC IMBC INBC',
935 $ ' MBC NBC RSRCC CSRCC' )
936 9988 FORMAT( 'Not enough memory for this test: going on to',
937 $ ' next test case.' )
938 9987 FORMAT( 'Not enough memory. Need: ', i12 )
939 9986 FORMAT( 2x, 'test number ', I2, ' completed.' )
940 9985 FORMAT( 2X, 'End of Tests.' )
941 9984 FORMAT( 2X, 'Tests started.' )
942 9983 FORMAT( 5X, A, ' ***** ', A, ' has an incorrect value: ',
943 $ ' BYPASS *****' )
944 9982 FORMAT( 2X, ' ***** Operation not supported, error code: ',
945 $ I5, ' *****' )
946 9981 FORMAT( 2X, '| ', A, 2X, F13.3, 2X, F13.3, 2X, F13.3, 2X, F13.3 )
947 9980 FORMAT( 2X, ' WALL time (s) WALL Mflops ',
948 $ ' CPU time (s) CPU Mflops' )
949*
950 STOP
951*
952* End of PCBLA3TIM
953*
954 END
955 SUBROUTINE PCBLA3TIMINFO( SUMMRY, NOUT, NMAT, DIAGVAL, SIDEVAL,
956 $ TRNAVAL, TRNBVAL, UPLOVAL, MVAL,
957 $ NVAL, KVAL, MAVAL, NAVAL, IMBAVAL,
958 $ MBAVAL, INBAVAL, NBAVAL, RSCAVAL,
959 $ CSCAVAL, IAVAL, JAVAL, MBVAL, NBVAL,
960 $ IMBBVAL, MBBVAL, INBBVAL, NBBVAL,
961 $ RSCBVAL, CSCBVAL, IBVAL, JBVAL,
962 $ MCVAL, NCVAL, IMBCVAL, MBCVAL,
963 $ INBCVAL, NBCVAL, RSCCVAL, CSCCVAL,
964 $ ICVAL, JCVAL, LDVAL, NGRIDS, PVAL,
965 $ LDPVAL, QVAL, LDQVAL, NBLOG, LTEST,
966 $ IAM, NPROCS, ALPHA, BETA, WORK )
967*
968* -- PBLAS test routine (version 2.0) --
969* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
970* and University of California, Berkeley.
971* April 1, 1998
972*
973* .. Scalar Arguments ..
974 INTEGER IAM, LDPVAL, LDQVAL, LDVAL, NBLOG, NGRIDS,
975 $ NMAT, NOUT, NPROCS
976 COMPLEX ALPHA, BETA
977* ..
978* .. Array Arguments ..
979 CHARACTER*( * ) SUMMRY
980 CHARACTER*1 DIAGVAL( LDVAL ), SIDEVAL( LDVAL ),
981 $ TRNAVAL( LDVAL ), TRNBVAL( LDVAL ),
982 $ UPLOVAL( LDVAL )
983 LOGICAL LTEST( * )
984 INTEGER CSCAVAL( LDVAL ), CSCBVAL( LDVAL ),
985 $ CSCCVAL( LDVAL ), IAVAL( LDVAL ),
986 $ IBVAL( LDVAL ), ICVAL( LDVAL ),
987 $ IMBAVAL( LDVAL ), IMBBVAL( LDVAL ),
988 $ IMBCVAL( LDVAL ), INBAVAL( LDVAL ),
989 $ INBBVAL( LDVAL ), INBCVAL( LDVAL ),
990 $ JAVAL( LDVAL ), JBVAL( LDVAL ), JCVAL( LDVAL ),
991 $ KVAL( LDVAL ), MAVAL( LDVAL ), MBAVAL( LDVAL ),
992 $ MBBVAL( LDVAL ), MBCVAL( LDVAL ),
993 $ MBVAL( LDVAL ), MCVAL( LDVAL ), MVAL( LDVAL ),
994 $ NAVAL( LDVAL ), NBAVAL( LDVAL ),
995 $ NBBVAL( LDVAL ), NBCVAL( LDVAL ),
996 $ NBVAL( LDVAL ), NCVAL( LDVAL ), NVAL( LDVAL ),
997 $ PVAL( LDPVAL ), QVAL( LDQVAL ),
998 $ RSCAVAL( LDVAL ), RSCBVAL( LDVAL ),
999 $ RSCCVAL( LDVAL ), WORK( * )
1000* ..
1001*
1002* Purpose
1003* =======
1004*
1005* PCBLA3TIMINFO get the needed startup information for timing various
1006* Level 3 PBLAS routines, and transmits it to all processes.
1007*
1008* Notes
1009* =====
1010*
1011* For packing the information we assumed that the length in bytes of an
1012* integer is equal to the length in bytes of a real single precision.
1013*
1014* Arguments
1015* =========
1016*
1017* SUMMRY (global output) CHARACTER*(*)
1018* On exit, SUMMRY is the name of output (summary) file (if
1019* any). SUMMRY is only defined for process 0.
1020*
1021* NOUT (global output) INTEGER
1022* On exit, NOUT specifies the unit number for the output file.
1023* When NOUT is 6, output to screen, when NOUT is 0, output to
1024* stderr. NOUT is only defined for process 0.
1025*
1026* NMAT (global output) INTEGER
1027* On exit, NMAT specifies the number of different test cases.
1028*
1029* DIAGVAL (global output) CHARACTER array
1030* On entry, DIAGVAL is an array of dimension LDVAL. On exit,
1031* this array contains the values of DIAG to run the code with.
1032*
1033* SIDEVAL (global output) CHARACTER array
1034* On entry, SIDEVAL is an array of dimension LDVAL. On exit,
1035* this array contains the values of SIDE to run the code with.
1036*
1037* TRNAVAL (global output) CHARACTER array
1038* On entry, TRNAVAL is an array of dimension LDVAL. On exit,
1039* this array contains the values of TRANSA to run the code
1040* with.
1041*
1042* TRNBVAL (global output) CHARACTER array
1043* On entry, TRNBVAL is an array of dimension LDVAL. On exit,
1044* this array contains the values of TRANSB to run the code
1045* with.
1046*
1047* UPLOVAL (global output) CHARACTER array
1048* On entry, UPLOVAL is an array of dimension LDVAL. On exit,
1049* this array contains the values of UPLO to run the code with.
1050*
1051* MVAL (global output) INTEGER array
1052* On entry, MVAL is an array of dimension LDVAL. On exit, this
1053* array contains the values of M to run the code with.
1054*
1055* NVAL (global output) INTEGER array
1056* On entry, NVAL is an array of dimension LDVAL. On exit, this
1057* array contains the values of N to run the code with.
1058*
1059* KVAL (global output) INTEGER array
1060* On entry, KVAL is an array of dimension LDVAL. On exit, this
1061* array contains the values of K to run the code with.
1062*
1063* MAVAL (global output) INTEGER array
1064* On entry, MAVAL is an array of dimension LDVAL. On exit, this
1065* array contains the values of DESCA( M_ ) to run the code
1066* with.
1067*
1068* NAVAL (global output) INTEGER array
1069* On entry, NAVAL is an array of dimension LDVAL. On exit, this
1070* array contains the values of DESCA( N_ ) to run the code
1071* with.
1072*
1073* IMBAVAL (global output) INTEGER array
1074* On entry, IMBAVAL is an array of dimension LDVAL. On exit,
1075* this array contains the values of DESCA( IMB_ ) to run the
1076* code with.
1077*
1078* MBAVAL (global output) INTEGER array
1079* On entry, MBAVAL is an array of dimension LDVAL. On exit,
1080* this array contains the values of DESCA( MB_ ) to run the
1081* code with.
1082*
1083* INBAVAL (global output) INTEGER array
1084* On entry, INBAVAL is an array of dimension LDVAL. On exit,
1085* this array contains the values of DESCA( INB_ ) to run the
1086* code with.
1087*
1088* NBAVAL (global output) INTEGER array
1089* On entry, NBAVAL is an array of dimension LDVAL. On exit,
1090* this array contains the values of DESCA( NB_ ) to run the
1091* code with.
1092*
1093* RSCAVAL (global output) INTEGER array
1094* On entry, RSCAVAL is an array of dimension LDVAL. On exit,
1095* this array contains the values of DESCA( RSRC_ ) to run the
1096* code with.
1097*
1098* CSCAVAL (global output) INTEGER array
1099* On entry, CSCAVAL is an array of dimension LDVAL. On exit,
1100* this array contains the values of DESCA( CSRC_ ) to run the
1101* code with.
1102*
1103* IAVAL (global output) INTEGER array
1104* On entry, IAVAL is an array of dimension LDVAL. On exit, this
1105* array contains the values of IA to run the code with.
1106*
1107* JAVAL (global output) INTEGER array
1108* On entry, JAVAL is an array of dimension LDVAL. On exit, this
1109* array contains the values of JA to run the code with.
1110*
1111* MBVAL (global output) INTEGER array
1112* On entry, MBVAL is an array of dimension LDVAL. On exit, this
1113* array contains the values of DESCB( M_ ) to run the code
1114* with.
1115*
1116* NBVAL (global output) INTEGER array
1117* On entry, NBVAL is an array of dimension LDVAL. On exit, this
1118* array contains the values of DESCB( N_ ) to run the code
1119* with.
1120*
1121* IMBBVAL (global output) INTEGER array
1122* On entry, IMBBVAL is an array of dimension LDVAL. On exit,
1123* this array contains the values of DESCB( IMB_ ) to run the
1124* code with.
1125*
1126* MBBVAL (global output) INTEGER array
1127* On entry, MBBVAL is an array of dimension LDVAL. On exit,
1128* this array contains the values of DESCB( MB_ ) to run the
1129* code with.
1130*
1131* INBBVAL (global output) INTEGER array
1132* On entry, INBBVAL is an array of dimension LDVAL. On exit,
1133* this array contains the values of DESCB( INB_ ) to run the
1134* code with.
1135*
1136* NBBVAL (global output) INTEGER array
1137* On entry, NBBVAL is an array of dimension LDVAL. On exit,
1138* this array contains the values of DESCB( NB_ ) to run the
1139* code with.
1140*
1141* RSCBVAL (global output) INTEGER array
1142* On entry, RSCBVAL is an array of dimension LDVAL. On exit,
1143* this array contains the values of DESCB( RSRC_ ) to run the
1144* code with.
1145*
1146* CSCBVAL (global output) INTEGER array
1147* On entry, CSCBVAL is an array of dimension LDVAL. On exit,
1148* this array contains the values of DESCB( CSRC_ ) to run the
1149* code with.
1150*
1151* IBVAL (global output) INTEGER array
1152* On entry, IBVAL is an array of dimension LDVAL. On exit, this
1153* array contains the values of IB to run the code with.
1154*
1155* JBVAL (global output) INTEGER array
1156* On entry, JBVAL is an array of dimension LDVAL. On exit, this
1157* array contains the values of JB to run the code with.
1158*
1159* MCVAL (global output) INTEGER array
1160* On entry, MCVAL is an array of dimension LDVAL. On exit, this
1161* array contains the values of DESCC( M_ ) to run the code
1162* with.
1163*
1164* NCVAL (global output) INTEGER array
1165* On entry, NCVAL is an array of dimension LDVAL. On exit, this
1166* array contains the values of DESCC( N_ ) to run the code
1167* with.
1168*
1169* IMBCVAL (global output) INTEGER array
1170* On entry, IMBCVAL is an array of dimension LDVAL. On exit,
1171* this array contains the values of DESCC( IMB_ ) to run the
1172* code with.
1173*
1174* MBCVAL (global output) INTEGER array
1175* On entry, MBCVAL is an array of dimension LDVAL. On exit,
1176* this array contains the values of DESCC( MB_ ) to run the
1177* code with.
1178*
1179* INBCVAL (global output) INTEGER array
1180* On entry, INBCVAL is an array of dimension LDVAL. On exit,
1181* this array contains the values of DESCC( INB_ ) to run the
1182* code with.
1183*
1184* NBCVAL (global output) INTEGER array
1185* On entry, NBCVAL is an array of dimension LDVAL. On exit,
1186* this array contains the values of DESCC( NB_ ) to run the
1187* code with.
1188*
1189* RSCCVAL (global output) INTEGER array
1190* On entry, RSCCVAL is an array of dimension LDVAL. On exit,
1191* this array contains the values of DESCC( RSRC_ ) to run the
1192* code with.
1193*
1194* CSCCVAL (global output) INTEGER array
1195* On entry, CSCCVAL is an array of dimension LDVAL. On exit,
1196* this array contains the values of DESCC( CSRC_ ) to run the
1197* code with.
1198*
1199* ICVAL (global output) INTEGER array
1200* On entry, ICVAL is an array of dimension LDVAL. On exit, this
1201* array contains the values of IC to run the code with.
1202*
1203* JCVAL (global output) INTEGER array
1204* On entry, JCVAL is an array of dimension LDVAL. On exit, this
1205* array contains the values of JC to run the code with.
1206*
1207* LDVAL (global input) INTEGER
1208* On entry, LDVAL specifies the maximum number of different va-
1209* lues that can be used for DIAG, SIDE, TRANSA, TRANSB, UPLO,
1210* M, N, K, DESCA(:), IA, JA, DESCB(:), IB, JB, DESCC(:), IC,
1211* JC. This is also the maximum number of test cases.
1212*
1213* NGRIDS (global output) INTEGER
1214* On exit, NGRIDS specifies the number of different values that
1215* can be used for P and Q.
1216*
1217* PVAL (global output) INTEGER array
1218* On entry, PVAL is an array of dimension LDPVAL. On exit, this
1219* array contains the values of P to run the code with.
1220*
1221* LDPVAL (global input) INTEGER
1222* On entry, LDPVAL specifies the maximum number of different
1223* values that can be used for P.
1224*
1225* QVAL (global output) INTEGER array
1226* On entry, QVAL is an array of dimension LDQVAL. On exit, this
1227* array contains the values of Q to run the code with.
1228*
1229* LDQVAL (global input) INTEGER
1230* On entry, LDQVAL specifies the maximum number of different
1231* values that can be used for Q.
1232*
1233* NBLOG (global output) INTEGER
1234* On exit, NBLOG specifies the logical computational block size
1235* to run the tests with. NBLOG must be at least one.
1236*
1237* LTEST (global output) LOGICAL array
1238* On entry, LTEST is an array of dimension at least eleven. On
1239* exit, if LTEST( i ) is .TRUE., the i-th Level 3 PBLAS routine
1240* will be tested. See the input file for the ordering of the
1241* routines.
1242*
1243* IAM (local input) INTEGER
1244* On entry, IAM specifies the number of the process executing
1245* this routine.
1246*
1247* NPROCS (global input) INTEGER
1248* On entry, NPROCS specifies the total number of processes.
1249*
1250* ALPHA (global output) COMPLEX
1251* On exit, ALPHA specifies the value of alpha to be used in all
1252* the test cases.
1253*
1254* BETA (global output) COMPLEX
1255* On exit, BETA specifies the value of beta to be used in all
1256* the test cases.
1257*
1258* WORK (local workspace) INTEGER array
1259* On entry, WORK is an array of dimension at least
1260* MAX( 3, 2*NGRIDS+38*NMAT+NSUBS ) with NSUBS = 11. This array
1261* is used to pack all output arrays in order to send info in
1262* one message.
1263*
1264* -- Written on April 1, 1998 by
1265* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
1266*
1267* =====================================================================
1268*
1269* .. Parameters ..
1270 INTEGER NIN, NSUBS
1271 PARAMETER ( NIN = 11, NSUBS = 11 )
1272* ..
1273* .. Local Scalars ..
1274 LOGICAL LTESTT
1275 INTEGER I, ICTXT, J
1276* ..
1277* .. Local Arrays ..
1278 CHARACTER*7 SNAMET
1279 CHARACTER*79 USRINFO
1280* ..
1281* .. External Subroutines ..
1282 EXTERNAL BLACS_ABORT, BLACS_GET, BLACS_GRIDEXIT,
1283 $ BLACS_GRIDINIT, BLACS_SETUP, CGEBR2D, CGEBS2D,
1284 $ ICOPY, IGEBR2D, IGEBS2D, SGEBR2D, SGEBS2D
1285* ..
1286* .. Intrinsic Functions ..
1287 INTRINSIC CHAR, ICHAR, MAX, MIN
1288* ..
1289* .. Common Blocks ..
1290 CHARACTER*7 SNAMES( NSUBS )
1291 COMMON /SNAMEC/SNAMES
1292* ..
1293* .. Executable Statements ..
1294*
1295* Process 0 reads the input data, broadcasts to other processes and
1296* writes needed information to NOUT
1297*
1298.EQ. IF( IAM0 ) THEN
1299*
1300* Open file and skip data file header
1301*
1302 OPEN( NIN, FILE='PCBLAS3TIM.dat', STATUS='OLD' )
1303 READ( NIN, FMT = * ) SUMMRY
1304 SUMMRY = ' '
1305*
1306* Read in user-supplied info about machine type, compiler, etc.
1307*
1308 READ( NIN, FMT = 9999 ) USRINFO
1309*
1310* Read name and unit number for summary output file
1311*
1312 READ( NIN, FMT = * ) SUMMRY
1313 READ( NIN, FMT = * ) NOUT
1314.NE..AND..NE. IF( NOUT0 NOUT6 )
1315 $ OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
1316*
1317* Read and check the parameter values for the tests.
1318*
1319* Get logical computational block size
1320*
1321 READ( NIN, FMT = * ) NBLOG
1322.LT. IF( NBLOG1 )
1323 $ NBLOG = 32
1324*
1325* Get number of grids
1326*
1327 READ( NIN, FMT = * ) NGRIDS
1328.LT..OR..GT. IF( NGRIDS1 NGRIDSLDPVAL ) THEN
1329 WRITE( NOUT, FMT = 9998 ) 'Grids', LDPVAL
1330 GO TO 120
1331.GT. ELSE IF( NGRIDSLDQVAL ) THEN
1332 WRITE( NOUT, FMT = 9998 ) 'Grids', LDQVAL
1333 GO TO 120
1334 END IF
1335*
1336* Get values of P and Q
1337*
1338 READ( NIN, FMT = * ) ( PVAL( I ), I = 1, NGRIDS )
1339 READ( NIN, FMT = * ) ( QVAL( I ), I = 1, NGRIDS )
1340*
1341* Read ALPHA, BETA
1342*
1343 READ( NIN, FMT = * ) ALPHA
1344 READ( NIN, FMT = * ) BETA
1345*
1346* Read number of tests.
1347*
1348 READ( NIN, FMT = * ) NMAT
1349.LT..OR..GT. IF( NMAT1 NMATLDVAL ) THEN
1350 WRITE( NOUT, FMT = 9998 ) 'Tests', LDVAL
1351 GO TO 120
1352 ENDIF
1353*
1354* Read in input data into arrays.
1355*
1356 READ( NIN, FMT = * ) ( DIAGVAL( I ), I = 1, NMAT )
1357 READ( NIN, FMT = * ) ( SIDEVAL( I ), I = 1, NMAT )
1358 READ( NIN, FMT = * ) ( TRNAVAL( I ), I = 1, NMAT )
1359 READ( NIN, FMT = * ) ( TRNBVAL( I ), I = 1, NMAT )
1360 READ( NIN, FMT = * ) ( UPLOVAL( I ), I = 1, NMAT )
1361 READ( NIN, FMT = * ) ( MVAL ( I ), I = 1, NMAT )
1362 READ( NIN, FMT = * ) ( NVAL ( I ), I = 1, NMAT )
1363 READ( NIN, FMT = * ) ( KVAL ( I ), I = 1, NMAT )
1364 READ( NIN, FMT = * ) ( MAVAL ( I ), I = 1, NMAT )
1365 READ( NIN, FMT = * ) ( NAVAL ( I ), I = 1, NMAT )
1366 READ( NIN, FMT = * ) ( IMBAVAL( I ), I = 1, NMAT )
1367 READ( NIN, FMT = * ) ( INBAVAL( I ), I = 1, NMAT )
1368 READ( NIN, FMT = * ) ( MBAVAL ( I ), I = 1, NMAT )
1369 READ( NIN, FMT = * ) ( NBAVAL ( I ), I = 1, NMAT )
1370 READ( NIN, FMT = * ) ( RSCAVAL( I ), I = 1, NMAT )
1371 READ( NIN, FMT = * ) ( CSCAVAL( I ), I = 1, NMAT )
1372 READ( NIN, FMT = * ) ( IAVAL ( I ), I = 1, NMAT )
1373 READ( NIN, FMT = * ) ( JAVAL ( I ), I = 1, NMAT )
1374 READ( NIN, FMT = * ) ( MBVAL ( I ), I = 1, NMAT )
1375 READ( NIN, FMT = * ) ( NBVAL ( I ), I = 1, NMAT )
1376 READ( NIN, FMT = * ) ( IMBBVAL( I ), I = 1, NMAT )
1377 READ( NIN, FMT = * ) ( INBBVAL( I ), I = 1, NMAT )
1378 READ( NIN, FMT = * ) ( MBBVAL ( I ), I = 1, NMAT )
1379 READ( NIN, FMT = * ) ( NBBVAL ( I ), I = 1, NMAT )
1380 READ( NIN, FMT = * ) ( RSCBVAL( I ), I = 1, NMAT )
1381 READ( NIN, FMT = * ) ( CSCBVAL( I ), I = 1, NMAT )
1382 READ( NIN, FMT = * ) ( IBVAL ( I ), I = 1, NMAT )
1383 READ( NIN, FMT = * ) ( JBVAL ( I ), I = 1, NMAT )
1384 READ( NIN, FMT = * ) ( MCVAL ( I ), I = 1, NMAT )
1385 READ( NIN, FMT = * ) ( NCVAL ( I ), I = 1, NMAT )
1386 READ( NIN, FMT = * ) ( IMBCVAL( I ), I = 1, NMAT )
1387 READ( NIN, FMT = * ) ( INBCVAL( I ), I = 1, NMAT )
1388 READ( NIN, FMT = * ) ( MBCVAL ( I ), I = 1, NMAT )
1389 READ( NIN, FMT = * ) ( NBCVAL ( I ), I = 1, NMAT )
1390 READ( NIN, FMT = * ) ( RSCCVAL( I ), I = 1, NMAT )
1391 READ( NIN, FMT = * ) ( CSCCVAL( I ), I = 1, NMAT )
1392 READ( NIN, FMT = * ) ( ICVAL ( I ), I = 1, NMAT )
1393 READ( NIN, FMT = * ) ( JCVAL ( I ), I = 1, NMAT )
1394*
1395* Read names of subroutines and flags which indicate
1396* whether they are to be tested.
1397*
1398 DO 10 I = 1, NSUBS
1399 LTEST( I ) = .FALSE.
1400 10 CONTINUE
1401 20 CONTINUE
1402 READ( NIN, FMT = 9996, END = 50 ) SNAMET, LTESTT
1403 DO 30 I = 1, NSUBS
1404.EQ. IF( SNAMETSNAMES( I ) )
1405 $ GO TO 40
1406 30 CONTINUE
1407*
1408 WRITE( NOUT, FMT = 9995 )SNAMET
1409 GO TO 120
1410*
1411 40 CONTINUE
1412 LTEST( I ) = LTESTT
1413 GO TO 20
1414*
1415 50 CONTINUE
1416*
1417* Close input file
1418*
1419 CLOSE ( NIN )
1420*
1421* For pvm only: if virtual machine not set up, allocate it and
1422* spawn the correct number of processes.
1423*
1424.LT. IF( NPROCS1 ) THEN
1425 NPROCS = 0
1426 DO 60 I = 1, NGRIDS
1427 NPROCS = MAX( NPROCS, PVAL( I )*QVAL( I ) )
1428 60 CONTINUE
1429 CALL BLACS_SETUP( IAM, NPROCS )
1430 END IF
1431*
1432* Temporarily define blacs grid to include all processes so
1433* information can be broadcast to all processes
1434*
1435 CALL BLACS_GET( -1, 0, ICTXT )
1436 CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS )
1437*
1438* Pack information arrays and broadcast
1439*
1440 CALL CGEBS2D( ICTXT, 'All', ' ', 1, 1, ALPHA, 1 )
1441 CALL CGEBS2D( ICTXT, 'All', ' ', 1, 1, BETA, 1 )
1442*
1443 WORK( 1 ) = NGRIDS
1444 WORK( 2 ) = NMAT
1445 WORK( 3 ) = NBLOG
1446 CALL IGEBS2D( ICTXT, 'All', ' ', 3, 1, WORK, 3 )
1447*
1448 I = 1
1449 DO 70 J = 1, NMAT
1450 WORK( I ) = ICHAR( DIAGVAL( J ) )
1451 WORK( I+1 ) = ICHAR( SIDEVAL( J ) )
1452 WORK( I+2 ) = ICHAR( TRNAVAL( J ) )
1453 WORK( I+3 ) = ICHAR( TRNBVAL( J ) )
1454 WORK( I+4 ) = ICHAR( UPLOVAL( J ) )
1455 I = I + 5
1456 70 CONTINUE
1457 CALL ICOPY( NGRIDS, PVAL, 1, WORK( I ), 1 )
1458 I = I + NGRIDS
1459 CALL ICOPY( NGRIDS, QVAL, 1, WORK( I ), 1 )
1460 I = I + NGRIDS
1461 CALL ICOPY( NMAT, MVAL, 1, WORK( I ), 1 )
1462 I = I + NMAT
1463 CALL ICOPY( NMAT, NVAL, 1, WORK( I ), 1 )
1464 I = I + NMAT
1465 CALL ICOPY( NMAT, KVAL, 1, WORK( I ), 1 )
1466 I = I + NMAT
1467 CALL ICOPY( NMAT, MAVAL, 1, WORK( I ), 1 )
1468 I = I + NMAT
1469 CALL ICOPY( NMAT, NAVAL, 1, WORK( I ), 1 )
1470 I = I + NMAT
1471 CALL ICOPY( NMAT, IMBAVAL, 1, WORK( I ), 1 )
1472 I = I + NMAT
1473 CALL ICOPY( NMAT, INBAVAL, 1, WORK( I ), 1 )
1474 I = I + NMAT
1475 CALL ICOPY( NMAT, MBAVAL, 1, WORK( I ), 1 )
1476 I = I + NMAT
1477 CALL ICOPY( NMAT, NBAVAL, 1, WORK( I ), 1 )
1478 I = I + NMAT
1479 CALL ICOPY( NMAT, RSCAVAL, 1, WORK( I ), 1 )
1480 I = I + NMAT
1481 CALL ICOPY( NMAT, CSCAVAL, 1, WORK( I ), 1 )
1482 I = I + NMAT
1483 CALL ICOPY( NMAT, IAVAL, 1, WORK( I ), 1 )
1484 I = I + NMAT
1485 CALL ICOPY( NMAT, JAVAL, 1, WORK( I ), 1 )
1486 I = I + NMAT
1487 CALL ICOPY( NMAT, MBVAL, 1, WORK( I ), 1 )
1488 I = I + NMAT
1489 CALL ICOPY( NMAT, NBVAL, 1, WORK( I ), 1 )
1490 I = I + NMAT
1491 CALL ICOPY( NMAT, IMBBVAL, 1, WORK( I ), 1 )
1492 I = I + NMAT
1493 CALL ICOPY( NMAT, INBBVAL, 1, WORK( I ), 1 )
1494 I = I + NMAT
1495 CALL ICOPY( NMAT, MBBVAL, 1, WORK( I ), 1 )
1496 I = I + NMAT
1497 CALL ICOPY( NMAT, NBBVAL, 1, WORK( I ), 1 )
1498 I = I + NMAT
1499 CALL ICOPY( NMAT, RSCBVAL, 1, WORK( I ), 1 )
1500 I = I + NMAT
1501 CALL ICOPY( NMAT, CSCBVAL, 1, WORK( I ), 1 )
1502 I = I + NMAT
1503 CALL ICOPY( NMAT, IBVAL, 1, WORK( I ), 1 )
1504 I = I + NMAT
1505 CALL ICOPY( NMAT, JBVAL, 1, WORK( I ), 1 )
1506 I = I + NMAT
1507 CALL ICOPY( NMAT, MCVAL, 1, WORK( I ), 1 )
1508 I = I + NMAT
1509 CALL ICOPY( NMAT, NCVAL, 1, WORK( I ), 1 )
1510 I = I + NMAT
1511 CALL ICOPY( NMAT, IMBCVAL, 1, WORK( I ), 1 )
1512 I = I + NMAT
1513 CALL ICOPY( NMAT, INBCVAL, 1, WORK( I ), 1 )
1514 I = I + NMAT
1515 CALL ICOPY( NMAT, MBCVAL, 1, WORK( I ), 1 )
1516 I = I + NMAT
1517 CALL ICOPY( NMAT, NBCVAL, 1, WORK( I ), 1 )
1518 I = I + NMAT
1519 CALL ICOPY( NMAT, RSCCVAL, 1, WORK( I ), 1 )
1520 I = I + NMAT
1521 CALL ICOPY( NMAT, CSCCVAL, 1, WORK( I ), 1 )
1522 I = I + NMAT
1523 CALL ICOPY( NMAT, ICVAL, 1, WORK( I ), 1 )
1524 I = I + NMAT
1525 CALL ICOPY( NMAT, JCVAL, 1, WORK( I ), 1 )
1526 I = I + NMAT
1527*
1528 DO 80 J = 1, NSUBS
1529 IF( LTEST( J ) ) THEN
1530 WORK( I ) = 1
1531 ELSE
1532 WORK( I ) = 0
1533 END IF
1534 I = I + 1
1535 80 CONTINUE
1536 I = I - 1
1537 CALL IGEBS2D( ICTXT, 'All', ' ', I, 1, WORK, I )
1538*
1539* regurgitate input
1540*
1541 WRITE( NOUT, FMT = 9999 )
1542 $ 'Level 3 PBLAS timing program.'
1543 WRITE( NOUT, FMT = 9999 ) USRINFO
1544 WRITE( NOUT, FMT = * )
1545 WRITE( NOUT, FMT = 9999 )
1546 $ 'Tests of the complex single precision '//
1547 $ 'Level 3 PBLAS'
1548 WRITE( NOUT, FMT = * )
1549 WRITE( NOUT, FMT = 9992 ) NMAT
1550 WRITE( NOUT, FMT = 9986 ) NBLOG
1551 WRITE( NOUT, FMT = 9991 ) NGRIDS
1552 WRITE( NOUT, FMT = 9989 )
1553 $ 'P', ( PVAL(I), I = 1, MIN(NGRIDS, 5) )
1554.GT. IF( NGRIDS5 )
1555 $ WRITE( NOUT, FMT = 9990 ) ( PVAL(I), I = 6,
1556 $ MIN( 10, NGRIDS ) )
1557.GT. IF( NGRIDS10 )
1558 $ WRITE( NOUT, FMT = 9990 ) ( PVAL(I), I = 11,
1559 $ MIN( 15, NGRIDS ) )
1560.GT. IF( NGRIDS15 )
1561 $ WRITE( NOUT, FMT = 9990 ) ( PVAL(I), I = 16, NGRIDS )
1562 WRITE( NOUT, FMT = 9989 )
1563 $ 'Q', ( QVAL(I), I = 1, MIN(NGRIDS, 5) )
1564.GT. IF( NGRIDS5 )
1565 $ WRITE( NOUT, FMT = 9990 ) ( QVAL(I), I = 6,
1566 $ MIN( 10, NGRIDS ) )
1567.GT. IF( NGRIDS10 )
1568 $ WRITE( NOUT, FMT = 9990 ) ( QVAL(I), I = 11,
1569 $ MIN( 15, NGRIDS ) )
1570.GT. IF( NGRIDS15 )
1571 $ WRITE( NOUT, FMT = 9990 ) ( QVAL(I), I = 16, NGRIDS )
1572 WRITE( NOUT, FMT = 9994 ) ALPHA
1573 WRITE( NOUT, FMT = 9993 ) BETA
1574 IF( LTEST( 1 ) ) THEN
1575 WRITE( NOUT, FMT = 9988 ) SNAMES( 1 ), ' ... Yes'
1576 ELSE
1577 WRITE( NOUT, FMT = 9988 ) SNAMES( 1 ), ' ... No '
1578 END IF
1579 DO 90 I = 2, NSUBS
1580 IF( LTEST( I ) ) THEN
1581 WRITE( NOUT, FMT = 9987 ) SNAMES( I ), ' ... Yes'
1582 ELSE
1583 WRITE( NOUT, FMT = 9987 ) SNAMES( I ), ' ... No '
1584 END IF
1585 90 CONTINUE
1586 WRITE( NOUT, FMT = * )
1587*
1588 ELSE
1589*
1590* If in pvm, must participate setting up virtual machine
1591*
1592.LT. IF( NPROCS1 )
1593 $ CALL BLACS_SETUP( IAM, NPROCS )
1594*
1595* Temporarily define blacs grid to include all processes so
1596* information can be broadcast to all processes
1597*
1598 CALL BLACS_GET( -1, 0, ICTXT )
1599 CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS )
1600*
1601 CALL CGEBR2D( ICTXT, 'All', ' ', 1, 1, ALPHA, 1, 0, 0 )
1602 CALL CGEBR2D( ICTXT, 'All', ' ', 1, 1, BETA, 1, 0, 0 )
1603*
1604 CALL IGEBR2D( ICTXT, 'All', ' ', 3, 1, WORK, 3, 0, 0 )
1605 NGRIDS = WORK( 1 )
1606 NMAT = WORK( 2 )
1607 NBLOG = WORK( 3 )
1608*
1609 I = 2*NGRIDS + 38*NMAT + NSUBS
1610 CALL IGEBR2D( ICTXT, 'All', ' ', I, 1, WORK, I, 0, 0 )
1611*
1612 I = 1
1613 DO 100 J = 1, NMAT
1614 DIAGVAL( J ) = CHAR( WORK( I ) )
1615 SIDEVAL( J ) = CHAR( WORK( I+1 ) )
1616 TRNAVAL( J ) = CHAR( WORK( I+2 ) )
1617 TRNBVAL( J ) = CHAR( WORK( I+3 ) )
1618 UPLOVAL( J ) = CHAR( WORK( I+4 ) )
1619 I = I + 5
1620 100 CONTINUE
1621 CALL ICOPY( NGRIDS, WORK( I ), 1, PVAL, 1 )
1622 I = I + NGRIDS
1623 CALL ICOPY( NGRIDS, WORK( I ), 1, QVAL, 1 )
1624 I = I + NGRIDS
1625 CALL ICOPY( NMAT, WORK( I ), 1, MVAL, 1 )
1626 I = I + NMAT
1627 CALL ICOPY( NMAT, WORK( I ), 1, NVAL, 1 )
1628 I = I + NMAT
1629 CALL ICOPY( NMAT, WORK( I ), 1, KVAL, 1 )
1630 I = I + NMAT
1631 CALL ICOPY( NMAT, WORK( I ), 1, MAVAL, 1 )
1632 I = I + NMAT
1633 CALL ICOPY( NMAT, WORK( I ), 1, NAVAL, 1 )
1634 I = I + NMAT
1635 CALL ICOPY( NMAT, WORK( I ), 1, IMBAVAL, 1 )
1636 I = I + NMAT
1637 CALL ICOPY( NMAT, WORK( I ), 1, INBAVAL, 1 )
1638 I = I + NMAT
1639 CALL ICOPY( NMAT, WORK( I ), 1, MBAVAL, 1 )
1640 I = I + NMAT
1641 CALL ICOPY( NMAT, WORK( I ), 1, NBAVAL, 1 )
1642 I = I + NMAT
1643 CALL ICOPY( NMAT, WORK( I ), 1, RSCAVAL, 1 )
1644 I = I + NMAT
1645 CALL ICOPY( NMAT, WORK( I ), 1, CSCAVAL, 1 )
1646 I = I + NMAT
1647 CALL ICOPY( NMAT, WORK( I ), 1, IAVAL, 1 )
1648 I = I + NMAT
1649 CALL ICOPY( NMAT, WORK( I ), 1, JAVAL, 1 )
1650 I = I + NMAT
1651 CALL ICOPY( NMAT, WORK( I ), 1, MBVAL, 1 )
1652 I = I + NMAT
1653 CALL ICOPY( NMAT, WORK( I ), 1, NBVAL, 1 )
1654 I = I + NMAT
1655 CALL ICOPY( NMAT, WORK( I ), 1, IMBBVAL, 1 )
1656 I = I + NMAT
1657 CALL ICOPY( NMAT, WORK( I ), 1, INBBVAL, 1 )
1658 I = I + NMAT
1659 CALL ICOPY( NMAT, WORK( I ), 1, MBBVAL, 1 )
1660 I = I + NMAT
1661 CALL ICOPY( NMAT, WORK( I ), 1, NBBVAL, 1 )
1662 I = I + NMAT
1663 CALL ICOPY( NMAT, WORK( I ), 1, RSCBVAL, 1 )
1664 I = I + NMAT
1665 CALL ICOPY( NMAT, WORK( I ), 1, CSCBVAL, 1 )
1666 I = I + NMAT
1667 CALL ICOPY( NMAT, WORK( I ), 1, IBVAL, 1 )
1668 I = I + NMAT
1669 CALL ICOPY( NMAT, WORK( I ), 1, JBVAL, 1 )
1670 I = I + NMAT
1671 CALL ICOPY( NMAT, WORK( I ), 1, MCVAL, 1 )
1672 I = I + NMAT
1673 CALL ICOPY( NMAT, WORK( I ), 1, NCVAL, 1 )
1674 I = I + NMAT
1675 CALL ICOPY( NMAT, WORK( I ), 1, IMBCVAL, 1 )
1676 I = I + NMAT
1677 CALL ICOPY( NMAT, WORK( I ), 1, INBCVAL, 1 )
1678 I = I + NMAT
1679 CALL ICOPY( NMAT, WORK( I ), 1, MBCVAL, 1 )
1680 I = I + NMAT
1681 CALL ICOPY( NMAT, WORK( I ), 1, NBCVAL, 1 )
1682 I = I + NMAT
1683 CALL ICOPY( NMAT, WORK( I ), 1, RSCCVAL, 1 )
1684 I = I + NMAT
1685 CALL ICOPY( NMAT, WORK( I ), 1, CSCCVAL, 1 )
1686 I = I + NMAT
1687 CALL ICOPY( NMAT, WORK( I ), 1, ICVAL, 1 )
1688 I = I + NMAT
1689 CALL ICOPY( NMAT, WORK( I ), 1, JCVAL, 1 )
1690 I = I + NMAT
1691*
1692 DO 110 J = 1, NSUBS
1693.EQ. IF( WORK( I )1 ) THEN
1694 LTEST( J ) = .TRUE.
1695 ELSE
1696 LTEST( J ) = .FALSE.
1697 END IF
1698 I = I + 1
1699 110 CONTINUE
1700*
1701 END IF
1702*
1703 CALL BLACS_GRIDEXIT( ICTXT )
1704*
1705 RETURN
1706*
1707 120 WRITE( NOUT, FMT = 9997 )
1708 CLOSE( NIN )
1709.NE..AND..NE. IF( NOUT6 NOUT0 )
1710 $ CLOSE( NOUT )
1711 CALL BLACS_ABORT( ICTXT, 1 )
1712*
1713 STOP
1714*
1715 9999 FORMAT( A )
1716 9998 FORMAT( ' Number of values of ',5A, ' is less than 1 or greater ',
1717 $ 'than ', I2 )
1718 9997 FORMAT( ' Illegal input in file ',40A,'. Aborting run.' )
1719 9996 FORMAT( A7, L2 )
1720 9995 FORMAT( ' Subprogram name ', A7, ' not recognized',
1721 $ /' ******* TESTS ABANDONED *******' )
1722 9994 FORMAT( 2X, 'Alpha : (', G16.6,
1723 $ ',', G16.6, ')' )
1724 9993 FORMAT( 2X, 'Beta : (', G16.6,
1725 $ ',', G16.6, ')' )
1726 9992 FORMAT( 2X, 'Number of Tests : ', I6 )
1727 9991 FORMAT( 2X, 'Number of process grids : ', I6 )
1728 9990 FORMAT( 2X, ' : ', 5I6 )
1729 9989 FORMAT( 2X, A1, ' : ', 5I6 )
1730 9988 FORMAT( 2X, 'Routines to be tested : ', A, A8 )
1731 9987 FORMAT( 2X, ' ', A, A8 )
1732 9986 FORMAT( 2X, 'Logical block size : ', I6 )
1733*
1734* End of PCBLA3TIMINFO
1735*
1736 END
cmplx
float cmplx[2]
Definition pblas.h:136
alpha
#define alpha
Definition eval.h:35
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53
max
#define max(a, b)
Definition macros.h:21
blacs_gridexit
subroutine blacs_gridexit(cntxt)
Definition mpi.f:762
pctrsm
subroutine pctrsm(side, uplo, transa, diag, m, n, alpha, a, ia, ja, desca, b, ib, jb, descb)
Definition mpi.f:1470
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
pdopbl3
double precision function pdopbl3(subnam, m, n, k)
Definition pblastim.f:1313
pb_timer
subroutine pb_timer(i)
Definition pblastim.f:2976
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
jc
subroutine jc(p, t, a, b, cm, cn, tref, tm, epsm, sigmam, jc_yield, tan_jc)
Definition sigeps106.F:339