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.

zdrvst2stg.f 76 kB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111
  1. *> \brief \b ZDRVST2STG
  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 ZDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
  12. * NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U,
  13. * LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK,
  14. * IWORK, LIWORK, RESULT, INFO )
  15. *
  16. * .. Scalar Arguments ..
  17. * INTEGER INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
  18. * $ NSIZES, NTYPES
  19. * DOUBLE PRECISION THRESH
  20. * ..
  21. * .. Array Arguments ..
  22. * LOGICAL DOTYPE( * )
  23. * INTEGER ISEED( 4 ), IWORK( * ), NN( * )
  24. * DOUBLE PRECISION D1( * ), D2( * ), D3( * ), RESULT( * ),
  25. * $ RWORK( * ), WA1( * ), WA2( * ), WA3( * )
  26. * COMPLEX*16 A( LDA, * ), TAU( * ), U( LDU, * ),
  27. * $ V( LDU, * ), WORK( * ), Z( LDU, * )
  28. * ..
  29. *
  30. *
  31. *> \par Purpose:
  32. * =============
  33. *>
  34. *> \verbatim
  35. *>
  36. *> ZDRVST2STG checks the Hermitian eigenvalue problem drivers.
  37. *>
  38. *> ZHEEVD computes all eigenvalues and, optionally,
  39. *> eigenvectors of a complex Hermitian matrix,
  40. *> using a divide-and-conquer algorithm.
  41. *>
  42. *> ZHEEVX computes selected eigenvalues and, optionally,
  43. *> eigenvectors of a complex Hermitian matrix.
  44. *>
  45. *> ZHEEVR computes selected eigenvalues and, optionally,
  46. *> eigenvectors of a complex Hermitian matrix
  47. *> using the Relatively Robust Representation where it can.
  48. *>
  49. *> ZHPEVD computes all eigenvalues and, optionally,
  50. *> eigenvectors of a complex Hermitian matrix in packed
  51. *> storage, using a divide-and-conquer algorithm.
  52. *>
  53. *> ZHPEVX computes selected eigenvalues and, optionally,
  54. *> eigenvectors of a complex Hermitian matrix in packed
  55. *> storage.
  56. *>
  57. *> ZHBEVD computes all eigenvalues and, optionally,
  58. *> eigenvectors of a complex Hermitian band matrix,
  59. *> using a divide-and-conquer algorithm.
  60. *>
  61. *> ZHBEVX computes selected eigenvalues and, optionally,
  62. *> eigenvectors of a complex Hermitian band matrix.
  63. *>
  64. *> ZHEEV computes all eigenvalues and, optionally,
  65. *> eigenvectors of a complex Hermitian matrix.
  66. *>
  67. *> ZHPEV computes all eigenvalues and, optionally,
  68. *> eigenvectors of a complex Hermitian matrix in packed
  69. *> storage.
  70. *>
  71. *> ZHBEV computes all eigenvalues and, optionally,
  72. *> eigenvectors of a complex Hermitian band matrix.
  73. *>
  74. *> When ZDRVST2STG is called, a number of matrix "sizes" ("n's") and a
  75. *> number of matrix "types" are specified. For each size ("n")
  76. *> and each type of matrix, one matrix will be generated and used
  77. *> to test the appropriate drivers. For each matrix and each
  78. *> driver routine called, the following tests will be performed:
  79. *>
  80. *> (1) | A - Z D Z' | / ( |A| n ulp )
  81. *>
  82. *> (2) | I - Z Z' | / ( n ulp )
  83. *>
  84. *> (3) | D1 - D2 | / ( |D1| ulp )
  85. *>
  86. *> where Z is the matrix of eigenvectors returned when the
  87. *> eigenvector option is given and D1 and D2 are the eigenvalues
  88. *> returned with and without the eigenvector option.
  89. *>
  90. *> The "sizes" are specified by an array NN(1:NSIZES); the value of
  91. *> each element NN(j) specifies one size.
  92. *> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
  93. *> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
  94. *> Currently, the list of possible types is:
  95. *>
  96. *> (1) The zero matrix.
  97. *> (2) The identity matrix.
  98. *>
  99. *> (3) A diagonal matrix with evenly spaced entries
  100. *> 1, ..., ULP and random signs.
  101. *> (ULP = (first number larger than 1) - 1 )
  102. *> (4) A diagonal matrix with geometrically spaced entries
  103. *> 1, ..., ULP and random signs.
  104. *> (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
  105. *> and random signs.
  106. *>
  107. *> (6) Same as (4), but multiplied by SQRT( overflow threshold )
  108. *> (7) Same as (4), but multiplied by SQRT( underflow threshold )
  109. *>
  110. *> (8) A matrix of the form U* D U, where U is unitary and
  111. *> D has evenly spaced entries 1, ..., ULP with random signs
  112. *> on the diagonal.
  113. *>
  114. *> (9) A matrix of the form U* D U, where U is unitary and
  115. *> D has geometrically spaced entries 1, ..., ULP with random
  116. *> signs on the diagonal.
  117. *>
  118. *> (10) A matrix of the form U* D U, where U is unitary and
  119. *> D has "clustered" entries 1, ULP,..., ULP with random
  120. *> signs on the diagonal.
  121. *>
  122. *> (11) Same as (8), but multiplied by SQRT( overflow threshold )
  123. *> (12) Same as (8), but multiplied by SQRT( underflow threshold )
  124. *>
  125. *> (13) Symmetric matrix with random entries chosen from (-1,1).
  126. *> (14) Same as (13), but multiplied by SQRT( overflow threshold )
  127. *> (15) Same as (13), but multiplied by SQRT( underflow threshold )
  128. *> (16) A band matrix with half bandwidth randomly chosen between
  129. *> 0 and N-1, with evenly spaced eigenvalues 1, ..., ULP
  130. *> with random signs.
  131. *> (17) Same as (16), but multiplied by SQRT( overflow threshold )
  132. *> (18) Same as (16), but multiplied by SQRT( underflow threshold )
  133. *> \endverbatim
  134. *
  135. * Arguments:
  136. * ==========
  137. *
  138. *> \verbatim
  139. *> NSIZES INTEGER
  140. *> The number of sizes of matrices to use. If it is zero,
  141. *> ZDRVST2STG does nothing. It must be at least zero.
  142. *> Not modified.
  143. *>
  144. *> NN INTEGER array, dimension (NSIZES)
  145. *> An array containing the sizes to be used for the matrices.
  146. *> Zero values will be skipped. The values must be at least
  147. *> zero.
  148. *> Not modified.
  149. *>
  150. *> NTYPES INTEGER
  151. *> The number of elements in DOTYPE. If it is zero, ZDRVST2STG
  152. *> does nothing. It must be at least zero. If it is MAXTYP+1
  153. *> and NSIZES is 1, then an additional type, MAXTYP+1 is
  154. *> defined, which is to use whatever matrix is in A. This
  155. *> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
  156. *> DOTYPE(MAXTYP+1) is .TRUE. .
  157. *> Not modified.
  158. *>
  159. *> DOTYPE LOGICAL array, dimension (NTYPES)
  160. *> If DOTYPE(j) is .TRUE., then for each size in NN a
  161. *> matrix of that size and of type j will be generated.
  162. *> If NTYPES is smaller than the maximum number of types
  163. *> defined (PARAMETER MAXTYP), then types NTYPES+1 through
  164. *> MAXTYP will not be generated. If NTYPES is larger
  165. *> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
  166. *> will be ignored.
  167. *> Not modified.
  168. *>
  169. *> ISEED INTEGER array, dimension (4)
  170. *> On entry ISEED specifies the seed of the random number
  171. *> generator. The array elements should be between 0 and 4095;
  172. *> if not they will be reduced mod 4096. Also, ISEED(4) must
  173. *> be odd. The random number generator uses a linear
  174. *> congruential sequence limited to small integers, and so
  175. *> should produce machine independent random numbers. The
  176. *> values of ISEED are changed on exit, and can be used in the
  177. *> next call to ZDRVST2STG to continue the same random number
  178. *> sequence.
  179. *> Modified.
  180. *>
  181. *> THRESH DOUBLE PRECISION
  182. *> A test will count as "failed" if the "error", computed as
  183. *> described above, exceeds THRESH. Note that the error
  184. *> is scaled to be O(1), so THRESH should be a reasonably
  185. *> small multiple of 1, e.g., 10 or 100. In particular,
  186. *> it should not depend on the precision (single vs. double)
  187. *> or the size of the matrix. It must be at least zero.
  188. *> Not modified.
  189. *>
  190. *> NOUNIT INTEGER
  191. *> The FORTRAN unit number for printing out error messages
  192. *> (e.g., if a routine returns IINFO not equal to 0.)
  193. *> Not modified.
  194. *>
  195. *> A COMPLEX*16 array, dimension (LDA , max(NN))
  196. *> Used to hold the matrix whose eigenvalues are to be
  197. *> computed. On exit, A contains the last matrix actually
  198. *> used.
  199. *> Modified.
  200. *>
  201. *> LDA INTEGER
  202. *> The leading dimension of A. It must be at
  203. *> least 1 and at least max( NN ).
  204. *> Not modified.
  205. *>
  206. *> D1 DOUBLE PRECISION array, dimension (max(NN))
  207. *> The eigenvalues of A, as computed by ZSTEQR simultaneously
  208. *> with Z. On exit, the eigenvalues in D1 correspond with the
  209. *> matrix in A.
  210. *> Modified.
  211. *>
  212. *> D2 DOUBLE PRECISION array, dimension (max(NN))
  213. *> The eigenvalues of A, as computed by ZSTEQR if Z is not
  214. *> computed. On exit, the eigenvalues in D2 correspond with
  215. *> the matrix in A.
  216. *> Modified.
  217. *>
  218. *> D3 DOUBLE PRECISION array, dimension (max(NN))
  219. *> The eigenvalues of A, as computed by DSTERF. On exit, the
  220. *> eigenvalues in D3 correspond with the matrix in A.
  221. *> Modified.
  222. *>
  223. *> WA1 DOUBLE PRECISION array, dimension
  224. *>
  225. *> WA2 DOUBLE PRECISION array, dimension
  226. *>
  227. *> WA3 DOUBLE PRECISION array, dimension
  228. *>
  229. *> U COMPLEX*16 array, dimension (LDU, max(NN))
  230. *> The unitary matrix computed by ZHETRD + ZUNGC3.
  231. *> Modified.
  232. *>
  233. *> LDU INTEGER
  234. *> The leading dimension of U, Z, and V. It must be at
  235. *> least 1 and at least max( NN ).
  236. *> Not modified.
  237. *>
  238. *> V COMPLEX*16 array, dimension (LDU, max(NN))
  239. *> The Housholder vectors computed by ZHETRD in reducing A to
  240. *> tridiagonal form.
  241. *> Modified.
  242. *>
  243. *> TAU COMPLEX*16 array, dimension (max(NN))
  244. *> The Householder factors computed by ZHETRD in reducing A
  245. *> to tridiagonal form.
  246. *> Modified.
  247. *>
  248. *> Z COMPLEX*16 array, dimension (LDU, max(NN))
  249. *> The unitary matrix of eigenvectors computed by ZHEEVD,
  250. *> ZHEEVX, ZHPEVD, CHPEVX, ZHBEVD, and CHBEVX.
  251. *> Modified.
  252. *>
  253. *> WORK - COMPLEX*16 array of dimension ( LWORK )
  254. *> Workspace.
  255. *> Modified.
  256. *>
  257. *> LWORK - INTEGER
  258. *> The number of entries in WORK. This must be at least
  259. *> 2*max( NN(j), 2 )**2.
  260. *> Not modified.
  261. *>
  262. *> RWORK DOUBLE PRECISION array, dimension (3*max(NN))
  263. *> Workspace.
  264. *> Modified.
  265. *>
  266. *> LRWORK - INTEGER
  267. *> The number of entries in RWORK.
  268. *>
  269. *> IWORK INTEGER array, dimension (6*max(NN))
  270. *> Workspace.
  271. *> Modified.
  272. *>
  273. *> LIWORK - INTEGER
  274. *> The number of entries in IWORK.
  275. *>
  276. *> RESULT DOUBLE PRECISION array, dimension (??)
  277. *> The values computed by the tests described above.
  278. *> The values are currently limited to 1/ulp, to avoid
  279. *> overflow.
  280. *> Modified.
  281. *>
  282. *> INFO INTEGER
  283. *> If 0, then everything ran OK.
  284. *> -1: NSIZES < 0
  285. *> -2: Some NN(j) < 0
  286. *> -3: NTYPES < 0
  287. *> -5: THRESH < 0
  288. *> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
  289. *> -16: LDU < 1 or LDU < NMAX.
  290. *> -21: LWORK too small.
  291. *> If DLATMR, SLATMS, ZHETRD, DORGC3, ZSTEQR, DSTERF,
  292. *> or DORMC2 returns an error code, the
  293. *> absolute value of it is returned.
  294. *> Modified.
  295. *>
  296. *>-----------------------------------------------------------------------
  297. *>
  298. *> Some Local Variables and Parameters:
  299. *> ---- ----- --------- --- ----------
  300. *> ZERO, ONE Real 0 and 1.
  301. *> MAXTYP The number of types defined.
  302. *> NTEST The number of tests performed, or which can
  303. *> be performed so far, for the current matrix.
  304. *> NTESTT The total number of tests performed so far.
  305. *> NMAX Largest value in NN.
  306. *> NMATS The number of matrices generated so far.
  307. *> NERRS The number of tests which have exceeded THRESH
  308. *> so far (computed by DLAFTS).
  309. *> COND, IMODE Values to be passed to the matrix generators.
  310. *> ANORM Norm of A; passed to matrix generators.
  311. *>
  312. *> OVFL, UNFL Overflow and underflow thresholds.
  313. *> ULP, ULPINV Finest relative precision and its inverse.
  314. *> RTOVFL, RTUNFL Square roots of the previous 2 values.
  315. *> The following four arrays decode JTYPE:
  316. *> KTYPE(j) The general type (1-10) for type "j".
  317. *> KMODE(j) The MODE value to be passed to the matrix
  318. *> generator for type "j".
  319. *> KMAGN(j) The order of magnitude ( O(1),
  320. *> O(overflow^(1/2) ), O(underflow^(1/2) )
  321. *> \endverbatim
  322. *
  323. * Authors:
  324. * ========
  325. *
  326. *> \author Univ. of Tennessee
  327. *> \author Univ. of California Berkeley
  328. *> \author Univ. of Colorado Denver
  329. *> \author NAG Ltd.
  330. *
  331. *> \ingroup complex16_eig
  332. *
  333. * =====================================================================
  334. SUBROUTINE ZDRVST2STG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
  335. $ NOUNIT, A, LDA, D1, D2, D3, WA1, WA2, WA3, U,
  336. $ LDU, V, TAU, Z, WORK, LWORK, RWORK, LRWORK,
  337. $ IWORK, LIWORK, RESULT, INFO )
  338. *
  339. * -- LAPACK test routine --
  340. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  341. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  342. *
  343. * .. Scalar Arguments ..
  344. INTEGER INFO, LDA, LDU, LIWORK, LRWORK, LWORK, NOUNIT,
  345. $ NSIZES, NTYPES
  346. DOUBLE PRECISION THRESH
  347. * ..
  348. * .. Array Arguments ..
  349. LOGICAL DOTYPE( * )
  350. INTEGER ISEED( 4 ), IWORK( * ), NN( * )
  351. DOUBLE PRECISION D1( * ), D2( * ), D3( * ), RESULT( * ),
  352. $ RWORK( * ), WA1( * ), WA2( * ), WA3( * )
  353. COMPLEX*16 A( LDA, * ), TAU( * ), U( LDU, * ),
  354. $ V( LDU, * ), WORK( * ), Z( LDU, * )
  355. * ..
  356. *
  357. * =====================================================================
  358. *
  359. *
  360. * .. Parameters ..
  361. DOUBLE PRECISION ZERO, ONE, TWO, TEN
  362. PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
  363. $ TEN = 10.0D+0 )
  364. DOUBLE PRECISION HALF
  365. PARAMETER ( HALF = ONE / TWO )
  366. COMPLEX*16 CZERO, CONE
  367. PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
  368. $ CONE = ( 1.0D+0, 0.0D+0 ) )
  369. INTEGER MAXTYP
  370. PARAMETER ( MAXTYP = 18 )
  371. * ..
  372. * .. Local Scalars ..
  373. LOGICAL BADNN
  374. CHARACTER UPLO
  375. INTEGER I, IDIAG, IHBW, IINFO, IL, IMODE, INDWRK, INDX,
  376. $ IROW, ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL,
  377. $ JSIZE, JTYPE, KD, LGN, LIWEDC, LRWEDC, LWEDC,
  378. $ M, M2, M3, MTYPES, N, NERRS, NMATS, NMAX,
  379. $ NTEST, NTESTT
  380. DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
  381. $ RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL,
  382. $ VL, VU
  383. * ..
  384. * .. Local Arrays ..
  385. INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
  386. $ ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
  387. $ KTYPE( MAXTYP )
  388. * ..
  389. * .. External Functions ..
  390. DOUBLE PRECISION DLAMCH, DLARND, DSXT1
  391. EXTERNAL DLAMCH, DLARND, DSXT1
  392. * ..
  393. * .. External Subroutines ..
  394. EXTERNAL ALASVM, DLAFTS, XERBLA, ZHBEV, ZHBEVD,
  395. $ ZHBEVX, ZHEEV, ZHEEVD, ZHEEVR, ZHEEVX, ZHET21,
  396. $ ZHET22, ZHPEV, ZHPEVD, ZHPEVX, ZLACPY, ZLASET,
  397. $ ZHEEVD_2STAGE, ZHEEVR_2STAGE, ZHEEVX_2STAGE,
  398. $ ZHEEV_2STAGE, ZHBEV_2STAGE, ZHBEVD_2STAGE,
  399. $ ZHBEVX_2STAGE, ZHETRD_2STAGE, ZLATMR, ZLATMS
  400. * ..
  401. * .. Intrinsic Functions ..
  402. INTRINSIC ABS, DBLE, INT, LOG, MAX, MIN, SQRT
  403. * ..
  404. * .. Data statements ..
  405. DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 /
  406. DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
  407. $ 2, 3, 1, 2, 3 /
  408. DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
  409. $ 0, 0, 4, 4, 4 /
  410. * ..
  411. * .. Executable Statements ..
  412. *
  413. * 1) Check for errors
  414. *
  415. NTESTT = 0
  416. INFO = 0
  417. *
  418. BADNN = .FALSE.
  419. NMAX = 1
  420. DO 10 J = 1, NSIZES
  421. NMAX = MAX( NMAX, NN( J ) )
  422. IF( NN( J ).LT.0 )
  423. $ BADNN = .TRUE.
  424. 10 CONTINUE
  425. *
  426. * Check for errors
  427. *
  428. IF( NSIZES.LT.0 ) THEN
  429. INFO = -1
  430. ELSE IF( BADNN ) THEN
  431. INFO = -2
  432. ELSE IF( NTYPES.LT.0 ) THEN
  433. INFO = -3
  434. ELSE IF( LDA.LT.NMAX ) THEN
  435. INFO = -9
  436. ELSE IF( LDU.LT.NMAX ) THEN
  437. INFO = -16
  438. ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
  439. INFO = -22
  440. END IF
  441. *
  442. IF( INFO.NE.0 ) THEN
  443. CALL XERBLA( 'ZDRVST2STG', -INFO )
  444. RETURN
  445. END IF
  446. *
  447. * Quick return if nothing to do
  448. *
  449. IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
  450. $ RETURN
  451. *
  452. * More Important constants
  453. *
  454. UNFL = DLAMCH( 'Safe minimum' )
  455. OVFL = DLAMCH( 'Overflow' )
  456. ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
  457. ULPINV = ONE / ULP
  458. RTUNFL = SQRT( UNFL )
  459. RTOVFL = SQRT( OVFL )
  460. *
  461. * Loop over sizes, types
  462. *
  463. DO 20 I = 1, 4
  464. ISEED2( I ) = ISEED( I )
  465. ISEED3( I ) = ISEED( I )
  466. 20 CONTINUE
  467. *
  468. NERRS = 0
  469. NMATS = 0
  470. *
  471. DO 1220 JSIZE = 1, NSIZES
  472. N = NN( JSIZE )
  473. IF( N.GT.0 ) THEN
  474. LGN = INT( LOG( DBLE( N ) ) / LOG( TWO ) )
  475. IF( 2**LGN.LT.N )
  476. $ LGN = LGN + 1
  477. IF( 2**LGN.LT.N )
  478. $ LGN = LGN + 1
  479. LWEDC = MAX( 2*N+N*N, 2*N*N )
  480. LRWEDC = 1 + 4*N + 2*N*LGN + 3*N**2
  481. LIWEDC = 3 + 5*N
  482. ELSE
  483. LWEDC = 2
  484. LRWEDC = 8
  485. LIWEDC = 8
  486. END IF
  487. ANINV = ONE / DBLE( MAX( 1, N ) )
  488. *
  489. IF( NSIZES.NE.1 ) THEN
  490. MTYPES = MIN( MAXTYP, NTYPES )
  491. ELSE
  492. MTYPES = MIN( MAXTYP+1, NTYPES )
  493. END IF
  494. *
  495. DO 1210 JTYPE = 1, MTYPES
  496. IF( .NOT.DOTYPE( JTYPE ) )
  497. $ GO TO 1210
  498. NMATS = NMATS + 1
  499. NTEST = 0
  500. *
  501. DO 30 J = 1, 4
  502. IOLDSD( J ) = ISEED( J )
  503. 30 CONTINUE
  504. *
  505. * 2) Compute "A"
  506. *
  507. * Control parameters:
  508. *
  509. * KMAGN KMODE KTYPE
  510. * =1 O(1) clustered 1 zero
  511. * =2 large clustered 2 identity
  512. * =3 small exponential (none)
  513. * =4 arithmetic diagonal, (w/ eigenvalues)
  514. * =5 random log Hermitian, w/ eigenvalues
  515. * =6 random (none)
  516. * =7 random diagonal
  517. * =8 random Hermitian
  518. * =9 band Hermitian, w/ eigenvalues
  519. *
  520. IF( MTYPES.GT.MAXTYP )
  521. $ GO TO 110
  522. *
  523. ITYPE = KTYPE( JTYPE )
  524. IMODE = KMODE( JTYPE )
  525. *
  526. * Compute norm
  527. *
  528. GO TO ( 40, 50, 60 )KMAGN( JTYPE )
  529. *
  530. 40 CONTINUE
  531. ANORM = ONE
  532. GO TO 70
  533. *
  534. 50 CONTINUE
  535. ANORM = ( RTOVFL*ULP )*ANINV
  536. GO TO 70
  537. *
  538. 60 CONTINUE
  539. ANORM = RTUNFL*N*ULPINV
  540. GO TO 70
  541. *
  542. 70 CONTINUE
  543. *
  544. CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
  545. IINFO = 0
  546. COND = ULPINV
  547. *
  548. * Special Matrices -- Identity & Jordan block
  549. *
  550. * Zero
  551. *
  552. IF( ITYPE.EQ.1 ) THEN
  553. IINFO = 0
  554. *
  555. ELSE IF( ITYPE.EQ.2 ) THEN
  556. *
  557. * Identity
  558. *
  559. DO 80 JCOL = 1, N
  560. A( JCOL, JCOL ) = ANORM
  561. 80 CONTINUE
  562. *
  563. ELSE IF( ITYPE.EQ.4 ) THEN
  564. *
  565. * Diagonal Matrix, [Eigen]values Specified
  566. *
  567. CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
  568. $ ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
  569. *
  570. ELSE IF( ITYPE.EQ.5 ) THEN
  571. *
  572. * Hermitian, eigenvalues specified
  573. *
  574. CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
  575. $ ANORM, N, N, 'N', A, LDA, WORK, IINFO )
  576. *
  577. ELSE IF( ITYPE.EQ.7 ) THEN
  578. *
  579. * Diagonal, random eigenvalues
  580. *
  581. CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
  582. $ 'T', 'N', WORK( N+1 ), 1, ONE,
  583. $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
  584. $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
  585. *
  586. ELSE IF( ITYPE.EQ.8 ) THEN
  587. *
  588. * Hermitian, random eigenvalues
  589. *
  590. CALL ZLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
  591. $ 'T', 'N', WORK( N+1 ), 1, ONE,
  592. $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
  593. $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
  594. *
  595. ELSE IF( ITYPE.EQ.9 ) THEN
  596. *
  597. * Hermitian banded, eigenvalues specified
  598. *
  599. IHBW = INT( ( N-1 )*DLARND( 1, ISEED3 ) )
  600. CALL ZLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
  601. $ ANORM, IHBW, IHBW, 'Z', U, LDU, WORK,
  602. $ IINFO )
  603. *
  604. * Store as dense matrix for most routines.
  605. *
  606. CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
  607. DO 100 IDIAG = -IHBW, IHBW
  608. IROW = IHBW - IDIAG + 1
  609. J1 = MAX( 1, IDIAG+1 )
  610. J2 = MIN( N, N+IDIAG )
  611. DO 90 J = J1, J2
  612. I = J - IDIAG
  613. A( I, J ) = U( IROW, J )
  614. 90 CONTINUE
  615. 100 CONTINUE
  616. ELSE
  617. IINFO = 1
  618. END IF
  619. *
  620. IF( IINFO.NE.0 ) THEN
  621. WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
  622. $ IOLDSD
  623. INFO = ABS( IINFO )
  624. RETURN
  625. END IF
  626. *
  627. 110 CONTINUE
  628. *
  629. ABSTOL = UNFL + UNFL
  630. IF( N.LE.1 ) THEN
  631. IL = 1
  632. IU = N
  633. ELSE
  634. IL = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
  635. IU = 1 + INT( ( N-1 )*DLARND( 1, ISEED2 ) )
  636. IF( IL.GT.IU ) THEN
  637. ITEMP = IL
  638. IL = IU
  639. IU = ITEMP
  640. END IF
  641. END IF
  642. *
  643. * Perform tests storing upper or lower triangular
  644. * part of matrix.
  645. *
  646. DO 1200 IUPLO = 0, 1
  647. IF( IUPLO.EQ.0 ) THEN
  648. UPLO = 'L'
  649. ELSE
  650. UPLO = 'U'
  651. END IF
  652. *
  653. * Call ZHEEVD and CHEEVX.
  654. *
  655. CALL ZLACPY( ' ', N, N, A, LDA, V, LDU )
  656. *
  657. NTEST = NTEST + 1
  658. CALL ZHEEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC,
  659. $ RWORK, LRWEDC, IWORK, LIWEDC, IINFO )
  660. IF( IINFO.NE.0 ) THEN
  661. WRITE( NOUNIT, FMT = 9999 )'ZHEEVD(V,' // UPLO //
  662. $ ')', IINFO, N, JTYPE, IOLDSD
  663. INFO = ABS( IINFO )
  664. IF( IINFO.LT.0 ) THEN
  665. RETURN
  666. ELSE
  667. RESULT( NTEST ) = ULPINV
  668. RESULT( NTEST+1 ) = ULPINV
  669. RESULT( NTEST+2 ) = ULPINV
  670. GO TO 130
  671. END IF
  672. END IF
  673. *
  674. * Do tests 1 and 2.
  675. *
  676. CALL ZHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
  677. $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  678. *
  679. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  680. *
  681. NTEST = NTEST + 2
  682. CALL ZHEEVD_2STAGE( 'N', UPLO, N, A, LDU, D3, WORK,
  683. $ LWORK, RWORK, LRWEDC, IWORK, LIWEDC, IINFO )
  684. IF( IINFO.NE.0 ) THEN
  685. WRITE( NOUNIT, FMT = 9999 )
  686. $ 'ZHEEVD_2STAGE(N,' // UPLO //
  687. $ ')', IINFO, N, JTYPE, IOLDSD
  688. INFO = ABS( IINFO )
  689. IF( IINFO.LT.0 ) THEN
  690. RETURN
  691. ELSE
  692. RESULT( NTEST ) = ULPINV
  693. GO TO 130
  694. END IF
  695. END IF
  696. *
  697. * Do test 3.
  698. *
  699. TEMP1 = ZERO
  700. TEMP2 = ZERO
  701. DO 120 J = 1, N
  702. TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
  703. TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
  704. 120 CONTINUE
  705. RESULT( NTEST ) = TEMP2 / MAX( UNFL,
  706. $ ULP*MAX( TEMP1, TEMP2 ) )
  707. *
  708. 130 CONTINUE
  709. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  710. *
  711. NTEST = NTEST + 1
  712. *
  713. IF( N.GT.0 ) THEN
  714. TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
  715. IF( IL.NE.1 ) THEN
  716. VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
  717. $ TEN*ULP*TEMP3, TEN*RTUNFL )
  718. ELSE IF( N.GT.0 ) THEN
  719. VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
  720. $ TEN*ULP*TEMP3, TEN*RTUNFL )
  721. END IF
  722. IF( IU.NE.N ) THEN
  723. VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
  724. $ TEN*ULP*TEMP3, TEN*RTUNFL )
  725. ELSE IF( N.GT.0 ) THEN
  726. VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
  727. $ TEN*ULP*TEMP3, TEN*RTUNFL )
  728. END IF
  729. ELSE
  730. TEMP3 = ZERO
  731. VL = ZERO
  732. VU = ONE
  733. END IF
  734. *
  735. CALL ZHEEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
  736. $ ABSTOL, M, WA1, Z, LDU, WORK, LWORK, RWORK,
  737. $ IWORK, IWORK( 5*N+1 ), IINFO )
  738. IF( IINFO.NE.0 ) THEN
  739. WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(V,A,' // UPLO //
  740. $ ')', IINFO, N, JTYPE, IOLDSD
  741. INFO = ABS( IINFO )
  742. IF( IINFO.LT.0 ) THEN
  743. RETURN
  744. ELSE
  745. RESULT( NTEST ) = ULPINV
  746. RESULT( NTEST+1 ) = ULPINV
  747. RESULT( NTEST+2 ) = ULPINV
  748. GO TO 150
  749. END IF
  750. END IF
  751. *
  752. * Do tests 4 and 5.
  753. *
  754. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  755. *
  756. CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
  757. $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  758. *
  759. NTEST = NTEST + 2
  760. CALL ZHEEVX_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU,
  761. $ IL, IU, ABSTOL, M2, WA2, Z, LDU,
  762. $ WORK, LWORK, RWORK, IWORK,
  763. $ IWORK( 5*N+1 ), IINFO )
  764. IF( IINFO.NE.0 ) THEN
  765. WRITE( NOUNIT, FMT = 9999 )
  766. $ 'ZHEEVX_2STAGE(N,A,' // UPLO //
  767. $ ')', IINFO, N, JTYPE, IOLDSD
  768. INFO = ABS( IINFO )
  769. IF( IINFO.LT.0 ) THEN
  770. RETURN
  771. ELSE
  772. RESULT( NTEST ) = ULPINV
  773. GO TO 150
  774. END IF
  775. END IF
  776. *
  777. * Do test 6.
  778. *
  779. TEMP1 = ZERO
  780. TEMP2 = ZERO
  781. DO 140 J = 1, N
  782. TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
  783. TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
  784. 140 CONTINUE
  785. RESULT( NTEST ) = TEMP2 / MAX( UNFL,
  786. $ ULP*MAX( TEMP1, TEMP2 ) )
  787. *
  788. 150 CONTINUE
  789. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  790. *
  791. NTEST = NTEST + 1
  792. *
  793. CALL ZHEEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
  794. $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK,
  795. $ IWORK, IWORK( 5*N+1 ), IINFO )
  796. IF( IINFO.NE.0 ) THEN
  797. WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(V,I,' // UPLO //
  798. $ ')', IINFO, N, JTYPE, IOLDSD
  799. INFO = ABS( IINFO )
  800. IF( IINFO.LT.0 ) THEN
  801. RETURN
  802. ELSE
  803. RESULT( NTEST ) = ULPINV
  804. GO TO 160
  805. END IF
  806. END IF
  807. *
  808. * Do tests 7 and 8.
  809. *
  810. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  811. *
  812. CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
  813. $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  814. *
  815. NTEST = NTEST + 2
  816. *
  817. CALL ZHEEVX_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU,
  818. $ IL, IU, ABSTOL, M3, WA3, Z, LDU,
  819. $ WORK, LWORK, RWORK, IWORK,
  820. $ IWORK( 5*N+1 ), IINFO )
  821. IF( IINFO.NE.0 ) THEN
  822. WRITE( NOUNIT, FMT = 9999 )
  823. $ 'ZHEEVX_2STAGE(N,I,' // UPLO //
  824. $ ')', IINFO, N, JTYPE, IOLDSD
  825. INFO = ABS( IINFO )
  826. IF( IINFO.LT.0 ) THEN
  827. RETURN
  828. ELSE
  829. RESULT( NTEST ) = ULPINV
  830. GO TO 160
  831. END IF
  832. END IF
  833. *
  834. * Do test 9.
  835. *
  836. TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
  837. TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
  838. IF( N.GT.0 ) THEN
  839. TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
  840. ELSE
  841. TEMP3 = ZERO
  842. END IF
  843. RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
  844. $ MAX( UNFL, TEMP3*ULP )
  845. *
  846. 160 CONTINUE
  847. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  848. *
  849. NTEST = NTEST + 1
  850. *
  851. CALL ZHEEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
  852. $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, RWORK,
  853. $ IWORK, IWORK( 5*N+1 ), IINFO )
  854. IF( IINFO.NE.0 ) THEN
  855. WRITE( NOUNIT, FMT = 9999 )'ZHEEVX(V,V,' // UPLO //
  856. $ ')', IINFO, N, JTYPE, IOLDSD
  857. INFO = ABS( IINFO )
  858. IF( IINFO.LT.0 ) THEN
  859. RETURN
  860. ELSE
  861. RESULT( NTEST ) = ULPINV
  862. GO TO 170
  863. END IF
  864. END IF
  865. *
  866. * Do tests 10 and 11.
  867. *
  868. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  869. *
  870. CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
  871. $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  872. *
  873. NTEST = NTEST + 2
  874. *
  875. CALL ZHEEVX_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU,
  876. $ IL, IU, ABSTOL, M3, WA3, Z, LDU,
  877. $ WORK, LWORK, RWORK, IWORK,
  878. $ IWORK( 5*N+1 ), IINFO )
  879. IF( IINFO.NE.0 ) THEN
  880. WRITE( NOUNIT, FMT = 9999 )
  881. $ 'ZHEEVX_2STAGE(N,V,' // UPLO //
  882. $ ')', IINFO, N, JTYPE, IOLDSD
  883. INFO = ABS( IINFO )
  884. IF( IINFO.LT.0 ) THEN
  885. RETURN
  886. ELSE
  887. RESULT( NTEST ) = ULPINV
  888. GO TO 170
  889. END IF
  890. END IF
  891. *
  892. IF( M3.EQ.0 .AND. N.GT.0 ) THEN
  893. RESULT( NTEST ) = ULPINV
  894. GO TO 170
  895. END IF
  896. *
  897. * Do test 12.
  898. *
  899. TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
  900. TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
  901. IF( N.GT.0 ) THEN
  902. TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
  903. ELSE
  904. TEMP3 = ZERO
  905. END IF
  906. RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
  907. $ MAX( UNFL, TEMP3*ULP )
  908. *
  909. 170 CONTINUE
  910. *
  911. * Call ZHPEVD and CHPEVX.
  912. *
  913. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  914. *
  915. * Load array WORK with the upper or lower triangular
  916. * part of the matrix in packed form.
  917. *
  918. IF( IUPLO.EQ.1 ) THEN
  919. INDX = 1
  920. DO 190 J = 1, N
  921. DO 180 I = 1, J
  922. WORK( INDX ) = A( I, J )
  923. INDX = INDX + 1
  924. 180 CONTINUE
  925. 190 CONTINUE
  926. ELSE
  927. INDX = 1
  928. DO 210 J = 1, N
  929. DO 200 I = J, N
  930. WORK( INDX ) = A( I, J )
  931. INDX = INDX + 1
  932. 200 CONTINUE
  933. 210 CONTINUE
  934. END IF
  935. *
  936. NTEST = NTEST + 1
  937. INDWRK = N*( N+1 ) / 2 + 1
  938. CALL ZHPEVD( 'V', UPLO, N, WORK, D1, Z, LDU,
  939. $ WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK,
  940. $ LIWEDC, IINFO )
  941. IF( IINFO.NE.0 ) THEN
  942. WRITE( NOUNIT, FMT = 9999 )'ZHPEVD(V,' // UPLO //
  943. $ ')', IINFO, N, JTYPE, IOLDSD
  944. INFO = ABS( IINFO )
  945. IF( IINFO.LT.0 ) THEN
  946. RETURN
  947. ELSE
  948. RESULT( NTEST ) = ULPINV
  949. RESULT( NTEST+1 ) = ULPINV
  950. RESULT( NTEST+2 ) = ULPINV
  951. GO TO 270
  952. END IF
  953. END IF
  954. *
  955. * Do tests 13 and 14.
  956. *
  957. CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
  958. $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  959. *
  960. IF( IUPLO.EQ.1 ) THEN
  961. INDX = 1
  962. DO 230 J = 1, N
  963. DO 220 I = 1, J
  964. WORK( INDX ) = A( I, J )
  965. INDX = INDX + 1
  966. 220 CONTINUE
  967. 230 CONTINUE
  968. ELSE
  969. INDX = 1
  970. DO 250 J = 1, N
  971. DO 240 I = J, N
  972. WORK( INDX ) = A( I, J )
  973. INDX = INDX + 1
  974. 240 CONTINUE
  975. 250 CONTINUE
  976. END IF
  977. *
  978. NTEST = NTEST + 2
  979. INDWRK = N*( N+1 ) / 2 + 1
  980. CALL ZHPEVD( 'N', UPLO, N, WORK, D3, Z, LDU,
  981. $ WORK( INDWRK ), LWEDC, RWORK, LRWEDC, IWORK,
  982. $ LIWEDC, IINFO )
  983. IF( IINFO.NE.0 ) THEN
  984. WRITE( NOUNIT, FMT = 9999 )'ZHPEVD(N,' // UPLO //
  985. $ ')', IINFO, N, JTYPE, IOLDSD
  986. INFO = ABS( IINFO )
  987. IF( IINFO.LT.0 ) THEN
  988. RETURN
  989. ELSE
  990. RESULT( NTEST ) = ULPINV
  991. GO TO 270
  992. END IF
  993. END IF
  994. *
  995. * Do test 15.
  996. *
  997. TEMP1 = ZERO
  998. TEMP2 = ZERO
  999. DO 260 J = 1, N
  1000. TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
  1001. TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
  1002. 260 CONTINUE
  1003. RESULT( NTEST ) = TEMP2 / MAX( UNFL,
  1004. $ ULP*MAX( TEMP1, TEMP2 ) )
  1005. *
  1006. * Load array WORK with the upper or lower triangular part
  1007. * of the matrix in packed form.
  1008. *
  1009. 270 CONTINUE
  1010. IF( IUPLO.EQ.1 ) THEN
  1011. INDX = 1
  1012. DO 290 J = 1, N
  1013. DO 280 I = 1, J
  1014. WORK( INDX ) = A( I, J )
  1015. INDX = INDX + 1
  1016. 280 CONTINUE
  1017. 290 CONTINUE
  1018. ELSE
  1019. INDX = 1
  1020. DO 310 J = 1, N
  1021. DO 300 I = J, N
  1022. WORK( INDX ) = A( I, J )
  1023. INDX = INDX + 1
  1024. 300 CONTINUE
  1025. 310 CONTINUE
  1026. END IF
  1027. *
  1028. NTEST = NTEST + 1
  1029. *
  1030. IF( N.GT.0 ) THEN
  1031. TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
  1032. IF( IL.NE.1 ) THEN
  1033. VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
  1034. $ TEN*ULP*TEMP3, TEN*RTUNFL )
  1035. ELSE IF( N.GT.0 ) THEN
  1036. VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
  1037. $ TEN*ULP*TEMP3, TEN*RTUNFL )
  1038. END IF
  1039. IF( IU.NE.N ) THEN
  1040. VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
  1041. $ TEN*ULP*TEMP3, TEN*RTUNFL )
  1042. ELSE IF( N.GT.0 ) THEN
  1043. VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
  1044. $ TEN*ULP*TEMP3, TEN*RTUNFL )
  1045. END IF
  1046. ELSE
  1047. TEMP3 = ZERO
  1048. VL = ZERO
  1049. VU = ONE
  1050. END IF
  1051. *
  1052. CALL ZHPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU,
  1053. $ ABSTOL, M, WA1, Z, LDU, V, RWORK, IWORK,
  1054. $ IWORK( 5*N+1 ), IINFO )
  1055. IF( IINFO.NE.0 ) THEN
  1056. WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,A,' // UPLO //
  1057. $ ')', IINFO, N, JTYPE, IOLDSD
  1058. INFO = ABS( IINFO )
  1059. IF( IINFO.LT.0 ) THEN
  1060. RETURN
  1061. ELSE
  1062. RESULT( NTEST ) = ULPINV
  1063. RESULT( NTEST+1 ) = ULPINV
  1064. RESULT( NTEST+2 ) = ULPINV
  1065. GO TO 370
  1066. END IF
  1067. END IF
  1068. *
  1069. * Do tests 16 and 17.
  1070. *
  1071. CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
  1072. $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1073. *
  1074. NTEST = NTEST + 2
  1075. *
  1076. IF( IUPLO.EQ.1 ) THEN
  1077. INDX = 1
  1078. DO 330 J = 1, N
  1079. DO 320 I = 1, J
  1080. WORK( INDX ) = A( I, J )
  1081. INDX = INDX + 1
  1082. 320 CONTINUE
  1083. 330 CONTINUE
  1084. ELSE
  1085. INDX = 1
  1086. DO 350 J = 1, N
  1087. DO 340 I = J, N
  1088. WORK( INDX ) = A( I, J )
  1089. INDX = INDX + 1
  1090. 340 CONTINUE
  1091. 350 CONTINUE
  1092. END IF
  1093. *
  1094. CALL ZHPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU,
  1095. $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK,
  1096. $ IWORK( 5*N+1 ), IINFO )
  1097. IF( IINFO.NE.0 ) THEN
  1098. WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,A,' // UPLO //
  1099. $ ')', IINFO, N, JTYPE, IOLDSD
  1100. INFO = ABS( IINFO )
  1101. IF( IINFO.LT.0 ) THEN
  1102. RETURN
  1103. ELSE
  1104. RESULT( NTEST ) = ULPINV
  1105. GO TO 370
  1106. END IF
  1107. END IF
  1108. *
  1109. * Do test 18.
  1110. *
  1111. TEMP1 = ZERO
  1112. TEMP2 = ZERO
  1113. DO 360 J = 1, N
  1114. TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
  1115. TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
  1116. 360 CONTINUE
  1117. RESULT( NTEST ) = TEMP2 / MAX( UNFL,
  1118. $ ULP*MAX( TEMP1, TEMP2 ) )
  1119. *
  1120. 370 CONTINUE
  1121. NTEST = NTEST + 1
  1122. IF( IUPLO.EQ.1 ) THEN
  1123. INDX = 1
  1124. DO 390 J = 1, N
  1125. DO 380 I = 1, J
  1126. WORK( INDX ) = A( I, J )
  1127. INDX = INDX + 1
  1128. 380 CONTINUE
  1129. 390 CONTINUE
  1130. ELSE
  1131. INDX = 1
  1132. DO 410 J = 1, N
  1133. DO 400 I = J, N
  1134. WORK( INDX ) = A( I, J )
  1135. INDX = INDX + 1
  1136. 400 CONTINUE
  1137. 410 CONTINUE
  1138. END IF
  1139. *
  1140. CALL ZHPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU,
  1141. $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK,
  1142. $ IWORK( 5*N+1 ), IINFO )
  1143. IF( IINFO.NE.0 ) THEN
  1144. WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,I,' // UPLO //
  1145. $ ')', IINFO, N, JTYPE, IOLDSD
  1146. INFO = ABS( IINFO )
  1147. IF( IINFO.LT.0 ) THEN
  1148. RETURN
  1149. ELSE
  1150. RESULT( NTEST ) = ULPINV
  1151. RESULT( NTEST+1 ) = ULPINV
  1152. RESULT( NTEST+2 ) = ULPINV
  1153. GO TO 460
  1154. END IF
  1155. END IF
  1156. *
  1157. * Do tests 19 and 20.
  1158. *
  1159. CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
  1160. $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1161. *
  1162. NTEST = NTEST + 2
  1163. *
  1164. IF( IUPLO.EQ.1 ) THEN
  1165. INDX = 1
  1166. DO 430 J = 1, N
  1167. DO 420 I = 1, J
  1168. WORK( INDX ) = A( I, J )
  1169. INDX = INDX + 1
  1170. 420 CONTINUE
  1171. 430 CONTINUE
  1172. ELSE
  1173. INDX = 1
  1174. DO 450 J = 1, N
  1175. DO 440 I = J, N
  1176. WORK( INDX ) = A( I, J )
  1177. INDX = INDX + 1
  1178. 440 CONTINUE
  1179. 450 CONTINUE
  1180. END IF
  1181. *
  1182. CALL ZHPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU,
  1183. $ ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK,
  1184. $ IWORK( 5*N+1 ), IINFO )
  1185. IF( IINFO.NE.0 ) THEN
  1186. WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,I,' // UPLO //
  1187. $ ')', IINFO, N, JTYPE, IOLDSD
  1188. INFO = ABS( IINFO )
  1189. IF( IINFO.LT.0 ) THEN
  1190. RETURN
  1191. ELSE
  1192. RESULT( NTEST ) = ULPINV
  1193. GO TO 460
  1194. END IF
  1195. END IF
  1196. *
  1197. * Do test 21.
  1198. *
  1199. TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
  1200. TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
  1201. IF( N.GT.0 ) THEN
  1202. TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
  1203. ELSE
  1204. TEMP3 = ZERO
  1205. END IF
  1206. RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
  1207. $ MAX( UNFL, TEMP3*ULP )
  1208. *
  1209. 460 CONTINUE
  1210. NTEST = NTEST + 1
  1211. IF( IUPLO.EQ.1 ) THEN
  1212. INDX = 1
  1213. DO 480 J = 1, N
  1214. DO 470 I = 1, J
  1215. WORK( INDX ) = A( I, J )
  1216. INDX = INDX + 1
  1217. 470 CONTINUE
  1218. 480 CONTINUE
  1219. ELSE
  1220. INDX = 1
  1221. DO 500 J = 1, N
  1222. DO 490 I = J, N
  1223. WORK( INDX ) = A( I, J )
  1224. INDX = INDX + 1
  1225. 490 CONTINUE
  1226. 500 CONTINUE
  1227. END IF
  1228. *
  1229. CALL ZHPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU,
  1230. $ ABSTOL, M2, WA2, Z, LDU, V, RWORK, IWORK,
  1231. $ IWORK( 5*N+1 ), IINFO )
  1232. IF( IINFO.NE.0 ) THEN
  1233. WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(V,V,' // UPLO //
  1234. $ ')', IINFO, N, JTYPE, IOLDSD
  1235. INFO = ABS( IINFO )
  1236. IF( IINFO.LT.0 ) THEN
  1237. RETURN
  1238. ELSE
  1239. RESULT( NTEST ) = ULPINV
  1240. RESULT( NTEST+1 ) = ULPINV
  1241. RESULT( NTEST+2 ) = ULPINV
  1242. GO TO 550
  1243. END IF
  1244. END IF
  1245. *
  1246. * Do tests 22 and 23.
  1247. *
  1248. CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
  1249. $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1250. *
  1251. NTEST = NTEST + 2
  1252. *
  1253. IF( IUPLO.EQ.1 ) THEN
  1254. INDX = 1
  1255. DO 520 J = 1, N
  1256. DO 510 I = 1, J
  1257. WORK( INDX ) = A( I, J )
  1258. INDX = INDX + 1
  1259. 510 CONTINUE
  1260. 520 CONTINUE
  1261. ELSE
  1262. INDX = 1
  1263. DO 540 J = 1, N
  1264. DO 530 I = J, N
  1265. WORK( INDX ) = A( I, J )
  1266. INDX = INDX + 1
  1267. 530 CONTINUE
  1268. 540 CONTINUE
  1269. END IF
  1270. *
  1271. CALL ZHPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU,
  1272. $ ABSTOL, M3, WA3, Z, LDU, V, RWORK, IWORK,
  1273. $ IWORK( 5*N+1 ), IINFO )
  1274. IF( IINFO.NE.0 ) THEN
  1275. WRITE( NOUNIT, FMT = 9999 )'ZHPEVX(N,V,' // UPLO //
  1276. $ ')', 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 550
  1283. END IF
  1284. END IF
  1285. *
  1286. IF( M3.EQ.0 .AND. N.GT.0 ) THEN
  1287. RESULT( NTEST ) = ULPINV
  1288. GO TO 550
  1289. END IF
  1290. *
  1291. * Do test 24.
  1292. *
  1293. TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
  1294. TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
  1295. IF( N.GT.0 ) THEN
  1296. TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
  1297. ELSE
  1298. TEMP3 = ZERO
  1299. END IF
  1300. RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
  1301. $ MAX( UNFL, TEMP3*ULP )
  1302. *
  1303. 550 CONTINUE
  1304. *
  1305. * Call ZHBEVD and CHBEVX.
  1306. *
  1307. IF( JTYPE.LE.7 ) THEN
  1308. KD = 0
  1309. ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
  1310. KD = MAX( N-1, 0 )
  1311. ELSE
  1312. KD = IHBW
  1313. END IF
  1314. *
  1315. * Load array V with the upper or lower triangular part
  1316. * of the matrix in band form.
  1317. *
  1318. IF( IUPLO.EQ.1 ) THEN
  1319. DO 570 J = 1, N
  1320. DO 560 I = MAX( 1, J-KD ), J
  1321. V( KD+1+I-J, J ) = A( I, J )
  1322. 560 CONTINUE
  1323. 570 CONTINUE
  1324. ELSE
  1325. DO 590 J = 1, N
  1326. DO 580 I = J, MIN( N, J+KD )
  1327. V( 1+I-J, J ) = A( I, J )
  1328. 580 CONTINUE
  1329. 590 CONTINUE
  1330. END IF
  1331. *
  1332. NTEST = NTEST + 1
  1333. CALL ZHBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
  1334. $ LWEDC, RWORK, LRWEDC, IWORK, LIWEDC, IINFO )
  1335. IF( IINFO.NE.0 ) THEN
  1336. WRITE( NOUNIT, FMT = 9998 )'ZHBEVD(V,' // UPLO //
  1337. $ ')', IINFO, N, KD, JTYPE, IOLDSD
  1338. INFO = ABS( IINFO )
  1339. IF( IINFO.LT.0 ) THEN
  1340. RETURN
  1341. ELSE
  1342. RESULT( NTEST ) = ULPINV
  1343. RESULT( NTEST+1 ) = ULPINV
  1344. RESULT( NTEST+2 ) = ULPINV
  1345. GO TO 650
  1346. END IF
  1347. END IF
  1348. *
  1349. * Do tests 25 and 26.
  1350. *
  1351. CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
  1352. $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1353. *
  1354. IF( IUPLO.EQ.1 ) THEN
  1355. DO 610 J = 1, N
  1356. DO 600 I = MAX( 1, J-KD ), J
  1357. V( KD+1+I-J, J ) = A( I, J )
  1358. 600 CONTINUE
  1359. 610 CONTINUE
  1360. ELSE
  1361. DO 630 J = 1, N
  1362. DO 620 I = J, MIN( N, J+KD )
  1363. V( 1+I-J, J ) = A( I, J )
  1364. 620 CONTINUE
  1365. 630 CONTINUE
  1366. END IF
  1367. *
  1368. NTEST = NTEST + 2
  1369. CALL ZHBEVD_2STAGE( 'N', UPLO, N, KD, V, LDU, D3,
  1370. $ Z, LDU, WORK, LWORK, RWORK,
  1371. $ LRWEDC, IWORK, LIWEDC, IINFO )
  1372. IF( IINFO.NE.0 ) THEN
  1373. WRITE( NOUNIT, FMT = 9998 )
  1374. $ 'ZHBEVD_2STAGE(N,' // UPLO //
  1375. $ ')', IINFO, N, KD, JTYPE, IOLDSD
  1376. INFO = ABS( IINFO )
  1377. IF( IINFO.LT.0 ) THEN
  1378. RETURN
  1379. ELSE
  1380. RESULT( NTEST ) = ULPINV
  1381. GO TO 650
  1382. END IF
  1383. END IF
  1384. *
  1385. * Do test 27.
  1386. *
  1387. TEMP1 = ZERO
  1388. TEMP2 = ZERO
  1389. DO 640 J = 1, N
  1390. TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
  1391. TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
  1392. 640 CONTINUE
  1393. RESULT( NTEST ) = TEMP2 / MAX( UNFL,
  1394. $ ULP*MAX( TEMP1, TEMP2 ) )
  1395. *
  1396. * Load array V with the upper or lower triangular part
  1397. * of the matrix in band form.
  1398. *
  1399. 650 CONTINUE
  1400. IF( IUPLO.EQ.1 ) THEN
  1401. DO 670 J = 1, N
  1402. DO 660 I = MAX( 1, J-KD ), J
  1403. V( KD+1+I-J, J ) = A( I, J )
  1404. 660 CONTINUE
  1405. 670 CONTINUE
  1406. ELSE
  1407. DO 690 J = 1, N
  1408. DO 680 I = J, MIN( N, J+KD )
  1409. V( 1+I-J, J ) = A( I, J )
  1410. 680 CONTINUE
  1411. 690 CONTINUE
  1412. END IF
  1413. *
  1414. NTEST = NTEST + 1
  1415. CALL ZHBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL,
  1416. $ VU, IL, IU, ABSTOL, M, WA1, Z, LDU, WORK,
  1417. $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
  1418. IF( IINFO.NE.0 ) THEN
  1419. WRITE( NOUNIT, FMT = 9999 )'ZHBEVX(V,A,' // UPLO //
  1420. $ ')', IINFO, N, KD, JTYPE, IOLDSD
  1421. INFO = ABS( IINFO )
  1422. IF( IINFO.LT.0 ) THEN
  1423. RETURN
  1424. ELSE
  1425. RESULT( NTEST ) = ULPINV
  1426. RESULT( NTEST+1 ) = ULPINV
  1427. RESULT( NTEST+2 ) = ULPINV
  1428. GO TO 750
  1429. END IF
  1430. END IF
  1431. *
  1432. * Do tests 28 and 29.
  1433. *
  1434. CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
  1435. $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1436. *
  1437. NTEST = NTEST + 2
  1438. *
  1439. IF( IUPLO.EQ.1 ) THEN
  1440. DO 710 J = 1, N
  1441. DO 700 I = MAX( 1, J-KD ), J
  1442. V( KD+1+I-J, J ) = A( I, J )
  1443. 700 CONTINUE
  1444. 710 CONTINUE
  1445. ELSE
  1446. DO 730 J = 1, N
  1447. DO 720 I = J, MIN( N, J+KD )
  1448. V( 1+I-J, J ) = A( I, J )
  1449. 720 CONTINUE
  1450. 730 CONTINUE
  1451. END IF
  1452. *
  1453. CALL ZHBEVX_2STAGE( 'N', 'A', UPLO, N, KD, V, LDU,
  1454. $ U, LDU, VL, VU, IL, IU, ABSTOL,
  1455. $ M2, WA2, Z, LDU, WORK, LWORK,
  1456. $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
  1457. IF( IINFO.NE.0 ) THEN
  1458. WRITE( NOUNIT, FMT = 9998 )
  1459. $ 'ZHBEVX_2STAGE(N,A,' // UPLO //
  1460. $ ')', IINFO, N, KD, JTYPE, IOLDSD
  1461. INFO = ABS( IINFO )
  1462. IF( IINFO.LT.0 ) THEN
  1463. RETURN
  1464. ELSE
  1465. RESULT( NTEST ) = ULPINV
  1466. GO TO 750
  1467. END IF
  1468. END IF
  1469. *
  1470. * Do test 30.
  1471. *
  1472. TEMP1 = ZERO
  1473. TEMP2 = ZERO
  1474. DO 740 J = 1, N
  1475. TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
  1476. TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
  1477. 740 CONTINUE
  1478. RESULT( NTEST ) = TEMP2 / MAX( UNFL,
  1479. $ ULP*MAX( TEMP1, TEMP2 ) )
  1480. *
  1481. * Load array V with the upper or lower triangular part
  1482. * of the matrix in band form.
  1483. *
  1484. 750 CONTINUE
  1485. NTEST = NTEST + 1
  1486. IF( IUPLO.EQ.1 ) THEN
  1487. DO 770 J = 1, N
  1488. DO 760 I = MAX( 1, J-KD ), J
  1489. V( KD+1+I-J, J ) = A( I, J )
  1490. 760 CONTINUE
  1491. 770 CONTINUE
  1492. ELSE
  1493. DO 790 J = 1, N
  1494. DO 780 I = J, MIN( N, J+KD )
  1495. V( 1+I-J, J ) = A( I, J )
  1496. 780 CONTINUE
  1497. 790 CONTINUE
  1498. END IF
  1499. *
  1500. CALL ZHBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL,
  1501. $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
  1502. $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
  1503. IF( IINFO.NE.0 ) THEN
  1504. WRITE( NOUNIT, FMT = 9998 )'ZHBEVX(V,I,' // UPLO //
  1505. $ ')', IINFO, N, KD, JTYPE, IOLDSD
  1506. INFO = ABS( IINFO )
  1507. IF( IINFO.LT.0 ) THEN
  1508. RETURN
  1509. ELSE
  1510. RESULT( NTEST ) = ULPINV
  1511. RESULT( NTEST+1 ) = ULPINV
  1512. RESULT( NTEST+2 ) = ULPINV
  1513. GO TO 840
  1514. END IF
  1515. END IF
  1516. *
  1517. * Do tests 31 and 32.
  1518. *
  1519. CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
  1520. $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1521. *
  1522. NTEST = NTEST + 2
  1523. *
  1524. IF( IUPLO.EQ.1 ) THEN
  1525. DO 810 J = 1, N
  1526. DO 800 I = MAX( 1, J-KD ), J
  1527. V( KD+1+I-J, J ) = A( I, J )
  1528. 800 CONTINUE
  1529. 810 CONTINUE
  1530. ELSE
  1531. DO 830 J = 1, N
  1532. DO 820 I = J, MIN( N, J+KD )
  1533. V( 1+I-J, J ) = A( I, J )
  1534. 820 CONTINUE
  1535. 830 CONTINUE
  1536. END IF
  1537. CALL ZHBEVX_2STAGE( 'N', 'I', UPLO, N, KD, V, LDU,
  1538. $ U, LDU, VL, VU, IL, IU, ABSTOL,
  1539. $ M3, WA3, Z, LDU, WORK, LWORK,
  1540. $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
  1541. IF( IINFO.NE.0 ) THEN
  1542. WRITE( NOUNIT, FMT = 9998 )
  1543. $ 'ZHBEVX_2STAGE(N,I,' // UPLO //
  1544. $ ')', IINFO, N, KD, JTYPE, IOLDSD
  1545. INFO = ABS( IINFO )
  1546. IF( IINFO.LT.0 ) THEN
  1547. RETURN
  1548. ELSE
  1549. RESULT( NTEST ) = ULPINV
  1550. GO TO 840
  1551. END IF
  1552. END IF
  1553. *
  1554. * Do test 33.
  1555. *
  1556. TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
  1557. TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
  1558. IF( N.GT.0 ) THEN
  1559. TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
  1560. ELSE
  1561. TEMP3 = ZERO
  1562. END IF
  1563. RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
  1564. $ MAX( UNFL, TEMP3*ULP )
  1565. *
  1566. * Load array V with the upper or lower triangular part
  1567. * of the matrix in band form.
  1568. *
  1569. 840 CONTINUE
  1570. NTEST = NTEST + 1
  1571. IF( IUPLO.EQ.1 ) THEN
  1572. DO 860 J = 1, N
  1573. DO 850 I = MAX( 1, J-KD ), J
  1574. V( KD+1+I-J, J ) = A( I, J )
  1575. 850 CONTINUE
  1576. 860 CONTINUE
  1577. ELSE
  1578. DO 880 J = 1, N
  1579. DO 870 I = J, MIN( N, J+KD )
  1580. V( 1+I-J, J ) = A( I, J )
  1581. 870 CONTINUE
  1582. 880 CONTINUE
  1583. END IF
  1584. CALL ZHBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL,
  1585. $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
  1586. $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
  1587. IF( IINFO.NE.0 ) THEN
  1588. WRITE( NOUNIT, FMT = 9998 )'ZHBEVX(V,V,' // UPLO //
  1589. $ ')', IINFO, N, KD, JTYPE, IOLDSD
  1590. INFO = ABS( IINFO )
  1591. IF( IINFO.LT.0 ) THEN
  1592. RETURN
  1593. ELSE
  1594. RESULT( NTEST ) = ULPINV
  1595. RESULT( NTEST+1 ) = ULPINV
  1596. RESULT( NTEST+2 ) = ULPINV
  1597. GO TO 930
  1598. END IF
  1599. END IF
  1600. *
  1601. * Do tests 34 and 35.
  1602. *
  1603. CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
  1604. $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1605. *
  1606. NTEST = NTEST + 2
  1607. *
  1608. IF( IUPLO.EQ.1 ) THEN
  1609. DO 900 J = 1, N
  1610. DO 890 I = MAX( 1, J-KD ), J
  1611. V( KD+1+I-J, J ) = A( I, J )
  1612. 890 CONTINUE
  1613. 900 CONTINUE
  1614. ELSE
  1615. DO 920 J = 1, N
  1616. DO 910 I = J, MIN( N, J+KD )
  1617. V( 1+I-J, J ) = A( I, J )
  1618. 910 CONTINUE
  1619. 920 CONTINUE
  1620. END IF
  1621. CALL ZHBEVX_2STAGE( 'N', 'V', UPLO, N, KD, V, LDU,
  1622. $ U, LDU, VL, VU, IL, IU, ABSTOL,
  1623. $ M3, WA3, Z, LDU, WORK, LWORK,
  1624. $ RWORK, IWORK, IWORK( 5*N+1 ), IINFO )
  1625. IF( IINFO.NE.0 ) THEN
  1626. WRITE( NOUNIT, FMT = 9998 )
  1627. $ 'ZHBEVX_2STAGE(N,V,' // UPLO //
  1628. $ ')', IINFO, N, KD, JTYPE, IOLDSD
  1629. INFO = ABS( IINFO )
  1630. IF( IINFO.LT.0 ) THEN
  1631. RETURN
  1632. ELSE
  1633. RESULT( NTEST ) = ULPINV
  1634. GO TO 930
  1635. END IF
  1636. END IF
  1637. *
  1638. IF( M3.EQ.0 .AND. N.GT.0 ) THEN
  1639. RESULT( NTEST ) = ULPINV
  1640. GO TO 930
  1641. END IF
  1642. *
  1643. * Do test 36.
  1644. *
  1645. TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
  1646. TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
  1647. IF( N.GT.0 ) THEN
  1648. TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
  1649. ELSE
  1650. TEMP3 = ZERO
  1651. END IF
  1652. RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
  1653. $ MAX( UNFL, TEMP3*ULP )
  1654. *
  1655. 930 CONTINUE
  1656. *
  1657. * Call ZHEEV
  1658. *
  1659. CALL ZLACPY( ' ', N, N, A, LDA, V, LDU )
  1660. *
  1661. NTEST = NTEST + 1
  1662. CALL ZHEEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK, RWORK,
  1663. $ IINFO )
  1664. IF( IINFO.NE.0 ) THEN
  1665. WRITE( NOUNIT, FMT = 9999 )'ZHEEV(V,' // UPLO // ')',
  1666. $ IINFO, N, JTYPE, IOLDSD
  1667. INFO = ABS( IINFO )
  1668. IF( IINFO.LT.0 ) THEN
  1669. RETURN
  1670. ELSE
  1671. RESULT( NTEST ) = ULPINV
  1672. RESULT( NTEST+1 ) = ULPINV
  1673. RESULT( NTEST+2 ) = ULPINV
  1674. GO TO 950
  1675. END IF
  1676. END IF
  1677. *
  1678. * Do tests 37 and 38
  1679. *
  1680. CALL ZHET21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
  1681. $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1682. *
  1683. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  1684. *
  1685. NTEST = NTEST + 2
  1686. CALL ZHEEV_2STAGE( 'N', UPLO, N, A, LDU, D3,
  1687. $ WORK, LWORK, RWORK, IINFO )
  1688. IF( IINFO.NE.0 ) THEN
  1689. WRITE( NOUNIT, FMT = 9999 )
  1690. $ 'ZHEEV_2STAGE(N,' // UPLO // ')',
  1691. $ IINFO, N, JTYPE, IOLDSD
  1692. INFO = ABS( IINFO )
  1693. IF( IINFO.LT.0 ) THEN
  1694. RETURN
  1695. ELSE
  1696. RESULT( NTEST ) = ULPINV
  1697. GO TO 950
  1698. END IF
  1699. END IF
  1700. *
  1701. * Do test 39
  1702. *
  1703. TEMP1 = ZERO
  1704. TEMP2 = ZERO
  1705. DO 940 J = 1, N
  1706. TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
  1707. TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
  1708. 940 CONTINUE
  1709. RESULT( NTEST ) = TEMP2 / MAX( UNFL,
  1710. $ ULP*MAX( TEMP1, TEMP2 ) )
  1711. *
  1712. 950 CONTINUE
  1713. *
  1714. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  1715. *
  1716. * Call ZHPEV
  1717. *
  1718. * Load array WORK with the upper or lower triangular
  1719. * part of the matrix in packed form.
  1720. *
  1721. IF( IUPLO.EQ.1 ) THEN
  1722. INDX = 1
  1723. DO 970 J = 1, N
  1724. DO 960 I = 1, J
  1725. WORK( INDX ) = A( I, J )
  1726. INDX = INDX + 1
  1727. 960 CONTINUE
  1728. 970 CONTINUE
  1729. ELSE
  1730. INDX = 1
  1731. DO 990 J = 1, N
  1732. DO 980 I = J, N
  1733. WORK( INDX ) = A( I, J )
  1734. INDX = INDX + 1
  1735. 980 CONTINUE
  1736. 990 CONTINUE
  1737. END IF
  1738. *
  1739. NTEST = NTEST + 1
  1740. INDWRK = N*( N+1 ) / 2 + 1
  1741. CALL ZHPEV( 'V', UPLO, N, WORK, D1, Z, LDU,
  1742. $ WORK( INDWRK ), RWORK, IINFO )
  1743. IF( IINFO.NE.0 ) THEN
  1744. WRITE( NOUNIT, FMT = 9999 )'ZHPEV(V,' // UPLO // ')',
  1745. $ IINFO, N, JTYPE, IOLDSD
  1746. INFO = ABS( IINFO )
  1747. IF( IINFO.LT.0 ) THEN
  1748. RETURN
  1749. ELSE
  1750. RESULT( NTEST ) = ULPINV
  1751. RESULT( NTEST+1 ) = ULPINV
  1752. RESULT( NTEST+2 ) = ULPINV
  1753. GO TO 1050
  1754. END IF
  1755. END IF
  1756. *
  1757. * Do tests 40 and 41.
  1758. *
  1759. CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
  1760. $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1761. *
  1762. IF( IUPLO.EQ.1 ) THEN
  1763. INDX = 1
  1764. DO 1010 J = 1, N
  1765. DO 1000 I = 1, J
  1766. WORK( INDX ) = A( I, J )
  1767. INDX = INDX + 1
  1768. 1000 CONTINUE
  1769. 1010 CONTINUE
  1770. ELSE
  1771. INDX = 1
  1772. DO 1030 J = 1, N
  1773. DO 1020 I = J, N
  1774. WORK( INDX ) = A( I, J )
  1775. INDX = INDX + 1
  1776. 1020 CONTINUE
  1777. 1030 CONTINUE
  1778. END IF
  1779. *
  1780. NTEST = NTEST + 2
  1781. INDWRK = N*( N+1 ) / 2 + 1
  1782. CALL ZHPEV( 'N', UPLO, N, WORK, D3, Z, LDU,
  1783. $ WORK( INDWRK ), RWORK, IINFO )
  1784. IF( IINFO.NE.0 ) THEN
  1785. WRITE( NOUNIT, FMT = 9999 )'ZHPEV(N,' // UPLO // ')',
  1786. $ IINFO, N, JTYPE, IOLDSD
  1787. INFO = ABS( IINFO )
  1788. IF( IINFO.LT.0 ) THEN
  1789. RETURN
  1790. ELSE
  1791. RESULT( NTEST ) = ULPINV
  1792. GO TO 1050
  1793. END IF
  1794. END IF
  1795. *
  1796. * Do test 42
  1797. *
  1798. TEMP1 = ZERO
  1799. TEMP2 = ZERO
  1800. DO 1040 J = 1, N
  1801. TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
  1802. TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
  1803. 1040 CONTINUE
  1804. RESULT( NTEST ) = TEMP2 / MAX( UNFL,
  1805. $ ULP*MAX( TEMP1, TEMP2 ) )
  1806. *
  1807. 1050 CONTINUE
  1808. *
  1809. * Call ZHBEV
  1810. *
  1811. IF( JTYPE.LE.7 ) THEN
  1812. KD = 0
  1813. ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
  1814. KD = MAX( N-1, 0 )
  1815. ELSE
  1816. KD = IHBW
  1817. END IF
  1818. *
  1819. * Load array V with the upper or lower triangular part
  1820. * of the matrix in band form.
  1821. *
  1822. IF( IUPLO.EQ.1 ) THEN
  1823. DO 1070 J = 1, N
  1824. DO 1060 I = MAX( 1, J-KD ), J
  1825. V( KD+1+I-J, J ) = A( I, J )
  1826. 1060 CONTINUE
  1827. 1070 CONTINUE
  1828. ELSE
  1829. DO 1090 J = 1, N
  1830. DO 1080 I = J, MIN( N, J+KD )
  1831. V( 1+I-J, J ) = A( I, J )
  1832. 1080 CONTINUE
  1833. 1090 CONTINUE
  1834. END IF
  1835. *
  1836. NTEST = NTEST + 1
  1837. CALL ZHBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
  1838. $ RWORK, IINFO )
  1839. IF( IINFO.NE.0 ) THEN
  1840. WRITE( NOUNIT, FMT = 9998 )'ZHBEV(V,' // UPLO // ')',
  1841. $ IINFO, N, KD, JTYPE, IOLDSD
  1842. INFO = ABS( IINFO )
  1843. IF( IINFO.LT.0 ) THEN
  1844. RETURN
  1845. ELSE
  1846. RESULT( NTEST ) = ULPINV
  1847. RESULT( NTEST+1 ) = ULPINV
  1848. RESULT( NTEST+2 ) = ULPINV
  1849. GO TO 1140
  1850. END IF
  1851. END IF
  1852. *
  1853. * Do tests 43 and 44.
  1854. *
  1855. CALL ZHET21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
  1856. $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1857. *
  1858. IF( IUPLO.EQ.1 ) THEN
  1859. DO 1110 J = 1, N
  1860. DO 1100 I = MAX( 1, J-KD ), J
  1861. V( KD+1+I-J, J ) = A( I, J )
  1862. 1100 CONTINUE
  1863. 1110 CONTINUE
  1864. ELSE
  1865. DO 1130 J = 1, N
  1866. DO 1120 I = J, MIN( N, J+KD )
  1867. V( 1+I-J, J ) = A( I, J )
  1868. 1120 CONTINUE
  1869. 1130 CONTINUE
  1870. END IF
  1871. *
  1872. NTEST = NTEST + 2
  1873. CALL ZHBEV_2STAGE( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU,
  1874. $ WORK, LWORK, RWORK, IINFO )
  1875. IF( IINFO.NE.0 ) THEN
  1876. WRITE( NOUNIT, FMT = 9998 )
  1877. $ 'ZHBEV_2STAGE(N,' // UPLO // ')',
  1878. $ IINFO, N, KD, JTYPE, IOLDSD
  1879. INFO = ABS( IINFO )
  1880. IF( IINFO.LT.0 ) THEN
  1881. RETURN
  1882. ELSE
  1883. RESULT( NTEST ) = ULPINV
  1884. GO TO 1140
  1885. END IF
  1886. END IF
  1887. *
  1888. 1140 CONTINUE
  1889. *
  1890. * Do test 45.
  1891. *
  1892. TEMP1 = ZERO
  1893. TEMP2 = ZERO
  1894. DO 1150 J = 1, N
  1895. TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
  1896. TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
  1897. 1150 CONTINUE
  1898. RESULT( NTEST ) = TEMP2 / MAX( UNFL,
  1899. $ ULP*MAX( TEMP1, TEMP2 ) )
  1900. *
  1901. CALL ZLACPY( ' ', N, N, A, LDA, V, LDU )
  1902. NTEST = NTEST + 1
  1903. CALL ZHEEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
  1904. $ ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK,
  1905. $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N,
  1906. $ IINFO )
  1907. IF( IINFO.NE.0 ) THEN
  1908. WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,A,' // UPLO //
  1909. $ ')', IINFO, N, JTYPE, IOLDSD
  1910. INFO = ABS( IINFO )
  1911. IF( IINFO.LT.0 ) THEN
  1912. RETURN
  1913. ELSE
  1914. RESULT( NTEST ) = ULPINV
  1915. RESULT( NTEST+1 ) = ULPINV
  1916. RESULT( NTEST+2 ) = ULPINV
  1917. GO TO 1170
  1918. END IF
  1919. END IF
  1920. *
  1921. * Do tests 45 and 46 (or ... )
  1922. *
  1923. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  1924. *
  1925. CALL ZHET21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
  1926. $ LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1927. *
  1928. NTEST = NTEST + 2
  1929. CALL ZHEEVR_2STAGE( 'N', 'A', UPLO, N, A, LDU, VL, VU,
  1930. $ IL, IU, ABSTOL, M2, WA2, Z, LDU,
  1931. $ IWORK, WORK, LWORK, RWORK, LRWORK,
  1932. $ IWORK( 2*N+1 ), LIWORK-2*N, IINFO )
  1933. IF( IINFO.NE.0 ) THEN
  1934. WRITE( NOUNIT, FMT = 9999 )
  1935. $ 'ZHEEVR_2STAGE(N,A,' // UPLO //
  1936. $ ')', IINFO, N, JTYPE, IOLDSD
  1937. INFO = ABS( IINFO )
  1938. IF( IINFO.LT.0 ) THEN
  1939. RETURN
  1940. ELSE
  1941. RESULT( NTEST ) = ULPINV
  1942. GO TO 1170
  1943. END IF
  1944. END IF
  1945. *
  1946. * Do test 47 (or ... )
  1947. *
  1948. TEMP1 = ZERO
  1949. TEMP2 = ZERO
  1950. DO 1160 J = 1, N
  1951. TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
  1952. TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
  1953. 1160 CONTINUE
  1954. RESULT( NTEST ) = TEMP2 / MAX( UNFL,
  1955. $ ULP*MAX( TEMP1, TEMP2 ) )
  1956. *
  1957. 1170 CONTINUE
  1958. *
  1959. NTEST = NTEST + 1
  1960. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  1961. CALL ZHEEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
  1962. $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
  1963. $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N,
  1964. $ IINFO )
  1965. IF( IINFO.NE.0 ) THEN
  1966. WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,I,' // UPLO //
  1967. $ ')', IINFO, N, JTYPE, IOLDSD
  1968. INFO = ABS( IINFO )
  1969. IF( IINFO.LT.0 ) THEN
  1970. RETURN
  1971. ELSE
  1972. RESULT( NTEST ) = ULPINV
  1973. RESULT( NTEST+1 ) = ULPINV
  1974. RESULT( NTEST+2 ) = ULPINV
  1975. GO TO 1180
  1976. END IF
  1977. END IF
  1978. *
  1979. * Do tests 48 and 49 (or +??)
  1980. *
  1981. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  1982. *
  1983. CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
  1984. $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  1985. *
  1986. NTEST = NTEST + 2
  1987. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  1988. CALL ZHEEVR_2STAGE( 'N', 'I', UPLO, N, A, LDU, VL, VU,
  1989. $ IL, IU, ABSTOL, M3, WA3, Z, LDU,
  1990. $ IWORK, WORK, LWORK, RWORK, LRWORK,
  1991. $ IWORK( 2*N+1 ), LIWORK-2*N, IINFO )
  1992. IF( IINFO.NE.0 ) THEN
  1993. WRITE( NOUNIT, FMT = 9999 )
  1994. $ 'ZHEEVR_2STAGE(N,I,' // UPLO //
  1995. $ ')', IINFO, N, JTYPE, IOLDSD
  1996. INFO = ABS( IINFO )
  1997. IF( IINFO.LT.0 ) THEN
  1998. RETURN
  1999. ELSE
  2000. RESULT( NTEST ) = ULPINV
  2001. GO TO 1180
  2002. END IF
  2003. END IF
  2004. *
  2005. * Do test 50 (or +??)
  2006. *
  2007. TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
  2008. TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
  2009. RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
  2010. $ MAX( UNFL, ULP*TEMP3 )
  2011. 1180 CONTINUE
  2012. *
  2013. NTEST = NTEST + 1
  2014. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  2015. CALL ZHEEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
  2016. $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
  2017. $ RWORK, LRWORK, IWORK( 2*N+1 ), LIWORK-2*N,
  2018. $ IINFO )
  2019. IF( IINFO.NE.0 ) THEN
  2020. WRITE( NOUNIT, FMT = 9999 )'ZHEEVR(V,V,' // UPLO //
  2021. $ ')', IINFO, N, JTYPE, IOLDSD
  2022. INFO = ABS( IINFO )
  2023. IF( IINFO.LT.0 ) THEN
  2024. RETURN
  2025. ELSE
  2026. RESULT( NTEST ) = ULPINV
  2027. RESULT( NTEST+1 ) = ULPINV
  2028. RESULT( NTEST+2 ) = ULPINV
  2029. GO TO 1190
  2030. END IF
  2031. END IF
  2032. *
  2033. * Do tests 51 and 52 (or +??)
  2034. *
  2035. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  2036. *
  2037. CALL ZHET22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
  2038. $ V, LDU, TAU, WORK, RWORK, RESULT( NTEST ) )
  2039. *
  2040. NTEST = NTEST + 2
  2041. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  2042. CALL ZHEEVR_2STAGE( 'N', 'V', UPLO, N, A, LDU, VL, VU,
  2043. $ IL, IU, ABSTOL, M3, WA3, Z, LDU,
  2044. $ IWORK, WORK, LWORK, RWORK, LRWORK,
  2045. $ IWORK( 2*N+1 ), LIWORK-2*N, IINFO )
  2046. IF( IINFO.NE.0 ) THEN
  2047. WRITE( NOUNIT, FMT = 9999 )
  2048. $ 'ZHEEVR_2STAGE(N,V,' // UPLO //
  2049. $ ')', IINFO, N, JTYPE, IOLDSD
  2050. INFO = ABS( IINFO )
  2051. IF( IINFO.LT.0 ) THEN
  2052. RETURN
  2053. ELSE
  2054. RESULT( NTEST ) = ULPINV
  2055. GO TO 1190
  2056. END IF
  2057. END IF
  2058. *
  2059. IF( M3.EQ.0 .AND. N.GT.0 ) THEN
  2060. RESULT( NTEST ) = ULPINV
  2061. GO TO 1190
  2062. END IF
  2063. *
  2064. * Do test 52 (or +??)
  2065. *
  2066. TEMP1 = DSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
  2067. TEMP2 = DSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
  2068. IF( N.GT.0 ) THEN
  2069. TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
  2070. ELSE
  2071. TEMP3 = ZERO
  2072. END IF
  2073. RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
  2074. $ MAX( UNFL, TEMP3*ULP )
  2075. *
  2076. CALL ZLACPY( ' ', N, N, V, LDU, A, LDA )
  2077. *
  2078. *
  2079. *
  2080. *
  2081. * Load array V with the upper or lower triangular part
  2082. * of the matrix in band form.
  2083. *
  2084. 1190 CONTINUE
  2085. *
  2086. 1200 CONTINUE
  2087. *
  2088. * End of Loop -- Check for RESULT(j) > THRESH
  2089. *
  2090. NTESTT = NTESTT + NTEST
  2091. CALL DLAFTS( 'ZST', N, N, JTYPE, NTEST, RESULT, IOLDSD,
  2092. $ THRESH, NOUNIT, NERRS )
  2093. *
  2094. 1210 CONTINUE
  2095. 1220 CONTINUE
  2096. *
  2097. * Summary
  2098. *
  2099. CALL ALASVM( 'ZST', NOUNIT, NERRS, NTESTT, 0 )
  2100. *
  2101. 9999 FORMAT( ' ZDRVST2STG: ', A, ' returned INFO=', I6, / 9X, 'N=', I6,
  2102. $ ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
  2103. 9998 FORMAT( ' ZDRVST2STG: ', A, ' returned INFO=', I6, / 9X, 'N=', I6,
  2104. $ ', KD=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5,
  2105. $ ')' )
  2106. *
  2107. RETURN
  2108. *
  2109. * End of ZDRVST2STG
  2110. *
  2111. END