LAPACK  3.7.1
LAPACK: Linear Algebra PACKage

◆ zchksp()

subroutine zchksp ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
double precision  THRESH,
logical  TSTERR,
integer  NMAX,
complex*16, dimension( * )  A,
complex*16, dimension( * )  AFAC,
complex*16, dimension( * )  AINV,
complex*16, dimension( * )  B,
complex*16, dimension( * )  X,
complex*16, dimension( * )  XACT,
complex*16, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

ZCHKSP

Purpose: 
 ZCHKSP tests ZSPTRF, -TRI, -TRS, -RFS, and -CON
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]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[in]THRESH
          THRESH is DOUBLE PRECISION
          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 COMPLEX*16 array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AFAC
          AFAC is COMPLEX*16 array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AINV
          AINV is COMPLEX*16 array, dimension
                      (NMAX*(NMAX+1)/2)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension
                      (NMAX*max(2,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION array,
                                 dimension (NMAX+2*NSMAX)
[out]IWORK
          IWORK is INTEGER 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
December 2016

Definition at line 166 of file zchksp.f.

166 *
167 * -- LAPACK test routine (version 3.7.0) --
168 * -- LAPACK is a software package provided by Univ. of Tennessee, --
169 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
170 * December 2016
171 *
172 * .. Scalar Arguments ..
173  LOGICAL tsterr
174  INTEGER nmax, nn, nns, nout
175  DOUBLE PRECISION thresh
176 * ..
177 * .. Array Arguments ..
178  LOGICAL dotype( * )
179  INTEGER iwork( * ), nsval( * ), nval( * )
180  DOUBLE PRECISION rwork( * )
181  COMPLEX*16 a( * ), afac( * ), ainv( * ), b( * ),
182  $ work( * ), x( * ), xact( * )
183 * ..
184 *
185 * =====================================================================
186 *
187 * .. Parameters ..
188  DOUBLE PRECISION zero
189  parameter( zero = 0.0d+0 )
190  INTEGER ntypes
191  parameter( ntypes = 11 )
192  INTEGER ntests
193  parameter( ntests = 8 )
194 * ..
195 * .. Local Scalars ..
196  LOGICAL trfcon, zerot
197  CHARACTER dist, packit, TYPE, uplo, xtype
198  CHARACTER*3 path
199  INTEGER i, i1, i2, imat, in, info, ioff, irhs, iuplo,
200  $ izero, j, k, kl, ku, lda, mode, n, nerrs,
201  $ nfail, nimat, npp, nrhs, nrun, nt
202  DOUBLE PRECISION anorm, cndnum, rcond, rcondc
203 * ..
204 * .. Local Arrays ..
205  CHARACTER uplos( 2 )
206  INTEGER iseed( 4 ), iseedy( 4 )
207  DOUBLE PRECISION result( ntests )
208 * ..
209 * .. External Functions ..
210  LOGICAL lsame
211  DOUBLE PRECISION dget06, zlansp
212  EXTERNAL lsame, dget06, zlansp
213 * ..
214 * .. External Subroutines ..
215  EXTERNAL alaerh, alahd, alasum, zcopy, zerrsy, zget04,
216  $ zlacpy, zlarhs, zlatb4, zlatms, zlatsp, zppt05,
217  $ zspcon, zsprfs, zspt01, zspt02, zspt03, zsptrf,
218  $ zsptri, zsptrs
219 * ..
220 * .. Intrinsic Functions ..
221  INTRINSIC max, min
222 * ..
223 * .. Scalars in Common ..
224  LOGICAL lerr, ok
225  CHARACTER*32 srnamt
226  INTEGER infot, nunit
227 * ..
228 * .. Common blocks ..
229  COMMON / infoc / infot, nunit, ok, lerr
230  COMMON / srnamc / srnamt
231 * ..
232 * .. Data statements ..
233  DATA iseedy / 1988, 1989, 1990, 1991 /
234  DATA uplos / 'U', 'L' /
235 * ..
236 * .. Executable Statements ..
237 *
238 * Initialize constants and the random number seed.
239 *
240  path( 1: 1 ) = 'Zomplex precision'
241  path( 2: 3 ) = 'SP'
242  nrun = 0
243  nfail = 0
244  nerrs = 0
245  DO 10 i = 1, 4
246  iseed( i ) = iseedy( i )
247  10 CONTINUE
248 *
249 * Test the error exits
250 *
251  IF( tsterr )
252  $ CALL zerrsy( path, nout )
253  infot = 0
254 *
255 * Do for each value of N in NVAL
256 *
257  DO 170 in = 1, nn
258  n = nval( in )
259  lda = max( n, 1 )
260  xtype = 'N'
261  nimat = ntypes
262  IF( n.LE.0 )
263  $ nimat = 1
264 *
265  DO 160 imat = 1, nimat
266 *
267 * Do the tests only if DOTYPE( IMAT ) is true.
268 *
269  IF( .NOT.dotype( imat ) )
270  $ GO TO 160
271 *
272 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
273 *
274  zerot = imat.GE.3 .AND. imat.LE.6
275  IF( zerot .AND. n.LT.imat-2 )
276  $ GO TO 160
277 *
278 * Do first for UPLO = 'U', then for UPLO = 'L'
279 *
280  DO 150 iuplo = 1, 2
281  uplo = uplos( iuplo )
282  IF( lsame( uplo, 'U' ) ) THEN
283  packit = 'C'
284  ELSE
285  packit = 'R'
286  END IF
287 *
288  IF( imat.NE.ntypes ) THEN
289 *
290 * Set up parameters with ZLATB4 and generate a test
291 * matrix with ZLATMS.
292 *
293  CALL zlatb4( path, imat, n, n, TYPE, kl, ku, anorm,
294  $ mode, cndnum, dist )
295 *
296  srnamt = 'ZLATMS'
297  CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode,
298  $ cndnum, anorm, kl, ku, packit, a, lda,
299  $ work, info )
300 *
301 * Check error code from ZLATMS.
302 *
303  IF( info.NE.0 ) THEN
304  CALL alaerh( path, 'ZLATMS', info, 0, uplo, n, n,
305  $ -1, -1, -1, imat, nfail, nerrs, nout )
306  GO TO 150
307  END IF
308 *
309 * For types 3-6, zero one or more rows and columns of
310 * the matrix to test that INFO is returned correctly.
311 *
312  IF( zerot ) THEN
313  IF( imat.EQ.3 ) THEN
314  izero = 1
315  ELSE IF( imat.EQ.4 ) THEN
316  izero = n
317  ELSE
318  izero = n / 2 + 1
319  END IF
320 *
321  IF( imat.LT.6 ) THEN
322 *
323 * Set row and column IZERO to zero.
324 *
325  IF( iuplo.EQ.1 ) THEN
326  ioff = ( izero-1 )*izero / 2
327  DO 20 i = 1, izero - 1
328  a( ioff+i ) = zero
329  20 CONTINUE
330  ioff = ioff + izero
331  DO 30 i = izero, n
332  a( ioff ) = zero
333  ioff = ioff + i
334  30 CONTINUE
335  ELSE
336  ioff = izero
337  DO 40 i = 1, izero - 1
338  a( ioff ) = zero
339  ioff = ioff + n - i
340  40 CONTINUE
341  ioff = ioff - izero
342  DO 50 i = izero, n
343  a( ioff+i ) = zero
344  50 CONTINUE
345  END IF
346  ELSE
347  IF( iuplo.EQ.1 ) THEN
348 *
349 * Set the first IZERO rows and columns to zero.
350 *
351  ioff = 0
352  DO 70 j = 1, n
353  i2 = min( j, izero )
354  DO 60 i = 1, i2
355  a( ioff+i ) = zero
356  60 CONTINUE
357  ioff = ioff + j
358  70 CONTINUE
359  ELSE
360 *
361 * Set the last IZERO rows and columns to zero.
362 *
363  ioff = 0
364  DO 90 j = 1, n
365  i1 = max( j, izero )
366  DO 80 i = i1, n
367  a( ioff+i ) = zero
368  80 CONTINUE
369  ioff = ioff + n - j
370  90 CONTINUE
371  END IF
372  END IF
373  ELSE
374  izero = 0
375  END IF
376  ELSE
377 *
378 * Use a special block diagonal matrix to test alternate
379 * code for the 2 x 2 blocks.
380 *
381  CALL zlatsp( uplo, n, a, iseed )
382  END IF
383 *
384 * Compute the L*D*L' or U*D*U' factorization of the matrix.
385 *
386  npp = n*( n+1 ) / 2
387  CALL zcopy( npp, a, 1, afac, 1 )
388  srnamt = 'ZSPTRF'
389  CALL zsptrf( uplo, n, afac, iwork, info )
390 *
391 * Adjust the expected value of INFO to account for
392 * pivoting.
393 *
394  k = izero
395  IF( k.GT.0 ) THEN
396  100 CONTINUE
397  IF( iwork( k ).LT.0 ) THEN
398  IF( iwork( k ).NE.-k ) THEN
399  k = -iwork( k )
400  GO TO 100
401  END IF
402  ELSE IF( iwork( k ).NE.k ) THEN
403  k = iwork( k )
404  GO TO 100
405  END IF
406  END IF
407 *
408 * Check error code from ZSPTRF.
409 *
410  IF( info.NE.k )
411  $ CALL alaerh( path, 'ZSPTRF', info, k, uplo, n, n, -1,
412  $ -1, -1, imat, nfail, nerrs, nout )
413  IF( info.NE.0 ) THEN
414  trfcon = .true.
415  ELSE
416  trfcon = .false.
417  END IF
418 *
419 *+ TEST 1
420 * Reconstruct matrix from factors and compute residual.
421 *
422  CALL zspt01( uplo, n, a, afac, iwork, ainv, lda, rwork,
423  $ result( 1 ) )
424  nt = 1
425 *
426 *+ TEST 2
427 * Form the inverse and compute the residual.
428 *
429  IF( .NOT.trfcon ) THEN
430  CALL zcopy( npp, afac, 1, ainv, 1 )
431  srnamt = 'ZSPTRI'
432  CALL zsptri( uplo, n, ainv, iwork, work, info )
433 *
434 * Check error code from ZSPTRI.
435 *
436  IF( info.NE.0 )
437  $ CALL alaerh( path, 'ZSPTRI', info, 0, uplo, n, n,
438  $ -1, -1, -1, imat, nfail, nerrs, nout )
439 *
440  CALL zspt03( uplo, n, a, ainv, work, lda, rwork,
441  $ rcondc, result( 2 ) )
442  nt = 2
443  END IF
444 *
445 * Print information about the tests that did not pass
446 * the threshold.
447 *
448  DO 110 k = 1, nt
449  IF( result( k ).GE.thresh ) THEN
450  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
451  $ CALL alahd( nout, path )
452  WRITE( nout, fmt = 9999 )uplo, n, imat, k,
453  $ result( k )
454  nfail = nfail + 1
455  END IF
456  110 CONTINUE
457  nrun = nrun + nt
458 *
459 * Do only the condition estimate if INFO is not 0.
460 *
461  IF( trfcon ) THEN
462  rcondc = zero
463  GO TO 140
464  END IF
465 *
466  DO 130 irhs = 1, nns
467  nrhs = nsval( irhs )
468 *
469 *+ TEST 3
470 * Solve and compute residual for A * X = B.
471 *
472  srnamt = 'ZLARHS'
473  CALL zlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
474  $ nrhs, a, lda, xact, lda, b, lda, iseed,
475  $ info )
476  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
477 *
478  srnamt = 'ZSPTRS'
479  CALL zsptrs( uplo, n, nrhs, afac, iwork, x, lda,
480  $ info )
481 *
482 * Check error code from ZSPTRS.
483 *
484  IF( info.NE.0 )
485  $ CALL alaerh( path, 'ZSPTRS', info, 0, uplo, n, n,
486  $ -1, -1, nrhs, imat, nfail, nerrs,
487  $ nout )
488 *
489  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
490  CALL zspt02( uplo, n, nrhs, a, x, lda, work, lda,
491  $ rwork, result( 3 ) )
492 *
493 *+ TEST 4
494 * Check solution from generated exact solution.
495 *
496  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
497  $ result( 4 ) )
498 *
499 *+ TESTS 5, 6, and 7
500 * Use iterative refinement to improve the solution.
501 *
502  srnamt = 'ZSPRFS'
503  CALL zsprfs( uplo, n, nrhs, a, afac, iwork, b, lda, x,
504  $ lda, rwork, rwork( nrhs+1 ), work,
505  $ rwork( 2*nrhs+1 ), info )
506 *
507 * Check error code from ZSPRFS.
508 *
509  IF( info.NE.0 )
510  $ CALL alaerh( path, 'ZSPRFS', info, 0, uplo, n, n,
511  $ -1, -1, nrhs, imat, nfail, nerrs,
512  $ nout )
513 *
514  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
515  $ result( 5 ) )
516  CALL zppt05( uplo, n, nrhs, a, b, lda, x, lda, xact,
517  $ lda, rwork, rwork( nrhs+1 ),
518  $ result( 6 ) )
519 *
520 * Print information about the tests that did not pass
521 * the threshold.
522 *
523  DO 120 k = 3, 7
524  IF( result( k ).GE.thresh ) THEN
525  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
526  $ CALL alahd( nout, path )
527  WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
528  $ k, result( k )
529  nfail = nfail + 1
530  END IF
531  120 CONTINUE
532  nrun = nrun + 5
533  130 CONTINUE
534 *
535 *+ TEST 8
536 * Get an estimate of RCOND = 1/CNDNUM.
537 *
538  140 CONTINUE
539  anorm = zlansp( '1', uplo, n, a, rwork )
540  srnamt = 'ZSPCON'
541  CALL zspcon( uplo, n, afac, iwork, anorm, rcond, work,
542  $ info )
543 *
544 * Check error code from ZSPCON.
545 *
546  IF( info.NE.0 )
547  $ CALL alaerh( path, 'ZSPCON', info, 0, uplo, n, n, -1,
548  $ -1, -1, imat, nfail, nerrs, nout )
549 *
550  result( 8 ) = dget06( rcond, rcondc )
551 *
552 * Print the test ratio if it is .GE. THRESH.
553 *
554  IF( result( 8 ).GE.thresh ) THEN
555  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
556  $ CALL alahd( nout, path )
557  WRITE( nout, fmt = 9999 )uplo, n, imat, 8,
558  $ result( 8 )
559  nfail = nfail + 1
560  END IF
561  nrun = nrun + 1
562  150 CONTINUE
563  160 CONTINUE
564  170 CONTINUE
565 *
566 * Print a summary of the results.
567 *
568  CALL alasum( path, nout, nfail, nrun, nerrs )
569 *
570  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', type ', i2, ', test ',
571  $ i2, ', ratio =', g12.5 )
572  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
573  $ i2, ', test(', i2, ') =', g12.5 )
574  RETURN
575 *
576 * End of ZCHKSP
577 *
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
zsptrs
subroutine zsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZSPTRS
Definition: zsptrs.f:117
zerrsy
subroutine zerrsy(PATH, NUNIT)
ZERRSY
Definition: zerrsy.f:57
zsptrf
subroutine zsptrf(UPLO, N, AP, IPIV, INFO)
ZSPTRF
Definition: zsptrf.f:160
zget04
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
zcopy
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:83
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
zspcon
subroutine zspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZSPCON
Definition: zspcon.f:120
zlacpy
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
zspt02
subroutine zspt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
ZSPT02
Definition: zspt02.f:125
zlatb4
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
zlatsp
subroutine zlatsp(UPLO, N, X, ISEED)
ZLATSP
Definition: zlatsp.f:86
zppt05
subroutine zppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPPT05
Definition: zppt05.f:159
zsptri
subroutine zsptri(UPLO, N, AP, IPIV, WORK, INFO)
ZSPTRI
Definition: zsptri.f:111
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
zsprfs
subroutine zsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZSPRFS
Definition: zsprfs.f:182
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
zspt03
subroutine zspt03(UPLO, N, A, AINV, WORK, LDW, RWORK, RCOND, RESID)
ZSPT03
Definition: zspt03.f:112
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
zlarhs
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
zlansp
double precision function zlansp(NORM, UPLO, N, AP, WORK)
ZLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
Definition: zlansp.f:117
zspt01
subroutine zspt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
ZSPT01
Definition: zspt01.f:114
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: