87 parameter( npmax = 16 )
89 parameter( nmax = 1000 )
91 parameter( maxin = 12 )
93 parameter( maxrhs = 16 )
95 parameter( matmax = 30 )
97 parameter( nin = 5, nout = 6 )
99 parameter( kdmax = nmax+( nmax+1 ) / 4 )
102 LOGICAL fatal, tstchk, tstdrv, tsterr
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
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 ),
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 )
127 EXTERNAL lsame,
lsamen, second, slamch
143 INTEGER iparms( 100 )
146 common / claenv / iparms
147 common / infoc / infot, nunit, ok, lerr
148 common / srnamc / srnamt
151 DATA threq / 2.0 / , intstr /
'0123456789' /
161 CALL plasma_version( vers_major, vers_minor, vers_patch, info)
162 WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
170 READ( nin, fmt = * )nnp
172 WRITE( nout, fmt = 9996 )
' NNP ', nnp, 1
175 ELSE IF( nnp.GT.maxin )
THEN
176 WRITE( nout, fmt = 9995 )
' NNP ', nnp, maxin
180 READ( nin, fmt = * )( npval( i ), i = 1, nnp )
182 IF( npval( i ).LT.0 )
THEN
183 WRITE( nout, fmt = 9996 )
' NP ', npval( i ), 0
185 ELSE IF( npval( i ).GT.npmax )
THEN
186 WRITE( nout, fmt = 9995 )
' NP ', npval( i ), npmax
191 $
WRITE( nout, fmt = 9993 )
'NP ', ( npval( i ), i = 1, nnp )
195 READ( nin, fmt = * )sched
196 IF (( sched .LT. 0 ) .OR. (sched .GT. 1))
THEN
197 WRITE( nout, fmt = 9987 )
' SCHED ', sched
204 READ( nin, fmt = * )nm
206 WRITE( nout, fmt = 9996 )
' NM ', nm, 1
209 ELSE IF( nm.GT.maxin )
THEN
210 WRITE( nout, fmt = 9995 )
' NM ', nm, maxin
214 READ( nin, fmt = * )( mval( i ), i = 1, nm )
216 IF( mval( i ).LT.0 )
THEN
217 WRITE( nout, fmt = 9996 )
' M ', mval( i ), 0
219 ELSE IF( mval( i ).GT.nmax )
THEN
220 WRITE( nout, fmt = 9995 )
' M ', mval( i ), nmax
225 $
WRITE( nout, fmt = 9993 )
'M ', ( mval( i ), i = 1, nm )
229 READ( nin, fmt = * )nn
231 WRITE( nout, fmt = 9996 )
' NN ', nn, 1
234 ELSE IF( nn.GT.maxin )
THEN
235 WRITE( nout, fmt = 9995 )
' NN ', nn, maxin
239 READ( nin, fmt = * )( nval( i ), i = 1, nn )
241 IF( nval( i ).LT.0 )
THEN
242 WRITE( nout, fmt = 9996 )
' N ', nval( i ), 0
244 ELSE IF( nval( i ).GT.nmax )
THEN
245 WRITE( nout, fmt = 9995 )
' N ', nval( i ), nmax
250 $
WRITE( nout, fmt = 9993 )
'N ', ( nval( i ), i = 1, nn )
254 READ( nin, fmt = * )nns
256 WRITE( nout, fmt = 9996 )
' NNS', nns, 1
259 ELSE IF( nns.GT.maxin )
THEN
260 WRITE( nout, fmt = 9995 )
' NNS', nns, maxin
264 READ( nin, fmt = * )( nsval( i ), i = 1, nns )
266 IF( nsval( i ).LT.0 )
THEN
267 WRITE( nout, fmt = 9996 )
'NRHS', nsval( i ), 0
269 ELSE IF( nsval( i ).GT.maxrhs )
THEN
270 WRITE( nout, fmt = 9995 )
'NRHS', nsval( i ), maxrhs
275 $
WRITE( nout, fmt = 9993 )
'NRHS', ( nsval( i ), i = 1, nns )
279 READ( nin, fmt = * )nnb
281 WRITE( nout, fmt = 9996 )
'NNB ', nnb, 1
284 ELSE IF( nnb.GT.maxin )
THEN
285 WRITE( nout, fmt = 9995 )
'NNB ', nnb, maxin
289 READ( nin, fmt = * )( nbval( i ), i = 1, nnb )
291 IF( nbval( i ).LT.0 )
THEN
292 WRITE( nout, fmt = 9996 )
' NB ', nbval( i ), 0
297 $
WRITE( nout, fmt = 9993 )
'NB ', ( nbval( i ), i = 1, nnb )
301 READ( nin, fmt = * )( ibval( i ), i = 1, nnb )
303 IF( ibval( i ).LT.0 )
THEN
304 WRITE( nout, fmt = 9996 )
' NB ', ibval( i ), 0
309 $
WRITE( nout, fmt = 9993 )
'IB ', ( ibval( i ), i = 1, nnb )
317 IF( nb.EQ.nbval2( j ) )
326 READ( nin, fmt = * )( nxval( i ), i = 1, nnb )
328 IF( nxval( i ).LT.0 )
THEN
329 WRITE( nout, fmt = 9996 )
' NX ', nxval( i ), 0
334 $
WRITE( nout, fmt = 9993 )
'NX ', ( nxval( i ), i = 1, nnb )
338 READ( nin, fmt = * )nrank
340 WRITE( nout, fmt = 9996 )
' NRANK ', nrank, 1
343 ELSE IF( nn.GT.maxin )
THEN
344 WRITE( nout, fmt = 9995 )
' NRANK ', nrank, maxin
348 READ( nin, fmt = * )( rankval( i ), i = 1, nrank )
350 IF( rankval( i ).LT.0 )
THEN
351 WRITE( nout, fmt = 9996 )
' RANK ', rankval( i ), 0
353 ELSE IF( rankval( i ).GT.100 )
THEN
354 WRITE( nout, fmt = 9995 )
' RANK ', rankval( i ), 100
359 $
WRITE( nout, fmt = 9993 )
'RANK % OF N',
360 $ ( rankval( i ), i = 1, nrank )
364 READ( nin, fmt = * )thresh
365 WRITE( nout, fmt = 9992 )thresh
369 READ( nin, fmt = * )tstchk
373 READ( nin, fmt = * )tstdrv
377 READ( nin, fmt = * )tsterr
380 WRITE( nout, fmt = 9999 )
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 = * )
399 IF( sched .EQ. 1 )
THEN
401 $ plasma_dynamic_scheduling, info )
404 $ plasma_static_scheduling, info )
413 READ( nin, fmt =
'(A72)',
END = 140 )aline
421 IF( aline( i: i ).EQ.
' ' )
427 IF( c1.EQ.intstr( k: k ) )
THEN
434 nmats = nmats*10 + ic
446 IF( .NOT.lsame( c1,
'Complex precision' ) )
THEN
447 WRITE( nout, fmt = 9990 )path
449 ELSE IF( nmats.LE.0 )
THEN
453 WRITE( nout, fmt = 9989 )path
455 ELSE IF(
lsamen( 2, c2,
'GE' ) )
THEN
460 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
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 )
468 WRITE( nout, fmt = 9989 )path
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 )
477 WRITE( nout, fmt = 9988 )path
480 ELSE IF(
lsamen( 2, c2,
'PO' ) )
THEN
485 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
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 )
493 WRITE( nout, fmt = 9989 )path
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,
502 WRITE( nout, fmt = 9988 )path
505 ELSE IF(
lsamen( 2, c2,
'QR' ) )
THEN
510 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
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 )
519 WRITE( nout, fmt = 9989 )path
522 ELSE IF(
lsamen( 2, c2,
'LQ' ) )
THEN
527 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
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 )
536 WRITE( nout, fmt = 9989 )path
539 ELSE IF(
lsamen( 2, c2,
'LS' ) )
THEN
544 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
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,
553 WRITE( nout, fmt = 9989 )path
558 WRITE( nout, fmt = 9990 )path
575 WRITE( nout, fmt = 9998 )
578 9999
format( /
' Execution not attempted due to input errors' )
579 9998
format( /
' End of tests' )
581 9996
format(
' Invalid input value: ', a4,
'=', i6,
'; must be >=',
583 9995
format(
' Invalid input value: ', a4,
'=', i6,
'; must be <=',
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')