LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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 (NBVAL)
          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.
Date
November 2011

Definition at line 156 of file schkps.f.

156 *
157 * -- LAPACK test routine (version 3.4.0) --
158 * -- LAPACK is a software package provided by Univ. of Tennessee, --
159 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
160 * November 2011
161 *
162 * .. Scalar Arguments ..
163  REAL thresh
164  INTEGER nmax, nn, nnb, nout, nrank
165  LOGICAL tsterr
166 * ..
167 * .. Array Arguments ..
168  REAL a( * ), afac( * ), perm( * ), rwork( * ),
169  $ work( * )
170  INTEGER nbval( * ), nval( * ), piv( * ), rankval( * )
171  LOGICAL dotype( * )
172 * ..
173 *
174 * =====================================================================
175 *
176 * .. Parameters ..
177  REAL one
178  parameter ( one = 1.0e+0 )
179  INTEGER ntypes
180  parameter ( ntypes = 9 )
181 * ..
182 * .. Local Scalars ..
183  REAL 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
188  CHARACTER*3 path
189 * ..
190 * .. Local Arrays ..
191  INTEGER iseed( 4 ), iseedy( 4 )
192  CHARACTER uplos( 2 )
193 * ..
194 * .. External Subroutines ..
195  EXTERNAL alaerh, alahd, alasum, serrps, slacpy, slatb5,
196  $ slatmt, spst01, spstrf, xlaenv
197 * ..
198 * .. Scalars in Common ..
199  INTEGER infot, nunit
200  LOGICAL lerr, ok
201  CHARACTER*32 srnamt
202 * ..
203 * .. Common blocks ..
204  COMMON / infoc / infot, nunit, ok, lerr
205  COMMON / srnamc / srnamt
206 * ..
207 * .. Intrinsic Functions ..
208  INTRINSIC max, REAL, ceiling
209 * ..
210 * .. Data statements ..
211  DATA iseedy / 1988, 1989, 1990, 1991 /
212  DATA uplos / 'U', 'L' /
213 * ..
214 * .. Executable Statements ..
215 *
216 * Initialize constants and the random number seed.
217 *
218  path( 1: 1 ) = 'Single Precision'
219  path( 2: 3 ) = 'PS'
220  nrun = 0
221  nfail = 0
222  nerrs = 0
223  DO 100 i = 1, 4
224  iseed( i ) = iseedy( i )
225  100 CONTINUE
226 *
227 * Test the error exits
228 *
229  IF( tsterr )
230  $ CALL serrps( path, nout )
231  infot = 0
232  CALL xlaenv( 2, 2 )
233 *
234 * Do for each value of N in NVAL
235 *
236  DO 150 in = 1, nn
237  n = nval( in )
238  lda = max( n, 1 )
239  nimat = ntypes
240  IF( n.LE.0 )
241  $ nimat = 1
242 *
243  izero = 0
244  DO 140 imat = 1, nimat
245 *
246 * Do the tests only if DOTYPE( IMAT ) is true.
247 *
248  IF( .NOT.dotype( imat ) )
249  $ GO TO 140
250 *
251 * Do for each value of RANK in RANKVAL
252 *
253  DO 130 irank = 1, nrank
254 *
255 * Only repeat test 3 to 5 for different ranks
256 * Other tests use full rank
257 *
258  IF( ( imat.LT.3 .OR. imat.GT.5 ) .AND. irank.GT.1 )
259  $ GO TO 130
260 *
261  rank = ceiling( ( n * REAL( RANKVAL( IRANK ) ) )
262  $ / 100.e+0 )
263 *
264 *
265 * Do first for UPLO = 'U', then for UPLO = 'L'
266 *
267  DO 120 iuplo = 1, 2
268  uplo = uplos( iuplo )
269 *
270 * Set up parameters with SLATB5 and generate a test matrix
271 * with SLATMT.
272 *
273  CALL slatb5( path, imat, n, TYPE, kl, ku, anorm,
274  $ mode, cndnum, dist )
275 *
276  srnamt = 'SLATMT'
277  CALL slatmt( n, n, dist, iseed, TYPE, rwork, mode,
278  $ cndnum, anorm, rank, kl, ku, uplo, a,
279  $ lda, work, info )
280 *
281 * Check error code from SLATMT.
282 *
283  IF( info.NE.0 ) THEN
284  CALL alaerh( path, 'SLATMT', info, 0, uplo, n,
285  $ n, -1, -1, -1, imat, nfail, nerrs,
286  $ nout )
287  GO TO 120
288  END IF
289 *
290 * Do for each value of NB in NBVAL
291 *
292  DO 110 inb = 1, nnb
293  nb = nbval( inb )
294  CALL xlaenv( 1, nb )
295 *
296 * Compute the pivoted L*L' or U'*U factorization
297 * of the matrix.
298 *
299  CALL slacpy( uplo, n, n, a, lda, afac, lda )
300  srnamt = 'SPSTRF'
301 *
302 * Use default tolerance
303 *
304  tol = -one
305  CALL spstrf( uplo, n, afac, lda, piv, comprank,
306  $ tol, work, info )
307 *
308 * Check error code from SPSTRF.
309 *
310  IF( (info.LT.izero)
311  $ .OR.(info.NE.izero.AND.rank.EQ.n)
312  $ .OR.(info.LE.izero.AND.rank.LT.n) ) THEN
313  CALL alaerh( path, 'SPSTRF', info, izero,
314  $ uplo, n, n, -1, -1, nb, imat,
315  $ nfail, nerrs, nout )
316  GO TO 110
317  END IF
318 *
319 * Skip the test if INFO is not 0.
320 *
321  IF( info.NE.0 )
322  $ GO TO 110
323 *
324 * Reconstruct matrix from factors and compute residual.
325 *
326 * PERM holds permuted L*L^T or U^T*U
327 *
328  CALL spst01( uplo, n, a, lda, afac, lda, perm, lda,
329  $ piv, rwork, result, comprank )
330 *
331 * Print information about the tests that did not pass
332 * the threshold or where computed rank was not RANK.
333 *
334  IF( n.EQ.0 )
335  $ comprank = 0
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
342  nfail = nfail + 1
343  END IF
344  nrun = nrun + 1
345  110 CONTINUE
346 *
347  120 CONTINUE
348  130 CONTINUE
349  140 CONTINUE
350  150 CONTINUE
351 *
352 * Print a summary of the results.
353 *
354  CALL alasum( path, nout, nfail, nrun, nerrs )
355 *
356  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', RANK =', i3,
357  $ ', Diff =', i5, ', NB =', i4, ', type ', i2, ', Ratio =',
358  $ g12.5 )
359  RETURN
360 *
361 * End of SCHKPS
362 *
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
spst01
subroutine spst01(UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
SPST01
Definition: spst01.f:136
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
serrps
subroutine serrps(PATH, NUNIT)
SERRPS
Definition: serrps.f:57
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
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:105
slatmt
subroutine slatmt(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RANK, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMT
Definition: slatmt.f:333
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:143
slatb5
subroutine slatb5(PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB5
Definition: slatb5.f:116
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75

Here is the call graph for this function:

Here is the caller graph for this function: