diff --git a/BLAS/SRC/CMakeLists.txt b/BLAS/SRC/CMakeLists.txt index b9e6f7c4a..0fa3a4fbf 100644 --- a/BLAS/SRC/CMakeLists.txt +++ b/BLAS/SRC/CMakeLists.txt @@ -29,18 +29,18 @@ # Level 1 BLAS #--------------------------------------------------------- -set(SBLAS1 isamax.f sasum.f saxpy.f scopy.f sdot.f snrm2.f90 +set(SBLAS1 isamax.f sasum.f saxpy.f saxpby.f scopy.f sdot.f snrm2.f90 srot.f srotg.f90 sscal.f sswap.f sdsdot.f srotmg.f srotm.f) -set(CBLAS1 scabs1.f scasum.f scnrm2.f90 icamax.f caxpy.f ccopy.f +set(CBLAS1 scabs1.f scasum.f scnrm2.f90 icamax.f caxpy.f caxpby.f ccopy.f cdotc.f cdotu.f csscal.f crotg.f90 cscal.f cswap.f csrot.f) -set(DBLAS1 idamax.f dasum.f daxpy.f dcopy.f ddot.f dnrm2.f90 +set(DBLAS1 idamax.f dasum.f daxpy.f daxpby.f dcopy.f ddot.f dnrm2.f90 drot.f drotg.f90 dscal.f dsdot.f dswap.f drotmg.f drotm.f) set(DB1AUX sscal.f isamax.f) -set(ZBLAS1 dcabs1.f dzasum.f dznrm2.f90 izamax.f zaxpy.f zcopy.f +set(ZBLAS1 dcabs1.f dzasum.f dznrm2.f90 izamax.f zaxpy.f zaxpby.f zcopy.f zdotc.f zdotu.f zdscal.f zrotg.f90 zscal.f zswap.f zdrot.f) set(CB1AUX diff --git a/BLAS/SRC/Makefile b/BLAS/SRC/Makefile index 486571fec..e49ff4d08 100644 --- a/BLAS/SRC/Makefile +++ b/BLAS/SRC/Makefile @@ -69,19 +69,19 @@ all: $(BLASLIB) # Comment out the next 6 definitions if you already have # the Level 1 BLAS. #--------------------------------------------------------- -SBLAS1 = isamax.o sasum.o saxpy.o scopy.o sdot.o snrm2.o \ +SBLAS1 = isamax.o sasum.o saxpy.o saxpby.o scopy.o sdot.o snrm2.o \ srot.o srotg.o sscal.o sswap.o sdsdot.o srotmg.o srotm.o $(SBLAS1): $(FRC) -CBLAS1 = scabs1.o scasum.o scnrm2.o icamax.o caxpy.o ccopy.o \ +CBLAS1 = scabs1.o scasum.o scnrm2.o icamax.o caxpy.o caxpby.o ccopy.o \ cdotc.o cdotu.o csscal.o crotg.o cscal.o cswap.o csrot.o $(CBLAS1): $(FRC) -DBLAS1 = idamax.o dasum.o daxpy.o dcopy.o ddot.o dnrm2.o \ +DBLAS1 = idamax.o dasum.o daxpy.o daxpby.o dcopy.o ddot.o dnrm2.o \ drot.o drotg.o dscal.o dsdot.o dswap.o drotmg.o drotm.o $(DBLAS1): $(FRC) -ZBLAS1 = dcabs1.o dzasum.o dznrm2.o izamax.o zaxpy.o zcopy.o \ +ZBLAS1 = dcabs1.o dzasum.o dznrm2.o izamax.o zaxpy.o zaxpby.o zcopy.o \ zdotc.o zdotu.o zdscal.o zrotg.o zscal.o zswap.o zdrot.o $(ZBLAS1): $(FRC) diff --git a/BLAS/SRC/caxpby.f b/BLAS/SRC/caxpby.f new file mode 100644 index 000000000..219388653 --- /dev/null +++ b/BLAS/SRC/caxpby.f @@ -0,0 +1,145 @@ +*> \brief \b CAXPBY +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE CAXPBY(N,CA,CX,INCX,CB,CY,INCY) +* +* .. Scalar Arguments .. +* COMPLEX CA,CB +* INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. +* COMPLEX CX(*),CY(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CAXPBY constant times a vector plus constanttimes a vector. +*> +*> Y = ALPHA * X + BETA * Y +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> number of elements in input vector(s) +*> \endverbatim +*> +*> \param[in] CA +*> \verbatim +*> CA is COMPLEX +*> On entry, CA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] CX +*> \verbatim +*> CX is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> storage spacing between elements of CX +*> \endverbatim +*> +*> \param[in] CB +*> \verbatim +*> CB is COMPLEX +*> On entry, CB specifies the scalar beta. +*> \endverbatim +*> +*> \param[in,out] CY +*> \verbatim +*> CY is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> storage spacing between elements of CY +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +*> \author Martin Koehler, MPI Magdeburg +* +*> \ingroup axpby +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> jack dongarra, linpack, 3/11/78. +*> modified 12/3/93, array(1) declarations changed to array(*) +*> modfied 8/23/24, implement the axpby case +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE CAXPBY(N,CA,CX,INCX,CB,CY,INCY) +* +* -- Reference BLAS level1 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + COMPLEX CA, CB + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + COMPLEX CX(*),CY(*) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I,IX,IY +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* + DO I = 1,N + CY(I) = CB*CY(I) + CA*CX(I) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + CY(IY) = CB*CY(IY) + CA*CX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF +* + RETURN +* +* End of CAXBPY +* + END diff --git a/BLAS/SRC/daxpby.f b/BLAS/SRC/daxpby.f new file mode 100644 index 000000000..06161d741 --- /dev/null +++ b/BLAS/SRC/daxpby.f @@ -0,0 +1,162 @@ +*> \brief \b DAXPBY +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DAXPBY(N,DA,DX,INCX,DB,DY,INCY) +* +* .. Scalar Arguments .. +* DOUBLE PRECISION DA,DB +* INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. +* DOUBLE PRECISION DX(*),DY(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DAXPBY constant times a vector plus constanttimes a vector. +*> +*> Y = ALPHA * X + BETA * Y +*> +*> uses unrolled loops for increments equal to one. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> number of elements in input vector(s) +*> \endverbatim +*> +*> \param[in] DA +*> \verbatim +*> DA is DOUBLE PRECISION +*> On entry, DA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] DX +*> \verbatim +*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> storage spacing between elements of DX +*> \endverbatim +*> +*> \param[in] DB +*> \verbatim +*> DB is DOUBLE PRECISION +*> On entry, DB specifies the scalar beta. +*> \endverbatim +*> +*> \param[in,out] DY +*> \verbatim +*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> storage spacing between elements of DY +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +*> \author Martin Koehler, MPI Magdeburg +* +*> \ingroup axpby +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> jack dongarra, linpack, 3/11/78. +*> modified 12/3/93, array(1) declarations changed to array(*) +*> modfied 8/23/24, implement the axpby case +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE DAXPBY(N,DA,DX,INCX,DB,DY,INCY) +* +* -- Reference BLAS level1 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + DOUBLE PRECISION DA,DB + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DX(*),DY(*) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + M = MOD(N,4) + IF (M.NE.0) THEN + DO I = 1,M + DY(I) = DB*DY(I) + DA*DX(I) + END DO + END IF + IF (N.LT.4) RETURN + MP1 = M + 1 + DO I = MP1,N,4 + DY(I) = DB*DY(I) + DA*DX(I) + DY(I+1) = DB*DY(I+1) + DA*DX(I+1) + DY(I+2) = DB*DY(I+2) + DA*DX(I+2) + DY(I+3) = DB*DY(I+3) + DA*DX(I+3) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + DY(IY) = DB*DY(IY) + DA*DX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF + RETURN +* +* End of DAXPBY +* + END diff --git a/BLAS/SRC/saxpby.f b/BLAS/SRC/saxpby.f new file mode 100644 index 000000000..9a33e0367 --- /dev/null +++ b/BLAS/SRC/saxpby.f @@ -0,0 +1,162 @@ +*> \brief \b SAXPBY +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE SAXPBY(N,SA,SX,INCX,SB,SY,INCY) +* +* .. Scalar Arguments .. +* REAL SA,SB +* INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. +* REAL SX(*),SY(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SAXPBY constant times a vector plus constanttimes a vector. +*> +*> Y = ALPHA * X + BETA * Y +*> +*> uses unrolled loops for increments equal to one. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> number of elements in input vector(s) +*> \endverbatim +*> +*> \param[in] SA +*> \verbatim +*> SA is REAL +*> On entry, SA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] SX +*> \verbatim +*> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> storage spacing between elements of SX +*> \endverbatim +*> +*> \param[in] SB +*> \verbatim +*> SB is REAL +*> On entry, SB specifies the scalar beta. +*> \endverbatim +*> +*> \param[in,out] SY +*> \verbatim +*> SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> storage spacing between elements of SY +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +*> \author Martin Koehler, MPI Magdeburg +* +*> \ingroup axpby +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> jack dongarra, linpack, 3/11/78. +*> modified 12/3/93, array(1) declarations changed to array(*) +*> modfied 8/23/24, implement the axpby case +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE SAXPBY(N,SA,SX,INCX,SB,SY,INCY) +* +* -- Reference BLAS level1 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + REAL SA,SB + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + REAL SX(*),SY(*) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I,IX,IY,M,MP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC MOD +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* +* +* clean-up loop +* + M = MOD(N,4) + IF (M.NE.0) THEN + DO I = 1,M + SY(I) = SB*SY(I) + SA*SX(I) + END DO + END IF + IF (N.LT.4) RETURN + MP1 = M + 1 + DO I = MP1,N,4 + SY(I) = SB*SY(I) + SA*SX(I) + SY(I+1) = SB*SY(I+1) + SA*SX(I+1) + SY(I+2) = SB*SY(I+2) + SA*SX(I+2) + SY(I+3) = SB*SY(I+3) + SA*SX(I+3) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + SY(IY) = SB*SY(IY) + SA*SX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF + RETURN +* +* End of SAXPY +* + END diff --git a/BLAS/SRC/zaxpby.f b/BLAS/SRC/zaxpby.f new file mode 100644 index 000000000..5dec73785 --- /dev/null +++ b/BLAS/SRC/zaxpby.f @@ -0,0 +1,145 @@ +*> \brief \b ZAXPBY +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE ZAXPBY(N,ZA,ZX,INCX,ZB,ZY,INCY) +* +* .. Scalar Arguments .. +* COMPLEX*16 ZA,ZB +* INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. +* COMPLEX*16 ZX(*),ZY(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZAXPBY constant times a vector plus constanttimes a vector. +*> +*> Y = ALPHA * X + BETA * Y +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> number of elements in input vector(s) +*> \endverbatim +*> +*> \param[in] ZA +*> \verbatim +*> ZA is COMPLEX*16 +*> On entry, ZA specifies the scalar alpha. +*> \endverbatim +*> +*> \param[in] ZX +*> \verbatim +*> ZX is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> storage spacing between elements of ZX +*> \endverbatim +*> +*> \param[in] ZB +*> \verbatim +*> ZB is COMPLEX*16 +*> On entry, ZB specifies the scalar beta. +*> \endverbatim +*> +*> \param[in,out] ZY +*> \verbatim +*> ZY is COMPLEX*16 array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> storage spacing between elements of ZY +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +*> \author Martin Koehler, MPI Magdeburg +* +*> \ingroup axpby +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> jack dongarra, 3/11/78. +*> modified 12/3/93, array(1) declarations changed to array(*) +*> modfied 8/23/24, implement the axpby case +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE ZAXPBY(N,ZA,ZX,INCX,ZB,ZY,INCY) +* +* -- Reference BLAS level1 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + COMPLEX*16 ZA,ZB + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + COMPLEX*16 ZX(*),ZY(*) +* .. +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I,IX,IY +* .. + IF (N.LE.0) RETURN + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN +* +* code for both increments equal to 1 +* + DO I = 1,N + ZY(I) = ZB*ZY(I) + ZA*ZX(I) + END DO + ELSE +* +* code for unequal increments or equal increments +* not equal to 1 +* + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + ZY(IY) = ZB*ZY(IY) + ZA*ZX(IX) + IX = IX + INCX + IY = IY + INCY + END DO + END IF +* + RETURN +* +* End of ZAXBPY +* + END diff --git a/BLAS/TESTING/cblat1.f b/BLAS/TESTING/cblat1.f index 82798fe0b..fe3580c49 100644 --- a/BLAS/TESTING/cblat1.f +++ b/BLAS/TESTING/cblat1.f @@ -58,7 +58,7 @@ PROGRAM CBLAT1 DATA SFAC/9.765625E-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -71,7 +71,7 @@ PROGRAM CBLAT1 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5) THEN + IF (ICASE.LE.5 .OR. ICASE.EQ.11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) @@ -95,7 +95,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*6 L(10) + CHARACTER*6 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. @@ -109,6 +109,8 @@ SUBROUTINE HEADER DATA L(8)/'CSCAL '/ DATA L(9)/'CSSCAL'/ DATA L(10)/'ICAMAX'/ + DATA L(11)/'CAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -354,26 +356,27 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - COMPLEX CA + COMPLEX CA, CB INTEGER I, J, KI, KN, KSIZE, LENX, LENY, LINCX, LINCY, + MX, MY * .. Local Arrays .. COMPLEX CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14), + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4), + CT8(7,4,4), CTY0(1), CX(7), CX0(1), CX1(7), - + CY(7), CY0(1), CY1(7) + + CY(7), CY0(1), CY1(7), CT11(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. COMPLEX CDOTC, CDOTU EXTERNAL CDOTC, CDOTU * .. External Subroutines .. - EXTERNAL CAXPY, CCOPY, CSWAP, CTEST + EXTERNAL CAXPY, CAXPBY, CCOPY, CSWAP, CTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA CA/(0.4E0,-0.7E0)/ + DATA CB/(0.7E0,-0.4E0)/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -543,6 +546,53 @@ SUBROUTINE CHECK2(SFAC) + (1.54E0,1.54E0), (1.54E0,1.54E0), + (1.54E0,1.54E0), (1.54E0,1.54E0), + (1.54E0,1.54E0), (1.54E0,1.54E0)/ + + DATA ((CT11(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.1E0,-1.47E0), + + (-1.08E0,0.71E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (-1.08E0,0.71E0), + + (-0.42E0,-0.99E0), (-0.61E0,-0.85E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ + DATA ((CT11(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.49E0,-0.95E0), + + (-0.9E0,0.5E0),(-0.03E0,-1.51E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.36E0,0.00E0), (-0.9E0,0.5E0), + + (-0.39E0,-0.23E0), (0.1E0,-0.5E0), + + (-0.82E0,-0.39E0), (-0.5E0,-0.3E0), + + (0.0E0,-1.62E0)/ + DATA ((CT11(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.49E0,-0.95E0), + + (-0.71E0,-0.1E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.36E0,0.00E0), (-1.07E0,1.18E0), + + (-0.42E0,-0.99E0), (-0.41E0,-1.2E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ + DATA ((CT11(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.1E0,-1.47E0), (-0.9E0,0.5E0), + + (-0.4E0,-0.7E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.1E0,-1.47E0), + + (-0.9E0,0.5E0),(-0.4E0,-0.7E0), (0.1E0,-0.5E0), + + (-0.82E0,-0.39E0), (-0.5E0,-0.3E0), + + (-0.2E0,-1.27E0)/ + * .. Executable Statements .. DO 60 KI = 1, 4 INCX = INCXS(KI) @@ -598,6 +648,10 @@ SUBROUTINE CHECK2(SFAC) CALL CSWAP(N,CX,INCX,CY,INCY) CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0E0) CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0) + ELSE IF (ICASE.EQ.11) THEN +* .. CAXBPY .. + CALL CAXPBY(N,CA,CX,INCX,CB,CY,INCY) + CALL CTEST(LENY,CY,CT11(1,KN,KI),CSIZE2(1,KSIZE),SFAC) ELSE WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' STOP diff --git a/BLAS/TESTING/dblat1.f b/BLAS/TESTING/dblat1.f index 95da39d12..6d4c3da0c 100644 --- a/BLAS/TESTING/dblat1.f +++ b/BLAS/TESTING/dblat1.f @@ -58,7 +58,7 @@ PROGRAM DBLAT1 DATA SFAC/9.765625D-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 13 + DO 20 IC = 1, 14 ICASE = IC CALL HEADER * @@ -76,7 +76,8 @@ PROGRAM DBLAT1 + ICASE.EQ.10) THEN CALL CHECK1(SFAC) ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR. - + ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13) THEN + + ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13 .OR. + + ICASE.EQ.14 ) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.EQ.4) THEN CALL CHECK3(SFAC) @@ -100,7 +101,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*6 L(13) + CHARACTER*6 L(14) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS * .. Data statements .. @@ -117,6 +118,8 @@ SUBROUTINE HEADER DATA L(11)/'DROTMG'/ DATA L(12)/'DROTM '/ DATA L(13)/'DSDOT '/ + DATA L(14)/'DAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -374,7 +377,7 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. - DOUBLE PRECISION SA + DOUBLE PRECISION SA, SB INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY, $ LINCX, LINCY, MX, MY * .. Local Arrays .. @@ -386,14 +389,14 @@ SUBROUTINE CHECK2(SFAC) $ DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4), $ DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4), $ DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5), - $ STY0(1), SX0(1), SY0(1) + $ STY0(1), SX0(1), SY0(1), DT20(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. DOUBLE PRECISION DDOT, DSDOT EXTERNAL DDOT, DSDOT * .. External Subroutines .. - EXTERNAL DAXPY, DCOPY, DROTM, DSWAP, STEST, STEST1, - $ TESTDSDOT + EXTERNAL DAXPY, DAXPBY, DCOPY, DROTM, DSWAP, STEST, + $ STEST1, TESTDSDOT * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. @@ -407,6 +410,7 @@ SUBROUTINE CHECK2(SFAC) B (DT19Y(1,1,13),DT19YD(1,1,1)) DATA SA/0.3D0/ + DATA SB/0.5D0/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -622,6 +626,27 @@ SUBROUTINE CHECK2(SFAC) M .7D0, -.9D0, 1.2D0, .7D0, -1.5D0, .2D0, 1.6D0, N 1.7D0, -.9D0, .5D0, .7D0, -1.6D0, .2D0, 2.4D0, O -2.6D0, -.9D0, -1.3D0, .7D0, 2.9D0, .2D0, -4.0D0 / + DATA DT20/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.43D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.43D0, -0.42D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.43D0, -0.42D0, 0.0D0, + + 0.59D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.43D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.1D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.13D0, -0.9D0, 0.42D0, 0.7D0, -0.45D0, + + 0.2D0, 0.58D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.43D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.1D0, -0.27D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.13D0, + + -0.18D0, 0.00D0, 0.53D0, 0.0D0, 0.0D0, 0.0D0, + + 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.43D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.43D0, -0.9D0, 0.18D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.43D0, -0.9D0, 0.18D0, 0.7D0, + + -0.45D0, 0.2D0, 0.64D0/ + + * * .. Executable Statements .. * @@ -653,6 +678,14 @@ SUBROUTINE CHECK2(SFAC) STY(J) = DT8(J,KN,KI) 40 CONTINUE CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.14) THEN +* .. DAXPBY .. + CALL DAXPBY(N,SA,SX,INCX,SB,SY,INCY) + DO 50 J = 1, LENY + STY(J) = DT20(J,KN,KI) + 50 CONTINUE + CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.5) THEN * .. DCOPY .. DO 60 I = 1, 7 diff --git a/BLAS/TESTING/sblat1.f b/BLAS/TESTING/sblat1.f index e68ee09c1..660a294bf 100644 --- a/BLAS/TESTING/sblat1.f +++ b/BLAS/TESTING/sblat1.f @@ -58,7 +58,7 @@ PROGRAM SBLAT1 DATA SFAC/9.765625E-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 13 + DO 20 IC = 1, 14 ICASE = IC CALL HEADER * @@ -76,7 +76,8 @@ PROGRAM SBLAT1 + ICASE.EQ.10) THEN CALL CHECK1(SFAC) ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR. - + ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13) THEN + + ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13 .OR. + + ICASE.EQ.14 ) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.EQ.4) THEN CALL CHECK3(SFAC) @@ -100,7 +101,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*6 L(13) + CHARACTER*6 L(14) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, PASS * .. Data statements .. @@ -117,6 +118,8 @@ SUBROUTINE HEADER DATA L(11)/'SROTMG'/ DATA L(12)/'SROTM '/ DATA L(13)/'SDSDOT'/ + DATA L(14)/'SAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -374,7 +377,7 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, N LOGICAL PASS * .. Local Scalars .. - REAL SA + REAL SA,SB INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY, $ LINCX, LINCY, MX, MY * .. Local Arrays .. @@ -386,13 +389,13 @@ SUBROUTINE CHECK2(SFAC) $ DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4), $ DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4), $ DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5), - $ ST7B(4,4), STY0(1), SX0(1), SY0(1) + $ ST7B(4,4), STY0(1), SX0(1), SY0(1), DT20(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. REAL SDOT, SDSDOT EXTERNAL SDOT, SDSDOT * .. External Subroutines .. - EXTERNAL SAXPY, SCOPY, SROTM, SSWAP, STEST, STEST1 + EXTERNAL SAXPY, SAXPBY,SCOPY, SROTM, SSWAP, STEST, STEST1 * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. @@ -406,6 +409,7 @@ SUBROUTINE CHECK2(SFAC) B (DT19Y(1,1,13),DT19YD(1,1,1)) DATA SA/0.3E0/ + DATA SB/0.5E0/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -624,6 +628,27 @@ SUBROUTINE CHECK2(SFAC) M .7E0, -.9E0, 1.2E0, .7E0, -1.5E0, .2E0, 1.6E0, N 1.7E0, -.9E0, .5E0, .7E0, -1.6E0, .2E0, 2.4E0, O -2.6E0, -.9E0, -1.3E0, .7E0, 2.9E0, .2E0, -4.0E0 / + DATA DT20/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.43E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.43E0, -0.42E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.43E0, -0.42E0, 0.0E0, + + 0.59E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.43E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.1E0, -0.9E0, 0.33E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.13E0, -0.9E0, 0.42E0, 0.7E0, -0.45E0, + + 0.2E0, 0.58E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.43E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.1E0, -0.27E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.13E0, + + -0.18E0, 0.00E0, 0.53E0, 0.0E0, 0.0E0, 0.0E0, + + 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.43E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.43E0, -0.9E0, 0.18E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.43E0, -0.9E0, 0.18E0, 0.7E0, + + -0.45E0, 0.2E0, 0.64E0/ + + * * .. Executable Statements .. * @@ -655,6 +680,14 @@ SUBROUTINE CHECK2(SFAC) STY(J) = DT8(J,KN,KI) 40 CONTINUE CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.14) THEN +* .. SAXPBY .. + CALL SAXPBY(N,SA,SX,INCX,SB,SY,INCY) + DO 50 J = 1, LENY + STY(J) = DT20(J,KN,KI) + 50 CONTINUE + CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.5) THEN * .. SCOPY .. DO 60 I = 1, 7 diff --git a/BLAS/TESTING/zblat1.f b/BLAS/TESTING/zblat1.f index 29daad574..bd21cbbad 100644 --- a/BLAS/TESTING/zblat1.f +++ b/BLAS/TESTING/zblat1.f @@ -58,7 +58,7 @@ PROGRAM ZBLAT1 DATA SFAC/9.765625D-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -71,7 +71,7 @@ PROGRAM ZBLAT1 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5) THEN + IF (ICASE.LE.5 .OR. ICASE.EQ.11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) @@ -95,7 +95,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*6 L(10) + CHARACTER*6 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. @@ -109,6 +109,8 @@ SUBROUTINE HEADER DATA L(8)/'ZSCAL '/ DATA L(9)/'ZDSCAL'/ DATA L(10)/'IZAMAX'/ + DATA L(11)/'ZAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -354,26 +356,27 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - COMPLEX*16 CA + COMPLEX*16 CA, CB INTEGER I, J, KI, KN, KSIZE, LENX, LENY, LINCX, LINCY, + MX, MY * .. Local Arrays .. COMPLEX*16 CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14), + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4), + CT8(7,4,4), CTY0(1), CX(7), CX0(1), CX1(7), - + CY(7), CY0(1), CY1(7) + + CY(7), CY0(1), CY1(7), CT11(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. COMPLEX*16 ZDOTC, ZDOTU EXTERNAL ZDOTC, ZDOTU * .. External Subroutines .. - EXTERNAL ZAXPY, ZCOPY, ZSWAP, CTEST + EXTERNAL ZAXPY, ZAXPBY, ZCOPY, ZSWAP, CTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA CA/(0.4D0,-0.7D0)/ + DATA CB/(0.7D0,-0.4D0)/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -543,6 +546,54 @@ SUBROUTINE CHECK2(SFAC) + (1.54D0,1.54D0), (1.54D0,1.54D0), + (1.54D0,1.54D0), (1.54D0,1.54D0), + (1.54D0,1.54D0), (1.54D0,1.54D0)/ + + DATA ((CT11(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.1D0,-1.47D0), + + (-1.08D0,0.71D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (-1.08D0,0.71D0), + + (-0.42D0,-0.99D0), (-0.61D0,-0.85D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ + DATA ((CT11(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.49D0,-0.95D0), + + (-0.9D0,0.5D0),(-0.03D0,-1.51D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.36D0,0.00D0), (-0.9D0,0.5D0), + + (-0.39D0,-0.23D0), (0.1D0,-0.5D0), + + (-0.82D0,-0.39D0), (-0.5D0,-0.3D0), + + (0.0D0,-1.62D0)/ + DATA ((CT11(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.49D0,-0.95D0), + + (-0.71D0,-0.1D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.36D0,0.00D0), (-1.07D0,1.18D0), + + (-0.42D0,-0.99D0), (-0.41D0,-1.2D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ + DATA ((CT11(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.1D0,-1.47D0), (-0.9D0,0.5D0), + + (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.1D0,-1.47D0), + + (-0.9D0,0.5D0),(-0.4D0,-0.7D0), (0.1D0,-0.5D0), + + (-0.82D0,-0.39D0), (-0.5D0,-0.3D0), + + (-0.2D0,-1.27D0)/ + + * .. Executable Statements .. DO 60 KI = 1, 4 INCX = INCXS(KI) @@ -598,6 +649,10 @@ SUBROUTINE CHECK2(SFAC) CALL ZSWAP(N,CX,INCX,CY,INCY) CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0D0) CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0) + ELSE IF (ICASE.EQ.11) THEN +* .. ZAXPY .. + CALL ZAXPBY(N,CA,CX,INCX,CB, CY,INCY) + CALL CTEST(LENY,CY,CT11(1,KN,KI),CSIZE2(1,KSIZE),SFAC) ELSE WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' STOP diff --git a/CBLAS/include/cblas.h b/CBLAS/include/cblas.h index b8baf4eca..af86cc688 100644 --- a/CBLAS/include/cblas.h +++ b/CBLAS/include/cblas.h @@ -130,6 +130,8 @@ void cblas_scopy(const CBLAS_INT N, const float *X, const CBLAS_INT incX, float *Y, const CBLAS_INT incY); void cblas_saxpy(const CBLAS_INT N, const float alpha, const float *X, const CBLAS_INT incX, float *Y, const CBLAS_INT incY); +void cblas_saxpby(const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float beta, float *Y, const CBLAS_INT incY); void cblas_dswap(const CBLAS_INT N, double *X, const CBLAS_INT incX, double *Y, const CBLAS_INT incY); @@ -137,6 +139,8 @@ void cblas_dcopy(const CBLAS_INT N, const double *X, const CBLAS_INT incX, double *Y, const CBLAS_INT incY); void cblas_daxpy(const CBLAS_INT N, const double alpha, const double *X, const CBLAS_INT incX, double *Y, const CBLAS_INT incY); +void cblas_daxpby(const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, const double beta, double *Y, const CBLAS_INT incY); void cblas_cswap(const CBLAS_INT N, void *X, const CBLAS_INT incX, void *Y, const CBLAS_INT incY); @@ -144,6 +148,8 @@ void cblas_ccopy(const CBLAS_INT N, const void *X, const CBLAS_INT incX, void *Y, const CBLAS_INT incY); void cblas_caxpy(const CBLAS_INT N, const void *alpha, const void *X, const CBLAS_INT incX, void *Y, const CBLAS_INT incY); +void cblas_caxpby(const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY); void cblas_zswap(const CBLAS_INT N, void *X, const CBLAS_INT incX, void *Y, const CBLAS_INT incY); @@ -151,6 +157,8 @@ void cblas_zcopy(const CBLAS_INT N, const void *X, const CBLAS_INT incX, void *Y, const CBLAS_INT incY); void cblas_zaxpy(const CBLAS_INT N, const void *alpha, const void *X, const CBLAS_INT incX, void *Y, const CBLAS_INT incY); +void cblas_zaxpby(const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY); /* diff --git a/CBLAS/include/cblas_64.h b/CBLAS/include/cblas_64.h index 16504d914..ddcd8f7aa 100644 --- a/CBLAS/include/cblas_64.h +++ b/CBLAS/include/cblas_64.h @@ -81,6 +81,9 @@ void cblas_scopy_64(const int64_t N, const float *X, const int64_t incX, float *Y, const int64_t incY); void cblas_saxpy_64(const int64_t N, const float alpha, const float *X, const int64_t incX, float *Y, const int64_t incY); +void cblas_saxpby_64(const int64_t N, const float alpha, const float *X, + const int64_t incX, const float beta, float *Y, const int64_t incY); + void cblas_dswap_64(const int64_t N, double *X, const int64_t incX, double *Y, const int64_t incY); @@ -88,6 +91,8 @@ void cblas_dcopy_64(const int64_t N, const double *X, const int64_t incX, double *Y, const int64_t incY); void cblas_daxpy_64(const int64_t N, const double alpha, const double *X, const int64_t incX, double *Y, const int64_t incY); +void cblas_daxpby_64(const int64_t N, const double alpha, const double *X, + const int64_t incX, const double beta, double *Y, const int64_t incY); void cblas_cswap_64(const int64_t N, void *X, const int64_t incX, void *Y, const int64_t incY); @@ -95,6 +100,8 @@ void cblas_ccopy_64(const int64_t N, const void *X, const int64_t incX, void *Y, const int64_t incY); void cblas_caxpy_64(const int64_t N, const void *alpha, const void *X, const int64_t incX, void *Y, const int64_t incY); +void cblas_caxpby_64(const int64_t N, const void *alpha, const void *X, + const int64_t incX, const void *beta, void *Y, const int64_t incY); void cblas_zswap_64(const int64_t N, void *X, const int64_t incX, void *Y, const int64_t incY); @@ -102,6 +109,8 @@ void cblas_zcopy_64(const int64_t N, const void *X, const int64_t incX, void *Y, const int64_t incY); void cblas_zaxpy_64(const int64_t N, const void *alpha, const void *X, const int64_t incX, void *Y, const int64_t incY); +void cblas_zaxbpy_64(const int64_t N, const void *alpha, const void *X, + const int64_t incX, const void *beta, void *Y, const int64_t incY); /* diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h index 4880690f6..a251f3079 100644 --- a/CBLAS/include/cblas_f77.h +++ b/CBLAS/include/cblas_f77.h @@ -76,18 +76,22 @@ #define F77_sswap_base F77_GLOBAL_SUFFIX(sswap,SSWAP) #define F77_scopy_base F77_GLOBAL_SUFFIX(scopy,SCOPY) #define F77_saxpy_base F77_GLOBAL_SUFFIX(saxpy,SAXPY) +#define F77_saxpby_base F77_GLOBAL_SUFFIX(saxpby,SAXPBY) #define F77_isamax_sub_base F77_GLOBAL_SUFFIX(isamaxsub,ISAMAXSUB) #define F77_dswap_base F77_GLOBAL_SUFFIX(dswap,DSWAP) #define F77_dcopy_base F77_GLOBAL_SUFFIX(dcopy,DCOPY) #define F77_daxpy_base F77_GLOBAL_SUFFIX(daxpy,DAXPY) +#define F77_daxpby_base F77_GLOBAL_SUFFIX(daxpby,DAXPBY) #define F77_idamax_sub_base F77_GLOBAL_SUFFIX(idamaxsub,IDAMAXSUB) #define F77_cswap_base F77_GLOBAL_SUFFIX(cswap,CSWAP) #define F77_ccopy_base F77_GLOBAL_SUFFIX(ccopy,CCOPY) #define F77_caxpy_base F77_GLOBAL_SUFFIX(caxpy,CAXPY) +#define F77_caxpby_base F77_GLOBAL_SUFFIX(caxpby,CAXPBY) #define F77_icamax_sub_base F77_GLOBAL_SUFFIX(icamaxsub,ICAMAXSUB) #define F77_zswap_base F77_GLOBAL_SUFFIX(zswap,ZSWAP) #define F77_zcopy_base F77_GLOBAL_SUFFIX(zcopy,ZCOPY) #define F77_zaxpy_base F77_GLOBAL_SUFFIX(zaxpy,ZAXPY) +#define F77_zaxpby_base F77_GLOBAL_SUFFIX(zaxpby,ZAXPBY) #define F77_izamax_sub_base F77_GLOBAL_SUFFIX(izamaxsub,IZAMAXSUB) #define F77_sdot_sub_base F77_GLOBAL_SUFFIX(sdotsub,SDOTSUB) #define F77_ddot_sub_base F77_GLOBAL_SUFFIX(ddotsub,DDOTSUB) @@ -239,6 +243,7 @@ #define F77_sswap(...) F77_sswap_base(__VA_ARGS__) #define F77_scopy(...) F77_scopy_base(__VA_ARGS__) #define F77_saxpy(...) F77_saxpy_base(__VA_ARGS__) +#define F77_saxpby(...) F77_saxpby_base(__VA_ARGS__) #define F77_sdot_sub(...) F77_sdot_sub_base(__VA_ARGS__) #define F77_sdsdot_sub(...) F77_sdsdot_sub_base(__VA_ARGS__) #define F77_sscal(...) F77_sscal_base(__VA_ARGS__) @@ -256,6 +261,7 @@ #define F77_dswap(...) F77_dswap_base(__VA_ARGS__) #define F77_dcopy(...) F77_dcopy_base(__VA_ARGS__) #define F77_daxpy(...) F77_daxpy_base(__VA_ARGS__) +#define F77_daxpby(...) F77_daxpby_base(__VA_ARGS__) #define F77_dswap(...) F77_dswap_base(__VA_ARGS__) #define F77_dsdot_sub(...) F77_dsdot_sub_base(__VA_ARGS__) #define F77_ddot_sub(...) F77_ddot_sub_base(__VA_ARGS__) @@ -272,6 +278,7 @@ #define F77_cswap(...) F77_cswap_base(__VA_ARGS__) #define F77_ccopy(...) F77_ccopy_base(__VA_ARGS__) #define F77_caxpy(...) F77_caxpy_base(__VA_ARGS__) +#define F77_caxpby(...) F77_caxpby_base(__VA_ARGS__) #define F77_cswap(...) F77_cswap_base(__VA_ARGS__) #define F77_cdotc_sub(...) F77_cdotc_sub_base(__VA_ARGS__) #define F77_cdotu_sub(...) F77_cdotu_sub_base(__VA_ARGS__) @@ -288,6 +295,7 @@ #define F77_zswap(...) F77_zswap_base(__VA_ARGS__) #define F77_zcopy(...) F77_zcopy_base(__VA_ARGS__) #define F77_zaxpy(...) F77_zaxpy_base(__VA_ARGS__) +#define F77_zaxpby(...) F77_zaxpby_base(__VA_ARGS__) #define F77_zswap(...) F77_zswap_base(__VA_ARGS__) #define F77_zdotc_sub(...) F77_zdotc_sub_base(__VA_ARGS__) #define F77_zdotu_sub(...) F77_zdotu_sub_base(__VA_ARGS__) @@ -602,6 +610,7 @@ void F77_srotmg_base(float *,float *,float *,const float *, float *); void F77_sswap_base(FINT, float *, FINT, float *, FINT); void F77_scopy_base(FINT, const float *, FINT, float *, FINT); void F77_saxpy_base(FINT, const float *, const float *, FINT, float *, FINT); +void F77_saxpby_base(FINT, const float *, const float *, FINT, const float *, float *, FINT); void F77_sdot_sub_base(FINT, const float *, FINT, const float *, FINT, float *); void F77_sdsdot_sub_base(FINT, const float *, const float *, FINT, const float *, FINT, float *); void F77_sscal_base(FINT, const float *, float *, FINT); @@ -618,6 +627,7 @@ void F77_drotmg_base(double *,double *,double *,const double *, double *); void F77_dswap_base(FINT, double *, FINT, double *, FINT); void F77_dcopy_base(FINT, const double *, FINT, double *, FINT); void F77_daxpy_base(FINT, const double *, const double *, FINT, double *, FINT); +void F77_daxpby_base(FINT, const double *, const double *, FINT, const double *, double *, FINT); void F77_dswap_base(FINT, double *, FINT, double *, FINT); void F77_dsdot_sub_base(FINT, const float *, FINT, const float *, FINT, double *); void F77_ddot_sub_base(FINT, const double *, FINT, const double *, FINT, double *); @@ -633,6 +643,7 @@ void F77_csrot_base(FINT, void *X, FINT, void *, FINT, const float *, const floa void F77_cswap_base(FINT, void *, FINT, void *, FINT); void F77_ccopy_base(FINT, const void *, FINT, void *, FINT); void F77_caxpy_base(FINT, const void *, const void *, FINT, void *, FINT); +void F77_caxpby_base(FINT, const void *, const void *, FINT, const void *, void *, FINT); void F77_cswap_base(FINT, void *, FINT, void *, FINT); void F77_cdotc_sub_base(FINT, const void *, FINT, const void *, FINT, void *); void F77_cdotu_sub_base(FINT, const void *, FINT, const void *, FINT, void *); @@ -650,6 +661,7 @@ void F77_zdrot_base(FINT, void *X, FINT, void *, FINT, const double *, const dou void F77_zswap_base(FINT, void *, FINT, void *, FINT); void F77_zcopy_base(FINT, const void *, FINT, void *, FINT); void F77_zaxpy_base(FINT, const void *, const void *, FINT, void *, FINT); +void F77_zaxpby_base(FINT, const void *, const void *, FINT, const void*, void *, FINT); void F77_zswap_base(FINT, void *, FINT, void *, FINT); void F77_zdotc_sub_base(FINT, const void *, FINT, const void *, FINT, void *); void F77_zdotu_sub_base(FINT, const void *, FINT, const void *, FINT, void *); diff --git a/CBLAS/include/cblas_test.h b/CBLAS/include/cblas_test.h index 4374cb378..32f939480 100644 --- a/CBLAS/include/cblas_test.h +++ b/CBLAS/include/cblas_test.h @@ -45,18 +45,22 @@ typedef struct { double real; double imag; } CBLAS_TEST_ZOMPLEX; #define F77_sswap F77_GLOBAL(sswaptest,SSWAPTEST) #define F77_scopy F77_GLOBAL(scopytest,SCOPYTEST) #define F77_saxpy F77_GLOBAL(saxpytest,SAXPYTEST) +#define F77_saxpby F77_GLOBAL(saxpbytest,SAXPBYTEST) #define F77_isamax F77_GLOBAL(isamaxtest,ISAMAXTEST) #define F77_dswap F77_GLOBAL(dswaptest,DSWAPTEST) #define F77_dcopy F77_GLOBAL(dcopytest,DCOPYTEST) #define F77_daxpy F77_GLOBAL(daxpytest,DAXPYTEST) +#define F77_daxpby F77_GLOBAL(daxpbytest,DAXPBYTEST) #define F77_idamax F77_GLOBAL(idamaxtest,IDAMAXTEST) #define F77_cswap F77_GLOBAL(cswaptest,CSWAPTEST) #define F77_ccopy F77_GLOBAL(ccopytest,CCOPYTEST) #define F77_caxpy F77_GLOBAL(caxpytest,CAXPYTEST) +#define F77_caxpby F77_GLOBAL(caxpbytest,CAXPBYTEST) #define F77_icamax F77_GLOBAL(icamaxtest,ICAMAXTEST) #define F77_zswap F77_GLOBAL(zswaptest,ZSWAPTEST) #define F77_zcopy F77_GLOBAL(zcopytest,ZCOPYTEST) #define F77_zaxpy F77_GLOBAL(zaxpytest,ZAXPYTEST) +#define F77_zaxpby F77_GLOBAL(zaxpbytest,ZAXPBYTEST) #define F77_izamax F77_GLOBAL(izamaxtest,IZAMAXTEST) #define F77_sdot F77_GLOBAL(sdottest,SDOTTEST) #define F77_ddot F77_GLOBAL(ddottest,DDOTTEST) diff --git a/CBLAS/src/CMakeLists.txt b/CBLAS/src/CMakeLists.txt index 8dcb2f293..87bc07686 100644 --- a/CBLAS/src/CMakeLists.txt +++ b/CBLAS/src/CMakeLists.txt @@ -16,21 +16,21 @@ set(SLEV1 cblas_srotg.c cblas_srotmg.c cblas_srot.c cblas_srotm.c cblas_sswap.c cblas_sscal.c cblas_scopy.c cblas_saxpy.c cblas_sdot.c cblas_sdsdot.c cblas_snrm2.c cblas_sasum.c cblas_isamax.c sdotsub.f sdsdotsub.f snrm2sub.f sasumsub.f - isamaxsub.f) + isamaxsub.f cblas_saxpby.c) # Files for level 1 double precision real set(DLEV1 cblas_drotg.c cblas_drotmg.c cblas_drot.c cblas_drotm.c cblas_dswap.c cblas_dscal.c cblas_dcopy.c cblas_daxpy.c cblas_ddot.c cblas_dsdot.c cblas_dnrm2.c cblas_dasum.c cblas_idamax.c ddotsub.f dsdotsub.f dnrm2sub.f - dasumsub.f idamaxsub.f) + dasumsub.f idamaxsub.f cblas_daxpby.c) # Files for level 1 single precision complex set(CLEV1 cblas_crotg.c cblas_csrot.c cblas_cswap.c cblas_cscal.c cblas_csscal.c cblas_ccopy.c cblas_caxpy.c cblas_cdotu_sub.c cblas_cdotc_sub.c cblas_icamax.c cdotcsub.f cdotusub.f icamaxsub.f - cblas_scabs1.c scabs1sub.f ) + cblas_scabs1.c scabs1sub.f cblas_caxpby.c) # Files for level 1 double precision complex set(ZLEV1 cblas_zrotg.c cblas_zdrot.c @@ -38,7 +38,7 @@ set(ZLEV1 cblas_zrotg.c cblas_zdrot.c cblas_zaxpy.c cblas_zdotu_sub.c cblas_zdotc_sub.c cblas_dznrm2.c cblas_dzasum.c cblas_izamax.c zdotcsub.f zdotusub.f dzasumsub.f dznrm2sub.f izamaxsub.f - cblas_dcabs1.c dcabs1sub.f) + cblas_dcabs1.c dcabs1sub.f cblas_zaxpby.c) # Common files for level 1 single precision set(SCLEV1 cblas_scasum.c scasumsub.f cblas_scnrm2.c scnrm2sub.f) diff --git a/CBLAS/src/Makefile b/CBLAS/src/Makefile index abc3192c6..9583a0844 100644 --- a/CBLAS/src/Makefile +++ b/CBLAS/src/Makefile @@ -26,21 +26,21 @@ slev1 = cblas_srotg.o cblas_srotmg.o cblas_srot.o cblas_srotm.o \ cblas_sswap.o cblas_sscal.o cblas_scopy.o cblas_saxpy.o \ cblas_sdot.o cblas_sdsdot.o cblas_snrm2.o cblas_sasum.o \ cblas_isamax.o sdotsub.o sdsdotsub.o snrm2sub.o sasumsub.o \ - isamaxsub.o + isamaxsub.o cblas_saxpby.o # Files for level 1 double precision real dlev1 = cblas_drotg.o cblas_drotmg.o cblas_drot.o cblas_drotm.o \ cblas_dswap.o cblas_dscal.o cblas_dcopy.o cblas_daxpy.o \ cblas_ddot.o cblas_dsdot.o cblas_dnrm2.o cblas_dasum.o \ cblas_idamax.o ddotsub.o dsdotsub.o dnrm2sub.o \ - dasumsub.o idamaxsub.o + dasumsub.o idamaxsub.o cblas_daxpby.o # Files for level 1 single precision complex clev1 = cblas_crotg.o cblas_csrot.o \ cblas_cswap.o cblas_cscal.o cblas_csscal.o cblas_ccopy.o \ cblas_caxpy.o cblas_cdotu_sub.o cblas_cdotc_sub.o \ cblas_icamax.o cdotcsub.o cdotusub.o icamaxsub.o \ - cblas_scabs1.o scabs1sub.o + cblas_scabs1.o scabs1sub.o cblas_caxpby.o # Files for level 1 double precision complex zlev1 = cblas_zrotg.o cblas_zdrot.o \ @@ -48,7 +48,7 @@ zlev1 = cblas_zrotg.o cblas_zdrot.o \ cblas_zaxpy.o cblas_zdotu_sub.o cblas_zdotc_sub.o cblas_dznrm2.o \ cblas_dzasum.o cblas_izamax.o zdotcsub.o zdotusub.o \ dzasumsub.o dznrm2sub.o izamaxsub.o \ - cblas_dcabs1.o dcabs1sub.o + cblas_dcabs1.o dcabs1sub.o cblas_zaxpby.o # Common files for level 1 single precision sclev1 = cblas_scasum.o scasumsub.o cblas_scnrm2.o scnrm2sub.o diff --git a/CBLAS/src/cblas_caxpby.c b/CBLAS/src/cblas_caxpby.c new file mode 100644 index 000000000..997ba3c95 --- /dev/null +++ b/CBLAS/src/cblas_caxpby.c @@ -0,0 +1,22 @@ +/* + * cblas_caxpby.c + * + * The program is a C interface to caxpby. + * + * Written by Martin Koehler. 08/26/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_caxpby)( const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_caxpby( &F77_N, alpha, X, &F77_incX, beta, Y, &F77_incY); +} diff --git a/CBLAS/src/cblas_daxpby.c b/CBLAS/src/cblas_daxpby.c new file mode 100644 index 000000000..a4df63524 --- /dev/null +++ b/CBLAS/src/cblas_daxpby.c @@ -0,0 +1,22 @@ +/* + * cblas_daxpby.c + * + * The program is a C interface to daxpby. + * + * Written by Martin Koehler. 08/26/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_daxpby)( const CBLAS_INT N, const double alpha, const double *X, + const CBLAS_INT incX, const double beta, double *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_daxpby( &F77_N, &alpha, X, &F77_incX, &beta, Y, &F77_incY); +} diff --git a/CBLAS/src/cblas_saxpby.c b/CBLAS/src/cblas_saxpby.c new file mode 100644 index 000000000..b8e025d76 --- /dev/null +++ b/CBLAS/src/cblas_saxpby.c @@ -0,0 +1,23 @@ +/* + * cblas_saxpby.c + * + * The program is a C interface to saxpby. + * It calls the fortran wrapper before calling saxpby. + * + * Written by Martin Koehler, 08/24/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_saxpby)( const CBLAS_INT N, const float alpha, const float *X, + const CBLAS_INT incX, const float beta, float *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_saxpby( &F77_N, &alpha, X, &F77_incX, &beta, Y, &F77_incY); +} diff --git a/CBLAS/src/cblas_zaxpby.c b/CBLAS/src/cblas_zaxpby.c new file mode 100644 index 000000000..3aebecac8 --- /dev/null +++ b/CBLAS/src/cblas_zaxpby.c @@ -0,0 +1,22 @@ +/* + * cblas_zaxpby.c + * + * The program is a C interface to zaxpby. + * + * Written by Martin Koehler, 08/26/2024 + * + */ +#include "cblas.h" +#include "cblas_f77.h" +void API_SUFFIX(cblas_zaxpby)( const CBLAS_INT N, const void *alpha, const void *X, + const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY) +{ +#ifdef F77_INT + F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; +#else + #define F77_N N + #define F77_incX incX + #define F77_incY incY +#endif + F77_zaxpby( &F77_N, alpha, X, &F77_incX, beta, Y, &F77_incY); +} diff --git a/CBLAS/testing/c_cblas1.c b/CBLAS/testing/c_cblas1.c index 75b5b7383..ddfd84490 100644 --- a/CBLAS/testing/c_cblas1.c +++ b/CBLAS/testing/c_cblas1.c @@ -15,6 +15,14 @@ void F77_caxpy(const CBLAS_INT *N, const void *alpha, void *X, return; } +void F77_caxpby(const CBLAS_INT *N, const void *alpha, void *X, + const CBLAS_INT *incX, const void *beta, void *Y, const CBLAS_INT *incY) +{ + cblas_caxpby(*N, alpha, X, *incX, beta, Y, *incY); + return; +} + + void F77_ccopy(const CBLAS_INT *N, void *X, const CBLAS_INT *incX, void *Y, const CBLAS_INT *incY) { diff --git a/CBLAS/testing/c_cblat1.f b/CBLAS/testing/c_cblat1.f index 1a123d74d..c060af641 100644 --- a/CBLAS/testing/c_cblat1.f +++ b/CBLAS/testing/c_cblat1.f @@ -19,7 +19,7 @@ PROGRAM CCBLAT1 DATA SFAC/9.765625E-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -32,7 +32,7 @@ PROGRAM CCBLAT1 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5) THEN + IF (ICASE.LE.5 .OR. ICASE.EQ.11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) @@ -53,7 +53,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*15 L(10) + CHARACTER*15 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. @@ -67,6 +67,8 @@ SUBROUTINE HEADER DATA L(8)/'CBLAS_CSCAL'/ DATA L(9)/'CBLAS_CSSCAL'/ DATA L(10)/'CBLAS_ICAMAX'/ + DATA L(11)/'CBLAS_CAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -284,23 +286,26 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - COMPLEX CA,CTEMP + COMPLEX CA,CB,CTEMP INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY * .. Local Arrays .. COMPLEX CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14), + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4), - + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7) + + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7), + + CT11(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. EXTERNAL CDOTCTEST, CDOTUTEST * .. External Subroutines .. - EXTERNAL CAXPYTEST, CCOPYTEST, CSWAPTEST, CTEST + EXTERNAL CAXPYTEST, CCOPYTEST, CSWAPTEST, CTEST, + + CAXPBYTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA CA/(0.4E0,-0.7E0)/ + DATA CB/(0.7E0,-0.4E0)/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -470,6 +475,54 @@ SUBROUTINE CHECK2(SFAC) + (1.54E0,1.54E0), (1.54E0,1.54E0), + (1.54E0,1.54E0), (1.54E0,1.54E0), + (1.54E0,1.54E0), (1.54E0,1.54E0)/ + + DATA ((CT11(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.1E0,-1.47E0), + + (-1.08E0,0.71E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (-1.08E0,0.71E0), + + (-0.42E0,-0.99E0), (-0.61E0,-0.85E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ + DATA ((CT11(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.49E0,-0.95E0), + + (-0.9E0,0.5E0),(-0.03E0,-1.51E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.36E0,0.00E0), (-0.9E0,0.5E0), + + (-0.39E0,-0.23E0), (0.1E0,-0.5E0), + + (-0.82E0,-0.39E0), (-0.5E0,-0.3E0), + + (0.0E0,-1.62E0)/ + DATA ((CT11(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.49E0,-0.95E0), + + (-0.71E0,-0.1E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.36E0,0.00E0), (-1.07E0,1.18E0), + + (-0.42E0,-0.99E0), (-0.41E0,-1.2E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/ + DATA ((CT11(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (-0.1E0,-1.47E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (-0.1E0,-1.47E0), (-0.9E0,0.5E0), + + (-0.4E0,-0.7E0), (0.0E0,0.0E0), (0.0E0,0.0E0), + + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.1E0,-1.47E0), + + (-0.9E0,0.5E0),(-0.4E0,-0.7E0), (0.1E0,-0.5E0), + + (-0.82E0,-0.39E0), (-0.5E0,-0.3E0), + + (-0.2E0,-1.27E0)/ + + * .. Executable Statements .. DO 60 KI = 1, 4 INCX = INCXS(KI) @@ -510,6 +563,10 @@ SUBROUTINE CHECK2(SFAC) CALL CSWAPTEST(N,CX,INCX,CY,INCY) CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0E0) CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0) + ELSE IF (ICASE.EQ.11) THEN +* .. CAXPBYTEST .. + CALL CAXPBYTEST(N,CA,CX,INCX,CB,CY,INCY) + CALL CTEST(LENY,CY,CT11(1,KN,KI),CSIZE2(1,KSIZE),SFAC) ELSE WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' STOP diff --git a/CBLAS/testing/c_dblas1.c b/CBLAS/testing/c_dblas1.c index cf03549fa..ee120af59 100644 --- a/CBLAS/testing/c_dblas1.c +++ b/CBLAS/testing/c_dblas1.c @@ -20,6 +20,14 @@ void F77_daxpy(const CBLAS_INT *N, const double *alpha, const double *X, return; } +void F77_daxpby(const CBLAS_INT *N, const double *alpha, const double *X, + const CBLAS_INT *incX, const double *beta, double *Y, const CBLAS_INT *incY) +{ + cblas_daxpby(*N, *alpha, X, *incX, *beta, Y, *incY); + return; +} + + void F77_dcopy(const CBLAS_INT *N, double *X, const CBLAS_INT *incX, double *Y, const CBLAS_INT *incY) { diff --git a/CBLAS/testing/c_dblat1.f b/CBLAS/testing/c_dblat1.f index 4a71b4dcf..cda3813e0 100644 --- a/CBLAS/testing/c_dblat1.f +++ b/CBLAS/testing/c_dblat1.f @@ -19,7 +19,7 @@ PROGRAM DCBLAT1 DATA SFAC/9.765625D-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -38,7 +38,7 @@ PROGRAM DCBLAT1 + ICASE.EQ.10) THEN CALL CHECK1(SFAC) ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR. - + ICASE.EQ.6) THEN + + ICASE.EQ.6 .OR. ICASE.EQ.11 ) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.EQ.4) THEN CALL CHECK3(SFAC) @@ -59,7 +59,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*15 L(10) + CHARACTER*15 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. @@ -73,6 +73,8 @@ SUBROUTINE HEADER DATA L(8)/'CBLAS_DASUM '/ DATA L(9)/'CBLAS_DSCAL '/ DATA L(10)/'CBLAS_IDAMAX'/ + DATA L(11)/'CBLAS_DAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -244,25 +246,27 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - DOUBLE PRECISION SA + DOUBLE PRECISION SA, SB INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY * .. Local Arrays .. DOUBLE PRECISION DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4), + DT8(7,4,4), DX1(7), + DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7), - + SX(7), SY(7) + + SX(7), SY(7), DT20(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. EXTERNAL DDOTTEST DOUBLE PRECISION DDOTTEST * .. External Subroutines .. EXTERNAL DAXPYTEST, DCOPYTEST, DSWAPTEST, STEST, STEST1 + + DAXPBYTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA SA/0.3D0/ + DATA SB/0.5D0/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -335,6 +339,27 @@ SUBROUTINE CHECK2(SFAC) + 0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, + 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, + 1.17D0, 1.17D0, 1.17D0/ + DATA DT20/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.43D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.43D0, -0.42D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.43D0, -0.42D0, 0.0D0, + + 0.59D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.43D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.1D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.13D0, -0.9D0, 0.42D0, 0.7D0, -0.45D0, + + 0.2D0, 0.58D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.43D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.1D0, -0.27D0, + + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.13D0, + + -0.18D0, 0.00D0, 0.53D0, 0.0D0, 0.0D0, 0.0D0, + + 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.43D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + + 0.0D0, 0.43D0, -0.9D0, 0.18D0, 0.0D0, 0.0D0, + + 0.0D0, 0.0D0, 0.43D0, -0.9D0, 0.18D0, 0.7D0, + + -0.45D0, 0.2D0, 0.64D0/ + + * .. Executable Statements .. * DO 120 KI = 1, 4 @@ -365,6 +390,14 @@ SUBROUTINE CHECK2(SFAC) STY(J) = DT8(J,KN,KI) 40 CONTINUE CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.11) THEN +* .. DAXPBYTEST .. + CALL DAXPBYTEST(N,SA,SX,INCX,SB,SY,INCY) + DO 50 J = 1, LENY + STY(J) = DT20(J,KN,KI) + 50 CONTINUE + CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.5) THEN * .. DCOPYTEST .. DO 60 I = 1, 7 diff --git a/CBLAS/testing/c_sblas1.c b/CBLAS/testing/c_sblas1.c index e5a88766f..133944afb 100644 --- a/CBLAS/testing/c_sblas1.c +++ b/CBLAS/testing/c_sblas1.c @@ -20,6 +20,14 @@ void F77_saxpy(const CBLAS_INT *N, const float *alpha, const float *X, return; } +void F77_saxpby(const CBLAS_INT *N, const float *alpha, const float *X, + const CBLAS_INT *incX, const float *beta, float *Y, const CBLAS_INT *incY) +{ + cblas_saxpby(*N, *alpha, X, *incX, *beta, Y, *incY); + return; +} + + float F77_scasum(const CBLAS_INT *N, void *X, const CBLAS_INT *incX) { return cblas_scasum(*N, X, *incX); diff --git a/CBLAS/testing/c_sblat1.f b/CBLAS/testing/c_sblat1.f index 89902f12d..1050cfc80 100644 --- a/CBLAS/testing/c_sblat1.f +++ b/CBLAS/testing/c_sblat1.f @@ -19,7 +19,7 @@ PROGRAM SCBLAT1 DATA SFAC/9.765625E-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -38,7 +38,7 @@ PROGRAM SCBLAT1 + ICASE.EQ.10) THEN CALL CHECK1(SFAC) ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR. - + ICASE.EQ.6) THEN + + ICASE.EQ.6 .OR. ICASE.EQ.11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.EQ.4) THEN CALL CHECK3(SFAC) @@ -59,7 +59,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*15 L(10) + CHARACTER*15 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. @@ -73,6 +73,8 @@ SUBROUTINE HEADER DATA L(8)/'CBLAS_SASUM '/ DATA L(9)/'CBLAS_SSCAL '/ DATA L(10)/'CBLAS_ISAMAX'/ + DATA L(11)/'CBLAS_SAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -244,25 +246,27 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - REAL SA + REAL SA, SB INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY * .. Local Arrays .. REAL DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4), + DT8(7,4,4), DX1(7), + DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7), - + SX(7), SY(7) + + SX(7), SY(7), DT20(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. REAL SDOTTEST EXTERNAL SDOTTEST * .. External Subroutines .. EXTERNAL SAXPYTEST, SCOPYTEST, SSWAPTEST, STEST, STEST1 + + SAXPBYTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA SA/0.3E0/ + DATA SB/0.5E0/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -335,6 +339,26 @@ SUBROUTINE CHECK2(SFAC) + 0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, + 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, + 1.17E0, 1.17E0, 1.17E0/ + DATA DT20/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.43E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.43E0, -0.42E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.43E0, -0.42E0, 0.0E0, + + 0.59E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.43E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.1E0, -0.9E0, 0.33E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.13E0, -0.9E0, 0.42E0, 0.7E0, -0.45E0, + + 0.2E0, 0.58E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.43E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.1E0, -0.27E0, + + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.13E0, + + -0.18E0, 0.00E0, 0.53E0, 0.0E0, 0.0E0, 0.0E0, + + 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.43E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + + 0.0E0, 0.43E0, -0.9E0, 0.18E0, 0.0E0, 0.0E0, + + 0.0E0, 0.0E0, 0.43E0, -0.9E0, 0.18E0, 0.7E0, + + -0.45E0, 0.2E0, 0.64E0/ + * .. Executable Statements .. * DO 120 KI = 1, 4 @@ -365,6 +389,13 @@ SUBROUTINE CHECK2(SFAC) STY(J) = DT8(J,KN,KI) 40 CONTINUE CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.11) THEN +* .. SAXPBYTEST .. + CALL SAXPBYTEST(N,SA,SX,INCX,SB,SY,INCY) + DO 50 J = 1, LENY + STY(J) = DT20(J,KN,KI) + 50 CONTINUE + CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC) ELSE IF (ICASE.EQ.5) THEN * .. SCOPYTEST .. DO 60 I = 1, 7 diff --git a/CBLAS/testing/c_zblas1.c b/CBLAS/testing/c_zblas1.c index 698397db4..48d7eaf61 100644 --- a/CBLAS/testing/c_zblas1.c +++ b/CBLAS/testing/c_zblas1.c @@ -15,6 +15,14 @@ void F77_zaxpy(const CBLAS_INT *N, const void *alpha, void *X, return; } + +void F77_zaxpby(const CBLAS_INT *N, const void *alpha, void *X, + const CBLAS_INT *incX, const void *beta, void *Y, const CBLAS_INT *incY) +{ + cblas_zaxpby(*N, alpha, X, *incX, beta, Y, *incY); + return; +} + void F77_zcopy(const CBLAS_INT *N, void *X, const CBLAS_INT *incX, void *Y, const CBLAS_INT *incY) { diff --git a/CBLAS/testing/c_zblat1.f b/CBLAS/testing/c_zblat1.f index cd0c8541d..03abc52b4 100644 --- a/CBLAS/testing/c_zblat1.f +++ b/CBLAS/testing/c_zblat1.f @@ -19,7 +19,7 @@ PROGRAM ZCBLAT1 DATA SFAC/9.765625D-4/ * .. Executable Statements .. WRITE (NOUT,99999) - DO 20 IC = 1, 10 + DO 20 IC = 1, 11 ICASE = IC CALL HEADER * @@ -32,7 +32,7 @@ PROGRAM ZCBLAT1 INCX = 9999 INCY = 9999 MODE = 9999 - IF (ICASE.LE.5) THEN + IF (ICASE.LE.5 .OR. ICASE .EQ. 11) THEN CALL CHECK2(SFAC) ELSE IF (ICASE.GE.6) THEN CALL CHECK1(SFAC) @@ -53,7 +53,7 @@ SUBROUTINE HEADER INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Arrays .. - CHARACTER*15 L(10) + CHARACTER*15 L(11) * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. @@ -67,6 +67,8 @@ SUBROUTINE HEADER DATA L(8)/'CBLAS_ZSCAL'/ DATA L(9)/'CBLAS_ZDSCAL'/ DATA L(10)/'CBLAS_IZAMAX'/ + DATA L(11)/'CBLAS_ZAXPBY'/ + * .. Executable Statements .. WRITE (NOUT,99999) ICASE, L(ICASE) RETURN @@ -284,23 +286,26 @@ SUBROUTINE CHECK2(SFAC) INTEGER ICASE, INCX, INCY, MODE, N LOGICAL PASS * .. Local Scalars .. - COMPLEX*16 CA,ZTEMP + COMPLEX*16 CA,CB,ZTEMP INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY * .. Local Arrays .. COMPLEX*16 CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14), + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4), - + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7) + + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7), + + CT11(7,4,4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) * .. External Functions .. EXTERNAL ZDOTCTEST, ZDOTUTEST * .. External Subroutines .. EXTERNAL ZAXPYTEST, ZCOPYTEST, ZSWAPTEST, CTEST + + ZAXPBYTEST * .. Intrinsic Functions .. INTRINSIC ABS, MIN * .. Common blocks .. COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS * .. Data statements .. DATA CA/(0.4D0,-0.7D0)/ + DATA CB/(0.7D0,-0.4D0)/ DATA INCXS/1, 2, -2, -1/ DATA INCYS/1, -2, 1, -2/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ @@ -470,6 +475,53 @@ SUBROUTINE CHECK2(SFAC) + (1.54D0,1.54D0), (1.54D0,1.54D0), + (1.54D0,1.54D0), (1.54D0,1.54D0), + (1.54D0,1.54D0), (1.54D0,1.54D0)/ + DATA ((CT11(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.1D0,-1.47D0), + + (-1.08D0,0.71D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (-1.08D0,0.71D0), + + (-0.42D0,-0.99D0), (-0.61D0,-0.85D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ + DATA ((CT11(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.49D0,-0.95D0), + + (-0.9D0,0.5D0),(-0.03D0,-1.51D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.36D0,0.00D0), (-0.9D0,0.5D0), + + (-0.39D0,-0.23D0), (0.1D0,-0.5D0), + + (-0.82D0,-0.39D0), (-0.5D0,-0.3D0), + + (0.0D0,-1.62D0)/ + DATA ((CT11(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.49D0,-0.95D0), + + (-0.71D0,-0.1D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.36D0,0.00D0), (-1.07D0,1.18D0), + + (-0.42D0,-0.99D0), (-0.41D0,-1.2D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/ + DATA ((CT11(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (-0.1D0,-1.47D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (-0.1D0,-1.47D0), (-0.9D0,0.5D0), + + (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0), + + (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.1D0,-1.47D0), + + (-0.9D0,0.5D0),(-0.4D0,-0.7D0), (0.1D0,-0.5D0), + + (-0.82D0,-0.39D0), (-0.5D0,-0.3D0), + + (-0.2D0,-1.27D0)/ + + * .. Executable Statements .. DO 60 KI = 1, 4 INCX = INCXS(KI) @@ -501,6 +553,10 @@ SUBROUTINE CHECK2(SFAC) * .. ZAXPYTEST .. CALL ZAXPYTEST(N,CA,CX,INCX,CY,INCY) CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC) + ELSE IF (ICASE.EQ.11) THEN +* .. ZAXPBYTEST .. + CALL ZAXPBYTEST(N,CA,CX,INCX,CB,CY,INCY) + CALL CTEST(LENY,CY,CT11(1,KN,KI),CSIZE2(1,KSIZE),SFAC) ELSE IF (ICASE.EQ.4) THEN * .. ZCOPYTEST .. CALL ZCOPYTEST(N,CX,INCX,CY,INCY) diff --git a/DOCS/groups-usr.dox b/DOCS/groups-usr.dox index 0234f83d9..f26e4ac8e 100644 --- a/DOCS/groups-usr.dox +++ b/DOCS/groups-usr.dox @@ -913,6 +913,7 @@ https://www.netlib.org/xblas/ @defgroup asum asum: sum | real( x_i ) | + | imag( x_i ) | @defgroup sum1 sum1: sum | x_i | (in LAPACK) @defgroup axpy axpy: y = ax + y + @defgroup axpby axpby: y = ax + by @defgroup copy copy: y = x @defgroup dot dot: x^H x and x^T x @defgroup iamax iamax: argmax_i | real( x_i ) | + | imag( x_i ) |