LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ cdrvsy_aa()

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

Definition at line 157 of file cdrvsy_aa.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  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, cerrvx, cget04, clacpy,
208  $ clarhs, claset, clatb4, clatms, csyt02,
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 *
248 * Test the error exits
249 *
250  IF( tsterr )
251  $ CALL cerrvx( path, nout )
252  infot = 0
253 *
254 * Set the block size and minimum block size for testing.
255 *
256  nb = 1
257  nbmin = 2
258  CALL xlaenv( 1, nb )
259  CALL xlaenv( 2, nbmin )
260 *
261 * Do for each value of N in NVAL
262 *
263  DO 180 in = 1, nn
264  n = nval( in )
265  lwork = max( 3*n-2, n*(1+nb) )
266  lwork = max( lwork, 1 )
267  lda = max( n, 1 )
268  xtype = 'N'
269  nimat = ntypes
270  IF( n.LE.0 )
271  $ nimat = 1
272 *
273  DO 170 imat = 1, nimat
274 *
275 * Do the tests only if DOTYPE( IMAT ) is true.
276 *
277  IF( .NOT.dotype( imat ) )
278  $ GO TO 170
279 *
280 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
281 *
282  zerot = imat.GE.3 .AND. imat.LE.6
283  IF( zerot .AND. n.LT.imat-2 )
284  $ GO TO 170
285 *
286 * Do first for UPLO = 'U', then for UPLO = 'L'
287 *
288  DO 160 iuplo = 1, 2
289  uplo = uplos( iuplo )
290 *
291 * Set up parameters with CLATB4 and generate a test matrix
292 * with CLATMS.
293 *
294  CALL clatb4( matpath, imat, n, n, TYPE, KL, KU, ANORM,
295  $ MODE, CNDNUM, DIST )
296 *
297  srnamt = 'CLATMS'
298  CALL clatms( n, n, dist, iseed, TYPE, RWORK, MODE,
299  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
300  $ INFO )
301 *
302 * Check error code from CLATMS.
303 *
304  IF( info.NE.0 ) THEN
305  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n, -1,
306  $ -1, -1, imat, nfail, nerrs, nout )
307  GO TO 160
308  END IF
309 *
310 * For types 3-6, zero one or more rows and columns of the
311 * matrix to test that INFO is returned correctly.
312 *
313  IF( zerot ) THEN
314  IF( imat.EQ.3 ) THEN
315  izero = 1
316  ELSE IF( imat.EQ.4 ) THEN
317  izero = n
318  ELSE
319  izero = n / 2 + 1
320  END IF
321 *
322  IF( imat.LT.6 ) THEN
323 *
324 * Set row and column IZERO to zero.
325 *
326  IF( iuplo.EQ.1 ) THEN
327  ioff = ( izero-1 )*lda
328  DO 20 i = 1, izero - 1
329  a( ioff+i ) = czero
330  20 CONTINUE
331  ioff = ioff + izero
332  DO 30 i = izero, n
333  a( ioff ) = czero
334  ioff = ioff + lda
335  30 CONTINUE
336  ELSE
337  ioff = izero
338  DO 40 i = 1, izero - 1
339  a( ioff ) = czero
340  ioff = ioff + lda
341  40 CONTINUE
342  ioff = ioff - izero
343  DO 50 i = izero, n
344  a( ioff+i ) = czero
345  50 CONTINUE
346  END IF
347  ELSE
348  ioff = 0
349  IF( iuplo.EQ.1 ) THEN
350 *
351 * Set the first IZERO rows and columns to zero.
352 *
353  DO 70 j = 1, n
354  i2 = min( j, izero )
355  DO 60 i = 1, i2
356  a( ioff+i ) = czero
357  60 CONTINUE
358  ioff = ioff + lda
359  70 CONTINUE
360  izero = 1
361  ELSE
362 *
363 * Set the last IZERO rows and columns to zero.
364 *
365  DO 90 j = 1, n
366  i1 = max( j, izero )
367  DO 80 i = i1, n
368  a( ioff+i ) = czero
369  80 CONTINUE
370  ioff = ioff + lda
371  90 CONTINUE
372  END IF
373  END IF
374  ELSE
375  izero = 0
376  END IF
377 *
378  DO 150 ifact = 1, nfact
379 *
380 * Do first for FACT = 'F', then for other values.
381 *
382  fact = facts( ifact )
383 *
384 * Form an exact solution and set the right hand side.
385 *
386  srnamt = 'CLARHS'
387  CALL clarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
388  $ nrhs, a, lda, xact, lda, b, lda, iseed,
389  $ info )
390  xtype = 'C'
391 *
392 * --- Test CSYSV_AA ---
393 *
394  IF( ifact.EQ.2 ) THEN
395  CALL clacpy( uplo, n, n, a, lda, afac, lda )
396  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
397 *
398 * Factor the matrix and solve the system using CSYSV_AA.
399 *
400  srnamt = 'CSYSV_AA'
401  CALL csysv_aa( uplo, n, nrhs, afac, lda, iwork,
402  $ x, lda, work, lwork, info )
403 *
404 * Adjust the expected value of INFO to account for
405 * pivoting.
406 *
407  IF( izero.GT.0 ) THEN
408  j = 1
409  k = izero
410  100 CONTINUE
411  IF( j.EQ.k ) THEN
412  k = iwork( j )
413  ELSE IF( iwork( j ).EQ.k ) THEN
414  k = j
415  END IF
416  IF( j.LT.k ) THEN
417  j = j + 1
418  GO TO 100
419  END IF
420  ELSE
421  k = 0
422  END IF
423 *
424 * Check error code from CSYSV_AA .
425 *
426  IF( info.NE.k ) THEN
427  CALL alaerh( path, 'CSYSV_AA ', info, k,
428  $ uplo, n, n, -1, -1, nrhs,
429  $ imat, nfail, nerrs, nout )
430  GO TO 120
431  ELSE IF( info.NE.0 ) THEN
432  GO TO 120
433  END IF
434 *
435 * Reconstruct matrix from factors and compute
436 * residual.
437 *
438  CALL csyt01_aa( uplo, n, a, lda, afac, lda,
439  $ iwork, ainv, lda, rwork,
440  $ result( 1 ) )
441 *
442 * Compute residual of the computed solution.
443 *
444  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
445  CALL csyt02( uplo, n, nrhs, a, lda, x, lda, work,
446  $ lda, rwork, result( 2 ) )
447  nt = 2
448 *
449 * Print information about the tests that did not pass
450 * the threshold.
451 *
452  DO 110 k = 1, nt
453  IF( result( k ).GE.thresh ) THEN
454  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
455  $ CALL aladhd( nout, path )
456  WRITE( nout, fmt = 9999 )'CSYSV_AA ',
457  $ uplo, n, imat, k, result( k )
458  nfail = nfail + 1
459  END IF
460  110 CONTINUE
461  nrun = nrun + nt
462  120 CONTINUE
463  END IF
464 *
465  150 CONTINUE
466 *
467  160 CONTINUE
468  170 CONTINUE
469  180 CONTINUE
470 *
471 * Print a summary of the results.
472 *
473  CALL alasvm( path, nout, nfail, nrun, nerrs )
474 *
475  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
476  $ ', test ', i2, ', ratio =', g12.5 )
477  RETURN
478 *
479 * End of CDRVSY_AA
480 *
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
csyt02
subroutine csyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CSYT02
Definition: csyt02.f:129
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,...
Definition: clansy.f:125
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
cerrvx
subroutine cerrvx(PATH, NUNIT)
CERRVX
Definition: cerrvx.f:57
cget04
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
csytrf_aa
subroutine csytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_AA
Definition: csytrf_aa.f:134
csyt01_aa
subroutine csyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CSYT01
Definition: csyt01_aa.f:128
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
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
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
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
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
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
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83