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

CDRVSY_AA

Purpose: 
 CDRVSY_AA tests the driver routine CSYSV_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 157 of file cdrvsy_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  REAL thresh
167 * ..
168 * .. Array Arguments ..
169  LOGICAL dotype( * )
170  INTEGER iwork( * ), nval( * )
171  REAL rwork( * )
172  COMPLEX a( * ), afac( * ), ainv( * ), b( * ),
173  $ work( * ), x( * ), xact( * )
174 * ..
175 *
176 * =====================================================================
177 *
178 * .. Parameters ..
179  REAL zero
180  parameter ( zero = 0.0d+0 )
181  COMPLEX 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  REAL anorm, cndnum
196 * ..
197 * .. Local Arrays ..
198  CHARACTER facts( nfact ), uplos( 2 )
199  INTEGER iseed( 4 ), iseedy( 4 )
200  REAL result( ntests )
201 * ..
202 * .. External Functions ..
203  REAL dget06, clansy
204  EXTERNAL dget06, clansy
205 * ..
206 * .. External Subroutines ..
207  EXTERNAL aladhd, alaerh, alasvm, derrvx, cget04, clacpy,
208  $ clarhs, claset, clatb4, clatms, csyt02, dsyt05,
209  $ csysv_aa, csyt01_aa, csytrf_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 ) = 'Complex precision'
234  path( 2: 3 ) = 'SA'
235 *
236 * Path to generate matrices
237 *
238  matpath( 1: 1 ) = 'Complex 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 cerrvx( 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 CLATB4 and generate a test matrix
291 * with CLATMS.
292 *
293  CALL clatb4( matpath, imat, n, n, TYPE, kl, ku, anorm,
294  $ mode, cndnum, dist )
295 *
296  srnamt = 'CLATMS'
297  CALL clatms( n, n, dist, iseed, TYPE, rwork, mode,
298  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
299  $ info )
300 *
301 * Check error code from CLATMS.
302 *
303  IF( info.NE.0 ) THEN
304  CALL alaerh( path, 'CLATMS', 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 = 'CLARHS'
386  CALL clarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
387  $ nrhs, a, lda, xact, lda, b, lda, iseed,
388  $ info )
389  xtype = 'C'
390 *
391 * --- Test CSYSV_AA ---
392 *
393  IF( ifact.EQ.2 ) THEN
394  CALL clacpy( uplo, n, n, a, lda, afac, lda )
395  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
396 *
397 * Factor the matrix and solve the system using CSYSV_AA.
398 *
399  srnamt = 'CSYSV_AA'
400  CALL csysv_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 CSYSV_AA .
424 *
425  IF( info.NE.k ) THEN
426  CALL alaerh( path, 'CSYSV_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 csyt01_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 clacpy( 'Full', n, nrhs, b, lda, work, lda )
444  CALL csyt02( 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 )'CSYSV_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 CDRVSY_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
clarhs
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
csytrf_aa
subroutine csytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_AA
Definition: csytrf_aa.f:138
csyt02
subroutine csyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CSYT02
Definition: csyt02.f:129
csyt01_aa
subroutine csyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CSYT01
Definition: csyt01_aa.f:128
csysv_aa
subroutine csysv_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: csysv_aa.f:164
claset
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
cerrvx
subroutine cerrvx(PATH, NUNIT)
CERRVX
Definition: cerrvx.f:57
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
aladhd
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:92
derrvx
subroutine derrvx(PATH, NUNIT)
DERRVX
Definition: derrvx.f:57
clacpy
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
clansy
real function clansy(NORM, UPLO, N, A, LDA, WORK)
CLANSY 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: clansy.f:125
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
cget04
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104

Here is the call graph for this function:

Here is the caller graph for this function: