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