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.

sdrvbd.f 46 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251
  1. *> \brief \b SDRVBD
  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 SDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
  12. * A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S,
  13. * SSAV, E, WORK, LWORK, IWORK, NOUT, INFO )
  14. *
  15. * .. Scalar Arguments ..
  16. * INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES,
  17. * $ NTYPES
  18. * REAL THRESH
  19. * ..
  20. * .. Array Arguments ..
  21. * LOGICAL DOTYPE( * )
  22. * INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
  23. * REAL A( LDA, * ), ASAV( LDA, * ), E( * ), S( * ),
  24. * $ SSAV( * ), U( LDU, * ), USAV( LDU, * ),
  25. * $ VT( LDVT, * ), VTSAV( LDVT, * ), WORK( * )
  26. * ..
  27. *
  28. *
  29. *> \par Purpose:
  30. * =============
  31. *>
  32. *> \verbatim
  33. *>
  34. *> SDRVBD checks the singular value decomposition (SVD) drivers
  35. *> SGESVD, SGESDD, SGESVDQ, SGESVJ, SGEJSV, and DGESVDX.
  36. *>
  37. *> Both SGESVD and SGESDD factor A = U diag(S) VT, where U and VT are
  38. *> orthogonal and diag(S) is diagonal with the entries of the array S
  39. *> on its diagonal. The entries of S are the singular values,
  40. *> nonnegative and stored in decreasing order. U and VT can be
  41. *> optionally not computed, overwritten on A, or computed partially.
  42. *>
  43. *> A is M by N. Let MNMIN = min( M, N ). S has dimension MNMIN.
  44. *> U can be M by M or M by MNMIN. VT can be N by N or MNMIN by N.
  45. *>
  46. *> When SDRVBD is called, a number of matrix "sizes" (M's and N's)
  47. *> and a number of matrix "types" are specified. For each size (M,N)
  48. *> and each type of matrix, and for the minimal workspace as well as
  49. *> workspace adequate to permit blocking, an M x N matrix "A" will be
  50. *> generated and used to test the SVD routines. For each matrix, A will
  51. *> be factored as A = U diag(S) VT and the following 12 tests computed:
  52. *>
  53. *> Test for SGESVD:
  54. *>
  55. *> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
  56. *>
  57. *> (2) | I - U'U | / ( M ulp )
  58. *>
  59. *> (3) | I - VT VT' | / ( N ulp )
  60. *>
  61. *> (4) S contains MNMIN nonnegative values in decreasing order.
  62. *> (Return 0 if true, 1/ULP if false.)
  63. *>
  64. *> (5) | U - Upartial | / ( M ulp ) where Upartial is a partially
  65. *> computed U.
  66. *>
  67. *> (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
  68. *> computed VT.
  69. *>
  70. *> (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
  71. *> vector of singular values from the partial SVD
  72. *>
  73. *> Test for SGESDD:
  74. *>
  75. *> (8) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
  76. *>
  77. *> (9) | I - U'U | / ( M ulp )
  78. *>
  79. *> (10) | I - VT VT' | / ( N ulp )
  80. *>
  81. *> (11) S contains MNMIN nonnegative values in decreasing order.
  82. *> (Return 0 if true, 1/ULP if false.)
  83. *>
  84. *> (12) | U - Upartial | / ( M ulp ) where Upartial is a partially
  85. *> computed U.
  86. *>
  87. *> (13) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
  88. *> computed VT.
  89. *>
  90. *> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
  91. *> vector of singular values from the partial SVD
  92. *>
  93. *> Test for SGESVDQ:
  94. *>
  95. *> (36) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
  96. *>
  97. *> (37) | I - U'U | / ( M ulp )
  98. *>
  99. *> (38) | I - VT VT' | / ( N ulp )
  100. *>
  101. *> (39) S contains MNMIN nonnegative values in decreasing order.
  102. *> (Return 0 if true, 1/ULP if false.)
  103. *>
  104. *> Test for SGESVJ:
  105. *>
  106. *> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
  107. *>
  108. *> (16) | I - U'U | / ( M ulp )
  109. *>
  110. *> (17) | I - VT VT' | / ( N ulp )
  111. *>
  112. *> (18) S contains MNMIN nonnegative values in decreasing order.
  113. *> (Return 0 if true, 1/ULP if false.)
  114. *>
  115. *> Test for SGEJSV:
  116. *>
  117. *> (19) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
  118. *>
  119. *> (20) | I - U'U | / ( M ulp )
  120. *>
  121. *> (21) | I - VT VT' | / ( N ulp )
  122. *>
  123. *> (22) S contains MNMIN nonnegative values in decreasing order.
  124. *> (Return 0 if true, 1/ULP if false.)
  125. *>
  126. *> Test for SGESVDX( 'V', 'V', 'A' )/SGESVDX( 'N', 'N', 'A' )
  127. *>
  128. *> (23) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
  129. *>
  130. *> (24) | I - U'U | / ( M ulp )
  131. *>
  132. *> (25) | I - VT VT' | / ( N ulp )
  133. *>
  134. *> (26) S contains MNMIN nonnegative values in decreasing order.
  135. *> (Return 0 if true, 1/ULP if false.)
  136. *>
  137. *> (27) | U - Upartial | / ( M ulp ) where Upartial is a partially
  138. *> computed U.
  139. *>
  140. *> (28) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
  141. *> computed VT.
  142. *>
  143. *> (29) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
  144. *> vector of singular values from the partial SVD
  145. *>
  146. *> Test for SGESVDX( 'V', 'V', 'I' )
  147. *>
  148. *> (30) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )
  149. *>
  150. *> (31) | I - U'U | / ( M ulp )
  151. *>
  152. *> (32) | I - VT VT' | / ( N ulp )
  153. *>
  154. *> Test for SGESVDX( 'V', 'V', 'V' )
  155. *>
  156. *> (33) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )
  157. *>
  158. *> (34) | I - U'U | / ( M ulp )
  159. *>
  160. *> (35) | I - VT VT' | / ( N ulp )
  161. *>
  162. *> The "sizes" are specified by the arrays MM(1:NSIZES) and
  163. *> NN(1:NSIZES); the value of each element pair (MM(j),NN(j))
  164. *> specifies one size. The "types" are specified by a logical array
  165. *> DOTYPE( 1:NTYPES ); if DOTYPE(j) is .TRUE., then matrix type "j"
  166. *> will be generated.
  167. *> Currently, the list of possible types is:
  168. *>
  169. *> (1) The zero matrix.
  170. *> (2) The identity matrix.
  171. *> (3) A matrix of the form U D V, where U and V are orthogonal and
  172. *> D has evenly spaced entries 1, ..., ULP with random signs
  173. *> on the diagonal.
  174. *> (4) Same as (3), but multiplied by the underflow-threshold / ULP.
  175. *> (5) Same as (3), but multiplied by the overflow-threshold * ULP.
  176. *> \endverbatim
  177. *
  178. * Arguments:
  179. * ==========
  180. *
  181. *> \param[in] NSIZES
  182. *> \verbatim
  183. *> NSIZES is INTEGER
  184. *> The number of matrix sizes (M,N) contained in the vectors
  185. *> MM and NN.
  186. *> \endverbatim
  187. *>
  188. *> \param[in] MM
  189. *> \verbatim
  190. *> MM is INTEGER array, dimension (NSIZES)
  191. *> The values of the matrix row dimension M.
  192. *> \endverbatim
  193. *>
  194. *> \param[in] NN
  195. *> \verbatim
  196. *> NN is INTEGER array, dimension (NSIZES)
  197. *> The values of the matrix column dimension N.
  198. *> \endverbatim
  199. *>
  200. *> \param[in] NTYPES
  201. *> \verbatim
  202. *> NTYPES is INTEGER
  203. *> The number of elements in DOTYPE. If it is zero, SDRVBD
  204. *> does nothing. It must be at least zero. If it is MAXTYP+1
  205. *> and NSIZES is 1, then an additional type, MAXTYP+1 is
  206. *> defined, which is to use whatever matrices are in A and B.
  207. *> This is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
  208. *> DOTYPE(MAXTYP+1) is .TRUE. .
  209. *> \endverbatim
  210. *>
  211. *> \param[in] DOTYPE
  212. *> \verbatim
  213. *> DOTYPE is LOGICAL array, dimension (NTYPES)
  214. *> If DOTYPE(j) is .TRUE., then for each size (m,n), a matrix
  215. *> of type j will be generated. If NTYPES is smaller than the
  216. *> maximum number of types defined (PARAMETER MAXTYP), then
  217. *> types NTYPES+1 through MAXTYP will not be generated. If
  218. *> NTYPES is larger than MAXTYP, DOTYPE(MAXTYP+1) through
  219. *> DOTYPE(NTYPES) will be ignored.
  220. *> \endverbatim
  221. *>
  222. *> \param[in,out] ISEED
  223. *> \verbatim
  224. *> ISEED is INTEGER array, dimension (4)
  225. *> On entry, the seed of the random number generator. The array
  226. *> elements should be between 0 and 4095; if not they will be
  227. *> reduced mod 4096. Also, ISEED(4) must be odd.
  228. *> On exit, ISEED is changed and can be used in the next call to
  229. *> SDRVBD to continue the same random number sequence.
  230. *> \endverbatim
  231. *>
  232. *> \param[in] THRESH
  233. *> \verbatim
  234. *> THRESH is REAL
  235. *> The threshold value for the test ratios. A result is
  236. *> included in the output file if RESULT >= THRESH. The test
  237. *> ratios are scaled to be O(1), so THRESH should be a small
  238. *> multiple of 1, e.g., 10 or 100. To have every test ratio
  239. *> printed, use THRESH = 0.
  240. *> \endverbatim
  241. *>
  242. *> \param[out] A
  243. *> \verbatim
  244. *> A is REAL array, dimension (LDA,NMAX)
  245. *> where NMAX is the maximum value of N in NN.
  246. *> \endverbatim
  247. *>
  248. *> \param[in] LDA
  249. *> \verbatim
  250. *> LDA is INTEGER
  251. *> The leading dimension of the array A. LDA >= max(1,MMAX),
  252. *> where MMAX is the maximum value of M in MM.
  253. *> \endverbatim
  254. *>
  255. *> \param[out] U
  256. *> \verbatim
  257. *> U is REAL array, dimension (LDU,MMAX)
  258. *> \endverbatim
  259. *>
  260. *> \param[in] LDU
  261. *> \verbatim
  262. *> LDU is INTEGER
  263. *> The leading dimension of the array U. LDU >= max(1,MMAX).
  264. *> \endverbatim
  265. *>
  266. *> \param[out] VT
  267. *> \verbatim
  268. *> VT is REAL array, dimension (LDVT,NMAX)
  269. *> \endverbatim
  270. *>
  271. *> \param[in] LDVT
  272. *> \verbatim
  273. *> LDVT is INTEGER
  274. *> The leading dimension of the array VT. LDVT >= max(1,NMAX).
  275. *> \endverbatim
  276. *>
  277. *> \param[out] ASAV
  278. *> \verbatim
  279. *> ASAV is REAL array, dimension (LDA,NMAX)
  280. *> \endverbatim
  281. *>
  282. *> \param[out] USAV
  283. *> \verbatim
  284. *> USAV is REAL array, dimension (LDU,MMAX)
  285. *> \endverbatim
  286. *>
  287. *> \param[out] VTSAV
  288. *> \verbatim
  289. *> VTSAV is REAL array, dimension (LDVT,NMAX)
  290. *> \endverbatim
  291. *>
  292. *> \param[out] S
  293. *> \verbatim
  294. *> S is REAL array, dimension
  295. *> (max(min(MM,NN)))
  296. *> \endverbatim
  297. *>
  298. *> \param[out] SSAV
  299. *> \verbatim
  300. *> SSAV is REAL array, dimension
  301. *> (max(min(MM,NN)))
  302. *> \endverbatim
  303. *>
  304. *> \param[out] E
  305. *> \verbatim
  306. *> E is REAL array, dimension
  307. *> (max(min(MM,NN)))
  308. *> \endverbatim
  309. *>
  310. *> \param[out] WORK
  311. *> \verbatim
  312. *> WORK is REAL array, dimension (LWORK)
  313. *> \endverbatim
  314. *>
  315. *> \param[in] LWORK
  316. *> \verbatim
  317. *> LWORK is INTEGER
  318. *> The number of entries in WORK. This must be at least
  319. *> max(3*MN+MX,5*MN-4)+2*MN**2 for all pairs
  320. *> pairs (MN,MX)=( min(MM(j),NN(j), max(MM(j),NN(j)) )
  321. *> \endverbatim
  322. *>
  323. *> \param[out] IWORK
  324. *> \verbatim
  325. *> IWORK is INTEGER array, dimension at least 8*min(M,N)
  326. *> \endverbatim
  327. *>
  328. *> \param[in] NOUT
  329. *> \verbatim
  330. *> NOUT is INTEGER
  331. *> The FORTRAN unit number for printing out error messages
  332. *> (e.g., if a routine returns IINFO not equal to 0.)
  333. *> \endverbatim
  334. *>
  335. *> \param[out] INFO
  336. *> \verbatim
  337. *> INFO is INTEGER
  338. *> If 0, then everything ran OK.
  339. *> -1: NSIZES < 0
  340. *> -2: Some MM(j) < 0
  341. *> -3: Some NN(j) < 0
  342. *> -4: NTYPES < 0
  343. *> -7: THRESH < 0
  344. *> -10: LDA < 1 or LDA < MMAX, where MMAX is max( MM(j) ).
  345. *> -12: LDU < 1 or LDU < MMAX.
  346. *> -14: LDVT < 1 or LDVT < NMAX, where NMAX is max( NN(j) ).
  347. *> -21: LWORK too small.
  348. *> If SLATMS, or SGESVD returns an error code, the
  349. *> absolute value of it is returned.
  350. *> \endverbatim
  351. *
  352. * Authors:
  353. * ========
  354. *
  355. *> \author Univ. of Tennessee
  356. *> \author Univ. of California Berkeley
  357. *> \author Univ. of Colorado Denver
  358. *> \author NAG Ltd.
  359. *
  360. *> \ingroup single_eig
  361. *
  362. * =====================================================================
  363. SUBROUTINE SDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
  364. $ A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S,
  365. $ SSAV, E, WORK, LWORK, IWORK, NOUT, INFO )
  366. *
  367. * -- LAPACK test routine --
  368. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  369. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  370. *
  371. IMPLICIT NONE
  372. *
  373. * .. Scalar Arguments ..
  374. INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES,
  375. $ NTYPES
  376. REAL THRESH
  377. * ..
  378. * .. Array Arguments ..
  379. LOGICAL DOTYPE( * )
  380. INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
  381. REAL A( LDA, * ), ASAV( LDA, * ), E( * ), S( * ),
  382. $ SSAV( * ), U( LDU, * ), USAV( LDU, * ),
  383. $ VT( LDVT, * ), VTSAV( LDVT, * ), WORK( * )
  384. * ..
  385. *
  386. * =====================================================================
  387. *
  388. * .. Parameters ..
  389. REAL ZERO, ONE, TWO, HALF
  390. PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
  391. $ HALF = 0.5E0 )
  392. INTEGER MAXTYP
  393. PARAMETER ( MAXTYP = 5 )
  394. * ..
  395. * .. Local Scalars ..
  396. LOGICAL BADMM, BADNN
  397. CHARACTER JOBQ, JOBU, JOBVT, RANGE
  398. CHARACTER*3 PATH
  399. INTEGER I, IINFO, IJQ, IJU, IJVT, IL,IU, IWS, IWTMP,
  400. $ ITEMP, J, JSIZE, JTYPE, LSWORK, M, MINWRK,
  401. $ MMAX, MNMAX, MNMIN, MTYPES, N, NFAIL,
  402. $ NMAX, NS, NSI, NSV, NTEST
  403. REAL ANORM, DIF, DIV, OVFL, RTUNFL, ULP,
  404. $ ULPINV, UNFL, VL, VU
  405. * ..
  406. * .. Local Scalars for DGESVDQ ..
  407. INTEGER LIWORK, LRWORK, NUMRANK
  408. * ..
  409. * .. Local Arrays for DGESVDQ ..
  410. REAL RWORK( 2 )
  411. * ..
  412. * .. Local Arrays ..
  413. CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
  414. INTEGER IOLDSD( 4 ), ISEED2( 4 )
  415. REAL RESULT( 39 )
  416. * ..
  417. * .. External Functions ..
  418. REAL SLAMCH, SLARND
  419. EXTERNAL SLAMCH, SLARND
  420. * ..
  421. * .. External Subroutines ..
  422. EXTERNAL ALASVM, SBDT01, SGEJSV, SGESDD, SGESVD,
  423. $ SGESVDQ, SGESVDX, SGESVJ, SLABAD, SLACPY,
  424. $ SLASET, SLATMS, SORT01, SORT03, XERBLA
  425. * ..
  426. * .. Intrinsic Functions ..
  427. INTRINSIC ABS, REAL, INT, MAX, MIN
  428. * ..
  429. * .. Scalars in Common ..
  430. LOGICAL LERR, OK
  431. CHARACTER*32 SRNAMT
  432. INTEGER INFOT, NUNIT
  433. * ..
  434. * .. Common blocks ..
  435. COMMON / INFOC / INFOT, NUNIT, OK, LERR
  436. COMMON / SRNAMC / SRNAMT
  437. * ..
  438. * .. Data statements ..
  439. DATA CJOB / 'N', 'O', 'S', 'A' /
  440. DATA CJOBR / 'A', 'V', 'I' /
  441. DATA CJOBV / 'N', 'V' /
  442. * ..
  443. * .. Executable Statements ..
  444. *
  445. * Check for errors
  446. *
  447. INFO = 0
  448. BADMM = .FALSE.
  449. BADNN = .FALSE.
  450. MMAX = 1
  451. NMAX = 1
  452. MNMAX = 1
  453. MINWRK = 1
  454. DO 10 J = 1, NSIZES
  455. MMAX = MAX( MMAX, MM( J ) )
  456. IF( MM( J ).LT.0 )
  457. $ BADMM = .TRUE.
  458. NMAX = MAX( NMAX, NN( J ) )
  459. IF( NN( J ).LT.0 )
  460. $ BADNN = .TRUE.
  461. MNMAX = MAX( MNMAX, MIN( MM( J ), NN( J ) ) )
  462. MINWRK = MAX( MINWRK, MAX( 3*MIN( MM( J ),
  463. $ NN( J ) )+MAX( MM( J ), NN( J ) ), 5*MIN( MM( J ),
  464. $ NN( J )-4 ) )+2*MIN( MM( J ), NN( J ) )**2 )
  465. 10 CONTINUE
  466. *
  467. * Check for errors
  468. *
  469. IF( NSIZES.LT.0 ) THEN
  470. INFO = -1
  471. ELSE IF( BADMM ) THEN
  472. INFO = -2
  473. ELSE IF( BADNN ) THEN
  474. INFO = -3
  475. ELSE IF( NTYPES.LT.0 ) THEN
  476. INFO = -4
  477. ELSE IF( LDA.LT.MAX( 1, MMAX ) ) THEN
  478. INFO = -10
  479. ELSE IF( LDU.LT.MAX( 1, MMAX ) ) THEN
  480. INFO = -12
  481. ELSE IF( LDVT.LT.MAX( 1, NMAX ) ) THEN
  482. INFO = -14
  483. ELSE IF( MINWRK.GT.LWORK ) THEN
  484. INFO = -21
  485. END IF
  486. *
  487. IF( INFO.NE.0 ) THEN
  488. CALL XERBLA( 'SDRVBD', -INFO )
  489. RETURN
  490. END IF
  491. *
  492. * Initialize constants
  493. *
  494. PATH( 1: 1 ) = 'Single precision'
  495. PATH( 2: 3 ) = 'BD'
  496. NFAIL = 0
  497. NTEST = 0
  498. UNFL = SLAMCH( 'Safe minimum' )
  499. OVFL = ONE / UNFL
  500. CALL SLABAD( UNFL, OVFL )
  501. ULP = SLAMCH( 'Precision' )
  502. RTUNFL = SQRT( UNFL )
  503. ULPINV = ONE / ULP
  504. INFOT = 0
  505. *
  506. * Loop over sizes, types
  507. *
  508. DO 240 JSIZE = 1, NSIZES
  509. M = MM( JSIZE )
  510. N = NN( JSIZE )
  511. MNMIN = MIN( M, N )
  512. *
  513. IF( NSIZES.NE.1 ) THEN
  514. MTYPES = MIN( MAXTYP, NTYPES )
  515. ELSE
  516. MTYPES = MIN( MAXTYP+1, NTYPES )
  517. END IF
  518. *
  519. DO 230 JTYPE = 1, MTYPES
  520. IF( .NOT.DOTYPE( JTYPE ) )
  521. $ GO TO 230
  522. *
  523. DO 20 J = 1, 4
  524. IOLDSD( J ) = ISEED( J )
  525. 20 CONTINUE
  526. *
  527. * Compute "A"
  528. *
  529. IF( MTYPES.GT.MAXTYP )
  530. $ GO TO 30
  531. *
  532. IF( JTYPE.EQ.1 ) THEN
  533. *
  534. * Zero matrix
  535. *
  536. CALL SLASET( 'Full', M, N, ZERO, ZERO, A, LDA )
  537. *
  538. ELSE IF( JTYPE.EQ.2 ) THEN
  539. *
  540. * Identity matrix
  541. *
  542. CALL SLASET( 'Full', M, N, ZERO, ONE, A, LDA )
  543. *
  544. ELSE
  545. *
  546. * (Scaled) random matrix
  547. *
  548. IF( JTYPE.EQ.3 )
  549. $ ANORM = ONE
  550. IF( JTYPE.EQ.4 )
  551. $ ANORM = UNFL / ULP
  552. IF( JTYPE.EQ.5 )
  553. $ ANORM = OVFL*ULP
  554. CALL SLATMS( M, N, 'U', ISEED, 'N', S, 4, REAL( MNMIN ),
  555. $ ANORM, M-1, N-1, 'N', A, LDA, WORK, IINFO )
  556. IF( IINFO.NE.0 ) THEN
  557. WRITE( NOUT, FMT = 9996 )'Generator', IINFO, M, N,
  558. $ JTYPE, IOLDSD
  559. INFO = ABS( IINFO )
  560. RETURN
  561. END IF
  562. END IF
  563. *
  564. 30 CONTINUE
  565. CALL SLACPY( 'F', M, N, A, LDA, ASAV, LDA )
  566. *
  567. * Do for minimal and adequate (for blocking) workspace
  568. *
  569. DO 220 IWS = 1, 4
  570. *
  571. DO 40 J = 1, 32
  572. RESULT( J ) = -ONE
  573. 40 CONTINUE
  574. *
  575. * Test SGESVD: Factorize A
  576. *
  577. IWTMP = MAX( 3*MIN( M, N )+MAX( M, N ), 5*MIN( M, N ) )
  578. LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
  579. LSWORK = MIN( LSWORK, LWORK )
  580. LSWORK = MAX( LSWORK, 1 )
  581. IF( IWS.EQ.4 )
  582. $ LSWORK = LWORK
  583. *
  584. IF( IWS.GT.1 )
  585. $ CALL SLACPY( 'F', M, N, ASAV, LDA, A, LDA )
  586. SRNAMT = 'SGESVD'
  587. CALL SGESVD( 'A', 'A', M, N, A, LDA, SSAV, USAV, LDU,
  588. $ VTSAV, LDVT, WORK, LSWORK, IINFO )
  589. IF( IINFO.NE.0 ) THEN
  590. WRITE( NOUT, FMT = 9995 )'GESVD', IINFO, M, N, JTYPE,
  591. $ LSWORK, IOLDSD
  592. INFO = ABS( IINFO )
  593. RETURN
  594. END IF
  595. *
  596. * Do tests 1--4
  597. *
  598. CALL SBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
  599. $ VTSAV, LDVT, WORK, RESULT( 1 ) )
  600. IF( M.NE.0 .AND. N.NE.0 ) THEN
  601. CALL SORT01( 'Columns', M, M, USAV, LDU, WORK, LWORK,
  602. $ RESULT( 2 ) )
  603. CALL SORT01( 'Rows', N, N, VTSAV, LDVT, WORK, LWORK,
  604. $ RESULT( 3 ) )
  605. END IF
  606. RESULT( 4 ) = ZERO
  607. DO 50 I = 1, MNMIN - 1
  608. IF( SSAV( I ).LT.SSAV( I+1 ) )
  609. $ RESULT( 4 ) = ULPINV
  610. IF( SSAV( I ).LT.ZERO )
  611. $ RESULT( 4 ) = ULPINV
  612. 50 CONTINUE
  613. IF( MNMIN.GE.1 ) THEN
  614. IF( SSAV( MNMIN ).LT.ZERO )
  615. $ RESULT( 4 ) = ULPINV
  616. END IF
  617. *
  618. * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
  619. *
  620. RESULT( 5 ) = ZERO
  621. RESULT( 6 ) = ZERO
  622. RESULT( 7 ) = ZERO
  623. DO 80 IJU = 0, 3
  624. DO 70 IJVT = 0, 3
  625. IF( ( IJU.EQ.3 .AND. IJVT.EQ.3 ) .OR.
  626. $ ( IJU.EQ.1 .AND. IJVT.EQ.1 ) )GO TO 70
  627. JOBU = CJOB( IJU+1 )
  628. JOBVT = CJOB( IJVT+1 )
  629. CALL SLACPY( 'F', M, N, ASAV, LDA, A, LDA )
  630. SRNAMT = 'SGESVD'
  631. CALL SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU,
  632. $ VT, LDVT, WORK, LSWORK, IINFO )
  633. *
  634. * Compare U
  635. *
  636. DIF = ZERO
  637. IF( M.GT.0 .AND. N.GT.0 ) THEN
  638. IF( IJU.EQ.1 ) THEN
  639. CALL SORT03( 'C', M, MNMIN, M, MNMIN, USAV,
  640. $ LDU, A, LDA, WORK, LWORK, DIF,
  641. $ IINFO )
  642. ELSE IF( IJU.EQ.2 ) THEN
  643. CALL SORT03( 'C', M, MNMIN, M, MNMIN, USAV,
  644. $ LDU, U, LDU, WORK, LWORK, DIF,
  645. $ IINFO )
  646. ELSE IF( IJU.EQ.3 ) THEN
  647. CALL SORT03( 'C', M, M, M, MNMIN, USAV, LDU,
  648. $ U, LDU, WORK, LWORK, DIF,
  649. $ IINFO )
  650. END IF
  651. END IF
  652. RESULT( 5 ) = MAX( RESULT( 5 ), DIF )
  653. *
  654. * Compare VT
  655. *
  656. DIF = ZERO
  657. IF( M.GT.0 .AND. N.GT.0 ) THEN
  658. IF( IJVT.EQ.1 ) THEN
  659. CALL SORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
  660. $ LDVT, A, LDA, WORK, LWORK, DIF,
  661. $ IINFO )
  662. ELSE IF( IJVT.EQ.2 ) THEN
  663. CALL SORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
  664. $ LDVT, VT, LDVT, WORK, LWORK,
  665. $ DIF, IINFO )
  666. ELSE IF( IJVT.EQ.3 ) THEN
  667. CALL SORT03( 'R', N, N, N, MNMIN, VTSAV,
  668. $ LDVT, VT, LDVT, WORK, LWORK,
  669. $ DIF, IINFO )
  670. END IF
  671. END IF
  672. RESULT( 6 ) = MAX( RESULT( 6 ), DIF )
  673. *
  674. * Compare S
  675. *
  676. DIF = ZERO
  677. DIV = MAX( MNMIN*ULP*S( 1 ), UNFL )
  678. DO 60 I = 1, MNMIN - 1
  679. IF( SSAV( I ).LT.SSAV( I+1 ) )
  680. $ DIF = ULPINV
  681. IF( SSAV( I ).LT.ZERO )
  682. $ DIF = ULPINV
  683. DIF = MAX( DIF, ABS( SSAV( I )-S( I ) ) / DIV )
  684. 60 CONTINUE
  685. RESULT( 7 ) = MAX( RESULT( 7 ), DIF )
  686. 70 CONTINUE
  687. 80 CONTINUE
  688. *
  689. * Test SGESDD: Factorize A
  690. *
  691. IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
  692. LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
  693. LSWORK = MIN( LSWORK, LWORK )
  694. LSWORK = MAX( LSWORK, 1 )
  695. IF( IWS.EQ.4 )
  696. $ LSWORK = LWORK
  697. *
  698. CALL SLACPY( 'F', M, N, ASAV, LDA, A, LDA )
  699. SRNAMT = 'SGESDD'
  700. CALL SGESDD( 'A', M, N, A, LDA, SSAV, USAV, LDU, VTSAV,
  701. $ LDVT, WORK, LSWORK, IWORK, IINFO )
  702. IF( IINFO.NE.0 ) THEN
  703. WRITE( NOUT, FMT = 9995 )'GESDD', IINFO, M, N, JTYPE,
  704. $ LSWORK, IOLDSD
  705. INFO = ABS( IINFO )
  706. RETURN
  707. END IF
  708. *
  709. * Do tests 8--11
  710. *
  711. CALL SBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
  712. $ VTSAV, LDVT, WORK, RESULT( 8 ) )
  713. IF( M.NE.0 .AND. N.NE.0 ) THEN
  714. CALL SORT01( 'Columns', M, M, USAV, LDU, WORK, LWORK,
  715. $ RESULT( 9 ) )
  716. CALL SORT01( 'Rows', N, N, VTSAV, LDVT, WORK, LWORK,
  717. $ RESULT( 10 ) )
  718. END IF
  719. RESULT( 11 ) = ZERO
  720. DO 90 I = 1, MNMIN - 1
  721. IF( SSAV( I ).LT.SSAV( I+1 ) )
  722. $ RESULT( 11 ) = ULPINV
  723. IF( SSAV( I ).LT.ZERO )
  724. $ RESULT( 11 ) = ULPINV
  725. 90 CONTINUE
  726. IF( MNMIN.GE.1 ) THEN
  727. IF( SSAV( MNMIN ).LT.ZERO )
  728. $ RESULT( 11 ) = ULPINV
  729. END IF
  730. *
  731. * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
  732. *
  733. RESULT( 12 ) = ZERO
  734. RESULT( 13 ) = ZERO
  735. RESULT( 14 ) = ZERO
  736. DO 110 IJQ = 0, 2
  737. JOBQ = CJOB( IJQ+1 )
  738. CALL SLACPY( 'F', M, N, ASAV, LDA, A, LDA )
  739. SRNAMT = 'SGESDD'
  740. CALL SGESDD( JOBQ, M, N, A, LDA, S, U, LDU, VT, LDVT,
  741. $ WORK, LSWORK, IWORK, IINFO )
  742. *
  743. * Compare U
  744. *
  745. DIF = ZERO
  746. IF( M.GT.0 .AND. N.GT.0 ) THEN
  747. IF( IJQ.EQ.1 ) THEN
  748. IF( M.GE.N ) THEN
  749. CALL SORT03( 'C', M, MNMIN, M, MNMIN, USAV,
  750. $ LDU, A, LDA, WORK, LWORK, DIF,
  751. $ INFO )
  752. ELSE
  753. CALL SORT03( 'C', M, MNMIN, M, MNMIN, USAV,
  754. $ LDU, U, LDU, WORK, LWORK, DIF,
  755. $ INFO )
  756. END IF
  757. ELSE IF( IJQ.EQ.2 ) THEN
  758. CALL SORT03( 'C', M, MNMIN, M, MNMIN, USAV, LDU,
  759. $ U, LDU, WORK, LWORK, DIF, INFO )
  760. END IF
  761. END IF
  762. RESULT( 12 ) = MAX( RESULT( 12 ), DIF )
  763. *
  764. * Compare VT
  765. *
  766. DIF = ZERO
  767. IF( M.GT.0 .AND. N.GT.0 ) THEN
  768. IF( IJQ.EQ.1 ) THEN
  769. IF( M.GE.N ) THEN
  770. CALL SORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
  771. $ LDVT, VT, LDVT, WORK, LWORK,
  772. $ DIF, INFO )
  773. ELSE
  774. CALL SORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
  775. $ LDVT, A, LDA, WORK, LWORK, DIF,
  776. $ INFO )
  777. END IF
  778. ELSE IF( IJQ.EQ.2 ) THEN
  779. CALL SORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
  780. $ LDVT, VT, LDVT, WORK, LWORK, DIF,
  781. $ INFO )
  782. END IF
  783. END IF
  784. RESULT( 13 ) = MAX( RESULT( 13 ), DIF )
  785. *
  786. * Compare S
  787. *
  788. DIF = ZERO
  789. DIV = MAX( MNMIN*ULP*S( 1 ), UNFL )
  790. DO 100 I = 1, MNMIN - 1
  791. IF( SSAV( I ).LT.SSAV( I+1 ) )
  792. $ DIF = ULPINV
  793. IF( SSAV( I ).LT.ZERO )
  794. $ DIF = ULPINV
  795. DIF = MAX( DIF, ABS( SSAV( I )-S( I ) ) / DIV )
  796. 100 CONTINUE
  797. RESULT( 14 ) = MAX( RESULT( 14 ), DIF )
  798. 110 CONTINUE
  799. *
  800. * Test SGESVDQ
  801. * Note: SGESVDQ only works for M >= N
  802. *
  803. RESULT( 36 ) = ZERO
  804. RESULT( 37 ) = ZERO
  805. RESULT( 38 ) = ZERO
  806. RESULT( 39 ) = ZERO
  807. *
  808. IF( M.GE.N ) THEN
  809. IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
  810. LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
  811. LSWORK = MIN( LSWORK, LWORK )
  812. LSWORK = MAX( LSWORK, 1 )
  813. IF( IWS.EQ.4 )
  814. $ LSWORK = LWORK
  815. *
  816. CALL SLACPY( 'F', M, N, ASAV, LDA, A, LDA )
  817. SRNAMT = 'SGESVDQ'
  818. *
  819. LRWORK = 2
  820. LIWORK = MAX( N, 1 )
  821. CALL SGESVDQ( 'H', 'N', 'N', 'A', 'A',
  822. $ M, N, A, LDA, SSAV, USAV, LDU,
  823. $ VTSAV, LDVT, NUMRANK, IWORK, LIWORK,
  824. $ WORK, LWORK, RWORK, LRWORK, IINFO )
  825. *
  826. IF( IINFO.NE.0 ) THEN
  827. WRITE( NOUT, FMT = 9995 )'SGESVDQ', IINFO, M, N,
  828. $ JTYPE, LSWORK, IOLDSD
  829. INFO = ABS( IINFO )
  830. RETURN
  831. END IF
  832. *
  833. * Do tests 36--39
  834. *
  835. CALL SBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
  836. $ VTSAV, LDVT, WORK, RESULT( 36 ) )
  837. IF( M.NE.0 .AND. N.NE.0 ) THEN
  838. CALL SORT01( 'Columns', M, M, USAV, LDU, WORK,
  839. $ LWORK, RESULT( 37 ) )
  840. CALL SORT01( 'Rows', N, N, VTSAV, LDVT, WORK,
  841. $ LWORK, RESULT( 38 ) )
  842. END IF
  843. RESULT( 39 ) = ZERO
  844. DO 199 I = 1, MNMIN - 1
  845. IF( SSAV( I ).LT.SSAV( I+1 ) )
  846. $ RESULT( 39 ) = ULPINV
  847. IF( SSAV( I ).LT.ZERO )
  848. $ RESULT( 39 ) = ULPINV
  849. 199 CONTINUE
  850. IF( MNMIN.GE.1 ) THEN
  851. IF( SSAV( MNMIN ).LT.ZERO )
  852. $ RESULT( 39 ) = ULPINV
  853. END IF
  854. END IF
  855. *
  856. * Test SGESVJ
  857. * Note: SGESVJ only works for M >= N
  858. *
  859. RESULT( 15 ) = ZERO
  860. RESULT( 16 ) = ZERO
  861. RESULT( 17 ) = ZERO
  862. RESULT( 18 ) = ZERO
  863. *
  864. IF( M.GE.N ) THEN
  865. IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
  866. LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
  867. LSWORK = MIN( LSWORK, LWORK )
  868. LSWORK = MAX( LSWORK, 1 )
  869. IF( IWS.EQ.4 )
  870. $ LSWORK = LWORK
  871. *
  872. CALL SLACPY( 'F', M, N, ASAV, LDA, USAV, LDA )
  873. SRNAMT = 'SGESVJ'
  874. CALL SGESVJ( 'G', 'U', 'V', M, N, USAV, LDA, SSAV,
  875. & 0, A, LDVT, WORK, LWORK, INFO )
  876. *
  877. * SGESVJ returns V not VT
  878. *
  879. DO J=1,N
  880. DO I=1,N
  881. VTSAV(J,I) = A(I,J)
  882. END DO
  883. END DO
  884. *
  885. IF( IINFO.NE.0 ) THEN
  886. WRITE( NOUT, FMT = 9995 )'GESVJ', IINFO, M, N,
  887. $ JTYPE, LSWORK, IOLDSD
  888. INFO = ABS( IINFO )
  889. RETURN
  890. END IF
  891. *
  892. * Do tests 15--18
  893. *
  894. CALL SBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
  895. $ VTSAV, LDVT, WORK, RESULT( 15 ) )
  896. IF( M.NE.0 .AND. N.NE.0 ) THEN
  897. CALL SORT01( 'Columns', M, M, USAV, LDU, WORK,
  898. $ LWORK, RESULT( 16 ) )
  899. CALL SORT01( 'Rows', N, N, VTSAV, LDVT, WORK,
  900. $ LWORK, RESULT( 17 ) )
  901. END IF
  902. RESULT( 18 ) = ZERO
  903. DO 120 I = 1, MNMIN - 1
  904. IF( SSAV( I ).LT.SSAV( I+1 ) )
  905. $ RESULT( 18 ) = ULPINV
  906. IF( SSAV( I ).LT.ZERO )
  907. $ RESULT( 18 ) = ULPINV
  908. 120 CONTINUE
  909. IF( MNMIN.GE.1 ) THEN
  910. IF( SSAV( MNMIN ).LT.ZERO )
  911. $ RESULT( 18 ) = ULPINV
  912. END IF
  913. END IF
  914. *
  915. * Test SGEJSV
  916. * Note: SGEJSV only works for M >= N
  917. *
  918. RESULT( 19 ) = ZERO
  919. RESULT( 20 ) = ZERO
  920. RESULT( 21 ) = ZERO
  921. RESULT( 22 ) = ZERO
  922. IF( M.GE.N ) THEN
  923. IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
  924. LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
  925. LSWORK = MIN( LSWORK, LWORK )
  926. LSWORK = MAX( LSWORK, 1 )
  927. IF( IWS.EQ.4 )
  928. $ LSWORK = LWORK
  929. *
  930. CALL SLACPY( 'F', M, N, ASAV, LDA, VTSAV, LDA )
  931. SRNAMT = 'SGEJSV'
  932. CALL SGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
  933. & M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT,
  934. & WORK, LWORK, IWORK, INFO )
  935. *
  936. * SGEJSV returns V not VT
  937. *
  938. DO 140 J=1,N
  939. DO 130 I=1,N
  940. VTSAV(J,I) = A(I,J)
  941. 130 END DO
  942. 140 END DO
  943. *
  944. IF( IINFO.NE.0 ) THEN
  945. WRITE( NOUT, FMT = 9995 )'GEJSV', IINFO, M, N,
  946. $ JTYPE, LSWORK, IOLDSD
  947. INFO = ABS( IINFO )
  948. RETURN
  949. END IF
  950. *
  951. * Do tests 19--22
  952. *
  953. CALL SBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
  954. $ VTSAV, LDVT, WORK, RESULT( 19 ) )
  955. IF( M.NE.0 .AND. N.NE.0 ) THEN
  956. CALL SORT01( 'Columns', M, M, USAV, LDU, WORK,
  957. $ LWORK, RESULT( 20 ) )
  958. CALL SORT01( 'Rows', N, N, VTSAV, LDVT, WORK,
  959. $ LWORK, RESULT( 21 ) )
  960. END IF
  961. RESULT( 22 ) = ZERO
  962. DO 150 I = 1, MNMIN - 1
  963. IF( SSAV( I ).LT.SSAV( I+1 ) )
  964. $ RESULT( 22 ) = ULPINV
  965. IF( SSAV( I ).LT.ZERO )
  966. $ RESULT( 22 ) = ULPINV
  967. 150 CONTINUE
  968. IF( MNMIN.GE.1 ) THEN
  969. IF( SSAV( MNMIN ).LT.ZERO )
  970. $ RESULT( 22 ) = ULPINV
  971. END IF
  972. END IF
  973. *
  974. * Test SGESVDX
  975. *
  976. CALL SLACPY( 'F', M, N, ASAV, LDA, A, LDA )
  977. CALL SGESVDX( 'V', 'V', 'A', M, N, A, LDA,
  978. $ VL, VU, IL, IU, NS, SSAV, USAV, LDU,
  979. $ VTSAV, LDVT, WORK, LWORK, IWORK,
  980. $ IINFO )
  981. IF( IINFO.NE.0 ) THEN
  982. WRITE( NOUT, FMT = 9995 )'GESVDX', IINFO, M, N,
  983. $ JTYPE, LSWORK, IOLDSD
  984. INFO = ABS( IINFO )
  985. RETURN
  986. END IF
  987. *
  988. * Do tests 23--29
  989. *
  990. RESULT( 23 ) = ZERO
  991. RESULT( 24 ) = ZERO
  992. RESULT( 25 ) = ZERO
  993. CALL SBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
  994. $ VTSAV, LDVT, WORK, RESULT( 23 ) )
  995. IF( M.NE.0 .AND. N.NE.0 ) THEN
  996. CALL SORT01( 'Columns', M, M, USAV, LDU, WORK, LWORK,
  997. $ RESULT( 24 ) )
  998. CALL SORT01( 'Rows', N, N, VTSAV, LDVT, WORK, LWORK,
  999. $ RESULT( 25 ) )
  1000. END IF
  1001. RESULT( 26 ) = ZERO
  1002. DO 160 I = 1, MNMIN - 1
  1003. IF( SSAV( I ).LT.SSAV( I+1 ) )
  1004. $ RESULT( 26 ) = ULPINV
  1005. IF( SSAV( I ).LT.ZERO )
  1006. $ RESULT( 26 ) = ULPINV
  1007. 160 CONTINUE
  1008. IF( MNMIN.GE.1 ) THEN
  1009. IF( SSAV( MNMIN ).LT.ZERO )
  1010. $ RESULT( 26 ) = ULPINV
  1011. END IF
  1012. *
  1013. * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
  1014. *
  1015. RESULT( 27 ) = ZERO
  1016. RESULT( 28 ) = ZERO
  1017. RESULT( 29 ) = ZERO
  1018. DO 180 IJU = 0, 1
  1019. DO 170 IJVT = 0, 1
  1020. IF( ( IJU.EQ.0 .AND. IJVT.EQ.0 ) .OR.
  1021. $ ( IJU.EQ.1 .AND. IJVT.EQ.1 ) )GO TO 170
  1022. JOBU = CJOBV( IJU+1 )
  1023. JOBVT = CJOBV( IJVT+1 )
  1024. RANGE = CJOBR( 1 )
  1025. CALL SLACPY( 'F', M, N, ASAV, LDA, A, LDA )
  1026. CALL SGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA,
  1027. $ VL, VU, IL, IU, NS, S, U, LDU,
  1028. $ VT, LDVT, WORK, LWORK, IWORK,
  1029. $ IINFO )
  1030. *
  1031. * Compare U
  1032. *
  1033. DIF = ZERO
  1034. IF( M.GT.0 .AND. N.GT.0 ) THEN
  1035. IF( IJU.EQ.1 ) THEN
  1036. CALL SORT03( 'C', M, MNMIN, M, MNMIN, USAV,
  1037. $ LDU, U, LDU, WORK, LWORK, DIF,
  1038. $ IINFO )
  1039. END IF
  1040. END IF
  1041. RESULT( 27 ) = MAX( RESULT( 27 ), DIF )
  1042. *
  1043. * Compare VT
  1044. *
  1045. DIF = ZERO
  1046. IF( M.GT.0 .AND. N.GT.0 ) THEN
  1047. IF( IJVT.EQ.1 ) THEN
  1048. CALL SORT03( 'R', N, MNMIN, N, MNMIN, VTSAV,
  1049. $ LDVT, VT, LDVT, WORK, LWORK,
  1050. $ DIF, IINFO )
  1051. END IF
  1052. END IF
  1053. RESULT( 28 ) = MAX( RESULT( 28 ), DIF )
  1054. *
  1055. * Compare S
  1056. *
  1057. DIF = ZERO
  1058. DIV = MAX( MNMIN*ULP*S( 1 ), UNFL )
  1059. DO 190 I = 1, MNMIN - 1
  1060. IF( SSAV( I ).LT.SSAV( I+1 ) )
  1061. $ DIF = ULPINV
  1062. IF( SSAV( I ).LT.ZERO )
  1063. $ DIF = ULPINV
  1064. DIF = MAX( DIF, ABS( SSAV( I )-S( I ) ) / DIV )
  1065. 190 CONTINUE
  1066. RESULT( 29 ) = MAX( RESULT( 29 ), DIF )
  1067. 170 CONTINUE
  1068. 180 CONTINUE
  1069. *
  1070. * Do tests 30--32: SGESVDX( 'V', 'V', 'I' )
  1071. *
  1072. DO 200 I = 1, 4
  1073. ISEED2( I ) = ISEED( I )
  1074. 200 CONTINUE
  1075. IF( MNMIN.LE.1 ) THEN
  1076. IL = 1
  1077. IU = MAX( 1, MNMIN )
  1078. ELSE
  1079. IL = 1 + INT( ( MNMIN-1 )*SLARND( 1, ISEED2 ) )
  1080. IU = 1 + INT( ( MNMIN-1 )*SLARND( 1, ISEED2 ) )
  1081. IF( IU.LT.IL ) THEN
  1082. ITEMP = IU
  1083. IU = IL
  1084. IL = ITEMP
  1085. END IF
  1086. END IF
  1087. CALL SLACPY( 'F', M, N, ASAV, LDA, A, LDA )
  1088. CALL SGESVDX( 'V', 'V', 'I', M, N, A, LDA,
  1089. $ VL, VU, IL, IU, NSI, S, U, LDU,
  1090. $ VT, LDVT, WORK, LWORK, IWORK,
  1091. $ IINFO )
  1092. IF( IINFO.NE.0 ) THEN
  1093. WRITE( NOUT, FMT = 9995 )'GESVDX', IINFO, M, N,
  1094. $ JTYPE, LSWORK, IOLDSD
  1095. INFO = ABS( IINFO )
  1096. RETURN
  1097. END IF
  1098. *
  1099. RESULT( 30 ) = ZERO
  1100. RESULT( 31 ) = ZERO
  1101. RESULT( 32 ) = ZERO
  1102. CALL SBDT05( M, N, ASAV, LDA, S, NSI, U, LDU,
  1103. $ VT, LDVT, WORK, RESULT( 30 ) )
  1104. CALL SORT01( 'Columns', M, NSI, U, LDU, WORK, LWORK,
  1105. $ RESULT( 31 ) )
  1106. CALL SORT01( 'Rows', NSI, N, VT, LDVT, WORK, LWORK,
  1107. $ RESULT( 32 ) )
  1108. *
  1109. * Do tests 33--35: SGESVDX( 'V', 'V', 'V' )
  1110. *
  1111. IF( MNMIN.GT.0 .AND. NSI.GT.1 ) THEN
  1112. IF( IL.NE.1 ) THEN
  1113. VU = SSAV( IL ) +
  1114. $ MAX( HALF*ABS( SSAV( IL )-SSAV( IL-1 ) ),
  1115. $ ULP*ANORM, TWO*RTUNFL )
  1116. ELSE
  1117. VU = SSAV( 1 ) +
  1118. $ MAX( HALF*ABS( SSAV( NS )-SSAV( 1 ) ),
  1119. $ ULP*ANORM, TWO*RTUNFL )
  1120. END IF
  1121. IF( IU.NE.NS ) THEN
  1122. VL = SSAV( IU ) - MAX( ULP*ANORM, TWO*RTUNFL,
  1123. $ HALF*ABS( SSAV( IU+1 )-SSAV( IU ) ) )
  1124. ELSE
  1125. VL = SSAV( NS ) - MAX( ULP*ANORM, TWO*RTUNFL,
  1126. $ HALF*ABS( SSAV( NS )-SSAV( 1 ) ) )
  1127. END IF
  1128. VL = MAX( VL,ZERO )
  1129. VU = MAX( VU,ZERO )
  1130. IF( VL.GE.VU ) VU = MAX( VU*2, VU+VL+HALF )
  1131. ELSE
  1132. VL = ZERO
  1133. VU = ONE
  1134. END IF
  1135. CALL SLACPY( 'F', M, N, ASAV, LDA, A, LDA )
  1136. CALL SGESVDX( 'V', 'V', 'V', M, N, A, LDA,
  1137. $ VL, VU, IL, IU, NSV, S, U, LDU,
  1138. $ VT, LDVT, WORK, LWORK, IWORK,
  1139. $ IINFO )
  1140. IF( IINFO.NE.0 ) THEN
  1141. WRITE( NOUT, FMT = 9995 )'GESVDX', IINFO, M, N,
  1142. $ JTYPE, LSWORK, IOLDSD
  1143. INFO = ABS( IINFO )
  1144. RETURN
  1145. END IF
  1146. *
  1147. RESULT( 33 ) = ZERO
  1148. RESULT( 34 ) = ZERO
  1149. RESULT( 35 ) = ZERO
  1150. CALL SBDT05( M, N, ASAV, LDA, S, NSV, U, LDU,
  1151. $ VT, LDVT, WORK, RESULT( 33 ) )
  1152. CALL SORT01( 'Columns', M, NSV, U, LDU, WORK, LWORK,
  1153. $ RESULT( 34 ) )
  1154. CALL SORT01( 'Rows', NSV, N, VT, LDVT, WORK, LWORK,
  1155. $ RESULT( 35 ) )
  1156. *
  1157. * End of Loop -- Check for RESULT(j) > THRESH
  1158. *
  1159. DO 210 J = 1, 39
  1160. IF( RESULT( J ).GE.THRESH ) THEN
  1161. IF( NFAIL.EQ.0 ) THEN
  1162. WRITE( NOUT, FMT = 9999 )
  1163. WRITE( NOUT, FMT = 9998 )
  1164. END IF
  1165. WRITE( NOUT, FMT = 9997 )M, N, JTYPE, IWS, IOLDSD,
  1166. $ J, RESULT( J )
  1167. NFAIL = NFAIL + 1
  1168. END IF
  1169. 210 CONTINUE
  1170. NTEST = NTEST + 39
  1171. 220 CONTINUE
  1172. 230 CONTINUE
  1173. 240 CONTINUE
  1174. *
  1175. * Summary
  1176. *
  1177. CALL ALASVM( PATH, NOUT, NFAIL, NTEST, 0 )
  1178. *
  1179. 9999 FORMAT( ' SVD -- Real Singular Value Decomposition Driver ',
  1180. $ / ' Matrix types (see SDRVBD for details):',
  1181. $ / / ' 1 = Zero matrix', / ' 2 = Identity matrix',
  1182. $ / ' 3 = Evenly spaced singular values near 1',
  1183. $ / ' 4 = Evenly spaced singular values near underflow',
  1184. $ / ' 5 = Evenly spaced singular values near overflow', / /
  1185. $ ' Tests performed: ( A is dense, U and V are orthogonal,',
  1186. $ / 19X, ' S is an array, and Upartial, VTpartial, and',
  1187. $ / 19X, ' Spartial are partially computed U, VT and S),', / )
  1188. 9998 FORMAT( ' 1 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
  1189. $ / ' 2 = | I - U**T U | / ( M ulp ) ',
  1190. $ / ' 3 = | I - VT VT**T | / ( N ulp ) ',
  1191. $ / ' 4 = 0 if S contains min(M,N) nonnegative values in',
  1192. $ ' decreasing order, else 1/ulp',
  1193. $ / ' 5 = | U - Upartial | / ( M ulp )',
  1194. $ / ' 6 = | VT - VTpartial | / ( N ulp )',
  1195. $ / ' 7 = | S - Spartial | / ( min(M,N) ulp |S| )',
  1196. $ / ' 8 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
  1197. $ / ' 9 = | I - U**T U | / ( M ulp ) ',
  1198. $ / '10 = | I - VT VT**T | / ( N ulp ) ',
  1199. $ / '11 = 0 if S contains min(M,N) nonnegative values in',
  1200. $ ' decreasing order, else 1/ulp',
  1201. $ / '12 = | U - Upartial | / ( M ulp )',
  1202. $ / '13 = | VT - VTpartial | / ( N ulp )',
  1203. $ / '14 = | S - Spartial | / ( min(M,N) ulp |S| )',
  1204. $ / '15 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
  1205. $ / '16 = | I - U**T U | / ( M ulp ) ',
  1206. $ / '17 = | I - VT VT**T | / ( N ulp ) ',
  1207. $ / '18 = 0 if S contains min(M,N) nonnegative values in',
  1208. $ ' decreasing order, else 1/ulp',
  1209. $ / '19 = | U - Upartial | / ( M ulp )',
  1210. $ / '20 = | VT - VTpartial | / ( N ulp )',
  1211. $ / '21 = | S - Spartial | / ( min(M,N) ulp |S| )',
  1212. $ / '22 = 0 if S contains min(M,N) nonnegative values in',
  1213. $ ' decreasing order, else 1/ulp',
  1214. $ ' SGESVDX(V,V,A) ',
  1215. $ / '23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ),'
  1216. $ / '24 = | I - U**T U | / ( M ulp ) ',
  1217. $ / '25 = | I - VT VT**T | / ( N ulp ) ',
  1218. $ / '26 = 0 if S contains min(M,N) nonnegative values in',
  1219. $ ' decreasing order, else 1/ulp',
  1220. $ / '27 = | U - Upartial | / ( M ulp )',
  1221. $ / '28 = | VT - VTpartial | / ( N ulp )',
  1222. $ / '29 = | S - Spartial | / ( min(M,N) ulp |S| )',
  1223. $ / '30 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
  1224. $ ' SGESVDX(V,V,I) ',
  1225. $ / '31 = | I - U**T U | / ( M ulp ) ',
  1226. $ / '32 = | I - VT VT**T | / ( N ulp ) ',
  1227. $ / '33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
  1228. $ ' SGESVDX(V,V,V) ',
  1229. $ / '34 = | I - U**T U | / ( M ulp ) ',
  1230. $ / '35 = | I - VT VT**T | / ( N ulp ) ',
  1231. $ ' SGESVDQ(H,N,N,A,A',
  1232. $ / '36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
  1233. $ / '37 = | I - U**T U | / ( M ulp ) ',
  1234. $ / '38 = | I - VT VT**T | / ( N ulp ) ',
  1235. $ / '39 = 0 if S contains min(M,N) nonnegative values in',
  1236. $ ' decreasing order, else 1/ulp',
  1237. $ / / )
  1238. 9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1,
  1239. $ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 )
  1240. 9996 FORMAT( ' SDRVBD: ', A, ' returned INFO=', I6, '.', / 9X, 'M=',
  1241. $ I6, ', N=', I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ),
  1242. $ I5, ')' )
  1243. 9995 FORMAT( ' SDRVBD: ', A, ' returned INFO=', I6, '.', / 9X, 'M=',
  1244. $ I6, ', N=', I6, ', JTYPE=', I6, ', LSWORK=', I6, / 9X,
  1245. $ 'ISEED=(', 3( I5, ',' ), I5, ')' )
  1246. *
  1247. RETURN
  1248. *
  1249. * End of SDRVBD
  1250. *
  1251. END