162
  163
  164
  165
  166
  167
  168      LOGICAL            TSTERR
  169      INTEGER            NMAX, NN, NOUT, NRHS
  170      REAL               THRESH
  171
  172
  173      LOGICAL            DOTYPE( * )
  174      INTEGER            NVAL( * )
  175      REAL               RWORK( * ), S( * )
  176      COMPLEX            A( * ), AFAC( * ), ASAV( * ), B( * ),
  177     $                   BSAV( * ), WORK( * ), X( * ), XACT( * )
  178
  179
  180
  181
  182
  183      REAL               ONE, ZERO
  184      parameter( one = 1.0e+0, zero = 0.0e+0 )
  185      INTEGER            NTYPES
  186      parameter( ntypes = 9 )
  187      INTEGER            NTESTS
  188      parameter( ntests = 6 )
  189
  190
  191      LOGICAL            EQUIL, NOFACT, PREFAC, ZEROT
  192      CHARACTER          DIST, EQUED, FACT, TYPE, UPLO, XTYPE
  193      CHARACTER*3        PATH
  194      INTEGER            I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
  195     $                   IZERO, K, K1, KL, KU, LDA, MODE, N, NB, NBMIN,
  196     $                   NERRS, NFACT, NFAIL, NIMAT, NRUN, NT,
  197     $                   N_ERR_BNDS
  198      REAL               AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
  199     $                   ROLDC, SCOND, RPVGRW_SVXX
  200
  201
  202      CHARACTER          EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
  203      INTEGER            ISEED( 4 ), ISEEDY( 4 )
  204      REAL               RESULT( NTESTS ), BERR( NRHS ),
  205     $                   ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
  206
  207
  208      LOGICAL            LSAME
  209      REAL               CLANHE, SGET06
  211
  212
  217
  218
  219      LOGICAL            LERR, OK
  220      CHARACTER*32       SRNAMT
  221      INTEGER            INFOT, NUNIT
  222
  223
  224      COMMON             / infoc / infot, nunit, ok, lerr
  225      COMMON             / srnamc / srnamt
  226
  227
  228      INTRINSIC          cmplx, max
  229
  230
  231      DATA               iseedy / 1988, 1989, 1990, 1991 /
  232      DATA               uplos / 'U', 'L' /
  233      DATA               facts / 'F', 'N', 'E' /
  234      DATA               equeds / 'N', 'Y' /
  235
  236
  237
  238
  239
  240      path( 1: 1 ) = 'Complex precision'
  241      path( 2: 3 ) = 'PO'
  242      nrun = 0
  243      nfail = 0
  244      nerrs = 0
  245      DO 10 i = 1, 4
  246         iseed( i ) = iseedy( i )
  247   10 CONTINUE
  248
  249
  250
  251      IF( tsterr )
  252     $   
CALL cerrvx( path, nout )
 
  253      infot = 0
  254
  255
  256
  257      nb = 1
  258      nbmin = 2
  261
  262
  263
  264      DO 130 in = 1, nn
  265         n = nval( in )
  266         lda = max( n, 1 )
  267         xtype = 'N'
  268         nimat = ntypes
  269         IF( n.LE.0 )
  270     $      nimat = 1
  271
  272         DO 120 imat = 1, nimat
  273
  274
  275
  276            IF( .NOT.dotype( imat ) )
  277     $         GO TO 120
  278
  279
  280
  281            zerot = imat.GE.3 .AND. imat.LE.5
  282            IF( zerot .AND. n.LT.imat-2 )
  283     $         GO TO 120
  284
  285
  286
  287            DO 110 iuplo = 1, 2
  288               uplo = uplos( iuplo )
  289
  290
  291
  292
  293               CALL clatb4( path, imat, n, n, 
TYPE, KL, KU, ANORM, MODE,
 
  294     $                      CNDNUM, DIST )
  295
  296               srnamt = 'CLATMS'
  297               CALL clatms( n, n, dist, iseed, 
TYPE, RWORK, MODE,
 
  298     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
  299     $                      INFO )
  300
  301
  302
  303               IF( info.NE.0 ) THEN
  304                  CALL alaerh( path, 
'CLATMS', info, 0, uplo, n, n, -1,
 
  305     $                         -1, -1, imat, nfail, nerrs, nout )
  306                  GO TO 110
  307               END IF
  308
  309
  310
  311
  312               IF( zerot ) THEN
  313                  IF( imat.EQ.3 ) THEN
  314                     izero = 1
  315                  ELSE IF( imat.EQ.4 ) THEN
  316                     izero = n
  317                  ELSE
  318                     izero = n / 2 + 1
  319                  END IF
  320                  ioff = ( izero-1 )*lda
  321
  322
  323
  324                  IF( iuplo.EQ.1 ) THEN
  325                     DO 20 i = 1, izero - 1
  326                        a( ioff+i ) = zero
  327   20                CONTINUE
  328                     ioff = ioff + izero
  329                     DO 30 i = izero, n
  330                        a( ioff ) = zero
  331                        ioff = ioff + lda
  332   30                CONTINUE
  333                  ELSE
  334                     ioff = izero
  335                     DO 40 i = 1, izero - 1
  336                        a( ioff ) = zero
  337                        ioff = ioff + lda
  338   40                CONTINUE
  339                     ioff = ioff - izero
  340                     DO 50 i = izero, n
  341                        a( ioff+i ) = zero
  342   50                CONTINUE
  343                  END IF
  344               ELSE
  345                  izero = 0
  346               END IF
  347
  348
  349
  350               CALL claipd( n, a, lda+1, 0 )
 
  351
  352
  353
  354               CALL clacpy( uplo, n, n, a, lda, asav, lda )
 
  355
  356               DO 100 iequed = 1, 2
  357                  equed = equeds( iequed )
  358                  IF( iequed.EQ.1 ) THEN
  359                     nfact = 3
  360                  ELSE
  361                     nfact = 1
  362                  END IF
  363
  364                  DO 90 ifact = 1, nfact
  365                     fact = facts( ifact )
  366                     prefac = 
lsame( fact, 
'F' )
 
  367                     nofact = 
lsame( fact, 
'N' )
 
  368                     equil = 
lsame( fact, 
'E' )
 
  369
  370                     IF( zerot ) THEN
  371                        IF( prefac )
  372     $                     GO TO 90
  373                        rcondc = zero
  374
  375                     ELSE IF( .NOT.
lsame( fact, 
'N' ) ) 
THEN 
  376
  377
  378
  379
  380
  381
  382                        CALL clacpy( uplo, n, n, asav, lda, afac, lda )
 
  383                        IF( equil .OR. iequed.GT.1 ) THEN
  384
  385
  386
  387
  388                           CALL cpoequ( n, afac, lda, s, scond, amax,
 
  389     $                                  info )
  390                           IF( info.EQ.0 .AND. n.GT.0 ) THEN
  391                              IF( iequed.GT.1 )
  392     $                           scond = zero
  393
  394
  395
  396                              CALL claqhe( uplo, n, afac, lda, s, scond,
 
  397     $                                     amax, equed )
  398                           END IF
  399                        END IF
  400
  401
  402
  403
  404                        IF( equil )
  405     $                     roldc = rcondc
  406
  407
  408
  409                        anorm = 
clanhe( 
'1', uplo, n, afac, lda, rwork )
 
  410
  411
  412
  413                        CALL cpotrf( uplo, n, afac, lda, info )
 
  414
  415
  416
  417                        CALL clacpy( uplo, n, n, afac, lda, a, lda )
 
  418                        CALL cpotri( uplo, n, a, lda, info )
 
  419
  420
  421
  422                        ainvnm = 
clanhe( 
'1', uplo, n, a, lda, rwork )
 
  423                        IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
  424                           rcondc = one
  425                        ELSE
  426                           rcondc = ( one / anorm ) / ainvnm
  427                        END IF
  428                     END IF
  429
  430
  431
  432                     CALL clacpy( uplo, n, n, asav, lda, a, lda )
 
  433
  434
  435
  436                     srnamt = 'CLARHS'
  437                     CALL clarhs( path, xtype, uplo, 
' ', n, n, kl, ku,
 
  438     $                            nrhs, a, lda, xact, lda, b, lda,
  439     $                            iseed, info )
  440                     xtype = 'C'
  441                     CALL clacpy( 
'Full', n, nrhs, b, lda, bsav, lda )
 
  442
  443                     IF( nofact ) THEN
  444
  445
  446
  447
  448
  449
  450                        CALL clacpy( uplo, n, n, a, lda, afac, lda )
 
  451                        CALL clacpy( 
'Full', n, nrhs, b, lda, x, lda )
 
  452
  453                        srnamt = 'CPOSV '
  454                        CALL cposv( uplo, n, nrhs, afac, lda, x, lda,
 
  455     $                              info )
  456
  457
  458
  459                        IF( info.NE.izero ) THEN
  460                           CALL alaerh( path, 
'CPOSV ', info, izero,
 
  461     $                                  uplo, n, n, -1, -1, nrhs, imat,
  462     $                                  nfail, nerrs, nout )
  463                           GO TO 70
  464                        ELSE IF( info.NE.0 ) THEN
  465                           GO TO 70
  466                        END IF
  467
  468
  469
  470
  471                        CALL cpot01( uplo, n, a, lda, afac, lda, rwork,
 
  472     $                               result( 1 ) )
  473
  474
  475
  476                        CALL clacpy( 
'Full', n, nrhs, b, lda, work,
 
  477     $                               lda )
  478                        CALL cpot02( uplo, n, nrhs, a, lda, x, lda,
 
  479     $                               work, lda, rwork, result( 2 ) )
  480
  481
  482
  483                        CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
 
  484     $                               result( 3 ) )
  485                        nt = 3
  486
  487
  488
  489
  490                        DO 60 k = 1, nt
  491                           IF( result( k ).GE.thresh ) THEN
  492                              IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
  493     $                           
CALL aladhd( nout, path )
 
  494                              WRITE( nout, fmt = 9999 )'CPOSV ', uplo,
  495     $                           n, imat, k, result( k )
  496                              nfail = nfail + 1
  497                           END IF
  498   60                   CONTINUE
  499                        nrun = nrun + nt
  500   70                   CONTINUE
  501                     END IF
  502
  503
  504
  505                     IF( .NOT.prefac )
  506     $                  
CALL claset( uplo, n, n, cmplx( zero ),
 
  507     $                               cmplx( zero ), afac, lda )
  508                     CALL claset( 
'Full', n, nrhs, cmplx( zero ),
 
  509     $                            cmplx( zero ), x, lda )
  510                     IF( iequed.GT.1 .AND. n.GT.0 ) THEN
  511
  512
  513
  514
  515                        CALL claqhe( uplo, n, a, lda, s, scond, amax,
 
  516     $                               equed )
  517                     END IF
  518
  519
  520
  521
  522                     srnamt = 'CPOSVX'
  523                     CALL cposvx( fact, uplo, n, nrhs, a, lda, afac,
 
  524     $                            lda, equed, s, b, lda, x, lda, rcond,
  525     $                            rwork, rwork( nrhs+1 ), work,
  526     $                            rwork( 2*nrhs+1 ), info )
  527
  528
  529
  530                     IF( info.NE.izero ) THEN
  531                        CALL alaerh( path, 
'CPOSVX', info, izero,
 
  532     $                               fact // uplo, n, n, -1, -1, nrhs,
  533     $                               imat, nfail, nerrs, nout )
  534                        GO TO 90
  535                     END IF
  536
  537                     IF( info.EQ.0 ) THEN
  538                        IF( .NOT.prefac ) THEN
  539
  540
  541
  542
  543                           CALL cpot01( uplo, n, a, lda, afac, lda,
 
  544     $                                  rwork( 2*nrhs+1 ), result( 1 ) )
  545                           k1 = 1
  546                        ELSE
  547                           k1 = 2
  548                        END IF
  549
  550
  551
  552                        CALL clacpy( 
'Full', n, nrhs, bsav, lda, work,
 
  553     $                               lda )
  554                        CALL cpot02( uplo, n, nrhs, asav, lda, x, lda,
 
  555     $                               work, lda, rwork( 2*nrhs+1 ),
  556     $                               result( 2 ) )
  557
  558
  559
  560                        IF( nofact .OR. ( prefac .AND. 
lsame( equed,
 
  561     $                      'N' ) ) ) THEN
  562                           CALL cget04( n, nrhs, x, lda, xact, lda,
 
  563     $                                  rcondc, result( 3 ) )
  564                        ELSE
  565                           CALL cget04( n, nrhs, x, lda, xact, lda,
 
  566     $                                  roldc, result( 3 ) )
  567                        END IF
  568
  569
  570
  571
  572                        CALL cpot05( uplo, n, nrhs, asav, lda, b, lda,
 
  573     $                               x, lda, xact, lda, rwork,
  574     $                               rwork( nrhs+1 ), result( 4 ) )
  575                     ELSE
  576                        k1 = 6
  577                     END IF
  578
  579
  580
  581
  582                     result( 6 ) = 
sget06( rcond, rcondc )
 
  583
  584
  585
  586
  587                     DO 80 k = k1, 6
  588                        IF( result( k ).GE.thresh ) THEN
  589                           IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
  590     $                        
CALL aladhd( nout, path )
 
  591                           IF( prefac ) THEN
  592                              WRITE( nout, fmt = 9997 )'CPOSVX', fact,
  593     $                           uplo, n, equed, imat, k, result( k )
  594                           ELSE
  595                              WRITE( nout, fmt = 9998 )'CPOSVX', fact,
  596     $                           uplo, n, imat, k, result( k )
  597                           END IF
  598                           nfail = nfail + 1
  599                        END IF
  600   80                CONTINUE
  601                     nrun = nrun + 7 - k1
  602
  603
  604
  605
  606
  607                     CALL clacpy( 
'Full', n, n, asav, lda, a, lda )
 
  608                     CALL clacpy( 
'Full', n, nrhs, bsav, lda, b, lda )
 
  609 
  610                     IF( .NOT.prefac )
  611     $                  
CALL claset( uplo, n, n, cmplx( zero ),
 
  612     $                               cmplx( zero ), afac, lda )
  613                     CALL claset( 
'Full', n, nrhs, cmplx( zero ),
 
  614     $                            cmplx( zero ), x, lda )
  615                     IF( iequed.GT.1 .AND. n.GT.0 ) THEN
  616
  617
  618
  619
  620                        CALL claqhe( uplo, n, a, lda, s, scond, amax,
 
  621     $                               equed )
  622                     END IF
  623
  624
  625
  626
  627                     srnamt = 'CPOSVXX'
  628                     n_err_bnds = 3
  629                    CALL cposvxx( fact, uplo, n, nrhs, a, lda, afac,
 
  630     $                    lda, equed, s, b, lda, x,
  631     $                    lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
  632     $                    errbnds_n, errbnds_c, 0, zero, work,
  633     $                    rwork( 2*nrhs+1 ), info )
  634
  635
  636
  637                     IF( info.EQ.n+1 ) GOTO 90
  638                     IF( info.NE.izero ) THEN
  639                        CALL alaerh( path, 
'CPOSVXX', info, izero,
 
  640     $                               fact // uplo, n, n, -1, -1, nrhs,
  641     $                               imat, nfail, nerrs, nout )
  642                        GO TO 90
  643                     END IF
  644
  645                     IF( info.EQ.0 ) THEN
  646                        IF( .NOT.prefac ) THEN
  647
  648
  649
  650
  651                           CALL cpot01( uplo, n, a, lda, afac, lda,
 
  652     $                                  rwork( 2*nrhs+1 ), result( 1 ) )
  653                           k1 = 1
  654                        ELSE
  655                           k1 = 2
  656                        END IF
  657
  658
  659
  660                        CALL clacpy( 
'Full', n, nrhs, bsav, lda, work,
 
  661     $                               lda )
  662                        CALL cpot02( uplo, n, nrhs, asav, lda, x, lda,
 
  663     $                               work, lda, rwork( 2*nrhs+1 ),
  664     $                               result( 2 ) )
  665
  666
  667
  668                        IF( nofact .OR. ( prefac .AND. 
lsame( equed,
 
  669     $                      'N' ) ) ) THEN
  670                           CALL cget04( n, nrhs, x, lda, xact, lda,
 
  671     $                                  rcondc, result( 3 ) )
  672                        ELSE
  673                           CALL cget04( n, nrhs, x, lda, xact, lda,
 
  674     $                                  roldc, result( 3 ) )
  675                        END IF
  676
  677
  678
  679
  680                        CALL cpot05( uplo, n, nrhs, asav, lda, b, lda,
 
  681     $                               x, lda, xact, lda, rwork,
  682     $                               rwork( nrhs+1 ), result( 4 ) )
  683                     ELSE
  684                        k1 = 6
  685                     END IF
  686
  687
  688
  689
  690                     result( 6 ) = 
sget06( rcond, rcondc )
 
  691
  692
  693
  694
  695                     DO 85 k = k1, 6
  696                        IF( result( k ).GE.thresh ) THEN
  697                           IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
  698     $                        
CALL aladhd( nout, path )
 
  699                           IF( prefac ) THEN
  700                              WRITE( nout, fmt = 9997 )'CPOSVXX', fact,
  701     $                           uplo, n, equed, imat, k, result( k )
  702                           ELSE
  703                              WRITE( nout, fmt = 9998 )'CPOSVXX', fact,
  704     $                           uplo, n, imat, k, result( k )
  705                           END IF
  706                           nfail = nfail + 1
  707                        END IF
  708  85                 CONTINUE
  709                     nrun = nrun + 7 - k1
  710  90              CONTINUE
  711  100          CONTINUE
  712  110       CONTINUE
  713  120    CONTINUE
  714  130 CONTINUE
  715
  716
  717
  718      CALL alasvm( path, nout, nfail, nrun, nerrs )
 
  719
  720 
  721
  722 
  724 
  725 9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i1,
  726     $      ', test(', i1, ')=', g12.5 )
  727 9998 FORMAT( 1x, a, ', FACT=''', a1, ''', UPLO=''', a1, ''', N=', i5,
  728     $      ', type ', i1, ', test(', i1, ')=', g12.5 )
  729 9997 FORMAT( 1x, a, ', FACT=''', a1, ''', UPLO=''', a1, ''', N=', i5,
  730     $      ', EQUED=''', a1, ''', type ', i1, ', test(', i1, ') =',
  731     $      g12.5 )
  732      RETURN
  733
  734
  735
subroutine alasvm(type, nout, nfail, nrun, nerrs)
ALASVM
subroutine clarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
CLARHS
subroutine xlaenv(ispec, nvalue)
XLAENV
subroutine aladhd(iounit, path)
ALADHD
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine cebchvxx(thresh, path)
CEBCHVXX
subroutine cerrvx(path, nunit)
CERRVX
subroutine cget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
CGET04
subroutine claipd(n, a, inda, vinda)
CLAIPD
subroutine clatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
CLATB4
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
subroutine cpot01(uplo, n, a, lda, afac, ldafac, rwork, resid)
CPOT01
subroutine cpot02(uplo, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
CPOT02
subroutine cpot05(uplo, n, nrhs, a, lda, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
CPOT05
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
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,...
subroutine claqhe(uplo, n, a, lda, s, scond, amax, equed)
CLAQHE scales a Hermitian matrix.
subroutine claset(uplo, m, n, alpha, beta, a, lda)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
logical function lsame(ca, cb)
LSAME
subroutine cpoequ(n, a, lda, s, scond, amax, info)
CPOEQU
subroutine cposv(uplo, n, nrhs, a, lda, b, ldb, info)
CPOSV computes the solution to system of linear equations A * X = B for PO matrices
subroutine cposvx(fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
CPOSVX computes the solution to system of linear equations A * X = B for PO matrices
subroutine cposvxx(fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork, info)
CPOSVXX computes the solution to system of linear equations A * X = B for PO matrices
subroutine cpotrf(uplo, n, a, lda, info)
CPOTRF
subroutine cpotri(uplo, n, a, lda, info)
CPOTRI
real function sget06(rcond, rcondc)
SGET06