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.

serred.f 22 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563
  1. *> \brief \b SERRED
  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 SERRED( 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. *> SERRED tests the error exits for the eigenvalue driver routines for
  25. *> REAL matrices:
  26. *>
  27. *> PATH driver description
  28. *> ---- ------ -----------
  29. *> SEV SGEEV find eigenvalues/eigenvectors for nonsymmetric A
  30. *> SES SGEES find eigenvalues/Schur form for nonsymmetric A
  31. *> SVX SGEEVX SGEEV + balancing and condition estimation
  32. *> SSX SGEESX SGEES + balancing and condition estimation
  33. *> SBD SGESVD compute SVD of an M-by-N matrix A
  34. *> SGESDD compute SVD of an M-by-N matrix A (by divide and
  35. *> conquer)
  36. *> SGEJSV compute SVD of an M-by-N matrix A where M >= N
  37. *> SGESVDX compute SVD of an M-by-N matrix A(by bisection
  38. *> and inverse iteration)
  39. *> SGESVDQ 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 single_eig
  67. *
  68. * =====================================================================
  69. SUBROUTINE SERRED( 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
  84. REAL ONE, ZERO
  85. PARAMETER ( NMAX = 4, ONE = 1.0E0, ZERO = 0.0E0 )
  86. * ..
  87. * .. Local Scalars ..
  88. CHARACTER*2 C2
  89. INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM
  90. REAL ABNRM
  91. * ..
  92. * .. Local Arrays ..
  93. LOGICAL B( NMAX )
  94. INTEGER IW( 2*NMAX )
  95. REAL A( NMAX, NMAX ), R1( NMAX ), R2( NMAX ),
  96. $ S( NMAX ), U( NMAX, NMAX ), VL( NMAX, NMAX ),
  97. $ VR( NMAX, NMAX ), VT( NMAX, NMAX ),
  98. $ W( 10*NMAX ), WI( NMAX ), WR( NMAX )
  99. * ..
  100. * .. External Subroutines ..
  101. EXTERNAL CHKXER, SGEES, SGEESX, SGEEV, SGEEVX, SGEJSV,
  102. $ SGESDD, SGESVD, SGESVDX, SGESVDQ
  103. * ..
  104. * .. External Functions ..
  105. LOGICAL SSLECT, LSAMEN
  106. EXTERNAL SSLECT, LSAMEN
  107. * ..
  108. * .. Intrinsic Functions ..
  109. INTRINSIC LEN_TRIM
  110. * ..
  111. * .. Arrays in Common ..
  112. LOGICAL SELVAL( 20 )
  113. REAL SELWI( 20 ), SELWR( 20 )
  114. * ..
  115. * .. Scalars in Common ..
  116. LOGICAL LERR, OK
  117. CHARACTER*32 SRNAMT
  118. INTEGER INFOT, NOUT, SELDIM, SELOPT
  119. * ..
  120. * .. Common blocks ..
  121. COMMON / INFOC / INFOT, NOUT, OK, LERR
  122. COMMON / SRNAMC / SRNAMT
  123. COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI
  124. * ..
  125. * .. Executable Statements ..
  126. *
  127. NOUT = NUNIT
  128. WRITE( NOUT, FMT = * )
  129. C2 = PATH( 2: 3 )
  130. *
  131. * Initialize A
  132. *
  133. DO 20 J = 1, NMAX
  134. DO 10 I = 1, NMAX
  135. A( I, J ) = ZERO
  136. 10 CONTINUE
  137. 20 CONTINUE
  138. DO 30 I = 1, NMAX
  139. A( I, I ) = ONE
  140. 30 CONTINUE
  141. OK = .TRUE.
  142. NT = 0
  143. *
  144. IF( LSAMEN( 2, C2, 'EV' ) ) THEN
  145. *
  146. * Test SGEEV
  147. *
  148. SRNAMT = 'SGEEV '
  149. INFOT = 1
  150. CALL SGEEV( 'X', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1,
  151. $ INFO )
  152. CALL CHKXER( 'SGEEV ', INFOT, NOUT, LERR, OK )
  153. INFOT = 2
  154. CALL SGEEV( 'N', 'X', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1,
  155. $ INFO )
  156. CALL CHKXER( 'SGEEV ', INFOT, NOUT, LERR, OK )
  157. INFOT = 3
  158. CALL SGEEV( 'N', 'N', -1, A, 1, WR, WI, VL, 1, VR, 1, W, 1,
  159. $ INFO )
  160. CALL CHKXER( 'SGEEV ', INFOT, NOUT, LERR, OK )
  161. INFOT = 5
  162. CALL SGEEV( 'N', 'N', 2, A, 1, WR, WI, VL, 1, VR, 1, W, 6,
  163. $ INFO )
  164. CALL CHKXER( 'SGEEV ', INFOT, NOUT, LERR, OK )
  165. INFOT = 9
  166. CALL SGEEV( 'V', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1, W, 8,
  167. $ INFO )
  168. CALL CHKXER( 'SGEEV ', INFOT, NOUT, LERR, OK )
  169. INFOT = 11
  170. CALL SGEEV( 'N', 'V', 2, A, 2, WR, WI, VL, 1, VR, 1, W, 8,
  171. $ INFO )
  172. CALL CHKXER( 'SGEEV ', INFOT, NOUT, LERR, OK )
  173. INFOT = 13
  174. CALL SGEEV( 'V', 'V', 1, A, 1, WR, WI, VL, 1, VR, 1, W, 3,
  175. $ INFO )
  176. CALL CHKXER( 'SGEEV ', INFOT, NOUT, LERR, OK )
  177. NT = NT + 7
  178. *
  179. ELSE IF( LSAMEN( 2, C2, 'ES' ) ) THEN
  180. *
  181. * Test SGEES
  182. *
  183. SRNAMT = 'SGEES '
  184. INFOT = 1
  185. CALL SGEES( 'X', 'N', SSLECT, 0, A, 1, SDIM, WR, WI, VL, 1, W,
  186. $ 1, B, INFO )
  187. CALL CHKXER( 'SGEES ', INFOT, NOUT, LERR, OK )
  188. INFOT = 2
  189. CALL SGEES( 'N', 'X', SSLECT, 0, A, 1, SDIM, WR, WI, VL, 1, W,
  190. $ 1, B, INFO )
  191. CALL CHKXER( 'SGEES ', INFOT, NOUT, LERR, OK )
  192. INFOT = 4
  193. CALL SGEES( 'N', 'S', SSLECT, -1, A, 1, SDIM, WR, WI, VL, 1, W,
  194. $ 1, B, INFO )
  195. CALL CHKXER( 'SGEES ', INFOT, NOUT, LERR, OK )
  196. INFOT = 6
  197. CALL SGEES( 'N', 'S', SSLECT, 2, A, 1, SDIM, WR, WI, VL, 1, W,
  198. $ 6, B, INFO )
  199. CALL CHKXER( 'SGEES ', INFOT, NOUT, LERR, OK )
  200. INFOT = 11
  201. CALL SGEES( 'V', 'S', SSLECT, 2, A, 2, SDIM, WR, WI, VL, 1, W,
  202. $ 6, B, INFO )
  203. CALL CHKXER( 'SGEES ', INFOT, NOUT, LERR, OK )
  204. INFOT = 13
  205. CALL SGEES( 'N', 'S', SSLECT, 1, A, 1, SDIM, WR, WI, VL, 1, W,
  206. $ 2, B, INFO )
  207. CALL CHKXER( 'SGEES ', INFOT, NOUT, LERR, OK )
  208. NT = NT + 6
  209. *
  210. ELSE IF( LSAMEN( 2, C2, 'VX' ) ) THEN
  211. *
  212. * Test SGEEVX
  213. *
  214. SRNAMT = 'SGEEVX'
  215. INFOT = 1
  216. CALL SGEEVX( 'X', 'N', 'N', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1,
  217. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  218. CALL CHKXER( 'SGEEVX', INFOT, NOUT, LERR, OK )
  219. INFOT = 2
  220. CALL SGEEVX( 'N', 'X', 'N', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1,
  221. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  222. CALL CHKXER( 'SGEEVX', INFOT, NOUT, LERR, OK )
  223. INFOT = 3
  224. CALL SGEEVX( 'N', 'N', 'X', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1,
  225. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  226. CALL CHKXER( 'SGEEVX', INFOT, NOUT, LERR, OK )
  227. INFOT = 4
  228. CALL SGEEVX( 'N', 'N', 'N', 'X', 0, A, 1, WR, WI, VL, 1, VR, 1,
  229. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  230. CALL CHKXER( 'SGEEVX', INFOT, NOUT, LERR, OK )
  231. INFOT = 5
  232. CALL SGEEVX( 'N', 'N', 'N', 'N', -1, A, 1, WR, WI, VL, 1, VR,
  233. $ 1, ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  234. CALL CHKXER( 'SGEEVX', INFOT, NOUT, LERR, OK )
  235. INFOT = 7
  236. CALL SGEEVX( 'N', 'N', 'N', 'N', 2, A, 1, WR, WI, VL, 1, VR, 1,
  237. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  238. CALL CHKXER( 'SGEEVX', INFOT, NOUT, LERR, OK )
  239. INFOT = 11
  240. CALL SGEEVX( 'N', 'V', 'N', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1,
  241. $ ILO, IHI, S, ABNRM, R1, R2, W, 6, IW, INFO )
  242. CALL CHKXER( 'SGEEVX', INFOT, NOUT, LERR, OK )
  243. INFOT = 13
  244. CALL SGEEVX( 'N', 'N', 'V', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1,
  245. $ ILO, IHI, S, ABNRM, R1, R2, W, 6, IW, INFO )
  246. CALL CHKXER( 'SGEEVX', INFOT, NOUT, LERR, OK )
  247. INFOT = 21
  248. CALL SGEEVX( 'N', 'N', 'N', 'N', 1, A, 1, WR, WI, VL, 1, VR, 1,
  249. $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO )
  250. CALL CHKXER( 'SGEEVX', INFOT, NOUT, LERR, OK )
  251. INFOT = 21
  252. CALL SGEEVX( 'N', 'V', 'N', 'N', 1, A, 1, WR, WI, VL, 1, VR, 1,
  253. $ ILO, IHI, S, ABNRM, R1, R2, W, 2, IW, INFO )
  254. CALL CHKXER( 'SGEEVX', INFOT, NOUT, LERR, OK )
  255. INFOT = 21
  256. CALL SGEEVX( 'N', 'N', 'V', 'V', 1, A, 1, WR, WI, VL, 1, VR, 1,
  257. $ ILO, IHI, S, ABNRM, R1, R2, W, 3, IW, INFO )
  258. CALL CHKXER( 'SGEEVX', INFOT, NOUT, LERR, OK )
  259. NT = NT + 11
  260. *
  261. ELSE IF( LSAMEN( 2, C2, 'SX' ) ) THEN
  262. *
  263. * Test SGEESX
  264. *
  265. SRNAMT = 'SGEESX'
  266. INFOT = 1
  267. CALL SGEESX( 'X', 'N', SSLECT, 'N', 0, A, 1, SDIM, WR, WI, VL,
  268. $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
  269. CALL CHKXER( 'SGEESX', INFOT, NOUT, LERR, OK )
  270. INFOT = 2
  271. CALL SGEESX( 'N', 'X', SSLECT, 'N', 0, A, 1, SDIM, WR, WI, VL,
  272. $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
  273. CALL CHKXER( 'SGEESX', INFOT, NOUT, LERR, OK )
  274. INFOT = 4
  275. CALL SGEESX( 'N', 'N', SSLECT, 'X', 0, A, 1, SDIM, WR, WI, VL,
  276. $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
  277. CALL CHKXER( 'SGEESX', INFOT, NOUT, LERR, OK )
  278. INFOT = 5
  279. CALL SGEESX( 'N', 'N', SSLECT, 'N', -1, A, 1, SDIM, WR, WI, VL,
  280. $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO )
  281. CALL CHKXER( 'SGEESX', INFOT, NOUT, LERR, OK )
  282. INFOT = 7
  283. CALL SGEESX( 'N', 'N', SSLECT, 'N', 2, A, 1, SDIM, WR, WI, VL,
  284. $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO )
  285. CALL CHKXER( 'SGEESX', INFOT, NOUT, LERR, OK )
  286. INFOT = 12
  287. CALL SGEESX( 'V', 'N', SSLECT, 'N', 2, A, 2, SDIM, WR, WI, VL,
  288. $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO )
  289. CALL CHKXER( 'SGEESX', INFOT, NOUT, LERR, OK )
  290. INFOT = 16
  291. CALL SGEESX( 'N', 'N', SSLECT, 'N', 1, A, 1, SDIM, WR, WI, VL,
  292. $ 1, R1( 1 ), R2( 1 ), W, 2, IW, 1, B, INFO )
  293. CALL CHKXER( 'SGEESX', INFOT, NOUT, LERR, OK )
  294. NT = NT + 7
  295. *
  296. ELSE IF( LSAMEN( 2, C2, 'BD' ) ) THEN
  297. *
  298. * Test SGESVD
  299. *
  300. SRNAMT = 'SGESVD'
  301. INFOT = 1
  302. CALL SGESVD( 'X', 'N', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
  303. CALL CHKXER( 'SGESVD', INFOT, NOUT, LERR, OK )
  304. INFOT = 2
  305. CALL SGESVD( 'N', 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
  306. CALL CHKXER( 'SGESVD', INFOT, NOUT, LERR, OK )
  307. INFOT = 2
  308. CALL SGESVD( 'O', 'O', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO )
  309. CALL CHKXER( 'SGESVD', INFOT, NOUT, LERR, OK )
  310. INFOT = 3
  311. CALL SGESVD( 'N', 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1,
  312. $ INFO )
  313. CALL CHKXER( 'SGESVD', INFOT, NOUT, LERR, OK )
  314. INFOT = 4
  315. CALL SGESVD( 'N', 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1,
  316. $ INFO )
  317. CALL CHKXER( 'SGESVD', INFOT, NOUT, LERR, OK )
  318. INFOT = 6
  319. CALL SGESVD( 'N', 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, INFO )
  320. CALL CHKXER( 'SGESVD', INFOT, NOUT, LERR, OK )
  321. INFOT = 9
  322. CALL SGESVD( 'A', 'N', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, INFO )
  323. CALL CHKXER( 'SGESVD', INFOT, NOUT, LERR, OK )
  324. INFOT = 11
  325. CALL SGESVD( 'N', 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, INFO )
  326. CALL CHKXER( 'SGESVD', INFOT, NOUT, LERR, OK )
  327. NT = 8
  328. IF( OK ) THEN
  329. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  330. $ NT
  331. ELSE
  332. WRITE( NOUT, FMT = 9998 )
  333. END IF
  334. *
  335. * Test SGESDD
  336. *
  337. SRNAMT = 'SGESDD'
  338. INFOT = 1
  339. CALL SGESDD( 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO )
  340. CALL CHKXER( 'SGESDD', INFOT, NOUT, LERR, OK )
  341. INFOT = 2
  342. CALL SGESDD( 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO )
  343. CALL CHKXER( 'SGESDD', INFOT, NOUT, LERR, OK )
  344. INFOT = 3
  345. CALL SGESDD( 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO )
  346. CALL CHKXER( 'SGESDD', INFOT, NOUT, LERR, OK )
  347. INFOT = 5
  348. CALL SGESDD( 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO )
  349. CALL CHKXER( 'SGESDD', INFOT, NOUT, LERR, OK )
  350. INFOT = 8
  351. CALL SGESDD( 'A', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, IW, INFO )
  352. CALL CHKXER( 'SGESDD', INFOT, NOUT, LERR, OK )
  353. INFOT = 10
  354. CALL SGESDD( 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO )
  355. CALL CHKXER( 'SGESDD', INFOT, NOUT, LERR, OK )
  356. NT = 6
  357. IF( OK ) THEN
  358. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  359. $ NT
  360. ELSE
  361. WRITE( NOUT, FMT = 9998 )
  362. END IF
  363. *
  364. * Test SGEJSV
  365. *
  366. SRNAMT = 'SGEJSV'
  367. INFOT = 1
  368. CALL SGEJSV( 'X', 'U', 'V', 'R', 'N', 'N',
  369. $ 0, 0, A, 1, S, U, 1, VT, 1,
  370. $ W, 1, IW, INFO)
  371. CALL CHKXER( 'SGEJSV', INFOT, NOUT, LERR, OK )
  372. INFOT = 2
  373. CALL SGEJSV( 'G', 'X', 'V', 'R', 'N', 'N',
  374. $ 0, 0, A, 1, S, U, 1, VT, 1,
  375. $ W, 1, IW, INFO)
  376. CALL CHKXER( 'SGEJSV', INFOT, NOUT, LERR, OK )
  377. INFOT = 3
  378. CALL SGEJSV( 'G', 'U', 'X', 'R', 'N', 'N',
  379. $ 0, 0, A, 1, S, U, 1, VT, 1,
  380. $ W, 1, IW, INFO)
  381. CALL CHKXER( 'SGEJSV', INFOT, NOUT, LERR, OK )
  382. INFOT = 4
  383. CALL SGEJSV( 'G', 'U', 'V', 'X', 'N', 'N',
  384. $ 0, 0, A, 1, S, U, 1, VT, 1,
  385. $ W, 1, IW, INFO)
  386. CALL CHKXER( 'SGEJSV', INFOT, NOUT, LERR, OK )
  387. INFOT = 5
  388. CALL SGEJSV( 'G', 'U', 'V', 'R', 'X', 'N',
  389. $ 0, 0, A, 1, S, U, 1, VT, 1,
  390. $ W, 1, IW, INFO)
  391. CALL CHKXER( 'SGEJSV', INFOT, NOUT, LERR, OK )
  392. INFOT = 6
  393. CALL SGEJSV( 'G', 'U', 'V', 'R', 'N', 'X',
  394. $ 0, 0, A, 1, S, U, 1, VT, 1,
  395. $ W, 1, IW, INFO)
  396. CALL CHKXER( 'SGEJSV', INFOT, NOUT, LERR, OK )
  397. INFOT = 7
  398. CALL SGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  399. $ -1, 0, A, 1, S, U, 1, VT, 1,
  400. $ W, 1, IW, INFO)
  401. CALL CHKXER( 'SGEJSV', INFOT, NOUT, LERR, OK )
  402. INFOT = 8
  403. CALL SGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  404. $ 0, -1, A, 1, S, U, 1, VT, 1,
  405. $ W, 1, IW, INFO)
  406. CALL CHKXER( 'SGEJSV', INFOT, NOUT, LERR, OK )
  407. INFOT = 10
  408. CALL SGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  409. $ 2, 1, A, 1, S, U, 1, VT, 1,
  410. $ W, 1, IW, INFO)
  411. CALL CHKXER( 'SGEJSV', INFOT, NOUT, LERR, OK )
  412. INFOT = 13
  413. CALL SGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  414. $ 2, 2, A, 2, S, U, 1, VT, 2,
  415. $ W, 1, IW, INFO)
  416. CALL CHKXER( 'SGEJSV', INFOT, NOUT, LERR, OK )
  417. INFOT = 15
  418. CALL SGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  419. $ 2, 2, A, 2, S, U, 2, VT, 1,
  420. $ W, 1, IW, INFO)
  421. CALL CHKXER( 'SGEJSV', INFOT, NOUT, LERR, OK )
  422. NT = 11
  423. IF( OK ) THEN
  424. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  425. $ NT
  426. ELSE
  427. WRITE( NOUT, FMT = 9998 )
  428. END IF
  429. *
  430. * Test SGESVDX
  431. *
  432. SRNAMT = 'SGESVDX'
  433. INFOT = 1
  434. CALL SGESVDX( 'X', 'N', 'A', 0, 0, A, 1, ZERO, ZERO,
  435. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  436. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  437. INFOT = 2
  438. CALL SGESVDX( 'N', 'X', 'A', 0, 0, A, 1, ZERO, ZERO,
  439. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  440. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  441. INFOT = 3
  442. CALL SGESVDX( 'N', 'N', 'X', 0, 0, A, 1, ZERO, ZERO,
  443. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  444. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  445. INFOT = 4
  446. CALL SGESVDX( 'N', 'N', 'A', -1, 0, A, 1, ZERO, ZERO,
  447. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  448. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  449. INFOT = 5
  450. CALL SGESVDX( 'N', 'N', 'A', 0, -1, A, 1, ZERO, ZERO,
  451. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  452. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  453. INFOT = 7
  454. CALL SGESVDX( 'N', 'N', 'A', 2, 1, A, 1, ZERO, ZERO,
  455. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  456. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  457. INFOT = 8
  458. CALL SGESVDX( 'N', 'N', 'V', 2, 1, A, 2, -ONE, ZERO,
  459. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  460. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  461. INFOT = 9
  462. CALL SGESVDX( 'N', 'N', 'V', 2, 1, A, 2, ONE, ZERO,
  463. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  464. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  465. INFOT = 10
  466. CALL SGESVDX( 'N', 'N', 'I', 2, 2, A, 2, ZERO, ZERO,
  467. $ 0, 1, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  468. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  469. INFOT = 11
  470. CALL SGESVDX( 'V', 'N', 'I', 2, 2, A, 2, ZERO, ZERO,
  471. $ 1, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  472. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  473. INFOT = 15
  474. CALL SGESVDX( 'V', 'N', 'A', 2, 2, A, 2, ZERO, ZERO,
  475. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  476. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  477. INFOT = 17
  478. CALL SGESVDX( 'N', 'V', 'A', 2, 2, A, 2, ZERO, ZERO,
  479. $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO )
  480. CALL CHKXER( 'SGESVDX', INFOT, NOUT, LERR, OK )
  481. NT = 12
  482. IF( OK ) THEN
  483. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  484. $ NT
  485. ELSE
  486. WRITE( NOUT, FMT = 9998 )
  487. END IF
  488. *
  489. * Test SGESVDQ
  490. *
  491. SRNAMT = 'SGESVDQ'
  492. INFOT = 1
  493. CALL SGESVDQ( 'X', 'P', 'T', 'A', 'A', 0, 0, A, 1, S, U,
  494. $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
  495. CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
  496. INFOT = 2
  497. CALL SGESVDQ( 'A', 'X', 'T', 'A', 'A', 0, 0, A, 1, S, U,
  498. $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
  499. CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
  500. INFOT = 3
  501. CALL SGESVDQ( 'A', 'P', 'X', 'A', 'A', 0, 0, A, 1, S, U,
  502. $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
  503. CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
  504. INFOT = 4
  505. CALL SGESVDQ( 'A', 'P', 'T', 'X', 'A', 0, 0, A, 1, S, U,
  506. $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
  507. CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
  508. INFOT = 5
  509. CALL SGESVDQ( 'A', 'P', 'T', 'A', 'X', 0, 0, A, 1, S, U,
  510. $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
  511. CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
  512. INFOT = 6
  513. CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', -1, 0, A, 1, S, U,
  514. $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
  515. CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
  516. INFOT = 7
  517. CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 0, 1, A, 1, S, U,
  518. $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
  519. CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
  520. INFOT = 9
  521. CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 0, S, U,
  522. $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
  523. CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
  524. INFOT = 12
  525. CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
  526. $ -1, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
  527. CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
  528. INFOT = 14
  529. CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
  530. $ 1, VT, -1, NS, IW, 1, W, 1, W, 1, INFO )
  531. CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
  532. INFOT = 17
  533. CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
  534. $ 1, VT, 1, NS, IW, -5, W, 1, W, 1, INFO )
  535. CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
  536. NT = 11
  537. IF( OK ) THEN
  538. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  539. $ NT
  540. ELSE
  541. WRITE( NOUT, FMT = 9998 )
  542. END IF
  543. END IF
  544. *
  545. * Print a summary line.
  546. *
  547. IF( .NOT.LSAMEN( 2, C2, 'BD' ) ) THEN
  548. IF( OK ) THEN
  549. WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
  550. $ NT
  551. ELSE
  552. WRITE( NOUT, FMT = 9998 )
  553. END IF
  554. END IF
  555. *
  556. 9999 FORMAT( 1X, A, ' passed the tests of the error exits (', I3,
  557. $ ' tests done)' )
  558. 9998 FORMAT( ' *** ', A, ' failed the tests of the error exits ***' )
  559. RETURN
  560. *
  561. * End of SERRED
  562. *
  563. END