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

CDRVSY

CDRVSYX

Purpose: 
 CDRVSY tests the driver routines CSYSV 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: 
 CDRVSY tests the driver routines CSYSV, -SVX, and -SVXX.

 Note that this file is used only when the XBLAS are available,
 otherwise cdrvsy.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 cdrvsy.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 = 11, 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 clansy, sget06
200  EXTERNAL clansy, sget06
201 * ..
202 * .. External Subroutines ..
203  EXTERNAL aladhd, alaerh, alasvm, cerrvx, cget04, clacpy,
204  $ clarhs, claset, clatb4, clatms, clatsy, cpot05,
205  $ csysv, csysvx, csyt01, csyt02, csytrf, csytri2,
206  $ 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 ) = 'SY'
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  IF( imat.NE.ntypes ) THEN
280 *
281 * Set up parameters with CLATB4 and generate a test
282 * matrix with CLATMS.
283 *
284  CALL clatb4( path, imat, n, n, TYPE, kl, ku, anorm,
285  $ mode, cndnum, dist )
286 *
287  srnamt = 'CLATMS'
288  CALL clatms( n, n, dist, iseed, TYPE, rwork, mode,
289  $ cndnum, anorm, kl, ku, uplo, a, lda,
290  $ work, info )
291 *
292 * Check error code from CLATMS.
293 *
294  IF( info.NE.0 ) THEN
295  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n,
296  $ -1, -1, -1, imat, nfail, nerrs, nout )
297  GO TO 160
298  END IF
299 *
300 * For types 3-6, zero one or more rows and columns of
301 * the matrix to test that INFO is returned correctly.
302 *
303  IF( zerot ) THEN
304  IF( imat.EQ.3 ) THEN
305  izero = 1
306  ELSE IF( imat.EQ.4 ) THEN
307  izero = n
308  ELSE
309  izero = n / 2 + 1
310  END IF
311 *
312  IF( imat.LT.6 ) THEN
313 *
314 * Set row and column IZERO to zero.
315 *
316  IF( iuplo.EQ.1 ) THEN
317  ioff = ( izero-1 )*lda
318  DO 20 i = 1, izero - 1
319  a( ioff+i ) = zero
320  20 CONTINUE
321  ioff = ioff + izero
322  DO 30 i = izero, n
323  a( ioff ) = zero
324  ioff = ioff + lda
325  30 CONTINUE
326  ELSE
327  ioff = izero
328  DO 40 i = 1, izero - 1
329  a( ioff ) = zero
330  ioff = ioff + lda
331  40 CONTINUE
332  ioff = ioff - izero
333  DO 50 i = izero, n
334  a( ioff+i ) = zero
335  50 CONTINUE
336  END IF
337  ELSE
338  IF( iuplo.EQ.1 ) THEN
339 *
340 * Set the first IZERO rows to zero.
341 *
342  ioff = 0
343  DO 70 j = 1, n
344  i2 = min( j, izero )
345  DO 60 i = 1, i2
346  a( ioff+i ) = zero
347  60 CONTINUE
348  ioff = ioff + lda
349  70 CONTINUE
350  ELSE
351 *
352 * Set the last IZERO rows to zero.
353 *
354  ioff = 0
355  DO 90 j = 1, n
356  i1 = max( j, izero )
357  DO 80 i = i1, n
358  a( ioff+i ) = zero
359  80 CONTINUE
360  ioff = ioff + lda
361  90 CONTINUE
362  END IF
363  END IF
364  ELSE
365  izero = 0
366  END IF
367  ELSE
368 *
369 * IMAT = NTYPES: Use a special block diagonal matrix to
370 * test alternate code for the 2-by-2 blocks.
371 *
372  CALL clatsy( uplo, n, a, lda, iseed )
373  END IF
374 *
375  DO 150 ifact = 1, nfact
376 *
377 * Do first for FACT = 'F', then for other values.
378 *
379  fact = facts( ifact )
380 *
381 * Compute the condition number for comparison with
382 * the value returned by CSYSVX.
383 *
384  IF( zerot ) THEN
385  IF( ifact.EQ.1 )
386  $ GO TO 150
387  rcondc = zero
388 *
389  ELSE IF( ifact.EQ.1 ) THEN
390 *
391 * Compute the 1-norm of A.
392 *
393  anorm = clansy( '1', uplo, n, a, lda, rwork )
394 *
395 * Factor the matrix A.
396 *
397  CALL clacpy( uplo, n, n, a, lda, afac, lda )
398  CALL csytrf( uplo, n, afac, lda, iwork, work,
399  $ lwork, info )
400 *
401 * Compute inv(A) and take its norm.
402 *
403  CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
404  lwork = (n+nb+1)*(nb+3)
405  CALL csytri2( uplo, n, ainv, lda, iwork, work,
406  $ lwork, info )
407  ainvnm = clansy( '1', uplo, n, ainv, lda, rwork )
408 *
409 * Compute the 1-norm condition number of A.
410 *
411  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
412  rcondc = one
413  ELSE
414  rcondc = ( one / anorm ) / ainvnm
415  END IF
416  END IF
417 *
418 * Form an exact solution and set the right hand side.
419 *
420  srnamt = 'CLARHS'
421  CALL clarhs( path, xtype, uplo, ' ', n, n, kl, ku,
422  $ nrhs, a, lda, xact, lda, b, lda, iseed,
423  $ info )
424  xtype = 'C'
425 *
426 * --- Test CSYSV ---
427 *
428  IF( ifact.EQ.2 ) THEN
429  CALL clacpy( uplo, n, n, a, lda, afac, lda )
430  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
431 *
432 * Factor the matrix and solve the system using CSYSV.
433 *
434  srnamt = 'CSYSV '
435  CALL csysv( uplo, n, nrhs, afac, lda, iwork, x,
436  $ lda, work, lwork, info )
437 *
438 * Adjust the expected value of INFO to account for
439 * pivoting.
440 *
441  k = izero
442  IF( k.GT.0 ) THEN
443  100 CONTINUE
444  IF( iwork( k ).LT.0 ) THEN
445  IF( iwork( k ).NE.-k ) THEN
446  k = -iwork( k )
447  GO TO 100
448  END IF
449  ELSE IF( iwork( k ).NE.k ) THEN
450  k = iwork( k )
451  GO TO 100
452  END IF
453  END IF
454 *
455 * Check error code from CSYSV .
456 *
457  IF( info.NE.k ) THEN
458  CALL alaerh( path, 'CSYSV ', info, k, uplo, n,
459  $ n, -1, -1, nrhs, imat, nfail,
460  $ nerrs, nout )
461  GO TO 120
462  ELSE IF( info.NE.0 ) THEN
463  GO TO 120
464  END IF
465 *
466 * Reconstruct matrix from factors and compute
467 * residual.
468 *
469  CALL csyt01( uplo, n, a, lda, afac, lda, iwork,
470  $ ainv, lda, rwork, result( 1 ) )
471 *
472 * Compute residual of the computed solution.
473 *
474  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
475  CALL csyt02( uplo, n, nrhs, a, lda, x, lda, work,
476  $ lda, rwork, result( 2 ) )
477 *
478 * Check solution from generated exact solution.
479 *
480  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
481  $ result( 3 ) )
482  nt = 3
483 *
484 * Print information about the tests that did not pass
485 * the threshold.
486 *
487  DO 110 k = 1, nt
488  IF( result( k ).GE.thresh ) THEN
489  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
490  $ CALL aladhd( nout, path )
491  WRITE( nout, fmt = 9999 )'CSYSV ', uplo, n,
492  $ imat, k, result( k )
493  nfail = nfail + 1
494  END IF
495  110 CONTINUE
496  nrun = nrun + nt
497  120 CONTINUE
498  END IF
499 *
500 * --- Test CSYSVX ---
501 *
502  IF( ifact.EQ.2 )
503  $ CALL claset( uplo, n, n, cmplx( zero ),
504  $ cmplx( zero ), afac, lda )
505  CALL claset( 'Full', n, nrhs, cmplx( zero ),
506  $ cmplx( zero ), x, lda )
507 *
508 * Solve the system and compute the condition number and
509 * error bounds using CSYSVX.
510 *
511  srnamt = 'CSYSVX'
512  CALL csysvx( fact, uplo, n, nrhs, a, lda, afac, lda,
513  $ iwork, b, lda, x, lda, rcond, rwork,
514  $ rwork( nrhs+1 ), work, lwork,
515  $ rwork( 2*nrhs+1 ), info )
516 *
517 * Adjust the expected value of INFO to account for
518 * pivoting.
519 *
520  k = izero
521  IF( k.GT.0 ) THEN
522  130 CONTINUE
523  IF( iwork( k ).LT.0 ) THEN
524  IF( iwork( k ).NE.-k ) THEN
525  k = -iwork( k )
526  GO TO 130
527  END IF
528  ELSE IF( iwork( k ).NE.k ) THEN
529  k = iwork( k )
530  GO TO 130
531  END IF
532  END IF
533 *
534 * Check the error code from CSYSVX.
535 *
536  IF( info.NE.k ) THEN
537  CALL alaerh( path, 'CSYSVX', info, k, fact // uplo,
538  $ n, n, -1, -1, nrhs, imat, nfail,
539  $ nerrs, nout )
540  GO TO 150
541  END IF
542 *
543  IF( info.EQ.0 ) THEN
544  IF( ifact.GE.2 ) THEN
545 *
546 * Reconstruct matrix from factors and compute
547 * residual.
548 *
549  CALL csyt01( uplo, n, a, lda, afac, lda, iwork,
550  $ ainv, lda, rwork( 2*nrhs+1 ),
551  $ result( 1 ) )
552  k1 = 1
553  ELSE
554  k1 = 2
555  END IF
556 *
557 * Compute residual of the computed solution.
558 *
559  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
560  CALL csyt02( uplo, n, nrhs, a, lda, x, lda, work,
561  $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
562 *
563 * Check solution from generated exact solution.
564 *
565  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
566  $ result( 3 ) )
567 *
568 * Check the error bounds from iterative refinement.
569 *
570  CALL cpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
571  $ xact, lda, rwork, rwork( nrhs+1 ),
572  $ result( 4 ) )
573  ELSE
574  k1 = 6
575  END IF
576 *
577 * Compare RCOND from CSYSVX with the computed value
578 * in RCONDC.
579 *
580  result( 6 ) = sget06( rcond, rcondc )
581 *
582 * Print information about the tests that did not pass
583 * the threshold.
584 *
585  DO 140 k = k1, 6
586  IF( result( k ).GE.thresh ) THEN
587  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
588  $ CALL aladhd( nout, path )
589  WRITE( nout, fmt = 9998 )'CSYSVX', fact, uplo,
590  $ n, imat, k, result( k )
591  nfail = nfail + 1
592  END IF
593  140 CONTINUE
594  nrun = nrun + 7 - k1
595 *
596  150 CONTINUE
597 *
598  160 CONTINUE
599  170 CONTINUE
600  180 CONTINUE
601 *
602 * Print a summary of the results.
603 *
604  CALL alasvm( path, nout, nfail, nrun, nerrs )
605 *
606  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
607  $ ', test ', i2, ', ratio =', g12.5 )
608  9998 FORMAT( 1x, a, ', FACT=''', a1, ''', UPLO=''', a1, ''', N =', i5,
609  $ ', type ', i2, ', test ', i2, ', ratio =', g12.5 )
610  RETURN
611 *
612 * End of CDRVSY
613 *
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
clatsy
subroutine clatsy(UPLO, N, X, LDX, ISEED)
CLATSY
Definition: clatsy.f:91
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
csyt02
subroutine csyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CSYT02
Definition: csyt02.f:129
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
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
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
csytrf
subroutine csytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF
Definition: csytrf.f:184
csysvx
subroutine csysvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
CSYSVX computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: csysvx.f:287
clansy
real function clansy(NORM, UPLO, N, A, LDA, WORK)
CLANSY 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 symmetric matrix.
Definition: clansy.f:125
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
csysv
subroutine csysv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CSYSV computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: csysv.f:173
csyt01
subroutine csyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CSYT01
Definition: csyt01.f:127
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
cget04
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
csytri2
subroutine csytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRI2
Definition: csytri2.f:129

Here is the call graph for this function:

Here is the caller graph for this function: