LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
cdrvpo.f
Go to the documentation of this file.
1 *> \brief \b CDRVPO
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 and -SVX.
35 *> \endverbatim
36 *
37 * Arguments:
38 * ==========
39 *
40 *> \param[in] DOTYPE
41 *> \verbatim
42 *> DOTYPE is LOGICAL array, dimension (NTYPES)
43 *> The matrix types to be used for testing. Matrices of type j
44 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
45 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
46 *> \endverbatim
47 *>
48 *> \param[in] NN
49 *> \verbatim
50 *> NN is INTEGER
51 *> The number of values of N contained in the vector NVAL.
52 *> \endverbatim
53 *>
54 *> \param[in] NVAL
55 *> \verbatim
56 *> NVAL is INTEGER array, dimension (NN)
57 *> The values of the matrix dimension N.
58 *> \endverbatim
59 *>
60 *> \param[in] NRHS
61 *> \verbatim
62 *> NRHS is INTEGER
63 *> The number of right hand side vectors to be generated for
64 *> each linear system.
65 *> \endverbatim
66 *>
67 *> \param[in] THRESH
68 *> \verbatim
69 *> THRESH is REAL
70 *> The threshold value for the test ratios. A result is
71 *> included in the output file if RESULT >= THRESH. To have
72 *> every test ratio printed, use THRESH = 0.
73 *> \endverbatim
74 *>
75 *> \param[in] TSTERR
76 *> \verbatim
77 *> TSTERR is LOGICAL
78 *> Flag that indicates whether error exits are to be tested.
79 *> \endverbatim
80 *>
81 *> \param[in] NMAX
82 *> \verbatim
83 *> NMAX is INTEGER
84 *> The maximum value permitted for N, used in dimensioning the
85 *> work arrays.
86 *> \endverbatim
87 *>
88 *> \param[out] A
89 *> \verbatim
90 *> A is COMPLEX array, dimension (NMAX*NMAX)
91 *> \endverbatim
92 *>
93 *> \param[out] AFAC
94 *> \verbatim
95 *> AFAC is COMPLEX array, dimension (NMAX*NMAX)
96 *> \endverbatim
97 *>
98 *> \param[out] ASAV
99 *> \verbatim
100 *> ASAV is COMPLEX array, dimension (NMAX*NMAX)
101 *> \endverbatim
102 *>
103 *> \param[out] B
104 *> \verbatim
105 *> B is COMPLEX array, dimension (NMAX*NRHS)
106 *> \endverbatim
107 *>
108 *> \param[out] BSAV
109 *> \verbatim
110 *> BSAV is COMPLEX array, dimension (NMAX*NRHS)
111 *> \endverbatim
112 *>
113 *> \param[out] X
114 *> \verbatim
115 *> X is COMPLEX array, dimension (NMAX*NRHS)
116 *> \endverbatim
117 *>
118 *> \param[out] XACT
119 *> \verbatim
120 *> XACT is COMPLEX array, dimension (NMAX*NRHS)
121 *> \endverbatim
122 *>
123 *> \param[out] S
124 *> \verbatim
125 *> S is REAL array, dimension (NMAX)
126 *> \endverbatim
127 *>
128 *> \param[out] WORK
129 *> \verbatim
130 *> WORK is COMPLEX array, dimension
131 *> (NMAX*max(3,NRHS))
132 *> \endverbatim
133 *>
134 *> \param[out] RWORK
135 *> \verbatim
136 *> RWORK is REAL array, dimension (NMAX+2*NRHS)
137 *> \endverbatim
138 *>
139 *> \param[in] NOUT
140 *> \verbatim
141 *> NOUT is INTEGER
142 *> The unit number for output.
143 *> \endverbatim
144 *
145 * Authors:
146 * ========
147 *
148 *> \author Univ. of Tennessee
149 *> \author Univ. of California Berkeley
150 *> \author Univ. of Colorado Denver
151 *> \author NAG Ltd.
152 *
153 *> \date November 2011
154 *
155 *> \ingroup complex_lin
156 *
157 * =====================================================================
158  SUBROUTINE cdrvpo( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
159  $ a, afac, asav, b, bsav, x, xact, s, work,
160  $ rwork, nout )
161 *
162 * -- LAPACK test routine (version 3.4.0) --
163 * -- LAPACK is a software package provided by Univ. of Tennessee, --
164 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
165 * November 2011
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  REAL AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
198  $ roldc, scond
199 * ..
200 * .. Local Arrays ..
201  CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
202  INTEGER ISEED( 4 ), ISEEDY( 4 )
203  REAL RESULT( ntests )
204 * ..
205 * .. External Functions ..
206  LOGICAL LSAME
207  REAL CLANHE, SGET06
208  EXTERNAL lsame, clanhe, sget06
209 * ..
210 * .. External Subroutines ..
211  EXTERNAL aladhd, alaerh, alasvm, cerrvx, cget04, clacpy,
214  $ cpotrf, cpotri, xlaenv
215 * ..
216 * .. Scalars in Common ..
217  LOGICAL LERR, OK
218  CHARACTER*32 SRNAMT
219  INTEGER INFOT, NUNIT
220 * ..
221 * .. Common blocks ..
222  COMMON / infoc / infot, nunit, ok, lerr
223  COMMON / srnamc / srnamt
224 * ..
225 * .. Intrinsic Functions ..
226  INTRINSIC cmplx, max
227 * ..
228 * .. Data statements ..
229  DATA iseedy / 1988, 1989, 1990, 1991 /
230  DATA uplos / 'U', 'L' /
231  DATA facts / 'F', 'N', 'E' /
232  DATA equeds / 'N', 'Y' /
233 * ..
234 * .. Executable Statements ..
235 *
236 * Initialize constants and the random number seed.
237 *
238  path( 1: 1 ) = 'Complex precision'
239  path( 2: 3 ) = 'PO'
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 130 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 120 imat = 1, nimat
271 *
272 * Do the tests only if DOTYPE( IMAT ) is true.
273 *
274  IF( .NOT.dotype( imat ) )
275  $ GO TO 120
276 *
277 * Skip types 3, 4, or 5 if the matrix size is too small.
278 *
279  zerot = imat.GE.3 .AND. imat.LE.5
280  IF( zerot .AND. n.LT.imat-2 )
281  $ GO TO 120
282 *
283 * Do first for UPLO = 'U', then for UPLO = 'L'
284 *
285  DO 110 iuplo = 1, 2
286  uplo = uplos( iuplo )
287 *
288 * Set up parameters with CLATB4 and generate a test matrix
289 * with CLATMS.
290 *
291  CALL clatb4( path, imat, n, n, TYPE, KL, KU, ANORM, MODE,
292  $ cndnum, dist )
293 *
294  srnamt = 'CLATMS'
295  CALL clatms( n, n, dist, iseed, TYPE, RWORK, MODE,
296  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
297  $ info )
298 *
299 * Check error code from CLATMS.
300 *
301  IF( info.NE.0 ) THEN
302  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n, -1,
303  $ -1, -1, imat, nfail, nerrs, nout )
304  GO TO 110
305  END IF
306 *
307 * For types 3-5, zero one row and column of the matrix to
308 * test that INFO is returned correctly.
309 *
310  IF( zerot ) THEN
311  IF( imat.EQ.3 ) THEN
312  izero = 1
313  ELSE IF( imat.EQ.4 ) THEN
314  izero = n
315  ELSE
316  izero = n / 2 + 1
317  END IF
318  ioff = ( izero-1 )*lda
319 *
320 * Set row and column IZERO of A to 0.
321 *
322  IF( iuplo.EQ.1 ) THEN
323  DO 20 i = 1, izero - 1
324  a( ioff+i ) = zero
325  20 CONTINUE
326  ioff = ioff + izero
327  DO 30 i = izero, n
328  a( ioff ) = zero
329  ioff = ioff + lda
330  30 CONTINUE
331  ELSE
332  ioff = izero
333  DO 40 i = 1, izero - 1
334  a( ioff ) = zero
335  ioff = ioff + lda
336  40 CONTINUE
337  ioff = ioff - izero
338  DO 50 i = izero, n
339  a( ioff+i ) = zero
340  50 CONTINUE
341  END IF
342  ELSE
343  izero = 0
344  END IF
345 *
346 * Set the imaginary part of the diagonals.
347 *
348  CALL claipd( n, a, lda+1, 0 )
349 *
350 * Save a copy of the matrix A in ASAV.
351 *
352  CALL clacpy( uplo, n, n, a, lda, asav, lda )
353 *
354  DO 100 iequed = 1, 2
355  equed = equeds( iequed )
356  IF( iequed.EQ.1 ) THEN
357  nfact = 3
358  ELSE
359  nfact = 1
360  END IF
361 *
362  DO 90 ifact = 1, nfact
363  fact = facts( ifact )
364  prefac = lsame( fact, 'F' )
365  nofact = lsame( fact, 'N' )
366  equil = lsame( fact, 'E' )
367 *
368  IF( zerot ) THEN
369  IF( prefac )
370  $ GO TO 90
371  rcondc = zero
372 *
373  ELSE IF( .NOT.lsame( fact, 'N' ) ) THEN
374 *
375 * Compute the condition number for comparison with
376 * the value returned by CPOSVX (FACT = 'N' reuses
377 * the condition number from the previous iteration
378 * with FACT = 'F').
379 *
380  CALL clacpy( uplo, n, n, asav, lda, afac, lda )
381  IF( equil .OR. iequed.GT.1 ) THEN
382 *
383 * Compute row and column scale factors to
384 * equilibrate the matrix A.
385 *
386  CALL cpoequ( n, afac, lda, s, scond, amax,
387  $ info )
388  IF( info.EQ.0 .AND. n.GT.0 ) THEN
389  IF( iequed.GT.1 )
390  $ scond = zero
391 *
392 * Equilibrate the matrix.
393 *
394  CALL claqhe( uplo, n, afac, lda, s, scond,
395  $ amax, equed )
396  END IF
397  END IF
398 *
399 * Save the condition number of the
400 * non-equilibrated system for use in CGET04.
401 *
402  IF( equil )
403  $ roldc = rcondc
404 *
405 * Compute the 1-norm of A.
406 *
407  anorm = clanhe( '1', uplo, n, afac, lda, rwork )
408 *
409 * Factor the matrix A.
410 *
411  CALL cpotrf( uplo, n, afac, lda, info )
412 *
413 * Form the inverse of A.
414 *
415  CALL clacpy( uplo, n, n, afac, lda, a, lda )
416  CALL cpotri( uplo, n, a, lda, info )
417 *
418 * Compute the 1-norm condition number of A.
419 *
420  ainvnm = clanhe( '1', uplo, n, a, lda, rwork )
421  IF( anorm.LE.zero .OR. ainvnm.LE.zero ) THEN
422  rcondc = one
423  ELSE
424  rcondc = ( one / anorm ) / ainvnm
425  END IF
426  END IF
427 *
428 * Restore the matrix A.
429 *
430  CALL clacpy( uplo, n, n, asav, lda, a, lda )
431 *
432 * Form an exact solution and set the right hand side.
433 *
434  srnamt = 'CLARHS'
435  CALL clarhs( path, xtype, uplo, ' ', n, n, kl, ku,
436  $ nrhs, a, lda, xact, lda, b, lda,
437  $ iseed, info )
438  xtype = 'C'
439  CALL clacpy( 'Full', n, nrhs, b, lda, bsav, lda )
440 *
441  IF( nofact ) THEN
442 *
443 * --- Test CPOSV ---
444 *
445 * Compute the L*L' or U'*U factorization of the
446 * matrix and solve the system.
447 *
448  CALL clacpy( uplo, n, n, a, lda, afac, lda )
449  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
450 *
451  srnamt = 'CPOSV '
452  CALL cposv( uplo, n, nrhs, afac, lda, x, lda,
453  $ info )
454 *
455 * Check error code from CPOSV .
456 *
457  IF( info.NE.izero ) THEN
458  CALL alaerh( path, 'CPOSV ', info, izero,
459  $ uplo, n, n, -1, -1, nrhs, imat,
460  $ nfail, nerrs, nout )
461  GO TO 70
462  ELSE IF( info.NE.0 ) THEN
463  GO TO 70
464  END IF
465 *
466 * Reconstruct matrix from factors and compute
467 * residual.
468 *
469  CALL cpot01( uplo, n, a, lda, afac, lda, rwork,
470  $ result( 1 ) )
471 *
472 * Compute residual of the computed solution.
473 *
474  CALL clacpy( 'Full', n, nrhs, b, lda, work,
475  $ lda )
476  CALL cpot02( uplo, n, nrhs, a, lda, x, lda,
477  $ work, lda, rwork, result( 2 ) )
478 *
479 * Check solution from generated exact solution.
480 *
481  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
482  $ result( 3 ) )
483  nt = 3
484 *
485 * Print information about the tests that did not
486 * pass the threshold.
487 *
488  DO 60 k = 1, nt
489  IF( result( k ).GE.thresh ) THEN
490  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
491  $ CALL aladhd( nout, path )
492  WRITE( nout, fmt = 9999 )'CPOSV ', uplo,
493  $ n, imat, k, result( k )
494  nfail = nfail + 1
495  END IF
496  60 CONTINUE
497  nrun = nrun + nt
498  70 CONTINUE
499  END IF
500 *
501 * --- Test CPOSVX ---
502 *
503  IF( .NOT.prefac )
504  $ CALL claset( uplo, n, n, cmplx( zero ),
505  $ cmplx( zero ), afac, lda )
506  CALL claset( 'Full', n, nrhs, cmplx( zero ),
507  $ cmplx( zero ), x, lda )
508  IF( iequed.GT.1 .AND. n.GT.0 ) THEN
509 *
510 * Equilibrate the matrix if FACT='F' and
511 * EQUED='Y'.
512 *
513  CALL claqhe( uplo, n, a, lda, s, scond, amax,
514  $ equed )
515  END IF
516 *
517 * Solve the system and compute the condition number
518 * and error bounds using CPOSVX.
519 *
520  srnamt = 'CPOSVX'
521  CALL cposvx( fact, uplo, n, nrhs, a, lda, afac,
522  $ lda, equed, s, b, lda, x, lda, rcond,
523  $ rwork, rwork( nrhs+1 ), work,
524  $ rwork( 2*nrhs+1 ), info )
525 *
526 * Check the error code from CPOSVX.
527 *
528  IF( info.NE.izero ) THEN
529  CALL alaerh( path, 'CPOSVX', info, izero,
530  $ fact // uplo, n, n, -1, -1, nrhs,
531  $ imat, nfail, nerrs, nout )
532  GO TO 90
533  END IF
534 *
535  IF( info.EQ.0 ) THEN
536  IF( .NOT.prefac ) THEN
537 *
538 * Reconstruct matrix from factors and compute
539 * residual.
540 *
541  CALL cpot01( uplo, n, a, lda, afac, lda,
542  $ rwork( 2*nrhs+1 ), result( 1 ) )
543  k1 = 1
544  ELSE
545  k1 = 2
546  END IF
547 *
548 * Compute residual of the computed solution.
549 *
550  CALL clacpy( 'Full', n, nrhs, bsav, lda, work,
551  $ lda )
552  CALL cpot02( uplo, n, nrhs, asav, lda, x, lda,
553  $ work, lda, rwork( 2*nrhs+1 ),
554  $ result( 2 ) )
555 *
556 * Check solution from generated exact solution.
557 *
558  IF( nofact .OR. ( prefac .AND. lsame( equed,
559  $ 'N' ) ) ) THEN
560  CALL cget04( n, nrhs, x, lda, xact, lda,
561  $ rcondc, result( 3 ) )
562  ELSE
563  CALL cget04( n, nrhs, x, lda, xact, lda,
564  $ roldc, result( 3 ) )
565  END IF
566 *
567 * Check the error bounds from iterative
568 * refinement.
569 *
570  CALL cpot05( uplo, n, nrhs, asav, lda, b, lda,
571  $ x, lda, xact, lda, rwork,
572  $ rwork( nrhs+1 ), result( 4 ) )
573  ELSE
574  k1 = 6
575  END IF
576 *
577 * Compare RCOND from CPOSVX with the computed value
578 * in RCONDC.
579 *
580  result( 6 ) = sget06( rcond, rcondc )
581 *
582 * Print information about the tests that did not pass
583 * the threshold.
584 *
585  DO 80 k = k1, 6
586  IF( result( k ).GE.thresh ) THEN
587  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
588  $ CALL aladhd( nout, path )
589  IF( prefac ) THEN
590  WRITE( nout, fmt = 9997 )'CPOSVX', fact,
591  $ uplo, n, equed, imat, k, result( k )
592  ELSE
593  WRITE( nout, fmt = 9998 )'CPOSVX', fact,
594  $ uplo, n, imat, k, result( k )
595  END IF
596  nfail = nfail + 1
597  END IF
598  80 CONTINUE
599  nrun = nrun + 7 - k1
600  90 CONTINUE
601  100 CONTINUE
602  110 CONTINUE
603  120 CONTINUE
604  130 CONTINUE
605 *
606 * Print a summary of the results.
607 *
608  CALL alasvm( path, nout, nfail, nrun, nerrs )
609 *
610  9999 FORMAT( 1x, a, ', UPLO=''', a1, ''', N =', i5, ', type ', i1,
611  $ ', test(', i1, ')=', g12.5 )
612  9998 FORMAT( 1x, a, ', FACT=''', a1, ''', UPLO=''', a1, ''', N=', i5,
613  $ ', type ', i1, ', test(', i1, ')=', g12.5 )
614  9997 FORMAT( 1x, a, ', FACT=''', a1, ''', UPLO=''', a1, ''', N=', i5,
615  $ ', EQUED=''', a1, ''', type ', i1, ', test(', i1, ') =',
616  $ g12.5 )
617  RETURN
618 *
619 * End of CDRVPO
620 *
621  END
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
subroutine cpotri(UPLO, N, A, LDA, INFO)
CPOTRI
Definition: cpotri.f:97
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
Definition: claipd.f:85
subroutine claqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
CLAQHE scales a Hermitian matrix.
Definition: claqhe.f:136
subroutine cpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
CPOT01
Definition: cpot01.f:108
subroutine cerrvx(PATH, NUNIT)
CERRVX
Definition: cerrvx.f:57
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
Definition: cpot02.f:129
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
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:80
subroutine cpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
CPOEQU
Definition: cpoequ.f:115
subroutine cpotrf(UPLO, N, A, LDA, INFO)
CPOTRF
Definition: cpotrf.f:109
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:308
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
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:132
subroutine cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
Definition: cpot05.f:167
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
subroutine cdrvpo(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, NOUT)
CDRVPO
Definition: cdrvpo.f:161
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104