LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
subroutine cdrvhe_aa ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NRHS,
real  THRESH,
logical  TSTERR,
integer  NMAX,
complex, dimension( * )  A,
complex, dimension( * )  AFAC,
complex, dimension( * )  AINV,
complex, dimension( * )  B,
complex, dimension( * )  X,
complex, dimension( * )  XACT,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

CDRVHE_AA

Purpose: 
 CDRVHE_AA tests the driver routine CHESV_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 REAL
          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 array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX array, dimension (NMAX*NRHS)
[out]X
          X is COMPLEX array, dimension (NMAX*NRHS)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NRHS)
[out]WORK
          WORK is COMPLEX array, dimension (NMAX*max(2,NRHS))
[out]RWORK
          RWORK is REAL 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 cdrvhe_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  REAL thresh
165 * ..
166 * .. Array Arguments ..
167  LOGICAL dotype( * )
168  INTEGER iwork( * ), nval( * )
169  REAL rwork( * )
170  COMPLEX a( * ), afac( * ), ainv( * ), b( * ),
171  $ work( * ), x( * ), xact( * )
172 * ..
173 *
174 * =====================================================================
175 *
176 * .. Parameters ..
177  REAL one, zero
178  parameter ( one = 1.0e+0, zero = 0.0e+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  REAL anorm, cndnum
192 * ..
193 * .. Local Arrays ..
194  CHARACTER facts( nfact ), uplos( 2 )
195  INTEGER iseed( 4 ), iseedy( 4 )
196  REAL result( ntests )
197 * ..
198 * .. External Functions ..
199  REAL clanhe, sget06
200  EXTERNAL clanhe, sget06
201 * ..
202 * .. External Subroutines ..
203  EXTERNAL aladhd, alaerh, alasvm, xlaenv, cerrvx,
204  $ cget04, clacpy, clarhs, clatb4, clatms,
205  $ chesv_aa, chet01_aa, cpot02,
206  $ chetrf_aa
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 cmplx, 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 ) = 'Complex precision'
231  path( 2: 3 ) = 'HA'
232 *
233 * Path to generate matrices
234 *
235  matpath( 1: 1 ) = 'Complex 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 cerrvx( 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 CLATB4 for the matrix generator
290 * based on the type of matrix to be generated.
291 *
292  CALL clatb4( matpath, imat, n, n, TYPE, kl, ku, anorm,
293  $ mode, cndnum, dist )
294 *
295 * Generate a matrix with CLATMS.
296 *
297  srnamt = 'CLATMS'
298  CALL clatms( n, n, dist, iseed, TYPE, rwork, mode,
299  $ cndnum, anorm, kl, ku, uplo, a, lda,
300  $ work, info )
301 *
302 * Check error code from CLATMS and handle error.
303 *
304  IF( info.NE.0 ) THEN
305  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n,
306  $ -1, -1, -1, imat, nfail, nerrs, nout )
307  GO TO 160
308  END IF
309 *
310 * For types 3-6, zero one or more rows and columns of
311 * the matrix to test that INFO is returned correctly.
312 *
313  IF( zerot ) THEN
314  IF( imat.EQ.3 ) THEN
315  izero = 1
316  ELSE IF( imat.EQ.4 ) THEN
317  izero = n
318  ELSE
319  izero = n / 2 + 1
320  END IF
321 *
322  IF( imat.LT.6 ) THEN
323 *
324 * Set row and column IZERO to zero.
325 *
326  IF( iuplo.EQ.1 ) THEN
327  ioff = ( izero-1 )*lda
328  DO 20 i = 1, izero - 1
329  a( ioff+i ) = zero
330  20 CONTINUE
331  ioff = ioff + izero
332  DO 30 i = izero, n
333  a( ioff ) = zero
334  ioff = ioff + lda
335  30 CONTINUE
336  ELSE
337  ioff = izero
338  DO 40 i = 1, izero - 1
339  a( ioff ) = zero
340  ioff = ioff + lda
341  40 CONTINUE
342  ioff = ioff - izero
343  DO 50 i = izero, n
344  a( ioff+i ) = zero
345  50 CONTINUE
346  END IF
347  ELSE
348  ioff = 0
349  IF( iuplo.EQ.1 ) THEN
350 *
351 * Set the first IZERO rows and columns to zero.
352 *
353  DO 70 j = 1, n
354  i2 = min( j, izero )
355  DO 60 i = 1, i2
356  a( ioff+i ) = zero
357  60 CONTINUE
358  ioff = ioff + lda
359  70 CONTINUE
360  izero = 1
361  ELSE
362 *
363 * Set the first IZERO rows and columns to zero.
364 *
365  ioff = 0
366  DO 90 j = 1, n
367  i1 = max( j, izero )
368  DO 80 i = i1, n
369  a( ioff+i ) = zero
370  80 CONTINUE
371  ioff = ioff + lda
372  90 CONTINUE
373  END IF
374  END IF
375  ELSE
376  izero = 0
377  END IF
378 *
379 * End generate the test matrix A.
380 *
381 *
382  DO 150 ifact = 1, nfact
383 *
384 * Do first for FACT = 'F', then for other values.
385 *
386  fact = facts( ifact )
387 *
388 * Form an exact solution and set the right hand side.
389 *
390  srnamt = 'CLARHS'
391  CALL clarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
392  $ nrhs, a, lda, xact, lda, b, lda, iseed,
393  $ info )
394  xtype = 'C'
395 *
396 * --- Test CHESV_AA ---
397 *
398  IF( ifact.EQ.2 ) THEN
399  CALL clacpy( uplo, n, n, a, lda, afac, lda )
400  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
401 *
402 * Factor the matrix and solve the system using CHESV_AA.
403 *
404  srnamt = 'CHESV_AA '
405  CALL chesv_aa( uplo, n, nrhs, afac, lda, iwork,
406  $ x, lda, work, lwork, info )
407 *
408 * Adjust the expected value of INFO to account for
409 * pivoting.
410 *
411  IF( izero.GT.0 ) THEN
412  j = 1
413  k = izero
414  100 CONTINUE
415  IF( j.EQ.k ) THEN
416  k = iwork( j )
417  ELSE IF( iwork( j ).EQ.k ) THEN
418  k = j
419  END IF
420  IF( j.LT.k ) THEN
421  j = j + 1
422  GO TO 100
423  END IF
424  ELSE
425  k = 0
426  END IF
427 *
428 * Check error code from CHESV_AA .
429 *
430  IF( info.NE.k ) THEN
431  CALL alaerh( path, 'CHESV_AA', info, k,
432  $ uplo, n, n, -1, -1, nrhs,
433  $ imat, nfail, nerrs, nout )
434  GO TO 120
435  ELSE IF( info.NE.0 ) THEN
436  GO TO 120
437  END IF
438 *
439 * Reconstruct matrix from factors and compute
440 * residual.
441 *
442  CALL chet01_aa( uplo, n, a, lda, afac, lda,
443  $ iwork, ainv, lda, rwork,
444  $ result( 1 ) )
445 *
446 * Compute residual of the computed solution.
447 *
448  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
449  CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
450  $ lda, rwork, result( 2 ) )
451  nt = 2
452 *
453 * Print information about the tests that did not pass
454 * the threshold.
455 *
456  DO 110 k = 1, nt
457  IF( result( k ).GE.thresh ) THEN
458  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
459  $ CALL aladhd( nout, path )
460  WRITE( nout, fmt = 9999 )'CHESV_AA ',
461  $ uplo, n, imat, k, result( k )
462  nfail = nfail + 1
463  END IF
464  110 CONTINUE
465  nrun = nrun + nt
466  120 CONTINUE
467  END IF
468 *
469  150 CONTINUE
470 *
471  160 CONTINUE
472  170 CONTINUE
473  180 CONTINUE
474 *
475 * Print a summary of the results.
476 *
477  CALL alasvm( path, nout, nfail, nrun, nerrs )
478 *
479  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
480  $ ', test ', i2, ', ratio =', g12.5 )
481  RETURN
482 *
483 * End of CDRVHE_AA
484 *
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
clarhs
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
cerrvx
subroutine cerrvx(PATH, NUNIT)
CERRVX
Definition: cerrvx.f:57
sget06
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
cpot02
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
Definition: cpot02.f:129
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
aladhd
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:92
clacpy
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
chet01_aa
subroutine chet01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01_AA
Definition: chet01_aa.f:127
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
chetrf_aa
subroutine chetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_AA
Definition: chetrf_aa.f:138
chesv_aa
subroutine chesv_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHESV_AA computes the solution to system of linear equations A * X = B for HE matrices ...
Definition: chesv_aa.f:166
clanhe
real function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE 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: clanhe.f:126
cget04
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104

Here is the call graph for this function:

Here is the caller graph for this function: