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