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
cchkaa.f
Go to the documentation of this file.
1  PROGRAM cchkaa
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 * CCHKAA is the main test program for the COMPLEX 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 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 * CGE 11 List types on next line if 0 < NTYPES < 11
41 * CGB 8 List types on next line if 0 < NTYPES < 8
42 * CGT 12 List types on next line if 0 < NTYPES < 12
43 * CPO 9 List types on next line if 0 < NTYPES < 9
44 * CPO 9 List types on next line if 0 < NTYPES < 9
45 * CPP 9 List types on next line if 0 < NTYPES < 9
46 * CPB 8 List types on next line if 0 < NTYPES < 8
47 * CPT 12 List types on next line if 0 < NTYPES < 12
48 * CHE 10 List types on next line if 0 < NTYPES < 10
49 * CHP 10 List types on next line if 0 < NTYPES < 10
50 * CSY 11 List types on next line if 0 < NTYPES < 11
51 * CSP 11 List types on next line if 0 < NTYPES < 11
52 * CTR 18 List types on next line if 0 < NTYPES < 18
53 * CTP 18 List types on next line if 0 < NTYPES < 18
54 * CTB 17 List types on next line if 0 < NTYPES < 17
55 * CQR 8 List types on next line if 0 < NTYPES < 8
56 * CRQ 8 List types on next line if 0 < NTYPES < 8
57 * CLQ 8 List types on next line if 0 < NTYPES < 8
58 * CQL 8 List types on next line if 0 < NTYPES < 8
59 * CQP 6 List types on next line if 0 < NTYPES < 6
60 * CTZ 3 List types on next line if 0 < NTYPES < 3
61 * CLS 6 List types on next line if 0 < NTYPES < 6
62 * CEQ
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, ic, j, k, lda, nb, nm, nmats,
109  $ nn, nnb, nnb2, nns, nnp, sched, nrhs, ntypes,
110  $ vers_major, vers_minor, vers_patch, info
111  REAL eps, 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 )
120  REAL rwork( 150*nmax+2*maxrhs ), s( 2*nmax )
121  COMPLEX a( ( kdmax+1 )*nmax, 7 ), b( nmax*maxrhs, 4 ),
122  $ work( nmax, nmax+maxrhs+10 )
123 * ..
124 * .. External Functions ..
125  LOGICAL lsame, lsamen
126  REAL second, slamch
127  EXTERNAL lsame, lsamen, second, slamch
128 * ..
129 * .. External Subroutines ..
130  EXTERNAL alareq, cchkge,
131  $ cchklq, cchkpo,
132  $ cchkqr,
133  $ cdrvls,
134  $ cdrvpo,
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 / claenv / iparms
147  common / infoc / infot, nunit, ok, lerr
148  common / srnamc / srnamt
149 * ..
150 * .. Data statements ..
151  DATA threq / 2.0 / , intstr / '0123456789' /
152 * ..
153 * .. Executable Statements ..
154 *
155 * S1 = SECOND( )
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 = slamch( 'Underflow threshold' )
387  WRITE( nout, fmt = 9991 )'underflow', eps
388  eps = slamch( 'Overflow threshold' )
389  WRITE( nout, fmt = 9991 )'overflow ', eps
390  eps = slamch( 'Epsilon' )
391  WRITE( nout, fmt = 9991 )'precision', eps
392  WRITE( nout, fmt = * )
393  nrhs = nsval( 1 )
394 *
395 * Initialize PLASMA
396 *
397  CALL plasma_init( npval(nnp), info )
398 *
399  IF( sched .EQ. 1 ) THEN
400  CALL plasma_set(plasma_scheduling_mode,
401  $ plasma_dynamic_scheduling, info )
402  ELSE
403  CALL plasma_set(plasma_scheduling_mode,
404  $ plasma_static_scheduling, info )
405  ENDIF
406 *
407  CALL plasma_disable( plasma_autotuning, info )
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 )
420  $ go to 130
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 *
443 *
444 * Check first character for correct precision.
445 *
446  IF( .NOT.lsame( c1, 'Complex 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 cchkge( 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 cdrvge( 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 cchkpo( 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, nout )
492  ELSE
493  WRITE( nout, fmt = 9989 )path
494  END IF
495 *
496  IF( tstdrv ) THEN
497  CALL cdrvpo( 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, 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 cchkqr( 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 cchklq( 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 cdrvls( dotype, nm, mval, nn, nval, nns, nsval, nnb,
548  $ ibval, nbval, nxval, thresh, tsterr, a( 1, 1 ),
549  $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
550  $ s( 1 ), s( nmax+1 ), work, rwork, iwork,
551  $ nout )
552  ELSE
553  WRITE( nout, fmt = 9989 )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 *
574 * S2 = SECOND( )
575  WRITE( nout, fmt = 9998 )
576 * WRITE( NOUT, FMT = 9997 )S2 - S1
577 *
578  9999 format( / ' Execution not attempted due to input errors' )
579  9998 format( / ' End of tests' )
580 C 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
581  9996 format( ' Invalid input value: ', a4, '=', i6, '; must be >=',
582  $ i6 )
583  9995 format( ' Invalid input value: ', a4, '=', i6, '; must be <=',
584  $ i6 )
585  9994 format( ' Tests of the COMPLEX PLASMA routines ',
586  $ / ' PLASMA VERSION ', i1, '.', i1, '.', i1,
587  $ / / ' The following parameter values will be used:' )
588  9993 format( 4x, a4, ': ', 10i6, / 11x, 10i6 )
589  9992 format( / ' Routines pass computational tests if test ratio is ',
590  $ 'less than', f8.2, / )
591  9991 format( ' Relative machine ', a, ' is taken to be', e16.6 )
592  9990 format( / 1x, a3, ': Unrecognized path name' )
593  9989 format( / 1x, a3, ' routines were not tested' )
594  9988 format( / 1x, a3, ' driver routines were not tested' )
595  9987 format( ' Invalid input value: ', a6, '=', i6, '; must be 0 or 1')
596 *
597 * End of CCHKAA
598 *
599  END