PLASMA  2.4.5
PLASMA - Parallel Linear Algebra for Scalable Multi-core Architectures
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
zchkaa.f
Go to the documentation of this file.
1  PROGRAM zchkaa
2 *
3  include 'plasmaf.h'
4 *
5 * -- PLASMA test routine (From LAPACK version 3.1.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * January 2007
8 *
9 * Purpose
10 * =======
11 *
12 * ZCHKAA is the main test program for the COMPLEX*16 linear equation
13 * routines.
14 *
15 * The program must be driven by a short data file. The first 14 records
16 * specify problem dimensions and program options using list-directed
17 * input. The remaining lines specify the PLASMA test paths and the
18 * number of matrix types to use in testing. An annotated example of a
19 * data file can be obtained by deleting the first 3 characters from the
20 * following 38 lines:
21 * Data file for testing COMPLEX*16 PLASMA linear equation routines
22 * 1 Number of values of NP
23 * 16 Values of NP (number of cores)
24 * 1 Values of SCHED (0: STATIC, 1:DYNAMIC)
25 * 7 Number of values of M
26 * 0 1 2 3 5 10 16 Values of M (row dimension)
27 * 7 Number of values of N
28 * 0 1 2 3 5 10 16 Values of N (column dimension)
29 * 1 Number of values of NRHS
30 * 2 Values of NRHS (number of right hand sides)
31 * 5 Number of values of NB
32 * 1 3 3 3 20 Values of NB (the blocksize)
33 * 1 0 5 9 1 Values of NX (crossover point)
34 * 3 Number of values of RANK
35 * 30 50 90 Values of rank (as a % of N)
36 * 30.0 Threshold value of test ratio
37 * T Put T to test the PLASMA routines
38 * T Put T to test the driver routines
39 * T Put T to test the error exits
40 * ZGE 11 List types on next line if 0 < NTYPES < 11
41 * ZGB 8 List types on next line if 0 < NTYPES < 8
42 * ZGT 12 List types on next line if 0 < NTYPES < 12
43 * ZPO 9 List types on next line if 0 < NTYPES < 9
44 * ZPS 9 List types on next line if 0 < NTYPES < 9
45 * ZPP 9 List types on next line if 0 < NTYPES < 9
46 * ZPB 8 List types on next line if 0 < NTYPES < 8
47 * ZPT 12 List types on next line if 0 < NTYPES < 12
48 * ZHE 10 List types on next line if 0 < NTYPES < 10
49 * ZHP 10 List types on next line if 0 < NTYPES < 10
50 * ZSY 11 List types on next line if 0 < NTYPES < 11
51 * ZSP 11 List types on next line if 0 < NTYPES < 11
52 * ZTR 18 List types on next line if 0 < NTYPES < 18
53 * ZTP 18 List types on next line if 0 < NTYPES < 18
54 * ZTB 17 List types on next line if 0 < NTYPES < 17
55 * ZQR 8 List types on next line if 0 < NTYPES < 8
56 * ZRQ 8 List types on next line if 0 < NTYPES < 8
57 * ZLQ 8 List types on next line if 0 < NTYPES < 8
58 * ZQL 8 List types on next line if 0 < NTYPES < 8
59 * ZQP 6 List types on next line if 0 < NTYPES < 6
60 * ZTZ 3 List types on next line if 0 < NTYPES < 3
61 * ZLS 6 List types on next line if 0 < NTYPES < 6
62 * ZEQ
63 *
64 * Internal Parameters
65 * ===================
66 *
67 * NMAX INTEGER
68 * The maximum allowable value for N.
69 *
70 * MAXIN INTEGER
71 * The number of different values that can be used for each of
72 * M, N, or NB
73 *
74 * MAXRHS INTEGER
75 * The maximum number of right hand sides
76 *
77 * NIN INTEGER
78 * The unit number for input
79 *
80 * NOUT INTEGER
81 * The unit number for output
82 *
83 * =====================================================================
84 *
85 * .. Parameters ..
86  INTEGER npmax
87  parameter( npmax = 16 )
88  INTEGER nmax
89  parameter( nmax = 1000 )
90  INTEGER maxin
91  parameter( maxin = 12 )
92  INTEGER maxrhs
93  parameter( maxrhs = 16 )
94  INTEGER matmax
95  parameter( matmax = 30 )
96  INTEGER nin, nout
97  parameter( nin = 5, nout = 6 )
98  INTEGER kdmax
99  parameter( kdmax = nmax+( nmax+1 ) / 4 )
100 * ..
101 * .. Local Scalars ..
102  LOGICAL fatal, tstchk, tstdrv, tsterr
103  CHARACTER c1
104  CHARACTER*2 c2
105  CHARACTER*3 path
106  CHARACTER*10 intstr
107  CHARACTER*72 aline
108  INTEGER i, ib, ic, j, k, la, lafac, lda, nb, nm, nmats,
109  $ nn, nnb, nnb2, np, nnp, sched, nns, nrhs,
110  $ ntypes, nrank, vers_major, vers_minor,
111  $ vers_patch, info
112  DOUBLE PRECISION eps, s1, s2, threq, thresh
113 * ..
114 * .. Local Arrays ..
115  LOGICAL dotype( matmax )
116  INTEGER ibval(maxin ), iwork( 25*nmax ), mval( maxin ),
117  $ nbval( maxin ), nbval2( maxin ),
118  $ npval( maxin ), nsval( maxin ),
119  $ nval( maxin ), nxval( maxin ),
120  $ rankval( maxin ), piv( nmax )
121  DOUBLE PRECISION rwork( 150*nmax+2*maxrhs ), s( 2*nmax )
122  COMPLEX*16 a( ( kdmax+1 )*nmax, 7 ), b( nmax*maxrhs, 4 ),
123  $ work( nmax, nmax+maxrhs+10 )
124 * ..
125 * .. External Functions ..
126  LOGICAL lsame, lsamen
127  DOUBLE PRECISION dlamch, dsecnd
128  EXTERNAL lsame, lsamen, dlamch, dsecnd
129 * ..
130 * .. External Subroutines ..
131  EXTERNAL alareq, zchkge,
132  $ zchklq, zchkpo,
133  $ zchkqr,
134  $ zdrvls,
135  $ zdrvpo,
136  $ ilaver
137 * ..
138 * .. Scalars in Common ..
139  LOGICAL lerr, ok
140  CHARACTER*32 srnamt
141  INTEGER infot, nunit
142 * ..
143 * .. Arrays in Common ..
144  INTEGER iparms( 100 )
145 * ..
146 * .. Common blocks ..
147  common / infoc / infot, nunit, ok, lerr
148  common / srnamc / srnamt
149  common / claenv / iparms
150 * ..
151 * .. Data statements ..
152  DATA threq / 2.0d0 / , intstr / '0123456789' /
153 * ..
154 * .. Executable Statements ..
155 *
156 * S1 = DSECND( )
157  lda = nmax
158  fatal = .false.
159 *
160 * Report values of parameters.
161 *
162  CALL plasma_version( vers_major, vers_minor, vers_patch, info)
163  WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
164 *
165 *
166 * Read a dummy line.
167 *
168  READ( nin, fmt = * )
169 *
170 * Read the values of NP
171 *
172  READ( nin, fmt = * )nnp
173  IF( nnp.LT.1 ) THEN
174  WRITE( nout, fmt = 9996 )' NNP ', nnp, 1
175  nnp = 0
176  fatal = .true.
177  ELSE IF( nnp.GT.maxin ) THEN
178  WRITE( nout, fmt = 9995 )' NNP ', nnp, maxin
179  nnp = 0
180  fatal = .true.
181  END IF
182  READ( nin, fmt = * )( npval( i ), i = 1, nnp )
183  DO 01 i = 1, nnp
184  IF( npval( i ).LT.0 ) THEN
185  WRITE( nout, fmt = 9996 )' NP ', npval( i ), 0
186  fatal = .true.
187  ELSE IF( npval( i ).GT.npmax ) THEN
188  WRITE( nout, fmt = 9995 )' NP ', npval( i ), npmax
189  fatal = .true.
190  END IF
191  01 continue
192  IF( nnp.GT.0 )
193  $ WRITE( nout, fmt = 9993 )'NP ', ( npval( i ), i = 1, nnp )
194 *
195 * Read the values of SCHED
196 *
197  READ( nin, fmt = * )sched
198  IF (( sched .LT. 0 ) .OR. (sched .GT. 1)) THEN
199  WRITE( nout, fmt = 9987 )' SCHED ', sched
200  sched = 0
201  fatal = .true.
202  END IF
203 *
204 * Read the values of M
205 *
206  READ( nin, fmt = * )nm
207  IF( nm.LT.1 ) THEN
208  WRITE( nout, fmt = 9996 )' NM ', nm, 1
209  nm = 0
210  fatal = .true.
211  ELSE IF( nm.GT.maxin ) THEN
212  WRITE( nout, fmt = 9995 )' NM ', nm, maxin
213  nm = 0
214  fatal = .true.
215  END IF
216  READ( nin, fmt = * )( mval( i ), i = 1, nm )
217  DO 10 i = 1, nm
218  IF( mval( i ).LT.0 ) THEN
219  WRITE( nout, fmt = 9996 )' M ', mval( i ), 0
220  fatal = .true.
221  ELSE IF( mval( i ).GT.nmax ) THEN
222  WRITE( nout, fmt = 9995 )' M ', mval( i ), nmax
223  fatal = .true.
224  END IF
225  10 continue
226  IF( nm.GT.0 )
227  $ WRITE( nout, fmt = 9993 )'M ', ( mval( i ), i = 1, nm )
228 *
229 * Read the values of N
230 *
231  READ( nin, fmt = * ) nn
232  IF( nn.LT.1 ) THEN
233  WRITE( nout, fmt = 9996 )' NN ', nn, 1
234  nn = 0
235  fatal = .true.
236  ELSE IF( nn.GT.maxin ) THEN
237  WRITE( nout, fmt = 9995 )' NN ', nn, maxin
238  nn = 0
239  fatal = .true.
240  END IF
241  READ( nin, fmt = * )( nval( i ), i = 1, nn )
242  DO 20 i = 1, nn
243  IF( nval( i ).LT.0 ) THEN
244  WRITE( nout, fmt = 9996 )' N ', nval( i ), 0
245  fatal = .true.
246  ELSE IF( nval( i ).GT.nmax ) THEN
247  WRITE( nout, fmt = 9995 )' N ', nval( i ), nmax
248  fatal = .true.
249  END IF
250  20 continue
251  IF( nn.GT.0 )
252  $ WRITE( nout, fmt = 9993 )'N ', ( nval( i ), i = 1, nn )
253 *
254 * Read the values of NRHS
255 *
256  READ( nin, fmt = * )nns
257  IF( nns.LT.1 ) THEN
258  WRITE( nout, fmt = 9996 )' NNS', nns, 1
259  nns = 0
260  fatal = .true.
261  ELSE IF( nns.GT.maxin ) THEN
262  WRITE( nout, fmt = 9995 )' NNS', nns, maxin
263  nns = 0
264  fatal = .true.
265  END IF
266  READ( nin, fmt = * )( nsval( i ), i = 1, nns )
267  DO 30 i = 1, nns
268  IF( nsval( i ).LT.0 ) THEN
269  WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
270  fatal = .true.
271  ELSE IF( nsval( i ).GT.maxrhs ) THEN
272  WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
273  fatal = .true.
274  END IF
275  30 continue
276  IF( nns.GT.0 )
277  $ WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
278 *
279 * Read the values of NB
280 *
281  READ( nin, fmt = * )nnb
282  IF( nnb.LT.1 ) THEN
283  WRITE( nout, fmt = 9996 )'NNB ', nnb, 1
284  nnb = 0
285  fatal = .true.
286  ELSE IF( nnb.GT.maxin ) THEN
287  WRITE( nout, fmt = 9995 )'NNB ', nnb, maxin
288  nnb = 0
289  fatal = .true.
290  END IF
291  READ( nin, fmt = * )( nbval( i ), i = 1, nnb )
292  DO 40 i = 1, nnb
293  IF( nbval( i ).LT.0 ) THEN
294  WRITE( nout, fmt = 9996 )' NB ', nbval( i ), 0
295  fatal = .true.
296  END IF
297  40 continue
298  IF( nnb.GT.0 )
299  $ WRITE( nout, fmt = 9993 )'NB ', ( nbval( i ), i = 1, nnb )
300 *
301 * Read the values of IB
302 *
303  READ( nin, fmt = * )( ibval( i ), i = 1, nnb )
304  DO 41 i = 1, nnb
305  IF( ibval( i ).LT.0 ) THEN
306  WRITE( nout, fmt = 9996 )' NB ', ibval( i ), 0
307  fatal = .true.
308  END IF
309  41 continue
310  IF( nnb.GT.0 )
311  $ WRITE( nout, fmt = 9993 )'IB ', ( ibval( i ), i = 1, nnb )
312 *
313 * Set NBVAL2 to be the set of unique values of NB
314 *
315  nnb2 = 0
316  DO 60 i = 1, nnb
317  nb = nbval( i )
318  DO 50 j = 1, nnb2
319  IF( nb.EQ.nbval2( j ) )
320  $ go to 60
321  50 continue
322  nnb2 = nnb2 + 1
323  nbval2( nnb2 ) = nb
324  60 continue
325 *
326 * Read the values of NX
327 *
328  READ( nin, fmt = * )( nxval( i ), i = 1, nnb )
329  DO 70 i = 1, nnb
330  IF( nxval( i ).LT.0 ) THEN
331  WRITE( nout, fmt = 9996 )' NX ', nxval( i ), 0
332  fatal = .true.
333  END IF
334  70 continue
335  IF( nnb.GT.0 )
336  $ WRITE( nout, fmt = 9993 )'NX ', ( nxval( i ), i = 1, nnb )
337 *
338 * Read the values of RANKVAL
339 *
340  READ( nin, fmt = * )nrank
341  IF( nn.LT.1 ) THEN
342  WRITE( nout, fmt = 9996 )' NRANK ', nrank, 1
343  nrank = 0
344  fatal = .true.
345  ELSE IF( nn.GT.maxin ) THEN
346  WRITE( nout, fmt = 9995 )' NRANK ', nrank, maxin
347  nrank = 0
348  fatal = .true.
349  END IF
350  READ( nin, fmt = * )( rankval( i ), i = 1, nrank )
351  DO i = 1, nrank
352  IF( rankval( i ).LT.0 ) THEN
353  WRITE( nout, fmt = 9996 )' RANK ', rankval( i ), 0
354  fatal = .true.
355  ELSE IF( rankval( i ).GT.100 ) THEN
356  WRITE( nout, fmt = 9995 )' RANK ', rankval( i ), 100
357  fatal = .true.
358  END IF
359  END DO
360  IF( nrank.GT.0 )
361  $ WRITE( nout, fmt = 9993 )'RANK % OF N',
362  $ ( rankval( i ), i = 1, nrank )
363 *
364 * Read the threshold value for the test ratios.
365 *
366  READ( nin, fmt = * )thresh
367  WRITE( nout, fmt = 9992 )thresh
368 *
369 * Read the flag that indicates whether to test the PLASMA routines.
370 *
371  READ( nin, fmt = * )tstchk
372 *
373 * Read the flag that indicates whether to test the driver routines.
374 *
375  READ( nin, fmt = * )tstdrv
376 *
377 * Read the flag that indicates whether to test the error exits.
378 *
379  READ( nin, fmt = * )tsterr
380 *
381  IF( fatal ) THEN
382  WRITE( nout, fmt = 9999 )
383  stop
384  END IF
385 *
386 * Calculate and print the machine dependent constants.
387 *
388  eps = dlamch( 'Underflow threshold' )
389  WRITE( nout, fmt = 9991 )'underflow', eps
390  eps = dlamch( 'Overflow threshold' )
391  WRITE( nout, fmt = 9991 )'overflow ', eps
392  eps = dlamch( 'Epsilon' )
393  WRITE( nout, fmt = 9991 )'precision', eps
394  WRITE( nout, fmt = * )
395  nrhs = nsval( 1 )
396 *
397 * Initialize PLASMA
398 *
399  CALL plasma_init( npval(nnp), info )
400 *
401  IF( sched .EQ. 1 ) THEN
402  CALL plasma_set(plasma_scheduling_mode,
403  $ plasma_dynamic_scheduling, info )
404  ELSE
405  CALL plasma_set(plasma_scheduling_mode,
406  $ plasma_static_scheduling, info )
407  ENDIF
408 *
409  CALL plasma_disable( plasma_autotuning, info )
410 *
411 *
412  80 continue
413 *
414 * Read a test path and the number of matrix types to use.
415 *
416  READ( nin, fmt = '(A72)', END = 140 )aline
417  path = aline( 1: 3 )
418  nmats = matmax
419  i = 3
420  90 continue
421  i = i + 1
422  IF( i.GT.72 )
423  $ go to 130
424  IF( aline( i: i ).EQ.' ' )
425  $ go to 90
426  nmats = 0
427  100 continue
428  c1 = aline( i: i )
429  DO 110 k = 1, 10
430  IF( c1.EQ.intstr( k: k ) ) THEN
431  ic = k - 1
432  go to 120
433  END IF
434  110 continue
435  go to 130
436  120 continue
437  nmats = nmats*10 + ic
438  i = i + 1
439  IF( i.GT.72 )
440  $ go to 130
441  go to 100
442  130 continue
443  c1 = path( 1: 1 )
444  c2 = path( 2: 3 )
445 *
446 * Check first character for correct precision.
447 *
448  IF( .NOT.lsame( c1, 'Zomplex precision' ) ) THEN
449  WRITE( nout, fmt = 9990 )path
450 *
451  ELSE IF( nmats.LE.0 ) THEN
452 *
453 * Check for a positive number of tests requested.
454 *
455  WRITE( nout, fmt = 9989 )path
456 *
457  ELSE IF( lsamen( 2, c2, 'GE' ) ) THEN
458 *
459 * GE: general matrices
460 *
461  ntypes = 11
462  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
463 *
464  IF( tstchk ) THEN
465  CALL zchkge( dotype, nm, mval, nn, nval, nnb2, nbval2, nns,
466  $ ibval, nsval, thresh, tsterr, lda, a( 1, 1 ),
467  $ a( 1, 2 ), a( 1, 3 ), b( 1, 1 ), b( 1, 2 ),
468  $ b( 1, 3 ), work, rwork, iwork, nout )
469  ELSE
470  WRITE( nout, fmt = 9989 )path
471  END IF
472 *
473  IF( tstdrv ) THEN
474  CALL zdrvge( dotype, nn, nval, nrhs, thresh, tsterr, lda,
475  $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
476  $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
477  $ rwork, iwork, nout )
478  ELSE
479  WRITE( nout, fmt = 9988 )path
480  END IF
481 *
482  ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
483 *
484 * PO: positive definite matrices
485 *
486  ntypes = 9
487  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
488 *
489  IF( tstchk ) THEN
490  CALL zchkpo( dotype, nn, nval, nnb2, nbval2, nns, nsval,
491  $ thresh, tsterr, lda, a( 1, 1 ), a( 1, 2 ),
492  $ a( 1, 3 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
493  $ work, rwork, nout )
494  ELSE
495  WRITE( nout, fmt = 9989 )path
496  END IF
497 *
498  IF( tstdrv ) THEN
499  CALL zdrvpo( dotype, nn, nval, nrhs, thresh, tsterr, lda,
500  $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b( 1, 1 ),
501  $ b( 1, 2 ), b( 1, 3 ), b( 1, 4 ), s, work,
502  $ rwork, nout )
503  ELSE
504  WRITE( nout, fmt = 9988 )path
505  END IF
506 *
507  ELSE IF( lsamen( 2, c2, 'QR' ) ) THEN
508 *
509 * QR: QR factorization
510 *
511  ntypes = 8
512  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
513 *
514  IF( tstchk ) THEN
515  CALL zchkqr( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
516  $ ibval, nrhs, thresh, tsterr, nmax, a( 1, 1 ),
517  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
518  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
519  $ work, rwork, iwork, nout )
520  ELSE
521  WRITE( nout, fmt = 9989 )path
522  END IF
523 *
524  ELSE IF( lsamen( 2, c2, 'LQ' ) ) THEN
525 *
526 * LQ: LQ factorization
527 *
528  ntypes = 8
529  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
530 *
531  IF( tstchk ) THEN
532  CALL zchklq( dotype, nm, mval, nn, nval, nnb, nbval, nxval,
533  $ ibval, nrhs, thresh, tsterr, nmax, a( 1, 1 ),
534  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
535  $ b( 1, 1 ), b( 1, 2 ), b( 1, 3 ), b( 1, 4 ),
536  $ work, rwork, iwork, nout )
537  ELSE
538  WRITE( nout, fmt = 9989 )path
539  END IF
540 *
541  ELSE IF( lsamen( 2, c2, 'LS' ) ) THEN
542 *
543 * LS: Least squares drivers
544 *
545  ntypes = 6
546  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
547 *
548  IF( tstdrv ) THEN
549  CALL zdrvls( dotype, nm, mval, nn, nval, nns, nsval, nnb,
550  $ ibval, nbval, nxval, thresh, tsterr, a( 1, 1 ),
551  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
552  $ s( 1 ), s( nmax+1 ), work, rwork, iwork,
553  $ nout )
554  ELSE
555  WRITE( nout, fmt = 9989 )path
556  END IF
557 *
558  ELSE
559 *
560  WRITE( nout, fmt = 9990 )path
561  END IF
562 *
563 * Go back to get another input line.
564 *
565  go to 80
566 *
567 * Branch to this line when the last record is read.
568 *
569  140 continue
570  CLOSE ( nin )
571 *
572 * Finalize PLASMA
573 *
574  CALL plasma_finalize( info )
575 * S2 = DSECND( )
576  WRITE( nout, fmt = 9998 )
577 * WRITE( NOUT, FMT = 9997 )S2 - S1
578 *
579  9999 format( / ' Execution not attempted due to input errors' )
580  9998 format( / ' End of tests' )
581  9997 format( ' Total time used = ', f12.2, ' seconds', / )
582  9996 format( ' Invalid input value: ', a4, '=', i6, '; must be >=',
583  $ i6 )
584  9995 format( ' Invalid input value: ', a4, '=', i6, '; must be <=',
585  $ i6 )
586  9994 format( ' Tests of the COMPLEX*16 PLASMA routines ',
587  $ / ' PLASMA VERSION ', i1, '.', i1, '.', i1,
588  $ / / ' The following parameter values will be used:' )
589  9993 format( 4x, a4, ': ', 10i6, / 11x, 10i6 )
590  9992 format( / ' Routines pass computational tests if test ratio is ',
591  $ 'less than', f8.2, / )
592  9991 format( ' Relative machine ', a, ' is taken to be', d16.6 )
593  9990 format( / 1x, a3, ': Unrecognized path name' )
594  9989 format( / 1x, a3, ' routines were not tested' )
595  9988 format( / 1x, a3, ' driver routines were not tested' )
596  9987 format( ' Invalid input value: ', a6, '=', i6, '; must be 0 or 1')
597 *
598 * End of ZCHKAA
599 *
600  END