You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

zdrvpb.f 25 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695
  1. *> \brief \b ZDRVPB
  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 ZDRVPB( 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. * DOUBLE PRECISION THRESH
  19. * ..
  20. * .. Array Arguments ..
  21. * LOGICAL DOTYPE( * )
  22. * INTEGER NVAL( * )
  23. * DOUBLE PRECISION RWORK( * ), S( * )
  24. * COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
  25. * $ BSAV( * ), WORK( * ), X( * ), XACT( * )
  26. * ..
  27. *
  28. *
  29. *> \par Purpose:
  30. * =============
  31. *>
  32. *> \verbatim
  33. *>
  34. *> ZDRVPB tests the driver routines ZPBSV 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 DOUBLE PRECISION
  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*16 array, dimension (NMAX*NMAX)
  91. *> \endverbatim
  92. *>
  93. *> \param[out] AFAC
  94. *> \verbatim
  95. *> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
  96. *> \endverbatim
  97. *>
  98. *> \param[out] ASAV
  99. *> \verbatim
  100. *> ASAV is COMPLEX*16 array, dimension (NMAX*NMAX)
  101. *> \endverbatim
  102. *>
  103. *> \param[out] B
  104. *> \verbatim
  105. *> B is COMPLEX*16 array, dimension (NMAX*NRHS)
  106. *> \endverbatim
  107. *>
  108. *> \param[out] BSAV
  109. *> \verbatim
  110. *> BSAV is COMPLEX*16 array, dimension (NMAX*NRHS)
  111. *> \endverbatim
  112. *>
  113. *> \param[out] X
  114. *> \verbatim
  115. *> X is COMPLEX*16 array, dimension (NMAX*NRHS)
  116. *> \endverbatim
  117. *>
  118. *> \param[out] XACT
  119. *> \verbatim
  120. *> XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
  121. *> \endverbatim
  122. *>
  123. *> \param[out] S
  124. *> \verbatim
  125. *> S is DOUBLE PRECISION array, dimension (NMAX)
  126. *> \endverbatim
  127. *>
  128. *> \param[out] WORK
  129. *> \verbatim
  130. *> WORK is COMPLEX*16 array, dimension
  131. *> (NMAX*max(3,NRHS))
  132. *> \endverbatim
  133. *>
  134. *> \param[out] RWORK
  135. *> \verbatim
  136. *> RWORK is DOUBLE PRECISION 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 December 2016
  154. *
  155. *> \ingroup complex16_lin
  156. *
  157. * =====================================================================
  158. SUBROUTINE ZDRVPB( 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.7.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. * December 2016
  166. *
  167. * .. Scalar Arguments ..
  168. LOGICAL TSTERR
  169. INTEGER NMAX, NN, NOUT, NRHS
  170. DOUBLE PRECISION THRESH
  171. * ..
  172. * .. Array Arguments ..
  173. LOGICAL DOTYPE( * )
  174. INTEGER NVAL( * )
  175. DOUBLE PRECISION RWORK( * ), S( * )
  176. COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
  177. $ BSAV( * ), WORK( * ), X( * ), XACT( * )
  178. * ..
  179. *
  180. * =====================================================================
  181. *
  182. * .. Parameters ..
  183. DOUBLE PRECISION ONE, ZERO
  184. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  185. INTEGER NTYPES, NTESTS
  186. PARAMETER ( NTYPES = 8, NTESTS = 6 )
  187. INTEGER NBW
  188. PARAMETER ( NBW = 4 )
  189. * ..
  190. * .. Local Scalars ..
  191. LOGICAL EQUIL, NOFACT, PREFAC, ZEROT
  192. CHARACTER DIST, EQUED, FACT, PACKIT, TYPE, UPLO, XTYPE
  193. CHARACTER*3 PATH
  194. INTEGER I, I1, I2, IEQUED, IFACT, IKD, IMAT, IN, INFO,
  195. $ IOFF, IUPLO, IW, IZERO, K, K1, KD, KL, KOFF,
  196. $ KU, LDA, LDAB, MODE, N, NB, NBMIN, NERRS,
  197. $ NFACT, NFAIL, NIMAT, NKD, NRUN, NT
  198. DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
  199. $ ROLDC, SCOND
  200. * ..
  201. * .. Local Arrays ..
  202. CHARACTER EQUEDS( 2 ), FACTS( 3 )
  203. INTEGER ISEED( 4 ), ISEEDY( 4 ), KDVAL( NBW )
  204. DOUBLE PRECISION RESULT( NTESTS )
  205. * ..
  206. * .. External Functions ..
  207. LOGICAL LSAME
  208. DOUBLE PRECISION DGET06, ZLANGE, ZLANHB
  209. EXTERNAL LSAME, DGET06, ZLANGE, ZLANHB
  210. * ..
  211. * .. External Subroutines ..
  212. EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZCOPY, ZERRVX,
  213. $ ZGET04, ZLACPY, ZLAIPD, ZLAQHB, ZLARHS, ZLASET,
  214. $ ZLATB4, ZLATMS, ZPBEQU, ZPBSV, ZPBSVX, ZPBT01,
  215. $ ZPBT02, ZPBT05, ZPBTRF, ZPBTRS, ZSWAP
  216. * ..
  217. * .. Intrinsic Functions ..
  218. INTRINSIC DCMPLX, MAX, MIN
  219. * ..
  220. * .. Scalars in Common ..
  221. LOGICAL LERR, OK
  222. CHARACTER*32 SRNAMT
  223. INTEGER INFOT, NUNIT
  224. * ..
  225. * .. Common blocks ..
  226. COMMON / INFOC / INFOT, NUNIT, OK, LERR
  227. COMMON / SRNAMC / SRNAMT
  228. * ..
  229. * .. Data statements ..
  230. DATA ISEEDY / 1988, 1989, 1990, 1991 /
  231. DATA FACTS / 'F', 'N', 'E' / , EQUEDS / 'N', 'Y' /
  232. * ..
  233. * .. Executable Statements ..
  234. *
  235. * Initialize constants and the random number seed.
  236. *
  237. PATH( 1: 1 ) = 'Zomplex precision'
  238. PATH( 2: 3 ) = 'PB'
  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. KDVAL( 1 ) = 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 110 IN = 1, NN
  263. N = NVAL( IN )
  264. LDA = MAX( N, 1 )
  265. XTYPE = 'N'
  266. *
  267. * Set limits on the number of loop iterations.
  268. *
  269. NKD = MAX( 1, MIN( N, 4 ) )
  270. NIMAT = NTYPES
  271. IF( N.EQ.0 )
  272. $ NIMAT = 1
  273. *
  274. KDVAL( 2 ) = N + ( N+1 ) / 4
  275. KDVAL( 3 ) = ( 3*N-1 ) / 4
  276. KDVAL( 4 ) = ( N+1 ) / 4
  277. *
  278. DO 100 IKD = 1, NKD
  279. *
  280. * Do for KD = 0, (5*N+1)/4, (3N-1)/4, and (N+1)/4. This order
  281. * makes it easier to skip redundant values for small values
  282. * of N.
  283. *
  284. KD = KDVAL( IKD )
  285. LDAB = KD + 1
  286. *
  287. * Do first for UPLO = 'U', then for UPLO = 'L'
  288. *
  289. DO 90 IUPLO = 1, 2
  290. KOFF = 1
  291. IF( IUPLO.EQ.1 ) THEN
  292. UPLO = 'U'
  293. PACKIT = 'Q'
  294. KOFF = MAX( 1, KD+2-N )
  295. ELSE
  296. UPLO = 'L'
  297. PACKIT = 'B'
  298. END IF
  299. *
  300. DO 80 IMAT = 1, NIMAT
  301. *
  302. * Do the tests only if DOTYPE( IMAT ) is true.
  303. *
  304. IF( .NOT.DOTYPE( IMAT ) )
  305. $ GO TO 80
  306. *
  307. * Skip types 2, 3, or 4 if the matrix size is too small.
  308. *
  309. ZEROT = IMAT.GE.2 .AND. IMAT.LE.4
  310. IF( ZEROT .AND. N.LT.IMAT-1 )
  311. $ GO TO 80
  312. *
  313. IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 1 ) ) THEN
  314. *
  315. * Set up parameters with ZLATB4 and generate a test
  316. * matrix with ZLATMS.
  317. *
  318. CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM,
  319. $ MODE, CNDNUM, DIST )
  320. *
  321. SRNAMT = 'ZLATMS'
  322. CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
  323. $ CNDNUM, ANORM, KD, KD, PACKIT,
  324. $ A( KOFF ), LDAB, WORK, INFO )
  325. *
  326. * Check error code from ZLATMS.
  327. *
  328. IF( INFO.NE.0 ) THEN
  329. CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N,
  330. $ N, -1, -1, -1, IMAT, NFAIL, NERRS,
  331. $ NOUT )
  332. GO TO 80
  333. END IF
  334. ELSE IF( IZERO.GT.0 ) THEN
  335. *
  336. * Use the same matrix for types 3 and 4 as for type
  337. * 2 by copying back the zeroed out column,
  338. *
  339. IW = 2*LDA + 1
  340. IF( IUPLO.EQ.1 ) THEN
  341. IOFF = ( IZERO-1 )*LDAB + KD + 1
  342. CALL ZCOPY( IZERO-I1, WORK( IW ), 1,
  343. $ A( IOFF-IZERO+I1 ), 1 )
  344. IW = IW + IZERO - I1
  345. CALL ZCOPY( I2-IZERO+1, WORK( IW ), 1,
  346. $ A( IOFF ), MAX( LDAB-1, 1 ) )
  347. ELSE
  348. IOFF = ( I1-1 )*LDAB + 1
  349. CALL ZCOPY( IZERO-I1, WORK( IW ), 1,
  350. $ A( IOFF+IZERO-I1 ),
  351. $ MAX( LDAB-1, 1 ) )
  352. IOFF = ( IZERO-1 )*LDAB + 1
  353. IW = IW + IZERO - I1
  354. CALL ZCOPY( I2-IZERO+1, WORK( IW ), 1,
  355. $ A( IOFF ), 1 )
  356. END IF
  357. END IF
  358. *
  359. * For types 2-4, zero one row and column of the matrix
  360. * to test that INFO is returned correctly.
  361. *
  362. IZERO = 0
  363. IF( ZEROT ) THEN
  364. IF( IMAT.EQ.2 ) THEN
  365. IZERO = 1
  366. ELSE IF( IMAT.EQ.3 ) THEN
  367. IZERO = N
  368. ELSE
  369. IZERO = N / 2 + 1
  370. END IF
  371. *
  372. * Save the zeroed out row and column in WORK(*,3)
  373. *
  374. IW = 2*LDA
  375. DO 20 I = 1, MIN( 2*KD+1, N )
  376. WORK( IW+I ) = ZERO
  377. 20 CONTINUE
  378. IW = IW + 1
  379. I1 = MAX( IZERO-KD, 1 )
  380. I2 = MIN( IZERO+KD, N )
  381. *
  382. IF( IUPLO.EQ.1 ) THEN
  383. IOFF = ( IZERO-1 )*LDAB + KD + 1
  384. CALL ZSWAP( IZERO-I1, A( IOFF-IZERO+I1 ), 1,
  385. $ WORK( IW ), 1 )
  386. IW = IW + IZERO - I1
  387. CALL ZSWAP( I2-IZERO+1, A( IOFF ),
  388. $ MAX( LDAB-1, 1 ), WORK( IW ), 1 )
  389. ELSE
  390. IOFF = ( I1-1 )*LDAB + 1
  391. CALL ZSWAP( IZERO-I1, A( IOFF+IZERO-I1 ),
  392. $ MAX( LDAB-1, 1 ), WORK( IW ), 1 )
  393. IOFF = ( IZERO-1 )*LDAB + 1
  394. IW = IW + IZERO - I1
  395. CALL ZSWAP( I2-IZERO+1, A( IOFF ), 1,
  396. $ WORK( IW ), 1 )
  397. END IF
  398. END IF
  399. *
  400. * Set the imaginary part of the diagonals.
  401. *
  402. IF( IUPLO.EQ.1 ) THEN
  403. CALL ZLAIPD( N, A( KD+1 ), LDAB, 0 )
  404. ELSE
  405. CALL ZLAIPD( N, A( 1 ), LDAB, 0 )
  406. END IF
  407. *
  408. * Save a copy of the matrix A in ASAV.
  409. *
  410. CALL ZLACPY( 'Full', KD+1, N, A, LDAB, ASAV, LDAB )
  411. *
  412. DO 70 IEQUED = 1, 2
  413. EQUED = EQUEDS( IEQUED )
  414. IF( IEQUED.EQ.1 ) THEN
  415. NFACT = 3
  416. ELSE
  417. NFACT = 1
  418. END IF
  419. *
  420. DO 60 IFACT = 1, NFACT
  421. FACT = FACTS( IFACT )
  422. PREFAC = LSAME( FACT, 'F' )
  423. NOFACT = LSAME( FACT, 'N' )
  424. EQUIL = LSAME( FACT, 'E' )
  425. *
  426. IF( ZEROT ) THEN
  427. IF( PREFAC )
  428. $ GO TO 60
  429. RCONDC = ZERO
  430. *
  431. ELSE IF( .NOT.LSAME( FACT, 'N' ) ) THEN
  432. *
  433. * Compute the condition number for comparison
  434. * with the value returned by ZPBSVX (FACT =
  435. * 'N' reuses the condition number from the
  436. * previous iteration with FACT = 'F').
  437. *
  438. CALL ZLACPY( 'Full', KD+1, N, ASAV, LDAB,
  439. $ AFAC, LDAB )
  440. IF( EQUIL .OR. IEQUED.GT.1 ) THEN
  441. *
  442. * Compute row and column scale factors to
  443. * equilibrate the matrix A.
  444. *
  445. CALL ZPBEQU( UPLO, N, KD, AFAC, LDAB, S,
  446. $ SCOND, AMAX, INFO )
  447. IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
  448. IF( IEQUED.GT.1 )
  449. $ SCOND = ZERO
  450. *
  451. * Equilibrate the matrix.
  452. *
  453. CALL ZLAQHB( UPLO, N, KD, AFAC, LDAB,
  454. $ S, SCOND, AMAX, EQUED )
  455. END IF
  456. END IF
  457. *
  458. * Save the condition number of the
  459. * non-equilibrated system for use in ZGET04.
  460. *
  461. IF( EQUIL )
  462. $ ROLDC = RCONDC
  463. *
  464. * Compute the 1-norm of A.
  465. *
  466. ANORM = ZLANHB( '1', UPLO, N, KD, AFAC, LDAB,
  467. $ RWORK )
  468. *
  469. * Factor the matrix A.
  470. *
  471. CALL ZPBTRF( UPLO, N, KD, AFAC, LDAB, INFO )
  472. *
  473. * Form the inverse of A.
  474. *
  475. CALL ZLASET( 'Full', N, N, DCMPLX( ZERO ),
  476. $ DCMPLX( ONE ), A, LDA )
  477. SRNAMT = 'ZPBTRS'
  478. CALL ZPBTRS( UPLO, N, KD, N, AFAC, LDAB, A,
  479. $ LDA, INFO )
  480. *
  481. * Compute the 1-norm condition number of A.
  482. *
  483. AINVNM = ZLANGE( '1', N, N, A, LDA, RWORK )
  484. IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
  485. RCONDC = ONE
  486. ELSE
  487. RCONDC = ( ONE / ANORM ) / AINVNM
  488. END IF
  489. END IF
  490. *
  491. * Restore the matrix A.
  492. *
  493. CALL ZLACPY( 'Full', KD+1, N, ASAV, LDAB, A,
  494. $ LDAB )
  495. *
  496. * Form an exact solution and set the right hand
  497. * side.
  498. *
  499. SRNAMT = 'ZLARHS'
  500. CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KD,
  501. $ KD, NRHS, A, LDAB, XACT, LDA, B,
  502. $ LDA, ISEED, INFO )
  503. XTYPE = 'C'
  504. CALL ZLACPY( 'Full', N, NRHS, B, LDA, BSAV,
  505. $ LDA )
  506. *
  507. IF( NOFACT ) THEN
  508. *
  509. * --- Test ZPBSV ---
  510. *
  511. * Compute the L*L' or U'*U factorization of the
  512. * matrix and solve the system.
  513. *
  514. CALL ZLACPY( 'Full', KD+1, N, A, LDAB, AFAC,
  515. $ LDAB )
  516. CALL ZLACPY( 'Full', N, NRHS, B, LDA, X,
  517. $ LDA )
  518. *
  519. SRNAMT = 'ZPBSV '
  520. CALL ZPBSV( UPLO, N, KD, NRHS, AFAC, LDAB, X,
  521. $ LDA, INFO )
  522. *
  523. * Check error code from ZPBSV .
  524. *
  525. IF( INFO.NE.IZERO ) THEN
  526. CALL ALAERH( PATH, 'ZPBSV ', INFO, IZERO,
  527. $ UPLO, N, N, KD, KD, NRHS,
  528. $ IMAT, NFAIL, NERRS, NOUT )
  529. GO TO 40
  530. ELSE IF( INFO.NE.0 ) THEN
  531. GO TO 40
  532. END IF
  533. *
  534. * Reconstruct matrix from factors and compute
  535. * residual.
  536. *
  537. CALL ZPBT01( UPLO, N, KD, A, LDAB, AFAC,
  538. $ LDAB, RWORK, RESULT( 1 ) )
  539. *
  540. * Compute residual of the computed solution.
  541. *
  542. CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK,
  543. $ LDA )
  544. CALL ZPBT02( UPLO, N, KD, NRHS, A, LDAB, X,
  545. $ LDA, WORK, LDA, RWORK,
  546. $ RESULT( 2 ) )
  547. *
  548. * Check solution from generated exact solution.
  549. *
  550. CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
  551. $ RCONDC, RESULT( 3 ) )
  552. NT = 3
  553. *
  554. * Print information about the tests that did
  555. * not pass the threshold.
  556. *
  557. DO 30 K = 1, NT
  558. IF( RESULT( K ).GE.THRESH ) THEN
  559. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  560. $ CALL ALADHD( NOUT, PATH )
  561. WRITE( NOUT, FMT = 9999 )'ZPBSV ',
  562. $ UPLO, N, KD, IMAT, K, RESULT( K )
  563. NFAIL = NFAIL + 1
  564. END IF
  565. 30 CONTINUE
  566. NRUN = NRUN + NT
  567. 40 CONTINUE
  568. END IF
  569. *
  570. * --- Test ZPBSVX ---
  571. *
  572. IF( .NOT.PREFAC )
  573. $ CALL ZLASET( 'Full', KD+1, N, DCMPLX( ZERO ),
  574. $ DCMPLX( ZERO ), AFAC, LDAB )
  575. CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
  576. $ DCMPLX( ZERO ), X, LDA )
  577. IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
  578. *
  579. * Equilibrate the matrix if FACT='F' and
  580. * EQUED='Y'
  581. *
  582. CALL ZLAQHB( UPLO, N, KD, A, LDAB, S, SCOND,
  583. $ AMAX, EQUED )
  584. END IF
  585. *
  586. * Solve the system and compute the condition
  587. * number and error bounds using ZPBSVX.
  588. *
  589. SRNAMT = 'ZPBSVX'
  590. CALL ZPBSVX( FACT, UPLO, N, KD, NRHS, A, LDAB,
  591. $ AFAC, LDAB, EQUED, S, B, LDA, X,
  592. $ LDA, RCOND, RWORK, RWORK( NRHS+1 ),
  593. $ WORK, RWORK( 2*NRHS+1 ), INFO )
  594. *
  595. * Check the error code from ZPBSVX.
  596. *
  597. IF( INFO.NE.IZERO ) THEN
  598. CALL ALAERH( PATH, 'ZPBSVX', INFO, IZERO,
  599. $ FACT // UPLO, N, N, KD, KD,
  600. $ NRHS, IMAT, NFAIL, NERRS, NOUT )
  601. GO TO 60
  602. END IF
  603. *
  604. IF( INFO.EQ.0 ) THEN
  605. IF( .NOT.PREFAC ) THEN
  606. *
  607. * Reconstruct matrix from factors and
  608. * compute residual.
  609. *
  610. CALL ZPBT01( UPLO, N, KD, A, LDAB, AFAC,
  611. $ LDAB, RWORK( 2*NRHS+1 ),
  612. $ RESULT( 1 ) )
  613. K1 = 1
  614. ELSE
  615. K1 = 2
  616. END IF
  617. *
  618. * Compute residual of the computed solution.
  619. *
  620. CALL ZLACPY( 'Full', N, NRHS, BSAV, LDA,
  621. $ WORK, LDA )
  622. CALL ZPBT02( UPLO, N, KD, NRHS, ASAV, LDAB,
  623. $ X, LDA, WORK, LDA,
  624. $ RWORK( 2*NRHS+1 ), RESULT( 2 ) )
  625. *
  626. * Check solution from generated exact solution.
  627. *
  628. IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
  629. $ 'N' ) ) ) THEN
  630. CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
  631. $ RCONDC, RESULT( 3 ) )
  632. ELSE
  633. CALL ZGET04( N, NRHS, X, LDA, XACT, LDA,
  634. $ ROLDC, RESULT( 3 ) )
  635. END IF
  636. *
  637. * Check the error bounds from iterative
  638. * refinement.
  639. *
  640. CALL ZPBT05( UPLO, N, KD, NRHS, ASAV, LDAB,
  641. $ B, LDA, X, LDA, XACT, LDA,
  642. $ RWORK, RWORK( NRHS+1 ),
  643. $ RESULT( 4 ) )
  644. ELSE
  645. K1 = 6
  646. END IF
  647. *
  648. * Compare RCOND from ZPBSVX with the computed
  649. * value in RCONDC.
  650. *
  651. RESULT( 6 ) = DGET06( RCOND, RCONDC )
  652. *
  653. * Print information about the tests that did not
  654. * pass the threshold.
  655. *
  656. DO 50 K = K1, 6
  657. IF( RESULT( K ).GE.THRESH ) THEN
  658. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  659. $ CALL ALADHD( NOUT, PATH )
  660. IF( PREFAC ) THEN
  661. WRITE( NOUT, FMT = 9997 )'ZPBSVX',
  662. $ FACT, UPLO, N, KD, EQUED, IMAT, K,
  663. $ RESULT( K )
  664. ELSE
  665. WRITE( NOUT, FMT = 9998 )'ZPBSVX',
  666. $ FACT, UPLO, N, KD, IMAT, K,
  667. $ RESULT( K )
  668. END IF
  669. NFAIL = NFAIL + 1
  670. END IF
  671. 50 CONTINUE
  672. NRUN = NRUN + 7 - K1
  673. 60 CONTINUE
  674. 70 CONTINUE
  675. 80 CONTINUE
  676. 90 CONTINUE
  677. 100 CONTINUE
  678. 110 CONTINUE
  679. *
  680. * Print a summary of the results.
  681. *
  682. CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
  683. *
  684. 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', KD =', I5,
  685. $ ', type ', I1, ', test(', I1, ')=', G12.5 )
  686. 9998 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ', I5, ', ', I5,
  687. $ ', ... ), type ', I1, ', test(', I1, ')=', G12.5 )
  688. 9997 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ', I5, ', ', I5,
  689. $ ', ... ), EQUED=''', A1, ''', type ', I1, ', test(', I1,
  690. $ ')=', G12.5 )
  691. RETURN
  692. *
  693. * End of ZDRVPB
  694. *
  695. END