BLAS: inline DCABS1 in DZASUM

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

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,15 +99,15 @@ 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
 *
 *        code for increment not equal to 1
 *
          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

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

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)

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)