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

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