1 SUBROUTINE sdrvls( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB,
2 $ nbval, nxval, thresh, tsterr, a, copya, b,
3 $ copyb, c, s, copys, ibval, work, iwork, nout )
13 INTEGER nm, nn, nnb, nns, nout
18 INTEGER iwork( * ), mval( * ), nbval( * ), nsval( * ),
19 $ nval( * ), nxval( * ), ibval( * )
20 REAL a( * ), b( * ), c( * ), copya( * ), copyb( * ),
21 $ copys( * ), s( * ), work( * )
122 parameter( ntests = 18 )
124 parameter( smlsiz = 25 )
126 parameter( one = 1.0e0, two = 2.0e0, zero = 0.0e0 )
131 INTEGER crank, i, im, in, inb, info, ins, irank,
132 $ iscale, itran,
itype, j, k, lda, ldb, ldwork,
133 $ lwlsy, lwork, m, mnmin, n, nb, ncols, nerrs,
134 $ nfail, nlvl, nrhs, nrows, nrun, rank, ib,
137 REAL eps, norma, normb, rcond
140 INTEGER iseed( 4 ), iseedy( 4 )
141 REAL result( ntests )
149 $ sgelsd, sgelss, sgelsx, sgelsy, sgemm, slacpy,
154 INTRINSIC int, log,
max,
min,
REAL, sqrt
159 INTEGER infot, iounit
162 common / infoc / infot, iounit, ok, lerr
163 common / srnamc / srnamt
166 DATA iseedy / 1988, 1989, 1990, 1991 /
172 path( 1: 1 ) =
'Single precision'
178 iseed( i ) = iseedy( i )
180 eps = slamch(
'Epsilon' )
184 rcond = sqrt( eps ) - ( sqrt( eps )-eps ) / 2
191 $ CALL
serrls( path, nout )
195 IF( ( nm.EQ.0 .OR. nn.EQ.0 ) .AND. thresh.EQ.zero )
196 $ CALL
alahd( nout, path )
210 nlvl =
max( int( log(
max( one,
REAL( MNMIN ) ) /
211 $
REAL( SMLSIZ+1 ) ) / log( two ) ) + 1, 0 )
212 lwork =
max( 1, ( m+nrhs )*( n+2 ), ( n+nrhs )*( m+2 ),
213 $ m*n+4*mnmin+
max( m, n ), 12*mnmin+2*mnmin*smlsiz+
214 $ 8*mnmin*nlvl+mnmin*nrhs+(smlsiz+1)**2 )
218 itype = ( irank-1 )*3 + iscale
219 IF( .NOT.dotype(
itype ) )
222 IF( irank.EQ.1 )
THEN
228 CALL
sqrt13( iscale, m, n, copya, lda, norma,
234 CALL
xlaenv( 3, nxval( inb ) )
235 IF ( (
max(m, n) / 25) .GT. nb )
THEN
253 IF( itran.EQ.1 )
THEN
255 plasma_trans = plasmanotrans
260 plasma_trans = plasmatrans
264 ldwork =
max( 1, ncols )
268 IF( ncols.GT.0 )
THEN
269 CALL slarnv( 2, iseed, ncols*nrhs,
271 CALL sscal( ncols*nrhs,
272 $ one /
REAL( NCOLS ), work,
275 CALL sgemm(
trans,
'No transpose', nrows,
276 $ nrhs, ncols, one, copya, lda,
277 $ work, ldwork, zero, b, ldb )
278 CALL slacpy(
'Full', nrows, nrhs, b, ldb,
283 IF( m.GT.0 .AND. n.GT.0 )
THEN
284 CALL slacpy(
'Full', m, n, copya, lda,
286 CALL slacpy(
'Full', nrows, nrhs,
287 $ copyb, ldb, b, ldb )
293 $ a, lda, ht, b, ldb,
296 $ CALL
alaerh( path,
'SGELS ', info, 0,
297 $
trans, m, n, nrhs, -1, nb,
298 $
itype, nfail, nerrs,
303 ldwork =
max( 1, nrows )
304 IF( nrows.GT.0 .AND. nrhs.GT.0 )
305 $ CALL slacpy(
'Full', nrows, nrhs,
306 $ copyb, ldb, c, ldb )
308 $ lda, b, ldb, c, ldb, work,
311 IF( ( itran.EQ.1 .AND. m.GE.n ) .OR.
312 $ ( itran.EQ.2 .AND. m.LT.n ) )
THEN
317 $ nrhs, copya, lda, b, ldb,
318 $ copyb, ldb, c, work,
325 $ nrhs, copya, lda, b, ldb,
333 IF( result( k ).GE.thresh )
THEN
334 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
335 $ CALL
alahd( nout, path )
336 WRITE( nout, fmt = 9999 )
trans, m,
337 $ n, nrhs, nb,
itype, k,
347 CALL plasma_dealloc_handle( ht, info )
358 CALL
alasvm( path, nout, nfail, nrun, nerrs )
360 9999
format(
' TRANS=''', a1,
''', M=', i5,
', N=', i5,
', NRHS=', i4,
361 $
', NB=', i4,
', type', i2,
', test(', i2,
')=', g12.5 )
362 9998
format(
' M=', i5,
', N=', i5,
', NRHS=', i4,
', NB=', i4,
363 $
', type', i2,
', test(', i2,
')=', g12.5 )