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.

cerred.f 22 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572
  1. *> \brief \b CERRED
  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 CERRED( 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. *> CERRED tests the error exits for the eigenvalue driver routines for
  25. *> REAL matrices:
  26. *>
  27. *> PATH driver description
  28. *> ---- ------ -----------
  29. *> CEV CGEEV find eigenvalues/eigenvectors for nonsymmetric A
  30. *> CES CGEES find eigenvalues/Schur form for nonsymmetric A
  31. *> CVX CGEEVX CGEEV + balancing and condition estimation
  32. *> CSX CGEESX CGEES + balancing and condition estimation
  33. *> CBD CGESVD compute SVD of an M-by-N matrix A
  34. *> CGESDD compute SVD of an M-by-N matrix A(by divide and
  35. *> conquer)
  36. *> CGEJSV compute SVD of an M-by-N matrix A where M >= N
  37. *> CGESVDX compute SVD of an M-by-N matrix A(by bisection
  38. *> and inverse iteration)
  39. *> CGESVDQ compute SVD of an M-by-N matrix A(with a
  40. *> QR-Preconditioned )
  41. *> \endverbatim
  42. *
  43. * Arguments:
  44. * ==========
  45. *
  46. *> \param[in] PATH
  47. *> \verbatim
  48. *> PATH is CHARACTER*3
  49. *> The LAPACK path name for the routines to be tested.
  50. *> \endverbatim
  51. *>
  52. *> \param[in] NUNIT
  53. *> \verbatim
  54. *> NUNIT is INTEGER
  55. *> The unit number for output.
  56. *> \endverbatim
  57. *
  58. * Authors:
  59. * ========
  60. *
  61. *> \author Univ. of Tennessee
  62. *> \author Univ. of California Berkeley
  63. *> \author Univ. of Colorado Denver
  64. *> \author NAG Ltd.
  65. *
  66. *> \ingroup complex_eig
  67. *
  68. * =====================================================================
  69. SUBROUTINE CERRED( PATH, NUNIT )
  70. *
  71. * -- LAPACK test routine --
  72. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  73. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  74. *
  75. * .. Scalar Arguments ..
  76. CHARACTER*3 PATH
  77. INTEGER NUNIT
  78. * ..
  79. *
  80. * =====================================================================
  81. *
  82. * .. Parameters ..
  83. INTEGER NMAX, LW
  84. PARAMETER ( NMAX = 4, LW = 5*NMAX )
  85. REAL ONE, ZERO
  86. PARAMETER ( ONE = 1.0E0, ZERO = 0.0E0 )
  87. * ..
  88. * .. Local Scalars ..
  89. CHARACTER*2 C2
  90. INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
  91. REAL ABNRM
  92. * ..
  93. * .. Local Arrays ..
  94. LOGICAL B( NMAX )
  95. INTEGER IW( 4*NMAX )
  96. REAL R1( NMAX ), R2( NMAX ), RW( LW ), S( NMAX )
  97. COMPLEX A( NMAX, NMAX ), U( NMAX, NMAX ),
  98. $ VL( NMAX, NMAX ), VR( NMAX, NMAX ),
  99. $ VT( NMAX, NMAX ), W( 10*NMAX ), X( NMAX )
  100. * ..
  101. * .. External Subroutines ..
  102. EXTERNAL CHKXER, CGEES, CGEESX, CGEEV, CGEEVX, CGEJSV,
  103. $ CGESDD, CGESVD, CGESVDX, CGESVDQ
  104. * ..
  105. * .. External Functions ..
  106. LOGICAL LSAMEN, CSLECT
  107. EXTERNAL LSAMEN, CSLECT
  108. * ..
  109. * .. Intrinsic Functions ..
  110. INTRINSIC LEN_TRIM
  111. * ..
  112. * .. Arrays in Common ..
  113. LOGICAL SELVAL( 20 )
  114. REAL 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 CGEEV
  148. *
  149. SRNAMT = 'CGEEV '
  150. INFOT = 1
  151. CALL CGEEV( 'X', 'N', 0, A, 1, X, VL, 1, VR, 1, W, 1, RW,
  152. $ INFO )
  153. CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
  154. INFOT = 2
  155. CALL CGEEV( 'N', 'X', 0, A, 1, X, VL, 1, VR, 1, W, 1, RW,
  156. $ INFO )
  157. CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
  158. INFOT = 3
  159. CALL CGEEV( 'N', 'N', -1, A, 1, X, VL, 1, VR, 1, W, 1, RW,
  160. $ INFO )
  161. CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
  162. INFOT = 5
  163. CALL CGEEV( 'N', 'N', 2, A, 1, X, VL, 1, VR, 1, W, 4, RW,
  164. $ INFO )
  165. CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
  166. INFOT = 8
  167. CALL CGEEV( 'V', 'N', 2, A, 2, X, VL, 1, VR, 1, W, 4, RW,
  168. $ INFO )
  169. CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
  170. INFOT = 10
  171. CALL CGEEV( 'N', 'V', 2, A, 2, X, VL, 1, VR, 1, W, 4, RW,
  172. $ INFO )
  173. CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
  174. INFOT = 12
  175. CALL CGEEV( 'V', 'V', 1, A, 1, X, VL, 1, VR, 1, W, 1, RW,
  176. $ INFO )
  177. CALL CHKXER( 'CGEEV ', INFOT, NOUT, LERR, OK )
  178. NT = NT + 7
  179. *
  180. ELSE IF( LSAMEN( 2, C2, 'ES' ) ) THEN
  181. *
  182. * Test CGEES
  183. *
  184. SRNAMT = 'CGEES '
  185. INFOT = 1
  186. CALL CGEES( 'X', 'N', CSLECT, 0, A, 1, SDIM, X, VL, 1, W, 1,
  187. $ RW, B, INFO )
  188. CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
  189. INFOT = 2
  190. CALL CGEES( 'N', 'X', CSLECT, 0, A, 1, SDIM, X, VL, 1, W, 1,
  191. $ RW, B, INFO )
  192. CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
  193. INFOT = 4
  194. CALL CGEES( 'N', 'S', CSLECT, -1, A, 1, SDIM, X, VL, 1, W, 1,
  195. $ RW, B, INFO )
  196. CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
  197. INFOT = 6
  198. CALL CGEES( 'N', 'S', CSLECT, 2, A, 1, SDIM, X, VL, 1, W, 4,
  199. $ RW, B, INFO )
  200. CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
  201. INFOT = 10
  202. CALL CGEES( 'V', 'S', CSLECT, 2, A, 2, SDIM, X, VL, 1, W, 4,
  203. $ RW, B, INFO )
  204. CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
  205. INFOT = 12
  206. CALL CGEES( 'N', 'S', CSLECT, 1, A, 1, SDIM, X, VL, 1, W, 1,
  207. $ RW, B, INFO )
  208. CALL CHKXER( 'CGEES ', INFOT, NOUT, LERR, OK )
  209. NT = NT + 6
  210. *
  211. ELSE IF( LSAMEN( 2, C2, 'VX' ) ) THEN
  212. *
  213. * Test CGEEVX
  214. *
  215. SRNAMT = 'CGEEVX'
  216. INFOT = 1
  217. CALL CGEEVX( 'X', 'N', 'N', 'N', 0, A, 1, X, VL, 1, VR, 1, ILO,
  218. $ IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
  219. CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
  220. INFOT = 2
  221. CALL CGEEVX( 'N', 'X', 'N', 'N', 0, A, 1, X, VL, 1, VR, 1, ILO,
  222. $ IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
  223. CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
  224. INFOT = 3
  225. CALL CGEEVX( 'N', 'N', 'X', 'N', 0, A, 1, X, VL, 1, VR, 1, ILO,
  226. $ IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
  227. CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
  228. INFOT = 4
  229. CALL CGEEVX( 'N', 'N', 'N', 'X', 0, A, 1, X, VL, 1, VR, 1, ILO,
  230. $ IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
  231. CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
  232. INFOT = 5
  233. CALL CGEEVX( 'N', 'N', 'N', 'N', -1, A, 1, X, VL, 1, VR, 1,
  234. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
  235. CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
  236. INFOT = 7
  237. CALL CGEEVX( 'N', 'N', 'N', 'N', 2, A, 1, X, VL, 1, VR, 1, ILO,
  238. $ IHI, S, ABNRM, R1, R2, W, 4, RW, INFO )
  239. CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
  240. INFOT = 10
  241. CALL CGEEVX( 'N', 'V', 'N', 'N', 2, A, 2, X, VL, 1, VR, 1, ILO,
  242. $ IHI, S, ABNRM, R1, R2, W, 4, RW, INFO )
  243. CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
  244. INFOT = 12
  245. CALL CGEEVX( 'N', 'N', 'V', 'N', 2, A, 2, X, VL, 1, VR, 1, ILO,
  246. $ IHI, S, ABNRM, R1, R2, W, 4, RW, INFO )
  247. CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
  248. INFOT = 20
  249. CALL CGEEVX( 'N', 'N', 'N', 'N', 1, A, 1, X, VL, 1, VR, 1, ILO,
  250. $ IHI, S, ABNRM, R1, R2, W, 1, RW, INFO )
  251. CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
  252. INFOT = 20
  253. CALL CGEEVX( 'N', 'N', 'V', 'V', 1, A, 1, X, VL, 1, VR, 1, ILO,
  254. $ IHI, S, ABNRM, R1, R2, W, 2, RW, INFO )
  255. CALL CHKXER( 'CGEEVX', INFOT, NOUT, LERR, OK )
  256. NT = NT + 10
  257. *
  258. ELSE IF( LSAMEN( 2, C2, 'SX' ) ) THEN
  259. *
  260. * Test CGEESX
  261. *
  262. SRNAMT = 'CGEESX'
  263. INFOT = 1
  264. CALL CGEESX( 'X', 'N', CSLECT, 'N', 0, A, 1, SDIM, X, VL, 1,
  265. $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
  266. CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
  267. INFOT = 2
  268. CALL CGEESX( 'N', 'X', CSLECT, 'N', 0, A, 1, SDIM, X, VL, 1,
  269. $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
  270. CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
  271. INFOT = 4
  272. CALL CGEESX( 'N', 'N', CSLECT, 'X', 0, A, 1, SDIM, X, VL, 1,
  273. $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
  274. CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
  275. INFOT = 5
  276. CALL CGEESX( 'N', 'N', CSLECT, 'N', -1, A, 1, SDIM, X, VL, 1,
  277. $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
  278. CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
  279. INFOT = 7
  280. CALL CGEESX( 'N', 'N', CSLECT, 'N', 2, A, 1, SDIM, X, VL, 1,
  281. $ R1( 1 ), R2( 1 ), W, 4, RW, B, INFO )
  282. CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
  283. INFOT = 11
  284. CALL CGEESX( 'V', 'N', CSLECT, 'N', 2, A, 2, SDIM, X, VL, 1,
  285. $ R1( 1 ), R2( 1 ), W, 4, RW, B, INFO )
  286. CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
  287. INFOT = 15
  288. CALL CGEESX( 'N', 'N', CSLECT, 'N', 1, A, 1, SDIM, X, VL, 1,
  289. $ R1( 1 ), R2( 1 ), W, 1, RW, B, INFO )
  290. CALL CHKXER( 'CGEESX', INFOT, NOUT, LERR, OK )
  291. NT = NT + 7
  292. *
  293. ELSE IF( LSAMEN( 2, C2, 'BD' ) ) THEN
  294. *
  295. * Test CGESVD
  296. *
  297. SRNAMT = 'CGESVD'
  298. INFOT = 1
  299. CALL CGESVD( 'X', 'N', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW,
  300. $ INFO )
  301. CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
  302. INFOT = 2
  303. CALL CGESVD( 'N', 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW,
  304. $ INFO )
  305. CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
  306. INFOT = 2
  307. CALL CGESVD( 'O', 'O', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW,
  308. $ INFO )
  309. CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
  310. INFOT = 3
  311. CALL CGESVD( 'N', 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, RW,
  312. $ INFO )
  313. CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
  314. INFOT = 4
  315. CALL CGESVD( 'N', 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, RW,
  316. $ INFO )
  317. CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
  318. INFOT = 6
  319. CALL CGESVD( 'N', 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, RW,
  320. $ INFO )
  321. CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
  322. INFOT = 9
  323. CALL CGESVD( 'A', 'N', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, RW,
  324. $ INFO )
  325. CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
  326. INFOT = 11
  327. CALL CGESVD( 'N', 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, RW,
  328. $ INFO )
  329. CALL CHKXER( 'CGESVD', INFOT, NOUT, LERR, OK )
  330. NT = NT + 8
  331. IF( OK ) THEN
  332. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  333. $ NT
  334. ELSE
  335. WRITE( NOUT, FMT = 9998 )
  336. END IF
  337. *
  338. * Test CGESDD
  339. *
  340. SRNAMT = 'CGESDD'
  341. INFOT = 1
  342. CALL CGESDD( 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, RW, IW,
  343. $ INFO )
  344. CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
  345. INFOT = 2
  346. CALL CGESDD( 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, RW, IW,
  347. $ INFO )
  348. CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
  349. INFOT = 3
  350. CALL CGESDD( 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, RW, IW,
  351. $ INFO )
  352. CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
  353. INFOT = 5
  354. CALL CGESDD( 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, RW, IW,
  355. $ INFO )
  356. CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
  357. INFOT = 8
  358. CALL CGESDD( 'A', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, RW, IW,
  359. $ INFO )
  360. CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
  361. INFOT = 10
  362. CALL CGESDD( 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, RW, IW,
  363. $ INFO )
  364. CALL CHKXER( 'CGESDD', INFOT, NOUT, LERR, OK )
  365. NT = NT - 2
  366. IF( OK ) THEN
  367. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  368. $ NT
  369. ELSE
  370. WRITE( NOUT, FMT = 9998 )
  371. END IF
  372. *
  373. * Test CGEJSV
  374. *
  375. SRNAMT = 'CGEJSV'
  376. INFOT = 1
  377. CALL CGEJSV( 'X', 'U', 'V', 'R', 'N', 'N',
  378. $ 0, 0, A, 1, S, U, 1, VT, 1,
  379. $ W, 1, RW, 1, IW, INFO)
  380. CALL CHKXER( 'CGEJSV', INFOT, NOUT, LERR, OK )
  381. INFOT = 2
  382. CALL CGEJSV( 'G', 'X', 'V', 'R', 'N', 'N',
  383. $ 0, 0, A, 1, S, U, 1, VT, 1,
  384. $ W, 1, RW, 1, IW, INFO)
  385. CALL CHKXER( 'CGEJSV', INFOT, NOUT, LERR, OK )
  386. INFOT = 3
  387. CALL CGEJSV( 'G', 'U', 'X', 'R', 'N', 'N',
  388. $ 0, 0, A, 1, S, U, 1, VT, 1,
  389. $ W, 1, RW, 1, IW, INFO)
  390. CALL CHKXER( 'CGEJSV', INFOT, NOUT, LERR, OK )
  391. INFOT = 4
  392. CALL CGEJSV( 'G', 'U', 'V', 'X', 'N', 'N',
  393. $ 0, 0, A, 1, S, U, 1, VT, 1,
  394. $ W, 1, RW, 1, IW, INFO)
  395. CALL CHKXER( 'CGEJSV', INFOT, NOUT, LERR, OK )
  396. INFOT = 5
  397. CALL CGEJSV( 'G', 'U', 'V', 'R', 'X', 'N',
  398. $ 0, 0, A, 1, S, U, 1, VT, 1,
  399. $ W, 1, RW, 1, IW, INFO)
  400. CALL CHKXER( 'CGEJSV', INFOT, NOUT, LERR, OK )
  401. INFOT = 6
  402. CALL CGEJSV( 'G', 'U', 'V', 'R', 'N', 'X',
  403. $ 0, 0, A, 1, S, U, 1, VT, 1,
  404. $ W, 1, RW, 1, IW, INFO)
  405. CALL CHKXER( 'CGEJSV', INFOT, NOUT, LERR, OK )
  406. INFOT = 7
  407. CALL CGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  408. $ -1, 0, A, 1, S, U, 1, VT, 1,
  409. $ W, 1, RW, 1, IW, INFO)
  410. CALL CHKXER( 'CGEJSV', INFOT, NOUT, LERR, OK )
  411. INFOT = 8
  412. CALL CGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  413. $ 0, -1, A, 1, S, U, 1, VT, 1,
  414. $ W, 1, RW, 1, IW, INFO)
  415. CALL CHKXER( 'CGEJSV', INFOT, NOUT, LERR, OK )
  416. INFOT = 10
  417. CALL CGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  418. $ 2, 1, A, 1, S, U, 1, VT, 1,
  419. $ W, 1, RW, 1, IW, INFO)
  420. CALL CHKXER( 'CGEJSV', INFOT, NOUT, LERR, OK )
  421. INFOT = 13
  422. CALL CGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  423. $ 2, 2, A, 2, S, U, 1, VT, 2,
  424. $ W, 1, RW, 1, IW, INFO)
  425. CALL CHKXER( 'CGEJSV', INFOT, NOUT, LERR, OK )
  426. INFOT = 15
  427. CALL CGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  428. $ 2, 2, A, 2, S, U, 2, VT, 1,
  429. $ W, 1, RW, 1, IW, INFO)
  430. CALL CHKXER( 'CGEJSV', INFOT, NOUT, LERR, OK )
  431. NT = 11
  432. IF( OK ) THEN
  433. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  434. $ NT
  435. ELSE
  436. WRITE( NOUT, FMT = 9998 )
  437. END IF
  438. *
  439. * Test CGESVDX
  440. *
  441. SRNAMT = 'CGESVDX'
  442. INFOT = 1
  443. CALL CGESVDX( 'X', 'N', 'A', 0, 0, A, 1, ZERO, ZERO,
  444. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  445. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  446. INFOT = 2
  447. CALL CGESVDX( 'N', 'X', 'A', 0, 0, A, 1, ZERO, ZERO,
  448. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  449. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  450. INFOT = 3
  451. CALL CGESVDX( 'N', 'N', 'X', 0, 0, A, 1, ZERO, ZERO,
  452. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  453. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  454. INFOT = 4
  455. CALL CGESVDX( 'N', 'N', 'A', -1, 0, A, 1, ZERO, ZERO,
  456. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  457. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  458. INFOT = 5
  459. CALL CGESVDX( 'N', 'N', 'A', 0, -1, A, 1, ZERO, ZERO,
  460. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  461. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  462. INFOT = 7
  463. CALL CGESVDX( 'N', 'N', 'A', 2, 1, A, 1, ZERO, ZERO,
  464. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  465. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  466. INFOT = 8
  467. CALL CGESVDX( 'N', 'N', 'V', 2, 1, A, 2, -ONE, ZERO,
  468. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  469. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  470. INFOT = 9
  471. CALL CGESVDX( 'N', 'N', 'V', 2, 1, A, 2, ONE, ZERO,
  472. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  473. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  474. INFOT = 10
  475. CALL CGESVDX( 'N', 'N', 'I', 2, 2, A, 2, ZERO, ZERO,
  476. $ 0, 1, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  477. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  478. INFOT = 11
  479. CALL CGESVDX( 'V', 'N', 'I', 2, 2, A, 2, ZERO, ZERO,
  480. $ 1, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  481. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  482. INFOT = 15
  483. CALL CGESVDX( 'V', 'N', 'A', 2, 2, A, 2, ZERO, ZERO,
  484. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  485. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  486. INFOT = 17
  487. CALL CGESVDX( 'N', 'V', 'A', 2, 2, A, 2, ZERO, ZERO,
  488. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, RW, IW, INFO )
  489. CALL CHKXER( 'CGESVDX', INFOT, NOUT, LERR, OK )
  490. NT = 12
  491. IF( OK ) THEN
  492. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  493. $ NT
  494. ELSE
  495. WRITE( NOUT, FMT = 9998 )
  496. END IF
  497. *
  498. * Test CGESVDQ
  499. *
  500. SRNAMT = 'CGESVDQ'
  501. INFOT = 1
  502. CALL CGESVDQ( 'X', 'P', 'T', 'A', 'A', 0, 0, A, 1, S, U,
  503. $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
  504. CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
  505. INFOT = 2
  506. CALL CGESVDQ( 'A', 'X', 'T', 'A', 'A', 0, 0, A, 1, S, U,
  507. $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
  508. CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
  509. INFOT = 3
  510. CALL CGESVDQ( 'A', 'P', 'X', 'A', 'A', 0, 0, A, 1, S, U,
  511. $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
  512. CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
  513. INFOT = 4
  514. CALL CGESVDQ( 'A', 'P', 'T', 'X', 'A', 0, 0, A, 1, S, U,
  515. $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
  516. CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
  517. INFOT = 5
  518. CALL CGESVDQ( 'A', 'P', 'T', 'A', 'X', 0, 0, A, 1, S, U,
  519. $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
  520. CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
  521. INFOT = 6
  522. CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', -1, 0, A, 1, S, U,
  523. $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
  524. CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
  525. INFOT = 7
  526. CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 0, 1, A, 1, S, U,
  527. $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
  528. CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
  529. INFOT = 9
  530. CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 0, S, U,
  531. $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
  532. CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
  533. INFOT = 12
  534. CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
  535. $ -1, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
  536. CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
  537. INFOT = 14
  538. CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
  539. $ 1, VT, -1, NS, IW, 1, W, 1, RW, 1, INFO )
  540. CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
  541. INFOT = 17
  542. CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
  543. $ 1, VT, 1, NS, IW, -5, W, 1, RW, 1, INFO )
  544. CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
  545. NT = 11
  546. IF( OK ) THEN
  547. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  548. $ NT
  549. ELSE
  550. WRITE( NOUT, FMT = 9998 )
  551. END IF
  552. END IF
  553. *
  554. * Print a summary line.
  555. *
  556. IF( .NOT.LSAMEN( 2, C2, 'BD' ) ) THEN
  557. IF( OK ) THEN
  558. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  559. $ NT
  560. ELSE
  561. WRITE( NOUT, FMT = 9998 )
  562. END IF
  563. END IF
  564. *
  565. 9999 FORMAT( 1X, A, ' passed the tests of the error exits (', I3,
  566. $ ' tests done)' )
  567. 9998 FORMAT( ' *** ', A, ' failed the tests of the error exits ***' )
  568. RETURN
  569. *
  570. * End of CERRED
  571. *
  572. END