3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
11 * SUBROUTINE ZDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
12 * A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
15 * .. Scalar Arguments ..
17 * INTEGER NMAX, NN, NOUT, NRHS
18 * DOUBLE PRECISION THRESH
20 * .. Array Arguments ..
22 * INTEGER IWORK( * ), NVAL( * )
23 * DOUBLE PRECISION RWORK( * )
24 * COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
25 * $ WORK( * ), X( * ), XACT( * )
34 *> ZDRVHE_AA tests the driver routine ZHESV_AA.
42 *> DOTYPE is LOGICAL array, dimension (NTYPES)
43 *> The matrix types to be used for testing. Matrices of type j
44 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
45 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
51 *> The number of values of N contained in the vector NVAL.
56 *> NVAL is INTEGER array, dimension (NN)
57 *> The values of the matrix dimension N.
63 *> The number of right hand side vectors to be generated for
64 *> each linear system.
69 *> THRESH is DOUBLE PRECISION
70 *> The threshold value for the test ratios. A result is
71 *> included in the output file if RESULT >= THRESH. To have
72 *> every test ratio printed, use THRESH = 0.
78 *> Flag that indicates whether error exits are to be tested.
84 *> The maximum value permitted for N, used in dimensioning the
90 *> A is COMPLEX*16 array, dimension (NMAX*NMAX)
95 *> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
100 *> AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
105 *> B is COMPLEX*16 array, dimension (NMAX*NRHS)
110 *> X is COMPLEX*16 array, dimension (NMAX*NRHS)
115 *> XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
120 *> WORK is COMPLEX*16 array, dimension (NMAX*max(2,NRHS))
125 *> RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
130 *> IWORK is INTEGER array, dimension (NMAX)
136 *> The unit number for output.
142 *> \author Univ. of Tennessee
143 *> \author Univ. of California Berkeley
144 *> \author Univ. of Colorado Denver
147 *> \date November 2016
149 *> \ingroup complex16_lin
151 * =====================================================================
152 SUBROUTINE ZDRVHE_AA( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
153 $ NMAX, A, AFAC, AINV, B, X, XACT, WORK,
154 $ RWORK, IWORK, NOUT )
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..--
161 * .. Scalar Arguments ..
163 INTEGER NMAX, NN, NOUT, NRHS
164 DOUBLE PRECISION THRESH
166 * .. Array Arguments ..
168 INTEGER IWORK( * ), NVAL( * )
169 DOUBLE PRECISION RWORK( * )
170 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
171 $ WORK( * ), X( * ), XACT( * )
174 * =====================================================================
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 )
182 PARAMETER ( NFACT = 2 )
184 * .. Local Scalars ..
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, RCONDC
194 CHARACTER FACTS( NFACT ), UPLOS( 2 )
195 INTEGER ISEED( 4 ), ISEEDY( 4 )
196 DOUBLE PRECISION RESULT( NTESTS )
198 * .. External Functions ..
199 DOUBLE PRECISION DGET06, ZLANHE
200 EXTERNAL DGET06, ZLANHE
202 * .. External Subroutines ..
203 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
204 $ ZHESV_AA, ZHET01_AA, ZHETRF_AA,
205 $ ZHETRI2, ZLACPY, ZLAIPD, ZLARHS, ZLATB4,
208 * .. Scalars in Common ..
213 * .. Common blocks ..
214 COMMON / INFOC / INFOT, NUNIT, OK, LERR
215 COMMON / SRNAMC / SRNAMT
217 * .. Intrinsic Functions ..
218 INTRINSIC DCMPLX, MAX, MIN
220 * .. Data statements ..
221 DATA ISEEDY / 1988, 1989, 1990, 1991 /
222 DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
224 * .. Executable Statements ..
226 * Initialize constants and the random number seed.
230 PATH( 1: 1 ) = 'Zomplex precision'
233 * Path to generate matrices
235 MATPATH( 1: 1 ) = 'Zomplex precision'
236 MATPATH( 2: 3 ) = 'HE'
242 ISEED( I ) = ISEEDY( I )
244 LWORK = MAX( 2*NMAX, NMAX*NRHS )
246 * Test the error exits
249 $ CALL ZERRVX( PATH, NOUT )
252 * Set the block size and minimum block size for testing.
257 CALL XLAENV( 2, NBMIN )
259 * Do for each value of N in NVAL
269 DO 170 IMAT = 1, NIMAT
271 * Do the tests only if DOTYPE( IMAT ) is true.
273 IF( .NOT.DOTYPE( IMAT ) )
276 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
278 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
279 IF( ZEROT .AND. N.LT.IMAT-2 )
282 * Do first for UPLO = 'U', then for UPLO = 'L'
285 UPLO = UPLOS( IUPLO )
287 * Begin generate the test matrix A.
289 * Set up parameters with ZLATB4 and generate a test matrix
292 CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM,
293 $ MODE, CNDNUM, DIST )
296 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
297 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
300 * Check error code from ZLATMS.
303 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
304 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
308 * For types 3-6, zero one or more rows and columns of the
309 * matrix to test that INFO is returned correctly.
314 ELSE IF( IMAT.EQ.4 ) THEN
322 * Set row and column IZERO to zero.
324 IF( IUPLO.EQ.1 ) THEN
325 IOFF = ( IZERO-1 )*LDA
326 DO 20 I = 1, IZERO - 1
336 DO 40 I = 1, IZERO - 1
347 IF( IUPLO.EQ.1 ) THEN
349 * Set the first IZERO rows and columns to zero.
361 * Set the last IZERO rows and columns to zero.
376 * Set the imaginary part of the diagonals.
378 CALL ZLAIPD( N, A, LDA+1, 0 )
380 DO 150 IFACT = 1, NFACT
382 * Do first for FACT = 'F', then for other values.
384 FACT = FACTS( IFACT )
386 * Compute the condition number for comparison with
387 * the value returned by ZHESVX.
395 * Form an exact solution and set the right hand side.
398 CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU,
399 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
403 * --- Test ZHESV_AA ---
405 IF( IFACT.EQ.2 ) THEN
406 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
407 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
409 * Factor the matrix and solve the system using ZHESV.
412 CALL ZHESV_AA( UPLO, N, NRHS, AFAC, LDA, IWORK,
413 $ X, LDA, WORK, LWORK, INFO )
415 * Adjust the expected value of INFO to account for
418 IF( IZERO.GT.0 ) THEN
424 ELSE IF( IWORK( J ).EQ.K ) THEN
435 * Check error code from ZHESV .
438 CALL ALAERH( PATH, 'ZHESV_AA', INFO, K, UPLO, N,
439 $ N, -1, -1, NRHS, IMAT, NFAIL,
442 ELSE IF( INFO.NE.0 ) THEN
446 * Reconstruct matrix from factors and compute
449 CALL ZHET01_AA( UPLO, N, A, LDA, AFAC, LDA,
450 $ IWORK, AINV, LDA, RWORK,
453 * Compute residual of the computed solution.
455 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
456 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
457 $ LDA, RWORK, RESULT( 2 ) )
460 * Print information about the tests that did not pass
464 IF( RESULT( K ).GE.THRESH ) THEN
465 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
466 $ CALL ALADHD( NOUT, PATH )
467 WRITE( NOUT, FMT = 9999 )'ZHESV_AA', UPLO, N,
468 $ IMAT, K, RESULT( K )
482 * Print a summary of the results.
484 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
486 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
487 $ ', test ', I2, ', ratio =', G12.5 )