sdrvbd.f

Go to the documentation of this file.

*> \brief \b SDRVBD
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at 
*            http://www.netlib.org/lapack/explore-html/ 
*
*  Definition:
*  ===========
*
*       SUBROUTINE SDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
*                          A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S,
*                          SSAV, E, WORK, LWORK, IWORK, NOUT, INFO )
* 
*       .. Scalar Arguments ..
*       INTEGER            INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES,
*      $                   NTYPES
*       REAL               THRESH
*       ..
*       .. Array Arguments ..
*       LOGICAL            DOTYPE( * )
*       INTEGER            ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
*       REAL               A( LDA, * ), ASAV( LDA, * ), E( * ), S( * ),
*      $                   SSAV( * ), U( LDU, * ), USAV( LDU, * ),
*      $                   VT( LDVT, * ), VTSAV( LDVT, * ), WORK( * )
*       ..
*  
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> SDRVBD checks the singular value decomposition (SVD) drivers
*> SGESVD, SGESDD, SGESVJ, and SGEJSV.
*>
*> Both SGESVD and SGESDD 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 SDRVBD 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 SGESVD:
*>
*> (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 SGESDD:
*>
*> (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 SGESVJ:
*>
*> (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 SGEJSV:
*>
*> (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 SGESVDX( 'V', 'V', 'A' )/SGESVDX( '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 SGESVDX( '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 SGESVDX( '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.
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] NSIZES
*> \verbatim
*>          NSIZES is INTEGER
*>          The number of matrix sizes (M,N) contained in the vectors
*>          MM and NN.
*> \endverbatim
*>
*> \param[in] MM
*> \verbatim
*>          MM is INTEGER array, dimension (NSIZES)
*>          The values of the matrix row dimension M.
*> \endverbatim
*>
*> \param[in] NN
*> \verbatim
*>          NN is INTEGER array, dimension (NSIZES)
*>          The values of the matrix column dimension N.
*> \endverbatim
*>
*> \param[in] NTYPES
*> \verbatim
*>          NTYPES is INTEGER
*>          The number of elements in DOTYPE.   If it is zero, SDRVBD
*>          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. .
*> \endverbatim
*>
*> \param[in] DOTYPE
*> \verbatim
*>          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.
*> \endverbatim
*>
*> \param[in,out] ISEED
*> \verbatim
*>          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
*>          SDRVBD to continue the same random number sequence.
*> \endverbatim
*>
*> \param[in] THRESH
*> \verbatim
*>          THRESH is REAL
*>          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.
*> \endverbatim
*>
*> \param[out] A
*> \verbatim
*>          A is REAL array, dimension (LDA,NMAX)
*>          where NMAX is the maximum value of N in NN.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*>          LDA is INTEGER
*>          The leading dimension of the array A.  LDA >= max(1,MMAX),
*>          where MMAX is the maximum value of M in MM.
*> \endverbatim
*>
*> \param[out] U
*> \verbatim
*>          U is REAL array, dimension (LDU,MMAX)
*> \endverbatim
*>
*> \param[in] LDU
*> \verbatim
*>          LDU is INTEGER
*>          The leading dimension of the array U.  LDU >= max(1,MMAX).
*> \endverbatim
*>
*> \param[out] VT
*> \verbatim
*>          VT is REAL array, dimension (LDVT,NMAX)
*> \endverbatim
*>
*> \param[in] LDVT
*> \verbatim
*>          LDVT is INTEGER
*>          The leading dimension of the array VT.  LDVT >= max(1,NMAX).
*> \endverbatim
*>
*> \param[out] ASAV
*> \verbatim
*>          ASAV is REAL array, dimension (LDA,NMAX)
*> \endverbatim
*>
*> \param[out] USAV
*> \verbatim
*>          USAV is REAL array, dimension (LDU,MMAX)
*> \endverbatim
*>
*> \param[out] VTSAV
*> \verbatim
*>          VTSAV is REAL array, dimension (LDVT,NMAX)
*> \endverbatim
*>
*> \param[out] S
*> \verbatim
*>          S is REAL array, dimension
*>                      (max(min(MM,NN)))
*> \endverbatim
*>
*> \param[out] SSAV
*> \verbatim
*>          SSAV is REAL array, dimension
*>                      (max(min(MM,NN)))
*> \endverbatim
*>
*> \param[out] E
*> \verbatim
*>          E is REAL array, dimension
*>                      (max(min(MM,NN)))
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*>          WORK is REAL array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*>          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)) )
*> \endverbatim
*>
*> \param[out] IWORK
*> \verbatim
*>          IWORK is INTEGER array, dimension at least 8*min(M,N)
*> \endverbatim
*>
*> \param[in] NOUT
*> \verbatim
*>          NOUT is INTEGER
*>          The FORTRAN unit number for printing out error messages
*>          (e.g., if a routine returns IINFO not equal to 0.)
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*>          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  SLATMS, or SGESVD returns an error code, the
*>              absolute value of it is returned.
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee 
*> \author Univ. of California Berkeley 
*> \author Univ. of Colorado Denver 
*> \author NAG Ltd. 
*
*> \date June 2016
*
*> \ingroup single_eig
*
*  =====================================================================
      SUBROUTINE sdrvbd( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
     $                   a, lda, u, ldu, vt, ldvt, asav, usav, vtsav, s,
     $                   ssav, e, work, lwork, iwork, nout, info )
*
*  -- LAPACK test routine (version 3.6.1) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     June 2016
*
*     .. Scalar Arguments ..
      INTEGER            INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES,
     $                   ntypes
      REAL               THRESH
*     ..
*     .. Array Arguments ..
      LOGICAL            DOTYPE( * )
      INTEGER            ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
      REAL               A( lda, * ), ASAV( lda, * ), E( * ), S( * ),
     $                   ssav( * ), u( ldu, * ), usav( ldu, * ),
     $                   vt( ldvt, * ), vtsav( ldvt, * ), work( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL              ZERO, ONE, TWO, HALF
      parameter                ( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
     $                   half = 0.5e0 )
      INTEGER            MAXTYP
      parameter                ( maxtyp = 5 )
*     ..
*     .. Local Scalars ..
      LOGICAL            BADMM, BADNN
      CHARACTER          JOBQ, JOBU, JOBVT, RANGE
      CHARACTER*3        PATH
      INTEGER            I, IINFO, IJQ, IJU, IJVT, IL,IU, IWS, IWTMP, 
     $                   itemp, j, jsize, jtype, lswork, m, minwrk, 
     $                   mmax, mnmax, mnmin, mtypes, n, nfail, 
     $                   nmax, ns, nsi, nsv, ntest
      REAL               ANORM, DIF, DIV, OVFL, RTUNFL, ULP, 
     $                    ulpinv, unfl, vl, vu
*     ..
*     .. Local Arrays ..
      CHARACTER          CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
      INTEGER            IOLDSD( 4 ), ISEED2( 4 ) 
      REAL               RESULT( 40 )
*     ..
*     .. External Functions ..
      REAL               SLAMCH, SLARND
      EXTERNAL           slamch, slarnd
*     ..
*     .. External Subroutines ..
      EXTERNAL           alasvm, sbdt01, sgejsv, sgesdd, sgesvd, 
     $                   sgesvdx, sgesvj, slabad, slacpy, slaset,
     $                   slatms, sort01, sort03, xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, REAL, INT, MAX, MIN
*     ..
*     .. Scalars in Common ..
      LOGICAL            LERR, OK
      CHARACTER*32       SRNAMT
      INTEGER            INFOT, NUNIT
*     ..
*     .. Common blocks ..
      COMMON             / infoc / infot, nunit, ok, lerr
      COMMON             / srnamc / srnamt
*     ..
*     .. Data statements ..
      DATA               cjob / 'N', 'O', 'S', 'A' /
      DATA               cjobr / 'A', 'V', 'I' /
      DATA               cjobv / 'N', 'V' /
*     ..
*     .. Executable Statements ..
*
*     Check for errors
*
      info = 0
      badmm = .false.
      badnn = .false.
      mmax = 1
      nmax = 1
      mnmax = 1
      minwrk = 1
      DO 10 j = 1, nsizes
         mmax = max( mmax, mm( j ) )
         IF( mm( j ).LT.0 )
     $      badmm = .true.
         nmax = max( nmax, nn( j ) )
         IF( nn( j ).LT.0 )
     $      badnn = .true.
         mnmax = max( mnmax, min( mm( j ), nn( j ) ) )
         minwrk = max( minwrk, max( 3*min( mm( j ),
     $            nn( j ) )+max( mm( j ), nn( j ) ), 5*min( mm( j ),
     $            nn( j )-4 ) )+2*min( mm( j ), nn( j ) )**2 )
   10 CONTINUE
*
*     Check for errors
*
      IF( nsizes.LT.0 ) THEN
         info = -1
      ELSE IF( badmm ) THEN
         info = -2
      ELSE IF( badnn ) THEN
         info = -3
      ELSE IF( ntypes.LT.0 ) THEN
         info = -4
      ELSE IF( lda.LT.max( 1, mmax ) ) THEN
         info = -10
      ELSE IF( ldu.LT.max( 1, mmax ) ) THEN
         info = -12
      ELSE IF( ldvt.LT.max( 1, nmax ) ) THEN
         info = -14
      ELSE IF( minwrk.GT.lwork ) THEN
         info = -21
      END IF
*
      IF( info.NE.0 ) THEN
         CALL xerbla( 'SDRVBD', -info )
         RETURN
      END IF
*
*     Initialize constants
*
      path( 1: 1 ) = 'Single precision'
      path( 2: 3 ) = 'BD'
      nfail = 0
      ntest = 0
      unfl = slamch( 'Safe minimum' )
      ovfl = one / unfl
      CALL slabad( unfl, ovfl )
      ulp = slamch( 'Precision' )
      rtunfl = sqrt( unfl )
      ulpinv = one / ulp
      infot = 0
*
*     Loop over sizes, types
*
      DO 240 jsize = 1, nsizes
         m = mm( jsize )
         n = nn( jsize )
         mnmin = min( m, n )
*
         IF( nsizes.NE.1 ) THEN
            mtypes = min( maxtyp, ntypes )
         ELSE
            mtypes = min( maxtyp+1, ntypes )
         END IF
*
         DO 230 jtype = 1, mtypes
            IF( .NOT.dotype( jtype ) )
     $         GO TO 230
*
            DO 20 j = 1, 4
               ioldsd( j ) = iseed( j )
   20       CONTINUE
*
*           Compute "A"
*
            IF( mtypes.GT.maxtyp )
     $         GO TO 30
*
            IF( jtype.EQ.1 ) THEN
*
*              Zero matrix
*
               CALL slaset( 'Full', m, n, zero, zero, a, lda )
*
            ELSE IF( jtype.EQ.2 ) THEN
*
*              Identity matrix
*
               CALL slaset( 'Full', m, n, zero, one, a, lda )
*
            ELSE
*
*              (Scaled) random matrix
*
               IF( jtype.EQ.3 )
     $            anorm = one
               IF( jtype.EQ.4 )
     $            anorm = unfl / ulp
               IF( jtype.EQ.5 )
     $            anorm = ovfl*ulp
               CALL slatms( m, n, 'U', iseed, 'N', s, 4, REAL( MNMIN ),
     $                      anorm, m-1, n-1, 'N', a, lda, work, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nout, fmt = 9996 )'Generator', iinfo, m, n,
     $               jtype, ioldsd
                  info = abs( iinfo )
                  RETURN
               END IF
            END IF
*
   30       CONTINUE
            CALL slacpy( 'F', m, n, a, lda, asav, lda )
*
*           Do for minimal and adequate (for blocking) workspace
*
            DO 220 iws = 1, 4
*
               DO 40 j = 1, 32
                  result( j ) = -one
   40          CONTINUE
*
*              Test SGESVD: Factorize A
*
               iwtmp = max( 3*min( m, n )+max( m, n ), 5*min( m, n ) )
               lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
               lswork = min( lswork, lwork )
               lswork = max( lswork, 1 )
               IF( iws.EQ.4 )
     $            lswork = lwork
*
               IF( iws.GT.1 )
     $            CALL slacpy( 'F', m, n, asav, lda, a, lda )
               srnamt = 'SGESVD'
               CALL sgesvd( 'A', 'A', m, n, a, lda, ssav, usav, ldu,
     $                      vtsav, ldvt, work, lswork, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nout, fmt = 9995 )'GESVD', iinfo, m, n, jtype,
     $               lswork, ioldsd
                  info = abs( iinfo )
                  RETURN
               END IF
*
*              Do tests 1--4
*
               CALL sbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
     $                      vtsav, ldvt, work, result( 1 ) )
               IF( m.NE.0 .AND. n.NE.0 ) THEN
                  CALL sort01( 'Columns', m, m, usav, ldu, work, lwork,
     $                         result( 2 ) )
                  CALL sort01( 'Rows', n, n, vtsav, ldvt, work, lwork,
     $                         result( 3 ) )
               END IF
               result( 4 ) = zero
               DO 50 i = 1, mnmin - 1
                  IF( ssav( i ).LT.ssav( i+1 ) )
     $               result( 4 ) = ulpinv
                  IF( ssav( i ).LT.zero )
     $               result( 4 ) = ulpinv
   50          CONTINUE
               IF( mnmin.GE.1 ) THEN
                  IF( ssav( mnmin ).LT.zero )
     $               result( 4 ) = ulpinv
               END IF
*
*              Do partial SVDs, comparing to SSAV, USAV, and VTSAV
*
               result( 5 ) = zero
               result( 6 ) = zero
               result( 7 ) = zero
               DO 80 iju = 0, 3
                  DO 70 ijvt = 0, 3
                     IF( ( iju.EQ.3 .AND. ijvt.EQ.3 ) .OR.
     $                   ( iju.EQ.1 .AND. ijvt.EQ.1 ) )GO TO 70
                     jobu = cjob( iju+1 )
                     jobvt = cjob( ijvt+1 )
                     CALL slacpy( 'F', m, n, asav, lda, a, lda )
                     srnamt = 'SGESVD'
                     CALL sgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,
     $                            vt, ldvt, work, lswork, iinfo )
*
*                    Compare U
*
                     dif = zero
                     IF( m.GT.0 .AND. n.GT.0 ) THEN
                        IF( iju.EQ.1 ) THEN
                           CALL sort03( 'C', m, mnmin, m, mnmin, usav,
     $                                  ldu, a, lda, work, lwork, dif,
     $                                  iinfo )
                        ELSE IF( iju.EQ.2 ) THEN
                           CALL sort03( 'C', m, mnmin, m, mnmin, usav,
     $                                  ldu, u, ldu, work, lwork, dif,
     $                                  iinfo )
                        ELSE IF( iju.EQ.3 ) THEN
                           CALL sort03( 'C', m, m, m, mnmin, usav, ldu,
     $                                  u, ldu, work, lwork, dif,
     $                                  iinfo )
                        END IF
                     END IF
                     result( 5 ) = max( result( 5 ), dif )
*
*                    Compare VT
*
                     dif = zero
                     IF( m.GT.0 .AND. n.GT.0 ) THEN
                        IF( ijvt.EQ.1 ) THEN
                           CALL sort03( 'R', n, mnmin, n, mnmin, vtsav,
     $                                  ldvt, a, lda, work, lwork, dif,
     $                                  iinfo )
                        ELSE IF( ijvt.EQ.2 ) THEN
                           CALL sort03( 'R', n, mnmin, n, mnmin, vtsav,
     $                                  ldvt, vt, ldvt, work, lwork,
     $                                  dif, iinfo )
                        ELSE IF( ijvt.EQ.3 ) THEN
                           CALL sort03( 'R', n, n, n, mnmin, vtsav,
     $                                  ldvt, vt, ldvt, work, lwork,
     $                                  dif, iinfo )
                        END IF
                     END IF
                     result( 6 ) = max( result( 6 ), dif )
*
*                    Compare S
*
                     dif = zero
                     div = max( mnmin*ulp*s( 1 ), unfl )
                     DO 60 i = 1, mnmin - 1
                        IF( ssav( i ).LT.ssav( i+1 ) )
     $                     dif = ulpinv
                        IF( ssav( i ).LT.zero )
     $                     dif = ulpinv
                        dif = max( dif, abs( ssav( i )-s( i ) ) / div )
   60                CONTINUE
                     result( 7 ) = max( result( 7 ), dif )
   70             CONTINUE
   80          CONTINUE
*
*              Test SGESDD: Factorize A
*
               iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
               lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
               lswork = min( lswork, lwork )
               lswork = max( lswork, 1 )
               IF( iws.EQ.4 )
     $            lswork = lwork
*
               CALL slacpy( 'F', m, n, asav, lda, a, lda )
               srnamt = 'SGESDD'
               CALL sgesdd( 'A', m, n, a, lda, ssav, usav, ldu, vtsav,
     $                      ldvt, work, lswork, iwork, iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nout, fmt = 9995 )'GESDD', iinfo, m, n, jtype,
     $               lswork, ioldsd
                  info = abs( iinfo )
                  RETURN
               END IF
*
*              Do tests 8--11
*
               CALL sbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
     $                      vtsav, ldvt, work, result( 8 ) )
               IF( m.NE.0 .AND. n.NE.0 ) THEN
                  CALL sort01( 'Columns', m, m, usav, ldu, work, lwork,
     $                         result( 9 ) )
                  CALL sort01( 'Rows', n, n, vtsav, ldvt, work, lwork,
     $                         result( 10 ) )
               END IF
               result( 11 ) = zero
               DO 90 i = 1, mnmin - 1
                  IF( ssav( i ).LT.ssav( i+1 ) )
     $               result( 11 ) = ulpinv
                  IF( ssav( i ).LT.zero )
     $               result( 11 ) = ulpinv
   90          CONTINUE
               IF( mnmin.GE.1 ) THEN
                  IF( ssav( mnmin ).LT.zero )
     $               result( 11 ) = ulpinv
               END IF
*
*              Do partial SVDs, comparing to SSAV, USAV, and VTSAV
*
               result( 12 ) = zero
               result( 13 ) = zero
               result( 14 ) = zero
               DO 110 ijq = 0, 2
                  jobq = cjob( ijq+1 )
                  CALL slacpy( 'F', m, n, asav, lda, a, lda )
                  srnamt = 'SGESDD'
                  CALL sgesdd( jobq, m, n, a, lda, s, u, ldu, vt, ldvt,
     $                         work, lswork, iwork, iinfo )
*
*                 Compare U
*
                  dif = zero
                  IF( m.GT.0 .AND. n.GT.0 ) THEN
                     IF( ijq.EQ.1 ) THEN
                        IF( m.GE.n ) THEN
                           CALL sort03( 'C', m, mnmin, m, mnmin, usav,
     $                                  ldu, a, lda, work, lwork, dif,
     $                                  info )
                        ELSE
                           CALL sort03( 'C', m, mnmin, m, mnmin, usav,
     $                                  ldu, u, ldu, work, lwork, dif,
     $                                  info )
                        END IF
                     ELSE IF( ijq.EQ.2 ) THEN
                        CALL sort03( 'C', m, mnmin, m, mnmin, usav, ldu,
     $                               u, ldu, work, lwork, dif, info )
                     END IF
                  END IF
                  result( 12 ) = max( result( 12 ), dif )
*
*                 Compare VT
*
                  dif = zero
                  IF( m.GT.0 .AND. n.GT.0 ) THEN
                     IF( ijq.EQ.1 ) THEN
                        IF( m.GE.n ) THEN
                           CALL sort03( 'R', n, mnmin, n, mnmin, vtsav,
     $                                  ldvt, vt, ldvt, work, lwork,
     $                                  dif, info )
                        ELSE
                           CALL sort03( 'R', n, mnmin, n, mnmin, vtsav,
     $                                  ldvt, a, lda, work, lwork, dif,
     $                                  info )
                        END IF
                     ELSE IF( ijq.EQ.2 ) THEN
                        CALL sort03( 'R', n, mnmin, n, mnmin, vtsav,
     $                               ldvt, vt, ldvt, work, lwork, dif,
     $                               info )
                     END IF
                  END IF
                  result( 13 ) = max( result( 13 ), dif )
*
*                 Compare S
*
                  dif = zero
                  div = max( mnmin*ulp*s( 1 ), unfl )
                  DO 100 i = 1, mnmin - 1
                     IF( ssav( i ).LT.ssav( i+1 ) )
     $                  dif = ulpinv
                     IF( ssav( i ).LT.zero )
     $                  dif = ulpinv
                     dif = max( dif, abs( ssav( i )-s( i ) ) / div )
  100             CONTINUE
                  result( 14 ) = max( result( 14 ), dif )
  110          CONTINUE
*
*              Test SGESVJ: Factorize A
*              Note: SGESVJ does not work for M < N
*
               result( 15 ) = zero
               result( 16 ) = zero
               result( 17 ) = zero
               result( 18 ) = zero
*
               IF( m.GE.n ) THEN
                  iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
                  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
                  lswork = min( lswork, lwork )
                  lswork = max( lswork, 1 )
                  IF( iws.EQ.4 )
     $               lswork = lwork
*
                  CALL slacpy( 'F', m, n, asav, lda, usav, lda )
                  srnamt = 'SGESVJ'
                  CALL sgesvj( 'G', 'U', 'V', m, n, usav, lda, ssav,
     &                        0, a, ldvt, work, lwork, info )
*
*                 SGESVJ retuns V not VT, so we transpose to use the same
*                 test suite.
*
                  DO j=1,n
                     DO i=1,n
                        vtsav(j,i) = a(i,j)
                     END DO
                  END DO
*
                  IF( iinfo.NE.0 ) THEN
                     WRITE( nout, fmt = 9995 )'GESVJ', iinfo, m, n,
     $               jtype, lswork, ioldsd
                     info = abs( iinfo )
                     RETURN
                  END IF
*
*                 Do tests 15--18
*
                  CALL sbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
     $                         vtsav, ldvt, work, result( 15 ) )
                  IF( m.NE.0 .AND. n.NE.0 ) THEN
                     CALL sort01( 'Columns', m, m, usav, ldu, work,
     $                            lwork, result( 16 ) )
                     CALL sort01( 'Rows', n, n, vtsav, ldvt, work,
     $                            lwork, result( 17 ) )
                  END IF
                  result( 18 ) = zero
                  DO 120 i = 1, mnmin - 1
                     IF( ssav( i ).LT.ssav( i+1 ) )
     $                  result( 18 ) = ulpinv
                     IF( ssav( i ).LT.zero )
     $                  result( 18 ) = ulpinv
  120             CONTINUE
                  IF( mnmin.GE.1 ) THEN
                     IF( ssav( mnmin ).LT.zero )
     $                  result( 18 ) = ulpinv
                  END IF
               END IF
*
*              Test SGEJSV: Factorize A
*              Note: SGEJSV does not work for M < N
*
               result( 19 ) = zero
               result( 20 ) = zero
               result( 21 ) = zero
               result( 22 ) = zero
               IF( m.GE.n ) THEN
                  iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
                  lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
                  lswork = min( lswork, lwork )
                  lswork = max( lswork, 1 )
                  IF( iws.EQ.4 )
     $               lswork = lwork
*
                  CALL slacpy( 'F', m, n, asav, lda, vtsav, lda )
                  srnamt = 'SGEJSV'
                  CALL sgejsv( 'G', 'U', 'V', 'R', 'N', 'N',
     &                   m, n, vtsav, lda, ssav, usav, ldu, a, ldvt,
     &                   work, lwork, iwork, info )
*
*                 SGEJSV retuns V not VT, so we transpose to use the same
*                 test suite.
*
                  DO 140 j=1,n
                     DO 130 i=1,n
                        vtsav(j,i) = a(i,j)
  130                END DO
  140             END DO
*
                  IF( iinfo.NE.0 ) THEN
                     WRITE( nout, fmt = 9995 )'GESVJ', iinfo, m, n,
     $               jtype, lswork, ioldsd
                     info = abs( iinfo )
                     RETURN
                  END IF
*
*                 Do tests 19--22
*
                  CALL sbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
     $                         vtsav, ldvt, work, result( 19 ) )
                  IF( m.NE.0 .AND. n.NE.0 ) THEN
                     CALL sort01( 'Columns', m, m, usav, ldu, work,
     $                            lwork, result( 20 ) )
                     CALL sort01( 'Rows', n, n, vtsav, ldvt, work,
     $                            lwork, result( 21 ) )
                  END IF
                  result( 22 ) = zero
                  DO 150 i = 1, mnmin - 1
                     IF( ssav( i ).LT.ssav( i+1 ) )
     $                  result( 22 ) = ulpinv
                     IF( ssav( i ).LT.zero )
     $                  result( 22 ) = ulpinv
  150             CONTINUE
                  IF( mnmin.GE.1 ) THEN
                     IF( ssav( mnmin ).LT.zero )
     $                  result( 22 ) = ulpinv
                  END IF
               END IF
*
*              Test SGESVDX
*
               CALL slacpy( 'F', m, n, asav, lda, a, lda )
               CALL sgesvdx( 'V', 'V', 'A', m, n, a, lda, 
     $                       vl, vu, il, iu, ns, ssav, usav, ldu, 
     $                       vtsav, ldvt, work, lwork, iwork, 
     $                       iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nout, fmt = 9995 )'GESVDX', iinfo, m, n, 
     $               jtype, lswork, ioldsd
                  info = abs( iinfo )
                  RETURN
               END IF
*
*              Do tests 23--29
*
               result( 23 ) = zero
               result( 24 ) = zero
               result( 25 ) = zero
               CALL sbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
     $                      vtsav, ldvt, work, result( 23 ) )
               IF( m.NE.0 .AND. n.NE.0 ) THEN
                  CALL sort01( 'Columns', m, m, usav, ldu, work, lwork,
     $                         result( 24 ) )
                  CALL sort01( 'Rows', n, n, vtsav, ldvt, work, lwork,
     $                         result( 25 ) )
               END IF
               result( 26 ) = zero
               DO 160 i = 1, mnmin - 1
                  IF( ssav( i ).LT.ssav( i+1 ) )
     $               result( 26 ) = ulpinv
                  IF( ssav( i ).LT.zero )
     $               result( 26 ) = ulpinv
  160          CONTINUE
               IF( mnmin.GE.1 ) THEN
                  IF( ssav( mnmin ).LT.zero )
     $               result( 26 ) = ulpinv
               END IF
*
*              Do partial SVDs, comparing to SSAV, USAV, and VTSAV
*
               result( 27 ) = zero
               result( 28 ) = zero
               result( 29 ) = zero
               DO 180 iju = 0, 1
                  DO 170 ijvt = 0, 1
                     IF( ( iju.EQ.0 .AND. ijvt.EQ.0 ) .OR.
     $                   ( iju.EQ.1 .AND. ijvt.EQ.1 ) )GO TO 170
                     jobu = cjobv( iju+1 )
                     jobvt = cjobv( ijvt+1 )
                     range = cjobr( 1 )
                     CALL slacpy( 'F', m, n, asav, lda, a, lda )
                     CALL sgesvdx( jobu, jobvt, range, m, n, a, lda, 
     $                             vl, vu, il, iu, ns, s, u, ldu, 
     $                             vt, ldvt, work, lwork, iwork, 
     $                             iinfo )
*   
*                    Compare U
*
                     dif = zero
                     IF( m.GT.0 .AND. n.GT.0 ) THEN
                        IF( iju.EQ.1 ) THEN
                           CALL sort03( 'C', m, mnmin, m, mnmin, usav,
     $                                  ldu, u, ldu, work, lwork, dif,
     $                                  iinfo )
                        END IF
                     END IF
                     result( 27 ) = max( result( 27 ), dif )
*
*                    Compare VT
*
                     dif = zero
                     IF( m.GT.0 .AND. n.GT.0 ) THEN
                        IF( ijvt.EQ.1 ) THEN
                           CALL sort03( 'R', n, mnmin, n, mnmin, vtsav,
     $                                  ldvt, vt, ldvt, work, lwork, 
     $                                  dif, iinfo )
                        END IF
                     END IF
                     result( 28 ) = max( result( 28 ), dif )
*
*                    Compare S
*
                     dif = zero
                     div = max( mnmin*ulp*s( 1 ), unfl )
                     DO 190 i = 1, mnmin - 1
                        IF( ssav( i ).LT.ssav( i+1 ) )
     $                     dif = ulpinv
                        IF( ssav( i ).LT.zero )
     $                     dif = ulpinv
                        dif = max( dif, abs( ssav( i )-s( i ) ) / div )
  190                CONTINUE
                     result( 29 ) = max( result( 29 ), dif )
  170             CONTINUE
  180          CONTINUE
*
*              Do tests 30--32: SGESVDX( 'V', 'V', 'I' )
*
               DO 200 i = 1, 4
                  iseed2( i ) = iseed( i )
  200          CONTINUE
               IF( mnmin.LE.1 ) THEN
                  il = 1
                  iu = max( 1, mnmin )
               ELSE
                  il = 1 + int( ( mnmin-1 )*slarnd( 1, iseed2 ) )
                  iu = 1 + int( ( mnmin-1 )*slarnd( 1, iseed2 ) )
                  IF( iu.LT.il ) THEN
                     itemp = iu
                     iu = il
                     il = itemp
                  END IF
               END IF  
               CALL slacpy( 'F', m, n, asav, lda, a, lda )
               CALL sgesvdx( 'V', 'V', 'I', m, n, a, lda, 
     $                       vl, vu, il, iu, nsi, s, u, ldu, 
     $                       vt, ldvt, work, lwork, iwork, 
     $                       iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nout, fmt = 9995 )'GESVDX', iinfo, m, n, 
     $               jtype, lswork, ioldsd
                  info = abs( iinfo )
                  RETURN
               END IF
*
               result( 30 ) = zero
               result( 31 ) = zero
               result( 32 ) = zero
               CALL sbdt05( m, n, asav, lda, s, nsi, u, ldu,
     $                      vt, ldvt, work, result( 30 ) )
               CALL sort01( 'Columns', m, nsi, u, ldu, work, lwork,
     $                      result( 31 ) )
               CALL sort01( 'Rows', nsi, n, vt, ldvt, work, lwork,
     $                      result( 32 ) )
*
*              Do tests 33--35: SGESVDX( 'V', 'V', 'V' )
*
               IF( mnmin.GT.0 .AND. nsi.GT.1 ) THEN
                  IF( il.NE.1 ) THEN
                     vu = ssav( il ) + 
     $                    max( half*abs( ssav( il )-ssav( il-1 ) ),
     $                    ulp*anorm, two*rtunfl )
                  ELSE
                     vu = ssav( 1 ) + 
     $                    max( half*abs( ssav( ns )-ssav( 1 ) ),
     $                    ulp*anorm, two*rtunfl )
                  END IF
                  IF( iu.NE.ns ) THEN
                     vl = ssav( iu ) - max( ulp*anorm, two*rtunfl,
     $                    half*abs( ssav( iu+1 )-ssav( iu ) ) )
                  ELSE
                     vl = ssav( ns ) - max( ulp*anorm, two*rtunfl,
     $                    half*abs( ssav( ns )-ssav( 1 ) ) )
                  END IF
                  vl = max( vl,zero )
                  vu = max( vu,zero )
                  IF( vl.GE.vu ) vu = max( vu*2, vu+vl+half )
               ELSE
                  vl = zero
                  vu = one
               END IF 
               CALL slacpy( 'F', m, n, asav, lda, a, lda )
               CALL sgesvdx( 'V', 'V', 'V', m, n, a, lda, 
     $                       vl, vu, il, iu, nsv, s, u, ldu, 
     $                       vt, ldvt, work, lwork, iwork, 
     $                       iinfo )
               IF( iinfo.NE.0 ) THEN
                  WRITE( nout, fmt = 9995 )'GESVDX', iinfo, m, n, 
     $               jtype, lswork, ioldsd
                  info = abs( iinfo )
                  RETURN
               END IF
*
               result( 33 ) = zero
               result( 34 ) = zero
               result( 35 ) = zero
               CALL sbdt05( m, n, asav, lda, s, nsv, u, ldu,
     $                      vt, ldvt, work, result( 33 ) )
               CALL sort01( 'Columns', m, nsv, u, ldu, work, lwork,
     $                      result( 34 ) )
               CALL sort01( 'Rows', nsv, n, vt, ldvt, work, lwork,
     $                      result( 35 ) )
*
*              End of Loop -- Check for RESULT(j) > THRESH
*
               DO 210 j = 1, 35
                  IF( result( j ).GE.thresh ) THEN        
                     IF( nfail.EQ.0 ) THEN
                        WRITE( nout, fmt = 9999 )
                        WRITE( nout, fmt = 9998 )
                     END IF
                     WRITE( nout, fmt = 9997 )m, n, jtype, iws, ioldsd,
     $                  j, result( j )
                     nfail = nfail + 1
                  END IF
  210          CONTINUE
               ntest = ntest + 35
  220       CONTINUE
  230    CONTINUE
  240 CONTINUE
*
*     Summary
*
      CALL alasvm( path, nout, nfail, ntest, 0 )
*
 9999 FORMAT( ' SVD -- Real Singular Value Decomposition Driver ',
     $      / ' Matrix types (see SDRVBD for details):',
     $      / / ' 1 = Zero matrix', / ' 2 = Identity matrix',
     $      / ' 3 = Evenly spaced singular values near 1',
     $      / ' 4 = Evenly spaced singular values near underflow',
     $      / ' 5 = Evenly spaced singular values near overflow', / /
     $      ' Tests performed: ( A is dense, U and V are orthogonal,',
     $      / 19x, ' S is an array, and Upartial, VTpartial, and',
     $      / 19x, ' Spartial are partially computed U, VT and S),', / )
 9998 FORMAT( ' 1 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
     $      / ' 2 = | I - U**T U | / ( M ulp ) ',
     $      / ' 3 = | I - VT VT**T | / ( N ulp ) ',
     $      / ' 4 = 0 if S contains min(M,N) nonnegative values in',
     $      ' decreasing order, else 1/ulp',
     $      / ' 5 = | U - Upartial | / ( M ulp )',
     $      / ' 6 = | VT - VTpartial | / ( N ulp )',
     $      / ' 7 = | S - Spartial | / ( min(M,N) ulp |S| )',
     $      / ' 8 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
     $      / ' 9 = | I - U**T U | / ( M ulp ) ',
     $      / '10 = | I - VT VT**T | / ( N ulp ) ',
     $      / '11 = 0 if S contains min(M,N) nonnegative values in',
     $      ' decreasing order, else 1/ulp',
     $      / '12 = | U - Upartial | / ( M ulp )',
     $      / '13 = | VT - VTpartial | / ( N ulp )',
     $      / '14 = | S - Spartial | / ( min(M,N) ulp |S| )',
     $      / '15 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
     $      / '16 = | I - U**T U | / ( M ulp ) ',
     $      / '17 = | I - VT VT**T | / ( N ulp ) ',
     $      / '18 = 0 if S contains min(M,N) nonnegative values in',
     $      ' decreasing order, else 1/ulp',
     $      / '19 = | U - Upartial | / ( M ulp )',
     $      / '20 = | VT - VTpartial | / ( N ulp )',
     $      / '21 = | S - Spartial | / ( min(M,N) ulp |S| )', 
     $      / '22 = 0 if S contains min(M,N) nonnegative values in',
     $      ' decreasing order, else 1/ulp',
     $      ' SGESVDX(V,V,A) ',
     $      / '23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ),'
     $      / '24 = | I - U**T U | / ( M ulp ) ',
     $      / '25 = | I - VT VT**T | / ( N ulp ) ',
     $      / '26 = 0 if S contains min(M,N) nonnegative values in',
     $      ' decreasing order, else 1/ulp',
     $      / '27 = | U - Upartial | / ( M ulp )',
     $      / '28 = | VT - VTpartial | / ( N ulp )',
     $      / '29 = | S - Spartial | / ( min(M,N) ulp |S| )',
     $      / '30 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
     $      ' SGESVDX(V,V,I) ',
     $      / '31 = | I - U**T U | / ( M ulp ) ',
     $      / '32 = | I - VT VT**T | / ( N ulp ) ',
     $      / '33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
     $      ' SGESVDX(V,V,V) ',
     $      / '34 = | I - U**T U | / ( M ulp ) ',
     $      / '35 = | I - VT VT**T | / ( N ulp ) ',  
     $      / / )
 9997 FORMAT( ' M=', i5, ', N=', i5, ', type ', i1, ', IWS=', i1,
     $      ', seed=', 4( i4, ',' ), ' test(', i2, ')=', g11.4 )
 9996 FORMAT( ' SDRVBD: ', a, ' returned INFO=', i6, '.', / 9x, 'M=',
     $      i6, ', N=', i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ),
     $      i5, ')' )
 9995 FORMAT( ' SDRVBD: ', a, ' returned INFO=', i6, '.', / 9x, 'M=',
     $      i6, ', N=', i6, ', JTYPE=', i6, ', LSWORK=', i6, / 9x,
     $      'ISEED=(', 3( i5, ',' ), i5, ')' )
*
      RETURN
*
*     End of SDRVBD
*
      END