LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
subroutine zdrvhe_aa ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NRHS,
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 
)

ZDRVHE_AA

Purpose: 
 ZDRVHE_AA tests the driver routine ZHESV_AA.
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]NRHS
          NRHS is INTEGER
          The number of right hand side vectors to be generated for
          each linear system.
[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*NRHS)
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]WORK
          WORK is COMPLEX*16 array, dimension (NMAX*max(2,NRHS))
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
[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 155 of file zdrvhe_aa.f.

155 *
156 * -- LAPACK test routine (version 3.7.0) --
157 * -- LAPACK is a software package provided by Univ. of Tennessee, --
158 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
159 * December 2016
160 *
161 * .. Scalar Arguments ..
162  LOGICAL tsterr
163  INTEGER nmax, nn, nout, nrhs
164  DOUBLE PRECISION thresh
165 * ..
166 * .. Array Arguments ..
167  LOGICAL dotype( * )
168  INTEGER iwork( * ), nval( * )
169  DOUBLE PRECISION rwork( * )
170  COMPLEX*16 a( * ), afac( * ), ainv( * ), b( * ),
171  $ work( * ), x( * ), xact( * )
172 * ..
173 *
174 * =====================================================================
175 *
176 * .. Parameters ..
177  DOUBLE PRECISION one, zero
178  parameter ( one = 1.0d+0, zero = 0.0d+0 )
179  INTEGER ntypes, ntests
180  parameter ( ntypes = 10, ntests = 3 )
181  INTEGER nfact
182  parameter ( nfact = 2 )
183 * ..
184 * .. Local Scalars ..
185  LOGICAL zerot
186  CHARACTER dist, fact, TYPE, uplo, xtype
187  CHARACTER*3 matpath, path
188  INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
189  $ izero, j, k, kl, ku, lda, lwork, mode, n,
190  $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
191  DOUBLE PRECISION anorm, cndnum
192 * ..
193 * .. Local Arrays ..
194  CHARACTER facts( nfact ), uplos( 2 )
195  INTEGER iseed( 4 ), iseedy( 4 )
196  DOUBLE PRECISION result( ntests )
197 * ..
198 * .. External Functions ..
199  DOUBLE PRECISION dget06, zlanhe
200  EXTERNAL dget06, zlanhe
201 * ..
202 * .. External Subroutines ..
203  EXTERNAL aladhd, alaerh, alasvm, xlaenv, zerrvx, zget04,
204  $ zhesv_aa, zhet01_aa, zhetrf_aa,
205  $ zhetri2, zlacpy, zlaipd, zlarhs, zlatb4,
206  $ zlatms, zpot02
207 * ..
208 * .. Scalars in Common ..
209  LOGICAL lerr, ok
210  CHARACTER*32 srnamt
211  INTEGER infot, nunit
212 * ..
213 * .. Common blocks ..
214  COMMON / infoc / infot, nunit, ok, lerr
215  COMMON / srnamc / srnamt
216 * ..
217 * .. Intrinsic Functions ..
218  INTRINSIC dcmplx, max, min
219 * ..
220 * .. Data statements ..
221  DATA iseedy / 1988, 1989, 1990, 1991 /
222  DATA uplos / 'U', 'L' / , facts / 'F', 'N' /
223 * ..
224 * .. Executable Statements ..
225 *
226 * Initialize constants and the random number seed.
227 *
228 * Test path
229 *
230  path( 1: 1 ) = 'Zomplex precision'
231  path( 2: 3 ) = 'HA'
232 *
233 * Path to generate matrices
234 *
235  matpath( 1: 1 ) = 'Zomplex precision'
236  matpath( 2: 3 ) = 'HE'
237 *
238  nrun = 0
239  nfail = 0
240  nerrs = 0
241  DO 10 i = 1, 4
242  iseed( i ) = iseedy( i )
243  10 CONTINUE
244  lwork = max( 2*nmax, nmax*nrhs )
245 *
246 * Test the error exits
247 *
248  IF( tsterr )
249  $ CALL zerrvx( path, nout )
250  infot = 0
251 *
252 * Set the block size and minimum block size for testing.
253 *
254  nb = 1
255  nbmin = 2
256  CALL xlaenv( 1, nb )
257  CALL xlaenv( 2, nbmin )
258 *
259 * Do for each value of N in NVAL
260 *
261  DO 180 in = 1, nn
262  n = nval( in )
263  lda = max( n, 1 )
264  xtype = 'N'
265  nimat = ntypes
266  IF( n.LE.0 )
267  $ nimat = 1
268 *
269  DO 170 imat = 1, nimat
270 *
271 * Do the tests only if DOTYPE( IMAT ) is true.
272 *
273  IF( .NOT.dotype( imat ) )
274  $ GO TO 170
275 *
276 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
277 *
278  zerot = imat.GE.3 .AND. imat.LE.6
279  IF( zerot .AND. n.LT.imat-2 )
280  $ GO TO 170
281 *
282 * Do first for UPLO = 'U', then for UPLO = 'L'
283 *
284  DO 160 iuplo = 1, 2
285  uplo = uplos( iuplo )
286 *
287 * Begin generate the test matrix A.
288 *
289 * Set up parameters with ZLATB4 and generate a test matrix
290 * with ZLATMS.
291 *
292  CALL zlatb4( matpath, imat, n, n, TYPE, kl, ku, anorm,
293  $ mode, cndnum, dist )
294 *
295  srnamt = 'ZLATMS'
296  CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode,
297  $ cndnum, anorm, kl, ku, uplo, 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 160
306  END IF
307 *
308 * For types 3-6, zero one or more rows and columns of the
309 * 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 )*lda
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 + lda
333  30 CONTINUE
334  ELSE
335  ioff = izero
336  DO 40 i = 1, izero - 1
337  a( ioff ) = zero
338  ioff = ioff + lda
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 + lda
357  70 CONTINUE
358  izero = 1
359  ELSE
360 *
361 * Set the last IZERO rows and columns to zero.
362 *
363  DO 90 j = 1, n
364  i1 = max( j, izero )
365  DO 80 i = i1, n
366  a( ioff+i ) = zero
367  80 CONTINUE
368  ioff = ioff + lda
369  90 CONTINUE
370  END IF
371  END IF
372  ELSE
373  izero = 0
374  END IF
375 *
376 * Set the imaginary part of the diagonals.
377 *
378  CALL zlaipd( n, a, lda+1, 0 )
379 *
380  DO 150 ifact = 1, nfact
381 *
382 * Do first for FACT = 'F', then for other values.
383 *
384  fact = facts( ifact )
385 *
386 * Form an exact solution and set the right hand side.
387 *
388  srnamt = 'ZLARHS'
389  CALL zlarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
390  $ nrhs, a, lda, xact, lda, b, lda, iseed,
391  $ info )
392  xtype = 'C'
393 *
394 * --- Test ZHESV_AA ---
395 *
396  IF( ifact.EQ.2 ) THEN
397  CALL zlacpy( uplo, n, n, a, lda, afac, lda )
398  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
399 *
400 * Factor the matrix and solve the system using ZHESV.
401 *
402  srnamt = 'ZHESV_AA '
403  CALL zhesv_aa( uplo, n, nrhs, afac, lda, iwork,
404  $ x, lda, work, lwork, info )
405 *
406 * Adjust the expected value of INFO to account for
407 * pivoting.
408 *
409  IF( izero.GT.0 ) THEN
410  j = 1
411  k = izero
412  100 CONTINUE
413  IF( j.EQ.k ) THEN
414  k = iwork( j )
415  ELSE IF( iwork( j ).EQ.k ) THEN
416  k = j
417  END IF
418  IF( j.LT.k ) THEN
419  j = j + 1
420  GO TO 100
421  END IF
422  ELSE
423  k = 0
424  END IF
425 *
426 * Check error code from ZHESV .
427 *
428  IF( info.NE.k ) THEN
429  CALL alaerh( path, 'ZHESV_AA', info, k, uplo, n,
430  $ n, -1, -1, nrhs, imat, nfail,
431  $ nerrs, nout )
432  GO TO 120
433  ELSE IF( info.NE.0 ) THEN
434  GO TO 120
435  END IF
436 *
437 * Reconstruct matrix from factors and compute
438 * residual.
439 *
440  CALL zhet01_aa( uplo, n, a, lda, afac, lda,
441  $ iwork, ainv, lda, rwork,
442  $ result( 1 ) )
443 *
444 * Compute residual of the computed solution.
445 *
446  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
447  CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
448  $ lda, rwork, result( 2 ) )
449  nt = 2
450 *
451 * Print information about the tests that did not pass
452 * the threshold.
453 *
454  DO 110 k = 1, nt
455  IF( result( k ).GE.thresh ) THEN
456  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
457  $ CALL aladhd( nout, path )
458  WRITE( nout, fmt = 9999 )'ZHESV_AA', uplo, n,
459  $ imat, k, result( k )
460  nfail = nfail + 1
461  END IF
462  110 CONTINUE
463  nrun = nrun + nt
464  120 CONTINUE
465  END IF
466 *
467  150 CONTINUE
468 *
469  160 CONTINUE
470  170 CONTINUE
471  180 CONTINUE
472 *
473 * Print a summary of the results.
474 *
475  CALL alasvm( path, nout, nfail, nrun, nerrs )
476 *
477  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
478  $ ', test ', i2, ', ratio =', g12.5 )
479  RETURN
480 *
481 * End of ZDRVHE_AA
482 *
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
zhetri2
subroutine zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
Definition: zhetri2.f:129
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
zlanhe
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, or the element of largest absolute value of a complex Hermitian matrix.
Definition: zlanhe.f:126
zget04
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
zpot02
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
Definition: zpot02.f:129
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
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
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
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
aladhd
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:92
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
zhesv_aa
subroutine zhesv_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZHESV_AA computes the solution to system of linear equations A * X = B for HE matrices ...
Definition: zhesv_aa.f:166
zerrvx
subroutine zerrvx(PATH, NUNIT)
ZERRVX
Definition: zerrvx.f:57
zhetrf_aa
subroutine zhetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF_AA
Definition: zhetrf_aa.f:138
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
zhet01_aa
subroutine zhet01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01_AA
Definition: zhet01_aa.f:127

Here is the call graph for this function:

Here is the caller graph for this function: