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.

zdrvsg2stg.f 50 kB

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