LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zchksy_aa_2stage.f
Go to the documentation of this file.
1*> \brief \b ZCHKSY_AA_2STAGE
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE ZCHKSY_AA_2STAGE( DOTYPE, NN, NVAL, NNB, NBVAL,
12* NNS, NSVAL, THRESH, TSTERR, NMAX, A,
13* AFAC, AINV, B, X, XACT, WORK, RWORK,
14* IWORK, NOUT )
15*
16* .. Scalar Arguments ..
17* LOGICAL TSTERR
18* INTEGER NMAX, NN, NNB, NNS, NOUT
19* DOUBLE PRECISION THRESH
20* ..
21* .. Array Arguments ..
22* LOGICAL DOTYPE( * )
23* INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
24* DOUBLE PRECISION RWORK( * )
25* COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
26* $ WORK( * ), X( * ), XACT( * )
27* ..
28*
29*
30*> \par Purpose:
31* =============
32*>
33*> \verbatim
34*>
35*> ZCHKSY_AA_2STAGE tests ZSYTRF_AA_2STAGE, -TRS_AA_2STAGE.
36*> \endverbatim
37*
38* Arguments:
39* ==========
40*
41*> \param[in] DOTYPE
42*> \verbatim
43*> DOTYPE is LOGICAL array, dimension (NTYPES)
44*> The matrix types to be used for testing. Matrices of type j
45*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
46*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
47*> \endverbatim
48*>
49*> \param[in] NN
50*> \verbatim
51*> NN is INTEGER
52*> The number of values of N contained in the vector NVAL.
53*> \endverbatim
54*>
55*> \param[in] NVAL
56*> \verbatim
57*> NVAL is INTEGER array, dimension (NN)
58*> The values of the matrix dimension N.
59*> \endverbatim
60*>
61*> \param[in] NNB
62*> \verbatim
63*> NNB is INTEGER
64*> The number of values of NB contained in the vector NBVAL.
65*> \endverbatim
66*>
67*> \param[in] NBVAL
68*> \verbatim
69*> NBVAL is INTEGER array, dimension (NNB)
70*> The values of the blocksize NB.
71*> \endverbatim
72*>
73*> \param[in] NNS
74*> \verbatim
75*> NNS is INTEGER
76*> The number of values of NRHS contained in the vector NSVAL.
77*> \endverbatim
78*>
79*> \param[in] NSVAL
80*> \verbatim
81*> NSVAL is INTEGER array, dimension (NNS)
82*> The values of the number of right hand sides NRHS.
83*> \endverbatim
84*>
85*> \param[in] THRESH
86*> \verbatim
87*> THRESH is DOUBLE PRECISION
88*> The threshold value for the test ratios. A result is
89*> included in the output file if RESULT >= THRESH. To have
90*> every test ratio printed, use THRESH = 0.
91*> \endverbatim
92*>
93*> \param[in] TSTERR
94*> \verbatim
95*> TSTERR is LOGICAL
96*> Flag that indicates whether error exits are to be tested.
97*> \endverbatim
98*>
99*> \param[in] NMAX
100*> \verbatim
101*> NMAX is INTEGER
102*> The maximum value permitted for N, used in dimensioning the
103*> work arrays.
104*> \endverbatim
105*>
106*> \param[out] A
107*> \verbatim
108*> A is COMPLEX*16 array, dimension (NMAX*NMAX)
109*> \endverbatim
110*>
111*> \param[out] AFAC
112*> \verbatim
113*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
114*> \endverbatim
115*>
116*> \param[out] AINV
117*> \verbatim
118*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
119*> \endverbatim
120*>
121*> \param[out] B
122*> \verbatim
123*> B is COMPLEX*16 array, dimension (NMAX*NSMAX)
124*> where NSMAX is the largest entry in NSVAL.
125*> \endverbatim
126*>
127*> \param[out] X
128*> \verbatim
129*> X is COMPLEX*16 array, dimension (NMAX*NSMAX)
130*> \endverbatim
131*>
132*> \param[out] XACT
133*> \verbatim
134*> XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
135*> \endverbatim
136*>
137*> \param[out] WORK
138*> \verbatim
139*> WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX))
140*> \endverbatim
141*>
142*> \param[out] RWORK
143*> \verbatim
144*> RWORK is COMPLEX*16 array, dimension (max(NMAX,2*NSMAX))
145*> \endverbatim
146*>
147*> \param[out] IWORK
148*> \verbatim
149*> IWORK is INTEGER array, dimension (2*NMAX)
150*> \endverbatim
151*>
152*> \param[in] NOUT
153*> \verbatim
154*> NOUT is INTEGER
155*> The unit number for output.
156*> \endverbatim
157*
158* Authors:
159* ========
160*
161*> \author Univ. of Tennessee
162*> \author Univ. of California Berkeley
163*> \author Univ. of Colorado Denver
164*> \author NAG Ltd.
165*
166*> \ingroup complex16_lin
167*
168* =====================================================================
169 SUBROUTINE zchksy_aa_2stage( DOTYPE, NN, NVAL, NNB, NBVAL, NNS,
170 $ NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV,
171 $ B, X, XACT, WORK, RWORK, IWORK, NOUT )
172*
173* -- LAPACK test routine --
174* -- LAPACK is a software package provided by Univ. of Tennessee, --
175* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
176*
177 IMPLICIT NONE
178*
179* .. Scalar Arguments ..
180 LOGICAL TSTERR
181 INTEGER NN, NNB, NNS, NMAX, NOUT
182 DOUBLE PRECISION THRESH
183* ..
184* .. Array Arguments ..
185 LOGICAL DOTYPE( * )
186 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
187 DOUBLE PRECISION RWORK( * )
188 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
189 $ work( * ), x( * ), xact( * )
190* ..
191*
192* =====================================================================
193*
194* .. Parameters ..
195 COMPLEX*16 CZERO
196 PARAMETER ( CZERO = ( 0.0d+0, 0.0d+0 ) )
197 INTEGER NTYPES
198 parameter( ntypes = 10 )
199 INTEGER NTESTS
200 parameter( ntests = 9 )
201* ..
202* .. Local Scalars ..
203 LOGICAL ZEROT
204 CHARACTER DIST, TYPE, UPLO, XTYPE
205 CHARACTER*3 PATH, MATPATH
206 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
207 $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
208 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
209 DOUBLE PRECISION ANORM, CNDNUM
210* ..
211* .. Local Arrays ..
212 CHARACTER UPLOS( 2 )
213 INTEGER ISEED( 4 ), ISEEDY( 4 )
214 DOUBLE PRECISION RESULT( NTESTS )
215* ..
216* .. External Subroutines ..
217 EXTERNAL alaerh, alahd, alasum, zerrsy, zlacpy, zlarhs,
218 $ zlatb4, zlatms, zsyt02, zsyt01,
219 $ zsytrf_aa_2stage, zsytrs_aa_2stage,
220 $ xlaenv
221* ..
222* .. Intrinsic Functions ..
223 INTRINSIC max, min
224* ..
225* .. Scalars in Common ..
226 LOGICAL LERR, OK
227 CHARACTER*32 SRNAMT
228 INTEGER INFOT, NUNIT
229* ..
230* .. Common blocks ..
231 COMMON / infoc / infot, nunit, ok, lerr
232 COMMON / srnamc / srnamt
233* ..
234* .. Data statements ..
235 DATA iseedy / 1988, 1989, 1990, 1991 /
236 DATA uplos / 'U', 'L' /
237* ..
238* .. Executable Statements ..
239*
240* Initialize constants and the random number seed.
241*
242* Test path
243*
244 path( 1: 1 ) = 'Zomplex precision'
245 path( 2: 3 ) = 'S2'
246*
247* Path to generate matrices
248*
249 matpath( 1: 1 ) = 'Zomplex precision'
250 matpath( 2: 3 ) = 'SY'
251 nrun = 0
252 nfail = 0
253 nerrs = 0
254 DO 10 i = 1, 4
255 iseed( i ) = iseedy( i )
256 10 CONTINUE
257*
258* Test the error exits
259*
260 IF( tsterr )
261 $ CALL zerrsy( path, nout )
262 infot = 0
263*
264* Set the minimum block size for which the block routine should
265* be used, which will be later returned by ILAENV
266*
267 CALL xlaenv( 2, 2 )
268*
269* Do for each value of N in NVAL
270*
271 DO 180 in = 1, nn
272 n = nval( in )
273 IF( n .GT. nmax ) THEN
274 nfail = nfail + 1
275 WRITE(nout, 9995) 'M ', n, nmax
276 GO TO 180
277 END IF
278 lda = max( n, 1 )
279 xtype = 'N'
280 nimat = ntypes
281 IF( n.LE.0 )
282 $ nimat = 1
283*
284 izero = 0
285*
286* Do for each value of matrix type IMAT
287*
288 DO 170 imat = 1, nimat
289*
290* Do the tests only if DOTYPE( IMAT ) is true.
291*
292 IF( .NOT.dotype( imat ) )
293 $ GO TO 170
294*
295* Skip types 3, 4, 5, or 6 if the matrix size is too small.
296*
297 zerot = imat.GE.3 .AND. imat.LE.6
298 IF( zerot .AND. n.LT.imat-2 )
299 $ GO TO 170
300*
301* Do first for UPLO = 'U', then for UPLO = 'L'
302*
303 DO 160 iuplo = 1, 2
304 uplo = uplos( iuplo )
305*
306* Begin generate the test matrix A.
307*
308*
309* Set up parameters with ZLATB4 for the matrix generator
310* based on the type of matrix to be generated.
311*
312 CALL zlatb4( matpath, imat, n, n, TYPE, kl, ku,
313 $ anorm, mode, cndnum, dist )
314*
315* Generate a matrix with ZLATMS.
316*
317 srnamt = 'ZLATMS'
318 CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode,
319 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
320 $ info )
321*
322* Check error code from ZLATMS and handle error.
323*
324 IF( info.NE.0 ) THEN
325 CALL alaerh( path, 'ZLATMS', info, 0, uplo, n, n, -1,
326 $ -1, -1, imat, nfail, nerrs, nout )
327*
328* Skip all tests for this generated matrix
329*
330 GO TO 160
331 END IF
332*
333* For matrix types 3-6, zero one or more rows and
334* columns of the matrix to test that INFO is returned
335* correctly.
336*
337 IF( zerot ) THEN
338 IF( imat.EQ.3 ) THEN
339 izero = 1
340 ELSE IF( imat.EQ.4 ) THEN
341 izero = n
342 ELSE
343 izero = n / 2 + 1
344 END IF
345*
346 IF( imat.LT.6 ) THEN
347*
348* Set row and column IZERO to zero.
349*
350 IF( iuplo.EQ.1 ) THEN
351 ioff = ( izero-1 )*lda
352 DO 20 i = 1, izero - 1
353 a( ioff+i ) = czero
354 20 CONTINUE
355 ioff = ioff + izero
356 DO 30 i = izero, n
357 a( ioff ) = czero
358 ioff = ioff + lda
359 30 CONTINUE
360 ELSE
361 ioff = izero
362 DO 40 i = 1, izero - 1
363 a( ioff ) = czero
364 ioff = ioff + lda
365 40 CONTINUE
366 ioff = ioff - izero
367 DO 50 i = izero, n
368 a( ioff+i ) = czero
369 50 CONTINUE
370 END IF
371 ELSE
372 IF( iuplo.EQ.1 ) THEN
373*
374* Set the first IZERO rows and columns to zero.
375*
376 ioff = 0
377 DO 70 j = 1, n
378 i2 = min( j, izero )
379 DO 60 i = 1, i2
380 a( ioff+i ) = czero
381 60 CONTINUE
382 ioff = ioff + lda
383 70 CONTINUE
384 izero = 1
385 ELSE
386*
387* Set the last IZERO rows and columns to zero.
388*
389 ioff = 0
390 DO 90 j = 1, n
391 i1 = max( j, izero )
392 DO 80 i = i1, n
393 a( ioff+i ) = czero
394 80 CONTINUE
395 ioff = ioff + lda
396 90 CONTINUE
397 END IF
398 END IF
399 ELSE
400 izero = 0
401 END IF
402*
403* End generate the test matrix A.
404*
405* Do for each value of NB in NBVAL
406*
407 DO 150 inb = 1, nnb
408*
409* Set the optimal blocksize, which will be later
410* returned by ILAENV.
411*
412 nb = nbval( inb )
413 CALL xlaenv( 1, nb )
414*
415* Copy the test matrix A into matrix AFAC which
416* will be factorized in place. This is needed to
417* preserve the test matrix A for subsequent tests.
418*
419 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
420*
421* Compute the L*D*L**T or U*D*U**T factorization of the
422* matrix. IWORK stores details of the interchanges and
423* the block structure of D. AINV is a work array for
424* block factorization, LWORK is the length of AINV.
425*
426 srnamt = 'ZSYTRF_AA_2STAGE'
427 lwork = min(n*nb, 3*nmax*nmax)
428 CALL zsytrf_aa_2stage( uplo, n, afac, lda,
429 $ ainv, (3*nb+1)*n,
430 $ iwork, iwork( 1+n ),
431 $ work, lwork,
432 $ info )
433*
434* Adjust the expected value of INFO to account for
435* pivoting.
436*
437 IF( izero.GT.0 ) THEN
438 j = 1
439 k = izero
440 100 CONTINUE
441 IF( j.EQ.k ) THEN
442 k = iwork( j )
443 ELSE IF( iwork( j ).EQ.k ) THEN
444 k = j
445 END IF
446 IF( j.LT.k ) THEN
447 j = j + 1
448 GO TO 100
449 END IF
450 ELSE
451 k = 0
452 END IF
453*
454* Check error code from ZSYTRF and handle error.
455*
456 IF( info.NE.k ) THEN
457 CALL alaerh( path, 'ZSYTRF_AA_2STAGE', info, k,
458 $ uplo, n, n, -1, -1, nb, imat, nfail,
459 $ nerrs, nout )
460 END IF
461*
462*+ TEST 1
463* Reconstruct matrix from factors and compute residual.
464*
465c CALL ZSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
466c $ AINV, LDA, RWORK, RESULT( 1 ) )
467c NT = 1
468 nt = 0
469*
470*
471* Print information about the tests that did not pass
472* the threshold.
473*
474 DO 110 k = 1, nt
475 IF( result( k ).GE.thresh ) THEN
476 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
477 $ CALL alahd( nout, path )
478 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
479 $ result( k )
480 nfail = nfail + 1
481 END IF
482 110 CONTINUE
483 nrun = nrun + nt
484*
485* Skip solver test if INFO is not 0.
486*
487 IF( info.NE.0 ) THEN
488 GO TO 140
489 END IF
490*
491* Do for each value of NRHS in NSVAL.
492*
493 DO 130 irhs = 1, nns
494 nrhs = nsval( irhs )
495*
496*+ TEST 2 (Using TRS)
497* Solve and compute residual for A * X = B.
498*
499* Choose a set of NRHS random solution vectors
500* stored in XACT and set up the right hand side B
501*
502 srnamt = 'ZLARHS'
503 CALL zlarhs( matpath, xtype, uplo, ' ', n, n,
504 $ kl, ku, nrhs, a, lda, xact, lda,
505 $ b, lda, iseed, info )
506 CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
507*
508 srnamt = 'ZSYTRS_AA_2STAGE'
509 lwork = max( 1, 3*n-2 )
510 CALL zsytrs_aa_2stage( uplo, n, nrhs, afac, lda,
511 $ ainv, (3*nb+1)*n, iwork, iwork( 1+n ),
512 $ x, lda, info )
513*
514* Check error code from ZSYTRS and handle error.
515*
516 IF( info.NE.0 ) THEN
517 IF( izero.EQ.0 ) THEN
518 CALL alaerh( path, 'ZSYTRS_AA_2STAGE',
519 $ info, 0, uplo, n, n, -1, -1,
520 $ nrhs, imat, nfail, nerrs, nout )
521 END IF
522 ELSE
523 CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda
524 $ )
525*
526* Compute the residual for the solution
527*
528 CALL zsyt02( uplo, n, nrhs, a, lda, x, lda,
529 $ work, lda, rwork, result( 2 ) )
530*
531*
532* Print information about the tests that did not pass
533* the threshold.
534*
535 DO 120 k = 2, 2
536 IF( result( k ).GE.thresh ) THEN
537 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
538 $ CALL alahd( nout, path )
539 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
540 $ imat, k, result( k )
541 nfail = nfail + 1
542 END IF
543 120 CONTINUE
544 END IF
545 nrun = nrun + 1
546*
547* End do for each value of NRHS in NSVAL.
548*
549 130 CONTINUE
550 140 CONTINUE
551 150 CONTINUE
552 160 CONTINUE
553 170 CONTINUE
554 180 CONTINUE
555*
556* Print a summary of the results.
557*
558 CALL alasum( path, nout, nfail, nrun, nerrs )
559*
560 9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
561 $ i2, ', test ', i2, ', ratio =', g12.5 )
562 9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
563 $ i2, ', test(', i2, ') =', g12.5 )
564 9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
565 $ i6 )
566 RETURN
567*
568* End of ZCHKSY_AA_2STAGE
569*
570 END
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:73
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:81
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
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
subroutine zsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01
Definition: zsyt01.f:125
zlatb4
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:121
zchksy_aa_2stage
subroutine zchksy_aa_2stage(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZCHKSY_AA_2STAGE
Definition: zchksy_aa_2stage.f:172
zerrsy
subroutine zerrsy(PATH, NUNIT)
ZERRSY
Definition: zerrsy.f:55
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
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
zsytrs_aa_2stage
subroutine zsytrs_aa_2stage(UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, IPIV2, B, LDB, INFO)
ZSYTRS_AA_2STAGE
Definition: zsytrs_aa_2stage.f:139