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.

zchkab.f 11 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364
  1. *> \brief \b ZCHKAB
  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 ZCHKAB
  12. *
  13. *
  14. *> \par Purpose:
  15. * =============
  16. *>
  17. *> \verbatim
  18. *>
  19. *> ZCHKAB is the test program for the COMPLEX*16 LAPACK
  20. *> ZCGESV/ZCPOSV routine
  21. *>
  22. *> The program must be driven by a short data file. The first 5 records
  23. *> specify problem dimensions and program options using list-directed
  24. *> input. The remaining lines specify the LAPACK test paths and the
  25. *> number of matrix types to use in testing. An annotated example of a
  26. *> data file can be obtained by deleting the first 3 characters from the
  27. *> following 9 lines:
  28. *> Data file for testing COMPLEX*16 LAPACK ZCGESV
  29. *> 7 Number of values of M
  30. *> 0 1 2 3 5 10 16 Values of M (row dimension)
  31. *> 1 Number of values of NRHS
  32. *> 2 Values of NRHS (number of right hand sides)
  33. *> 20.0 Threshold value of test ratio
  34. *> T Put T to test the LAPACK routine
  35. *> T Put T to test the error exits
  36. *> DGE 11 List types on next line if 0 < NTYPES < 11
  37. *> DPO 9 List types on next line if 0 < NTYPES < 9
  38. *> \endverbatim
  39. *
  40. * Arguments:
  41. * ==========
  42. *
  43. *> \verbatim
  44. *> NMAX INTEGER
  45. *> The maximum allowable value for N
  46. *>
  47. *> MAXIN INTEGER
  48. *> The number of different values that can be used for each of
  49. *> M, N, NRHS, NB, and NX
  50. *>
  51. *> MAXRHS INTEGER
  52. *> The maximum number of right hand sides
  53. *>
  54. *> NIN INTEGER
  55. *> The unit number for input
  56. *>
  57. *> NOUT INTEGER
  58. *> The unit number for output
  59. *> \endverbatim
  60. *
  61. * Authors:
  62. * ========
  63. *
  64. *> \author Univ. of Tennessee
  65. *> \author Univ. of California Berkeley
  66. *> \author Univ. of Colorado Denver
  67. *> \author NAG Ltd.
  68. *
  69. *> \ingroup complex16_lin
  70. *
  71. * =====================================================================
  72. PROGRAM ZCHKAB
  73. *
  74. * -- LAPACK test routine --
  75. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  76. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  77. *
  78. * =====================================================================
  79. *
  80. * .. Parameters ..
  81. INTEGER NMAX
  82. PARAMETER ( NMAX = 132 )
  83. INTEGER MAXIN
  84. PARAMETER ( MAXIN = 12 )
  85. INTEGER MAXRHS
  86. PARAMETER ( MAXRHS = 16 )
  87. INTEGER MATMAX
  88. PARAMETER ( MATMAX = 30 )
  89. INTEGER NIN, NOUT
  90. PARAMETER ( NIN = 5, NOUT = 6 )
  91. INTEGER LDAMAX
  92. PARAMETER ( LDAMAX = NMAX )
  93. * ..
  94. * .. Local Scalars ..
  95. LOGICAL FATAL, TSTDRV, TSTERR
  96. CHARACTER C1
  97. CHARACTER*2 C2
  98. CHARACTER*3 PATH
  99. CHARACTER*10 INTSTR
  100. CHARACTER*72 ALINE
  101. INTEGER I, IC, K, LDA, NM, NMATS,
  102. $ NNS, NRHS, NTYPES,
  103. $ VERS_MAJOR, VERS_MINOR, VERS_PATCH
  104. DOUBLE PRECISION EPS, S1, S2, THRESH
  105. REAL SEPS
  106. * ..
  107. * .. Local Arrays ..
  108. LOGICAL DOTYPE( MATMAX )
  109. INTEGER IWORK( NMAX ), MVAL( MAXIN ), NSVAL( MAXIN )
  110. DOUBLE PRECISION RWORK(NMAX)
  111. COMPLEX*16 A( LDAMAX*NMAX, 2 ), B( NMAX*MAXRHS, 2 ),
  112. $ WORK( NMAX*MAXRHS*2 )
  113. COMPLEX SWORK(NMAX*(NMAX+MAXRHS))
  114. * ..
  115. * .. External Functions ..
  116. DOUBLE PRECISION DLAMCH, DSECND
  117. LOGICAL LSAME, LSAMEN
  118. REAL SLAMCH
  119. EXTERNAL DLAMCH, DSECND, LSAME, LSAMEN, SLAMCH
  120. * ..
  121. * .. External Subroutines ..
  122. EXTERNAL ALAREQ, ZDRVAB, ZDRVAC, ZERRAB, ZERRAC,
  123. $ ILAVER
  124. * ..
  125. * .. Scalars in Common ..
  126. LOGICAL LERR, OK
  127. CHARACTER*32 SRNAMT
  128. INTEGER INFOT, NUNIT
  129. * ..
  130. * .. Common blocks ..
  131. COMMON / INFOC / INFOT, NUNIT, OK, LERR
  132. COMMON / SRNAMC / SRNAMT
  133. *
  134. * .. Data statements ..
  135. DATA INTSTR / '0123456789' /
  136. * ..
  137. * .. Executable Statements ..
  138. *
  139. S1 = DSECND( )
  140. LDA = NMAX
  141. FATAL = .FALSE.
  142. *
  143. * Read a dummy line.
  144. *
  145. READ( NIN, FMT = * )
  146. *
  147. * Report values of parameters.
  148. *
  149. CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
  150. WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
  151. *
  152. * Read the values of M
  153. *
  154. READ( NIN, FMT = * )NM
  155. IF( NM.LT.1 ) THEN
  156. WRITE( NOUT, FMT = 9996 )' NM ', NM, 1
  157. NM = 0
  158. FATAL = .TRUE.
  159. ELSE IF( NM.GT.MAXIN ) THEN
  160. WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN
  161. NM = 0
  162. FATAL = .TRUE.
  163. END IF
  164. READ( NIN, FMT = * )( MVAL( I ), I = 1, NM )
  165. DO 10 I = 1, NM
  166. IF( MVAL( I ).LT.0 ) THEN
  167. WRITE( NOUT, FMT = 9996 )' M ', MVAL( I ), 0
  168. FATAL = .TRUE.
  169. ELSE IF( MVAL( I ).GT.NMAX ) THEN
  170. WRITE( NOUT, FMT = 9995 )' M ', MVAL( I ), NMAX
  171. FATAL = .TRUE.
  172. END IF
  173. 10 CONTINUE
  174. IF( NM.GT.0 )
  175. $ WRITE( NOUT, FMT = 9993 )'M ', ( MVAL( I ), I = 1, NM )
  176. *
  177. * Read the values of NRHS
  178. *
  179. READ( NIN, FMT = * )NNS
  180. IF( NNS.LT.1 ) THEN
  181. WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
  182. NNS = 0
  183. FATAL = .TRUE.
  184. ELSE IF( NNS.GT.MAXIN ) THEN
  185. WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
  186. NNS = 0
  187. FATAL = .TRUE.
  188. END IF
  189. READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
  190. DO 30 I = 1, NNS
  191. IF( NSVAL( I ).LT.0 ) THEN
  192. WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
  193. FATAL = .TRUE.
  194. ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
  195. WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
  196. FATAL = .TRUE.
  197. END IF
  198. 30 CONTINUE
  199. IF( NNS.GT.0 )
  200. $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
  201. *
  202. * Read the threshold value for the test ratios.
  203. *
  204. READ( NIN, FMT = * )THRESH
  205. WRITE( NOUT, FMT = 9992 )THRESH
  206. *
  207. * Read the flag that indicates whether to test the driver routine.
  208. *
  209. READ( NIN, FMT = * )TSTDRV
  210. *
  211. * Read the flag that indicates whether to test the error exits.
  212. *
  213. READ( NIN, FMT = * )TSTERR
  214. *
  215. IF( FATAL ) THEN
  216. WRITE( NOUT, FMT = 9999 )
  217. STOP
  218. END IF
  219. *
  220. * Calculate and print the machine dependent constants.
  221. *
  222. SEPS = SLAMCH( 'Underflow threshold' )
  223. WRITE( NOUT, FMT = 9991 )'(single precision) underflow', SEPS
  224. SEPS = SLAMCH( 'Overflow threshold' )
  225. WRITE( NOUT, FMT = 9991 )'(single precision) overflow ', SEPS
  226. SEPS = SLAMCH( 'Epsilon' )
  227. WRITE( NOUT, FMT = 9991 )'(single precision) precision', SEPS
  228. WRITE( NOUT, FMT = * )
  229. *
  230. EPS = DLAMCH( 'Underflow threshold' )
  231. WRITE( NOUT, FMT = 9991 )'(double precision) underflow', EPS
  232. EPS = DLAMCH( 'Overflow threshold' )
  233. WRITE( NOUT, FMT = 9991 )'(double precision) overflow ', EPS
  234. EPS = DLAMCH( 'Epsilon' )
  235. WRITE( NOUT, FMT = 9991 )'(double precision) precision', EPS
  236. WRITE( NOUT, FMT = * )
  237. *
  238. 80 CONTINUE
  239. *
  240. * Read a test path and the number of matrix types to use.
  241. *
  242. READ( NIN, FMT = '(A72)', END = 140 )ALINE
  243. PATH = ALINE( 1: 3 )
  244. NMATS = MATMAX
  245. I = 3
  246. 90 CONTINUE
  247. I = I + 1
  248. IF( I.GT.72 ) THEN
  249. NMATS = MATMAX
  250. GO TO 130
  251. END IF
  252. IF( ALINE( I: I ).EQ.' ' )
  253. $ GO TO 90
  254. NMATS = 0
  255. 100 CONTINUE
  256. C1 = ALINE( I: I )
  257. DO 110 K = 1, 10
  258. IF( C1.EQ.INTSTR( K: K ) ) THEN
  259. IC = K - 1
  260. GO TO 120
  261. END IF
  262. 110 CONTINUE
  263. GO TO 130
  264. 120 CONTINUE
  265. NMATS = NMATS*10 + IC
  266. I = I + 1
  267. IF( I.GT.72 )
  268. $ GO TO 130
  269. GO TO 100
  270. 130 CONTINUE
  271. C1 = PATH( 1: 1 )
  272. C2 = PATH( 2: 3 )
  273. NRHS = NSVAL( 1 )
  274. NRHS = NSVAL( 1 )
  275. *
  276. * Check first character for correct precision.
  277. *
  278. IF( .NOT.LSAME( C1, 'Zomplex precision' ) ) THEN
  279. WRITE( NOUT, FMT = 9990 )PATH
  280. *
  281. ELSE IF( NMATS.LE.0 ) THEN
  282. *
  283. * Check for a positive number of tests requested.
  284. *
  285. WRITE( NOUT, FMT = 9990 )'ZCGESV'
  286. GO TO 140
  287. *
  288. ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN
  289. *
  290. * GE: general matrices
  291. *
  292. NTYPES = 11
  293. CALL ALAREQ( 'ZGE', NMATS, DOTYPE, NTYPES, NIN, NOUT )
  294. *
  295. * Test the error exits
  296. *
  297. IF( TSTERR )
  298. $ CALL ZERRAB( NOUT )
  299. *
  300. IF( TSTDRV ) THEN
  301. CALL ZDRVAB( DOTYPE, NM, MVAL, NNS,
  302. $ NSVAL, THRESH, LDA, A( 1, 1 ),
  303. $ A( 1, 2 ), B( 1, 1 ), B( 1, 2 ),
  304. $ WORK, RWORK, SWORK, IWORK, NOUT )
  305. ELSE
  306. WRITE( NOUT, FMT = 9989 )'ZCGESV'
  307. END IF
  308. *
  309. ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN
  310. *
  311. * PO: positive definite matrices
  312. *
  313. NTYPES = 9
  314. CALL ALAREQ( 'DPO', NMATS, DOTYPE, NTYPES, NIN, NOUT )
  315. *
  316. IF( TSTERR )
  317. $ CALL ZERRAC( NOUT )
  318. *
  319. *
  320. IF( TSTDRV ) THEN
  321. CALL ZDRVAC( DOTYPE, NM, MVAL, NNS, NSVAL,
  322. $ THRESH, LDA, A( 1, 1 ), A( 1, 2 ),
  323. $ B( 1, 1 ), B( 1, 2 ),
  324. $ WORK, RWORK, SWORK, NOUT )
  325. ELSE
  326. WRITE( NOUT, FMT = 9989 )'ZCPOSV'
  327. END IF
  328. *
  329. ELSE
  330. *
  331. END IF
  332. *
  333. * Go back to get another input line.
  334. *
  335. GO TO 80
  336. *
  337. * Branch to this line when the last record is read.
  338. *
  339. 140 CONTINUE
  340. CLOSE ( NIN )
  341. S2 = DSECND( )
  342. WRITE( NOUT, FMT = 9998 )
  343. WRITE( NOUT, FMT = 9997 )S2 - S1
  344. *
  345. 9999 FORMAT( / ' Execution not attempted due to input errors' )
  346. 9998 FORMAT( / ' End of tests' )
  347. 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
  348. 9996 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be >=',
  349. $ I6 )
  350. 9995 FORMAT( ' Invalid input value: ', A4, '=', I6, '; must be <=',
  351. $ I6 )
  352. 9994 FORMAT( ' Tests of the COMPLEX*16 LAPACK ZCGESV/ZCPOSV routines ',
  353. $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
  354. $ / / ' The following parameter values will be used:' )
  355. 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 )
  356. 9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
  357. $ 'less than', F8.2, / )
  358. 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
  359. 9990 FORMAT( / 1X, A6, ' routines were not tested' )
  360. 9989 FORMAT( / 1X, A6, ' driver routines were not tested' )
  361. *
  362. * End of ZCHKAB
  363. *
  364. END