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.

cdrvsg2stg.f 50 kB

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