Merge pull request #2518 from shengyang-3390/dev
add ctest for srotm and modified ctest for srot.
This commit is contained in:
Martin Kroeker
GitHub
commit
a46a8c4956
|
|
@ -55,6 +55,13 @@ void F77_srotg( float *a, float *b, float *c, float *s)
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void F77_srotm(blasint *N, float *X, blasint *incX, float *Y, blasint *incY,
|
||||||
|
float *param)
|
||||||
|
{
|
||||||
|
cblas_srotm(*N, X, *incX, Y, *incY, param);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
void F77_srot( blasint *N, float *X, blasint *incX, float *Y,
|
void F77_srot( blasint *N, float *X, blasint *incX, float *Y,
|
||||||
blasint *incY, const float *c, const float *s)
|
blasint *incY, const float *c, const float *s)
|
||||||
{
|
{
|
||||||
|
|
|
||||||
370
ctest/c_sblat1.f
370
ctest/c_sblat1.f
|
|
@ -19,7 +19,7 @@
|
||||||
DATA SFAC/9.765625E-4/
|
DATA SFAC/9.765625E-4/
|
||||||
* .. Executable Statements ..
|
* .. Executable Statements ..
|
||||||
WRITE (NOUT,99999)
|
WRITE (NOUT,99999)
|
||||||
DO 20 IC = 1, 10
|
DO 20 IC = 1, 11
|
||||||
ICASE = IC
|
ICASE = IC
|
||||||
CALL HEADER
|
CALL HEADER
|
||||||
*
|
*
|
||||||
|
|
@ -40,7 +40,7 @@
|
||||||
ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR.
|
ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR.
|
||||||
+ ICASE.EQ.6) THEN
|
+ ICASE.EQ.6) THEN
|
||||||
CALL CHECK2(SFAC)
|
CALL CHECK2(SFAC)
|
||||||
ELSE IF (ICASE.EQ.4) THEN
|
ELSE IF (ICASE.EQ.4 .OR. ICASE.EQ.11) THEN
|
||||||
CALL CHECK3(SFAC)
|
CALL CHECK3(SFAC)
|
||||||
END IF
|
END IF
|
||||||
* -- Print
|
* -- Print
|
||||||
|
|
@ -59,7 +59,7 @@
|
||||||
INTEGER ICASE, INCX, INCY, MODE, N
|
INTEGER ICASE, INCX, INCY, MODE, N
|
||||||
LOGICAL PASS
|
LOGICAL PASS
|
||||||
* .. Local Arrays ..
|
* .. Local Arrays ..
|
||||||
CHARACTER*15 L(10)
|
CHARACTER*15 L(11)
|
||||||
* .. Common blocks ..
|
* .. Common blocks ..
|
||||||
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
|
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
|
||||||
* .. Data statements ..
|
* .. Data statements ..
|
||||||
|
|
@ -73,6 +73,7 @@
|
||||||
DATA L(8)/'CBLAS_SASUM '/
|
DATA L(8)/'CBLAS_SASUM '/
|
||||||
DATA L(9)/'CBLAS_SSCAL '/
|
DATA L(9)/'CBLAS_SSCAL '/
|
||||||
DATA L(10)/'CBLAS_ISAMAX'/
|
DATA L(10)/'CBLAS_ISAMAX'/
|
||||||
|
DATA L(11)/'CBLAS_SROTM'/
|
||||||
* .. Executable Statements ..
|
* .. Executable Statements ..
|
||||||
WRITE (NOUT,99999) ICASE, L(ICASE)
|
WRITE (NOUT,99999) ICASE, L(ICASE)
|
||||||
RETURN
|
RETURN
|
||||||
|
|
@ -396,203 +397,92 @@
|
||||||
* .. Scalar Arguments ..
|
* .. Scalar Arguments ..
|
||||||
REAL SFAC
|
REAL SFAC
|
||||||
* .. Scalars in Common ..
|
* .. Scalars in Common ..
|
||||||
INTEGER ICASE, INCX, INCY, MODE, N
|
INTEGER ICASE, INCX, INCY, N
|
||||||
LOGICAL PASS
|
LOGICAL PASS
|
||||||
* .. Local Scalars ..
|
* .. Local Scalars ..
|
||||||
REAL SC, SS
|
REAL SC, SS
|
||||||
INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
|
INTEGER I, K, KI, KN, KSIZE, LEN
|
||||||
* .. Local Arrays ..
|
* .. Local Arrays ..
|
||||||
REAL COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
|
REAL DX(19), DY(19),
|
||||||
+ DX1(7), DY1(7), MWPC(11), MWPS(11), MWPSTX(5),
|
+ SSIZE2(19,2), STX(19), STY(19), SX(19), SY(19),
|
||||||
+ MWPSTY(5), MWPTX(11,5), MWPTY(11,5), MWPX(5),
|
+ PARAM(5, 4), SPARAM(5)
|
||||||
+ MWPY(5), SSIZE2(14,2), STX(7), STY(7), SX(7),
|
INTEGER INCXS(7), INCYS(7), NS(7)
|
||||||
+ SY(7)
|
|
||||||
INTEGER INCXS(4), INCYS(4), LENS(4,2), MWPINX(11),
|
|
||||||
+ MWPINY(11), MWPN(11), NS(4)
|
|
||||||
* .. External Subroutines ..
|
* .. External Subroutines ..
|
||||||
EXTERNAL SROTTEST, STEST
|
EXTERNAL SROTMTEST, SROTM
|
||||||
* .. Intrinsic Functions ..
|
* .. Intrinsic Functions ..
|
||||||
INTRINSIC ABS, MIN
|
INTRINSIC MIN
|
||||||
* .. Common blocks ..
|
* .. Common blocks ..
|
||||||
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
|
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
|
||||||
* .. Data statements ..
|
* .. Data statements ..
|
||||||
DATA INCXS/1, 2, -2, -1/
|
DATA INCXS/1, 1, 2, 2, -2, -1, -2/
|
||||||
DATA INCYS/1, -2, 1, -2/
|
DATA INCYS/1, 2, 2, -2, 1, -2, -2/
|
||||||
DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
|
DATA NS/0, 1, 2, 4, 5, 8, 9/
|
||||||
DATA NS/0, 1, 2, 4/
|
DATA DX/0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.9E0, -0.3E0,
|
||||||
DATA DX1/0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.9E0, -0.3E0,
|
+ -0.4E0, 0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0,
|
||||||
+ -0.4E0/
|
+ 0.2E0, 0.8E0, -0.46E0, 0.78E0, -0.46E0, -0.22E0,
|
||||||
DATA DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
|
+ 1.06E0/
|
||||||
|
DATA DY/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
|
||||||
|
+ 0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.9E0, -0.3E0,
|
||||||
|
+ 0.96E0, 0.1E0, -0.76E0, 0.8E0, 0.90E0, 0.66E0,
|
||||||
+ 0.8E0/
|
+ 0.8E0/
|
||||||
DATA SC, SS/0.8E0, 0.6E0/
|
DATA SC, SS/0.8E0, 0.6E0/
|
||||||
DATA DT9X/0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
DATA PARAM/-2.0E0, 1.0E0, 0.0E0, 0.0E0, 1.0E0,
|
||||||
+ 0.0E0, 0.78E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
+ -1.0E0, 0.2E0, 0.3E0, 0.4E0, 0.5E0,
|
||||||
+ 0.0E0, 0.0E0, 0.78E0, -0.46E0, 0.0E0, 0.0E0,
|
+ 0.0E0, 1.0E0, 0.3E0, 0.4E0, 1.0E0,
|
||||||
+ 0.0E0, 0.0E0, 0.0E0, 0.78E0, -0.46E0, -0.22E0,
|
+ 1.0E0, 0.2E0, -1.0E0, 1.0E0, 0.5E0/
|
||||||
+ 1.06E0, 0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0,
|
DATA LEN/19/
|
||||||
+ 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.78E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.66E0, 0.1E0, -0.1E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.96E0, 0.1E0, -0.76E0, 0.8E0, 0.90E0,
|
|
||||||
+ -0.3E0, -0.02E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.0E0, 0.78E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.06E0, 0.1E0,
|
|
||||||
+ -0.1E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.90E0,
|
|
||||||
+ 0.1E0, -0.22E0, 0.8E0, 0.18E0, -0.3E0, -0.02E0,
|
|
||||||
+ 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.78E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.78E0, 0.26E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.78E0, 0.26E0, -0.76E0, 1.12E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.0E0/
|
|
||||||
DATA DT9Y/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.04E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.04E0, -0.78E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.0E0, 0.04E0, -0.78E0, 0.54E0,
|
|
||||||
+ 0.08E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.04E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.7E0,
|
|
||||||
+ -0.9E0, -0.12E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.64E0, -0.9E0, -0.30E0, 0.7E0, -0.18E0, 0.2E0,
|
|
||||||
+ 0.28E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.04E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.0E0, 0.7E0, -1.08E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.64E0, -1.26E0,
|
|
||||||
+ 0.54E0, 0.20E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.04E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.04E0, -0.9E0, 0.18E0, 0.0E0, 0.0E0,
|
|
||||||
+ 0.0E0, 0.0E0, 0.04E0, -0.9E0, 0.18E0, 0.7E0,
|
|
||||||
+ -0.18E0, 0.2E0, 0.16E0/
|
|
||||||
DATA SSIZE2/0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
DATA SSIZE2/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.0E0,
|
+ 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
|
||||||
+ 0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
|
+ 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 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, 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/
|
||||||
* .. Executable Statements ..
|
* .. Executable Statements ..
|
||||||
*
|
*
|
||||||
DO 60 KI = 1, 4
|
DO 60 KI = 1, 7
|
||||||
INCX = INCXS(KI)
|
INCX = INCXS(KI)
|
||||||
INCY = INCYS(KI)
|
INCY = INCYS(KI)
|
||||||
MX = ABS(INCX)
|
|
||||||
MY = ABS(INCY)
|
|
||||||
*
|
*
|
||||||
DO 40 KN = 1, 4
|
DO 40 KN = 1, 7
|
||||||
N = NS(KN)
|
N = NS(KN)
|
||||||
KSIZE = MIN(2,KN)
|
KSIZE = MIN(2,KN)
|
||||||
LENX = LENS(KN,MX)
|
|
||||||
LENY = LENS(KN,MY)
|
|
||||||
*
|
*
|
||||||
IF (ICASE.EQ.4) THEN
|
IF (ICASE.EQ.4) THEN
|
||||||
* .. SROTTEST ..
|
* .. SROTTEST ..
|
||||||
DO 20 I = 1, 7
|
DO 20 I = 1, 19
|
||||||
SX(I) = DX1(I)
|
SX(I) = DX(I)
|
||||||
SY(I) = DY1(I)
|
SY(I) = DY(I)
|
||||||
STX(I) = DT9X(I,KN,KI)
|
STX(I) = DX(I)
|
||||||
STY(I) = DT9Y(I,KN,KI)
|
STY(I) = DY(I)
|
||||||
20 CONTINUE
|
20 CONTINUE
|
||||||
CALL SROTTEST(N,SX,INCX,SY,INCY,SC,SS)
|
CALL SROTTEST(N,SX,INCX,SY,INCY,SC,SS)
|
||||||
CALL STEST(LENX,SX,STX,SSIZE2(1,KSIZE),SFAC)
|
CALL SROT(N,STX,INCX,STY,INCY,SC,SS)
|
||||||
CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
|
CALL STEST(LEN,SX,STX,SSIZE2(1,KSIZE),SFAC)
|
||||||
|
CALL STEST(LEN,SY,STY,SSIZE2(1,KSIZE),SFAC)
|
||||||
|
ELSE IF (ICASE.EQ.11) THEN
|
||||||
|
* .. SROTMTEST ..
|
||||||
|
DO 90 I = 1, 19
|
||||||
|
SX(I) = DX(I)
|
||||||
|
SY(I) = DY(I)
|
||||||
|
STX(I) = DX(I)
|
||||||
|
STY(I) = DY(I)
|
||||||
|
90 CONTINUE
|
||||||
|
DO 70 I = 1, 4
|
||||||
|
DO 80 K = 1, 5
|
||||||
|
SPARAM(K) = PARAM(K,I)
|
||||||
|
80 CONTINUE
|
||||||
|
CALL SROTMTEST(N,SX,INCX,SY,INCY,SPARAM)
|
||||||
|
CALL SROTM(N,STX,INCX,STY,INCY,SPARAM)
|
||||||
|
CALL STEST(LEN,SX,STX,SSIZE2(1,KSIZE),SFAC)
|
||||||
|
CALL STEST(LEN,SY,STY,SSIZE2(1,KSIZE),SFAC)
|
||||||
|
70 CONTINUE
|
||||||
ELSE
|
ELSE
|
||||||
WRITE (NOUT,*) ' Shouldn''t be here in CHECK3'
|
WRITE (NOUT,*) ' Shouldn''t be here in CHECK3'
|
||||||
STOP
|
STOP
|
||||||
END IF
|
END IF
|
||||||
40 CONTINUE
|
40 CONTINUE
|
||||||
60 CONTINUE
|
60 CONTINUE
|
||||||
*
|
|
||||||
MWPC(1) = 1
|
|
||||||
DO 80 I = 2, 11
|
|
||||||
MWPC(I) = 0
|
|
||||||
80 CONTINUE
|
|
||||||
MWPS(1) = 0
|
|
||||||
DO 100 I = 2, 6
|
|
||||||
MWPS(I) = 1
|
|
||||||
100 CONTINUE
|
|
||||||
DO 120 I = 7, 11
|
|
||||||
MWPS(I) = -1
|
|
||||||
120 CONTINUE
|
|
||||||
MWPINX(1) = 1
|
|
||||||
MWPINX(2) = 1
|
|
||||||
MWPINX(3) = 1
|
|
||||||
MWPINX(4) = -1
|
|
||||||
MWPINX(5) = 1
|
|
||||||
MWPINX(6) = -1
|
|
||||||
MWPINX(7) = 1
|
|
||||||
MWPINX(8) = 1
|
|
||||||
MWPINX(9) = -1
|
|
||||||
MWPINX(10) = 1
|
|
||||||
MWPINX(11) = -1
|
|
||||||
MWPINY(1) = 1
|
|
||||||
MWPINY(2) = 1
|
|
||||||
MWPINY(3) = -1
|
|
||||||
MWPINY(4) = -1
|
|
||||||
MWPINY(5) = 2
|
|
||||||
MWPINY(6) = 1
|
|
||||||
MWPINY(7) = 1
|
|
||||||
MWPINY(8) = -1
|
|
||||||
MWPINY(9) = -1
|
|
||||||
MWPINY(10) = 2
|
|
||||||
MWPINY(11) = 1
|
|
||||||
DO 140 I = 1, 11
|
|
||||||
MWPN(I) = 5
|
|
||||||
140 CONTINUE
|
|
||||||
MWPN(5) = 3
|
|
||||||
MWPN(10) = 3
|
|
||||||
DO 160 I = 1, 5
|
|
||||||
MWPX(I) = I
|
|
||||||
MWPY(I) = I
|
|
||||||
MWPTX(1,I) = I
|
|
||||||
MWPTY(1,I) = I
|
|
||||||
MWPTX(2,I) = I
|
|
||||||
MWPTY(2,I) = -I
|
|
||||||
MWPTX(3,I) = 6 - I
|
|
||||||
MWPTY(3,I) = I - 6
|
|
||||||
MWPTX(4,I) = I
|
|
||||||
MWPTY(4,I) = -I
|
|
||||||
MWPTX(6,I) = 6 - I
|
|
||||||
MWPTY(6,I) = I - 6
|
|
||||||
MWPTX(7,I) = -I
|
|
||||||
MWPTY(7,I) = I
|
|
||||||
MWPTX(8,I) = I - 6
|
|
||||||
MWPTY(8,I) = 6 - I
|
|
||||||
MWPTX(9,I) = -I
|
|
||||||
MWPTY(9,I) = I
|
|
||||||
MWPTX(11,I) = I - 6
|
|
||||||
MWPTY(11,I) = 6 - I
|
|
||||||
160 CONTINUE
|
|
||||||
MWPTX(5,1) = 1
|
|
||||||
MWPTX(5,2) = 3
|
|
||||||
MWPTX(5,3) = 5
|
|
||||||
MWPTX(5,4) = 4
|
|
||||||
MWPTX(5,5) = 5
|
|
||||||
MWPTY(5,1) = -1
|
|
||||||
MWPTY(5,2) = 2
|
|
||||||
MWPTY(5,3) = -2
|
|
||||||
MWPTY(5,4) = 4
|
|
||||||
MWPTY(5,5) = -3
|
|
||||||
MWPTX(10,1) = -1
|
|
||||||
MWPTX(10,2) = -3
|
|
||||||
MWPTX(10,3) = -5
|
|
||||||
MWPTX(10,4) = 4
|
|
||||||
MWPTX(10,5) = 5
|
|
||||||
MWPTY(10,1) = 1
|
|
||||||
MWPTY(10,2) = 2
|
|
||||||
MWPTY(10,3) = 2
|
|
||||||
MWPTY(10,4) = 4
|
|
||||||
MWPTY(10,5) = 3
|
|
||||||
DO 200 I = 1, 11
|
|
||||||
INCX = MWPINX(I)
|
|
||||||
INCY = MWPINY(I)
|
|
||||||
DO 180 K = 1, 5
|
|
||||||
COPYX(K) = MWPX(K)
|
|
||||||
COPYY(K) = MWPY(K)
|
|
||||||
MWPSTX(K) = MWPTX(I,K)
|
|
||||||
MWPSTY(K) = MWPTY(I,K)
|
|
||||||
180 CONTINUE
|
|
||||||
CALL SROTTEST(MWPN(I),COPYX,INCX,COPYY,INCY,MWPC(I),MWPS(I))
|
|
||||||
CALL STEST(5,COPYX,MWPSTX,MWPSTX,SFAC)
|
|
||||||
CALL STEST(5,COPYY,MWPSTY,MWPSTY,SFAC)
|
|
||||||
200 CONTINUE
|
|
||||||
RETURN
|
RETURN
|
||||||
END
|
END
|
||||||
SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
|
SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
|
||||||
|
|
@ -726,3 +616,147 @@
|
||||||
+ /1X)
|
+ /1X)
|
||||||
99997 FORMAT (1X,I4,I3,3I5,2I36,I12)
|
99997 FORMAT (1X,I4,I3,3I5,2I36,I12)
|
||||||
END
|
END
|
||||||
|
SUBROUTINE SROT(N,SX,INCX,SY,INCY,C,S)
|
||||||
|
*
|
||||||
|
* --Reference BLAS level1 routine (version 3.8.0) --
|
||||||
|
* --Reference BLAS is a software package provided by Univ. of Tennessee, --
|
||||||
|
* --Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||||
|
* November 2017
|
||||||
|
*
|
||||||
|
* .. Scalar Arguments ..
|
||||||
|
REAL C,S
|
||||||
|
INTEGER INCX,INCY,N
|
||||||
|
* ..
|
||||||
|
* .. Array Arguments ..
|
||||||
|
REAL SX(*),SY(*)
|
||||||
|
* ..
|
||||||
|
* .. Local Scalars ..
|
||||||
|
REAL STEMP
|
||||||
|
INTEGER I,IX,IY
|
||||||
|
* ..
|
||||||
|
IF (n.LE.0) RETURN
|
||||||
|
IF (incx.EQ.1 .AND. incy.EQ.1) THEN
|
||||||
|
DO i = 1,n
|
||||||
|
stemp = c*sx(i) + s*sy(i)
|
||||||
|
sy(i) = c*sy(i) - s*sx(i)
|
||||||
|
sx(i) = stemp
|
||||||
|
END DO
|
||||||
|
ELSE
|
||||||
|
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
|
||||||
|
stemp = c*sx(ix) + s*sy(iy)
|
||||||
|
sy(iy) = c*sy(iy) - s*sx(ix)
|
||||||
|
sx(ix) = stemp
|
||||||
|
ix = ix + incx
|
||||||
|
iy = iy + incy
|
||||||
|
END DO
|
||||||
|
END IF
|
||||||
|
RETURN
|
||||||
|
END
|
||||||
|
SUBROUTINE srotm(N,SX,INCX,SY,INCY,SPARAM)
|
||||||
|
*
|
||||||
|
* --Reference BLAS level1 routine (version 3.8.0) --
|
||||||
|
* --Reference BLAS is a software package provided by Univ. of Tennessee, --
|
||||||
|
* --Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||||
|
* November 2017
|
||||||
|
*
|
||||||
|
* .. Scalar Arguments ..
|
||||||
|
INTEGER INCX,INCY,N
|
||||||
|
* ..
|
||||||
|
* .. Array Arguments ..
|
||||||
|
REAL SPARAM(5),SX(*),SY(*)
|
||||||
|
* ..
|
||||||
|
*
|
||||||
|
* ====================================================================
|
||||||
|
*
|
||||||
|
* .. Local Scalars ..
|
||||||
|
REAL SFLAG,SH11,SH12,SH21,SH22,TWO,W,Z,ZERO
|
||||||
|
INTEGER I,KX,KY,NSTEPS
|
||||||
|
* ..
|
||||||
|
* .. Data statements ..
|
||||||
|
DATA zero,two/0.e0,2.e0/
|
||||||
|
* ..
|
||||||
|
*
|
||||||
|
sflag = sparam(1)
|
||||||
|
IF (n.LE.0 .OR. (sflag+two.EQ.zero)) RETURN
|
||||||
|
IF (incx.EQ.incy.AND.incx.GT.0) THEN
|
||||||
|
*
|
||||||
|
nsteps = n*incx
|
||||||
|
IF (sflag.LT.zero) THEN
|
||||||
|
sh11 = sparam(2)
|
||||||
|
sh12 = sparam(4)
|
||||||
|
sh21 = sparam(3)
|
||||||
|
sh22 = sparam(5)
|
||||||
|
DO i = 1,nsteps,incx
|
||||||
|
w = sx(i)
|
||||||
|
z = sy(i)
|
||||||
|
sx(i) = w*sh11 + z*sh12
|
||||||
|
sy(i) = w*sh21 + z*sh22
|
||||||
|
END DO
|
||||||
|
ELSE IF (sflag.EQ.zero) THEN
|
||||||
|
sh12 = sparam(4)
|
||||||
|
sh21 = sparam(3)
|
||||||
|
DO i = 1,nsteps,incx
|
||||||
|
w = sx(i)
|
||||||
|
z = sy(i)
|
||||||
|
sx(i) = w + z*sh12
|
||||||
|
sy(i) = w*sh21 + z
|
||||||
|
END DO
|
||||||
|
ELSE
|
||||||
|
sh11 = sparam(2)
|
||||||
|
sh22 = sparam(5)
|
||||||
|
DO i = 1,nsteps,incx
|
||||||
|
w = sx(i)
|
||||||
|
z = sy(i)
|
||||||
|
sx(i) = w*sh11 + z
|
||||||
|
sy(i) = -w + sh22*z
|
||||||
|
END DO
|
||||||
|
END IF
|
||||||
|
ELSE
|
||||||
|
kx = 1
|
||||||
|
ky = 1
|
||||||
|
IF (incx.LT.0) kx = 1 + (1-n)*incx
|
||||||
|
IF (incy.LT.0) ky = 1 + (1-n)*incy
|
||||||
|
*
|
||||||
|
IF (sflag.LT.zero) THEN
|
||||||
|
sh11 = sparam(2)
|
||||||
|
sh12 = sparam(4)
|
||||||
|
sh21 = sparam(3)
|
||||||
|
sh22 = sparam(5)
|
||||||
|
DO i = 1,n
|
||||||
|
w = sx(kx)
|
||||||
|
z = sy(ky)
|
||||||
|
sx(kx) = w*sh11 + z*sh12
|
||||||
|
sy(ky) = w*sh21 + z*sh22
|
||||||
|
kx = kx + incx
|
||||||
|
ky = ky + incy
|
||||||
|
END DO
|
||||||
|
ELSE IF (sflag.EQ.zero) THEN
|
||||||
|
sh12 = sparam(4)
|
||||||
|
sh21 = sparam(3)
|
||||||
|
DO i = 1,n
|
||||||
|
w = sx(kx)
|
||||||
|
z = sy(ky)
|
||||||
|
sx(kx) = w + z*sh12
|
||||||
|
sy(ky) = w*sh21 + z
|
||||||
|
kx = kx + incx
|
||||||
|
ky = ky + incy
|
||||||
|
END DO
|
||||||
|
ELSE
|
||||||
|
sh11 = sparam(2)
|
||||||
|
sh22 = sparam(5)
|
||||||
|
DO i = 1,n
|
||||||
|
w = sx(kx)
|
||||||
|
z = sy(ky)
|
||||||
|
sx(kx) = w*sh11 + z
|
||||||
|
sy(ky) = -w + sh22*z
|
||||||
|
kx = kx + incx
|
||||||
|
ky = ky + incy
|
||||||
|
END DO
|
||||||
|
END IF
|
||||||
|
END IF
|
||||||
|
RETURN
|
||||||
|
END
|
||||||
Loading…
Reference in New Issue