LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
subroutine ddrvsy_aa ( 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_AA

Purpose: 
 DDRVSY_AA tests the driver routine DSYSV_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 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.
Date
December 2016

Definition at line 156 of file ddrvsy_aa.f.

156 *
157 * -- LAPACK test routine (version 3.7.0) --
158 * -- LAPACK is a software package provided by Univ. of Tennessee, --
159 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
160 * December 2016
161 *
162 * .. Scalar Arguments ..
163  LOGICAL tsterr
164  INTEGER nmax, nn, nout, nrhs
165  DOUBLE PRECISION thresh
166 * ..
167 * .. Array Arguments ..
168  LOGICAL dotype( * )
169  INTEGER iwork( * ), nval( * )
170  DOUBLE PRECISION a( * ), afac( * ), ainv( * ), b( * ),
171  $ rwork( * ), work( * ), x( * ), xact( * )
172 * ..
173 *
174 * =====================================================================
175 *
176 * .. Parameters ..
177  DOUBLE PRECISION one, zero
178  parameter ( one = 1.0d+0, zero = 0.0d+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  DOUBLE PRECISION anorm, cndnum
192 * ..
193 * .. Local Arrays ..
194  CHARACTER facts( nfact ), uplos( 2 )
195  INTEGER iseed( 4 ), iseedy( 4 )
196  DOUBLE PRECISION result( ntests )
197 * ..
198 * .. External Functions ..
199  DOUBLE PRECISION dget06, dlansy
200  EXTERNAL dget06, dlansy
201 * ..
202 * .. External Subroutines ..
203  EXTERNAL aladhd, alaerh, alasvm, derrvx, dget04, dlacpy,
204  $ dlarhs, dlaset, dlatb4, dlatms, dpot02, dpot05,
205  $ dsysv_aa, dsyt01_aa, dsytrf_aa, xlaenv
206 * ..
207 * .. Scalars in Common ..
208  LOGICAL lerr, ok
209  CHARACTER*32 srnamt
210  INTEGER infot, nunit
211 * ..
212 * .. Common blocks ..
213  COMMON / infoc / infot, nunit, ok, lerr
214  COMMON / srnamc / srnamt
215 * ..
216 * .. Intrinsic Functions ..
217  INTRINSIC max, min
218 * ..
219 * .. Data statements ..
220  DATA iseedy / 1988, 1989, 1990, 1991 /
221  DATA uplos / 'U', 'L' / , facts / 'F', 'N' /
222 * ..
223 * .. Executable Statements ..
224 *
225 * Initialize constants and the random number seed.
226 *
227 * Test path
228 *
229  path( 1: 1 ) = 'Double precision'
230  path( 2: 3 ) = 'SA'
231 *
232 * Path to generate matrices
233 *
234  matpath( 1: 1 ) = 'Double precision'
235  matpath( 2: 3 ) = 'SY'
236 *
237  nrun = 0
238  nfail = 0
239  nerrs = 0
240  DO 10 i = 1, 4
241  iseed( i ) = iseedy( i )
242  10 CONTINUE
243  lwork = max( 2*nmax, nmax*nrhs )
244 *
245 * Test the error exits
246 *
247  IF( tsterr )
248  $ CALL derrvx( 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  lda = max( n, 1 )
263  xtype = 'N'
264  nimat = ntypes
265  IF( n.LE.0 )
266  $ nimat = 1
267 *
268  DO 170 imat = 1, nimat
269 *
270 * Do the tests only if DOTYPE( IMAT ) is true.
271 *
272  IF( .NOT.dotype( imat ) )
273  $ GO TO 170
274 *
275 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
276 *
277  zerot = imat.GE.3 .AND. imat.LE.6
278  IF( zerot .AND. n.LT.imat-2 )
279  $ GO TO 170
280 *
281 * Do first for UPLO = 'U', then for UPLO = 'L'
282 *
283  DO 160 iuplo = 1, 2
284  uplo = uplos( iuplo )
285 *
286 * Set up parameters with DLATB4 and generate a test matrix
287 * with DLATMS.
288 *
289  CALL dlatb4( matpath, imat, n, n, TYPE, kl, ku, anorm,
290  $ mode, cndnum, dist )
291 *
292  srnamt = 'DLATMS'
293  CALL dlatms( n, n, dist, iseed, TYPE, rwork, mode,
294  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
295  $ info )
296 *
297 * Check error code from DLATMS.
298 *
299  IF( info.NE.0 ) THEN
300  CALL alaerh( path, 'DLATMS', info, 0, uplo, n, n, -1,
301  $ -1, -1, imat, nfail, nerrs, nout )
302  GO TO 160
303  END IF
304 *
305 * For types 3-6, zero one or more rows and columns of the
306 * matrix to test that INFO is returned correctly.
307 *
308  IF( zerot ) THEN
309  IF( imat.EQ.3 ) THEN
310  izero = 1
311  ELSE IF( imat.EQ.4 ) THEN
312  izero = n
313  ELSE
314  izero = n / 2 + 1
315  END IF
316 *
317  IF( imat.LT.6 ) THEN
318 *
319 * Set row and column IZERO to zero.
320 *
321  IF( iuplo.EQ.1 ) THEN
322  ioff = ( izero-1 )*lda
323  DO 20 i = 1, izero - 1
324  a( ioff+i ) = zero
325  20 CONTINUE
326  ioff = ioff + izero
327  DO 30 i = izero, n
328  a( ioff ) = zero
329  ioff = ioff + lda
330  30 CONTINUE
331  ELSE
332  ioff = izero
333  DO 40 i = 1, izero - 1
334  a( ioff ) = zero
335  ioff = ioff + lda
336  40 CONTINUE
337  ioff = ioff - izero
338  DO 50 i = izero, n
339  a( ioff+i ) = zero
340  50 CONTINUE
341  END IF
342  ELSE
343  ioff = 0
344  IF( iuplo.EQ.1 ) THEN
345 *
346 * Set the first IZERO rows and columns to zero.
347 *
348  DO 70 j = 1, n
349  i2 = min( j, izero )
350  DO 60 i = 1, i2
351  a( ioff+i ) = zero
352  60 CONTINUE
353  ioff = ioff + lda
354  70 CONTINUE
355  izero = 1
356  ELSE
357 *
358 * Set the last IZERO rows and columns to zero.
359 *
360  DO 90 j = 1, n
361  i1 = max( j, izero )
362  DO 80 i = i1, n
363  a( ioff+i ) = zero
364  80 CONTINUE
365  ioff = ioff + lda
366  90 CONTINUE
367  END IF
368  END IF
369  ELSE
370  izero = 0
371  END IF
372 *
373  DO 150 ifact = 1, nfact
374 *
375 * Do first for FACT = 'F', then for other values.
376 *
377  fact = facts( ifact )
378 *
379 * Form an exact solution and set the right hand side.
380 *
381  srnamt = 'DLARHS'
382  CALL dlarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
383  $ nrhs, a, lda, xact, lda, b, lda, iseed,
384  $ info )
385  xtype = 'C'
386 *
387 * --- Test DSYSV_AA ---
388 *
389  IF( ifact.EQ.2 ) THEN
390  CALL dlacpy( uplo, n, n, a, lda, afac, lda )
391  CALL dlacpy( 'Full', n, nrhs, b, lda, x, lda )
392 *
393 * Factor the matrix and solve the system using DSYSV_AA.
394 *
395  srnamt = 'DSYSV_AA'
396  CALL dsysv_aa( uplo, n, nrhs, afac, lda, iwork,
397  $ x, lda, work, lwork, info )
398 *
399 * Adjust the expected value of INFO to account for
400 * pivoting.
401 *
402  IF( izero.GT.0 ) THEN
403  j = 1
404  k = izero
405  100 CONTINUE
406  IF( j.EQ.k ) THEN
407  k = iwork( j )
408  ELSE IF( iwork( j ).EQ.k ) THEN
409  k = j
410  END IF
411  IF( j.LT.k ) THEN
412  j = j + 1
413  GO TO 100
414  END IF
415  ELSE
416  k = 0
417  END IF
418 *
419 * Check error code from DSYSV_AA .
420 *
421  IF( info.NE.k ) THEN
422  CALL alaerh( path, 'DSYSV_AA ', info, k,
423  $ uplo, n, n, -1, -1, nrhs,
424  $ imat, nfail, nerrs, nout )
425  GO TO 120
426  ELSE IF( info.NE.0 ) THEN
427  GO TO 120
428  END IF
429 *
430 * Reconstruct matrix from factors and compute
431 * residual.
432 *
433  CALL dsyt01_aa( uplo, n, a, lda, afac, lda,
434  $ iwork, ainv, lda, rwork,
435  $ result( 1 ) )
436 *
437 * Compute residual of the computed solution.
438 *
439  CALL dlacpy( 'Full', n, nrhs, b, lda, work, lda )
440  CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
441  $ lda, rwork, result( 2 ) )
442  nt = 2
443 *
444 * Print information about the tests that did not pass
445 * the threshold.
446 *
447  DO 110 k = 1, nt
448  IF( result( k ).GE.thresh ) THEN
449  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
450  $ CALL aladhd( nout, path )
451  WRITE( nout, fmt = 9999 )'DSYSV_AA ',
452  $ uplo, n, imat, k, result( k )
453  nfail = nfail + 1
454  END IF
455  110 CONTINUE
456  nrun = nrun + nt
457  120 CONTINUE
458  END IF
459 *
460  150 CONTINUE
461 *
462  160 CONTINUE
463  170 CONTINUE
464  180 CONTINUE
465 *
466 * Print a summary of the results.
467 *
468  CALL alasvm( path, nout, nfail, nrun, nerrs )
469 *
470  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
471  $ ', test ', i2, ', ratio =', g12.5 )
472  RETURN
473 *
474 * End of DDRVSY_AA
475 *
dlacpy
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
dlansy
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, or the element of largest absolute value of a real symmetric matrix.
Definition: dlansy.f:124
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
dlarhs
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
Definition: dlarhs.f:206
dsysv_aa
subroutine dsysv_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
DSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: dsysv_aa.f:166
dlaset
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:112
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
dsyt01_aa
subroutine dsyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
DSYT01
Definition: dsyt01_aa.f:128
dlatb4
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
Definition: dlatb4.f:122
dget04
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
Definition: dget04.f:104
dsytrf_aa
subroutine dsytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_AA
Definition: dsytrf_aa.f:138
aladhd
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:92
derrvx
subroutine derrvx(PATH, NUNIT)
DERRVX
Definition: derrvx.f:57
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
dpot05
subroutine dpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPOT05
Definition: dpot05.f:166
dlatms
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
dpot02
subroutine dpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DPOT02
Definition: dpot02.f:129

Here is the call graph for this function:

Here is the caller graph for this function: