OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cdrvpox.f
Go to the documentation of this file.
1*> \brief \b CDRVPOX
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 CDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
12* A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
13* RWORK, NOUT )
14*
15* .. Scalar Arguments ..
16* LOGICAL TSTERR
17* INTEGER NMAX, NN, NOUT, NRHS
18* REAL THRESH
19* ..
20* .. Array Arguments ..
21* LOGICAL DOTYPE( * )
22* INTEGER NVAL( * )
23* REAL RWORK( * ), S( * )
24* COMPLEX A( * ), AFAC( * ), ASAV( * ), B( * ),
25* $ BSAV( * ), WORK( * ), X( * ), XACT( * )
26* ..
27*
28*
29*> \par Purpose:
30* =============
31*>
32*> \verbatim
33*>
34*> CDRVPO tests the driver routines CPOSV, -SVX, and -SVXX.
35*>
36*> Note that this file is used only when the XBLAS are available,
37*> otherwise cdrvpo.f defines this subroutine.
38*> \endverbatim
39*
40* Arguments:
41* ==========
42*
43*> \param[in] DOTYPE
44*> \verbatim
45*> DOTYPE is LOGICAL array, dimension (NTYPES)
46*> The matrix types to be used for testing. Matrices of type j
47*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
48*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
49*> \endverbatim
50*>
51*> \param[in] NN
52*> \verbatim
53*> NN is INTEGER
54*> The number of values of N contained in the vector NVAL.
55*> \endverbatim
56*>
57*> \param[in] NVAL
58*> \verbatim
59*> NVAL is INTEGER array, dimension (NN)
60*> The values of the matrix dimension N.
61*> \endverbatim
62*>
63*> \param[in] NRHS
64*> \verbatim
65*> NRHS is INTEGER
66*> The number of right hand side vectors to be generated for
67*> each linear system.
68*> \endverbatim
69*>
70*> \param[in] THRESH
71*> \verbatim
72*> THRESH is REAL
73*> The threshold value for the test ratios. A result is
74*> included in the output file if RESULT >= THRESH. To have
75*> every test ratio printed, use THRESH = 0.
76*> \endverbatim
77*>
78*> \param[in] TSTERR
79*> \verbatim
80*> TSTERR is LOGICAL
81*> Flag that indicates whether error exits are to be tested.
82*> \endverbatim
83*>
84*> \param[in] NMAX
85*> \verbatim
86*> NMAX is INTEGER
87*> The maximum value permitted for N, used in dimensioning the
88*> work arrays.
89*> \endverbatim
90*>
91*> \param[out] A
92*> \verbatim
93*> A is COMPLEX array, dimension (NMAX*NMAX)
94*> \endverbatim
95*>
96*> \param[out] AFAC
97*> \verbatim
98*> AFAC is COMPLEX array, dimension (NMAX*NMAX)
99*> \endverbatim
100*>
101*> \param[out] ASAV
102*> \verbatim
103*> ASAV is COMPLEX array, dimension (NMAX*NMAX)
104*> \endverbatim
105*>
106*> \param[out] B
107*> \verbatim
108*> B is COMPLEX array, dimension (NMAX*NRHS)
109*> \endverbatim
110*>
111*> \param[out] BSAV
112*> \verbatim
113*> BSAV is COMPLEX array, dimension (NMAX*NRHS)
114*> \endverbatim
115*>
116*> \param[out] X
117*> \verbatim
118*> X is COMPLEX array, dimension (NMAX*NRHS)
119*> \endverbatim
120*>
121*> \param[out] XACT
122*> \verbatim
123*> XACT is COMPLEX array, dimension (NMAX*NRHS)
124*> \endverbatim
125*>
126*> \param[out] S
127*> \verbatim
128*> S is REAL array, dimension (NMAX)
129*> \endverbatim
130*>
131*> \param[out] WORK
132*> \verbatim
133*> WORK is COMPLEX array, dimension
134*> (NMAX*max(3,NRHS))
135*> \endverbatim
136*>
137*> \param[out] RWORK
138*> \verbatim
139*> RWORK is REAL array, dimension (NMAX+2*NRHS)
140*> \endverbatim
141*>
142*> \param[in] NOUT
143*> \verbatim
144*> NOUT is INTEGER
145*> The unit number for output.
146*> \endverbatim
147*
148* Authors:
149* ========
150*
151*> \author Univ. of Tennessee
152*> \author Univ. of California Berkeley
153*> \author Univ. of Colorado Denver
154*> \author NAG Ltd.
155*
156*> \ingroup complex_lin
157*
158* =====================================================================
159 SUBROUTINE cdrvpo( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
160 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
161 $ RWORK, NOUT )
162*
163* -- LAPACK test routine --
164* -- LAPACK is a software package provided by Univ. of Tennessee, --
165* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
166*
167* .. Scalar Arguments ..
168 LOGICAL TSTERR
169 INTEGER NMAX, NN, NOUT, NRHS
170 REAL THRESH
171* ..
172* .. Array Arguments ..
173 LOGICAL DOTYPE( * )
174 INTEGER NVAL( * )
175 REAL RWORK( * ), S( * )
176 COMPLEX A( * ), AFAC( * ), ASAV( * ), B( * ),
177 $ bsav( * ), work( * ), x( * ), xact( * )
178* ..
179*
180* =====================================================================
181*
182* .. Parameters ..
183 REAL ONE, ZERO
184 PARAMETER ( ONE = 1.0e+0, zero = 0.0e+0 )
185 INTEGER NTYPES
186 parameter( ntypes = 9 )
187 INTEGER NTESTS
188 parameter( ntests = 6 )
189* ..
190* .. Local Scalars ..
191 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT
192 CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE
193 CHARACTER*3 PATH
194 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
195 $ izero, k, k1, kl, ku, lda, mode, n, nb, nbmin,
196 $ nerrs, nfact, nfail, nimat, nrun, nt,
197 $ n_err_bnds
198 REAL AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
199 $ ROLDC, SCOND, RPVGRW_SVXX
200* ..
201* .. Local Arrays ..
202 CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
203 INTEGER ISEED( 4 ), ISEEDY( 4 )
204 REAL RESULT( NTESTS ), BERR( NRHS ),
205 $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
206* ..
207* .. External Functions ..
208 LOGICAL LSAME
209 REAL CLANHE, SGET06
210 EXTERNAL lsame, clanhe, sget06
211* ..
212* .. External Subroutines ..
213 EXTERNAL aladhd, alaerh, alasvm, cerrvx, cget04, clacpy,
214 $ claipd, claqhe, clarhs, claset, clatb4, clatms,
215 $ cpoequ, cposv, cposvx, cpot01, cpot02, cpot05,
216 $ cpotrf, cpotri, xlaenv, cposvxx
217* ..
218* .. Scalars in Common ..
219 LOGICAL LERR, OK
220 CHARACTER*32 SRNAMT
221 INTEGER INFOT, NUNIT
222* ..
223* .. Common blocks ..
224 COMMON / infoc / infot, nunit, ok, lerr
225 COMMON / srnamc / srnamt
226* ..
227* .. Intrinsic Functions ..
228 INTRINSIC cmplx, max
229* ..
230* .. Data statements ..
231 DATA iseedy / 1988, 1989, 1990, 1991 /
232 DATA uplos / 'U', 'L' /
233 DATA facts / 'F', 'N', 'E' /
234 DATA equeds / 'N', 'Y' /
235* ..
236* .. Executable Statements ..
237*
238* Initialize constants and the random number seed.
239*
240 path( 1: 1 ) = 'Complex precision'
241 path( 2: 3 ) = 'PO'
242 nrun = 0
243 nfail = 0
244 nerrs = 0
245 DO 10 i = 1, 4
246 iseed( i ) = iseedy( i )
247 10 CONTINUE
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 130 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 120 imat = 1, nimat
273*
274* Do the tests only if DOTYPE( IMAT ) is true.
275*
276 IF( .NOT.dotype( imat ) )
277 $ GO TO 120
278*
279* Skip types 3, 4, or 5 if the matrix size is too small.
280*
281 zerot = imat.GE.3 .AND. imat.LE.5
282 IF( zerot .AND. n.LT.imat-2 )
283 $ GO TO 120
284*
285* Do first for UPLO = 'U', then for UPLO = 'L'
286*
287 DO 110 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( path, imat, n, n, TYPE, KL, KU, ANORM, MODE,
294 $ 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 110
307 END IF
308*
309* For types 3-5, zero one row and column of the matrix to
310* test that INFO is returned correctly.
311*
312 IF( ZEROT ) THEN
313.EQ. IF( IMAT3 ) THEN
314 IZERO = 1
315.EQ. ELSE IF( IMAT4 ) THEN
316 IZERO = N
317 ELSE
318 IZERO = N / 2 + 1
319 END IF
320 IOFF = ( IZERO-1 )*LDA
321*
322* Set row and column IZERO of A to 0.
323*
324.EQ. IF( IUPLO1 ) THEN
325 DO 20 I = 1, IZERO - 1
326 A( IOFF+I ) = ZERO
327 20 CONTINUE
328 IOFF = IOFF + IZERO
329 DO 30 I = IZERO, N
330 A( IOFF ) = ZERO
331 IOFF = IOFF + LDA
332 30 CONTINUE
333 ELSE
334 IOFF = IZERO
335 DO 40 I = 1, IZERO - 1
336 A( IOFF ) = ZERO
337 IOFF = IOFF + LDA
338 40 CONTINUE
339 IOFF = IOFF - IZERO
340 DO 50 I = IZERO, N
341 A( IOFF+I ) = ZERO
342 50 CONTINUE
343 END IF
344 ELSE
345 IZERO = 0
346 END IF
347*
348* Set the imaginary part of the diagonals.
349*
350 CALL CLAIPD( N, A, LDA+1, 0 )
351*
352* Save a copy of the matrix A in ASAV.
353*
354 CALL CLACPY( UPLO, N, N, A, LDA, ASAV, LDA )
355*
356 DO 100 IEQUED = 1, 2
357 EQUED = EQUEDS( IEQUED )
358.EQ. IF( IEQUED1 ) THEN
359 NFACT = 3
360 ELSE
361 NFACT = 1
362 END IF
363*
364 DO 90 IFACT = 1, NFACT
365 FACT = FACTS( IFACT )
366 PREFAC = LSAME( FACT, 'f' )
367 NOFACT = LSAME( FACT, 'n' )
368 EQUIL = LSAME( FACT, 'e' )
369*
370 IF( ZEROT ) THEN
371 IF( PREFAC )
372 $ GO TO 90
373 RCONDC = ZERO
374*
375.NOT. ELSE IF( LSAME( FACT, 'n' ) ) THEN
376*
377* Compute the condition number for comparison with
378* the value returned by CPOSVX (FACT = 'N' reuses
379* the condition number from the previous iteration
380* with FACT = 'F').
381*
382 CALL CLACPY( UPLO, N, N, ASAV, LDA, AFAC, LDA )
383.OR..GT. IF( EQUIL IEQUED1 ) THEN
384*
385* Compute row and column scale factors to
386* equilibrate the matrix A.
387*
388 CALL CPOEQU( N, AFAC, LDA, S, SCOND, AMAX,
389 $ INFO )
390.EQ..AND..GT. IF( INFO0 N0 ) THEN
391.GT. IF( IEQUED1 )
392 $ SCOND = ZERO
393*
394* Equilibrate the matrix.
395*
396 CALL CLAQHE( UPLO, N, AFAC, LDA, S, SCOND,
397 $ AMAX, EQUED )
398 END IF
399 END IF
400*
401* Save the condition number of the
402* non-equilibrated system for use in CGET04.
403*
404 IF( EQUIL )
405 $ ROLDC = RCONDC
406*
407* Compute the 1-norm of A.
408*
409 ANORM = CLANHE( '1', UPLO, N, AFAC, LDA, RWORK )
410*
411* Factor the matrix A.
412*
413 CALL CPOTRF( UPLO, N, AFAC, LDA, INFO )
414*
415* Form the inverse of A.
416*
417 CALL CLACPY( UPLO, N, N, AFAC, LDA, A, LDA )
418 CALL CPOTRI( UPLO, N, A, LDA, INFO )
419*
420* Compute the 1-norm condition number of A.
421*
422 AINVNM = CLANHE( '1', UPLO, N, A, LDA, RWORK )
423.LE..OR..LE. IF( ANORMZERO AINVNMZERO ) THEN
424 RCONDC = ONE
425 ELSE
426 RCONDC = ( ONE / ANORM ) / AINVNM
427 END IF
428 END IF
429*
430* Restore the matrix A.
431*
432 CALL CLACPY( UPLO, N, N, ASAV, LDA, A, LDA )
433*
434* Form an exact solution and set the right hand side.
435*
436 SRNAMT = 'clarhs'
437 CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
438 $ NRHS, A, LDA, XACT, LDA, B, LDA,
439 $ ISEED, INFO )
440 XTYPE = 'c'
441 CALL CLACPY( 'full', N, NRHS, B, LDA, BSAV, LDA )
442*
443 IF( NOFACT ) THEN
444*
445* --- Test CPOSV ---
446*
447* Compute the L*L' or U'*U factorization of the
448* matrix and solve the system.
449*
450 CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
451 CALL CLACPY( 'full', N, NRHS, B, LDA, X, LDA )
452*
453 SRNAMT = 'cposv '
454 CALL CPOSV( UPLO, N, NRHS, AFAC, LDA, X, LDA,
455 $ INFO )
456*
457* Check error code from CPOSV .
458*
459.NE. IF( INFOIZERO ) THEN
460 CALL ALAERH( PATH, 'cposv ', INFO, IZERO,
461 $ UPLO, N, N, -1, -1, NRHS, IMAT,
462 $ NFAIL, NERRS, NOUT )
463 GO TO 70
464.NE. ELSE IF( INFO0 ) THEN
465 GO TO 70
466 END IF
467*
468* Reconstruct matrix from factors and compute
469* residual.
470*
471 CALL CPOT01( UPLO, N, A, LDA, AFAC, LDA, RWORK,
472 $ RESULT( 1 ) )
473*
474* Compute residual of the computed solution.
475*
476 CALL CLACPY( 'full', N, NRHS, B, LDA, WORK,
477 $ LDA )
478 CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA,
479 $ WORK, LDA, RWORK, RESULT( 2 ) )
480*
481* Check solution from generated exact solution.
482*
483 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
484 $ RESULT( 3 ) )
485 NT = 3
486*
487* Print information about the tests that did not
488* pass the threshold.
489*
490 DO 60 K = 1, NT
491.GE. IF( RESULT( K )THRESH ) THEN
492.EQ..AND..EQ. IF( NFAIL0 NERRS0 )
493 $ CALL ALADHD( NOUT, PATH )
494 WRITE( NOUT, FMT = 9999 )'cposv ', UPLO,
495 $ N, IMAT, K, RESULT( K )
496 NFAIL = NFAIL + 1
497 END IF
498 60 CONTINUE
499 NRUN = NRUN + NT
500 70 CONTINUE
501 END IF
502*
503* --- Test CPOSVX ---
504*
505.NOT. IF( PREFAC )
506 $ CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
507 $ CMPLX( ZERO ), AFAC, LDA )
508 CALL CLASET( 'full', N, NRHS, CMPLX( ZERO ),
509 $ CMPLX( ZERO ), X, LDA )
510.GT..AND..GT. IF( IEQUED1 N0 ) THEN
511*
512* Equilibrate the matrix if FACT='F' and
513* EQUED='Y'.
514*
515 CALL CLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX,
516 $ EQUED )
517 END IF
518*
519* Solve the system and compute the condition number
520* and error bounds using CPOSVX.
521*
522 SRNAMT = 'cposvx'
523 CALL CPOSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
524 $ LDA, EQUED, S, B, LDA, X, LDA, RCOND,
525 $ RWORK, RWORK( NRHS+1 ), WORK,
526 $ RWORK( 2*NRHS+1 ), INFO )
527*
528* Check the error code from CPOSVX.
529*
530.NE. IF( INFOIZERO ) THEN
531 CALL ALAERH( PATH, 'cposvx', INFO, IZERO,
532 $ FACT // UPLO, N, N, -1, -1, NRHS,
533 $ IMAT, NFAIL, NERRS, NOUT )
534 GO TO 90
535 END IF
536*
537.EQ. IF( INFO0 ) THEN
538.NOT. IF( PREFAC ) THEN
539*
540* Reconstruct matrix from factors and compute
541* residual.
542*
543 CALL CPOT01( UPLO, N, A, LDA, AFAC, LDA,
544 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
545 K1 = 1
546 ELSE
547 K1 = 2
548 END IF
549*
550* Compute residual of the computed solution.
551*
552 CALL CLACPY( 'full', N, NRHS, BSAV, LDA, WORK,
553 $ LDA )
554 CALL CPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
555 $ WORK, LDA, RWORK( 2*NRHS+1 ),
556 $ RESULT( 2 ) )
557*
558* Check solution from generated exact solution.
559*
560.OR..AND. IF( NOFACT ( PREFAC LSAME( EQUED,
561 $ 'n' ) ) ) THEN
562 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
563 $ RCONDC, RESULT( 3 ) )
564 ELSE
565 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
566 $ ROLDC, RESULT( 3 ) )
567 END IF
568*
569* Check the error bounds from iterative
570* refinement.
571*
572 CALL CPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
573 $ X, LDA, XACT, LDA, RWORK,
574 $ RWORK( NRHS+1 ), RESULT( 4 ) )
575 ELSE
576 K1 = 6
577 END IF
578*
579* Compare RCOND from CPOSVX with the computed value
580* in RCONDC.
581*
582 RESULT( 6 ) = SGET06( RCOND, RCONDC )
583*
584* Print information about the tests that did not pass
585* the threshold.
586*
587 DO 80 K = K1, 6
588.GE. IF( RESULT( K )THRESH ) THEN
589.EQ..AND..EQ. IF( NFAIL0 NERRS0 )
590 $ CALL ALADHD( NOUT, PATH )
591 IF( PREFAC ) THEN
592 WRITE( NOUT, FMT = 9997 )'cposvx', FACT,
593 $ UPLO, N, EQUED, IMAT, K, RESULT( K )
594 ELSE
595 WRITE( NOUT, FMT = 9998 )'cposvx', FACT,
596 $ UPLO, N, IMAT, K, RESULT( K )
597 END IF
598 NFAIL = NFAIL + 1
599 END IF
600 80 CONTINUE
601 NRUN = NRUN + 7 - K1
602*
603* --- Test CPOSVXX ---
604*
605* Restore the matrices A and B.
606*
607 CALL CLACPY( 'full', N, N, ASAV, LDA, A, LDA )
608 CALL CLACPY( 'full', N, NRHS, BSAV, LDA, B, LDA )
609
610.NOT. IF( PREFAC )
611 $ CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
612 $ CMPLX( ZERO ), AFAC, LDA )
613 CALL CLASET( 'full', N, NRHS, CMPLX( ZERO ),
614 $ CMPLX( ZERO ), X, LDA )
615.GT..AND..GT. IF( IEQUED1 N0 ) THEN
616*
617* Equilibrate the matrix if FACT='F' and
618* EQUED='Y'.
619*
620 CALL CLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX,
621 $ EQUED )
622 END IF
623*
624* Solve the system and compute the condition number
625* and error bounds using CPOSVXX.
626*
627 SRNAMT = 'cposvxx'
628 N_ERR_BNDS = 3
629 CALL CPOSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
630 $ LDA, EQUED, S, B, LDA, X,
631 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
632 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
633 $ RWORK( 2*NRHS+1 ), INFO )
634*
635* Check the error code from CPOSVXX.
636*
637.EQ. IF( INFON+1 ) GOTO 90
638.NE. IF( INFOIZERO ) THEN
639 CALL ALAERH( PATH, 'cposvxx', INFO, IZERO,
640 $ FACT // UPLO, N, N, -1, -1, NRHS,
641 $ IMAT, NFAIL, NERRS, NOUT )
642 GO TO 90
643 END IF
644*
645.EQ. IF( INFO0 ) THEN
646.NOT. IF( PREFAC ) THEN
647*
648* Reconstruct matrix from factors and compute
649* residual.
650*
651 CALL CPOT01( UPLO, N, A, LDA, AFAC, LDA,
652 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
653 K1 = 1
654 ELSE
655 K1 = 2
656 END IF
657*
658* Compute residual of the computed solution.
659*
660 CALL CLACPY( 'full', N, NRHS, BSAV, LDA, WORK,
661 $ LDA )
662 CALL CPOT02( UPLO, N, NRHS, ASAV, LDA, X, LDA,
663 $ WORK, LDA, RWORK( 2*NRHS+1 ),
664 $ RESULT( 2 ) )
665*
666* Check solution from generated exact solution.
667*
668.OR..AND. IF( NOFACT ( PREFAC LSAME( EQUED,
669 $ 'n' ) ) ) THEN
670 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
671 $ RCONDC, RESULT( 3 ) )
672 ELSE
673 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
674 $ ROLDC, RESULT( 3 ) )
675 END IF
676*
677* Check the error bounds from iterative
678* refinement.
679*
680 CALL CPOT05( UPLO, N, NRHS, ASAV, LDA, B, LDA,
681 $ X, LDA, XACT, LDA, RWORK,
682 $ RWORK( NRHS+1 ), RESULT( 4 ) )
683 ELSE
684 K1 = 6
685 END IF
686*
687* Compare RCOND from CPOSVXX with the computed value
688* in RCONDC.
689*
690 RESULT( 6 ) = SGET06( RCOND, RCONDC )
691*
692* Print information about the tests that did not pass
693* the threshold.
694*
695 DO 85 K = K1, 6
696.GE. IF( RESULT( K )THRESH ) THEN
697.EQ..AND..EQ. IF( NFAIL0 NERRS0 )
698 $ CALL ALADHD( NOUT, PATH )
699 IF( PREFAC ) THEN
700 WRITE( NOUT, FMT = 9997 )'cposvxx', FACT,
701 $ UPLO, N, EQUED, IMAT, K, RESULT( K )
702 ELSE
703 WRITE( NOUT, FMT = 9998 )'cposvxx', FACT,
704 $ UPLO, N, IMAT, K, RESULT( K )
705 END IF
706 NFAIL = NFAIL + 1
707 END IF
708 85 CONTINUE
709 NRUN = NRUN + 7 - K1
710 90 CONTINUE
711 100 CONTINUE
712 110 CONTINUE
713 120 CONTINUE
714 130 CONTINUE
715*
716* Print a summary of the results.
717*
718 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
719*
720
721* Test Error Bounds for CGESVXX
722
723 CALL CEBCHVXX(THRESH, PATH)
724
725 9999 FORMAT( 1X, A, ', uplo=''', A1, ''', n =', I5, ', type ', I1,
726 $ ', test(', I1, ')=', G12.5 )
727 9998 FORMAT( 1X, A, ', fact=''', A1, ''', uplo=''', A1, ''', n=', I5,
728 $ ', type ', I1, ', test(', I1, ')=', G12.5 )
729 9997 FORMAT( 1X, A, ', fact=''', A1, ''', uplo=''', A1, ''', n=', I5,
730 $ ', equed=''', a1, ''', type ', i1, ', test(', I1, ') =',
731 $ G12.5 )
732 RETURN
733*
734* End of CDRVPOX
735*
736 END
cmplx
float cmplx[2]
Definition pblas.h:136
xlaenv
subroutine xlaenv(ispec, nvalue)
XLAENV
Definition xlaenv.f:81
alasvm
subroutine alasvm(type, nout, nfail, nrun, nerrs)
ALASVM
Definition alasvm.f:73
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
claqhe
subroutine claqhe(uplo, n, a, lda, s, scond, amax, equed)
CLAQHE scales a Hermitian matrix.
Definition claqhe.f:134
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:103
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:106
cpoequ
subroutine cpoequ(n, a, lda, s, scond, amax, info)
CPOEQU
Definition cpoequ.f:113
cpotri
subroutine cpotri(uplo, n, a, lda, info)
CPOTRI
Definition cpotri.f:95
cpotrf
subroutine cpotrf(uplo, n, a, lda, info)
CPOTRF
Definition cpotrf.f:107
cposvxx
subroutine cposvxx(fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork, info)
CPOSVXX computes the solution to system of linear equations A * X = B for PO matrices
Definition cposvxx.f:496
cposv
subroutine cposv(uplo, n, nrhs, a, lda, b, ldb, info)
CPOSV computes the solution to system of linear equations A * X = B for PO matrices
Definition cposv.f:130
cposvx
subroutine cposvx(fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
CPOSVX computes the solution to system of linear equations A * X = B for PO matrices
Definition cposvx.f:306
clarhs
subroutine clarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
CLARHS
Definition clarhs.f:208
cerrvx
subroutine cerrvx(path, nunit)
CERRVX
Definition cerrvx.f:55
claipd
subroutine claipd(n, a, inda, vinda)
CLAIPD
Definition claipd.f:83
cdrvpo
subroutine cdrvpo(dotype, nn, nval, nrhs, thresh, tsterr, nmax, a, afac, asav, b, bsav, x, xact, s, work, rwork, nout)
CDRVPO
Definition cdrvpo.f:159
cpot05
subroutine cpot05(uplo, n, nrhs, a, lda, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
CPOT05
Definition cpot05.f:165
clatb4
subroutine clatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
CLATB4
Definition clatb4.f:121
cpot02
subroutine cpot02(uplo, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
CPOT02
Definition cpot02.f:127
cget04
subroutine cget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
CGET04
Definition cget04.f:102
cpot01
subroutine cpot01(uplo, n, a, lda, afac, ldafac, rwork, resid)
CPOT01
Definition cpot01.f:106
clatms
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
Definition clatms.f:332
max
#define max(a, b)
Definition macros.h:21