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

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