LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ ddrvbd()

subroutine ddrvbd ( integer  NSIZES,
integer, dimension( * )  MM,
integer, dimension( * )  NN,
integer  NTYPES,
logical, dimension( * )  DOTYPE,
integer, dimension( 4 )  ISEED,
double precision  THRESH,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( ldu, * )  U,
integer  LDU,
double precision, dimension( ldvt, * )  VT,
integer  LDVT,
double precision, dimension( lda, * )  ASAV,
double precision, dimension( ldu, * )  USAV,
double precision, dimension( ldvt, * )  VTSAV,
double precision, dimension( * )  S,
double precision, dimension( * )  SSAV,
double precision, dimension( * )  E,
double precision, dimension( * )  WORK,
integer  LWORK,
integer, dimension( * )  IWORK,
integer  NOUT,
integer  INFO 
)

DDRVBD

Purpose:
 DDRVBD checks the singular value decomposition (SVD) drivers
 DGESVD, DGESDD, DGESVDQ, DGESVJ, DGEJSV, and DGESVDX.

 Both DGESVD and DGESDD factor A = U diag(S) VT, where U and VT are
 orthogonal and diag(S) is diagonal with the entries of the array S
 on its diagonal. The entries of S are the singular values,
 nonnegative and stored in decreasing order.  U and VT can be
 optionally not computed, overwritten on A, or computed partially.

 A is M by N. Let MNMIN = min( M, N ). S has dimension MNMIN.
 U can be M by M or M by MNMIN. VT can be N by N or MNMIN by N.

 When DDRVBD is called, a number of matrix "sizes" (M's and N's)
 and a number of matrix "types" are specified.  For each size (M,N)
 and each type of matrix, and for the minimal workspace as well as
 workspace adequate to permit blocking, an  M x N  matrix "A" will be
 generated and used to test the SVD routines.  For each matrix, A will
 be factored as A = U diag(S) VT and the following 12 tests computed:

 Test for DGESVD:

 (1)    | A - U diag(S) VT | / ( |A| max(M,N) ulp )

 (2)    | I - U'U | / ( M ulp )

 (3)    | I - VT VT' | / ( N ulp )

 (4)    S contains MNMIN nonnegative values in decreasing order.
        (Return 0 if true, 1/ULP if false.)

 (5)    | U - Upartial | / ( M ulp ) where Upartial is a partially
        computed U.

 (6)    | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
        computed VT.

 (7)    | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
        vector of singular values from the partial SVD

 Test for DGESDD:

 (8)    | A - U diag(S) VT | / ( |A| max(M,N) ulp )

 (9)    | I - U'U | / ( M ulp )

 (10)   | I - VT VT' | / ( N ulp )

 (11)   S contains MNMIN nonnegative values in decreasing order.
        (Return 0 if true, 1/ULP if false.)

 (12)   | U - Upartial | / ( M ulp ) where Upartial is a partially
        computed U.

 (13)   | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
        computed VT.

 (14)   | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
        vector of singular values from the partial SVD

 Test for DGESVDQ:

 (36)   | A - U diag(S) VT | / ( |A| max(M,N) ulp )

 (37)   | I - U'U | / ( M ulp )

 (38)   | I - VT VT' | / ( N ulp )

 (39)   S contains MNMIN nonnegative values in decreasing order.
        (Return 0 if true, 1/ULP if false.)

 Test for DGESVJ:

 (15)   | A - U diag(S) VT | / ( |A| max(M,N) ulp )

 (16)   | I - U'U | / ( M ulp )

 (17)   | I - VT VT' | / ( N ulp )

 (18)   S contains MNMIN nonnegative values in decreasing order.
        (Return 0 if true, 1/ULP if false.)

 Test for DGEJSV:

 (19)   | A - U diag(S) VT | / ( |A| max(M,N) ulp )

 (20)   | I - U'U | / ( M ulp )

 (21)   | I - VT VT' | / ( N ulp )

 (22)   S contains MNMIN nonnegative values in decreasing order.
        (Return 0 if true, 1/ULP if false.)

 Test for DGESVDX( 'V', 'V', 'A' )/DGESVDX( 'N', 'N', 'A' )

 (23)   | A - U diag(S) VT | / ( |A| max(M,N) ulp )

 (24)   | I - U'U | / ( M ulp )

 (25)   | I - VT VT' | / ( N ulp )

 (26)   S contains MNMIN nonnegative values in decreasing order.
        (Return 0 if true, 1/ULP if false.)

 (27)   | U - Upartial | / ( M ulp ) where Upartial is a partially
        computed U.

 (28)   | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
        computed VT.

 (29)   | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
        vector of singular values from the partial SVD

 Test for DGESVDX( 'V', 'V', 'I' )

 (30)   | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )

 (31)   | I - U'U | / ( M ulp )

 (32)   | I - VT VT' | / ( N ulp )

 Test for DGESVDX( 'V', 'V', 'V' )

 (33)   | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )

 (34)   | I - U'U | / ( M ulp )

 (35)   | I - VT VT' | / ( N ulp )

 The "sizes" are specified by the arrays MM(1:NSIZES) and
 NN(1:NSIZES); the value of each element pair (MM(j),NN(j))
 specifies one size.  The "types" are specified by a logical array
 DOTYPE( 1:NTYPES ); if DOTYPE(j) is .TRUE., then matrix type "j"
 will be generated.
 Currently, the list of possible types is:

 (1)  The zero matrix.
 (2)  The identity matrix.
 (3)  A matrix of the form  U D V, where U and V are orthogonal and
      D has evenly spaced entries 1, ..., ULP with random signs
      on the diagonal.
 (4)  Same as (3), but multiplied by the underflow-threshold / ULP.
 (5)  Same as (3), but multiplied by the overflow-threshold * ULP.
Parameters
[in]NSIZES
          NSIZES is INTEGER
          The number of matrix sizes (M,N) contained in the vectors
          MM and NN.
[in]MM
          MM is INTEGER array, dimension (NSIZES)
          The values of the matrix row dimension M.
[in]NN
          NN is INTEGER array, dimension (NSIZES)
          The values of the matrix column dimension N.
[in]NTYPES
          NTYPES is INTEGER
          The number of elements in DOTYPE.   If it is zero, DDRVBD
          does nothing.  It must be at least zero.  If it is MAXTYP+1
          and NSIZES is 1, then an additional type, MAXTYP+1 is
          defined, which is to use whatever matrices are in A and B.
          This is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
          DOTYPE(MAXTYP+1) is .TRUE. .
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          If DOTYPE(j) is .TRUE., then for each size (m,n), a matrix
          of type j will be generated.  If NTYPES is smaller than the
          maximum number of types defined (PARAMETER MAXTYP), then
          types NTYPES+1 through MAXTYP will not be generated.  If
          NTYPES is larger than MAXTYP, DOTYPE(MAXTYP+1) through
          DOTYPE(NTYPES) will be ignored.
[in,out]ISEED
          ISEED is INTEGER array, dimension (4)
          On entry, the seed of the random number generator.  The array
          elements should be between 0 and 4095; if not they will be
          reduced mod 4096.  Also, ISEED(4) must be odd.
          On exit, ISEED is changed and can be used in the next call to
          DDRVBD to continue the same random number sequence.
[in]THRESH
          THRESH is DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  The test
          ratios are scaled to be O(1), so THRESH should be a small
          multiple of 1, e.g., 10 or 100.  To have every test ratio
          printed, use THRESH = 0.
[out]A
          A is DOUBLE PRECISION array, dimension (LDA,NMAX)
          where NMAX is the maximum value of N in NN.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,MMAX),
          where MMAX is the maximum value of M in MM.
[out]U
          U is DOUBLE PRECISION array, dimension (LDU,MMAX)
[in]LDU
          LDU is INTEGER
          The leading dimension of the array U.  LDU >= max(1,MMAX).
[out]VT
          VT is DOUBLE PRECISION array, dimension (LDVT,NMAX)
[in]LDVT
          LDVT is INTEGER
          The leading dimension of the array VT.  LDVT >= max(1,NMAX).
[out]ASAV
          ASAV is DOUBLE PRECISION array, dimension (LDA,NMAX)
[out]USAV
          USAV is DOUBLE PRECISION array, dimension (LDU,MMAX)
[out]VTSAV
          VTSAV is DOUBLE PRECISION array, dimension (LDVT,NMAX)
[out]S
          S is DOUBLE PRECISION array, dimension
                      (max(min(MM,NN)))
[out]SSAV
          SSAV is DOUBLE PRECISION array, dimension
                      (max(min(MM,NN)))
[out]E
          E is DOUBLE PRECISION array, dimension
                      (max(min(MM,NN)))
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          The number of entries in WORK.  This must be at least
          max(3*MN+MX,5*MN-4)+2*MN**2 for all pairs
          pairs  (MN,MX)=( min(MM(j),NN(j), max(MM(j),NN(j)) )
[out]IWORK
          IWORK is INTEGER array, dimension at least 8*min(M,N)
[in]NOUT
          NOUT is INTEGER
          The FORTRAN unit number for printing out error messages
          (e.g., if a routine returns IINFO not equal to 0.)
[out]INFO
          INFO is INTEGER
          If 0, then everything ran OK.
           -1: NSIZES < 0
           -2: Some MM(j) < 0
           -3: Some NN(j) < 0
           -4: NTYPES < 0
           -7: THRESH < 0
          -10: LDA < 1 or LDA < MMAX, where MMAX is max( MM(j) ).
          -12: LDU < 1 or LDU < MMAX.
          -14: LDVT < 1 or LDVT < NMAX, where NMAX is max( NN(j) ).
          -21: LWORK too small.
          If  DLATMS, or DGESVD returns an error code, the
              absolute value of it is returned.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
June 2016

Definition at line 368 of file ddrvbd.f.

368 *
369  IMPLICIT NONE
370 *
371 * -- LAPACK test routine (version 3.7.0) --
372 * -- LAPACK is a software package provided by Univ. of Tennessee, --
373 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
374 * June 2016
375 *
376 * .. Scalar Arguments ..
377  INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES,
378  $ NTYPES
379  DOUBLE PRECISION THRESH
380 * ..
381 * .. Array Arguments ..
382  LOGICAL DOTYPE( * )
383  INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
384  DOUBLE PRECISION A( LDA, * ), ASAV( LDA, * ), E( * ), S( * ),
385  $ SSAV( * ), U( LDU, * ), USAV( LDU, * ),
386  $ VT( LDVT, * ), VTSAV( LDVT, * ), WORK( * )
387 * ..
388 *
389 * =====================================================================
390 *
391 * .. Parameters ..
392  DOUBLE PRECISION ZERO, ONE, TWO, HALF
393  parameter( zero = 0.0d0, one = 1.0d0, two = 2.0d0,
394  $ half = 0.5d0 )
395  INTEGER MAXTYP
396  parameter( maxtyp = 5 )
397 * ..
398 * .. Local Scalars ..
399  LOGICAL BADMM, BADNN
400  CHARACTER JOBQ, JOBU, JOBVT, RANGE
401  CHARACTER*3 PATH
402  INTEGER I, IINFO, IJQ, IJU, IJVT, IL,IU, IWS, IWTMP,
403  $ ITEMP, J, JSIZE, JTYPE, LSWORK, M, MINWRK,
404  $ MMAX, MNMAX, MNMIN, MTYPES, N, NFAIL,
405  $ NMAX, NS, NSI, NSV, NTEST
406  DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP,
407  $ ULPINV, UNFL, VL, VU
408 * ..
409 * .. Local Scalars for DGESVDQ ..
410  INTEGER LIWORK, LRWORK, NUMRANK
411 * ..
412 * .. Local Arrays for DGESVDQ ..
413  DOUBLE PRECISION RWORK( 2 )
414 * ..
415 * .. Local Arrays ..
416  CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
417  INTEGER IOLDSD( 4 ), ISEED2( 4 )
418  DOUBLE PRECISION RESULT( 39 )
419 * ..
420 * .. External Functions ..
421  DOUBLE PRECISION DLAMCH, DLARND
422  EXTERNAL dlamch, dlarnd
423 * ..
424 * .. External Subroutines ..
425  EXTERNAL alasvm, dbdt01, dgejsv, dgesdd, dgesvd,
426  $ dgesvdq, dgesvdx, dgesvj, dlabad, dlacpy,
427  $ dlaset, dlatms, dort01, dort03, xerbla
428 * ..
429 * .. Intrinsic Functions ..
430  INTRINSIC abs, dble, int, max, min
431 * ..
432 * .. Scalars in Common ..
433  LOGICAL LERR, OK
434  CHARACTER*32 SRNAMT
435  INTEGER INFOT, NUNIT
436 * ..
437 * .. Common blocks ..
438  COMMON / infoc / infot, nunit, ok, lerr
439  COMMON / srnamc / srnamt
440 * ..
441 * .. Data statements ..
442  DATA cjob / 'N', 'O', 'S', 'A' /
443  DATA cjobr / 'A', 'V', 'I' /
444  DATA cjobv / 'N', 'V' /
445 * ..
446 * .. Executable Statements ..
447 *
448 * Check for errors
449 *
450  info = 0
451  badmm = .false.
452  badnn = .false.
453  mmax = 1
454  nmax = 1
455  mnmax = 1
456  minwrk = 1
457  DO 10 j = 1, nsizes
458  mmax = max( mmax, mm( j ) )
459  IF( mm( j ).LT.0 )
460  $ badmm = .true.
461  nmax = max( nmax, nn( j ) )
462  IF( nn( j ).LT.0 )
463  $ badnn = .true.
464  mnmax = max( mnmax, min( mm( j ), nn( j ) ) )
465  minwrk = max( minwrk, max( 3*min( mm( j ),
466  $ nn( j ) )+max( mm( j ), nn( j ) ), 5*min( mm( j ),
467  $ nn( j )-4 ) )+2*min( mm( j ), nn( j ) )**2 )
468  10 CONTINUE
469 *
470 * Check for errors
471 *
472  IF( nsizes.LT.0 ) THEN
473  info = -1
474  ELSE IF( badmm ) THEN
475  info = -2
476  ELSE IF( badnn ) THEN
477  info = -3
478  ELSE IF( ntypes.LT.0 ) THEN
479  info = -4
480  ELSE IF( lda.LT.max( 1, mmax ) ) THEN
481  info = -10
482  ELSE IF( ldu.LT.max( 1, mmax ) ) THEN
483  info = -12
484  ELSE IF( ldvt.LT.max( 1, nmax ) ) THEN
485  info = -14
486  ELSE IF( minwrk.GT.lwork ) THEN
487  info = -21
488  END IF
489 *
490  IF( info.NE.0 ) THEN
491  CALL xerbla( 'DDRVBD', -info )
492  RETURN
493  END IF
494 *
495 * Initialize constants
496 *
497  path( 1: 1 ) = 'Double precision'
498  path( 2: 3 ) = 'BD'
499  nfail = 0
500  ntest = 0
501  unfl = dlamch( 'Safe minimum' )
502  ovfl = one / unfl
503  CALL dlabad( unfl, ovfl )
504  ulp = dlamch( 'Precision' )
505  rtunfl = sqrt( unfl )
506  ulpinv = one / ulp
507  infot = 0
508 *
509 * Loop over sizes, types
510 *
511  DO 240 jsize = 1, nsizes
512  m = mm( jsize )
513  n = nn( jsize )
514  mnmin = min( m, n )
515 *
516  IF( nsizes.NE.1 ) THEN
517  mtypes = min( maxtyp, ntypes )
518  ELSE
519  mtypes = min( maxtyp+1, ntypes )
520  END IF
521 *
522  DO 230 jtype = 1, mtypes
523  IF( .NOT.dotype( jtype ) )
524  $ GO TO 230
525 *
526  DO 20 j = 1, 4
527  ioldsd( j ) = iseed( j )
528  20 CONTINUE
529 *
530 * Compute "A"
531 *
532  IF( mtypes.GT.maxtyp )
533  $ GO TO 30
534 *
535  IF( jtype.EQ.1 ) THEN
536 *
537 * Zero matrix
538 *
539  CALL dlaset( 'Full', m, n, zero, zero, a, lda )
540 *
541  ELSE IF( jtype.EQ.2 ) THEN
542 *
543 * Identity matrix
544 *
545  CALL dlaset( 'Full', m, n, zero, one, a, lda )
546 *
547  ELSE
548 *
549 * (Scaled) random matrix
550 *
551  IF( jtype.EQ.3 )
552  $ anorm = one
553  IF( jtype.EQ.4 )
554  $ anorm = unfl / ulp
555  IF( jtype.EQ.5 )
556  $ anorm = ovfl*ulp
557  CALL dlatms( m, n, 'U', iseed, 'N', s, 4, dble( mnmin ),
558  $ anorm, m-1, n-1, 'N', a, lda, work, iinfo )
559  IF( iinfo.NE.0 ) THEN
560  WRITE( nout, fmt = 9996 )'Generator', iinfo, m, n,
561  $ jtype, ioldsd
562  info = abs( iinfo )
563  RETURN
564  END IF
565  END IF
566 *
567  30 CONTINUE
568  CALL dlacpy( 'F', m, n, a, lda, asav, lda )
569 *
570 * Do for minimal and adequate (for blocking) workspace
571 *
572  DO 220 iws = 1, 4
573 *
574  DO 40 j = 1, 32
575  result( j ) = -one
576  40 CONTINUE
577 *
578 * Test DGESVD: Factorize A
579 *
580  iwtmp = max( 3*min( m, n )+max( m, n ), 5*min( m, n ) )
581  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
582  lswork = min( lswork, lwork )
583  lswork = max( lswork, 1 )
584  IF( iws.EQ.4 )
585  $ lswork = lwork
586 *
587  IF( iws.GT.1 )
588  $ CALL dlacpy( 'F', m, n, asav, lda, a, lda )
589  srnamt = 'DGESVD'
590  CALL dgesvd( 'A', 'A', m, n, a, lda, ssav, usav, ldu,
591  $ vtsav, ldvt, work, lswork, iinfo )
592  IF( iinfo.NE.0 ) THEN
593  WRITE( nout, fmt = 9995 )'GESVD', iinfo, m, n, jtype,
594  $ lswork, ioldsd
595  info = abs( iinfo )
596  RETURN
597  END IF
598 *
599 * Do tests 1--4
600 *
601  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
602  $ vtsav, ldvt, work, result( 1 ) )
603  IF( m.NE.0 .AND. n.NE.0 ) THEN
604  CALL dort01( 'Columns', m, m, usav, ldu, work, lwork,
605  $ result( 2 ) )
606  CALL dort01( 'Rows', n, n, vtsav, ldvt, work, lwork,
607  $ result( 3 ) )
608  END IF
609  result( 4 ) = zero
610  DO 50 i = 1, mnmin - 1
611  IF( ssav( i ).LT.ssav( i+1 ) )
612  $ result( 4 ) = ulpinv
613  IF( ssav( i ).LT.zero )
614  $ result( 4 ) = ulpinv
615  50 CONTINUE
616  IF( mnmin.GE.1 ) THEN
617  IF( ssav( mnmin ).LT.zero )
618  $ result( 4 ) = ulpinv
619  END IF
620 *
621 * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
622 *
623  result( 5 ) = zero
624  result( 6 ) = zero
625  result( 7 ) = zero
626  DO 80 iju = 0, 3
627  DO 70 ijvt = 0, 3
628  IF( ( iju.EQ.3 .AND. ijvt.EQ.3 ) .OR.
629  $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )GO TO 70
630  jobu = cjob( iju+1 )
631  jobvt = cjob( ijvt+1 )
632  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
633  srnamt = 'DGESVD'
634  CALL dgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,
635  $ vt, ldvt, work, lswork, iinfo )
636 *
637 * Compare U
638 *
639  dif = zero
640  IF( m.GT.0 .AND. n.GT.0 ) THEN
641  IF( iju.EQ.1 ) THEN
642  CALL dort03( 'C', m, mnmin, m, mnmin, usav,
643  $ ldu, a, lda, work, lwork, dif,
644  $ iinfo )
645  ELSE IF( iju.EQ.2 ) THEN
646  CALL dort03( 'C', m, mnmin, m, mnmin, usav,
647  $ ldu, u, ldu, work, lwork, dif,
648  $ iinfo )
649  ELSE IF( iju.EQ.3 ) THEN
650  CALL dort03( 'C', m, m, m, mnmin, usav, ldu,
651  $ u, ldu, work, lwork, dif,
652  $ iinfo )
653  END IF
654  END IF
655  result( 5 ) = max( result( 5 ), dif )
656 *
657 * Compare VT
658 *
659  dif = zero
660  IF( m.GT.0 .AND. n.GT.0 ) THEN
661  IF( ijvt.EQ.1 ) THEN
662  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
663  $ ldvt, a, lda, work, lwork, dif,
664  $ iinfo )
665  ELSE IF( ijvt.EQ.2 ) THEN
666  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
667  $ ldvt, vt, ldvt, work, lwork,
668  $ dif, iinfo )
669  ELSE IF( ijvt.EQ.3 ) THEN
670  CALL dort03( 'R', n, n, n, mnmin, vtsav,
671  $ ldvt, vt, ldvt, work, lwork,
672  $ dif, iinfo )
673  END IF
674  END IF
675  result( 6 ) = max( result( 6 ), dif )
676 *
677 * Compare S
678 *
679  dif = zero
680  div = max( mnmin*ulp*s( 1 ), unfl )
681  DO 60 i = 1, mnmin - 1
682  IF( ssav( i ).LT.ssav( i+1 ) )
683  $ dif = ulpinv
684  IF( ssav( i ).LT.zero )
685  $ dif = ulpinv
686  dif = max( dif, abs( ssav( i )-s( i ) ) / div )
687  60 CONTINUE
688  result( 7 ) = max( result( 7 ), dif )
689  70 CONTINUE
690  80 CONTINUE
691 *
692 * Test DGESDD: Factorize A
693 *
694  iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
695  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
696  lswork = min( lswork, lwork )
697  lswork = max( lswork, 1 )
698  IF( iws.EQ.4 )
699  $ lswork = lwork
700 *
701  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
702  srnamt = 'DGESDD'
703  CALL dgesdd( 'A', m, n, a, lda, ssav, usav, ldu, vtsav,
704  $ ldvt, work, lswork, iwork, iinfo )
705  IF( iinfo.NE.0 ) THEN
706  WRITE( nout, fmt = 9995 )'GESDD', iinfo, m, n, jtype,
707  $ lswork, ioldsd
708  info = abs( iinfo )
709  RETURN
710  END IF
711 *
712 * Do tests 8--11
713 *
714  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
715  $ vtsav, ldvt, work, result( 8 ) )
716  IF( m.NE.0 .AND. n.NE.0 ) THEN
717  CALL dort01( 'Columns', m, m, usav, ldu, work, lwork,
718  $ result( 9 ) )
719  CALL dort01( 'Rows', n, n, vtsav, ldvt, work, lwork,
720  $ result( 10 ) )
721  END IF
722  result( 11 ) = zero
723  DO 90 i = 1, mnmin - 1
724  IF( ssav( i ).LT.ssav( i+1 ) )
725  $ result( 11 ) = ulpinv
726  IF( ssav( i ).LT.zero )
727  $ result( 11 ) = ulpinv
728  90 CONTINUE
729  IF( mnmin.GE.1 ) THEN
730  IF( ssav( mnmin ).LT.zero )
731  $ result( 11 ) = ulpinv
732  END IF
733 *
734 * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
735 *
736  result( 12 ) = zero
737  result( 13 ) = zero
738  result( 14 ) = zero
739  DO 110 ijq = 0, 2
740  jobq = cjob( ijq+1 )
741  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
742  srnamt = 'DGESDD'
743  CALL dgesdd( jobq, m, n, a, lda, s, u, ldu, vt, ldvt,
744  $ work, lswork, iwork, iinfo )
745 *
746 * Compare U
747 *
748  dif = zero
749  IF( m.GT.0 .AND. n.GT.0 ) THEN
750  IF( ijq.EQ.1 ) THEN
751  IF( m.GE.n ) THEN
752  CALL dort03( 'C', m, mnmin, m, mnmin, usav,
753  $ ldu, a, lda, work, lwork, dif,
754  $ info )
755  ELSE
756  CALL dort03( 'C', m, mnmin, m, mnmin, usav,
757  $ ldu, u, ldu, work, lwork, dif,
758  $ info )
759  END IF
760  ELSE IF( ijq.EQ.2 ) THEN
761  CALL dort03( 'C', m, mnmin, m, mnmin, usav, ldu,
762  $ u, ldu, work, lwork, dif, info )
763  END IF
764  END IF
765  result( 12 ) = max( result( 12 ), dif )
766 *
767 * Compare VT
768 *
769  dif = zero
770  IF( m.GT.0 .AND. n.GT.0 ) THEN
771  IF( ijq.EQ.1 ) THEN
772  IF( m.GE.n ) THEN
773  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
774  $ ldvt, vt, ldvt, work, lwork,
775  $ dif, info )
776  ELSE
777  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
778  $ ldvt, a, lda, work, lwork, dif,
779  $ info )
780  END IF
781  ELSE IF( ijq.EQ.2 ) THEN
782  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
783  $ ldvt, vt, ldvt, work, lwork, dif,
784  $ info )
785  END IF
786  END IF
787  result( 13 ) = max( result( 13 ), dif )
788 *
789 * Compare S
790 *
791  dif = zero
792  div = max( mnmin*ulp*s( 1 ), unfl )
793  DO 100 i = 1, mnmin - 1
794  IF( ssav( i ).LT.ssav( i+1 ) )
795  $ dif = ulpinv
796  IF( ssav( i ).LT.zero )
797  $ dif = ulpinv
798  dif = max( dif, abs( ssav( i )-s( i ) ) / div )
799  100 CONTINUE
800  result( 14 ) = max( result( 14 ), dif )
801  110 CONTINUE
802 *
803 * Test DGESVDQ
804 * Note: DGESVDQ only works for M >= N
805 *
806  result( 36 ) = zero
807  result( 37 ) = zero
808  result( 38 ) = zero
809  result( 39 ) = zero
810 *
811  IF( m.GE.n ) THEN
812  iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
813  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
814  lswork = min( lswork, lwork )
815  lswork = max( lswork, 1 )
816  IF( iws.EQ.4 )
817  $ lswork = lwork
818 *
819  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
820  srnamt = 'DGESVDQ'
821 *
822  lrwork = 2
823  liwork = max( n, 1 )
824  CALL dgesvdq( 'H', 'N', 'N', 'A', 'A',
825  $ m, n, a, lda, ssav, usav, ldu,
826  $ vtsav, ldvt, numrank, iwork, liwork,
827  $ work, lwork, rwork, lrwork, iinfo )
828 *
829  IF( iinfo.NE.0 ) THEN
830  WRITE( nout, fmt = 9995 )'DGESVDQ', iinfo, m, n,
831  $ jtype, lswork, ioldsd
832  info = abs( iinfo )
833  RETURN
834  END IF
835 *
836 * Do tests 36--39
837 *
838  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
839  $ vtsav, ldvt, work, result( 36 ) )
840  IF( m.NE.0 .AND. n.NE.0 ) THEN
841  CALL dort01( 'Columns', m, m, usav, ldu, work,
842  $ lwork, result( 37 ) )
843  CALL dort01( 'Rows', n, n, vtsav, ldvt, work,
844  $ lwork, result( 38 ) )
845  END IF
846  result( 39 ) = zero
847  DO 199 i = 1, mnmin - 1
848  IF( ssav( i ).LT.ssav( i+1 ) )
849  $ result( 39 ) = ulpinv
850  IF( ssav( i ).LT.zero )
851  $ result( 39 ) = ulpinv
852  199 CONTINUE
853  IF( mnmin.GE.1 ) THEN
854  IF( ssav( mnmin ).LT.zero )
855  $ result( 39 ) = ulpinv
856  END IF
857  END IF
858 *
859 * Test DGESVJ
860 * Note: DGESVJ only works for M >= N
861 *
862  result( 15 ) = zero
863  result( 16 ) = zero
864  result( 17 ) = zero
865  result( 18 ) = zero
866 *
867  IF( m.GE.n ) THEN
868  iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
869  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
870  lswork = min( lswork, lwork )
871  lswork = max( lswork, 1 )
872  IF( iws.EQ.4 )
873  $ lswork = lwork
874 *
875  CALL dlacpy( 'F', m, n, asav, lda, usav, lda )
876  srnamt = 'DGESVJ'
877  CALL dgesvj( 'G', 'U', 'V', m, n, usav, lda, ssav,
878  & 0, a, ldvt, work, lwork, info )
879 *
880 * DGESVJ returns V not VT
881 *
882  DO j=1,n
883  DO i=1,n
884  vtsav(j,i) = a(i,j)
885  END DO
886  END DO
887 *
888  IF( iinfo.NE.0 ) THEN
889  WRITE( nout, fmt = 9995 )'GESVJ', iinfo, m, n,
890  $ jtype, lswork, ioldsd
891  info = abs( iinfo )
892  RETURN
893  END IF
894 *
895 * Do tests 15--18
896 *
897  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
898  $ vtsav, ldvt, work, result( 15 ) )
899  IF( m.NE.0 .AND. n.NE.0 ) THEN
900  CALL dort01( 'Columns', m, m, usav, ldu, work,
901  $ lwork, result( 16 ) )
902  CALL dort01( 'Rows', n, n, vtsav, ldvt, work,
903  $ lwork, result( 17 ) )
904  END IF
905  result( 18 ) = zero
906  DO 120 i = 1, mnmin - 1
907  IF( ssav( i ).LT.ssav( i+1 ) )
908  $ result( 18 ) = ulpinv
909  IF( ssav( i ).LT.zero )
910  $ result( 18 ) = ulpinv
911  120 CONTINUE
912  IF( mnmin.GE.1 ) THEN
913  IF( ssav( mnmin ).LT.zero )
914  $ result( 18 ) = ulpinv
915  END IF
916  END IF
917 *
918 * Test DGEJSV
919 * Note: DGEJSV only works for M >= N
920 *
921  result( 19 ) = zero
922  result( 20 ) = zero
923  result( 21 ) = zero
924  result( 22 ) = zero
925  IF( m.GE.n ) THEN
926  iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
927  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
928  lswork = min( lswork, lwork )
929  lswork = max( lswork, 1 )
930  IF( iws.EQ.4 )
931  $ lswork = lwork
932 *
933  CALL dlacpy( 'F', m, n, asav, lda, vtsav, lda )
934  srnamt = 'DGEJSV'
935  CALL dgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
936  & m, n, vtsav, lda, ssav, usav, ldu, a, ldvt,
937  & work, lwork, iwork, info )
938 *
939 * DGEJSV returns V not VT
940 *
941  DO 140 j=1,n
942  DO 130 i=1,n
943  vtsav(j,i) = a(i,j)
944  130 END DO
945  140 END DO
946 *
947  IF( iinfo.NE.0 ) THEN
948  WRITE( nout, fmt = 9995 )'GEJSV', iinfo, m, n,
949  $ jtype, lswork, ioldsd
950  info = abs( iinfo )
951  RETURN
952  END IF
953 *
954 * Do tests 19--22
955 *
956  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
957  $ vtsav, ldvt, work, result( 19 ) )
958  IF( m.NE.0 .AND. n.NE.0 ) THEN
959  CALL dort01( 'Columns', m, m, usav, ldu, work,
960  $ lwork, result( 20 ) )
961  CALL dort01( 'Rows', n, n, vtsav, ldvt, work,
962  $ lwork, result( 21 ) )
963  END IF
964  result( 22 ) = zero
965  DO 150 i = 1, mnmin - 1
966  IF( ssav( i ).LT.ssav( i+1 ) )
967  $ result( 22 ) = ulpinv
968  IF( ssav( i ).LT.zero )
969  $ result( 22 ) = ulpinv
970  150 CONTINUE
971  IF( mnmin.GE.1 ) THEN
972  IF( ssav( mnmin ).LT.zero )
973  $ result( 22 ) = ulpinv
974  END IF
975  END IF
976 *
977 * Test DGESVDX
978 *
979  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
980  CALL dgesvdx( 'V', 'V', 'A', m, n, a, lda,
981  $ vl, vu, il, iu, ns, ssav, usav, ldu,
982  $ vtsav, ldvt, work, lwork, iwork,
983  $ iinfo )
984  IF( iinfo.NE.0 ) THEN
985  WRITE( nout, fmt = 9995 )'GESVDX', iinfo, m, n,
986  $ jtype, lswork, ioldsd
987  info = abs( iinfo )
988  RETURN
989  END IF
990 *
991 * Do tests 23--29
992 *
993  result( 23 ) = zero
994  result( 24 ) = zero
995  result( 25 ) = zero
996  CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
997  $ vtsav, ldvt, work, result( 23 ) )
998  IF( m.NE.0 .AND. n.NE.0 ) THEN
999  CALL dort01( 'Columns', m, m, usav, ldu, work, lwork,
1000  $ result( 24 ) )
1001  CALL dort01( 'Rows', n, n, vtsav, ldvt, work, lwork,
1002  $ result( 25 ) )
1003  END IF
1004  result( 26 ) = zero
1005  DO 160 i = 1, mnmin - 1
1006  IF( ssav( i ).LT.ssav( i+1 ) )
1007  $ result( 26 ) = ulpinv
1008  IF( ssav( i ).LT.zero )
1009  $ result( 26 ) = ulpinv
1010  160 CONTINUE
1011  IF( mnmin.GE.1 ) THEN
1012  IF( ssav( mnmin ).LT.zero )
1013  $ result( 26 ) = ulpinv
1014  END IF
1015 *
1016 * Do partial SVDs, comparing to SSAV, USAV, and VTSAV
1017 *
1018  result( 27 ) = zero
1019  result( 28 ) = zero
1020  result( 29 ) = zero
1021  DO 180 iju = 0, 1
1022  DO 170 ijvt = 0, 1
1023  IF( ( iju.EQ.0 .AND. ijvt.EQ.0 ) .OR.
1024  $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )GO TO 170
1025  jobu = cjobv( iju+1 )
1026  jobvt = cjobv( ijvt+1 )
1027  range = cjobr( 1 )
1028  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
1029  CALL dgesvdx( jobu, jobvt, range, m, n, a, lda,
1030  $ vl, vu, il, iu, ns, s, u, ldu,
1031  $ vt, ldvt, work, lwork, iwork,
1032  $ iinfo )
1033 *
1034 * Compare U
1035 *
1036  dif = zero
1037  IF( m.GT.0 .AND. n.GT.0 ) THEN
1038  IF( iju.EQ.1 ) THEN
1039  CALL dort03( 'C', m, mnmin, m, mnmin, usav,
1040  $ ldu, u, ldu, work, lwork, dif,
1041  $ iinfo )
1042  END IF
1043  END IF
1044  result( 27 ) = max( result( 27 ), dif )
1045 *
1046 * Compare VT
1047 *
1048  dif = zero
1049  IF( m.GT.0 .AND. n.GT.0 ) THEN
1050  IF( ijvt.EQ.1 ) THEN
1051  CALL dort03( 'R', n, mnmin, n, mnmin, vtsav,
1052  $ ldvt, vt, ldvt, work, lwork,
1053  $ dif, iinfo )
1054  END IF
1055  END IF
1056  result( 28 ) = max( result( 28 ), dif )
1057 *
1058 * Compare S
1059 *
1060  dif = zero
1061  div = max( mnmin*ulp*s( 1 ), unfl )
1062  DO 190 i = 1, mnmin - 1
1063  IF( ssav( i ).LT.ssav( i+1 ) )
1064  $ dif = ulpinv
1065  IF( ssav( i ).LT.zero )
1066  $ dif = ulpinv
1067  dif = max( dif, abs( ssav( i )-s( i ) ) / div )
1068  190 CONTINUE
1069  result( 29 ) = max( result( 29 ), dif )
1070  170 CONTINUE
1071  180 CONTINUE
1072 *
1073 * Do tests 30--32: DGESVDX( 'V', 'V', 'I' )
1074 *
1075  DO 200 i = 1, 4
1076  iseed2( i ) = iseed( i )
1077  200 CONTINUE
1078  IF( mnmin.LE.1 ) THEN
1079  il = 1
1080  iu = max( 1, mnmin )
1081  ELSE
1082  il = 1 + int( ( mnmin-1 )*dlarnd( 1, iseed2 ) )
1083  iu = 1 + int( ( mnmin-1 )*dlarnd( 1, iseed2 ) )
1084  IF( iu.LT.il ) THEN
1085  itemp = iu
1086  iu = il
1087  il = itemp
1088  END IF
1089  END IF
1090  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
1091  CALL dgesvdx( 'V', 'V', 'I', m, n, a, lda,
1092  $ vl, vu, il, iu, nsi, s, u, ldu,
1093  $ vt, ldvt, work, lwork, iwork,
1094  $ iinfo )
1095  IF( iinfo.NE.0 ) THEN
1096  WRITE( nout, fmt = 9995 )'GESVDX', iinfo, m, n,
1097  $ jtype, lswork, ioldsd
1098  info = abs( iinfo )
1099  RETURN
1100  END IF
1101 *
1102  result( 30 ) = zero
1103  result( 31 ) = zero
1104  result( 32 ) = zero
1105  CALL dbdt05( m, n, asav, lda, s, nsi, u, ldu,
1106  $ vt, ldvt, work, result( 30 ) )
1107  CALL dort01( 'Columns', m, nsi, u, ldu, work, lwork,
1108  $ result( 31 ) )
1109  CALL dort01( 'Rows', nsi, n, vt, ldvt, work, lwork,
1110  $ result( 32 ) )
1111 *
1112 * Do tests 33--35: DGESVDX( 'V', 'V', 'V' )
1113 *
1114  IF( mnmin.GT.0 .AND. nsi.GT.1 ) THEN
1115  IF( il.NE.1 ) THEN
1116  vu = ssav( il ) +
1117  $ max( half*abs( ssav( il )-ssav( il-1 ) ),
1118  $ ulp*anorm, two*rtunfl )
1119  ELSE
1120  vu = ssav( 1 ) +
1121  $ max( half*abs( ssav( ns )-ssav( 1 ) ),
1122  $ ulp*anorm, two*rtunfl )
1123  END IF
1124  IF( iu.NE.ns ) THEN
1125  vl = ssav( iu ) - max( ulp*anorm, two*rtunfl,
1126  $ half*abs( ssav( iu+1 )-ssav( iu ) ) )
1127  ELSE
1128  vl = ssav( ns ) - max( ulp*anorm, two*rtunfl,
1129  $ half*abs( ssav( ns )-ssav( 1 ) ) )
1130  END IF
1131  vl = max( vl,zero )
1132  vu = max( vu,zero )
1133  IF( vl.GE.vu ) vu = max( vu*2, vu+vl+half )
1134  ELSE
1135  vl = zero
1136  vu = one
1137  END IF
1138  CALL dlacpy( 'F', m, n, asav, lda, a, lda )
1139  CALL dgesvdx( 'V', 'V', 'V', m, n, a, lda,
1140  $ vl, vu, il, iu, nsv, s, u, ldu,
1141  $ vt, ldvt, work, lwork, iwork,
1142  $ iinfo )
1143  IF( iinfo.NE.0 ) THEN
1144  WRITE( nout, fmt = 9995 )'GESVDX', iinfo, m, n,
1145  $ jtype, lswork, ioldsd
1146  info = abs( iinfo )
1147  RETURN
1148  END IF
1149 *
1150  result( 33 ) = zero
1151  result( 34 ) = zero
1152  result( 35 ) = zero
1153  CALL dbdt05( m, n, asav, lda, s, nsv, u, ldu,
1154  $ vt, ldvt, work, result( 33 ) )
1155  CALL dort01( 'Columns', m, nsv, u, ldu, work, lwork,
1156  $ result( 34 ) )
1157  CALL dort01( 'Rows', nsv, n, vt, ldvt, work, lwork,
1158  $ result( 35 ) )
1159 *
1160 * End of Loop -- Check for RESULT(j) > THRESH
1161 *
1162  DO 210 j = 1, 39
1163  IF( result( j ).GE.thresh ) THEN
1164  IF( nfail.EQ.0 ) THEN
1165  WRITE( nout, fmt = 9999 )
1166  WRITE( nout, fmt = 9998 )
1167  END IF
1168  WRITE( nout, fmt = 9997 )m, n, jtype, iws, ioldsd,
1169  $ j, result( j )
1170  nfail = nfail + 1
1171  END IF
1172  210 CONTINUE
1173  ntest = ntest + 39
1174  220 CONTINUE
1175  230 CONTINUE
1176  240 CONTINUE
1177 *
1178 * Summary
1179 *
1180  CALL alasvm( path, nout, nfail, ntest, 0 )
1181 *
1182  9999 FORMAT( ' SVD -- Real Singular Value Decomposition Driver ',
1183  $ / ' Matrix types (see DDRVBD for details):',
1184  $ / / ' 1 = Zero matrix', / ' 2 = Identity matrix',
1185  $ / ' 3 = Evenly spaced singular values near 1',
1186  $ / ' 4 = Evenly spaced singular values near underflow',
1187  $ / ' 5 = Evenly spaced singular values near overflow', / /
1188  $ ' Tests performed: ( A is dense, U and V are orthogonal,',
1189  $ / 19x, ' S is an array, and Upartial, VTpartial, and',
1190  $ / 19x, ' Spartial are partially computed U, VT and S),', / )
1191  9998 FORMAT( ' 1 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1192  $ / ' 2 = | I - U**T U | / ( M ulp ) ',
1193  $ / ' 3 = | I - VT VT**T | / ( N ulp ) ',
1194  $ / ' 4 = 0 if S contains min(M,N) nonnegative values in',
1195  $ ' decreasing order, else 1/ulp',
1196  $ / ' 5 = | U - Upartial | / ( M ulp )',
1197  $ / ' 6 = | VT - VTpartial | / ( N ulp )',
1198  $ / ' 7 = | S - Spartial | / ( min(M,N) ulp |S| )',
1199  $ / ' 8 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1200  $ / ' 9 = | I - U**T U | / ( M ulp ) ',
1201  $ / '10 = | I - VT VT**T | / ( N ulp ) ',
1202  $ / '11 = 0 if S contains min(M,N) nonnegative values in',
1203  $ ' decreasing order, else 1/ulp',
1204  $ / '12 = | U - Upartial | / ( M ulp )',
1205  $ / '13 = | VT - VTpartial | / ( N ulp )',
1206  $ / '14 = | S - Spartial | / ( min(M,N) ulp |S| )',
1207  $ / '15 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1208  $ / '16 = | I - U**T U | / ( M ulp ) ',
1209  $ / '17 = | I - VT VT**T | / ( N ulp ) ',
1210  $ / '18 = 0 if S contains min(M,N) nonnegative values in',
1211  $ ' decreasing order, else 1/ulp',
1212  $ / '19 = | U - Upartial | / ( M ulp )',
1213  $ / '20 = | VT - VTpartial | / ( N ulp )',
1214  $ / '21 = | S - Spartial | / ( min(M,N) ulp |S| )',
1215  $ / '22 = 0 if S contains min(M,N) nonnegative values in',
1216  $ ' decreasing order, else 1/ulp',
1217  $ / '23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ),',
1218  $ ' DGESVDX(V,V,A) ',
1219  $ / '24 = | I - U**T U | / ( M ulp ) ',
1220  $ / '25 = | I - VT VT**T | / ( N ulp ) ',
1221  $ / '26 = 0 if S contains min(M,N) nonnegative values in',
1222  $ ' decreasing order, else 1/ulp',
1223  $ / '27 = | U - Upartial | / ( M ulp )',
1224  $ / '28 = | VT - VTpartial | / ( N ulp )',
1225  $ / '29 = | S - Spartial | / ( min(M,N) ulp |S| )',
1226  $ / '30 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
1227  $ ' DGESVDX(V,V,I) ',
1228  $ / '31 = | I - U**T U | / ( M ulp ) ',
1229  $ / '32 = | I - VT VT**T | / ( N ulp ) ',
1230  $ / '33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
1231  $ ' DGESVDX(V,V,V) ',
1232  $ / '34 = | I - U**T U | / ( M ulp ) ',
1233  $ / '35 = | I - VT VT**T | / ( N ulp ) ',
1234  $ ' DGESVDQ(H,N,N,A,A',
1235  $ / '36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1236  $ / '37 = | I - U**T U | / ( M ulp ) ',
1237  $ / '38 = | I - VT VT**T | / ( N ulp ) ',
1238  $ / '39 = 0 if S contains min(M,N) nonnegative values in',
1239  $ ' decreasing order, else 1/ulp',
1240  $ / / )
1241  9997 FORMAT( ' M=', i5, ', N=', i5, ', type ', i1, ', IWS=', i1,
1242  $ ', seed=', 4( i4, ',' ), ' test(', i2, ')=', g11.4 )
1243  9996 FORMAT( ' DDRVBD: ', a, ' returned INFO=', i6, '.', / 9x, 'M=',
1244  $ i6, ', N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ),
1245  $ i5, ')' )
1246  9995 FORMAT( ' DDRVBD: ', a, ' returned INFO=', i6, '.', / 9x, 'M=',
1247  $ i6, ', N=', i6, ', JTYPE=', i6, ', LSWORK=', i6, / 9x,
1248  $ 'ISEED=(', 3( i5, ',' ), i5, ')' )
1249 *
1250  RETURN
1251 *
1252 * End of DDRVBD
1253 *
Here is the call graph for this function:
Here is the caller graph for this function:
dlatms
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
dgesvj
subroutine dgesvj(JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LDV, WORK, LWORK, INFO)
DGESVJ
Definition: dgesvj.f:339
dort03
subroutine dort03(RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK, RESULT, INFO)
DORT03
Definition: dort03.f:158
dort01
subroutine dort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
DORT01
Definition: dort01.f:118
dgesdd
subroutine dgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
DGESDD
Definition: dgesdd.f:220
dbdt01
subroutine dbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RESID)
DBDT01
Definition: dbdt01.f:142
dgesvd
subroutine dgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO)
DGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: dgesvd.f:213
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
dgesvdq
subroutine dgesvdq(JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, WORK, LWORK, RWORK, LRWORK, INFO)
DGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE...
Definition: dgesvdq.f:417
dbdt05
subroutine dbdt05(M, N, A, LDA, S, NS, U, LDU, VT, LDVT, WORK, RESID)
Definition: dbdt05.f:127
dlabad
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
dlarnd
double precision function dlarnd(IDIST, ISEED)
DLARND
Definition: dlarnd.f:75
dlaset
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: dlaset.f:112
dgesvdx
subroutine dgesvdx(JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, IL, IU, NS, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
DGESVDX computes the singular value decomposition (SVD) for GE matrices
Definition: dgesvdx.f:265
dlamch
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:70
dlacpy
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
dgejsv
subroutine dgejsv(JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, M, N, A, LDA, SVA, U, LDU, V, LDV, WORK, LWORK, IWORK, INFO)
DGEJSV
Definition: dgejsv.f:478