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.

ddrvsg.f 47 kB

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