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.

derrge.f 14 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406
  1. *> \brief \b DERRGE
  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 DERRGE( PATH, NUNIT )
  12. *
  13. * .. Scalar Arguments ..
  14. * CHARACTER*3 PATH
  15. * INTEGER NUNIT
  16. * ..
  17. *
  18. *
  19. *> \par Purpose:
  20. * =============
  21. *>
  22. *> \verbatim
  23. *>
  24. *> DERRGE tests the error exits for the DOUBLE PRECISION routines
  25. *> for general matrices.
  26. *> \endverbatim
  27. *
  28. * Arguments:
  29. * ==========
  30. *
  31. *> \param[in] PATH
  32. *> \verbatim
  33. *> PATH is CHARACTER*3
  34. *> The LAPACK path name for the routines to be tested.
  35. *> \endverbatim
  36. *>
  37. *> \param[in] NUNIT
  38. *> \verbatim
  39. *> NUNIT is INTEGER
  40. *> The unit number for output.
  41. *> \endverbatim
  42. *
  43. * Authors:
  44. * ========
  45. *
  46. *> \author Univ. of Tennessee
  47. *> \author Univ. of California Berkeley
  48. *> \author Univ. of Colorado Denver
  49. *> \author NAG Ltd.
  50. *
  51. *> \ingroup double_lin
  52. *
  53. * =====================================================================
  54. SUBROUTINE DERRGE( PATH, NUNIT )
  55. *
  56. * -- LAPACK test routine --
  57. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  58. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  59. *
  60. * .. Scalar Arguments ..
  61. CHARACTER*3 PATH
  62. INTEGER NUNIT
  63. * ..
  64. *
  65. * =====================================================================
  66. *
  67. * .. Parameters ..
  68. INTEGER NMAX, LW
  69. PARAMETER ( NMAX = 4, LW = 3*NMAX )
  70. * ..
  71. * .. Local Scalars ..
  72. CHARACTER*2 C2
  73. INTEGER I, INFO, J
  74. DOUBLE PRECISION ANRM, CCOND, RCOND
  75. * ..
  76. * .. Local Arrays ..
  77. INTEGER IP( NMAX ), IW( NMAX )
  78. DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
  79. $ R1( NMAX ), R2( NMAX ), W( LW ), X( NMAX )
  80. * ..
  81. * .. External Functions ..
  82. LOGICAL LSAMEN
  83. EXTERNAL LSAMEN
  84. * ..
  85. * .. External Subroutines ..
  86. EXTERNAL ALAESM, CHKXER, DGBCON, DGBEQU, DGBRFS, DGBTF2,
  87. $ DGBTRF, DGBTRS, DGECON, DGEEQU, DGERFS, DGETF2,
  88. $ DGETRF, DGETRI, DGETRS
  89. * ..
  90. * .. Scalars in Common ..
  91. LOGICAL LERR, OK
  92. CHARACTER*32 SRNAMT
  93. INTEGER INFOT, NOUT
  94. * ..
  95. * .. Common blocks ..
  96. COMMON / INFOC / INFOT, NOUT, OK, LERR
  97. COMMON / SRNAMC / SRNAMT
  98. * ..
  99. * .. Intrinsic Functions ..
  100. INTRINSIC DBLE
  101. * ..
  102. * .. Executable Statements ..
  103. *
  104. NOUT = NUNIT
  105. WRITE( NOUT, FMT = * )
  106. C2 = PATH( 2: 3 )
  107. *
  108. * Set the variables to innocuous values.
  109. *
  110. DO 20 J = 1, NMAX
  111. DO 10 I = 1, NMAX
  112. A( I, J ) = 1.D0 / DBLE( I+J )
  113. AF( I, J ) = 1.D0 / DBLE( I+J )
  114. 10 CONTINUE
  115. B( J ) = 0.D0
  116. R1( J ) = 0.D0
  117. R2( J ) = 0.D0
  118. W( J ) = 0.D0
  119. X( J ) = 0.D0
  120. IP( J ) = J
  121. IW( J ) = J
  122. 20 CONTINUE
  123. OK = .TRUE.
  124. *
  125. IF( LSAMEN( 2, C2, 'GE' ) ) THEN
  126. *
  127. * Test error exits of the routines that use the LU decomposition
  128. * of a general matrix.
  129. *
  130. * DGETRF
  131. *
  132. SRNAMT = 'DGETRF'
  133. INFOT = 1
  134. CALL DGETRF( -1, 0, A, 1, IP, INFO )
  135. CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
  136. INFOT = 2
  137. CALL DGETRF( 0, -1, A, 1, IP, INFO )
  138. CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
  139. INFOT = 4
  140. CALL DGETRF( 2, 1, A, 1, IP, INFO )
  141. CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
  142. *
  143. * DGETF2
  144. *
  145. SRNAMT = 'DGETF2'
  146. INFOT = 1
  147. CALL DGETF2( -1, 0, A, 1, IP, INFO )
  148. CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
  149. INFOT = 2
  150. CALL DGETF2( 0, -1, A, 1, IP, INFO )
  151. CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
  152. INFOT = 4
  153. CALL DGETF2( 2, 1, A, 1, IP, INFO )
  154. CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
  155. *
  156. * DGETRI
  157. *
  158. SRNAMT = 'DGETRI'
  159. INFOT = 1
  160. CALL DGETRI( -1, A, 1, IP, W, LW, INFO )
  161. CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK )
  162. INFOT = 3
  163. CALL DGETRI( 2, A, 1, IP, W, LW, INFO )
  164. CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK )
  165. *
  166. * DGETRS
  167. *
  168. SRNAMT = 'DGETRS'
  169. INFOT = 1
  170. CALL DGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
  171. CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
  172. INFOT = 2
  173. CALL DGETRS( 'N', -1, 0, A, 1, IP, B, 1, INFO )
  174. CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
  175. INFOT = 3
  176. CALL DGETRS( 'N', 0, -1, A, 1, IP, B, 1, INFO )
  177. CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
  178. INFOT = 5
  179. CALL DGETRS( 'N', 2, 1, A, 1, IP, B, 2, INFO )
  180. CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
  181. INFOT = 8
  182. CALL DGETRS( 'N', 2, 1, A, 2, IP, B, 1, INFO )
  183. CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
  184. *
  185. * DGERFS
  186. *
  187. SRNAMT = 'DGERFS'
  188. INFOT = 1
  189. CALL DGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
  190. $ IW, INFO )
  191. CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
  192. INFOT = 2
  193. CALL DGERFS( 'N', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
  194. $ W, IW, INFO )
  195. CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
  196. INFOT = 3
  197. CALL DGERFS( 'N', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
  198. $ W, IW, INFO )
  199. CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
  200. INFOT = 5
  201. CALL DGERFS( 'N', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
  202. $ IW, INFO )
  203. CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
  204. INFOT = 7
  205. CALL DGERFS( 'N', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
  206. $ IW, INFO )
  207. CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
  208. INFOT = 10
  209. CALL DGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
  210. $ IW, INFO )
  211. CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
  212. INFOT = 12
  213. CALL DGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
  214. $ IW, INFO )
  215. CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
  216. *
  217. * DGECON
  218. *
  219. SRNAMT = 'DGECON'
  220. INFOT = 1
  221. CALL DGECON( '/', 0, A, 1, ANRM, RCOND, W, IW, INFO )
  222. CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
  223. INFOT = 2
  224. CALL DGECON( '1', -1, A, 1, ANRM, RCOND, W, IW, INFO )
  225. CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
  226. INFOT = 4
  227. CALL DGECON( '1', 2, A, 1, ANRM, RCOND, W, IW, INFO )
  228. CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
  229. *
  230. * DGEEQU
  231. *
  232. SRNAMT = 'DGEEQU'
  233. INFOT = 1
  234. CALL DGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
  235. CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK )
  236. INFOT = 2
  237. CALL DGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
  238. CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK )
  239. INFOT = 4
  240. CALL DGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
  241. CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK )
  242. *
  243. ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN
  244. *
  245. * Test error exits of the routines that use the LU decomposition
  246. * of a general band matrix.
  247. *
  248. * DGBTRF
  249. *
  250. SRNAMT = 'DGBTRF'
  251. INFOT = 1
  252. CALL DGBTRF( -1, 0, 0, 0, A, 1, IP, INFO )
  253. CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
  254. INFOT = 2
  255. CALL DGBTRF( 0, -1, 0, 0, A, 1, IP, INFO )
  256. CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
  257. INFOT = 3
  258. CALL DGBTRF( 1, 1, -1, 0, A, 1, IP, INFO )
  259. CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
  260. INFOT = 4
  261. CALL DGBTRF( 1, 1, 0, -1, A, 1, IP, INFO )
  262. CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
  263. INFOT = 6
  264. CALL DGBTRF( 2, 2, 1, 1, A, 3, IP, INFO )
  265. CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
  266. *
  267. * DGBTF2
  268. *
  269. SRNAMT = 'DGBTF2'
  270. INFOT = 1
  271. CALL DGBTF2( -1, 0, 0, 0, A, 1, IP, INFO )
  272. CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
  273. INFOT = 2
  274. CALL DGBTF2( 0, -1, 0, 0, A, 1, IP, INFO )
  275. CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
  276. INFOT = 3
  277. CALL DGBTF2( 1, 1, -1, 0, A, 1, IP, INFO )
  278. CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
  279. INFOT = 4
  280. CALL DGBTF2( 1, 1, 0, -1, A, 1, IP, INFO )
  281. CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
  282. INFOT = 6
  283. CALL DGBTF2( 2, 2, 1, 1, A, 3, IP, INFO )
  284. CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
  285. *
  286. * DGBTRS
  287. *
  288. SRNAMT = 'DGBTRS'
  289. INFOT = 1
  290. CALL DGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO )
  291. CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
  292. INFOT = 2
  293. CALL DGBTRS( 'N', -1, 0, 0, 1, A, 1, IP, B, 1, INFO )
  294. CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
  295. INFOT = 3
  296. CALL DGBTRS( 'N', 1, -1, 0, 1, A, 1, IP, B, 1, INFO )
  297. CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
  298. INFOT = 4
  299. CALL DGBTRS( 'N', 1, 0, -1, 1, A, 1, IP, B, 1, INFO )
  300. CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
  301. INFOT = 5
  302. CALL DGBTRS( 'N', 1, 0, 0, -1, A, 1, IP, B, 1, INFO )
  303. CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
  304. INFOT = 7
  305. CALL DGBTRS( 'N', 2, 1, 1, 1, A, 3, IP, B, 2, INFO )
  306. CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
  307. INFOT = 10
  308. CALL DGBTRS( 'N', 2, 0, 0, 1, A, 1, IP, B, 1, INFO )
  309. CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
  310. *
  311. * DGBRFS
  312. *
  313. SRNAMT = 'DGBRFS'
  314. INFOT = 1
  315. CALL DGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
  316. $ R2, W, IW, INFO )
  317. CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
  318. INFOT = 2
  319. CALL DGBRFS( 'N', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
  320. $ R2, W, IW, INFO )
  321. CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
  322. INFOT = 3
  323. CALL DGBRFS( 'N', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
  324. $ R2, W, IW, INFO )
  325. CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
  326. INFOT = 4
  327. CALL DGBRFS( 'N', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
  328. $ R2, W, IW, INFO )
  329. CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
  330. INFOT = 5
  331. CALL DGBRFS( 'N', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1,
  332. $ R2, W, IW, INFO )
  333. CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
  334. INFOT = 7
  335. CALL DGBRFS( 'N', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1,
  336. $ R2, W, IW, INFO )
  337. CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
  338. INFOT = 9
  339. CALL DGBRFS( 'N', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1,
  340. $ R2, W, IW, INFO )
  341. CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
  342. INFOT = 12
  343. CALL DGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1,
  344. $ R2, W, IW, INFO )
  345. CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
  346. INFOT = 14
  347. CALL DGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1,
  348. $ R2, W, IW, INFO )
  349. CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
  350. *
  351. * DGBCON
  352. *
  353. SRNAMT = 'DGBCON'
  354. INFOT = 1
  355. CALL DGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
  356. CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
  357. INFOT = 2
  358. CALL DGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, IW,
  359. $ INFO )
  360. CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
  361. INFOT = 3
  362. CALL DGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, IW,
  363. $ INFO )
  364. CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
  365. INFOT = 4
  366. CALL DGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, IW,
  367. $ INFO )
  368. CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
  369. INFOT = 6
  370. CALL DGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, IW, INFO )
  371. CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
  372. *
  373. * DGBEQU
  374. *
  375. SRNAMT = 'DGBEQU'
  376. INFOT = 1
  377. CALL DGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
  378. $ INFO )
  379. CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
  380. INFOT = 2
  381. CALL DGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
  382. $ INFO )
  383. CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
  384. INFOT = 3
  385. CALL DGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
  386. $ INFO )
  387. CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
  388. INFOT = 4
  389. CALL DGBEQU( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM,
  390. $ INFO )
  391. CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
  392. INFOT = 6
  393. CALL DGBEQU( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM,
  394. $ INFO )
  395. CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
  396. END IF
  397. *
  398. * Print a summary line.
  399. *
  400. CALL ALAESM( PATH, OK, NOUT )
  401. *
  402. RETURN
  403. *
  404. * End of DERRGE
  405. *
  406. END