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 25 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670
  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, CGELSS, CGELSY
  37. *> 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 2015
  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.6.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 2015
  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 = 14 )
  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, 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. LDWORK = MAX( 1, M )
  448. *
  449. * Loop for testing different block sizes.
  450. *
  451. DO 90 INB = 1, NNB
  452. NB = NBVAL( INB )
  453. CALL XLAENV( 1, NB )
  454. CALL XLAENV( 3, NXVAL( INB ) )
  455. *
  456. * Test CGELSY
  457. *
  458. * CGELSY: Compute the minimum-norm solution
  459. * X to min( norm( A * X - B ) )
  460. * using the rank-revealing orthogonal
  461. * factorization.
  462. *
  463. CALL CLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
  464. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, B,
  465. $ LDB )
  466. *
  467. * Initialize vector IWORK.
  468. *
  469. DO 70 J = 1, N
  470. IWORK( J ) = 0
  471. 70 CONTINUE
  472. *
  473. * Set LWLSY to the adequate value.
  474. *
  475. LWLSY = MNMIN + MAX( 2*MNMIN, NB*( N+1 ),
  476. $ MNMIN+NB*NRHS )
  477. LWLSY = MAX( 1, LWLSY )
  478. *
  479. SRNAMT = 'CGELSY'
  480. CALL CGELSY( M, N, NRHS, A, LDA, B, LDB, IWORK,
  481. $ RCOND, CRANK, WORK, LWLSY, RWORK,
  482. $ INFO )
  483. IF( INFO.NE.0 )
  484. $ CALL ALAERH( PATH, 'CGELSY', INFO, 0, ' ', M,
  485. $ N, NRHS, -1, NB, ITYPE, NFAIL,
  486. $ NERRS, NOUT )
  487. *
  488. * workspace used: 2*MNMIN+NB*NB+NB*MAX(N,NRHS)
  489. *
  490. * Test 3: Compute relative error in svd
  491. * workspace: M*N + 4*MIN(M,N) + MAX(M,N)
  492. *
  493. RESULT( 3 ) = CQRT12( CRANK, CRANK, A, LDA,
  494. $ COPYS, WORK, LWORK, RWORK )
  495. *
  496. * Test 4: Compute error in solution
  497. * workspace: M*NRHS + M
  498. *
  499. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
  500. $ LDWORK )
  501. CALL CQRT16( 'No transpose', M, N, NRHS, COPYA,
  502. $ LDA, B, LDB, WORK, LDWORK, RWORK,
  503. $ RESULT( 4 ) )
  504. *
  505. * Test 5: Check norm of r'*A
  506. * workspace: NRHS*(M+N)
  507. *
  508. RESULT( 5 ) = ZERO
  509. IF( M.GT.CRANK )
  510. $ RESULT( 5 ) = CQRT17( 'No transpose', 1, M,
  511. $ N, NRHS, COPYA, LDA, B, LDB,
  512. $ COPYB, LDB, C, WORK, LWORK )
  513. *
  514. * Test 6: Check if x is in the rowspace of A
  515. * workspace: (M+NRHS)*(N+2)
  516. *
  517. RESULT( 6 ) = ZERO
  518. *
  519. IF( N.GT.CRANK )
  520. $ RESULT( 6 ) = CQRT14( 'No transpose', M, N,
  521. $ NRHS, COPYA, LDA, B, LDB,
  522. $ WORK, LWORK )
  523. *
  524. * Test CGELSS
  525. *
  526. * CGELSS: Compute the minimum-norm solution
  527. * X to min( norm( A * X - B ) )
  528. * using the SVD.
  529. *
  530. CALL CLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
  531. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, B,
  532. $ LDB )
  533. SRNAMT = 'CGELSS'
  534. CALL CGELSS( M, N, NRHS, A, LDA, B, LDB, S,
  535. $ RCOND, CRANK, WORK, LWORK, RWORK,
  536. $ INFO )
  537. *
  538. IF( INFO.NE.0 )
  539. $ CALL ALAERH( PATH, 'CGELSS', INFO, 0, ' ', M,
  540. $ N, NRHS, -1, NB, ITYPE, NFAIL,
  541. $ NERRS, NOUT )
  542. *
  543. * workspace used: 3*min(m,n) +
  544. * max(2*min(m,n),nrhs,max(m,n))
  545. *
  546. * Test 7: Compute relative error in svd
  547. *
  548. IF( RANK.GT.0 ) THEN
  549. CALL SAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
  550. RESULT( 7 ) = SASUM( MNMIN, S, 1 ) /
  551. $ SASUM( MNMIN, COPYS, 1 ) /
  552. $ ( EPS*REAL( MNMIN ) )
  553. ELSE
  554. RESULT( 7 ) = ZERO
  555. END IF
  556. *
  557. * Test 8: Compute error in solution
  558. *
  559. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
  560. $ LDWORK )
  561. CALL CQRT16( 'No transpose', M, N, NRHS, COPYA,
  562. $ LDA, B, LDB, WORK, LDWORK, RWORK,
  563. $ RESULT( 8 ) )
  564. *
  565. * Test 9: Check norm of r'*A
  566. *
  567. RESULT( 9 ) = ZERO
  568. IF( M.GT.CRANK )
  569. $ RESULT( 9 ) = CQRT17( 'No transpose', 1, M,
  570. $ N, NRHS, COPYA, LDA, B, LDB,
  571. $ COPYB, LDB, C, WORK, LWORK )
  572. *
  573. * Test 10: Check if x is in the rowspace of A
  574. *
  575. RESULT( 10 ) = ZERO
  576. IF( N.GT.CRANK )
  577. $ RESULT( 10 ) = CQRT14( 'No transpose', M, N,
  578. $ NRHS, COPYA, LDA, B, LDB,
  579. $ WORK, LWORK )
  580. *
  581. * Test CGELSD
  582. *
  583. * CGELSD: Compute the minimum-norm solution X
  584. * to min( norm( A * X - B ) ) using a
  585. * divide and conquer SVD.
  586. *
  587. CALL XLAENV( 9, 25 )
  588. *
  589. CALL CLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
  590. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, B,
  591. $ LDB )
  592. *
  593. SRNAMT = 'CGELSD'
  594. CALL CGELSD( M, N, NRHS, A, LDA, B, LDB, S,
  595. $ RCOND, CRANK, WORK, LWORK, RWORK,
  596. $ IWORK, INFO )
  597. IF( INFO.NE.0 )
  598. $ CALL ALAERH( PATH, 'CGELSD', INFO, 0, ' ', M,
  599. $ N, NRHS, -1, NB, ITYPE, NFAIL,
  600. $ NERRS, NOUT )
  601. *
  602. * Test 11: Compute relative error in svd
  603. *
  604. IF( RANK.GT.0 ) THEN
  605. CALL SAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
  606. RESULT( 11 ) = SASUM( MNMIN, S, 1 ) /
  607. $ SASUM( MNMIN, COPYS, 1 ) /
  608. $ ( EPS*REAL( MNMIN ) )
  609. ELSE
  610. RESULT( 11 ) = ZERO
  611. END IF
  612. *
  613. * Test 12: Compute error in solution
  614. *
  615. CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
  616. $ LDWORK )
  617. CALL CQRT16( 'No transpose', M, N, NRHS, COPYA,
  618. $ LDA, B, LDB, WORK, LDWORK, RWORK,
  619. $ RESULT( 12 ) )
  620. *
  621. * Test 13: Check norm of r'*A
  622. *
  623. RESULT( 13 ) = ZERO
  624. IF( M.GT.CRANK )
  625. $ RESULT( 13 ) = CQRT17( 'No transpose', 1, M,
  626. $ N, NRHS, COPYA, LDA, B, LDB,
  627. $ COPYB, LDB, C, WORK, LWORK )
  628. *
  629. * Test 14: Check if x is in the rowspace of A
  630. *
  631. RESULT( 14 ) = ZERO
  632. IF( N.GT.CRANK )
  633. $ RESULT( 14 ) = CQRT14( 'No transpose', M, N,
  634. $ NRHS, COPYA, LDA, B, LDB,
  635. $ WORK, LWORK )
  636. *
  637. * Print information about the tests that did not
  638. * pass the threshold.
  639. *
  640. DO 80 K = 3, NTESTS
  641. IF( RESULT( K ).GE.THRESH ) THEN
  642. IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
  643. $ CALL ALAHD( NOUT, PATH )
  644. WRITE( NOUT, FMT = 9998 )M, N, NRHS, NB,
  645. $ ITYPE, K, RESULT( K )
  646. NFAIL = NFAIL + 1
  647. END IF
  648. 80 CONTINUE
  649. NRUN = NRUN + 12
  650. *
  651. 90 CONTINUE
  652. 100 CONTINUE
  653. 110 CONTINUE
  654. 120 CONTINUE
  655. 130 CONTINUE
  656. 140 CONTINUE
  657. *
  658. * Print a summary of the results.
  659. *
  660. CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
  661. *
  662. 9999 FORMAT( ' TRANS=''', A1, ''', M=', I5, ', N=', I5, ', NRHS=', I4,
  663. $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 )
  664. 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4,
  665. $ ', type', I2, ', test(', I2, ')=', G12.5 )
  666. RETURN
  667. *
  668. * End of CDRVLS
  669. *
  670. END