diff --git a/BLAS/SRC/dcabs1.f b/BLAS/SRC/dcabs1.f index 9014cd6bf..0f87f65a6 100644 --- a/BLAS/SRC/dcabs1.f +++ b/BLAS/SRC/dcabs1.f @@ -21,7 +21,7 @@ *> *> \verbatim *> -*> DCABS1 computes |Re(.)| + |Im(.)| of a double complex number +*> DCABS1 computes |Re(.)| + |Im(.)| of a double complex number. *> \endverbatim * * Arguments: @@ -42,6 +42,18 @@ * *> \ingroup abs1 * +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> No routine in the reference BLAS or in LAPACK calls DCABS1 any +*> longer: each one inlines ABS(DBLE(Z)) + ABS(DIMAG(Z)) instead. +*> DCABS1 is kept for backwards compatibility and because vendor +*> BLAS libraries have long exported it, so callers outside this +*> library might depend on it. +*> \endverbatim +*> * ===================================================================== DOUBLE PRECISION FUNCTION DCABS1(Z) IMPLICIT NONE diff --git a/BLAS/SRC/dzasum.f b/BLAS/SRC/dzasum.f index 9cf841c19..3bc9a0c1b 100644 --- a/BLAS/SRC/dzasum.f +++ b/BLAS/SRC/dzasum.f @@ -88,9 +88,8 @@ DOUBLE PRECISION FUNCTION DZASUM(N,ZX,INCX) DOUBLE PRECISION STEMP INTEGER I,NINCX * .. -* .. External Functions .. - DOUBLE PRECISION DCABS1 - EXTERNAL DCABS1 +* .. Intrinsic Functions .. + INTRINSIC ABS,DBLE,DIMAG * .. DZASUM = 0.0d0 STEMP = 0.0d0 @@ -100,7 +99,7 @@ DOUBLE PRECISION FUNCTION DZASUM(N,ZX,INCX) * code for increment equal to 1 * DO I = 1,N - STEMP = STEMP + DCABS1(ZX(I)) + STEMP = STEMP + (ABS(DBLE(ZX(I))) + ABS(DIMAG(ZX(I)))) END DO ELSE * @@ -108,7 +107,7 @@ DOUBLE PRECISION FUNCTION DZASUM(N,ZX,INCX) * NINCX = N*INCX DO I = 1,NINCX,INCX - STEMP = STEMP + DCABS1(ZX(I)) + STEMP = STEMP + (ABS(DBLE(ZX(I))) + ABS(DIMAG(ZX(I)))) END DO END IF DZASUM = STEMP diff --git a/BLAS/SRC/scabs1.f b/BLAS/SRC/scabs1.f index f6e6cbb7c..2549115d3 100644 --- a/BLAS/SRC/scabs1.f +++ b/BLAS/SRC/scabs1.f @@ -20,7 +20,7 @@ *> *> \verbatim *> -*> SCABS1 computes |Re(.)| + |Im(.)| of a complex number +*> SCABS1 computes |Re(.)| + |Im(.)| of a complex number. *> \endverbatim * * Arguments: @@ -41,6 +41,18 @@ * *> \ingroup abs1 * +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> No routine in the reference BLAS or in LAPACK calls SCABS1 any +*> longer: each one inlines ABS(REAL(Z)) + ABS(AIMAG(Z)) instead. +*> SCABS1 is kept for backwards compatibility and because vendor +*> BLAS libraries have long exported it, so callers outside this +*> library might depend on it. +*> \endverbatim +*> * ===================================================================== REAL FUNCTION SCABS1(Z) IMPLICIT NONE diff --git a/BLAS/TESTING/cblat1.f b/BLAS/TESTING/cblat1.f index f07e4e189..abed289c5 100644 --- a/BLAS/TESTING/cblat1.f +++ b/BLAS/TESTING/cblat1.f @@ -55,7 +55,7 @@ PROGRAM CBLAT1 REAL SFAC INTEGER IC * .. External Subroutines .. - EXTERNAL CHECK1, CHECK2, HEADER + EXTERNAL CHECK0, CHECK1, CHECK2, HEADER * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /CNTBLA/NTESTS, NFAILS @@ -65,7 +65,7 @@ PROGRAM CBLAT1 * .. Executable Statements .. CALL CPU_TIME( S1 ) WRITE (NOUT,99999) - DO 20 IC = 1, 11 + DO 20 IC = 1, 12 ICASE = IC CALL HEADER * @@ -80,7 +80,9 @@ PROGRAM CBLAT1 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5 .OR. ICASE.EQ.11) THEN + IF (ICASE.EQ.12) THEN + CALL CHECK0(SFAC) + ELSE IF (ICASE.LE.5 .OR. ICASE.EQ.11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) @@ -112,7 +114,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*6 L(11) + CHARACTER*6 L(12) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /NAMBLA/SUBNAM @@ -128,6 +130,7 @@ SUBROUTINE HEADER DATA L(9)/'CSSCAL'/ DATA L(10)/'ICAMAX'/ DATA L(11)/'CAXPBY'/ + DATA L(12)/'SCABS1'/ * .. Executable Statements .. SUBNAM = L(ICASE) @@ -137,6 +140,52 @@ SUBROUTINE HEADER 99999 FORMAT (/' Test of subprogram number',I3,12X,A6) * * End of HEADER +* + END + SUBROUTINE CHECK0(SFAC) + IMPLICIT NONE +* +* SCABS1 is the only routine tested here that takes no vector at +* all, so neither the loop over N nor the loop over INCX that +* CHECK1 and CHECK2 run applies to it, and it gets a check of its +* own. Nothing in the library calls SCABS1, so this is the only +* thing that exercises it. +* +* .. Scalar Arguments .. + REAL SFAC +* .. Scalars in Common .. + INTEGER ICASE, INCX, INCY, MODE, N + LOGICAL PASS +* .. Local Scalars .. + INTEGER I +* .. Local Arrays .. + COMPLEX CV0(6) + REAL STRUE0(6) +* .. External Functions .. + REAL SCABS1 + EXTERNAL SCABS1 +* .. External Subroutines .. + EXTERNAL STEST1 +* .. Common blocks .. + COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS +* .. Data statements .. +* Every part below is exact in binary, so the expected sums are +* exact as well, and the zero case is required to be exact by the +* zero it also supplies as the comparison size. The three (3,4) +* variants separate |Re| + |Im| from the Euclidean length, which +* would give 5 rather than 7, and cover both signs of both parts. + DATA CV0/(0.0E0,0.0E0), (0.5E0,0.0E0), + + (0.0E0,-0.25E0), (3.0E0,4.0E0), (-3.0E0,4.0E0), + + (-3.0E0,-4.0E0)/ + DATA STRUE0/0.0E0, 0.5E0, 0.25E0, 7.0E0, 7.0E0, + + 7.0E0/ +* .. Executable Statements .. + DO 20 I = 1, 6 + CALL STEST1(SCABS1(CV0(I)),STRUE0(I),STRUE0(I),SFAC) + 20 CONTINUE + RETURN +* +* End of CHECK0 * END SUBROUTINE CHECK1(SFAC) diff --git a/BLAS/TESTING/zblat1.f b/BLAS/TESTING/zblat1.f index 7742590d7..646b8dcba 100644 --- a/BLAS/TESTING/zblat1.f +++ b/BLAS/TESTING/zblat1.f @@ -55,7 +55,7 @@ PROGRAM ZBLAT1 DOUBLE PRECISION SFAC INTEGER IC * .. External Subroutines .. - EXTERNAL CHECK1, CHECK2, HEADER + EXTERNAL CHECK0, CHECK1, CHECK2, HEADER * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /CNTBLA/NTESTS, NFAILS @@ -65,7 +65,7 @@ PROGRAM ZBLAT1 * .. Executable Statements .. CALL CPU_TIME( S1 ) WRITE (NOUT,99999) - DO 20 IC = 1, 11 + DO 20 IC = 1, 12 ICASE = IC CALL HEADER * @@ -80,7 +80,9 @@ PROGRAM ZBLAT1 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5 .OR. ICASE.EQ.11) THEN + IF (ICASE.EQ.12) THEN + CALL CHECK0(SFAC) + ELSE IF (ICASE.LE.5 .OR. ICASE.EQ.11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) @@ -111,7 +113,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*6 L(11) + CHARACTER*6 L(12) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /NAMBLA/SUBNAM @@ -127,6 +129,7 @@ SUBROUTINE HEADER DATA L(9)/'ZDSCAL'/ DATA L(10)/'IZAMAX'/ DATA L(11)/'ZAXPBY'/ + DATA L(12)/'DCABS1'/ * .. Executable Statements .. SUBNAM = L(ICASE) @@ -136,6 +139,52 @@ SUBROUTINE HEADER 99999 FORMAT (/' Test of subprogram number',I3,12X,A6) * * End of HEADER +* + END + SUBROUTINE CHECK0(SFAC) + IMPLICIT NONE +* +* DCABS1 is the only routine tested here that takes no vector at +* all, so neither the loop over N nor the loop over INCX that +* CHECK1 and CHECK2 run applies to it, and it gets a check of its +* own. Nothing in the library calls DCABS1, so this is the only +* thing that exercises it. +* +* .. Scalar Arguments .. + DOUBLE PRECISION SFAC +* .. Scalars in Common .. + INTEGER ICASE, INCX, INCY, MODE, N + LOGICAL PASS +* .. Local Scalars .. + INTEGER I +* .. Local Arrays .. + COMPLEX*16 ZV0(6) + DOUBLE PRECISION DTRUE0(6) +* .. External Functions .. + DOUBLE PRECISION DCABS1 + EXTERNAL DCABS1 +* .. External Subroutines .. + EXTERNAL STEST1 +* .. Common blocks .. + COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS +* .. Data statements .. +* Every part below is exact in binary, so the expected sums are +* exact as well, and the zero case is required to be exact by the +* zero it also supplies as the comparison size. The three (3,4) +* variants separate |Re| + |Im| from the Euclidean length, which +* would give 5 rather than 7, and cover both signs of both parts. + DATA ZV0/(0.0D0,0.0D0), (0.5D0,0.0D0), + + (0.0D0,-0.25D0), (3.0D0,4.0D0), (-3.0D0,4.0D0), + + (-3.0D0,-4.0D0)/ + DATA DTRUE0/0.0D0, 0.5D0, 0.25D0, 7.0D0, 7.0D0, + + 7.0D0/ +* .. Executable Statements .. + DO 20 I = 1, 6 + CALL STEST1(DCABS1(ZV0(I)),DTRUE0(I),DTRUE0(I),SFAC) + 20 CONTINUE + RETURN +* +* End of CHECK0 * END SUBROUTINE CHECK1(SFAC)