153 SUBROUTINE dchkps( DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL,
154 $ thresh, tsterr, nmax, a, afac, perm, piv, work,
163 DOUBLE PRECISION THRESH
164 INTEGER NMAX, NN, NNB, NOUT, NRANK
168 DOUBLE PRECISION A( * ), AFAC( * ), PERM( * ), RWORK( * ),
170 INTEGER NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * )
178 parameter( one = 1.0d+0 )
180 parameter( ntypes = 9 )
183 DOUBLE PRECISION ANORM, CNDNUM, RESULT, TOL
184 INTEGER COMPRANK, I, IMAT, IN, INB, INFO, IRANK, IUPLO,
185 $ izero, kl, ku, lda, mode, n, nb, nerrs, nfail,
186 $ nimat, nrun, rank, rankdiff
187 CHARACTER DIST,
TYPE, UPLO
191 INTEGER ISEED( 4 ), ISEEDY( 4 )
204 COMMON / infoc / infot, nunit, ok, lerr
205 COMMON / srnamc / srnamt
208 INTRINSIC dble, max, ceiling
211 DATA iseedy / 1988, 1989, 1990, 1991 /
212 DATA uplos /
'U',
'L' /
218 path( 1: 1 ) =
'Double precision'
224 iseed( i ) = iseedy( i )
230 $ CALL
derrps( path, nout )
244 DO 140 imat = 1, nimat
248 IF( .NOT.dotype( imat ) )
253 DO 130 irank = 1, nrank
258 IF( ( imat.LT.3 .OR. imat.GT.5 ) .AND. irank.GT.1 )
261 rank = ceiling( ( n * dble( rankval( irank ) ) )
268 uplo = uplos( iuplo )
273 CALL
dlatb5( path, imat, n,
TYPE, KL, KU, ANORM,
274 $ mode, cndnum, dist )
277 CALL
dlatmt( n, n, dist, iseed,
TYPE, RWORK, MODE,
278 $ cndnum, anorm, rank, kl, ku, uplo, a,
284 CALL
alaerh( path,
'DLATMT', info, 0, uplo, n,
285 $ n, -1, -1, -1, imat, nfail, nerrs,
299 CALL
dlacpy( uplo, n, n, a, lda, afac, lda )
305 CALL
dpstrf( uplo, n, afac, lda, piv, comprank,
311 $ .OR.(info.NE.izero.AND.rank.EQ.n)
312 $ .OR.(info.LE.izero.AND.rank.LT.n) )
THEN
313 CALL
alaerh( path,
'DPSTRF', info, izero,
314 $ uplo, n, n, -1, -1, nb, imat,
315 $ nfail, nerrs, nout )
328 CALL
dpst01( uplo, n, a, lda, afac, lda, perm, lda,
329 $ piv, rwork, result, comprank )
336 rankdiff = rank - comprank
337 IF( result.GE.thresh )
THEN
338 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
339 $ CALL
alahd( nout, path )
340 WRITE( nout, fmt = 9999 )uplo, n, rank,
341 $ rankdiff, nb, imat, result
354 CALL
alasum( path, nout, nfail, nrun, nerrs )
356 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', RANK =', i3,
357 $
', Diff =', i5,
', NB =', i4,
', type ', i2,
', Ratio =',
subroutine dlatb5(PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB5
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine dlatmt(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RANK, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMT
subroutine dpst01(UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
DPST01
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine dpstrf(UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO)
DPSTRF
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine derrps(PATH, NUNIT)
DERRPS
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dchkps(DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL, THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK, RWORK, NOUT)
DCHKPS