LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ schkps()

subroutine schkps ( logical, dimension( * )  dotype,
integer  nn,
integer, dimension( * )  nval,
integer  nnb,
integer, dimension( * )  nbval,
integer  nrank,
integer, dimension( * )  rankval,
real  thresh,
logical  tsterr,
integer  nmax,
real, dimension( * )  a,
real, dimension( * )  afac,
real, dimension( * )  perm,
integer, dimension( * )  piv,
real, dimension( * )  work,
real, dimension( * )  rwork,
integer  nout 
)

SCHKPS

Purpose:
 SCHKPS tests SPSTRF.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NNB)
          The values of the block size NB.
[in]NRANK
          NRANK is INTEGER
          The number of values of RANK contained in the vector RANKVAL.
[in]RANKVAL
          RANKVAL is INTEGER array, dimension (NBVAL)
          The values of the block size NB.
[in]THRESH
          THRESH is REAL
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for N, used in dimensioning the
          work arrays.
[out]A
          A is REAL array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is REAL array, dimension (NMAX*NMAX)
[out]PERM
          PERM is REAL array, dimension (NMAX*NMAX)
[out]PIV
          PIV is INTEGER array, dimension (NMAX)
[out]WORK
          WORK is REAL array, dimension (NMAX*3)
[out]RWORK
          RWORK is REAL array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 151 of file schkps.f.

154*
155* -- LAPACK test routine --
156* -- LAPACK is a software package provided by Univ. of Tennessee, --
157* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
158*
159* .. Scalar Arguments ..
160 REAL THRESH
161 INTEGER NMAX, NN, NNB, NOUT, NRANK
162 LOGICAL TSTERR
163* ..
164* .. Array Arguments ..
165 REAL A( * ), AFAC( * ), PERM( * ), RWORK( * ),
166 $ WORK( * )
167 INTEGER NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * )
168 LOGICAL DOTYPE( * )
169* ..
170*
171* =====================================================================
172*
173* .. Parameters ..
174 REAL ONE
175 parameter( one = 1.0e+0 )
176 INTEGER NTYPES
177 parameter( ntypes = 9 )
178* ..
179* .. Local Scalars ..
180 REAL ANORM, CNDNUM, RESULT, TOL
181 INTEGER COMPRANK, I, IMAT, IN, INB, INFO, IRANK, IUPLO,
182 $ IZERO, KL, KU, LDA, MODE, N, NB, NERRS, NFAIL,
183 $ NIMAT, NRUN, RANK, RANKDIFF
184 CHARACTER DIST, TYPE, UPLO
185 CHARACTER*3 PATH
186* ..
187* .. Local Arrays ..
188 INTEGER ISEED( 4 ), ISEEDY( 4 )
189 CHARACTER UPLOS( 2 )
190* ..
191* .. External Subroutines ..
192 EXTERNAL alaerh, alahd, alasum, serrps, slacpy, slatb5,
193 $ slatmt, spst01, spstrf, xlaenv
194* ..
195* .. Scalars in Common ..
196 INTEGER INFOT, NUNIT
197 LOGICAL LERR, OK
198 CHARACTER*32 SRNAMT
199* ..
200* .. Common blocks ..
201 COMMON / infoc / infot, nunit, ok, lerr
202 COMMON / srnamc / srnamt
203* ..
204* .. Intrinsic Functions ..
205 INTRINSIC max, real, ceiling
206* ..
207* .. Data statements ..
208 DATA iseedy / 1988, 1989, 1990, 1991 /
209 DATA uplos / 'U', 'L' /
210* ..
211* .. Executable Statements ..
212*
213* Initialize constants and the random number seed.
214*
215 path( 1: 1 ) = 'Single Precision'
216 path( 2: 3 ) = 'PS'
217 nrun = 0
218 nfail = 0
219 nerrs = 0
220 DO 100 i = 1, 4
221 iseed( i ) = iseedy( i )
222 100 CONTINUE
223*
224* Test the error exits
225*
226 IF( tsterr )
227 $ CALL serrps( path, nout )
228 infot = 0
229 CALL xlaenv( 2, 2 )
230*
231* Do for each value of N in NVAL
232*
233 DO 150 in = 1, nn
234 n = nval( in )
235 lda = max( n, 1 )
236 nimat = ntypes
237 IF( n.LE.0 )
238 $ nimat = 1
239*
240 izero = 0
241 DO 140 imat = 1, nimat
242*
243* Do the tests only if DOTYPE( IMAT ) is true.
244*
245 IF( .NOT.dotype( imat ) )
246 $ GO TO 140
247*
248* Do for each value of RANK in RANKVAL
249*
250 DO 130 irank = 1, nrank
251*
252* Only repeat test 3 to 5 for different ranks
253* Other tests use full rank
254*
255 IF( ( imat.LT.3 .OR. imat.GT.5 ) .AND. irank.GT.1 )
256 $ GO TO 130
257*
258 rank = ceiling( ( n * real( rankval( irank ) ) )
259 $ / 100.e+0 )
260*
261*
262* Do first for UPLO = 'U', then for UPLO = 'L'
263*
264 DO 120 iuplo = 1, 2
265 uplo = uplos( iuplo )
266*
267* Set up parameters with SLATB5 and generate a test matrix
268* with SLATMT.
269*
270 CALL slatb5( path, imat, n, TYPE, KL, KU, ANORM,
271 $ MODE, CNDNUM, DIST )
272*
273 srnamt = 'SLATMT'
274 CALL slatmt( n, n, dist, iseed, TYPE, RWORK, MODE,
275 $ CNDNUM, ANORM, RANK, KL, KU, UPLO, A,
276 $ LDA, WORK, INFO )
277*
278* Check error code from SLATMT.
279*
280 IF( info.NE.0 ) THEN
281 CALL alaerh( path, 'SLATMT', info, 0, uplo, n,
282 $ n, -1, -1, -1, imat, nfail, nerrs,
283 $ nout )
284 GO TO 120
285 END IF
286*
287* Do for each value of NB in NBVAL
288*
289 DO 110 inb = 1, nnb
290 nb = nbval( inb )
291 CALL xlaenv( 1, nb )
292*
293* Compute the pivoted L*L' or U'*U factorization
294* of the matrix.
295*
296 CALL slacpy( uplo, n, n, a, lda, afac, lda )
297 srnamt = 'SPSTRF'
298*
299* Use default tolerance
300*
301 tol = -one
302 CALL spstrf( uplo, n, afac, lda, piv, comprank,
303 $ tol, work, info )
304*
305* Check error code from SPSTRF.
306*
307 IF( (info.LT.izero)
308 $ .OR.(info.NE.izero.AND.rank.EQ.n)
309 $ .OR.(info.LE.izero.AND.rank.LT.n) ) THEN
310 CALL alaerh( path, 'SPSTRF', info, izero,
311 $ uplo, n, n, -1, -1, nb, imat,
312 $ nfail, nerrs, nout )
313 GO TO 110
314 END IF
315*
316* Skip the test if INFO is not 0.
317*
318 IF( info.NE.0 )
319 $ GO TO 110
320*
321* Reconstruct matrix from factors and compute residual.
322*
323* PERM holds permuted L*L^T or U^T*U
324*
325 CALL spst01( uplo, n, a, lda, afac, lda, perm, lda,
326 $ piv, rwork, result, comprank )
327*
328* Print information about the tests that did not pass
329* the threshold or where computed rank was not RANK.
330*
331 IF( n.EQ.0 )
332 $ comprank = 0
333 rankdiff = rank - comprank
334 IF( result.GE.thresh ) THEN
335 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
336 $ CALL alahd( nout, path )
337 WRITE( nout, fmt = 9999 )uplo, n, rank,
338 $ rankdiff, nb, imat, result
339 nfail = nfail + 1
340 END IF
341 nrun = nrun + 1
342 110 CONTINUE
343*
344 120 CONTINUE
345 130 CONTINUE
346 140 CONTINUE
347 150 CONTINUE
348*
349* Print a summary of the results.
350*
351 CALL alasum( path, nout, nfail, nrun, nerrs )
352*
353 9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', RANK =', i3,
354 $ ', Diff =', i5, ', NB =', i4, ', type ', i2, ', Ratio =',
355 $ g12.5 )
356 RETURN
357*
358* End of SCHKPS
359*
alasum
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
xlaenv
subroutine xlaenv(ispec, nvalue)
XLAENV
Definition xlaenv.f:81
alaerh
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
Definition alaerh.f:147
alahd
subroutine alahd(iounit, path)
ALAHD
Definition alahd.f:107
slacpy
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
Definition slacpy.f:103
spstrf
subroutine spstrf(uplo, n, a, lda, piv, rank, tol, work, info)
SPSTRF computes the Cholesky factorization with complete pivoting of a real symmetric positive semide...
Definition spstrf.f:141
serrps
subroutine serrps(path, nunit)
SERRPS
Definition serrps.f:55
slatb5
subroutine slatb5(path, imat, n, type, kl, ku, anorm, mode, cndnum, dist)
SLATB5
Definition slatb5.f:114
slatmt
subroutine slatmt(m, n, dist, iseed, sym, d, mode, cond, dmax, rank, kl, ku, pack, a, lda, work, info)
SLATMT
Definition slatmt.f:331
spst01
subroutine spst01(uplo, n, a, lda, afac, ldafac, perm, ldperm, piv, rwork, resid, rank)
SPST01
Definition spst01.f:134
Here is the call graph for this function:
Here is the caller graph for this function: