LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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,
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 *
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
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:73
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:81
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:147
subroutine slatmt(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RANK, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMT
Definition: slatmt.f:331
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
subroutine spst01(UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
SPST01
Definition: spst01.f:134
subroutine serrps(PATH, NUNIT)
SERRPS
Definition: serrps.f:55
subroutine slatb5(PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB5
Definition: slatb5.f:114
Here is the call graph for this function:
Here is the caller graph for this function: