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.

dchkaa.f 31 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928
  1. *> \brief \b DCHKAA
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * PROGRAM DCHKAA
  12. *
  13. *
  14. *> \par Purpose:
  15. * =============
  16. *>
  17. *> \verbatim
  18. *>
  19. *> DCHKAA is the main test program for the DOUBLE PRECISION LAPACK
  20. *> linear equation routines
  21. *>
  22. *> The program must be driven by a short data file. The first 15 records
  23. *> (not including the first comment line) specify problem dimensions
  24. *> and program options using list-directed input. The remaining lines
  25. *> specify the LAPACK test paths and the number of matrix types to use
  26. *> in testing. An annotated example of a data file can be obtained by
  27. *> deleting the first 3 characters from the following 40 lines:
  28. *> Data file for testing DOUBLE PRECISION LAPACK linear eqn. routines
  29. *> 7 Number of values of M
  30. *> 0 1 2 3 5 10 16 Values of M (row dimension)
  31. *> 7 Number of values of N
  32. *> 0 1 2 3 5 10 16 Values of N (column dimension)
  33. *> 1 Number of values of NRHS
  34. *> 2 Values of NRHS (number of right hand sides)
  35. *> 5 Number of values of NB
  36. *> 1 3 3 3 20 Values of NB (the blocksize)
  37. *> 1 0 5 9 1 Values of NX (crossover point)
  38. *> 3 Number of values of RANK
  39. *> 30 50 90 Values of rank (as a % of N)
  40. *> 20.0 Threshold value of test ratio
  41. *> T Put T to test the LAPACK routines
  42. *> T Put T to test the driver routines
  43. *> T Put T to test the error exits
  44. *> DGE 11 List types on next line if 0 < NTYPES < 11
  45. *> DGB 8 List types on next line if 0 < NTYPES < 8
  46. *> DGT 12 List types on next line if 0 < NTYPES < 12
  47. *> DPO 9 List types on next line if 0 < NTYPES < 9
  48. *> DPS 9 List types on next line if 0 < NTYPES < 9
  49. *> DPP 9 List types on next line if 0 < NTYPES < 9
  50. *> DPB 8 List types on next line if 0 < NTYPES < 8
  51. *> DPT 12 List types on next line if 0 < NTYPES < 12
  52. *> DSY 10 List types on next line if 0 < NTYPES < 10
  53. *> DSR 10 List types on next line if 0 < NTYPES < 10
  54. *> DSP 10 List types on next line if 0 < NTYPES < 10
  55. *> DTR 18 List types on next line if 0 < NTYPES < 18
  56. *> DTP 18 List types on next line if 0 < NTYPES < 18
  57. *> DTB 17 List types on next line if 0 < NTYPES < 17
  58. *> DQR 8 List types on next line if 0 < NTYPES < 8
  59. *> DRQ 8 List types on next line if 0 < NTYPES < 8
  60. *> DLQ 8 List types on next line if 0 < NTYPES < 8
  61. *> DQL 8 List types on next line if 0 < NTYPES < 8
  62. *> DQP 6 List types on next line if 0 < NTYPES < 6
  63. *> DTZ 3 List types on next line if 0 < NTYPES < 3
  64. *> DLS 6 List types on next line if 0 < NTYPES < 6
  65. *> DEQ
  66. *> DQT
  67. *> DQX
  68. *> \endverbatim
  69. *
  70. * Parameters:
  71. * ==========
  72. *
  73. *> \verbatim
  74. *> NMAX INTEGER
  75. *> The maximum allowable value for M and N.
  76. *>
  77. *> MAXIN INTEGER
  78. *> The number of different values that can be used for each of
  79. *> M, N, NRHS, NB, NX and RANK
  80. *>
  81. *> MAXRHS INTEGER
  82. *> The maximum number of right hand sides
  83. *>
  84. *> MATMAX INTEGER
  85. *> The maximum number of matrix types to use for testing
  86. *>
  87. *> NIN INTEGER
  88. *> The unit number for input
  89. *>
  90. *> NOUT INTEGER
  91. *> The unit number for output
  92. *> \endverbatim
  93. *
  94. * Authors:
  95. * ========
  96. *
  97. *> \author Univ. of Tennessee
  98. *> \author Univ. of California Berkeley
  99. *> \author Univ. of Colorado Denver
  100. *> \author NAG Ltd.
  101. *
  102. *> \date April 2012
  103. *
  104. *> \ingroup double_lin
  105. *
  106. * =====================================================================
  107. PROGRAM DCHKAA
  108. *
  109. * -- LAPACK test routine (version 3.4.1) --
  110. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  111. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  112. * April 2012
  113. *
  114. * =====================================================================
  115. *
  116. * .. Parameters ..
  117. INTEGER NMAX
  118. PARAMETER ( NMAX = 132 )
  119. INTEGER MAXIN
  120. PARAMETER ( MAXIN = 12 )
  121. INTEGER MAXRHS
  122. PARAMETER ( MAXRHS = 16 )
  123. INTEGER MATMAX
  124. PARAMETER ( MATMAX = 30 )
  125. INTEGER NIN, NOUT
  126. PARAMETER ( NIN = 5, NOUT = 6 )
  127. INTEGER KDMAX
  128. PARAMETER ( KDMAX = NMAX+( NMAX+1 ) / 4 )
  129. * ..
  130. * .. Local Scalars ..
  131. LOGICAL FATAL, TSTCHK, TSTDRV, TSTERR
  132. CHARACTER C1
  133. CHARACTER*2 C2
  134. CHARACTER*3 PATH
  135. CHARACTER*10 INTSTR
  136. CHARACTER*72 ALINE
  137. INTEGER I, IC, J, K, LA, LAFAC, LDA, NB, NM, NMATS, NN,
  138. $ NNB, NNB2, NNS, NRHS, NTYPES, NRANK,
  139. $ VERS_MAJOR, VERS_MINOR, VERS_PATCH
  140. DOUBLE PRECISION EPS, S1, S2, THREQ, THRESH
  141. * ..
  142. * .. Local Arrays ..
  143. LOGICAL DOTYPE( MATMAX )
  144. INTEGER IWORK( 25*NMAX ), MVAL( MAXIN ),
  145. $ NBVAL( MAXIN ), NBVAL2( MAXIN ),
  146. $ NSVAL( MAXIN ), NVAL( MAXIN ), NXVAL( MAXIN ),
  147. $ RANKVAL( MAXIN ), PIV( NMAX )
  148. DOUBLE PRECISION A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ),
  149. $ RWORK( 5*NMAX+2*MAXRHS ), S( 2*NMAX ),
  150. $ WORK( NMAX, NMAX+MAXRHS+30 )
  151. * ..
  152. * .. External Functions ..
  153. LOGICAL LSAME, LSAMEN
  154. DOUBLE PRECISION DLAMCH, DSECND
  155. EXTERNAL LSAME, LSAMEN, DLAMCH, DSECND
  156. * ..
  157. * .. External Subroutines ..
  158. EXTERNAL ALAREQ, DCHKEQ, DCHKGB, DCHKGE, DCHKGT, DCHKLQ,
  159. $ DCHKPB, DCHKPO, DCHKPS, DCHKPP, DCHKPT, DCHKQ3,
  160. $ DCHKQL, DCHKQP, DCHKQR, DCHKRQ, DCHKSP, DCHKSY,
  161. $ DCHKSY_ROOK, DCHKTB, DCHKTP, DCHKTR, DCHKTZ,
  162. $ DDRVGB, DDRVGE, DDRVGT, DDRVLS, DDRVPB, DDRVPO,
  163. $ DDRVPP, DDRVPT, DDRVSP, DDRVSY, DDRVSY_ROOK,
  164. $ ILAVER, DCHKQRT, DCHKQRTP
  165. * ..
  166. * .. Scalars in Common ..
  167. LOGICAL LERR, OK
  168. CHARACTER*32 SRNAMT
  169. INTEGER INFOT, NUNIT
  170. * ..
  171. * .. Arrays in Common ..
  172. INTEGER IPARMS( 100 )
  173. * ..
  174. * .. Common blocks ..
  175. COMMON / INFOC / INFOT, NUNIT, OK, LERR
  176. COMMON / SRNAMC / SRNAMT
  177. COMMON / CLAENV / IPARMS
  178. * ..
  179. * .. Data statements ..
  180. DATA THREQ / 2.0D0 / , INTSTR / '0123456789' /
  181. * ..
  182. * .. Executable Statements ..
  183. *
  184. S1 = DSECND( )
  185. LDA = NMAX
  186. FATAL = .FALSE.
  187. *
  188. * Read a dummy line.
  189. *
  190. READ( NIN, FMT = * )
  191. *
  192. * Report values of parameters.
  193. *
  194. CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
  195. WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
  196. *
  197. * Read the values of M
  198. *
  199. READ( NIN, FMT = * )NM
  200. IF( NM.LT.1 ) THEN
  201. WRITE( NOUT, FMT = 9996 )' NM ', NM, 1
  202. NM = 0
  203. FATAL = .TRUE.
  204. ELSE IF( NM.GT.MAXIN ) THEN
  205. WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN
  206. NM = 0
  207. FATAL = .TRUE.
  208. END IF
  209. READ( NIN, FMT = * )( MVAL( I ), I = 1, NM )
  210. DO 10 I = 1, NM
  211. IF( MVAL( I ).LT.0 ) THEN
  212. WRITE( NOUT, FMT = 9996 )' M ', MVAL( I ), 0
  213. FATAL = .TRUE.
  214. ELSE IF( MVAL( I ).GT.NMAX ) THEN
  215. WRITE( NOUT, FMT = 9995 )' M ', MVAL( I ), NMAX
  216. FATAL = .TRUE.
  217. END IF
  218. 10 CONTINUE
  219. IF( NM.GT.0 )
  220. $ WRITE( NOUT, FMT = 9993 )'M ', ( MVAL( I ), I = 1, NM )
  221. *
  222. * Read the values of N
  223. *
  224. READ( NIN, FMT = * )NN
  225. IF( NN.LT.1 ) THEN
  226. WRITE( NOUT, FMT = 9996 )' NN ', NN, 1
  227. NN = 0
  228. FATAL = .TRUE.
  229. ELSE IF( NN.GT.MAXIN ) THEN
  230. WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN
  231. NN = 0
  232. FATAL = .TRUE.
  233. END IF
  234. READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
  235. DO 20 I = 1, NN
  236. IF( NVAL( I ).LT.0 ) THEN
  237. WRITE( NOUT, FMT = 9996 )' N ', NVAL( I ), 0
  238. FATAL = .TRUE.
  239. ELSE IF( NVAL( I ).GT.NMAX ) THEN
  240. WRITE( NOUT, FMT = 9995 )' N ', NVAL( I ), NMAX
  241. FATAL = .TRUE.
  242. END IF
  243. 20 CONTINUE
  244. IF( NN.GT.0 )
  245. $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN )
  246. *
  247. * Read the values of NRHS
  248. *
  249. READ( NIN, FMT = * )NNS
  250. IF( NNS.LT.1 ) THEN
  251. WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
  252. NNS = 0
  253. FATAL = .TRUE.
  254. ELSE IF( NNS.GT.MAXIN ) THEN
  255. WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
  256. NNS = 0
  257. FATAL = .TRUE.
  258. END IF
  259. READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
  260. DO 30 I = 1, NNS
  261. IF( NSVAL( I ).LT.0 ) THEN
  262. WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
  263. FATAL = .TRUE.
  264. ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
  265. WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
  266. FATAL = .TRUE.
  267. END IF
  268. 30 CONTINUE
  269. IF( NNS.GT.0 )
  270. $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
  271. *
  272. * Read the values of NB
  273. *
  274. READ( NIN, FMT = * )NNB
  275. IF( NNB.LT.1 ) THEN
  276. WRITE( NOUT, FMT = 9996 )'NNB ', NNB, 1
  277. NNB = 0
  278. FATAL = .TRUE.
  279. ELSE IF( NNB.GT.MAXIN ) THEN
  280. WRITE( NOUT, FMT = 9995 )'NNB ', NNB, MAXIN
  281. NNB = 0
  282. FATAL = .TRUE.
  283. END IF
  284. READ( NIN, FMT = * )( NBVAL( I ), I = 1, NNB )
  285. DO 40 I = 1, NNB
  286. IF( NBVAL( I ).LT.0 ) THEN
  287. WRITE( NOUT, FMT = 9996 )' NB ', NBVAL( I ), 0
  288. FATAL = .TRUE.
  289. END IF
  290. 40 CONTINUE
  291. IF( NNB.GT.0 )
  292. $ WRITE( NOUT, FMT = 9993 )'NB ', ( NBVAL( I ), I = 1, NNB )
  293. *
  294. * Set NBVAL2 to be the set of unique values of NB
  295. *
  296. NNB2 = 0
  297. DO 60 I = 1, NNB
  298. NB = NBVAL( I )
  299. DO 50 J = 1, NNB2
  300. IF( NB.EQ.NBVAL2( J ) )
  301. $ GO TO 60
  302. 50 CONTINUE
  303. NNB2 = NNB2 + 1
  304. NBVAL2( NNB2 ) = NB
  305. 60 CONTINUE
  306. *
  307. * Read the values of NX
  308. *
  309. READ( NIN, FMT = * )( NXVAL( I ), I = 1, NNB )
  310. DO 70 I = 1, NNB
  311. IF( NXVAL( I ).LT.0 ) THEN
  312. WRITE( NOUT, FMT = 9996 )' NX ', NXVAL( I ), 0
  313. FATAL = .TRUE.
  314. END IF
  315. 70 CONTINUE
  316. IF( NNB.GT.0 )
  317. $ WRITE( NOUT, FMT = 9993 )'NX ', ( NXVAL( I ), I = 1, NNB )
  318. *
  319. * Read the values of RANKVAL
  320. *
  321. READ( NIN, FMT = * )NRANK
  322. IF( NN.LT.1 ) THEN
  323. WRITE( NOUT, FMT = 9996 )' NRANK ', NRANK, 1
  324. NRANK = 0
  325. FATAL = .TRUE.
  326. ELSE IF( NN.GT.MAXIN ) THEN
  327. WRITE( NOUT, FMT = 9995 )' NRANK ', NRANK, MAXIN
  328. NRANK = 0
  329. FATAL = .TRUE.
  330. END IF
  331. READ( NIN, FMT = * )( RANKVAL( I ), I = 1, NRANK )
  332. DO I = 1, NRANK
  333. IF( RANKVAL( I ).LT.0 ) THEN
  334. WRITE( NOUT, FMT = 9996 )' RANK ', RANKVAL( I ), 0
  335. FATAL = .TRUE.
  336. ELSE IF( RANKVAL( I ).GT.100 ) THEN
  337. WRITE( NOUT, FMT = 9995 )' RANK ', RANKVAL( I ), 100
  338. FATAL = .TRUE.
  339. END IF
  340. END DO
  341. IF( NRANK.GT.0 )
  342. $ WRITE( NOUT, FMT = 9993 )'RANK % OF N',
  343. $ ( RANKVAL( I ), I = 1, NRANK )
  344. *
  345. * Read the threshold value for the test ratios.
  346. *
  347. READ( NIN, FMT = * )THRESH
  348. WRITE( NOUT, FMT = 9992 )THRESH
  349. *
  350. * Read the flag that indicates whether to test the LAPACK routines.
  351. *
  352. READ( NIN, FMT = * )TSTCHK
  353. *
  354. * Read the flag that indicates whether to test the driver routines.
  355. *
  356. READ( NIN, FMT = * )TSTDRV
  357. *
  358. * Read the flag that indicates whether to test the error exits.
  359. *
  360. READ( NIN, FMT = * )TSTERR
  361. *
  362. IF( FATAL ) THEN
  363. WRITE( NOUT, FMT = 9999 )
  364. STOP
  365. END IF
  366. *
  367. * Calculate and print the machine dependent constants.
  368. *
  369. EPS = DLAMCH( 'Underflow threshold' )
  370. WRITE( NOUT, FMT = 9991 )'underflow', EPS
  371. EPS = DLAMCH( 'Overflow threshold' )
  372. WRITE( NOUT, FMT = 9991 )'overflow ', EPS
  373. EPS = DLAMCH( 'Epsilon' )
  374. WRITE( NOUT, FMT = 9991 )'precision', EPS
  375. WRITE( NOUT, FMT = * )
  376. *
  377. 80 CONTINUE
  378. *
  379. * Read a test path and the number of matrix types to use.
  380. *
  381. READ( NIN, FMT = '(A72)', END = 140 )ALINE
  382. PATH = ALINE( 1: 3 )
  383. NMATS = MATMAX
  384. I = 3
  385. 90 CONTINUE
  386. I = I + 1
  387. IF( I.GT.72 ) THEN
  388. NMATS = MATMAX
  389. GO TO 130
  390. END IF
  391. IF( ALINE( I: I ).EQ.' ' )
  392. $ GO TO 90
  393. NMATS = 0
  394. 100 CONTINUE
  395. C1 = ALINE( I: I )
  396. DO 110 K = 1, 10
  397. IF( C1.EQ.INTSTR( K: K ) ) THEN
  398. IC = K - 1
  399. GO TO 120
  400. END IF
  401. 110 CONTINUE
  402. GO TO 130
  403. 120 CONTINUE
  404. NMATS = NMATS*10 + IC
  405. I = I + 1
  406. IF( I.GT.72 )
  407. $ GO TO 130
  408. GO TO 100
  409. 130 CONTINUE
  410. C1 = PATH( 1: 1 )
  411. C2 = PATH( 2: 3 )
  412. NRHS = NSVAL( 1 )
  413. *
  414. * Check first character for correct precision.
  415. *
  416. IF( .NOT.LSAME( C1, 'Double precision' ) ) THEN
  417. WRITE( NOUT, FMT = 9990 )PATH
  418. *
  419. ELSE IF( NMATS.LE.0 ) THEN
  420. *
  421. * Check for a positive number of tests requested.
  422. *
  423. WRITE( NOUT, FMT = 9989 )PATH
  424. *
  425. ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN
  426. *
  427. * GE: general matrices
  428. *
  429. NTYPES = 11
  430. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  431. *
  432. IF( TSTCHK ) THEN
  433. CALL DCHKGE( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS,
  434. $ NSVAL, THRESH, TSTERR, LDA, A( 1, 1 ),
  435. $ A( 1, 2 ), A( 1, 3 ), B( 1, 1 ), B( 1, 2 ),
  436. $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
  437. ELSE
  438. WRITE( NOUT, FMT = 9989 )PATH
  439. END IF
  440. *
  441. IF( TSTDRV ) THEN
  442. CALL DDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
  443. $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
  444. $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK,
  445. $ RWORK, IWORK, NOUT )
  446. ELSE
  447. WRITE( NOUT, FMT = 9988 )PATH
  448. END IF
  449. *
  450. ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN
  451. *
  452. * GB: general banded matrices
  453. *
  454. LA = ( 2*KDMAX+1 )*NMAX
  455. LAFAC = ( 3*KDMAX+1 )*NMAX
  456. NTYPES = 8
  457. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  458. *
  459. IF( TSTCHK ) THEN
  460. CALL DCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB2, NBVAL2, NNS,
  461. $ NSVAL, THRESH, TSTERR, A( 1, 1 ), LA,
  462. $ A( 1, 3 ), LAFAC, B( 1, 1 ), B( 1, 2 ),
  463. $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
  464. ELSE
  465. WRITE( NOUT, FMT = 9989 )PATH
  466. END IF
  467. *
  468. IF( TSTDRV ) THEN
  469. CALL DDRVGB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
  470. $ A( 1, 1 ), LA, A( 1, 3 ), LAFAC, A( 1, 6 ),
  471. $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S,
  472. $ WORK, RWORK, IWORK, NOUT )
  473. ELSE
  474. WRITE( NOUT, FMT = 9988 )PATH
  475. END IF
  476. *
  477. ELSE IF( LSAMEN( 2, C2, 'GT' ) ) THEN
  478. *
  479. * GT: general tridiagonal matrices
  480. *
  481. NTYPES = 12
  482. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  483. *
  484. IF( TSTCHK ) THEN
  485. CALL DCHKGT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
  486. $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ),
  487. $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
  488. ELSE
  489. WRITE( NOUT, FMT = 9989 )PATH
  490. END IF
  491. *
  492. IF( TSTDRV ) THEN
  493. CALL DDRVGT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
  494. $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ),
  495. $ B( 1, 3 ), WORK, RWORK, IWORK, NOUT )
  496. ELSE
  497. WRITE( NOUT, FMT = 9988 )PATH
  498. END IF
  499. *
  500. ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN
  501. *
  502. * PO: positive definite matrices
  503. *
  504. NTYPES = 9
  505. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  506. *
  507. IF( TSTCHK ) THEN
  508. CALL DCHKPO( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
  509. $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
  510. $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
  511. $ WORK, RWORK, IWORK, NOUT )
  512. ELSE
  513. WRITE( NOUT, FMT = 9989 )PATH
  514. END IF
  515. *
  516. IF( TSTDRV ) THEN
  517. CALL DDRVPO( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
  518. $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
  519. $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK,
  520. $ RWORK, IWORK, NOUT )
  521. ELSE
  522. WRITE( NOUT, FMT = 9988 )PATH
  523. END IF
  524. *
  525. ELSE IF( LSAMEN( 2, C2, 'PS' ) ) THEN
  526. *
  527. * PS: positive semi-definite matrices
  528. *
  529. NTYPES = 9
  530. *
  531. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  532. *
  533. IF( TSTCHK ) THEN
  534. CALL DCHKPS( DOTYPE, NN, NVAL, NNB2, NBVAL2, NRANK,
  535. $ RANKVAL, THRESH, TSTERR, LDA, A( 1, 1 ),
  536. $ A( 1, 2 ), A( 1, 3 ), PIV, WORK, RWORK,
  537. $ NOUT )
  538. ELSE
  539. WRITE( NOUT, FMT = 9989 )PATH
  540. END IF
  541. *
  542. ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN
  543. *
  544. * PP: positive definite packed matrices
  545. *
  546. NTYPES = 9
  547. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  548. *
  549. IF( TSTCHK ) THEN
  550. CALL DCHKPP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
  551. $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
  552. $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK,
  553. $ IWORK, NOUT )
  554. ELSE
  555. WRITE( NOUT, FMT = 9989 )PATH
  556. END IF
  557. *
  558. IF( TSTDRV ) THEN
  559. CALL DDRVPP( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
  560. $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
  561. $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK,
  562. $ RWORK, IWORK, NOUT )
  563. ELSE
  564. WRITE( NOUT, FMT = 9988 )PATH
  565. END IF
  566. *
  567. ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN
  568. *
  569. * PB: positive definite banded matrices
  570. *
  571. NTYPES = 8
  572. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  573. *
  574. IF( TSTCHK ) THEN
  575. CALL DCHKPB( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
  576. $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
  577. $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
  578. $ WORK, RWORK, IWORK, NOUT )
  579. ELSE
  580. WRITE( NOUT, FMT = 9989 )PATH
  581. END IF
  582. *
  583. IF( TSTDRV ) THEN
  584. CALL DDRVPB( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
  585. $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
  586. $ B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), S, WORK,
  587. $ RWORK, IWORK, NOUT )
  588. ELSE
  589. WRITE( NOUT, FMT = 9988 )PATH
  590. END IF
  591. *
  592. ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN
  593. *
  594. * PT: positive definite tridiagonal matrices
  595. *
  596. NTYPES = 12
  597. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  598. *
  599. IF( TSTCHK ) THEN
  600. CALL DCHKPT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
  601. $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
  602. $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, NOUT )
  603. ELSE
  604. WRITE( NOUT, FMT = 9989 )PATH
  605. END IF
  606. *
  607. IF( TSTDRV ) THEN
  608. CALL DDRVPT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
  609. $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
  610. $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, NOUT )
  611. ELSE
  612. WRITE( NOUT, FMT = 9988 )PATH
  613. END IF
  614. *
  615. ELSE IF( LSAMEN( 2, C2, 'SY' ) ) THEN
  616. *
  617. * SY: symmetric indefinite matrices,
  618. * with partial (Bunch-Kaufman) pivoting algorithm
  619. *
  620. NTYPES = 10
  621. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  622. *
  623. IF( TSTCHK ) THEN
  624. CALL DCHKSY( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
  625. $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
  626. $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
  627. $ WORK, RWORK, IWORK, NOUT )
  628. ELSE
  629. WRITE( NOUT, FMT = 9989 )PATH
  630. END IF
  631. *
  632. IF( TSTDRV ) THEN
  633. CALL DDRVSY( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
  634. $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
  635. $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK,
  636. $ NOUT )
  637. ELSE
  638. WRITE( NOUT, FMT = 9988 )PATH
  639. END IF
  640. *
  641. ELSE IF( LSAMEN( 2, C2, 'SR' ) ) THEN
  642. *
  643. * SR: symmetric indefinite matrices with Rook pivoting,
  644. * with rook (bounded Bunch-Kaufman) pivoting algorithm
  645. *
  646. NTYPES = 10
  647. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  648. *
  649. IF( TSTCHK ) THEN
  650. CALL DCHKSY_ROOK(DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
  651. $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
  652. $ A( 1, 3 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
  653. $ WORK, RWORK, IWORK, NOUT )
  654. ELSE
  655. WRITE( NOUT, FMT = 9989 )PATH
  656. END IF
  657. *
  658. IF( TSTDRV ) THEN
  659. CALL DDRVSY_ROOK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
  660. $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
  661. $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
  662. $ WORK, RWORK, IWORK, NOUT )
  663. ELSE
  664. WRITE( NOUT, FMT = 9988 )PATH
  665. END IF
  666. *
  667. ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
  668. *
  669. * SP: symmetric indefinite packed matrices,
  670. * with partial (Bunch-Kaufman) pivoting algorithm
  671. *
  672. NTYPES = 10
  673. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  674. *
  675. IF( TSTCHK ) THEN
  676. CALL DCHKSP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
  677. $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ),
  678. $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK,
  679. $ IWORK, NOUT )
  680. ELSE
  681. WRITE( NOUT, FMT = 9989 )PATH
  682. END IF
  683. *
  684. IF( TSTDRV ) THEN
  685. CALL DDRVSP( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, LDA,
  686. $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), B( 1, 1 ),
  687. $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK,
  688. $ NOUT )
  689. ELSE
  690. WRITE( NOUT, FMT = 9988 )PATH
  691. END IF
  692. *
  693. ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN
  694. *
  695. * TR: triangular matrices
  696. *
  697. NTYPES = 18
  698. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  699. *
  700. IF( TSTCHK ) THEN
  701. CALL DCHKTR( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, NSVAL,
  702. $ THRESH, TSTERR, LDA, A( 1, 1 ), A( 1, 2 ),
  703. $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), WORK, RWORK,
  704. $ IWORK, NOUT )
  705. ELSE
  706. WRITE( NOUT, FMT = 9989 )PATH
  707. END IF
  708. *
  709. ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN
  710. *
  711. * TP: triangular packed matrices
  712. *
  713. NTYPES = 18
  714. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  715. *
  716. IF( TSTCHK ) THEN
  717. CALL DCHKTP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
  718. $ LDA, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
  719. $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK,
  720. $ NOUT )
  721. ELSE
  722. WRITE( NOUT, FMT = 9989 )PATH
  723. END IF
  724. *
  725. ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
  726. *
  727. * TB: triangular banded matrices
  728. *
  729. NTYPES = 17
  730. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  731. *
  732. IF( TSTCHK ) THEN
  733. CALL DCHKTB( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
  734. $ LDA, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
  735. $ B( 1, 2 ), B( 1, 3 ), WORK, RWORK, IWORK,
  736. $ NOUT )
  737. ELSE
  738. WRITE( NOUT, FMT = 9989 )PATH
  739. END IF
  740. *
  741. ELSE IF( LSAMEN( 2, C2, 'QR' ) ) THEN
  742. *
  743. * QR: QR factorization
  744. *
  745. NTYPES = 8
  746. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  747. *
  748. IF( TSTCHK ) THEN
  749. CALL DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
  750. $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ),
  751. $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ),
  752. $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ),
  753. $ WORK, RWORK, IWORK, NOUT )
  754. ELSE
  755. WRITE( NOUT, FMT = 9989 )PATH
  756. END IF
  757. *
  758. ELSE IF( LSAMEN( 2, C2, 'LQ' ) ) THEN
  759. *
  760. * LQ: LQ factorization
  761. *
  762. NTYPES = 8
  763. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  764. *
  765. IF( TSTCHK ) THEN
  766. CALL DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
  767. $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ),
  768. $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ),
  769. $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ),
  770. $ WORK, RWORK, NOUT )
  771. ELSE
  772. WRITE( NOUT, FMT = 9989 )PATH
  773. END IF
  774. *
  775. ELSE IF( LSAMEN( 2, C2, 'QL' ) ) THEN
  776. *
  777. * QL: QL factorization
  778. *
  779. NTYPES = 8
  780. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  781. *
  782. IF( TSTCHK ) THEN
  783. CALL DCHKQL( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
  784. $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ),
  785. $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ),
  786. $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ),
  787. $ WORK, RWORK, IWORK, NOUT )
  788. ELSE
  789. WRITE( NOUT, FMT = 9989 )PATH
  790. END IF
  791. *
  792. ELSE IF( LSAMEN( 2, C2, 'RQ' ) ) THEN
  793. *
  794. * RQ: RQ factorization
  795. *
  796. NTYPES = 8
  797. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  798. *
  799. IF( TSTCHK ) THEN
  800. CALL DCHKRQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
  801. $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ),
  802. $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ),
  803. $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ),
  804. $ WORK, RWORK, IWORK, NOUT )
  805. ELSE
  806. WRITE( NOUT, FMT = 9989 )PATH
  807. END IF
  808. *
  809. ELSE IF( LSAMEN( 2, C2, 'QP' ) ) THEN
  810. *
  811. * QP: QR factorization with pivoting
  812. *
  813. NTYPES = 6
  814. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  815. *
  816. IF( TSTCHK ) THEN
  817. CALL DCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR,
  818. $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
  819. $ B( 1, 3 ), WORK, IWORK, NOUT )
  820. CALL DCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
  821. $ THRESH, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
  822. $ B( 1, 3 ), WORK, IWORK, NOUT )
  823. ELSE
  824. WRITE( NOUT, FMT = 9989 )PATH
  825. END IF
  826. *
  827. ELSE IF( LSAMEN( 2, C2, 'TZ' ) ) THEN
  828. *
  829. * TZ: Trapezoidal matrix
  830. *
  831. NTYPES = 3
  832. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  833. *
  834. IF( TSTCHK ) THEN
  835. CALL DCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR,
  836. $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ),
  837. $ B( 1, 3 ), WORK, NOUT )
  838. ELSE
  839. WRITE( NOUT, FMT = 9989 )PATH
  840. END IF
  841. *
  842. ELSE IF( LSAMEN( 2, C2, 'LS' ) ) THEN
  843. *
  844. * LS: Least squares drivers
  845. *
  846. NTYPES = 6
  847. CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
  848. *
  849. IF( TSTDRV ) THEN
  850. CALL DDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB,
  851. $ NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ),
  852. $ A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ),
  853. $ RWORK, RWORK( NMAX+1 ), WORK, IWORK, NOUT )
  854. ELSE
  855. WRITE( NOUT, FMT = 9988 )PATH
  856. END IF
  857. *
  858. ELSE IF( LSAMEN( 2, C2, 'EQ' ) ) THEN
  859. *
  860. * EQ: Equilibration routines for general and positive definite
  861. * matrices (THREQ should be between 2 and 10)
  862. *
  863. IF( TSTCHK ) THEN
  864. CALL DCHKEQ( THREQ, NOUT )
  865. ELSE
  866. WRITE( NOUT, FMT = 9989 )PATH
  867. END IF
  868. *
  869. ELSE IF( LSAMEN( 2, C2, 'QT' ) ) THEN
  870. *
  871. * QT: QRT routines for general matrices
  872. *
  873. IF( TSTCHK ) THEN
  874. CALL DCHKQRT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
  875. $ NBVAL, NOUT )
  876. ELSE
  877. WRITE( NOUT, FMT = 9989 )PATH
  878. END IF
  879. *
  880. ELSE IF( LSAMEN( 2, C2, 'QX' ) ) THEN
  881. *
  882. * QX: QRT routines for triangular-pentagonal matrices
  883. *
  884. IF( TSTCHK ) THEN
  885. CALL DCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
  886. $ NBVAL, NOUT )
  887. ELSE
  888. WRITE( NOUT, FMT = 9989 )PATH
  889. END IF
  890. *
  891. ELSE
  892. *
  893. WRITE( NOUT, FMT = 9990 )PATH
  894. END IF
  895. *
  896. * Go back to get another input line.
  897. *
  898. GO TO 80
  899. *
  900. * Branch to this line when the last record is read.
  901. *
  902. 140 CONTINUE
  903. CLOSE ( NIN )
  904. S2 = DSECND( )
  905. WRITE( NOUT, FMT = 9998 )
  906. WRITE( NOUT, FMT = 9997 )S2 - S1
  907. *
  908. 9999 FORMAT( / ' Execution not attempted due to input errors' )
  909. 9998 FORMAT( / ' End of tests' )
  910. 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
  911. 9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=',
  912. $ I6 )
  913. 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
  914. $ I6 )
  915. 9994 FORMAT( ' Tests of the DOUBLE PRECISION LAPACK routines ',
  916. $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
  917. $ / / ' The following parameter values will be used:' )
  918. 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 )
  919. 9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
  920. $ 'less than', F8.2, / )
  921. 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
  922. 9990 FORMAT( / 1X, A3, ': Unrecognized path name' )
  923. 9989 FORMAT( / 1X, A3, ' routines were not tested' )
  924. 9988 FORMAT( / 1X, A3, ' driver routines were not tested' )
  925. *
  926. * End of DCHKAA
  927. *
  928. END