LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ cdrvsy_aa_2stage()

subroutine cdrvsy_aa_2stage ( 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_2STAGE

Purpose:
 CDRVSY_AA_2STAGE tests the driver routine CSYSV_AA_2STAGE.
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 COMPLEX array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX array, dimension (NMAX*NRHS)
[out]X
          X is COMPLEX array, dimension (NMAX*NRHS)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NRHS)
[out]WORK
          WORK is COMPLEX array, dimension (NMAX*max(2,NRHS))
[out]RWORK
          RWORK is COMPLEX array, dimension (NMAX+2*NRHS)
[out]IWORK
          IWORK is INTEGER array, dimension (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_2stage.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  COMPLEX CZERO
180  parameter( czero = ( 0.0e+0, 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  REAL ANORM, CNDNUM
194 * ..
195 * .. Local Arrays ..
196  CHARACTER FACTS( NFACT ), UPLOS( 2 )
197  INTEGER ISEED( 4 ), ISEEDY( 4 )
198  REAL RESULT( NTESTS )
199 * ..
200 * .. External Functions ..
201  COMPLEX CLANSY, SGET06
202  EXTERNAL clansy, sget06
203 * ..
204 * .. External Subroutines ..
205  EXTERNAL aladhd, alaerh, alasvm, xlaenv, cerrvx,
206  $ cget04, clacpy, clarhs, clatb4, clatms,
207  $ csysv_aa_2stage, csyt01_aa, csyt02,
208  $ csytrf_aa_2stage
209 * ..
210 * .. Scalars in Common ..
211  LOGICAL LERR, OK
212  CHARACTER*32 SRNAMT
213  INTEGER INFOT, NUNIT
214 * ..
215 * .. Common blocks ..
216  COMMON / infoc / infot, nunit, ok, lerr
217  COMMON / srnamc / srnamt
218 * ..
219 * .. Intrinsic Functions ..
220  INTRINSIC cmplx, max, min
221 * ..
222 * .. Data statements ..
223  DATA iseedy / 1988, 1989, 1990, 1991 /
224  DATA uplos / 'U', 'L' / , facts / 'F', 'N' /
225 * ..
226 * .. Executable Statements ..
227 *
228 * Initialize constants and the random number seed.
229 *
230 * Test path
231 *
232  path( 1: 1 ) = 'Complex precision'
233  path( 2: 3 ) = 'S2'
234 *
235 * Path to generate matrices
236 *
237  matpath( 1: 1 ) = 'Complex precision'
238  matpath( 2: 3 ) = 'SY'
239 *
240  nrun = 0
241  nfail = 0
242  nerrs = 0
243  DO 10 i = 1, 4
244  iseed( i ) = iseedy( i )
245  10 CONTINUE
246 *
247 * Test the error exits
248 *
249  IF( tsterr )
250  $ CALL cerrvx( path, nout )
251  infot = 0
252 *
253 * Set the block size and minimum block size for testing.
254 *
255  nb = 1
256  nbmin = 2
257  CALL xlaenv( 1, nb )
258  CALL xlaenv( 2, nbmin )
259 *
260 * Do for each value of N in NVAL
261 *
262  DO 180 in = 1, nn
263  n = nval( in )
264  lda = max( n, 1 )
265  xtype = 'N'
266  nimat = ntypes
267  IF( n.LE.0 )
268  $ nimat = 1
269 *
270  DO 170 imat = 1, nimat
271 *
272 * Do the tests only if DOTYPE( IMAT ) is true.
273 *
274  IF( .NOT.dotype( imat ) )
275  $ GO TO 170
276 *
277 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
278 *
279  zerot = imat.GE.3 .AND. imat.LE.6
280  IF( zerot .AND. n.LT.imat-2 )
281  $ GO TO 170
282 *
283 * Do first for UPLO = 'U', then for UPLO = 'L'
284 *
285  DO 160 iuplo = 1, 2
286  uplo = uplos( iuplo )
287 *
288 * Begin generate the test matrix A.
289 *
290 * Set up parameters with CLATB4 for the matrix generator
291 * based on the type of matrix to be generated.
292 *
293  CALL clatb4( matpath, imat, n, n, TYPE, KL, KU, ANORM,
294  $ MODE, CNDNUM, DIST )
295 *
296 * Generate a matrix with CLATMS.
297 *
298  srnamt = 'CLATMS'
299  CALL clatms( n, n, dist, iseed, TYPE, RWORK, MODE,
300  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
301  $ WORK, INFO )
302 *
303 * Check error code from CLATMS and handle error.
304 *
305  IF( info.NE.0 ) THEN
306  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n,
307  $ -1, -1, -1, imat, nfail, nerrs, nout )
308  GO TO 160
309  END IF
310 *
311 * For types 3-6, zero one or more rows and columns of
312 * the matrix to test that INFO is returned correctly.
313 *
314  IF( zerot ) THEN
315  IF( imat.EQ.3 ) THEN
316  izero = 1
317  ELSE IF( imat.EQ.4 ) THEN
318  izero = n
319  ELSE
320  izero = n / 2 + 1
321  END IF
322 *
323  IF( imat.LT.6 ) THEN
324 *
325 * Set row and column IZERO to zero.
326 *
327  IF( iuplo.EQ.1 ) THEN
328  ioff = ( izero-1 )*lda
329  DO 20 i = 1, izero - 1
330  a( ioff+i ) = czero
331  20 CONTINUE
332  ioff = ioff + izero
333  DO 30 i = izero, n
334  a( ioff ) = czero
335  ioff = ioff + lda
336  30 CONTINUE
337  ELSE
338  ioff = izero
339  DO 40 i = 1, izero - 1
340  a( ioff ) = czero
341  ioff = ioff + lda
342  40 CONTINUE
343  ioff = ioff - izero
344  DO 50 i = izero, n
345  a( ioff+i ) = czero
346  50 CONTINUE
347  END IF
348  ELSE
349  ioff = 0
350  IF( iuplo.EQ.1 ) THEN
351 *
352 * Set the first IZERO rows and columns to zero.
353 *
354  DO 70 j = 1, n
355  i2 = min( j, izero )
356  DO 60 i = 1, i2
357  a( ioff+i ) = czero
358  60 CONTINUE
359  ioff = ioff + lda
360  70 CONTINUE
361  izero = 1
362  ELSE
363 *
364 * Set the first IZERO rows and columns to zero.
365 *
366  ioff = 0
367  DO 90 j = 1, n
368  i1 = max( j, izero )
369  DO 80 i = i1, n
370  a( ioff+i ) = czero
371  80 CONTINUE
372  ioff = ioff + lda
373  90 CONTINUE
374  END IF
375  END IF
376  ELSE
377  izero = 0
378  END IF
379 *
380 * End generate the test matrix A.
381 *
382 *
383  DO 150 ifact = 1, nfact
384 *
385 * Do first for FACT = 'F', then for other values.
386 *
387  fact = facts( ifact )
388 *
389 * Form an exact solution and set the right hand side.
390 *
391  srnamt = 'CLARHS'
392  CALL clarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
393  $ nrhs, a, lda, xact, lda, b, lda, iseed,
394  $ info )
395  xtype = 'C'
396 *
397 * --- Test CSYSV_AA_2STAGE ---
398 *
399  IF( ifact.EQ.2 ) THEN
400  CALL clacpy( uplo, n, n, a, lda, afac, lda )
401  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
402 *
403 * Factor the matrix and solve the system using CSYSV_AA.
404 *
405  srnamt = 'CSYSV_AA_2STAGE '
406  lwork = min(n*nb, 3*nmax*nmax)
407  CALL csysv_aa_2stage( uplo, n, nrhs, afac, lda,
408  $ ainv, (3*nb+1)*n,
409  $ iwork, iwork( 1+n ),
410  $ x, lda, work, lwork, info )
411 *
412 * Adjust the expected value of INFO to account for
413 * pivoting.
414 *
415  IF( izero.GT.0 ) THEN
416  j = 1
417  k = izero
418  100 CONTINUE
419  IF( j.EQ.k ) THEN
420  k = iwork( j )
421  ELSE IF( iwork( j ).EQ.k ) THEN
422  k = j
423  END IF
424  IF( j.LT.k ) THEN
425  j = j + 1
426  GO TO 100
427  END IF
428  ELSE
429  k = 0
430  END IF
431 *
432 * Check error code from CSYSV_AA .
433 *
434  IF( info.NE.k ) THEN
435  CALL alaerh( path, 'CSYSV_AA', info, k,
436  $ uplo, n, n, -1, -1, nrhs,
437  $ imat, nfail, nerrs, nout )
438  GO TO 120
439  ELSE IF( info.NE.0 ) THEN
440  GO TO 120
441  END IF
442 *
443 * Compute residual of the computed solution.
444 *
445  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
446  CALL csyt02( uplo, n, nrhs, a, lda, x, lda, work,
447  $ lda, rwork, result( 1 ) )
448 *
449 * Reconstruct matrix from factors and compute
450 * residual.
451 *
452 c CALL CSY01_AA( UPLO, N, A, LDA, AFAC, LDA,
453 c $ IWORK, AINV, LDA, RWORK,
454 c $ RESULT( 2 ) )
455 c NT = 2
456  nt = 1
457 *
458 * Print information about the tests that did not pass
459 * the threshold.
460 *
461  DO 110 k = 1, nt
462  IF( result( k ).GE.thresh ) THEN
463  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
464  $ CALL aladhd( nout, path )
465  WRITE( nout, fmt = 9999 )'CSYSV_AA_2STAGE ',
466  $ uplo, n, imat, k, result( k )
467  nfail = nfail + 1
468  END IF
469  110 CONTINUE
470  nrun = nrun + nt
471  120 CONTINUE
472  END IF
473 *
474  150 CONTINUE
475 *
476  160 CONTINUE
477  170 CONTINUE
478  180 CONTINUE
479 *
480 * Print a summary of the results.
481 *
482  CALL alasvm( path, nout, nfail, nrun, nerrs )
483 *
484  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
485  $ ', test ', i2, ', ratio =', g12.5 )
486  RETURN
487 *
488 * End of SDRVSY_AA_2STAGE
489 *
Here is the call graph for this function:
Here is the caller graph for this function:
csysv_aa_2stage
subroutine csysv_aa_2stage(UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, IPIV2, B, LDB, WORK, LWORK, INFO)
CSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices
Definition: csysv_aa_2stage.f:188
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
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
sget06
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
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
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
csytrf_aa_2stage
subroutine csytrf_aa_2stage(UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, WORK, LWORK, INFO)
CSYTRF_AA_2STAGE
Definition: csytrf_aa_2stage.f:162
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