LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ ddrvsy_aa()

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
November 2017

Definition at line 156 of file ddrvsy_aa.f.

156 *
157 * -- LAPACK test routine (version 3.8.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 * November 2017
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,
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 *
244 * Test the error exits
245 *
246  IF( tsterr )
247  $ CALL derrvx( path, nout )
248  infot = 0
249 *
250 * Set the block size and minimum block size for testing.
251 *
252  nb = 1
253  nbmin = 2
254  CALL xlaenv( 1, nb )
255  CALL xlaenv( 2, nbmin )
256 *
257 * Do for each value of N in NVAL
258 *
259  DO 180 in = 1, nn
260  n = nval( in )
261  lwork = max( 3*n-2, n*(1+nb) )
262  lwork = max( lwork, 1 )
263  lda = max( n, 1 )
264  xtype = 'N'
265  nimat = ntypes
266  IF( n.LE.0 )
267  $ nimat = 1
268 *
269  DO 170 imat = 1, nimat
270 *
271 * Do the tests only if DOTYPE( IMAT ) is true.
272 *
273  IF( .NOT.dotype( imat ) )
274  $ GO TO 170
275 *
276 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
277 *
278  zerot = imat.GE.3 .AND. imat.LE.6
279  IF( zerot .AND. n.LT.imat-2 )
280  $ GO TO 170
281 *
282 * Do first for UPLO = 'U', then for UPLO = 'L'
283 *
284  DO 160 iuplo = 1, 2
285  uplo = uplos( iuplo )
286 *
287 * Set up parameters with DLATB4 and generate a test matrix
288 * with DLATMS.
289 *
290  CALL dlatb4( matpath, imat, n, n, TYPE, KL, KU, ANORM,
291  $ MODE, CNDNUM, DIST )
292 *
293  srnamt = 'DLATMS'
294  CALL dlatms( n, n, dist, iseed, TYPE, RWORK, MODE,
295  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
296  $ INFO )
297 *
298 * Check error code from DLATMS.
299 *
300  IF( info.NE.0 ) THEN
301  CALL alaerh( path, 'DLATMS', info, 0, uplo, n, n, -1,
302  $ -1, -1, imat, nfail, nerrs, nout )
303  GO TO 160
304  END IF
305 *
306 * For types 3-6, zero one or more rows and columns of the
307 * matrix to test that INFO is returned correctly.
308 *
309  IF( zerot ) THEN
310  IF( imat.EQ.3 ) THEN
311  izero = 1
312  ELSE IF( imat.EQ.4 ) THEN
313  izero = n
314  ELSE
315  izero = n / 2 + 1
316  END IF
317 *
318  IF( imat.LT.6 ) THEN
319 *
320 * Set row and column IZERO to zero.
321 *
322  IF( iuplo.EQ.1 ) THEN
323  ioff = ( izero-1 )*lda
324  DO 20 i = 1, izero - 1
325  a( ioff+i ) = zero
326  20 CONTINUE
327  ioff = ioff + izero
328  DO 30 i = izero, n
329  a( ioff ) = zero
330  ioff = ioff + lda
331  30 CONTINUE
332  ELSE
333  ioff = izero
334  DO 40 i = 1, izero - 1
335  a( ioff ) = zero
336  ioff = ioff + lda
337  40 CONTINUE
338  ioff = ioff - izero
339  DO 50 i = izero, n
340  a( ioff+i ) = zero
341  50 CONTINUE
342  END IF
343  ELSE
344  ioff = 0
345  IF( iuplo.EQ.1 ) THEN
346 *
347 * Set the first IZERO rows and columns to zero.
348 *
349  DO 70 j = 1, n
350  i2 = min( j, izero )
351  DO 60 i = 1, i2
352  a( ioff+i ) = zero
353  60 CONTINUE
354  ioff = ioff + lda
355  70 CONTINUE
356  izero = 1
357  ELSE
358 *
359 * Set the last IZERO rows and columns to zero.
360 *
361  DO 90 j = 1, n
362  i1 = max( j, izero )
363  DO 80 i = i1, n
364  a( ioff+i ) = zero
365  80 CONTINUE
366  ioff = ioff + lda
367  90 CONTINUE
368  END IF
369  END IF
370  ELSE
371  izero = 0
372  END IF
373 *
374  DO 150 ifact = 1, nfact
375 *
376 * Do first for FACT = 'F', then for other values.
377 *
378  fact = facts( ifact )
379 *
380 * Form an exact solution and set the right hand side.
381 *
382  srnamt = 'DLARHS'
383  CALL dlarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
384  $ nrhs, a, lda, xact, lda, b, lda, iseed,
385  $ info )
386  xtype = 'C'
387 *
388 * --- Test DSYSV_AA ---
389 *
390  IF( ifact.EQ.2 ) THEN
391  CALL dlacpy( uplo, n, n, a, lda, afac, lda )
392  CALL dlacpy( 'Full', n, nrhs, b, lda, x, lda )
393 *
394 * Factor the matrix and solve the system using DSYSV_AA.
395 *
396  srnamt = 'DSYSV_AA'
397  CALL dsysv_aa( uplo, n, nrhs, afac, lda, iwork,
398  $ x, lda, work, lwork, info )
399 *
400 * Adjust the expected value of INFO to account for
401 * pivoting.
402 *
403  IF( izero.GT.0 ) THEN
404  j = 1
405  k = izero
406  100 CONTINUE
407  IF( j.EQ.k ) THEN
408  k = iwork( j )
409  ELSE IF( iwork( j ).EQ.k ) THEN
410  k = j
411  END IF
412  IF( j.LT.k ) THEN
413  j = j + 1
414  GO TO 100
415  END IF
416  ELSE
417  k = 0
418  END IF
419 *
420 * Check error code from DSYSV_AA .
421 *
422  IF( info.NE.k ) THEN
423  CALL alaerh( path, 'DSYSV_AA ', info, k,
424  $ uplo, n, n, -1, -1, nrhs,
425  $ imat, nfail, nerrs, nout )
426  GO TO 120
427  ELSE IF( info.NE.0 ) THEN
428  GO TO 120
429  END IF
430 *
431 * Reconstruct matrix from factors and compute
432 * residual.
433 *
434  CALL dsyt01_aa( uplo, n, a, lda, afac, lda,
435  $ iwork, ainv, lda, rwork,
436  $ result( 1 ) )
437 *
438 * Compute residual of the computed solution.
439 *
440  CALL dlacpy( 'Full', n, nrhs, b, lda, work, lda )
441  CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
442  $ lda, rwork, result( 2 ) )
443  nt = 2
444 *
445 * Print information about the tests that did not pass
446 * the threshold.
447 *
448  DO 110 k = 1, nt
449  IF( result( k ).GE.thresh ) THEN
450  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
451  $ CALL aladhd( nout, path )
452  WRITE( nout, fmt = 9999 )'DSYSV_AA ',
453  $ uplo, n, imat, k, result( k )
454  nfail = nfail + 1
455  END IF
456  110 CONTINUE
457  nrun = nrun + nt
458  120 CONTINUE
459  END IF
460 *
461  150 CONTINUE
462 *
463  160 CONTINUE
464  170 CONTINUE
465  180 CONTINUE
466 *
467 * Print a summary of the results.
468 *
469  CALL alasvm( path, nout, nfail, nrun, nerrs )
470 *
471  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
472  $ ', test ', i2, ', ratio =', g12.5 )
473  RETURN
474 *
475 * End of DDRVSY_AA
476 *
Here is the call graph for this function:
Here is the caller graph for this function:
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
dlatms
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
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:164
derrvx
subroutine derrvx(PATH, NUNIT)
DERRVX
Definition: derrvx.f:57
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,...
Definition: dlansy.f:124
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
dlatb4
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
Definition: dlatb4.f:122
dsyt01_aa
subroutine dsyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
DSYT01
Definition: dsyt01_aa.f:128
dget04
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
Definition: dget04.f:104
aladhd
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:92
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
dsytrf_aa
subroutine dsytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_AA
Definition: dsytrf_aa.f:134
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
dpot02
subroutine dpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DPOT02
Definition: dpot02.f:129
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
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