85 parameter ( nmax = 132 )
87 parameter ( maxin = 12 )
89 parameter ( maxrhs = 16 )
91 parameter ( matmax = 30 )
93 parameter ( nin = 5, nout = 6 )
95 parameter ( ldamax = nmax )
98 LOGICAL FATAL, TSTDRV, TSTERR
104 INTEGER I, IC, K, LDA, NM, NMATS,
106 $ vers_major, vers_minor, vers_patch
107 DOUBLE PRECISION EPS, S1, S2, THRESH
111 LOGICAL DOTYPE( matmax )
112 INTEGER IWORK( nmax ), MVAL( maxin ), NSVAL( maxin )
113 DOUBLE PRECISION A( ldamax*nmax, 2 ), B( nmax*maxrhs, 2 ),
114 $ rwork( nmax ), work( nmax*maxrhs*2 )
115 REAL SWORK(nmax*(nmax+maxrhs))
118 DOUBLE PRECISION DLAMCH, DSECND
119 LOGICAL LSAME, LSAMEN
121 EXTERNAL lsame, lsamen, dlamch, dsecnd, slamch
133 COMMON / infoc / infot, nunit, ok, lerr
134 COMMON / srnamc / srnamt
137 DATA intstr /
'0123456789' /
151 CALL ilaver( vers_major, vers_minor, vers_patch )
152 WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
156 READ( nin, fmt = * )nm
158 WRITE( nout, fmt = 9996 )
' NM ', nm, 1
161 ELSE IF( nm.GT.maxin )
THEN
162 WRITE( nout, fmt = 9995 )
' NM ', nm, maxin
166 READ( nin, fmt = * )( mval( i ), i = 1, nm )
168 IF( mval( i ).LT.0 )
THEN
169 WRITE( nout, fmt = 9996 )
' M ', mval( i ), 0
171 ELSE IF( mval( i ).GT.nmax )
THEN
172 WRITE( nout, fmt = 9995 )
' M ', mval( i ), nmax
177 $
WRITE( nout, fmt = 9993 )
'M ', ( mval( i ), i = 1, nm )
181 READ( nin, fmt = * )nns
183 WRITE( nout, fmt = 9996 )
' NNS', nns, 1
186 ELSE IF( nns.GT.maxin )
THEN
187 WRITE( nout, fmt = 9995 )
' NNS', nns, maxin
191 READ( nin, fmt = * )( nsval( i ), i = 1, nns )
193 IF( nsval( i ).LT.0 )
THEN
194 WRITE( nout, fmt = 9996 )
'NRHS', nsval( i ), 0
196 ELSE IF( nsval( i ).GT.maxrhs )
THEN
197 WRITE( nout, fmt = 9995 )
'NRHS', nsval( i ), maxrhs
202 $
WRITE( nout, fmt = 9993 )
'NRHS', ( nsval( i ), i = 1, nns )
206 READ( nin, fmt = * )thresh
207 WRITE( nout, fmt = 9992 )thresh
211 READ( nin, fmt = * )tstdrv
215 READ( nin, fmt = * )tsterr
218 WRITE( nout, fmt = 9999 )
224 seps = slamch(
'Underflow threshold' )
225 WRITE( nout, fmt = 9991 )
'(single precision) underflow', seps
226 seps = slamch(
'Overflow threshold' )
227 WRITE( nout, fmt = 9991 )
'(single precision) overflow ', seps
228 seps = slamch(
'Epsilon' )
229 WRITE( nout, fmt = 9991 )
'(single precision) precision', seps
230 WRITE( nout, fmt = * )
232 eps = dlamch(
'Underflow threshold' )
233 WRITE( nout, fmt = 9991 )
'(double precision) underflow', eps
234 eps = dlamch(
'Overflow threshold' )
235 WRITE( nout, fmt = 9991 )
'(double precision) overflow ', eps
236 eps = dlamch(
'Epsilon' )
237 WRITE( nout, fmt = 9991 )
'(double precision) precision', eps
238 WRITE( nout, fmt = * )
244 READ( nin, fmt =
'(A72)', end = 140 )aline
254 IF( aline( i: i ).EQ.
' ' )
260 IF( c1.EQ.intstr( k: k ) )
THEN
267 nmats = nmats*10 + ic
279 IF( .NOT.lsame( c1,
'Double precision' ) )
THEN
280 WRITE( nout, fmt = 9990 )path
283 ELSE IF( nmats.LE.0 )
THEN
287 WRITE( nout, fmt = 9989 )path
290 ELSE IF( lsamen( 2, c2,
'GE' ) )
THEN
295 CALL alareq(
'DGE', nmats, dotype, ntypes, nin, nout )
303 CALL ddrvab( dotype, nm, mval, nns,
304 $ nsval, thresh, lda, a( 1, 1 ),
305 $ a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
306 $ work, rwork, swork, iwork, nout )
308 WRITE( nout, fmt = 9989 )
'DSGESV'
311 ELSE IF( lsamen( 2, c2,
'PO' ) )
THEN
316 CALL alareq(
'DPO', nmats, dotype, ntypes, nin, nout )
324 CALL ddrvac( dotype, nm, mval, nns, nsval,
325 $ thresh, lda, a( 1, 1 ), a( 1, 2 ),
326 $ b( 1, 1 ), b( 1, 2 ),
327 $ work, rwork, swork, nout )
329 WRITE( nout, fmt = 9989 )path
344 WRITE( nout, fmt = 9998 )
345 WRITE( nout, fmt = 9997 )s2 - s1
347 9999
FORMAT( /
' Execution not attempted due to input errors' )
348 9998
FORMAT( /
' End of tests' )
349 9997
FORMAT(
' Total time used = ', f12.2,
' seconds', / )
350 9996
FORMAT(
' Invalid input value: ', a4,
'=', i6,
'; must be >=',
352 9995
FORMAT(
' Invalid input value: ', a4,
'=', i6,
'; must be <=',
354 9994
FORMAT(
' Tests of the DOUBLE PRECISION LAPACK DSGESV/DSPOSV',
356 $ /
' LAPACK VERSION ', i1,
'.', i1,
'.', i1,
357 $ / /
' The following parameter values will be used:' )
358 9993
FORMAT( 4x, a4,
': ', 10i6, / 11x, 10i6 )
359 9992
FORMAT( /
' Routines pass computational tests if test ratio is ',
360 $
'less than', f8.2, / )
361 9991
FORMAT(
' Relative machine ', a,
' is taken to be', d16.6 )
362 9990
FORMAT( / 1x, a6,
' routines were not tested' )
363 9989
FORMAT( / 1x, a6,
' driver routines were not tested' )
subroutine derrac(NUNIT)
DERRAC
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
subroutine ddrvac(DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, NOUT)
DDRVAC
subroutine derrab(NUNIT)
DERRAB
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
subroutine ddrvab(DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, IWORK, NOUT)
DDRVAB