LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ zdrvsy_aa()

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

Definition at line 155 of file zdrvsy_aa.f.

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