--- rpl/lapack/lapack/dgesvj.f 2014/01/27 09:28:17 1.13 +++ rpl/lapack/lapack/dgesvj.f 2015/11/26 11:44:15 1.14 @@ -45,6 +45,8 @@ *> matrix, and V is an N-by-N orthogonal matrix. The diagonal elements *> of SIGMA are the singular values of A. The columns of U and V are the *> left and the right singular vectors of A, respectively. +*> DGESVJ can sometimes compute tiny singular values and their singular vectors much +*> more accurately than other SVD routines, see below under Further Details. *> \endverbatim * * Arguments: @@ -258,7 +260,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date November 2015 * *> \ingroup doubleGEcomputational * @@ -335,10 +337,10 @@ SUBROUTINE DGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ LDV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* November 2015 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDV, LWORK, M, MV, N @@ -374,7 +376,7 @@ DOUBLE PRECISION FASTR( 5 ) * .. * .. Intrinsic Functions .. - INTRINSIC DABS, DMAX1, DMIN1, DBLE, MIN0, DSIGN, DSQRT + INTRINSIC DABS, MAX, MIN, DBLE, DSIGN, DSQRT * .. * .. External Functions .. * .. @@ -428,7 +430,7 @@ INFO = -11 ELSE IF( UCTOL .AND. ( WORK( 1 ).LE.ONE ) ) THEN INFO = -12 - ELSE IF( LWORK.LT.MAX0( M+N, 6 ) ) THEN + ELSE IF( LWORK.LT.MAX( M+N, 6 ) ) THEN INFO = -13 ELSE INFO = 0 @@ -594,8 +596,8 @@ AAPP = ZERO AAQQ = BIG DO 4781 p = 1, N - IF( SVA( p ).NE.ZERO )AAQQ = DMIN1( AAQQ, SVA( p ) ) - AAPP = DMAX1( AAPP, SVA( p ) ) + IF( SVA( p ).NE.ZERO )AAQQ = MIN( AAQQ, SVA( p ) ) + AAPP = MAX( AAPP, SVA( p ) ) 4781 CONTINUE * * #:) Quick return for zero matrix @@ -636,19 +638,19 @@ TEMP1 = DSQRT( BIG / DBLE( N ) ) IF( ( AAPP.LE.SN ) .OR. ( AAQQ.GE.TEMP1 ) .OR. $ ( ( SN.LE.AAQQ ) .AND. ( AAPP.LE.TEMP1 ) ) ) THEN - TEMP1 = DMIN1( BIG, TEMP1 / AAPP ) + TEMP1 = MIN( BIG, TEMP1 / AAPP ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.LE.TEMP1 ) ) THEN - TEMP1 = DMIN1( SN / AAQQ, BIG / ( AAPP*DSQRT( DBLE( N ) ) ) ) + TEMP1 = MIN( SN / AAQQ, BIG / ( AAPP*DSQRT( DBLE( N ) ) ) ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE IF( ( AAQQ.GE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN - TEMP1 = DMAX1( SN / AAQQ, TEMP1 / AAPP ) + TEMP1 = MAX( SN / AAQQ, TEMP1 / AAPP ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN - TEMP1 = DMIN1( SN / AAQQ, BIG / ( DSQRT( DBLE( N ) )*AAPP ) ) + TEMP1 = MIN( SN / AAQQ, BIG / ( DSQRT( DBLE( N ) )*AAPP ) ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE @@ -689,7 +691,7 @@ * The boundaries are determined dynamically, based on the number of * pivots above a threshold. * - KBL = MIN0( 8, N ) + KBL = MIN( 8, N ) *[TP] KBL is a tuning parameter that defines the tile size in the * tiling of the p-q loops of pivot pairs. In general, an optimal * value of KBL depends on the matrix dimensions and on the @@ -701,7 +703,7 @@ BLSKIP = KBL**2 *[TP] BLKSKIP is a tuning parameter that depends on SWBAND and KBL. * - ROWSKIP = MIN0( 5, KBL ) + ROWSKIP = MIN( 5, KBL ) *[TP] ROWSKIP is a tuning parameter. * LKAHEAD = 1 @@ -712,7 +714,7 @@ * invokes cubic convergence. Big part of this cycle is done inside * canonical subspaces of dimensions less than M. * - IF( ( LOWER .OR. UPPER ) .AND. ( N.GT.MAX0( 64, 4*KBL ) ) ) THEN + IF( ( LOWER .OR. UPPER ) .AND. ( N.GT.MAX( 64, 4*KBL ) ) ) THEN *[TP] The number of partition levels and the actual partition are * tuning parameters. N4 = N / 4 @@ -810,11 +812,11 @@ * igl = ( ibr-1 )*KBL + 1 * - DO 1002 ir1 = 0, MIN0( LKAHEAD, NBL-ibr ) + DO 1002 ir1 = 0, MIN( LKAHEAD, NBL-ibr ) * igl = igl + ir1*KBL * - DO 2001 p = igl, MIN0( igl+KBL-1, N-1 ) + DO 2001 p = igl, MIN( igl+KBL-1, N-1 ) * * .. de Rijk's pivoting * @@ -863,7 +865,7 @@ * PSKIPPED = 0 * - DO 2002 q = p + 1, MIN0( igl+KBL-1, N ) + DO 2002 q = p + 1, MIN( igl+KBL-1, N ) * AAQQ = SVA( q ) * @@ -902,7 +904,7 @@ END IF END IF * - MXAAPQ = DMAX1( MXAAPQ, DABS( AAPQ ) ) + MXAAPQ = MAX( MXAAPQ, DABS( AAPQ ) ) * * TO rotate or NOT to rotate, THAT is the question ... * @@ -935,11 +937,11 @@ $ V( 1, p ), 1, $ V( 1, q ), 1, $ FASTR ) - SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO, + SVA( q ) = AAQQ*DSQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*DSQRT( DMAX1( ZERO, + AAPP = AAPP*DSQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) - MXSINJ = DMAX1( MXSINJ, DABS( T ) ) + MXSINJ = MAX( MXSINJ, DABS( T ) ) * ELSE * @@ -951,10 +953,10 @@ CS = DSQRT( ONE / ( ONE+T*T ) ) SN = T*CS * - MXSINJ = DMAX1( MXSINJ, DABS( SN ) ) - SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO, + MXSINJ = MAX( MXSINJ, DABS( SN ) ) + SVA( q ) = AAQQ*DSQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*DSQRT( DMAX1( ZERO, + AAPP = AAPP*DSQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) * APOAQ = WORK( p ) / WORK( q ) @@ -1068,9 +1070,9 @@ $ A( 1, q ), 1 ) CALL DLASCL( 'G', 0, 0, ONE, AAQQ, M, $ 1, A( 1, q ), LDA, IERR ) - SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO, + SVA( q ) = AAQQ*DSQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) - MXSINJ = DMAX1( MXSINJ, SFMIN ) + MXSINJ = MAX( MXSINJ, SFMIN ) END IF * END IF ROTOK THEN ... ELSE * @@ -1136,7 +1138,7 @@ ELSE SVA( p ) = AAPP IF( ( ir1.EQ.0 ) .AND. ( AAPP.EQ.ZERO ) ) - $ NOTROT = NOTROT + MIN0( igl+KBL-1, N ) - p + $ NOTROT = NOTROT + MIN( igl+KBL-1, N ) - p END IF * 2001 CONTINUE @@ -1156,14 +1158,14 @@ * doing the block at ( ibr, jbc ) * IJBLSK = 0 - DO 2100 p = igl, MIN0( igl+KBL-1, N ) + DO 2100 p = igl, MIN( igl+KBL-1, N ) * AAPP = SVA( p ) IF( AAPP.GT.ZERO ) THEN * PSKIPPED = 0 * - DO 2200 q = jgl, MIN0( jgl+KBL-1, N ) + DO 2200 q = jgl, MIN( jgl+KBL-1, N ) * AAQQ = SVA( q ) IF( AAQQ.GT.ZERO ) THEN @@ -1213,7 +1215,7 @@ END IF END IF * - MXAAPQ = DMAX1( MXAAPQ, DABS( AAPQ ) ) + MXAAPQ = MAX( MXAAPQ, DABS( AAPQ ) ) * * TO rotate or NOT to rotate, THAT is the question ... * @@ -1241,11 +1243,11 @@ $ V( 1, p ), 1, $ V( 1, q ), 1, $ FASTR ) - SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO, + SVA( q ) = AAQQ*DSQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*DSQRT( DMAX1( ZERO, + AAPP = AAPP*DSQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) - MXSINJ = DMAX1( MXSINJ, DABS( T ) ) + MXSINJ = MAX( MXSINJ, DABS( T ) ) ELSE * * .. choose correct signum for THETA and rotate @@ -1256,10 +1258,10 @@ $ DSQRT( ONE+THETA*THETA ) ) CS = DSQRT( ONE / ( ONE+T*T ) ) SN = T*CS - MXSINJ = DMAX1( MXSINJ, DABS( SN ) ) - SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO, + MXSINJ = MAX( MXSINJ, DABS( SN ) ) + SVA( q ) = AAQQ*DSQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*DSQRT( DMAX1( ZERO, + AAPP = AAPP*DSQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) * APOAQ = WORK( p ) / WORK( q ) @@ -1376,9 +1378,9 @@ CALL DLASCL( 'G', 0, 0, ONE, AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) - SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO, + SVA( q ) = AAQQ*DSQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) - MXSINJ = DMAX1( MXSINJ, SFMIN ) + MXSINJ = MAX( MXSINJ, SFMIN ) ELSE CALL DCOPY( M, A( 1, q ), 1, $ WORK( N+1 ), 1 ) @@ -1394,9 +1396,9 @@ CALL DLASCL( 'G', 0, 0, ONE, AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) - SVA( p ) = AAPP*DSQRT( DMAX1( ZERO, + SVA( p ) = AAPP*DSQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) - MXSINJ = DMAX1( MXSINJ, SFMIN ) + MXSINJ = MAX( MXSINJ, SFMIN ) END IF END IF * END IF ROTOK THEN ... ELSE @@ -1466,7 +1468,7 @@ ELSE * IF( AAPP.EQ.ZERO )NOTROT = NOTROT + - $ MIN0( jgl+KBL-1, N ) - jgl + 1 + $ MIN( jgl+KBL-1, N ) - jgl + 1 IF( AAPP.LT.ZERO )NOTROT = 0 * END IF @@ -1477,7 +1479,7 @@ * end of the jbc-loop 2011 CONTINUE *2011 bailed out of the jbc-loop - DO 2012 p = igl, MIN0( igl+KBL-1, N ) + DO 2012 p = igl, MIN( igl+KBL-1, N ) SVA( p ) = DABS( SVA( p ) ) 2012 CONTINUE ***