LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ zdrvhe_aa()

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
November 2017

Definition at line 155 of file zdrvhe_aa.f.

155 *
156 * -- LAPACK test routine (version 3.8.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 * November 2017
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 *
245 * Test the error exits
246 *
247  IF( tsterr )
248  $ CALL zerrvx( path, nout )
249  infot = 0
250 *
251 * Set the block size and minimum block size for testing.
252 *
253  nb = 1
254  nbmin = 2
255  CALL xlaenv( 1, nb )
256  CALL xlaenv( 2, nbmin )
257 *
258 * Do for each value of N in NVAL
259 *
260  DO 180 in = 1, nn
261  n = nval( in )
262  lwork = max( 3*n-2, n*(1+nb) )
263  lwork = max( lwork, 1 )
264  lda = max( n, 1 )
265  xtype = 'N'
266  nimat = ntypes
267  IF( n.LE.0 )
268  $ nimat = 1
269 *
270  DO 170 imat = 1, nimat
271 *
272 * Do the tests only if DOTYPE( IMAT ) is true.
273 *
274  IF( .NOT.dotype( imat ) )
275  $ GO TO 170
276 *
277 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
278 *
279  zerot = imat.GE.3 .AND. imat.LE.6
280  IF( zerot .AND. n.LT.imat-2 )
281  $ GO TO 170
282 *
283 * Do first for UPLO = 'U', then for UPLO = 'L'
284 *
285  DO 160 iuplo = 1, 2
286  uplo = uplos( iuplo )
287 *
288 * Begin generate the test matrix A.
289 *
290 * Set up parameters with ZLATB4 and generate a test matrix
291 * with ZLATMS.
292 *
293  CALL zlatb4( matpath, 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, UPLO, A, LDA, WORK,
299  $ 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, -1,
305  $ -1, -1, imat, nfail, nerrs, nout )
306  GO TO 160
307  END IF
308 *
309 * For types 3-6, zero one or more rows and columns of the
310 * 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 )*lda
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 + lda
334  30 CONTINUE
335  ELSE
336  ioff = izero
337  DO 40 i = 1, izero - 1
338  a( ioff ) = zero
339  ioff = ioff + lda
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  ioff = 0
348  IF( iuplo.EQ.1 ) THEN
349 *
350 * Set the first IZERO rows and columns to zero.
351 *
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 + lda
358  70 CONTINUE
359  izero = 1
360  ELSE
361 *
362 * Set the last IZERO rows and columns to zero.
363 *
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 + lda
370  90 CONTINUE
371  END IF
372  END IF
373  ELSE
374  izero = 0
375  END IF
376 *
377 * Set the imaginary part of the diagonals.
378 *
379  CALL zlaipd( n, a, lda+1, 0 )
380 *
381  DO 150 ifact = 1, nfact
382 *
383 * Do first for FACT = 'F', then for other values.
384 *
385  fact = facts( ifact )
386 *
387 * Form an exact solution and set the right hand side.
388 *
389  srnamt = 'ZLARHS'
390  CALL zlarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
391  $ nrhs, a, lda, xact, lda, b, lda, iseed,
392  $ info )
393  xtype = 'C'
394 *
395 * --- Test ZHESV_AA ---
396 *
397  IF( ifact.EQ.2 ) THEN
398  CALL zlacpy( uplo, n, n, a, lda, afac, lda )
399  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
400 *
401 * Factor the matrix and solve the system using ZHESV.
402 *
403  srnamt = 'ZHESV_AA '
404  CALL zhesv_aa( uplo, n, nrhs, afac, lda, iwork,
405  $ x, lda, work, lwork, info )
406 *
407 * Adjust the expected value of INFO to account for
408 * pivoting.
409 *
410  IF( izero.GT.0 ) THEN
411  j = 1
412  k = izero
413  100 CONTINUE
414  IF( j.EQ.k ) THEN
415  k = iwork( j )
416  ELSE IF( iwork( j ).EQ.k ) THEN
417  k = j
418  END IF
419  IF( j.LT.k ) THEN
420  j = j + 1
421  GO TO 100
422  END IF
423  ELSE
424  k = 0
425  END IF
426 *
427 * Check error code from ZHESV .
428 *
429  IF( info.NE.k ) THEN
430  CALL alaerh( path, 'ZHESV_AA', info, k, uplo, n,
431  $ n, -1, -1, nrhs, imat, nfail,
432  $ nerrs, nout )
433  GO TO 120
434  ELSE IF( info.NE.0 ) THEN
435  GO TO 120
436  END IF
437 *
438 * Reconstruct matrix from factors and compute
439 * residual.
440 *
441  CALL zhet01_aa( uplo, n, a, lda, afac, lda,
442  $ iwork, ainv, lda, rwork,
443  $ result( 1 ) )
444 *
445 * Compute residual of the computed solution.
446 *
447  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
448  CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
449  $ lda, rwork, result( 2 ) )
450  nt = 2
451 *
452 * Print information about the tests that did not pass
453 * the threshold.
454 *
455  DO 110 k = 1, nt
456  IF( result( k ).GE.thresh ) THEN
457  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
458  $ CALL aladhd( nout, path )
459  WRITE( nout, fmt = 9999 )'ZHESV_AA', uplo, n,
460  $ imat, k, result( k )
461  nfail = nfail + 1
462  END IF
463  110 CONTINUE
464  nrun = nrun + nt
465  120 CONTINUE
466  END IF
467 *
468  150 CONTINUE
469 *
470  160 CONTINUE
471  170 CONTINUE
472  180 CONTINUE
473 *
474 * Print a summary of the results.
475 *
476  CALL alasvm( path, nout, nfail, nrun, nerrs )
477 *
478  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
479  $ ', test ', i2, ', ratio =', g12.5 )
480  RETURN
481 *
482 * End of ZDRVHE_AA
483 *
Here is the call graph for this function:
Here is the caller graph for this function:
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
zerrvx
subroutine zerrvx(PATH, NUNIT)
ZERRVX
Definition: zerrvx.f:57
zhet01_aa
subroutine zhet01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01_AA
Definition: zhet01_aa.f:127
zpot02
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
Definition: zpot02.f:129
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
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:164
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
zhetri2
subroutine zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
Definition: zhetri2.f:129
zlaipd
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
Definition: zlaipd.f:85
zhetrf_aa
subroutine zhetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF_AA
Definition: zhetrf_aa.f:134
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,...
Definition: zlanhe.f:126
zget04
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
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
aladhd
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:92
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
zlatb4
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334