[BACK]Return to zgesvd.f CVS log [TXT] [DIR] Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/zgesvd.f between versions 1.9 and 1.20

version 1.9, 2011/11/21 22:19:46 version 1.20, 2023/08/07 08:39:19
Line 2 Line 2
 *  *
 *  =========== DOCUMENTATION ===========  *  =========== DOCUMENTATION ===========
 *  *
 * Online html documentation available at   * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/   *            http://www.netlib.org/lapack/explore-html/
 *  *
 *> \htmlonly  *> \htmlonly
 *> Download ZGESVD + dependencies   *> Download ZGESVD + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgesvd.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgesvd.f">
 *> [TGZ]</a>   *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgesvd.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgesvd.f">
 *> [ZIP]</a>   *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgesvd.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgesvd.f">
 *> [TXT]</a>  *> [TXT]</a>
 *> \endhtmlonly   *> \endhtmlonly
 *  *
 *  Definition:  *  Definition:
 *  ===========  *  ===========
 *  *
 *       SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,  *       SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
 *                          WORK, LWORK, RWORK, INFO )  *                          WORK, LWORK, RWORK, INFO )
 *   *
 *       .. Scalar Arguments ..  *       .. Scalar Arguments ..
 *       CHARACTER          JOBU, JOBVT  *       CHARACTER          JOBU, JOBVT
 *       INTEGER            INFO, LDA, LDU, LDVT, LWORK, M, N  *       INTEGER            INFO, LDA, LDU, LDVT, LWORK, M, N
Line 30 Line 30
 *       COMPLEX*16         A( LDA, * ), U( LDU, * ), VT( LDVT, * ),  *       COMPLEX*16         A( LDA, * ), U( LDU, * ), VT( LDVT, * ),
 *      $                   WORK( * )  *      $                   WORK( * )
 *       ..  *       ..
 *    *
 *  *
 *> \par Purpose:  *> \par Purpose:
 *  =============  *  =============
Line 201 Line 201
 *  Authors:  *  Authors:
 *  ========  *  ========
 *  *
 *> \author Univ. of Tennessee   *> \author Univ. of Tennessee
 *> \author Univ. of California Berkeley   *> \author Univ. of California Berkeley
 *> \author Univ. of Colorado Denver   *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.   *> \author NAG Ltd.
 *  
 *> \date November 2011  
 *  *
 *> \ingroup complex16GEsing  *> \ingroup complex16GEsing
 *  *
 *  =====================================================================  *  =====================================================================
       SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU,         SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU,
      $                   VT, LDVT, WORK, LWORK, RWORK, INFO )       $                   VT, LDVT, WORK, LWORK, RWORK, INFO )
 *  *
 *  -- LAPACK driver routine (version 3.4.0) --  *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --  *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--  *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     November 2011  
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       CHARACTER          JOBU, JOBVT        CHARACTER          JOBU, JOBVT
Line 321 Line 318
 *  *
             MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 )              MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 )
 *           Compute space needed for ZGEQRF  *           Compute space needed for ZGEQRF
             CALL ZGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR )              CALL ZGEQRF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR )
             LWORK_ZGEQRF=DUM(1)              LWORK_ZGEQRF = INT( CDUM(1) )
 *           Compute space needed for ZUNGQR  *           Compute space needed for ZUNGQR
             CALL ZUNGQR( M, N, N, A, LDA, DUM(1), DUM(1), -1, IERR )              CALL ZUNGQR( M, N, N, A, LDA, CDUM(1), CDUM(1), -1, IERR )
             LWORK_ZUNGQR_N=DUM(1)              LWORK_ZUNGQR_N = INT( CDUM(1) )
             CALL ZUNGQR( M, M, N, A, LDA, DUM(1), DUM(1), -1, IERR )              CALL ZUNGQR( M, M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR )
             LWORK_ZUNGQR_M=DUM(1)              LWORK_ZUNGQR_M = INT( CDUM(1) )
 *           Compute space needed for ZGEBRD  *           Compute space needed for ZGEBRD
             CALL ZGEBRD( N, N, A, LDA, S, DUM(1), DUM(1),              CALL ZGEBRD( N, N, A, LDA, S, DUM(1), CDUM(1),
      $                   DUM(1), DUM(1), -1, IERR )       $                   CDUM(1), CDUM(1), -1, IERR )
             LWORK_ZGEBRD=DUM(1)              LWORK_ZGEBRD = INT( CDUM(1) )
 *           Compute space needed for ZUNGBR  *           Compute space needed for ZUNGBR
             CALL ZUNGBR( 'P', N, N, N, A, LDA, DUM(1),              CALL ZUNGBR( 'P', N, N, N, A, LDA, CDUM(1),
      $                   DUM(1), -1, IERR )       $                   CDUM(1), -1, IERR )
             LWORK_ZUNGBR_P=DUM(1)              LWORK_ZUNGBR_P = INT( CDUM(1) )
             CALL ZUNGBR( 'Q', N, N, N, A, LDA, DUM(1),              CALL ZUNGBR( 'Q', N, N, N, A, LDA, CDUM(1),
      $                   DUM(1), -1, IERR )       $                   CDUM(1), -1, IERR )
             LWORK_ZUNGBR_Q=DUM(1)              LWORK_ZUNGBR_Q = INT( CDUM(1) )
 *  *
             IF( M.GE.MNTHR ) THEN              IF( M.GE.MNTHR ) THEN
                IF( WNTUN ) THEN                 IF( WNTUN ) THEN
Line 443 Line 440
 *  *
 *              Path 10 (M at least N, but not much larger)  *              Path 10 (M at least N, but not much larger)
 *  *
                CALL ZGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),                 CALL ZGEBRD( M, N, A, LDA, S, DUM(1), CDUM(1),
      $                   DUM(1), DUM(1), -1, IERR )       $                   CDUM(1), CDUM(1), -1, IERR )
                LWORK_ZGEBRD=DUM(1)                 LWORK_ZGEBRD = INT( CDUM(1) )
                MAXWRK = 2*N + LWORK_ZGEBRD                 MAXWRK = 2*N + LWORK_ZGEBRD
                IF( WNTUS .OR. WNTUO ) THEN                 IF( WNTUS .OR. WNTUO ) THEN
                   CALL ZUNGBR( 'Q', M, N, N, A, LDA, DUM(1),                    CALL ZUNGBR( 'Q', M, N, N, A, LDA, CDUM(1),
      $                   DUM(1), -1, IERR )       $                   CDUM(1), -1, IERR )
                   LWORK_ZUNGBR_Q=DUM(1)                    LWORK_ZUNGBR_Q = INT( CDUM(1) )
                   MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_Q )                    MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_Q )
                END IF                 END IF
                IF( WNTUA ) THEN                 IF( WNTUA ) THEN
                   CALL ZUNGBR( 'Q', M, M, N, A, LDA, DUM(1),                    CALL ZUNGBR( 'Q', M, M, N, A, LDA, CDUM(1),
      $                   DUM(1), -1, IERR )       $                   CDUM(1), -1, IERR )
                   LWORK_ZUNGBR_Q=DUM(1)                    LWORK_ZUNGBR_Q = INT( CDUM(1) )
                   MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_Q )                    MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_Q )
                END IF                 END IF
                IF( .NOT.WNTVN ) THEN                 IF( .NOT.WNTVN ) THEN
                   MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_P )                    MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_P )
                MINWRK = 2*N + M  
                END IF                 END IF
                  MINWRK = 2*N + M
             END IF              END IF
          ELSE IF( MINMN.GT.0 ) THEN           ELSE IF( MINMN.GT.0 ) THEN
 *  *
Line 470 Line 467
 *  *
             MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 )              MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 )
 *           Compute space needed for ZGELQF  *           Compute space needed for ZGELQF
             CALL ZGELQF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR )              CALL ZGELQF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR )
             LWORK_ZGELQF=DUM(1)              LWORK_ZGELQF = INT( CDUM(1) )
 *           Compute space needed for ZUNGLQ  *           Compute space needed for ZUNGLQ
             CALL ZUNGLQ( N, N, M, VT, LDVT, DUM(1), DUM(1), -1, IERR )              CALL ZUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), -1,
             LWORK_ZUNGLQ_N=DUM(1)       $                   IERR )
             CALL ZUNGLQ( M, N, M, A, LDA, DUM(1), DUM(1), -1, IERR )              LWORK_ZUNGLQ_N = INT( CDUM(1) )
             LWORK_ZUNGLQ_M=DUM(1)              CALL ZUNGLQ( M, N, M, A, LDA, CDUM(1), CDUM(1), -1, IERR )
               LWORK_ZUNGLQ_M = INT( CDUM(1) )
 *           Compute space needed for ZGEBRD  *           Compute space needed for ZGEBRD
             CALL ZGEBRD( M, M, A, LDA, S, DUM(1), DUM(1),              CALL ZGEBRD( M, M, A, LDA, S, DUM(1), CDUM(1),
      $                   DUM(1), DUM(1), -1, IERR )       $                   CDUM(1), CDUM(1), -1, IERR )
             LWORK_ZGEBRD=DUM(1)              LWORK_ZGEBRD = INT( CDUM(1) )
 *            Compute space needed for ZUNGBR P  *            Compute space needed for ZUNGBR P
             CALL ZUNGBR( 'P', M, M, M, A, N, DUM(1),              CALL ZUNGBR( 'P', M, M, M, A, N, CDUM(1),
      $                   DUM(1), -1, IERR )       $                   CDUM(1), -1, IERR )
             LWORK_ZUNGBR_P=DUM(1)              LWORK_ZUNGBR_P = INT( CDUM(1) )
 *           Compute space needed for ZUNGBR Q  *           Compute space needed for ZUNGBR Q
             CALL ZUNGBR( 'Q', M, M, M, A, N, DUM(1),              CALL ZUNGBR( 'Q', M, M, M, A, N, CDUM(1),
      $                   DUM(1), -1, IERR )       $                   CDUM(1), -1, IERR )
             LWORK_ZUNGBR_Q=DUM(1)              LWORK_ZUNGBR_Q = INT( CDUM(1) )
             IF( N.GE.MNTHR ) THEN              IF( N.GE.MNTHR ) THEN
                IF( WNTVN ) THEN                 IF( WNTVN ) THEN
 *  *
Line 592 Line 590
 *  *
 *              Path 10t(N greater than M, but not much larger)  *              Path 10t(N greater than M, but not much larger)
 *  *
                CALL ZGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),                 CALL ZGEBRD( M, N, A, LDA, S, DUM(1), CDUM(1),
      $                   DUM(1), DUM(1), -1, IERR )       $                   CDUM(1), CDUM(1), -1, IERR )
                LWORK_ZGEBRD=DUM(1)                 LWORK_ZGEBRD = INT( CDUM(1) )
                MAXWRK = 2*M + LWORK_ZGEBRD                 MAXWRK = 2*M + LWORK_ZGEBRD
                IF( WNTVS .OR. WNTVO ) THEN                 IF( WNTVS .OR. WNTVO ) THEN
 *                Compute space needed for ZUNGBR P  *                Compute space needed for ZUNGBR P
                  CALL ZUNGBR( 'P', M, N, M, A, N, DUM(1),                   CALL ZUNGBR( 'P', M, N, M, A, N, CDUM(1),
      $                   DUM(1), -1, IERR )       $                   CDUM(1), -1, IERR )
                  LWORK_ZUNGBR_P=DUM(1)                   LWORK_ZUNGBR_P = INT( CDUM(1) )
                  MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_P )                   MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_P )
                END IF                 END IF
                IF( WNTVA ) THEN                 IF( WNTVA ) THEN
                  CALL ZUNGBR( 'P', N,  N, M, A, N, DUM(1),                   CALL ZUNGBR( 'P', N,  N, M, A, N, CDUM(1),
      $                   DUM(1), -1, IERR )       $                   CDUM(1), -1, IERR )
                  LWORK_ZUNGBR_P=DUM(1)                   LWORK_ZUNGBR_P = INT( CDUM(1) )
                  MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_P )                   MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_P )
                END IF                 END IF
                IF( .NOT.WNTUN ) THEN                 IF( .NOT.WNTUN ) THEN
                   MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_Q )                    MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_Q )
                MINWRK = 2*M + N  
                END IF                 END IF
                  MINWRK = 2*M + N
             END IF              END IF
          END IF           END IF
          MAXWRK = MAX( MAXWRK, MINWRK )           MAXWRK = MAX( MAXWRK, MINWRK )
Line 679 Line 677
 *  *
 *              Zero out below R  *              Zero out below R
 *  *
                CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ),                 IF( N .GT. 1 ) THEN
      $                      LDA )                    CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ),
        $                         LDA )
                  END IF
                IE = 1                 IE = 1
                ITAUQ = 1                 ITAUQ = 1
                ITAUP = ITAUQ + N                 ITAUP = ITAUQ + N
Line 1143 Line 1143
 *  *
 *                    Zero out below R in A  *                    Zero out below R in A
 *  *
                      CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,                       IF( N .GT. 1 ) THEN
      $                            A( 2, 1 ), LDA )                          CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
        $                               A( 2, 1 ), LDA )
                        END IF
 *  *
 *                    Bidiagonalize R in A  *                    Bidiagonalize R in A
 *                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)  *                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
Line 1320 Line 1322
 *  *
 *                    Zero out below R in A  *                    Zero out below R in A
 *  *
                      CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,                       IF( N .GT. 1 ) THEN
      $                            A( 2, 1 ), LDA )                          CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
        $                               A( 2, 1 ), LDA )
                        END IF
 *  *
 *                    Bidiagonalize R in A  *                    Bidiagonalize R in A
 *                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)  *                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
Line 1648 Line 1652
 *  *
 *                    Zero out below R in A  *                    Zero out below R in A
 *  *
                      CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,                       IF( N .GT. 1 ) THEN
      $                            A( 2, 1 ), LDA )                          CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
        $                               A( 2, 1 ), LDA )
                        END IF
 *  *
 *                    Bidiagonalize R in A  *                    Bidiagonalize R in A
 *                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)  *                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
Line 1829 Line 1835
 *  *
 *                    Zero out below R in A  *                    Zero out below R in A
 *  *
                      CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,                       IF( N .GT. 1 ) THEN
      $                            A( 2, 1 ), LDA )                          CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO,
        $                               A( 2, 1 ), LDA )
                        END IF
 *  *
 *                    Bidiagonalize R in A  *                    Bidiagonalize R in A
 *                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)  *                    (CWorkspace: need 3*N, prefer 2*N+2*N*NB)
Removed from v.1.9  
changed lines
  Added in v.1.20

CVSweb interface <joel.bertrand@systella.fr>