166 SUBROUTINE sckglm( 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
180 INTEGER iseed( 4 ), mval( * ), nval( * ), pval( * )
181 REAL a( * ), af( * ), b( * ), bf( * ), rwork( * ),
189 parameter( ntypes = 8 )
193 CHARACTER dista, distb, type
195 INTEGER i, iinfo, ik, imat, kla, klb, kua, kub, lda,
196 $ ldb, lwork, m, modea, modeb, n, nfail, nrun, p
197 REAL anorm, bnorm, cndnma, cndnmb, resid
200 LOGICAL dotype( ntypes )
221 CALL
alareq( path, nmats, dotype, ntypes, nin, nout )
232 IF( m.GT.n .OR. n.GT.m+p )
THEN
234 WRITE( nout, fmt = * )
237 WRITE( nout, fmt = 9997 )m, p, n
248 IF( m.GT.n .OR. n.GT.m+p )
251 DO 30 imat = 1, ntypes
255 IF( .NOT.dotype( imat ) )
261 CALL
slatb9( path, imat, m, p, n, type, kla, kua, klb, kub,
262 $ anorm, bnorm, modea, modeb, cndnma, cndnmb,
265 CALL
slatms( n, m, dista, iseed, type, rwork, modea, cndnma,
266 $ anorm, kla, kua,
'No packing', a, lda, work,
268 IF( iinfo.NE.0 )
THEN
269 WRITE( nout, fmt = 9999 )iinfo
274 CALL
slatms( n, p, distb, iseed, type, rwork, modeb, cndnmb,
275 $ bnorm, klb, kub,
'No packing', b, ldb, work,
277 IF( iinfo.NE.0 )
THEN
278 WRITE( nout, fmt = 9999 )iinfo
286 x( i ) =
slarnd( 2, iseed )
289 CALL
sglmts( n, m, p, a, af, lda, b, bf, ldb, x,
290 $ x( nmax+1 ), x( 2*nmax+1 ), x( 3*nmax+1 ),
291 $ work, lwork, rwork, resid )
296 IF( resid.GE.thresh )
THEN
297 IF( nfail.EQ.0 .AND. firstt )
THEN
301 WRITE( nout, fmt = 9998 )n, m, p, imat, 1, resid
311 CALL
alasum( path, nout, nfail, nrun, 0 )
313 9999 format(
' SLATMS in SCKGLM INFO = ', i5 )
314 9998 format(
' N=', i4,
' M=', i4,
', P=', i4,
', type ', i2,
315 $
', test ', i2,
', ratio=', g13.6 )
316 9997 format(
' *** Invalid input for GLM: M = ', i6,
', P = ', i6,
317 $
', N = ', i6,
';', /
' must satisfy M <= N <= M+P ',
318 $
'(this set of values will be skipped)' )