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.

sdrvsg2stg.f 49 kB

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