C  5 FEB 05 - MWS - NICKED FROM LAPACK FOR SINGLE VALUE DECOMPOSITION
C
C*MODULE DGESVD  *DECK DGESVD
      SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
     $                   WORK, LWORK, INFO )
C
C  -- LAPACK DRIVER ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     OCTOBER 31, 1999
C
C     .. SCALAR ARGUMENTS ..
      CHARACTER          JOBU, JOBVT
      INTEGER            INFO, LDA, LDU, LDVT, LWORK, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), S( * ), U( LDU, * ),
     $                   VT( LDVT, * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DGESVD COMPUTES THE SINGULAR VALUE DECOMPOSITION (SVD) OF A REAL
C  M-BY-N MATRIX A, OPTIONALLY COMPUTING THE LEFT AND/OR RIGHT SINGULAR
C  VECTORS. THE SVD IS WRITTEN
C
C       A = U * SIGMA * TRANSPOSE(V)
C
C  WHERE SIGMA IS AN M-BY-N MATRIX WHICH IS ZERO EXCEPT FOR ITS
C  MIN(M,N) DIAGONAL ELEMENTS, U IS AN M-BY-M ORTHOGONAL MATRIX, AND
C  V IS AN N-BY-N ORTHOGONAL MATRIX.  THE DIAGONAL ELEMENTS OF SIGMA
C  ARE THE SINGULAR VALUES OF A; THEY ARE REAL AND NON-NEGATIVE, AND
C  ARE RETURNED IN DESCENDING ORDER.  THE FIRST MIN(M,N) COLUMNS OF
C  U AND V ARE THE LEFT AND RIGHT SINGULAR VECTORS OF A.
C
C  NOTE THAT THE ROUTINE RETURNS V**T, NOT V.
C
C  ARGUMENTS
C  =========
C
C  JOBU    (INPUT) CHARACTER*1
C          SPECIFIES OPTIONS FOR COMPUTING ALL OR PART OF THE MATRIX U:
C          = 'A':  ALL M COLUMNS OF U ARE RETURNED IN ARRAY U:
C          = 'S':  THE FIRST MIN(M,N) COLUMNS OF U (THE LEFT SINGULAR
C                  VECTORS) ARE RETURNED IN THE ARRAY U;
C          = 'O':  THE FIRST MIN(M,N) COLUMNS OF U (THE LEFT SINGULAR
C                  VECTORS) ARE OVERWRITTEN ON THE ARRAY A;
C          = 'N':  NO COLUMNS OF U (NO LEFT SINGULAR VECTORS) ARE
C                  COMPUTED.
C
C  JOBVT   (INPUT) CHARACTER*1
C          SPECIFIES OPTIONS FOR COMPUTING ALL OR PART OF THE MATRIX
C          V**T:
C          = 'A':  ALL N ROWS OF V**T ARE RETURNED IN THE ARRAY VT;
C          = 'S':  THE FIRST MIN(M,N) ROWS OF V**T (THE RIGHT SINGULAR
C                  VECTORS) ARE RETURNED IN THE ARRAY VT;
C          = 'O':  THE FIRST MIN(M,N) ROWS OF V**T (THE RIGHT SINGULAR
C                  VECTORS) ARE OVERWRITTEN ON THE ARRAY A;
C          = 'N':  NO ROWS OF V**T (NO RIGHT SINGULAR VECTORS) ARE
C                  COMPUTED.
C
C          JOBVT AND JOBU CANNOT BOTH BE 'O'.
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE INPUT MATRIX A.  M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE INPUT MATRIX A.  N >= 0.
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          ON ENTRY, THE M-BY-N MATRIX A.
C          ON EXIT,
C          IF JOBU = 'O',  A IS OVERWRITTEN WITH THE FIRST MIN(M,N)
C                          COLUMNS OF U (THE LEFT SINGULAR VECTORS,
C                          STORED COLUMNWISE);
C          IF JOBVT = 'O', A IS OVERWRITTEN WITH THE FIRST MIN(M,N)
C                          ROWS OF V**T (THE RIGHT SINGULAR VECTORS,
C                          STORED ROWWISE);
C          IF JOBU .NE. 'O' AND JOBVT .NE. 'O', THE CONTENTS OF A
C                          ARE DESTROYED.
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.  LDA >= MAX(1,M).
C
C  S       (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(M,N))
C          THE SINGULAR VALUES OF A, SORTED SO THAT S(I) >= S(I+1).
C
C  U       (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDU,UCOL)
C          (LDU,M) IF JOBU = 'A' OR (LDU,MIN(M,N)) IF JOBU = 'S'.
C          IF JOBU = 'A', U CONTAINS THE M-BY-M ORTHOGONAL MATRIX U;
C          IF JOBU = 'S', U CONTAINS THE FIRST MIN(M,N) COLUMNS OF U
C          (THE LEFT SINGULAR VECTORS, STORED COLUMNWISE);
C          IF JOBU = 'N' OR 'O', U IS NOT REFERENCED.
C
C  LDU     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY U.  LDU >= 1; IF
C          JOBU = 'S' OR 'A', LDU >= M.
C
C  VT      (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDVT,N)
C          IF JOBVT = 'A', VT CONTAINS THE N-BY-N ORTHOGONAL MATRIX
C          V**T;
C          IF JOBVT = 'S', VT CONTAINS THE FIRST MIN(M,N) ROWS OF
C          V**T (THE RIGHT SINGULAR VECTORS, STORED ROWWISE);
C          IF JOBVT = 'N' OR 'O', VT IS NOT REFERENCED.
C
C  LDVT    (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY VT.  LDVT >= 1; IF
C          JOBVT = 'A', LDVT >= N; IF JOBVT = 'S', LDVT >= MIN(M,N).
C
C  WORK    (WORKSPACE/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LWORK)
C          ON EXIT, IF INFO = 0, WORK(1) RETURNS THE OPTIMAL LWORK;
C          IF INFO > 0, WORK(2:MIN(M,N)) CONTAINS THE UNCONVERGED
C          SUPERDIAGONAL ELEMENTS OF AN UPPER BIDIAGONAL MATRIX B
C          WHOSE DIAGONAL IS IN S (NOT NECESSARILY SORTED). B
C          SATISFIES A = U * B * VT, SO IT HAS THE SAME SINGULAR VALUES
C          AS A, AND SINGULAR VECTORS RELATED BY U AND VT.
C
C  LWORK   (INPUT) INTEGER
C          THE DIMENSION OF THE ARRAY WORK. LWORK >= 1.
C          LWORK >= MAX(3*MIN(M,N)+MAX(M,N),5*MIN(M,N)).
C          FOR GOOD PERFORMANCE, LWORK SHOULD GENERALLY BE LARGER.
C
C          IF LWORK = -1, THEN A WORKSPACE QUERY IS ASSUMED; THE ROUTINE
C          ONLY CALCULATES THE OPTIMAL SIZE OF THE WORK ARRAY, RETURNS
C          THIS VALUE AS THE FIRST ENTRY OF THE WORK ARRAY, AND NO ERROR
C          MESSAGE RELATED TO LWORK IS ISSUED BY XERBLA.
C
C  INFO    (OUTPUT) INTEGER
C          = 0:  SUCCESSFUL EXIT.
C          < 0:  IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE.
C          > 0:  IF DBDSQR DID NOT CONVERGE, INFO SPECIFIES HOW MANY
C                SUPERDIAGONALS OF AN INTERMEDIATE BIDIAGONAL FORM B
C                DID NOT CONVERGE TO ZERO. SEE THE DESCRIPTION OF WORK
C                ABOVE FOR DETAILS.
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ZERO, ONE
      PARAMETER          ( ZERO = 0.0D+00, ONE = 1.0D+00 )
C     ..
C     .. LOCAL SCALARS ..
      LOGICAL            LQUERY, WNTUA, WNTUAS, WNTUN, WNTUO, WNTUS,
     $                   WNTVA, WNTVAS, WNTVN, WNTVO, WNTVS
      INTEGER            BDSPAC, BLK, CHUNK, I, IE, IERR, IR, ISCL,
     $                   ITAU, ITAUP, ITAUQ, IU, IWORK, LDWRKR, LDWRKU,
     $                   MAXWRK, MINMN, MINWRK, MNTHR, NCU, NCVT, NRU,
     $                   NRVT, WRKBL
      DOUBLE PRECISION   ANRM, BIGNUM, EPS, SMLNUM
C     ..
C     .. LOCAL ARRAYS ..
      DOUBLE PRECISION   DUM( 1 )
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DBDSQR, DGEBRD, DGELQF, DGEMM, DGEQRF, DLACPY,
     $                   DLASCL, DLASET, DORGBR, DORGLQ, DORGQR, DORMBR,
     $                   XERBLA
C     ..
C     .. EXTERNAL FUNCTIONS ..
      LOGICAL            LSAME
      INTEGER            ILAENV
      DOUBLE PRECISION   DLAMCH
      EXTERNAL           LSAME, ILAENV, DLAMCH
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN, SQRT
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      MINMN = MIN( M, N )
      MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 )
      WNTUA = LSAME( JOBU, 'A' )
      WNTUS = LSAME( JOBU, 'S' )
      WNTUAS = WNTUA .OR. WNTUS
      WNTUO = LSAME( JOBU, 'O' )
      WNTUN = LSAME( JOBU, 'N' )
      WNTVA = LSAME( JOBVT, 'A' )
      WNTVS = LSAME( JOBVT, 'S' )
      WNTVAS = WNTVA .OR. WNTVS
      WNTVO = LSAME( JOBVT, 'O' )
      WNTVN = LSAME( JOBVT, 'N' )
      MINWRK = 1
      LQUERY = ( LWORK.EQ.-1 )
C
      IF( .NOT.( WNTUA .OR. WNTUS .OR. WNTUO .OR. WNTUN ) ) THEN
         INFO = -1
      ELSE IF( .NOT.( WNTVA .OR. WNTVS .OR. WNTVO .OR. WNTVN ) .OR.
     $         ( WNTVO .AND. WNTUO ) ) THEN
         INFO = -2
      ELSE IF( M.LT.0 ) THEN
         INFO = -3
      ELSE IF( N.LT.0 ) THEN
         INFO = -4
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = -6
      ELSE IF( LDU.LT.1 .OR. ( WNTUAS .AND. LDU.LT.M ) ) THEN
         INFO = -9
      ELSE IF( LDVT.LT.1 .OR. ( WNTVA .AND. LDVT.LT.N ) .OR.
     $         ( WNTVS .AND. LDVT.LT.MINMN ) ) THEN
         INFO = -11
      END IF
C
C     COMPUTE WORKSPACE
C      (NOTE: COMMENTS IN THE CODE BEGINNING "WORKSPACE:" DESCRIBE THE
C       MINIMAL AMOUNT OF WORKSPACE NEEDED AT THAT POINT IN THE CODE,
C       AS WELL AS THE PREFERRED AMOUNT FOR GOOD PERFORMANCE.
C       NB REFERS TO THE OPTIMAL BLOCK SIZE FOR THE IMMEDIATELY
C       FOLLOWING SUBROUTINE, AS RETURNED BY ILAENV.)
C
      IF( INFO.EQ.0 .AND. ( LWORK.GE.1 .OR. LQUERY ) .AND. M.GT.0 .AND.
     $    N.GT.0 ) THEN
         IF( M.GE.N ) THEN
C
C           COMPUTE SPACE NEEDED FOR DBDSQR
C
            BDSPAC = 5*N
            IF( M.GE.MNTHR ) THEN
               IF( WNTUN ) THEN
C
C                 PATH 1 (M MUCH LARGER THAN N, JOBU='N')
C
                  MAXWRK = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1,
     $                     -1 )
                  MAXWRK = MAX( MAXWRK, 3*N+2*N*
     $                     ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
                  IF( WNTVO .OR. WNTVAS )
     $               MAXWRK = MAX( MAXWRK, 3*N+( N-1 )*
     $                        ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
                  MAXWRK = MAX( MAXWRK, BDSPAC )
                  MINWRK = MAX( 4*N, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTUO .AND. WNTVN ) THEN
C
C                 PATH 2 (M MUCH LARGER THAN N, JOBU='O', JOBVT='N')
C
                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
     $                    N, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+2*N*
     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+N*
     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N )
                  MINWRK = MAX( 3*N+M, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTUO .AND. WNTVAS ) THEN
C
C                 PATH 3 (M MUCH LARGER THAN N, JOBU='O', JOBVT='S' OR
C                 'A')
C
                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
     $                    N, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+2*N*
     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+N*
     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+( N-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N )
                  MINWRK = MAX( 3*N+M, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTUS .AND. WNTVN ) THEN
C
C                 PATH 4 (M MUCH LARGER THAN N, JOBU='S', JOBVT='N')
C
                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
     $                    N, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+2*N*
     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+N*
     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = N*N + WRKBL
                  MINWRK = MAX( 3*N+M, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTUS .AND. WNTVO ) THEN
C
C                 PATH 5 (M MUCH LARGER THAN N, JOBU='S', JOBVT='O')
C
                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
     $                    N, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+2*N*
     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+N*
     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+( N-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = 2*N*N + WRKBL
                  MINWRK = MAX( 3*N+M, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTUS .AND. WNTVAS ) THEN
C
C                 PATH 6 (M MUCH LARGER THAN N, JOBU='S', JOBVT='S' OR
C                 'A')
C
                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M,
     $                    N, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+2*N*
     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+N*
     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+( N-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = N*N + WRKBL
                  MINWRK = MAX( 3*N+M, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTUA .AND. WNTVN ) THEN
C
C                 PATH 7 (M MUCH LARGER THAN N, JOBU='A', JOBVT='N')
C
                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'DORGQR', ' ', M,
     $                    M, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+2*N*
     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+N*
     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = N*N + WRKBL
                  MINWRK = MAX( 3*N+M, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTUA .AND. WNTVO ) THEN
C
C                 PATH 8 (M MUCH LARGER THAN N, JOBU='A', JOBVT='O')
C
                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'DORGQR', ' ', M,
     $                    M, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+2*N*
     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+N*
     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+( N-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = 2*N*N + WRKBL
                  MINWRK = MAX( 3*N+M, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTUA .AND. WNTVAS ) THEN
C
C                 PATH 9 (M MUCH LARGER THAN N, JOBU='A', JOBVT='S' OR
C                 'A')
C
                  WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'DORGQR', ' ', M,
     $                    M, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+2*N*
     $                    ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+N*
     $                    ILAENV( 1, 'DORGBR', 'Q', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, 3*N+( N-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = N*N + WRKBL
                  MINWRK = MAX( 3*N+M, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               END IF
            ELSE
C
C              PATH 10 (M AT LEAST N, BUT NOT MUCH LARGER)
C
               MAXWRK = 3*N + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N,
     $                  -1, -1 )
               IF( WNTUS .OR. WNTUO )
     $            MAXWRK = MAX( MAXWRK, 3*N+N*
     $                     ILAENV( 1, 'DORGBR', 'Q', M, N, N, -1 ) )
               IF( WNTUA )
     $            MAXWRK = MAX( MAXWRK, 3*N+M*
     $                     ILAENV( 1, 'DORGBR', 'Q', M, M, N, -1 ) )
               IF( .NOT.WNTVN )
     $            MAXWRK = MAX( MAXWRK, 3*N+( N-1 )*
     $                     ILAENV( 1, 'DORGBR', 'P', N, N, N, -1 ) )
               MAXWRK = MAX( MAXWRK, BDSPAC )
               MINWRK = MAX( 3*N+M, BDSPAC )
               MAXWRK = MAX( MAXWRK, MINWRK )
            END IF
         ELSE
C
C           COMPUTE SPACE NEEDED FOR DBDSQR
C
            BDSPAC = 5*M
            IF( N.GE.MNTHR ) THEN
               IF( WNTVN ) THEN
C
C                 PATH 1T(N MUCH LARGER THAN M, JOBVT='N')
C
                  MAXWRK = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1,
     $                     -1 )
                  MAXWRK = MAX( MAXWRK, 3*M+2*M*
     $                     ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
                  IF( WNTUO .OR. WNTUAS )
     $               MAXWRK = MAX( MAXWRK, 3*M+M*
     $                        ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
                  MAXWRK = MAX( MAXWRK, BDSPAC )
                  MINWRK = MAX( 4*M, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTVO .AND. WNTUN ) THEN
C
C                 PATH 2T(N MUCH LARGER THAN M, JOBU='N', JOBVT='O')
C
                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
     $                    N, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+2*M*
     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M )
                  MINWRK = MAX( 3*M+N, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTVO .AND. WNTUAS ) THEN
C
C                 PATH 3T(N MUCH LARGER THAN M, JOBU='S' OR 'A',
C                 JOBVT='O')
C
                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
     $                    N, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+2*M*
     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+M*
     $                    ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M )
                  MINWRK = MAX( 3*M+N, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTVS .AND. WNTUN ) THEN
C
C                 PATH 4T(N MUCH LARGER THAN M, JOBU='N', JOBVT='S')
C
                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
     $                    N, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+2*M*
     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = M*M + WRKBL
                  MINWRK = MAX( 3*M+N, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTVS .AND. WNTUO ) THEN
C
C                 PATH 5T(N MUCH LARGER THAN M, JOBU='O', JOBVT='S')
C
                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
     $                    N, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+2*M*
     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+M*
     $                    ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = 2*M*M + WRKBL
                  MINWRK = MAX( 3*M+N, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTVS .AND. WNTUAS ) THEN
C
C                 PATH 6T(N MUCH LARGER THAN M, JOBU='S' OR 'A',
C                 JOBVT='S')
C
                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M,
     $                    N, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+2*M*
     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+M*
     $                    ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = M*M + WRKBL
                  MINWRK = MAX( 3*M+N, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTVA .AND. WNTUN ) THEN
C
C                 PATH 7T(N MUCH LARGER THAN M, JOBU='N', JOBVT='A')
C
                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'DORGLQ', ' ', N,
     $                    N, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+2*M*
     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = M*M + WRKBL
                  MINWRK = MAX( 3*M+N, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTVA .AND. WNTUO ) THEN
C
C                 PATH 8T(N MUCH LARGER THAN M, JOBU='O', JOBVT='A')
C
                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'DORGLQ', ' ', N,
     $                    N, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+2*M*
     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+M*
     $                    ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = 2*M*M + WRKBL
                  MINWRK = MAX( 3*M+N, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               ELSE IF( WNTVA .AND. WNTUAS ) THEN
C
C                 PATH 9T(N MUCH LARGER THAN M, JOBU='S' OR 'A',
C                 JOBVT='A')
C
                  WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
                  WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'DORGLQ', ' ', N,
     $                    N, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+2*M*
     $                    ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+( M-1 )*
     $                    ILAENV( 1, 'DORGBR', 'P', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, 3*M+M*
     $                    ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
                  WRKBL = MAX( WRKBL, BDSPAC )
                  MAXWRK = M*M + WRKBL
                  MINWRK = MAX( 3*M+N, BDSPAC )
                  MAXWRK = MAX( MAXWRK, MINWRK )
               END IF
            ELSE
C
C              PATH 10T(N GREATER THAN M, BUT NOT MUCH LARGER)
C
               MAXWRK = 3*M + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N,
     $                  -1, -1 )
               IF( WNTVS .OR. WNTVO )
     $            MAXWRK = MAX( MAXWRK, 3*M+M*
     $                     ILAENV( 1, 'DORGBR', 'P', M, N, M, -1 ) )
               IF( WNTVA )
     $            MAXWRK = MAX( MAXWRK, 3*M+N*
     $                     ILAENV( 1, 'DORGBR', 'P', N, N, M, -1 ) )
               IF( .NOT.WNTUN )
     $            MAXWRK = MAX( MAXWRK, 3*M+( M-1 )*
     $                     ILAENV( 1, 'DORGBR', 'Q', M, M, M, -1 ) )
               MAXWRK = MAX( MAXWRK, BDSPAC )
               MINWRK = MAX( 3*M+N, BDSPAC )
               MAXWRK = MAX( MAXWRK, MINWRK )
            END IF
         END IF
         WORK( 1 ) = MAXWRK
      END IF
C
      IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
         INFO = -13
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DGESVD', -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
         IF( LWORK.GE.1 )
     $      WORK( 1 ) = ONE
         RETURN
      END IF
C
C     GET MACHINE CONSTANTS
C
      EPS = DLAMCH( 'P' )
      SMLNUM = SQRT( DLAMCH( 'S' ) ) / EPS
      BIGNUM = ONE / SMLNUM
C
C     SCALE A IF MAX ELEMENT OUTSIDE RANGE [SMLNUM,BIGNUM]
C
      CALL SUBR_DLANGE(ANRM,  'M', M, N, A, LDA, DUM )
      ISCL = 0
      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
         ISCL = 1
         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, IERR )
      ELSE IF( ANRM.GT.BIGNUM ) THEN
         ISCL = 1
         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, IERR )
      END IF
C
      IF( M.GE.N ) THEN
C
C        A HAS AT LEAST AS MANY ROWS AS COLUMNS. IF A HAS SUFFICIENTLY
C        MORE ROWS THAN COLUMNS, FIRST REDUCE USING THE QR
C        DECOMPOSITION (IF SUFFICIENT WORKSPACE AVAILABLE)
C
         IF( M.GE.MNTHR ) THEN
C
            IF( WNTUN ) THEN
C
C              PATH 1 (M MUCH LARGER THAN N, JOBU='N')
C              NO LEFT SINGULAR VECTORS TO BE COMPUTED
C
               ITAU = 1
               IWORK = ITAU + N
C
C              COMPUTE A=Q*R
C              (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
               CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
     $                      LWORK-IWORK+1, IERR )
C
C              ZERO OUT BELOW R
C
               CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA )
               IE = 1
               ITAUQ = IE + N
               ITAUP = ITAUQ + N
               IWORK = ITAUP + N
C
C              BIDIAGONALIZE R IN A
C              (WORKSPACE: NEED 4*N, PREFER 3*N+2*N*NB)
C
               CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
     $                      WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
     $                      IERR )
               NCVT = 0
               IF( WNTVO .OR. WNTVAS ) THEN
C
C                 IF RIGHT SINGULAR VECTORS DESIRED, GENERATE P'.
C                 (WORKSPACE: NEED 4*N-1, PREFER 3*N+(N-1)*NB)
C
                  CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  NCVT = N
               END IF
               IWORK = IE + N
C
C              PERFORM BIDIAGONAL QR ITERATION, COMPUTING RIGHT
C              SINGULAR VECTORS OF A IN A IF DESIRED
C              (WORKSPACE: NEED BDSPAC)
C
               CALL DBDSQR( 'U', N, NCVT, 0, 0, S, WORK( IE ), A, LDA,
     $                      DUM, 1, DUM, 1, WORK( IWORK ), INFO )
C
C              IF RIGHT SINGULAR VECTORS DESIRED IN VT, COPY THEM THERE
C
               IF( WNTVAS )
     $            CALL DLACPY( 'F', N, N, A, LDA, VT, LDVT )
C
            ELSE IF( WNTUO .AND. WNTVN ) THEN
C
C              PATH 2 (M MUCH LARGER THAN N, JOBU='O', JOBVT='N')
C              N LEFT SINGULAR VECTORS TO BE OVERWRITTEN ON A AND
C              NO RIGHT SINGULAR VECTORS TO BE COMPUTED
C
               IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
C
C                 SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                  IR = 1
                  IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN
C
C                    WORK(IU) IS LDA BY N, WORK(IR) IS LDA BY N
C
                     LDWRKU = LDA
                     LDWRKR = LDA
                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN
C
C                    WORK(IU) IS LDA BY N, WORK(IR) IS N BY N
C
                     LDWRKU = LDA
                     LDWRKR = N
                  ELSE
C
C                    WORK(IU) IS LDWRKU BY N, WORK(IR) IS N BY N
C
                     LDWRKU = ( LWORK-N*N-N ) / N
                     LDWRKR = N
                  END IF
                  ITAU = IR + LDWRKR*N
                  IWORK = ITAU + N
C
C                 COMPUTE A=Q*R
C                 (WORKSPACE: NEED N*N+2*N, PREFER N*N+N+N*NB)
C
                  CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 COPY R TO WORK(IR) AND ZERO OUT BELOW IT
C
                  CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR )
                  CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ),
     $                         LDWRKR )
C
C                 GENERATE Q IN A
C                 (WORKSPACE: NEED N*N+2*N, PREFER N*N+N+N*NB)
C
                  CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IE = ITAU
                  ITAUQ = IE + N
                  ITAUP = ITAUQ + N
                  IWORK = ITAUP + N
C
C                 BIDIAGONALIZE R IN WORK(IR)
C                 (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+2*N*NB)
C
                  CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ),
     $                         WORK( ITAUQ ), WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 GENERATE LEFT VECTORS BIDIAGONALIZING R
C                 (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+N*NB)
C
                  CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
     $                         WORK( ITAUQ ), WORK( IWORK ),
     $                         LWORK-IWORK+1, IERR )
                  IWORK = IE + N
C
C                 PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                 SINGULAR VECTORS OF R IN WORK(IR)
C                 (WORKSPACE: NEED N*N+BDSPAC)
C
                  CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, 1,
     $                         WORK( IR ), LDWRKR, DUM, 1,
     $                         WORK( IWORK ), INFO )
                  IU = IE + N
C
C                 MULTIPLY Q IN A BY LEFT SINGULAR VECTORS OF R IN
C                 WORK(IR), STORING RESULT IN WORK(IU) AND COPYING TO A
C                 (WORKSPACE: NEED N*N+2*N, PREFER N*N+M*N+N)
C
                  DO 10 I = 1, M, LDWRKU
                     CHUNK = MIN( M-I+1, LDWRKU )
                     CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
     $                           LDA, WORK( IR ), LDWRKR, ZERO,
     $                           WORK( IU ), LDWRKU )
                     CALL DLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
     $                            A( I, 1 ), LDA )
   10             CONTINUE
C
               ELSE
C
C                 INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                  IE = 1
                  ITAUQ = IE + N
                  ITAUP = ITAUQ + N
                  IWORK = ITAUP + N
C
C                 BIDIAGONALIZE A
C                 (WORKSPACE: NEED 3*N+M, PREFER 3*N+(M+N)*NB)
C
                  CALL DGEBRD( M, N, A, LDA, S, WORK( IE ),
     $                         WORK( ITAUQ ), WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 GENERATE LEFT VECTORS BIDIAGONALIZING A
C                 (WORKSPACE: NEED 4*N, PREFER 3*N+N*NB)
C
                  CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IWORK = IE + N
C
C                 PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                 SINGULAR VECTORS OF A IN A
C                 (WORKSPACE: NEED BDSPAC)
C
                  CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM, 1,
     $                         A, LDA, DUM, 1, WORK( IWORK ), INFO )
C
               END IF
C
            ELSE IF( WNTUO .AND. WNTVAS ) THEN
C
C              PATH 3 (M MUCH LARGER THAN N, JOBU='O', JOBVT='S' OR 'A')
C              N LEFT SINGULAR VECTORS TO BE OVERWRITTEN ON A AND
C              N RIGHT SINGULAR VECTORS TO BE COMPUTED IN VT
C
               IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
C
C                 SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                  IR = 1
                  IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN
C
C                    WORK(IU) IS LDA BY N AND WORK(IR) IS LDA BY N
C
                     LDWRKU = LDA
                     LDWRKR = LDA
                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN
C
C                    WORK(IU) IS LDA BY N AND WORK(IR) IS N BY N
C
                     LDWRKU = LDA
                     LDWRKR = N
                  ELSE
C
C                    WORK(IU) IS LDWRKU BY N AND WORK(IR) IS N BY N
C
                     LDWRKU = ( LWORK-N*N-N ) / N
                     LDWRKR = N
                  END IF
                  ITAU = IR + LDWRKR*N
                  IWORK = ITAU + N
C
C                 COMPUTE A=Q*R
C                 (WORKSPACE: NEED N*N+2*N, PREFER N*N+N+N*NB)
C
                  CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 COPY R TO VT, ZEROING OUT BELOW IT
C
                  CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
                  CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, VT( 2, 1 ),
     $                         LDVT )
C
C                 GENERATE Q IN A
C                 (WORKSPACE: NEED N*N+2*N, PREFER N*N+N+N*NB)
C
                  CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IE = ITAU
                  ITAUQ = IE + N
                  ITAUP = ITAUQ + N
                  IWORK = ITAUP + N
C
C                 BIDIAGONALIZE R IN VT, COPYING RESULT TO WORK(IR)
C                 (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+2*N*NB)
C
                  CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
     $                         WORK( ITAUQ ), WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  CALL DLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR )
C
C                 GENERATE LEFT VECTORS BIDIAGONALIZING R IN WORK(IR)
C                 (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+N*NB)
C
                  CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
     $                         WORK( ITAUQ ), WORK( IWORK ),
     $                         LWORK-IWORK+1, IERR )
C
C                 GENERATE RIGHT VECTORS BIDIAGONALIZING R IN VT
C                 (WORKSPACE: NEED N*N+4*N-1, PREFER N*N+3*N+(N-1)*NB)
C
                  CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IWORK = IE + N
C
C                 PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                 SINGULAR VECTORS OF R IN WORK(IR) AND COMPUTING RIGHT
C                 SINGULAR VECTORS OF R IN VT
C                 (WORKSPACE: NEED N*N+BDSPAC)
C
                  CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, LDVT,
     $                         WORK( IR ), LDWRKR, DUM, 1,
     $                         WORK( IWORK ), INFO )
                  IU = IE + N
C
C                 MULTIPLY Q IN A BY LEFT SINGULAR VECTORS OF R IN
C                 WORK(IR), STORING RESULT IN WORK(IU) AND COPYING TO A
C                 (WORKSPACE: NEED N*N+2*N, PREFER N*N+M*N+N)
C
                  DO 20 I = 1, M, LDWRKU
                     CHUNK = MIN( M-I+1, LDWRKU )
                     CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ),
     $                           LDA, WORK( IR ), LDWRKR, ZERO,
     $                           WORK( IU ), LDWRKU )
                     CALL DLACPY( 'F', CHUNK, N, WORK( IU ), LDWRKU,
     $                            A( I, 1 ), LDA )
   20             CONTINUE
C
               ELSE
C
C                 INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                  ITAU = 1
                  IWORK = ITAU + N
C
C                 COMPUTE A=Q*R
C                 (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
                  CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 COPY R TO VT, ZEROING OUT BELOW IT
C
                  CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
                  CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, VT( 2, 1 ),
     $                         LDVT )
C
C                 GENERATE Q IN A
C                 (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
                  CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IE = ITAU
                  ITAUQ = IE + N
                  ITAUP = ITAUQ + N
                  IWORK = ITAUP + N
C
C                 BIDIAGONALIZE R IN VT
C                 (WORKSPACE: NEED 4*N, PREFER 3*N+2*N*NB)
C
                  CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
     $                         WORK( ITAUQ ), WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 MULTIPLY Q IN A BY LEFT VECTORS BIDIAGONALIZING R
C                 (WORKSPACE: NEED 3*N+M, PREFER 3*N+M*NB)
C
                  CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
     $                         WORK( ITAUQ ), A, LDA, WORK( IWORK ),
     $                         LWORK-IWORK+1, IERR )
C
C                 GENERATE RIGHT VECTORS BIDIAGONALIZING R IN VT
C                 (WORKSPACE: NEED 4*N-1, PREFER 3*N+(N-1)*NB)
C
                  CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IWORK = IE + N
C
C                 PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                 SINGULAR VECTORS OF A IN A AND COMPUTING RIGHT
C                 SINGULAR VECTORS OF A IN VT
C                 (WORKSPACE: NEED BDSPAC)
C
                  CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT, LDVT,
     $                         A, LDA, DUM, 1, WORK( IWORK ), INFO )
C
               END IF
C
            ELSE IF( WNTUS ) THEN
C
               IF( WNTVN ) THEN
C
C                 PATH 4 (M MUCH LARGER THAN N, JOBU='S', JOBVT='N')
C                 N LEFT SINGULAR VECTORS TO BE COMPUTED IN U AND
C                 NO RIGHT SINGULAR VECTORS TO BE COMPUTED
C
                  IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IR = 1
                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
C
C                       WORK(IR) IS LDA BY N
C
                        LDWRKR = LDA
                     ELSE
C
C                       WORK(IR) IS N BY N
C
                        LDWRKR = N
                     END IF
                     ITAU = IR + LDWRKR*N
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R
C                    (WORKSPACE: NEED N*N+2*N, PREFER N*N+N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY R TO WORK(IR), ZEROING OUT BELOW IT
C
                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ),
     $                            LDWRKR )
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
     $                            WORK( IR+1 ), LDWRKR )
C
C                    GENERATE Q IN A
C                    (WORKSPACE: NEED N*N+2*N, PREFER N*N+N+N*NB)
C
                     CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    BIDIAGONALIZE R IN WORK(IR)
C                    (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE LEFT VECTORS BIDIAGONALIZING R IN WORK(IR)
C                    (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+N*NB)
C
                     CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
     $                            WORK( ITAUQ ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF R IN WORK(IR)
C                    (WORKSPACE: NEED N*N+BDSPAC)
C
                     CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM,
     $                            1, WORK( IR ), LDWRKR, DUM, 1,
     $                            WORK( IWORK ), INFO )
C
C                    MULTIPLY Q IN A BY LEFT SINGULAR VECTORS OF R IN
C                    WORK(IR), STORING RESULT IN U
C                    (WORKSPACE: NEED N*N)
C
                     CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
     $                           WORK( IR ), LDWRKR, ZERO, U, LDU )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R, COPYING RESULT TO U
C                    (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
C
C                    GENERATE Q IN U
C                    (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
                     CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    ZERO OUT BELOW R IN A
C
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
     $                            LDA )
C
C                    BIDIAGONALIZE R IN A
C                    (WORKSPACE: NEED 4*N, PREFER 3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY Q IN U BY LEFT VECTORS BIDIAGONALIZING R
C                    (WORKSPACE: NEED 3*N+M, PREFER 3*N+M*NB)
C
                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF A IN U
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM,
     $                            1, U, LDU, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               ELSE IF( WNTVO ) THEN
C
C                 PATH 5 (M MUCH LARGER THAN N, JOBU='S', JOBVT='O')
C                 N LEFT SINGULAR VECTORS TO BE COMPUTED IN U AND
C                 N RIGHT SINGULAR VECTORS TO BE OVERWRITTEN ON A
C
                  IF( LWORK.GE.2*N*N+MAX( 4*N, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IU = 1
                     IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
C
C                       WORK(IU) IS LDA BY N AND WORK(IR) IS LDA BY N
C
                        LDWRKU = LDA
                        IR = IU + LDWRKU*N
                        LDWRKR = LDA
                     ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
C
C                       WORK(IU) IS LDA BY N AND WORK(IR) IS N BY N
C
                        LDWRKU = LDA
                        IR = IU + LDWRKU*N
                        LDWRKR = N
                     ELSE
C
C                       WORK(IU) IS N BY N AND WORK(IR) IS N BY N
C
                        LDWRKU = N
                        IR = IU + LDWRKU*N
                        LDWRKR = N
                     END IF
                     ITAU = IR + LDWRKR*N
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R
C                    (WORKSPACE: NEED 2*N*N+2*N, PREFER 2*N*N+N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY R TO WORK(IU), ZEROING OUT BELOW IT
C
                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
     $                            LDWRKU )
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
     $                            WORK( IU+1 ), LDWRKU )
C
C                    GENERATE Q IN A
C                    (WORKSPACE: NEED 2*N*N+2*N, PREFER 2*N*N+N+N*NB)
C
                     CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    BIDIAGONALIZE R IN WORK(IU), COPYING RESULT TO
C                    WORK(IR)
C                    (WORKSPACE: NEED 2*N*N+4*N,
C                                PREFER 2*N*N+3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU,
     $                            WORK( IR ), LDWRKR )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN WORK(IU)
C                    (WORKSPACE: NEED 2*N*N+4*N, PREFER 2*N*N+3*N+N*NB)
C
                     CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
     $                            WORK( ITAUQ ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN WORK(IR)
C                    (WORKSPACE: NEED 2*N*N+4*N-1,
C                                PREFER 2*N*N+3*N+(N-1)*NB)
C
                     CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF R IN WORK(IU) AND COMPUTING
C                    RIGHT SINGULAR VECTORS OF R IN WORK(IR)
C                    (WORKSPACE: NEED 2*N*N+BDSPAC)
C
                     CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ),
     $                            WORK( IR ), LDWRKR, WORK( IU ),
     $                            LDWRKU, DUM, 1, WORK( IWORK ), INFO )
C
C                    MULTIPLY Q IN A BY LEFT SINGULAR VECTORS OF R IN
C                    WORK(IU), STORING RESULT IN U
C                    (WORKSPACE: NEED N*N)
C
                     CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
     $                           WORK( IU ), LDWRKU, ZERO, U, LDU )
C
C                    COPY RIGHT SINGULAR VECTORS OF R TO A
C                    (WORKSPACE: NEED N*N)
C
                     CALL DLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
     $                            LDA )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R, COPYING RESULT TO U
C                    (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
C
C                    GENERATE Q IN U
C                    (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
                     CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    ZERO OUT BELOW R IN A
C
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
     $                            LDA )
C
C                    BIDIAGONALIZE R IN A
C                    (WORKSPACE: NEED 4*N, PREFER 3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY Q IN U BY LEFT VECTORS BIDIAGONALIZING R
C                    (WORKSPACE: NEED 3*N+M, PREFER 3*N+M*NB)
C
                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE RIGHT VECTORS BIDIAGONALIZING R IN A
C                    (WORKSPACE: NEED 4*N-1, PREFER 3*N+(N-1)*NB)
C
                     CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF A IN U AND COMPUTING RIGHT
C                    SINGULAR VECTORS OF A IN A
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), A,
     $                            LDA, U, LDU, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               ELSE IF( WNTVAS ) THEN
C
C                 PATH 6 (M MUCH LARGER THAN N, JOBU='S', JOBVT='S'
C                         OR 'A')
C                 N LEFT SINGULAR VECTORS TO BE COMPUTED IN U AND
C                 N RIGHT SINGULAR VECTORS TO BE COMPUTED IN VT
C
                  IF( LWORK.GE.N*N+MAX( 4*N, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IU = 1
                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
C
C                       WORK(IU) IS LDA BY N
C
                        LDWRKU = LDA
                     ELSE
C
C                       WORK(IU) IS N BY N
C
                        LDWRKU = N
                     END IF
                     ITAU = IU + LDWRKU*N
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R
C                    (WORKSPACE: NEED N*N+2*N, PREFER N*N+N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY R TO WORK(IU), ZEROING OUT BELOW IT
C
                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
     $                            LDWRKU )
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
     $                            WORK( IU+1 ), LDWRKU )
C
C                    GENERATE Q IN A
C                    (WORKSPACE: NEED N*N+2*N, PREFER N*N+N+N*NB)
C
                     CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    BIDIAGONALIZE R IN WORK(IU), COPYING RESULT TO VT
C                    (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
     $                            LDVT )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN WORK(IU)
C                    (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+N*NB)
C
                     CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
     $                            WORK( ITAUQ ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN VT
C                    (WORKSPACE: NEED N*N+4*N-1,
C                                PREFER N*N+3*N+(N-1)*NB)
C
                     CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF R IN WORK(IU) AND COMPUTING
C                    RIGHT SINGULAR VECTORS OF R IN VT
C                    (WORKSPACE: NEED N*N+BDSPAC)
C
                     CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT,
     $                            LDVT, WORK( IU ), LDWRKU, DUM, 1,
     $                            WORK( IWORK ), INFO )
C
C                    MULTIPLY Q IN A BY LEFT SINGULAR VECTORS OF R IN
C                    WORK(IU), STORING RESULT IN U
C                    (WORKSPACE: NEED N*N)
C
                     CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA,
     $                           WORK( IU ), LDWRKU, ZERO, U, LDU )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R, COPYING RESULT TO U
C                    (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
C
C                    GENERATE Q IN U
C                    (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
                     CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY R TO VT, ZEROING OUT BELOW IT
C
                     CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, VT( 2, 1 ),
     $                            LDVT )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    BIDIAGONALIZE R IN VT
C                    (WORKSPACE: NEED 4*N, PREFER 3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY Q IN U BY LEFT BIDIAGONALIZING VECTORS
C                    IN VT
C                    (WORKSPACE: NEED 3*N+M, PREFER 3*N+M*NB)
C
                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN VT
C                    (WORKSPACE: NEED 4*N-1, PREFER 3*N+(N-1)*NB)
C
                     CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF A IN U AND COMPUTING RIGHT
C                    SINGULAR VECTORS OF A IN VT
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT,
     $                            LDVT, U, LDU, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               END IF
C
            ELSE IF( WNTUA ) THEN
C
               IF( WNTVN ) THEN
C
C                 PATH 7 (M MUCH LARGER THAN N, JOBU='A', JOBVT='N')
C                 M LEFT SINGULAR VECTORS TO BE COMPUTED IN U AND
C                 NO RIGHT SINGULAR VECTORS TO BE COMPUTED
C
                  IF( LWORK.GE.N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IR = 1
                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
C
C                       WORK(IR) IS LDA BY N
C
                        LDWRKR = LDA
                     ELSE
C
C                       WORK(IR) IS N BY N
C
                        LDWRKR = N
                     END IF
                     ITAU = IR + LDWRKR*N
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R, COPYING RESULT TO U
C                    (WORKSPACE: NEED N*N+2*N, PREFER N*N+N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
C
C                    COPY R TO WORK(IR), ZEROING OUT BELOW IT
C
                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ),
     $                            LDWRKR )
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
     $                            WORK( IR+1 ), LDWRKR )
C
C                    GENERATE Q IN U
C                    (WORKSPACE: NEED N*N+N+M, PREFER N*N+N+M*NB)
C
                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    BIDIAGONALIZE R IN WORK(IR)
C                    (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN WORK(IR)
C                    (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+N*NB)
C
                     CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR,
     $                            WORK( ITAUQ ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF R IN WORK(IR)
C                    (WORKSPACE: NEED N*N+BDSPAC)
C
                     CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM,
     $                            1, WORK( IR ), LDWRKR, DUM, 1,
     $                            WORK( IWORK ), INFO )
C
C                    MULTIPLY Q IN U BY LEFT SINGULAR VECTORS OF R IN
C                    WORK(IR), STORING RESULT IN A
C                    (WORKSPACE: NEED N*N)
C
                     CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
     $                           WORK( IR ), LDWRKR, ZERO, A, LDA )
C
C                    COPY LEFT SINGULAR VECTORS OF A FROM A TO U
C
                     CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R, COPYING RESULT TO U
C                    (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
C
C                    GENERATE Q IN U
C                    (WORKSPACE: NEED N+M, PREFER N+M*NB)
C
                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    ZERO OUT BELOW R IN A
C
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
     $                            LDA )
C
C                    BIDIAGONALIZE R IN A
C                    (WORKSPACE: NEED 4*N, PREFER 3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY Q IN U BY LEFT BIDIAGONALIZING VECTORS
C                    IN A
C                    (WORKSPACE: NEED 3*N+M, PREFER 3*N+M*NB)
C
                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF A IN U
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', N, 0, M, 0, S, WORK( IE ), DUM,
     $                            1, U, LDU, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               ELSE IF( WNTVO ) THEN
C
C                 PATH 8 (M MUCH LARGER THAN N, JOBU='A', JOBVT='O')
C                 M LEFT SINGULAR VECTORS TO BE COMPUTED IN U AND
C                 N RIGHT SINGULAR VECTORS TO BE OVERWRITTEN ON A
C
                  IF( LWORK.GE.2*N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IU = 1
                     IF( LWORK.GE.WRKBL+2*LDA*N ) THEN
C
C                       WORK(IU) IS LDA BY N AND WORK(IR) IS LDA BY N
C
                        LDWRKU = LDA
                        IR = IU + LDWRKU*N
                        LDWRKR = LDA
                     ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN
C
C                       WORK(IU) IS LDA BY N AND WORK(IR) IS N BY N
C
                        LDWRKU = LDA
                        IR = IU + LDWRKU*N
                        LDWRKR = N
                     ELSE
C
C                       WORK(IU) IS N BY N AND WORK(IR) IS N BY N
C
                        LDWRKU = N
                        IR = IU + LDWRKU*N
                        LDWRKR = N
                     END IF
                     ITAU = IR + LDWRKR*N
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R, COPYING RESULT TO U
C                    (WORKSPACE: NEED 2*N*N+2*N, PREFER 2*N*N+N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
C
C                    GENERATE Q IN U
C                    (WORKSPACE: NEED 2*N*N+N+M, PREFER 2*N*N+N+M*NB)
C
                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY R TO WORK(IU), ZEROING OUT BELOW IT
C
                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
     $                            LDWRKU )
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
     $                            WORK( IU+1 ), LDWRKU )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    BIDIAGONALIZE R IN WORK(IU), COPYING RESULT TO
C                    WORK(IR)
C                    (WORKSPACE: NEED 2*N*N+4*N,
C                                PREFER 2*N*N+3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU,
     $                            WORK( IR ), LDWRKR )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN WORK(IU)
C                    (WORKSPACE: NEED 2*N*N+4*N, PREFER 2*N*N+3*N+N*NB)
C
                     CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
     $                            WORK( ITAUQ ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN WORK(IR)
C                    (WORKSPACE: NEED 2*N*N+4*N-1,
C                                PREFER 2*N*N+3*N+(N-1)*NB)
C
                     CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR,
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF R IN WORK(IU) AND COMPUTING
C                    RIGHT SINGULAR VECTORS OF R IN WORK(IR)
C                    (WORKSPACE: NEED 2*N*N+BDSPAC)
C
                     CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ),
     $                            WORK( IR ), LDWRKR, WORK( IU ),
     $                            LDWRKU, DUM, 1, WORK( IWORK ), INFO )
C
C                    MULTIPLY Q IN U BY LEFT SINGULAR VECTORS OF R IN
C                    WORK(IU), STORING RESULT IN A
C                    (WORKSPACE: NEED N*N)
C
                     CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
     $                           WORK( IU ), LDWRKU, ZERO, A, LDA )
C
C                    COPY LEFT SINGULAR VECTORS OF A FROM A TO U
C
                     CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
C
C                    COPY RIGHT SINGULAR VECTORS OF R FROM WORK(IR) TO A
C
                     CALL DLACPY( 'F', N, N, WORK( IR ), LDWRKR, A,
     $                            LDA )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R, COPYING RESULT TO U
C                    (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
C
C                    GENERATE Q IN U
C                    (WORKSPACE: NEED N+M, PREFER N+M*NB)
C
                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    ZERO OUT BELOW R IN A
C
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ),
     $                            LDA )
C
C                    BIDIAGONALIZE R IN A
C                    (WORKSPACE: NEED 4*N, PREFER 3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, A, LDA, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY Q IN U BY LEFT BIDIAGONALIZING VECTORS
C                    IN A
C                    (WORKSPACE: NEED 3*N+M, PREFER 3*N+M*NB)
C
                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA,
     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN A
C                    (WORKSPACE: NEED 4*N-1, PREFER 3*N+(N-1)*NB)
C
                     CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF A IN U AND COMPUTING RIGHT
C                    SINGULAR VECTORS OF A IN A
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), A,
     $                            LDA, U, LDU, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               ELSE IF( WNTVAS ) THEN
C
C                 PATH 9 (M MUCH LARGER THAN N, JOBU='A', JOBVT='S'
C                         OR 'A')
C                 M LEFT SINGULAR VECTORS TO BE COMPUTED IN U AND
C                 N RIGHT SINGULAR VECTORS TO BE COMPUTED IN VT
C
                  IF( LWORK.GE.N*N+MAX( N+M, 4*N, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IU = 1
                     IF( LWORK.GE.WRKBL+LDA*N ) THEN
C
C                       WORK(IU) IS LDA BY N
C
                        LDWRKU = LDA
                     ELSE
C
C                       WORK(IU) IS N BY N
C
                        LDWRKU = N
                     END IF
                     ITAU = IU + LDWRKU*N
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R, COPYING RESULT TO U
C                    (WORKSPACE: NEED N*N+2*N, PREFER N*N+N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
C
C                    GENERATE Q IN U
C                    (WORKSPACE: NEED N*N+N+M, PREFER N*N+N+M*NB)
C
                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY R TO WORK(IU), ZEROING OUT BELOW IT
C
                     CALL DLACPY( 'U', N, N, A, LDA, WORK( IU ),
     $                            LDWRKU )
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO,
     $                            WORK( IU+1 ), LDWRKU )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    BIDIAGONALIZE R IN WORK(IU), COPYING RESULT TO VT
C                    (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', N, N, WORK( IU ), LDWRKU, VT,
     $                            LDVT )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN WORK(IU)
C                    (WORKSPACE: NEED N*N+4*N, PREFER N*N+3*N+N*NB)
C
                     CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU,
     $                            WORK( ITAUQ ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN VT
C                    (WORKSPACE: NEED N*N+4*N-1,
C                                PREFER N*N+3*N+(N-1)*NB)
C
                     CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF R IN WORK(IU) AND COMPUTING
C                    RIGHT SINGULAR VECTORS OF R IN VT
C                    (WORKSPACE: NEED N*N+BDSPAC)
C
                     CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT,
     $                            LDVT, WORK( IU ), LDWRKU, DUM, 1,
     $                            WORK( IWORK ), INFO )
C
C                    MULTIPLY Q IN U BY LEFT SINGULAR VECTORS OF R IN
C                    WORK(IU), STORING RESULT IN A
C                    (WORKSPACE: NEED N*N)
C
                     CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU,
     $                           WORK( IU ), LDWRKU, ZERO, A, LDA )
C
C                    COPY LEFT SINGULAR VECTORS OF A FROM A TO U
C
                     CALL DLACPY( 'F', M, N, A, LDA, U, LDU )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + N
C
C                    COMPUTE A=Q*R, COPYING RESULT TO U
C                    (WORKSPACE: NEED 2*N, PREFER N+N*NB)
C
                     CALL DGEQRF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
C
C                    GENERATE Q IN U
C                    (WORKSPACE: NEED N+M, PREFER N+M*NB)
C
                     CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY R FROM A TO VT, ZEROING OUT BELOW IT
C
                     CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
                     CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, VT( 2, 1 ),
     $                            LDVT )
                     IE = ITAU
                     ITAUQ = IE + N
                     ITAUP = ITAUQ + N
                     IWORK = ITAUP + N
C
C                    BIDIAGONALIZE R IN VT
C                    (WORKSPACE: NEED 4*N, PREFER 3*N+2*N*NB)
C
                     CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY Q IN U BY LEFT BIDIAGONALIZING VECTORS
C                    IN VT
C                    (WORKSPACE: NEED 3*N+M, PREFER 3*N+M*NB)
C
                     CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT,
     $                            WORK( ITAUQ ), U, LDU, WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN VT
C                    (WORKSPACE: NEED 4*N-1, PREFER 3*N+(N-1)*NB)
C
                     CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + N
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF A IN U AND COMPUTING RIGHT
C                    SINGULAR VECTORS OF A IN VT
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', N, N, M, 0, S, WORK( IE ), VT,
     $                            LDVT, U, LDU, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               END IF
C
            END IF
C
         ELSE
C
C           M .LT. MNTHR
C
C           PATH 10 (M AT LEAST N, BUT NOT MUCH LARGER)
C           REDUCE TO BIDIAGONAL FORM WITHOUT QR DECOMPOSITION
C
            IE = 1
            ITAUQ = IE + N
            ITAUP = ITAUQ + N
            IWORK = ITAUP + N
C
C           BIDIAGONALIZE A
C           (WORKSPACE: NEED 3*N+M, PREFER 3*N+(M+N)*NB)
C
            CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
     $                   WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
     $                   IERR )
            IF( WNTUAS ) THEN
C
C              IF LEFT SINGULAR VECTORS DESIRED IN U, COPY RESULT TO U
C              AND GENERATE LEFT BIDIAGONALIZING VECTORS IN U
C              (WORKSPACE: NEED 3*N+NCU, PREFER 3*N+NCU*NB)
C
               CALL DLACPY( 'L', M, N, A, LDA, U, LDU )
               IF( WNTUS )
     $            NCU = N
               IF( WNTUA )
     $            NCU = M
               CALL DORGBR( 'Q', M, NCU, N, U, LDU, WORK( ITAUQ ),
     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
            END IF
            IF( WNTVAS ) THEN
C
C              IF RIGHT SINGULAR VECTORS DESIRED IN VT, COPY RESULT TO
C              VT AND GENERATE RIGHT BIDIAGONALIZING VECTORS IN VT
C              (WORKSPACE: NEED 4*N-1, PREFER 3*N+(N-1)*NB)
C
               CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT )
               CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ),
     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
            END IF
            IF( WNTUO ) THEN
C
C              IF LEFT SINGULAR VECTORS DESIRED IN A, GENERATE LEFT
C              BIDIAGONALIZING VECTORS IN A
C              (WORKSPACE: NEED 4*N, PREFER 3*N+N*NB)
C
               CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ),
     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
            END IF
            IF( WNTVO ) THEN
C
C              IF RIGHT SINGULAR VECTORS DESIRED IN A, GENERATE RIGHT
C              BIDIAGONALIZING VECTORS IN A
C              (WORKSPACE: NEED 4*N-1, PREFER 3*N+(N-1)*NB)
C
               CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ),
     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
            END IF
            IWORK = IE + N
            IF( WNTUAS .OR. WNTUO )
     $         NRU = M
            IF( WNTUN )
     $         NRU = 0
            IF( WNTVAS .OR. WNTVO )
     $         NCVT = N
            IF( WNTVN )
     $         NCVT = 0
            IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
C
C              PERFORM BIDIAGONAL QR ITERATION, IF DESIRED, COMPUTING
C              LEFT SINGULAR VECTORS IN U AND COMPUTING RIGHT SINGULAR
C              VECTORS IN VT
C              (WORKSPACE: NEED BDSPAC)
C
               CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), VT,
     $                      LDVT, U, LDU, DUM, 1, WORK( IWORK ), INFO )
            ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
C
C              PERFORM BIDIAGONAL QR ITERATION, IF DESIRED, COMPUTING
C              LEFT SINGULAR VECTORS IN U AND COMPUTING RIGHT SINGULAR
C              VECTORS IN A
C              (WORKSPACE: NEED BDSPAC)
C
               CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), A, LDA,
     $                      U, LDU, DUM, 1, WORK( IWORK ), INFO )
            ELSE
C
C              PERFORM BIDIAGONAL QR ITERATION, IF DESIRED, COMPUTING
C              LEFT SINGULAR VECTORS IN A AND COMPUTING RIGHT SINGULAR
C              VECTORS IN VT
C              (WORKSPACE: NEED BDSPAC)
C
               CALL DBDSQR( 'U', N, NCVT, NRU, 0, S, WORK( IE ), VT,
     $                      LDVT, A, LDA, DUM, 1, WORK( IWORK ), INFO )
            END IF
C
         END IF
C
      ELSE
C
C        A HAS MORE COLUMNS THAN ROWS. IF A HAS SUFFICIENTLY MORE
C        COLUMNS THAN ROWS, FIRST REDUCE USING THE LQ DECOMPOSITION (IF
C        SUFFICIENT WORKSPACE AVAILABLE)
C
         IF( N.GE.MNTHR ) THEN
C
            IF( WNTVN ) THEN
C
C              PATH 1T(N MUCH LARGER THAN M, JOBVT='N')
C              NO RIGHT SINGULAR VECTORS TO BE COMPUTED
C
               ITAU = 1
               IWORK = ITAU + M
C
C              COMPUTE A=L*Q
C              (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
               CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ),
     $                      LWORK-IWORK+1, IERR )
C
C              ZERO OUT ABOVE L
C
               CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ), LDA )
               IE = 1
               ITAUQ = IE + M
               ITAUP = ITAUQ + M
               IWORK = ITAUP + M
C
C              BIDIAGONALIZE L IN A
C              (WORKSPACE: NEED 4*M, PREFER 3*M+2*M*NB)
C
               CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
     $                      WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
     $                      IERR )
               IF( WNTUO .OR. WNTUAS ) THEN
C
C                 IF LEFT SINGULAR VECTORS DESIRED, GENERATE Q
C                 (WORKSPACE: NEED 4*M, PREFER 3*M+M*NB)
C
                  CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
               END IF
               IWORK = IE + M
               NRU = 0
               IF( WNTUO .OR. WNTUAS )
     $            NRU = M
C
C              PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT SINGULAR
C              VECTORS OF A IN A IF DESIRED
C              (WORKSPACE: NEED BDSPAC)
C
               CALL DBDSQR( 'U', M, 0, NRU, 0, S, WORK( IE ), DUM, 1, A,
     $                      LDA, DUM, 1, WORK( IWORK ), INFO )
C
C              IF LEFT SINGULAR VECTORS DESIRED IN U, COPY THEM THERE
C
               IF( WNTUAS )
     $            CALL DLACPY( 'F', M, M, A, LDA, U, LDU )
C
            ELSE IF( WNTVO .AND. WNTUN ) THEN
C
C              PATH 2T(N MUCH LARGER THAN M, JOBU='N', JOBVT='O')
C              M RIGHT SINGULAR VECTORS TO BE OVERWRITTEN ON A AND
C              NO LEFT SINGULAR VECTORS TO BE COMPUTED
C
               IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
C
C                 SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                  IR = 1
                  IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN
C
C                    WORK(IU) IS LDA BY N AND WORK(IR) IS LDA BY M
C
                     LDWRKU = LDA
                     CHUNK = N
                     LDWRKR = LDA
                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN
C
C                    WORK(IU) IS LDA BY N AND WORK(IR) IS M BY M
C
                     LDWRKU = LDA
                     CHUNK = N
                     LDWRKR = M
                  ELSE
C
C                    WORK(IU) IS M BY CHUNK AND WORK(IR) IS M BY M
C
                     LDWRKU = M
                     CHUNK = ( LWORK-M*M-M ) / M
                     LDWRKR = M
                  END IF
                  ITAU = IR + LDWRKR*M
                  IWORK = ITAU + M
C
C                 COMPUTE A=L*Q
C                 (WORKSPACE: NEED M*M+2*M, PREFER M*M+M+M*NB)
C
                  CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 COPY L TO WORK(IR) AND ZERO OUT ABOVE IT
C
                  CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ), LDWRKR )
                  CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
     $                         WORK( IR+LDWRKR ), LDWRKR )
C
C                 GENERATE Q IN A
C                 (WORKSPACE: NEED M*M+2*M, PREFER M*M+M+M*NB)
C
                  CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IE = ITAU
                  ITAUQ = IE + M
                  ITAUP = ITAUQ + M
                  IWORK = ITAUP + M
C
C                 BIDIAGONALIZE L IN WORK(IR)
C                 (WORKSPACE: NEED M*M+4*M, PREFER M*M+3*M+2*M*NB)
C
                  CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, WORK( IE ),
     $                         WORK( ITAUQ ), WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 GENERATE RIGHT VECTORS BIDIAGONALIZING L
C                 (WORKSPACE: NEED M*M+4*M-1, PREFER M*M+3*M+(M-1)*NB)
C
                  CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
     $                         WORK( ITAUP ), WORK( IWORK ),
     $                         LWORK-IWORK+1, IERR )
                  IWORK = IE + M
C
C                 PERFORM BIDIAGONAL QR ITERATION, COMPUTING RIGHT
C                 SINGULAR VECTORS OF L IN WORK(IR)
C                 (WORKSPACE: NEED M*M+BDSPAC)
C
                  CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
     $                         WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
     $                         WORK( IWORK ), INFO )
                  IU = IE + M
C
C                 MULTIPLY RIGHT SINGULAR VECTORS OF L IN WORK(IR) BY Q
C                 IN A, STORING RESULT IN WORK(IU) AND COPYING TO A
C                 (WORKSPACE: NEED M*M+2*M, PREFER M*M+M*N+M)
C
                  DO 30 I = 1, N, CHUNK
                     BLK = MIN( N-I+1, CHUNK )
                     CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ),
     $                           LDWRKR, A( 1, I ), LDA, ZERO,
     $                           WORK( IU ), LDWRKU )
                     CALL DLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
     $                            A( 1, I ), LDA )
   30             CONTINUE
C
               ELSE
C
C                 INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                  IE = 1
                  ITAUQ = IE + M
                  ITAUP = ITAUQ + M
                  IWORK = ITAUP + M
C
C                 BIDIAGONALIZE A
C                 (WORKSPACE: NEED 3*M+N, PREFER 3*M+(M+N)*NB)
C
                  CALL DGEBRD( M, N, A, LDA, S, WORK( IE ),
     $                         WORK( ITAUQ ), WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 GENERATE RIGHT VECTORS BIDIAGONALIZING A
C                 (WORKSPACE: NEED 4*M, PREFER 3*M+M*NB)
C
                  CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IWORK = IE + M
C
C                 PERFORM BIDIAGONAL QR ITERATION, COMPUTING RIGHT
C                 SINGULAR VECTORS OF A IN A
C                 (WORKSPACE: NEED BDSPAC)
C
                  CALL DBDSQR( 'L', M, N, 0, 0, S, WORK( IE ), A, LDA,
     $                         DUM, 1, DUM, 1, WORK( IWORK ), INFO )
C
               END IF
C
            ELSE IF( WNTVO .AND. WNTUAS ) THEN
C
C              PATH 3T(N MUCH LARGER THAN M, JOBU='S' OR 'A', JOBVT='O')
C              M RIGHT SINGULAR VECTORS TO BE OVERWRITTEN ON A AND
C              M LEFT SINGULAR VECTORS TO BE COMPUTED IN U
C
               IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
C
C                 SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                  IR = 1
                  IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN
C
C                    WORK(IU) IS LDA BY N AND WORK(IR) IS LDA BY M
C
                     LDWRKU = LDA
                     CHUNK = N
                     LDWRKR = LDA
                  ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN
C
C                    WORK(IU) IS LDA BY N AND WORK(IR) IS M BY M
C
                     LDWRKU = LDA
                     CHUNK = N
                     LDWRKR = M
                  ELSE
C
C                    WORK(IU) IS M BY CHUNK AND WORK(IR) IS M BY M
C
                     LDWRKU = M
                     CHUNK = ( LWORK-M*M-M ) / M
                     LDWRKR = M
                  END IF
                  ITAU = IR + LDWRKR*M
                  IWORK = ITAU + M
C
C                 COMPUTE A=L*Q
C                 (WORKSPACE: NEED M*M+2*M, PREFER M*M+M+M*NB)
C
                  CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 COPY L TO U, ZEROING ABOUT ABOVE IT
C
                  CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
                  CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
     $                         LDU )
C
C                 GENERATE Q IN A
C                 (WORKSPACE: NEED M*M+2*M, PREFER M*M+M+M*NB)
C
                  CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IE = ITAU
                  ITAUQ = IE + M
                  ITAUP = ITAUQ + M
                  IWORK = ITAUP + M
C
C                 BIDIAGONALIZE L IN U, COPYING RESULT TO WORK(IR)
C                 (WORKSPACE: NEED M*M+4*M, PREFER M*M+3*M+2*M*NB)
C
                  CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
     $                         WORK( ITAUQ ), WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  CALL DLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR )
C
C                 GENERATE RIGHT VECTORS BIDIAGONALIZING L IN WORK(IR)
C                 (WORKSPACE: NEED M*M+4*M-1, PREFER M*M+3*M+(M-1)*NB)
C
                  CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
     $                         WORK( ITAUP ), WORK( IWORK ),
     $                         LWORK-IWORK+1, IERR )
C
C                 GENERATE LEFT VECTORS BIDIAGONALIZING L IN U
C                 (WORKSPACE: NEED M*M+4*M, PREFER M*M+3*M+M*NB)
C
                  CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IWORK = IE + M
C
C                 PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                 SINGULAR VECTORS OF L IN U, AND COMPUTING RIGHT
C                 SINGULAR VECTORS OF L IN WORK(IR)
C                 (WORKSPACE: NEED M*M+BDSPAC)
C
                  CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
     $                         WORK( IR ), LDWRKR, U, LDU, DUM, 1,
     $                         WORK( IWORK ), INFO )
                  IU = IE + M
C
C                 MULTIPLY RIGHT SINGULAR VECTORS OF L IN WORK(IR) BY Q
C                 IN A, STORING RESULT IN WORK(IU) AND COPYING TO A
C                 (WORKSPACE: NEED M*M+2*M, PREFER M*M+M*N+M))
C
                  DO 40 I = 1, N, CHUNK
                     BLK = MIN( N-I+1, CHUNK )
                     CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IR ),
     $                           LDWRKR, A( 1, I ), LDA, ZERO,
     $                           WORK( IU ), LDWRKU )
                     CALL DLACPY( 'F', M, BLK, WORK( IU ), LDWRKU,
     $                            A( 1, I ), LDA )
   40             CONTINUE
C
               ELSE
C
C                 INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                  ITAU = 1
                  IWORK = ITAU + M
C
C                 COMPUTE A=L*Q
C                 (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
                  CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 COPY L TO U, ZEROING OUT ABOVE IT
C
                  CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
                  CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
     $                         LDU )
C
C                 GENERATE Q IN A
C                 (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
                  CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IE = ITAU
                  ITAUQ = IE + M
                  ITAUP = ITAUQ + M
                  IWORK = ITAUP + M
C
C                 BIDIAGONALIZE L IN U
C                 (WORKSPACE: NEED 4*M, PREFER 3*M+2*M*NB)
C
                  CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
     $                         WORK( ITAUQ ), WORK( ITAUP ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                 MULTIPLY RIGHT VECTORS BIDIAGONALIZING L BY Q IN A
C                 (WORKSPACE: NEED 3*M+N, PREFER 3*M+N*NB)
C
                  CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
     $                         WORK( ITAUP ), A, LDA, WORK( IWORK ),
     $                         LWORK-IWORK+1, IERR )
C
C                 GENERATE LEFT VECTORS BIDIAGONALIZING L IN U
C                 (WORKSPACE: NEED 4*M, PREFER 3*M+M*NB)
C
                  CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
     $                         WORK( IWORK ), LWORK-IWORK+1, IERR )
                  IWORK = IE + M
C
C                 PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                 SINGULAR VECTORS OF A IN U AND COMPUTING RIGHT
C                 SINGULAR VECTORS OF A IN A
C                 (WORKSPACE: NEED BDSPAC)
C
                  CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), A, LDA,
     $                         U, LDU, DUM, 1, WORK( IWORK ), INFO )
C
               END IF
C
            ELSE IF( WNTVS ) THEN
C
               IF( WNTUN ) THEN
C
C                 PATH 4T(N MUCH LARGER THAN M, JOBU='N', JOBVT='S')
C                 M RIGHT SINGULAR VECTORS TO BE COMPUTED IN VT AND
C                 NO LEFT SINGULAR VECTORS TO BE COMPUTED
C
                  IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IR = 1
                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
C
C                       WORK(IR) IS LDA BY M
C
                        LDWRKR = LDA
                     ELSE
C
C                       WORK(IR) IS M BY M
C
                        LDWRKR = M
                     END IF
                     ITAU = IR + LDWRKR*M
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q
C                    (WORKSPACE: NEED M*M+2*M, PREFER M*M+M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY L TO WORK(IR), ZEROING OUT ABOVE IT
C
                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ),
     $                            LDWRKR )
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
     $                            WORK( IR+LDWRKR ), LDWRKR )
C
C                    GENERATE Q IN A
C                    (WORKSPACE: NEED M*M+2*M, PREFER M*M+M+M*NB)
C
                     CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    BIDIAGONALIZE L IN WORK(IR)
C                    (WORKSPACE: NEED M*M+4*M, PREFER M*M+3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE RIGHT VECTORS BIDIAGONALIZING L IN
C                    WORK(IR)
C                    (WORKSPACE: NEED M*M+4*M, PREFER M*M+3*M+(M-1)*NB)
C
                     CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING RIGHT
C                    SINGULAR VECTORS OF L IN WORK(IR)
C                    (WORKSPACE: NEED M*M+BDSPAC)
C
                     CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
     $                            WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
     $                            WORK( IWORK ), INFO )
C
C                    MULTIPLY RIGHT SINGULAR VECTORS OF L IN WORK(IR) BY
C                    Q IN A, STORING RESULT IN VT
C                    (WORKSPACE: NEED M*M)
C
                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IR ),
     $                           LDWRKR, A, LDA, ZERO, VT, LDVT )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q
C                    (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY RESULT TO VT
C
                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
C
C                    GENERATE Q IN VT
C                    (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
                     CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    ZERO OUT ABOVE L IN A
C
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
     $                            LDA )
C
C                    BIDIAGONALIZE L IN A
C                    (WORKSPACE: NEED 4*M, PREFER 3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY RIGHT VECTORS BIDIAGONALIZING L BY Q IN VT
C                    (WORKSPACE: NEED 3*M+N, PREFER 3*M+N*NB)
C
                     CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
     $                            WORK( ITAUP ), VT, LDVT,
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING RIGHT
C                    SINGULAR VECTORS OF A IN VT
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', M, N, 0, 0, S, WORK( IE ), VT,
     $                            LDVT, DUM, 1, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               ELSE IF( WNTUO ) THEN
C
C                 PATH 5T(N MUCH LARGER THAN M, JOBU='O', JOBVT='S')
C                 M RIGHT SINGULAR VECTORS TO BE COMPUTED IN VT AND
C                 M LEFT SINGULAR VECTORS TO BE OVERWRITTEN ON A
C
                  IF( LWORK.GE.2*M*M+MAX( 4*M, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IU = 1
                     IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
C
C                       WORK(IU) IS LDA BY M AND WORK(IR) IS LDA BY M
C
                        LDWRKU = LDA
                        IR = IU + LDWRKU*M
                        LDWRKR = LDA
                     ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
C
C                       WORK(IU) IS LDA BY M AND WORK(IR) IS M BY M
C
                        LDWRKU = LDA
                        IR = IU + LDWRKU*M
                        LDWRKR = M
                     ELSE
C
C                       WORK(IU) IS M BY M AND WORK(IR) IS M BY M
C
                        LDWRKU = M
                        IR = IU + LDWRKU*M
                        LDWRKR = M
                     END IF
                     ITAU = IR + LDWRKR*M
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q
C                    (WORKSPACE: NEED 2*M*M+2*M, PREFER 2*M*M+M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY L TO WORK(IU), ZEROING OUT BELOW IT
C
                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
     $                            LDWRKU )
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
     $                            WORK( IU+LDWRKU ), LDWRKU )
C
C                    GENERATE Q IN A
C                    (WORKSPACE: NEED 2*M*M+2*M, PREFER 2*M*M+M+M*NB)
C
                     CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    BIDIAGONALIZE L IN WORK(IU), COPYING RESULT TO
C                    WORK(IR)
C                    (WORKSPACE: NEED 2*M*M+4*M,
C                                PREFER 2*M*M+3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU,
     $                            WORK( IR ), LDWRKR )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN WORK(IU)
C                    (WORKSPACE: NEED 2*M*M+4*M-1,
C                                PREFER 2*M*M+3*M+(M-1)*NB)
C
                     CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN WORK(IR)
C                    (WORKSPACE: NEED 2*M*M+4*M, PREFER 2*M*M+3*M+M*NB)
C
                     CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
     $                            WORK( ITAUQ ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF L IN WORK(IR) AND COMPUTING
C                    RIGHT SINGULAR VECTORS OF L IN WORK(IU)
C                    (WORKSPACE: NEED 2*M*M+BDSPAC)
C
                     CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
     $                            WORK( IU ), LDWRKU, WORK( IR ),
     $                            LDWRKR, DUM, 1, WORK( IWORK ), INFO )
C
C                    MULTIPLY RIGHT SINGULAR VECTORS OF L IN WORK(IU) BY
C                    Q IN A, STORING RESULT IN VT
C                    (WORKSPACE: NEED M*M)
C
                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
     $                           LDWRKU, A, LDA, ZERO, VT, LDVT )
C
C                    COPY LEFT SINGULAR VECTORS OF L TO A
C                    (WORKSPACE: NEED M*M)
C
                     CALL DLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
     $                            LDA )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q, COPYING RESULT TO VT
C                    (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
C
C                    GENERATE Q IN VT
C                    (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
                     CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    ZERO OUT ABOVE L IN A
C
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
     $                            LDA )
C
C                    BIDIAGONALIZE L IN A
C                    (WORKSPACE: NEED 4*M, PREFER 3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY RIGHT VECTORS BIDIAGONALIZING L BY Q IN VT
C                    (WORKSPACE: NEED 3*M+N, PREFER 3*M+N*NB)
C
                     CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
     $                            WORK( ITAUP ), VT, LDVT,
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS OF L IN A
C                    (WORKSPACE: NEED 4*M, PREFER 3*M+M*NB)
C
                     CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTE LEFT
C                    SINGULAR VECTORS OF A IN A AND COMPUTE RIGHT
C                    SINGULAR VECTORS OF A IN VT
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
     $                            LDVT, A, LDA, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               ELSE IF( WNTUAS ) THEN
C
C                 PATH 6T(N MUCH LARGER THAN M, JOBU='S' OR 'A',
C                         JOBVT='S')
C                 M RIGHT SINGULAR VECTORS TO BE COMPUTED IN VT AND
C                 M LEFT SINGULAR VECTORS TO BE COMPUTED IN U
C
                  IF( LWORK.GE.M*M+MAX( 4*M, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IU = 1
                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
C
C                       WORK(IU) IS LDA BY N
C
                        LDWRKU = LDA
                     ELSE
C
C                       WORK(IU) IS LDA BY M
C
                        LDWRKU = M
                     END IF
                     ITAU = IU + LDWRKU*M
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q
C                    (WORKSPACE: NEED M*M+2*M, PREFER M*M+M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY L TO WORK(IU), ZEROING OUT ABOVE IT
C
                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
     $                            LDWRKU )
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
     $                            WORK( IU+LDWRKU ), LDWRKU )
C
C                    GENERATE Q IN A
C                    (WORKSPACE: NEED M*M+2*M, PREFER M*M+M+M*NB)
C
                     CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    BIDIAGONALIZE L IN WORK(IU), COPYING RESULT TO U
C                    (WORKSPACE: NEED M*M+4*M, PREFER M*M+3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
     $                            LDU )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN WORK(IU)
C                    (WORKSPACE: NEED M*M+4*M-1,
C                                PREFER M*M+3*M+(M-1)*NB)
C
                     CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN U
C                    (WORKSPACE: NEED M*M+4*M, PREFER M*M+3*M+M*NB)
C
                     CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF L IN U AND COMPUTING RIGHT
C                    SINGULAR VECTORS OF L IN WORK(IU)
C                    (WORKSPACE: NEED M*M+BDSPAC)
C
                     CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
     $                            WORK( IU ), LDWRKU, U, LDU, DUM, 1,
     $                            WORK( IWORK ), INFO )
C
C                    MULTIPLY RIGHT SINGULAR VECTORS OF L IN WORK(IU) BY
C                    Q IN A, STORING RESULT IN VT
C                    (WORKSPACE: NEED M*M)
C
                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
     $                           LDWRKU, A, LDA, ZERO, VT, LDVT )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q, COPYING RESULT TO VT
C                    (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
C
C                    GENERATE Q IN VT
C                    (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
                     CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY L TO U, ZEROING OUT ABOVE IT
C
                     CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
     $                            LDU )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    BIDIAGONALIZE L IN U
C                    (WORKSPACE: NEED 4*M, PREFER 3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY RIGHT BIDIAGONALIZING VECTORS IN U BY Q
C                    IN VT
C                    (WORKSPACE: NEED 3*M+N, PREFER 3*M+N*NB)
C
                     CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
     $                            WORK( ITAUP ), VT, LDVT,
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN U
C                    (WORKSPACE: NEED 4*M, PREFER 3*M+M*NB)
C
                     CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF A IN U AND COMPUTING RIGHT
C                    SINGULAR VECTORS OF A IN VT
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
     $                            LDVT, U, LDU, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               END IF
C
            ELSE IF( WNTVA ) THEN
C
               IF( WNTUN ) THEN
C
C                 PATH 7T(N MUCH LARGER THAN M, JOBU='N', JOBVT='A')
C                 N RIGHT SINGULAR VECTORS TO BE COMPUTED IN VT AND
C                 NO LEFT SINGULAR VECTORS TO BE COMPUTED
C
                  IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IR = 1
                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
C
C                       WORK(IR) IS LDA BY M
C
                        LDWRKR = LDA
                     ELSE
C
C                       WORK(IR) IS M BY M
C
                        LDWRKR = M
                     END IF
                     ITAU = IR + LDWRKR*M
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q, COPYING RESULT TO VT
C                    (WORKSPACE: NEED M*M+2*M, PREFER M*M+M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
C
C                    COPY L TO WORK(IR), ZEROING OUT ABOVE IT
C
                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IR ),
     $                            LDWRKR )
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
     $                            WORK( IR+LDWRKR ), LDWRKR )
C
C                    GENERATE Q IN VT
C                    (WORKSPACE: NEED M*M+M+N, PREFER M*M+M+N*NB)
C
                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    BIDIAGONALIZE L IN WORK(IR)
C                    (WORKSPACE: NEED M*M+4*M, PREFER M*M+3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN WORK(IR)
C                    (WORKSPACE: NEED M*M+4*M-1,
C                                PREFER M*M+3*M+(M-1)*NB)
C
                     CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR,
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING RIGHT
C                    SINGULAR VECTORS OF L IN WORK(IR)
C                    (WORKSPACE: NEED M*M+BDSPAC)
C
                     CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ),
     $                            WORK( IR ), LDWRKR, DUM, 1, DUM, 1,
     $                            WORK( IWORK ), INFO )
C
C                    MULTIPLY RIGHT SINGULAR VECTORS OF L IN WORK(IR) BY
C                    Q IN VT, STORING RESULT IN A
C                    (WORKSPACE: NEED M*M)
C
                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IR ),
     $                           LDWRKR, VT, LDVT, ZERO, A, LDA )
C
C                    COPY RIGHT SINGULAR VECTORS OF A FROM A TO VT
C
                     CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q, COPYING RESULT TO VT
C                    (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
C
C                    GENERATE Q IN VT
C                    (WORKSPACE: NEED M+N, PREFER M+N*NB)
C
                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    ZERO OUT ABOVE L IN A
C
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
     $                            LDA )
C
C                    BIDIAGONALIZE L IN A
C                    (WORKSPACE: NEED 4*M, PREFER 3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY RIGHT BIDIAGONALIZING VECTORS IN A BY Q
C                    IN VT
C                    (WORKSPACE: NEED 3*M+N, PREFER 3*M+N*NB)
C
                     CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
     $                            WORK( ITAUP ), VT, LDVT,
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING RIGHT
C                    SINGULAR VECTORS OF A IN VT
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', M, N, 0, 0, S, WORK( IE ), VT,
     $                            LDVT, DUM, 1, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               ELSE IF( WNTUO ) THEN
C
C                 PATH 8T(N MUCH LARGER THAN M, JOBU='O', JOBVT='A')
C                 N RIGHT SINGULAR VECTORS TO BE COMPUTED IN VT AND
C                 M LEFT SINGULAR VECTORS TO BE OVERWRITTEN ON A
C
                  IF( LWORK.GE.2*M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IU = 1
                     IF( LWORK.GE.WRKBL+2*LDA*M ) THEN
C
C                       WORK(IU) IS LDA BY M AND WORK(IR) IS LDA BY M
C
                        LDWRKU = LDA
                        IR = IU + LDWRKU*M
                        LDWRKR = LDA
                     ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN
C
C                       WORK(IU) IS LDA BY M AND WORK(IR) IS M BY M
C
                        LDWRKU = LDA
                        IR = IU + LDWRKU*M
                        LDWRKR = M
                     ELSE
C
C                       WORK(IU) IS M BY M AND WORK(IR) IS M BY M
C
                        LDWRKU = M
                        IR = IU + LDWRKU*M
                        LDWRKR = M
                     END IF
                     ITAU = IR + LDWRKR*M
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q, COPYING RESULT TO VT
C                    (WORKSPACE: NEED 2*M*M+2*M, PREFER 2*M*M+M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
C
C                    GENERATE Q IN VT
C                    (WORKSPACE: NEED 2*M*M+M+N, PREFER 2*M*M+M+N*NB)
C
                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY L TO WORK(IU), ZEROING OUT ABOVE IT
C
                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
     $                            LDWRKU )
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
     $                            WORK( IU+LDWRKU ), LDWRKU )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    BIDIAGONALIZE L IN WORK(IU), COPYING RESULT TO
C                    WORK(IR)
C                    (WORKSPACE: NEED 2*M*M+4*M,
C                                PREFER 2*M*M+3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU,
     $                            WORK( IR ), LDWRKR )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN WORK(IU)
C                    (WORKSPACE: NEED 2*M*M+4*M-1,
C                                PREFER 2*M*M+3*M+(M-1)*NB)
C
                     CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN WORK(IR)
C                    (WORKSPACE: NEED 2*M*M+4*M, PREFER 2*M*M+3*M+M*NB)
C
                     CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR,
     $                            WORK( ITAUQ ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF L IN WORK(IR) AND COMPUTING
C                    RIGHT SINGULAR VECTORS OF L IN WORK(IU)
C                    (WORKSPACE: NEED 2*M*M+BDSPAC)
C
                     CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
     $                            WORK( IU ), LDWRKU, WORK( IR ),
     $                            LDWRKR, DUM, 1, WORK( IWORK ), INFO )
C
C                    MULTIPLY RIGHT SINGULAR VECTORS OF L IN WORK(IU) BY
C                    Q IN VT, STORING RESULT IN A
C                    (WORKSPACE: NEED M*M)
C
                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
     $                           LDWRKU, VT, LDVT, ZERO, A, LDA )
C
C                    COPY RIGHT SINGULAR VECTORS OF A FROM A TO VT
C
                     CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
C
C                    COPY LEFT SINGULAR VECTORS OF A FROM WORK(IR) TO A
C
                     CALL DLACPY( 'F', M, M, WORK( IR ), LDWRKR, A,
     $                            LDA )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q, COPYING RESULT TO VT
C                    (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
C
C                    GENERATE Q IN VT
C                    (WORKSPACE: NEED M+N, PREFER M+N*NB)
C
                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    ZERO OUT ABOVE L IN A
C
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, A( 1, 2 ),
     $                            LDA )
C
C                    BIDIAGONALIZE L IN A
C                    (WORKSPACE: NEED 4*M, PREFER 3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, A, LDA, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY RIGHT BIDIAGONALIZING VECTORS IN A BY Q
C                    IN VT
C                    (WORKSPACE: NEED 3*M+N, PREFER 3*M+N*NB)
C
                     CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA,
     $                            WORK( ITAUP ), VT, LDVT,
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN A
C                    (WORKSPACE: NEED 4*M, PREFER 3*M+M*NB)
C
                     CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF A IN A AND COMPUTING RIGHT
C                    SINGULAR VECTORS OF A IN VT
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
     $                            LDVT, A, LDA, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               ELSE IF( WNTUAS ) THEN
C
C                 PATH 9T(N MUCH LARGER THAN M, JOBU='S' OR 'A',
C                         JOBVT='A')
C                 N RIGHT SINGULAR VECTORS TO BE COMPUTED IN VT AND
C                 M LEFT SINGULAR VECTORS TO BE COMPUTED IN U
C
                  IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN
C
C                    SUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     IU = 1
                     IF( LWORK.GE.WRKBL+LDA*M ) THEN
C
C                       WORK(IU) IS LDA BY M
C
                        LDWRKU = LDA
                     ELSE
C
C                       WORK(IU) IS M BY M
C
                        LDWRKU = M
                     END IF
                     ITAU = IU + LDWRKU*M
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q, COPYING RESULT TO VT
C                    (WORKSPACE: NEED M*M+2*M, PREFER M*M+M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
C
C                    GENERATE Q IN VT
C                    (WORKSPACE: NEED M*M+M+N, PREFER M*M+M+N*NB)
C
                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY L TO WORK(IU), ZEROING OUT ABOVE IT
C
                     CALL DLACPY( 'L', M, M, A, LDA, WORK( IU ),
     $                            LDWRKU )
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO,
     $                            WORK( IU+LDWRKU ), LDWRKU )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    BIDIAGONALIZE L IN WORK(IU), COPYING RESULT TO U
C                    (WORKSPACE: NEED M*M+4*M, PREFER M*M+3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S,
     $                            WORK( IE ), WORK( ITAUQ ),
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'L', M, M, WORK( IU ), LDWRKU, U,
     $                            LDU )
C
C                    GENERATE RIGHT BIDIAGONALIZING VECTORS IN WORK(IU)
C                    (WORKSPACE: NEED M*M+4*M, PREFER M*M+3*M+(M-1)*NB)
C
                     CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU,
     $                            WORK( ITAUP ), WORK( IWORK ),
     $                            LWORK-IWORK+1, IERR )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN U
C                    (WORKSPACE: NEED M*M+4*M, PREFER M*M+3*M+M*NB)
C
                     CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF L IN U AND COMPUTING RIGHT
C                    SINGULAR VECTORS OF L IN WORK(IU)
C                    (WORKSPACE: NEED M*M+BDSPAC)
C
                     CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ),
     $                            WORK( IU ), LDWRKU, U, LDU, DUM, 1,
     $                            WORK( IWORK ), INFO )
C
C                    MULTIPLY RIGHT SINGULAR VECTORS OF L IN WORK(IU) BY
C                    Q IN VT, STORING RESULT IN A
C                    (WORKSPACE: NEED M*M)
C
                     CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IU ),
     $                           LDWRKU, VT, LDVT, ZERO, A, LDA )
C
C                    COPY RIGHT SINGULAR VECTORS OF A FROM A TO VT
C
                     CALL DLACPY( 'F', M, N, A, LDA, VT, LDVT )
C
                  ELSE
C
C                    INSUFFICIENT WORKSPACE FOR A FAST ALGORITHM
C
                     ITAU = 1
                     IWORK = ITAU + M
C
C                    COMPUTE A=L*Q, COPYING RESULT TO VT
C                    (WORKSPACE: NEED 2*M, PREFER M+M*NB)
C
                     CALL DGELQF( M, N, A, LDA, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
C
C                    GENERATE Q IN VT
C                    (WORKSPACE: NEED M+N, PREFER M+N*NB)
C
                     CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    COPY L TO U, ZEROING OUT ABOVE IT
C
                     CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
                     CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, U( 1, 2 ),
     $                            LDU )
                     IE = ITAU
                     ITAUQ = IE + M
                     ITAUP = ITAUQ + M
                     IWORK = ITAUP + M
C
C                    BIDIAGONALIZE L IN U
C                    (WORKSPACE: NEED 4*M, PREFER 3*M+2*M*NB)
C
                     CALL DGEBRD( M, M, U, LDU, S, WORK( IE ),
     $                            WORK( ITAUQ ), WORK( ITAUP ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    MULTIPLY RIGHT BIDIAGONALIZING VECTORS IN U BY Q
C                    IN VT
C                    (WORKSPACE: NEED 3*M+N, PREFER 3*M+N*NB)
C
                     CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU,
     $                            WORK( ITAUP ), VT, LDVT,
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
C
C                    GENERATE LEFT BIDIAGONALIZING VECTORS IN U
C                    (WORKSPACE: NEED 4*M, PREFER 3*M+M*NB)
C
                     CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ),
     $                            WORK( IWORK ), LWORK-IWORK+1, IERR )
                     IWORK = IE + M
C
C                    PERFORM BIDIAGONAL QR ITERATION, COMPUTING LEFT
C                    SINGULAR VECTORS OF A IN U AND COMPUTING RIGHT
C                    SINGULAR VECTORS OF A IN VT
C                    (WORKSPACE: NEED BDSPAC)
C
                     CALL DBDSQR( 'U', M, N, M, 0, S, WORK( IE ), VT,
     $                            LDVT, U, LDU, DUM, 1, WORK( IWORK ),
     $                            INFO )
C
                  END IF
C
               END IF
C
            END IF
C
         ELSE
C
C           N .LT. MNTHR
C
C           PATH 10T(N GREATER THAN M, BUT NOT MUCH LARGER)
C           REDUCE TO BIDIAGONAL FORM WITHOUT LQ DECOMPOSITION
C
            IE = 1
            ITAUQ = IE + M
            ITAUP = ITAUQ + M
            IWORK = ITAUP + M
C
C           BIDIAGONALIZE A
C           (WORKSPACE: NEED 3*M+N, PREFER 3*M+(M+N)*NB)
C
            CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ),
     $                   WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1,
     $                   IERR )
            IF( WNTUAS ) THEN
C
C              IF LEFT SINGULAR VECTORS DESIRED IN U, COPY RESULT TO U
C              AND GENERATE LEFT BIDIAGONALIZING VECTORS IN U
C              (WORKSPACE: NEED 4*M-1, PREFER 3*M+(M-1)*NB)
C
               CALL DLACPY( 'L', M, M, A, LDA, U, LDU )
               CALL DORGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ),
     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
            END IF
            IF( WNTVAS ) THEN
C
C              IF RIGHT SINGULAR VECTORS DESIRED IN VT, COPY RESULT TO
C              VT AND GENERATE RIGHT BIDIAGONALIZING VECTORS IN VT
C              (WORKSPACE: NEED 3*M+NRVT, PREFER 3*M+NRVT*NB)
C
               CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT )
               IF( WNTVA )
     $            NRVT = N
               IF( WNTVS )
     $            NRVT = M
               CALL DORGBR( 'P', NRVT, N, M, VT, LDVT, WORK( ITAUP ),
     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
            END IF
            IF( WNTUO ) THEN
C
C              IF LEFT SINGULAR VECTORS DESIRED IN A, GENERATE LEFT
C              BIDIAGONALIZING VECTORS IN A
C              (WORKSPACE: NEED 4*M-1, PREFER 3*M+(M-1)*NB)
C
               CALL DORGBR( 'Q', M, M, N, A, LDA, WORK( ITAUQ ),
     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
            END IF
            IF( WNTVO ) THEN
C
C              IF RIGHT SINGULAR VECTORS DESIRED IN A, GENERATE RIGHT
C              BIDIAGONALIZING VECTORS IN A
C              (WORKSPACE: NEED 4*M, PREFER 3*M+M*NB)
C
               CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ),
     $                      WORK( IWORK ), LWORK-IWORK+1, IERR )
            END IF
            IWORK = IE + M
            IF( WNTUAS .OR. WNTUO )
     $         NRU = M
            IF( WNTUN )
     $         NRU = 0
            IF( WNTVAS .OR. WNTVO )
     $         NCVT = N
            IF( WNTVN )
     $         NCVT = 0
            IF( ( .NOT.WNTUO ) .AND. ( .NOT.WNTVO ) ) THEN
C
C              PERFORM BIDIAGONAL QR ITERATION, IF DESIRED, COMPUTING
C              LEFT SINGULAR VECTORS IN U AND COMPUTING RIGHT SINGULAR
C              VECTORS IN VT
C              (WORKSPACE: NEED BDSPAC)
C
               CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), VT,
     $                      LDVT, U, LDU, DUM, 1, WORK( IWORK ), INFO )
            ELSE IF( ( .NOT.WNTUO ) .AND. WNTVO ) THEN
C
C              PERFORM BIDIAGONAL QR ITERATION, IF DESIRED, COMPUTING
C              LEFT SINGULAR VECTORS IN U AND COMPUTING RIGHT SINGULAR
C              VECTORS IN A
C              (WORKSPACE: NEED BDSPAC)
C
               CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), A, LDA,
     $                      U, LDU, DUM, 1, WORK( IWORK ), INFO )
            ELSE
C
C              PERFORM BIDIAGONAL QR ITERATION, IF DESIRED, COMPUTING
C              LEFT SINGULAR VECTORS IN A AND COMPUTING RIGHT SINGULAR
C              VECTORS IN VT
C              (WORKSPACE: NEED BDSPAC)
C
               CALL DBDSQR( 'L', M, NCVT, NRU, 0, S, WORK( IE ), VT,
     $                      LDVT, A, LDA, DUM, 1, WORK( IWORK ), INFO )
            END IF
C
         END IF
C
      END IF
C
C     IF DBDSQR FAILED TO CONVERGE, COPY UNCONVERGED SUPERDIAGONALS
C     TO WORK( 2:MINMN )
C
      IF( INFO.NE.0 ) THEN
         IF( IE.GT.2 ) THEN
            DO 50 I = 1, MINMN - 1
               WORK( I+1 ) = WORK( I+IE-1 )
   50       CONTINUE
         END IF
         IF( IE.LT.2 ) THEN
            DO 60 I = MINMN - 1, 1, -1
               WORK( I+1 ) = WORK( I+IE-1 )
   60       CONTINUE
         END IF
      END IF
C
C     UNDO SCALING IF NECESSARY
C
      IF( ISCL.EQ.1 ) THEN
         IF( ANRM.GT.BIGNUM )
     $      CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN, 1, S, MINMN,
     $                   IERR )
         IF( INFO.NE.0 .AND. ANRM.GT.BIGNUM )
     $      CALL DLASCL( 'G', 0, 0, BIGNUM, ANRM, MINMN-1, 1, WORK( 2 ),
     $                   MINMN, IERR )
         IF( ANRM.LT.SMLNUM )
     $      CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN, 1, S, MINMN,
     $                   IERR )
         IF( INFO.NE.0 .AND. ANRM.LT.SMLNUM )
     $      CALL DLASCL( 'G', 0, 0, SMLNUM, ANRM, MINMN-1, 1, WORK( 2 ),
     $                   MINMN, IERR )
      END IF
C
C     RETURN OPTIMAL WORKSPACE IN WORK(1)
C
      WORK( 1 ) = MAXWRK
C
      RETURN
C
C     END OF DGESVD
C
      END
C*MODEULE DGESVD  *DECK DGEBRD
      SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
     $                   INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     JUNE 30, 1999
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            INFO, LDA, LWORK, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), D( * ), E( * ), TAUP( * ),
     $                   TAUQ( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DGEBRD REDUCES A GENERAL REAL M-BY-N MATRIX A TO UPPER OR LOWER
C  BIDIAGONAL FORM B BY AN ORTHOGONAL TRANSFORMATION: Q**T * A * P = B.
C
C  IF M >= N, B IS UPPER BIDIAGONAL; IF M < N, B IS LOWER BIDIAGONAL.
C
C  ARGUMENTS
C  =========
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS IN THE MATRIX A.  M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS IN THE MATRIX A.  N >= 0.
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          ON ENTRY, THE M-BY-N GENERAL MATRIX TO BE REDUCED.
C          ON EXIT,
C          IF M >= N, THE DIAGONAL AND THE FIRST SUPERDIAGONAL ARE
C            OVERWRITTEN WITH THE UPPER BIDIAGONAL MATRIX B; THE
C            ELEMENTS BELOW THE DIAGONAL, WITH THE ARRAY TAUQ, REPRESENT
C            THE ORTHOGONAL MATRIX Q AS A PRODUCT OF ELEMENTARY
C            REFLECTORS, AND THE ELEMENTS ABOVE THE FIRST SUPERDIAGONAL,
C            WITH THE ARRAY TAUP, REPRESENT THE ORTHOGONAL MATRIX P AS
C            A PRODUCT OF ELEMENTARY REFLECTORS;
C          IF M < N, THE DIAGONAL AND THE FIRST SUBDIAGONAL ARE
C            OVERWRITTEN WITH THE LOWER BIDIAGONAL MATRIX B; THE
C            ELEMENTS BELOW THE FIRST SUBDIAGONAL, WITH THE ARRAY TAUQ,
C            REPRESENT THE ORTHOGONAL MATRIX Q AS A PRODUCT OF
C            ELEMENTARY REFLECTORS, AND THE ELEMENTS ABOVE THE DIAGONAL,
C            WITH THE ARRAY TAUP, REPRESENT THE ORTHOGONAL MATRIX P AS
C            A PRODUCT OF ELEMENTARY REFLECTORS.
C          SEE FURTHER DETAILS.
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.  LDA >= MAX(1,M).
C
C  D       (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(M,N))
C          THE DIAGONAL ELEMENTS OF THE BIDIAGONAL MATRIX B:
C          D(I) = A(I,I).
C
C  E       (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(M,N)-1)
C          THE OFF-DIAGONAL ELEMENTS OF THE BIDIAGONAL MATRIX B:
C          IF M >= N, E(I) = A(I,I+1) FOR I = 1,2,...,N-1;
C          IF M < N, E(I) = A(I+1,I) FOR I = 1,2,...,M-1.
C
C  TAUQ    (OUTPUT) DOUBLE PRECISION ARRAY DIMENSION (MIN(M,N))
C          THE SCALAR FACTORS OF THE ELEMENTARY REFLECTORS WHICH
C          REPRESENT THE ORTHOGONAL MATRIX Q. SEE FURTHER DETAILS.
C
C  TAUP    (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(M,N))
C          THE SCALAR FACTORS OF THE ELEMENTARY REFLECTORS WHICH
C          REPRESENT THE ORTHOGONAL MATRIX P. SEE FURTHER DETAILS.
C
C  WORK    (WORKSPACE/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LWORK)
C          ON EXIT, IF INFO = 0, WORK(1) RETURNS THE OPTIMAL LWORK.
C
C  LWORK   (INPUT) INTEGER
C          THE LENGTH OF THE ARRAY WORK.  LWORK >= MAX(1,M,N).
C          FOR OPTIMUM PERFORMANCE LWORK >= (M+N)*NB, WHERE NB
C          IS THE OPTIMAL BLOCKSIZE.
C
C          IF LWORK = -1, THEN A WORKSPACE QUERY IS ASSUMED; THE ROUTINE
C          ONLY CALCULATES THE OPTIMAL SIZE OF THE WORK ARRAY, RETURNS
C          THIS VALUE AS THE FIRST ENTRY OF THE WORK ARRAY, AND NO ERROR
C          MESSAGE RELATED TO LWORK IS ISSUED BY XERBLA.
C
C  INFO    (OUTPUT) INTEGER
C          = 0:  SUCCESSFUL EXIT
C          < 0:  IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE.
C
C  FURTHER DETAILS
C  ===============
C
C  THE MATRICES Q AND P ARE REPRESENTED AS PRODUCTS OF ELEMENTARY
C  REFLECTORS:
C
C  IF M >= N,
C
C     Q = H(1) H(2) . . . H(N)  AND  P = G(1) G(2) . . . G(N-1)
C
C  EACH H(I) AND G(I) HAS THE FORM:
C
C     H(I) = I - TAUQ * V * V'  AND G(I) = I - TAUP * U * U'
C
C  WHERE TAUQ AND TAUP ARE REAL SCALARS, AND V AND U ARE REAL VECTORS;
C  V(1:I-1) = 0, V(I) = 1, AND V(I+1:M) IS STORED ON EXIT IN A(I+1:M,I);
C  U(1:I) = 0, U(I+1) = 1, AND U(I+2:N) IS STORED ON EXIT IN A(I,I+2:N);
C  TAUQ IS STORED IN TAUQ(I) AND TAUP IN TAUP(I).
C
C  IF M < N,
C
C     Q = H(1) H(2) . . . H(M-1)  AND  P = G(1) G(2) . . . G(M)
C
C  EACH H(I) AND G(I) HAS THE FORM:
C
C     H(I) = I - TAUQ * V * V'  AND G(I) = I - TAUP * U * U'
C
C  WHERE TAUQ AND TAUP ARE REAL SCALARS, AND V AND U ARE REAL VECTORS;
C  V(1:I) = 0, V(I+1) = 1, AND V(I+2:M) IS STORED ON EXIT IN A(I+2:M,I);
C  U(1:I-1) = 0, U(I) = 1, AND U(I+1:N) IS STORED ON EXIT IN A(I,I+1:N);
C  TAUQ IS STORED IN TAUQ(I) AND TAUP IN TAUP(I).
C
C  THE CONTENTS OF A ON EXIT ARE ILLUSTRATED BY THE FOLLOWING EXAMPLES:
C
C  M = 6 AND N = 5 (M > N):          M = 5 AND N = 6 (M < N):
C
C    (  D   E   U1  U1  U1 )           (  D   U1  U1  U1  U1  U1 )
C    (  V1  D   E   U2  U2 )           (  E   D   U2  U2  U2  U2 )
C    (  V1  V2  D   E   U3 )           (  V1  E   D   U3  U3  U3 )
C    (  V1  V2  V3  D   E  )           (  V1  V2  E   D   U4  U4 )
C    (  V1  V2  V3  V4  D  )           (  V1  V2  V3  E   D   U5 )
C    (  V1  V2  V3  V4  V5 )
C
C  WHERE D AND E DENOTE DIAGONAL AND OFF-DIAGONAL ELEMENTS OF B, VI
C  DENOTES AN ELEMENT OF THE VECTOR DEFINING H(I), AND UI AN ELEMENT OF
C  THE VECTOR DEFINING G(I).
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ONE
      PARAMETER          ( ONE = 1.0D+0 )
C     ..
C     .. LOCAL SCALARS ..
      LOGICAL            LQUERY
      INTEGER            I, IINFO, J, LDWRKX, LDWRKY, LWKOPT, MINMN, NB,
     $                   NBMIN, NX
      DOUBLE PRECISION   WS
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DGEBD2, DGEMM, DLABRD, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN
C     ..
C     .. EXTERNAL FUNCTIONS ..
      INTEGER            ILAENV
      EXTERNAL           ILAENV
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT PARAMETERS
C
      INFO = 0
      NB = MAX( 1, ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) )
      LWKOPT = ( M+N )*NB
      WORK( 1 ) = LWKOPT
      LQUERY = ( LWORK.EQ.-1 )
      IF( M.LT.0 ) THEN
         INFO = -1
      ELSE IF( N.LT.0 ) THEN
         INFO = -2
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = -4
      ELSE IF( LWORK.LT.MAX( 1, M, N ) .AND. .NOT.LQUERY ) THEN
         INFO = -10
      END IF
      IF( INFO.LT.0 ) THEN
         CALL XERBLA( 'DGEBRD', -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      MINMN = MIN( M, N )
      IF( MINMN.EQ.0 ) THEN
         WORK( 1 ) = 1
         RETURN
      END IF
C
      WS = MAX( M, N )
      LDWRKX = M
      LDWRKY = N
C
      IF( NB.GT.1 .AND. NB.LT.MINMN ) THEN
C
C        SET THE CROSSOVER POINT NX.
C
         NX = MAX( NB, ILAENV( 3, 'DGEBRD', ' ', M, N, -1, -1 ) )
C
C        DETERMINE WHEN TO SWITCH FROM BLOCKED TO UNBLOCKED CODE.
C
         IF( NX.LT.MINMN ) THEN
            WS = ( M+N )*NB
            IF( LWORK.LT.WS ) THEN
C
C              NOT ENOUGH WORK SPACE FOR THE OPTIMAL NB, CONSIDER USING
C              A SMALLER BLOCK SIZE.
C
               NBMIN = ILAENV( 2, 'DGEBRD', ' ', M, N, -1, -1 )
               IF( LWORK.GE.( M+N )*NBMIN ) THEN
                  NB = LWORK / ( M+N )
               ELSE
                  NB = 1
                  NX = MINMN
               END IF
            END IF
         END IF
      ELSE
         NX = MINMN
      END IF
C
      DO 30 I = 1, MINMN - NX, NB
C
C        REDUCE ROWS AND COLUMNS I:I+NB-1 TO BIDIAGONAL FORM AND RETURN
C        THE MATRICES X AND Y WHICH ARE NEEDED TO UPDATE THE UNREDUCED
C        PART OF THE MATRIX
C
         CALL DLABRD( M-I+1, N-I+1, NB, A( I, I ), LDA, D( I ), E( I ),
     $                TAUQ( I ), TAUP( I ), WORK, LDWRKX,
     $                WORK( LDWRKX*NB+1 ), LDWRKY )
C
C        UPDATE THE TRAILING SUBMATRIX A(I+NB:M,I+NB:N), USING AN UPDATE
C        OF THE FORM  A := A - V*Y' - X*U'
C
         CALL DGEMM( 'NO TRANSPOSE', 'TRANSPOSE', M-I-NB+1, N-I-NB+1,
     $               NB, -ONE, A( I+NB, I ), LDA,
     $               WORK( LDWRKX*NB+NB+1 ), LDWRKY, ONE,
     $               A( I+NB, I+NB ), LDA )
         CALL DGEMM( 'NO TRANSPOSE', 'NO TRANSPOSE', M-I-NB+1, N-I-NB+1,
     $               NB, -ONE, WORK( NB+1 ), LDWRKX, A( I, I+NB ), LDA,
     $               ONE, A( I+NB, I+NB ), LDA )
C
C        COPY DIAGONAL AND OFF-DIAGONAL ELEMENTS OF B BACK INTO A
C
         IF( M.GE.N ) THEN
            DO 10 J = I, I + NB - 1
               A( J, J ) = D( J )
               A( J, J+1 ) = E( J )
   10       CONTINUE
         ELSE
            DO 20 J = I, I + NB - 1
               A( J, J ) = D( J )
               A( J+1, J ) = E( J )
   20       CONTINUE
         END IF
   30 CONTINUE
C
C     USE UNBLOCKED CODE TO REDUCE THE REMAINDER OF THE MATRIX
C
      CALL DGEBD2( M-I+1, N-I+1, A( I, I ), LDA, D( I ), E( I ),
     $             TAUQ( I ), TAUP( I ), WORK, IINFO )
      WORK( 1 ) = WS
      RETURN
C
C     END OF DGEBRD
C
      END
C*MODEULE DGESVD  *DECK DORGBR
      SUBROUTINE DORGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     JUNE 30, 1999
C
C     .. SCALAR ARGUMENTS ..
      CHARACTER          VECT
      INTEGER            INFO, K, LDA, LWORK, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DORGBR GENERATES ONE OF THE REAL ORTHOGONAL MATRICES Q OR P**T
C  DETERMINED BY DGEBRD WHEN REDUCING A REAL MATRIX A TO BIDIAGONAL
C  FORM: A = Q * B * P**T.  Q AND P**T ARE DEFINED AS PRODUCTS OF
C  ELEMENTARY REFLECTORS H(I) OR G(I) RESPECTIVELY.
C
C  IF VECT = 'Q', A IS ASSUMED TO HAVE BEEN AN M-BY-K MATRIX, AND Q
C  IS OF ORDER M:
C  IF M >= K, Q = H(1) H(2) . . . H(K) AND DORGBR RETURNS THE FIRST N
C  COLUMNS OF Q, WHERE M >= N >= K;
C  IF M < K, Q = H(1) H(2) . . . H(M-1) AND DORGBR RETURNS Q AS AN
C  M-BY-M MATRIX.
C
C  IF VECT = 'P', A IS ASSUMED TO HAVE BEEN A K-BY-N MATRIX, AND P**T
C  IS OF ORDER N:
C  IF K < N, P**T = G(K) . . . G(2) G(1) AND DORGBR RETURNS THE FIRST M
C  ROWS OF P**T, WHERE N >= M >= K;
C  IF K >= N, P**T = G(N-1) . . . G(2) G(1) AND DORGBR RETURNS P**T AS
C  AN N-BY-N MATRIX.
C
C  ARGUMENTS
C  =========
C
C  VECT    (INPUT) CHARACTER*1
C          SPECIFIES WHETHER THE MATRIX Q OR THE MATRIX P**T IS
C          REQUIRED, AS DEFINED IN THE TRANSFORMATION APPLIED BY DGEBRD:
C          = 'Q':  GENERATE Q;
C          = 'P':  GENERATE P**T.
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX Q OR P**T TO BE RETURNED.
C          M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX Q OR P**T TO BE RETURNED.
C          N >= 0.
C          IF VECT = 'Q', M >= N >= MIN(M,K);
C          IF VECT = 'P', N >= M >= MIN(N,K).
C
C  K       (INPUT) INTEGER
C          IF VECT = 'Q', THE NUMBER OF COLUMNS IN THE ORIGINAL M-BY-K
C          MATRIX REDUCED BY DGEBRD.
C          IF VECT = 'P', THE NUMBER OF ROWS IN THE ORIGINAL K-BY-N
C          MATRIX REDUCED BY DGEBRD.
C          K >= 0.
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          ON ENTRY, THE VECTORS WHICH DEFINE THE ELEMENTARY REFLECTORS,
C          AS RETURNED BY DGEBRD.
C          ON EXIT, THE M-BY-N MATRIX Q OR P**T.
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A. LDA >= MAX(1,M).
C
C  TAU     (INPUT) DOUBLE PRECISION ARRAY, DIMENSION
C                                (MIN(M,K)) IF VECT = 'Q'
C                                (MIN(N,K)) IF VECT = 'P'
C          TAU(I) MUST CONTAIN THE SCALAR FACTOR OF THE ELEMENTARY
C          REFLECTOR H(I) OR G(I), WHICH DETERMINES Q OR P**T, AS
C          RETURNED BY DGEBRD IN ITS ARRAY ARGUMENT TAUQ OR TAUP.
C
C  WORK    (WORKSPACE/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LWORK)
C          ON EXIT, IF INFO = 0, WORK(1) RETURNS THE OPTIMAL LWORK.
C
C  LWORK   (INPUT) INTEGER
C          THE DIMENSION OF THE ARRAY WORK. LWORK >= MAX(1,MIN(M,N)).
C          FOR OPTIMUM PERFORMANCE LWORK >= MIN(M,N)*NB, WHERE NB
C          IS THE OPTIMAL BLOCKSIZE.
C
C          IF LWORK = -1, THEN A WORKSPACE QUERY IS ASSUMED; THE ROUTINE
C          ONLY CALCULATES THE OPTIMAL SIZE OF THE WORK ARRAY, RETURNS
C          THIS VALUE AS THE FIRST ENTRY OF THE WORK ARRAY, AND NO ERROR
C          MESSAGE RELATED TO LWORK IS ISSUED BY XERBLA.
C
C  INFO    (OUTPUT) INTEGER
C          = 0:  SUCCESSFUL EXIT
C          < 0:  IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ZERO, ONE
      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
C     ..
C     .. LOCAL SCALARS ..
      LOGICAL            LQUERY, WANTQ
      INTEGER            I, IINFO, J, LWKOPT, MN, NB
C     ..
C     .. EXTERNAL FUNCTIONS ..
      LOGICAL            LSAME
      INTEGER            ILAENV
      EXTERNAL           LSAME, ILAENV
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DORGLQ, DORGQR, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      WANTQ = LSAME( VECT, 'Q' )
      MN = MIN( M, N )
      LQUERY = ( LWORK.EQ.-1 )
      IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
         INFO = -1
      ELSE IF( M.LT.0 ) THEN
         INFO = -2
      ELSE IF( N.LT.0 .OR. ( WANTQ .AND. ( N.GT.M .OR. N.LT.MIN( M,
     $         K ) ) ) .OR. ( .NOT.WANTQ .AND. ( M.GT.N .OR. M.LT.
     $         MIN( N, K ) ) ) ) THEN
         INFO = -3
      ELSE IF( K.LT.0 ) THEN
         INFO = -4
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = -6
      ELSE IF( LWORK.LT.MAX( 1, MN ) .AND. .NOT.LQUERY ) THEN
         INFO = -9
      END IF
C
      IF( INFO.EQ.0 ) THEN
         IF( WANTQ ) THEN
            NB = ILAENV( 1, 'DORGQR', ' ', M, N, K, -1 )
         ELSE
            NB = ILAENV( 1, 'DORGLQ', ' ', M, N, K, -1 )
         END IF
         LWKOPT = MAX( 1, MN )*NB
         WORK( 1 ) = LWKOPT
      END IF
C
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DORGBR', -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
         WORK( 1 ) = 1
         RETURN
      END IF
C
      IF( WANTQ ) THEN
C
C        FORM Q, DETERMINED BY A CALL TO DGEBRD TO REDUCE AN M-BY-K
C        MATRIX
C
         IF( M.GE.K ) THEN
C
C           IF M >= K, ASSUME M >= N >= K
C
            CALL DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
C
         ELSE
C
C           IF M < K, ASSUME M = N
C
C           SHIFT THE VECTORS WHICH DEFINE THE ELEMENTARY REFLECTORS ONE
C           COLUMN TO THE RIGHT, AND SET THE FIRST ROW AND COLUMN OF Q
C           TO THOSE OF THE UNIT MATRIX
C
            DO 20 J = M, 2, -1
               A( 1, J ) = ZERO
               DO 10 I = J + 1, M
                  A( I, J ) = A( I, J-1 )
   10          CONTINUE
   20       CONTINUE
            A( 1, 1 ) = ONE
            DO 30 I = 2, M
               A( I, 1 ) = ZERO
   30       CONTINUE
            IF( M.GT.1 ) THEN
C
C              FORM Q(2:M,2:M)
C
               CALL DORGQR( M-1, M-1, M-1, A( 2, 2 ), LDA, TAU, WORK,
     $                      LWORK, IINFO )
            END IF
         END IF
      ELSE
C
C        FORM P', DETERMINED BY A CALL TO DGEBRD TO REDUCE A K-BY-N
C        MATRIX
C
         IF( K.LT.N ) THEN
C
C           IF K < N, ASSUME K <= M <= N
C
            CALL DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, IINFO )
C
         ELSE
C
C           IF K >= N, ASSUME M = N
C
C           SHIFT THE VECTORS WHICH DEFINE THE ELEMENTARY REFLECTORS ONE
C           ROW DOWNWARD, AND SET THE FIRST ROW AND COLUMN OF P' TO
C           THOSE OF THE UNIT MATRIX
C
            A( 1, 1 ) = ONE
            DO 40 I = 2, N
               A( I, 1 ) = ZERO
   40       CONTINUE
            DO 60 J = 2, N
               DO 50 I = J - 1, 2, -1
                  A( I, J ) = A( I-1, J )
   50          CONTINUE
               A( 1, J ) = ZERO
   60       CONTINUE
            IF( N.GT.1 ) THEN
C
C              FORM P'(2:N,2:N)
C
               CALL DORGLQ( N-1, N-1, N-1, A( 2, 2 ), LDA, TAU, WORK,
     $                      LWORK, IINFO )
            END IF
         END IF
      END IF
      WORK( 1 ) = LWKOPT
      RETURN
C
C     END OF DORGBR
C
      END
C*MODEULE DGESVD  *DECK DBDSQR
      SUBROUTINE DBDSQR( UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U,
     $                   LDU, C, LDC, WORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     OCTOBER 31, 1999
C
C     .. SCALAR ARGUMENTS ..
      CHARACTER          UPLO
      INTEGER            INFO, LDC, LDU, LDVT, N, NCC, NCVT, NRU
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   C( LDC, * ), D( * ), E( * ), U( LDU, * ),
     $                   VT( LDVT, * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DBDSQR COMPUTES THE SINGULAR VALUE DECOMPOSITION (SVD) OF A REAL
C  N-BY-N (UPPER OR LOWER) BIDIAGONAL MATRIX B:  B = Q * S * P' (P'
C  DENOTES THE TRANSPOSE OF P), WHERE S IS A DIAGONAL MATRIX WITH
C  NON-NEGATIVE DIAGONAL ELEMENTS (THE SINGULAR VALUES OF B), AND Q
C  AND P ARE ORTHOGONAL MATRICES.
C
C  THE ROUTINE COMPUTES S, AND OPTIONALLY COMPUTES U * Q, P' * VT,
C  OR Q' * C, FOR GIVEN REAL INPUT MATRICES U, VT, AND C.
C
C  SEE "COMPUTING  SMALL SINGULAR VALUES OF BIDIAGONAL MATRICES WITH
C  GUARANTEED HIGH RELATIVE ACCURACY," BY J. DEMMEL AND W. KAHAN,
C  LAPACK WORKING NOTE #3 (OR SIAM J. SCI. STATIST. COMPUT. VOL. 11,
C  NO. 5, PP. 873-912, SEPT 1990) AND
C  "ACCURATE SINGULAR VALUES AND DIFFERENTIAL QD ALGORITHMS," BY
C  B. PARLETT AND V. FERNANDO, TECHNICAL REPORT CPAM-554, MATHEMATICS
C  DEPARTMENT, UNIVERSITY OF CALIFORNIA AT BERKELEY, JULY 1992
C  FOR A DETAILED DESCRIPTION OF THE ALGORITHM.
C
C  ARGUMENTS
C  =========
C
C  UPLO    (INPUT) CHARACTER*1
C          = 'U':  B IS UPPER BIDIAGONAL;
C          = 'L':  B IS LOWER BIDIAGONAL.
C
C  N       (INPUT) INTEGER
C          THE ORDER OF THE MATRIX B.  N >= 0.
C
C  NCVT    (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX VT. NCVT >= 0.
C
C  NRU     (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX U. NRU >= 0.
C
C  NCC     (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX C. NCC >= 0.
C
C  D       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (N)
C          ON ENTRY, THE N DIAGONAL ELEMENTS OF THE BIDIAGONAL MATRIX B.
C          ON EXIT, IF INFO=0, THE SINGULAR VALUES OF B IN DECREASING
C          ORDER.
C
C  E       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (N)
C          ON ENTRY, THE ELEMENTS OF E CONTAIN THE
C          OFFDIAGONAL ELEMENTS OF THE BIDIAGONAL MATRIX WHOSE SVD
C          IS DESIRED. ON NORMAL EXIT (INFO = 0), E IS DESTROYED.
C          IF THE ALGORITHM DOES NOT CONVERGE (INFO > 0), D AND E
C          WILL CONTAIN THE DIAGONAL AND SUPERDIAGONAL ELEMENTS OF A
C          BIDIAGONAL MATRIX ORTHOGONALLY EQUIVALENT TO THE ONE GIVEN
C          AS INPUT. E(N) IS USED FOR WORKSPACE.
C
C  VT      (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDVT, NCVT)
C          ON ENTRY, AN N-BY-NCVT MATRIX VT.
C          ON EXIT, VT IS OVERWRITTEN BY P' * VT.
C          VT IS NOT REFERENCED IF NCVT = 0.
C
C  LDVT    (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY VT.
C          LDVT >= MAX(1,N) IF NCVT > 0; LDVT >= 1 IF NCVT = 0.
C
C  U       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDU, N)
C          ON ENTRY, AN NRU-BY-N MATRIX U.
C          ON EXIT, U IS OVERWRITTEN BY U * Q.
C          U IS NOT REFERENCED IF NRU = 0.
C
C  LDU     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY U.  LDU >= MAX(1,NRU).
C
C  C       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDC, NCC)
C          ON ENTRY, AN N-BY-NCC MATRIX C.
C          ON EXIT, C IS OVERWRITTEN BY Q' * C.
C          C IS NOT REFERENCED IF NCC = 0.
C
C  LDC     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY C.
C          LDC >= MAX(1,N) IF NCC > 0; LDC >=1 IF NCC = 0.
C
C  WORK    (WORKSPACE) DOUBLE PRECISION ARRAY, DIMENSION (4*N)
C
C  INFO    (OUTPUT) INTEGER
C          = 0:  SUCCESSFUL EXIT
C          < 0:  IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C          > 0:  THE ALGORITHM DID NOT CONVERGE; D AND E CONTAIN THE
C                ELEMENTS OF A BIDIAGONAL MATRIX WHICH IS ORTHOGONALLY
C                SIMILAR TO THE INPUT MATRIX B;  IF INFO = I, I
C                ELEMENTS OF E HAVE NOT CONVERGED TO ZERO.
C
C  INTERNAL PARAMETERS
C  ===================
C
C  TOLMUL  DOUBLE PRECISION, DEFAULT = MAX(10,MIN(100,EPS**(-1/8)))
C          TOLMUL CONTROLS THE CONVERGENCE CRITERION OF THE QR LOOP.
C          IF IT IS POSITIVE, TOLMUL*EPS IS THE DESIRED RELATIVE
C             PRECISION IN THE COMPUTED SINGULAR VALUES.
C          IF IT IS NEGATIVE, ABS(TOLMUL*EPS*SIGMA_MAX) IS THE
C             DESIRED ABSOLUTE ACCURACY IN THE COMPUTED SINGULAR
C             VALUES (CORRESPONDS TO RELATIVE ACCURACY
C             ABS(TOLMUL*EPS) IN THE LARGEST SINGULAR VALUE.
C          ABS(TOLMUL) SHOULD BE BETWEEN 1 AND 1/EPS, AND PREFERABLY
C             BETWEEN 10 (FOR FAST CONVERGENCE) AND .1/EPS
C             (FOR THERE TO BE SOME ACCURACY IN THE RESULTS).
C          DEFAULT IS TO LOSE AT EITHER ONE EIGHTH OR 2 OF THE
C             AVAILABLE DECIMAL DIGITS IN EACH COMPUTED SINGULAR VALUE
C             (WHICHEVER IS SMALLER).
C
C  MAXITR  INTEGER, DEFAULT = 6
C          MAXITR CONTROLS THE MAXIMUM NUMBER OF PASSES OF THE
C          ALGORITHM THROUGH ITS INNER LOOP. THE ALGORITHMS STOPS
C          (AND SO FAILS TO CONVERGE) IF THE NUMBER OF PASSES
C          THROUGH THE INNER LOOP EXCEEDS MAXITR*N**2.
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ZERO
      PARAMETER          ( ZERO = 0.0D+00 )
      DOUBLE PRECISION   ONE
      PARAMETER          ( ONE = 1.0D+00 )
      DOUBLE PRECISION   NEGONE
      PARAMETER          ( NEGONE = -1.0D+00 )
      DOUBLE PRECISION   HNDRTH
      PARAMETER          ( HNDRTH = 0.01D+00 )
      DOUBLE PRECISION   TEN
      PARAMETER          ( TEN = 10.0D+00 )
      DOUBLE PRECISION   HNDRD
      PARAMETER          ( HNDRD = 100.0D+00 )
      DOUBLE PRECISION   MEIGTH
      PARAMETER          ( MEIGTH = -0.125D+00 )
      INTEGER            MAXITR
      PARAMETER          ( MAXITR = 6 )
C     ..
C     .. LOCAL SCALARS ..
      LOGICAL            LOWER, ROTATE
      INTEGER            I, IDIR, ISUB, ITER, J, LL, LLL, M, MAXIT, NM1,
     $                   NM12, NM13, OLDLL, OLDM
      DOUBLE PRECISION   ABSE, ABSS, COSL, COSR, CS, EPS, F, G, H, MU,
     $                   OLDCS, OLDSN, R, SHIFT, SIGMN, SIGMX, SINL,
     $                   SINR, SLL, SMAX, SMIN, SMINL, SMINOA,
     $                   SN, THRESH, TOL, TOLMUL, UNFL, DPN
C     ..
C     .. EXTERNAL FUNCTIONS ..
      LOGICAL            LSAME
      DOUBLE PRECISION   DLAMCH
      EXTERNAL           LSAME, DLAMCH
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLARTG, DLAS2, DLASQ1, DLASR, DLASV2, DROT,
     $                   DSCAL, DSWAP, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          ABS, MAX, MIN, SIGN, SQRT
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT PARAMETERS.
C
      INFO = 0
      LOWER = LSAME( UPLO, 'L' )
      IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LOWER ) THEN
         INFO = -1
      ELSE IF( N.LT.0 ) THEN
         INFO = -2
      ELSE IF( NCVT.LT.0 ) THEN
         INFO = -3
      ELSE IF( NRU.LT.0 ) THEN
         INFO = -4
      ELSE IF( NCC.LT.0 ) THEN
         INFO = -5
      ELSE IF( ( NCVT.EQ.0 .AND. LDVT.LT.1 ) .OR.
     $         ( NCVT.GT.0 .AND. LDVT.LT.MAX( 1, N ) ) ) THEN
         INFO = -9
      ELSE IF( LDU.LT.MAX( 1, NRU ) ) THEN
         INFO = -11
      ELSE IF( ( NCC.EQ.0 .AND. LDC.LT.1 ) .OR.
     $         ( NCC.GT.0 .AND. LDC.LT.MAX( 1, N ) ) ) THEN
         INFO = -13
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DBDSQR', -INFO )
         RETURN
      END IF
      IF( N.EQ.0 )
     $   RETURN
      IF( N.EQ.1 )
     $   GO TO 160
C
C     ROTATE IS TRUE IF ANY SINGULAR VECTORS DESIRED, FALSE OTHERWISE
C
      ROTATE = ( NCVT.GT.0 ) .OR. ( NRU.GT.0 ) .OR. ( NCC.GT.0 )
C
C     IF NO SINGULAR VECTORS DESIRED, USE QD ALGORITHM
C
      IF( .NOT.ROTATE ) THEN
         CALL DLASQ1( N, D, E, WORK, INFO )
         RETURN
      END IF
C
      NM1 = N - 1
      NM12 = NM1 + NM1
      NM13 = NM12 + NM1
      IDIR = 0
C
C     GET MACHINE CONSTANTS
C
      EPS = DLAMCH( 'EPSILON' )
      UNFL = DLAMCH( 'SAFE MINIMUM' )
C
C     IF MATRIX LOWER BIDIAGONAL, ROTATE TO BE UPPER BIDIAGONAL
C     BY APPLYING GIVENS ROTATIONS ON THE LEFT
C
      IF( LOWER ) THEN
         DO 10 I = 1, N - 1
            CALL DLARTG( D( I ), E( I ), CS, SN, R )
            D( I ) = R
            E( I ) = SN*D( I+1 )
            D( I+1 ) = CS*D( I+1 )
            WORK( I ) = CS
            WORK( NM1+I ) = SN
   10    CONTINUE
C
C        UPDATE SINGULAR VECTORS IF DESIRED
C
         IF( NRU.GT.0 )
     $      CALL DLASR( 'R', 'V', 'F', NRU, N, WORK( 1 ), WORK( N ), U,
     $                  LDU )
         IF( NCC.GT.0 )
     $      CALL DLASR( 'L', 'V', 'F', N, NCC, WORK( 1 ), WORK( N ), C,
     $                  LDC )
      END IF
C
C     COMPUTE SINGULAR VALUES TO RELATIVE ACCURACY TOL
C     (BY SETTING TOL TO BE NEGATIVE, ALGORITHM WILL COMPUTE
C     SINGULAR VALUES TO ABSOLUTE ACCURACY ABS(TOL)*NORM(INPUT MATRIX))
C
      TOLMUL = MAX( TEN, MIN( HNDRD, EPS**MEIGTH ) )
      TOL = TOLMUL*EPS
C
C     COMPUTE APPROXIMATE MAXIMUM, MINIMUM SINGULAR VALUES
C
      SMAX = ZERO
      DO 20 I = 1, N
         SMAX = MAX( SMAX, ABS( D( I ) ) )
   20 CONTINUE
      DO 30 I = 1, N - 1
         SMAX = MAX( SMAX, ABS( E( I ) ) )
   30 CONTINUE
      SMINL = ZERO
      IF( TOL.GE.ZERO ) THEN
C
C        RELATIVE ACCURACY DESIRED
C
         SMINOA = ABS( D( 1 ) )
         IF( SMINOA.EQ.ZERO )
     $      GO TO 50
         MU = SMINOA
         DO 40 I = 2, N
            MU = ABS( D( I ) )*( MU / ( MU+ABS( E( I-1 ) ) ) )
            SMINOA = MIN( SMINOA, MU )
            IF( SMINOA.EQ.ZERO )
     $         GO TO 50
   40    CONTINUE
   50    CONTINUE
         DPN = N
         SMINOA = SMINOA / SQRT( DPN )
         THRESH = MAX( TOL*SMINOA, MAXITR*N*N*UNFL )
      ELSE
C
C        ABSOLUTE ACCURACY DESIRED
C
         THRESH = MAX( ABS( TOL )*SMAX, MAXITR*N*N*UNFL )
      END IF
C
C     PREPARE FOR MAIN ITERATION LOOP FOR THE SINGULAR VALUES
C     (MAXIT IS THE MAXIMUM NUMBER OF PASSES THROUGH THE INNER
C     LOOP PERMITTED BEFORE NONCONVERGENCE SIGNALLED.)
C
      MAXIT = MAXITR*N*N
      ITER = 0
      OLDLL = -1
      OLDM = -1
C
C     M POINTS TO LAST ELEMENT OF UNCONVERGED PART OF MATRIX
C
      M = N
C
C     BEGIN MAIN ITERATION LOOP
C
   60 CONTINUE
C
C     CHECK FOR CONVERGENCE OR EXCEEDING ITERATION COUNT
C
      IF( M.LE.1 )
     $   GO TO 160
      IF( ITER.GT.MAXIT )
     $   GO TO 200
C
C     FIND DIAGONAL BLOCK OF MATRIX TO WORK ON
C
      IF( TOL.LT.ZERO .AND. ABS( D( M ) ).LE.THRESH )
     $   D( M ) = ZERO
      SMAX = ABS( D( M ) )
      SMIN = SMAX
      DO 70 LLL = 1, M - 1
         LL = M - LLL
         ABSS = ABS( D( LL ) )
         ABSE = ABS( E( LL ) )
         IF( TOL.LT.ZERO .AND. ABSS.LE.THRESH )
     $      D( LL ) = ZERO
         IF( ABSE.LE.THRESH )
     $      GO TO 80
         SMIN = MIN( SMIN, ABSS )
         SMAX = MAX( SMAX, ABSS, ABSE )
   70 CONTINUE
      LL = 0
      GO TO 90
   80 CONTINUE
      E( LL ) = ZERO
C
C     MATRIX SPLITS SINCE E(LL) = 0
C
      IF( LL.EQ.M-1 ) THEN
C
C        CONVERGENCE OF BOTTOM SINGULAR VALUE, RETURN TO TOP OF LOOP
C
         M = M - 1
         GO TO 60
      END IF
   90 CONTINUE
      LL = LL + 1
C
C     E(LL) THROUGH E(M-1) ARE NONZERO, E(LL-1) IS ZERO
C
      IF( LL.EQ.M-1 ) THEN
C
C        2 BY 2 BLOCK, HANDLE SEPARATELY
C
         CALL DLASV2( D( M-1 ), E( M-1 ), D( M ), SIGMN, SIGMX, SINR,
     $                COSR, SINL, COSL )
         D( M-1 ) = SIGMX
         E( M-1 ) = ZERO
         D( M ) = SIGMN
C
C        COMPUTE SINGULAR VECTORS, IF DESIRED
C
         IF( NCVT.GT.0 )
     $      CALL DROT( NCVT, VT( M-1, 1 ), LDVT, VT( M, 1 ), LDVT, COSR,
     $                 SINR )
         IF( NRU.GT.0 )
     $      CALL DROT( NRU, U( 1, M-1 ), 1, U( 1, M ), 1, COSL, SINL )
         IF( NCC.GT.0 )
     $      CALL DROT( NCC, C( M-1, 1 ), LDC, C( M, 1 ), LDC, COSL,
     $                 SINL )
         M = M - 2
         GO TO 60
      END IF
C
C     IF WORKING ON NEW SUBMATRIX, CHOOSE SHIFT DIRECTION
C     (FROM LARGER END DIAGONAL ELEMENT TOWARDS SMALLER)
C
      IF( LL.GT.OLDM .OR. M.LT.OLDLL ) THEN
         IF( ABS( D( LL ) ).GE.ABS( D( M ) ) ) THEN
C
C           CHASE BULGE FROM TOP (BIG END) TO BOTTOM (SMALL END)
C
            IDIR = 1
         ELSE
C
C           CHASE BULGE FROM BOTTOM (BIG END) TO TOP (SMALL END)
C
            IDIR = 2
         END IF
      END IF
C
C     APPLY CONVERGENCE TESTS
C
      IF( IDIR.EQ.1 ) THEN
C
C        RUN CONVERGENCE TEST IN FORWARD DIRECTION
C        FIRST APPLY STANDARD TEST TO BOTTOM OF MATRIX
C
         IF( ABS( E( M-1 ) ).LE.ABS( TOL )*ABS( D( M ) ) .OR.
     $       ( TOL.LT.ZERO .AND. ABS( E( M-1 ) ).LE.THRESH ) ) THEN
            E( M-1 ) = ZERO
            GO TO 60
         END IF
C
         IF( TOL.GE.ZERO ) THEN
C
C           IF RELATIVE ACCURACY DESIRED,
C           APPLY CONVERGENCE CRITERION FORWARD
C
            MU = ABS( D( LL ) )
            SMINL = MU
            DO 100 LLL = LL, M - 1
               IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
                  E( LLL ) = ZERO
                  GO TO 60
               END IF
               MU = ABS( D( LLL+1 ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
               SMINL = MIN( SMINL, MU )
  100       CONTINUE
         END IF
C
      ELSE
C
C        RUN CONVERGENCE TEST IN BACKWARD DIRECTION
C        FIRST APPLY STANDARD TEST TO TOP OF MATRIX
C
         IF( ABS( E( LL ) ).LE.ABS( TOL )*ABS( D( LL ) ) .OR.
     $       ( TOL.LT.ZERO .AND. ABS( E( LL ) ).LE.THRESH ) ) THEN
            E( LL ) = ZERO
            GO TO 60
         END IF
C
         IF( TOL.GE.ZERO ) THEN
C
C           IF RELATIVE ACCURACY DESIRED,
C           APPLY CONVERGENCE CRITERION BACKWARD
C
            MU = ABS( D( M ) )
            SMINL = MU
            DO 110 LLL = M - 1, LL, -1
               IF( ABS( E( LLL ) ).LE.TOL*MU ) THEN
                  E( LLL ) = ZERO
                  GO TO 60
               END IF
               MU = ABS( D( LLL ) )*( MU / ( MU+ABS( E( LLL ) ) ) )
               SMINL = MIN( SMINL, MU )
  110       CONTINUE
         END IF
      END IF
      OLDLL = LL
      OLDM = M
C
C     COMPUTE SHIFT.  FIRST, TEST IF SHIFTING WOULD RUIN RELATIVE
C     ACCURACY, AND IF SO SET THE SHIFT TO ZERO.
C
      IF( TOL.GE.ZERO .AND. N*TOL*( SMINL / SMAX ).LE.
     $    MAX( EPS, HNDRTH*TOL ) ) THEN
C
C        USE A ZERO SHIFT TO AVOID LOSS OF RELATIVE ACCURACY
C
         SHIFT = ZERO
      ELSE
C
C        COMPUTE THE SHIFT FROM 2-BY-2 BLOCK AT END OF MATRIX
C
         IF( IDIR.EQ.1 ) THEN
            SLL = ABS( D( LL ) )
            CALL DLAS2( D( M-1 ), E( M-1 ), D( M ), SHIFT, R )
         ELSE
            SLL = ABS( D( M ) )
            CALL DLAS2( D( LL ), E( LL ), D( LL+1 ), SHIFT, R )
         END IF
C
C        TEST IF SHIFT NEGLIGIBLE, AND IF SO SET TO ZERO
C
         IF( SLL.GT.ZERO ) THEN
            IF( ( SHIFT / SLL )**2.LT.EPS )
     $         SHIFT = ZERO
         END IF
      END IF
C
C     INCREMENT ITERATION COUNT
C
      ITER = ITER + M - LL
C
C     IF SHIFT = 0, DO SIMPLIFIED QR ITERATION
C
      IF( SHIFT.EQ.ZERO ) THEN
         IF( IDIR.EQ.1 ) THEN
C
C           CHASE BULGE FROM TOP TO BOTTOM
C           SAVE COSINES AND SINES FOR LATER SINGULAR VECTOR UPDATES
C
            CS = ONE
            OLDCS = ONE
            OLDSN = ZERO
            DO 120 I = LL, M - 1
               CALL DLARTG( D( I )*CS, E( I ), CS, SN, R )
               IF( I.GT.LL )
     $            E( I-1 ) = OLDSN*R
               CALL DLARTG( OLDCS*R, D( I+1 )*SN, OLDCS, OLDSN, D( I ) )
               WORK( I-LL+1 ) = CS
               WORK( I-LL+1+NM1 ) = SN
               WORK( I-LL+1+NM12 ) = OLDCS
               WORK( I-LL+1+NM13 ) = OLDSN
  120       CONTINUE
            H = D( M )*CS
            D( M ) = H*OLDCS
            E( M-1 ) = H*OLDSN
C
C           UPDATE SINGULAR VECTORS
C
            IF( NCVT.GT.0 )
     $         CALL DLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ),
     $                     WORK( N ), VT( LL, 1 ), LDVT )
            IF( NRU.GT.0 )
     $         CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ),
     $                     WORK( NM13+1 ), U( 1, LL ), LDU )
            IF( NCC.GT.0 )
     $         CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ),
     $                     WORK( NM13+1 ), C( LL, 1 ), LDC )
C
C           TEST CONVERGENCE
C
            IF( ABS( E( M-1 ) ).LE.THRESH )
     $         E( M-1 ) = ZERO
C
         ELSE
C
C           CHASE BULGE FROM BOTTOM TO TOP
C           SAVE COSINES AND SINES FOR LATER SINGULAR VECTOR UPDATES
C
            CS = ONE
            OLDCS = ONE
            DO 130 I = M, LL + 1, -1
               CALL DLARTG( D( I )*CS, E( I-1 ), CS, SN, R )
               IF( I.LT.M )
     $            E( I ) = OLDSN*R
               CALL DLARTG( OLDCS*R, D( I-1 )*SN, OLDCS, OLDSN, D( I ) )
               WORK( I-LL ) = CS
               WORK( I-LL+NM1 ) = -SN
               WORK( I-LL+NM12 ) = OLDCS
               WORK( I-LL+NM13 ) = -OLDSN
  130       CONTINUE
            H = D( LL )*CS
            D( LL ) = H*OLDCS
            E( LL ) = H*OLDSN
C
C           UPDATE SINGULAR VECTORS
C
            IF( NCVT.GT.0 )
     $         CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ),
     $                     WORK( NM13+1 ), VT( LL, 1 ), LDVT )
            IF( NRU.GT.0 )
     $         CALL DLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ),
     $                     WORK( N ), U( 1, LL ), LDU )
            IF( NCC.GT.0 )
     $         CALL DLASR( 'L', 'V', 'B', M-LL+1, NCC, WORK( 1 ),
     $                     WORK( N ), C( LL, 1 ), LDC )
C
C           TEST CONVERGENCE
C
            IF( ABS( E( LL ) ).LE.THRESH )
     $         E( LL ) = ZERO
         END IF
      ELSE
C
C        USE NONZERO SHIFT
C
         IF( IDIR.EQ.1 ) THEN
C
C           CHASE BULGE FROM TOP TO BOTTOM
C           SAVE COSINES AND SINES FOR LATER SINGULAR VECTOR UPDATES
C
            F = ( ABS( D( LL ) )-SHIFT )*
     $          ( SIGN( ONE, D( LL ) )+SHIFT / D( LL ) )
            G = E( LL )
            DO 140 I = LL, M - 1
               CALL DLARTG( F, G, COSR, SINR, R )
               IF( I.GT.LL )
     $            E( I-1 ) = R
               F = COSR*D( I ) + SINR*E( I )
               E( I ) = COSR*E( I ) - SINR*D( I )
               G = SINR*D( I+1 )
               D( I+1 ) = COSR*D( I+1 )
               CALL DLARTG( F, G, COSL, SINL, R )
               D( I ) = R
               F = COSL*E( I ) + SINL*D( I+1 )
               D( I+1 ) = COSL*D( I+1 ) - SINL*E( I )
               IF( I.LT.M-1 ) THEN
                  G = SINL*E( I+1 )
                  E( I+1 ) = COSL*E( I+1 )
               END IF
               WORK( I-LL+1 ) = COSR
               WORK( I-LL+1+NM1 ) = SINR
               WORK( I-LL+1+NM12 ) = COSL
               WORK( I-LL+1+NM13 ) = SINL
  140       CONTINUE
            E( M-1 ) = F
C
C           UPDATE SINGULAR VECTORS
C
            IF( NCVT.GT.0 )
     $         CALL DLASR( 'L', 'V', 'F', M-LL+1, NCVT, WORK( 1 ),
     $                     WORK( N ), VT( LL, 1 ), LDVT )
            IF( NRU.GT.0 )
     $         CALL DLASR( 'R', 'V', 'F', NRU, M-LL+1, WORK( NM12+1 ),
     $                     WORK( NM13+1 ), U( 1, LL ), LDU )
            IF( NCC.GT.0 )
     $         CALL DLASR( 'L', 'V', 'F', M-LL+1, NCC, WORK( NM12+1 ),
     $                     WORK( NM13+1 ), C( LL, 1 ), LDC )
C
C           TEST CONVERGENCE
C
            IF( ABS( E( M-1 ) ).LE.THRESH )
     $         E( M-1 ) = ZERO
C
         ELSE
C
C           CHASE BULGE FROM BOTTOM TO TOP
C           SAVE COSINES AND SINES FOR LATER SINGULAR VECTOR UPDATES
C
            F = ( ABS( D( M ) )-SHIFT )*( SIGN( ONE, D( M ) )+SHIFT /
     $          D( M ) )
            G = E( M-1 )
            DO 150 I = M, LL + 1, -1
               CALL DLARTG( F, G, COSR, SINR, R )
               IF( I.LT.M )
     $            E( I ) = R
               F = COSR*D( I ) + SINR*E( I-1 )
               E( I-1 ) = COSR*E( I-1 ) - SINR*D( I )
               G = SINR*D( I-1 )
               D( I-1 ) = COSR*D( I-1 )
               CALL DLARTG( F, G, COSL, SINL, R )
               D( I ) = R
               F = COSL*E( I-1 ) + SINL*D( I-1 )
               D( I-1 ) = COSL*D( I-1 ) - SINL*E( I-1 )
               IF( I.GT.LL+1 ) THEN
                  G = SINL*E( I-2 )
                  E( I-2 ) = COSL*E( I-2 )
               END IF
               WORK( I-LL ) = COSR
               WORK( I-LL+NM1 ) = -SINR
               WORK( I-LL+NM12 ) = COSL
               WORK( I-LL+NM13 ) = -SINL
  150       CONTINUE
            E( LL ) = F
C
C           TEST CONVERGENCE
C
            IF( ABS( E( LL ) ).LE.THRESH )
     $         E( LL ) = ZERO
C
C           UPDATE SINGULAR VECTORS IF DESIRED
C
            IF( NCVT.GT.0 )
     $         CALL DLASR( 'L', 'V', 'B', M-LL+1, NCVT, WORK( NM12+1 ),
     $                     WORK( NM13+1 ), VT( LL, 1 ), LDVT )
            IF( NRU.GT.0 )
     $         CALL DLASR( 'R', 'V', 'B', NRU, M-LL+1, WORK( 1 ),
     $                     WORK( N ), U( 1, LL ), LDU )
            IF( NCC.GT.0 )
     $         CALL DLASR( 'L', 'V', 'B', M-LL+1, NCC, WORK( 1 ),
     $                     WORK( N ), C( LL, 1 ), LDC )
         END IF
      END IF
C
C     QR ITERATION FINISHED, GO BACK AND CHECK CONVERGENCE
C
      GO TO 60
C
C     ALL SINGULAR VALUES CONVERGED, SO MAKE THEM POSITIVE
C
  160 CONTINUE
      DO 170 I = 1, N
         IF( D( I ).LT.ZERO ) THEN
            D( I ) = -D( I )
C
C           CHANGE SIGN OF SINGULAR VECTORS, IF DESIRED
C
            IF( NCVT.GT.0 )
     $         CALL DSCAL( NCVT, NEGONE, VT( I, 1 ), LDVT )
         END IF
  170 CONTINUE
C
C     SORT THE SINGULAR VALUES INTO DECREASING ORDER (INSERTION SORT ON
C     SINGULAR VALUES, BUT ONLY ONE TRANSPOSITION PER SINGULAR VECTOR)
C
      DO 190 I = 1, N - 1
C
C        SCAN FOR SMALLEST D(I)
C
         ISUB = 1
         SMIN = D( 1 )
         DO 180 J = 2, N + 1 - I
            IF( D( J ).LE.SMIN ) THEN
               ISUB = J
               SMIN = D( J )
            END IF
  180    CONTINUE
         IF( ISUB.NE.N+1-I ) THEN
C
C           SWAP SINGULAR VALUES AND VECTORS
C
            D( ISUB ) = D( N+1-I )
            D( N+1-I ) = SMIN
            IF( NCVT.GT.0 )
     $         CALL DSWAP( NCVT, VT( ISUB, 1 ), LDVT, VT( N+1-I, 1 ),
     $                     LDVT )
            IF( NRU.GT.0 )
     $         CALL DSWAP( NRU, U( 1, ISUB ), 1, U( 1, N+1-I ), 1 )
            IF( NCC.GT.0 )
     $         CALL DSWAP( NCC, C( ISUB, 1 ), LDC, C( N+1-I, 1 ), LDC )
         END IF
  190 CONTINUE
      GO TO 220
C
C     MAXIMUM NUMBER OF ITERATIONS EXCEEDED, FAILURE TO CONVERGE
C
  200 CONTINUE
      INFO = 0
      DO 210 I = 1, N - 1
         IF( E( I ).NE.ZERO )
     $      INFO = INFO + 1
  210 CONTINUE
  220 CONTINUE
      RETURN
C
C     END OF DBDSQR
C
      END
C*MODEULE DGESVD  *DECK DORMBR
      SUBROUTINE DORMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
     $                   LDC, WORK, LWORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     JUNE 30, 1999
C
C     .. SCALAR ARGUMENTS ..
      CHARACTER          SIDE, TRANS, VECT
      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  IF VECT = 'Q', DORMBR OVERWRITES THE GENERAL REAL M-BY-N MATRIX C
C  WITH
C                  SIDE = 'L'     SIDE = 'R'
C  TRANS = 'N':      Q * C          C * Q
C  TRANS = 'T':      Q**T * C       C * Q**T
C
C  IF VECT = 'P', DORMBR OVERWRITES THE GENERAL REAL M-BY-N MATRIX C
C  WITH
C                  SIDE = 'L'     SIDE = 'R'
C  TRANS = 'N':      P * C          C * P
C  TRANS = 'T':      P**T * C       C * P**T
C
C  HERE Q AND P**T ARE THE ORTHOGONAL MATRICES DETERMINED BY DGEBRD WHEN
C  REDUCING A REAL MATRIX A TO BIDIAGONAL FORM: A = Q * B * P**T. Q AND
C  P**T ARE DEFINED AS PRODUCTS OF ELEMENTARY REFLECTORS H(I) AND G(I)
C  RESPECTIVELY.
C
C  LET NQ = M IF SIDE = 'L' AND NQ = N IF SIDE = 'R'. THUS NQ IS THE
C  ORDER OF THE ORTHOGONAL MATRIX Q OR P**T THAT IS APPLIED.
C
C  IF VECT = 'Q', A IS ASSUMED TO HAVE BEEN AN NQ-BY-K MATRIX:
C  IF NQ >= K, Q = H(1) H(2) . . . H(K);
C  IF NQ < K, Q = H(1) H(2) . . . H(NQ-1).
C
C  IF VECT = 'P', A IS ASSUMED TO HAVE BEEN A K-BY-NQ MATRIX:
C  IF K < NQ, P = G(1) G(2) . . . G(K);
C  IF K >= NQ, P = G(1) G(2) . . . G(NQ-1).
C
C  ARGUMENTS
C  =========
C
C  VECT    (INPUT) CHARACTER*1
C          = 'Q': APPLY Q OR Q**T;
C          = 'P': APPLY P OR P**T.
C
C  SIDE    (INPUT) CHARACTER*1
C          = 'L': APPLY Q, Q**T, P OR P**T FROM THE LEFT;
C          = 'R': APPLY Q, Q**T, P OR P**T FROM THE RIGHT.
C
C  TRANS   (INPUT) CHARACTER*1
C          = 'N':  NO TRANSPOSE, APPLY Q  OR P;
C          = 'T':  TRANSPOSE, APPLY Q**T OR P**T.
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX C. M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX C. N >= 0.
C
C  K       (INPUT) INTEGER
C          IF VECT = 'Q', THE NUMBER OF COLUMNS IN THE ORIGINAL
C          MATRIX REDUCED BY DGEBRD.
C          IF VECT = 'P', THE NUMBER OF ROWS IN THE ORIGINAL
C          MATRIX REDUCED BY DGEBRD.
C          K >= 0.
C
C  A       (INPUT) DOUBLE PRECISION ARRAY, DIMENSION
C                                (LDA,MIN(NQ,K)) IF VECT = 'Q'
C                                (LDA,NQ)        IF VECT = 'P'
C          THE VECTORS WHICH DEFINE THE ELEMENTARY REFLECTORS H(I) AND
C          G(I), WHOSE PRODUCTS DETERMINE THE MATRICES Q AND P, AS
C          RETURNED BY DGEBRD.
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.
C          IF VECT = 'Q', LDA >= MAX(1,NQ);
C          IF VECT = 'P', LDA >= MAX(1,MIN(NQ,K)).
C
C  TAU     (INPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(NQ,K))
C          TAU(I) MUST CONTAIN THE SCALAR FACTOR OF THE ELEMENTARY
C          REFLECTOR H(I) OR G(I) WHICH DETERMINES Q OR P, AS RETURNED
C          BY DGEBRD IN THE ARRAY ARGUMENT TAUQ OR TAUP.
C
C  C       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDC,N)
C          ON ENTRY, THE M-BY-N MATRIX C.
C          ON EXIT, C IS OVERWRITTEN BY Q*C OR Q**T*C OR C*Q**T OR C*Q
C          OR P*C OR P**T*C OR C*P OR C*P**T.
C
C  LDC     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY C. LDC >= MAX(1,M).
C
C  WORK    (WORKSPACE/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LWORK)
C          ON EXIT, IF INFO = 0, WORK(1) RETURNS THE OPTIMAL LWORK.
C
C  LWORK   (INPUT) INTEGER
C          THE DIMENSION OF THE ARRAY WORK.
C          IF SIDE = 'L', LWORK >= MAX(1,N);
C          IF SIDE = 'R', LWORK >= MAX(1,M).
C          FOR OPTIMUM PERFORMANCE LWORK >= N*NB IF SIDE = 'L', AND
C          LWORK >= M*NB IF SIDE = 'R', WHERE NB IS THE OPTIMAL
C          BLOCKSIZE.
C
C          IF LWORK = -1, THEN A WORKSPACE QUERY IS ASSUMED; THE ROUTINE
C          ONLY CALCULATES THE OPTIMAL SIZE OF THE WORK ARRAY, RETURNS
C          THIS VALUE AS THE FIRST ENTRY OF THE WORK ARRAY, AND NO ERROR
C          MESSAGE RELATED TO LWORK IS ISSUED BY XERBLA.
C
C  INFO    (OUTPUT) INTEGER
C          = 0:  SUCCESSFUL EXIT
C          < 0:  IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C
C  =====================================================================
C
C     .. LOCAL SCALARS ..
      LOGICAL            APPLYQ, LEFT, LQUERY, NOTRAN
      CHARACTER          TRANST
      INTEGER            I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
C     ..
C     .. EXTERNAL FUNCTIONS ..
      LOGICAL            LSAME
      INTEGER            ILAENV
      EXTERNAL           LSAME, ILAENV
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DORMLQ, DORMQR, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      APPLYQ = LSAME( VECT, 'Q' )
      LEFT = LSAME( SIDE, 'L' )
      NOTRAN = LSAME( TRANS, 'N' )
      LQUERY = ( LWORK.EQ.-1 )
C
C     NQ IS THE ORDER OF Q OR P AND NW IS THE MINIMUM DIMENSION OF WORK
C
      IF( LEFT ) THEN
         NQ = M
         NW = N
      ELSE
         NQ = N
         NW = M
      END IF
      IF( .NOT.APPLYQ .AND. .NOT.LSAME( VECT, 'P' ) ) THEN
         INFO = -1
      ELSE IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
         INFO = -2
      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
         INFO = -3
      ELSE IF( M.LT.0 ) THEN
         INFO = -4
      ELSE IF( N.LT.0 ) THEN
         INFO = -5
      ELSE IF( K.LT.0 ) THEN
         INFO = -6
      ELSE IF( ( APPLYQ .AND. LDA.LT.MAX( 1, NQ ) ) .OR.
     $         ( .NOT.APPLYQ .AND. LDA.LT.MAX( 1, MIN( NQ, K ) ) ) )
     $          THEN
         INFO = -8
      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
         INFO = -11
      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
         INFO = -13
      END IF
C
      IF( INFO.EQ.0 ) THEN
         IF( APPLYQ ) THEN
            IF( LEFT ) THEN
               NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M-1, N, M-1,
     $              -1 )
            ELSE
               NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N-1, N-1,
     $              -1 )
            END IF
         ELSE
            IF( LEFT ) THEN
               NB = ILAENV( 1, 'DORMLQ', SIDE // TRANS, M-1, N, M-1,
     $              -1 )
            ELSE
               NB = ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N-1, N-1,
     $              -1 )
            END IF
         END IF
         LWKOPT = MAX( 1, NW )*NB
         WORK( 1 ) = LWKOPT
      END IF
C
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DORMBR', -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      WORK( 1 ) = 1
      IF( M.EQ.0 .OR. N.EQ.0 )
     $   RETURN
C
      IF( APPLYQ ) THEN
C
C        APPLY Q
C
         IF( NQ.GE.K ) THEN
C
C           Q WAS DETERMINED BY A CALL TO DGEBRD WITH NQ >= K
C
            CALL DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
     $                   WORK, LWORK, IINFO )
         ELSE IF( NQ.GT.1 ) THEN
C
C           Q WAS DETERMINED BY A CALL TO DGEBRD WITH NQ < K
C
            IF( LEFT ) THEN
               MI = M - 1
               NI = N
               I1 = 2
               I2 = 1
            ELSE
               MI = M
               NI = N - 1
               I1 = 1
               I2 = 2
            END IF
            CALL DORMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU,
     $                   C( I1, I2 ), LDC, WORK, LWORK, IINFO )
         END IF
      ELSE
C
C        APPLY P
C
         IF( NOTRAN ) THEN
            TRANST = 'T'
         ELSE
            TRANST = 'N'
         END IF
         IF( NQ.GT.K ) THEN
C
C           P WAS DETERMINED BY A CALL TO DGEBRD WITH NQ > K
C
            CALL DORMLQ( SIDE, TRANST, M, N, K, A, LDA, TAU, C, LDC,
     $                   WORK, LWORK, IINFO )
         ELSE IF( NQ.GT.1 ) THEN
C
C           P WAS DETERMINED BY A CALL TO DGEBRD WITH NQ <= K
C
            IF( LEFT ) THEN
               MI = M - 1
               NI = N
               I1 = 2
               I2 = 1
            ELSE
               MI = M
               NI = N - 1
               I1 = 1
               I2 = 2
            END IF
            CALL DORMLQ( SIDE, TRANST, MI, NI, NQ-1, A( 1, 2 ), LDA,
     $                   TAU, C( I1, I2 ), LDC, WORK, LWORK, IINFO )
         END IF
      END IF
      WORK( 1 ) = LWKOPT
      RETURN
C
C     END OF DORMBR
C
      END
C*MODEULE DGESVD  *DECK DGELQF
      SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     JUNE 30, 1999
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            INFO, LDA, LWORK, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DGELQF COMPUTES AN LQ FACTORIZATION OF A REAL M-BY-N MATRIX A:
C  A = L * Q.
C
C  ARGUMENTS
C  =========
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX A.  M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX A.  N >= 0.
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          ON ENTRY, THE M-BY-N MATRIX A.
C          ON EXIT, THE ELEMENTS ON AND BELOW THE DIAGONAL OF THE ARRAY
C          CONTAIN THE M-BY-MIN(M,N) LOWER TRAPEZOIDAL MATRIX L (L IS
C          LOWER TRIANGULAR IF M <= N); THE ELEMENTS ABOVE THE DIAGONAL,
C          WITH THE ARRAY TAU, REPRESENT THE ORTHOGONAL MATRIX Q AS A
C          PRODUCT OF ELEMENTARY REFLECTORS (SEE FURTHER DETAILS).
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.  LDA >= MAX(1,M).
C
C  TAU     (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(M,N))
C          THE SCALAR FACTORS OF THE ELEMENTARY REFLECTORS (SEE FURTHER
C          DETAILS).
C
C  WORK    (WORKSPACE/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LWORK)
C          ON EXIT, IF INFO = 0, WORK(1) RETURNS THE OPTIMAL LWORK.
C
C  LWORK   (INPUT) INTEGER
C          THE DIMENSION OF THE ARRAY WORK.  LWORK >= MAX(1,M).
C          FOR OPTIMUM PERFORMANCE LWORK >= M*NB, WHERE NB IS THE
C          OPTIMAL BLOCKSIZE.
C
C          IF LWORK = -1, THEN A WORKSPACE QUERY IS ASSUMED; THE ROUTINE
C          ONLY CALCULATES THE OPTIMAL SIZE OF THE WORK ARRAY, RETURNS
C          THIS VALUE AS THE FIRST ENTRY OF THE WORK ARRAY, AND NO ERROR
C          MESSAGE RELATED TO LWORK IS ISSUED BY XERBLA.
C
C  INFO    (OUTPUT) INTEGER
C          = 0:  SUCCESSFUL EXIT
C          < 0:  IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C
C  FURTHER DETAILS
C  ===============
C
C  THE MATRIX Q IS REPRESENTED AS A PRODUCT OF ELEMENTARY REFLECTORS
C
C     Q = H(K) . . . H(2) H(1), WHERE K = MIN(M,N).
C
C  EACH H(I) HAS THE FORM
C
C     H(I) = I - TAU * V * V'
C
C  WHERE TAU IS A REAL SCALAR, AND V IS A REAL VECTOR WITH
C  V(1:I-1) = 0 AND V(I) = 1; V(I+1:N) IS STORED ON EXIT IN A(I,I+1:N),
C  AND TAU IN TAU(I).
C
C  =====================================================================
C
C     .. LOCAL SCALARS ..
      LOGICAL            LQUERY
      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
     $                   NBMIN, NX
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DGELQ2, DLARFB, DLARFT, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN
C     ..
C     .. EXTERNAL FUNCTIONS ..
      INTEGER            ILAENV
      EXTERNAL           ILAENV
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      NB = ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
      LWKOPT = M*NB
      WORK( 1 ) = LWKOPT
      LQUERY = ( LWORK.EQ.-1 )
      IF( M.LT.0 ) THEN
         INFO = -1
      ELSE IF( N.LT.0 ) THEN
         INFO = -2
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = -4
      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
         INFO = -7
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DGELQF', -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      K = MIN( M, N )
      IF( K.EQ.0 ) THEN
         WORK( 1 ) = 1
         RETURN
      END IF
C
      NBMIN = 2
      NX = 0
      IWS = M
      IF( NB.GT.1 .AND. NB.LT.K ) THEN
C
C        DETERMINE WHEN TO CROSS OVER FROM BLOCKED TO UNBLOCKED CODE.
C
         NX = MAX( 0, ILAENV( 3, 'DGELQF', ' ', M, N, -1, -1 ) )
         IF( NX.LT.K ) THEN
C
C           DETERMINE IF WORKSPACE IS LARGE ENOUGH FOR BLOCKED CODE.
C
            LDWORK = M
            IWS = LDWORK*NB
            IF( LWORK.LT.IWS ) THEN
C
C              NOT ENOUGH WORKSPACE TO USE OPTIMAL NB:  REDUCE NB AND
C              DETERMINE THE MINIMUM VALUE OF NB.
C
               NB = LWORK / LDWORK
               NBMIN = MAX( 2, ILAENV( 2, 'DGELQF', ' ', M, N, -1,
     $                 -1 ) )
            END IF
         END IF
      END IF
C
      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
C
C        USE BLOCKED CODE INITIALLY
C
         DO 10 I = 1, K - NX, NB
            IB = MIN( K-I+1, NB )
C
C           COMPUTE THE LQ FACTORIZATION OF THE CURRENT BLOCK
C           A(I:I+IB-1,I:N)
C
            CALL DGELQ2( IB, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
     $                   IINFO )
            IF( I+IB.LE.M ) THEN
C
C              FORM THE TRIANGULAR FACTOR OF THE BLOCK REFLECTOR
C              H = H(I) H(I+1) . . . H(I+IB-1)
C
               CALL DLARFT( 'FORWARD', 'ROWWISE', N-I+1, IB, A( I, I ),
     $                      LDA, TAU( I ), WORK, LDWORK )
C
C              APPLY H TO A(I+IB:M,I:N) FROM THE RIGHT
C
               CALL DLARFB( 'RIGHT', 'NO TRANSPOSE', 'FORWARD',
     $                      'ROWWISE', M-I-IB+1, N-I+1, IB, A( I, I ),
     $                      LDA, WORK, LDWORK, A( I+IB, I ), LDA,
     $                      WORK( IB+1 ), LDWORK )
            END IF
   10    CONTINUE
      ELSE
         I = 1
      END IF
C
C     USE UNBLOCKED CODE TO FACTOR THE LAST OR ONLY BLOCK.
C
      IF( I.LE.K )
     $   CALL DGELQ2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
     $                IINFO )
C
      WORK( 1 ) = IWS
      RETURN
C
C     END OF DGELQF
C
      END
C*MODEULE DGESVD  *DECK DORGLQ
      SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     JUNE 30, 1999
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            INFO, K, LDA, LWORK, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DORGLQ GENERATES AN M-BY-N REAL MATRIX Q WITH ORTHONORMAL ROWS,
C  WHICH IS DEFINED AS THE FIRST M ROWS OF A PRODUCT OF K ELEMENTARY
C  REFLECTORS OF ORDER N
C
C        Q  =  H(K) . . . H(2) H(1)
C
C  AS RETURNED BY DGELQF.
C
C  ARGUMENTS
C  =========
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX Q. M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX Q. N >= M.
C
C  K       (INPUT) INTEGER
C          THE NUMBER OF ELEMENTARY REFLECTORS WHOSE PRODUCT DEFINES THE
C          MATRIX Q. M >= K >= 0.
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          ON ENTRY, THE I-TH ROW MUST CONTAIN THE VECTOR WHICH DEFINES
C          THE ELEMENTARY REFLECTOR H(I), FOR I = 1,2,...,K, AS RETURNED
C          BY DGELQF IN THE FIRST K ROWS OF ITS ARRAY ARGUMENT A.
C          ON EXIT, THE M-BY-N MATRIX Q.
C
C  LDA     (INPUT) INTEGER
C          THE FIRST DIMENSION OF THE ARRAY A. LDA >= MAX(1,M).
C
C  TAU     (INPUT) DOUBLE PRECISION ARRAY, DIMENSION (K)
C          TAU(I) MUST CONTAIN THE SCALAR FACTOR OF THE ELEMENTARY
C          REFLECTOR H(I), AS RETURNED BY DGELQF.
C
C  WORK    (WORKSPACE/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LWORK)
C          ON EXIT, IF INFO = 0, WORK(1) RETURNS THE OPTIMAL LWORK.
C
C  LWORK   (INPUT) INTEGER
C          THE DIMENSION OF THE ARRAY WORK. LWORK >= MAX(1,M).
C          FOR OPTIMUM PERFORMANCE LWORK >= M*NB, WHERE NB IS
C          THE OPTIMAL BLOCKSIZE.
C
C          IF LWORK = -1, THEN A WORKSPACE QUERY IS ASSUMED; THE ROUTINE
C          ONLY CALCULATES THE OPTIMAL SIZE OF THE WORK ARRAY, RETURNS
C          THIS VALUE AS THE FIRST ENTRY OF THE WORK ARRAY, AND NO ERROR
C          MESSAGE RELATED TO LWORK IS ISSUED BY XERBLA.
C
C  INFO    (OUTPUT) INTEGER
C          = 0:  SUCCESSFUL EXIT
C          < 0:  IF INFO = -I, THE I-TH ARGUMENT HAS AN ILLEGAL VALUE
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ZERO
      PARAMETER          ( ZERO = 0.0D+0 )
C     ..
C     .. LOCAL SCALARS ..
      LOGICAL            LQUERY
      INTEGER            I, IB, IINFO, IWS, J, KI, KK, L, LDWORK,
     $                   LWKOPT, NB, NBMIN, NX
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLARFB, DLARFT, DORGL2, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN
C     ..
C     .. EXTERNAL FUNCTIONS ..
      INTEGER            ILAENV
      EXTERNAL           ILAENV
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      NB = ILAENV( 1, 'DORGLQ', ' ', M, N, K, -1 )
      LWKOPT = MAX( 1, M )*NB
      WORK( 1 ) = LWKOPT
      LQUERY = ( LWORK.EQ.-1 )
      IF( M.LT.0 ) THEN
         INFO = -1
      ELSE IF( N.LT.M ) THEN
         INFO = -2
      ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
         INFO = -3
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = -5
      ELSE IF( LWORK.LT.MAX( 1, M ) .AND. .NOT.LQUERY ) THEN
         INFO = -8
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DORGLQ', -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      IF( M.LE.0 ) THEN
         WORK( 1 ) = 1
         RETURN
      END IF
C
      NBMIN = 2
      NX = 0
      IWS = M
      IF( NB.GT.1 .AND. NB.LT.K ) THEN
C
C        DETERMINE WHEN TO CROSS OVER FROM BLOCKED TO UNBLOCKED CODE.
C
         NX = MAX( 0, ILAENV( 3, 'DORGLQ', ' ', M, N, K, -1 ) )
         IF( NX.LT.K ) THEN
C
C           DETERMINE IF WORKSPACE IS LARGE ENOUGH FOR BLOCKED CODE.
C
            LDWORK = M
            IWS = LDWORK*NB
            IF( LWORK.LT.IWS ) THEN
C
C              NOT ENOUGH WORKSPACE TO USE OPTIMAL NB:  REDUCE NB AND
C              DETERMINE THE MINIMUM VALUE OF NB.
C
               NB = LWORK / LDWORK
               NBMIN = MAX( 2, ILAENV( 2, 'DORGLQ', ' ', M, N, K, -1 ) )
            END IF
         END IF
      END IF
C
      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
C
C        USE BLOCKED CODE AFTER THE LAST BLOCK.
C        THE FIRST KK ROWS ARE HANDLED BY THE BLOCK METHOD.
C
         KI = ( ( K-NX-1 ) / NB )*NB
         KK = MIN( K, KI+NB )
C
C        SET A(KK+1:M,1:KK) TO ZERO.
C
         DO 20 J = 1, KK
            DO 10 I = KK + 1, M
               A( I, J ) = ZERO
   10       CONTINUE
   20    CONTINUE
      ELSE
         KK = 0
      END IF
C
C     USE UNBLOCKED CODE FOR THE LAST OR ONLY BLOCK.
C
      IF( KK.LT.M )
     $   CALL DORGL2( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
     $                TAU( KK+1 ), WORK, IINFO )
C
      IF( KK.GT.0 ) THEN
C
C        USE BLOCKED CODE
C
         DO 50 I = KI + 1, 1, -NB
            IB = MIN( NB, K-I+1 )
            IF( I+IB.LE.M ) THEN
C
C              FORM THE TRIANGULAR FACTOR OF THE BLOCK REFLECTOR
C              H = H(I) H(I+1) . . . H(I+IB-1)
C
               CALL DLARFT( 'FORWARD', 'ROWWISE', N-I+1, IB, A( I, I ),
     $                      LDA, TAU( I ), WORK, LDWORK )
C
C              APPLY H' TO A(I+IB:M,I:N) FROM THE RIGHT
C
               CALL DLARFB( 'RIGHT', 'TRANSPOSE', 'FORWARD', 'ROWWISE',
     $                      M-I-IB+1, N-I+1, IB, A( I, I ), LDA, WORK,
     $                      LDWORK, A( I+IB, I ), LDA, WORK( IB+1 ),
     $                      LDWORK )
            END IF
C
C           APPLY H' TO COLUMNS I:N OF CURRENT BLOCK
C
            CALL DORGL2( IB, N-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
     $                   IINFO )
C
C           SET COLUMNS 1:I-1 OF CURRENT BLOCK TO ZERO
C
            DO 40 J = 1, I - 1
               DO 30 L = I, I + IB - 1
                  A( L, J ) = ZERO
   30          CONTINUE
   40       CONTINUE
   50    CONTINUE
      END IF
C
      WORK( 1 ) = IWS
      RETURN
C
C     END OF DORGLQ
C
      END
C*MODULE DGESVD  *DECK DLABRD
      SUBROUTINE DLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
     $                   LDY )
C
C  -- LAPACK AUXILIARY ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     FEBRUARY 29, 1992
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            LDA, LDX, LDY, M, N, NB
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), D( * ), E( * ), TAUP( * ),
     $                   TAUQ( * ), X( LDX, * ), Y( LDY, * )
C     ..
C
C  PURPOSE
C  =======
C
C  DLABRD REDUCES THE FIRST NB ROWS AND COLUMNS OF A REAL GENERAL
C  M BY N MATRIX A TO UPPER OR LOWER BIDIAGONAL FORM BY AN ORTHOGONAL
C  TRANSFORMATION Q' * A * P, AND RETURNS THE MATRICES X AND Y WHICH
C  ARE NEEDED TO APPLY THE TRANSFORMATION TO THE UNREDUCED PART OF A.
C
C  IF M >= N, A IS REDUCED TO UPPER BIDIAGONAL FORM; IF M < N, TO LOWER
C  BIDIAGONAL FORM.
C
C  THIS IS AN AUXILIARY ROUTINE CALLED BY DGEBRD
C
C  ARGUMENTS
C  =========
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS IN THE MATRIX A.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS IN THE MATRIX A.
C
C  NB      (INPUT) INTEGER
C          THE NUMBER OF LEADING ROWS AND COLUMNS OF A TO BE REDUCED.
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          ON ENTRY, THE M BY N GENERAL MATRIX TO BE REDUCED.
C          ON EXIT, THE FIRST NB ROWS AND COLUMNS OF THE MATRIX ARE
C          OVERWRITTEN; THE REST OF THE ARRAY IS UNCHANGED.
C          IF M >= N, ELEMENTS ON AND BELOW THE DIAGONAL IN THE FIRST NB
C            COLUMNS, WITH THE ARRAY TAUQ, REPRESENT THE ORTHOGONAL
C            MATRIX Q AS A PRODUCT OF ELEMENTARY REFLECTORS; AND
C            ELEMENTS ABOVE THE DIAGONAL IN THE FIRST NB ROWS, WITH THE
C            ARRAY TAUP, REPRESENT THE ORTHOGONAL MATRIX P AS A PRODUCT
C            OF ELEMENTARY REFLECTORS.
C          IF M < N, ELEMENTS BELOW THE DIAGONAL IN THE FIRST NB
C            COLUMNS, WITH THE ARRAY TAUQ, REPRESENT THE ORTHOGONAL
C            MATRIX Q AS A PRODUCT OF ELEMENTARY REFLECTORS, AND
C            ELEMENTS ON AND ABOVE THE DIAGONAL IN THE FIRST NB ROWS,
C            WITH THE ARRAY TAUP, REPRESENT THE ORTHOGONAL MATRIX P AS
C            A PRODUCT OF ELEMENTARY REFLECTORS.
C          SEE FURTHER DETAILS.
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.  LDA >= MAX(1,M).
C
C  D       (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (NB)
C          THE DIAGONAL ELEMENTS OF THE FIRST NB ROWS AND COLUMNS OF
C          THE REDUCED MATRIX.  D(I) = A(I,I).
C
C  E       (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (NB)
C          THE OFF-DIAGONAL ELEMENTS OF THE FIRST NB ROWS AND COLUMNS OF
C          THE REDUCED MATRIX.
C
C  TAUQ    (OUTPUT) DOUBLE PRECISION ARRAY DIMENSION (NB)
C          THE SCALAR FACTORS OF THE ELEMENTARY REFLECTORS WHICH
C          REPRESENT THE ORTHOGONAL MATRIX Q. SEE FURTHER DETAILS.
C
C  TAUP    (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (NB)
C          THE SCALAR FACTORS OF THE ELEMENTARY REFLECTORS WHICH
C          REPRESENT THE ORTHOGONAL MATRIX P. SEE FURTHER DETAILS.
C
C  X       (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDX,NB)
C          THE M-BY-NB MATRIX X REQUIRED TO UPDATE THE UNREDUCED PART
C          OF A.
C
C  LDX     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY X. LDX >= M.
C
C  Y       (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDY,NB)
C          THE N-BY-NB MATRIX Y REQUIRED TO UPDATE THE UNREDUCED PART
C          OF A.
C
C  LDY     (OUTPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY Y. LDY >= N.
C
C  FURTHER DETAILS
C  ===============
C
C  THE MATRICES Q AND P ARE REPRESENTED AS PRODUCTS OF ELEMENTARY
C  REFLECTORS:
C
C     Q = H(1) H(2) . . . H(NB)  AND  P = G(1) G(2) . . . G(NB)
C
C  EACH H(I) AND G(I) HAS THE FORM:
C
C     H(I) = I - TAUQ * V * V'  AND G(I) = I - TAUP * U * U'
C
C  WHERE TAUQ AND TAUP ARE REAL SCALARS, AND V AND U ARE REAL VECTORS.
C
C  IF M >= N, V(1:I-1) = 0, V(I) = 1, AND V(I:M) IS STORED ON EXIT IN
C  A(I:M,I); U(1:I) = 0, U(I+1) = 1, AND U(I+1:N) IS STORED ON EXIT IN
C  A(I,I+1:N); TAUQ IS STORED IN TAUQ(I) AND TAUP IN TAUP(I).
C
C  IF M < N, V(1:I) = 0, V(I+1) = 1, AND V(I+1:M) IS STORED ON EXIT IN
C  A(I+2:M,I); U(1:I-1) = 0, U(I) = 1, AND U(I:N) IS STORED ON EXIT IN
C  A(I,I+1:N); TAUQ IS STORED IN TAUQ(I) AND TAUP IN TAUP(I).
C
C  THE ELEMENTS OF THE VECTORS V AND U TOGETHER FORM THE M-BY-NB MATRIX
C  V AND THE NB-BY-N MATRIX U' WHICH ARE NEEDED, WITH X AND Y, TO APPLY
C  THE TRANSFORMATION TO THE UNREDUCED PART OF THE MATRIX, USING A BLOCK
C  UPDATE OF THE FORM:  A := A - V*Y' - X*U'.
C
C  THE CONTENTS OF A ON EXIT ARE ILLUSTRATED BY THE FOLLOWING EXAMPLES
C  WITH NB = 2:
C
C  M = 6 AND N = 5 (M > N):          M = 5 AND N = 6 (M < N):
C
C    (  1   1   U1  U1  U1 )           (  1   U1  U1  U1  U1  U1 )
C    (  V1  1   1   U2  U2 )           (  1   1   U2  U2  U2  U2 )
C    (  V1  V2  A   A   A  )           (  V1  1   A   A   A   A  )
C    (  V1  V2  A   A   A  )           (  V1  V2  A   A   A   A  )
C    (  V1  V2  A   A   A  )           (  V1  V2  A   A   A   A  )
C    (  V1  V2  A   A   A  )
C
C  WHERE A DENOTES AN ELEMENT OF THE ORIGINAL MATRIX WHICH IS UNCHANGED,
C  VI DENOTES AN ELEMENT OF THE VECTOR DEFINING H(I), AND UI AN ELEMENT
C  OF THE VECTOR DEFINING G(I).
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ZERO, ONE
      PARAMETER          ( ZERO = 0.0D+00, ONE = 1.0D+00 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            I
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DGEMV, DLARFG, DSCAL
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MIN
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     QUICK RETURN IF POSSIBLE
C
      IF( M.LE.0 .OR. N.LE.0 )
     $   RETURN
C
      IF( M.GE.N ) THEN
C
C        REDUCE TO UPPER BIDIAGONAL FORM
C
         DO 10 I = 1, NB
C
C           UPDATE A(I:M,I)
C
            CALL DGEMV( 'NO TRANSPOSE', M-I+1, I-1, -ONE, A( I, 1 ),
     $                  LDA, Y( I, 1 ), LDY, ONE, A( I, I ), 1 )
            CALL DGEMV( 'NO TRANSPOSE', M-I+1, I-1, -ONE, X( I, 1 ),
     $                  LDX, A( 1, I ), 1, ONE, A( I, I ), 1 )
C
C           GENERATE REFLECTION Q(I) TO ANNIHILATE A(I+1:M,I)
C
            CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
     $                   TAUQ( I ) )
            D( I ) = A( I, I )
            IF( I.LT.N ) THEN
               A( I, I ) = ONE
C
C              COMPUTE Y(I+1:N,I)
C
               CALL DGEMV( 'TRANSPOSE', M-I+1, N-I, ONE, A( I, I+1 ),
     $                     LDA, A( I, I ), 1, ZERO, Y( I+1, I ), 1 )
               CALL DGEMV( 'TRANSPOSE', M-I+1, I-1, ONE, A( I, 1 ), LDA,
     $                     A( I, I ), 1, ZERO, Y( 1, I ), 1 )
               CALL DGEMV( 'NO TRANSPOSE', N-I, I-1, -ONE, Y( I+1, 1 ),
     $                     LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
               CALL DGEMV( 'TRANSPOSE', M-I+1, I-1, ONE, X( I, 1 ), LDX,
     $                     A( I, I ), 1, ZERO, Y( 1, I ), 1 )
               CALL DGEMV( 'TRANSPOSE', I-1, N-I, -ONE, A( 1, I+1 ),
     $                     LDA, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
               CALL DSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
C
C              UPDATE A(I,I+1:N)
C
               CALL DGEMV( 'NO TRANSPOSE', N-I, I, -ONE, Y( I+1, 1 ),
     $                     LDY, A( I, 1 ), LDA, ONE, A( I, I+1 ), LDA )
               CALL DGEMV( 'TRANSPOSE', I-1, N-I, -ONE, A( 1, I+1 ),
     $                     LDA, X( I, 1 ), LDX, ONE, A( I, I+1 ), LDA )
C
C              GENERATE REFLECTION P(I) TO ANNIHILATE A(I,I+2:N)
C
               CALL DLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
     $                      LDA, TAUP( I ) )
               E( I ) = A( I, I+1 )
               A( I, I+1 ) = ONE
C
C              COMPUTE X(I+1:M,I)
C
               CALL DGEMV( 'NO TRANSPOSE', M-I, N-I, ONE, A( I+1, I+1 ),
     $                     LDA, A( I, I+1 ), LDA, ZERO, X( I+1, I ), 1 )
               CALL DGEMV( 'TRANSPOSE', N-I, I, ONE, Y( I+1, 1 ), LDY,
     $                     A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
               CALL DGEMV( 'NO TRANSPOSE', M-I, I, -ONE, A( I+1, 1 ),
     $                     LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
               CALL DGEMV( 'NO TRANSPOSE', I-1, N-I, ONE, A( 1, I+1 ),
     $                     LDA, A( I, I+1 ), LDA, ZERO, X( 1, I ), 1 )
               CALL DGEMV( 'NO TRANSPOSE', M-I, I-1, -ONE, X( I+1, 1 ),
     $                     LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
               CALL DSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
            END IF
   10    CONTINUE
      ELSE
C
C        REDUCE TO LOWER BIDIAGONAL FORM
C
         DO 20 I = 1, NB
C
C           UPDATE A(I,I:N)
C
            CALL DGEMV( 'NO TRANSPOSE', N-I+1, I-1, -ONE, Y( I, 1 ),
     $                  LDY, A( I, 1 ), LDA, ONE, A( I, I ), LDA )
            CALL DGEMV( 'TRANSPOSE', I-1, N-I+1, -ONE, A( 1, I ), LDA,
     $                  X( I, 1 ), LDX, ONE, A( I, I ), LDA )
C
C           GENERATE REFLECTION P(I) TO ANNIHILATE A(I,I+1:N)
C
            CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
     $                   TAUP( I ) )
            D( I ) = A( I, I )
            IF( I.LT.M ) THEN
               A( I, I ) = ONE
C
C              COMPUTE X(I+1:M,I)
C
               CALL DGEMV( 'NO TRANSPOSE', M-I, N-I+1, ONE, A( I+1, I ),
     $                     LDA, A( I, I ), LDA, ZERO, X( I+1, I ), 1 )
               CALL DGEMV( 'TRANSPOSE', N-I+1, I-1, ONE, Y( I, 1 ), LDY,
     $                     A( I, I ), LDA, ZERO, X( 1, I ), 1 )
               CALL DGEMV( 'NO TRANSPOSE', M-I, I-1, -ONE, A( I+1, 1 ),
     $                     LDA, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
               CALL DGEMV( 'NO TRANSPOSE', I-1, N-I+1, ONE, A( 1, I ),
     $                     LDA, A( I, I ), LDA, ZERO, X( 1, I ), 1 )
               CALL DGEMV( 'NO TRANSPOSE', M-I, I-1, -ONE, X( I+1, 1 ),
     $                     LDX, X( 1, I ), 1, ONE, X( I+1, I ), 1 )
               CALL DSCAL( M-I, TAUP( I ), X( I+1, I ), 1 )
C
C              UPDATE A(I+1:M,I)
C
               CALL DGEMV( 'NO TRANSPOSE', M-I, I-1, -ONE, A( I+1, 1 ),
     $                     LDA, Y( I, 1 ), LDY, ONE, A( I+1, I ), 1 )
               CALL DGEMV( 'NO TRANSPOSE', M-I, I, -ONE, X( I+1, 1 ),
     $                     LDX, A( 1, I ), 1, ONE, A( I+1, I ), 1 )
C
C              GENERATE REFLECTION Q(I) TO ANNIHILATE A(I+2:M,I)
C
               CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
     $                      TAUQ( I ) )
               E( I ) = A( I+1, I )
               A( I+1, I ) = ONE
C
C              COMPUTE Y(I+1:N,I)
C
               CALL DGEMV( 'TRANSPOSE', M-I, N-I, ONE, A( I+1, I+1 ),
     $                     LDA, A( I+1, I ), 1, ZERO, Y( I+1, I ), 1 )
               CALL DGEMV( 'TRANSPOSE', M-I, I-1, ONE, A( I+1, 1 ), LDA,
     $                     A( I+1, I ), 1, ZERO, Y( 1, I ), 1 )
               CALL DGEMV( 'NO TRANSPOSE', N-I, I-1, -ONE, Y( I+1, 1 ),
     $                     LDY, Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
               CALL DGEMV( 'TRANSPOSE', M-I, I, ONE, X( I+1, 1 ), LDX,
     $                     A( I+1, I ), 1, ZERO, Y( 1, I ), 1 )
               CALL DGEMV( 'TRANSPOSE', I, N-I, -ONE, A( 1, I+1 ), LDA,
     $                     Y( 1, I ), 1, ONE, Y( I+1, I ), 1 )
               CALL DSCAL( N-I, TAUQ( I ), Y( I+1, I ), 1 )
            END IF
   20    CONTINUE
      END IF
      RETURN
C
C     END OF DLABRD
C
      END
C*MODULE DGESVD  *DECK DGEBD2
      SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     FEBRUARY 29, 1992
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            INFO, LDA, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), D( * ), E( * ), TAUP( * ),
     $                   TAUQ( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DGEBD2 REDUCES A REAL GENERAL M BY N MATRIX A TO UPPER OR LOWER
C  BIDIAGONAL FORM B BY AN ORTHOGONAL TRANSFORMATION: Q' * A * P = B.
C
C  IF M >= N, B IS UPPER BIDIAGONAL; IF M < N, B IS LOWER BIDIAGONAL.
C
C  ARGUMENTS
C  =========
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS IN THE MATRIX A.  M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS IN THE MATRIX A.  N >= 0.
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          ON ENTRY, THE M BY N GENERAL MATRIX TO BE REDUCED.
C          ON EXIT,
C          IF M >= N, THE DIAGONAL AND THE FIRST SUPERDIAGONAL ARE
C            OVERWRITTEN WITH THE UPPER BIDIAGONAL MATRIX B; THE
C            ELEMENTS BELOW THE DIAGONAL, WITH THE ARRAY TAUQ, REPRESENT
C            THE ORTHOGONAL MATRIX Q AS A PRODUCT OF ELEMENTARY
C            REFLECTORS, AND THE ELEMENTS ABOVE THE FIRST SUPERDIAGONAL,
C            WITH THE ARRAY TAUP, REPRESENT THE ORTHOGONAL MATRIX P AS
C            A PRODUCT OF ELEMENTARY REFLECTORS;
C          IF M < N, THE DIAGONAL AND THE FIRST SUBDIAGONAL ARE
C            OVERWRITTEN WITH THE LOWER BIDIAGONAL MATRIX B; THE
C            ELEMENTS BELOW THE FIRST SUBDIAGONAL, WITH THE ARRAY TAUQ,
C            REPRESENT THE ORTHOGONAL MATRIX Q AS A PRODUCT OF
C            ELEMENTARY REFLECTORS, AND THE ELEMENTS ABOVE THE DIAGONAL,
C            WITH THE ARRAY TAUP, REPRESENT THE ORTHOGONAL MATRIX P AS
C            A PRODUCT OF ELEMENTARY REFLECTORS.
C          SEE FURTHER DETAILS.
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.  LDA >= MAX(1,M).
C
C  D       (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(M,N))
C          THE DIAGONAL ELEMENTS OF THE BIDIAGONAL MATRIX B:
C          D(I) = A(I,I).
C
C  E       (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(M,N)-1)
C          THE OFF-DIAGONAL ELEMENTS OF THE BIDIAGONAL MATRIX B:
C          IF M >= N, E(I) = A(I,I+1) FOR I = 1,2,...,N-1;
C          IF M < N, E(I) = A(I+1,I) FOR I = 1,2,...,M-1.
C
C  TAUQ    (OUTPUT) DOUBLE PRECISION ARRAY DIMENSION (MIN(M,N))
C          THE SCALAR FACTORS OF THE ELEMENTARY REFLECTORS WHICH
C          REPRESENT THE ORTHOGONAL MATRIX Q. SEE FURTHER DETAILS.
C
C  TAUP    (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(M,N))
C          THE SCALAR FACTORS OF THE ELEMENTARY REFLECTORS WHICH
C          REPRESENT THE ORTHOGONAL MATRIX P. SEE FURTHER DETAILS.
C
C  WORK    (WORKSPACE) DOUBLE PRECISION ARRAY, DIMENSION (MAX(M,N))
C
C  INFO    (OUTPUT) INTEGER
C          = 0: SUCCESSFUL EXIT.
C          < 0: IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE.
C
C  FURTHER DETAILS
C  ===============
C
C  THE MATRICES Q AND P ARE REPRESENTED AS PRODUCTS OF ELEMENTARY
C  REFLECTORS:
C
C  IF M >= N,
C
C     Q = H(1) H(2) . . . H(N)  AND  P = G(1) G(2) . . . G(N-1)
C
C  EACH H(I) AND G(I) HAS THE FORM:
C
C     H(I) = I - TAUQ * V * V'  AND G(I) = I - TAUP * U * U'
C
C  WHERE TAUQ AND TAUP ARE REAL SCALARS, AND V AND U ARE REAL VECTORS;
C  V(1:I-1) = 0, V(I) = 1, AND V(I+1:M) IS STORED ON EXIT IN A(I+1:M,I);
C  U(1:I) = 0, U(I+1) = 1, AND U(I+2:N) IS STORED ON EXIT IN A(I,I+2:N);
C  TAUQ IS STORED IN TAUQ(I) AND TAUP IN TAUP(I).
C
C  IF M < N,
C
C     Q = H(1) H(2) . . . H(M-1)  AND  P = G(1) G(2) . . . G(M)
C
C  EACH H(I) AND G(I) HAS THE FORM:
C
C     H(I) = I - TAUQ * V * V'  AND G(I) = I - TAUP * U * U'
C
C  WHERE TAUQ AND TAUP ARE REAL SCALARS, AND V AND U ARE REAL VECTORS;
C  V(1:I) = 0, V(I+1) = 1, AND V(I+2:M) IS STORED ON EXIT IN A(I+2:M,I);
C  U(1:I-1) = 0, U(I) = 1, AND U(I+1:N) IS STORED ON EXIT IN A(I,I+1:N);
C  TAUQ IS STORED IN TAUQ(I) AND TAUP IN TAUP(I).
C
C  THE CONTENTS OF A ON EXIT ARE ILLUSTRATED BY THE FOLLOWING EXAMPLES:
C
C  M = 6 AND N = 5 (M > N):          M = 5 AND N = 6 (M < N):
C
C    (  D   E   U1  U1  U1 )           (  D   U1  U1  U1  U1  U1 )
C    (  V1  D   E   U2  U2 )           (  E   D   U2  U2  U2  U2 )
C    (  V1  V2  D   E   U3 )           (  V1  E   D   U3  U3  U3 )
C    (  V1  V2  V3  D   E  )           (  V1  V2  E   D   U4  U4 )
C    (  V1  V2  V3  V4  D  )           (  V1  V2  V3  E   D   U5 )
C    (  V1  V2  V3  V4  V5 )
C
C  WHERE D AND E DENOTE DIAGONAL AND OFF-DIAGONAL ELEMENTS OF B, VI
C  DENOTES AN ELEMENT OF THE VECTOR DEFINING H(I), AND UI AN ELEMENT OF
C  THE VECTOR DEFINING G(I).
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ZERO, ONE
      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            I
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLARF, DLARFG, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT PARAMETERS
C
      INFO = 0
      IF( M.LT.0 ) THEN
         INFO = -1
      ELSE IF( N.LT.0 ) THEN
         INFO = -2
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = -4
      END IF
      IF( INFO.LT.0 ) THEN
         CALL XERBLA( 'DGEBD2', -INFO )
         RETURN
      END IF
C
      IF( M.GE.N ) THEN
C
C        REDUCE TO UPPER BIDIAGONAL FORM
C
         DO 10 I = 1, N
C
C           GENERATE ELEMENTARY REFLECTOR H(I) TO ANNIHILATE A(I+1:M,I)
C
            CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
     $                   TAUQ( I ) )
            D( I ) = A( I, I )
            A( I, I ) = ONE
C
C           APPLY H(I) TO A(I:M,I+1:N) FROM THE LEFT
C
            CALL DLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAUQ( I ),
     $                  A( I, I+1 ), LDA, WORK )
            A( I, I ) = D( I )
C
            IF( I.LT.N ) THEN
C
C              GENERATE ELEMENTARY REFLECTOR G(I) TO ANNIHILATE
C              A(I,I+2:N)
C
               CALL DLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
     $                      LDA, TAUP( I ) )
               E( I ) = A( I, I+1 )
               A( I, I+1 ) = ONE
C
C              APPLY G(I) TO A(I+1:M,I+1:N) FROM THE RIGHT
C
               CALL DLARF( 'RIGHT', M-I, N-I, A( I, I+1 ), LDA,
     $                     TAUP( I ), A( I+1, I+1 ), LDA, WORK )
               A( I, I+1 ) = E( I )
            ELSE
               TAUP( I ) = ZERO
            END IF
   10    CONTINUE
      ELSE
C
C        REDUCE TO LOWER BIDIAGONAL FORM
C
         DO 20 I = 1, M
C
C           GENERATE ELEMENTARY REFLECTOR G(I) TO ANNIHILATE A(I,I+1:N)
C
            CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
     $                   TAUP( I ) )
            D( I ) = A( I, I )
            A( I, I ) = ONE
C
C           APPLY G(I) TO A(I+1:M,I:N) FROM THE RIGHT
C
            CALL DLARF( 'RIGHT', M-I, N-I+1, A( I, I ), LDA, TAUP( I ),
     $                  A( MIN( I+1, M ), I ), LDA, WORK )
            A( I, I ) = D( I )
C
            IF( I.LT.M ) THEN
C
C              GENERATE ELEMENTARY REFLECTOR H(I) TO ANNIHILATE
C              A(I+2:M,I)
C
               CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
     $                      TAUQ( I ) )
               E( I ) = A( I+1, I )
               A( I+1, I ) = ONE
C
C              APPLY H(I) TO A(I+1:M,I+1:N) FROM THE LEFT
C
               CALL DLARF( 'LEFT', M-I, N-I, A( I+1, I ), 1, TAUQ( I ),
     $                     A( I+1, I+1 ), LDA, WORK )
               A( I+1, I ) = E( I )
            ELSE
               TAUQ( I ) = ZERO
            END IF
   20    CONTINUE
      END IF
      RETURN
C
C     END OF DGEBD2
C
      END
C*MODULE DGESVD  *DECK DORGL2
      SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     JUNE 30, 1999
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            INFO, K, LDA, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DORGL2 GENERATES AN M BY N REAL MATRIX Q WITH ORTHONORMAL ROWS,
C  WHICH IS DEFINED AS THE FIRST M ROWS OF A PRODUCT OF K ELEMENTARY
C  REFLECTORS OF ORDER N
C
C        Q  =  H(K) . . . H(2) H(1)
C
C  AS RETURNED BY DGELQF.
C
C  ARGUMENTS
C  =========
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX Q. M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX Q. N >= M.
C
C  K       (INPUT) INTEGER
C          THE NUMBER OF ELEMENTARY REFLECTORS WHOSE PRODUCT DEFINES THE
C          MATRIX Q. M >= K >= 0.
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          ON ENTRY, THE I-TH ROW MUST CONTAIN THE VECTOR WHICH DEFINES
C          THE ELEMENTARY REFLECTOR H(I), FOR I = 1,2,...,K, AS RETURNED
C          BY DGELQF IN THE FIRST K ROWS OF ITS ARRAY ARGUMENT A.
C          ON EXIT, THE M-BY-N MATRIX Q.
C
C  LDA     (INPUT) INTEGER
C          THE FIRST DIMENSION OF THE ARRAY A. LDA >= MAX(1,M).
C
C  TAU     (INPUT) DOUBLE PRECISION ARRAY, DIMENSION (K)
C          TAU(I) MUST CONTAIN THE SCALAR FACTOR OF THE ELEMENTARY
C          REFLECTOR H(I), AS RETURNED BY DGELQF.
C
C  WORK    (WORKSPACE) DOUBLE PRECISION ARRAY, DIMENSION (M)
C
C  INFO    (OUTPUT) INTEGER
C          = 0: SUCCESSFUL EXIT
C          < 0: IF INFO = -I, THE I-TH ARGUMENT HAS AN ILLEGAL VALUE
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ONE, ZERO
      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            I, J, L
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLARF, DSCAL, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      IF( M.LT.0 ) THEN
         INFO = -1
      ELSE IF( N.LT.M ) THEN
         INFO = -2
      ELSE IF( K.LT.0 .OR. K.GT.M ) THEN
         INFO = -3
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = -5
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DORGL2', -INFO )
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      IF( M.LE.0 )
     $   RETURN
C
      IF( K.LT.M ) THEN
C
C        INITIALISE ROWS K+1:M TO ROWS OF THE UNIT MATRIX
C
         DO 20 J = 1, N
            DO 10 L = K + 1, M
               A( L, J ) = ZERO
   10       CONTINUE
            IF( J.GT.K .AND. J.LE.M )
     $         A( J, J ) = ONE
   20    CONTINUE
      END IF
C
      DO 40 I = K, 1, -1
C
C        APPLY H(I) TO A(I:M,I:N) FROM THE RIGHT
C
         IF( I.LT.N ) THEN
            IF( I.LT.M ) THEN
               A( I, I ) = ONE
               CALL DLARF( 'RIGHT', M-I, N-I+1, A( I, I ), LDA,
     $                     TAU( I ), A( I+1, I ), LDA, WORK )
            END IF
            CALL DSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA )
         END IF
         A( I, I ) = ONE - TAU( I )
C
C        SET A(I,1:I-1) TO ZERO
C
         DO 30 L = 1, I - 1
            A( I, L ) = ZERO
   30    CONTINUE
   40 CONTINUE
      RETURN
C
C     END OF DORGL2
C
      END
C*MODULE DGESVD  *DECK DLASR
      SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
C
C  -- LAPACK AUXILIARY ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     OCTOBER 31, 1992
C
C     .. SCALAR ARGUMENTS ..
      CHARACTER          DIRECT, PIVOT, SIDE
      INTEGER            LDA, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), C( * ), S( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DLASR   PERFORMS THE TRANSFORMATION
C
C     A := P*A,   WHEN SIDE = 'L' OR 'L'  (  LEFT-HAND SIDE )
C
C     A := A*P',  WHEN SIDE = 'R' OR 'R'  ( RIGHT-HAND SIDE )
C
C  WHERE A IS AN M BY N REAL MATRIX AND P IS AN ORTHOGONAL MATRIX,
C  CONSISTING OF A SEQUENCE OF PLANE ROTATIONS DETERMINED BY THE
C  PARAMETERS PIVOT AND DIRECT AS FOLLOWS ( Z = M WHEN SIDE = 'L' OR 'L'
C  AND Z = N WHEN SIDE = 'R' OR 'R' ):
C
C  WHEN  DIRECT = 'F' OR 'F'  ( FORWARD SEQUENCE ) THEN
C
C     P = P( Z - 1 )*...*P( 2 )*P( 1 ),
C
C  AND WHEN DIRECT = 'B' OR 'B'  ( BACKWARD SEQUENCE ) THEN
C
C     P = P( 1 )*P( 2 )*...*P( Z - 1 ),
C
C  WHERE  P( K ) IS A PLANE ROTATION MATRIX FOR THE FOLLOWING PLANES:
C
C     WHEN  PIVOT = 'V' OR 'V'  ( VARIABLE PIVOT ),
C        THE PLANE ( K, K + 1 )
C
C     WHEN  PIVOT = 'T' OR 'T'  ( TOP PIVOT ),
C        THE PLANE ( 1, K + 1 )
C
C     WHEN  PIVOT = 'B' OR 'B'  ( BOTTOM PIVOT ),
C        THE PLANE ( K, Z )
C
C  C( K ) AND S( K )  MUST CONTAIN THE  COSINE AND SINE THAT DEFINE THE
C  MATRIX  P( K ).  THE TWO BY TWO PLANE ROTATION PART OF THE MATRIX
C  P( K ), R( K ), IS ASSUMED TO BE OF THE FORM
C
C     R( K ) = (  C( K )  S( K ) ).
C              ( -S( K )  C( K ) )
C
C  THIS VERSION VECTORISES ACROSS ROWS OF THE ARRAY A WHEN SIDE = 'L'.
C
C  ARGUMENTS
C  =========
C
C  SIDE    (INPUT) CHARACTER*1
C          SPECIFIES WHETHER THE PLANE ROTATION MATRIX P IS APPLIED TO
C          A ON THE LEFT OR THE RIGHT.
C          = 'L':  LEFT, COMPUTE A := P*A
C          = 'R':  RIGHT, COMPUTE A:= A*P'
C
C  DIRECT  (INPUT) CHARACTER*1
C          SPECIFIES WHETHER P IS A FORWARD OR BACKWARD SEQUENCE OF
C          PLANE ROTATIONS.
C          = 'F':  FORWARD, P = P( Z - 1 )*...*P( 2 )*P( 1 )
C          = 'B':  BACKWARD, P = P( 1 )*P( 2 )*...*P( Z - 1 )
C
C  PIVOT   (INPUT) CHARACTER*1
C          SPECIFIES THE PLANE FOR WHICH P(K) IS A PLANE ROTATION
C          MATRIX.
C          = 'V':  VARIABLE PIVOT, THE PLANE (K,K+1)
C          = 'T':  TOP PIVOT, THE PLANE (1,K+1)
C          = 'B':  BOTTOM PIVOT, THE PLANE (K,Z)
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX A.  IF M <= 1, AN IMMEDIATE
C          RETURN IS EFFECTED.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX A.  IF N <= 1, AN
C          IMMEDIATE RETURN IS EFFECTED.
C
C  C, S    (INPUT) DOUBLE PRECISION ARRAYS, DIMENSION
C                  (M-1) IF SIDE = 'L'
C                  (N-1) IF SIDE = 'R'
C          C(K) AND S(K) CONTAIN THE COSINE AND SINE THAT DEFINE THE
C          MATRIX P(K).  THE TWO BY TWO PLANE ROTATION PART OF THE
C          MATRIX P(K), R(K), IS ASSUMED TO BE OF THE FORM
C          R( K ) = (  C( K )  S( K ) ).
C                   ( -S( K )  C( K ) )
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          THE M BY N MATRIX A.  ON EXIT, A IS OVERWRITTEN BY P*A IF
C          SIDE = 'R' OR BY A*P' IF SIDE = 'L'.
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.  LDA >= MAX(1,M).
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ONE, ZERO
      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            I, INFO, J
      DOUBLE PRECISION   CTEMP, STEMP, TEMP
C     ..
C     .. EXTERNAL FUNCTIONS ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT PARAMETERS
C
      INFO = 0
      IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN
         INFO = 1
      ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT,
     $         'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN
         INFO = 2
      ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) )
     $          THEN
         INFO = 3
      ELSE IF( M.LT.0 ) THEN
         INFO = 4
      ELSE IF( N.LT.0 ) THEN
         INFO = 5
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = 9
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DLASR ', INFO )
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
     $   RETURN
      IF( LSAME( SIDE, 'L' ) ) THEN
C
C        FORM  P * A
C
         IF( LSAME( PIVOT, 'V' ) ) THEN
            IF( LSAME( DIRECT, 'F' ) ) THEN
               DO 20 J = 1, M - 1
                  CTEMP = C( J )
                  STEMP = S( J )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 10 I = 1, N
                        TEMP = A( J+1, I )
                        A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
                        A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
   10                CONTINUE
                  END IF
   20          CONTINUE
            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
               DO 40 J = M - 1, 1, -1
                  CTEMP = C( J )
                  STEMP = S( J )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 30 I = 1, N
                        TEMP = A( J+1, I )
                        A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I )
                        A( J, I ) = STEMP*TEMP + CTEMP*A( J, I )
   30                CONTINUE
                  END IF
   40          CONTINUE
            END IF
         ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
            IF( LSAME( DIRECT, 'F' ) ) THEN
               DO 60 J = 2, M
                  CTEMP = C( J-1 )
                  STEMP = S( J-1 )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 50 I = 1, N
                        TEMP = A( J, I )
                        A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
                        A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
   50                CONTINUE
                  END IF
   60          CONTINUE
            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
               DO 80 J = M, 2, -1
                  CTEMP = C( J-1 )
                  STEMP = S( J-1 )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 70 I = 1, N
                        TEMP = A( J, I )
                        A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I )
                        A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I )
   70                CONTINUE
                  END IF
   80          CONTINUE
            END IF
         ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
            IF( LSAME( DIRECT, 'F' ) ) THEN
               DO 100 J = 1, M - 1
                  CTEMP = C( J )
                  STEMP = S( J )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 90 I = 1, N
                        TEMP = A( J, I )
                        A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
                        A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
   90                CONTINUE
                  END IF
  100          CONTINUE
            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
               DO 120 J = M - 1, 1, -1
                  CTEMP = C( J )
                  STEMP = S( J )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 110 I = 1, N
                        TEMP = A( J, I )
                        A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP
                        A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP
  110                CONTINUE
                  END IF
  120          CONTINUE
            END IF
         END IF
      ELSE IF( LSAME( SIDE, 'R' ) ) THEN
C
C        FORM A * P'
C
         IF( LSAME( PIVOT, 'V' ) ) THEN
            IF( LSAME( DIRECT, 'F' ) ) THEN
               DO 140 J = 1, N - 1
                  CTEMP = C( J )
                  STEMP = S( J )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 130 I = 1, M
                        TEMP = A( I, J+1 )
                        A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
                        A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
  130                CONTINUE
                  END IF
  140          CONTINUE
            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
               DO 160 J = N - 1, 1, -1
                  CTEMP = C( J )
                  STEMP = S( J )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 150 I = 1, M
                        TEMP = A( I, J+1 )
                        A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J )
                        A( I, J ) = STEMP*TEMP + CTEMP*A( I, J )
  150                CONTINUE
                  END IF
  160          CONTINUE
            END IF
         ELSE IF( LSAME( PIVOT, 'T' ) ) THEN
            IF( LSAME( DIRECT, 'F' ) ) THEN
               DO 180 J = 2, N
                  CTEMP = C( J-1 )
                  STEMP = S( J-1 )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 170 I = 1, M
                        TEMP = A( I, J )
                        A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
                        A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
  170                CONTINUE
                  END IF
  180          CONTINUE
            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
               DO 200 J = N, 2, -1
                  CTEMP = C( J-1 )
                  STEMP = S( J-1 )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 190 I = 1, M
                        TEMP = A( I, J )
                        A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 )
                        A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 )
  190                CONTINUE
                  END IF
  200          CONTINUE
            END IF
         ELSE IF( LSAME( PIVOT, 'B' ) ) THEN
            IF( LSAME( DIRECT, 'F' ) ) THEN
               DO 220 J = 1, N - 1
                  CTEMP = C( J )
                  STEMP = S( J )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 210 I = 1, M
                        TEMP = A( I, J )
                        A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
                        A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
  210                CONTINUE
                  END IF
  220          CONTINUE
            ELSE IF( LSAME( DIRECT, 'B' ) ) THEN
               DO 240 J = N - 1, 1, -1
                  CTEMP = C( J )
                  STEMP = S( J )
                  IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN
                     DO 230 I = 1, M
                        TEMP = A( I, J )
                        A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP
                        A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP
  230                CONTINUE
                  END IF
  240          CONTINUE
            END IF
         END IF
      END IF
C
      RETURN
C
C     END OF DLASR
C
      END
C*MODULE DGESVD  *DECK DLASV2
      SUBROUTINE DLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
C
C  -- LAPACK AUXILIARY ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     OCTOBER 31, 1992
C
C     .. SCALAR ARGUMENTS ..
      DOUBLE PRECISION   CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
C     ..
C
C  PURPOSE
C  =======
C
C  DLASV2 COMPUTES THE SINGULAR VALUE DECOMPOSITION OF A 2-BY-2
C  TRIANGULAR MATRIX
C     [  F   G  ]
C     [  0   H  ].
C  ON RETURN, ABS(SSMAX) IS THE LARGER SINGULAR VALUE, ABS(SSMIN) IS THE
C  SMALLER SINGULAR VALUE, AND (CSL,SNL) AND (CSR,SNR) ARE THE LEFT AND
C  RIGHT SINGULAR VECTORS FOR ABS(SSMAX), GIVING THE DECOMPOSITION
C
C     [ CSL  SNL ] [  F   G  ] [ CSR -SNR ]  =  [ SSMAX   0   ]
C     [-SNL  CSL ] [  0   H  ] [ SNR  CSR ]     [  0    SSMIN ].
C
C  ARGUMENTS
C  =========
C
C  F       (INPUT) DOUBLE PRECISION
C          THE (1,1) ELEMENT OF THE 2-BY-2 MATRIX.
C
C  G       (INPUT) DOUBLE PRECISION
C          THE (1,2) ELEMENT OF THE 2-BY-2 MATRIX.
C
C  H       (INPUT) DOUBLE PRECISION
C          THE (2,2) ELEMENT OF THE 2-BY-2 MATRIX.
C
C  SSMIN   (OUTPUT) DOUBLE PRECISION
C          ABS(SSMIN) IS THE SMALLER SINGULAR VALUE.
C
C  SSMAX   (OUTPUT) DOUBLE PRECISION
C          ABS(SSMAX) IS THE LARGER SINGULAR VALUE.
C
C  SNL     (OUTPUT) DOUBLE PRECISION
C  CSL     (OUTPUT) DOUBLE PRECISION
C          THE VECTOR (CSL, SNL) IS A UNIT LEFT SINGULAR VECTOR FOR THE
C          SINGULAR VALUE ABS(SSMAX).
C
C  SNR     (OUTPUT) DOUBLE PRECISION
C  CSR     (OUTPUT) DOUBLE PRECISION
C          THE VECTOR (CSR, SNR) IS A UNIT RIGHT SINGULAR VECTOR FOR THE
C          SINGULAR VALUE ABS(SSMAX).
C
C  FURTHER DETAILS
C  ===============
C
C  ANY INPUT PARAMETER MAY BE ALIASED WITH ANY OUTPUT PARAMETER.
C
C  BARRING OVER/UNDERFLOW AND ASSUMING A GUARD DIGIT IN SUBTRACTION, ALL
C  OUTPUT QUANTITIES ARE CORRECT TO WITHIN A FEW UNITS IN THE LAST
C  PLACE (ULPS).
C
C  IN IEEE ARITHMETIC, THE CODE WORKS CORRECTLY IF ONE MATRIX ELEMENT IS
C  INFINITE.
C
C  OVERFLOW WILL NOT OCCUR UNLESS THE LARGEST SINGULAR VALUE ITSELF
C  OVERFLOWS OR IS WITHIN A FEW ULPS OF OVERFLOW. (ON MACHINES WITH
C  PARTIAL OVERFLOW, LIKE THE CRAY, OVERFLOW MAY OCCUR IF THE LARGEST
C  SINGULAR VALUE IS WITHIN A FACTOR OF 2 OF OVERFLOW.)
C
C  UNDERFLOW IS HARMLESS IF UNDERFLOW IS GRADUAL. OTHERWISE, RESULTS
C  MAY CORRESPOND TO A MATRIX MODIFIED BY PERTURBATIONS OF SIZE NEAR
C  THE UNDERFLOW THRESHOLD.
C
C =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ZERO
      PARAMETER          ( ZERO = 0.0D+00 )
      DOUBLE PRECISION   HALF
      PARAMETER          ( HALF = 0.5D+00 )
      DOUBLE PRECISION   ONE
      PARAMETER          ( ONE = 1.0D+00 )
      DOUBLE PRECISION   TWO
      PARAMETER          ( TWO = 2.0D+00 )
      DOUBLE PRECISION   FOUR
      PARAMETER          ( FOUR = 4.0D+00 )
C     ..
C     .. LOCAL SCALARS ..
      LOGICAL            GASMAL, SWAP
      INTEGER            PMAX
      DOUBLE PRECISION   A, CLT, CRT, D, FA, FT, GA, GT, HA, HT, L, M,
     $                   MM, R, S, SLT, SRT, T, TEMP, TSIGN, TT
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          ABS, SIGN, SQRT
C     ..
C     .. EXTERNAL FUNCTIONS ..
      DOUBLE PRECISION   DLAMCH
      EXTERNAL           DLAMCH
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
      FT = F
      FA = ABS( FT )
      HT = H
      HA = ABS( H )
C
C     PMAX POINTS TO THE MAXIMUM ABSOLUTE ELEMENT OF MATRIX
C       PMAX = 1 IF F LARGEST IN ABSOLUTE VALUES
C       PMAX = 2 IF G LARGEST IN ABSOLUTE VALUES
C       PMAX = 3 IF H LARGEST IN ABSOLUTE VALUES
C
      PMAX = 1
      SWAP = ( HA.GT.FA )
      IF( SWAP ) THEN
         PMAX = 3
         TEMP = FT
         FT = HT
         HT = TEMP
         TEMP = FA
         FA = HA
         HA = TEMP
C
C        NOW FA .GE. HA
C
      END IF
      GT = G
      GA = ABS( GT )
      IF( GA.EQ.ZERO ) THEN
C
C        DIAGONAL MATRIX
C
         SSMIN = HA
         SSMAX = FA
         CLT = ONE
         CRT = ONE
         SLT = ZERO
         SRT = ZERO
      ELSE
         GASMAL = .TRUE.
         IF( GA.GT.FA ) THEN
            PMAX = 2
            IF( ( FA / GA ).LT.DLAMCH( 'EPS' ) ) THEN
C
C              CASE OF VERY LARGE GA
C
               GASMAL = .FALSE.
               SSMAX = GA
               IF( HA.GT.ONE ) THEN
                  SSMIN = FA / ( GA / HA )
               ELSE
                  SSMIN = ( FA / GA )*HA
               END IF
               CLT = ONE
               SLT = HT / GT
               SRT = ONE
               CRT = FT / GT
            END IF
         END IF
         IF( GASMAL ) THEN
C
C           NORMAL CASE
C
            D = FA - HA
            IF( D.EQ.FA ) THEN
C
C              COPES WITH INFINITE F OR H
C
               L = ONE
            ELSE
               L = D / FA
            END IF
C
C           NOTE THAT 0 .LE. L .LE. 1
C
            M = GT / FT
C
C           NOTE THAT ABS(M) .LE. 1/MACHEPS
C
            T = TWO - L
C
C           NOTE THAT T .GE. 1
C
            MM = M*M
            TT = T*T
            S = SQRT( TT+MM )
C
C           NOTE THAT 1 .LE. S .LE. 1 + 1/MACHEPS
C
            IF( L.EQ.ZERO ) THEN
               R = ABS( M )
            ELSE
               R = SQRT( L*L+MM )
            END IF
C
C           NOTE THAT 0 .LE. R .LE. 1 + 1/MACHEPS
C
            A = HALF*( S+R )
C
C           NOTE THAT 1 .LE. A .LE. 1 + ABS(M)
C
            SSMIN = HA / A
            SSMAX = FA*A
            IF( MM.EQ.ZERO ) THEN
C
C              NOTE THAT M IS VERY TINY
C
               IF( L.EQ.ZERO ) THEN
                  T = SIGN( TWO, FT )*SIGN( ONE, GT )
               ELSE
                  T = GT / SIGN( D, FT ) + M / T
               END IF
            ELSE
               T = ( M / ( S+T )+M / ( R+L ) )*( ONE+A )
            END IF
            L = SQRT( T*T+FOUR )
            CRT = TWO / L
            SRT = T / L
            CLT = ( CRT+SRT*M ) / A
            SLT = ( HT / FT )*SRT / A
         END IF
      END IF
      IF( SWAP ) THEN
         CSL = SRT
         SNL = CRT
         CSR = SLT
         SNR = CLT
      ELSE
         CSL = CLT
         SNL = SLT
         CSR = CRT
         SNR = SRT
      END IF
C
C     CORRECT SIGNS OF SSMAX AND SSMIN
C
      IF( PMAX.EQ.1 )
     $   TSIGN = SIGN( ONE, CSR )*SIGN( ONE, CSL )*SIGN( ONE, F )
      IF( PMAX.EQ.2 )
     $   TSIGN = SIGN( ONE, SNR )*SIGN( ONE, CSL )*SIGN( ONE, G )
      IF( PMAX.EQ.3 )
     $   TSIGN = SIGN( ONE, SNR )*SIGN( ONE, SNL )*SIGN( ONE, H )
      SSMAX = SIGN( SSMAX, TSIGN )
      SSMIN = SIGN( SSMIN, TSIGN*SIGN( ONE, F )*SIGN( ONE, H ) )
      RETURN
C
C     END OF DLASV2
C
      END
C*MODULE DGESVD  *DECK DLAS2
      SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX )
C
C  -- LAPACK AUXILIARY ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     SEPTEMBER 30, 1994
C
C     .. SCALAR ARGUMENTS ..
      DOUBLE PRECISION   F, G, H, SSMAX, SSMIN
C     ..
C
C  PURPOSE
C  =======
C
C  DLAS2  COMPUTES THE SINGULAR VALUES OF THE 2-BY-2 MATRIX
C     [  F   G  ]
C     [  0   H  ].
C  ON RETURN, SSMIN IS THE SMALLER SINGULAR VALUE AND SSMAX IS THE
C  LARGER SINGULAR VALUE.
C
C  ARGUMENTS
C  =========
C
C  F       (INPUT) DOUBLE PRECISION
C          THE (1,1) ELEMENT OF THE 2-BY-2 MATRIX.
C
C  G       (INPUT) DOUBLE PRECISION
C          THE (1,2) ELEMENT OF THE 2-BY-2 MATRIX.
C
C  H       (INPUT) DOUBLE PRECISION
C          THE (2,2) ELEMENT OF THE 2-BY-2 MATRIX.
C
C  SSMIN   (OUTPUT) DOUBLE PRECISION
C          THE SMALLER SINGULAR VALUE.
C
C  SSMAX   (OUTPUT) DOUBLE PRECISION
C          THE LARGER SINGULAR VALUE.
C
C  FURTHER DETAILS
C  ===============
C
C  BARRING OVER/UNDERFLOW, ALL OUTPUT QUANTITIES ARE CORRECT TO WITHIN
C  A FEW UNITS IN THE LAST PLACE (ULPS), EVEN IN THE ABSENCE OF A GUARD
C  DIGIT IN ADDITION/SUBTRACTION.
C
C  IN IEEE ARITHMETIC, THE CODE WORKS CORRECTLY IF ONE MATRIX ELEMENT IS
C  INFINITE.
C
C  OVERFLOW WILL NOT OCCUR UNLESS THE LARGEST SINGULAR VALUE ITSELF
C  OVERFLOWS, OR IS WITHIN A FEW ULPS OF OVERFLOW. (ON MACHINES WITH
C  PARTIAL OVERFLOW, LIKE THE CRAY, OVERFLOW MAY OCCUR IF THE LARGEST
C  SINGULAR VALUE IS WITHIN A FACTOR OF 2 OF OVERFLOW.)
C
C  UNDERFLOW IS HARMLESS IF UNDERFLOW IS GRADUAL. OTHERWISE, RESULTS
C  MAY CORRESPOND TO A MATRIX MODIFIED BY PERTURBATIONS OF SIZE NEAR
C  THE UNDERFLOW THRESHOLD.
C
C  ====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ZERO
      PARAMETER          ( ZERO = 0.0D+00 )
      DOUBLE PRECISION   ONE
      PARAMETER          ( ONE = 1.0D+00 )
      DOUBLE PRECISION   TWO
      PARAMETER          ( TWO = 2.0D+00 )
C     ..
C     .. LOCAL SCALARS ..
      DOUBLE PRECISION   AS, AT, AU, C, FA, FHMN, FHMX, GA, HA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          ABS, MAX, MIN, SQRT
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
      FA = ABS( F )
      GA = ABS( G )
      HA = ABS( H )
      FHMN = MIN( FA, HA )
      FHMX = MAX( FA, HA )
      IF( FHMN.EQ.ZERO ) THEN
         SSMIN = ZERO
         IF( FHMX.EQ.ZERO ) THEN
            SSMAX = GA
         ELSE
            SSMAX = MAX( FHMX, GA )*SQRT( ONE+
     $              ( MIN( FHMX, GA ) / MAX( FHMX, GA ) )**2 )
         END IF
      ELSE
         IF( GA.LT.FHMX ) THEN
            AS = ONE + FHMN / FHMX
            AT = ( FHMX-FHMN ) / FHMX
            AU = ( GA / FHMX )**2
            C = TWO / ( SQRT( AS*AS+AU )+SQRT( AT*AT+AU ) )
            SSMIN = FHMN*C
            SSMAX = FHMX / C
         ELSE
            AU = FHMX / GA
            IF( AU.EQ.ZERO ) THEN
C
C              AVOID POSSIBLE HARMFUL UNDERFLOW IF EXPONENT RANGE
C              ASYMMETRIC (TRUE SSMIN MAY NOT UNDERFLOW EVEN IF
C              AU UNDERFLOWS)
C
               SSMIN = ( FHMN*FHMX ) / GA
               SSMAX = GA
            ELSE
               AS = ONE + FHMN / FHMX
               AT = ( FHMX-FHMN ) / FHMX
               C = ONE / ( SQRT( ONE+( AS*AU )**2 )+
     $             SQRT( ONE+( AT*AU )**2 ) )
               SSMIN = ( FHMN*C )*AU
               SSMIN = SSMIN + SSMIN
               SSMAX = GA / ( C+C )
            END IF
         END IF
      END IF
      RETURN
C
C     END OF DLAS2
C
      END
C*MODULE DGESVD  *DECK DORMQR
      SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
     $                   WORK, LWORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     JUNE 30, 1999
C
C     .. SCALAR ARGUMENTS ..
      CHARACTER          SIDE, TRANS
      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DORMQR OVERWRITES THE GENERAL REAL M-BY-N MATRIX C WITH
C
C                  SIDE = 'L'     SIDE = 'R'
C  TRANS = 'N':      Q * C          C * Q
C  TRANS = 'T':      Q**T * C       C * Q**T
C
C  WHERE Q IS A REAL ORTHOGONAL MATRIX DEFINED AS THE PRODUCT OF K
C  ELEMENTARY REFLECTORS
C
C        Q = H(1) H(2) . . . H(K)
C
C  AS RETURNED BY DGEQRF. Q IS OF ORDER M IF SIDE = 'L' AND OF ORDER N
C  IF SIDE = 'R'.
C
C  ARGUMENTS
C  =========
C
C  SIDE    (INPUT) CHARACTER*1
C          = 'L': APPLY Q OR Q**T FROM THE LEFT;
C          = 'R': APPLY Q OR Q**T FROM THE RIGHT.
C
C  TRANS   (INPUT) CHARACTER*1
C          = 'N':  NO TRANSPOSE, APPLY Q;
C          = 'T':  TRANSPOSE, APPLY Q**T.
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX C. M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX C. N >= 0.
C
C  K       (INPUT) INTEGER
C          THE NUMBER OF ELEMENTARY REFLECTORS WHOSE PRODUCT DEFINES
C          THE MATRIX Q.
C          IF SIDE = 'L', M >= K >= 0;
C          IF SIDE = 'R', N >= K >= 0.
C
C  A       (INPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,K)
C          THE I-TH COLUMN MUST CONTAIN THE VECTOR WHICH DEFINES THE
C          ELEMENTARY REFLECTOR H(I), FOR I = 1,2,...,K, AS RETURNED BY
C          DGEQRF IN THE FIRST K COLUMNS OF ITS ARRAY ARGUMENT A.
C          A IS MODIFIED BY THE ROUTINE BUT RESTORED ON EXIT.
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.
C          IF SIDE = 'L', LDA >= MAX(1,M);
C          IF SIDE = 'R', LDA >= MAX(1,N).
C
C  TAU     (INPUT) DOUBLE PRECISION ARRAY, DIMENSION (K)
C          TAU(I) MUST CONTAIN THE SCALAR FACTOR OF THE ELEMENTARY
C          REFLECTOR H(I), AS RETURNED BY DGEQRF.
C
C  C       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDC,N)
C          ON ENTRY, THE M-BY-N MATRIX C.
C          ON EXIT, C IS OVERWRITTEN BY Q*C OR Q**T*C OR C*Q**T OR C*Q.
C
C  LDC     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY C. LDC >= MAX(1,M).
C
C  WORK    (WORKSPACE/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LWORK)
C          ON EXIT, IF INFO = 0, WORK(1) RETURNS THE OPTIMAL LWORK.
C
C  LWORK   (INPUT) INTEGER
C          THE DIMENSION OF THE ARRAY WORK.
C          IF SIDE = 'L', LWORK >= MAX(1,N);
C          IF SIDE = 'R', LWORK >= MAX(1,M).
C          FOR OPTIMUM PERFORMANCE LWORK >= N*NB IF SIDE = 'L', AND
C          LWORK >= M*NB IF SIDE = 'R', WHERE NB IS THE OPTIMAL
C          BLOCKSIZE.
C
C          IF LWORK = -1, THEN A WORKSPACE QUERY IS ASSUMED; THE ROUTINE
C          ONLY CALCULATES THE OPTIMAL SIZE OF THE WORK ARRAY, RETURNS
C          THIS VALUE AS THE FIRST ENTRY OF THE WORK ARRAY, AND NO ERROR
C          MESSAGE RELATED TO LWORK IS ISSUED BY XERBLA.
C
C  INFO    (OUTPUT) INTEGER
C          = 0:  SUCCESSFUL EXIT
C          < 0:  IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C
C  =====================================================================
C
C     .. PARAMETERS ..
      INTEGER            NBMAX, LDT
      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
C     ..
C     .. LOCAL SCALARS ..
      LOGICAL            LEFT, LQUERY, NOTRAN
      INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
     $                   LWKOPT, MI, NB, NBMIN, NI, NQ, NW
C     ..
C     .. LOCAL ARRAYS ..
      DOUBLE PRECISION   T( LDT, NBMAX )
C     ..
C     .. EXTERNAL FUNCTIONS ..
      LOGICAL            LSAME
      INTEGER            ILAENV
      EXTERNAL           LSAME, ILAENV
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLARFB, DLARFT, DORM2R, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      LEFT = LSAME( SIDE, 'L' )
      NOTRAN = LSAME( TRANS, 'N' )
      LQUERY = ( LWORK.EQ.-1 )
C
C     NQ IS THE ORDER OF Q AND NW IS THE MINIMUM DIMENSION OF WORK
C
      IF( LEFT ) THEN
         NQ = M
         NW = N
      ELSE
         NQ = N
         NW = M
      END IF
      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
         INFO = -1
      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
         INFO = -2
      ELSE IF( M.LT.0 ) THEN
         INFO = -3
      ELSE IF( N.LT.0 ) THEN
         INFO = -4
      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
         INFO = -5
      ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
         INFO = -7
      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
         INFO = -10
      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
         INFO = -12
      END IF
C
      IF( INFO.EQ.0 ) THEN
C
C        DETERMINE THE BLOCK SIZE.  NB MAY BE AT MOST NBMAX, WHERE NBMAX
C        IS USED TO DEFINE THE LOCAL ARRAY T.
C
         NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS, M, N, K,
     $        -1 ) )
         LWKOPT = MAX( 1, NW )*NB
         WORK( 1 ) = LWKOPT
      END IF
C
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DORMQR', -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
         WORK( 1 ) = 1
         RETURN
      END IF
C
      NBMIN = 2
      LDWORK = NW
      IF( NB.GT.1 .AND. NB.LT.K ) THEN
         IWS = NW*NB
         IF( LWORK.LT.IWS ) THEN
            NB = LWORK / LDWORK
            NBMIN = MAX( 2, ILAENV( 2, 'DORMQR', SIDE // TRANS, M, N, K,
     $              -1 ) )
         END IF
      ELSE
         IWS = NW
      END IF
C
      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
C
C        USE UNBLOCKED CODE
C
         CALL DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
     $                IINFO )
      ELSE
C
C        USE BLOCKED CODE
C
         IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
     $       ( .NOT.LEFT .AND. NOTRAN ) ) THEN
            I1 = 1
            I2 = K
            I3 = NB
         ELSE
            I1 = ( ( K-1 ) / NB )*NB + 1
            I2 = 1
            I3 = -NB
         END IF
C
         IF( LEFT ) THEN
            NI = N
            JC = 1
         ELSE
            MI = M
            IC = 1
         END IF
C
         DO 10 I = I1, I2, I3
            IB = MIN( NB, K-I+1 )
C
C           FORM THE TRIANGULAR FACTOR OF THE BLOCK REFLECTOR
C           H = H(I) H(I+1) . . . H(I+IB-1)
C
            CALL DLARFT( 'FORWARD', 'COLUMNWISE', NQ-I+1, IB, A( I, I ),
     $                   LDA, TAU( I ), T, LDT )
            IF( LEFT ) THEN
C
C              H OR H' IS APPLIED TO C(I:M,1:N)
C
               MI = M - I + 1
               IC = I
            ELSE
C
C              H OR H' IS APPLIED TO C(1:M,I:N)
C
               NI = N - I + 1
               JC = I
            END IF
C
C           APPLY H OR H'
C
            CALL DLARFB( SIDE, TRANS, 'FORWARD', 'COLUMNWISE', MI, NI,
     $                   IB, A( I, I ), LDA, T, LDT, C( IC, JC ), LDC,
     $                   WORK, LDWORK )
   10    CONTINUE
      END IF
      WORK( 1 ) = LWKOPT
      RETURN
C
C     END OF DORMQR
C
      END
C*MODULE DGESVD  *DECK DORMLQ
      SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
     $                   WORK, LWORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     JUNE 30, 1999
C
C     .. SCALAR ARGUMENTS ..
      CHARACTER          SIDE, TRANS
      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DORMLQ OVERWRITES THE GENERAL REAL M-BY-N MATRIX C WITH
C
C                  SIDE = 'L'     SIDE = 'R'
C  TRANS = 'N':      Q * C          C * Q
C  TRANS = 'T':      Q**T * C       C * Q**T
C
C  WHERE Q IS A REAL ORTHOGONAL MATRIX DEFINED AS THE PRODUCT OF K
C  ELEMENTARY REFLECTORS
C
C        Q = H(K) . . . H(2) H(1)
C
C  AS RETURNED BY DGELQF. Q IS OF ORDER M IF SIDE = 'L' AND OF ORDER N
C  IF SIDE = 'R'.
C
C  ARGUMENTS
C  =========
C
C  SIDE    (INPUT) CHARACTER*1
C          = 'L': APPLY Q OR Q**T FROM THE LEFT;
C          = 'R': APPLY Q OR Q**T FROM THE RIGHT.
C
C  TRANS   (INPUT) CHARACTER*1
C          = 'N':  NO TRANSPOSE, APPLY Q;
C          = 'T':  TRANSPOSE, APPLY Q**T.
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX C. M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX C. N >= 0.
C
C  K       (INPUT) INTEGER
C          THE NUMBER OF ELEMENTARY REFLECTORS WHOSE PRODUCT DEFINES
C          THE MATRIX Q.
C          IF SIDE = 'L', M >= K >= 0;
C          IF SIDE = 'R', N >= K >= 0.
C
C  A       (INPUT) DOUBLE PRECISION ARRAY, DIMENSION
C                               (LDA,M) IF SIDE = 'L',
C                               (LDA,N) IF SIDE = 'R'
C          THE I-TH ROW MUST CONTAIN THE VECTOR WHICH DEFINES THE
C          ELEMENTARY REFLECTOR H(I), FOR I = 1,2,...,K, AS RETURNED BY
C          DGELQF IN THE FIRST K ROWS OF ITS ARRAY ARGUMENT A.
C          A IS MODIFIED BY THE ROUTINE BUT RESTORED ON EXIT.
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A. LDA >= MAX(1,K).
C
C  TAU     (INPUT) DOUBLE PRECISION ARRAY, DIMENSION (K)
C          TAU(I) MUST CONTAIN THE SCALAR FACTOR OF THE ELEMENTARY
C          REFLECTOR H(I), AS RETURNED BY DGELQF.
C
C  C       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDC,N)
C          ON ENTRY, THE M-BY-N MATRIX C.
C          ON EXIT, C IS OVERWRITTEN BY Q*C OR Q**T*C OR C*Q**T OR C*Q.
C
C  LDC     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY C. LDC >= MAX(1,M).
C
C  WORK    (WORKSPACE/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LWORK)
C          ON EXIT, IF INFO = 0, WORK(1) RETURNS THE OPTIMAL LWORK.
C
C  LWORK   (INPUT) INTEGER
C          THE DIMENSION OF THE ARRAY WORK.
C          IF SIDE = 'L', LWORK >= MAX(1,N);
C          IF SIDE = 'R', LWORK >= MAX(1,M).
C          FOR OPTIMUM PERFORMANCE LWORK >= N*NB IF SIDE = 'L', AND
C          LWORK >= M*NB IF SIDE = 'R', WHERE NB IS THE OPTIMAL
C          BLOCKSIZE.
C
C          IF LWORK = -1, THEN A WORKSPACE QUERY IS ASSUMED; THE ROUTINE
C          ONLY CALCULATES THE OPTIMAL SIZE OF THE WORK ARRAY, RETURNS
C          THIS VALUE AS THE FIRST ENTRY OF THE WORK ARRAY, AND NO ERROR
C          MESSAGE RELATED TO LWORK IS ISSUED BY XERBLA.
C
C  INFO    (OUTPUT) INTEGER
C          = 0:  SUCCESSFUL EXIT
C          < 0:  IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C
C  =====================================================================
C
C     .. PARAMETERS ..
      INTEGER            NBMAX, LDT
      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
C     ..
C     .. LOCAL SCALARS ..
      LOGICAL            LEFT, LQUERY, NOTRAN
      CHARACTER          TRANST
      INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
     $                   LWKOPT, MI, NB, NBMIN, NI, NQ, NW
C     ..
C     .. LOCAL ARRAYS ..
      DOUBLE PRECISION   T( LDT, NBMAX )
C     ..
C     .. EXTERNAL FUNCTIONS ..
      LOGICAL            LSAME
      INTEGER            ILAENV
      EXTERNAL           LSAME, ILAENV
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLARFB, DLARFT, DORML2, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      LEFT = LSAME( SIDE, 'L' )
      NOTRAN = LSAME( TRANS, 'N' )
      LQUERY = ( LWORK.EQ.-1 )
C
C     NQ IS THE ORDER OF Q AND NW IS THE MINIMUM DIMENSION OF WORK
C
      IF( LEFT ) THEN
         NQ = M
         NW = N
      ELSE
         NQ = N
         NW = M
      END IF
      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
         INFO = -1
      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
         INFO = -2
      ELSE IF( M.LT.0 ) THEN
         INFO = -3
      ELSE IF( N.LT.0 ) THEN
         INFO = -4
      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
         INFO = -5
      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
         INFO = -7
      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
         INFO = -10
      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
         INFO = -12
      END IF
C
      IF( INFO.EQ.0 ) THEN
C
C        DETERMINE THE BLOCK SIZE.  NB MAY BE AT MOST NBMAX, WHERE NBMAX
C        IS USED TO DEFINE THE LOCAL ARRAY T.
C
         NB = MIN( NBMAX, ILAENV( 1, 'DORMLQ', SIDE // TRANS, M, N, K,
     $        -1 ) )
         LWKOPT = MAX( 1, NW )*NB
         WORK( 1 ) = LWKOPT
      END IF
C
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DORMLQ', -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
         WORK( 1 ) = 1
         RETURN
      END IF
C
      NBMIN = 2
      LDWORK = NW
      IF( NB.GT.1 .AND. NB.LT.K ) THEN
         IWS = NW*NB
         IF( LWORK.LT.IWS ) THEN
            NB = LWORK / LDWORK
            NBMIN = MAX( 2, ILAENV( 2, 'DORMLQ', SIDE // TRANS, M, N, K,
     $              -1 ) )
         END IF
      ELSE
         IWS = NW
      END IF
C
      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
C
C        USE UNBLOCKED CODE
C
         CALL DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
     $                IINFO )
      ELSE
C
C        USE BLOCKED CODE
C
         IF( ( LEFT .AND. NOTRAN ) .OR.
     $       ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
            I1 = 1
            I2 = K
            I3 = NB
         ELSE
            I1 = ( ( K-1 ) / NB )*NB + 1
            I2 = 1
            I3 = -NB
         END IF
C
         IF( LEFT ) THEN
            NI = N
            JC = 1
         ELSE
            MI = M
            IC = 1
         END IF
C
         IF( NOTRAN ) THEN
            TRANST = 'T'
         ELSE
            TRANST = 'N'
         END IF
C
         DO 10 I = I1, I2, I3
            IB = MIN( NB, K-I+1 )
C
C           FORM THE TRIANGULAR FACTOR OF THE BLOCK REFLECTOR
C           H = H(I) H(I+1) . . . H(I+IB-1)
C
            CALL DLARFT( 'FORWARD', 'ROWWISE', NQ-I+1, IB, A( I, I ),
     $                   LDA, TAU( I ), T, LDT )
            IF( LEFT ) THEN
C
C              H OR H' IS APPLIED TO C(I:M,1:N)
C
               MI = M - I + 1
               IC = I
            ELSE
C
C              H OR H' IS APPLIED TO C(1:M,I:N)
C
               NI = N - I + 1
               JC = I
            END IF
C
C           APPLY H OR H'
C
            CALL DLARFB( SIDE, TRANST, 'FORWARD', 'ROWWISE', MI, NI, IB,
     $                   A( I, I ), LDA, T, LDT, C( IC, JC ), LDC, WORK,
     $                   LDWORK )
   10    CONTINUE
      END IF
      WORK( 1 ) = LWKOPT
      RETURN
C
C     END OF DORMLQ
C
      END
C*MODULE DGESVD  *DECK DGELQ2
      SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     FEBRUARY 29, 1992
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            INFO, LDA, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DGELQ2 COMPUTES AN LQ FACTORIZATION OF A REAL M BY N MATRIX A:
C  A = L * Q.
C
C  ARGUMENTS
C  =========
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX A.  M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX A.  N >= 0.
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          ON ENTRY, THE M BY N MATRIX A.
C          ON EXIT, THE ELEMENTS ON AND BELOW THE DIAGONAL OF THE ARRAY
C          CONTAIN THE M BY MIN(M,N) LOWER TRAPEZOIDAL MATRIX L (L IS
C          LOWER TRIANGULAR IF M <= N); THE ELEMENTS ABOVE THE DIAGONAL,
C          WITH THE ARRAY TAU, REPRESENT THE ORTHOGONAL MATRIX Q AS A
C          PRODUCT OF ELEMENTARY REFLECTORS (SEE FURTHER DETAILS).
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.  LDA >= MAX(1,M).
C
C  TAU     (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(M,N))
C          THE SCALAR FACTORS OF THE ELEMENTARY REFLECTORS (SEE FURTHER
C          DETAILS).
C
C  WORK    (WORKSPACE) DOUBLE PRECISION ARRAY, DIMENSION (M)
C
C  INFO    (OUTPUT) INTEGER
C          = 0: SUCCESSFUL EXIT
C          < 0: IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C
C  FURTHER DETAILS
C  ===============
C
C  THE MATRIX Q IS REPRESENTED AS A PRODUCT OF ELEMENTARY REFLECTORS
C
C     Q = H(K) . . . H(2) H(1), WHERE K = MIN(M,N).
C
C  EACH H(I) HAS THE FORM
C
C     H(I) = I - TAU * V * V'
C
C  WHERE TAU IS A REAL SCALAR, AND V IS A REAL VECTOR WITH
C  V(1:I-1) = 0 AND V(I) = 1; V(I+1:N) IS STORED ON EXIT IN A(I,I+1:N),
C  AND TAU IN TAU(I).
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ONE
      PARAMETER          ( ONE = 1.0D+0 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            I, K
      DOUBLE PRECISION   AII
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLARF, DLARFG, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      IF( M.LT.0 ) THEN
         INFO = -1
      ELSE IF( N.LT.0 ) THEN
         INFO = -2
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = -4
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DGELQ2', -INFO )
         RETURN
      END IF
C
      K = MIN( M, N )
C
      DO 10 I = 1, K
C
C        GENERATE ELEMENTARY REFLECTOR H(I) TO ANNIHILATE A(I,I+1:N)
C
         CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
     $                TAU( I ) )
         IF( I.LT.M ) THEN
C
C           APPLY H(I) TO A(I+1:M,I:N) FROM THE RIGHT
C
            AII = A( I, I )
            A( I, I ) = ONE
            CALL DLARF( 'RIGHT', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
     $                  A( I+1, I ), LDA, WORK )
            A( I, I ) = AII
         END IF
   10 CONTINUE
      RETURN
C
C     END OF DGELQ2
C
      END
C*MODULE DGESVD  *DECK DLASRT
      SUBROUTINE DLASRT( ID, N, D, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     SEPTEMBER 30, 1994
C
C     .. SCALAR ARGUMENTS ..
      CHARACTER          ID
      INTEGER            INFO, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   D( * )
C     ..
C
C  PURPOSE
C  =======
C
C  SORT THE NUMBERS IN D IN INCREASING ORDER (IF ID = 'I') OR
C  IN DECREASING ORDER (IF ID = 'D' ).
C
C  USE QUICK SORT, REVERTING TO INSERTION SORT ON ARRAYS OF
C  SIZE <= 20. DIMENSION OF STACK LIMITS N TO ABOUT 2**32.
C
C  ARGUMENTS
C  =========
C
C  ID      (INPUT) CHARACTER*1
C          = 'I': SORT D IN INCREASING ORDER;
C          = 'D': SORT D IN DECREASING ORDER.
C
C  N       (INPUT) INTEGER
C          THE LENGTH OF THE ARRAY D.
C
C  D       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (N)
C          ON ENTRY, THE ARRAY TO BE SORTED.
C          ON EXIT, D HAS BEEN SORTED INTO INCREASING ORDER
C          (D(1) <= ... <= D(N) ) OR INTO DECREASING ORDER
C          (D(1) >= ... >= D(N) ), DEPENDING ON ID.
C
C  INFO    (OUTPUT) INTEGER
C          = 0:  SUCCESSFUL EXIT
C          < 0:  IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C
C  =====================================================================
C
C     .. PARAMETERS ..
      INTEGER            SELECT
      PARAMETER          ( SELECT = 20 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            DIR, ENDD, I, J, START, STKPNT
      DOUBLE PRECISION   D1, D2, D3, DMNMX, TMP
C     ..
C     .. LOCAL ARRAYS ..
      INTEGER            STACK( 2, 32 )
C     ..
C     .. EXTERNAL FUNCTIONS ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           XERBLA
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT PARAMTERS.
C
      INFO = 0
      DIR = -1
      IF( LSAME( ID, 'D' ) ) THEN
         DIR = 0
      ELSE IF( LSAME( ID, 'I' ) ) THEN
         DIR = 1
      END IF
      IF( DIR.EQ.-1 ) THEN
         INFO = -1
      ELSE IF( N.LT.0 ) THEN
         INFO = -2
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DLASRT', -INFO )
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      IF( N.LE.1 )
     $   RETURN
C
      STKPNT = 1
      STACK( 1, 1 ) = 1
      STACK( 2, 1 ) = N
   10 CONTINUE
      START = STACK( 1, STKPNT )
      ENDD = STACK( 2, STKPNT )
      STKPNT = STKPNT - 1
      IF( ENDD-START.LE.SELECT .AND. ENDD-START.GT.0 ) THEN
C
C        DO INSERTION SORT ON D( START:ENDD )
C
         IF( DIR.EQ.0 ) THEN
C
C           SORT INTO DECREASING ORDER
C
            DO 30 I = START + 1, ENDD
               DO 20 J = I, START + 1, -1
                  IF( D( J ).GT.D( J-1 ) ) THEN
                     DMNMX = D( J )
                     D( J ) = D( J-1 )
                     D( J-1 ) = DMNMX
                  ELSE
                     GO TO 30
                  END IF
   20          CONTINUE
   30       CONTINUE
C
         ELSE
C
C           SORT INTO INCREASING ORDER
C
            DO 50 I = START + 1, ENDD
               DO 40 J = I, START + 1, -1
                  IF( D( J ).LT.D( J-1 ) ) THEN
                     DMNMX = D( J )
                     D( J ) = D( J-1 )
                     D( J-1 ) = DMNMX
                  ELSE
                     GO TO 50
                  END IF
   40          CONTINUE
   50       CONTINUE
C
         END IF
C
      ELSE IF( ENDD-START.GT.SELECT ) THEN
C
C        PARTITION D( START:ENDD ) AND STACK PARTS, LARGEST ONE FIRST
C
C        CHOOSE PARTITION ENTRY AS MEDIAN OF 3
C
         D1 = D( START )
         D2 = D( ENDD )
         I = ( START+ENDD ) / 2
         D3 = D( I )
         IF( D1.LT.D2 ) THEN
            IF( D3.LT.D1 ) THEN
               DMNMX = D1
            ELSE IF( D3.LT.D2 ) THEN
               DMNMX = D3
            ELSE
               DMNMX = D2
            END IF
         ELSE
            IF( D3.LT.D2 ) THEN
               DMNMX = D2
            ELSE IF( D3.LT.D1 ) THEN
               DMNMX = D3
            ELSE
               DMNMX = D1
            END IF
         END IF
C
         IF( DIR.EQ.0 ) THEN
C
C           SORT INTO DECREASING ORDER
C
            I = START - 1
            J = ENDD + 1
   60       CONTINUE
   70       CONTINUE
            J = J - 1
            IF( D( J ).LT.DMNMX )
     $         GO TO 70
   80       CONTINUE
            I = I + 1
            IF( D( I ).GT.DMNMX )
     $         GO TO 80
            IF( I.LT.J ) THEN
               TMP = D( I )
               D( I ) = D( J )
               D( J ) = TMP
               GO TO 60
            END IF
            IF( J-START.GT.ENDD-J-1 ) THEN
               STKPNT = STKPNT + 1
               STACK( 1, STKPNT ) = START
               STACK( 2, STKPNT ) = J
               STKPNT = STKPNT + 1
               STACK( 1, STKPNT ) = J + 1
               STACK( 2, STKPNT ) = ENDD
            ELSE
               STKPNT = STKPNT + 1
               STACK( 1, STKPNT ) = J + 1
               STACK( 2, STKPNT ) = ENDD
               STKPNT = STKPNT + 1
               STACK( 1, STKPNT ) = START
               STACK( 2, STKPNT ) = J
            END IF
         ELSE
C
C           SORT INTO INCREASING ORDER
C
            I = START - 1
            J = ENDD + 1
   90       CONTINUE
  100       CONTINUE
            J = J - 1
            IF( D( J ).GT.DMNMX )
     $         GO TO 100
  110       CONTINUE
            I = I + 1
            IF( D( I ).LT.DMNMX )
     $         GO TO 110
            IF( I.LT.J ) THEN
               TMP = D( I )
               D( I ) = D( J )
               D( J ) = TMP
               GO TO 90
            END IF
            IF( J-START.GT.ENDD-J-1 ) THEN
               STKPNT = STKPNT + 1
               STACK( 1, STKPNT ) = START
               STACK( 2, STKPNT ) = J
               STKPNT = STKPNT + 1
               STACK( 1, STKPNT ) = J + 1
               STACK( 2, STKPNT ) = ENDD
            ELSE
               STKPNT = STKPNT + 1
               STACK( 1, STKPNT ) = J + 1
               STACK( 2, STKPNT ) = ENDD
               STKPNT = STKPNT + 1
               STACK( 1, STKPNT ) = START
               STACK( 2, STKPNT ) = J
            END IF
         END IF
      END IF
      IF( STKPNT.GT.0 )
     $   GO TO 10
      RETURN
C
C     END OF DLASRT
C
      END
C*MODULE DGESVD  *DECK DLASQ1
      SUBROUTINE DLASQ1( N, D, E, WORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     OCTOBER 31, 1999
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            INFO, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   D( * ), E( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DLASQ1 COMPUTES THE SINGULAR VALUES OF A REAL N-BY-N BIDIAGONAL
C  MATRIX WITH DIAGONAL D AND OFF-DIAGONAL E. THE SINGULAR VALUES
C  ARE COMPUTED TO HIGH RELATIVE ACCURACY, IN THE ABSENCE OF
C  DENORMALIZATION, UNDERFLOW AND OVERFLOW. THE ALGORITHM WAS FIRST
C  PRESENTED IN
C
C  "ACCURATE SINGULAR VALUES AND DIFFERENTIAL QD ALGORITHMS" BY K. V.
C  FERNANDO AND B. N. PARLETT, NUMER. MATH., VOL-67, NO. 2, PP. 191-230,
C  1994,
C
C  AND THE PRESENT IMPLEMENTATION IS DESCRIBED IN "AN IMPLEMENTATION OF
C  THE DQDS ALGORITHM (POSITIVE CASE)", LAPACK WORKING NOTE.
C
C  ARGUMENTS
C  =========
C
C  N     (INPUT) INTEGER
C        THE NUMBER OF ROWS AND COLUMNS IN THE MATRIX. N >= 0.
C
C  D     (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (N)
C        ON ENTRY, D CONTAINS THE DIAGONAL ELEMENTS OF THE
C        BIDIAGONAL MATRIX WHOSE SVD IS DESIRED. ON NORMAL EXIT,
C        D CONTAINS THE SINGULAR VALUES IN DECREASING ORDER.
C
C  E     (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (N)
C        ON ENTRY, ELEMENTS E(1:N-1) CONTAIN THE OFF-DIAGONAL ELEMENTS
C        OF THE BIDIAGONAL MATRIX WHOSE SVD IS DESIRED.
C        ON EXIT, E IS OVERWRITTEN.
C
C  WORK  (WORKSPACE) DOUBLE PRECISION ARRAY, DIMENSION (4*N)
C
C  INFO  (OUTPUT) INTEGER
C        = 0: SUCCESSFUL EXIT
C        < 0: IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C        > 0: THE ALGORITHM FAILED
C             = 1, A SPLIT WAS MARKED BY A POSITIVE VALUE IN E
C             = 2, CURRENT BLOCK OF Z NOT DIAGONALIZED AFTER 30*N
C                  ITERATIONS (IN INNER WHILE LOOP)
C             = 3, TERMINATION CRITERION OF OUTER WHILE LOOP NOT MET
C                  (PROGRAM CREATED MORE THAN N UNREDUCED BLOCKS)
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ZERO
      PARAMETER          ( ZERO = 0.0D+00 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            I, IINFO
      DOUBLE PRECISION   EPS, SCALE, SAFMIN, SIGMN, SIGMX
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLAS2, DLASQ2, DLASRT, XERBLA
C     ..
C     .. EXTERNAL FUNCTIONS ..
      DOUBLE PRECISION   DLAMCH
      EXTERNAL           DLAMCH
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          ABS, MAX, SQRT
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
      INFO = 0
      IF( N.LT.0 ) THEN
         INFO = -2
         CALL XERBLA( 'DLASQ1', -INFO )
         RETURN
      ELSE IF( N.EQ.0 ) THEN
         RETURN
      ELSE IF( N.EQ.1 ) THEN
         D( 1 ) = ABS( D( 1 ) )
         RETURN
      ELSE IF( N.EQ.2 ) THEN
         CALL DLAS2( D( 1 ), E( 1 ), D( 2 ), SIGMN, SIGMX )
         D( 1 ) = SIGMX
         D( 2 ) = SIGMN
         RETURN
      END IF
C
C     ESTIMATE THE LARGEST SINGULAR VALUE.
C
      SIGMX = ZERO
      DO 10 I = 1, N - 1
         D( I ) = ABS( D( I ) )
         SIGMX = MAX( SIGMX, ABS( E( I ) ) )
   10 CONTINUE
      D( N ) = ABS( D( N ) )
C
C     EARLY RETURN IF SIGMX IS ZERO (MATRIX IS ALREADY DIAGONAL).
C
      IF( SIGMX.EQ.ZERO ) THEN
         CALL DLASRT( 'D', N, D, IINFO )
         RETURN
      END IF
C
      DO 20 I = 1, N
         SIGMX = MAX( SIGMX, D( I ) )
   20 CONTINUE
C
C     COPY D AND E INTO WORK (IN THE Z FORMAT) AND SCALE (SQUARING THE
C     INPUT DATA MAKES SCALING BY A POWER OF THE RADIX POINTLESS).
C
      EPS = DLAMCH( 'PRECISION' )
      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
      SCALE = SQRT( EPS / SAFMIN )
      CALL DCOPY( N, D, 1, WORK( 1 ), 2 )
      CALL DCOPY( N-1, E, 1, WORK( 2 ), 2 )
      CALL DLASCL( 'G', 0, 0, SIGMX, SCALE, 2*N-1, 1, WORK, 2*N-1,
     $             IINFO )
C
C     COMPUTE THE Q'S AND E'S.
C
      DO 30 I = 1, 2*N - 1
         WORK( I ) = WORK( I )**2
   30 CONTINUE
      WORK( 2*N ) = ZERO
C
      CALL DLASQ2( N, WORK, INFO )
C
      IF( INFO.EQ.0 ) THEN
         DO 40 I = 1, N
            D( I ) = SQRT( WORK( I ) )
   40    CONTINUE
         CALL DLASCL( 'G', 0, 0, SCALE, SIGMX, N, 1, D, N, IINFO )
      END IF
C
      RETURN
C
C     END OF DLASQ1
C
      END
C*MODULE DGESVD  *DECK DLASQ2
      SUBROUTINE DLASQ2( N, Z, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     OCTOBER 31, 1999
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            INFO, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   Z( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DLASQ2 COMPUTES ALL THE EIGENVALUES OF THE SYMMETRIC POSITIVE
C  DEFINITE TRIDIAGONAL MATRIX ASSOCIATED WITH THE QD ARRAY Z TO HIGH
C  RELATIVE ACCURACY ARE COMPUTED TO HIGH RELATIVE ACCURACY, IN THE
C  ABSENCE OF DENORMALIZATION, UNDERFLOW AND OVERFLOW.
C
C  TO SEE THE RELATION OF Z TO THE TRIDIAGONAL MATRIX, LET L BE A
C  UNIT LOWER BIDIAGONAL MATRIX WITH SUBDIAGONALS Z(2,4,6,,..) AND
C  LET U BE AN UPPER BIDIAGONAL MATRIX WITH 1'S ABOVE AND DIAGONAL
C  Z(1,3,5,,..). THE TRIDIAGONAL IS L*U OR, IF YOU PREFER, THE
C  SYMMETRIC TRIDIAGONAL TO WHICH IT IS SIMILAR.
C
C  NOTE : DLASQ2 DEFINES A LOGICAL VARIABLE, IEEE, WHICH IS TRUE
C  ON MACHINES WHICH FOLLOW IEEE-754 FLOATING-POINT STANDARD IN THEIR
C  HANDLING OF INFINITIES AND NANS, AND FALSE OTHERWISE. THIS VARIABLE
C  IS PASSED TO DLASQ3.
C
C  ARGUMENTS
C  =========
C
C  N     (INPUT) INTEGER
C        THE NUMBER OF ROWS AND COLUMNS IN THE MATRIX. N >= 0.
C
C  Z     (WORKSPACE) DOUBLE PRECISION ARRAY, DIMENSION ( 4*N )
C        ON ENTRY Z HOLDS THE QD ARRAY. ON EXIT, ENTRIES 1 TO N HOLD
C        THE EIGENVALUES IN DECREASING ORDER, Z( 2*N+1 ) HOLDS THE
C        TRACE, AND Z( 2*N+2 ) HOLDS THE SUM OF THE EIGENVALUES. IF
C        N > 2, THEN Z( 2*N+3 ) HOLDS THE ITERATION COUNT, Z( 2*N+4 )
C        HOLDS NDIVS/NIN^2, AND Z( 2*N+5 ) HOLDS THE PERCENTAGE OF
C        SHIFTS THAT FAILED.
C
C  INFO  (OUTPUT) INTEGER
C        = 0: SUCCESSFUL EXIT
C        < 0: IF THE I-TH ARGUMENT IS A SCALAR AND HAD AN ILLEGAL
C             VALUE, THEN INFO = -I, IF THE I-TH ARGUMENT IS AN
C             ARRAY AND THE J-ENTRY HAD AN ILLEGAL VALUE, THEN
C             INFO = -(I*100+J)
C        > 0: THE ALGORITHM FAILED
C              = 1, A SPLIT WAS MARKED BY A POSITIVE VALUE IN E
C              = 2, CURRENT BLOCK OF Z NOT DIAGONALIZED AFTER 30*N
C                   ITERATIONS (IN INNER WHILE LOOP)
C              = 3, TERMINATION CRITERION OF OUTER WHILE LOOP NOT MET
C                   (PROGRAM CREATED MORE THAN N UNREDUCED BLOCKS)
C
C  FURTHER DETAILS
C  ===============
C  LOCAL VARIABLES: I0:N0 DEFINES A CURRENT UNREDUCED SEGMENT OF Z.
C  THE SHIFTS ARE ACCUMULATED IN SIGMA. ITERATION COUNT IS IN ITER.
C  PING-PONG IS CONTROLLED BY PP (ALTERNATES BETWEEN 0 AND 1).
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   CBIAS
      PARAMETER          ( CBIAS = 1.50D+00 )
      DOUBLE PRECISION   ZERO, HALF, ONE, TWO, FOUR, HUNDRD
      PARAMETER  ( ZERO = 0.0D+00, HALF = 0.5D+00, ONE = 1.0D+00,
     $             TWO = 2.0D+00, FOUR = 4.0D+00, HUNDRD = 100.0D+00)
C     ..
C     .. LOCAL SCALARS ..
      LOGICAL            IEEE
      INTEGER            I0, I4, IINFO, IPN4, ITER, IWHILA, IWHILB, K,
     $                   N0, NBIG, NDIV, NFAIL, PP, SPLT
      DOUBLE PRECISION   D, DESIG, DMIN, E, EMAX, EMIN, EPS, OLDEMN,
     $                   QMAX, QMIN, S, SAFMIN, SIGMA, T, TEMP, TOL,
     $                   TOL2, TRACE, ZMAX
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLASQ3, DLASRT, XERBLA
C     ..
C     .. EXTERNAL FUNCTIONS ..
      INTEGER            ILAENV
      DOUBLE PRECISION   DLAMCH
      EXTERNAL           DLAMCH, ILAENV
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN, SQRT
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS.
C     (IN CASE DLASQ2 IS NOT CALLED BY DLASQ1)
C
      INFO = 0
      EPS = DLAMCH( 'PRECISION' )
      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
      TOL = EPS*HUNDRD
      TOL2 = TOL**2
C
      IF( N.LT.0 ) THEN
         INFO = -1
         CALL XERBLA( 'DLASQ2', 1 )
         RETURN
      ELSE IF( N.EQ.0 ) THEN
         RETURN
      ELSE IF( N.EQ.1 ) THEN
C
C        1-BY-1 CASE.
C
         IF( Z( 1 ).LT.ZERO ) THEN
            INFO = -201
            CALL XERBLA( 'DLASQ2', 2 )
         END IF
         RETURN
      ELSE IF( N.EQ.2 ) THEN
C
C        2-BY-2 CASE.
C
         IF( Z( 2 ).LT.ZERO .OR. Z( 3 ).LT.ZERO ) THEN
            INFO = -2
            CALL XERBLA( 'DLASQ2', 2 )
            RETURN
         ELSE IF( Z( 3 ).GT.Z( 1 ) ) THEN
            D = Z( 3 )
            Z( 3 ) = Z( 1 )
            Z( 1 ) = D
         END IF
         Z( 5 ) = Z( 1 ) + Z( 2 ) + Z( 3 )
         IF( Z( 2 ).GT.Z( 3 )*TOL2 ) THEN
            T = HALF*( ( Z( 1 )-Z( 3 ) )+Z( 2 ) )
            S = Z( 3 )*( Z( 2 ) / T )
            IF( S.LE.T ) THEN
               S = Z( 3 )*( Z( 2 ) / ( T*( ONE+SQRT( ONE+S / T ) ) ) )
            ELSE
               S = Z( 3 )*( Z( 2 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
            END IF
            T = Z( 1 ) + ( S+Z( 2 ) )
            Z( 3 ) = Z( 3 )*( Z( 1 ) / T )
            Z( 1 ) = T
         END IF
         Z( 2 ) = Z( 3 )
         Z( 6 ) = Z( 2 ) + Z( 1 )
         RETURN
      END IF
C
C     CHECK FOR NEGATIVE DATA AND COMPUTE SUMS OF Q'S AND E'S.
C
      Z( 2*N ) = ZERO
      EMIN = Z( 2 )
      QMAX = ZERO
      ZMAX = ZERO
      D = ZERO
      E = ZERO
C
      DO 10 K = 1, 2*( N-1 ), 2
         IF( Z( K ).LT.ZERO ) THEN
            INFO = -( 200+K )
            CALL XERBLA( 'DLASQ2', 2 )
            RETURN
         ELSE IF( Z( K+1 ).LT.ZERO ) THEN
            INFO = -( 200+K+1 )
            CALL XERBLA( 'DLASQ2', 2 )
            RETURN
         END IF
         D = D + Z( K )
         E = E + Z( K+1 )
         QMAX = MAX( QMAX, Z( K ) )
         EMIN = MIN( EMIN, Z( K+1 ) )
         ZMAX = MAX( QMAX, ZMAX, Z( K+1 ) )
   10 CONTINUE
      IF( Z( 2*N-1 ).LT.ZERO ) THEN
         INFO = -( 200+2*N-1 )
         CALL XERBLA( 'DLASQ2', 2 )
         RETURN
      END IF
      D = D + Z( 2*N-1 )
      QMAX = MAX( QMAX, Z( 2*N-1 ) )
      ZMAX = MAX( QMAX, ZMAX )
C
C     CHECK FOR DIAGONALITY.
C
      IF( E.EQ.ZERO ) THEN
         DO 20 K = 2, N
            Z( K ) = Z( 2*K-1 )
   20    CONTINUE
         CALL DLASRT( 'D', N, Z, IINFO )
         Z( 2*N-1 ) = D
         RETURN
      END IF
C
      TRACE = D + E
C
C     CHECK FOR ZERO DATA.
C
      IF( TRACE.EQ.ZERO ) THEN
         Z( 2*N-1 ) = ZERO
         RETURN
      END IF
C
C     CHECK WHETHER THE MACHINE IS IEEE CONFORMABLE.
C
      IEEE = ILAENV( 10, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 .AND.
     $       ILAENV( 11, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1
C
C     REARRANGE DATA FOR LOCALITY: Z=(Q1,QQ1,E1,EE1,Q2,QQ2,E2,EE2,...).
C
      DO 30 K = 2*N, 2, -2
         Z( 2*K ) = ZERO
         Z( 2*K-1 ) = Z( K )
         Z( 2*K-2 ) = ZERO
         Z( 2*K-3 ) = Z( K-1 )
   30 CONTINUE
C
      I0 = 1
      N0 = N
C
C     REVERSE THE QD-ARRAY, IF WARRANTED.
C
      IF( CBIAS*Z( 4*I0-3 ).LT.Z( 4*N0-3 ) ) THEN
         IPN4 = 4*( I0+N0 )
         DO 40 I4 = 4*I0, 2*( I0+N0-1 ), 4
            TEMP = Z( I4-3 )
            Z( I4-3 ) = Z( IPN4-I4-3 )
            Z( IPN4-I4-3 ) = TEMP
            TEMP = Z( I4-1 )
            Z( I4-1 ) = Z( IPN4-I4-5 )
            Z( IPN4-I4-5 ) = TEMP
   40    CONTINUE
      END IF
C
C     INITIAL SPLIT CHECKING VIA DQD AND LI'S TEST.
C
      PP = 0
C
      DO 80 K = 1, 2
C
         D = Z( 4*N0+PP-3 )
         DO 50 I4 = 4*( N0-1 ) + PP, 4*I0 + PP, -4
            IF( Z( I4-1 ).LE.TOL2*D ) THEN
               Z( I4-1 ) = -ZERO
               D = Z( I4-3 )
            ELSE
               D = Z( I4-3 )*( D / ( D+Z( I4-1 ) ) )
            END IF
   50    CONTINUE
C
C        DQD MAPS Z TO ZZ PLUS LI'S TEST.
C
         EMIN = Z( 4*I0+PP+1 )
         D = Z( 4*I0+PP-3 )
         DO 60 I4 = 4*I0 + PP, 4*( N0-1 ) + PP, 4
            Z( I4-2*PP-2 ) = D + Z( I4-1 )
            IF( Z( I4-1 ).LE.TOL2*D ) THEN
               Z( I4-1 ) = -ZERO
               Z( I4-2*PP-2 ) = D
               Z( I4-2*PP ) = ZERO
               D = Z( I4+1 )
            ELSE IF( SAFMIN*Z( I4+1 ).LT.Z( I4-2*PP-2 ) .AND.
     $               SAFMIN*Z( I4-2*PP-2 ).LT.Z( I4+1 ) ) THEN
               TEMP = Z( I4+1 ) / Z( I4-2*PP-2 )
               Z( I4-2*PP ) = Z( I4-1 )*TEMP
               D = D*TEMP
            ELSE
               Z( I4-2*PP ) = Z( I4+1 )*( Z( I4-1 ) / Z( I4-2*PP-2 ) )
               D = Z( I4+1 )*( D / Z( I4-2*PP-2 ) )
            END IF
            EMIN = MIN( EMIN, Z( I4-2*PP ) )
   60    CONTINUE
         Z( 4*N0-PP-2 ) = D
C
C        NOW FIND QMAX.
C
         QMAX = Z( 4*I0-PP-2 )
         DO 70 I4 = 4*I0 - PP + 2, 4*N0 - PP - 2, 4
            QMAX = MAX( QMAX, Z( I4 ) )
   70    CONTINUE
C
C        PREPARE FOR THE NEXT ITERATION ON K.
C
         PP = 1 - PP
   80 CONTINUE
C
      ITER = 2
      NFAIL = 0
      NDIV = 2*( N0-I0 )
C
      DO 140 IWHILA = 1, N + 1
         IF( N0.LT.1 )
     $      GO TO 150
C
C        WHILE ARRAY UNFINISHED DO
C
C        E(N0) HOLDS THE VALUE OF SIGMA WHEN SUBMATRIX IN I0:N0
C        SPLITS FROM THE REST OF THE ARRAY, BUT IS NEGATED.
C
         DESIG = ZERO
         IF( N0.EQ.N ) THEN
            SIGMA = ZERO
         ELSE
            SIGMA = -Z( 4*N0-1 )
         END IF
         IF( SIGMA.LT.ZERO ) THEN
            INFO = 1
            RETURN
         END IF
C
C        FIND LAST UNREDUCED SUBMATRIX'S TOP INDEX I0, FIND QMAX AND
C        EMIN. FIND GERSHGORIN-TYPE BOUND IF Q'S MUCH GREATER THAN E'S.
C
         EMAX = ZERO
         IF( N0.GT.I0 ) THEN
            EMIN = ABS( Z( 4*N0-5 ) )
         ELSE
            EMIN = ZERO
         END IF
         QMIN = Z( 4*N0-3 )
         QMAX = QMIN
         DO 90 I4 = 4*N0, 8, -4
            IF( Z( I4-5 ).LE.ZERO )
     $         GO TO 100
            IF( QMIN.GE.FOUR*EMAX ) THEN
               QMIN = MIN( QMIN, Z( I4-3 ) )
               EMAX = MAX( EMAX, Z( I4-5 ) )
            END IF
            QMAX = MAX( QMAX, Z( I4-7 )+Z( I4-5 ) )
            EMIN = MIN( EMIN, Z( I4-5 ) )
   90    CONTINUE
         I4 = 4
C
  100    CONTINUE
         I0 = I4 / 4
C
C        STORE EMIN FOR PASSING TO DLASQ3.
C
         Z( 4*N0-1 ) = EMIN
C
C        PUT -(INITIAL SHIFT) INTO DMIN.
C
         DMIN = -MAX( ZERO, QMIN-TWO*SQRT( QMIN )*SQRT( EMAX ) )
C
C        NOW I0:N0 IS UNREDUCED. PP = 0 FOR PING, PP = 1 FOR PONG.
C
         PP = 0
C
         NBIG = 30*( N0-I0+1 )
         DO 120 IWHILB = 1, NBIG
            IF( I0.GT.N0 )
     $         GO TO 130
C
C           WHILE SUBMATRIX UNFINISHED TAKE A GOOD DQDS STEP.
C
            CALL DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
     $                   ITER, NDIV, IEEE )
C
            PP = 1 - PP
C
C           WHEN EMIN IS VERY SMALL CHECK FOR SPLITS.
C
            IF( PP.EQ.0 .AND. N0-I0.GE.3 ) THEN
               IF( Z( 4*N0 ).LE.TOL2*QMAX .OR.
     $             Z( 4*N0-1 ).LE.TOL2*SIGMA ) THEN
                  SPLT = I0 - 1
                  QMAX = Z( 4*I0-3 )
                  EMIN = Z( 4*I0-1 )
                  OLDEMN = Z( 4*I0 )
                  DO 110 I4 = 4*I0, 4*( N0-3 ), 4
                     IF( Z( I4 ).LE.TOL2*Z( I4-3 ) .OR.
     $                   Z( I4-1 ).LE.TOL2*SIGMA ) THEN
                        Z( I4-1 ) = -SIGMA
                        SPLT = I4 / 4
                        QMAX = ZERO
                        EMIN = Z( I4+3 )
                        OLDEMN = Z( I4+4 )
                     ELSE
                        QMAX = MAX( QMAX, Z( I4+1 ) )
                        EMIN = MIN( EMIN, Z( I4-1 ) )
                        OLDEMN = MIN( OLDEMN, Z( I4 ) )
                     END IF
  110             CONTINUE
                  Z( 4*N0-1 ) = EMIN
                  Z( 4*N0 ) = OLDEMN
                  I0 = SPLT + 1
               END IF
            END IF
C
  120    CONTINUE
C
         INFO = 2
         RETURN
C
C        END IWHILB
C
  130    CONTINUE
C
  140 CONTINUE
C
      INFO = 3
      RETURN
C
C     END IWHILA
C
  150 CONTINUE
C
C     MOVE Q'S TO THE FRONT.
C
      DO 160 K = 2, N
         Z( K ) = Z( 4*K-3 )
  160 CONTINUE
C
C     SORT AND COMPUTE SUM OF EIGENVALUES.
C
      CALL DLASRT( 'D', N, Z, IINFO )
C
      E = ZERO
      DO 170 K = N, 1, -1
         E = E + Z( K )
  170 CONTINUE
C
C     STORE TRACE, SUM(EIGENVALUES) AND INFORMATION ON PERFORMANCE.
C
      Z( 2*N+1 ) = TRACE
      Z( 2*N+2 ) = E
      Z( 2*N+3 ) = ITER
      Z( 2*N+4 ) = NDIV
      Z( 2*N+4 ) = Z(2*N+4)/(N*N)
      Z( 2*N+5 ) = (HUNDRD*NFAIL)/ITER
      RETURN
C
C     END OF DLASQ2
C
      END
C*MODULE DGESVD  *DECK DLASQ3
      SUBROUTINE DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
     $                   ITER, NDIV, IEEE )
C
C  -- LAPACK AUXILIARY ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     MAY 17, 2000
C
C     .. SCALAR ARGUMENTS ..
      LOGICAL            IEEE
      INTEGER            I0, ITER, N0, NDIV, NFAIL, PP
      DOUBLE PRECISION   DESIG, DMIN, QMAX, SIGMA
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   Z( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DLASQ3 CHECKS FOR DEFLATION, COMPUTES A SHIFT (TAU) AND CALLS DQDS.
C  IN CASE OF FAILURE IT CHANGES SHIFTS, AND TRIES AGAIN UNTIL OUTPUT
C  IS POSITIVE.
C
C  ARGUMENTS
C  =========
C
C  I0     (INPUT) INTEGER
C         FIRST INDEX.
C
C  N0     (INPUT) INTEGER
C         LAST INDEX.
C
C  Z      (INPUT) DOUBLE PRECISION ARRAY, DIMENSION ( 4*N )
C         Z HOLDS THE QD ARRAY.
C
C  PP     (INPUT) INTEGER
C         PP=0 FOR PING, PP=1 FOR PONG.
C
C  DMIN   (OUTPUT) DOUBLE PRECISION
C         MINIMUM VALUE OF D.
C
C  SIGMA  (OUTPUT) DOUBLE PRECISION
C         SUM OF SHIFTS USED IN CURRENT SEGMENT.
C
C  DESIG  (INPUT/OUTPUT) DOUBLE PRECISION
C         LOWER ORDER PART OF SIGMA
C
C  QMAX   (INPUT) DOUBLE PRECISION
C         MAXIMUM VALUE OF Q.
C
C  NFAIL  (OUTPUT) INTEGER
C         NUMBER OF TIMES SHIFT WAS TOO BIG.
C
C  ITER   (OUTPUT) INTEGER
C         NUMBER OF ITERATIONS.
C
C  NDIV   (OUTPUT) INTEGER
C         NUMBER OF DIVISIONS.
C
C  TTYPE  (OUTPUT) INTEGER
C         SHIFT TYPE.
C
C  IEEE   (INPUT) LOGICAL
C         FLAG FOR IEEE OR NON IEEE ARITHMETIC (PASSED TO DLASQ5).
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   CBIAS
      PARAMETER          ( CBIAS = 1.50D+00 )
      DOUBLE PRECISION   ZERO, QURTR, HALF, ONE, TWO, HUNDRD
      PARAMETER  ( ZERO = 0.0D+00, QURTR = 0.250D+00, HALF = 0.5D+00,
     $             ONE = 1.0D+00, TWO = 2.0D+00, HUNDRD = 100.0D+00 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            IPN4, J4, N0IN, NN, TTYPE
      DOUBLE PRECISION   DMIN1, DMIN2, DN, DN1, DN2, EPS, S, SAFMIN, T,
     $                   TAU, TEMP, TOL, TOL2
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLASQ4, DLASQ5, DLASQ6
C     ..
C     .. EXTERNAL FUNCTION ..
      DOUBLE PRECISION   DLAMCH
      EXTERNAL           DLAMCH
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          ABS, MIN, SQRT
C     ..
C     .. SAVE STATEMENT ..
      SAVE               TTYPE
      SAVE               DMIN1, DMIN2, DN, DN1, DN2, TAU
C     ..
C     .. DATA STATEMENT ..
      DATA               TTYPE / 0 /
      DATA               DMIN1 / ZERO /, DMIN2 / ZERO /, DN / ZERO /,
     $                   DN1 / ZERO /, DN2 / ZERO /, TAU / ZERO /
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
      N0IN = N0
      EPS = DLAMCH( 'PRECISION' )
      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
      TOL = EPS*HUNDRD
      TOL2 = TOL**2
C
C     CHECK FOR DEFLATION.
C
   10 CONTINUE
C
      IF( N0.LT.I0 )
     $   RETURN
      IF( N0.EQ.I0 )
     $   GO TO 20
      NN = 4*N0 + PP
      IF( N0.EQ.( I0+1 ) )
     $   GO TO 40
C
C     CHECK WHETHER E(N0-1) IS NEGLIGIBLE, 1 EIGENVALUE.
C
      IF( Z( NN-5 ).GT.TOL2*( SIGMA+Z( NN-3 ) ) .AND.
     $    Z( NN-2*PP-4 ).GT.TOL2*Z( NN-7 ) )
     $   GO TO 30
C
   20 CONTINUE
C
      Z( 4*N0-3 ) = Z( 4*N0+PP-3 ) + SIGMA
      N0 = N0 - 1
      GO TO 10
C
C     CHECK  WHETHER E(N0-2) IS NEGLIGIBLE, 2 EIGENVALUES.
C
   30 CONTINUE
C
      IF( Z( NN-9 ).GT.TOL2*SIGMA .AND.
     $    Z( NN-2*PP-8 ).GT.TOL2*Z( NN-11 ) )
     $   GO TO 50
C
   40 CONTINUE
C
      IF( Z( NN-3 ).GT.Z( NN-7 ) ) THEN
         S = Z( NN-3 )
         Z( NN-3 ) = Z( NN-7 )
         Z( NN-7 ) = S
      END IF
      IF( Z( NN-5 ).GT.Z( NN-3 )*TOL2 ) THEN
         T = HALF*( ( Z( NN-7 )-Z( NN-3 ) )+Z( NN-5 ) )
         S = Z( NN-3 )*( Z( NN-5 ) / T )
         IF( S.LE.T ) THEN
            S = Z( NN-3 )*( Z( NN-5 ) /
     $          ( T*( ONE+SQRT( ONE+S / T ) ) ) )
         ELSE
            S = Z( NN-3 )*( Z( NN-5 ) / ( T+SQRT( T )*SQRT( T+S ) ) )
         END IF
         T = Z( NN-7 ) + ( S+Z( NN-5 ) )
         Z( NN-3 ) = Z( NN-3 )*( Z( NN-7 ) / T )
         Z( NN-7 ) = T
      END IF
      Z( 4*N0-7 ) = Z( NN-7 ) + SIGMA
      Z( 4*N0-3 ) = Z( NN-3 ) + SIGMA
      N0 = N0 - 2
      GO TO 10
C
   50 CONTINUE
C
C     REVERSE THE QD-ARRAY, IF WARRANTED.
C
      IF( DMIN.LE.ZERO .OR. N0.LT.N0IN ) THEN
         IF( CBIAS*Z( 4*I0+PP-3 ).LT.Z( 4*N0+PP-3 ) ) THEN
            IPN4 = 4*( I0+N0 )
            DO 60 J4 = 4*I0, 2*( I0+N0-1 ), 4
               TEMP = Z( J4-3 )
               Z( J4-3 ) = Z( IPN4-J4-3 )
               Z( IPN4-J4-3 ) = TEMP
               TEMP = Z( J4-2 )
               Z( J4-2 ) = Z( IPN4-J4-2 )
               Z( IPN4-J4-2 ) = TEMP
               TEMP = Z( J4-1 )
               Z( J4-1 ) = Z( IPN4-J4-5 )
               Z( IPN4-J4-5 ) = TEMP
               TEMP = Z( J4 )
               Z( J4 ) = Z( IPN4-J4-4 )
               Z( IPN4-J4-4 ) = TEMP
   60       CONTINUE
            IF( N0-I0.LE.4 ) THEN
               Z( 4*N0+PP-1 ) = Z( 4*I0+PP-1 )
               Z( 4*N0-PP ) = Z( 4*I0-PP )
            END IF
            DMIN2 = MIN( DMIN2, Z( 4*N0+PP-1 ) )
            Z( 4*N0+PP-1 ) = MIN( Z( 4*N0+PP-1 ), Z( 4*I0+PP-1 ),
     $                            Z( 4*I0+PP+3 ) )
            Z( 4*N0-PP ) = MIN( Z( 4*N0-PP ), Z( 4*I0-PP ),
     $                          Z( 4*I0-PP+4 ) )
            QMAX = MAX( QMAX, Z( 4*I0+PP-3 ), Z( 4*I0+PP+1 ) )
            DMIN = -ZERO
         END IF
      END IF
C
      IF( DMIN.LT.ZERO .OR. SAFMIN*QMAX.LT.MIN( Z( 4*N0+PP-1 ),
     $    Z( 4*N0+PP-9 ), DMIN2+Z( 4*N0-PP ) ) ) THEN
C
C        CHOOSE A SHIFT.
C
         CALL DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1,
     $                DN2, TAU, TTYPE )
C
C        CALL DQDS UNTIL DMIN > 0.
C
   80    CONTINUE
C
         CALL DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
     $                DN1, DN2, IEEE )
C
         NDIV = NDIV + ( N0-I0+2 )
         ITER = ITER + 1
C
C        CHECK STATUS.
C
         IF( DMIN.GE.ZERO .AND. DMIN1.GT.ZERO ) THEN
C
C           SUCCESS.
C
            GO TO 100
C
         ELSE IF( DMIN.LT.ZERO .AND. DMIN1.GT.ZERO .AND.
     $            Z( 4*( N0-1 )-PP ).LT.TOL*( SIGMA+DN1 ) .AND.
     $            ABS( DN ).LT.TOL*SIGMA ) THEN
C
C           CONVERGENCE HIDDEN BY NEGATIVE DN.
C
            Z( 4*( N0-1 )-PP+2 ) = ZERO
            DMIN = ZERO
            GO TO 100
         ELSE IF( DMIN.LT.ZERO ) THEN
C
C           TAU TOO BIG. SELECT NEW TAU AND TRY AGAIN.
C
            NFAIL = NFAIL + 1
            IF( TTYPE.LT.-22 ) THEN
C
C              FAILED TWICE. PLAY IT SAFE.
C
               TAU = ZERO
            ELSE IF( DMIN1.GT.ZERO ) THEN
C
C              LATE FAILURE. GIVES EXCELLENT SHIFT.
C
               TAU = ( TAU+DMIN )*( ONE-TWO*EPS )
               TTYPE = TTYPE - 11
            ELSE
C
C              EARLY FAILURE. DIVIDE BY 4.
C
               TAU = QURTR*TAU
               TTYPE = TTYPE - 12
            END IF
            GO TO 80
         ELSE IF( DMIN.NE.DMIN ) THEN
C
C           NAN.
C
            TAU = ZERO
            GO TO 80
         ELSE
C
C           POSSIBLE UNDERFLOW. PLAY IT SAFE.
C
            GO TO 90
         END IF
      END IF
C
C     RISK OF UNDERFLOW.
C
   90 CONTINUE
      CALL DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DN1, DN2 )
      NDIV = NDIV + ( N0-I0+2 )
      ITER = ITER + 1
      TAU = ZERO
C
  100 CONTINUE
      IF( TAU.LT.SIGMA ) THEN
         DESIG = DESIG + TAU
         T = SIGMA + DESIG
         DESIG = DESIG - ( T-SIGMA )
      ELSE
         T = SIGMA + TAU
         DESIG = SIGMA - ( T-TAU ) + DESIG
      END IF
      SIGMA = T
C
      RETURN
C
C     END OF DLASQ3
C
      END
C*MODULE DGESVD  *DECK DLASQ4
      SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
     $                   DN1, DN2, TAU, TTYPE )
C
C  -- LAPACK AUXILIARY ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     OCTOBER 31, 1999
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            I0, N0, N0IN, PP, TTYPE
      DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DN1, DN2, TAU
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   Z( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DLASQ4 COMPUTES AN APPROXIMATION TAU TO THE SMALLEST EIGENVALUE
C  USING VALUES OF D FROM THE PREVIOUS TRANSFORM.
C
C  I0    (INPUT) INTEGER
C        FIRST INDEX.
C
C  N0    (INPUT) INTEGER
C        LAST INDEX.
C
C  Z     (INPUT) DOUBLE PRECISION ARRAY, DIMENSION ( 4*N )
C        Z HOLDS THE QD ARRAY.
C
C  PP    (INPUT) INTEGER
C        PP=0 FOR PING, PP=1 FOR PONG.
C
C  NOIN  (INPUT) INTEGER
C        THE VALUE OF N0 AT START OF EIGTEST.
C
C  DMIN  (INPUT) DOUBLE PRECISION
C        MINIMUM VALUE OF D.
C
C  DMIN1 (INPUT) DOUBLE PRECISION
C        MINIMUM VALUE OF D, EXCLUDING D( N0 ).
C
C  DMIN2 (INPUT) DOUBLE PRECISION
C        MINIMUM VALUE OF D, EXCLUDING D( N0 ) AND D( N0-1 ).
C
C  DN    (INPUT) DOUBLE PRECISION
C        D(N)
C
C  DN1   (INPUT) DOUBLE PRECISION
C        D(N-1)
C
C  DN2   (INPUT) DOUBLE PRECISION
C        D(N-2)
C
C  TAU   (OUTPUT) DOUBLE PRECISION
C        THIS IS THE SHIFT.
C
C  TTYPE (OUTPUT) INTEGER
C        SHIFT TYPE.
C
C  FURTHER DETAILS
C  ===============
C  CNST1 = 9/16
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   CNST1, CNST2, CNST3
      PARAMETER          ( CNST1 = 0.5630D+00, CNST2 = 1.010D+00,
     $                   CNST3 = 1.050D+00 )
      DOUBLE PRECISION   QURTR, THIRD, HALF, ZERO, ONE, TWO, HUNDRD
      PARAMETER          ( QURTR = 0.250D+00, THIRD = 0.3330D+00,
     $                   HALF = 0.50D+00, ZERO = 0.0D+00, ONE = 1.0D+00,
     $                   TWO = 2.0D+00, HUNDRD = 100.0D+00 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            I4, NN, NP
      DOUBLE PRECISION   A2, B1, B2, G, GAM, GAP1, GAP2, S
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN, SQRT
C     ..
C     .. SAVE STATEMENT ..
      SAVE               G
C     ..
C     .. DATA STATEMENT ..
      DATA               G / ZERO /
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     A NEGATIVE DMIN FORCES THE SHIFT TO TAKE THAT ABSOLUTE VALUE
C     TTYPE RECORDS THE TYPE OF SHIFT.
C
      IF( DMIN.LE.ZERO ) THEN
         TAU = -DMIN
         TTYPE = -1
         RETURN
      END IF
C
      NN = 4*N0 + PP
      IF( N0IN.EQ.N0 ) THEN
C
C        NO EIGENVALUES DEFLATED.
C
         IF( DMIN.EQ.DN .OR. DMIN.EQ.DN1 ) THEN
C
            B1 = SQRT( Z( NN-3 ) )*SQRT( Z( NN-5 ) )
            B2 = SQRT( Z( NN-7 ) )*SQRT( Z( NN-9 ) )
            A2 = Z( NN-7 ) + Z( NN-5 )
C
C           CASES 2 AND 3.
C
            IF( DMIN.EQ.DN .AND. DMIN1.EQ.DN1 ) THEN
               GAP2 = DMIN2 - A2 - DMIN2*QURTR
               IF( GAP2.GT.ZERO .AND. GAP2.GT.B2 ) THEN
                  GAP1 = A2 - DN - ( B2 / GAP2 )*B2
               ELSE
                  GAP1 = A2 - DN - ( B1+B2 )
               END IF
               IF( GAP1.GT.ZERO .AND. GAP1.GT.B1 ) THEN
                  S = MAX( DN-( B1 / GAP1 )*B1, HALF*DMIN )
                  TTYPE = -2
               ELSE
                  S = ZERO
                  IF( DN.GT.B1 )
     $               S = DN - B1
                  IF( A2.GT.( B1+B2 ) )
     $               S = MIN( S, A2-( B1+B2 ) )
                  S = MAX( S, THIRD*DMIN )
                  TTYPE = -3
               END IF
            ELSE
C
C              CASE 4.
C
               TTYPE = -4
               S = QURTR*DMIN
               IF( DMIN.EQ.DN ) THEN
                  GAM = DN
                  A2 = ZERO
                  IF( Z( NN-5 ) .GT. Z( NN-7 ) )
     $               RETURN
                  B2 = Z( NN-5 ) / Z( NN-7 )
                  NP = NN - 9
               ELSE
                  NP = NN - 2*PP
                  B2 = Z( NP-2 )
                  GAM = DN1
                  IF( Z( NP-4 ) .GT. Z( NP-2 ) )
     $               RETURN
                  A2 = Z( NP-4 ) / Z( NP-2 )
                  IF( Z( NN-9 ) .GT. Z( NN-11 ) )
     $               RETURN
                  B2 = Z( NN-9 ) / Z( NN-11 )
                  NP = NN - 13
               END IF
C
C              APPROXIMATE CONTRIBUTION TO NORM SQUARED FROM I < NN-1.
C
               A2 = A2 + B2
               DO 10 I4 = NP, 4*I0 - 1 + PP, -4
                  IF( B2.EQ.ZERO )
     $               GO TO 20
                  B1 = B2
                  IF( Z( I4 ) .GT. Z( I4-2 ) )
     $               RETURN
                  B2 = B2*( Z( I4 ) / Z( I4-2 ) )
                  A2 = A2 + B2
                  IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
     $               GO TO 20
   10          CONTINUE
   20          CONTINUE
               A2 = CNST3*A2
C
C              RAYLEIGH QUOTIENT RESIDUAL BOUND.
C
               IF( A2.LT.CNST1 )
     $            S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
            END IF
         ELSE IF( DMIN.EQ.DN2 ) THEN
C
C           CASE 5.
C
            TTYPE = -5
            S = QURTR*DMIN
C
C           COMPUTE CONTRIBUTION TO NORM SQUARED FROM I > NN-2.
C
            NP = NN - 2*PP
            B1 = Z( NP-2 )
            B2 = Z( NP-6 )
            GAM = DN2
            IF( Z( NP-8 ).GT.B2 .OR. Z( NP-4 ).GT.B1 )
     $         RETURN
            A2 = ( Z( NP-8 ) / B2 )*( ONE+Z( NP-4 ) / B1 )
C
C           APPROXIMATE CONTRIBUTION TO NORM SQUARED FROM I < NN-2.
C
            IF( N0-I0.GT.2 ) THEN
               B2 = Z( NN-13 ) / Z( NN-15 )
               A2 = A2 + B2
               DO 30 I4 = NN - 17, 4*I0 - 1 + PP, -4
                  IF( B2.EQ.ZERO )
     $               GO TO 40
                  B1 = B2
                  IF( Z( I4 ) .GT. Z( I4-2 ) )
     $               RETURN
                  B2 = B2*( Z( I4 ) / Z( I4-2 ) )
                  A2 = A2 + B2
                  IF( HUNDRD*MAX( B2, B1 ).LT.A2 .OR. CNST1.LT.A2 )
     $               GO TO 40
   30          CONTINUE
   40          CONTINUE
               A2 = CNST3*A2
            END IF
C
            IF( A2.LT.CNST1 )
     $         S = GAM*( ONE-SQRT( A2 ) ) / ( ONE+A2 )
         ELSE
C
C           CASE 6, NO INFORMATION TO GUIDE US.
C
            IF( TTYPE.EQ.-6 ) THEN
               G = G + THIRD*( ONE-G )
            ELSE IF( TTYPE.EQ.-18 ) THEN
               G = QURTR*THIRD
            ELSE
               G = QURTR
            END IF
            S = G*DMIN
            TTYPE = -6
         END IF
C
      ELSE IF( N0IN.EQ.( N0+1 ) ) THEN
C
C        ONE EIGENVALUE JUST DEFLATED. USE DMIN1, DN1 FOR DMIN AND DN.
C
         IF( DMIN1.EQ.DN1 .AND. DMIN2.EQ.DN2 ) THEN
C
C           CASES 7 AND 8.
C
            TTYPE = -7
            S = THIRD*DMIN1
            IF( Z( NN-5 ).GT.Z( NN-7 ) )
     $         RETURN
            B1 = Z( NN-5 ) / Z( NN-7 )
            B2 = B1
            IF( B2.EQ.ZERO )
     $         GO TO 60
            DO 50 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
               A2 = B1
               IF( Z( I4 ).GT.Z( I4-2 ) )
     $            RETURN
               B1 = B1*( Z( I4 ) / Z( I4-2 ) )
               B2 = B2 + B1
               IF( HUNDRD*MAX( B1, A2 ).LT.B2 )
     $            GO TO 60
   50       CONTINUE
   60       CONTINUE
            B2 = SQRT( CNST3*B2 )
            A2 = DMIN1 / ( ONE+B2**2 )
            GAP2 = HALF*DMIN2 - A2
            IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
               S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
            ELSE
               S = MAX( S, A2*( ONE-CNST2*B2 ) )
               TTYPE = -8
            END IF
         ELSE
C
C           CASE 9.
C
            S = QURTR*DMIN1
            IF( DMIN1.EQ.DN1 )
     $         S = HALF*DMIN1
            TTYPE = -9
         END IF
C
      ELSE IF( N0IN.EQ.( N0+2 ) ) THEN
C
C        TWO EIGENVALUES DEFLATED. USE DMIN2, DN2 FOR DMIN AND DN.
C
C        CASES 10 AND 11.
C
         IF( DMIN2.EQ.DN2 .AND. TWO*Z( NN-5 ).LT.Z( NN-7 ) ) THEN
            TTYPE = -10
            S = THIRD*DMIN2
            IF( Z( NN-5 ).GT.Z( NN-7 ) )
     $         RETURN
            B1 = Z( NN-5 ) / Z( NN-7 )
            B2 = B1
            IF( B2.EQ.ZERO )
     $         GO TO 80
            DO 70 I4 = 4*N0 - 9 + PP, 4*I0 - 1 + PP, -4
               IF( Z( I4 ).GT.Z( I4-2 ) )
     $            RETURN
               B1 = B1*( Z( I4 ) / Z( I4-2 ) )
               B2 = B2 + B1
               IF( HUNDRD*B1.LT.B2 )
     $            GO TO 80
   70       CONTINUE
   80       CONTINUE
            B2 = SQRT( CNST3*B2 )
            A2 = DMIN2 / ( ONE+B2**2 )
            GAP2 = Z( NN-7 ) + Z( NN-9 ) -
     $             SQRT( Z( NN-11 ) )*SQRT( Z( NN-9 ) ) - A2
            IF( GAP2.GT.ZERO .AND. GAP2.GT.B2*A2 ) THEN
               S = MAX( S, A2*( ONE-CNST2*A2*( B2 / GAP2 )*B2 ) )
            ELSE
               S = MAX( S, A2*( ONE-CNST2*B2 ) )
            END IF
         ELSE
            S = QURTR*DMIN2
            TTYPE = -11
         END IF
      ELSE IF( N0IN.GT.( N0+2 ) ) THEN
C
C        CASE 12, MORE THAN TWO EIGENVALUES DEFLATED. NO INFORMATION.
C
         S = ZERO
         TTYPE = -12
      END IF
C
      TAU = S
      RETURN
C
C     END OF DLASQ4
C
      END
C*MODULE DGESVD  *DECK DLASQ5
      SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
     $                   DNM1, DNM2, IEEE )
C
C  -- LAPACK AUXILIARY ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     MAY 17, 2000
C
C     .. SCALAR ARGUMENTS ..
      LOGICAL            IEEE
      INTEGER            I0, N0, PP
      DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   Z( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DLASQ5 COMPUTES ONE DQDS TRANSFORM IN PING-PONG FORM, ONE
C  VERSION FOR IEEE MACHINES ANOTHER FOR NON IEEE MACHINES.
C
C  ARGUMENTS
C  =========
C
C  I0    (INPUT) INTEGER
C        FIRST INDEX.
C
C  N0    (INPUT) INTEGER
C        LAST INDEX.
C
C  Z     (INPUT) DOUBLE PRECISION ARRAY, DIMENSION ( 4*N )
C        Z HOLDS THE QD ARRAY. EMIN IS STORED IN Z(4*N0) TO AVOID
C        AN EXTRA ARGUMENT.
C
C  PP    (INPUT) INTEGER
C        PP=0 FOR PING, PP=1 FOR PONG.
C
C  TAU   (INPUT) DOUBLE PRECISION
C        THIS IS THE SHIFT.
C
C  DMIN  (OUTPUT) DOUBLE PRECISION
C        MINIMUM VALUE OF D.
C
C  DMIN1 (OUTPUT) DOUBLE PRECISION
C        MINIMUM VALUE OF D, EXCLUDING D( N0 ).
C
C  DMIN2 (OUTPUT) DOUBLE PRECISION
C        MINIMUM VALUE OF D, EXCLUDING D( N0 ) AND D( N0-1 ).
C
C  DN    (OUTPUT) DOUBLE PRECISION
C        D(N0), THE LAST VALUE OF D.
C
C  DNM1  (OUTPUT) DOUBLE PRECISION
C        D(N0-1).
C
C  DNM2  (OUTPUT) DOUBLE PRECISION
C        D(N0-2).
C
C  IEEE  (INPUT) LOGICAL
C        FLAG FOR IEEE OR NON IEEE ARITHMETIC.
C
C  =====================================================================
C
C     .. PARAMETER ..
      DOUBLE PRECISION   ZERO
      PARAMETER          ( ZERO = 0.0D+00 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            J4, J4P2
      DOUBLE PRECISION   D, EMIN, TEMP
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MIN
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
      IF( ( N0-I0-1 ).LE.0 )
     $   RETURN
C
      J4 = 4*I0 + PP - 3
      EMIN = Z( J4+4 )
      D = Z( J4 ) - TAU
      DMIN = D
      DMIN1 = -Z( J4 )
C
      IF( IEEE ) THEN
C
C        CODE FOR IEEE ARITHMETIC.
C
         IF( PP.EQ.0 ) THEN
            DO 10 J4 = 4*I0, 4*( N0-3 ), 4
               Z( J4-2 ) = D + Z( J4-1 )
               TEMP = Z( J4+1 ) / Z( J4-2 )
               D = D*TEMP - TAU
               DMIN = MIN( DMIN, D )
               Z( J4 ) = Z( J4-1 )*TEMP
               EMIN = MIN( Z( J4 ), EMIN )
   10       CONTINUE
         ELSE
            DO 20 J4 = 4*I0, 4*( N0-3 ), 4
               Z( J4-3 ) = D + Z( J4 )
               TEMP = Z( J4+2 ) / Z( J4-3 )
               D = D*TEMP - TAU
               DMIN = MIN( DMIN, D )
               Z( J4-1 ) = Z( J4 )*TEMP
               EMIN = MIN( Z( J4-1 ), EMIN )
   20       CONTINUE
         END IF
C
C        UNROLL LAST TWO STEPS.
C
         DNM2 = D
         DMIN2 = DMIN
         J4 = 4*( N0-2 ) - PP
         J4P2 = J4 + 2*PP - 1
         Z( J4-2 ) = DNM2 + Z( J4P2 )
         Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
         DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
         DMIN = MIN( DMIN, DNM1 )
C
         DMIN1 = DMIN
         J4 = J4 + 4
         J4P2 = J4 + 2*PP - 1
         Z( J4-2 ) = DNM1 + Z( J4P2 )
         Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
         DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
         DMIN = MIN( DMIN, DN )
C
      ELSE
C
C        CODE FOR NON IEEE ARITHMETIC.
C
         IF( PP.EQ.0 ) THEN
            DO 30 J4 = 4*I0, 4*( N0-3 ), 4
               Z( J4-2 ) = D + Z( J4-1 )
               IF( D.LT.ZERO ) THEN
                  RETURN
               ELSE
                  Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
                  D = Z( J4+1 )*( D / Z( J4-2 ) ) - TAU
               END IF
               DMIN = MIN( DMIN, D )
               EMIN = MIN( EMIN, Z( J4 ) )
   30       CONTINUE
         ELSE
            DO 40 J4 = 4*I0, 4*( N0-3 ), 4
               Z( J4-3 ) = D + Z( J4 )
               IF( D.LT.ZERO ) THEN
                  RETURN
               ELSE
                  Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
                  D = Z( J4+2 )*( D / Z( J4-3 ) ) - TAU
               END IF
               DMIN = MIN( DMIN, D )
               EMIN = MIN( EMIN, Z( J4-1 ) )
   40       CONTINUE
         END IF
C
C        UNROLL LAST TWO STEPS.
C
         DNM2 = D
         DMIN2 = DMIN
         J4 = 4*( N0-2 ) - PP
         J4P2 = J4 + 2*PP - 1
         Z( J4-2 ) = DNM2 + Z( J4P2 )
         IF( DNM2.LT.ZERO ) THEN
            RETURN
         ELSE
            Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
            DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
         END IF
         DMIN = MIN( DMIN, DNM1 )
C
         DMIN1 = DMIN
         J4 = J4 + 4
         J4P2 = J4 + 2*PP - 1
         Z( J4-2 ) = DNM1 + Z( J4P2 )
         IF( DNM1.LT.ZERO ) THEN
            RETURN
         ELSE
            Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
            DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
         END IF
         DMIN = MIN( DMIN, DN )
C
      END IF
C
      Z( J4+2 ) = DN
      Z( 4*N0-PP ) = EMIN
      RETURN
C
C     END OF DLASQ5
C
      END
C*MODULE DGESVD  *DECK DLASQ6
      SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN,
     $                   DNM1, DNM2 )
C
C  -- LAPACK AUXILIARY ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     OCTOBER 31, 1999
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            I0, N0, PP
      DOUBLE PRECISION   DMIN, DMIN1, DMIN2, DN, DNM1, DNM2
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   Z( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DLASQ6 COMPUTES ONE DQD (SHIFT EQUAL TO ZERO) TRANSFORM IN
C  PING-PONG FORM, WITH PROTECTION AGAINST UNDERFLOW AND OVERFLOW.
C
C  ARGUMENTS
C  =========
C
C  I0    (INPUT) INTEGER
C        FIRST INDEX.
C
C  N0    (INPUT) INTEGER
C        LAST INDEX.
C
C  Z     (INPUT) DOUBLE PRECISION ARRAY, DIMENSION ( 4*N )
C        Z HOLDS THE QD ARRAY. EMIN IS STORED IN Z(4*N0) TO AVOID
C        AN EXTRA ARGUMENT.
C
C  PP    (INPUT) INTEGER
C        PP=0 FOR PING, PP=1 FOR PONG.
C
C  DMIN  (OUTPUT) DOUBLE PRECISION
C        MINIMUM VALUE OF D.
C
C  DMIN1 (OUTPUT) DOUBLE PRECISION
C        MINIMUM VALUE OF D, EXCLUDING D( N0 ).
C
C  DMIN2 (OUTPUT) DOUBLE PRECISION
C        MINIMUM VALUE OF D, EXCLUDING D( N0 ) AND D( N0-1 ).
C
C  DN    (OUTPUT) DOUBLE PRECISION
C        D(N0), THE LAST VALUE OF D.
C
C  DNM1  (OUTPUT) DOUBLE PRECISION
C        D(N0-1).
C
C  DNM2  (OUTPUT) DOUBLE PRECISION
C        D(N0-2).
C
C  =====================================================================
C
C     .. PARAMETER ..
      DOUBLE PRECISION   ZERO
      PARAMETER          ( ZERO = 0.0D+00 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            J4, J4P2
      DOUBLE PRECISION   D, EMIN, SAFMIN, TEMP
C     ..
C     .. EXTERNAL FUNCTION ..
      DOUBLE PRECISION   DLAMCH
      EXTERNAL           DLAMCH
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MIN
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
      IF( ( N0-I0-1 ).LE.0 )
     $   RETURN
C
      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
      J4 = 4*I0 + PP - 3
      EMIN = Z( J4+4 )
      D = Z( J4 )
      DMIN = D
C
      IF( PP.EQ.0 ) THEN
         DO 10 J4 = 4*I0, 4*( N0-3 ), 4
            Z( J4-2 ) = D + Z( J4-1 )
            IF( Z( J4-2 ).EQ.ZERO ) THEN
               Z( J4 ) = ZERO
               D = Z( J4+1 )
               DMIN = D
               EMIN = ZERO
            ELSE IF( SAFMIN*Z( J4+1 ).LT.Z( J4-2 ) .AND.
     $               SAFMIN*Z( J4-2 ).LT.Z( J4+1 ) ) THEN
               TEMP = Z( J4+1 ) / Z( J4-2 )
               Z( J4 ) = Z( J4-1 )*TEMP
               D = D*TEMP
            ELSE
               Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
               D = Z( J4+1 )*( D / Z( J4-2 ) )
            END IF
            DMIN = MIN( DMIN, D )
            EMIN = MIN( EMIN, Z( J4 ) )
   10    CONTINUE
      ELSE
         DO 20 J4 = 4*I0, 4*( N0-3 ), 4
            Z( J4-3 ) = D + Z( J4 )
            IF( Z( J4-3 ).EQ.ZERO ) THEN
               Z( J4-1 ) = ZERO
               D = Z( J4+2 )
               DMIN = D
               EMIN = ZERO
            ELSE IF( SAFMIN*Z( J4+2 ).LT.Z( J4-3 ) .AND.
     $               SAFMIN*Z( J4-3 ).LT.Z( J4+2 ) ) THEN
               TEMP = Z( J4+2 ) / Z( J4-3 )
               Z( J4-1 ) = Z( J4 )*TEMP
               D = D*TEMP
            ELSE
               Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
               D = Z( J4+2 )*( D / Z( J4-3 ) )
            END IF
            DMIN = MIN( DMIN, D )
            EMIN = MIN( EMIN, Z( J4-1 ) )
   20    CONTINUE
      END IF
C
C     UNROLL LAST TWO STEPS.
C
      DNM2 = D
      DMIN2 = DMIN
      J4 = 4*( N0-2 ) - PP
      J4P2 = J4 + 2*PP - 1
      Z( J4-2 ) = DNM2 + Z( J4P2 )
      IF( Z( J4-2 ).EQ.ZERO ) THEN
         Z( J4 ) = ZERO
         DNM1 = Z( J4P2+2 )
         DMIN = DNM1
         EMIN = ZERO
      ELSE IF( SAFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) .AND.
     $         SAFMIN*Z( J4-2 ).LT.Z( J4P2+2 ) ) THEN
         TEMP = Z( J4P2+2 ) / Z( J4-2 )
         Z( J4 ) = Z( J4P2 )*TEMP
         DNM1 = DNM2*TEMP
      ELSE
         Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
         DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) )
      END IF
      DMIN = MIN( DMIN, DNM1 )
C
      DMIN1 = DMIN
      J4 = J4 + 4
      J4P2 = J4 + 2*PP - 1
      Z( J4-2 ) = DNM1 + Z( J4P2 )
      IF( Z( J4-2 ).EQ.ZERO ) THEN
         Z( J4 ) = ZERO
         DN = Z( J4P2+2 )
         DMIN = DN
         EMIN = ZERO
      ELSE IF( SAFMIN*Z( J4P2+2 ).LT.Z( J4-2 ) .AND.
     $         SAFMIN*Z( J4-2 ).LT.Z( J4P2+2 ) ) THEN
         TEMP = Z( J4P2+2 ) / Z( J4-2 )
         Z( J4 ) = Z( J4P2 )*TEMP
         DN = DNM1*TEMP
      ELSE
         Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
         DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) )
      END IF
      DMIN = MIN( DMIN, DN )
C
      Z( J4+2 ) = DN
      Z( 4*N0-PP ) = EMIN
      RETURN
C
C     END OF DLASQ6
C
      END
C*MODULE DGESVD  *DECK DORM2R
      SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
     $                   WORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     FEBRUARY 29, 1992
C
C     .. SCALAR ARGUMENTS ..
      CHARACTER          SIDE, TRANS
      INTEGER            INFO, K, LDA, LDC, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DORM2R OVERWRITES THE GENERAL REAL M BY N MATRIX C WITH
C
C        Q * C  IF SIDE = 'L' AND TRANS = 'N', OR
C
C        Q'* C  IF SIDE = 'L' AND TRANS = 'T', OR
C
C        C * Q  IF SIDE = 'R' AND TRANS = 'N', OR
C
C        C * Q' IF SIDE = 'R' AND TRANS = 'T',
C
C  WHERE Q IS A REAL ORTHOGONAL MATRIX DEFINED AS THE PRODUCT OF K
C  ELEMENTARY REFLECTORS
C
C        Q = H(1) H(2) . . . H(K)
C
C  AS RETURNED BY DGEQRF. Q IS OF ORDER M IF SIDE = 'L' AND OF ORDER N
C  IF SIDE = 'R'.
C
C  ARGUMENTS
C  =========
C
C  SIDE    (INPUT) CHARACTER*1
C          = 'L': APPLY Q OR Q' FROM THE LEFT
C          = 'R': APPLY Q OR Q' FROM THE RIGHT
C
C  TRANS   (INPUT) CHARACTER*1
C          = 'N': APPLY Q  (NO TRANSPOSE)
C          = 'T': APPLY Q' (TRANSPOSE)
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX C. M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX C. N >= 0.
C
C  K       (INPUT) INTEGER
C          THE NUMBER OF ELEMENTARY REFLECTORS WHOSE PRODUCT DEFINES
C          THE MATRIX Q.
C          IF SIDE = 'L', M >= K >= 0;
C          IF SIDE = 'R', N >= K >= 0.
C
C  A       (INPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,K)
C          THE I-TH COLUMN MUST CONTAIN THE VECTOR WHICH DEFINES THE
C          ELEMENTARY REFLECTOR H(I), FOR I = 1,2,...,K, AS RETURNED BY
C          DGEQRF IN THE FIRST K COLUMNS OF ITS ARRAY ARGUMENT A.
C          A IS MODIFIED BY THE ROUTINE BUT RESTORED ON EXIT.
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.
C          IF SIDE = 'L', LDA >= MAX(1,M);
C          IF SIDE = 'R', LDA >= MAX(1,N).
C
C  TAU     (INPUT) DOUBLE PRECISION ARRAY, DIMENSION (K)
C          TAU(I) MUST CONTAIN THE SCALAR FACTOR OF THE ELEMENTARY
C          REFLECTOR H(I), AS RETURNED BY DGEQRF.
C
C  C       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDC,N)
C          ON ENTRY, THE M BY N MATRIX C.
C          ON EXIT, C IS OVERWRITTEN BY Q*C OR Q'*C OR C*Q' OR C*Q.
C
C  LDC     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY C. LDC >= MAX(1,M).
C
C  WORK    (WORKSPACE) DOUBLE PRECISION ARRAY, DIMENSION
C                                   (N) IF SIDE = 'L',
C                                   (M) IF SIDE = 'R'
C
C  INFO    (OUTPUT) INTEGER
C          = 0: SUCCESSFUL EXIT
C          < 0: IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ONE
      PARAMETER          ( ONE = 1.0D+0 )
C     ..
C     .. LOCAL SCALARS ..
      LOGICAL            LEFT, NOTRAN
      INTEGER            I, I1, I2, I3, IC, JC, MI, NI, NQ
      DOUBLE PRECISION   AII
C     ..
C     .. EXTERNAL FUNCTIONS ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLARF, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      LEFT = LSAME( SIDE, 'L' )
      NOTRAN = LSAME( TRANS, 'N' )
C
C     NQ IS THE ORDER OF Q
C
      IF( LEFT ) THEN
         NQ = M
      ELSE
         NQ = N
      END IF
      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
         INFO = -1
      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
         INFO = -2
      ELSE IF( M.LT.0 ) THEN
         INFO = -3
      ELSE IF( N.LT.0 ) THEN
         INFO = -4
      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
         INFO = -5
      ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
         INFO = -7
      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
         INFO = -10
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DORM2R', -INFO )
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
     $   RETURN
C
      IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
     $     THEN
         I1 = 1
         I2 = K
         I3 = 1
      ELSE
         I1 = K
         I2 = 1
         I3 = -1
      END IF
C
      IF( LEFT ) THEN
         NI = N
         JC = 1
      ELSE
         MI = M
         IC = 1
      END IF
C
      DO 10 I = I1, I2, I3
         IF( LEFT ) THEN
C
C           H(I) IS APPLIED TO C(I:M,1:N)
C
            MI = M - I + 1
            IC = I
         ELSE
C
C           H(I) IS APPLIED TO C(1:M,I:N)
C
            NI = N - I + 1
            JC = I
         END IF
C
C        APPLY H(I)
C
         AII = A( I, I )
         A( I, I ) = ONE
         CALL DLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, JC ),
     $               LDC, WORK )
         A( I, I ) = AII
   10 CONTINUE
      RETURN
C
C     END OF DORM2R
C
      END
C*MODULE DGESVD  *DECK DORML2
      SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
     $                   WORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     FEBRUARY 29, 1992
C
C     .. SCALAR ARGUMENTS ..
      CHARACTER          SIDE, TRANS
      INTEGER            INFO, K, LDA, LDC, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DORML2 OVERWRITES THE GENERAL REAL M BY N MATRIX C WITH
C
C        Q * C  IF SIDE = 'L' AND TRANS = 'N', OR
C
C        Q'* C  IF SIDE = 'L' AND TRANS = 'T', OR
C
C        C * Q  IF SIDE = 'R' AND TRANS = 'N', OR
C
C        C * Q' IF SIDE = 'R' AND TRANS = 'T',
C
C  WHERE Q IS A REAL ORTHOGONAL MATRIX DEFINED AS THE PRODUCT OF K
C  ELEMENTARY REFLECTORS
C
C        Q = H(K) . . . H(2) H(1)
C
C  AS RETURNED BY DGELQF. Q IS OF ORDER M IF SIDE = 'L' AND OF ORDER N
C  IF SIDE = 'R'.
C
C  ARGUMENTS
C  =========
C
C  SIDE    (INPUT) CHARACTER*1
C          = 'L': APPLY Q OR Q' FROM THE LEFT
C          = 'R': APPLY Q OR Q' FROM THE RIGHT
C
C  TRANS   (INPUT) CHARACTER*1
C          = 'N': APPLY Q  (NO TRANSPOSE)
C          = 'T': APPLY Q' (TRANSPOSE)
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX C. M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX C. N >= 0.
C
C  K       (INPUT) INTEGER
C          THE NUMBER OF ELEMENTARY REFLECTORS WHOSE PRODUCT DEFINES
C          THE MATRIX Q.
C          IF SIDE = 'L', M >= K >= 0;
C          IF SIDE = 'R', N >= K >= 0.
C
C  A       (INPUT) DOUBLE PRECISION ARRAY, DIMENSION
C                               (LDA,M) IF SIDE = 'L',
C                               (LDA,N) IF SIDE = 'R'
C          THE I-TH ROW MUST CONTAIN THE VECTOR WHICH DEFINES THE
C          ELEMENTARY REFLECTOR H(I), FOR I = 1,2,...,K, AS RETURNED BY
C          DGELQF IN THE FIRST K ROWS OF ITS ARRAY ARGUMENT A.
C          A IS MODIFIED BY THE ROUTINE BUT RESTORED ON EXIT.
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A. LDA >= MAX(1,K).
C
C  TAU     (INPUT) DOUBLE PRECISION ARRAY, DIMENSION (K)
C          TAU(I) MUST CONTAIN THE SCALAR FACTOR OF THE ELEMENTARY
C          REFLECTOR H(I), AS RETURNED BY DGELQF.
C
C  C       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDC,N)
C          ON ENTRY, THE M BY N MATRIX C.
C          ON EXIT, C IS OVERWRITTEN BY Q*C OR Q'*C OR C*Q' OR C*Q.
C
C  LDC     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY C. LDC >= MAX(1,M).
C
C  WORK    (WORKSPACE) DOUBLE PRECISION ARRAY, DIMENSION
C                                   (N) IF SIDE = 'L',
C                                   (M) IF SIDE = 'R'
C
C  INFO    (OUTPUT) INTEGER
C          = 0: SUCCESSFUL EXIT
C          < 0: IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ONE
      PARAMETER          ( ONE = 1.0D+0 )
C     ..
C     .. LOCAL SCALARS ..
      LOGICAL            LEFT, NOTRAN
      INTEGER            I, I1, I2, I3, IC, JC, MI, NI, NQ
      DOUBLE PRECISION   AII
C     ..
C     .. EXTERNAL FUNCTIONS ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLARF, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      LEFT = LSAME( SIDE, 'L' )
      NOTRAN = LSAME( TRANS, 'N' )
C
C     NQ IS THE ORDER OF Q
C
      IF( LEFT ) THEN
         NQ = M
      ELSE
         NQ = N
      END IF
      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
         INFO = -1
      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
         INFO = -2
      ELSE IF( M.LT.0 ) THEN
         INFO = -3
      ELSE IF( N.LT.0 ) THEN
         INFO = -4
      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
         INFO = -5
      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
         INFO = -7
      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
         INFO = -10
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DORML2', -INFO )
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
     $   RETURN
C
      IF( ( LEFT .AND. NOTRAN ) .OR. ( .NOT.LEFT .AND. .NOT.NOTRAN ) )
     $     THEN
         I1 = 1
         I2 = K
         I3 = 1
      ELSE
         I1 = K
         I2 = 1
         I3 = -1
      END IF
C
      IF( LEFT ) THEN
         NI = N
         JC = 1
      ELSE
         MI = M
         IC = 1
      END IF
C
      DO 10 I = I1, I2, I3
         IF( LEFT ) THEN
C
C           H(I) IS APPLIED TO C(I:M,1:N)
C
            MI = M - I + 1
            IC = I
         ELSE
C
C           H(I) IS APPLIED TO C(1:M,I:N)
C
            NI = N - I + 1
            JC = I
         END IF
C
C        APPLY H(I)
C
         AII = A( I, I )
         A( I, I ) = ONE
         CALL DLARF( SIDE, MI, NI, A( I, I ), LDA, TAU( I ),
     $               C( IC, JC ), LDC, WORK )
         A( I, I ) = AII
   10 CONTINUE
      RETURN
C
C     END OF DORML2
C
      END
C*MODULE DGESVD   *DECK DGEQRF
      SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     JUNE 30, 1999
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            INFO, LDA, LWORK, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DGEQRF COMPUTES A QR FACTORIZATION OF A REAL M-BY-N MATRIX A:
C  A = Q * R.
C
C  ARGUMENTS
C  =========
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX A.  M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX A.  N >= 0.
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          ON ENTRY, THE M-BY-N MATRIX A.
C          ON EXIT, THE ELEMENTS ON AND ABOVE THE DIAGONAL OF THE ARRAY
C          CONTAIN THE MIN(M,N)-BY-N UPPER TRAPEZOIDAL MATRIX R (R IS
C          UPPER TRIANGULAR IF M >= N); THE ELEMENTS BELOW THE DIAGONAL,
C          WITH THE ARRAY TAU, REPRESENT THE ORTHOGONAL MATRIX Q AS A
C          PRODUCT OF MIN(M,N) ELEMENTARY REFLECTORS (SEE FURTHER
C          DETAILS).
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.  LDA >= MAX(1,M).
C
C  TAU     (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(M,N))
C          THE SCALAR FACTORS OF THE ELEMENTARY REFLECTORS (SEE FURTHER
C          DETAILS).
C
C  WORK    (WORKSPACE/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LWORK)
C          ON EXIT, IF INFO = 0, WORK(1) RETURNS THE OPTIMAL LWORK.
C
C  LWORK   (INPUT) INTEGER
C          THE DIMENSION OF THE ARRAY WORK.  LWORK >= MAX(1,N).
C          FOR OPTIMUM PERFORMANCE LWORK >= N*NB, WHERE NB IS
C          THE OPTIMAL BLOCKSIZE.
C
C          IF LWORK = -1, THEN A WORKSPACE QUERY IS ASSUMED; THE ROUTINE
C          ONLY CALCULATES THE OPTIMAL SIZE OF THE WORK ARRAY, RETURNS
C          THIS VALUE AS THE FIRST ENTRY OF THE WORK ARRAY, AND NO ERROR
C          MESSAGE RELATED TO LWORK IS ISSUED BY XERBLA.
C
C  INFO    (OUTPUT) INTEGER
C          = 0:  SUCCESSFUL EXIT
C          < 0:  IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C
C  FURTHER DETAILS
C  ===============
C
C  THE MATRIX Q IS REPRESENTED AS A PRODUCT OF ELEMENTARY REFLECTORS
C
C     Q = H(1) H(2) . . . H(K), WHERE K = MIN(M,N).
C
C  EACH H(I) HAS THE FORM
C
C     H(I) = I - TAU * V * V'
C
C  WHERE TAU IS A REAL SCALAR, AND V IS A REAL VECTOR WITH
C  V(1:I-1) = 0 AND V(I) = 1; V(I+1:M) IS STORED ON EXIT IN A(I+1:M,I),
C  AND TAU IN TAU(I).
C
C  =====================================================================
C
C     .. LOCAL SCALARS ..
      LOGICAL            LQUERY
      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
     $                   NBMIN, NX
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DGEQR2, DLARFB, DLARFT, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN
C     ..
C     .. EXTERNAL FUNCTIONS ..
      INTEGER            ILAENV
      EXTERNAL           ILAENV
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      NB = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
      LWKOPT = N*NB
      WORK( 1 ) = LWKOPT
      LQUERY = ( LWORK.EQ.-1 )
      IF( M.LT.0 ) THEN
         INFO = -1
      ELSE IF( N.LT.0 ) THEN
         INFO = -2
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = -4
      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
         INFO = -7
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DGEQRF', -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         RETURN
      END IF
C
C     QUICK RETURN IF POSSIBLE
C
      K = MIN( M, N )
      IF( K.EQ.0 ) THEN
         WORK( 1 ) = 1
         RETURN
      END IF
C
      NBMIN = 2
      NX = 0
      IWS = N
      IF( NB.GT.1 .AND. NB.LT.K ) THEN
C
C        DETERMINE WHEN TO CROSS OVER FROM BLOCKED TO UNBLOCKED CODE.
C
         NX = MAX( 0, ILAENV( 3, 'DGEQRF', ' ', M, N, -1, -1 ) )
         IF( NX.LT.K ) THEN
C
C           DETERMINE IF WORKSPACE IS LARGE ENOUGH FOR BLOCKED CODE.
C
            LDWORK = N
            IWS = LDWORK*NB
            IF( LWORK.LT.IWS ) THEN
C
C              NOT ENOUGH WORKSPACE TO USE OPTIMAL NB:  REDUCE NB AND
C              DETERMINE THE MINIMUM VALUE OF NB.
C
               NB = LWORK / LDWORK
               NBMIN = MAX( 2, ILAENV( 2, 'DGEQRF', ' ', M, N, -1,
     $                 -1 ) )
            END IF
         END IF
      END IF
C
      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
C
C        USE BLOCKED CODE INITIALLY
C
         DO 10 I = 1, K - NX, NB
            IB = MIN( K-I+1, NB )
C
C           COMPUTE THE QR FACTORIZATION OF THE CURRENT BLOCK
C           A(I:M,I:I+IB-1)
C
            CALL DGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
     $                   IINFO )
            IF( I+IB.LE.N ) THEN
C
C              FORM THE TRIANGULAR FACTOR OF THE BLOCK REFLECTOR
C              H = H(I) H(I+1) . . . H(I+IB-1)
C
               CALL DLARFT( 'FORWARD', 'COLUMNWISE', M-I+1, IB,
     $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
C
C              APPLY H' TO A(I:M,I+IB:N) FROM THE LEFT
C
               CALL DLARFB( 'LEFT', 'TRANSPOSE', 'FORWARD',
     $                      'COLUMNWISE', M-I+1, N-I-IB+1, IB,
     $                      A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
     $                      LDA, WORK( IB+1 ), LDWORK )
            END IF
   10    CONTINUE
      ELSE
         I = 1
      END IF
C
C     USE UNBLOCKED CODE TO FACTOR THE LAST OR ONLY BLOCK.
C
      IF( I.LE.K )
     $   CALL DGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
     $                IINFO )
C
      WORK( 1 ) = IWS
      RETURN
C
C     END OF DGEQRF
C
      END
C*MODULE DGESVD   *DECK DGEQR2
      SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
C
C  -- LAPACK ROUTINE (VERSION 3.0) --
C     UNIV. OF TENNESSEE, UNIV. OF CALIFORNIA BERKELEY, NAG LTD.,
C     COURANT INSTITUTE, ARGONNE NATIONAL LAB, AND RICE UNIVERSITY
C     FEBRUARY 29, 1992
C
C     .. SCALAR ARGUMENTS ..
      INTEGER            INFO, LDA, M, N
C     ..
C     .. ARRAY ARGUMENTS ..
      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
C     ..
C
C  PURPOSE
C  =======
C
C  DGEQR2 COMPUTES A QR FACTORIZATION OF A REAL M BY N MATRIX A:
C  A = Q * R.
C
C  ARGUMENTS
C  =========
C
C  M       (INPUT) INTEGER
C          THE NUMBER OF ROWS OF THE MATRIX A.  M >= 0.
C
C  N       (INPUT) INTEGER
C          THE NUMBER OF COLUMNS OF THE MATRIX A.  N >= 0.
C
C  A       (INPUT/OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (LDA,N)
C          ON ENTRY, THE M BY N MATRIX A.
C          ON EXIT, THE ELEMENTS ON AND ABOVE THE DIAGONAL OF THE ARRAY
C          CONTAIN THE MIN(M,N) BY N UPPER TRAPEZOIDAL MATRIX R (R IS
C          UPPER TRIANGULAR IF M >= N); THE ELEMENTS BELOW THE DIAGONAL,
C          WITH THE ARRAY TAU, REPRESENT THE ORTHOGONAL MATRIX Q AS A
C          PRODUCT OF ELEMENTARY REFLECTORS (SEE FURTHER DETAILS).
C
C  LDA     (INPUT) INTEGER
C          THE LEADING DIMENSION OF THE ARRAY A.  LDA >= MAX(1,M).
C
C  TAU     (OUTPUT) DOUBLE PRECISION ARRAY, DIMENSION (MIN(M,N))
C          THE SCALAR FACTORS OF THE ELEMENTARY REFLECTORS (SEE FURTHER
C          DETAILS).
C
C  WORK    (WORKSPACE) DOUBLE PRECISION ARRAY, DIMENSION (N)
C
C  INFO    (OUTPUT) INTEGER
C          = 0: SUCCESSFUL EXIT
C          < 0: IF INFO = -I, THE I-TH ARGUMENT HAD AN ILLEGAL VALUE
C
C  FURTHER DETAILS
C  ===============
C
C  THE MATRIX Q IS REPRESENTED AS A PRODUCT OF ELEMENTARY REFLECTORS
C
C     Q = H(1) H(2) . . . H(K), WHERE K = MIN(M,N).
C
C  EACH H(I) HAS THE FORM
C
C     H(I) = I - TAU * V * V'
C
C  WHERE TAU IS A REAL SCALAR, AND V IS A REAL VECTOR WITH
C  V(1:I-1) = 0 AND V(I) = 1; V(I+1:M) IS STORED ON EXIT IN A(I+1:M,I),
C  AND TAU IN TAU(I).
C
C  =====================================================================
C
C     .. PARAMETERS ..
      DOUBLE PRECISION   ONE
      PARAMETER          ( ONE = 1.0D+0 )
C     ..
C     .. LOCAL SCALARS ..
      INTEGER            I, K
      DOUBLE PRECISION   AII
C     ..
C     .. EXTERNAL SUBROUTINES ..
      EXTERNAL           DLARF, DLARFG, XERBLA
C     ..
C     .. INTRINSIC FUNCTIONS ..
      INTRINSIC          MAX, MIN
C     ..
C     .. EXECUTABLE STATEMENTS ..
C
C     TEST THE INPUT ARGUMENTS
C
      INFO = 0
      IF( M.LT.0 ) THEN
         INFO = -1
      ELSE IF( N.LT.0 ) THEN
         INFO = -2
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = -4
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'DGEQR2', -INFO )
         RETURN
      END IF
C
      K = MIN( M, N )
C
      DO 10 I = 1, K
C
C        GENERATE ELEMENTARY REFLECTOR H(I) TO ANNIHILATE A(I+1:M,I)
C
         CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
     $                TAU( I ) )
         IF( I.LT.N ) THEN
C
C           APPLY H(I) TO A(I:M,I+1:N) FROM THE LEFT
C
            AII = A( I, I )
            A( I, I ) = ONE
            CALL DLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAU( I ),
     $                  A( I, I+1 ), LDA, WORK )
            A( I, I ) = AII
         END IF
   10 CONTINUE
      RETURN
C
C     END OF DGEQR2
C
      END
