Diff for /rpl/lapack/lapack/dgejsv.f between versions 1.3 and 1.4

version 1.3, 2010/08/13 21:03:44 version 1.4, 2010/12/21 13:48:05
Line 2 Line 2
      &                   M, N, A, LDA, SVA, U, LDU, V, LDV,       &                   M, N, A, LDA, SVA, U, LDU, V, LDV,
      &                   WORK, LWORK, IWORK, INFO )       &                   WORK, LWORK, IWORK, INFO )
 *  *
 *  -- LAPACK routine (version 3.2.2)                                    --  *  -- LAPACK routine (version 3.3.0)                                    --
 *  *
 *  -- Contributed by Zlatko Drmac of the University of Zagreb and     --  *  -- Contributed by Zlatko Drmac of the University of Zagreb and     --
 *  -- Kresimir Veselic of the Fernuniversitaet Hagen                  --  *  -- Kresimir Veselic of the Fernuniversitaet Hagen                  --
 *  -- June 2010                                                       --  *     November 2010
 *  *
 *  -- 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..--
Line 489 Line 489
       GOSCAL  = .TRUE.        GOSCAL  = .TRUE.
       DO 1874 p = 1, N        DO 1874 p = 1, N
          AAPP = ZERO           AAPP = ZERO
          AAQQ = ZERO           AAQQ = ONE
          CALL DLASSQ( M, A(1,p), 1, AAPP, AAQQ )           CALL DLASSQ( M, A(1,p), 1, AAPP, AAQQ )
          IF ( AAPP .GT. BIG ) THEN           IF ( AAPP .GT. BIG ) THEN
             INFO = - 9              INFO = - 9
Line 612 Line 612
          IF ( L2TRAN ) THEN           IF ( L2TRAN ) THEN
             DO 1950 p = 1, M              DO 1950 p = 1, M
                XSC   = ZERO                 XSC   = ZERO
                TEMP1 = ZERO                 TEMP1 = ONE
                CALL DLASSQ( N, A(p,1), LDA, XSC, TEMP1 )                 CALL DLASSQ( N, A(p,1), LDA, XSC, TEMP1 )
 *              DLASSQ gets both the ell_2 and the ell_infinity norm  *              DLASSQ gets both the ell_2 and the ell_infinity norm
 *              in one pass through the vector  *              in one pass through the vector
Line 643 Line 643
       IF ( L2TRAN ) THEN        IF ( L2TRAN ) THEN
 *  *
          XSC   = ZERO           XSC   = ZERO
          TEMP1 = ZERO           TEMP1 = ONE
          CALL DLASSQ( N, SVA, 1, XSC, TEMP1 )           CALL DLASSQ( N, SVA, 1, XSC, TEMP1 )
          TEMP1 = ONE / TEMP1           TEMP1 = ONE / TEMP1
 *  *
Line 697 Line 697
             KILL   = LSVEC              KILL   = LSVEC
             LSVEC  = RSVEC              LSVEC  = RSVEC
             RSVEC  = KILL              RSVEC  = KILL
               IF ( LSVEC ) N1 = N
 *  *
             ROWPIV = .TRUE.              ROWPIV = .TRUE.
          END IF           END IF
Line 1475 Line 1476
 *           Assemble the left singular vector matrix U (M x N).  *           Assemble the left singular vector matrix U (M x N).
 *  *
             IF ( N .LT. M ) THEN              IF ( N .LT. M ) THEN
                CALL DLASET( 'A',  M-N, N, ZERO, ZERO, U(NR+1,1), LDU )                 CALL DLASET( 'A',  M-N, N, ZERO, ZERO, U(N+1,1), LDU )
                IF ( N .LT. N1 ) THEN                 IF ( N .LT. N1 ) THEN
                   CALL DLASET( 'A',N,  N1-N, ZERO, ZERO,  U(1,N+1),LDU )                    CALL DLASET( 'A',N,  N1-N, ZERO, ZERO,  U(1,N+1),LDU )
                   CALL DLASET( 'A',M-N,N1-N, ZERO, ONE,U(NR+1,N+1),LDU )                    CALL DLASET( 'A',M-N,N1-N, ZERO, ONE,U(N+1,N+1),LDU )
                END IF                 END IF
             END IF              END IF
             CALL DORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U,              CALL DORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U,
Line 1582 Line 1583
 *           At this moment, V contains the right singular vectors of A.  *           At this moment, V contains the right singular vectors of A.
 *           Next, assemble the left singular vector matrix U (M x N).  *           Next, assemble the left singular vector matrix U (M x N).
 *  *
          IF ( N .LT. M ) THEN           IF ( NR .LT. M ) THEN
             CALL DLASET( 'A',  M-N, N, ZERO, ZERO, U(NR+1,1), LDU )              CALL DLASET( 'A',  M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU )
             IF ( N .LT. N1 ) THEN              IF ( NR .LT. N1 ) THEN
                CALL DLASET( 'A',N,  N1-N, ZERO, ZERO,  U(1,N+1),LDU )                 CALL DLASET( 'A',NR,  N1-NR, ZERO, ZERO,  U(1,NR+1),LDU )
                CALL DLASET( 'A',M-N,N1-N, ZERO, ONE,U(NR+1,N+1),LDU )                 CALL DLASET( 'A',M-NR,N1-NR, ZERO, ONE,U(NR+1,NR+1),LDU )
             END IF              END IF
          END IF           END IF
 *  *

Removed from v.1.3  
changed lines
  Added in v.1.4


CVSweb interface <joel.bertrand@systella.fr>