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.

ddrvsg2stg.f 49 kB

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