LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ cchkhe_aa_2stage()

subroutine cchkhe_aa_2stage ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
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 
)

CCHKHE_AA_2STAGE

Purpose:
 CCHKSY_AA_2STAGE tests CHETRF_AA_2STAGE, -TRS_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]NNB
          NNB is INTEGER
          The number of values of NB contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NBVAL)
          The values of the blocksize NB.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[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*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX array, dimension (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL array, dimension (max(NMAX,2*NSMAX))
[out]IWORK
          IWORK is INTEGER array, dimension (2*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 175 of file cchkhe_aa_2stage.f.

175 *
176 * -- LAPACK test routine (version 3.8.0) --
177 * -- LAPACK is a software package provided by Univ. of Tennessee, --
178 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
179 * November 2017
180 *
181  IMPLICIT NONE
182 *
183 * .. Scalar Arguments ..
184  LOGICAL TSTERR
185  INTEGER NN, NNB, NNS, NMAX, NOUT
186  REAL THRESH
187 * ..
188 * .. Array Arguments ..
189 *
190  LOGICAL DOTYPE( * )
191  INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
192  REAL RWORK( * )
193  COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
194  $ WORK( * ), X( * ), XACT( * )
195 * ..
196 *
197 * =====================================================================
198 *
199 * .. Parameters ..
200  REAL ZERO
201  parameter( zero = 0.0e+0 )
202  COMPLEX CZERO
203  parameter( czero = ( 0.0e+0, 0.0e+0 ) )
204  INTEGER NTYPES
205  parameter( ntypes = 10 )
206  INTEGER NTESTS
207  parameter( ntests = 9 )
208 * ..
209 * .. Local Scalars ..
210  LOGICAL ZEROT
211  CHARACTER DIST, TYPE, UPLO, XTYPE
212  CHARACTER*3 PATH, MATPATH
213  INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
214  $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
215  $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
216  REAL ANORM, CNDNUM
217 * ..
218 * .. Local Arrays ..
219  CHARACTER UPLOS( 2 )
220  INTEGER ISEED( 4 ), ISEEDY( 4 )
221  REAL RESULT( NTESTS )
222 * ..
223 * .. External Subroutines ..
224  EXTERNAL alaerh, alahd, alasum, cerrhe, clacpy,
225  $ clarhs, clatb4, clatms, cpot02,
226  $ chetrf_aa_2stage,
227  $ chetrs_aa_2stage, xlaenv
228 * ..
229 * .. Intrinsic Functions ..
230  INTRINSIC max, min
231 * ..
232 * .. Scalars in Common ..
233  LOGICAL LERR, OK
234  CHARACTER*32 SRNAMT
235  INTEGER INFOT, NUNIT
236 * ..
237 * .. Common blocks ..
238  COMMON / infoc / infot, nunit, ok, lerr
239  COMMON / srnamc / srnamt
240 * ..
241 * .. Data statements ..
242  DATA iseedy / 1988, 1989, 1990, 1991 /
243  DATA uplos / 'U', 'L' /
244 * ..
245 * .. Executable Statements ..
246 *
247 * Initialize constants and the random number seed.
248 *
249 *
250 * Test path
251 *
252  path( 1: 1 ) = 'Complex precision'
253  path( 2: 3 ) = 'H2'
254 *
255 * Path to generate matrices
256 *
257  matpath( 1: 1 ) = 'Complex precision'
258  matpath( 2: 3 ) = 'HE'
259  nrun = 0
260  nfail = 0
261  nerrs = 0
262  DO 10 i = 1, 4
263  iseed( i ) = iseedy( i )
264  10 CONTINUE
265 *
266 * Test the error exits
267 *
268  IF( tsterr )
269  $ CALL cerrhe( path, nout )
270  infot = 0
271 *
272 * Set the minimum block size for which the block routine should
273 * be used, which will be later returned by ILAENV
274 *
275  CALL xlaenv( 2, 2 )
276 *
277 * Do for each value of N in NVAL
278 *
279  DO 180 in = 1, nn
280  n = nval( in )
281  IF( n .GT. nmax ) THEN
282  nfail = nfail + 1
283  WRITE(nout, 9995) 'M ', n, nmax
284  GO TO 180
285  END IF
286  lda = max( n, 1 )
287  xtype = 'N'
288  nimat = ntypes
289  IF( n.LE.0 )
290  $ nimat = 1
291 *
292  izero = 0
293 *
294 * Do for each value of matrix type IMAT
295 *
296  DO 170 imat = 1, nimat
297 *
298 * Do the tests only if DOTYPE( IMAT ) is true.
299 *
300  IF( .NOT.dotype( imat ) )
301  $ GO TO 170
302 *
303 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
304 *
305  zerot = imat.GE.3 .AND. imat.LE.6
306  IF( zerot .AND. n.LT.imat-2 )
307  $ GO TO 170
308 *
309 * Do first for UPLO = 'U', then for UPLO = 'L'
310 *
311  DO 160 iuplo = 1, 2
312  uplo = uplos( iuplo )
313 *
314 * Begin generate the test matrix A.
315 *
316 *
317 * Set up parameters with CLATB4 for the matrix generator
318 * based on the type of matrix to be generated.
319 *
320  CALL clatb4( matpath, imat, n, n, TYPE, KL, KU,
321  $ ANORM, MODE, CNDNUM, DIST )
322 *
323 * Generate a matrix with CLATMS.
324 *
325  srnamt = 'CLATMS'
326  CALL clatms( n, n, dist, iseed, TYPE, RWORK, MODE,
327  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
328  $ INFO )
329 *
330 * Check error code from CLATMS and handle error.
331 *
332  IF( info.NE.0 ) THEN
333  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n, -1,
334  $ -1, -1, imat, nfail, nerrs, nout )
335 *
336 * Skip all tests for this generated matrix
337 *
338  GO TO 160
339  END IF
340 *
341 * For matrix types 3-6, zero one or more rows and
342 * columns of the matrix to test that INFO is returned
343 * correctly.
344 *
345  IF( zerot ) THEN
346  IF( imat.EQ.3 ) THEN
347  izero = 1
348  ELSE IF( imat.EQ.4 ) THEN
349  izero = n
350  ELSE
351  izero = n / 2 + 1
352  END IF
353 *
354  IF( imat.LT.6 ) THEN
355 *
356 * Set row and column IZERO to zero.
357 *
358  IF( iuplo.EQ.1 ) THEN
359  ioff = ( izero-1 )*lda
360  DO 20 i = 1, izero - 1
361  a( ioff+i ) = czero
362  20 CONTINUE
363  ioff = ioff + izero
364  DO 30 i = izero, n
365  a( ioff ) = czero
366  ioff = ioff + lda
367  30 CONTINUE
368  ELSE
369  ioff = izero
370  DO 40 i = 1, izero - 1
371  a( ioff ) = czero
372  ioff = ioff + lda
373  40 CONTINUE
374  ioff = ioff - izero
375  DO 50 i = izero, n
376  a( ioff+i ) = czero
377  50 CONTINUE
378  END IF
379  ELSE
380  IF( iuplo.EQ.1 ) THEN
381 *
382 * Set the first IZERO rows and columns to zero.
383 *
384  ioff = 0
385  DO 70 j = 1, n
386  i2 = min( j, izero )
387  DO 60 i = 1, i2
388  a( ioff+i ) = czero
389  60 CONTINUE
390  ioff = ioff + lda
391  70 CONTINUE
392  izero = 1
393  ELSE
394 *
395 * Set the last IZERO rows and columns to zero.
396 *
397  ioff = 0
398  DO 90 j = 1, n
399  i1 = max( j, izero )
400  DO 80 i = i1, n
401  a( ioff+i ) = czero
402  80 CONTINUE
403  ioff = ioff + lda
404  90 CONTINUE
405  END IF
406  END IF
407  ELSE
408  izero = 0
409  END IF
410 *
411 * End generate test matrix A.
412 *
413 *
414 * Set the imaginary part of the diagonals.
415 *
416  CALL claipd( n, a, lda+1, 0 )
417 *
418 * Do for each value of NB in NBVAL
419 *
420  DO 150 inb = 1, nnb
421 *
422 * Set the optimal blocksize, which will be later
423 * returned by ILAENV.
424 *
425  nb = nbval( inb )
426  CALL xlaenv( 1, nb )
427 *
428 * Copy the test matrix A into matrix AFAC which
429 * will be factorized in place. This is needed to
430 * preserve the test matrix A for subsequent tests.
431 *
432  CALL clacpy( uplo, n, n, a, lda, afac, lda )
433 *
434 * Compute the L*D*L**T or U*D*U**T factorization of the
435 * matrix. IWORK stores details of the interchanges and
436 * the block structure of D. AINV is a work array for
437 * block factorization, LWORK is the length of AINV.
438 *
439  srnamt = 'CHETRF_AA_2STAGE'
440  lwork = min(n*nb, 3*nmax*nmax)
441  CALL chetrf_aa_2stage( uplo, n, afac, lda,
442  $ ainv, (3*nb+1)*n,
443  $ iwork, iwork( 1+n ),
444  $ work, lwork,
445  $ info )
446 *
447 * Adjust the expected value of INFO to account for
448 * pivoting.
449 *
450  IF( izero.GT.0 ) THEN
451  j = 1
452  k = izero
453  100 CONTINUE
454  IF( j.EQ.k ) THEN
455  k = iwork( j )
456  ELSE IF( iwork( j ).EQ.k ) THEN
457  k = j
458  END IF
459  IF( j.LT.k ) THEN
460  j = j + 1
461  GO TO 100
462  END IF
463  ELSE
464  k = 0
465  END IF
466 *
467 * Check error code from CHETRF and handle error.
468 *
469  IF( info.NE.k ) THEN
470  CALL alaerh( path, 'CHETRF_AA_2STAGE', info, k,
471  $ uplo, n, n, -1, -1, nb, imat, nfail,
472  $ nerrs, nout )
473  END IF
474 *
475 *+ TEST 1
476 * Reconstruct matrix from factors and compute residual.
477 *
478 *
479 c NEED TO WRITE CHET01_AA_2STAGE
480 c CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
481 c $ AINV, LDA, RWORK, RESULT( 1 ) )
482 c NT = 1
483  nt = 0
484 *
485 *
486 * Print information about the tests that did not pass
487 * the threshold.
488 *
489  DO 110 k = 1, nt
490  IF( result( k ).GE.thresh ) THEN
491  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
492  $ CALL alahd( nout, path )
493  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
494  $ result( k )
495  nfail = nfail + 1
496  END IF
497  110 CONTINUE
498  nrun = nrun + nt
499 *
500 * Skip solver test if INFO is not 0.
501 *
502  IF( info.NE.0 ) THEN
503  GO TO 140
504  END IF
505 *
506 * Do for each value of NRHS in NSVAL.
507 *
508  DO 130 irhs = 1, nns
509  nrhs = nsval( irhs )
510 *
511 *+ TEST 2 (Using TRS)
512 * Solve and compute residual for A * X = B.
513 *
514 * Choose a set of NRHS random solution vectors
515 * stored in XACT and set up the right hand side B
516 *
517  srnamt = 'CLARHS'
518  CALL clarhs( matpath, xtype, uplo, ' ', n, n,
519  $ kl, ku, nrhs, a, lda, xact, lda,
520  $ b, lda, iseed, info )
521  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
522 *
523  srnamt = 'CHETRS_AA_2STAGE'
524  lwork = max( 1, 3*n-2 )
525  CALL chetrs_aa_2stage( uplo, n, nrhs, afac, lda,
526  $ ainv, (3*nb+1)*n, iwork, iwork( 1+n ),
527  $ x, lda, info )
528 *
529 * Check error code from CHETRS and handle error.
530 *
531  IF( info.NE.0 ) THEN
532  IF( izero.EQ.0 ) THEN
533  CALL alaerh( path, 'CHETRS_AA_2STAGE',
534  $ info, 0, uplo, n, n, -1, -1,
535  $ nrhs, imat, nfail, nerrs, nout )
536  END IF
537  ELSE
538  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda
539  $ )
540 *
541 * Compute the residual for the solution
542 *
543  CALL cpot02( uplo, n, nrhs, a, lda, x, lda,
544  $ work, lda, rwork, result( 2 ) )
545 *
546 * Print information about the tests that did not pass
547 * the threshold.
548 *
549  DO 120 k = 2, 2
550  IF( result( k ).GE.thresh ) THEN
551  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
552  $ CALL alahd( nout, path )
553  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
554  $ imat, k, result( k )
555  nfail = nfail + 1
556  END IF
557  120 CONTINUE
558  END IF
559  nrun = nrun + 1
560 *
561 * End do for each value of NRHS in NSVAL.
562 *
563  130 CONTINUE
564  140 CONTINUE
565  150 CONTINUE
566  160 CONTINUE
567  170 CONTINUE
568  180 CONTINUE
569 *
570 * Print a summary of the results.
571 *
572  CALL alasum( path, nout, nfail, nrun, nerrs )
573 *
574  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
575  $ i2, ', test ', i2, ', ratio =', g12.5 )
576  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
577  $ i2, ', test(', i2, ') =', g12.5 )
578  9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
579  $ i6 )
580  RETURN
581 *
582 * End of CCHKSY_AA_2STAGE
583 *
Here is the call graph for this function:
Here is the caller graph for this function:
chetrs_aa_2stage
subroutine chetrs_aa_2stage(UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, IPIV2, B, LDB, INFO)
CHETRS_AA_2STAGE
Definition: chetrs_aa_2stage.f:143
claipd
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
Definition: claipd.f:85
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:109
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
chetrf_aa_2stage
subroutine chetrf_aa_2stage(UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, WORK, LWORK, INFO)
CHETRF_AA_2STAGE
Definition: chetrf_aa_2stage.f:162
cerrhe
subroutine cerrhe(PATH, NUNIT)
CERRHE
Definition: cerrhe.f:57
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
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