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

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326
  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 generalized 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. *> \ingroup complex16_eig
  364. *
  365. * =====================================================================
  366. SUBROUTINE ZDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
  367. $ NOUNIT, A, LDA, B, LDB, D, Z, LDZ, AB, BB, AP,
  368. $ BP, WORK, NWORK, RWORK, LRWORK, IWORK, LIWORK,
  369. $ RESULT, INFO )
  370. *
  371. * -- LAPACK test routine --
  372. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  373. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  374. *
  375. * .. Scalar Arguments ..
  376. INTEGER INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
  377. $ NSIZES, NTYPES, NWORK
  378. DOUBLE PRECISION THRESH
  379. * ..
  380. * .. Array Arguments ..
  381. LOGICAL DOTYPE( * )
  382. INTEGER ISEED( 4 ), IWORK( * ), NN( * )
  383. DOUBLE PRECISION D( * ), RESULT( * ), RWORK( * )
  384. COMPLEX*16 A( LDA, * ), AB( LDA, * ), AP( * ),
  385. $ B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ),
  386. $ Z( LDZ, * )
  387. * ..
  388. *
  389. * =====================================================================
  390. *
  391. * .. Parameters ..
  392. DOUBLE PRECISION ZERO, ONE, TEN
  393. PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TEN = 10.0D+0 )
  394. COMPLEX*16 CZERO, CONE
  395. PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
  396. $ CONE = ( 1.0D+0, 0.0D+0 ) )
  397. INTEGER MAXTYP
  398. PARAMETER ( MAXTYP = 21 )
  399. * ..
  400. * .. Local Scalars ..
  401. LOGICAL BADNN
  402. CHARACTER UPLO
  403. INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
  404. $ ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB,
  405. $ KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
  406. $ NTESTT
  407. DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
  408. $ RTUNFL, ULP, ULPINV, UNFL, VL, VU
  409. * ..
  410. * .. Local Arrays ..
  411. INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
  412. $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
  413. $ KTYPE( MAXTYP )
  414. * ..
  415. * .. External Functions ..
  416. LOGICAL LSAME
  417. DOUBLE PRECISION DLAMCH, DLARND
  418. EXTERNAL LSAME, DLAMCH, DLARND
  419. * ..
  420. * .. External Subroutines ..
  421. EXTERNAL DLAFTS, DLASUM, XERBLA, ZHBGV, ZHBGVD,
  422. $ ZHBGVX, ZHEGV, ZHEGVD, ZHEGVX, ZHPGV, ZHPGVD,
  423. $ ZHPGVX, ZLACPY, ZLASET, ZLATMR, ZLATMS, ZSGT01
  424. * ..
  425. * .. Intrinsic Functions ..
  426. INTRINSIC ABS, DBLE, MAX, MIN, SQRT
  427. * ..
  428. * .. Data statements ..
  429. DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 /
  430. DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
  431. $ 2, 3, 6*1 /
  432. DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
  433. $ 0, 0, 6*4 /
  434. * ..
  435. * .. Executable Statements ..
  436. *
  437. * 1) Check for errors
  438. *
  439. NTESTT = 0
  440. INFO = 0
  441. *
  442. BADNN = .FALSE.
  443. NMAX = 0
  444. DO 10 J = 1, NSIZES
  445. NMAX = MAX( NMAX, NN( J ) )
  446. IF( NN( J ).LT.0 )
  447. $ BADNN = .TRUE.
  448. 10 CONTINUE
  449. *
  450. * Check for errors
  451. *
  452. IF( NSIZES.LT.0 ) THEN
  453. INFO = -1
  454. ELSE IF( BADNN ) THEN
  455. INFO = -2
  456. ELSE IF( NTYPES.LT.0 ) THEN
  457. INFO = -3
  458. ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
  459. INFO = -9
  460. ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN
  461. INFO = -16
  462. ELSE IF( 2*MAX( NMAX, 2 )**2.GT.NWORK ) THEN
  463. INFO = -21
  464. ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LRWORK ) THEN
  465. INFO = -23
  466. ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LIWORK ) THEN
  467. INFO = -25
  468. END IF
  469. *
  470. IF( INFO.NE.0 ) THEN
  471. CALL XERBLA( 'ZDRVSG', -INFO )
  472. RETURN
  473. END IF
  474. *
  475. * Quick return if possible
  476. *
  477. IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
  478. $ RETURN
  479. *
  480. * More Important constants
  481. *
  482. UNFL = DLAMCH( 'Safe minimum' )
  483. OVFL = DLAMCH( 'Overflow' )
  484. ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
  485. ULPINV = ONE / ULP
  486. RTUNFL = SQRT( UNFL )
  487. RTOVFL = SQRT( OVFL )
  488. *
  489. DO 20 I = 1, 4
  490. ISEED2( I ) = ISEED( I )
  491. 20 CONTINUE
  492. *
  493. * Loop over sizes, types
  494. *
  495. NERRS = 0
  496. NMATS = 0
  497. *
  498. DO 650 JSIZE = 1, NSIZES
  499. N = NN( JSIZE )
  500. ANINV = ONE / DBLE( MAX( 1, N ) )
  501. *
  502. IF( NSIZES.NE.1 ) THEN
  503. MTYPES = MIN( MAXTYP, NTYPES )
  504. ELSE
  505. MTYPES = MIN( MAXTYP+1, NTYPES )
  506. END IF
  507. *
  508. KA9 = 0
  509. KB9 = 0
  510. DO 640 JTYPE = 1, MTYPES
  511. IF( .NOT.DOTYPE( JTYPE ) )
  512. $ GO TO 640
  513. NMATS = NMATS + 1
  514. NTEST = 0
  515. *
  516. DO 30 J = 1, 4
  517. IOLDSD( J ) = ISEED( J )
  518. 30 CONTINUE
  519. *
  520. * 2) Compute "A"
  521. *
  522. * Control parameters:
  523. *
  524. * KMAGN KMODE KTYPE
  525. * =1 O(1) clustered 1 zero
  526. * =2 large clustered 2 identity
  527. * =3 small exponential (none)
  528. * =4 arithmetic diagonal, w/ eigenvalues
  529. * =5 random log hermitian, w/ eigenvalues
  530. * =6 random (none)
  531. * =7 random diagonal
  532. * =8 random hermitian
  533. * =9 banded, w/ eigenvalues
  534. *
  535. IF( MTYPES.GT.MAXTYP )
  536. $ GO TO 90
  537. *
  538. ITYPE = KTYPE( JTYPE )
  539. IMODE = KMODE( JTYPE )
  540. *
  541. * Compute norm
  542. *
  543. GO TO ( 40, 50, 60 )KMAGN( JTYPE )
  544. *
  545. 40 CONTINUE
  546. ANORM = ONE
  547. GO TO 70
  548. *
  549. 50 CONTINUE
  550. ANORM = ( RTOVFL*ULP )*ANINV
  551. GO TO 70
  552. *
  553. 60 CONTINUE
  554. ANORM = RTUNFL*N*ULPINV
  555. GO TO 70
  556. *
  557. 70 CONTINUE
  558. *
  559. IINFO = 0
  560. COND = ULPINV
  561. *
  562. * Special Matrices -- Identity & Jordan block
  563. *
  564. IF( ITYPE.EQ.1 ) THEN
  565. *
  566. * Zero
  567. *
  568. KA = 0
  569. KB = 0
  570. CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
  571. *
  572. ELSE IF( ITYPE.EQ.2 ) THEN
  573. *
  574. * Identity
  575. *
  576. KA = 0
  577. KB = 0
  578. CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
  579. DO 80 JCOL = 1, N
  580. A( JCOL, JCOL ) = ANORM
  581. 80 CONTINUE
  582. *
  583. ELSE IF( ITYPE.EQ.4 ) THEN
  584. *
  585. * Diagonal Matrix, [Eigen]values Specified
  586. *
  587. KA = 0
  588. KB = 0
  589. CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
  590. $ ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
  591. *
  592. ELSE IF( ITYPE.EQ.5 ) THEN
  593. *
  594. * Hermitian, eigenvalues specified
  595. *
  596. KA = MAX( 0, N-1 )
  597. KB = KA
  598. CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
  599. $ ANORM, N, N, 'N', A, LDA, WORK, IINFO )
  600. *
  601. ELSE IF( ITYPE.EQ.7 ) THEN
  602. *
  603. * Diagonal, random eigenvalues
  604. *
  605. KA = 0
  606. KB = 0
  607. CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
  608. $ 'T', 'N', WORK( N+1 ), 1, ONE,
  609. $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
  610. $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
  611. *
  612. ELSE IF( ITYPE.EQ.8 ) THEN
  613. *
  614. * Hermitian, random eigenvalues
  615. *
  616. KA = MAX( 0, N-1 )
  617. KB = KA
  618. CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
  619. $ 'T', 'N', WORK( N+1 ), 1, ONE,
  620. $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
  621. $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
  622. *
  623. ELSE IF( ITYPE.EQ.9 ) THEN
  624. *
  625. * Hermitian banded, eigenvalues specified
  626. *
  627. * The following values are used for the half-bandwidths:
  628. *
  629. * ka = 1 kb = 1
  630. * ka = 2 kb = 1
  631. * ka = 2 kb = 2
  632. * ka = 3 kb = 1
  633. * ka = 3 kb = 2
  634. * ka = 3 kb = 3
  635. *
  636. KB9 = KB9 + 1
  637. IF( KB9.GT.KA9 ) THEN
  638. KA9 = KA9 + 1
  639. KB9 = 1
  640. END IF
  641. KA = MAX( 0, MIN( N-1, KA9 ) )
  642. KB = MAX( 0, MIN( N-1, KB9 ) )
  643. CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
  644. $ ANORM, KA, KA, 'N', A, LDA, WORK, IINFO )
  645. *
  646. ELSE
  647. *
  648. IINFO = 1
  649. END IF
  650. *
  651. IF( IINFO.NE.0 ) THEN
  652. WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
  653. $ IOLDSD
  654. INFO = ABS( IINFO )
  655. RETURN
  656. END IF
  657. *
  658. 90 CONTINUE
  659. *
  660. ABSTOL = UNFL + UNFL
  661. IF( N.LE.1 ) THEN
  662. IL = 1
  663. IU = N
  664. ELSE
  665. IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
  666. IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
  667. IF( IL.GT.IU ) THEN
  668. ITEMP = IL
  669. IL = IU
  670. IU = ITEMP
  671. END IF
  672. END IF
  673. *
  674. * 3) Call ZHEGV, ZHPGV, ZHBGV, CHEGVD, CHPGVD, CHBGVD,
  675. * ZHEGVX, ZHPGVX and ZHBGVX, do tests.
  676. *
  677. * loop over the three generalized problems
  678. * IBTYPE = 1: A*x = (lambda)*B*x
  679. * IBTYPE = 2: A*B*x = (lambda)*x
  680. * IBTYPE = 3: B*A*x = (lambda)*x
  681. *
  682. DO 630 IBTYPE = 1, 3
  683. *
  684. * loop over the setting UPLO
  685. *
  686. DO 620 IBUPLO = 1, 2
  687. IF( IBUPLO.EQ.1 )
  688. $ UPLO = 'U'
  689. IF( IBUPLO.EQ.2 )
  690. $ UPLO = 'L'
  691. *
  692. * Generate random well-conditioned positive definite
  693. * matrix B, of bandwidth not greater than that of A.
  694. *
  695. CALL ZLATMS( N, N, 'U', ISEED, 'P', RWORK, 5, TEN,
  696. $ ONE, KB, KB, UPLO, B, LDB, WORK( N+1 ),
  697. $ IINFO )
  698. *
  699. * Test ZHEGV
  700. *
  701. NTEST = NTEST + 1
  702. *
  703. CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ )
  704. CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
  705. *
  706. CALL ZHEGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
  707. $ WORK, NWORK, RWORK, IINFO )
  708. IF( IINFO.NE.0 ) THEN
  709. WRITE( NOUNIT, FMT = 9999 )'ZHEGV(V,' // UPLO //
  710. $ ')', IINFO, N, JTYPE, IOLDSD
  711. INFO = ABS( IINFO )
  712. IF( IINFO.LT.0 ) THEN
  713. RETURN
  714. ELSE
  715. RESULT( NTEST ) = ULPINV
  716. GO TO 100
  717. END IF
  718. END IF
  719. *
  720. * Do Test
  721. *
  722. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  723. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  724. *
  725. * Test ZHEGVD
  726. *
  727. NTEST = NTEST + 1
  728. *
  729. CALL ZLACPY( ' ', N, N, A, LDA, Z, LDZ )
  730. CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
  731. *
  732. CALL ZHEGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
  733. $ WORK, NWORK, RWORK, LRWORK, IWORK,
  734. $ LIWORK, IINFO )
  735. IF( IINFO.NE.0 ) THEN
  736. WRITE( NOUNIT, FMT = 9999 )'ZHEGVD(V,' // UPLO //
  737. $ ')', IINFO, N, JTYPE, IOLDSD
  738. INFO = ABS( IINFO )
  739. IF( IINFO.LT.0 ) THEN
  740. RETURN
  741. ELSE
  742. RESULT( NTEST ) = ULPINV
  743. GO TO 100
  744. END IF
  745. END IF
  746. *
  747. * Do Test
  748. *
  749. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  750. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  751. *
  752. * Test ZHEGVX
  753. *
  754. NTEST = NTEST + 1
  755. *
  756. CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
  757. CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
  758. *
  759. CALL ZHEGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB,
  760. $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
  761. $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
  762. $ IWORK, IINFO )
  763. IF( IINFO.NE.0 ) THEN
  764. WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,A' // UPLO //
  765. $ ')', IINFO, N, JTYPE, IOLDSD
  766. INFO = ABS( IINFO )
  767. IF( IINFO.LT.0 ) THEN
  768. RETURN
  769. ELSE
  770. RESULT( NTEST ) = ULPINV
  771. GO TO 100
  772. END IF
  773. END IF
  774. *
  775. * Do Test
  776. *
  777. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  778. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  779. *
  780. NTEST = NTEST + 1
  781. *
  782. CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
  783. CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
  784. *
  785. * since we do not know the exact eigenvalues of this
  786. * eigenpair, we just set VL and VU as constants.
  787. * It is quite possible that there are no eigenvalues
  788. * in this interval.
  789. *
  790. VL = ZERO
  791. VU = ANORM
  792. CALL ZHEGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB,
  793. $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
  794. $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
  795. $ IWORK, IINFO )
  796. IF( IINFO.NE.0 ) THEN
  797. WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,V,' //
  798. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  799. INFO = ABS( IINFO )
  800. IF( IINFO.LT.0 ) THEN
  801. RETURN
  802. ELSE
  803. RESULT( NTEST ) = ULPINV
  804. GO TO 100
  805. END IF
  806. END IF
  807. *
  808. * Do Test
  809. *
  810. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  811. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  812. *
  813. NTEST = NTEST + 1
  814. *
  815. CALL ZLACPY( ' ', N, N, A, LDA, AB, LDA )
  816. CALL ZLACPY( UPLO, N, N, B, LDB, BB, LDB )
  817. *
  818. CALL ZHEGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB,
  819. $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
  820. $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
  821. $ IWORK, IINFO )
  822. IF( IINFO.NE.0 ) THEN
  823. WRITE( NOUNIT, FMT = 9999 )'ZHEGVX(V,I,' //
  824. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  825. INFO = ABS( IINFO )
  826. IF( IINFO.LT.0 ) THEN
  827. RETURN
  828. ELSE
  829. RESULT( NTEST ) = ULPINV
  830. GO TO 100
  831. END IF
  832. END IF
  833. *
  834. * Do Test
  835. *
  836. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  837. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  838. *
  839. 100 CONTINUE
  840. *
  841. * Test ZHPGV
  842. *
  843. NTEST = NTEST + 1
  844. *
  845. * Copy the matrices into packed storage.
  846. *
  847. IF( LSAME( UPLO, 'U' ) ) THEN
  848. IJ = 1
  849. DO 120 J = 1, N
  850. DO 110 I = 1, J
  851. AP( IJ ) = A( I, J )
  852. BP( IJ ) = B( I, J )
  853. IJ = IJ + 1
  854. 110 CONTINUE
  855. 120 CONTINUE
  856. ELSE
  857. IJ = 1
  858. DO 140 J = 1, N
  859. DO 130 I = J, N
  860. AP( IJ ) = A( I, J )
  861. BP( IJ ) = B( I, J )
  862. IJ = IJ + 1
  863. 130 CONTINUE
  864. 140 CONTINUE
  865. END IF
  866. *
  867. CALL ZHPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
  868. $ WORK, RWORK, IINFO )
  869. IF( IINFO.NE.0 ) THEN
  870. WRITE( NOUNIT, FMT = 9999 )'ZHPGV(V,' // UPLO //
  871. $ ')', IINFO, N, JTYPE, IOLDSD
  872. INFO = ABS( IINFO )
  873. IF( IINFO.LT.0 ) THEN
  874. RETURN
  875. ELSE
  876. RESULT( NTEST ) = ULPINV
  877. GO TO 310
  878. END IF
  879. END IF
  880. *
  881. * Do Test
  882. *
  883. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  884. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  885. *
  886. * Test ZHPGVD
  887. *
  888. NTEST = NTEST + 1
  889. *
  890. * Copy the matrices into packed storage.
  891. *
  892. IF( LSAME( UPLO, 'U' ) ) THEN
  893. IJ = 1
  894. DO 160 J = 1, N
  895. DO 150 I = 1, J
  896. AP( IJ ) = A( I, J )
  897. BP( IJ ) = B( I, J )
  898. IJ = IJ + 1
  899. 150 CONTINUE
  900. 160 CONTINUE
  901. ELSE
  902. IJ = 1
  903. DO 180 J = 1, N
  904. DO 170 I = J, N
  905. AP( IJ ) = A( I, J )
  906. BP( IJ ) = B( I, J )
  907. IJ = IJ + 1
  908. 170 CONTINUE
  909. 180 CONTINUE
  910. END IF
  911. *
  912. CALL ZHPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
  913. $ WORK, NWORK, RWORK, LRWORK, IWORK,
  914. $ LIWORK, IINFO )
  915. IF( IINFO.NE.0 ) THEN
  916. WRITE( NOUNIT, FMT = 9999 )'ZHPGVD(V,' // UPLO //
  917. $ ')', IINFO, N, JTYPE, IOLDSD
  918. INFO = ABS( IINFO )
  919. IF( IINFO.LT.0 ) THEN
  920. RETURN
  921. ELSE
  922. RESULT( NTEST ) = ULPINV
  923. GO TO 310
  924. END IF
  925. END IF
  926. *
  927. * Do Test
  928. *
  929. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  930. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  931. *
  932. * Test ZHPGVX
  933. *
  934. NTEST = NTEST + 1
  935. *
  936. * Copy the matrices into packed storage.
  937. *
  938. IF( LSAME( UPLO, 'U' ) ) THEN
  939. IJ = 1
  940. DO 200 J = 1, N
  941. DO 190 I = 1, J
  942. AP( IJ ) = A( I, J )
  943. BP( IJ ) = B( I, J )
  944. IJ = IJ + 1
  945. 190 CONTINUE
  946. 200 CONTINUE
  947. ELSE
  948. IJ = 1
  949. DO 220 J = 1, N
  950. DO 210 I = J, N
  951. AP( IJ ) = A( I, J )
  952. BP( IJ ) = B( I, J )
  953. IJ = IJ + 1
  954. 210 CONTINUE
  955. 220 CONTINUE
  956. END IF
  957. *
  958. CALL ZHPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
  959. $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
  960. $ RWORK, IWORK( N+1 ), IWORK, INFO )
  961. IF( IINFO.NE.0 ) THEN
  962. WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,A' // UPLO //
  963. $ ')', IINFO, N, JTYPE, IOLDSD
  964. INFO = ABS( IINFO )
  965. IF( IINFO.LT.0 ) THEN
  966. RETURN
  967. ELSE
  968. RESULT( NTEST ) = ULPINV
  969. GO TO 310
  970. END IF
  971. END IF
  972. *
  973. * Do Test
  974. *
  975. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  976. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  977. *
  978. NTEST = NTEST + 1
  979. *
  980. * Copy the matrices into packed storage.
  981. *
  982. IF( LSAME( UPLO, 'U' ) ) THEN
  983. IJ = 1
  984. DO 240 J = 1, N
  985. DO 230 I = 1, J
  986. AP( IJ ) = A( I, J )
  987. BP( IJ ) = B( I, J )
  988. IJ = IJ + 1
  989. 230 CONTINUE
  990. 240 CONTINUE
  991. ELSE
  992. IJ = 1
  993. DO 260 J = 1, N
  994. DO 250 I = J, N
  995. AP( IJ ) = A( I, J )
  996. BP( IJ ) = B( I, J )
  997. IJ = IJ + 1
  998. 250 CONTINUE
  999. 260 CONTINUE
  1000. END IF
  1001. *
  1002. VL = ZERO
  1003. VU = ANORM
  1004. CALL ZHPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
  1005. $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
  1006. $ RWORK, IWORK( N+1 ), IWORK, INFO )
  1007. IF( IINFO.NE.0 ) THEN
  1008. WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,V' // UPLO //
  1009. $ ')', IINFO, N, JTYPE, IOLDSD
  1010. INFO = ABS( IINFO )
  1011. IF( IINFO.LT.0 ) THEN
  1012. RETURN
  1013. ELSE
  1014. RESULT( NTEST ) = ULPINV
  1015. GO TO 310
  1016. END IF
  1017. END IF
  1018. *
  1019. * Do Test
  1020. *
  1021. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  1022. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1023. *
  1024. NTEST = NTEST + 1
  1025. *
  1026. * Copy the matrices into packed storage.
  1027. *
  1028. IF( LSAME( UPLO, 'U' ) ) THEN
  1029. IJ = 1
  1030. DO 280 J = 1, N
  1031. DO 270 I = 1, J
  1032. AP( IJ ) = A( I, J )
  1033. BP( IJ ) = B( I, J )
  1034. IJ = IJ + 1
  1035. 270 CONTINUE
  1036. 280 CONTINUE
  1037. ELSE
  1038. IJ = 1
  1039. DO 300 J = 1, N
  1040. DO 290 I = J, N
  1041. AP( IJ ) = A( I, J )
  1042. BP( IJ ) = B( I, J )
  1043. IJ = IJ + 1
  1044. 290 CONTINUE
  1045. 300 CONTINUE
  1046. END IF
  1047. *
  1048. CALL ZHPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
  1049. $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
  1050. $ RWORK, IWORK( N+1 ), IWORK, INFO )
  1051. IF( IINFO.NE.0 ) THEN
  1052. WRITE( NOUNIT, FMT = 9999 )'ZHPGVX(V,I' // UPLO //
  1053. $ ')', IINFO, N, JTYPE, IOLDSD
  1054. INFO = ABS( IINFO )
  1055. IF( IINFO.LT.0 ) THEN
  1056. RETURN
  1057. ELSE
  1058. RESULT( NTEST ) = ULPINV
  1059. GO TO 310
  1060. END IF
  1061. END IF
  1062. *
  1063. * Do Test
  1064. *
  1065. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  1066. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1067. *
  1068. 310 CONTINUE
  1069. *
  1070. IF( IBTYPE.EQ.1 ) THEN
  1071. *
  1072. * TEST ZHBGV
  1073. *
  1074. NTEST = NTEST + 1
  1075. *
  1076. * Copy the matrices into band storage.
  1077. *
  1078. IF( LSAME( UPLO, 'U' ) ) THEN
  1079. DO 340 J = 1, N
  1080. DO 320 I = MAX( 1, J-KA ), J
  1081. AB( KA+1+I-J, J ) = A( I, J )
  1082. 320 CONTINUE
  1083. DO 330 I = MAX( 1, J-KB ), J
  1084. BB( KB+1+I-J, J ) = B( I, J )
  1085. 330 CONTINUE
  1086. 340 CONTINUE
  1087. ELSE
  1088. DO 370 J = 1, N
  1089. DO 350 I = J, MIN( N, J+KA )
  1090. AB( 1+I-J, J ) = A( I, J )
  1091. 350 CONTINUE
  1092. DO 360 I = J, MIN( N, J+KB )
  1093. BB( 1+I-J, J ) = B( I, J )
  1094. 360 CONTINUE
  1095. 370 CONTINUE
  1096. END IF
  1097. *
  1098. CALL ZHBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB,
  1099. $ D, Z, LDZ, WORK, RWORK, IINFO )
  1100. IF( IINFO.NE.0 ) THEN
  1101. WRITE( NOUNIT, FMT = 9999 )'ZHBGV(V,' //
  1102. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  1103. INFO = ABS( IINFO )
  1104. IF( IINFO.LT.0 ) THEN
  1105. RETURN
  1106. ELSE
  1107. RESULT( NTEST ) = ULPINV
  1108. GO TO 620
  1109. END IF
  1110. END IF
  1111. *
  1112. * Do Test
  1113. *
  1114. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  1115. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1116. *
  1117. * TEST ZHBGVD
  1118. *
  1119. NTEST = NTEST + 1
  1120. *
  1121. * Copy the matrices into band storage.
  1122. *
  1123. IF( LSAME( UPLO, 'U' ) ) THEN
  1124. DO 400 J = 1, N
  1125. DO 380 I = MAX( 1, J-KA ), J
  1126. AB( KA+1+I-J, J ) = A( I, J )
  1127. 380 CONTINUE
  1128. DO 390 I = MAX( 1, J-KB ), J
  1129. BB( KB+1+I-J, J ) = B( I, J )
  1130. 390 CONTINUE
  1131. 400 CONTINUE
  1132. ELSE
  1133. DO 430 J = 1, N
  1134. DO 410 I = J, MIN( N, J+KA )
  1135. AB( 1+I-J, J ) = A( I, J )
  1136. 410 CONTINUE
  1137. DO 420 I = J, MIN( N, J+KB )
  1138. BB( 1+I-J, J ) = B( I, J )
  1139. 420 CONTINUE
  1140. 430 CONTINUE
  1141. END IF
  1142. *
  1143. CALL ZHBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB,
  1144. $ LDB, D, Z, LDZ, WORK, NWORK, RWORK,
  1145. $ LRWORK, IWORK, LIWORK, IINFO )
  1146. IF( IINFO.NE.0 ) THEN
  1147. WRITE( NOUNIT, FMT = 9999 )'ZHBGVD(V,' //
  1148. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  1149. INFO = ABS( IINFO )
  1150. IF( IINFO.LT.0 ) THEN
  1151. RETURN
  1152. ELSE
  1153. RESULT( NTEST ) = ULPINV
  1154. GO TO 620
  1155. END IF
  1156. END IF
  1157. *
  1158. * Do Test
  1159. *
  1160. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  1161. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1162. *
  1163. * Test ZHBGVX
  1164. *
  1165. NTEST = NTEST + 1
  1166. *
  1167. * Copy the matrices into band storage.
  1168. *
  1169. IF( LSAME( UPLO, 'U' ) ) THEN
  1170. DO 460 J = 1, N
  1171. DO 440 I = MAX( 1, J-KA ), J
  1172. AB( KA+1+I-J, J ) = A( I, J )
  1173. 440 CONTINUE
  1174. DO 450 I = MAX( 1, J-KB ), J
  1175. BB( KB+1+I-J, J ) = B( I, J )
  1176. 450 CONTINUE
  1177. 460 CONTINUE
  1178. ELSE
  1179. DO 490 J = 1, N
  1180. DO 470 I = J, MIN( N, J+KA )
  1181. AB( 1+I-J, J ) = A( I, J )
  1182. 470 CONTINUE
  1183. DO 480 I = J, MIN( N, J+KB )
  1184. BB( 1+I-J, J ) = B( I, J )
  1185. 480 CONTINUE
  1186. 490 CONTINUE
  1187. END IF
  1188. *
  1189. CALL ZHBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA,
  1190. $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
  1191. $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
  1192. $ IWORK( N+1 ), IWORK, IINFO )
  1193. IF( IINFO.NE.0 ) THEN
  1194. WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,A' //
  1195. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  1196. INFO = ABS( IINFO )
  1197. IF( IINFO.LT.0 ) THEN
  1198. RETURN
  1199. ELSE
  1200. RESULT( NTEST ) = ULPINV
  1201. GO TO 620
  1202. END IF
  1203. END IF
  1204. *
  1205. * Do Test
  1206. *
  1207. CALL ZSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  1208. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1209. *
  1210. NTEST = NTEST + 1
  1211. *
  1212. * Copy the matrices into band storage.
  1213. *
  1214. IF( LSAME( UPLO, 'U' ) ) THEN
  1215. DO 520 J = 1, N
  1216. DO 500 I = MAX( 1, J-KA ), J
  1217. AB( KA+1+I-J, J ) = A( I, J )
  1218. 500 CONTINUE
  1219. DO 510 I = MAX( 1, J-KB ), J
  1220. BB( KB+1+I-J, J ) = B( I, J )
  1221. 510 CONTINUE
  1222. 520 CONTINUE
  1223. ELSE
  1224. DO 550 J = 1, N
  1225. DO 530 I = J, MIN( N, J+KA )
  1226. AB( 1+I-J, J ) = A( I, J )
  1227. 530 CONTINUE
  1228. DO 540 I = J, MIN( N, J+KB )
  1229. BB( 1+I-J, J ) = B( I, J )
  1230. 540 CONTINUE
  1231. 550 CONTINUE
  1232. END IF
  1233. *
  1234. VL = ZERO
  1235. VU = ANORM
  1236. CALL ZHBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA,
  1237. $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
  1238. $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
  1239. $ IWORK( N+1 ), IWORK, IINFO )
  1240. IF( IINFO.NE.0 ) THEN
  1241. WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,V' //
  1242. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  1243. INFO = ABS( IINFO )
  1244. IF( IINFO.LT.0 ) THEN
  1245. RETURN
  1246. ELSE
  1247. RESULT( NTEST ) = ULPINV
  1248. GO TO 620
  1249. END IF
  1250. END IF
  1251. *
  1252. * Do Test
  1253. *
  1254. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  1255. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1256. *
  1257. NTEST = NTEST + 1
  1258. *
  1259. * Copy the matrices into band storage.
  1260. *
  1261. IF( LSAME( UPLO, 'U' ) ) THEN
  1262. DO 580 J = 1, N
  1263. DO 560 I = MAX( 1, J-KA ), J
  1264. AB( KA+1+I-J, J ) = A( I, J )
  1265. 560 CONTINUE
  1266. DO 570 I = MAX( 1, J-KB ), J
  1267. BB( KB+1+I-J, J ) = B( I, J )
  1268. 570 CONTINUE
  1269. 580 CONTINUE
  1270. ELSE
  1271. DO 610 J = 1, N
  1272. DO 590 I = J, MIN( N, J+KA )
  1273. AB( 1+I-J, J ) = A( I, J )
  1274. 590 CONTINUE
  1275. DO 600 I = J, MIN( N, J+KB )
  1276. BB( 1+I-J, J ) = B( I, J )
  1277. 600 CONTINUE
  1278. 610 CONTINUE
  1279. END IF
  1280. *
  1281. CALL ZHBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA,
  1282. $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
  1283. $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
  1284. $ IWORK( N+1 ), IWORK, IINFO )
  1285. IF( IINFO.NE.0 ) THEN
  1286. WRITE( NOUNIT, FMT = 9999 )'ZHBGVX(V,I' //
  1287. $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
  1288. INFO = ABS( IINFO )
  1289. IF( IINFO.LT.0 ) THEN
  1290. RETURN
  1291. ELSE
  1292. RESULT( NTEST ) = ULPINV
  1293. GO TO 620
  1294. END IF
  1295. END IF
  1296. *
  1297. * Do Test
  1298. *
  1299. CALL ZSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  1300. $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
  1301. *
  1302. END IF
  1303. *
  1304. 620 CONTINUE
  1305. 630 CONTINUE
  1306. *
  1307. * End of Loop -- Check for RESULT(j) > THRESH
  1308. *
  1309. NTESTT = NTESTT + NTEST
  1310. CALL DLAFTS( 'ZSG', N, N, JTYPE, NTEST, RESULT, IOLDSD,
  1311. $ THRESH, NOUNIT, NERRS )
  1312. 640 CONTINUE
  1313. 650 CONTINUE
  1314. *
  1315. * Summary
  1316. *
  1317. CALL DLASUM( 'ZSG', NOUNIT, NERRS, NTESTT )
  1318. *
  1319. RETURN
  1320. *
  1321. 9999 FORMAT( ' ZDRVSG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
  1322. $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
  1323. *
  1324. * End of ZDRVSG
  1325. *
  1326. END