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( 1
x, a6,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
588 +
', test(', i1,
')=', g12.5 )
subroutine cpftrf(TRANSR, UPLO, N, A, INFO)
CPFTRF
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
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...
subroutine cpftrs(TRANSR, UPLO, N, NRHS, A, B, LDB, INFO)
CPFTRS
subroutine cpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
CPOT01
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
REAL function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPOT03
subroutine cpotri(UPLO, N, A, LDA, INFO)
CPOTRI
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
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 cpftri(TRANSR, UPLO, N, A, INFO)
CPFTRI
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
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 cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Intel Corp All rights reserved Redistribution and use in source and binary forms