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

ZDRVSY_AA

Purpose: 
 ZDRVSY_AA tests the driver routine ZSYSV_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 COMPLEX*16
          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 COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]WORK
          WORK is COMPLEX*16 array, dimension (NMAX*max(2,NRHS))
[out]RWORK
          RWORK is COMPLEX*16 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 157 of file zdrvsy_aa.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: