LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cdrvls.f
Go to the documentation of this file.
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