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
dchkaa.f
Go to the documentation of this file.
1  PROGRAM dchkaa
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 * DCHKAA is the main test program for the DOUBLE PRECISION PLASMA
13 * linear equation 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 36 lines:
21 * Data file for testing DOUBLE PRECISION PLASMA linear eqn. 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 2 5 10 10 Values of IB (the inner block size)
34 * 1 0 5 9 1 Values of NX (crossover point)
35 * 3 Number of values of RANK
36 * 30 50 90 Values of rank (as a % of N)
37 * 20.0 Threshold value of test ratio
38 * T Put T to test the PLASMA routines
39 * T Put T to test the driver routines
40 * T Put T to test the error exits
41 * DGE 11 List types on next line if 0 < NTYPES < 11
42 * DGB 8 List types on next line if 0 < NTYPES < 8
43 * DGT 12 List types on next line if 0 < NTYPES < 12
44 * DPO 9 List types on next line if 0 < NTYPES < 9
45 * DPS 9 List types on next line if 0 < NTYPES < 9
46 * DPP 9 List types on next line if 0 < NTYPES < 9
47 * DPB 8 List types on next line if 0 < NTYPES < 8
48 * DPT 12 List types on next line if 0 < NTYPES < 12
49 * DSY 10 List types on next line if 0 < NTYPES < 10
50 * DSP 10 List types on next line if 0 < NTYPES < 10
51 * DTR 18 List types on next line if 0 < NTYPES < 18
52 * DTP 18 List types on next line if 0 < NTYPES < 18
53 * DTB 17 List types on next line if 0 < NTYPES < 17
54 * DQR 8 List types on next line if 0 < NTYPES < 8
55 * DRQ 8 List types on next line if 0 < NTYPES < 8
56 * DLQ 8 List types on next line if 0 < NTYPES < 8
57 * DQL 8 List types on next line if 0 < NTYPES < 8
58 * DQP 6 List types on next line if 0 < NTYPES < 6
59 * DTZ 3 List types on next line if 0 < NTYPES < 3
60 * DLS 6 List types on next line if 0 < NTYPES < 6
61 * DEQ
62 *
63 * Internal Parameters
64 * ===================
65 *
66 * NMAX INTEGER
67 * The maximum allowable value for N
68 *
69 * MAXIN INTEGER
70 * The number of different values that can be used for each of
71 * M, N, NRHS, NB, and NX
72 *
73 * MAXRHS INTEGER
74 * The maximum number of right hand sides
75 *
76 * NIN INTEGER
77 * The unit number for input
78 *
79 * NOUT INTEGER
80 * The unit number for output
81 *
82 * =====================================================================
83 *
84 * .. Parameters ..
85  INTEGER npmax
86  parameter( npmax = 16 )
87  INTEGER nmax
88  parameter( nmax = 1000 )
89  INTEGER maxin
90  parameter( maxin = 12 )
91  INTEGER maxrhs
92  parameter( maxrhs = 16 )
93  INTEGER matmax
94  parameter( matmax = 30 )
95  INTEGER nin, nout
96  parameter( nin = 5, nout = 6 )
97  INTEGER kdmax
98  parameter( kdmax = nmax+( nmax+1 ) / 4 )
99 * ..
100 * .. Local Scalars ..
101  LOGICAL fatal, tstchk, tstdrv, tsterr
102  CHARACTER c1
103  CHARACTER*2 c2
104  CHARACTER*3 path
105  CHARACTER*10 intstr
106  CHARACTER*72 aline
107  INTEGER i, ib, ic, j, k, la, lafac, lda, nb, nm, nmats,
108  $ nn, nnb, nnb2, nnp, nns, np, sched, nrhs,
109  $ ntypes, nrank, vers_major, vers_minor,
110  $ vers_patch, info
111  DOUBLE PRECISION eps, s1, s2, threq, thresh
112 * ..
113 * .. Local Arrays ..
114  LOGICAL dotype( matmax )
115  INTEGER ibval(maxin), iwork( 25*nmax ), mval( maxin ),
116  $ nbval( maxin ), nbval2( maxin ),
117  $ npval( maxin), nsval( maxin ),
118  $ nval( maxin ), nxval( maxin ),
119  $ rankval( maxin ), piv( nmax )
120  DOUBLE PRECISION a( ( kdmax+1 )*nmax, 7 ), b( nmax*maxrhs, 4 ),
121  $ rwork( 5*nmax+2*maxrhs ), s( 2*nmax ),
122  $ work( nmax, nmax+maxrhs+30 )
123 * ..
124 * .. External Functions ..
125  LOGICAL lsame, lsamen
126  DOUBLE PRECISION dlamch, dsecnd
127  EXTERNAL lsame, lsamen, dlamch, dsecnd
128 * ..
129 * .. External Subroutines ..
130  EXTERNAL alareq, dchkge, dchklq,
131  $ dchkpo,
132  $ dchkqr,
133  $ ddrvge,
134  $ ddrvls, ddrvpo,
135  $ ilaver
136 * ..
137 * .. Scalars in Common ..
138  LOGICAL lerr, ok
139  CHARACTER*32 srnamt
140  INTEGER infot, nunit
141 * ..
142 * .. Arrays in Common ..
143  INTEGER iparms( 100 )
144 * ..
145 * .. Common blocks ..
146  common / infoc / infot, nunit, ok, lerr
147  common / srnamc / srnamt
148  common / claenv / iparms
149 * ..
150 * .. Data statements ..
151  DATA threq / 2.0d0 / , intstr / '0123456789' /
152 * ..
153 * .. Executable Statements ..
154 *
155 * S1 = DSECND( )
156  lda = nmax
157  fatal = .false.
158 *
159 * Report values of parameters version.
160 *
161  CALL plasma_version( vers_major, vers_minor, vers_patch, info)
162  WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
163 *
164 * Read a dummy line.
165 *
166  READ( nin, fmt = * )
167 *
168 * Read the values of NP
169 *
170  READ( nin, fmt = * )nnp
171  IF( nnp.LT.1 ) THEN
172  WRITE( nout, fmt = 9996 )' NNP ', nnp, 1
173  nnp = 0
174  fatal = .true.
175  ELSE IF( nnp.GT.maxin ) THEN
176  WRITE( nout, fmt = 9995 )' NNP ', nnp, maxin
177  nnp = 0
178  fatal = .true.
179  END IF
180  READ( nin, fmt = * )( npval( i ), i = 1, nnp )
181  DO 01 i = 1, nnp
182  IF( npval( i ).LT.0 ) THEN
183  WRITE( nout, fmt = 9996 )' NP ', npval( i ), 0
184  fatal = .true.
185  ELSE IF( npval( i ).GT.npmax ) THEN
186  WRITE( nout, fmt = 9995 )' NP ', npval( i ), npmax
187  fatal = .true.
188  END IF
189  01 continue
190  IF( nnp.GT.0 )
191  $ WRITE( nout, fmt = 9993 )'NP ', ( npval( i ), i = 1, nnp )
192 *
193 * Read the values of SCHED
194 *
195  READ( nin, fmt = * )sched
196  IF (( sched .LT. 0 ) .OR. (sched .GT. 1)) THEN
197  WRITE( nout, fmt = 9987 )' SCHED ', sched
198  sched = 0
199  fatal = .true.
200  END IF
201 *
202 * Read the values of M
203 *
204  READ( nin, fmt = * )nm
205  IF( nm.LT.1 ) THEN
206  WRITE( nout, fmt = 9996 )' NM ', nm, 1
207  nm = 0
208  fatal = .true.
209  ELSE IF( nm.GT.maxin ) THEN
210  WRITE( nout, fmt = 9995 )' NM ', nm, maxin
211  nm = 0
212  fatal = .true.
213  END IF
214  READ( nin, fmt = * )( mval( i ), i = 1, nm )
215  DO 10 i = 1, nm
216  IF( mval( i ).LT.0 ) THEN
217  WRITE( nout, fmt = 9996 )' M ', mval( i ), 0
218  fatal = .true.
219  ELSE IF( mval( i ).GT.nmax ) THEN
220  WRITE( nout, fmt = 9995 )' M ', mval( i ), nmax
221  fatal = .true.
222  END IF
223  10 continue
224  IF( nm.GT.0 )
225  $ WRITE( nout, fmt = 9993 )'M ', ( mval( i ), i = 1, nm )
226 *
227 * Read the values of N
228 *
229  READ( nin, fmt = * )nn
230  IF( nn.LT.1 ) THEN
231  WRITE( nout, fmt = 9996 )' NN ', nn, 1
232  nn = 0
233  fatal = .true.
234  ELSE IF( nn.GT.maxin ) THEN
235  WRITE( nout, fmt = 9995 )' NN ', nn, maxin
236  nn = 0
237  fatal = .true.
238  END IF
239  READ( nin, fmt = * )( nval( i ), i = 1, nn )
240  DO 20 i = 1, nn
241  IF( nval( i ).LT.0 ) THEN
242  WRITE( nout, fmt = 9996 )' N ', nval( i ), 0
243  fatal = .true.
244  ELSE IF( nval( i ).GT.nmax ) THEN
245  WRITE( nout, fmt = 9995 )' N ', nval( i ), nmax
246  fatal = .true.
247  END IF
248  20 continue
249  IF( nn.GT.0 )
250  $ WRITE( nout, fmt = 9993 )'N ', ( nval( i ), i = 1, nn )
251 *
252 * Read the values of NRHS
253 *
254  READ( nin, fmt = * )nns
255  IF( nns.LT.1 ) THEN
256  WRITE( nout, fmt = 9996 )' NNS', nns, 1
257  nns = 0
258  fatal = .true.
259  ELSE IF( nns.GT.maxin ) THEN
260  WRITE( nout, fmt = 9995 )' NNS', nns, maxin
261  nns = 0
262  fatal = .true.
263  END IF
264  READ( nin, fmt = * )( nsval( i ), i = 1, nns )
265  DO 30 i = 1, nns
266  IF( nsval( i ).LT.0 ) THEN
267  WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
268  fatal = .true.
269  ELSE IF( nsval( i ).GT.maxrhs ) THEN
270  WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
271  fatal = .true.
272  END IF
273  30 continue
274  IF( nns.GT.0 )
275  $ WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
276 *
277 * Read the values of NB
278 *
279  READ( nin, fmt = * )nnb
280  IF( nnb.LT.1 ) THEN
281  WRITE( nout, fmt = 9996 )'NNB ', nnb, 1
282  nnb = 0
283  fatal = .true.
284  ELSE IF( nnb.GT.maxin ) THEN
285  WRITE( nout, fmt = 9995 )'NNB ', nnb, maxin
286  nnb = 0
287  fatal = .true.
288  END IF
289  READ( nin, fmt = * )( nbval( i ), i = 1, nnb )
290  DO 40 i = 1, nnb
291  IF( nbval( i ).LT.0 ) THEN
292  WRITE( nout, fmt = 9996 )' NB ', nbval( i ), 0
293  fatal = .true.
294  END IF
295  40 continue
296  IF( nnb.GT.0 )
297  $ WRITE( nout, fmt = 9993 )'NB ', ( nbval( i ), i = 1, nnb )
298 *
299 * Read the values of IB
300 *
301  READ( nin, fmt = * )( ibval( i ), i = 1, nnb )
302  DO 41 i = 1, nnb
303  IF( ibval( i ).LT.0 ) THEN
304  WRITE( nout, fmt = 9996 )' NB ', ibval( i ), 0
305  fatal = .true.
306  END IF
307  41 continue
308  IF( nnb.GT.0 )
309  $ WRITE( nout, fmt = 9993 )'IB ', ( ibval( i ), i = 1, nnb )
310 *
311 * Set NBVAL2 to be the set of unique values of NB
312 *
313  nnb2 = 0
314  DO 60 i = 1, nnb
315  nb = nbval( i )
316  DO 50 j = 1, nnb2
317  IF( nb.EQ.nbval2( j ) )
318  $ go to 60
319  50 continue
320  nnb2 = nnb2 + 1
321  nbval2( nnb2 ) = nb
322  60 continue
323 *
324 * Read the values of NX
325 *
326  READ( nin, fmt = * )( nxval( i ), i = 1, nnb )
327  DO 70 i = 1, nnb
328  IF( nxval( i ).LT.0 ) THEN
329  WRITE( nout, fmt = 9996 )' NX ', nxval( i ), 0
330  fatal = .true.
331  END IF
332  70 continue
333  IF( nnb.GT.0 )
334  $ WRITE( nout, fmt = 9993 )'NX ', ( nxval( i ), i = 1, nnb )
335 *
336 * Read the values of RANKVAL
337 *
338  READ( nin, fmt = * )nrank
339  IF( nn.LT.1 ) THEN
340  WRITE( nout, fmt = 9996 )' NRANK ', nrank, 1
341  nrank = 0
342  fatal = .true.
343  ELSE IF( nn.GT.maxin ) THEN
344  WRITE( nout, fmt = 9995 )' NRANK ', nrank, maxin
345  nrank = 0
346  fatal = .true.
347  END IF
348  READ( nin, fmt = * )( rankval( i ), i = 1, nrank )
349  DO i = 1, nrank
350  IF( rankval( i ).LT.0 ) THEN
351  WRITE( nout, fmt = 9996 )' RANK ', rankval( i ), 0
352  fatal = .true.
353  ELSE IF( rankval( i ).GT.100 ) THEN
354  WRITE( nout, fmt = 9995 )' RANK ', rankval( i ), 100
355  fatal = .true.
356  END IF
357  END DO
358  IF( nrank.GT.0 )
359  $ WRITE( nout, fmt = 9993 )'RANK % OF N',
360  $ ( rankval( i ), i = 1, nrank )
361 *
362 * Read the threshold value for the test ratios.
363 *
364  READ( nin, fmt = * )thresh
365  WRITE( nout, fmt = 9992 )thresh
366 *
367 * Read the flag that indicates whether to test the PLASMA routines.
368 *
369  READ( nin, fmt = * )tstchk
370 *
371 * Read the flag that indicates whether to test the driver routines.
372 *
373  READ( nin, fmt = * )tstdrv
374 *
375 * Read the flag that indicates whether to test the error exits.
376 *
377  READ( nin, fmt = * )tsterr
378 *
379  IF( fatal ) THEN
380  WRITE( nout, fmt = 9999 )
381  stop
382  END IF
383 *
384 * Calculate and print the machine dependent constants.
385 *
386  eps = dlamch( 'Underflow threshold' )
387  WRITE( nout, fmt = 9991 )'underflow', eps
388  eps = dlamch( 'Overflow threshold' )
389  WRITE( nout, fmt = 9991 )'overflow ', eps
390  eps = dlamch( 'Epsilon' )
391  WRITE( nout, fmt = 9991 )'precision', eps
392  WRITE( nout, fmt = * )
393 *
394 * Initialize PLASMA
395 *
396  CALL plasma_init( npval(nnp), info )
397 *
398  IF( sched .EQ. 1 ) THEN
399  CALL plasma_set(plasma_scheduling_mode,
400  $ plasma_dynamic_scheduling, info )
401  ELSE
402  CALL plasma_set(plasma_scheduling_mode,
403  $ plasma_static_scheduling, info )
404  ENDIF
405 *
406  CALL plasma_disable( plasma_autotuning, info )
407 *
408 *
409  80 continue
410 *
411 * Read a test path and the number of matrix types to use.
412 *
413  READ( nin, fmt = '(A72)', END = 140 )aline
414  path = aline( 1: 3 )
415  nmats = matmax
416  i = 3
417  90 continue
418  i = i + 1
419  IF( i.GT.72 ) THEN
420  nmats = matmax
421  go to 130
422  END IF
423  IF( aline( i: i ).EQ.' ' )
424  $ go to 90
425  nmats = 0
426  100 continue
427  c1 = aline( i: i )
428  DO 110 k = 1, 10
429  IF( c1.EQ.intstr( k: k ) ) THEN
430  ic = k - 1
431  go to 120
432  END IF
433  110 continue
434  go to 130
435  120 continue
436  nmats = nmats*10 + ic
437  i = i + 1
438  IF( i.GT.72 )
439  $ go to 130
440  go to 100
441  130 continue
442  c1 = path( 1: 1 )
443  c2 = path( 2: 3 )
444  nrhs = nsval( 1 )
445 *
446 * Check first character for correct precision.
447 *
448  IF( .NOT.lsame( c1, 'Double 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 dchkge( 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 ddrvge( 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 dchkpo( 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, iwork, nout )
494  ELSE
495  WRITE( nout, fmt = 9989 )path
496  END IF
497 *
498  IF( tstdrv ) THEN
499  CALL ddrvpo( 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, iwork, 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 dchkqr( 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 dchklq( 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 ddrvls( dotype, nm, mval, nn, nval, nns, nsval, nnb,
550  $ nbval, nxval, thresh, tsterr, a( 1, 1 ),
551  $ a( 1, 2 ), b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
552  $ rwork, rwork( nmax+1 ), ibval, work, iwork,
553  $ nout )
554  ELSE
555  WRITE( nout, fmt = 9988 )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 *
576 * S2 = DSECND( )
577  WRITE( nout, fmt = 9998 )
578 * WRITE( NOUT, FMT = 9997 )S2 - S1
579 *
580  9999 format( / ' Execution not attempted due to input errors' )
581  9998 format( / ' End of tests' )
582  9997 format( ' Total time used = ', f12.2, ' seconds', / )
583  9996 format( ' Invalid input value: ', a4, '=', i6, '; must be >=',
584  $ i6 )
585  9995 format( ' Invalid input value: ', a4, '=', i6, '; must be <=',
586  $ i6 )
587  9994 format( ' Tests of the DOUBLE PRECISION PLASMA routines ',
588  $ / ' PLASMA VERSION ', i1, '.', i1, '.', i1,
589  $ / / ' The following parameter values will be used:' )
590  9993 format( 4x, a4, ': ', 10i6, / 11x, 10i6 )
591  9992 format( / ' Routines pass computational tests if test ratio is ',
592  $ 'less than', f8.2, / )
593  9991 format( ' Relative machine ', a, ' is taken to be', d16.6 )
594  9990 format( / 1x, a3, ': Unrecognized path name' )
595  9989 format( / 1x, a3, ' routines were not tested' )
596  9988 format( / 1x, a3, ' driver routines were not tested' )
597  9987 format( ' Invalid input value: ', a6, '=', i6, '; must be 0 or 1')
598 *
599 * End of DCHKAA
600 *
601  END