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

Diff for /rpl/lapack/lapack/zgesvj.f between versions 1.1 and 1.2

version 1.1, 2015/11/26 11:44:22 version 1.2, 2016/08/27 15:27:12
Line 270 Line 270
 *> \author Univ. of Colorado Denver   *> \author Univ. of Colorado Denver 
 *> \author NAG Ltd.   *> \author NAG Ltd. 
 *  *
 *> \date November 2015  *> \date June 2016
 *  *
 *> \ingroup doubleGEcomputational  *> \ingroup doubleGEcomputational
 *  *
Line 342 Line 342
       SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,         SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, 
      $                   LDV, CWORK, LWORK, RWORK, LRWORK, INFO )       $                   LDV, CWORK, LWORK, RWORK, LRWORK, INFO )
 *  *
 *  -- LAPACK computational routine (version 3.6.0) --  *  -- LAPACK computational routine (version 3.6.1) --
 *  -- 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 2015  *     June 2016
 *  *
       IMPLICIT NONE         IMPLICIT NONE 
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
Line 381 Line 381
 *     ..  *     ..
 *     ..  *     ..
 *     .. Intrinsic Functions ..  *     .. Intrinsic Functions ..
       INTRINSIC ABS, DMAX1, DMIN1, DCONJG, DFLOAT, MIN0, MAX0,         INTRINSIC ABS, DMAX1, DMIN1, DCONJG, DBLE, MIN0, MAX0, 
      $          DSIGN, DSQRT       $          DSIGN, DSQRT
 *     ..  *     ..
 *     .. External Functions ..  *     .. External Functions ..
Line 403 Line 403
 *     from BLAS  *     from BLAS
       EXTERNAL           ZCOPY, ZROT, ZDSCAL, ZSWAP        EXTERNAL           ZCOPY, ZROT, ZDSCAL, ZSWAP
 *     from LAPACK  *     from LAPACK
       EXTERNAL           ZLASCL, ZLASET, ZLASSQ, XERBLA        EXTERNAL           DLASCL, ZLASCL, ZLASET, ZLASSQ, XERBLA
       EXTERNAL           ZGSVJ0, ZGSVJ1        EXTERNAL           ZGSVJ0, ZGSVJ1
 *     ..  *     ..
 *     .. Executable Statements ..  *     .. Executable Statements ..
Line 467 Line 467
       ELSE        ELSE
 *        ... default  *        ... default
          IF( LSVEC .OR. RSVEC .OR. APPLV ) THEN           IF( LSVEC .OR. RSVEC .OR. APPLV ) THEN
             CTOL = DSQRT( DFLOAT( M ) )              CTOL = DSQRT( DBLE( M ) )
          ELSE           ELSE
             CTOL = DFLOAT( M )              CTOL = DBLE( M )
          END IF           END IF
       END IF        END IF
 *     ... and the machine dependent parameters are  *     ... and the machine dependent parameters are
Line 483 Line 483
       BIG = DLAMCH( 'Overflow' )        BIG = DLAMCH( 'Overflow' )
 *     BIG         = ONE    / SFMIN  *     BIG         = ONE    / SFMIN
       ROOTBIG = ONE / ROOTSFMIN        ROOTBIG = ONE / ROOTSFMIN
       LARGE = BIG / DSQRT( DFLOAT( M*N ) )        LARGE = BIG / DSQRT( DBLE( M*N ) )
       BIGTHETA = ONE / ROOTEPS        BIGTHETA = ONE / ROOTEPS
 *  *
       TOL = CTOL*EPSLN        TOL = CTOL*EPSLN
       ROOTTOL = DSQRT( TOL )        ROOTTOL = DSQRT( TOL )
 *  *
       IF( DFLOAT( M )*EPSLN.GE.ONE ) THEN        IF( DBLE( M )*EPSLN.GE.ONE ) THEN
          INFO = -4           INFO = -4
          CALL XERBLA( 'ZGESVJ', -INFO )           CALL XERBLA( 'ZGESVJ', -INFO )
          RETURN           RETURN
Line 514 Line 514
 *     SQRT(N)*max_i SVA(i) does not overflow. If INFinite entries  *     SQRT(N)*max_i SVA(i) does not overflow. If INFinite entries
 *     in A are detected, the procedure returns with INFO=-6.  *     in A are detected, the procedure returns with INFO=-6.
 *  *
       SKL = ONE / DSQRT( DFLOAT( M )*DFLOAT( N ) )        SKL = ONE / DSQRT( DBLE( M )*DBLE( N ) )
       NOSCALE = .TRUE.        NOSCALE = .TRUE.
       GOSCALE = .TRUE.        GOSCALE = .TRUE.
 *  *
Line 643 Line 643
 *     avoid underflows/overflows in computing Jacobi rotations.  *     avoid underflows/overflows in computing Jacobi rotations.
 *  *
       SN = DSQRT( SFMIN / EPSLN )        SN = DSQRT( SFMIN / EPSLN )
       TEMP1 = DSQRT( BIG / DFLOAT( N ) )        TEMP1 = DSQRT( BIG / DBLE( N ) )
       IF( ( AAPP.LE.SN ) .OR. ( AAQQ.GE.TEMP1 ) .OR.            IF( ( AAPP.LE.SN ) .OR. ( AAQQ.GE.TEMP1 ) .OR.    
      $    ( ( SN.LE.AAQQ ) .AND. ( AAPP.LE.TEMP1 ) ) ) THEN       $    ( ( SN.LE.AAQQ ) .AND. ( AAPP.LE.TEMP1 ) ) ) THEN
          TEMP1 = DMIN1( BIG, TEMP1 / AAPP )           TEMP1 = DMIN1( BIG, TEMP1 / AAPP )
 *         AAQQ  = AAQQ*TEMP1  *         AAQQ  = AAQQ*TEMP1
 *         AAPP  = AAPP*TEMP1  *         AAPP  = AAPP*TEMP1
       ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.LE.TEMP1 ) ) THEN        ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.LE.TEMP1 ) ) THEN
          TEMP1 = DMIN1( SN / AAQQ, BIG / (AAPP*DSQRT( DFLOAT(N)) ) )           TEMP1 = DMIN1( SN / AAQQ, BIG / (AAPP*DSQRT( DBLE(N)) ) )
 *         AAQQ  = AAQQ*TEMP1  *         AAQQ  = AAQQ*TEMP1
 *         AAPP  = AAPP*TEMP1  *         AAPP  = AAPP*TEMP1
       ELSE IF( ( AAQQ.GE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN        ELSE IF( ( AAQQ.GE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN
Line 658 Line 658
 *         AAQQ  = AAQQ*TEMP1  *         AAQQ  = AAQQ*TEMP1
 *         AAPP  = AAPP*TEMP1  *         AAPP  = AAPP*TEMP1
       ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN        ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN
          TEMP1 = DMIN1( SN / AAQQ, BIG / ( DSQRT( DFLOAT( N ) )*AAPP ) )           TEMP1 = DMIN1( SN / AAQQ, BIG / ( DSQRT( DBLE( N ) )*AAPP ) )
 *         AAQQ  = AAQQ*TEMP1  *         AAQQ  = AAQQ*TEMP1
 *         AAPP  = AAPP*TEMP1  *         AAPP  = AAPP*TEMP1
       ELSE        ELSE
Line 668 Line 668
 *     Scale, if necessary  *     Scale, if necessary
 *  *
       IF( TEMP1.NE.ONE ) THEN        IF( TEMP1.NE.ONE ) THEN
          CALL ZLASCL( 'G', 0, 0, ONE, TEMP1, N, 1, SVA, N, IERR )           CALL DLASCL( 'G', 0, 0, ONE, TEMP1, N, 1, SVA, N, IERR )
       END IF        END IF
       SKL = TEMP1*SKL        SKL = TEMP1*SKL
       IF( SKL.NE.ONE ) THEN        IF( SKL.NE.ONE ) THEN
Line 905 Line 905
                               END IF                                END IF
                            END IF                             END IF
 *  *
                            OMPQ = AAPQ / ABS(AAPQ)   
 *                           AAPQ = AAPQ * DCONJG( CWORK(p) ) * CWORK(q)   *                           AAPQ = AAPQ * DCONJG( CWORK(p) ) * CWORK(q) 
                            AAPQ1  = -ABS(AAPQ)                              AAPQ1  = -ABS(AAPQ) 
                            MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 )                             MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 )
Line 925 Line 924
 *  *
                               IF( ROTOK ) THEN                                IF( ROTOK ) THEN
 *  *
                                  AQOAP = AAQQ / AAPP                                  OMPQ = AAPQ / ABS(AAPQ) 
                                   AQOAP = AAQQ / AAPP
                                  APOAQ = AAPP / AAQQ                                   APOAQ = AAPP / AAQQ
                                  THETA = -HALF*ABS( AQOAP-APOAQ )/AAPQ1                                   THETA = -HALF*ABS( AQOAP-APOAQ )/AAPQ1
 *  *
Line 1126 Line 1126
                               END IF                                END IF
                            END IF                             END IF
 *  *
                            OMPQ = AAPQ / ABS(AAPQ)   
 *                           AAPQ = AAPQ * DCONJG(CWORK(p))*CWORK(q)     *                           AAPQ = AAPQ * DCONJG(CWORK(p))*CWORK(q)   
                            AAPQ1  = -ABS(AAPQ)                             AAPQ1  = -ABS(AAPQ)
                            MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 )                             MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 )
Line 1141 Line 1140
 *  *
                               IF( ROTOK ) THEN                                IF( ROTOK ) THEN
 *  *
                                    OMPQ = AAPQ / ABS(AAPQ) 
                                  AQOAP = AAQQ / AAPP                                   AQOAP = AAQQ / AAPP
                                  APOAQ = AAPP / AAQQ                                   APOAQ = AAPP / AAQQ
                                  THETA = -HALF*ABS( AQOAP-APOAQ )/ AAPQ1                                   THETA = -HALF*ABS( AQOAP-APOAQ )/ AAPQ1
Line 1322 Line 1322
          IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR.           IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR.
      $       ( ISWROT.LE.N ) ) )SWBAND = i       $       ( ISWROT.LE.N ) ) )SWBAND = i
 *  *
          IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DFLOAT( N ) )*           IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DBLE( N ) )*
      $       TOL ) .AND. ( DFLOAT( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN       $       TOL ) .AND. ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN
             GO TO 1994              GO TO 1994
          END IF           END IF
 *  *
Line 1400 Line 1400
 *     then some of the singular values may overflow or underflow and  *     then some of the singular values may overflow or underflow and
 *     the spectrum is given in this factored representation.  *     the spectrum is given in this factored representation.
 *  *
       RWORK( 2 ) = DFLOAT( N4 )        RWORK( 2 ) = DBLE( N4 )
 *     N4 is the number of computed nonzero singular values of A.  *     N4 is the number of computed nonzero singular values of A.
 *  *
       RWORK( 3 ) = DFLOAT( N2 )        RWORK( 3 ) = DBLE( N2 )
 *     N2 is the number of singular values of A greater than SFMIN.  *     N2 is the number of singular values of A greater than SFMIN.
 *     If N2<N, SVA(N2:N) contains ZEROS and/or denormalized numbers  *     If N2<N, SVA(N2:N) contains ZEROS and/or denormalized numbers
 *     that may carry some information.  *     that may carry some information.
 *  *
       RWORK( 4 ) = DFLOAT( i )        RWORK( 4 ) = DBLE( i )
 *     i is the index of the last sweep before declaring convergence.  *     i is the index of the last sweep before declaring convergence.
 *  *
       RWORK( 5 ) = MXAAPQ        RWORK( 5 ) = MXAAPQ
Removed from v.1.1  
changed lines
  Added in v.1.2

CVSweb interface <joel.bertrand@systella.fr>