LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ ddrvsy()

subroutine ddrvsy ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NRHS,
double precision  THRESH,
logical  TSTERR,
integer  NMAX,
double precision, dimension( * )  A,
double precision, dimension( * )  AFAC,
double precision, dimension( * )  AINV,
double precision, dimension( * )  B,
double precision, dimension( * )  X,
double precision, dimension( * )  XACT,
double precision, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

DDRVSY

DDRVSYX

Purpose:
 DDRVSY tests the driver routines DSYSV 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 DOUBLE PRECISION
          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 DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AINV
          AINV is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (NMAX*max(2,NRHS))
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
[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.
Purpose:
 DDRVSY tests the driver routines DSYSV, -SVX, and -SVXX.

 Note that this file is used only when the XBLAS are available,
 otherwise ddrvsy.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 DOUBLE PRECISION
          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 DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AINV
          AINV is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension
                      (NMAX*max(2,NRHS))
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
[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.

Definition at line 149 of file ddrvsy.f.

152 *
153 * -- LAPACK test routine --
154 * -- LAPACK is a software package provided by Univ. of Tennessee, --
155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
156 *
157 * .. Scalar Arguments ..
158  LOGICAL TSTERR
159  INTEGER NMAX, NN, NOUT, NRHS
160  DOUBLE PRECISION THRESH
161 * ..
162 * .. Array Arguments ..
163  LOGICAL DOTYPE( * )
164  INTEGER IWORK( * ), NVAL( * )
165  DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
166  $ RWORK( * ), WORK( * ), X( * ), XACT( * )
167 * ..
168 *
169 * =====================================================================
170 *
171 * .. Parameters ..
172  DOUBLE PRECISION ONE, ZERO
173  parameter( one = 1.0d+0, zero = 0.0d+0 )
174  INTEGER NTYPES, NTESTS
175  parameter( ntypes = 10, ntests = 6 )
176  INTEGER NFACT
177  parameter( nfact = 2 )
178 * ..
179 * .. Local Scalars ..
180  LOGICAL ZEROT
181  CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
182  CHARACTER*3 PATH
183  INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
184  $ IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
185  $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
186  DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCOND, RCONDC
187 * ..
188 * .. Local Arrays ..
189  CHARACTER FACTS( NFACT ), UPLOS( 2 )
190  INTEGER ISEED( 4 ), ISEEDY( 4 )
191  DOUBLE PRECISION RESULT( NTESTS )
192 * ..
193 * .. External Functions ..
194  DOUBLE PRECISION DGET06, DLANSY
195  EXTERNAL dget06, dlansy
196 * ..
197 * .. External Subroutines ..
198  EXTERNAL aladhd, alaerh, alasvm, derrvx, dget04, dlacpy,
201 * ..
202 * .. Scalars in Common ..
203  LOGICAL LERR, OK
204  CHARACTER*32 SRNAMT
205  INTEGER INFOT, NUNIT
206 * ..
207 * .. Common blocks ..
208  COMMON / infoc / infot, nunit, ok, lerr
209  COMMON / srnamc / srnamt
210 * ..
211 * .. Intrinsic Functions ..
212  INTRINSIC max, min
213 * ..
214 * .. Data statements ..
215  DATA iseedy / 1988, 1989, 1990, 1991 /
216  DATA uplos / 'U', 'L' / , facts / 'F', 'N' /
217 * ..
218 * .. Executable Statements ..
219 *
220 * Initialize constants and the random number seed.
221 *
222  path( 1: 1 ) = 'Double precision'
223  path( 2: 3 ) = 'SY'
224  nrun = 0
225  nfail = 0
226  nerrs = 0
227  DO 10 i = 1, 4
228  iseed( i ) = iseedy( i )
229  10 CONTINUE
230  lwork = max( 2*nmax, nmax*nrhs )
231 *
232 * Test the error exits
233 *
234  IF( tsterr )
235  $ CALL derrvx( path, nout )
236  infot = 0
237 *
238 * Set the block size and minimum block size for testing.
239 *
240  nb = 1
241  nbmin = 2
242  CALL xlaenv( 1, nb )
243  CALL xlaenv( 2, nbmin )
244 *
245 * Do for each value of N in NVAL
246 *
247  DO 180 in = 1, nn
248  n = nval( in )
249  lda = max( n, 1 )
250  xtype = 'N'
251  nimat = ntypes
252  IF( n.LE.0 )
253  $ nimat = 1
254 *
255  DO 170 imat = 1, nimat
256 *
257 * Do the tests only if DOTYPE( IMAT ) is true.
258 *
259  IF( .NOT.dotype( imat ) )
260  $ GO TO 170
261 *
262 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
263 *
264  zerot = imat.GE.3 .AND. imat.LE.6
265  IF( zerot .AND. n.LT.imat-2 )
266  $ GO TO 170
267 *
268 * Do first for UPLO = 'U', then for UPLO = 'L'
269 *
270  DO 160 iuplo = 1, 2
271  uplo = uplos( iuplo )
272 *
273 * Set up parameters with DLATB4 and generate a test matrix
274 * with DLATMS.
275 *
276  CALL dlatb4( path, imat, n, n, TYPE, KL, KU, ANORM, MODE,
277  $ CNDNUM, DIST )
278 *
279  srnamt = 'DLATMS'
280  CALL dlatms( n, n, dist, iseed, TYPE, RWORK, MODE,
281  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
282  $ INFO )
283 *
284 * Check error code from DLATMS.
285 *
286  IF( info.NE.0 ) THEN
287  CALL alaerh( path, 'DLATMS', info, 0, uplo, n, n, -1,
288  $ -1, -1, imat, nfail, nerrs, nout )
289  GO TO 160
290  END IF
291 *
292 * For types 3-6, zero one or more rows and columns of the
293 * matrix to test that INFO is returned correctly.
294 *
295  IF( zerot ) THEN
296  IF( imat.EQ.3 ) THEN
297  izero = 1
298  ELSE IF( imat.EQ.4 ) THEN
299  izero = n
300  ELSE
301  izero = n / 2 + 1
302  END IF
303 *
304  IF( imat.LT.6 ) THEN
305 *
306 * Set row and column IZERO to zero.
307 *
308  IF( iuplo.EQ.1 ) THEN
309  ioff = ( izero-1 )*lda
310  DO 20 i = 1, izero - 1
311  a( ioff+i ) = zero
312  20 CONTINUE
313  ioff = ioff + izero
314  DO 30 i = izero, n
315  a( ioff ) = zero
316  ioff = ioff + lda
317  30 CONTINUE
318  ELSE
319  ioff = izero
320  DO 40 i = 1, izero - 1
321  a( ioff ) = zero
322  ioff = ioff + lda
323  40 CONTINUE
324  ioff = ioff - izero
325  DO 50 i = izero, n
326  a( ioff+i ) = zero
327  50 CONTINUE
328  END IF
329  ELSE
330  ioff = 0
331  IF( iuplo.EQ.1 ) THEN
332 *
333 * Set the first IZERO rows and columns to zero.
334 *
335  DO 70 j = 1, n
336  i2 = min( j, izero )
337  DO 60 i = 1, i2
338  a( ioff+i ) = zero
339  60 CONTINUE
340  ioff = ioff + lda
341  70 CONTINUE
342  ELSE
343 *
344 * Set the last IZERO rows and columns to zero.
345 *
346  DO 90 j = 1, n
347  i1 = max( j, izero )
348  DO 80 i = i1, n
349  a( ioff+i ) = zero
350  80 CONTINUE
351  ioff = ioff + lda
352  90 CONTINUE
353  END IF
354  END IF
355  ELSE
356  izero = 0
357  END IF
358 *
359  DO 150 ifact = 1, nfact
360 *
361 * Do first for FACT = 'F', then for other values.
362 *
363  fact = facts( ifact )
364 *
365 * Compute the condition number for comparison with
366 * the value returned by DSYSVX.
367 *
368  IF( zerot ) THEN
369  IF( ifact.EQ.1 )
370  $ GO TO 150
371  rcondc = zero
372 *
373  ELSE IF( ifact.EQ.1 ) THEN
374 *
375 * Compute the 1-norm of A.
376 *
377  anorm = dlansy( '1', uplo, n, a, lda, rwork )
378 *
379 * Factor the matrix A.
380 *
381  CALL dlacpy( uplo, n, n, a, lda, afac, lda )
382  CALL dsytrf( uplo, n, afac, lda, iwork, work,
383  $ lwork, info )
384 *
385 * Compute inv(A) and take its norm.
386 *
387  CALL dlacpy( uplo, n, n, afac, lda, ainv, lda )
388  lwork = (n+nb+1)*(nb+3)
389  CALL dsytri2( uplo, n, ainv, lda, iwork, work,
390  $ lwork, info )
391  ainvnm = dlansy( '1', uplo, n, ainv, lda, rwork )
392 *
393 * Compute the 1-norm condition number of A.
394 *
395  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
396  rcondc = one
397  ELSE
398  rcondc = ( one / anorm ) / ainvnm
399  END IF
400  END IF
401 *
402 * Form an exact solution and set the right hand side.
403 *
404  srnamt = 'DLARHS'
405  CALL dlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
406  $ nrhs, a, lda, xact, lda, b, lda, iseed,
407  $ info )
408  xtype = 'C'
409 *
410 * --- Test DSYSV ---
411 *
412  IF( ifact.EQ.2 ) THEN
413  CALL dlacpy( uplo, n, n, a, lda, afac, lda )
414  CALL dlacpy( 'Full', n, nrhs, b, lda, x, lda )
415 *
416 * Factor the matrix and solve the system using DSYSV.
417 *
418  srnamt = 'DSYSV '
419  CALL dsysv( uplo, n, nrhs, afac, lda, iwork, x,
420  $ lda, work, lwork, info )
421 *
422 * Adjust the expected value of INFO to account for
423 * pivoting.
424 *
425  k = izero
426  IF( k.GT.0 ) THEN
427  100 CONTINUE
428  IF( iwork( k ).LT.0 ) THEN
429  IF( iwork( k ).NE.-k ) THEN
430  k = -iwork( k )
431  GO TO 100
432  END IF
433  ELSE IF( iwork( k ).NE.k ) THEN
434  k = iwork( k )
435  GO TO 100
436  END IF
437  END IF
438 *
439 * Check error code from DSYSV .
440 *
441  IF( info.NE.k ) THEN
442  CALL alaerh( path, 'DSYSV ', info, k, uplo, n,
443  $ n, -1, -1, nrhs, imat, nfail,
444  $ nerrs, nout )
445  GO TO 120
446  ELSE IF( info.NE.0 ) THEN
447  GO TO 120
448  END IF
449 *
450 * Reconstruct matrix from factors and compute
451 * residual.
452 *
453  CALL dsyt01( uplo, n, a, lda, afac, lda, iwork,
454  $ ainv, lda, rwork, result( 1 ) )
455 *
456 * Compute residual of the computed solution.
457 *
458  CALL dlacpy( 'Full', n, nrhs, b, lda, work, lda )
459  CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
460  $ lda, rwork, result( 2 ) )
461 *
462 * Check solution from generated exact solution.
463 *
464  CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
465  $ result( 3 ) )
466  nt = 3
467 *
468 * Print information about the tests that did not pass
469 * the threshold.
470 *
471  DO 110 k = 1, nt
472  IF( result( k ).GE.thresh ) THEN
473  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
474  $ CALL aladhd( nout, path )
475  WRITE( nout, fmt = 9999 )'DSYSV ', uplo, n,
476  $ imat, k, result( k )
477  nfail = nfail + 1
478  END IF
479  110 CONTINUE
480  nrun = nrun + nt
481  120 CONTINUE
482  END IF
483 *
484 * --- Test DSYSVX ---
485 *
486  IF( ifact.EQ.2 )
487  $ CALL dlaset( uplo, n, n, zero, zero, afac, lda )
488  CALL dlaset( 'Full', n, nrhs, zero, zero, x, lda )
489 *
490 * Solve the system and compute the condition number and
491 * error bounds using DSYSVX.
492 *
493  srnamt = 'DSYSVX'
494  CALL dsysvx( fact, uplo, n, nrhs, a, lda, afac, lda,
495  $ iwork, b, lda, x, lda, rcond, rwork,
496  $ rwork( nrhs+1 ), work, lwork,
497  $ iwork( n+1 ), info )
498 *
499 * Adjust the expected value of INFO to account for
500 * pivoting.
501 *
502  k = izero
503  IF( k.GT.0 ) THEN
504  130 CONTINUE
505  IF( iwork( k ).LT.0 ) THEN
506  IF( iwork( k ).NE.-k ) THEN
507  k = -iwork( k )
508  GO TO 130
509  END IF
510  ELSE IF( iwork( k ).NE.k ) THEN
511  k = iwork( k )
512  GO TO 130
513  END IF
514  END IF
515 *
516 * Check the error code from DSYSVX.
517 *
518  IF( info.NE.k ) THEN
519  CALL alaerh( path, 'DSYSVX', info, k, fact // uplo,
520  $ n, n, -1, -1, nrhs, imat, nfail,
521  $ nerrs, nout )
522  GO TO 150
523  END IF
524 *
525  IF( info.EQ.0 ) THEN
526  IF( ifact.GE.2 ) THEN
527 *
528 * Reconstruct matrix from factors and compute
529 * residual.
530 *
531  CALL dsyt01( uplo, n, a, lda, afac, lda, iwork,
532  $ ainv, lda, rwork( 2*nrhs+1 ),
533  $ result( 1 ) )
534  k1 = 1
535  ELSE
536  k1 = 2
537  END IF
538 *
539 * Compute residual of the computed solution.
540 *
541  CALL dlacpy( 'Full', n, nrhs, b, lda, work, lda )
542  CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
543  $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
544 *
545 * Check solution from generated exact solution.
546 *
547  CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
548  $ result( 3 ) )
549 *
550 * Check the error bounds from iterative refinement.
551 *
552  CALL dpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
553  $ xact, lda, rwork, rwork( nrhs+1 ),
554  $ result( 4 ) )
555  ELSE
556  k1 = 6
557  END IF
558 *
559 * Compare RCOND from DSYSVX with the computed value
560 * in RCONDC.
561 *
562  result( 6 ) = dget06( rcond, rcondc )
563 *
564 * Print information about the tests that did not pass
565 * the threshold.
566 *
567  DO 140 k = k1, 6
568  IF( result( k ).GE.thresh ) THEN
569  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
570  $ CALL aladhd( nout, path )
571  WRITE( nout, fmt = 9998 )'DSYSVX', fact, uplo,
572  $ n, imat, k, result( k )
573  nfail = nfail + 1
574  END IF
575  140 CONTINUE
576  nrun = nrun + 7 - k1
577 *
578  150 CONTINUE
579 *
580  160 CONTINUE
581  170 CONTINUE
582  180 CONTINUE
583 *
584 * Print a summary of the results.
585 *
586  CALL alasvm( path, nout, nfail, nrun, nerrs )
587 *
588  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
589  $ ', test ', i2, ', ratio =', g12.5 )
590  9998 FORMAT( 1x, a, ', FACT=''', a1, ''', UPLO=''', a1, ''', N =', i5,
591  $ ', type ', i2, ', test ', i2, ', ratio =', g12.5 )
592  RETURN
593 *
594 * End of DDRVSY
595 *
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:103
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: dlaset.f:110
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:73
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:81
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:90
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:147
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
Definition: dlarhs.f:205
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
Definition: dget04.f:102
subroutine dpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DPOT02
Definition: dpot02.f:127
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
Definition: dlatb4.f:120
subroutine derrvx(PATH, NUNIT)
DERRVX
Definition: derrvx.f:55
subroutine dpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPOT05
Definition: dpot05.f:164
subroutine dsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
DSYT01
Definition: dsyt01.f:124
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:55
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:321
double precision function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition: dlansy.f:122
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
Definition: dsytri2.f:127
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF
Definition: dsytrf.f:182
subroutine dsysvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, IWORK, INFO)
DSYSVX computes the solution to system of linear equations A * X = B for SY matrices
Definition: dsysvx.f:284
subroutine dsysv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
DSYSV computes the solution to system of linear equations A * X = B for SY matrices
Definition: dsysv.f:171
Here is the call graph for this function:
Here is the caller graph for this function: