LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cdrvhe ( 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

CDRVHEX

Purpose: 
 CDRVHE tests the driver routines CHESV and -SVX.
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 2013
Purpose: 
 CDRVHE tests the driver routines CHESV, -SVX, and -SVXX.

 Note that this file is used only when the XBLAS are available,
 otherwise cdrvhe.f defines this subroutine.
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 (2*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
April 2012

Definition at line 155 of file cdrvhe.f.

155 *
156 * -- LAPACK test routine (version 3.5.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 2013
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 = 6 )
181  INTEGER nfact
182  parameter ( nfact = 2 )
183 * ..
184 * .. Local Scalars ..
185  LOGICAL zerot
186  CHARACTER dist, fact, TYPE, uplo, xtype
187  CHARACTER*3 path
188  INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
189  $ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
190  $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
191  REAL ainvnm, anorm, cndnum, rcond, rcondc
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, cerrvx, cget04, chesv,
204  $ chesvx, chet01, chetrf, chetri2, clacpy,
205  $ claipd, clarhs, claset, clatb4, clatms, cpot02,
206  $ cpot05, xlaenv
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  path( 1: 1 ) = 'Complex precision'
229  path( 2: 3 ) = 'HE'
230  nrun = 0
231  nfail = 0
232  nerrs = 0
233  DO 10 i = 1, 4
234  iseed( i ) = iseedy( i )
235  10 CONTINUE
236  lwork = max( 2*nmax, nmax*nrhs )
237 *
238 * Test the error exits
239 *
240  IF( tsterr )
241  $ CALL cerrvx( path, nout )
242  infot = 0
243 *
244 * Set the block size and minimum block size for testing.
245 *
246  nb = 1
247  nbmin = 2
248  CALL xlaenv( 1, nb )
249  CALL xlaenv( 2, nbmin )
250 *
251 * Do for each value of N in NVAL
252 *
253  DO 180 in = 1, nn
254  n = nval( in )
255  lda = max( n, 1 )
256  xtype = 'N'
257  nimat = ntypes
258  IF( n.LE.0 )
259  $ nimat = 1
260 *
261  DO 170 imat = 1, nimat
262 *
263 * Do the tests only if DOTYPE( IMAT ) is true.
264 *
265  IF( .NOT.dotype( imat ) )
266  $ GO TO 170
267 *
268 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
269 *
270  zerot = imat.GE.3 .AND. imat.LE.6
271  IF( zerot .AND. n.LT.imat-2 )
272  $ GO TO 170
273 *
274 * Do first for UPLO = 'U', then for UPLO = 'L'
275 *
276  DO 160 iuplo = 1, 2
277  uplo = uplos( iuplo )
278 *
279 * Set up parameters with CLATB4 and generate a test matrix
280 * with CLATMS.
281 *
282  CALL clatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
283  $ cndnum, dist )
284 *
285  srnamt = 'CLATMS'
286  CALL clatms( n, n, dist, iseed, TYPE, rwork, mode,
287  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
288  $ info )
289 *
290 * Check error code from CLATMS.
291 *
292  IF( info.NE.0 ) THEN
293  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n, -1,
294  $ -1, -1, imat, nfail, nerrs, nout )
295  GO TO 160
296  END IF
297 *
298 * For types 3-6, zero one or more rows and columns of the
299 * matrix to test that INFO is returned correctly.
300 *
301  IF( zerot ) THEN
302  IF( imat.EQ.3 ) THEN
303  izero = 1
304  ELSE IF( imat.EQ.4 ) THEN
305  izero = n
306  ELSE
307  izero = n / 2 + 1
308  END IF
309 *
310  IF( imat.LT.6 ) THEN
311 *
312 * Set row and column IZERO to zero.
313 *
314  IF( iuplo.EQ.1 ) THEN
315  ioff = ( izero-1 )*lda
316  DO 20 i = 1, izero - 1
317  a( ioff+i ) = zero
318  20 CONTINUE
319  ioff = ioff + izero
320  DO 30 i = izero, n
321  a( ioff ) = zero
322  ioff = ioff + lda
323  30 CONTINUE
324  ELSE
325  ioff = izero
326  DO 40 i = 1, izero - 1
327  a( ioff ) = zero
328  ioff = ioff + lda
329  40 CONTINUE
330  ioff = ioff - izero
331  DO 50 i = izero, n
332  a( ioff+i ) = zero
333  50 CONTINUE
334  END IF
335  ELSE
336  ioff = 0
337  IF( iuplo.EQ.1 ) THEN
338 *
339 * Set the first IZERO rows and columns to zero.
340 *
341  DO 70 j = 1, n
342  i2 = min( j, izero )
343  DO 60 i = 1, i2
344  a( ioff+i ) = zero
345  60 CONTINUE
346  ioff = ioff + lda
347  70 CONTINUE
348  ELSE
349 *
350 * Set the last IZERO rows and columns to zero.
351 *
352  DO 90 j = 1, n
353  i1 = max( j, izero )
354  DO 80 i = i1, n
355  a( ioff+i ) = zero
356  80 CONTINUE
357  ioff = ioff + lda
358  90 CONTINUE
359  END IF
360  END IF
361  ELSE
362  izero = 0
363  END IF
364 *
365 * Set the imaginary part of the diagonals.
366 *
367  CALL claipd( n, a, lda+1, 0 )
368 *
369  DO 150 ifact = 1, nfact
370 *
371 * Do first for FACT = 'F', then for other values.
372 *
373  fact = facts( ifact )
374 *
375 * Compute the condition number for comparison with
376 * the value returned by CHESVX.
377 *
378  IF( zerot ) THEN
379  IF( ifact.EQ.1 )
380  $ GO TO 150
381  rcondc = zero
382 *
383  ELSE IF( ifact.EQ.1 ) THEN
384 *
385 * Compute the 1-norm of A.
386 *
387  anorm = clanhe( '1', uplo, n, a, lda, rwork )
388 *
389 * Factor the matrix A.
390 *
391  CALL clacpy( uplo, n, n, a, lda, afac, lda )
392  CALL chetrf( uplo, n, afac, lda, iwork, work,
393  $ lwork, info )
394 *
395 * Compute inv(A) and take its norm.
396 *
397  CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
398  lwork = (n+nb+1)*(nb+3)
399  CALL chetri2( uplo, n, ainv, lda, iwork, work,
400  $ lwork, info )
401  ainvnm = clanhe( '1', uplo, n, ainv, lda, rwork )
402 *
403 * Compute the 1-norm condition number of A.
404 *
405  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
406  rcondc = one
407  ELSE
408  rcondc = ( one / anorm ) / ainvnm
409  END IF
410  END IF
411 *
412 * Form an exact solution and set the right hand side.
413 *
414  srnamt = 'CLARHS'
415  CALL clarhs( path, xtype, uplo, ' ', n, n, kl, ku,
416  $ nrhs, a, lda, xact, lda, b, lda, iseed,
417  $ info )
418  xtype = 'C'
419 *
420 * --- Test CHESV ---
421 *
422  IF( ifact.EQ.2 ) THEN
423  CALL clacpy( uplo, n, n, a, lda, afac, lda )
424  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
425 *
426 * Factor the matrix and solve the system using CHESV.
427 *
428  srnamt = 'CHESV '
429  CALL chesv( uplo, n, nrhs, afac, lda, iwork, x,
430  $ lda, work, lwork, info )
431 *
432 * Adjust the expected value of INFO to account for
433 * pivoting.
434 *
435  k = izero
436  IF( k.GT.0 ) THEN
437  100 CONTINUE
438  IF( iwork( k ).LT.0 ) THEN
439  IF( iwork( k ).NE.-k ) THEN
440  k = -iwork( k )
441  GO TO 100
442  END IF
443  ELSE IF( iwork( k ).NE.k ) THEN
444  k = iwork( k )
445  GO TO 100
446  END IF
447  END IF
448 *
449 * Check error code from CHESV .
450 *
451  IF( info.NE.k ) THEN
452  CALL alaerh( path, 'CHESV ', info, k, uplo, n,
453  $ n, -1, -1, nrhs, imat, nfail,
454  $ nerrs, nout )
455  GO TO 120
456  ELSE IF( info.NE.0 ) THEN
457  GO TO 120
458  END IF
459 *
460 * Reconstruct matrix from factors and compute
461 * residual.
462 *
463  CALL chet01( uplo, n, a, lda, afac, lda, iwork,
464  $ ainv, lda, rwork, result( 1 ) )
465 *
466 * Compute residual of the computed solution.
467 *
468  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
469  CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
470  $ lda, rwork, result( 2 ) )
471 *
472 * Check solution from generated exact solution.
473 *
474  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
475  $ result( 3 ) )
476  nt = 3
477 *
478 * Print information about the tests that did not pass
479 * the threshold.
480 *
481  DO 110 k = 1, nt
482  IF( result( k ).GE.thresh ) THEN
483  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
484  $ CALL aladhd( nout, path )
485  WRITE( nout, fmt = 9999 )'CHESV ', uplo, n,
486  $ imat, k, result( k )
487  nfail = nfail + 1
488  END IF
489  110 CONTINUE
490  nrun = nrun + nt
491  120 CONTINUE
492  END IF
493 *
494 * --- Test CHESVX ---
495 *
496  IF( ifact.EQ.2 )
497  $ CALL claset( uplo, n, n, cmplx( zero ),
498  $ cmplx( zero ), afac, lda )
499  CALL claset( 'Full', n, nrhs, cmplx( zero ),
500  $ cmplx( zero ), x, lda )
501 *
502 * Solve the system and compute the condition number and
503 * error bounds using CHESVX.
504 *
505  srnamt = 'CHESVX'
506  CALL chesvx( fact, uplo, n, nrhs, a, lda, afac, lda,
507  $ iwork, b, lda, x, lda, rcond, rwork,
508  $ rwork( nrhs+1 ), work, lwork,
509  $ rwork( 2*nrhs+1 ), info )
510 *
511 * Adjust the expected value of INFO to account for
512 * pivoting.
513 *
514  k = izero
515  IF( k.GT.0 ) THEN
516  130 CONTINUE
517  IF( iwork( k ).LT.0 ) THEN
518  IF( iwork( k ).NE.-k ) THEN
519  k = -iwork( k )
520  GO TO 130
521  END IF
522  ELSE IF( iwork( k ).NE.k ) THEN
523  k = iwork( k )
524  GO TO 130
525  END IF
526  END IF
527 *
528 * Check the error code from CHESVX.
529 *
530  IF( info.NE.k ) THEN
531  CALL alaerh( path, 'CHESVX', info, k, fact // uplo,
532  $ n, n, -1, -1, nrhs, imat, nfail,
533  $ nerrs, nout )
534  GO TO 150
535  END IF
536 *
537  IF( info.EQ.0 ) THEN
538  IF( ifact.GE.2 ) THEN
539 *
540 * Reconstruct matrix from factors and compute
541 * residual.
542 *
543  CALL chet01( uplo, n, a, lda, afac, lda, iwork,
544  $ ainv, lda, rwork( 2*nrhs+1 ),
545  $ result( 1 ) )
546  k1 = 1
547  ELSE
548  k1 = 2
549  END IF
550 *
551 * Compute residual of the computed solution.
552 *
553  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
554  CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
555  $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
556 *
557 * Check solution from generated exact solution.
558 *
559  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
560  $ result( 3 ) )
561 *
562 * Check the error bounds from iterative refinement.
563 *
564  CALL cpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
565  $ xact, lda, rwork, rwork( nrhs+1 ),
566  $ result( 4 ) )
567  ELSE
568  k1 = 6
569  END IF
570 *
571 * Compare RCOND from CHESVX with the computed value
572 * in RCONDC.
573 *
574  result( 6 ) = sget06( rcond, rcondc )
575 *
576 * Print information about the tests that did not pass
577 * the threshold.
578 *
579  DO 140 k = k1, 6
580  IF( result( k ).GE.thresh ) THEN
581  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
582  $ CALL aladhd( nout, path )
583  WRITE( nout, fmt = 9998 )'CHESVX', fact, uplo,
584  $ n, imat, k, result( k )
585  nfail = nfail + 1
586  END IF
587  140 CONTINUE
588  nrun = nrun + 7 - k1
589 *
590  150 CONTINUE
591 *
592  160 CONTINUE
593  170 CONTINUE
594  180 CONTINUE
595 *
596 * Print a summary of the results.
597 *
598  CALL alasvm( path, nout, nfail, nrun, nerrs )
599 *
600  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
601  $ ', test ', i2, ', ratio =', g12.5 )
602  9998 FORMAT( 1x, a, ', FACT=''', a1, ''', UPLO=''', a1, ''', N =', i5,
603  $ ', type ', i2, ', test ', i2, ', ratio =', g12.5 )
604  RETURN
605 *
606 * End of CDRVHE
607 *
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
claipd
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
Definition: claipd.f:85
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
cerrvx
subroutine cerrvx(PATH, NUNIT)
CERRVX
Definition: cerrvx.f:57
chesv
subroutine chesv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHESV computes the solution to system of linear equations A * X = B for HE matrices ...
Definition: chesv.f:173
chesvx
subroutine chesvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
CHESVX computes the solution to system of linear equations A * X = B for HE matrices ...
Definition: chesvx.f:287
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
claset
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
chetrf
subroutine chetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF
Definition: chetrf.f:179
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:80
chet01
subroutine chet01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01
Definition: chet01.f:128
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
cpot05
subroutine cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
Definition: cpot05.f:167
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
chetri2
subroutine chetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRI2
Definition: chetri2.f:129
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: