159      SUBROUTINE cdrvpo( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
 
  160     $                   A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
 
  169      INTEGER            NMAX, NN, NOUT, NRHS
 
  175      REAL               RWORK( * ), S( * )
 
  176      COMPLEX            A( * ), AFAC( * ), ASAV( * ), B( * ),
 
  177     $                   bsav( * ), work( * ), x( * ), xact( * )
 
  184      PARAMETER          ( ONE = 1.0e+0, zero = 0.0e+0 )
 
  186      parameter( ntypes = 9 )
 
  188      parameter( ntests = 6 )
 
  191      LOGICAL            EQUIL, NOFACT, PREFAC, ZEROT
 
  192      CHARACTER          DIST, EQUED, FACT, 
TYPE, UPLO, XTYPE
 
  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,
 
  198      REAL               AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
 
  199     $                   ROLDC, SCOND, RPVGRW_SVXX
 
  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 )
 
  210      EXTERNAL           lsame, clanhe, sget06
 
  224      COMMON             / infoc / infot, nunit, ok, lerr
 
  225      COMMON             / srnamc / srnamt
 
  231      DATA               iseedy / 1988, 1989, 1990, 1991 /
 
  232      DATA               uplos / 
'U', 
'L' /
 
  233      DATA               facts / 
'F', 
'N', 
'E' /
 
  234      DATA               equeds / 
'N', 
'Y' /
 
  240      path( 1: 1 ) = 
'Complex precision' 
  246         iseed( i ) = iseedy( i )
 
  252     $   
CALL cerrvx( path, nout )
 
  272         DO 120 imat = 1, nimat
 
  276            IF( .NOT.dotype( imat ) )
 
  281            zerot = imat.GE.3 .AND. imat.LE.5
 
  282            IF( zerot .AND. n.LT.imat-2 )
 
  288               uplo = uplos( iuplo )
 
  293               CALL clatb4( path, imat, n, n, 
TYPE, kl, ku, anorm, mode,
 
  297               CALL clatms( n, n, dist, iseed, 
TYPE, rwork, mode,
 
  298     $                      cndnum, anorm, kl, ku, uplo, a, lda, work,
 
  304                  CALL alaerh( path, 
'CLATMS', info, 0, uplo, n, n, -1,
 
  305     $                         -1, -1, imat, nfail, nerrs, nout )
 
  315                  ELSE IF( imat.EQ.4 ) 
THEN 
  320                  ioff = ( izero-1 )*lda
 
  324                  IF( iuplo.EQ.1 ) 
THEN 
  325                     DO 20 i = 1, izero - 1
 
  335                     DO 40 i = 1, izero - 1
 
  350               CALL claipd( n, a, lda+1, 0 )
 
  354               CALL clacpy( uplo, n, n, a, lda, asav, lda )
 
  357                  equed = equeds( iequed )
 
  358                  IF( iequed.EQ.1 ) 
THEN 
  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' )
 
  375                     ELSE IF( .NOT.lsame( fact, 
'N' ) ) 
THEN 
  382                        CALL clacpy( uplo, n, n, asav, lda, afac, lda )
 
  383                        IF( equil .OR. iequed.GT.1 ) 
THEN 
  388                           CALL cpoequ( n, afac, lda, s, scond, amax,
 
  390                           IF( info.EQ.0 .AND. n.GT.0 ) 
THEN 
  396                              CALL claqhe( uplo, n, afac, lda, s, scond,
 
  409                        anorm = clanhe( 
'1', uplo, n, afac, lda, rwork )
 
  413                        CALL cpotrf( uplo, n, afac, lda, info )
 
  417                        CALL clacpy( uplo, n, n, afac, lda, a, lda )
 
  418                        CALL cpotri( uplo, n, a, lda, info )
 
  422                        ainvnm = clanhe( 
'1', uplo, n, a, lda, rwork )
 
  423                        IF( anorm.LE.zero .OR. ainvnm.LE.zero ) 
THEN 
  426                           rcondc = ( one / anorm ) / ainvnm
 
  432                     CALL clacpy( uplo, n, n, asav, lda, a, lda )
 
  437                     CALL clarhs( path, xtype, uplo, 
' ', n, n, kl, ku,
 
  438     $                            nrhs, a, lda, xact, lda, b, lda,
 
  441                     CALL clacpy( 
'Full', n, nrhs, b, lda, bsav, lda )
 
  450                        CALL clacpy( uplo, n, n, a, lda, afac, lda )
 
  451                        CALL clacpy( 
'Full', n, nrhs, b, lda, x, lda )
 
  454                        CALL cposv( uplo, n, nrhs, afac, lda, x, lda,
 
  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 )
 
  464                        ELSE IF( info.NE.0 ) 
THEN 
  471                        CALL cpot01( uplo, n, a, lda, afac, lda, rwork,
 
  476                        CALL clacpy( 
'Full', n, nrhs, b, lda, work,
 
  478                        CALL cpot02( uplo, n, nrhs, a, lda, x, lda,
 
  479     $                               work, lda, rwork, result( 2 ) )
 
  483                        CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
 
  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 )
 
  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 
  515                        CALL claqhe( uplo, n, a, lda, s, scond, amax,
 
  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 )
 
  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 )
 
  538                        IF( .NOT.prefac ) 
THEN 
  543                           CALL cpot01( uplo, n, a, lda, afac, lda,
 
  544     $                                  rwork( 2*nrhs+1 ), result( 1 ) )
 
  552                        CALL clacpy( 
'Full', n, nrhs, bsav, lda, work,
 
  554                        CALL cpot02( uplo, n, nrhs, asav, lda, x, lda,
 
  555     $                               work, lda, rwork( 2*nrhs+1 ),
 
  560                        IF( nofact .OR. ( prefac .AND. lsame( equed,
 
  562                           CALL cget04( n, nrhs, x, lda, xact, lda,
 
  563     $                                  rcondc, result( 3 ) )
 
  565                           CALL cget04( n, nrhs, x, lda, xact, lda,
 
  566     $                                  roldc, result( 3 ) )
 
  572                        CALL cpot05( uplo, n, nrhs, asav, lda, b, lda,
 
  573     $                               x, lda, xact, lda, rwork,
 
  574     $                               rwork( nrhs+1 ), result( 4 ) )
 
  582                     result( 6 ) = sget06( rcond, rcondc )
 
  588                        IF( result( k ).GE.thresh ) 
THEN 
  589                           IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
 
  590     $                        
CALL aladhd( nout, path )
 
  592                              WRITE( nout, fmt = 9997 )
'CPOSVX', fact,
 
  593     $                           uplo, n, equed, imat, k, result( k )
 
  595                              WRITE( nout, fmt = 9998 )
'CPOSVX', fact,
 
  596     $                           uplo, n, imat, k, result( k )
 
  607                     CALL clacpy( 
'Full', n, n, asav, lda, a, lda )
 
  608                     CALL clacpy( 
'Full', n, nrhs, bsav, lda, b, lda )
 
  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 
  620                        CALL claqhe( uplo, n, a, lda, s, scond, amax,
 
  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 )
 
  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 )
 
  646                        IF( .NOT.prefac ) 
THEN 
  651                           CALL cpot01( uplo, n, a, lda, afac, lda,
 
  652     $                                  rwork( 2*nrhs+1 ), result( 1 ) )
 
  660                        CALL clacpy( 
'Full', n, nrhs, bsav, lda, work,
 
  662                        CALL cpot02( uplo, n, nrhs, asav, lda, x, lda,
 
  663     $                               work, lda, rwork( 2*nrhs+1 ),
 
  668                        IF( nofact .OR. ( prefac .AND. lsame( equed,
 
  670                           CALL cget04( n, nrhs, x, lda, xact, lda,
 
  671     $                                  rcondc, result( 3 ) )
 
  673                           CALL cget04( n, nrhs, x, lda, xact, lda,
 
  674     $                                  roldc, result( 3 ) )
 
  680                        CALL cpot05( uplo, n, nrhs, asav, lda, b, lda,
 
  681     $                               x, lda, xact, lda, rwork,
 
  682     $                               rwork( nrhs+1 ), result( 4 ) )
 
  690                     result( 6 ) = sget06( rcond, rcondc )
 
  696                        IF( result( k ).GE.thresh ) 
THEN 
  697                           IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
 
  698     $                        
CALL aladhd( nout, path )
 
  700                              WRITE( nout, fmt = 9997 )
'CPOSVXX', fact,
 
  701     $                           uplo, n, equed, imat, k, result( k )
 
  703                              WRITE( nout, fmt = 9998 )
'CPOSVXX', fact,
 
  704     $                           uplo, n, imat, k, result( k )
 
  718      CALL alasvm( path, nout, nfail, nrun, nerrs )
 
  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, 
') =',