161 INTEGER NMAX, NN, NNS, NOUT
166 INTEGER NSVAL( * ), NVAL( * )
168 COMPLEX AINVP( * ), AP( * ), B( * ), WORK( * ), X( * ),
175 INTEGER NTYPE1, NTYPES
176 parameter( ntype1 = 10, ntypes = 18 )
178 parameter( ntests = 9 )
180 parameter( ntran = 3 )
182 parameter( one = 1.0e+0, zero = 0.0e+0 )
185 CHARACTER DIAG, NORM, TRANS, UPLO, XTYPE
187 INTEGER I, IDIAG, IMAT, IN, INFO, IRHS, ITRAN, IUPLO,
188 $ K, LAP, LDA, N, NERRS, NFAIL, NRHS, NRUN
189 REAL AINVNM, ANORM, RCOND, RCONDC, RCONDI, RCONDO,
193 CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
194 INTEGER ISEED( 4 ), ISEEDY( 4 )
195 REAL RESULT( NTESTS )
211 INTEGER INFOT, IOUNIT
214 COMMON / infoc / infot, iounit, ok, lerr
215 COMMON / srnamc / srnamt
221 DATA iseedy / 1988, 1989, 1990, 1991 /
222 DATA uplos /
'U',
'L' / , transs /
'N',
'T',
'C' /
228 path( 1: 1 ) =
'Complex precision'
234 iseed( i ) = iseedy( i )
240 $
CALL cerrtr( path, nout )
249 lap = lda*( lda+1 ) / 2
252 DO 70 imat = 1, ntype1
256 IF( .NOT.dotype( imat ) )
263 uplo = uplos( iuplo )
268 CALL clattp( imat, uplo,
'No transpose', diag, iseed, n,
269 $ ap, x, work, rwork, info )
273 IF(
lsame( diag,
'N' ) )
THEN
283 $
CALL ccopy( lap, ap, 1, ainvp, 1 )
285 CALL ctptri( uplo, diag, n, ainvp, info )
290 $
CALL alaerh( path,
'CTPTRI', info, 0, uplo // diag, n,
291 $ n, -1, -1, -1, imat, nfail, nerrs, nout )
295 anorm =
clantp(
'I', uplo, diag, n, ap, rwork )
296 ainvnm =
clantp(
'I', uplo, diag, n, ainvp, rwork )
297 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
300 rcondi = ( one / anorm ) / ainvnm
306 CALL ctpt01( uplo, diag, n, ap, ainvp, rcondo, rwork,
311 IF( result( 1 ).GE.thresh )
THEN
312 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
313 $
CALL alahd( nout, path )
314 WRITE( nout, fmt = 9999 )uplo, diag, n, imat, 1,
324 DO 30 itran = 1, ntran
328 trans = transs( itran )
329 IF( itran.EQ.1 )
THEN
341 CALL clarhs( path, xtype, uplo, trans, n, n, 0,
342 $ idiag, nrhs, ap, lap, xact, lda, b,
345 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
348 CALL ctptrs( uplo, trans, diag, n, nrhs, ap, x,
354 $
CALL alaerh( path,
'CTPTRS', info, 0,
355 $ uplo // trans // diag, n, n, -1,
356 $ -1, -1, imat, nfail, nerrs, nout )
358 CALL ctpt02( uplo, trans, diag, n, nrhs, ap, x,
359 $ lda, b, lda, work, rwork,
365 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
373 CALL ctprfs( uplo, trans, diag, n, nrhs, ap, b,
374 $ lda, x, lda, rwork, rwork( nrhs+1 ),
375 $ work, rwork( 2*nrhs+1 ), info )
380 $
CALL alaerh( path,
'CTPRFS', info, 0,
381 $ uplo // trans // diag, n, n, -1,
382 $ -1, nrhs, imat, nfail, nerrs,
385 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
387 CALL ctpt05( uplo, trans, diag, n, nrhs, ap, b,
388 $ lda, x, lda, xact, lda, rwork,
389 $ rwork( nrhs+1 ), result( 5 ) )
395 IF( result( k ).GE.thresh )
THEN
396 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
397 $
CALL alahd( nout, path )
398 WRITE( nout, fmt = 9998 )uplo, trans, diag,
399 $ n, nrhs, imat, k, result( k )
411 IF( itran.EQ.1 )
THEN
419 CALL ctpcon( norm, uplo, diag, n, ap, rcond, work,
425 $
CALL alaerh( path,
'CTPCON', info, 0,
426 $ norm // uplo // diag, n, n, -1, -1,
427 $ -1, imat, nfail, nerrs, nout )
429 CALL ctpt06( rcond, rcondc, uplo, diag, n, ap, rwork,
434 IF( result( 7 ).GE.thresh )
THEN
435 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
436 $
CALL alahd( nout, path )
437 WRITE( nout, fmt = 9997 )
'CTPCON', norm, uplo,
438 $ diag, n, imat, 7, result( 7 )
448 DO 100 imat = ntype1 + 1, ntypes
452 IF( .NOT.dotype( imat ) )
459 uplo = uplos( iuplo )
460 DO 80 itran = 1, ntran
464 trans = transs( itran )
469 CALL clattp( imat, uplo, trans, diag, iseed, n, ap, x,
470 $ work, rwork, info )
476 CALL ccopy( n, x, 1, b, 1 )
477 CALL clatps( uplo, trans, diag,
'N', n, ap, b, scale,
483 $
CALL alaerh( path,
'CLATPS', info, 0,
484 $ uplo // trans // diag //
'N', n, n,
485 $ -1, -1, -1, imat, nfail, nerrs, nout )
487 CALL ctpt03( uplo, trans, diag, n, 1, ap, scale,
488 $ rwork, one, b, lda, x, lda, work,
494 CALL ccopy( n, x, 1, b( n+1 ), 1 )
495 CALL clatps( uplo, trans, diag,
'Y', n, ap, b( n+1 ),
496 $ scale, rwork, info )
501 $
CALL alaerh( path,
'CLATPS', info, 0,
502 $ uplo // trans // diag //
'Y', n, n,
503 $ -1, -1, -1, imat, nfail, nerrs, nout )
505 CALL ctpt03( uplo, trans, diag, n, 1, ap, scale,
506 $ rwork, one, b( n+1 ), lda, x, lda, work,
512 IF( result( 8 ).GE.thresh )
THEN
513 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
514 $
CALL alahd( nout, path )
515 WRITE( nout, fmt = 9996 )
'CLATPS', uplo, trans,
516 $ diag,
'N', n, imat, 8, result( 8 )
519 IF( result( 9 ).GE.thresh )
THEN
520 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
521 $
CALL alahd( nout, path )
522 WRITE( nout, fmt = 9996 )
'CLATPS', uplo, trans,
523 $ diag,
'Y', n, imat, 9, result( 9 )
534 CALL alasum( path, nout, nfail, nrun, nerrs )
536 9999
FORMAT(
' UPLO=''', a1,
''', DIAG=''', a1,
''', N=', i5,
537 $
', type ', i2,
', test(', i2,
')= ', g12.5 )
538 9998
FORMAT(
' UPLO=''', a1,
''', TRANS=''', a1,
''', DIAG=''', a1,
539 $
''', N=', i5,
''', NRHS=', i5,
', type ', i2,
', test(',
541 9997
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ''', a1,
''',',
542 $ i5,
', ... ), type ', i2,
', test(', i2,
')=', g12.5 )
543 9996
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ''', a1,
''', ''',
544 $ a1,
''',', i5,
', ... ), type ', i2,
', test(', i2,
')=',