47
   48
   49
   50
   51
   52
   53      INTEGER            NUNIT
   54
   55
   56
   57
   58
   59      INTEGER            NMAX
   60      parameter( nmax = 4 )
   61
   62
   63      INTEGER            I, INFO, ITER, J
   64
   65
   66      COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
   67     $                   C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
   68     $                   W( 2*NMAX ), X( NMAX )
   69      DOUBLE PRECISION   RWORK( NMAX )
   70      COMPLEX*16         WORK(NMAX*NMAX)
   71      COMPLEX            SWORK(NMAX*NMAX)
   72
   73
   75
   76
   77      LOGICAL            LERR, OK
   78      CHARACTER*32       SRNAMT
   79      INTEGER            INFOT, NOUT
   80
   81
   82      COMMON             / infoc / infot, nout, ok, lerr
   83      COMMON             / srnamc / srnamt
   84
   85
   86      INTRINSIC          dble
   87
   88
   89
   90      nout = nunit
   91      WRITE( nout, fmt = * )
   92
   93
   94
   95      DO 20 j = 1, nmax
   96         DO 10 i = 1, nmax
   97            a( i, j ) = 1.d0 / dble( i+j )
   98            af( i, j ) = 1.d0 / dble( i+j )
   99   10    CONTINUE
  100         b( j ) = 0.d0
  101         r1( j ) = 0.d0
  102         r2( j ) = 0.d0
  103         w( j ) = 0.d0
  104         x( j ) = 0.d0
  105         c( j ) = 0.d0
  106         r( j ) = 0.d0
  107   20 CONTINUE
  108      ok = .true.
  109
  110      srnamt = 'ZCPOSV'
  111      infot = 1
  112      CALL zcposv(
'/',0,0,a,1,b,1,x,1,work,swork,rwork,iter,info)
 
  113      CALL chkxer( 
'ZCPOSV', infot, nout, lerr, ok )
 
  114      infot = 2
  115      CALL zcposv(
'U',-1,0,a,1,b,1,x,1,work,swork,rwork,iter,info)
 
  116      CALL chkxer( 
'ZCPOSV', infot, nout, lerr, ok )
 
  117      infot = 3
  118      CALL zcposv(
'U',0,-1,a,1,b,1,x,1,work,swork,rwork,iter,info)
 
  119      CALL chkxer( 
'ZCPOSV', infot, nout, lerr, ok )
 
  120      infot = 5
  121      CALL zcposv(
'U',2,1,a,1,b,2,x,2,work,swork,rwork,iter,info)
 
  122      CALL chkxer( 
'ZCPOSV', infot, nout, lerr, ok )
 
  123      infot = 7
  124      CALL zcposv(
'U',2,1,a,2,b,1,x,2,work,swork,rwork,iter,info)
 
  125      CALL chkxer( 
'ZCPOSV', infot, nout, lerr, ok )
 
  126      infot = 9
  127      CALL zcposv(
'U',2,1,a,2,b,2,x,1,work,swork,rwork,iter,info)
 
  128      CALL chkxer( 
'ZCPOSV', infot, nout, lerr, ok )
 
  129
  130
  131
  132      IF( ok ) THEN
  133         WRITE( nout, fmt = 9999 )'ZCPOSV'
  134      ELSE
  135         WRITE( nout, fmt = 9998 )'ZCPOSV'
  136      END IF
  137
  138 9999 FORMAT( 1x, a6, ' drivers passed the tests of the error exits' )
  139 9998 FORMAT( ' *** ', a6, ' drivers failed the tests of the error ',
  140     $      'exits ***' )
  141
  142      RETURN
  143
  144
  145
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine zcposv(uplo, n, nrhs, a, lda, b, ldb, x, ldx, work, swork, rwork, iter, info)
ZCPOSV computes the solution to system of linear equations A * X = B for PO matrices