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.

cdrvsg.f 48 kB

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