LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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.

Definition at line 363 of file ddrvbd.f.

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