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.

cdrvls.f 28 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741
  1. *> \brief \b CDRVLS
  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 CDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB,
  12. * NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B,
  13. * COPYB, C, S, COPYS, WORK, RWORK, IWORK,
  14. * NOUT )
  15. *
  16. * .. Scalar Arguments ..
  17. * LOGICAL TSTERR
  18. * INTEGER NM, NN, NNB, NNS, NOUT
  19. * REAL THRESH
  20. * ..
  21. * .. Array Arguments ..
  22. * LOGICAL DOTYPE( * )
  23. * INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
  24. * $ NVAL( * ), NXVAL( * )
  25. * REAL COPYS( * ), RWORK( * ), S( * )
  26. * COMPLEX A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ),
  27. * $ WORK( * )
  28. * ..
  29. *
  30. *
  31. *> \par Purpose:
  32. * =============
  33. *>
  34. *> \verbatim
  35. *>
  36. *> CDRVLS tests the least squares driver routines CGELS, CGELSX, CGELSS,
  37. *> CGELSY and CGELSD.
  38. *> \endverbatim
  39. *
  40. * Arguments:
  41. * ==========
  42. *
  43. *> \param[in] DOTYPE
  44. *> \verbatim
  45. *> DOTYPE is LOGICAL array, dimension (NTYPES)
  46. *> The matrix types to be used for testing. Matrices of type j
  47. *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
  48. *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
  49. *> The matrix of type j is generated as follows:
  50. *> j=1: A = U*D*V where U and V are random unitary matrices
  51. *> and D has random entries (> 0.1) taken from a uniform
  52. *> distribution (0,1). A is full rank.
  53. *> j=2: The same of 1, but A is scaled up.
  54. *> j=3: The same of 1, but A is scaled down.
  55. *> j=4: A = U*D*V where U and V are random unitary matrices
  56. *> and D has 3*min(M,N)/4 random entries (> 0.1) taken
  57. *> from a uniform distribution (0,1) and the remaining
  58. *> entries set to 0. A is rank-deficient.
  59. *> j=5: The same of 4, but A is scaled up.
  60. *> j=6: The same of 5, but A is scaled down.
  61. *> \endverbatim
  62. *>
  63. *> \param[in] NM
  64. *> \verbatim
  65. *> NM is INTEGER
  66. *> The number of values of M contained in the vector MVAL.
  67. *> \endverbatim
  68. *>
  69. *> \param[in] MVAL
  70. *> \verbatim
  71. *> MVAL is INTEGER array, dimension (NM)
  72. *> The values of the matrix row dimension M.
  73. *> \endverbatim
  74. *>
  75. *> \param[in] NN
  76. *> \verbatim
  77. *> NN is INTEGER
  78. *> The number of values of N contained in the vector NVAL.
  79. *> \endverbatim
  80. *>
  81. *> \param[in] NVAL
  82. *> \verbatim
  83. *> NVAL is INTEGER array, dimension (NN)
  84. *> The values of the matrix column dimension N.
  85. *> \endverbatim
  86. *>
  87. *> \param[in] NNB
  88. *> \verbatim
  89. *> NNB is INTEGER
  90. *> The number of values of NB and NX contained in the
  91. *> vectors NBVAL and NXVAL. The blocking parameters are used
  92. *> in pairs (NB,NX).
  93. *> \endverbatim
  94. *>
  95. *> \param[in] NBVAL
  96. *> \verbatim
  97. *> NBVAL is INTEGER array, dimension (NNB)
  98. *> The values of the blocksize NB.
  99. *> \endverbatim
  100. *>
  101. *> \param[in] NXVAL
  102. *> \verbatim
  103. *> NXVAL is INTEGER array, dimension (NNB)
  104. *> The values of the crossover point NX.
  105. *> \endverbatim
  106. *>
  107. *> \param[in] NNS
  108. *> \verbatim
  109. *> NNS is INTEGER
  110. *> The number of values of NRHS contained in the vector NSVAL.
  111. *> \endverbatim
  112. *>
  113. *> \param[in] NSVAL
  114. *> \verbatim
  115. *> NSVAL is INTEGER array, dimension (NNS)
  116. *> The values of the number of right hand sides NRHS.
  117. *> \endverbatim
  118. *>
  119. *> \param[in] THRESH
  120. *> \verbatim
  121. *> THRESH is REAL
  122. *> The threshold value for the test ratios. A result is
  123. *> included in the output file if RESULT >= THRESH. To have
  124. *> every test ratio printed, use THRESH = 0.
  125. *> \endverbatim
  126. *>
  127. *> \param[in] TSTERR
  128. *> \verbatim
  129. *> TSTERR is LOGICAL
  130. *> Flag that indicates whether error exits are to be tested.
  131. *> \endverbatim
  132. *>
  133. *> \param[out] A
  134. *> \verbatim
  135. *> A is COMPLEX array, dimension (MMAX*NMAX)
  136. *> where MMAX is the maximum value of M in MVAL and NMAX is the
  137. *> maximum value of N in NVAL.
  138. *> \endverbatim
  139. *>
  140. *> \param[out] COPYA
  141. *> \verbatim
  142. *> COPYA is COMPLEX array, dimension (MMAX*NMAX)
  143. *> \endverbatim
  144. *>
  145. *> \param[out] B
  146. *> \verbatim
  147. *> B is COMPLEX array, dimension (MMAX*NSMAX)
  148. *> where MMAX is the maximum value of M in MVAL and NSMAX is the
  149. *> maximum value of NRHS in NSVAL.
  150. *> \endverbatim
  151. *>
  152. *> \param[out] COPYB
  153. *> \verbatim
  154. *> COPYB is COMPLEX array, dimension (MMAX*NSMAX)
  155. *> \endverbatim
  156. *>
  157. *> \param[out] C
  158. *> \verbatim
  159. *> C is COMPLEX array, dimension (MMAX*NSMAX)
  160. *> \endverbatim
  161. *>
  162. *> \param[out] S
  163. *> \verbatim
  164. *> S is REAL array, dimension
  165. *> (min(MMAX,NMAX))
  166. *> \endverbatim
  167. *>
  168. *> \param[out] COPYS
  169. *> \verbatim
  170. *> COPYS is REAL array, dimension
  171. *> (min(MMAX,NMAX))
  172. *> \endverbatim
  173. *>
  174. *> \param[out] WORK
  175. *> \verbatim
  176. *> WORK is COMPLEX array, dimension
  177. *> (MMAX*NMAX + 4*NMAX + MMAX).
  178. *> \endverbatim
  179. *>
  180. *> \param[out] RWORK
  181. *> \verbatim
  182. *> RWORK is REAL array, dimension (5*NMAX-1)
  183. *> \endverbatim
  184. *>
  185. *> \param[out] IWORK
  186. *> \verbatim
  187. *> IWORK is INTEGER array, dimension (15*NMAX)
  188. *> \endverbatim
  189. *>
  190. *> \param[in] NOUT
  191. *> \verbatim
  192. *> NOUT is INTEGER
  193. *> The unit number for output.
  194. *> \endverbatim
  195. *
  196. * Authors:
  197. * ========
  198. *
  199. *> \author Univ. of Tennessee
  200. *> \author Univ. of California Berkeley
  201. *> \author Univ. of Colorado Denver
  202. *> \author NAG Ltd.
  203. *
  204. *> \date November 2011
  205. *
  206. *> \ingroup complex_lin
  207. *
  208. * =====================================================================
  209. SUBROUTINE CDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB,
  210. $ NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B,
  211. $ COPYB, C, S, COPYS, WORK, RWORK, IWORK,
  212. $ NOUT )
  213. *
  214. * -- LAPACK test routine (version 3.4.0) --
  215. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  216. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  217. * November 2011
  218. *
  219. * .. Scalar Arguments ..
  220. LOGICAL TSTERR
  221. INTEGER NM, NN, NNB, NNS, NOUT
  222. REAL THRESH
  223. * ..
  224. * .. Array Arguments ..
  225. LOGICAL DOTYPE( * )
  226. INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
  227. $ NVAL( * ), NXVAL( * )
  228. REAL COPYS( * ), RWORK( * ), S( * )
  229. COMPLEX A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ),
  230. $ WORK( * )
  231. * ..
  232. *
  233. * =====================================================================
  234. *
  235. * .. Parameters ..
  236. INTEGER NTESTS
  237. PARAMETER ( NTESTS = 18 )
  238. INTEGER SMLSIZ
  239. PARAMETER ( SMLSIZ = 25 )
  240. REAL ONE, ZERO
  241. PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
  242. COMPLEX CONE, CZERO
  243. PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ),
  244. $ CZERO = ( 0.0E+0, 0.0E+0 ) )
  245. * ..
  246. * .. Local Scalars ..
  247. CHARACTER TRANS
  248. CHARACTER*3 PATH
  249. INTEGER CRANK, I, IM, IN, INB, INFO, INS, IRANK,
  250. $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK,
  251. $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS,
  252. $ NFAIL, NRHS, NROWS, NRUN, RANK
  253. REAL EPS, NORMA, NORMB, RCOND
  254. * ..
  255. * .. Local Arrays ..
  256. INTEGER ISEED( 4 ), ISEEDY( 4 )
  257. REAL RESULT( NTESTS )
  258. * ..
  259. * .. External Functions ..
  260. REAL CQRT12, CQRT14, CQRT17, SASUM, SLAMCH
  261. EXTERNAL CQRT12, CQRT14, CQRT17, SASUM, SLAMCH
  262. * ..
  263. * .. External Subroutines ..
  264. EXTERNAL ALAERH, ALAHD, ALASVM, CERRLS, CGELS, CGELSD,
  265. $ CGELSS, CGELSX, CGELSY, CGEMM, CLACPY, CLARNV,
  266. $ CQRT13, CQRT15, CQRT16, CSSCAL, SAXPY,
  267. $ XLAENV
  268. * ..
  269. * .. Intrinsic Functions ..
  270. INTRINSIC MAX, MIN, REAL, SQRT
  271. * ..
  272. * .. Scalars in Common ..
  273. LOGICAL LERR, OK
  274. CHARACTER*32 SRNAMT
  275. INTEGER INFOT, IOUNIT
  276. * ..
  277. * .. Common blocks ..
  278. COMMON / INFOC / INFOT, IOUNIT, OK, LERR
  279. COMMON / SRNAMC / SRNAMT
  280. * ..
  281. * .. Data statements ..
  282. DATA ISEEDY / 1988, 1989, 1990, 1991 /
  283. * ..
  284. * .. Executable Statements ..
  285. *
  286. * Initialize constants and the random number seed.
  287. *
  288. PATH( 1: 1 ) = 'Complex precision'
  289. PATH( 2: 3 ) = 'LS'
  290. NRUN = 0
  291. NFAIL = 0
  292. NERRS = 0
  293. DO 10 I = 1, 4
  294. ISEED( I ) = ISEEDY( I )
  295. 10 CONTINUE
  296. EPS = SLAMCH( 'Epsilon' )
  297. *
  298. * Threshold for rank estimation
  299. *
  300. RCOND = SQRT( EPS ) - ( SQRT( EPS )-EPS ) / 2
  301. *
  302. * Test the error exits
  303. *
  304. CALL XLAENV( 9, SMLSIZ )
  305. IF( TSTERR )
  306. $ CALL CERRLS( PATH, NOUT )
  307. *
  308. * Print the header if NM = 0 or NN = 0 and THRESH = 0.
  309. *
  310. IF( ( NM.EQ.0 .OR. NN.EQ.0 ) .AND. THRESH.EQ.ZERO )
  311. $ CALL ALAHD( NOUT, PATH )
  312. INFOT = 0
  313. *
  314. DO 140 IM = 1, NM
  315. M = MVAL( IM )
  316. LDA = MAX( 1, M )
  317. *
  318. DO 130 IN = 1, NN
  319. N = NVAL( IN )
  320. MNMIN = MIN( M, N )
  321. LDB = MAX( 1, M, N )
  322. *
  323. DO 120 INS = 1, NNS
  324. NRHS = NSVAL( INS )
  325. LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ),
  326. $ M*N+4*MNMIN+MAX( M, N ), 2*N+M )
  327. *
  328. DO 110 IRANK = 1, 2
  329. DO 100 ISCALE = 1, 3
  330. ITYPE = ( IRANK-1 )*3 + ISCALE
  331. IF( .NOT.DOTYPE( ITYPE ) )
  332. $ GO TO 100
  333. *
  334. IF( IRANK.EQ.1 ) THEN
  335. *
  336. * Test CGELS
  337. *
  338. * Generate a matrix of scaling type ISCALE
  339. *
  340. CALL CQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
  341. $ ISEED )
  342. DO 40 INB = 1, NNB
  343. NB = NBVAL( INB )
  344. CALL XLAENV( 1, NB )
  345. CALL XLAENV( 3, NXVAL( INB ) )
  346. *
  347. DO 30 ITRAN = 1, 2
  348. IF( ITRAN.EQ.1 ) THEN
  349. TRANS = 'N'
  350. NROWS = M
  351. NCOLS = N
  352. ELSE
  353. TRANS = 'C'
  354. NROWS = N
  355. NCOLS = M
  356. END IF
  357. LDWORK = MAX( 1, NCOLS )
  358. *
  359. * Set up a consistent rhs
  360. *
  361. IF( NCOLS.GT.0 ) THEN
  362. CALL CLARNV( 2, ISEED, NCOLS*NRHS,
  363. $ WORK )
  364. CALL CSSCAL( NCOLS*NRHS,
  365. $ ONE / REAL( NCOLS ), WORK,
  366. $ 1 )
  367. END IF
  368. CALL CGEMM( TRANS, 'No transpose', NROWS,
  369. $ NRHS, NCOLS, CONE, COPYA, LDA,
  370. $ WORK, LDWORK, CZERO, B, LDB )
  371. CALL CLACPY( 'Full', NROWS, NRHS, B, LDB,
  372. $ COPYB, LDB )
  373. *
  374. * Solve LS or overdetermined system
  375. *
  376. IF( M.GT.0 .AND. N.GT.0 ) THEN
  377. CALL CLACPY( 'Full', M, N, COPYA, LDA,
  378. $ A, LDA )
  379. CALL CLACPY( 'Full', NROWS, NRHS,
  380. $ COPYB, LDB, B, LDB )
  381. END IF
  382. SRNAMT = 'CGELS '
  383. CALL CGELS( TRANS, M, N, NRHS, A, LDA, B,
  384. $ LDB, WORK, LWORK, INFO )
  385. *
  386. IF( INFO.NE.0 )
  387. $ CALL ALAERH( PATH, 'CGELS ', INFO, 0,
  388. $ TRANS, M, N, NRHS, -1, NB,
  389. $ ITYPE, NFAIL, NERRS,
  390. $ NOUT )
  391. *
  392. * Check correctness of results
  393. *
  394. LDWORK = MAX( 1, NROWS )
  395. IF( NROWS.GT.0 .AND. NRHS.GT.0 )
  396. $ CALL CLACPY( 'Full', NROWS, NRHS,
  397. $ COPYB, LDB, C, LDB )
  398. CALL CQRT16( TRANS, M, N, NRHS, COPYA,
  399. $ LDA, B, LDB, C, LDB, RWORK,
  400. $ RESULT( 1 ) )
  401. *
  402. IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
  403. $ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
  404. *
  405. * Solving LS system
  406. *
  407. RESULT( 2 ) = CQRT17( TRANS, 1, M, N,
  408. $ NRHS, COPYA, LDA, B, LDB,
  409. $ COPYB, LDB, C, WORK,
  410. $ LWORK )
  411. ELSE
  412. *
  413. * Solving overdetermined system
  414. *
  415. RESULT( 2 ) = CQRT14( TRANS, M, N,
  416. $ NRHS, COPYA, LDA, B, LDB,
  417. $ WORK, LWORK )
  418. END IF
  419. *
  420. * Print information about the tests that
  421. * did not pass the threshold.
  422. *
  423. DO 20 K = 1, 2
  424. IF( RESULT( K ).GE.THRESH ) THEN
  425. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  426. $ CALL ALAHD( NOUT, PATH )
  427. WRITE( NOUT, FMT = 9999 )TRANS, M,
  428. $ N, NRHS, NB, ITYPE, K,
  429. $ RESULT( K )
  430. NFAIL = NFAIL + 1
  431. END IF
  432. 20 CONTINUE
  433. NRUN = NRUN + 2
  434. 30 CONTINUE
  435. 40 CONTINUE
  436. END IF
  437. *
  438. * Generate a matrix of scaling type ISCALE and rank
  439. * type IRANK.
  440. *
  441. CALL CQRT15( ISCALE, IRANK, M, N, NRHS, COPYA, LDA,
  442. $ COPYB, LDB, COPYS, RANK, NORMA, NORMB,
  443. $ ISEED, WORK, LWORK )
  444. *
  445. * workspace used: MAX(M+MIN(M,N),NRHS*MIN(M,N),2*N+M)
  446. *
  447. DO 50 J = 1, N
  448. IWORK( J ) = 0
  449. 50 CONTINUE
  450. LDWORK = MAX( 1, M )
  451. *
  452. * Test CGELSX
  453. *
  454. * CGELSX: Compute the minimum-norm solution X
  455. * to min( norm( A * X - B ) )
  456. * using a complete orthogonal factorization.
  457. *
  458. CALL CLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
  459. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, B, LDB )
  460. *
  461. SRNAMT = 'CGELSX'
  462. CALL CGELSX( M, N, NRHS, A, LDA, B, LDB, IWORK,
  463. $ RCOND, CRANK, WORK, RWORK, INFO )
  464. *
  465. IF( INFO.NE.0 )
  466. $ CALL ALAERH( PATH, 'CGELSX', INFO, 0, ' ', M, N,
  467. $ NRHS, -1, NB, ITYPE, NFAIL, NERRS,
  468. $ NOUT )
  469. *
  470. * workspace used: MAX( MNMIN+3*N, 2*MNMIN+NRHS )
  471. *
  472. * Test 3: Compute relative error in svd
  473. * workspace: M*N + 4*MIN(M,N) + MAX(M,N)
  474. *
  475. RESULT( 3 ) = CQRT12( CRANK, CRANK, A, LDA, COPYS,
  476. $ WORK, LWORK, RWORK )
  477. *
  478. * Test 4: Compute error in solution
  479. * workspace: M*NRHS + M
  480. *
  481. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
  482. $ LDWORK )
  483. CALL CQRT16( 'No transpose', M, N, NRHS, COPYA,
  484. $ LDA, B, LDB, WORK, LDWORK, RWORK,
  485. $ RESULT( 4 ) )
  486. *
  487. * Test 5: Check norm of r'*A
  488. * workspace: NRHS*(M+N)
  489. *
  490. RESULT( 5 ) = ZERO
  491. IF( M.GT.CRANK )
  492. $ RESULT( 5 ) = CQRT17( 'No transpose', 1, M, N,
  493. $ NRHS, COPYA, LDA, B, LDB, COPYB,
  494. $ LDB, C, WORK, LWORK )
  495. *
  496. * Test 6: Check if x is in the rowspace of A
  497. * workspace: (M+NRHS)*(N+2)
  498. *
  499. RESULT( 6 ) = ZERO
  500. *
  501. IF( N.GT.CRANK )
  502. $ RESULT( 6 ) = CQRT14( 'No transpose', M, N,
  503. $ NRHS, COPYA, LDA, B, LDB, WORK,
  504. $ LWORK )
  505. *
  506. * Print information about the tests that did not
  507. * pass the threshold.
  508. *
  509. DO 60 K = 3, 6
  510. IF( RESULT( K ).GE.THRESH ) THEN
  511. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  512. $ CALL ALAHD( NOUT, PATH )
  513. WRITE( NOUT, FMT = 9998 )M, N, NRHS, 0,
  514. $ ITYPE, K, RESULT( K )
  515. NFAIL = NFAIL + 1
  516. END IF
  517. 60 CONTINUE
  518. NRUN = NRUN + 4
  519. *
  520. * Loop for testing different block sizes.
  521. *
  522. DO 90 INB = 1, NNB
  523. NB = NBVAL( INB )
  524. CALL XLAENV( 1, NB )
  525. CALL XLAENV( 3, NXVAL( INB ) )
  526. *
  527. * Test CGELSY
  528. *
  529. * CGELSY: Compute the minimum-norm solution
  530. * X to min( norm( A * X - B ) )
  531. * using the rank-revealing orthogonal
  532. * factorization.
  533. *
  534. CALL CLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
  535. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, B,
  536. $ LDB )
  537. *
  538. * Initialize vector IWORK.
  539. *
  540. DO 70 J = 1, N
  541. IWORK( J ) = 0
  542. 70 CONTINUE
  543. *
  544. * Set LWLSY to the adequate value.
  545. *
  546. LWLSY = MNMIN + MAX( 2*MNMIN, NB*( N+1 ),
  547. $ MNMIN+NB*NRHS )
  548. LWLSY = MAX( 1, LWLSY )
  549. *
  550. SRNAMT = 'CGELSY'
  551. CALL CGELSY( M, N, NRHS, A, LDA, B, LDB, IWORK,
  552. $ RCOND, CRANK, WORK, LWLSY, RWORK,
  553. $ INFO )
  554. IF( INFO.NE.0 )
  555. $ CALL ALAERH( PATH, 'CGELSY', INFO, 0, ' ', M,
  556. $ N, NRHS, -1, NB, ITYPE, NFAIL,
  557. $ NERRS, NOUT )
  558. *
  559. * workspace used: 2*MNMIN+NB*NB+NB*MAX(N,NRHS)
  560. *
  561. * Test 7: Compute relative error in svd
  562. * workspace: M*N + 4*MIN(M,N) + MAX(M,N)
  563. *
  564. RESULT( 7 ) = CQRT12( CRANK, CRANK, A, LDA,
  565. $ COPYS, WORK, LWORK, RWORK )
  566. *
  567. * Test 8: Compute error in solution
  568. * workspace: M*NRHS + M
  569. *
  570. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
  571. $ LDWORK )
  572. CALL CQRT16( 'No transpose', M, N, NRHS, COPYA,
  573. $ LDA, B, LDB, WORK, LDWORK, RWORK,
  574. $ RESULT( 8 ) )
  575. *
  576. * Test 9: Check norm of r'*A
  577. * workspace: NRHS*(M+N)
  578. *
  579. RESULT( 9 ) = ZERO
  580. IF( M.GT.CRANK )
  581. $ RESULT( 9 ) = CQRT17( 'No transpose', 1, M,
  582. $ N, NRHS, COPYA, LDA, B, LDB,
  583. $ COPYB, LDB, C, WORK, LWORK )
  584. *
  585. * Test 10: Check if x is in the rowspace of A
  586. * workspace: (M+NRHS)*(N+2)
  587. *
  588. RESULT( 10 ) = ZERO
  589. *
  590. IF( N.GT.CRANK )
  591. $ RESULT( 10 ) = CQRT14( 'No transpose', M, N,
  592. $ NRHS, COPYA, LDA, B, LDB,
  593. $ WORK, LWORK )
  594. *
  595. * Test CGELSS
  596. *
  597. * CGELSS: Compute the minimum-norm solution
  598. * X to min( norm( A * X - B ) )
  599. * using the SVD.
  600. *
  601. CALL CLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
  602. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, B,
  603. $ LDB )
  604. SRNAMT = 'CGELSS'
  605. CALL CGELSS( M, N, NRHS, A, LDA, B, LDB, S,
  606. $ RCOND, CRANK, WORK, LWORK, RWORK,
  607. $ INFO )
  608. *
  609. IF( INFO.NE.0 )
  610. $ CALL ALAERH( PATH, 'CGELSS', INFO, 0, ' ', M,
  611. $ N, NRHS, -1, NB, ITYPE, NFAIL,
  612. $ NERRS, NOUT )
  613. *
  614. * workspace used: 3*min(m,n) +
  615. * max(2*min(m,n),nrhs,max(m,n))
  616. *
  617. * Test 11: Compute relative error in svd
  618. *
  619. IF( RANK.GT.0 ) THEN
  620. CALL SAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
  621. RESULT( 11 ) = SASUM( MNMIN, S, 1 ) /
  622. $ SASUM( MNMIN, COPYS, 1 ) /
  623. $ ( EPS*REAL( MNMIN ) )
  624. ELSE
  625. RESULT( 11 ) = ZERO
  626. END IF
  627. *
  628. * Test 12: Compute error in solution
  629. *
  630. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
  631. $ LDWORK )
  632. CALL CQRT16( 'No transpose', M, N, NRHS, COPYA,
  633. $ LDA, B, LDB, WORK, LDWORK, RWORK,
  634. $ RESULT( 12 ) )
  635. *
  636. * Test 13: Check norm of r'*A
  637. *
  638. RESULT( 13 ) = ZERO
  639. IF( M.GT.CRANK )
  640. $ RESULT( 13 ) = CQRT17( 'No transpose', 1, M,
  641. $ N, NRHS, COPYA, LDA, B, LDB,
  642. $ COPYB, LDB, C, WORK, LWORK )
  643. *
  644. * Test 14: Check if x is in the rowspace of A
  645. *
  646. RESULT( 14 ) = ZERO
  647. IF( N.GT.CRANK )
  648. $ RESULT( 14 ) = CQRT14( 'No transpose', M, N,
  649. $ NRHS, COPYA, LDA, B, LDB,
  650. $ WORK, LWORK )
  651. *
  652. * Test CGELSD
  653. *
  654. * CGELSD: Compute the minimum-norm solution X
  655. * to min( norm( A * X - B ) ) using a
  656. * divide and conquer SVD.
  657. *
  658. CALL XLAENV( 9, 25 )
  659. *
  660. CALL CLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
  661. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, B,
  662. $ LDB )
  663. *
  664. SRNAMT = 'CGELSD'
  665. CALL CGELSD( M, N, NRHS, A, LDA, B, LDB, S,
  666. $ RCOND, CRANK, WORK, LWORK, RWORK,
  667. $ IWORK, INFO )
  668. IF( INFO.NE.0 )
  669. $ CALL ALAERH( PATH, 'CGELSD', INFO, 0, ' ', M,
  670. $ N, NRHS, -1, NB, ITYPE, NFAIL,
  671. $ NERRS, NOUT )
  672. *
  673. * Test 15: Compute relative error in svd
  674. *
  675. IF( RANK.GT.0 ) THEN
  676. CALL SAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
  677. RESULT( 15 ) = SASUM( MNMIN, S, 1 ) /
  678. $ SASUM( MNMIN, COPYS, 1 ) /
  679. $ ( EPS*REAL( MNMIN ) )
  680. ELSE
  681. RESULT( 15 ) = ZERO
  682. END IF
  683. *
  684. * Test 16: Compute error in solution
  685. *
  686. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
  687. $ LDWORK )
  688. CALL CQRT16( 'No transpose', M, N, NRHS, COPYA,
  689. $ LDA, B, LDB, WORK, LDWORK, RWORK,
  690. $ RESULT( 16 ) )
  691. *
  692. * Test 17: Check norm of r'*A
  693. *
  694. RESULT( 17 ) = ZERO
  695. IF( M.GT.CRANK )
  696. $ RESULT( 17 ) = CQRT17( 'No transpose', 1, M,
  697. $ N, NRHS, COPYA, LDA, B, LDB,
  698. $ COPYB, LDB, C, WORK, LWORK )
  699. *
  700. * Test 18: Check if x is in the rowspace of A
  701. *
  702. RESULT( 18 ) = ZERO
  703. IF( N.GT.CRANK )
  704. $ RESULT( 18 ) = CQRT14( 'No transpose', M, N,
  705. $ NRHS, COPYA, LDA, B, LDB,
  706. $ WORK, LWORK )
  707. *
  708. * Print information about the tests that did not
  709. * pass the threshold.
  710. *
  711. DO 80 K = 7, NTESTS
  712. IF( RESULT( K ).GE.THRESH ) THEN
  713. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  714. $ CALL ALAHD( NOUT, PATH )
  715. WRITE( NOUT, FMT = 9998 )M, N, NRHS, NB,
  716. $ ITYPE, K, RESULT( K )
  717. NFAIL = NFAIL + 1
  718. END IF
  719. 80 CONTINUE
  720. NRUN = NRUN + 12
  721. *
  722. 90 CONTINUE
  723. 100 CONTINUE
  724. 110 CONTINUE
  725. 120 CONTINUE
  726. 130 CONTINUE
  727. 140 CONTINUE
  728. *
  729. * Print a summary of the results.
  730. *
  731. CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
  732. *
  733. 9999 FORMAT( ' TRANS=''', A1, ''', M=', I5, ', N=', I5, ', NRHS=', I4,
  734. $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 )
  735. 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4,
  736. $ ', type', I2, ', test(', I2, ')=', G12.5 )
  737. RETURN
  738. *
  739. * End of CDRVLS
  740. *
  741. END