240 SUBROUTINE cdrvrfp( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL,
241 + thresh, a, asav, afac, ainv, b,
242 + bsav, xact, x, arf, arfinv,
243 + c_work_clatms, c_work_cpot02,
244 + c_work_cpot03, s_work_clatms, s_work_clanhe,
245 + s_work_cpot01, s_work_cpot02, s_work_cpot03 )
253 INTEGER NN, NNS, NNT, NOUT
257 INTEGER NVAL( nn ), NSVAL( nns ), NTVAL( nnt )
268 COMPLEX C_WORK_CLATMS( * )
269 COMPLEX C_WORK_CPOT02( * )
270 COMPLEX C_WORK_CPOT03( * )
271 REAL S_WORK_CLATMS( * )
272 REAL S_WORK_CLANHE( * )
273 REAL S_WORK_CPOT01( * )
274 REAL S_WORK_CPOT02( * )
275 REAL S_WORK_CPOT03( * )
282 parameter ( one = 1.0e+0, zero = 0.0e+0 )
284 parameter ( ntests = 4 )
288 INTEGER I, INFO, IUPLO, LDA, LDB, IMAT, NERRS, NFAIL,
289 + nrhs, nrun, izero, ioff, k, nt, n, iform, iin,
291 CHARACTER DIST, CTYPE, UPLO, CFORM
293 REAL ANORM, AINVNM, CNDNUM, RCONDC
296 CHARACTER UPLOS( 2 ), FORMS( 2 )
297 INTEGER ISEED( 4 ), ISEEDY( 4 )
298 REAL RESULT( ntests )
314 COMMON / srnamc / srnamt
317 DATA iseedy / 1988, 1989, 1990, 1991 /
318 DATA uplos /
'U',
'L' /
319 DATA forms /
'N',
'C' /
329 iseed( i ) = iseedy( i )
348 IF( n.EQ.0 .AND. iit.GE.1 )
GO TO 120
352 IF( imat.EQ.4 .AND. n.LE.1 )
GO TO 120
353 IF( imat.EQ.5 .AND. n.LE.2 )
GO TO 120
358 uplo = uplos( iuplo )
363 cform = forms( iform )
368 CALL clatb4(
'CPO', imat, n, n, ctype, kl, ku,
369 + anorm, mode, cndnum, dist )
372 CALL clatms( n, n, dist, iseed, ctype,
374 + mode, cndnum, anorm, kl, ku, uplo, a,
375 + lda, c_work_clatms, info )
380 CALL alaerh(
'CPF',
'CLATMS', info, 0, uplo, n,
381 + n, -1, -1, -1, iit, nfail, nerrs,
389 zerot = imat.GE.3 .AND. imat.LE.5
393 ELSE IF( iit.EQ.4 )
THEN
398 ioff = ( izero-1 )*lda
402 IF( iuplo.EQ.1 )
THEN
403 DO 20 i = 1, izero - 1
413 DO 40 i = 1, izero - 1
428 CALL claipd( n, a, lda+1, 0 )
432 CALL clacpy( uplo, n, n, a, lda, asav, lda )
442 anorm = clanhe(
'1', uplo, n, a, lda,
447 CALL cpotrf( uplo, n, a, lda, info )
451 CALL cpotri( uplo, n, a, lda, info )
456 ainvnm = clanhe(
'1', uplo, n, a, lda,
458 rcondc = ( one / anorm ) / ainvnm
462 CALL clacpy( uplo, n, n, asav, lda, a, lda )
471 CALL clarhs(
'CPO',
'N', uplo,
' ', n, n, kl, ku,
472 + nrhs, a, lda, xact, lda, b, lda,
474 CALL clacpy(
'Full', n, nrhs, b, lda, bsav, lda )
479 CALL clacpy( uplo, n, n, a, lda, afac, lda )
480 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldb )
483 CALL ctrttf( cform, uplo, n, afac, lda, arf, info )
485 CALL cpftrf( cform, uplo, n, arf, info )
489 IF( info.NE.izero )
THEN
495 CALL alaerh(
'CPF',
'CPFSV ', info, izero,
496 + uplo, n, n, -1, -1, nrhs, iit,
497 + nfail, nerrs, nout )
508 CALL cpftrs( cform, uplo, n, nrhs, arf, x, ldb,
512 CALL ctfttr( cform, uplo, n, arf, afac, lda, info )
517 CALL clacpy( uplo, n, n, afac, lda, asav, lda )
518 CALL cpot01( uplo, n, a, lda, afac, lda,
519 + s_work_cpot01, result( 1 ) )
520 CALL clacpy( uplo, n, n, asav, lda, afac, lda )
524 IF(mod(n,2).EQ.0)
THEN
525 CALL clacpy(
'A', n+1, n/2, arf, n+1, arfinv,
528 CALL clacpy(
'A', n, (n+1)/2, arf, n, arfinv,
533 CALL cpftri( cform, uplo, n, arfinv , info )
536 CALL ctfttr( cform, uplo, n, arfinv, ainv, lda,
542 +
CALL alaerh(
'CPO',
'CPFTRI', info, 0, uplo, n,
543 + n, -1, -1, -1, imat, nfail, nerrs,
546 CALL cpot03( uplo, n, a, lda, ainv, lda,
547 + c_work_cpot03, lda, s_work_cpot03,
548 + rcondc, result( 2 ) )
552 CALL clacpy(
'Full', n, nrhs, b, lda,
553 + c_work_cpot02, lda )
554 CALL cpot02( uplo, n, nrhs, a, lda, x, lda,
555 + c_work_cpot02, lda, s_work_cpot02,
560 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
568 IF( result( k ).GE.thresh )
THEN
569 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
570 +
CALL aladhd( nout,
'CPF' )
571 WRITE( nout, fmt = 9999 )
'CPFSV ', uplo,
572 + n, iit, k, result( k )
585 CALL alasvm(
'CPF', nout, nfail, nrun, nerrs )
587 9999
FORMAT( 1x, a6,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
588 +
', test(', i1,
')=', g12.5 )
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cpotri(UPLO, N, A, LDA, INFO)
CPOTRI
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
subroutine cpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
CPOT01
subroutine cpftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
CPFTRS
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
subroutine ctfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
CTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine cdrvrfp(NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, C_WORK_CLATMS, C_WORK_CPOT02, C_WORK_CPOT03, S_WORK_CLATMS, S_WORK_CLANHE, S_WORK_CPOT01, S_WORK_CPOT02, S_WORK_CPOT03)
CDRVRFP
subroutine cpotrf(UPLO, N, A, LDA, INFO)
CPOTRF
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPOT03
subroutine cpftri(TRANSR, UPLO, N, A, INFO)
CPFTRI
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine cpftrf(TRANSR, UPLO, N, A, INFO)
CPFTRF
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine ctrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
CTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...