LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zdrvsy_aa_2stage()

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

Purpose:
 ZDRVSY_AA_2STAGE tests the driver routine ZSYSV_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 DOUBLE PRECISION
          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 (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.

Definition at line 151 of file zdrvsy_aa_2stage.f.

155*
156* -- LAPACK test routine --
157* -- LAPACK is a software package provided by Univ. of Tennessee, --
158* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
159*
160* .. Scalar Arguments ..
161 LOGICAL TSTERR
162 INTEGER NMAX, NN, NOUT, NRHS
163 DOUBLE PRECISION THRESH
164* ..
165* .. Array Arguments ..
166 LOGICAL DOTYPE( * )
167 INTEGER IWORK( * ), NVAL( * )
168 DOUBLE PRECISION RWORK( * )
169 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
170 $ WORK( * ), X( * ), XACT( * )
171* ..
172*
173* =====================================================================
174*
175* .. Parameters ..
176 DOUBLE PRECISION ZERO
177 parameter( zero = 0.0d+0 )
178 COMPLEX*16 CZERO
179 parameter( czero = ( 0.0d+0, 0.0d+0 ) )
180 INTEGER NTYPES, NTESTS
181 parameter( ntypes = 10, ntests = 3 )
182 INTEGER NFACT
183 parameter( nfact = 2 )
184* ..
185* .. Local Scalars ..
186 LOGICAL ZEROT
187 CHARACTER DIST, FACT, TYPE, UPLO, XTYPE
188 CHARACTER*3 MATPATH, PATH
189 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
190 $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N,
191 $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT
192 DOUBLE PRECISION ANORM, CNDNUM
193* ..
194* .. Local Arrays ..
195 CHARACTER FACTS( NFACT ), UPLOS( 2 )
196 INTEGER ISEED( 4 ), ISEEDY( 4 )
197 DOUBLE PRECISION RESULT( NTESTS )
198* ..
199* .. External Functions ..
200 DOUBLE PRECISION DGET06, ZLANSY
201 EXTERNAL dget06, zlansy
202* ..
203* .. External Subroutines ..
204 EXTERNAL aladhd, alaerh, alasvm, xlaenv, zerrvx,
205 $ zget04, zlacpy, zlarhs, zlatb4, zlatms,
206 $ zsysv_aa_2stage, zsyt01_aa, zsyt02,
207 $ zsytrf_aa_2stage
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 cmplx, 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 ) = 'H2'
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 lda = max( n, 1 )
264 xtype = 'N'
265 nimat = ntypes
266 IF( n.LE.0 )
267 $ nimat = 1
268*
269 DO 170 imat = 1, nimat
270*
271* Do the tests only if DOTYPE( IMAT ) is true.
272*
273 IF( .NOT.dotype( imat ) )
274 $ GO TO 170
275*
276* Skip types 3, 4, 5, or 6 if the matrix size is too small.
277*
278 zerot = imat.GE.3 .AND. imat.LE.6
279 IF( zerot .AND. n.LT.imat-2 )
280 $ GO TO 170
281*
282* Do first for UPLO = 'U', then for UPLO = 'L'
283*
284 DO 160 iuplo = 1, 2
285 uplo = uplos( iuplo )
286*
287* Begin generate the test matrix A.
288*
289* Set up parameters with ZLATB4 for the matrix generator
290* based on the type of matrix to be generated.
291*
292 CALL zlatb4( matpath, imat, n, n, TYPE, KL, KU, ANORM,
293 $ MODE, CNDNUM, DIST )
294*
295* Generate a matrix with ZLATMS.
296*
297 srnamt = 'ZLATMS'
298 CALL zlatms( n, n, dist, iseed, TYPE, RWORK, MODE,
299 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA,
300 $ WORK, INFO )
301*
302* Check error code from ZLATMS and handle error.
303*
304 IF( info.NE.0 ) THEN
305 CALL alaerh( path, 'ZLATMS', info, 0, uplo, n, n,
306 $ -1, -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
311* the 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 first IZERO rows and columns to zero.
364*
365 ioff = 0
366 DO 90 j = 1, n
367 i1 = max( j, izero )
368 DO 80 i = i1, n
369 a( ioff+i ) = czero
370 80 CONTINUE
371 ioff = ioff + lda
372 90 CONTINUE
373 END IF
374 END IF
375 ELSE
376 izero = 0
377 END IF
378*
379* End generate the test matrix A.
380*
381*
382 DO 150 ifact = 1, nfact
383*
384* Do first for FACT = 'F', then for other values.
385*
386 fact = facts( ifact )
387*
388* Form an exact solution and set the right hand side.
389*
390 srnamt = 'ZLARHS'
391 CALL zlarhs( matpath, xtype, uplo, ' ', n, n, kl, ku,
392 $ nrhs, a, lda, xact, lda, b, lda, iseed,
393 $ info )
394 xtype = 'C'
395*
396* --- Test ZSYSV_AA_2STAGE ---
397*
398 IF( ifact.EQ.2 ) THEN
399 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
400 CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
401*
402* Factor the matrix and solve the system using ZSYSV_AA.
403*
404 srnamt = 'ZSYSV_AA_2STAGE '
405 lwork = min(n*nb, 3*nmax*nmax)
406 CALL zsysv_aa_2stage( uplo, n, nrhs, afac, lda,
407 $ ainv, (3*nb+1)*n,
408 $ iwork, iwork( 1+n ),
409 $ x, lda, work, lwork, info )
410*
411* Adjust the expected value of INFO to account for
412* pivoting.
413*
414 IF( izero.GT.0 ) THEN
415 j = 1
416 k = izero
417 100 CONTINUE
418 IF( j.EQ.k ) THEN
419 k = iwork( j )
420 ELSE IF( iwork( j ).EQ.k ) THEN
421 k = j
422 END IF
423 IF( j.LT.k ) THEN
424 j = j + 1
425 GO TO 100
426 END IF
427 ELSE
428 k = 0
429 END IF
430*
431* Check error code from ZSYSV_AA_2STAGE .
432*
433 IF( info.NE.k ) THEN
434 CALL alaerh( path, 'ZSYSV_AA_2STAGE', info, k,
435 $ uplo, n, n, -1, -1, nrhs,
436 $ imat, nfail, nerrs, nout )
437 GO TO 120
438 ELSE IF( info.NE.0 ) THEN
439 GO TO 120
440 END IF
441*
442* Compute residual of the computed solution.
443*
444 CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
445 CALL zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
446 $ lda, rwork, result( 1 ) )
447*
448* Reconstruct matrix from factors and compute
449* residual.
450*
451c CALL ZSY01_AA( UPLO, N, A, LDA, AFAC, LDA,
452c $ IWORK, AINV, LDA, RWORK,
453c $ RESULT( 2 ) )
454c NT = 2
455 nt = 1
456*
457* Print information about the tests that did not pass
458* the threshold.
459*
460 DO 110 k = 1, nt
461 IF( result( k ).GE.thresh ) THEN
462 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
463 $ CALL aladhd( nout, path )
464 WRITE( nout, fmt = 9999 )'ZSYSV_AA_2STAGE ',
465 $ uplo, n, imat, k, result( k )
466 nfail = nfail + 1
467 END IF
468 110 CONTINUE
469 nrun = nrun + nt
470 120 CONTINUE
471 END IF
472*
473 150 CONTINUE
474*
475 160 CONTINUE
476 170 CONTINUE
477 180 CONTINUE
478*
479* Print a summary of the results.
480*
481 CALL alasvm( path, nout, nfail, nrun, nerrs )
482*
483 9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i2,
484 $ ', test ', i2, ', ratio =', g12.5 )
485 RETURN
486*
487* End of ZDRVSY_AA_2STAGE
488*
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:73
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:81
aladhd
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:90
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:147
zlarhs
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:208
zsyt02
subroutine zsyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZSYT02
Definition: zsyt02.f:127
zsyt01_aa
subroutine zsyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01
Definition: zsyt01_aa.f:124
zerrvx
subroutine zerrvx(PATH, NUNIT)
ZERRVX
Definition: zerrvx.f:55
zget04
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:102
zlatb4
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:121
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:332
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:103
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:123
zsytrf_aa_2stage
subroutine zsytrf_aa_2stage(UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, WORK, LWORK, INFO)
ZSYTRF_AA_2STAGE
Definition: zsytrf_aa_2stage.f:160
zsysv_aa_2stage
subroutine zsysv_aa_2stage(UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, IPIV2, B, LDB, WORK, LWORK, INFO)
ZSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices
Definition: zsysv_aa_2stage.f:186
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:55
Here is the call graph for this function:
Here is the caller graph for this function: