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.

zdrvsg.f 48 kB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330
  1. *> \brief \b ZDRVSG
  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 ZDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
  12. * NOUNIT, A, LDA, B, LDB, D, Z, LDZ, AB, BB, AP,
  13. * BP, WORK, NWORK, RWORK, LRWORK, IWORK, LIWORK,
  14. * RESULT, INFO )
  15. *
  16. * .. Scalar Arguments ..
  17. * INTEGER INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
  18. * $ NSIZES, NTYPES, NWORK
  19. * DOUBLE PRECISION THRESH
  20. * ..
  21. * .. Array Arguments ..
  22. * LOGICAL DOTYPE( * )
  23. * INTEGER ISEED( 4 ), IWORK( * ), NN( * )
  24. * DOUBLE PRECISION D( * ), RESULT( * ), RWORK( * )
  25. * COMPLEX*16 A( LDA, * ), AB( LDA, * ), AP( * ),
  26. * $ B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ),
  27. * $ Z( LDZ, * )
  28. * ..
  29. *
  30. *
  31. *> \par Purpose:
  32. * =============
  33. *>
  34. *> \verbatim
  35. *>
  36. *> ZDRVSG checks the complex Hermitian generalized eigenproblem
  37. *> drivers.
  38. *>
  39. *> ZHEGV computes all eigenvalues and, optionally,
  40. *> eigenvectors of a complex Hermitian-definite generalized
  41. *> eigenproblem.
  42. *>
  43. *> ZHEGVD computes all eigenvalues and, optionally,
  44. *> eigenvectors of a complex Hermitian-definite generalized
  45. *> eigenproblem using a divide and conquer algorithm.
  46. *>
  47. *> ZHEGVX computes selected eigenvalues and, optionally,
  48. *> eigenvectors of a complex Hermitian-definite generalized
  49. *> eigenproblem.
  50. *>
  51. *> ZHPGV computes all eigenvalues and, optionally,
  52. *> eigenvectors of a complex Hermitian-definite generalized
  53. *> eigenproblem in packed storage.
  54. *>
  55. *> ZHPGVD computes all eigenvalues and, optionally,
  56. *> eigenvectors of a complex Hermitian-definite generalized
  57. *> eigenproblem in packed storage using a divide and
  58. *> conquer algorithm.
  59. *>
  60. *> ZHPGVX computes selected eigenvalues and, optionally,
  61. *> eigenvectors of a complex Hermitian-definite generalized
  62. *> eigenproblem in packed storage.
  63. *>
  64. *> ZHBGV computes all eigenvalues and, optionally,
  65. *> eigenvectors of a complex Hermitian-definite banded
  66. *> generalized eigenproblem.
  67. *>
  68. *> ZHBGVD computes all eigenvalues and, optionally,
  69. *> eigenvectors of a complex Hermitian-definite banded
  70. *> generalized eigenproblem using a divide and conquer
  71. *> algorithm.
  72. *>
  73. *> ZHBGVX computes selected eigenvalues and, optionally,
  74. *> eigenvectors of a complex Hermitian-definite banded
  75. *> generalized eigenproblem.
  76. *>
  77. *> When ZDRVSG is called, a number of matrix "sizes" ("n's") and a
  78. *> number of matrix "types" are specified. For each size ("n")
  79. *> and each type of matrix, one matrix A of the given type will be
  80. *> generated; a random well-conditioned matrix B is also generated
  81. *> and the pair (A,B) is used to test the drivers.
  82. *>
  83. *> For each pair (A,B), the following tests are performed:
  84. *>
  85. *> (1) ZHEGV with ITYPE = 1 and UPLO ='U':
  86. *>
  87. *> | A Z - B Z D | / ( |A| |Z| n ulp )
  88. *>
  89. *> (2) as (1) but calling ZHPGV
  90. *> (3) as (1) but calling ZHBGV
  91. *> (4) as (1) but with UPLO = 'L'
  92. *> (5) as (4) but calling ZHPGV
  93. *> (6) as (4) but calling ZHBGV
  94. *>
  95. *> (7) ZHEGV with ITYPE = 2 and UPLO ='U':
  96. *>
  97. *> | A B Z - Z D | / ( |A| |Z| n ulp )
  98. *>
  99. *> (8) as (7) but calling ZHPGV
  100. *> (9) as (7) but with UPLO = 'L'
  101. *> (10) as (9) but calling ZHPGV
  102. *>
  103. *> (11) ZHEGV with ITYPE = 3 and UPLO ='U':
  104. *>
  105. *> | B A Z - Z D | / ( |A| |Z| n ulp )
  106. *>
  107. *> (12) as (11) but calling ZHPGV
  108. *> (13) as (11) but with UPLO = 'L'
  109. *> (14) as (13) but calling ZHPGV
  110. *>
  111. *> ZHEGVD, ZHPGVD and ZHBGVD performed the same 14 tests.
  112. *>
  113. *> ZHEGVX, ZHPGVX and ZHBGVX performed the above 14 tests with
  114. *> the parameter RANGE = 'A', 'N' and 'I', respectively.
  115. *>
  116. *> The "sizes" are specified by an array NN(1:NSIZES); the value of
  117. *> each element NN(j) specifies one size.
  118. *> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
  119. *> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
  120. *> This type is used for the matrix A which has half-bandwidth KA.
  121. *> B is generated as a well-conditioned positive definite matrix
  122. *> with half-bandwidth KB (<= KA).
  123. *> Currently, the list of possible types for A is:
  124. *>
  125. *> (1) The zero matrix.
  126. *> (2) The identity matrix.
  127. *>
  128. *> (3) A diagonal matrix with evenly spaced entries
  129. *> 1, ..., ULP and random signs.
  130. *> (ULP = (first number larger than 1) - 1 )
  131. *> (4) A diagonal matrix with geometrically spaced entries
  132. *> 1, ..., ULP and random signs.
  133. *> (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
  134. *> and random signs.
  135. *>
  136. *> (6) Same as (4), but multiplied by SQRT( overflow threshold )
  137. *> (7) Same as (4), but multiplied by SQRT( underflow threshold )
  138. *>
  139. *> (8) A matrix of the form U* D U, where U is unitary and
  140. *> D has evenly spaced entries 1, ..., ULP with random signs
  141. *> on the diagonal.
  142. *>
  143. *> (9) A matrix of the form U* D U, where U is unitary and
  144. *> D has geometrically spaced entries 1, ..., ULP with random
  145. *> signs on the diagonal.
  146. *>
  147. *> (10) A matrix of the form U* D U, where U is unitary and
  148. *> D has "clustered" entries 1, ULP,..., ULP with random
  149. *> signs on the diagonal.
  150. *>
  151. *> (11) Same as (8), but multiplied by SQRT( overflow threshold )
  152. *> (12) Same as (8), but multiplied by SQRT( underflow threshold )
  153. *>
  154. *> (13) Hermitian matrix with random entries chosen from (-1,1).
  155. *> (14) Same as (13), but multiplied by SQRT( overflow threshold )
  156. *> (15) Same as (13), but multiplied by SQRT( underflow threshold )
  157. *>
  158. *> (16) Same as (8), but with KA = 1 and KB = 1
  159. *> (17) Same as (8), but with KA = 2 and KB = 1
  160. *> (18) Same as (8), but with KA = 2 and KB = 2
  161. *> (19) Same as (8), but with KA = 3 and KB = 1
  162. *> (20) Same as (8), but with KA = 3 and KB = 2
  163. *> (21) Same as (8), but with KA = 3 and KB = 3
  164. *> \endverbatim
  165. *
  166. * Arguments:
  167. * ==========
  168. *
  169. *> \verbatim
  170. *> NSIZES INTEGER
  171. *> The number of sizes of matrices to use. If it is zero,
  172. *> ZDRVSG does nothing. It must be at least zero.
  173. *> Not modified.
  174. *>
  175. *> NN INTEGER array, dimension (NSIZES)
  176. *> An array containing the sizes to be used for the matrices.
  177. *> Zero values will be skipped. The values must be at least
  178. *> zero.
  179. *> Not modified.
  180. *>
  181. *> NTYPES INTEGER
  182. *> The number of elements in DOTYPE. If it is zero, ZDRVSG
  183. *> does nothing. It must be at least zero. If it is MAXTYP+1
  184. *> and NSIZES is 1, then an additional type, MAXTYP+1 is
  185. *> defined, which is to use whatever matrix is in A. This
  186. *> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
  187. *> DOTYPE(MAXTYP+1) is .TRUE. .
  188. *> Not modified.
  189. *>
  190. *> DOTYPE LOGICAL array, dimension (NTYPES)
  191. *> If DOTYPE(j) is .TRUE., then for each size in NN a
  192. *> matrix of that size and of type j will be generated.
  193. *> If NTYPES is smaller than the maximum number of types
  194. *> defined (PARAMETER MAXTYP), then types NTYPES+1 through
  195. *> MAXTYP will not be generated. If NTYPES is larger
  196. *> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
  197. *> will be ignored.
  198. *> Not modified.
  199. *>
  200. *> ISEED INTEGER array, dimension (4)
  201. *> On entry ISEED specifies the seed of the random number
  202. *> generator. The array elements should be between 0 and 4095;
  203. *> if not they will be reduced mod 4096. Also, ISEED(4) must
  204. *> be odd. The random number generator uses a linear
  205. *> congruential sequence limited to small integers, and so
  206. *> should produce machine independent random numbers. The
  207. *> values of ISEED are changed on exit, and can be used in the
  208. *> next call to ZDRVSG to continue the same random number
  209. *> sequence.
  210. *> Modified.
  211. *>
  212. *> THRESH DOUBLE PRECISION
  213. *> A test will count as "failed" if the "error", computed as
  214. *> described above, exceeds THRESH. Note that the error
  215. *> is scaled to be O(1), so THRESH should be a reasonably
  216. *> small multiple of 1, e.g., 10 or 100. In particular,
  217. *> it should not depend on the precision (single vs. double)
  218. *> or the size of the matrix. It must be at least zero.
  219. *> Not modified.
  220. *>
  221. *> NOUNIT INTEGER
  222. *> The FORTRAN unit number for printing out error messages
  223. *> (e.g., if a routine returns IINFO not equal to 0.)
  224. *> Not modified.
  225. *>
  226. *> A COMPLEX*16 array, dimension (LDA , max(NN))
  227. *> Used to hold the matrix whose eigenvalues are to be
  228. *> computed. On exit, A contains the last matrix actually
  229. *> used.
  230. *> Modified.
  231. *>
  232. *> LDA INTEGER
  233. *> The leading dimension of A. It must be at
  234. *> least 1 and at least max( NN ).
  235. *> Not modified.
  236. *>
  237. *> B COMPLEX*16 array, dimension (LDB , max(NN))
  238. *> Used to hold the Hermitian positive definite matrix for
  239. *> the generailzed problem.
  240. *> On exit, B contains the last matrix actually
  241. *> used.
  242. *> Modified.
  243. *>
  244. *> LDB INTEGER
  245. *> The leading dimension of B. It must be at
  246. *> least 1 and at least max( NN ).
  247. *> Not modified.
  248. *>
  249. *> D DOUBLE PRECISION array, dimension (max(NN))
  250. *> The eigenvalues of A. On exit, the eigenvalues in D
  251. *> correspond with the matrix in A.
  252. *> Modified.
  253. *>
  254. *> Z COMPLEX*16 array, dimension (LDZ, max(NN))
  255. *> The matrix of eigenvectors.
  256. *> Modified.
  257. *>
  258. *> LDZ INTEGER
  259. *> The leading dimension of ZZ. It must be at least 1 and
  260. *> at least max( NN ).
  261. *> Not modified.
  262. *>
  263. *> AB COMPLEX*16 array, dimension (LDA, max(NN))
  264. *> Workspace.
  265. *> Modified.
  266. *>
  267. *> BB COMPLEX*16 array, dimension (LDB, max(NN))
  268. *> Workspace.
  269. *> Modified.
  270. *>
  271. *> AP COMPLEX*16 array, dimension (max(NN)**2)
  272. *> Workspace.
  273. *> Modified.
  274. *>
  275. *> BP COMPLEX*16 array, dimension (max(NN)**2)
  276. *> Workspace.
  277. *> Modified.
  278. *>
  279. *> WORK COMPLEX*16 array, dimension (NWORK)
  280. *> Workspace.
  281. *> Modified.
  282. *>
  283. *> NWORK INTEGER
  284. *> The number of entries in WORK. This must be at least
  285. *> 2*N + N**2 where N = max( NN(j), 2 ).
  286. *> Not modified.
  287. *>
  288. *> RWORK DOUBLE PRECISION array, dimension (LRWORK)
  289. *> Workspace.
  290. *> Modified.
  291. *>
  292. *> LRWORK INTEGER
  293. *> The number of entries in RWORK. This must be at least
  294. *> max( 7*N, 1 + 4*N + 2*N*lg(N) + 3*N**2 ) where
  295. *> N = max( NN(j) ) and lg( N ) = smallest integer k such
  296. *> that 2**k >= N .
  297. *> Not modified.
  298. *>
  299. *> IWORK INTEGER array, dimension (LIWORK))
  300. *> Workspace.
  301. *> Modified.
  302. *>
  303. *> LIWORK INTEGER
  304. *> The number of entries in IWORK. This must be at least
  305. *> 2 + 5*max( NN(j) ).
  306. *> Not modified.
  307. *>
  308. *> RESULT DOUBLE PRECISION array, dimension (70)
  309. *> The values computed by the 70 tests described above.
  310. *> Modified.
  311. *>
  312. *> INFO INTEGER
  313. *> If 0, then everything ran OK.
  314. *> -1: NSIZES < 0
  315. *> -2: Some NN(j) < 0
  316. *> -3: NTYPES < 0
  317. *> -5: THRESH < 0
  318. *> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
  319. *> -16: LDZ < 1 or LDZ < NMAX.
  320. *> -21: NWORK too small.
  321. *> -23: LRWORK too small.
  322. *> -25: LIWORK too small.
  323. *> If ZLATMR, CLATMS, ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD,
  324. *> ZHPGVD, ZHEGVX, CHPGVX, ZHBGVX returns an error code,
  325. *> the absolute value of it is returned.
  326. *> Modified.
  327. *>
  328. *>-----------------------------------------------------------------------
  329. *>
  330. *> Some Local Variables and Parameters:
  331. *> ---- ----- --------- --- ----------
  332. *> ZERO, ONE Real 0 and 1.
  333. *> MAXTYP The number of types defined.
  334. *> NTEST The number of tests that have been run
  335. *> on this matrix.
  336. *> NTESTT The total number of tests for this call.
  337. *> NMAX Largest value in NN.
  338. *> NMATS The number of matrices generated so far.
  339. *> NERRS The number of tests which have exceeded THRESH
  340. *> so far (computed by DLAFTS).
  341. *> COND, IMODE Values to be passed to the matrix generators.
  342. *> ANORM Norm of A; passed to matrix generators.
  343. *>
  344. *> OVFL, UNFL Overflow and underflow thresholds.
  345. *> ULP, ULPINV Finest relative precision and its inverse.
  346. *> RTOVFL, RTUNFL Square roots of the previous 2 values.
  347. *> The following four arrays decode JTYPE:
  348. *> KTYPE(j) The general type (1-10) for type "j".
  349. *> KMODE(j) The MODE value to be passed to the matrix
  350. *> generator for type "j".
  351. *> KMAGN(j) The order of magnitude ( O(1),
  352. *> O(overflow^(1/2) ), O(underflow^(1/2) )
  353. *> \endverbatim
  354. *
  355. * Authors:
  356. * ========
  357. *
  358. *> \author Univ. of Tennessee
  359. *> \author Univ. of California Berkeley
  360. *> \author Univ. of Colorado Denver
  361. *> \author NAG Ltd.
  362. *
  363. *> \date December 2016
  364. *
  365. *> \ingroup complex16_eig
  366. *
  367. * =====================================================================
  368. SUBROUTINE ZDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
  369. $ NOUNIT, A, LDA, B, LDB, D, Z, LDZ, AB, BB, AP,
  370. $ BP, WORK, NWORK, RWORK, LRWORK, IWORK, LIWORK,
  371. $ RESULT, INFO )
  372. *
  373. * -- LAPACK test routine (version 3.7.0) --
  374. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  375. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  376. * December 2016
  377. *
  378. * .. Scalar Arguments ..
  379. INTEGER INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
  380. $ NSIZES, NTYPES, NWORK
  381. DOUBLE PRECISION THRESH
  382. * ..
  383. * .. Array Arguments ..
  384. LOGICAL DOTYPE( * )
  385. INTEGER ISEED( 4 ), IWORK( * ), NN( * )
  386. DOUBLE PRECISION D( * ), RESULT( * ), RWORK( * )
  387. COMPLEX*16 A( LDA, * ), AB( LDA, * ), AP( * ),
  388. $ B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ),
  389. $ Z( LDZ, * )
  390. * ..
  391. *
  392. * =====================================================================
  393. *
  394. * .. Parameters ..
  395. DOUBLE PRECISION ZERO, ONE, TEN
  396. PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TEN = 10.0D+0 )
  397. COMPLEX*16 CZERO, CONE
  398. PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
  399. $ CONE = ( 1.0D+0, 0.0D+0 ) )
  400. INTEGER MAXTYP
  401. PARAMETER ( MAXTYP = 21 )
  402. * ..
  403. * .. Local Scalars ..
  404. LOGICAL BADNN
  405. CHARACTER UPLO
  406. INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
  407. $ ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB,
  408. $ KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
  409. $ NTESTT
  410. DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
  411. $ RTUNFL, ULP, ULPINV, UNFL, VL, VU
  412. * ..
  413. * .. Local Arrays ..
  414. INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
  415. $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
  416. $ KTYPE( MAXTYP )
  417. * ..
  418. * .. External Functions ..
  419. LOGICAL LSAME
  420. DOUBLE PRECISION DLAMCH, DLARND
  421. EXTERNAL LSAME, DLAMCH, DLARND
  422. * ..
  423. * .. External Subroutines ..
  424. EXTERNAL DLABAD, DLAFTS, DLASUM, XERBLA, ZHBGV, ZHBGVD,
  425. $ ZHBGVX, ZHEGV, ZHEGVD, ZHEGVX, ZHPGV, ZHPGVD,
  426. $ ZHPGVX, ZLACPY, ZLASET, ZLATMR, ZLATMS, ZSGT01
  427. * ..
  428. * .. Intrinsic Functions ..
  429. INTRINSIC ABS, DBLE, MAX, MIN, SQRT
  430. * ..
  431. * .. Data statements ..
  432. DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 /
  433. DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
  434. $ 2, 3, 6*1 /
  435. DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
  436. $ 0, 0, 6*4 /
  437. * ..
  438. * .. Executable Statements ..
  439. *
  440. * 1) Check for errors
  441. *
  442. NTESTT = 0
  443. INFO = 0
  444. *
  445. BADNN = .FALSE.
  446. NMAX = 0
  447. DO 10 J = 1, NSIZES
  448. NMAX = MAX( NMAX, NN( J ) )
  449. IF( NN( J ).LT.0 )
  450. $ BADNN = .TRUE.
  451. 10 CONTINUE
  452. *
  453. * Check for errors
  454. *
  455. IF( NSIZES.LT.0 ) THEN
  456. INFO = -1
  457. ELSE IF( BADNN ) THEN
  458. INFO = -2
  459. ELSE IF( NTYPES.LT.0 ) THEN
  460. INFO = -3
  461. ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
  462. INFO = -9
  463. ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN
  464. INFO = -16
  465. ELSE IF( 2*MAX( NMAX, 2 )**2.GT.NWORK ) THEN
  466. INFO = -21
  467. ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LRWORK ) THEN
  468. INFO = -23
  469. ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LIWORK ) THEN
  470. INFO = -25
  471. END IF
  472. *
  473. IF( INFO.NE.0 ) THEN
  474. CALL XERBLA( 'ZDRVSG', -INFO )
  475. RETURN
  476. END IF
  477. *
  478. * Quick return if possible
  479. *
  480. IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
  481. $ RETURN
  482. *
  483. * More Important constants
  484. *
  485. UNFL = DLAMCH( 'Safe minimum' )
  486. OVFL = DLAMCH( 'Overflow' )
  487. CALL DLABAD( UNFL, OVFL )
  488. ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
  489. ULPINV = ONE / ULP
  490. RTUNFL = SQRT( UNFL )
  491. RTOVFL = SQRT( OVFL )
  492. *
  493. DO 20 I = 1, 4
  494. ISEED2( I ) = ISEED( I )
  495. 20 CONTINUE
  496. *
  497. * Loop over sizes, types
  498. *
  499. NERRS = 0
  500. NMATS = 0
  501. *
  502. DO 650 JSIZE = 1, NSIZES
  503. N = NN( JSIZE )
  504. ANINV = ONE / DBLE( MAX( 1, N ) )
  505. *
  506. IF( NSIZES.NE.1 ) THEN
  507. MTYPES = MIN( MAXTYP, NTYPES )
  508. ELSE
  509. MTYPES = MIN( MAXTYP+1, NTYPES )
  510. END IF
  511. *
  512. KA9 = 0
  513. KB9 = 0
  514. DO 640 JTYPE = 1, MTYPES
  515. IF( .NOT.DOTYPE( JTYPE ) )
  516. $ GO TO 640
  517. NMATS = NMATS + 1
  518. NTEST = 0
  519. *
  520. DO 30 J = 1, 4
  521. IOLDSD( J ) = ISEED( J )
  522. 30 CONTINUE
  523. *
  524. * 2) Compute "A"
  525. *
  526. * Control parameters:
  527. *
  528. * KMAGN KMODE KTYPE
  529. * =1 O(1) clustered 1 zero
  530. * =2 large clustered 2 identity
  531. * =3 small exponential (none)
  532. * =4 arithmetic diagonal, w/ eigenvalues
  533. * =5 random log hermitian, w/ eigenvalues
  534. * =6 random (none)
  535. * =7 random diagonal
  536. * =8 random hermitian
  537. * =9 banded, w/ eigenvalues
  538. *
  539. IF( MTYPES.GT.MAXTYP )
  540. $ GO TO 90
  541. *
  542. ITYPE = KTYPE( JTYPE )
  543. IMODE = KMODE( JTYPE )
  544. *
  545. * Compute norm
  546. *
  547. GO TO ( 40, 50, 60 )KMAGN( JTYPE )
  548. *
  549. 40 CONTINUE
  550. ANORM = ONE
  551. GO TO 70
  552. *
  553. 50 CONTINUE
  554. ANORM = ( RTOVFL*ULP )*ANINV
  555. GO TO 70
  556. *
  557. 60 CONTINUE
  558. ANORM = RTUNFL*N*ULPINV
  559. GO TO 70
  560. *
  561. 70 CONTINUE
  562. *
  563. IINFO = 0
  564. COND = ULPINV
  565. *
  566. * Special Matrices -- Identity & Jordan block
  567. *
  568. IF( ITYPE.EQ.1 ) THEN
  569. *
  570. * Zero
  571. *
  572. KA = 0
  573. KB = 0
  574. CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
  575. *
  576. ELSE IF( ITYPE.EQ.2 ) THEN
  577. *
  578. * Identity
  579. *
  580. KA = 0
  581. KB = 0
  582. CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
  583. DO 80 JCOL = 1, N
  584. A( JCOL, JCOL ) = ANORM
  585. 80 CONTINUE
  586. *
  587. ELSE IF( ITYPE.EQ.4 ) THEN
  588. *
  589. * Diagonal Matrix, [Eigen]values Specified
  590. *
  591. KA = 0
  592. KB = 0
  593. CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
  594. $ ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
  595. *
  596. ELSE IF( ITYPE.EQ.5 ) THEN
  597. *
  598. * Hermitian, eigenvalues specified
  599. *
  600. KA = MAX( 0, N-1 )
  601. KB = KA
  602. CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
  603. $ ANORM, N, N, 'N', A, LDA, WORK, IINFO )
  604. *
  605. ELSE IF( ITYPE.EQ.7 ) THEN
  606. *
  607. * Diagonal, random eigenvalues
  608. *
  609. KA = 0
  610. KB = 0
  611. CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
  612. $ 'T', 'N', WORK( N+1 ), 1, ONE,
  613. $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
  614. $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
  615. *
  616. ELSE IF( ITYPE.EQ.8 ) THEN
  617. *
  618. * Hermitian, random eigenvalues
  619. *
  620. KA = MAX( 0, N-1 )
  621. KB = KA
  622. CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
  623. $ 'T', 'N', WORK( N+1 ), 1, ONE,
  624. $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
  625. $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
  626. *
  627. ELSE IF( ITYPE.EQ.9 ) THEN
  628. *
  629. * Hermitian banded, eigenvalues specified
  630. *
  631. * The following values are used for the half-bandwidths:
  632. *
  633. * ka = 1 kb = 1
  634. * ka = 2 kb = 1
  635. * ka = 2 kb = 2
  636. * ka = 3 kb = 1
  637. * ka = 3 kb = 2
  638. * ka = 3 kb = 3
  639. *
  640. KB9 = KB9 + 1
  641. IF( KB9.GT.KA9 ) THEN
  642. KA9 = KA9 + 1
  643. KB9 = 1
  644. END IF
  645. KA = MAX( 0, MIN( N-1, KA9 ) )
  646. KB = MAX( 0, MIN( N-1, KB9 ) )
  647. CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
  648. $ ANORM, KA, KA, 'N', A, LDA, WORK, IINFO )
  649. *
  650. ELSE
  651. *
  652. IINFO = 1
  653. END IF
  654. *
  655. IF( IINFO.NE.0 ) THEN
  656. WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
  657. $ IOLDSD
  658. INFO = ABS( IINFO )
  659. RETURN
  660. END IF
  661. *
  662. 90 CONTINUE
  663. *
  664. ABSTOL = UNFL + UNFL
  665. IF( N.LE.1 ) THEN
  666. IL = 1
  667. IU = N
  668. ELSE
  669. IL = 1 + ( N-1 )*DLARND( 1, ISEED2 )
  670. IU = 1 + ( N-1 )*DLARND( 1, ISEED2 )
  671. IF( IL.GT.IU ) THEN
  672. ITEMP = IL
  673. IL = IU
  674. IU = ITEMP
  675. END IF
  676. END IF
  677. *
  678. * 3) Call ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD, CHBGVD,
  679. * ZHEGVX, ZHPGVX and ZHBGVX, do tests.
  680. *
  681. * loop over the three generalized problems
  682. * IBTYPE = 1: A*x = (lambda)*B*x
  683. * IBTYPE = 2: A*B*x = (lambda)*x
  684. * IBTYPE = 3: B*A*x = (lambda)*x
  685. *
  686. DO 630 IBTYPE = 1, 3
  687. *
  688. * loop over the setting UPLO
  689. *
  690. DO 620 IBUPLO = 1, 2
  691. IF( IBUPLO.EQ.1 )
  692. $ UPLO = 'U'
  693. IF( IBUPLO.EQ.2 )
  694. $ UPLO = 'L'
  695. *
  696. * Generate random well-conditioned positive definite
  697. * matrix B, of bandwidth not greater than that of A.
  698. *
  699. CALL ZLATMS( N, N, 'U', ISEED, 'P', RWORK, 5, TEN,
  700. $ ONE, KB, KB, UPLO, B, LDB, WORK( N+1 ),
  701. $ IINFO )
  702. *
  703. * Test ZHEGV
  704. *
  705. NTEST = NTEST + 1
  706. *
  707. CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ )
  708. CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
  709. *
  710. CALL ZHEGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
  711. $ WORK, NWORK, RWORK, IINFO )
  712. IF( IINFO.NE.0 ) THEN
  713. WRITE( NOUNIT, FMT = 9999 )'ZHEGV(V,' // UPLO //
  714. $ ')', IINFO, N, JTYPE, IOLDSD
  715. INFO = ABS( IINFO )
  716. IF( IINFO.LT.0 ) THEN
  717. RETURN
  718. ELSE
  719. RESULT( NTEST ) = ULPINV
  720. GO TO 100
  721. END IF
  722. END IF
  723. *
  724. * Do Test
  725. *
  726. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  727. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  728. *
  729. * Test ZHEGVD
  730. *
  731. NTEST = NTEST + 1
  732. *
  733. CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ )
  734. CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
  735. *
  736. CALL ZHEGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
  737. $ WORK, NWORK, RWORK, LRWORK, IWORK,
  738. $ LIWORK, IINFO )
  739. IF( IINFO.NE.0 ) THEN
  740. WRITE( NOUNIT, FMT = 9999 )'ZHEGVD(V,' // UPLO //
  741. $ ')', IINFO, N, JTYPE, IOLDSD
  742. INFO = ABS( IINFO )
  743. IF( IINFO.LT.0 ) THEN
  744. RETURN
  745. ELSE
  746. RESULT( NTEST ) = ULPINV
  747. GO TO 100
  748. END IF
  749. END IF
  750. *
  751. * Do Test
  752. *
  753. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  754. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  755. *
  756. * Test ZHEGVX
  757. *
  758. NTEST = NTEST + 1
  759. *
  760. CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
  761. CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
  762. *
  763. CALL ZHEGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB,
  764. $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
  765. $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
  766. $ IWORK, IINFO )
  767. IF( IINFO.NE.0 ) THEN
  768. WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,A' // UPLO //
  769. $ ')', IINFO, N, JTYPE, IOLDSD
  770. INFO = ABS( IINFO )
  771. IF( IINFO.LT.0 ) THEN
  772. RETURN
  773. ELSE
  774. RESULT( NTEST ) = ULPINV
  775. GO TO 100
  776. END IF
  777. END IF
  778. *
  779. * Do Test
  780. *
  781. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  782. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  783. *
  784. NTEST = NTEST + 1
  785. *
  786. CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
  787. CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
  788. *
  789. * since we do not know the exact eigenvalues of this
  790. * eigenpair, we just set VL and VU as constants.
  791. * It is quite possible that there are no eigenvalues
  792. * in this interval.
  793. *
  794. VL = ZERO
  795. VU = ANORM
  796. CALL ZHEGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB,
  797. $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
  798. $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
  799. $ IWORK, IINFO )
  800. IF( IINFO.NE.0 ) THEN
  801. WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,V,' //
  802. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  803. INFO = ABS( IINFO )
  804. IF( IINFO.LT.0 ) THEN
  805. RETURN
  806. ELSE
  807. RESULT( NTEST ) = ULPINV
  808. GO TO 100
  809. END IF
  810. END IF
  811. *
  812. * Do Test
  813. *
  814. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  815. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  816. *
  817. NTEST = NTEST + 1
  818. *
  819. CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
  820. CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
  821. *
  822. CALL ZHEGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB,
  823. $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
  824. $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
  825. $ IWORK, IINFO )
  826. IF( IINFO.NE.0 ) THEN
  827. WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,I,' //
  828. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  829. INFO = ABS( IINFO )
  830. IF( IINFO.LT.0 ) THEN
  831. RETURN
  832. ELSE
  833. RESULT( NTEST ) = ULPINV
  834. GO TO 100
  835. END IF
  836. END IF
  837. *
  838. * Do Test
  839. *
  840. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  841. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  842. *
  843. 100 CONTINUE
  844. *
  845. * Test ZHPGV
  846. *
  847. NTEST = NTEST + 1
  848. *
  849. * Copy the matrices into packed storage.
  850. *
  851. IF( LSAME( UPLO, 'U' ) ) THEN
  852. IJ = 1
  853. DO 120 J = 1, N
  854. DO 110 I = 1, J
  855. AP( IJ ) = A( I, J )
  856. BP( IJ ) = B( I, J )
  857. IJ = IJ + 1
  858. 110 CONTINUE
  859. 120 CONTINUE
  860. ELSE
  861. IJ = 1
  862. DO 140 J = 1, N
  863. DO 130 I = J, N
  864. AP( IJ ) = A( I, J )
  865. BP( IJ ) = B( I, J )
  866. IJ = IJ + 1
  867. 130 CONTINUE
  868. 140 CONTINUE
  869. END IF
  870. *
  871. CALL ZHPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
  872. $ WORK, RWORK, IINFO )
  873. IF( IINFO.NE.0 ) THEN
  874. WRITE( NOUNIT, FMT = 9999 )'ZHPGV(V,' // UPLO //
  875. $ ')', IINFO, N, JTYPE, IOLDSD
  876. INFO = ABS( IINFO )
  877. IF( IINFO.LT.0 ) THEN
  878. RETURN
  879. ELSE
  880. RESULT( NTEST ) = ULPINV
  881. GO TO 310
  882. END IF
  883. END IF
  884. *
  885. * Do Test
  886. *
  887. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  888. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  889. *
  890. * Test ZHPGVD
  891. *
  892. NTEST = NTEST + 1
  893. *
  894. * Copy the matrices into packed storage.
  895. *
  896. IF( LSAME( UPLO, 'U' ) ) THEN
  897. IJ = 1
  898. DO 160 J = 1, N
  899. DO 150 I = 1, J
  900. AP( IJ ) = A( I, J )
  901. BP( IJ ) = B( I, J )
  902. IJ = IJ + 1
  903. 150 CONTINUE
  904. 160 CONTINUE
  905. ELSE
  906. IJ = 1
  907. DO 180 J = 1, N
  908. DO 170 I = J, N
  909. AP( IJ ) = A( I, J )
  910. BP( IJ ) = B( I, J )
  911. IJ = IJ + 1
  912. 170 CONTINUE
  913. 180 CONTINUE
  914. END IF
  915. *
  916. CALL ZHPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
  917. $ WORK, NWORK, RWORK, LRWORK, IWORK,
  918. $ LIWORK, IINFO )
  919. IF( IINFO.NE.0 ) THEN
  920. WRITE( NOUNIT, FMT = 9999 )'ZHPGVD(V,' // UPLO //
  921. $ ')', IINFO, N, JTYPE, IOLDSD
  922. INFO = ABS( IINFO )
  923. IF( IINFO.LT.0 ) THEN
  924. RETURN
  925. ELSE
  926. RESULT( NTEST ) = ULPINV
  927. GO TO 310
  928. END IF
  929. END IF
  930. *
  931. * Do Test
  932. *
  933. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  934. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  935. *
  936. * Test ZHPGVX
  937. *
  938. NTEST = NTEST + 1
  939. *
  940. * Copy the matrices into packed storage.
  941. *
  942. IF( LSAME( UPLO, 'U' ) ) THEN
  943. IJ = 1
  944. DO 200 J = 1, N
  945. DO 190 I = 1, J
  946. AP( IJ ) = A( I, J )
  947. BP( IJ ) = B( I, J )
  948. IJ = IJ + 1
  949. 190 CONTINUE
  950. 200 CONTINUE
  951. ELSE
  952. IJ = 1
  953. DO 220 J = 1, N
  954. DO 210 I = J, N
  955. AP( IJ ) = A( I, J )
  956. BP( IJ ) = B( I, J )
  957. IJ = IJ + 1
  958. 210 CONTINUE
  959. 220 CONTINUE
  960. END IF
  961. *
  962. CALL ZHPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
  963. $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
  964. $ RWORK, IWORK( N+1 ), IWORK, INFO )
  965. IF( IINFO.NE.0 ) THEN
  966. WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,A' // UPLO //
  967. $ ')', IINFO, N, JTYPE, IOLDSD
  968. INFO = ABS( IINFO )
  969. IF( IINFO.LT.0 ) THEN
  970. RETURN
  971. ELSE
  972. RESULT( NTEST ) = ULPINV
  973. GO TO 310
  974. END IF
  975. END IF
  976. *
  977. * Do Test
  978. *
  979. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  980. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  981. *
  982. NTEST = NTEST + 1
  983. *
  984. * Copy the matrices into packed storage.
  985. *
  986. IF( LSAME( UPLO, 'U' ) ) THEN
  987. IJ = 1
  988. DO 240 J = 1, N
  989. DO 230 I = 1, J
  990. AP( IJ ) = A( I, J )
  991. BP( IJ ) = B( I, J )
  992. IJ = IJ + 1
  993. 230 CONTINUE
  994. 240 CONTINUE
  995. ELSE
  996. IJ = 1
  997. DO 260 J = 1, N
  998. DO 250 I = J, N
  999. AP( IJ ) = A( I, J )
  1000. BP( IJ ) = B( I, J )
  1001. IJ = IJ + 1
  1002. 250 CONTINUE
  1003. 260 CONTINUE
  1004. END IF
  1005. *
  1006. VL = ZERO
  1007. VU = ANORM
  1008. CALL ZHPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
  1009. $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
  1010. $ RWORK, IWORK( N+1 ), IWORK, INFO )
  1011. IF( IINFO.NE.0 ) THEN
  1012. WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,V' // UPLO //
  1013. $ ')', IINFO, N, JTYPE, IOLDSD
  1014. INFO = ABS( IINFO )
  1015. IF( IINFO.LT.0 ) THEN
  1016. RETURN
  1017. ELSE
  1018. RESULT( NTEST ) = ULPINV
  1019. GO TO 310
  1020. END IF
  1021. END IF
  1022. *
  1023. * Do Test
  1024. *
  1025. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  1026. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1027. *
  1028. NTEST = NTEST + 1
  1029. *
  1030. * Copy the matrices into packed storage.
  1031. *
  1032. IF( LSAME( UPLO, 'U' ) ) THEN
  1033. IJ = 1
  1034. DO 280 J = 1, N
  1035. DO 270 I = 1, J
  1036. AP( IJ ) = A( I, J )
  1037. BP( IJ ) = B( I, J )
  1038. IJ = IJ + 1
  1039. 270 CONTINUE
  1040. 280 CONTINUE
  1041. ELSE
  1042. IJ = 1
  1043. DO 300 J = 1, N
  1044. DO 290 I = J, N
  1045. AP( IJ ) = A( I, J )
  1046. BP( IJ ) = B( I, J )
  1047. IJ = IJ + 1
  1048. 290 CONTINUE
  1049. 300 CONTINUE
  1050. END IF
  1051. *
  1052. CALL ZHPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
  1053. $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
  1054. $ RWORK, IWORK( N+1 ), IWORK, INFO )
  1055. IF( IINFO.NE.0 ) THEN
  1056. WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,I' // UPLO //
  1057. $ ')', IINFO, N, JTYPE, IOLDSD
  1058. INFO = ABS( IINFO )
  1059. IF( IINFO.LT.0 ) THEN
  1060. RETURN
  1061. ELSE
  1062. RESULT( NTEST ) = ULPINV
  1063. GO TO 310
  1064. END IF
  1065. END IF
  1066. *
  1067. * Do Test
  1068. *
  1069. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  1070. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1071. *
  1072. 310 CONTINUE
  1073. *
  1074. IF( IBTYPE.EQ.1 ) THEN
  1075. *
  1076. * TEST ZHBGV
  1077. *
  1078. NTEST = NTEST + 1
  1079. *
  1080. * Copy the matrices into band storage.
  1081. *
  1082. IF( LSAME( UPLO, 'U' ) ) THEN
  1083. DO 340 J = 1, N
  1084. DO 320 I = MAX( 1, J-KA ), J
  1085. AB( KA+1+I-J, J ) = A( I, J )
  1086. 320 CONTINUE
  1087. DO 330 I = MAX( 1, J-KB ), J
  1088. BB( KB+1+I-J, J ) = B( I, J )
  1089. 330 CONTINUE
  1090. 340 CONTINUE
  1091. ELSE
  1092. DO 370 J = 1, N
  1093. DO 350 I = J, MIN( N, J+KA )
  1094. AB( 1+I-J, J ) = A( I, J )
  1095. 350 CONTINUE
  1096. DO 360 I = J, MIN( N, J+KB )
  1097. BB( 1+I-J, J ) = B( I, J )
  1098. 360 CONTINUE
  1099. 370 CONTINUE
  1100. END IF
  1101. *
  1102. CALL ZHBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB,
  1103. $ D, Z, LDZ, WORK, RWORK, IINFO )
  1104. IF( IINFO.NE.0 ) THEN
  1105. WRITE( NOUNIT, FMT = 9999 )'ZHBGV(V,' //
  1106. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  1107. INFO = ABS( IINFO )
  1108. IF( IINFO.LT.0 ) THEN
  1109. RETURN
  1110. ELSE
  1111. RESULT( NTEST ) = ULPINV
  1112. GO TO 620
  1113. END IF
  1114. END IF
  1115. *
  1116. * Do Test
  1117. *
  1118. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  1119. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1120. *
  1121. * TEST ZHBGVD
  1122. *
  1123. NTEST = NTEST + 1
  1124. *
  1125. * Copy the matrices into band storage.
  1126. *
  1127. IF( LSAME( UPLO, 'U' ) ) THEN
  1128. DO 400 J = 1, N
  1129. DO 380 I = MAX( 1, J-KA ), J
  1130. AB( KA+1+I-J, J ) = A( I, J )
  1131. 380 CONTINUE
  1132. DO 390 I = MAX( 1, J-KB ), J
  1133. BB( KB+1+I-J, J ) = B( I, J )
  1134. 390 CONTINUE
  1135. 400 CONTINUE
  1136. ELSE
  1137. DO 430 J = 1, N
  1138. DO 410 I = J, MIN( N, J+KA )
  1139. AB( 1+I-J, J ) = A( I, J )
  1140. 410 CONTINUE
  1141. DO 420 I = J, MIN( N, J+KB )
  1142. BB( 1+I-J, J ) = B( I, J )
  1143. 420 CONTINUE
  1144. 430 CONTINUE
  1145. END IF
  1146. *
  1147. CALL ZHBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB,
  1148. $ LDB, D, Z, LDZ, WORK, NWORK, RWORK,
  1149. $ LRWORK, IWORK, LIWORK, IINFO )
  1150. IF( IINFO.NE.0 ) THEN
  1151. WRITE( NOUNIT, FMT = 9999 )'ZHBGVD(V,' //
  1152. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  1153. INFO = ABS( IINFO )
  1154. IF( IINFO.LT.0 ) THEN
  1155. RETURN
  1156. ELSE
  1157. RESULT( NTEST ) = ULPINV
  1158. GO TO 620
  1159. END IF
  1160. END IF
  1161. *
  1162. * Do Test
  1163. *
  1164. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  1165. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1166. *
  1167. * Test ZHBGVX
  1168. *
  1169. NTEST = NTEST + 1
  1170. *
  1171. * Copy the matrices into band storage.
  1172. *
  1173. IF( LSAME( UPLO, 'U' ) ) THEN
  1174. DO 460 J = 1, N
  1175. DO 440 I = MAX( 1, J-KA ), J
  1176. AB( KA+1+I-J, J ) = A( I, J )
  1177. 440 CONTINUE
  1178. DO 450 I = MAX( 1, J-KB ), J
  1179. BB( KB+1+I-J, J ) = B( I, J )
  1180. 450 CONTINUE
  1181. 460 CONTINUE
  1182. ELSE
  1183. DO 490 J = 1, N
  1184. DO 470 I = J, MIN( N, J+KA )
  1185. AB( 1+I-J, J ) = A( I, J )
  1186. 470 CONTINUE
  1187. DO 480 I = J, MIN( N, J+KB )
  1188. BB( 1+I-J, J ) = B( I, J )
  1189. 480 CONTINUE
  1190. 490 CONTINUE
  1191. END IF
  1192. *
  1193. CALL ZHBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA,
  1194. $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
  1195. $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
  1196. $ IWORK( N+1 ), IWORK, IINFO )
  1197. IF( IINFO.NE.0 ) THEN
  1198. WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,A' //
  1199. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  1200. INFO = ABS( IINFO )
  1201. IF( IINFO.LT.0 ) THEN
  1202. RETURN
  1203. ELSE
  1204. RESULT( NTEST ) = ULPINV
  1205. GO TO 620
  1206. END IF
  1207. END IF
  1208. *
  1209. * Do Test
  1210. *
  1211. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  1212. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1213. *
  1214. NTEST = NTEST + 1
  1215. *
  1216. * Copy the matrices into band storage.
  1217. *
  1218. IF( LSAME( UPLO, 'U' ) ) THEN
  1219. DO 520 J = 1, N
  1220. DO 500 I = MAX( 1, J-KA ), J
  1221. AB( KA+1+I-J, J ) = A( I, J )
  1222. 500 CONTINUE
  1223. DO 510 I = MAX( 1, J-KB ), J
  1224. BB( KB+1+I-J, J ) = B( I, J )
  1225. 510 CONTINUE
  1226. 520 CONTINUE
  1227. ELSE
  1228. DO 550 J = 1, N
  1229. DO 530 I = J, MIN( N, J+KA )
  1230. AB( 1+I-J, J ) = A( I, J )
  1231. 530 CONTINUE
  1232. DO 540 I = J, MIN( N, J+KB )
  1233. BB( 1+I-J, J ) = B( I, J )
  1234. 540 CONTINUE
  1235. 550 CONTINUE
  1236. END IF
  1237. *
  1238. VL = ZERO
  1239. VU = ANORM
  1240. CALL ZHBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA,
  1241. $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
  1242. $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
  1243. $ IWORK( N+1 ), IWORK, IINFO )
  1244. IF( IINFO.NE.0 ) THEN
  1245. WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,V' //
  1246. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  1247. INFO = ABS( IINFO )
  1248. IF( IINFO.LT.0 ) THEN
  1249. RETURN
  1250. ELSE
  1251. RESULT( NTEST ) = ULPINV
  1252. GO TO 620
  1253. END IF
  1254. END IF
  1255. *
  1256. * Do Test
  1257. *
  1258. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  1259. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1260. *
  1261. NTEST = NTEST + 1
  1262. *
  1263. * Copy the matrices into band storage.
  1264. *
  1265. IF( LSAME( UPLO, 'U' ) ) THEN
  1266. DO 580 J = 1, N
  1267. DO 560 I = MAX( 1, J-KA ), J
  1268. AB( KA+1+I-J, J ) = A( I, J )
  1269. 560 CONTINUE
  1270. DO 570 I = MAX( 1, J-KB ), J
  1271. BB( KB+1+I-J, J ) = B( I, J )
  1272. 570 CONTINUE
  1273. 580 CONTINUE
  1274. ELSE
  1275. DO 610 J = 1, N
  1276. DO 590 I = J, MIN( N, J+KA )
  1277. AB( 1+I-J, J ) = A( I, J )
  1278. 590 CONTINUE
  1279. DO 600 I = J, MIN( N, J+KB )
  1280. BB( 1+I-J, J ) = B( I, J )
  1281. 600 CONTINUE
  1282. 610 CONTINUE
  1283. END IF
  1284. *
  1285. CALL ZHBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA,
  1286. $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
  1287. $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
  1288. $ IWORK( N+1 ), IWORK, IINFO )
  1289. IF( IINFO.NE.0 ) THEN
  1290. WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,I' //
  1291. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  1292. INFO = ABS( IINFO )
  1293. IF( IINFO.LT.0 ) THEN
  1294. RETURN
  1295. ELSE
  1296. RESULT( NTEST ) = ULPINV
  1297. GO TO 620
  1298. END IF
  1299. END IF
  1300. *
  1301. * Do Test
  1302. *
  1303. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  1304. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1305. *
  1306. END IF
  1307. *
  1308. 620 CONTINUE
  1309. 630 CONTINUE
  1310. *
  1311. * End of Loop -- Check for RESULT(j) > THRESH
  1312. *
  1313. NTESTT = NTESTT + NTEST
  1314. CALL DLAFTS( 'ZSG', N, N, JTYPE, NTEST, RESULT, IOLDSD,
  1315. $ THRESH, NOUNIT, NERRS )
  1316. 640 CONTINUE
  1317. 650 CONTINUE
  1318. *
  1319. * Summary
  1320. *
  1321. CALL DLASUM( 'ZSG', NOUNIT, NERRS, NTESTT )
  1322. *
  1323. RETURN
  1324. *
  1325. 9999 FORMAT( ' ZDRVSG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
  1326. $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
  1327. *
  1328. * End of ZDRVSG
  1329. *
  1330. END