From 4e5b091f146da93419a9780d3612ca4edf75312b Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Tue, 15 Sep 2026 15:49:03 +0100 Subject: [PATCH] BLAS: inline DCABS1 in DZASUM, and test both ?CABS1 routines The call is the last one to DCABS1 in the library, and it costs more than twice the loop it sits in unless the build uses LTO. Writing it out with the inner parentheses kept returns bit-identical results. That leaves SCABS1 and DCABS1 with no caller at all, so xBLAT1 gains a case of its own for each, and both say in their documentation that they are kept for the callers outside this library. Co-Authored-By: Claude Opus 5 (1M context) --- BLAS/SRC/dcabs1.f | 14 ++++++++++- BLAS/SRC/dzasum.f | 9 +++---- BLAS/SRC/scabs1.f | 14 ++++++++++- BLAS/TESTING/cblat1.f | 57 ++++++++++++++++++++++++++++++++++++++++--- BLAS/TESTING/zblat1.f | 57 ++++++++++++++++++++++++++++++++++++++++--- 5 files changed, 136 insertions(+), 15 deletions(-) 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)