From 8caa8ba4f9d3af7101e678e790d983f48169e170 Mon Sep 17 00:00:00 2001 From: "philippe.theveny" Date: Tue, 11 Aug 2015 20:44:38 +0000 Subject: [PATCH] Replaced archaic intrinsics AMIN1, DMIN1, MIN0, AMAX1, DMAX1, MAX0 by MIN/MAX. --- SRC/dgejsv.f | 39 +++++++++++++++--------------- SRC/dgesvj.f | 78 ++++++++++++++++++++++++++++++------------------------------ SRC/dgsvj0.f | 62 +++++++++++++++++++++++------------------------ SRC/dgsvj1.f | 36 ++++++++++++++-------------- SRC/sgejsv.f | 39 +++++++++++++++--------------- SRC/sgesvj.f | 78 ++++++++++++++++++++++++++++++------------------------------ SRC/sgsvj0.f | 62 +++++++++++++++++++++++------------------------ SRC/sgsvj1.f | 36 ++++++++++++++-------------- 8 files changed, 214 insertions(+), 216 deletions(-) diff --git a/SRC/dgejsv.f b/SRC/dgejsv.f index ca67a74..6a80783 100644 --- a/SRC/dgejsv.f +++ b/SRC/dgejsv.f @@ -507,8 +507,7 @@ $ NOSCAL, ROWPIV, RSVEC, TRANSP * .. * .. Intrinsic Functions .. - INTRINSIC DABS, DLOG, DMAX1, DMIN1, DBLE, - $ MAX0, MIN0, IDNINT, DSIGN, DSQRT + INTRINSIC DABS, DLOG, MAX, MIN, DBLE, IDNINT, DSIGN, DSQRT * .. * .. External Functions .. DOUBLE PRECISION DLAMCH, DNRM2 @@ -564,17 +563,17 @@ ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN INFO = - 14 ELSE IF ( (.NOT.(LSVEC .OR. RSVEC .OR. ERREST).AND. - & (LWORK .LT. MAX0(7,4*N+1,2*M+N))) .OR. + & (LWORK .LT. MAX(7,4*N+1,2*M+N))) .OR. & (.NOT.(LSVEC .OR. RSVEC) .AND. ERREST .AND. - & (LWORK .LT. MAX0(7,4*N+N*N,2*M+N))) .OR. - & (LSVEC .AND. (.NOT.RSVEC) .AND. (LWORK .LT. MAX0(7,2*M+N,4*N+1))) + & (LWORK .LT. MAX(7,4*N+N*N,2*M+N))) .OR. + & (LSVEC .AND. (.NOT.RSVEC) .AND. (LWORK .LT. MAX(7,2*M+N,4*N+1))) & .OR. - & (RSVEC .AND. (.NOT.LSVEC) .AND. (LWORK .LT. MAX0(7,2*M+N,4*N+1))) + & (RSVEC .AND. (.NOT.LSVEC) .AND. (LWORK .LT. MAX(7,2*M+N,4*N+1))) & .OR. & (LSVEC .AND. RSVEC .AND. (.NOT.JRACC) .AND. - & (LWORK.LT.MAX0(2*M+N,6*N+2*N*N))) + & (LWORK.LT.MAX(2*M+N,6*N+2*N*N))) & .OR. (LSVEC .AND. RSVEC .AND. JRACC .AND. - & LWORK.LT.MAX0(2*M+N,4*N+N*N,2*N+N*N+6))) + & LWORK.LT.MAX(2*M+N,4*N+N*N,2*N+N*N+6))) & THEN INFO = - 17 ELSE @@ -645,8 +644,8 @@ AAPP = ZERO AAQQ = BIG DO 4781 p = 1, N - AAPP = DMAX1( AAPP, SVA(p) ) - IF ( SVA(p) .NE. ZERO ) AAQQ = DMIN1( AAQQ, SVA(p) ) + AAPP = MAX( AAPP, SVA(p) ) + IF ( SVA(p) .NE. ZERO ) AAQQ = MIN( AAQQ, SVA(p) ) 4781 CONTINUE * * Quick return for zero M x N matrix @@ -750,14 +749,14 @@ * in one pass through the vector WORK(M+N+p) = XSC * SCALEM WORK(N+p) = XSC * (SCALEM*DSQRT(TEMP1)) - AATMAX = DMAX1( AATMAX, WORK(N+p) ) - IF (WORK(N+p) .NE. ZERO) AATMIN = DMIN1(AATMIN,WORK(N+p)) + AATMAX = MAX( AATMAX, WORK(N+p) ) + IF (WORK(N+p) .NE. ZERO) AATMIN = MIN(AATMIN,WORK(N+p)) 1950 CONTINUE ELSE DO 1904 p = 1, M WORK(M+N+p) = SCALEM*DABS( A(p,IDAMAX(N,A(p,1),LDA)) ) - AATMAX = DMAX1( AATMAX, WORK(M+N+p) ) - AATMIN = DMIN1( AATMIN, WORK(M+N+p) ) + AATMAX = MAX( AATMAX, WORK(M+N+p) ) + AATMIN = MIN( AATMIN, WORK(M+N+p) ) 1904 CONTINUE END IF * @@ -995,7 +994,7 @@ MAXPRJ = ONE DO 3051 p = 2, N TEMP1 = DABS(A(p,p)) / SVA(IWORK(p)) - MAXPRJ = DMIN1( MAXPRJ, TEMP1 ) + MAXPRJ = MIN( MAXPRJ, TEMP1 ) 3051 CONTINUE IF ( MAXPRJ**2 .GE. ONE - DBLE(N)*EPSLN ) ALMORT = .TRUE. END IF @@ -1053,7 +1052,7 @@ * Singular Values only * * .. transpose A(1:NR,1:N) - DO 1946 p = 1, MIN0( N-1, NR ) + DO 1946 p = 1, MIN( N-1, NR ) CALL DCOPY( N-p, A(p,p+1), LDA, A(p+1,p), 1 ) 1946 CONTINUE * @@ -1309,7 +1308,7 @@ XSC = DSQRT(SMALL)/EPSLN DO 3959 p = 2, NR DO 3958 q = 1, p - 1 - TEMP1 = XSC * DMIN1(DABS(V(p,p)),DABS(V(q,q))) + TEMP1 = XSC * MIN(DABS(V(p,p)),DABS(V(q,q))) IF ( DABS(V(q,p)) .LE. TEMP1 ) $ V(q,p) = DSIGN( TEMP1, V(q,p) ) 3958 CONTINUE @@ -1348,7 +1347,7 @@ XSC = DSQRT(SMALL) DO 3969 p = 2, NR DO 3968 q = 1, p - 1 - TEMP1 = XSC * DMIN1(DABS(V(p,p)),DABS(V(q,q))) + TEMP1 = XSC * MIN(DABS(V(p,p)),DABS(V(q,q))) IF ( DABS(V(q,p)) .LE. TEMP1 ) $ V(q,p) = DSIGN( TEMP1, V(q,p) ) 3968 CONTINUE @@ -1361,7 +1360,7 @@ XSC = DSQRT(SMALL) DO 8970 p = 2, NR DO 8971 q = 1, p - 1 - TEMP1 = XSC * DMIN1(DABS(V(p,p)),DABS(V(q,q))) + TEMP1 = XSC * MIN(DABS(V(p,p)),DABS(V(q,q))) V(p,q) = - DSIGN( TEMP1, V(q,p) ) 8971 CONTINUE 8970 CONTINUE @@ -1672,7 +1671,7 @@ XSC = DSQRT(SMALL/EPSLN) DO 9970 q = 2, NR DO 9971 p = 1, q - 1 - TEMP1 = XSC * DMIN1(DABS(U(p,p)),DABS(U(q,q))) + TEMP1 = XSC * MIN(DABS(U(p,p)),DABS(U(q,q))) U(p,q) = - DSIGN( TEMP1, U(q,p) ) 9971 CONTINUE 9970 CONTINUE diff --git a/SRC/dgesvj.f b/SRC/dgesvj.f index 812b050..d5f3557 100644 --- a/SRC/dgesvj.f +++ b/SRC/dgesvj.f @@ -376,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 .. * .. @@ -430,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 @@ -596,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 @@ -638,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 @@ -691,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 @@ -703,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 @@ -714,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 @@ -812,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 * @@ -865,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 ) * @@ -904,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 ... * @@ -937,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 * @@ -953,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 ) @@ -1070,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 * @@ -1138,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 @@ -1158,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 @@ -1215,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 ... * @@ -1243,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 @@ -1258,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 ) @@ -1378,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 ) @@ -1396,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 @@ -1468,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 @@ -1479,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 *** diff --git a/SRC/dgsvj0.f b/SRC/dgsvj0.f index bc0dd50..9402a33 100644 --- a/SRC/dgsvj0.f +++ b/SRC/dgsvj0.f @@ -253,7 +253,7 @@ DOUBLE PRECISION FASTR( 5 ) * .. * .. Intrinsic Functions .. - INTRINSIC DABS, DMAX1, DBLE, MIN0, DSIGN, DSQRT + INTRINSIC DABS, MAX, DBLE, MIN, DSIGN, DSQRT * .. * .. External Functions .. DOUBLE PRECISION DDOT, DNRM2 @@ -329,7 +329,7 @@ * Jacobi SVD algorithm SGESVJ. For sweeps i=1:SWBAND the procedure * ...... - 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 @@ -341,7 +341,7 @@ BLSKIP = ( KBL**2 ) + 1 *[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 @@ -363,11 +363,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 q = IDAMAX( N-p+1, SVA( p ), 1 ) + p - 1 @@ -416,7 +416,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 ) @@ -451,7 +451,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 ... * @@ -483,11 +483,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 * @@ -499,10 +499,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 = D( p ) / D( q ) @@ -613,9 +613,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 * @@ -679,7 +679,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 @@ -700,7 +700,7 @@ * 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 ) * @@ -708,7 +708,7 @@ * PSKIPPED = 0 * - DO 2200 q = jgl, MIN0( jgl+KBL-1, N ) + DO 2200 q = jgl, MIN( jgl+KBL-1, N ) * AAQQ = SVA( q ) * @@ -755,7 +755,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 ... * @@ -782,11 +782,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 @@ -797,10 +797,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 = D( p ) / D( q ) @@ -915,9 +915,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, $ 1 ) @@ -932,9 +932,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 @@ -1002,7 +1002,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 @@ -1012,7 +1012,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 * diff --git a/SRC/dgsvj1.f b/SRC/dgsvj1.f index 1c5efeb..3e9c523 100644 --- a/SRC/dgsvj1.f +++ b/SRC/dgsvj1.f @@ -271,7 +271,7 @@ DOUBLE PRECISION FASTR( 5 ) * .. * .. Intrinsic Functions .. - INTRINSIC DABS, DMAX1, DBLE, MIN0, DSIGN, DSQRT + INTRINSIC DABS, MAX, DBLE, MIN, DSIGN, DSQRT * .. * .. External Functions .. DOUBLE PRECISION DDOT, DNRM2 @@ -345,7 +345,7 @@ * * .. Row-cyclic pivot strategy with de Rijk's pivoting .. * - KBL = MIN0( 8, N ) + KBL = MIN( 8, N ) NBLR = N1 / KBL IF( ( NBLR*KBL ).NE.N1 )NBLR = NBLR + 1 @@ -356,7 +356,7 @@ BLSKIP = ( KBL**2 ) + 1 *[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. SWBAND = 0 *[TP] SWBAND is a tuning parameter. It is meaningful and effective @@ -399,7 +399,7 @@ * doing the block at ( ibr, jbc ) IJBLSK = 0 - DO 2100 p = igl, MIN0( igl+KBL-1, N1 ) + DO 2100 p = igl, MIN( igl+KBL-1, N1 ) AAPP = SVA( p ) @@ -407,7 +407,7 @@ PSKIPPED = 0 - DO 2200 q = jgl, MIN0( jgl+KBL-1, N ) + DO 2200 q = jgl, MIN( jgl+KBL-1, N ) * AAQQ = SVA( q ) @@ -454,7 +454,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 ... * @@ -481,11 +481,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 @@ -496,10 +496,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 = D( p ) / D( q ) @@ -614,9 +614,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, $ 1 ) @@ -631,9 +631,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 @@ -704,7 +704,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 *** IF ( NOTROT .GE. EMPTSW ) GO TO 2011 END IF @@ -715,7 +715,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 *** IF ( NOTROT .GE. EMPTSW ) GO TO 1994 diff --git a/SRC/sgejsv.f b/SRC/sgejsv.f index 0dc89e6..54a3d40 100644 --- a/SRC/sgejsv.f +++ b/SRC/sgejsv.f @@ -509,8 +509,7 @@ $ NOSCAL, ROWPIV, RSVEC, TRANSP * .. * .. Intrinsic Functions .. - INTRINSIC ABS, ALOG, AMAX1, AMIN1, FLOAT, - $ MAX0, MIN0, NINT, SIGN, SQRT + INTRINSIC ABS, ALOG, MAX, MIN, FLOAT, NINT, SIGN, SQRT * .. * .. External Functions .. REAL SLAMCH, SNRM2 @@ -566,17 +565,17 @@ ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN INFO = - 14 ELSE IF ( (.NOT.(LSVEC .OR. RSVEC .OR. ERREST).AND. - $ (LWORK .LT. MAX0(7,4*N+1,2*M+N))) .OR. + $ (LWORK .LT. MAX(7,4*N+1,2*M+N))) .OR. $ (.NOT.(LSVEC .OR. RSVEC) .AND. ERREST .AND. - $ (LWORK .LT. MAX0(7,4*N+N*N,2*M+N))) .OR. - $ (LSVEC .AND. (.NOT.RSVEC) .AND. (LWORK .LT. MAX0(7,2*M+N,4*N+1))) + $ (LWORK .LT. MAX(7,4*N+N*N,2*M+N))) .OR. + $ (LSVEC .AND. (.NOT.RSVEC) .AND. (LWORK .LT. MAX(7,2*M+N,4*N+1))) $ .OR. - $ (RSVEC .AND. (.NOT.LSVEC) .AND. (LWORK .LT. MAX0(7,2*M+N,4*N+1))) + $ (RSVEC .AND. (.NOT.LSVEC) .AND. (LWORK .LT. MAX(7,2*M+N,4*N+1))) $ .OR. $ (LSVEC .AND. RSVEC .AND. (.NOT.JRACC) .AND. - $ (LWORK.LT.MAX0(2*M+N,6*N+2*N*N))) + $ (LWORK.LT.MAX(2*M+N,6*N+2*N*N))) $ .OR. (LSVEC .AND. RSVEC .AND. JRACC .AND. - $ LWORK.LT.MAX0(2*M+N,4*N+N*N,2*N+N*N+6))) + $ LWORK.LT.MAX(2*M+N,4*N+N*N,2*N+N*N+6))) $ THEN INFO = - 17 ELSE @@ -647,8 +646,8 @@ AAPP = ZERO AAQQ = BIG DO 4781 p = 1, N - AAPP = AMAX1( AAPP, SVA(p) ) - IF ( SVA(p) .NE. ZERO ) AAQQ = AMIN1( AAQQ, SVA(p) ) + AAPP = MAX( AAPP, SVA(p) ) + IF ( SVA(p) .NE. ZERO ) AAQQ = MIN( AAQQ, SVA(p) ) 4781 CONTINUE * * Quick return for zero M x N matrix @@ -752,14 +751,14 @@ * in one pass through the vector WORK(M+N+p) = XSC * SCALEM WORK(N+p) = XSC * (SCALEM*SQRT(TEMP1)) - AATMAX = AMAX1( AATMAX, WORK(N+p) ) - IF (WORK(N+p) .NE. ZERO) AATMIN = AMIN1(AATMIN,WORK(N+p)) + AATMAX = MAX( AATMAX, WORK(N+p) ) + IF (WORK(N+p) .NE. ZERO) AATMIN = MIN(AATMIN,WORK(N+p)) 1950 CONTINUE ELSE DO 1904 p = 1, M WORK(M+N+p) = SCALEM*ABS( A(p,ISAMAX(N,A(p,1),LDA)) ) - AATMAX = AMAX1( AATMAX, WORK(M+N+p) ) - AATMIN = AMIN1( AATMIN, WORK(M+N+p) ) + AATMAX = MAX( AATMAX, WORK(M+N+p) ) + AATMIN = MIN( AATMIN, WORK(M+N+p) ) 1904 CONTINUE END IF * @@ -997,7 +996,7 @@ MAXPRJ = ONE DO 3051 p = 2, N TEMP1 = ABS(A(p,p)) / SVA(IWORK(p)) - MAXPRJ = AMIN1( MAXPRJ, TEMP1 ) + MAXPRJ = MIN( MAXPRJ, TEMP1 ) 3051 CONTINUE IF ( MAXPRJ**2 .GE. ONE - FLOAT(N)*EPSLN ) ALMORT = .TRUE. END IF @@ -1055,7 +1054,7 @@ * Singular Values only * * .. transpose A(1:NR,1:N) - DO 1946 p = 1, MIN0( N-1, NR ) + DO 1946 p = 1, MIN( N-1, NR ) CALL SCOPY( N-p, A(p,p+1), LDA, A(p+1,p), 1 ) 1946 CONTINUE * @@ -1311,7 +1310,7 @@ XSC = SQRT(SMALL)/EPSLN DO 3959 p = 2, NR DO 3958 q = 1, p - 1 - TEMP1 = XSC * AMIN1(ABS(V(p,p)),ABS(V(q,q))) + TEMP1 = XSC * MIN(ABS(V(p,p)),ABS(V(q,q))) IF ( ABS(V(q,p)) .LE. TEMP1 ) $ V(q,p) = SIGN( TEMP1, V(q,p) ) 3958 CONTINUE @@ -1350,7 +1349,7 @@ XSC = SQRT(SMALL) DO 3969 p = 2, NR DO 3968 q = 1, p - 1 - TEMP1 = XSC * AMIN1(ABS(V(p,p)),ABS(V(q,q))) + TEMP1 = XSC * MIN(ABS(V(p,p)),ABS(V(q,q))) IF ( ABS(V(q,p)) .LE. TEMP1 ) $ V(q,p) = SIGN( TEMP1, V(q,p) ) 3968 CONTINUE @@ -1363,7 +1362,7 @@ XSC = SQRT(SMALL) DO 8970 p = 2, NR DO 8971 q = 1, p - 1 - TEMP1 = XSC * AMIN1(ABS(V(p,p)),ABS(V(q,q))) + TEMP1 = XSC * MIN(ABS(V(p,p)),ABS(V(q,q))) V(p,q) = - SIGN( TEMP1, V(q,p) ) 8971 CONTINUE 8970 CONTINUE @@ -1674,7 +1673,7 @@ XSC = SQRT(SMALL/EPSLN) DO 9970 q = 2, NR DO 9971 p = 1, q - 1 - TEMP1 = XSC * AMIN1(ABS(U(p,p)),ABS(U(q,q))) + TEMP1 = XSC * MIN(ABS(U(p,p)),ABS(U(q,q))) U(p,q) = - SIGN( TEMP1, U(q,p) ) 9971 CONTINUE 9970 CONTINUE diff --git a/SRC/sgesvj.f b/SRC/sgesvj.f index 0d57d68..5305ec2 100644 --- a/SRC/sgesvj.f +++ b/SRC/sgesvj.f @@ -362,7 +362,7 @@ REAL FASTR( 5 ) * .. * .. Intrinsic Functions .. - INTRINSIC ABS, AMAX1, AMIN1, FLOAT, MIN0, SIGN, SQRT + INTRINSIC ABS, MAX, MIN, FLOAT, SIGN, SQRT * .. * .. External Functions .. * .. @@ -416,7 +416,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 @@ -582,8 +582,8 @@ AAPP = ZERO AAQQ = BIG DO 4781 p = 1, N - IF( SVA( p ).NE.ZERO )AAQQ = AMIN1( AAQQ, SVA( p ) ) - AAPP = AMAX1( 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 @@ -624,19 +624,19 @@ TEMP1 = SQRT( BIG / FLOAT( N ) ) IF( ( AAPP.LE.SN ) .OR. ( AAQQ.GE.TEMP1 ) .OR. $ ( ( SN.LE.AAQQ ) .AND. ( AAPP.LE.TEMP1 ) ) ) THEN - TEMP1 = AMIN1( 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 = AMIN1( SN / AAQQ, BIG / ( AAPP*SQRT( FLOAT( N ) ) ) ) + TEMP1 = MIN( SN / AAQQ, BIG / ( AAPP*SQRT( FLOAT( N ) ) ) ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE IF( ( AAQQ.GE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN - TEMP1 = AMAX1( 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 = AMIN1( SN / AAQQ, BIG / ( SQRT( FLOAT( N ) )*AAPP ) ) + TEMP1 = MIN( SN / AAQQ, BIG / ( SQRT( FLOAT( N ) )*AAPP ) ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE @@ -677,7 +677,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 @@ -689,7 +689,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 @@ -700,7 +700,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 @@ -798,11 +798,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 * @@ -851,7 +851,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 ) * @@ -890,7 +890,7 @@ END IF END IF * - MXAAPQ = AMAX1( MXAAPQ, ABS( AAPQ ) ) + MXAAPQ = MAX( MXAAPQ, ABS( AAPQ ) ) * * TO rotate or NOT to rotate, THAT is the question ... * @@ -923,11 +923,11 @@ $ V( 1, p ), 1, $ V( 1, q ), 1, $ FASTR ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*SQRT( AMAX1( ZERO, + AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, ABS( T ) ) + MXSINJ = MAX( MXSINJ, ABS( T ) ) * ELSE * @@ -939,10 +939,10 @@ CS = SQRT( ONE / ( ONE+T*T ) ) SN = T*CS * - MXSINJ = AMAX1( MXSINJ, ABS( SN ) ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + MXSINJ = MAX( MXSINJ, ABS( SN ) ) + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*SQRT( AMAX1( ZERO, + AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) * APOAQ = WORK( p ) / WORK( q ) @@ -1056,9 +1056,9 @@ $ A( 1, q ), 1 ) CALL SLASCL( 'G', 0, 0, ONE, AAQQ, M, $ 1, A( 1, q ), LDA, IERR ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, SFMIN ) + MXSINJ = MAX( MXSINJ, SFMIN ) END IF * END IF ROTOK THEN ... ELSE * @@ -1124,7 +1124,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 @@ -1144,14 +1144,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 @@ -1201,7 +1201,7 @@ END IF END IF * - MXAAPQ = AMAX1( MXAAPQ, ABS( AAPQ ) ) + MXAAPQ = MAX( MXAAPQ, ABS( AAPQ ) ) * * TO rotate or NOT to rotate, THAT is the question ... * @@ -1229,11 +1229,11 @@ $ V( 1, p ), 1, $ V( 1, q ), 1, $ FASTR ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*SQRT( AMAX1( ZERO, + AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, ABS( T ) ) + MXSINJ = MAX( MXSINJ, ABS( T ) ) ELSE * * .. choose correct signum for THETA and rotate @@ -1244,10 +1244,10 @@ $ SQRT( ONE+THETA*THETA ) ) CS = SQRT( ONE / ( ONE+T*T ) ) SN = T*CS - MXSINJ = AMAX1( MXSINJ, ABS( SN ) ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + MXSINJ = MAX( MXSINJ, ABS( SN ) ) + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*SQRT( AMAX1( ZERO, + AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) * APOAQ = WORK( p ) / WORK( q ) @@ -1364,9 +1364,9 @@ CALL SLASCL( 'G', 0, 0, ONE, AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, SFMIN ) + MXSINJ = MAX( MXSINJ, SFMIN ) ELSE CALL SCOPY( M, A( 1, q ), 1, $ WORK( N+1 ), 1 ) @@ -1382,9 +1382,9 @@ CALL SLASCL( 'G', 0, 0, ONE, AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) - SVA( p ) = AAPP*SQRT( AMAX1( ZERO, + SVA( p ) = AAPP*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, SFMIN ) + MXSINJ = MAX( MXSINJ, SFMIN ) END IF END IF * END IF ROTOK THEN ... ELSE @@ -1454,7 +1454,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 @@ -1465,7 +1465,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 ) = ABS( SVA( p ) ) 2012 CONTINUE *** diff --git a/SRC/sgsvj0.f b/SRC/sgsvj0.f index 48defb8..9ef10bc 100644 --- a/SRC/sgsvj0.f +++ b/SRC/sgsvj0.f @@ -253,7 +253,7 @@ REAL FASTR( 5 ) * .. * .. Intrinsic Functions .. - INTRINSIC ABS, AMAX1, FLOAT, MIN0, SIGN, SQRT + INTRINSIC ABS, MAX, FLOAT, MIN, SIGN, SQRT * .. * .. External Functions .. REAL SDOT, SNRM2 @@ -329,7 +329,7 @@ * Jacobi SVD algorithm SGESVJ. For sweeps i=1:SWBAND the procedure * ...... - 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 @@ -341,7 +341,7 @@ BLSKIP = ( KBL**2 ) + 1 *[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 @@ -363,11 +363,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 q = ISAMAX( N-p+1, SVA( p ), 1 ) + p - 1 @@ -416,7 +416,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 ) @@ -451,7 +451,7 @@ END IF END IF * - MXAAPQ = AMAX1( MXAAPQ, ABS( AAPQ ) ) + MXAAPQ = MAX( MXAAPQ, ABS( AAPQ ) ) * * TO rotate or NOT to rotate, THAT is the question ... * @@ -483,11 +483,11 @@ $ V( 1, p ), 1, $ V( 1, q ), 1, $ FASTR ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*SQRT( AMAX1( ZERO, + AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, ABS( T ) ) + MXSINJ = MAX( MXSINJ, ABS( T ) ) * ELSE * @@ -499,10 +499,10 @@ CS = SQRT( ONE / ( ONE+T*T ) ) SN = T*CS * - MXSINJ = AMAX1( MXSINJ, ABS( SN ) ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + MXSINJ = MAX( MXSINJ, ABS( SN ) ) + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*SQRT( AMAX1( ZERO, + AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) * APOAQ = D( p ) / D( q ) @@ -613,9 +613,9 @@ $ A( 1, q ), 1 ) CALL SLASCL( 'G', 0, 0, ONE, AAQQ, M, $ 1, A( 1, q ), LDA, IERR ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, SFMIN ) + MXSINJ = MAX( MXSINJ, SFMIN ) END IF * END IF ROTOK THEN ... ELSE * @@ -679,7 +679,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 @@ -700,7 +700,7 @@ * 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 ) * @@ -708,7 +708,7 @@ * PSKIPPED = 0 * - DO 2200 q = jgl, MIN0( jgl+KBL-1, N ) + DO 2200 q = jgl, MIN( jgl+KBL-1, N ) * AAQQ = SVA( q ) * @@ -755,7 +755,7 @@ END IF END IF * - MXAAPQ = AMAX1( MXAAPQ, ABS( AAPQ ) ) + MXAAPQ = MAX( MXAAPQ, ABS( AAPQ ) ) * * TO rotate or NOT to rotate, THAT is the question ... * @@ -782,11 +782,11 @@ $ V( 1, p ), 1, $ V( 1, q ), 1, $ FASTR ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*SQRT( AMAX1( ZERO, + AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, ABS( T ) ) + MXSINJ = MAX( MXSINJ, ABS( T ) ) ELSE * * .. choose correct signum for THETA and rotate @@ -797,10 +797,10 @@ $ SQRT( ONE+THETA*THETA ) ) CS = SQRT( ONE / ( ONE+T*T ) ) SN = T*CS - MXSINJ = AMAX1( MXSINJ, ABS( SN ) ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + MXSINJ = MAX( MXSINJ, ABS( SN ) ) + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*SQRT( AMAX1( ZERO, + AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) * APOAQ = D( p ) / D( q ) @@ -915,9 +915,9 @@ CALL SLASCL( 'G', 0, 0, ONE, AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, SFMIN ) + MXSINJ = MAX( MXSINJ, SFMIN ) ELSE CALL SCOPY( M, A( 1, q ), 1, WORK, $ 1 ) @@ -932,9 +932,9 @@ CALL SLASCL( 'G', 0, 0, ONE, AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) - SVA( p ) = AAPP*SQRT( AMAX1( ZERO, + SVA( p ) = AAPP*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, SFMIN ) + MXSINJ = MAX( MXSINJ, SFMIN ) END IF END IF * END IF ROTOK THEN ... ELSE @@ -1002,7 +1002,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 @@ -1012,7 +1012,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 ) = ABS( SVA( p ) ) 2012 CONTINUE * diff --git a/SRC/sgsvj1.f b/SRC/sgsvj1.f index dca8f38..806e5eb 100644 --- a/SRC/sgsvj1.f +++ b/SRC/sgsvj1.f @@ -271,7 +271,7 @@ REAL FASTR( 5 ) * .. * .. Intrinsic Functions .. - INTRINSIC ABS, AMAX1, FLOAT, MIN0, SIGN, SQRT + INTRINSIC ABS, MAX, FLOAT, MIN, SIGN, SQRT * .. * .. External Functions .. REAL SDOT, SNRM2 @@ -345,7 +345,7 @@ * * .. Row-cyclic pivot strategy with de Rijk's pivoting .. * - KBL = MIN0( 8, N ) + KBL = MIN( 8, N ) NBLR = N1 / KBL IF( ( NBLR*KBL ).NE.N1 )NBLR = NBLR + 1 @@ -356,7 +356,7 @@ BLSKIP = ( KBL**2 ) + 1 *[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. SWBAND = 0 *[TP] SWBAND is a tuning parameter. It is meaningful and effective @@ -399,7 +399,7 @@ * doing the block at ( ibr, jbc ) IJBLSK = 0 - DO 2100 p = igl, MIN0( igl+KBL-1, N1 ) + DO 2100 p = igl, MIN( igl+KBL-1, N1 ) AAPP = SVA( p ) @@ -407,7 +407,7 @@ PSKIPPED = 0 - DO 2200 q = jgl, MIN0( jgl+KBL-1, N ) + DO 2200 q = jgl, MIN( jgl+KBL-1, N ) * AAQQ = SVA( q ) @@ -454,7 +454,7 @@ END IF END IF - MXAAPQ = AMAX1( MXAAPQ, ABS( AAPQ ) ) + MXAAPQ = MAX( MXAAPQ, ABS( AAPQ ) ) * TO rotate or NOT to rotate, THAT is the question ... * @@ -481,11 +481,11 @@ $ V( 1, p ), 1, $ V( 1, q ), 1, $ FASTR ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*SQRT( AMAX1( ZERO, + AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, ABS( T ) ) + MXSINJ = MAX( MXSINJ, ABS( T ) ) ELSE * * .. choose correct signum for THETA and rotate @@ -496,10 +496,10 @@ $ SQRT( ONE+THETA*THETA ) ) CS = SQRT( ONE / ( ONE+T*T ) ) SN = T*CS - MXSINJ = AMAX1( MXSINJ, ABS( SN ) ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + MXSINJ = MAX( MXSINJ, ABS( SN ) ) + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE+T*APOAQ*AAPQ ) ) - AAPP = AAPP*SQRT( AMAX1( ZERO, + AAPP = AAPP*SQRT( MAX( ZERO, $ ONE-T*AQOAP*AAPQ ) ) APOAQ = D( p ) / D( q ) @@ -614,9 +614,9 @@ CALL SLASCL( 'G', 0, 0, ONE, AAQQ, $ M, 1, A( 1, q ), LDA, $ IERR ) - SVA( q ) = AAQQ*SQRT( AMAX1( ZERO, + SVA( q ) = AAQQ*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, SFMIN ) + MXSINJ = MAX( MXSINJ, SFMIN ) ELSE CALL SCOPY( M, A( 1, q ), 1, WORK, $ 1 ) @@ -631,9 +631,9 @@ CALL SLASCL( 'G', 0, 0, ONE, AAPP, $ M, 1, A( 1, p ), LDA, $ IERR ) - SVA( p ) = AAPP*SQRT( AMAX1( ZERO, + SVA( p ) = AAPP*SQRT( MAX( ZERO, $ ONE-AAPQ*AAPQ ) ) - MXSINJ = AMAX1( MXSINJ, SFMIN ) + MXSINJ = MAX( MXSINJ, SFMIN ) END IF END IF * END IF ROTOK THEN ... ELSE @@ -704,7 +704,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 *** IF ( NOTROT .GE. EMPTSW ) GO TO 2011 END IF @@ -715,7 +715,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 ) = ABS( SVA( p ) ) 2012 CONTINUE *** IF ( NOTROT .GE. EMPTSW ) GO TO 1994 -- 2.7.4