166 SUBROUTINE dcklse( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
167 $ nmax, a, af, b, bf, x, work, rwork, nin, nout,
176 INTEGER info, nin, nmats, nmax, nn, nout
177 DOUBLE PRECISION thresh
180 INTEGER iseed( 4 ), mval( * ), nval( * ), pval( * )
181 DOUBLE PRECISION a( * ), af( * ), b( * ), bf( * ), rwork( * ),
189 parameter( ntests = 7 )
191 parameter( ntypes = 8 )
195 CHARACTER dista, distb, type
197 INTEGER i, iinfo, ik, imat, kla, klb, kua, kub, lda,
198 $ ldb, lwork, m, modea, modeb, n, nfail, nrun,
200 DOUBLE PRECISION anorm, bnorm, cndnma, cndnmb
203 LOGICAL dotype( ntypes )
204 DOUBLE PRECISION result( ntests )
222 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
233 IF( p.GT.n .OR. n.GT.m+p )
THEN
235 WRITE( nout, fmt = * )
238 WRITE( nout, fmt = 9997 )m, p, n
249 IF( p.GT.n .OR. n.GT.m+p )
252 DO 30 imat = 1, ntypes
256 IF( .NOT.dotype( imat ) )
262 CALL
dlatb9( path, imat, m, p, n, type, kla, kua, klb, kub,
263 $ anorm, bnorm, modea, modeb, cndnma, cndnmb,
266 CALL
dlatms( m, n, dista, iseed, type, rwork, modea, cndnma,
267 $ anorm, kla, kua,
'No packing', a, lda, work,
269 IF( iinfo.NE.0 )
THEN
270 WRITE( nout, fmt = 9999 )iinfo
275 CALL
dlatms( p, n, distb, iseed, type, rwork, modeb, cndnmb,
276 $ bnorm, klb, kub,
'No packing', b, ldb, work,
278 IF( iinfo.NE.0 )
THEN
279 WRITE( nout, fmt = 9999 )iinfo
286 CALL
dlarhs(
'DGE',
'New solution',
'Upper',
'N', m, n,
287 $ max( m-1, 0 ), max( n-1, 0 ), 1, a, lda,
288 $ x( 4*nmax+1 ), max( n, 1 ), x, max( m, 1 ),
291 CALL
dlarhs(
'DGE',
'Computed',
'Upper',
'N', p, n,
292 $ max( p-1, 0 ), max( n-1, 0 ), 1, b, ldb,
293 $ x( 4*nmax+1 ), max( n, 1 ), x( 2*nmax+1 ),
294 $ max( p, 1 ), iseed, iinfo )
298 CALL
dlsets( m, p, n, a, af, lda, b, bf, ldb, x,
299 $ x( nmax+1 ), x( 2*nmax+1 ), x( 3*nmax+1 ),
300 $ x( 4*nmax+1 ), work, lwork, rwork,
307 IF( result( i ).GE.thresh )
THEN
308 IF( nfail.EQ.0 .AND. firstt )
THEN
312 WRITE( nout, fmt = 9998 )m, p, n, imat, i,
324 CALL
alasum( path, nout, nfail, nrun, 0 )
326 9999 format(
' DLATMS in DCKLSE INFO = ', i5 )
327 9998 format(
' M=', i4,
' P=', i4,
', N=', i4,
', type ', i2,
328 $
', test ', i2,
', ratio=', g13.6 )
329 9997 format(
' *** Invalid input for LSE: M = ', i6,
', P = ', i6,
330 $
', N = ', i6,
';', /
' must satisfy P <= N <= P+M ',
331 $
'(this set of values will be skipped)' )