LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zchkhp ( 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 
)

ZCHKHP

Purpose: 
 ZCHKHP tests ZHPTRF, -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
November 2011

Definition at line 166 of file zchkhp.f.

166 *
167 * -- LAPACK test routine (version 3.4.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 * November 2011
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 = 10 )
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, zlanhp
212  EXTERNAL lsame, dget06, zlanhp
213 * ..
214 * .. External Subroutines ..
215  EXTERNAL alaerh, alahd, alasum, zcopy, zerrsy, zget04,
216  $ zhpcon, zhprfs, zhpt01, zhptrf, zhptri, zhptrs,
217  $ zlacpy, zlaipd, zlarhs, zlatb4, zlatms, zppt02,
218  $ zppt03, zppt05
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 ) = 'HP'
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  izero = 0
266  DO 160 imat = 1, nimat
267 *
268 * Do the tests only if DOTYPE( IMAT ) is true.
269 *
270  IF( .NOT.dotype( imat ) )
271  $ GO TO 160
272 *
273 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
274 *
275  zerot = imat.GE.3 .AND. imat.LE.6
276  IF( zerot .AND. n.LT.imat-2 )
277  $ GO TO 160
278 *
279 * Do first for UPLO = 'U', then for UPLO = 'L'
280 *
281  DO 150 iuplo = 1, 2
282  uplo = uplos( iuplo )
283  IF( lsame( uplo, 'U' ) ) THEN
284  packit = 'C'
285  ELSE
286  packit = 'R'
287  END IF
288 *
289 * Set up parameters with ZLATB4 and generate a test matrix
290 * with ZLATMS.
291 *
292  CALL zlatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
293  $ cndnum, dist )
294 *
295  srnamt = 'ZLATMS'
296  CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode,
297  $ cndnum, anorm, kl, ku, packit, a, lda, work,
298  $ info )
299 *
300 * Check error code from ZLATMS.
301 *
302  IF( info.NE.0 ) THEN
303  CALL alaerh( path, 'ZLATMS', info, 0, uplo, n, n, -1,
304  $ -1, -1, imat, nfail, nerrs, nout )
305  GO TO 150
306  END IF
307 *
308 * For types 3-6, zero one or more rows and columns of
309 * the matrix to test that INFO is returned correctly.
310 *
311  IF( zerot ) THEN
312  IF( imat.EQ.3 ) THEN
313  izero = 1
314  ELSE IF( imat.EQ.4 ) THEN
315  izero = n
316  ELSE
317  izero = n / 2 + 1
318  END IF
319 *
320  IF( imat.LT.6 ) THEN
321 *
322 * Set row and column IZERO to zero.
323 *
324  IF( iuplo.EQ.1 ) THEN
325  ioff = ( izero-1 )*izero / 2
326  DO 20 i = 1, izero - 1
327  a( ioff+i ) = zero
328  20 CONTINUE
329  ioff = ioff + izero
330  DO 30 i = izero, n
331  a( ioff ) = zero
332  ioff = ioff + i
333  30 CONTINUE
334  ELSE
335  ioff = izero
336  DO 40 i = 1, izero - 1
337  a( ioff ) = zero
338  ioff = ioff + n - i
339  40 CONTINUE
340  ioff = ioff - izero
341  DO 50 i = izero, n
342  a( ioff+i ) = zero
343  50 CONTINUE
344  END IF
345  ELSE
346  ioff = 0
347  IF( iuplo.EQ.1 ) THEN
348 *
349 * Set the first IZERO rows and columns to zero.
350 *
351  DO 70 j = 1, n
352  i2 = min( j, izero )
353  DO 60 i = 1, i2
354  a( ioff+i ) = zero
355  60 CONTINUE
356  ioff = ioff + j
357  70 CONTINUE
358  ELSE
359 *
360 * Set the last IZERO rows and columns to zero.
361 *
362  DO 90 j = 1, n
363  i1 = max( j, izero )
364  DO 80 i = i1, n
365  a( ioff+i ) = zero
366  80 CONTINUE
367  ioff = ioff + n - j
368  90 CONTINUE
369  END IF
370  END IF
371  ELSE
372  izero = 0
373  END IF
374 *
375 * Set the imaginary part of the diagonals.
376 *
377  IF( iuplo.EQ.1 ) THEN
378  CALL zlaipd( n, a, 2, 1 )
379  ELSE
380  CALL zlaipd( n, a, n, -1 )
381  END IF
382 *
383 * Compute the L*D*L' or U*D*U' factorization of the matrix.
384 *
385  npp = n*( n+1 ) / 2
386  CALL zcopy( npp, a, 1, afac, 1 )
387  srnamt = 'ZHPTRF'
388  CALL zhptrf( uplo, n, afac, iwork, info )
389 *
390 * Adjust the expected value of INFO to account for
391 * pivoting.
392 *
393  k = izero
394  IF( k.GT.0 ) THEN
395  100 CONTINUE
396  IF( iwork( k ).LT.0 ) THEN
397  IF( iwork( k ).NE.-k ) THEN
398  k = -iwork( k )
399  GO TO 100
400  END IF
401  ELSE IF( iwork( k ).NE.k ) THEN
402  k = iwork( k )
403  GO TO 100
404  END IF
405  END IF
406 *
407 * Check error code from ZHPTRF.
408 *
409  IF( info.NE.k )
410  $ CALL alaerh( path, 'ZHPTRF', info, k, uplo, n, n, -1,
411  $ -1, -1, imat, nfail, nerrs, nout )
412  IF( info.NE.0 ) THEN
413  trfcon = .true.
414  ELSE
415  trfcon = .false.
416  END IF
417 *
418 *+ TEST 1
419 * Reconstruct matrix from factors and compute residual.
420 *
421  CALL zhpt01( uplo, n, a, afac, iwork, ainv, lda, rwork,
422  $ result( 1 ) )
423  nt = 1
424 *
425 *+ TEST 2
426 * Form the inverse and compute the residual.
427 *
428  IF( .NOT.trfcon ) THEN
429  CALL zcopy( npp, afac, 1, ainv, 1 )
430  srnamt = 'ZHPTRI'
431  CALL zhptri( uplo, n, ainv, iwork, work, info )
432 *
433 * Check error code from ZHPTRI.
434 *
435  IF( info.NE.0 )
436  $ CALL alaerh( path, 'ZHPTRI', info, 0, uplo, n, n,
437  $ -1, -1, -1, imat, nfail, nerrs, nout )
438 *
439  CALL zppt03( uplo, n, a, ainv, work, lda, rwork,
440  $ rcondc, result( 2 ) )
441  nt = 2
442  END IF
443 *
444 * Print information about the tests that did not pass
445 * the threshold.
446 *
447  DO 110 k = 1, nt
448  IF( result( k ).GE.thresh ) THEN
449  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
450  $ CALL alahd( nout, path )
451  WRITE( nout, fmt = 9999 )uplo, n, imat, k,
452  $ result( k )
453  nfail = nfail + 1
454  END IF
455  110 CONTINUE
456  nrun = nrun + nt
457 *
458 * Do only the condition estimate if INFO is not 0.
459 *
460  IF( trfcon ) THEN
461  rcondc = zero
462  GO TO 140
463  END IF
464 *
465  DO 130 irhs = 1, nns
466  nrhs = nsval( irhs )
467 *
468 *+ TEST 3
469 * Solve and compute residual for A * X = B.
470 *
471  srnamt = 'ZLARHS'
472  CALL zlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
473  $ nrhs, a, lda, xact, lda, b, lda, iseed,
474  $ info )
475  xtype = 'C'
476  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
477 *
478  srnamt = 'ZHPTRS'
479  CALL zhptrs( uplo, n, nrhs, afac, iwork, x, lda,
480  $ info )
481 *
482 * Check error code from ZHPTRS.
483 *
484  IF( info.NE.0 )
485  $ CALL alaerh( path, 'ZHPTRS', 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 zppt02( 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 = 'ZHPRFS'
503  CALL zhprfs( 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 ZHPRFS.
508 *
509  IF( info.NE.0 )
510  $ CALL alaerh( path, 'ZHPRFS', 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 = zlanhp( '1', uplo, n, a, rwork )
540  srnamt = 'ZHPCON'
541  CALL zhpcon( uplo, n, afac, iwork, anorm, rcond, work,
542  $ info )
543 *
544 * Check error code from ZHPCON.
545 *
546  IF( info.NE.0 )
547  $ CALL alaerh( path, 'ZHPCON', 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 ZCHKHP
577 *
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
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
zerrsy
subroutine zerrsy(PATH, NUNIT)
ZERRSY
Definition: zerrsy.f:57
zhptrs
subroutine zhptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZHPTRS
Definition: zhptrs.f:117
zget04
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
zhprfs
subroutine zhprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHPRFS
Definition: zhprfs.f:182
zcopy
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
zlanhp
double precision function zlanhp(NORM, UPLO, N, AP, WORK)
ZLANHP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix supplied in packed form.
Definition: zlanhp.f:119
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
zhptrf
subroutine zhptrf(UPLO, N, AP, IPIV, INFO)
ZHPTRF
Definition: zhptrf.f:161
zhptri
subroutine zhptri(UPLO, N, AP, IPIV, WORK, INFO)
ZHPTRI
Definition: zhptri.f:111
zppt03
subroutine zppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPPT03
Definition: zppt03.f:112
zlatb4
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
zlaipd
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
Definition: zlaipd.f:85
zppt02
subroutine zppt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
ZPPT02
Definition: zppt02.f:125
zhpt01
subroutine zhpt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
ZHPT01
Definition: zhpt01.f:115
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
zppt05
subroutine zppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPPT05
Definition: zppt05.f:159
zhpcon
subroutine zhpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZHPCON
Definition: zhpcon.f:120
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
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: