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

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