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.

cdrvst.f 75 kB

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