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 INTEGER IP( NMAX )
67 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
68 $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
69 $ W( 2*NMAX ), X( NMAX )
70 DOUBLE PRECISION WORK(1)
71 REAL SWORK(1)
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 ip( j ) = j
108 20 CONTINUE
109 ok = .true.
110
111 srnamt = 'DSGESV'
112 infot = 1
113 CALL dsgesv(-1,0,a,1,ip,b,1,x,1,work,swork,iter,info)
114 CALL chkxer(
'DSGESV', infot, nout, lerr, ok )
115 infot = 2
116 CALL dsgesv(0,-1,a,1,ip,b,1,x,1,work,swork,iter,info)
117 CALL chkxer(
'DSGESV', infot, nout, lerr, ok )
118 infot = 4
119 CALL dsgesv(2,1,a,1,ip,b,2,x,2,work,swork,iter,info)
120 CALL chkxer(
'DSGESV', infot, nout, lerr, ok )
121 infot = 7
122 CALL dsgesv(2,1,a,2,ip,b,1,x,2,work,swork,iter,info)
123 CALL chkxer(
'DSGESV', infot, nout, lerr, ok )
124 infot = 9
125 CALL dsgesv(2,1,a,2,ip,b,2,x,1,work,swork,iter,info)
126 CALL chkxer(
'DSGESV', infot, nout, lerr, ok )
127
128
129
130 IF( ok ) THEN
131 WRITE( nout, fmt = 9999 )'DSGESV'
132 ELSE
133 WRITE( nout, fmt = 9998 )'DSGESV'
134 END IF
135
136 9999 FORMAT( 1x, a6, ' drivers passed the tests of the error exits' )
137 9998 FORMAT( ' *** ', a6, ' drivers failed the tests of the error ',
138 $ 'exits ***' )
139
140 RETURN
141
142
143
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine dsgesv(n, nrhs, a, lda, ipiv, b, ldb, x, ldx, work, swork, iter, info)
DSGESV computes the solution to system of linear equations A * X = B for GE matrices (mixed precision...