BUGFIX: removed fixes for bugs #148 and #149, because info for xerbla is wrong
authorWerner Saar <wernsaar@googlemail.com>
Mon, 7 Mar 2016 09:34:04 +0000 (10:34 +0100)
committerWerner Saar <wernsaar@googlemail.com>
Mon, 7 Mar 2016 09:34:04 +0000 (10:34 +0100)
lapack-netlib/SRC/cgesvdx.f
lapack-netlib/SRC/dgesvdx.f
lapack-netlib/SRC/sgesvdx.f
lapack-netlib/SRC/zgesvdx.f

index 87ea986..235426a 100644 (file)
 *>          vectors, stored columnwise) as specified by RANGE; if 
 *>          JOBU = 'N', U is not referenced.
 *>          Note: The user must ensure that UCOL >= NS; if RANGE = 'V', 
 *>          vectors, stored columnwise) as specified by RANGE; if 
 *>          JOBU = 'N', U is not referenced.
 *>          Note: The user must ensure that UCOL >= NS; if RANGE = 'V', 
-*>          the exact value of NS is not known in advance and an upper
+*>          the exact value of NS is not known ILQFin advance and an upper 
 *>          bound must be used.
 *> \endverbatim
 *>
 *>          bound must be used.
 *> \endverbatim
 *>
       CHARACTER          JOBZ, RNGTGK
       LOGICAL            ALLS, INDS, LQUERY, VALS, WANTU, WANTVT
       INTEGER            I, ID, IE, IERR, ILQF, ILTGK, IQRF, ISCL,
       CHARACTER          JOBZ, RNGTGK
       LOGICAL            ALLS, INDS, LQUERY, VALS, WANTU, WANTVT
       INTEGER            I, ID, IE, IERR, ILQF, ILTGK, IQRF, ISCL,
-     $                   ITAU, ITAUP, ITAUQ, ITEMP, ITEMPR, ITGKZ, 
-     $                   IUTGK, J, K, MAXWRK, MINMN, MINWRK, MNTHR
+     $                   ITAU, ITAUP, ITAUQ, ITEMP, ITGKZ, IUTGK,
+     $                   J, K, MAXWRK, MINMN, MINWRK, MNTHR
       REAL               ABSTOL, ANRM, BIGNUM, EPS, SMLNUM
 *     ..
 *     .. Local Arrays ..
       REAL               ABSTOL, ANRM, BIGNUM, EPS, SMLNUM
 *     ..
 *     .. Local Arrays ..
          IF( INFO.EQ.0 ) THEN
             IF( WANTU .AND. LDU.LT.M ) THEN
                INFO = -15
          IF( INFO.EQ.0 ) THEN
             IF( WANTU .AND. LDU.LT.M ) THEN
                INFO = -15
-            ELSE IF( WANTVT ) THEN
-               IF( INDS ) THEN
-                   IF( LDVT.LT.IU-IL+1 ) THEN
-                       INFO = -17
-                   END IF
-               ELSE IF( LDVT.LT.MINMN ) THEN
-                   INFO = -17
-               END IF
+            ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN
+               INFO = -16
             END IF
          END IF
       END IF
             END IF
          END IF
       END IF
 *
 *                 Path 1 (M much larger than N)
 *
 *
 *                 Path 1 (M much larger than N)
 *
-                  MINWRK = N*(N+5)
-                  MAXWRK = N + N*ILAENV(1,'CGEQRF',' ',M,N,-1,-1)
-                  MAXWRK = MAX(MAXWRK,
-     $                     N*N+2*N+2*N*ILAENV(1,'CGEBRD',' ',N,N,-1,-1))
-                  IF (WANTU .OR. WANTVT) THEN
-                     MAXWRK = MAX(MAXWRK,
-     $                       N*N+2*N+N*ILAENV(1,'CUNMQR','LN',N,N,N,-1))
-                  END IF
+                  MAXWRK = N + N*
+     $                     ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
+                  MAXWRK = MAX( MAXWRK, N*N + N + 2*N*
+     $                     ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) )
+                  MINWRK = N*(N+4)
                ELSE
 *
 *                 Path 2 (M at least N, but not much larger)
 *
                ELSE
 *
 *                 Path 2 (M at least N, but not much larger)
 *
-                  MINWRK = 3*N + M
-                  MAXWRK = 2*N + (M+N)*ILAENV(1,'CGEBRD',' ',M,N,-1,-1)
-                  IF (WANTU .OR. WANTVT) THEN
-                     MAXWRK = MAX(MAXWRK,
-     $                        2*N+N*ILAENV(1,'CUNMQR','LN',N,N,N,-1))
-                  END IF
+                  MAXWRK = 2*N + ( M+N )*
+     $                     ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 )
+                  MINWRK = 2*N + M
                END IF
             ELSE
                MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, 0 )
                END IF
             ELSE
                MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, 0 )
 *
 *                 Path 1t (N much larger than M)
 *
 *
 *                 Path 1t (N much larger than M)
 *
-                  MINWRK = M*(M+5)
-                  MAXWRK = M + M*ILAENV(1,'CGELQF',' ',M,N,-1,-1)
-                  MAXWRK = MAX(MAXWRK,
-     $                     M*M+2*M+2*M*ILAENV(1,'CGEBRD',' ',M,M,-1,-1))
-                  IF (WANTU .OR. WANTVT) THEN
-                     MAXWRK = MAX(MAXWRK,
-     $                       M*M+2*M+M*ILAENV(1,'CUNMQR','LN',M,M,M,-1))
-                  END IF
+                  MAXWRK = M + M*
+     $                     ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 )
+                  MAXWRK = MAX( MAXWRK, M*M + M + 2*M*
+     $                     ILAENV( 1, 'CGEBRD', ' ', M, M, -1, -1 ) )
+                  MINWRK = M*(M+4)
                ELSE
 *
 *                 Path 2t (N greater than M, but not much larger)
 *
                ELSE
 *
 *                 Path 2t (N greater than M, but not much larger)
 *
-*
-                  MINWRK = 3*M + N
-                  MAXWRK = 2*M + (M+N)*ILAENV(1,'CGEBRD',' ',M,N,-1,-1)
-                  IF (WANTU .OR. WANTVT) THEN
-                     MAXWRK = MAX(MAXWRK,
-     $                        2*M+M*ILAENV(1,'CUNMQR','LN',M,M,M,-1))
-                  END IF
+                  MAXWRK = M*(M*2+19) + ( M+N )*
+     $                     ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 )
+                  MINWRK = 2*M + N
                END IF
             END IF
          END IF
                END IF
             END IF
          END IF
             CALL CGEBRD( N, N, WORK( IQRF ), N, RWORK( ID ), 
      $                   RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ),
      $                   WORK( ITEMP ), LWORK-ITEMP+1, INFO )
             CALL CGEBRD( N, N, WORK( IQRF ), N, RWORK( ID ), 
      $                   RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ),
      $                   WORK( ITEMP ), LWORK-ITEMP+1, INFO )
-            ITEMPR = ITGKZ + N*(N*2+1)
+            ITEMP = ITGKZ + N*(N*2+1)
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*N*N+14*N)          
 *                   
             CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S,
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*N*N+14*N)          
 *                   
             CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S,
-     $                    RWORK( ITGKZ ), N*2, RWORK( ITEMPR ),
+     $                    RWORK( ITGKZ ), N*2, RWORK( ITEMP ),
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
                   END DO
                   K = K + N
                END DO
                   END DO
                   K = K + N
                END DO
-               CALL CLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU)
+               CALL CLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU )
 *
 *              Call CUNMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
 *
 *              Call CUNMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
             CALL CGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), 
      $                   WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ),
      $                   LWORK-ITEMP+1, INFO )
             CALL CGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), 
      $                   WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ),
      $                   LWORK-ITEMP+1, INFO )
-            ITEMPR = ITGKZ + N*(N*2+1)
+            ITEMP = ITGKZ + N*(N*2+1)
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*N*N+14*N)          
 *                     
             CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*N*N+14*N)          
 *                     
             CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
-     $                    RWORK( ITGKZ ), N*2, RWORK( ITEMPR ), 
+     $                    RWORK( ITGKZ ), N*2, RWORK( ITEMP ), 
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
                   END DO
                   K = K + N
                END DO
                   END DO
                   K = K + N
                END DO
-               CALL CLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU)
+               CALL CLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU )
 *
 *              Call CUNMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
 *
 *              Call CUNMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
             CALL CGEBRD( M, M, WORK( ILQF ), M, RWORK( ID ),
      $                   RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), 
      $                   WORK( ITEMP ), LWORK-ITEMP+1, INFO )
             CALL CGEBRD( M, M, WORK( ILQF ), M, RWORK( ID ),
      $                   RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), 
      $                   WORK( ITEMP ), LWORK-ITEMP+1, INFO )
-            ITEMPR = ITGKZ + M*(M*2+1)
+            ITEMP = ITGKZ + M*(M*2+1)
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*M*M+14*M)          
 *
             CALL SBDSVDX( 'U', JOBZ, RNGTGK, M, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*M*M+14*M)          
 *
             CALL SBDSVDX( 'U', JOBZ, RNGTGK, M, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
-     $                    RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), 
+     $                    RWORK( ITGKZ ), M*2, RWORK( ITEMP ), 
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
                   END DO
                   K = K + M
                END DO
                   END DO
                   K = K + M
                END DO
-               CALL CLASET( 'A', NS, N-M, CZERO, CZERO,
+               CALL CLASET( 'A', M, N-M, CZERO, CZERO, 
      $                      VT( 1,M+1 ), LDVT )
 *
 *              Call CUNMBR to compute (VB**T)*(PB**T)
      $                      VT( 1,M+1 ), LDVT )
 *
 *              Call CUNMBR to compute (VB**T)*(PB**T)
             CALL CGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), 
      $                   WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ),
      $                   LWORK-ITEMP+1, INFO )
             CALL CGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), 
      $                   WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ),
      $                   LWORK-ITEMP+1, INFO )
-            ITEMPR = ITGKZ + M*(M*2+1)
+            ITEMP = ITGKZ + M*(M*2+1)
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*M*M+14*M)          
 *          
             CALL SBDSVDX( 'L', JOBZ, RNGTGK, M, RWORK( ID ), 
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*M*M+14*M)          
 *          
             CALL SBDSVDX( 'L', JOBZ, RNGTGK, M, RWORK( ID ), 
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
-     $                    RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), 
+     $                    RWORK( ITGKZ ), M*2, RWORK( ITEMP ), 
      $                    IWORK, INFO)
 * 
 *           If needed, compute left singular vectors.
      $                    IWORK, INFO)
 * 
 *           If needed, compute left singular vectors.
                   END DO
                   K = K + M
                END DO
                   END DO
                   K = K + M
                END DO
-               CALL CLASET( 'A', NS, N-M, CZERO, CZERO,
+               CALL CLASET( 'A', M, N-M, CZERO, CZERO, 
      $                      VT( 1,M+1 ), LDVT )
 *
 *              Call CUNMBR to compute VB**T * PB**T
      $                      VT( 1,M+1 ), LDVT )
 *
 *              Call CUNMBR to compute VB**T * PB**T
index 4588083..cfa2ff0 100644 (file)
 *>          vectors, stored columnwise) as specified by RANGE; if 
 *>          JOBU = 'N', U is not referenced.
 *>          Note: The user must ensure that UCOL >= NS; if RANGE = 'V', 
 *>          vectors, stored columnwise) as specified by RANGE; if 
 *>          JOBU = 'N', U is not referenced.
 *>          Note: The user must ensure that UCOL >= NS; if RANGE = 'V', 
-*>          the exact value of NS is not known in advance and an upper
+*>          the exact value of NS is not known ILQFin advance and an upper 
 *>          bound must be used.
 *> \endverbatim
 *>
 *>          bound must be used.
 *> \endverbatim
 *>
          IF( INFO.EQ.0 ) THEN
             IF( WANTU .AND. LDU.LT.M ) THEN
                INFO = -15
          IF( INFO.EQ.0 ) THEN
             IF( WANTU .AND. LDU.LT.M ) THEN
                INFO = -15
-            ELSE IF( WANTVT ) THEN
-               IF( INDS ) THEN
-                   IF( LDVT.LT.IU-IL+1 ) THEN
-                       INFO = -17
-                   END IF
-               ELSE IF( LDVT.LT.MINMN ) THEN
-                   INFO = -17
-               END IF
+            ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN
+               INFO = -16
             END IF
          END IF
       END IF
             END IF
          END IF
       END IF
 *
 *                 Path 1 (M much larger than N)
 *
 *
 *                 Path 1 (M much larger than N)
 *
-                  MAXWRK = N + 
+                  MAXWRK = N*(N*2+16) + 
      $                     N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
      $                     N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-                  MAXWRK = MAX( MAXWRK, N*(N+5) + 2*N*
+                  MAXWRK = MAX( MAXWRK, N*(N*2+20) + 2*N*
      $                     ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
      $                     ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
-                  IF (WANTU) THEN
-                      MAXWRK = MAX(MAXWRK,N*(N*3+6)+N*
-     $                     ILAENV( 1, 'DORMQR', ' ', N, N, -1, -1 ) )
-                  END IF
-                  IF (WANTVT) THEN
-                      MAXWRK = MAX(MAXWRK,N*(N*3+6)+N*
-     $                     ILAENV( 1, 'DORMLQ', ' ', N, N, -1, -1 ) )
-                  END IF
-                  MINWRK = N*(N*3+20)
+                  MINWRK = N*(N*2+21)
                ELSE
 *
 *                 Path 2 (M at least N, but not much larger)
 *
                ELSE
 *
 *                 Path 2 (M at least N, but not much larger)
 *
-                  MAXWRK = 4*N + ( M+N )*
+                  MAXWRK = N*(N*2+19) + ( M+N )*
      $                     ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 )
      $                     ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 )
-                  IF (WANTU) THEN
-                      MAXWRK = MAX(MAXWRK,N*(N*2+5)+N*
-     $                     ILAENV( 1, 'DORMQR', ' ', N, N, -1, -1 ) )
-                  END IF
-                  IF (WANTVT) THEN
-                      MAXWRK = MAX(MAXWRK,N*(N*2+5)+N*
-     $                     ILAENV( 1, 'DORMLQ', ' ', N, N, -1, -1 ) )
-                  END IF
-                  MINWRK = MAX(N*(N*2+19),4*N+M)
+                  MINWRK = N*(N*2+20) + M
                END IF
             ELSE
                MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 )
                END IF
             ELSE
                MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 )
 *
 *                 Path 1t (N much larger than M)
 *
 *
 *                 Path 1t (N much larger than M)
 *
-                  MAXWRK = M + 
+                  MAXWRK = M*(M*2+16) + 
      $                     M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
      $                     M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 )
-                  MAXWRK = MAX( MAXWRK, M*(M+5) + 2*M*
+                  MAXWRK = MAX( MAXWRK, M*(M*2+20) + 2*M*
      $                     ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
      $                     ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) )
-                  IF (WANTU) THEN
-                      MAXWRK = MAX(MAXWRK,M*(M*3+6)+M*
-     $                     ILAENV( 1, 'DORMQR', ' ', M, M, -1, -1 ) )
-                  END IF
-                  IF (WANTVT) THEN
-                      MAXWRK = MAX(MAXWRK,M*(M*3+6)+M*
-     $                     ILAENV( 1, 'DORMLQ', ' ', M, M, -1, -1 ) )
-                  END IF
-                  MINWRK = M*(M*3+20)
+                  MINWRK = M*(M*2+21)
                ELSE
 *
                ELSE
 *
-*                 Path 2t (N at least M, but not much larger)
+*                 Path 2t (N greater than M, but not much larger)
 *
 *
-                  MAXWRK = 4*M + ( M+N )*
+                  MAXWRK = M*(M*2+19) + ( M+N )*
      $                     ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 )
      $                     ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 )
-                  IF (WANTU) THEN
-                      MAXWRK = MAX(MAXWRK,M*(M*2+5)+M*
-     $                     ILAENV( 1, 'DORMQR', ' ', M, M, -1, -1 ) )
-                  END IF
-                  IF (WANTVT) THEN
-                      MAXWRK = MAX(MAXWRK,M*(M*2+5)+M*
-     $                     ILAENV( 1, 'DORMLQ', ' ', M, M, -1, -1 ) )
-                  END IF
-                  MINWRK = MAX(M*(M*2+19),4*M+N)
+                  MINWRK = M*(M*2+20) + N
                END IF
             END IF
          END IF
                END IF
             END IF
          END IF
                   CALL DCOPY( N, WORK( J ), 1, U( 1,I ), 1 )
                   J = J + N*2
                END DO
                   CALL DCOPY( N, WORK( J ), 1, U( 1,I ), 1 )
                   J = J + N*2
                END DO
-               CALL DLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU )
+               CALL DLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU )
 *
 *              Call DORMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
 *
 *              Call DORMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
                   CALL DCOPY( N, WORK( J ), 1, U( 1,I ), 1 )
                   J = J + N*2
                END DO
                   CALL DCOPY( N, WORK( J ), 1, U( 1,I ), 1 )
                   J = J + N*2
                END DO
-               CALL DLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU )
+               CALL DLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU )
 *
 *              Call DORMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
 *
 *              Call DORMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
                   CALL DCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT )
                   J = J + M*2
                END DO
                   CALL DCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT )
                   J = J + M*2
                END DO
-               CALL DLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT)
+               CALL DLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT )
 *
 *              Call DORMBR to compute (VB**T)*(PB**T)
 *              (Workspace in WORK( ITEMP ): need M, prefer M*NB)
 *
 *              Call DORMBR to compute (VB**T)*(PB**T)
 *              (Workspace in WORK( ITEMP ): need M, prefer M*NB)
                   CALL DCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT )
                   J = J + M*2
                END DO
                   CALL DCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT )
                   J = J + M*2
                END DO
-               CALL DLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT)
+               CALL DLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT )
 *
 *              Call DORMBR to compute VB**T * PB**T
 *              (Workspace in WORK( ITEMP ): need M, prefer M*NB)
 *
 *              Call DORMBR to compute VB**T * PB**T
 *              (Workspace in WORK( ITEMP ): need M, prefer M*NB)
index 9128a7c..aae8b07 100644 (file)
 *>          vectors, stored columnwise) as specified by RANGE; if 
 *>          JOBU = 'N', U is not referenced.
 *>          Note: The user must ensure that UCOL >= NS; if RANGE = 'V', 
 *>          vectors, stored columnwise) as specified by RANGE; if 
 *>          JOBU = 'N', U is not referenced.
 *>          Note: The user must ensure that UCOL >= NS; if RANGE = 'V', 
-*>          the exact value of NS is not known in advance and an upper
+*>          the exact value of NS is not known ILQFin advance and an upper 
 *>          bound must be used.
 *> \endverbatim
 *>
 *>          bound must be used.
 *> \endverbatim
 *>
          IF( INFO.EQ.0 ) THEN
             IF( WANTU .AND. LDU.LT.M ) THEN
                INFO = -15
          IF( INFO.EQ.0 ) THEN
             IF( WANTU .AND. LDU.LT.M ) THEN
                INFO = -15
-            ELSE IF( WANTVT ) THEN
-               IF( INDS ) THEN
-                   IF( LDVT.LT.IU-IL+1 ) THEN
-                       INFO = -17
-                   END IF
-               ELSE IF( LDVT.LT.MINMN ) THEN
-                   INFO = -17
-               END IF
+            ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN
+               INFO = -16
             END IF
          END IF
       END IF
             END IF
          END IF
       END IF
 *
 *                 Path 1 (M much larger than N)
 *
 *
 *                 Path 1 (M much larger than N)
 *
-                  MAXWRK = N + 
+                  MAXWRK = N*(N*2+16) + 
      $                     N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
      $                     N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
-                  MAXWRK = MAX( MAXWRK, N*(N+5) + 2*N*
+                  MAXWRK = MAX( MAXWRK, N*(N*2+20) + 2*N*
      $                     ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) )
      $                     ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) )
-                  IF (WANTU) THEN
-                      MAXWRK = MAX(MAXWRK,N*(N*3+6)+N*
-     $                     ILAENV( 1, 'SORMQR', ' ', N, N, -1, -1 ) )
-                  END IF
-                  IF (WANTVT) THEN
-                      MAXWRK = MAX(MAXWRK,N*(N*3+6)+N*
-     $                     ILAENV( 1, 'SORMLQ', ' ', N, N, -1, -1 ) )
-                  END IF
-                  MINWRK = N*(N*3+20)
+                  MINWRK = N*(N*2+21)
                ELSE
 *
 *                 Path 2 (M at least N, but not much larger)
 *
                ELSE
 *
 *                 Path 2 (M at least N, but not much larger)
 *
-                  MAXWRK = 4*N + ( M+N )*
+                  MAXWRK = N*(N*2+19) + ( M+N )*
      $                     ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 )
      $                     ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 )
-                  IF (WANTU) THEN
-                      MAXWRK = MAX(MAXWRK,N*(N*2+5)+N*
-     $                     ILAENV( 1, 'SORMQR', ' ', N, N, -1, -1 ) )
-                  END IF
-                  IF (WANTVT) THEN
-                      MAXWRK = MAX(MAXWRK,N*(N*2+5)+N*
-     $                     ILAENV( 1, 'SORMLQ', ' ', N, N, -1, -1 ) )
-                  END IF
-                  MINWRK = MAX(N*(N*2+19),4*N+M)
+                  MINWRK = N*(N*2+20) + M
                END IF
             ELSE
                MNTHR = ILAENV( 6, 'SGESVD', JOBU // JOBVT, M, N, 0, 0 )
                END IF
             ELSE
                MNTHR = ILAENV( 6, 'SGESVD', JOBU // JOBVT, M, N, 0, 0 )
 *
 *                 Path 1t (N much larger than M)
 *
 *
 *                 Path 1t (N much larger than M)
 *
-                  MAXWRK = M + 
+                  MAXWRK = M*(M*2+16) + 
      $                     M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 )
      $                     M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 )
-                  MAXWRK = MAX( MAXWRK, M*(M+5) + 2*M*
+                  MAXWRK = MAX( MAXWRK, M*(M*2+20) + 2*M*
      $                     ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) )
      $                     ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) )
-                  IF (WANTU) THEN
-                      MAXWRK = MAX(MAXWRK,M*(M*3+6)+M*
-     $                     ILAENV( 1, 'SORMQR', ' ', M, M, -1, -1 ) )
-                  END IF
-                  IF (WANTVT) THEN
-                      MAXWRK = MAX(MAXWRK,M*(M*3+6)+M*
-     $                     ILAENV( 1, 'SORMLQ', ' ', M, M, -1, -1 ) )
-                  END IF
-                  MINWRK = M*(M*3+20)
+                  MINWRK = M*(M*2+21)
                ELSE
 *
                ELSE
 *
-*                 Path 2t (N at least M, but not much larger)
+*                 Path 2t (N greater than M, but not much larger)
 *
 *
-                  MAXWRK = 4*M + ( M+N )*
+                  MAXWRK = M*(M*2+19) + ( M+N )*
      $                     ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 )
      $                     ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 )
-                  IF (WANTU) THEN
-                      MAXWRK = MAX(MAXWRK,M*(M*2+5)+M*
-     $                     ILAENV( 1, 'SORMQR', ' ', M, M, -1, -1 ) )
-                  END IF
-                  IF (WANTVT) THEN
-                      MAXWRK = MAX(MAXWRK,M*(M*2+5)+M*
-     $                     ILAENV( 1, 'SORMLQ', ' ', M, M, -1, -1 ) )
-                  END IF
-                  MINWRK = MAX(M*(M*2+19),4*M+N)
+                  MINWRK = M*(M*2+20) + N
                END IF
             END IF
          END IF
                END IF
             END IF
          END IF
                   CALL SCOPY( N, WORK( J ), 1, U( 1,I ), 1 )
                   J = J + N*2
                END DO
                   CALL SCOPY( N, WORK( J ), 1, U( 1,I ), 1 )
                   J = J + N*2
                END DO
-               CALL SLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU )
+               CALL SLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU )
 *
 *              Call SORMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
 *
 *              Call SORMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
                   CALL SCOPY( N, WORK( J ), 1, U( 1,I ), 1 )
                   J = J + N*2
                END DO
                   CALL SCOPY( N, WORK( J ), 1, U( 1,I ), 1 )
                   J = J + N*2
                END DO
-               CALL SLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU )
+               CALL SLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU )
 *
 *              Call SORMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
 *
 *              Call SORMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
                   CALL SCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT )
                   J = J + M*2
                END DO
                   CALL SCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT )
                   J = J + M*2
                END DO
-               CALL SLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT)
+               CALL SLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT )
 *
 *              Call SORMBR to compute (VB**T)*(PB**T)
 *              (Workspace in WORK( ITEMP ): need M, prefer M*NB)
 *
 *              Call SORMBR to compute (VB**T)*(PB**T)
 *              (Workspace in WORK( ITEMP ): need M, prefer M*NB)
                   CALL SCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT )
                   J = J + M*2
                END DO
                   CALL SCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT )
                   J = J + M*2
                END DO
-               CALL SLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT)
+               CALL SLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT )
 *
 *              Call SORMBR to compute VB**T * PB**T
 *              (Workspace in WORK( ITEMP ): need M, prefer M*NB)
 *
 *              Call SORMBR to compute VB**T * PB**T
 *              (Workspace in WORK( ITEMP ): need M, prefer M*NB)
index c9509e4..6f7d5ba 100644 (file)
 *     ..
 *
 *
 *     ..
 *
 *
-*> \par Purpose:
-*  =============
-*>
-*> \verbatim
-*>
-*>  ZGESVDX computes the singular value decomposition (SVD) of a complex
-*>  M-by-N matrix A, optionally computing the left and/or right singular
-*>  vectors. The SVD is written
-*>
-*>      A = U * SIGMA * transpose(V)
-*>
-*>  where SIGMA is an M-by-N matrix which is zero except for its
-*>  min(m,n) diagonal elements, U is an M-by-M unitary matrix, and
-*>  V is an N-by-N unitary matrix.  The diagonal elements of SIGMA
-*>  are the singular values of A; they are real and non-negative, and
-*>  are returned in descending order.  The first min(m,n) columns of
-*>  U and V are the left and right singular vectors of A.
-*>
-*>  ZGESVDX uses an eigenvalue problem for obtaining the SVD, which
-*>  allows for the computation of a subset of singular values and
-*>  vectors. See DBDSVDX for details.
-*>
-*>  Note that the routine returns V**T, not V.
-*> \endverbatim
+*  Purpose
+*  =======
+*
+*  ZGESVDX computes the singular value decomposition (SVD) of a complex
+*  M-by-N matrix A, optionally computing the left and/or right singular
+*  vectors. The SVD is written
+* 
+*       A = U * SIGMA * transpose(V)
+* 
+*  where SIGMA is an M-by-N matrix which is zero except for its
+*  min(m,n) diagonal elements, U is an M-by-M unitary matrix, and
+*  V is an N-by-N unitary matrix.  The diagonal elements of SIGMA
+*  are the singular values of A; they are real and non-negative, and
+*  are returned in descending order.  The first min(m,n) columns of
+*  U and V are the left and right singular vectors of A.
+* 
+*  ZGESVDX uses an eigenvalue problem for obtaining the SVD, which 
+*  allows for the computation of a subset of singular values and 
+*  vectors. See DBDSVDX for details.
+* 
+*  Note that the routine returns V**T, not V.
 *   
 *  Arguments:
 *  ==========
 *   
 *  Arguments:
 *  ==========
 *>
 *> \param[in,out] A
 *> \verbatim
 *>
 *> \param[in,out] A
 *> \verbatim
-*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          A is COMPLEX array, dimension (LDA,N)
 *>          On entry, the M-by-N matrix A.
 *>          On exit, the contents of A are destroyed.
 *> \endverbatim
 *>          On entry, the M-by-N matrix A.
 *>          On exit, the contents of A are destroyed.
 *> \endverbatim
 *>          vectors, stored columnwise) as specified by RANGE; if 
 *>          JOBU = 'N', U is not referenced.
 *>          Note: The user must ensure that UCOL >= NS; if RANGE = 'V', 
 *>          vectors, stored columnwise) as specified by RANGE; if 
 *>          JOBU = 'N', U is not referenced.
 *>          Note: The user must ensure that UCOL >= NS; if RANGE = 'V', 
-*>          the exact value of NS is not known in advance and an upper
+*>          the exact value of NS is not known ILQFin advance and an upper 
 *>          bound must be used.
 *> \endverbatim
 *>
 *>          bound must be used.
 *> \endverbatim
 *>
       CHARACTER          JOBZ, RNGTGK
       LOGICAL            ALLS, INDS, LQUERY, VALS, WANTU, WANTVT
       INTEGER            I, ID, IE, IERR, ILQF, ILTGK, IQRF, ISCL,
       CHARACTER          JOBZ, RNGTGK
       LOGICAL            ALLS, INDS, LQUERY, VALS, WANTU, WANTVT
       INTEGER            I, ID, IE, IERR, ILQF, ILTGK, IQRF, ISCL,
-     $                   ITAU, ITAUP, ITAUQ, ITEMP, ITEMPR, ITGKZ, 
-     $                   IUTGK, J, K, MAXWRK, MINMN, MINWRK, MNTHR
+     $                   ITAU, ITAUP, ITAUQ, ITEMP, ITGKZ, IUTGK,
+     $                   J, K, MAXWRK, MINMN, MINWRK, MNTHR
       DOUBLE PRECISION   ABSTOL, ANRM, BIGNUM, EPS, SMLNUM
 *     ..
 *     .. Local Arrays ..
       DOUBLE PRECISION   ABSTOL, ANRM, BIGNUM, EPS, SMLNUM
 *     ..
 *     .. Local Arrays ..
          IF( INFO.EQ.0 ) THEN
             IF( WANTU .AND. LDU.LT.M ) THEN
                INFO = -15
          IF( INFO.EQ.0 ) THEN
             IF( WANTU .AND. LDU.LT.M ) THEN
                INFO = -15
-            ELSE IF( WANTVT ) THEN
-               IF( INDS ) THEN
-                   IF( LDVT.LT.IU-IL+1 ) THEN
-                       INFO = -17
-                   END IF
-               ELSE IF( LDVT.LT.MINMN ) THEN
-                   INFO = -17
-               END IF
+            ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN
+               INFO = -16
             END IF
          END IF
       END IF
             END IF
          END IF
       END IF
 *
 *                 Path 1 (M much larger than N)
 *
 *
 *                 Path 1 (M much larger than N)
 *
-                  MINWRK = N*(N+5)
-                  MAXWRK = N + N*ILAENV(1,'ZGEQRF',' ',M,N,-1,-1)
-                  MAXWRK = MAX(MAXWRK,
-     $                     N*N+2*N+2*N*ILAENV(1,'ZGEBRD',' ',N,N,-1,-1))
-                  IF (WANTU .OR. WANTVT) THEN
-                     MAXWRK = MAX(MAXWRK,
-     $                       N*N+2*N+N*ILAENV(1,'ZUNMQR','LN',N,N,N,-1))
-                  END IF
+                  MAXWRK = N + N*
+     $                     ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
+                  MAXWRK = MAX( MAXWRK, N*N + N + 2*N*
+     $                     ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) )
+                  MINWRK = N*(N+4)
                ELSE
 *
 *                 Path 2 (M at least N, but not much larger)
 *
                ELSE
 *
 *                 Path 2 (M at least N, but not much larger)
 *
-                  MINWRK = 3*N + M
-                  MAXWRK = 2*N + (M+N)*ILAENV(1,'ZGEBRD',' ',M,N,-1,-1)
-                  IF (WANTU .OR. WANTVT) THEN
-                     MAXWRK = MAX(MAXWRK,
-     $                        2*N+N*ILAENV(1,'ZUNMQR','LN',N,N,N,-1))
-                  END IF
+                  MAXWRK = 2*N + ( M+N )*
+     $                     ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 )
+                  MINWRK = 2*N + M
                END IF
             ELSE
                MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 )
                END IF
             ELSE
                MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 )
 *
 *                 Path 1t (N much larger than M)
 *
 *
 *                 Path 1t (N much larger than M)
 *
-                  MINWRK = M*(M+5)
-                  MAXWRK = M + M*ILAENV(1,'ZGELQF',' ',M,N,-1,-1)
-                  MAXWRK = MAX(MAXWRK,
-     $                     M*M+2*M+2*M*ILAENV(1,'ZGEBRD',' ',M,M,-1,-1))
-                  IF (WANTU .OR. WANTVT) THEN
-                     MAXWRK = MAX(MAXWRK,
-     $                       M*M+2*M+M*ILAENV(1,'ZUNMQR','LN',M,M,M,-1))
-                  END IF
+                  MAXWRK = M + M*
+     $                     ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 )
+                  MAXWRK = MAX( MAXWRK, M*M + M + 2*M*
+     $                     ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) )
+                  MINWRK = M*(M+4)
                ELSE
 *
 *                 Path 2t (N greater than M, but not much larger)
 *
                ELSE
 *
 *                 Path 2t (N greater than M, but not much larger)
 *
-*
-                  MINWRK = 3*M + N
-                  MAXWRK = 2*M + (M+N)*ILAENV(1,'ZGEBRD',' ',M,N,-1,-1)
-                  IF (WANTU .OR. WANTVT) THEN
-                     MAXWRK = MAX(MAXWRK,
-     $                        2*M+M*ILAENV(1,'ZUNMQR','LN',M,M,M,-1))
-                  END IF
+                  MAXWRK = M*(M*2+19) + ( M+N )*
+     $                     ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 )
+                  MINWRK = 2*M + N
                END IF
             END IF
          END IF
                END IF
             END IF
          END IF
             CALL ZGEBRD( N, N, WORK( IQRF ), N, RWORK( ID ), 
      $                   RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ),
      $                   WORK( ITEMP ), LWORK-ITEMP+1, INFO )
             CALL ZGEBRD( N, N, WORK( IQRF ), N, RWORK( ID ), 
      $                   RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ),
      $                   WORK( ITEMP ), LWORK-ITEMP+1, INFO )
-            ITEMPR = ITGKZ + N*(N*2+1)
+            ITEMP = ITGKZ + N*(N*2+1)
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*N*N+14*N)          
 *                   
             CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S,
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*N*N+14*N)          
 *                   
             CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S,
-     $                    RWORK( ITGKZ ), N*2, RWORK( ITEMPR ),
+     $                    RWORK( ITGKZ ), N*2, RWORK( ITEMP ),
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
                   END DO
                   K = K + N
                END DO
                   END DO
                   K = K + N
                END DO
-               CALL ZLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU)
+               CALL ZLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU )
 *
 *              Call ZUNMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
 *
 *              Call ZUNMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
             CALL ZGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), 
      $                   WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ),
      $                   LWORK-ITEMP+1, INFO )
             CALL ZGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), 
      $                   WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ),
      $                   LWORK-ITEMP+1, INFO )
-            ITEMPR = ITGKZ + N*(N*2+1)
+            ITEMP = ITGKZ + N*(N*2+1)
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*N*N+14*N)          
 *                     
             CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*N*N+14*N)          
 *                     
             CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
-     $                    RWORK( ITGKZ ), N*2, RWORK( ITEMPR ), 
+     $                    RWORK( ITGKZ ), N*2, RWORK( ITEMP ), 
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
                   END DO
                   K = K + N
                END DO
                   END DO
                   K = K + N
                END DO
-               CALL ZLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU)
+               CALL ZLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU )
 *
 *              Call ZUNMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
 *
 *              Call ZUNMBR to compute QB*UB.
 *              (Workspace in WORK( ITEMP ): need N, prefer N*NB)
             CALL ZGEBRD( M, M, WORK( ILQF ), M, RWORK( ID ),
      $                   RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), 
      $                   WORK( ITEMP ), LWORK-ITEMP+1, INFO )
             CALL ZGEBRD( M, M, WORK( ILQF ), M, RWORK( ID ),
      $                   RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), 
      $                   WORK( ITEMP ), LWORK-ITEMP+1, INFO )
-            ITEMPR = ITGKZ + M*(M*2+1)
+            ITEMP = ITGKZ + M*(M*2+1)
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*M*M+14*M)          
 *
             CALL DBDSVDX( 'U', JOBZ, RNGTGK, M, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*M*M+14*M)          
 *
             CALL DBDSVDX( 'U', JOBZ, RNGTGK, M, RWORK( ID ),
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
-     $                    RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), 
+     $                    RWORK( ITGKZ ), M*2, RWORK( ITEMP ), 
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
      $                    IWORK, INFO)
 *
 *           If needed, compute left singular vectors.
                   END DO
                   K = K + M
                END DO
                   END DO
                   K = K + M
                END DO
-               CALL ZLASET( 'A', NS, N-M, CZERO, CZERO,
+               CALL ZLASET( 'A', M, N-M, CZERO, CZERO, 
      $                      VT( 1,M+1 ), LDVT )
 *
 *              Call ZUNMBR to compute (VB**T)*(PB**T)
      $                      VT( 1,M+1 ), LDVT )
 *
 *              Call ZUNMBR to compute (VB**T)*(PB**T)
             CALL ZGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), 
      $                   WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ),
      $                   LWORK-ITEMP+1, INFO )
             CALL ZGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), 
      $                   WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ),
      $                   LWORK-ITEMP+1, INFO )
-            ITEMPR = ITGKZ + M*(M*2+1)
+            ITEMP = ITGKZ + M*(M*2+1)
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*M*M+14*M)          
 *          
             CALL DBDSVDX( 'L', JOBZ, RNGTGK, M, RWORK( ID ), 
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
 *
 *           Solve eigenvalue problem TGK*Z=Z*S.
 *           (Workspace: need 2*M*M+14*M)          
 *          
             CALL DBDSVDX( 'L', JOBZ, RNGTGK, M, RWORK( ID ), 
      $                    RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, 
-     $                    RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), 
+     $                    RWORK( ITGKZ ), M*2, RWORK( ITEMP ), 
      $                    IWORK, INFO)
 * 
 *           If needed, compute left singular vectors.
      $                    IWORK, INFO)
 * 
 *           If needed, compute left singular vectors.
                   END DO
                   K = K + M
                END DO
                   END DO
                   K = K + M
                END DO
-               CALL ZLASET( 'A', NS, N-M, CZERO, CZERO,
+               CALL ZLASET( 'A', M, N-M, CZERO, CZERO, 
      $                      VT( 1,M+1 ), LDVT )
 *
 *              Call ZUNMBR to compute VB**T * PB**T
      $                      VT( 1,M+1 ), LDVT )
 *
 *              Call ZUNMBR to compute VB**T * PB**T