LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ zchkpo()

subroutine zchkpo ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
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  NOUT 
)

ZCHKPO

Purpose:
 ZCHKPO tests ZPOTRF, -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]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 blocksize NB.
[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)
[out]AFAC
          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
[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(3,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension
                      (NMAX+2*NSMAX)
[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 165 of file zchkpo.f.

168 *
169 * -- LAPACK test routine --
170 * -- LAPACK is a software package provided by Univ. of Tennessee, --
171 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172 *
173 * .. Scalar Arguments ..
174  LOGICAL TSTERR
175  INTEGER NMAX, NN, NNB, NNS, NOUT
176  DOUBLE PRECISION THRESH
177 * ..
178 * .. Array Arguments ..
179  LOGICAL DOTYPE( * )
180  INTEGER NBVAL( * ), NSVAL( * ), NVAL( * )
181  DOUBLE PRECISION RWORK( * )
182  COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
183  $ WORK( * ), X( * ), XACT( * )
184 * ..
185 *
186 * =====================================================================
187 *
188 * .. Parameters ..
189  COMPLEX*16 CZERO
190  parameter( czero = ( 0.0d+0, 0.0d+0 ) )
191  INTEGER NTYPES
192  parameter( ntypes = 9 )
193  INTEGER NTESTS
194  parameter( ntests = 8 )
195 * ..
196 * .. Local Scalars ..
197  LOGICAL ZEROT
198  CHARACTER DIST, TYPE, UPLO, XTYPE
199  CHARACTER*3 PATH
200  INTEGER I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO,
201  $ IZERO, K, KL, KU, LDA, MODE, N, NB, NERRS,
202  $ NFAIL, NIMAT, NRHS, NRUN
203  DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC
204 * ..
205 * .. Local Arrays ..
206  CHARACTER UPLOS( 2 )
207  INTEGER ISEED( 4 ), ISEEDY( 4 )
208  DOUBLE PRECISION RESULT( NTESTS )
209 * ..
210 * .. External Functions ..
211  DOUBLE PRECISION DGET06, ZLANHE
212  EXTERNAL dget06, zlanhe
213 * ..
214 * .. External Subroutines ..
215  EXTERNAL alaerh, alahd, alasum, xlaenv, zerrpo, zget04,
218  $ zpotri, zpotrs
219 * ..
220 * .. Scalars in Common ..
221  LOGICAL LERR, OK
222  CHARACTER*32 SRNAMT
223  INTEGER INFOT, NUNIT
224 * ..
225 * .. Common blocks ..
226  COMMON / infoc / infot, nunit, ok, lerr
227  COMMON / srnamc / srnamt
228 * ..
229 * .. Intrinsic Functions ..
230  INTRINSIC max
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 ) = 'PO'
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 zerrpo( path, nout )
253  infot = 0
254 *
255 * Do for each value of N in NVAL
256 *
257  DO 120 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  izero = 0
266  DO 110 imat = 1, nimat
267 *
268 * Do the tests only if DOTYPE( IMAT ) is true.
269 *
270  IF( .NOT.dotype( imat ) )
271  $ GO TO 110
272 *
273 * Skip types 3, 4, or 5 if the matrix size is too small.
274 *
275  zerot = imat.GE.3 .AND. imat.LE.5
276  IF( zerot .AND. n.LT.imat-2 )
277  $ GO TO 110
278 *
279 * Do first for UPLO = 'U', then for UPLO = 'L'
280 *
281  DO 100 iuplo = 1, 2
282  uplo = uplos( iuplo )
283 *
284 * Set up parameters with ZLATB4 and generate a test matrix
285 * with ZLATMS.
286 *
287  CALL zlatb4( path, imat, n, n, TYPE, KL, KU, ANORM, MODE,
288  $ CNDNUM, DIST )
289 *
290  srnamt = 'ZLATMS'
291  CALL zlatms( n, n, dist, iseed, TYPE, RWORK, MODE,
292  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
293  $ INFO )
294 *
295 * Check error code from ZLATMS.
296 *
297  IF( info.NE.0 ) THEN
298  CALL alaerh( path, 'ZLATMS', info, 0, uplo, n, n, -1,
299  $ -1, -1, imat, nfail, nerrs, nout )
300  GO TO 100
301  END IF
302 *
303 * For types 3-5, zero one row and column of the matrix to
304 * test that INFO is returned correctly.
305 *
306  IF( zerot ) THEN
307  IF( imat.EQ.3 ) THEN
308  izero = 1
309  ELSE IF( imat.EQ.4 ) THEN
310  izero = n
311  ELSE
312  izero = n / 2 + 1
313  END IF
314  ioff = ( izero-1 )*lda
315 *
316 * Set row and column IZERO of A to 0.
317 *
318  IF( iuplo.EQ.1 ) THEN
319  DO 20 i = 1, izero - 1
320  a( ioff+i ) = czero
321  20 CONTINUE
322  ioff = ioff + izero
323  DO 30 i = izero, n
324  a( ioff ) = czero
325  ioff = ioff + lda
326  30 CONTINUE
327  ELSE
328  ioff = izero
329  DO 40 i = 1, izero - 1
330  a( ioff ) = czero
331  ioff = ioff + lda
332  40 CONTINUE
333  ioff = ioff - izero
334  DO 50 i = izero, n
335  a( ioff+i ) = czero
336  50 CONTINUE
337  END IF
338  ELSE
339  izero = 0
340  END IF
341 *
342 * Set the imaginary part of the diagonals.
343 *
344  CALL zlaipd( n, a, lda+1, 0 )
345 *
346 * Do for each value of NB in NBVAL
347 *
348  DO 90 inb = 1, nnb
349  nb = nbval( inb )
350  CALL xlaenv( 1, nb )
351 *
352 * Compute the L*L' or U'*U factorization of the matrix.
353 *
354  CALL zlacpy( uplo, n, n, a, lda, afac, lda )
355  srnamt = 'ZPOTRF'
356  CALL zpotrf( uplo, n, afac, lda, info )
357 *
358 * Check error code from ZPOTRF.
359 *
360  IF( info.NE.izero ) THEN
361  CALL alaerh( path, 'ZPOTRF', info, izero, uplo, n,
362  $ n, -1, -1, nb, imat, nfail, nerrs,
363  $ nout )
364  GO TO 90
365  END IF
366 *
367 * Skip the tests if INFO is not 0.
368 *
369  IF( info.NE.0 )
370  $ GO TO 90
371 *
372 *+ TEST 1
373 * Reconstruct matrix from factors and compute residual.
374 *
375  CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
376  CALL zpot01( uplo, n, a, lda, ainv, lda, rwork,
377  $ result( 1 ) )
378 *
379 *+ TEST 2
380 * Form the inverse and compute the residual.
381 *
382  CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
383  srnamt = 'ZPOTRI'
384  CALL zpotri( uplo, n, ainv, lda, info )
385 *
386 * Check error code from ZPOTRI.
387 *
388  IF( info.NE.0 )
389  $ CALL alaerh( path, 'ZPOTRI', info, 0, uplo, n, n,
390  $ -1, -1, -1, imat, nfail, nerrs, nout )
391 *
392  CALL zpot03( uplo, n, a, lda, ainv, lda, work, lda,
393  $ rwork, rcondc, result( 2 ) )
394 *
395 * Print information about the tests that did not pass
396 * the threshold.
397 *
398  DO 60 k = 1, 2
399  IF( result( k ).GE.thresh ) THEN
400  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
401  $ CALL alahd( nout, path )
402  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
403  $ result( k )
404  nfail = nfail + 1
405  END IF
406  60 CONTINUE
407  nrun = nrun + 2
408 *
409 * Skip the rest of the tests unless this is the first
410 * blocksize.
411 *
412  IF( inb.NE.1 )
413  $ GO TO 90
414 *
415  DO 80 irhs = 1, nns
416  nrhs = nsval( irhs )
417 *
418 *+ TEST 3
419 * Solve and compute residual for A * X = B .
420 *
421  srnamt = 'ZLARHS'
422  CALL zlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
423  $ nrhs, a, lda, xact, lda, b, lda,
424  $ iseed, info )
425  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
426 *
427  srnamt = 'ZPOTRS'
428  CALL zpotrs( uplo, n, nrhs, afac, lda, x, lda,
429  $ info )
430 *
431 * Check error code from ZPOTRS.
432 *
433  IF( info.NE.0 )
434  $ CALL alaerh( path, 'ZPOTRS', info, 0, uplo, n,
435  $ n, -1, -1, nrhs, imat, nfail,
436  $ nerrs, nout )
437 *
438  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
439  CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
440  $ lda, rwork, result( 3 ) )
441 *
442 *+ TEST 4
443 * Check solution from generated exact solution.
444 *
445  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
446  $ result( 4 ) )
447 *
448 *+ TESTS 5, 6, and 7
449 * Use iterative refinement to improve the solution.
450 *
451  srnamt = 'ZPORFS'
452  CALL zporfs( uplo, n, nrhs, a, lda, afac, lda, b,
453  $ lda, x, lda, rwork, rwork( nrhs+1 ),
454  $ work, rwork( 2*nrhs+1 ), info )
455 *
456 * Check error code from ZPORFS.
457 *
458  IF( info.NE.0 )
459  $ CALL alaerh( path, 'ZPORFS', info, 0, uplo, n,
460  $ n, -1, -1, nrhs, imat, nfail,
461  $ nerrs, nout )
462 *
463  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
464  $ result( 5 ) )
465  CALL zpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
466  $ xact, lda, rwork, rwork( nrhs+1 ),
467  $ result( 6 ) )
468 *
469 * Print information about the tests that did not pass
470 * the threshold.
471 *
472  DO 70 k = 3, 7
473  IF( result( k ).GE.thresh ) THEN
474  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
475  $ CALL alahd( nout, path )
476  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
477  $ imat, k, result( k )
478  nfail = nfail + 1
479  END IF
480  70 CONTINUE
481  nrun = nrun + 5
482  80 CONTINUE
483 *
484 *+ TEST 8
485 * Get an estimate of RCOND = 1/CNDNUM.
486 *
487  anorm = zlanhe( '1', uplo, n, a, lda, rwork )
488  srnamt = 'ZPOCON'
489  CALL zpocon( uplo, n, afac, lda, anorm, rcond, work,
490  $ rwork, info )
491 *
492 * Check error code from ZPOCON.
493 *
494  IF( info.NE.0 )
495  $ CALL alaerh( path, 'ZPOCON', info, 0, uplo, n, n,
496  $ -1, -1, -1, imat, nfail, nerrs, nout )
497 *
498  result( 8 ) = dget06( rcond, rcondc )
499 *
500 * Print the test ratio if it is .GE. THRESH.
501 *
502  IF( result( 8 ).GE.thresh ) THEN
503  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
504  $ CALL alahd( nout, path )
505  WRITE( nout, fmt = 9997 )uplo, n, imat, 8,
506  $ result( 8 )
507  nfail = nfail + 1
508  END IF
509  nrun = nrun + 1
510  90 CONTINUE
511  100 CONTINUE
512  110 CONTINUE
513  120 CONTINUE
514 *
515 * Print a summary of the results.
516 *
517  CALL alasum( path, nout, nfail, nrun, nerrs )
518 *
519  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
520  $ i2, ', test ', i2, ', ratio =', g12.5 )
521  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
522  $ i2, ', test(', i2, ') =', g12.5 )
523  9997 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
524  $ ', test(', i2, ') =', g12.5 )
525  RETURN
526 *
527 * End of ZCHKPO
528 *
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 zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:208
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
Definition: zpot03.f:126
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:102
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
Definition: zlaipd.f:83
subroutine zerrpo(PATH, NUNIT)
ZERRPO
Definition: zerrpo.f:55
subroutine zpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
ZPOT01
Definition: zpot01.f:106
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
Definition: zpot02.f:127
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:121
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
Definition: zpot05.f:165
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:332
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition: zlanhe.f:124
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:103
subroutine zpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
ZPOTRS
Definition: zpotrs.f:110
subroutine zpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZPOCON
Definition: zpocon.f:121
subroutine zporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPORFS
Definition: zporfs.f:183
subroutine zpotri(UPLO, N, A, LDA, INFO)
ZPOTRI
Definition: zpotri.f:95
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:55
subroutine zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
Definition: zpotrf.f:102
Here is the call graph for this function:
Here is the caller graph for this function: