LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
subroutine sdrvsy_aa ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NRHS,
real  THRESH,
logical  TSTERR,
integer  NMAX,
real, dimension( * )  A,
real, dimension( * )  AFAC,
real, dimension( * )  AINV,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

SDRVSY_AA

Purpose: 
 SDRVSY_AA tests the driver routine SSYSV_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 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 REAL array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is REAL array, dimension (NMAX*NMAX)
[out]AINV
          AINV is REAL array, dimension (NMAX*NMAX)
[out]B
          B is REAL array, dimension (NMAX*NRHS)
[out]X
          X is REAL array, dimension (NMAX*NRHS)
[out]XACT
          XACT is REAL array, dimension (NMAX*NRHS)
[out]WORK
          WORK is REAL array, dimension (NMAX*max(2,NRHS))
[out]RWORK
          RWORK is REAL 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 154 of file sdrvsy_aa.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: