Skip to content

Commit dba6115

Browse files
langoulangou
authored
Merge pull request #398 from matcross/master
Add more tests for edge cases in level-1 BLAS.
2 parents efc3839 + 8dace58 commit dba6115

4 files changed

Lines changed: 67 additions & 8 deletions

File tree

‎BLAS/TESTING/cblat1.f‎

Lines changed: 17 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -132,7 +132,7 @@ SUBROUTINE CHECK1(SFAC)
132132
COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
133133
+ MWPCS(5), MWPCT(5)
134134
REAL STRUE2(5), STRUE4(5)
135-
INTEGER ITRUE3(5)
135+
INTEGER ITRUE3(5), ITRUEC(5)
136136
* .. External Functions ..
137137
REAL SCASUM, SCNRM2
138138
INTEGER ICAMAX
@@ -238,6 +238,7 @@ SUBROUTINE CHECK1(SFAC)
238238
+ (0.15E0,0.00E0), (6.0E0,9.0E0), (0.00E0,0.15E0),
239239
+ (8.0E0,3.0E0), (0.00E0,0.06E0), (9.0E0,4.0E0)/
240240
DATA ITRUE3/0, 1, 2, 2, 2/
241+
DATA ITRUEC/0, 1, 1, 1, 1/
241242
* .. Executable Statements ..
242243
DO 60 INCX = 1, 2
243244
DO 40 NP1 = 1, 5
@@ -268,6 +269,10 @@ SUBROUTINE CHECK1(SFAC)
268269
ELSE IF (ICASE.EQ.10) THEN
269270
* .. ICAMAX ..
270271
CALL ITEST1(ICAMAX(N,CX,INCX),ITRUE3(NP1))
272+
DO 160 I = 1, LEN
273+
CX(I) = (42.0E0,43.0E0)
274+
160 CONTINUE
275+
CALL ITEST1(ICAMAX(N,CX,INCX),ITRUEC(NP1))
271276
ELSE
272277
WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
273278
STOP
@@ -331,7 +336,8 @@ SUBROUTINE CHECK2(SFAC)
331336
* .. Local Arrays ..
332337
COMPLEX CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
333338
+ CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
334-
+ CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7)
339+
+ CT8(7,4,4), CTY0(1), CX(7), CX0(1), CX1(7),
340+
+ CY(7), CY0(1), CY1(7)
335341
INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
336342
* .. External Functions ..
337343
COMPLEX CDOTC, CDOTU
@@ -546,6 +552,15 @@ SUBROUTINE CHECK2(SFAC)
546552
* .. CCOPY ..
547553
CALL CCOPY(N,CX,INCX,CY,INCY)
548554
CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0)
555+
CX0(1) = (42.0E0,43.0E0)
556+
CY0(1) = (44.0E0,45.0E0)
557+
IF (N.EQ.0) THEN
558+
CTY0(1) = CY0(1)
559+
ELSE
560+
CTY0(1) = CX0(1)
561+
END IF
562+
CALL CCOPY(N,CX0,0,CY0,0)
563+
CALL CTEST(1,CY0,CTY0,CSIZE3,1.0E0)
549564
ELSE IF (ICASE.EQ.5) THEN
550565
* .. CSWAP ..
551566
CALL CSWAP(N,CX,INCX,CY,INCY)

‎BLAS/TESTING/dblat1.f‎

Lines changed: 17 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -253,7 +253,7 @@ SUBROUTINE CHECK1(SFAC)
253253
* .. Local Arrays ..
254254
DOUBLE PRECISION DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
255255
+ SA(10), STEMP(1), STRUE(8), SX(8)
256-
INTEGER ITRUE2(5)
256+
INTEGER ITRUE2(5), ITRUEC(5)
257257
* .. External Functions ..
258258
DOUBLE PRECISION DASUM, DNRM2
259259
INTEGER IDAMAX
@@ -297,6 +297,7 @@ SUBROUTINE CHECK1(SFAC)
297297
+ 0.03D0, 4.0D0, -0.09D0, 6.0D0, -0.15D0, 7.0D0,
298298
+ -0.03D0, 3.0D0/
299299
DATA ITRUE2/0, 1, 2, 2, 3/
300+
DATA ITRUEC/0, 1, 1, 1, 1/
300301
* .. Executable Statements ..
301302
DO 80 INCX = 1, 2
302303
DO 60 NP1 = 1, 5
@@ -325,6 +326,10 @@ SUBROUTINE CHECK1(SFAC)
325326
ELSE IF (ICASE.EQ.10) THEN
326327
* .. IDAMAX ..
327328
CALL ITEST1(IDAMAX(N,SX,INCX),ITRUE2(NP1))
329+
DO 100 I = 1, LEN
330+
SX(I) = 42.0D0
331+
100 CONTINUE
332+
CALL ITEST1(IDAMAX(N,SX,INCX),ITRUEC(NP1))
328333
ELSE
329334
WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
330335
STOP
@@ -354,7 +359,8 @@ SUBROUTINE CHECK2(SFAC)
354359
$ DPAR(5,4), DT19X(7,4,16),DT19XA(7,4,4),
355360
$ DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4),
356361
$ DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4),
357-
$ DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5)
362+
$ DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5),
363+
$ STY0(1), SX0(1), SY0(1)
358364
INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
359365
* .. External Functions ..
360366
DOUBLE PRECISION DDOT, DSDOT
@@ -628,6 +634,15 @@ SUBROUTINE CHECK2(SFAC)
628634
60 CONTINUE
629635
CALL DCOPY(N,SX,INCX,SY,INCY)
630636
CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0)
637+
SX0(1) = 42.0D0
638+
SY0(1) = 43.0D0
639+
IF (N.EQ.0) THEN
640+
STY0(1) = SY0(1)
641+
ELSE
642+
STY0(1) = SX0(1)
643+
END IF
644+
CALL DCOPY(N,SX0,0,SY0,0)
645+
CALL STEST(1,SY0,STY0,SSIZE2(1,1),1.0D0)
631646
ELSE IF (ICASE.EQ.6) THEN
632647
* .. DSWAP ..
633648
CALL DSWAP(N,SX,INCX,SY,INCY)

‎BLAS/TESTING/sblat1.f‎

Lines changed: 16 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -253,7 +253,7 @@ SUBROUTINE CHECK1(SFAC)
253253
* .. Local Arrays ..
254254
REAL DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
255255
+ SA(10), STEMP(1), STRUE(8), SX(8)
256-
INTEGER ITRUE2(5)
256+
INTEGER ITRUE2(5), ITRUEC(5)
257257
* .. External Functions ..
258258
REAL SASUM, SNRM2
259259
INTEGER ISAMAX
@@ -297,6 +297,7 @@ SUBROUTINE CHECK1(SFAC)
297297
+ 0.03E0, 4.0E0, -0.09E0, 6.0E0, -0.15E0, 7.0E0,
298298
+ -0.03E0, 3.0E0/
299299
DATA ITRUE2/0, 1, 2, 2, 3/
300+
DATA ITRUEC/0, 1, 1, 1, 1/
300301
* .. Executable Statements ..
301302
DO 80 INCX = 1, 2
302303
DO 60 NP1 = 1, 5
@@ -325,6 +326,10 @@ SUBROUTINE CHECK1(SFAC)
325326
ELSE IF (ICASE.EQ.10) THEN
326327
* .. ISAMAX ..
327328
CALL ITEST1(ISAMAX(N,SX,INCX),ITRUE2(NP1))
329+
DO 100 I = 1, LEN
330+
SX(I) = 42.0E0
331+
100 CONTINUE
332+
CALL ITEST1(ISAMAX(N,SX,INCX),ITRUEC(NP1))
328333
ELSE
329334
WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
330335
STOP
@@ -355,7 +360,7 @@ SUBROUTINE CHECK2(SFAC)
355360
$ DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4),
356361
$ DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4),
357362
$ DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5),
358-
$ ST7B(4,4)
363+
$ ST7B(4,4), STY0(1), SX0(1), SY0(1)
359364
INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
360365
* .. External Functions ..
361366
REAL SDOT, SDSDOT
@@ -631,6 +636,15 @@ SUBROUTINE CHECK2(SFAC)
631636
60 CONTINUE
632637
CALL SCOPY(N,SX,INCX,SY,INCY)
633638
CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0)
639+
SX0(1) = 42.0E0
640+
SY0(1) = 43.0E0
641+
IF (N.EQ.0) THEN
642+
STY0(1) = SY0(1)
643+
ELSE
644+
STY0(1) = SX0(1)
645+
END IF
646+
CALL SCOPY(N,SX0,0,SY0,0)
647+
CALL STEST(1,SY0,STY0,SSIZE2(1,1),1.0E0)
634648
ELSE IF (ICASE.EQ.6) THEN
635649
* .. SSWAP ..
636650
CALL SSWAP(N,SX,INCX,SY,INCY)

‎BLAS/TESTING/zblat1.f‎

Lines changed: 17 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -132,7 +132,7 @@ SUBROUTINE CHECK1(SFAC)
132132
COMPLEX*16 CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
133133
+ MWPCS(5), MWPCT(5)
134134
DOUBLE PRECISION STRUE2(5), STRUE4(5)
135-
INTEGER ITRUE3(5)
135+
INTEGER ITRUE3(5), ITRUEC(5)
136136
* .. External Functions ..
137137
DOUBLE PRECISION DZASUM, DZNRM2
138138
INTEGER IZAMAX
@@ -238,6 +238,7 @@ SUBROUTINE CHECK1(SFAC)
238238
+ (0.15D0,0.00D0), (6.0D0,9.0D0), (0.00D0,0.15D0),
239239
+ (8.0D0,3.0D0), (0.00D0,0.06D0), (9.0D0,4.0D0)/
240240
DATA ITRUE3/0, 1, 2, 2, 2/
241+
DATA ITRUEC/0, 1, 1, 1, 1/
241242
* .. Executable Statements ..
242243
DO 60 INCX = 1, 2
243244
DO 40 NP1 = 1, 5
@@ -268,6 +269,10 @@ SUBROUTINE CHECK1(SFAC)
268269
ELSE IF (ICASE.EQ.10) THEN
269270
* .. IZAMAX ..
270271
CALL ITEST1(IZAMAX(N,CX,INCX),ITRUE3(NP1))
272+
DO 160 I = 1, LEN
273+
CX(I) = (42.0D0,43.0D0)
274+
160 CONTINUE
275+
CALL ITEST1(IZAMAX(N,CX,INCX),ITRUEC(NP1))
271276
ELSE
272277
WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
273278
STOP
@@ -331,7 +336,8 @@ SUBROUTINE CHECK2(SFAC)
331336
* .. Local Arrays ..
332337
COMPLEX*16 CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
333338
+ CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
334-
+ CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7)
339+
+ CT8(7,4,4), CTY0(1), CX(7), CX0(1), CX1(7),
340+
+ CY(7), CY0(1), CY1(7)
335341
INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
336342
* .. External Functions ..
337343
COMPLEX*16 ZDOTC, ZDOTU
@@ -546,6 +552,15 @@ SUBROUTINE CHECK2(SFAC)
546552
* .. ZCOPY ..
547553
CALL ZCOPY(N,CX,INCX,CY,INCY)
548554
CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0)
555+
CX0(1) = (42.0D0,43.0D0)
556+
CY0(1) = (44.0D0,45.0D0)
557+
IF (N.EQ.0) THEN
558+
CTY0(1) = CY0(1)
559+
ELSE
560+
CTY0(1) = CX0(1)
561+
END IF
562+
CALL ZCOPY(N,CX0,0,CY0,0)
563+
CALL CTEST(1,CY0,CTY0,CSIZE3,1.0D0)
549564
ELSE IF (ICASE.EQ.5) THEN
550565
* .. ZSWAP ..
551566
CALL ZSWAP(N,CX,INCX,CY,INCY)

0 commit comments

Comments
 (0)