LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ ddrvsy_aa_2stage()

subroutine ddrvsy_aa_2stage ( 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_2STAGE

Purpose:
 DDRVSY_AA_2STAGE tests the driver routine DSYSV_AA_2STAGE.
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 (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 157 of file ddrvsy_aa_2stage.f.

157 *
158 * -- LAPACK test routine (version 3.8.0) --
159 * -- LAPACK is a software package provided by Univ. of Tennessee, --
160 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
161 * November 2017
162 *
163 * .. Scalar Arguments ..
164  LOGICAL TSTERR
165  INTEGER NMAX, NN, NOUT, NRHS
166  DOUBLE PRECISION THRESH
167 * ..
168 * .. Array Arguments ..
169  LOGICAL DOTYPE( * )
170  INTEGER IWORK( * ), NVAL( * )
171  DOUBLE PRECISION RWORK( * )
172  DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
173  $ WORK( * ), X( * ), XACT( * )
174 * ..
175 *
176 * =====================================================================
177 *
178 * .. Parameters ..
179  DOUBLE PRECISION ONE, ZERO
180  parameter( one = 1.0d+0, zero = 0.0d+0 )
181  INTEGER NTYPES, NTESTS
182  parameter( ntypes = 10, ntests = 3 )
183  INTEGER NFACT
184  parameter( nfact = 2 )
185 * ..
186 * .. Local Scalars ..
187  LOGICAL ZEROT
188  CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
189  CHARACTER*3 MATPATH, PATH
190  INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
191  $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
192  $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
193  DOUBLE PRECISION ANORM, CNDNUM
194 * ..
195 * .. Local Arrays ..
196  CHARACTER FACTS( NFACT ), UPLOS( 2 )
197  INTEGER ISEED( 4 ), ISEEDY( 4 )
198  DOUBLE PRECISION RESULT( NTESTS )
199 * ..
200 * .. External Functions ..
201  DOUBLE PRECISION DLANSY, SGET06
202  EXTERNAL dlansy, sget06
203 * ..
204 * .. External Subroutines ..
205  EXTERNAL aladhd, alaerh, alasvm, xlaenv, derrvx,
206  $ dget04, dlacpy, dlarhs, dlatb4, dlatms,
207  $ dsysv_aa_2stage, dpot02,
208  $ dsytrf_aa_2stage
209 * ..
210 * .. Scalars in Common ..
211  LOGICAL LERR, OK
212  CHARACTER*32 SRNAMT
213  INTEGER INFOT, NUNIT
214 * ..
215 * .. Common blocks ..
216  COMMON / infoc / infot, nunit, ok, lerr
217  COMMON / srnamc / srnamt
218 * ..
219 * .. Intrinsic Functions ..
220  INTRINSIC cmplx, max, min
221 * ..
222 * .. Data statements ..
223  DATA iseedy / 1988, 1989, 1990, 1991 /
224  DATA uplos / 'U', 'L' / , facts / 'F', 'N' /
225 * ..
226 * .. Executable Statements ..
227 *
228 * Initialize constants and the random number seed.
229 *
230 * Test path
231 *
232  path( 1: 1 ) = 'Double precision'
233  path( 2: 3 ) = 'S2'
234 *
235 * Path to generate matrices
236 *
237  matpath( 1: 1 ) = 'Double precision'
238  matpath( 2: 3 ) = 'SY'
239 *
240  nrun = 0
241  nfail = 0
242  nerrs = 0
243  DO 10 i = 1, 4
244  iseed( i ) = iseedy( i )
245  10 CONTINUE
246 *
247 * Test the error exits
248 *
249  IF( tsterr )
250  $ CALL derrvx( path, nout )
251  infot = 0
252 *
253 * Set the block size and minimum block size for testing.
254 *
255  nb = 1
256  nbmin = 2
257  CALL xlaenv( 1, nb )
258  CALL xlaenv( 2, nbmin )
259 *
260 * Do for each value of N in NVAL
261 *
262  DO 180 in = 1, nn
263  n = nval( in )
264  lda = max( n, 1 )
265  xtype = 'N'
266  nimat = ntypes
267  IF( n.LE.0 )
268  $ nimat = 1
269 *
270  DO 170 imat = 1, nimat
271 *
272 * Do the tests only if DOTYPE( IMAT ) is true.
273 *
274  IF( .NOT.dotype( imat ) )
275  $ GO TO 170
276 *
277 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
278 *
279  zerot = imat.GE.3 .AND. imat.LE.6
280  IF( zerot .AND. n.LT.imat-2 )
281  $ GO TO 170
282 *
283 * Do first for UPLO = 'U', then for UPLO = 'L'
284 *
285  DO 160 iuplo = 1, 2
286  uplo = uplos( iuplo )
287 *
288 * Begin generate the test matrix A.
289 *
290 * Set up parameters with DLATB4 for the matrix generator
291 * based on the type of matrix to be generated.
292 *
293  CALL dlatb4( matpath, imat, n, n, TYPE, KL, KU, ANORM,
294  $ MODE, CNDNUM, DIST )
295 *
296 * Generate a matrix with DLATMS.
297 *
298  srnamt = 'DLATMS'
299  CALL dlatms( n, n, dist, iseed, TYPE, RWORK, MODE,
300  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
301  $ WORK, INFO )
302 *
303 * Check error code from DLATMS and handle error.
304 *
305  IF( info.NE.0 ) THEN
306  CALL alaerh( path, 'DLATMS', info, 0, uplo, n, n,
307  $ -1, -1, -1, imat, nfail, nerrs, nout )
308  GO TO 160
309  END IF
310 *
311 * For types 3-6, zero one or more rows and columns of
312 * the matrix to test that INFO is returned correctly.
313 *
314  IF( zerot ) THEN
315  IF( imat.EQ.3 ) THEN
316  izero = 1
317  ELSE IF( imat.EQ.4 ) THEN
318  izero = n
319  ELSE
320  izero = n / 2 + 1
321  END IF
322 *
323  IF( imat.LT.6 ) THEN
324 *
325 * Set row and column IZERO to zero.
326 *
327  IF( iuplo.EQ.1 ) THEN
328  ioff = ( izero-1 )*lda
329  DO 20 i = 1, izero - 1
330  a( ioff+i ) = zero
331  20 CONTINUE
332  ioff = ioff + izero
333  DO 30 i = izero, n
334  a( ioff ) = zero
335  ioff = ioff + lda
336  30 CONTINUE
337  ELSE
338  ioff = izero
339  DO 40 i = 1, izero - 1
340  a( ioff ) = zero
341  ioff = ioff + lda
342  40 CONTINUE
343  ioff = ioff - izero
344  DO 50 i = izero, n
345  a( ioff+i ) = zero
346  50 CONTINUE
347  END IF
348  ELSE
349  ioff = 0
350  IF( iuplo.EQ.1 ) THEN
351 *
352 * Set the first IZERO rows and columns to zero.
353 *
354  DO 70 j = 1, n
355  i2 = min( j, izero )
356  DO 60 i = 1, i2
357  a( ioff+i ) = zero
358  60 CONTINUE
359  ioff = ioff + lda
360  70 CONTINUE
361  izero = 1
362  ELSE
363 *
364 * Set the first IZERO rows and columns to zero.
365 *
366  ioff = 0
367  DO 90 j = 1, n
368  i1 = max( j, izero )
369  DO 80 i = i1, n
370  a( ioff+i ) = zero
371  80 CONTINUE
372  ioff = ioff + lda
373  90 CONTINUE
374  END IF
375  END IF
376  ELSE
377  izero = 0
378  END IF
379 *
380 * End generate the test matrix A.
381 *
382 *
383  DO 150 ifact = 1, nfact
384 *
385 * Do first for FACT = 'F', then for other values.
386 *
387  fact = facts( ifact )
388 *
389 * Form an exact solution and set the right hand side.
390 *
391  srnamt = 'DLARHS'
392  CALL dlarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
393  $ nrhs, a, lda, xact, lda, b, lda, iseed,
394  $ info )
395  xtype = 'C'
396 *
397 * --- Test DSYSV_AA_2STAGE ---
398 *
399  IF( ifact.EQ.2 ) THEN
400  CALL dlacpy( uplo, n, n, a, lda, afac, lda )
401  CALL dlacpy( 'Full', n, nrhs, b, lda, x, lda )
402 *
403 * Factor the matrix and solve the system using DSYSV_AA.
404 *
405  srnamt = 'DSYSV_AA_2STAGE '
406  lwork = min(n*nb, 3*nmax*nmax)
407  CALL dsysv_aa_2stage( uplo, n, nrhs, afac, lda,
408  $ ainv, (3*nb+1)*n,
409  $ iwork, iwork( 1+n ),
410  $ x, lda, work, lwork, info )
411 *
412 * Adjust the expected value of INFO to account for
413 * pivoting.
414 *
415  IF( izero.GT.0 ) THEN
416  j = 1
417  k = izero
418  100 CONTINUE
419  IF( j.EQ.k ) THEN
420  k = iwork( j )
421  ELSE IF( iwork( j ).EQ.k ) THEN
422  k = j
423  END IF
424  IF( j.LT.k ) THEN
425  j = j + 1
426  GO TO 100
427  END IF
428  ELSE
429  k = 0
430  END IF
431 *
432 * Check error code from DSYSV_AA .
433 *
434  IF( info.NE.k ) THEN
435  CALL alaerh( path, 'DSYSV_AA', info, k,
436  $ uplo, n, n, -1, -1, nrhs,
437  $ imat, nfail, nerrs, nout )
438  GO TO 120
439  ELSE IF( info.NE.0 ) THEN
440  GO TO 120
441  END IF
442 *
443 * Compute residual of the computed solution.
444 *
445  CALL dlacpy( 'Full', n, nrhs, b, lda, work, lda )
446  CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
447  $ lda, rwork, result( 1 ) )
448 *
449 * Reconstruct matrix from factors and compute
450 * residual.
451 *
452 c CALL CHET01_AA( UPLO, N, A, LDA, AFAC, LDA,
453 c $ IWORK, AINV, LDA, RWORK,
454 c $ RESULT( 2 ) )
455 c NT = 2
456  nt = 1
457 *
458 * Print information about the tests that did not pass
459 * the threshold.
460 *
461  DO 110 k = 1, nt
462  IF( result( k ).GE.thresh ) THEN
463  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
464  $ CALL aladhd( nout, path )
465  WRITE( nout, fmt = 9999 )'DSYSV_AA ',
466  $ uplo, n, imat, k, result( k )
467  nfail = nfail + 1
468  END IF
469  110 CONTINUE
470  nrun = nrun + nt
471  120 CONTINUE
472  END IF
473 *
474  150 CONTINUE
475 *
476  160 CONTINUE
477  170 CONTINUE
478  180 CONTINUE
479 *
480 * Print a summary of the results.
481 *
482  CALL alasvm( path, nout, nfail, nrun, nerrs )
483 *
484  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
485  $ ', test ', i2, ', ratio =', g12.5 )
486  RETURN
487 *
488 * End of DDRVSY_AA_2STAGE
489 *
Here is the call graph for this function:
Here is the caller graph for this function:
dsytrf_aa_2stage
subroutine dsytrf_aa_2stage(UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, WORK, LWORK, INFO)
DSYTRF_AA_2STAGE
Definition: dsytrf_aa_2stage.f:162
dlatms
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
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
dget04
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
Definition: dget04.f:104
sget06
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
dsysv_aa_2stage
subroutine dsysv_aa_2stage(UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, IPIV2, B, LDB, WORK, LWORK, INFO)
DSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices
Definition: dsysv_aa_2stage.f:190
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
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