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 DOUBLE PRECISION 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 WORK(NMAX*NMAX)
70 REAL SWORK(NMAX*NMAX)
71
72
74
75
76 LOGICAL LERR, OK
77 CHARACTER*32 SRNAMT
78 INTEGER INFOT, NOUT
79
80
81 COMMON / infoc / infot, nout, ok, lerr
82 COMMON / srnamc / srnamt
83
84
85 INTRINSIC dble
86
87
88
89 nout = nunit
90 WRITE( nout, fmt = * )
91
92
93
94 DO 20 j = 1, nmax
95 DO 10 i = 1, nmax
96 a( i, j ) = 1.d0 / dble( i+j )
97 af( i, j ) = 1.d0 / dble( i+j )
98 10 CONTINUE
99 b( j ) = 0.d0
100 r1( j ) = 0.d0
101 r2( j ) = 0.d0
102 w( j ) = 0.d0
103 x( j ) = 0.d0
104 c( j ) = 0.d0
105 r( j ) = 0.d0
106 20 CONTINUE
107 ok = .true.
108
109 srnamt = 'DSPOSV'
110 infot = 1
111 CALL dsposv(
'/',0,0,a,1,b,1,x,1,work,swork,iter,info)
112 CALL chkxer(
'DSPOSV', infot, nout, lerr, ok )
113 infot = 2
114 CALL dsposv(
'U',-1,0,a,1,b,1,x,1,work,swork,iter,info)
115 CALL chkxer(
'DSPOSV', infot, nout, lerr, ok )
116 infot = 3
117 CALL dsposv(
'U',0,-1,a,1,b,1,x,1,work,swork,iter,info)
118 CALL chkxer(
'DSPOSV', infot, nout, lerr, ok )
119 infot = 5
120 CALL dsposv(
'U',2,1,a,1,b,2,x,2,work,swork,iter,info)
121 CALL chkxer(
'DSPOSV', infot, nout, lerr, ok )
122 infot = 7
123 CALL dsposv(
'U',2,1,a,2,b,1,x,2,work,swork,iter,info)
124 CALL chkxer(
'DSPOSV', infot, nout, lerr, ok )
125 infot = 9
126 CALL dsposv(
'U',2,1,a,2,b,2,x,1,work,swork,iter,info)
127 CALL chkxer(
'DSPOSV', infot, nout, lerr, ok )
128
129
130
131 IF( ok ) THEN
132 WRITE( nout, fmt = 9999 )'DSPOSV'
133 ELSE
134 WRITE( nout, fmt = 9998 )'DSPOSV'
135 END IF
136
137 9999 FORMAT( 1x, a6, ' drivers passed the tests of the error exits' )
138 9998 FORMAT( ' *** ', a6, ' drivers failed the tests of the error ',
139 $ 'exits ***' )
140
141 RETURN
142
143
144
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine dsposv(uplo, n, nrhs, a, lda, b, ldb, x, ldx, work, swork, iter, info)
DSPOSV computes the solution to system of linear equations A * X = B for PO matrices