LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ cdrvhe_aa()

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

Definition at line 155 of file cdrvhe_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  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 *
245 * Test the error exits
246 *
247  IF( tsterr )
248  $ CALL cerrvx( 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 CLATB4 for the matrix generator
291 * based on the type of matrix to be generated.
292 *
293  CALL clatb4( matpath, imat, n, n, TYPE, KL, KU, ANORM,
294  $ MODE, CNDNUM, DIST )
295 *
296 * Generate a matrix with CLATMS.
297 *
298  srnamt = 'CLATMS'
299  CALL clatms( n, n, dist, iseed, TYPE, RWORK, MODE,
300  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
301  $ WORK, INFO )
302 *
303 * Check error code from CLATMS and handle error.
304 *
305  IF( info.NE.0 ) THEN
306  CALL alaerh( path, 'CLATMS', 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 = 'CLARHS'
392  CALL clarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
393  $ nrhs, a, lda, xact, lda, b, lda, iseed,
394  $ info )
395  xtype = 'C'
396 *
397 * --- Test CHESV_AA ---
398 *
399  IF( ifact.EQ.2 ) THEN
400  CALL clacpy( uplo, n, n, a, lda, afac, lda )
401  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
402 *
403 * Factor the matrix and solve the system using CHESV_AA.
404 *
405  srnamt = 'CHESV_AA '
406  CALL chesv_aa( uplo, n, nrhs, afac, lda, iwork,
407  $ x, lda, work, lwork, info )
408 *
409 * Adjust the expected value of INFO to account for
410 * pivoting.
411 *
412  IF( izero.GT.0 ) THEN
413  j = 1
414  k = izero
415  100 CONTINUE
416  IF( j.EQ.k ) THEN
417  k = iwork( j )
418  ELSE IF( iwork( j ).EQ.k ) THEN
419  k = j
420  END IF
421  IF( j.LT.k ) THEN
422  j = j + 1
423  GO TO 100
424  END IF
425  ELSE
426  k = 0
427  END IF
428 *
429 * Check error code from CHESV_AA .
430 *
431  IF( info.NE.k ) THEN
432  CALL alaerh( path, 'CHESV_AA', info, k,
433  $ uplo, n, n, -1, -1, nrhs,
434  $ imat, nfail, nerrs, nout )
435  GO TO 120
436  ELSE IF( info.NE.0 ) THEN
437  GO TO 120
438  END IF
439 *
440 * Reconstruct matrix from factors and compute
441 * residual.
442 *
443  CALL chet01_aa( uplo, n, a, lda, afac, lda,
444  $ iwork, ainv, lda, rwork,
445  $ result( 1 ) )
446 *
447 * Compute residual of the computed solution.
448 *
449  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
450  CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
451  $ lda, rwork, result( 2 ) )
452  nt = 2
453 *
454 * Print information about the tests that did not pass
455 * the threshold.
456 *
457  DO 110 k = 1, nt
458  IF( result( k ).GE.thresh ) THEN
459  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
460  $ CALL aladhd( nout, path )
461  WRITE( nout, fmt = 9999 )'CHESV_AA ',
462  $ uplo, n, imat, k, result( k )
463  nfail = nfail + 1
464  END IF
465  110 CONTINUE
466  nrun = nrun + nt
467  120 CONTINUE
468  END IF
469 *
470  150 CONTINUE
471 *
472  160 CONTINUE
473  170 CONTINUE
474  180 CONTINUE
475 *
476 * Print a summary of the results.
477 *
478  CALL alasvm( path, nout, nfail, nrun, nerrs )
479 *
480  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
481  $ ', test ', i2, ', ratio =', g12.5 )
482  RETURN
483 *
484 * End of CDRVHE_AA
485 *
Here is the call graph for this function:
Here is the caller graph for this function:
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
cerrvx
subroutine cerrvx(PATH, NUNIT)
CERRVX
Definition: cerrvx.f:57
chet01_aa
subroutine chet01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01_AA
Definition: chet01_aa.f:127
cget04
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
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
cpot02
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
Definition: cpot02.f:129
sget06
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
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,...
Definition: clanhe.f:126
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
chetrf_aa
subroutine chetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_AA
Definition: chetrf_aa.f:134
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
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:164
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
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83