LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ zdrvhe_aa_2stage()

subroutine zdrvhe_aa_2stage ( 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_2STAGE

Purpose:
 ZDRVHE_AA_2STAGE tests the driver routine ZHESV_AA_2STAGE.
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 157 of file zdrvhe_aa_2stage.f.

157 *
158 * -- LAPACK test routine (version 3.8.0) --
159 * -- LAPACK is a software package provided by Univ. of Tennessee, --
160 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
161 * November 2017
162 *
163 * .. Scalar Arguments ..
164  LOGICAL TSTERR
165  INTEGER NMAX, NN, NOUT, NRHS
166  DOUBLE PRECISION THRESH
167 * ..
168 * .. Array Arguments ..
169  LOGICAL DOTYPE( * )
170  INTEGER IWORK( * ), NVAL( * )
171  DOUBLE PRECISION RWORK( * )
172  COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
173  $ WORK( * ), X( * ), XACT( * )
174 * ..
175 *
176 * =====================================================================
177 *
178 * .. Parameters ..
179  DOUBLE PRECISION ONE, ZERO
180  parameter( one = 1.0d+0, zero = 0.0d+0 )
181  INTEGER NTYPES, NTESTS
182  parameter( ntypes = 10, ntests = 3 )
183  INTEGER NFACT
184  parameter( nfact = 2 )
185 * ..
186 * .. Local Scalars ..
187  LOGICAL ZEROT
188  CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
189  CHARACTER*3 MATPATH, PATH
190  INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
191  $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
192  $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
193  DOUBLE PRECISION ANORM, CNDNUM
194 * ..
195 * .. Local Arrays ..
196  CHARACTER FACTS( NFACT ), UPLOS( 2 )
197  INTEGER ISEED( 4 ), ISEEDY( 4 )
198  DOUBLE PRECISION RESULT( NTESTS )
199 * ..
200 * .. External Functions ..
201  DOUBLE PRECISION DGET06, ZLANHE
202  EXTERNAL dget06, zlanhe
203 * ..
204 * .. External Subroutines ..
205  EXTERNAL aladhd, alaerh, alasvm, xlaenv, zerrvx,
206  $ zget04, zlacpy, zlarhs, zlatb4, zlatms,
207  $ zhesv_aa_2stage, zhet01_aa, zpot02,
208  $ zhetrf_aa_2stage
209 * ..
210 * .. Scalars in Common ..
211  LOGICAL LERR, OK
212  CHARACTER*32 SRNAMT
213  INTEGER INFOT, NUNIT
214 * ..
215 * .. Common blocks ..
216  COMMON / infoc / infot, nunit, ok, lerr
217  COMMON / srnamc / srnamt
218 * ..
219 * .. Intrinsic Functions ..
220  INTRINSIC dcmplx, max, min
221 * ..
222 * .. Data statements ..
223  DATA iseedy / 1988, 1989, 1990, 1991 /
224  DATA uplos / 'U', 'L' / , facts / 'F', 'N' /
225 * ..
226 * .. Executable Statements ..
227 *
228 * Initialize constants and the random number seed.
229 *
230 * Test path
231 *
232  path( 1: 1 ) = 'Zomplex precision'
233  path( 2: 3 ) = 'H2'
234 *
235 * Path to generate matrices
236 *
237  matpath( 1: 1 ) = 'Zomplex precision'
238  matpath( 2: 3 ) = 'HE'
239 *
240  nrun = 0
241  nfail = 0
242  nerrs = 0
243  DO 10 i = 1, 4
244  iseed( i ) = iseedy( i )
245  10 CONTINUE
246 *
247 * Test the error exits
248 *
249  IF( tsterr )
250  $ CALL zerrvx( path, nout )
251  infot = 0
252 *
253 * Set the block size and minimum block size for testing.
254 *
255  nb = 1
256  nbmin = 2
257  CALL xlaenv( 1, nb )
258  CALL xlaenv( 2, nbmin )
259 *
260 * Do for each value of N in NVAL
261 *
262  DO 180 in = 1, nn
263  n = nval( in )
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 for the matrix generator
291 * based on the type of matrix to be generated.
292 *
293  CALL zlatb4( matpath, imat, n, n, TYPE, KL, KU, ANORM,
294  $ MODE, CNDNUM, DIST )
295 *
296 * Generate a matrix with ZLATMS.
297 *
298  srnamt = 'ZLATMS'
299  CALL zlatms( n, n, dist, iseed, TYPE, RWORK, MODE,
300  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
301  $ WORK, INFO )
302 *
303 * Check error code from ZLATMS and handle error.
304 *
305  IF( info.NE.0 ) THEN
306  CALL alaerh( path, 'ZLATMS', info, 0, uplo, n, n,
307  $ -1, -1, -1, imat, nfail, nerrs, nout )
308  GO TO 160
309  END IF
310 *
311 * For types 3-6, zero one or more rows and columns of
312 * the matrix to test that INFO is returned correctly.
313 *
314  IF( zerot ) THEN
315  IF( imat.EQ.3 ) THEN
316  izero = 1
317  ELSE IF( imat.EQ.4 ) THEN
318  izero = n
319  ELSE
320  izero = n / 2 + 1
321  END IF
322 *
323  IF( imat.LT.6 ) THEN
324 *
325 * Set row and column IZERO to zero.
326 *
327  IF( iuplo.EQ.1 ) THEN
328  ioff = ( izero-1 )*lda
329  DO 20 i = 1, izero - 1
330  a( ioff+i ) = zero
331  20 CONTINUE
332  ioff = ioff + izero
333  DO 30 i = izero, n
334  a( ioff ) = zero
335  ioff = ioff + lda
336  30 CONTINUE
337  ELSE
338  ioff = izero
339  DO 40 i = 1, izero - 1
340  a( ioff ) = zero
341  ioff = ioff + lda
342  40 CONTINUE
343  ioff = ioff - izero
344  DO 50 i = izero, n
345  a( ioff+i ) = zero
346  50 CONTINUE
347  END IF
348  ELSE
349  ioff = 0
350  IF( iuplo.EQ.1 ) THEN
351 *
352 * Set the first IZERO rows and columns to zero.
353 *
354  DO 70 j = 1, n
355  i2 = min( j, izero )
356  DO 60 i = 1, i2
357  a( ioff+i ) = zero
358  60 CONTINUE
359  ioff = ioff + lda
360  70 CONTINUE
361  izero = 1
362  ELSE
363 *
364 * Set the first IZERO rows and columns to zero.
365 *
366  ioff = 0
367  DO 90 j = 1, n
368  i1 = max( j, izero )
369  DO 80 i = i1, n
370  a( ioff+i ) = zero
371  80 CONTINUE
372  ioff = ioff + lda
373  90 CONTINUE
374  END IF
375  END IF
376  ELSE
377  izero = 0
378  END IF
379 *
380 * End generate the test matrix A.
381 *
382 *
383  DO 150 ifact = 1, nfact
384 *
385 * Do first for FACT = 'F', then for other values.
386 *
387  fact = facts( ifact )
388 *
389 * Form an exact solution and set the right hand side.
390 *
391  srnamt = 'ZLARHS'
392  CALL zlarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
393  $ nrhs, a, lda, xact, lda, b, lda, iseed,
394  $ info )
395  xtype = 'C'
396 *
397 * --- Test ZHESV_AA_2STAGE ---
398 *
399  IF( ifact.EQ.2 ) THEN
400  CALL zlacpy( uplo, n, n, a, lda, afac, lda )
401  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
402 *
403 * Factor the matrix and solve the system using ZHESV_AA.
404 *
405  srnamt = 'ZHESV_AA_2STAGE '
406  lwork = min(n*nb, 3*nmax*nmax)
407  CALL zhesv_aa_2stage( uplo, n, nrhs, afac, lda,
408  $ ainv, (3*nb+1)*n,
409  $ iwork, iwork( 1+n ),
410  $ x, lda, work, lwork, info )
411 *
412 * Adjust the expected value of INFO to account for
413 * pivoting.
414 *
415  IF( izero.GT.0 ) THEN
416  j = 1
417  k = izero
418  100 CONTINUE
419  IF( j.EQ.k ) THEN
420  k = iwork( j )
421  ELSE IF( iwork( j ).EQ.k ) THEN
422  k = j
423  END IF
424  IF( j.LT.k ) THEN
425  j = j + 1
426  GO TO 100
427  END IF
428  ELSE
429  k = 0
430  END IF
431 *
432 * Check error code from ZHESV_AA .
433 *
434  IF( info.NE.k ) THEN
435  CALL alaerh( path, 'ZHESV_AA', info, k,
436  $ uplo, n, n, -1, -1, nrhs,
437  $ imat, nfail, nerrs, nout )
438  GO TO 120
439  ELSE IF( info.NE.0 ) THEN
440  GO TO 120
441  END IF
442 *
443 * Compute residual of the computed solution.
444 *
445  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
446  CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
447  $ lda, rwork, result( 1 ) )
448 *
449 * Reconstruct matrix from factors and compute
450 * residual.
451 *
452 * NEED TO CREATE ZHET01_AA_2STAGE
453 * CALL ZHET01_AA( UPLO, N, A, LDA, AFAC, LDA,
454 * $ IWORK, AINV, LDA, RWORK,
455 * $ RESULT( 2 ) )
456 * NT = 2
457  nt = 1
458 *
459 * Print information about the tests that did not pass
460 * the threshold.
461 *
462  DO 110 k = 1, nt
463  IF( result( k ).GE.thresh ) THEN
464  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
465  $ CALL aladhd( nout, path )
466  WRITE( nout, fmt = 9999 )'ZHESV_AA_2STAGE',
467  $ uplo, n, imat, k, result( k )
468  nfail = nfail + 1
469  END IF
470  110 CONTINUE
471  nrun = nrun + nt
472  120 CONTINUE
473  END IF
474 *
475  150 CONTINUE
476 *
477  160 CONTINUE
478  170 CONTINUE
479  180 CONTINUE
480 *
481 * Print a summary of the results.
482 *
483  CALL alasvm( path, nout, nfail, nrun, nerrs )
484 *
485  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
486  $ ', test ', i2, ', ratio =', g12.5 )
487  RETURN
488 *
489 * End of ZDRVHE_AA_2STAGE
490 *
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
zhesv_aa_2stage
subroutine zhesv_aa_2stage(UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, IPIV2, B, LDB, WORK, LWORK, INFO)
ZHESV_AA_2STAGE computes the solution to system of linear equations A * X = B for HE matrices
Definition: zhesv_aa_2stage.f:189
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
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
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
zhetrf_aa_2stage
subroutine zhetrf_aa_2stage(UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, WORK, LWORK, INFO)
ZHETRF_AA_2STAGE
Definition: zhetrf_aa_2stage.f:162
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334