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.

derred.f 19 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508
  1. *> \brief \b DERRED
  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 DERRED( 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. *> DERRED tests the error exits for the eigenvalue driver routines for
  25. *> DOUBLE PRECISION matrices:
  26. *>
  27. *> PATH driver description
  28. *> ---- ------ -----------
  29. *> SEV DGEEV find eigenvalues/eigenvectors for nonsymmetric A
  30. *> SES DGEES find eigenvalues/Schur form for nonsymmetric A
  31. *> SVX DGEEVX SGEEV + balancing and condition estimation
  32. *> SSX DGEESX SGEES + balancing and condition estimation
  33. *> DBD DGESVD compute SVD of an M-by-N matrix A
  34. *> DGESDD compute SVD of an M-by-N matrix A (by divide and
  35. *> conquer)
  36. *> DGEJSV compute SVD of an M-by-N matrix A where M >= N
  37. *> DGESVDX compute SVD of an M-by-N matrix A(by bisection
  38. *> and inverse iteration)
  39. *> \endverbatim
  40. *
  41. * Arguments:
  42. * ==========
  43. *
  44. *> \param[in] PATH
  45. *> \verbatim
  46. *> PATH is CHARACTER*3
  47. *> The LAPACK path name for the routines to be tested.
  48. *> \endverbatim
  49. *>
  50. *> \param[in] NUNIT
  51. *> \verbatim
  52. *> NUNIT is INTEGER
  53. *> The unit number for output.
  54. *> \endverbatim
  55. *
  56. * Authors:
  57. * ========
  58. *
  59. *> \author Univ. of Tennessee
  60. *> \author Univ. of California Berkeley
  61. *> \author Univ. of Colorado Denver
  62. *> \author NAG Ltd.
  63. *
  64. *> \date June 2016
  65. *
  66. *> \ingroup double_eig
  67. *
  68. * =====================================================================
  69. SUBROUTINE DERRED( PATH, NUNIT )
  70. *
  71. * -- LAPACK test routine (version 3.7.0) --
  72. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  73. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  74. * June 2016
  75. *
  76. * .. Scalar Arguments ..
  77. CHARACTER*3 PATH
  78. INTEGER NUNIT
  79. * ..
  80. *
  81. * =====================================================================
  82. *
  83. * .. Parameters ..
  84. INTEGER NMAX
  85. DOUBLE PRECISION ONE, ZERO
  86. PARAMETER ( NMAX = 4, ONE = 1.0D0, ZERO = 0.0D0 )
  87. * ..
  88. * .. Local Scalars ..
  89. CHARACTER*2 C2
  90. INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
  91. DOUBLE PRECISION ABNRM
  92. * ..
  93. * .. Local Arrays ..
  94. LOGICAL B( NMAX )
  95. INTEGER IW( 2*NMAX )
  96. DOUBLE PRECISION A( NMAX, NMAX ), R1( NMAX ), R2( NMAX ),
  97. $ S( NMAX ), U( NMAX, NMAX ), VL( NMAX, NMAX ),
  98. $ VR( NMAX, NMAX ), VT( NMAX, NMAX ),
  99. $ W( 10*NMAX ), WI( NMAX ), WR( NMAX )
  100. * ..
  101. * .. External Subroutines ..
  102. EXTERNAL CHKXER, DGEES, DGEESX, DGEEV, DGEEVX, DGEJSV,
  103. $ DGESDD, DGESVD
  104. * ..
  105. * .. External Functions ..
  106. LOGICAL DSLECT, LSAMEN
  107. EXTERNAL DSLECT, LSAMEN
  108. * ..
  109. * .. Intrinsic Functions ..
  110. INTRINSIC LEN_TRIM
  111. * ..
  112. * .. Arrays in Common ..
  113. LOGICAL SELVAL( 20 )
  114. DOUBLE PRECISION SELWI( 20 ), SELWR( 20 )
  115. * ..
  116. * .. Scalars in Common ..
  117. LOGICAL LERR, OK
  118. CHARACTER*32 SRNAMT
  119. INTEGER INFOT, NOUT, SELDIM, SELOPT
  120. * ..
  121. * .. Common blocks ..
  122. COMMON / INFOC / INFOT, NOUT, OK, LERR
  123. COMMON / SRNAMC / SRNAMT
  124. COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI
  125. * ..
  126. * .. Executable Statements ..
  127. *
  128. NOUT = NUNIT
  129. WRITE( NOUT, FMT = * )
  130. C2 = PATH( 2: 3 )
  131. *
  132. * Initialize A
  133. *
  134. DO 20 J = 1, NMAX
  135. DO 10 I = 1, NMAX
  136. A( I, J ) = ZERO
  137. 10 CONTINUE
  138. 20 CONTINUE
  139. DO 30 I = 1, NMAX
  140. A( I, I ) = ONE
  141. 30 CONTINUE
  142. OK = .TRUE.
  143. NT = 0
  144. *
  145. IF( LSAMEN( 2, C2, 'EV' ) ) THEN
  146. *
  147. * Test DGEEV
  148. *
  149. SRNAMT = 'DGEEV '
  150. INFOT = 1
  151. CALL DGEEV( 'X', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1,
  152. $ INFO )
  153. CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK )
  154. INFOT = 2
  155. CALL DGEEV( 'N', 'X', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1,
  156. $ INFO )
  157. CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK )
  158. INFOT = 3
  159. CALL DGEEV( 'N', 'N', -1, A, 1, WR, WI, VL, 1, VR, 1, W, 1,
  160. $ INFO )
  161. CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK )
  162. INFOT = 5
  163. CALL DGEEV( 'N', 'N', 2, A, 1, WR, WI, VL, 1, VR, 1, W, 6,
  164. $ INFO )
  165. CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK )
  166. INFOT = 9
  167. CALL DGEEV( 'V', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1, W, 8,
  168. $ INFO )
  169. CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK )
  170. INFOT = 11
  171. CALL DGEEV( 'N', 'V', 2, A, 2, WR, WI, VL, 1, VR, 1, W, 8,
  172. $ INFO )
  173. CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK )
  174. INFOT = 13
  175. CALL DGEEV( 'V', 'V', 1, A, 1, WR, WI, VL, 1, VR, 1, W, 3,
  176. $ INFO )
  177. CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK )
  178. NT = NT + 7
  179. *
  180. ELSE IF( LSAMEN( 2, C2, 'ES' ) ) THEN
  181. *
  182. * Test DGEES
  183. *
  184. SRNAMT = 'DGEES '
  185. INFOT = 1
  186. CALL DGEES( 'X', 'N', DSLECT, 0, A, 1, SDIM, WR, WI, VL, 1, W,
  187. $ 1, B, INFO )
  188. CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK )
  189. INFOT = 2
  190. CALL DGEES( 'N', 'X', DSLECT, 0, A, 1, SDIM, WR, WI, VL, 1, W,
  191. $ 1, B, INFO )
  192. CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK )
  193. INFOT = 4
  194. CALL DGEES( 'N', 'S', DSLECT, -1, A, 1, SDIM, WR, WI, VL, 1, W,
  195. $ 1, B, INFO )
  196. CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK )
  197. INFOT = 6
  198. CALL DGEES( 'N', 'S', DSLECT, 2, A, 1, SDIM, WR, WI, VL, 1, W,
  199. $ 6, B, INFO )
  200. CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK )
  201. INFOT = 11
  202. CALL DGEES( 'V', 'S', DSLECT, 2, A, 2, SDIM, WR, WI, VL, 1, W,
  203. $ 6, B, INFO )
  204. CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK )
  205. INFOT = 13
  206. CALL DGEES( 'N', 'S', DSLECT, 1, A, 1, SDIM, WR, WI, VL, 1, W,
  207. $ 2, B, INFO )
  208. CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK )
  209. NT = NT + 6
  210. *
  211. ELSE IF( LSAMEN( 2, C2, 'VX' ) ) THEN
  212. *
  213. * Test DGEEVX
  214. *
  215. SRNAMT = 'DGEEVX'
  216. INFOT = 1
  217. CALL DGEEVX( 'X', 'N', 'N', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1,
  218. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  219. CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK )
  220. INFOT = 2
  221. CALL DGEEVX( 'N', 'X', 'N', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1,
  222. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  223. CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK )
  224. INFOT = 3
  225. CALL DGEEVX( 'N', 'N', 'X', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1,
  226. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  227. CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK )
  228. INFOT = 4
  229. CALL DGEEVX( 'N', 'N', 'N', 'X', 0, A, 1, WR, WI, VL, 1, VR, 1,
  230. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  231. CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK )
  232. INFOT = 5
  233. CALL DGEEVX( 'N', 'N', 'N', 'N', -1, A, 1, WR, WI, VL, 1, VR,
  234. $ 1, ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  235. CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK )
  236. INFOT = 7
  237. CALL DGEEVX( 'N', 'N', 'N', 'N', 2, A, 1, WR, WI, VL, 1, VR, 1,
  238. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  239. CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK )
  240. INFOT = 11
  241. CALL DGEEVX( 'N', 'V', 'N', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1,
  242. $ ILO, IHI, S, ABNRM, R1, R2, W, 6, IW, INFO )
  243. CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK )
  244. INFOT = 13
  245. CALL DGEEVX( 'N', 'N', 'V', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1,
  246. $ ILO, IHI, S, ABNRM, R1, R2, W, 6, IW, INFO )
  247. CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK )
  248. INFOT = 21
  249. CALL DGEEVX( 'N', 'N', 'N', 'N', 1, A, 1, WR, WI, VL, 1, VR, 1,
  250. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  251. CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK )
  252. INFOT = 21
  253. CALL DGEEVX( 'N', 'V', 'N', 'N', 1, A, 1, WR, WI, VL, 1, VR, 1,
  254. $ ILO, IHI, S, ABNRM, R1, R2, W, 2, IW, INFO )
  255. CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK )
  256. INFOT = 21
  257. CALL DGEEVX( 'N', 'N', 'V', 'V', 1, A, 1, WR, WI, VL, 1, VR, 1,
  258. $ ILO, IHI, S, ABNRM, R1, R2, W, 3, IW, INFO )
  259. CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK )
  260. NT = NT + 11
  261. *
  262. ELSE IF( LSAMEN( 2, C2, 'SX' ) ) THEN
  263. *
  264. * Test DGEESX
  265. *
  266. SRNAMT = 'DGEESX'
  267. INFOT = 1
  268. CALL DGEESX( 'X', 'N', DSLECT, 'N', 0, A, 1, SDIM, WR, WI, VL,
  269. $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
  270. CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK )
  271. INFOT = 2
  272. CALL DGEESX( 'N', 'X', DSLECT, 'N', 0, A, 1, SDIM, WR, WI, VL,
  273. $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
  274. CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK )
  275. INFOT = 4
  276. CALL DGEESX( 'N', 'N', DSLECT, 'X', 0, A, 1, SDIM, WR, WI, VL,
  277. $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
  278. CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK )
  279. INFOT = 5
  280. CALL DGEESX( 'N', 'N', DSLECT, 'N', -1, A, 1, SDIM, WR, WI, VL,
  281. $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
  282. CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK )
  283. INFOT = 7
  284. CALL DGEESX( 'N', 'N', DSLECT, 'N', 2, A, 1, SDIM, WR, WI, VL,
  285. $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO )
  286. CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK )
  287. INFOT = 12
  288. CALL DGEESX( 'V', 'N', DSLECT, 'N', 2, A, 2, SDIM, WR, WI, VL,
  289. $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO )
  290. CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK )
  291. INFOT = 16
  292. CALL DGEESX( 'N', 'N', DSLECT, 'N', 1, A, 1, SDIM, WR, WI, VL,
  293. $ 1, R1( 1 ), R2( 1 ), W, 2, IW, 1, B, INFO )
  294. CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK )
  295. NT = NT + 7
  296. *
  297. ELSE IF( LSAMEN( 2, C2, 'BD' ) ) THEN
  298. *
  299. * Test DGESVD
  300. *
  301. SRNAMT = 'DGESVD'
  302. INFOT = 1
  303. CALL DGESVD( 'X', 'N', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
  304. CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK )
  305. INFOT = 2
  306. CALL DGESVD( 'N', 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
  307. CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK )
  308. INFOT = 2
  309. CALL DGESVD( 'O', 'O', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
  310. CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK )
  311. INFOT = 3
  312. CALL DGESVD( 'N', 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1,
  313. $ INFO )
  314. CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK )
  315. INFOT = 4
  316. CALL DGESVD( 'N', 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1,
  317. $ INFO )
  318. CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK )
  319. INFOT = 6
  320. CALL DGESVD( 'N', 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, INFO )
  321. CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK )
  322. INFOT = 9
  323. CALL DGESVD( 'A', 'N', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, INFO )
  324. CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK )
  325. INFOT = 11
  326. CALL DGESVD( 'N', 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, INFO )
  327. CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK )
  328. NT = 8
  329. IF( OK ) THEN
  330. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  331. $ NT
  332. ELSE
  333. WRITE( NOUT, FMT = 9998 )
  334. END IF
  335. *
  336. * Test DGESDD
  337. *
  338. SRNAMT = 'DGESDD'
  339. INFOT = 1
  340. CALL DGESDD( 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO )
  341. CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK )
  342. INFOT = 2
  343. CALL DGESDD( 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO )
  344. CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK )
  345. INFOT = 3
  346. CALL DGESDD( 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO )
  347. CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK )
  348. INFOT = 5
  349. CALL DGESDD( 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO )
  350. CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK )
  351. INFOT = 8
  352. CALL DGESDD( 'A', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, IW, INFO )
  353. CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK )
  354. INFOT = 10
  355. CALL DGESDD( 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO )
  356. CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK )
  357. NT = 6
  358. IF( OK ) THEN
  359. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  360. $ NT
  361. ELSE
  362. WRITE( NOUT, FMT = 9998 )
  363. END IF
  364. *
  365. * Test DGEJSV
  366. *
  367. SRNAMT = 'DGEJSV'
  368. INFOT = 1
  369. CALL DGEJSV( 'X', 'U', 'V', 'R', 'N', 'N',
  370. $ 0, 0, A, 1, S, U, 1, VT, 1,
  371. $ W, 1, IW, INFO)
  372. CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK )
  373. INFOT = 2
  374. CALL DGEJSV( 'G', 'X', 'V', 'R', 'N', 'N',
  375. $ 0, 0, A, 1, S, U, 1, VT, 1,
  376. $ W, 1, IW, INFO)
  377. CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK )
  378. INFOT = 3
  379. CALL DGEJSV( 'G', 'U', 'X', 'R', 'N', 'N',
  380. $ 0, 0, A, 1, S, U, 1, VT, 1,
  381. $ W, 1, IW, INFO)
  382. CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK )
  383. INFOT = 4
  384. CALL DGEJSV( 'G', 'U', 'V', 'X', 'N', 'N',
  385. $ 0, 0, A, 1, S, U, 1, VT, 1,
  386. $ W, 1, IW, INFO)
  387. CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK )
  388. INFOT = 5
  389. CALL DGEJSV( 'G', 'U', 'V', 'R', 'X', 'N',
  390. $ 0, 0, A, 1, S, U, 1, VT, 1,
  391. $ W, 1, IW, INFO)
  392. CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK )
  393. INFOT = 6
  394. CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'X',
  395. $ 0, 0, A, 1, S, U, 1, VT, 1,
  396. $ W, 1, IW, INFO)
  397. CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK )
  398. INFOT = 7
  399. CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  400. $ -1, 0, A, 1, S, U, 1, VT, 1,
  401. $ W, 1, IW, INFO)
  402. CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK )
  403. INFOT = 8
  404. CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  405. $ 0, -1, A, 1, S, U, 1, VT, 1,
  406. $ W, 1, IW, INFO)
  407. CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK )
  408. INFOT = 10
  409. CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  410. $ 2, 1, A, 1, S, U, 1, VT, 1,
  411. $ W, 1, IW, INFO)
  412. CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK )
  413. INFOT = 13
  414. CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  415. $ 2, 2, A, 2, S, U, 1, VT, 2,
  416. $ W, 1, IW, INFO)
  417. CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK )
  418. INFOT = 15
  419. CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  420. $ 2, 2, A, 2, S, U, 2, VT, 1,
  421. $ W, 1, IW, INFO)
  422. CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK )
  423. NT = 11
  424. IF( OK ) THEN
  425. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  426. $ NT
  427. ELSE
  428. WRITE( NOUT, FMT = 9998 )
  429. END IF
  430. *
  431. * Test DGESVDX
  432. *
  433. SRNAMT = 'DGESVDX'
  434. INFOT = 1
  435. CALL DGESVDX( 'X', 'N', 'A', 0, 0, A, 1, ZERO, ZERO,
  436. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  437. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  438. INFOT = 2
  439. CALL DGESVDX( 'N', 'X', 'A', 0, 0, A, 1, ZERO, ZERO,
  440. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  441. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  442. INFOT = 3
  443. CALL DGESVDX( 'N', 'N', 'X', 0, 0, A, 1, ZERO, ZERO,
  444. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  445. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  446. INFOT = 4
  447. CALL DGESVDX( 'N', 'N', 'A', -1, 0, A, 1, ZERO, ZERO,
  448. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  449. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  450. INFOT = 5
  451. CALL DGESVDX( 'N', 'N', 'A', 0, -1, A, 1, ZERO, ZERO,
  452. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  453. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  454. INFOT = 7
  455. CALL DGESVDX( 'N', 'N', 'A', 2, 1, A, 1, ZERO, ZERO,
  456. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  457. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  458. INFOT = 8
  459. CALL DGESVDX( 'N', 'N', 'V', 2, 1, A, 2, -ONE, ZERO,
  460. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  461. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  462. INFOT = 9
  463. CALL DGESVDX( 'N', 'N', 'V', 2, 1, A, 2, ONE, ZERO,
  464. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  465. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  466. INFOT = 10
  467. CALL DGESVDX( 'N', 'N', 'I', 2, 2, A, 2, ZERO, ZERO,
  468. $ 0, 1, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  469. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  470. INFOT = 11
  471. CALL DGESVDX( 'V', 'N', 'I', 2, 2, A, 2, ZERO, ZERO,
  472. $ 1, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  473. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  474. INFOT = 15
  475. CALL DGESVDX( 'V', 'N', 'A', 2, 2, A, 2, ZERO, ZERO,
  476. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  477. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  478. INFOT = 17
  479. CALL DGESVDX( 'N', 'V', 'A', 2, 2, A, 2, ZERO, ZERO,
  480. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  481. CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK )
  482. NT = 12
  483. IF( OK ) THEN
  484. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  485. $ NT
  486. ELSE
  487. WRITE( NOUT, FMT = 9998 )
  488. END IF
  489. END IF
  490. *
  491. * Print a summary line.
  492. *
  493. IF( .NOT.LSAMEN( 2, C2, 'BD' ) ) THEN
  494. IF( OK ) THEN
  495. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  496. $ NT
  497. ELSE
  498. WRITE( NOUT, FMT = 9998 )
  499. END IF
  500. END IF
  501. *
  502. 9999 FORMAT( 1X, A, ' passed the tests of the error exits (', I3,
  503. $ ' tests done)' )
  504. 9998 FORMAT( ' *** ', A, ' failed the tests of the error exits ***' )
  505. RETURN
  506. *
  507. * End of DERRED
  508. END