You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

ddrvsg2stg.f 49 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359
  1. *> \brief \b DDRVSG2STG
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * SUBROUTINE DDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
  12. * NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
  13. * BB, AP, BP, WORK, NWORK, IWORK, LIWORK,
  14. * RESULT, INFO )
  15. *
  16. * IMPLICIT NONE
  17. * .. Scalar Arguments ..
  18. * INTEGER INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES,
  19. * $ NTYPES, NWORK
  20. * DOUBLE PRECISION THRESH
  21. * ..
  22. * .. Array Arguments ..
  23. * LOGICAL DOTYPE( * )
  24. * INTEGER ISEED( 4 ), IWORK( * ), NN( * )
  25. * DOUBLE PRECISION A( LDA, * ), AB( LDA, * ), AP( * ),
  26. * $ B( LDB, * ), BB( LDB, * ), BP( * ), D( * ),
  27. * $ RESULT( * ), WORK( * ), Z( LDZ, * )
  28. * ..
  29. *
  30. *
  31. *> \par Purpose:
  32. * =============
  33. *>
  34. *> \verbatim
  35. *>
  36. *> DDRVSG2STG checks the real symmetric generalized eigenproblem
  37. *> drivers.
  38. *>
  39. *> DSYGV computes all eigenvalues and, optionally,
  40. *> eigenvectors of a real symmetric-definite generalized
  41. *> eigenproblem.
  42. *>
  43. *> DSYGVD computes all eigenvalues and, optionally,
  44. *> eigenvectors of a real symmetric-definite generalized
  45. *> eigenproblem using a divide and conquer algorithm.
  46. *>
  47. *> DSYGVX computes selected eigenvalues and, optionally,
  48. *> eigenvectors of a real symmetric-definite generalized
  49. *> eigenproblem.
  50. *>
  51. *> DSPGV computes all eigenvalues and, optionally,
  52. *> eigenvectors of a real symmetric-definite generalized
  53. *> eigenproblem in packed storage.
  54. *>
  55. *> DSPGVD computes all eigenvalues and, optionally,
  56. *> eigenvectors of a real symmetric-definite generalized
  57. *> eigenproblem in packed storage using a divide and
  58. *> conquer algorithm.
  59. *>
  60. *> DSPGVX computes selected eigenvalues and, optionally,
  61. *> eigenvectors of a real symmetric-definite generalized
  62. *> eigenproblem in packed storage.
  63. *>
  64. *> DSBGV computes all eigenvalues and, optionally,
  65. *> eigenvectors of a real symmetric-definite banded
  66. *> generalized eigenproblem.
  67. *>
  68. *> DSBGVD computes all eigenvalues and, optionally,
  69. *> eigenvectors of a real symmetric-definite banded
  70. *> generalized eigenproblem using a divide and conquer
  71. *> algorithm.
  72. *>
  73. *> DSBGVX computes selected eigenvalues and, optionally,
  74. *> eigenvectors of a real symmetric-definite banded
  75. *> generalized eigenproblem.
  76. *>
  77. *> When DDRVSG2STG is called, a number of matrix "sizes" ("n's") and a
  78. *> number of matrix "types" are specified. For each size ("n")
  79. *> and each type of matrix, one matrix A of the given type will be
  80. *> generated; a random well-conditioned matrix B is also generated
  81. *> and the pair (A,B) is used to test the drivers.
  82. *>
  83. *> For each pair (A,B), the following tests are performed:
  84. *>
  85. *> (1) DSYGV with ITYPE = 1 and UPLO ='U':
  86. *>
  87. *> | A Z - B Z D | / ( |A| |Z| n ulp )
  88. *> | D - D2 | / ( |D| ulp ) where D is computed by
  89. *> DSYGV and D2 is computed by
  90. *> DSYGV_2STAGE. This test is
  91. *> only performed for DSYGV
  92. *>
  93. *> (2) as (1) but calling DSPGV
  94. *> (3) as (1) but calling DSBGV
  95. *> (4) as (1) but with UPLO = 'L'
  96. *> (5) as (4) but calling DSPGV
  97. *> (6) as (4) but calling DSBGV
  98. *>
  99. *> (7) DSYGV with ITYPE = 2 and UPLO ='U':
  100. *>
  101. *> | A B Z - Z D | / ( |A| |Z| n ulp )
  102. *>
  103. *> (8) as (7) but calling DSPGV
  104. *> (9) as (7) but with UPLO = 'L'
  105. *> (10) as (9) but calling DSPGV
  106. *>
  107. *> (11) DSYGV with ITYPE = 3 and UPLO ='U':
  108. *>
  109. *> | B A Z - Z D | / ( |A| |Z| n ulp )
  110. *>
  111. *> (12) as (11) but calling DSPGV
  112. *> (13) as (11) but with UPLO = 'L'
  113. *> (14) as (13) but calling DSPGV
  114. *>
  115. *> DSYGVD, DSPGVD and DSBGVD performed the same 14 tests.
  116. *>
  117. *> DSYGVX, DSPGVX and DSBGVX performed the above 14 tests with
  118. *> the parameter RANGE = 'A', 'N' and 'I', respectively.
  119. *>
  120. *> The "sizes" are specified by an array NN(1:NSIZES); the value
  121. *> of each element NN(j) specifies one size.
  122. *> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
  123. *> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
  124. *> This type is used for the matrix A which has half-bandwidth KA.
  125. *> B is generated as a well-conditioned positive definite matrix
  126. *> with half-bandwidth KB (<= KA).
  127. *> Currently, the list of possible types for A is:
  128. *>
  129. *> (1) The zero matrix.
  130. *> (2) The identity matrix.
  131. *>
  132. *> (3) A diagonal matrix with evenly spaced entries
  133. *> 1, ..., ULP and random signs.
  134. *> (ULP = (first number larger than 1) - 1 )
  135. *> (4) A diagonal matrix with geometrically spaced entries
  136. *> 1, ..., ULP and random signs.
  137. *> (5) A diagonal matrix with "clustered" entries
  138. *> 1, ULP, ..., ULP and random signs.
  139. *>
  140. *> (6) Same as (4), but multiplied by SQRT( overflow threshold )
  141. *> (7) Same as (4), but multiplied by SQRT( underflow threshold )
  142. *>
  143. *> (8) A matrix of the form U* D U, where U is orthogonal and
  144. *> D has evenly spaced entries 1, ..., ULP with random signs
  145. *> on the diagonal.
  146. *>
  147. *> (9) A matrix of the form U* D U, where U is orthogonal and
  148. *> D has geometrically spaced entries 1, ..., ULP with random
  149. *> signs on the diagonal.
  150. *>
  151. *> (10) A matrix of the form U* D U, where U is orthogonal and
  152. *> D has "clustered" entries 1, ULP,..., ULP with random
  153. *> signs on the diagonal.
  154. *>
  155. *> (11) Same as (8), but multiplied by SQRT( overflow threshold )
  156. *> (12) Same as (8), but multiplied by SQRT( underflow threshold )
  157. *>
  158. *> (13) symmetric matrix with random entries chosen from (-1,1).
  159. *> (14) Same as (13), but multiplied by SQRT( overflow threshold )
  160. *> (15) Same as (13), but multiplied by SQRT( underflow threshold)
  161. *>
  162. *> (16) Same as (8), but with KA = 1 and KB = 1
  163. *> (17) Same as (8), but with KA = 2 and KB = 1
  164. *> (18) Same as (8), but with KA = 2 and KB = 2
  165. *> (19) Same as (8), but with KA = 3 and KB = 1
  166. *> (20) Same as (8), but with KA = 3 and KB = 2
  167. *> (21) Same as (8), but with KA = 3 and KB = 3
  168. *> \endverbatim
  169. *
  170. * Arguments:
  171. * ==========
  172. *
  173. *> \verbatim
  174. *> NSIZES INTEGER
  175. *> The number of sizes of matrices to use. If it is zero,
  176. *> DDRVSG2STG does nothing. It must be at least zero.
  177. *> Not modified.
  178. *>
  179. *> NN INTEGER array, dimension (NSIZES)
  180. *> An array containing the sizes to be used for the matrices.
  181. *> Zero values will be skipped. The values must be at least
  182. *> zero.
  183. *> Not modified.
  184. *>
  185. *> NTYPES INTEGER
  186. *> The number of elements in DOTYPE. If it is zero, DDRVSG2STG
  187. *> does nothing. It must be at least zero. If it is MAXTYP+1
  188. *> and NSIZES is 1, then an additional type, MAXTYP+1 is
  189. *> defined, which is to use whatever matrix is in A. This
  190. *> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
  191. *> DOTYPE(MAXTYP+1) is .TRUE. .
  192. *> Not modified.
  193. *>
  194. *> DOTYPE LOGICAL array, dimension (NTYPES)
  195. *> If DOTYPE(j) is .TRUE., then for each size in NN a
  196. *> matrix of that size and of type j will be generated.
  197. *> If NTYPES is smaller than the maximum number of types
  198. *> defined (PARAMETER MAXTYP), then types NTYPES+1 through
  199. *> MAXTYP will not be generated. If NTYPES is larger
  200. *> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
  201. *> will be ignored.
  202. *> Not modified.
  203. *>
  204. *> ISEED INTEGER array, dimension (4)
  205. *> On entry ISEED specifies the seed of the random number
  206. *> generator. The array elements should be between 0 and 4095;
  207. *> if not they will be reduced mod 4096. Also, ISEED(4) must
  208. *> be odd. The random number generator uses a linear
  209. *> congruential sequence limited to small integers, and so
  210. *> should produce machine independent random numbers. The
  211. *> values of ISEED are changed on exit, and can be used in the
  212. *> next call to DDRVSG2STG to continue the same random number
  213. *> sequence.
  214. *> Modified.
  215. *>
  216. *> THRESH DOUBLE PRECISION
  217. *> A test will count as "failed" if the "error", computed as
  218. *> described above, exceeds THRESH. Note that the error
  219. *> is scaled to be O(1), so THRESH should be a reasonably
  220. *> small multiple of 1, e.g., 10 or 100. In particular,
  221. *> it should not depend on the precision (single vs. double)
  222. *> or the size of the matrix. It must be at least zero.
  223. *> Not modified.
  224. *>
  225. *> NOUNIT INTEGER
  226. *> The FORTRAN unit number for printing out error messages
  227. *> (e.g., if a routine returns IINFO not equal to 0.)
  228. *> Not modified.
  229. *>
  230. *> A DOUBLE PRECISION array, dimension (LDA , max(NN))
  231. *> Used to hold the matrix whose eigenvalues are to be
  232. *> computed. On exit, A contains the last matrix actually
  233. *> used.
  234. *> Modified.
  235. *>
  236. *> LDA INTEGER
  237. *> The leading dimension of A and AB. It must be at
  238. *> least 1 and at least max( NN ).
  239. *> Not modified.
  240. *>
  241. *> B DOUBLE PRECISION array, dimension (LDB , max(NN))
  242. *> Used to hold the symmetric positive definite matrix for
  243. *> the 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 DOUBLE PRECISION array, dimension (max(NN))
  254. *> The eigenvalues of A. On exit, the eigenvalues in D
  255. *> correspond with the matrix in A.
  256. *> Modified.
  257. *>
  258. *> Z DOUBLE PRECISION array, dimension (LDZ, max(NN))
  259. *> The matrix of eigenvectors.
  260. *> Modified.
  261. *>
  262. *> LDZ INTEGER
  263. *> The leading dimension of Z. It must be at least 1 and
  264. *> at least max( NN ).
  265. *> Not modified.
  266. *>
  267. *> AB DOUBLE PRECISION array, dimension (LDA, max(NN))
  268. *> Workspace.
  269. *> Modified.
  270. *>
  271. *> BB DOUBLE PRECISION array, dimension (LDB, max(NN))
  272. *> Workspace.
  273. *> Modified.
  274. *>
  275. *> AP DOUBLE PRECISION array, dimension (max(NN)**2)
  276. *> Workspace.
  277. *> Modified.
  278. *>
  279. *> BP DOUBLE PRECISION array, dimension (max(NN)**2)
  280. *> Workspace.
  281. *> Modified.
  282. *>
  283. *> WORK DOUBLE PRECISION array, dimension (NWORK)
  284. *> Workspace.
  285. *> Modified.
  286. *>
  287. *> NWORK INTEGER
  288. *> The number of entries in WORK. This must be at least
  289. *> 1+5*N+2*N*lg(N)+3*N**2 where N = max( NN(j) ) and
  290. *> lg( N ) = smallest integer k such that 2**k >= N.
  291. *> Not modified.
  292. *>
  293. *> IWORK INTEGER array, dimension (LIWORK)
  294. *> Workspace.
  295. *> Modified.
  296. *>
  297. *> LIWORK INTEGER
  298. *> The number of entries in WORK. This must be at least 6*N.
  299. *> Not modified.
  300. *>
  301. *> RESULT DOUBLE PRECISION array, dimension (70)
  302. *> The values computed by the 70 tests described above.
  303. *> Modified.
  304. *>
  305. *> INFO INTEGER
  306. *> If 0, then everything ran OK.
  307. *> -1: NSIZES < 0
  308. *> -2: Some NN(j) < 0
  309. *> -3: NTYPES < 0
  310. *> -5: THRESH < 0
  311. *> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
  312. *> -16: LDZ < 1 or LDZ < NMAX.
  313. *> -21: NWORK too small.
  314. *> -23: LIWORK too small.
  315. *> If DLATMR, SLATMS, DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD,
  316. *> DSBGVD, DSYGVX, DSPGVX or SSBGVX returns an error code,
  317. *> the absolute value of it is returned.
  318. *> Modified.
  319. *>
  320. *> ----------------------------------------------------------------------
  321. *>
  322. *> Some Local Variables and Parameters:
  323. *> ---- ----- --------- --- ----------
  324. *> ZERO, ONE Real 0 and 1.
  325. *> MAXTYP The number of types defined.
  326. *> NTEST The number of tests that have been run
  327. *> on this matrix.
  328. *> NTESTT The total number of tests for this call.
  329. *> NMAX Largest value in NN.
  330. *> NMATS The number of matrices generated so far.
  331. *> NERRS The number of tests which have exceeded THRESH
  332. *> so far (computed by DLAFTS).
  333. *> COND, IMODE Values to be passed to the matrix generators.
  334. *> ANORM Norm of A; passed to matrix generators.
  335. *>
  336. *> OVFL, UNFL Overflow and underflow thresholds.
  337. *> ULP, ULPINV Finest relative precision and its inverse.
  338. *> RTOVFL, RTUNFL Square roots of the previous 2 values.
  339. *> The following four arrays decode JTYPE:
  340. *> KTYPE(j) The general type (1-10) for type "j".
  341. *> KMODE(j) The MODE value to be passed to the matrix
  342. *> generator for type "j".
  343. *> KMAGN(j) The order of magnitude ( O(1),
  344. *> O(overflow^(1/2) ), O(underflow^(1/2) )
  345. *> \endverbatim
  346. *
  347. * Authors:
  348. * ========
  349. *
  350. *> \author Univ. of Tennessee
  351. *> \author Univ. of California Berkeley
  352. *> \author Univ. of Colorado Denver
  353. *> \author NAG Ltd.
  354. *
  355. *> \ingroup double_eig
  356. *
  357. * =====================================================================
  358. SUBROUTINE DDRVSG2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
  359. $ NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
  360. $ BB, AP, BP, WORK, NWORK, IWORK, LIWORK,
  361. $ RESULT, INFO )
  362. *
  363. IMPLICIT NONE
  364. *
  365. * -- LAPACK test routine --
  366. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  367. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  368. *
  369. * .. Scalar Arguments ..
  370. INTEGER INFO, LDA, LDB, LDZ, LIWORK, NOUNIT, NSIZES,
  371. $ NTYPES, NWORK
  372. DOUBLE PRECISION THRESH
  373. * ..
  374. * .. Array Arguments ..
  375. LOGICAL DOTYPE( * )
  376. INTEGER ISEED( 4 ), IWORK( * ), NN( * )
  377. DOUBLE PRECISION A( LDA, * ), AB( LDA, * ), AP( * ),
  378. $ B( LDB, * ), BB( LDB, * ), BP( * ), D( * ),
  379. $ D2( * ), RESULT( * ), WORK( * ), Z( LDZ, * )
  380. * ..
  381. *
  382. * =====================================================================
  383. *
  384. * .. Parameters ..
  385. DOUBLE PRECISION ZERO, ONE, TEN
  386. PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TEN = 10.0D0 )
  387. INTEGER MAXTYP
  388. PARAMETER ( MAXTYP = 21 )
  389. * ..
  390. * .. Local Scalars ..
  391. LOGICAL BADNN
  392. CHARACTER UPLO
  393. INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
  394. $ ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB,
  395. $ KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
  396. $ NTESTT
  397. DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
  398. $ RTUNFL, ULP, ULPINV, UNFL, VL, VU, TEMP1, TEMP2
  399. * ..
  400. * .. Local Arrays ..
  401. INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
  402. $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
  403. $ KTYPE( MAXTYP )
  404. * ..
  405. * .. External Functions ..
  406. LOGICAL LSAME
  407. DOUBLE PRECISION DLAMCH, DLARND
  408. EXTERNAL LSAME, DLAMCH, DLARND
  409. * ..
  410. * .. External Subroutines ..
  411. EXTERNAL DLABAD, DLACPY, DLAFTS, DLASET, DLASUM, DLATMR,
  412. $ DLATMS, DSBGV, DSBGVD, DSBGVX, DSGT01, DSPGV,
  413. $ DSPGVD, DSPGVX, DSYGV, DSYGVD, DSYGVX, XERBLA,
  414. $ DSYGV_2STAGE
  415. * ..
  416. * .. Intrinsic Functions ..
  417. INTRINSIC ABS, DBLE, MAX, MIN, SQRT
  418. * ..
  419. * .. Data statements ..
  420. DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 /
  421. DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
  422. $ 2, 3, 6*1 /
  423. DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
  424. $ 0, 0, 6*4 /
  425. * ..
  426. * .. Executable Statements ..
  427. *
  428. * 1) Check for errors
  429. *
  430. NTESTT = 0
  431. INFO = 0
  432. *
  433. BADNN = .FALSE.
  434. NMAX = 0
  435. DO 10 J = 1, NSIZES
  436. NMAX = MAX( NMAX, NN( J ) )
  437. IF( NN( J ).LT.0 )
  438. $ BADNN = .TRUE.
  439. 10 CONTINUE
  440. *
  441. * Check for errors
  442. *
  443. IF( NSIZES.LT.0 ) THEN
  444. INFO = -1
  445. ELSE IF( BADNN ) THEN
  446. INFO = -2
  447. ELSE IF( NTYPES.LT.0 ) THEN
  448. INFO = -3
  449. ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
  450. INFO = -9
  451. ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN
  452. INFO = -16
  453. ELSE IF( 2*MAX( NMAX, 3 )**2.GT.NWORK ) THEN
  454. INFO = -21
  455. ELSE IF( 2*MAX( NMAX, 3 )**2.GT.LIWORK ) THEN
  456. INFO = -23
  457. END IF
  458. *
  459. IF( INFO.NE.0 ) THEN
  460. CALL XERBLA( 'DDRVSG2STG', -INFO )
  461. RETURN
  462. END IF
  463. *
  464. * Quick return if possible
  465. *
  466. IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
  467. $ RETURN
  468. *
  469. * More Important constants
  470. *
  471. UNFL = DLAMCH( 'Safe minimum' )
  472. OVFL = DLAMCH( 'Overflow' )
  473. CALL DLABAD( UNFL, OVFL )
  474. ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
  475. ULPINV = ONE / ULP
  476. RTUNFL = SQRT( UNFL )
  477. RTOVFL = SQRT( OVFL )
  478. *
  479. DO 20 I = 1, 4
  480. ISEED2( I ) = ISEED( I )
  481. 20 CONTINUE
  482. *
  483. * Loop over sizes, types
  484. *
  485. NERRS = 0
  486. NMATS = 0
  487. *
  488. DO 650 JSIZE = 1, NSIZES
  489. N = NN( JSIZE )
  490. ANINV = ONE / DBLE( MAX( 1, N ) )
  491. *
  492. IF( NSIZES.NE.1 ) THEN
  493. MTYPES = MIN( MAXTYP, NTYPES )
  494. ELSE
  495. MTYPES = MIN( MAXTYP+1, NTYPES )
  496. END IF
  497. *
  498. KA9 = 0
  499. KB9 = 0
  500. DO 640 JTYPE = 1, MTYPES
  501. IF( .NOT.DOTYPE( JTYPE ) )
  502. $ GO TO 640
  503. NMATS = NMATS + 1
  504. NTEST = 0
  505. *
  506. DO 30 J = 1, 4
  507. IOLDSD( J ) = ISEED( J )
  508. 30 CONTINUE
  509. *
  510. * 2) Compute "A"
  511. *
  512. * Control parameters:
  513. *
  514. * KMAGN KMODE KTYPE
  515. * =1 O(1) clustered 1 zero
  516. * =2 large clustered 2 identity
  517. * =3 small exponential (none)
  518. * =4 arithmetic diagonal, w/ eigenvalues
  519. * =5 random log hermitian, w/ eigenvalues
  520. * =6 random (none)
  521. * =7 random diagonal
  522. * =8 random hermitian
  523. * =9 banded, w/ eigenvalues
  524. *
  525. IF( MTYPES.GT.MAXTYP )
  526. $ GO TO 90
  527. *
  528. ITYPE = KTYPE( JTYPE )
  529. IMODE = KMODE( JTYPE )
  530. *
  531. * Compute norm
  532. *
  533. GO TO ( 40, 50, 60 )KMAGN( JTYPE )
  534. *
  535. 40 CONTINUE
  536. ANORM = ONE
  537. GO TO 70
  538. *
  539. 50 CONTINUE
  540. ANORM = ( RTOVFL*ULP )*ANINV
  541. GO TO 70
  542. *
  543. 60 CONTINUE
  544. ANORM = RTUNFL*N*ULPINV
  545. GO TO 70
  546. *
  547. 70 CONTINUE
  548. *
  549. IINFO = 0
  550. COND = ULPINV
  551. *
  552. * Special Matrices -- Identity & Jordan block
  553. *
  554. IF( ITYPE.EQ.1 ) THEN
  555. *
  556. * Zero
  557. *
  558. KA = 0
  559. KB = 0
  560. CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
  561. *
  562. ELSE IF( ITYPE.EQ.2 ) THEN
  563. *
  564. * Identity
  565. *
  566. KA = 0
  567. KB = 0
  568. CALL DLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
  569. DO 80 JCOL = 1, N
  570. A( JCOL, JCOL ) = ANORM
  571. 80 CONTINUE
  572. *
  573. ELSE IF( ITYPE.EQ.4 ) THEN
  574. *
  575. * Diagonal Matrix, [Eigen]values Specified
  576. *
  577. KA = 0
  578. KB = 0
  579. CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
  580. $ ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),
  581. $ IINFO )
  582. *
  583. ELSE IF( ITYPE.EQ.5 ) THEN
  584. *
  585. * symmetric, eigenvalues specified
  586. *
  587. KA = MAX( 0, N-1 )
  588. KB = KA
  589. CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
  590. $ ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
  591. $ IINFO )
  592. *
  593. ELSE IF( ITYPE.EQ.7 ) THEN
  594. *
  595. * Diagonal, random eigenvalues
  596. *
  597. KA = 0
  598. KB = 0
  599. CALL DLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
  600. $ 'T', 'N', WORK( N+1 ), 1, ONE,
  601. $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
  602. $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
  603. *
  604. ELSE IF( ITYPE.EQ.8 ) THEN
  605. *
  606. * symmetric, random eigenvalues
  607. *
  608. KA = MAX( 0, N-1 )
  609. KB = KA
  610. CALL DLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, ONE,
  611. $ 'T', 'N', WORK( N+1 ), 1, ONE,
  612. $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
  613. $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
  614. *
  615. ELSE IF( ITYPE.EQ.9 ) THEN
  616. *
  617. * symmetric banded, eigenvalues specified
  618. *
  619. * The following values are used for the half-bandwidths:
  620. *
  621. * ka = 1 kb = 1
  622. * ka = 2 kb = 1
  623. * ka = 2 kb = 2
  624. * ka = 3 kb = 1
  625. * ka = 3 kb = 2
  626. * ka = 3 kb = 3
  627. *
  628. KB9 = KB9 + 1
  629. IF( KB9.GT.KA9 ) THEN
  630. KA9 = KA9 + 1
  631. KB9 = 1
  632. END IF
  633. KA = MAX( 0, MIN( N-1, KA9 ) )
  634. KB = MAX( 0, MIN( N-1, KB9 ) )
  635. CALL DLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
  636. $ ANORM, KA, KA, 'N', A, LDA, WORK( N+1 ),
  637. $ IINFO )
  638. *
  639. ELSE
  640. *
  641. IINFO = 1
  642. END IF
  643. *
  644. IF( IINFO.NE.0 ) THEN
  645. WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
  646. $ IOLDSD
  647. INFO = ABS( IINFO )
  648. RETURN
  649. END IF
  650. *
  651. 90 CONTINUE
  652. *
  653. ABSTOL = UNFL + UNFL
  654. IF( N.LE.1 ) THEN
  655. IL = 1
  656. IU = N
  657. ELSE
  658. IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
  659. IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
  660. IF( IL.GT.IU ) THEN
  661. ITEMP = IL
  662. IL = IU
  663. IU = ITEMP
  664. END IF
  665. END IF
  666. *
  667. * 3) Call DSYGV, DSPGV, DSBGV, SSYGVD, SSPGVD, SSBGVD,
  668. * DSYGVX, DSPGVX, and DSBGVX, do tests.
  669. *
  670. * loop over the three generalized problems
  671. * IBTYPE = 1: A*x = (lambda)*B*x
  672. * IBTYPE = 2: A*B*x = (lambda)*x
  673. * IBTYPE = 3: B*A*x = (lambda)*x
  674. *
  675. DO 630 IBTYPE = 1, 3
  676. *
  677. * loop over the setting UPLO
  678. *
  679. DO 620 IBUPLO = 1, 2
  680. IF( IBUPLO.EQ.1 )
  681. $ UPLO = 'U'
  682. IF( IBUPLO.EQ.2 )
  683. $ UPLO = 'L'
  684. *
  685. * Generate random well-conditioned positive definite
  686. * matrix B, of bandwidth not greater than that of A.
  687. *
  688. CALL DLATMS( N, N, 'U', ISEED, 'P', WORK, 5, TEN, ONE,
  689. $ KB, KB, UPLO, B, LDB, WORK( N+1 ),
  690. $ IINFO )
  691. *
  692. * Test DSYGV
  693. *
  694. NTEST = NTEST + 1
  695. *
  696. CALL DLACPY( ' ', N, N, A, LDA, Z, LDZ )
  697. CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
  698. *
  699. CALL DSYGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
  700. $ WORK, NWORK, IINFO )
  701. IF( IINFO.NE.0 ) THEN
  702. WRITE( NOUNIT, FMT = 9999 )'DSYGV(V,' // UPLO //
  703. $ ')', IINFO, N, JTYPE, IOLDSD
  704. INFO = ABS( IINFO )
  705. IF( IINFO.LT.0 ) THEN
  706. RETURN
  707. ELSE
  708. RESULT( NTEST ) = ULPINV
  709. GO TO 100
  710. END IF
  711. END IF
  712. *
  713. * Do Test
  714. *
  715. CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  716. $ LDZ, D, WORK, RESULT( NTEST ) )
  717. *
  718. * Test DSYGV_2STAGE
  719. *
  720. NTEST = NTEST + 1
  721. *
  722. CALL DLACPY( ' ', N, N, A, LDA, Z, LDZ )
  723. CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
  724. *
  725. CALL DSYGV_2STAGE( IBTYPE, 'N', UPLO, N, Z, LDZ,
  726. $ BB, LDB, D2, WORK, NWORK, IINFO )
  727. IF( IINFO.NE.0 ) THEN
  728. WRITE( NOUNIT, FMT = 9999 )
  729. $ 'DSYGV_2STAGE(V,' // UPLO //
  730. $ ')', IINFO, N, JTYPE, IOLDSD
  731. INFO = ABS( IINFO )
  732. IF( IINFO.LT.0 ) THEN
  733. RETURN
  734. ELSE
  735. RESULT( NTEST ) = ULPINV
  736. GO TO 100
  737. END IF
  738. END IF
  739. *
  740. * Do Test
  741. *
  742. C CALL DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  743. C $ LDZ, D, WORK, RESULT( NTEST ) )
  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 DSYGVD
  761. *
  762. NTEST = NTEST + 1
  763. *
  764. CALL DLACPY( ' ', N, N, A, LDA, Z, LDZ )
  765. CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
  766. *
  767. CALL DSYGVD( 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 )'DSYGVD(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 DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  784. $ LDZ, D, WORK, RESULT( NTEST ) )
  785. *
  786. * Test DSYGVX
  787. *
  788. NTEST = NTEST + 1
  789. *
  790. CALL DLACPY( ' ', N, N, A, LDA, AB, LDA )
  791. CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
  792. *
  793. CALL DSYGVX( 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 )'DSYGVX(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 DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  812. $ LDZ, D, WORK, RESULT( NTEST ) )
  813. *
  814. NTEST = NTEST + 1
  815. *
  816. CALL DLACPY( ' ', N, N, A, LDA, AB, LDA )
  817. CALL DLACPY( 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 DSYGVX( 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 )'DSYGVX(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 DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  845. $ LDZ, D, WORK, RESULT( NTEST ) )
  846. *
  847. NTEST = NTEST + 1
  848. *
  849. CALL DLACPY( ' ', N, N, A, LDA, AB, LDA )
  850. CALL DLACPY( UPLO, N, N, B, LDB, BB, LDB )
  851. *
  852. CALL DSYGVX( 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 )'DSYGVX(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 DSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
  871. $ LDZ, D, WORK, RESULT( NTEST ) )
  872. *
  873. 100 CONTINUE
  874. *
  875. * Test DSPGV
  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 DSPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
  902. $ WORK, IINFO )
  903. IF( IINFO.NE.0 ) THEN
  904. WRITE( NOUNIT, FMT = 9999 )'DSPGV(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 DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  918. $ LDZ, D, WORK, RESULT( NTEST ) )
  919. *
  920. * Test DSPGVD
  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 DSPGVD( 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 )'DSPGVD(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 DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  963. $ LDZ, D, WORK, RESULT( NTEST ) )
  964. *
  965. * Test DSPGVX
  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 DSPGVX( 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 )'DSPGVX(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 DSGT01( 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 DSPGVX( 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 )'DSPGVX(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 DSGT01( 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 DSPGVX( 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 )'DSPGVX(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 DSGT01( 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 DSBGV
  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 DSBGV( '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 )'DSBGV(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 DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  1148. $ LDZ, D, WORK, RESULT( NTEST ) )
  1149. *
  1150. * TEST DSBGVD
  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 DSBGVD( '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 )'DSBGVD(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 DSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
  1194. $ LDZ, D, WORK, RESULT( NTEST ) )
  1195. *
  1196. * Test DSBGVX
  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 DSBGVX( '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 )'DSBGVX(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 DSGT01( 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 DSBGVX( '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 )'DSBGVX(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 DSGT01( 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 DSBGVX( '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 )'DSBGVX(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 DSGT01( 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 DLAFTS( 'DSG', N, N, JTYPE, NTEST, RESULT, IOLDSD,
  1345. $ THRESH, NOUNIT, NERRS )
  1346. 640 CONTINUE
  1347. 650 CONTINUE
  1348. *
  1349. * Summary
  1350. *
  1351. CALL DLASUM( 'DSG', NOUNIT, NERRS, NTESTT )
  1352. *
  1353. RETURN
  1354. *
  1355. * End of DDRVSG2STG
  1356. *
  1357. 9999 FORMAT( ' DDRVSG2STG: ', A, ' returned INFO=', I6, '.', / 9X,
  1358. $ 'N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
  1359. END