GitHub-Proxy/eigen
1
0
Fork 0
mirror of https://gitlab.com/libeigen/eigen.git synced 2025-06-04 18:54:00 +08:00
Code Issues Packages Projects Releases Wiki Activity

BLAS: implement DSDOT and SDSDOT; update test for them.

Browse Source
This commit is contained in:
Chen-Pang He 2012-09-05 18:59:32 +08:00
parent c4051d3d02
commit c86d047c2f
4 changed files with 763 additions and 179 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
blas/double.cpp
View File

@ -2,6 +2,7 @@
// for linear algebra. // for linear algebra.
// //
// Copyright (C) 2009 Gael Guennebaud <gael.guennebaud@inria.fr> // Copyright (C) 2009 Gael Guennebaud <gael.guennebaud@inria.fr>
// Copyright (C) 2012 Chen-Pang He <jdh8@ms63.hinet.net>
// //
// This Source Code Form is subject to the terms of the Mozilla // This Source Code Form is subject to the terms of the Mozilla
// Public License v. 2.0. If a copy of the MPL was not distributed // Public License v. 2.0. If a copy of the MPL was not distributed
@ -17,3 +18,21 @@
#include "level2_impl.h" #include "level2_impl.h"
#include "level2_real_impl.h" #include "level2_real_impl.h"
#include "level3_impl.h" #include "level3_impl.h"
// currently used by DSDOT only
double* cast_vector_to_double(float* x, int n, int incx)
{
double* ret = new double[n];
if(incx<0) vector(ret,n) = vector(x,n,-incx).reverse().cast<double>();
else vector(ret,n) = vector(x,n, incx).cast<double>();
return ret;
}
double BLASFUNC(dsdot)(int* n, float* px, int* incx, float* py, int* incy)
{
if(*n <= 0) return 0;
double* x = cast_vector_to_double(px, *n, *incx);
double* y = cast_vector_to_double(py, *n, *incy);
return vector(x,*n).cwiseProduct(vector(y,*n)).sum();
}

17
blas/single.cpp
View File

@ -2,6 +2,7 @@
// for linear algebra. // for linear algebra.
// //
// Copyright (C) 2009 Gael Guennebaud <gael.guennebaud@inria.fr> // Copyright (C) 2009 Gael Guennebaud <gael.guennebaud@inria.fr>
// Copyright (C) 2012 Chen-Pang He <jdh8@ms63.hinet.net>
// //
// This Source Code Form is subject to the terms of the Mozilla // This Source Code Form is subject to the terms of the Mozilla
// Public License v. 2.0. If a copy of the MPL was not distributed // Public License v. 2.0. If a copy of the MPL was not distributed
@ -17,3 +18,19 @@
#include "level2_impl.h" #include "level2_impl.h"
#include "level2_real_impl.h" #include "level2_real_impl.h"
#include "level3_impl.h" #include "level3_impl.h"
float BLASFUNC(sdsdot)(int* n, float* alpha, float* px, int* incx, float* py, int* incy)
{
float* x = reinterpret_cast<float*>(px);
float* y = reinterpret_cast<float*>(py);
float ret = *alpha;
if(*n>0) {
if(*incx==1 && *incy==1) ret += (vector(x,*n).cwiseProduct(vector(y,*n))).sum();
else if(*incx>0 && *incy>0) ret += (vector(x,*n,*incx).cwiseProduct(vector(y,*n,*incy))).sum();
else if(*incx<0 && *incy>0) ret += (vector(x,*n,-*incx).reverse().cwiseProduct(vector(y,*n,*incy))).sum();
else if(*incx>0 && *incy<0) ret += (vector(x,*n,*incx).cwiseProduct(vector(y,*n,-*incy).reverse())).sum();
else if(*incx<0 && *incy<0) ret += (vector(x,*n,-*incx).reverse().cwiseProduct(vector(y,*n,-*incy).reverse())).sum();
}
return ret;
}

476
blas/testing/dblat1.f
View File

@ -1,12 +1,54 @@
*> \brief \b DBLAT1
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM DBLAT1
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the DOUBLE PRECISION Level 1 BLAS.
*>
*> Based upon the original BLAS test routine together with:
*> F06EAF Example Program Text
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup double_blas_testing
*
* =====================================================================
PROGRAM DBLAT1 PROGRAM DBLAT1
* Test program for the DOUBLE PRECISION Level 1 BLAS. *
* Based upon the original BLAS test routine together with: * -- Reference BLAS test routine (version 3.4.1) --
* F06EAF Example Program Text * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*
* =====================================================================
*
* .. Parameters .. * .. Parameters ..
INTEGER NOUT INTEGER NOUT
PARAMETER (NOUT=6) PARAMETER (NOUT=6)
* .. 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 ..
DOUBLE PRECISION SFAC DOUBLE PRECISION SFAC
@ -14,31 +56,30 @@
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
DATA SFAC/9.765625D-4/ DATA SFAC/9.765625D-4/
* .. Executable Statements .. * .. Executable Statements ..
WRITE (NOUT,99999) WRITE (NOUT,99999)
DO 20 IC = 1, 10 DO 20 IC = 1, 13
ICASE = IC ICASE = IC
CALL HEADER CALL HEADER
* *
* .. Initialize PASS, INCX, INCY, and MODE for a new case. .. * .. Initialize PASS, INCX, and INCY for a new case. ..
* .. the value 9999 for INCX, INCY or MODE will appear in the .. * .. the value 9999 for INCX or INCY will appear in the ..
* .. detailed output, if any, for cases that do not involve .. * .. detailed output, if any, for cases that do not involve ..
* .. these parameters .. * .. these parameters ..
* *
PASS = .TRUE. PASS = .TRUE.
INCX = 9999 INCX = 9999
INCY = 9999 INCY = 9999
MODE = 9999 IF (ICASE.EQ.3 .OR. ICASE.EQ.11) THEN
IF (ICASE.EQ.3) THEN
CALL CHECK0(SFAC) CALL CHECK0(SFAC)
ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR. ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR.
+ ICASE.EQ.10) THEN + ICASE.EQ.10) THEN
CALL CHECK1(SFAC) CALL CHECK1(SFAC)
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 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13) THEN
CALL CHECK2(SFAC) CALL CHECK2(SFAC)
ELSE IF (ICASE.EQ.4) THEN ELSE IF (ICASE.EQ.4) THEN
CALL CHECK3(SFAC) CALL CHECK3(SFAC)
@ -56,12 +97,12 @@
INTEGER NOUT INTEGER NOUT
PARAMETER (NOUT=6) PARAMETER (NOUT=6)
* .. Scalars in Common .. * .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N INTEGER ICASE, INCX, INCY, N
LOGICAL PASS LOGICAL PASS
* .. Local Arrays .. * .. Local Arrays ..
CHARACTER*6 L(10) CHARACTER*6 L(13)
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
DATA L(1)/' DDOT '/ DATA L(1)/' DDOT '/
DATA L(2)/'DAXPY '/ DATA L(2)/'DAXPY '/
@ -73,6 +114,9 @@
DATA L(8)/'DASUM '/ DATA L(8)/'DASUM '/
DATA L(9)/'DSCAL '/ DATA L(9)/'DSCAL '/
DATA L(10)/'IDAMAX'/ DATA L(10)/'IDAMAX'/
DATA L(11)/'DROTMG'/
DATA L(12)/'DROTM '/
DATA L(13)/'DSDOT '/
* .. Executable Statements .. * .. Executable Statements ..
WRITE (NOUT,99999) ICASE, L(ICASE) WRITE (NOUT,99999) ICASE, L(ICASE)
RETURN RETURN
@ -86,18 +130,18 @@
* .. Scalar Arguments .. * .. Scalar Arguments ..
DOUBLE PRECISION SFAC DOUBLE PRECISION 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 ..
DOUBLE PRECISION D12, SA, SB, SC, SS DOUBLE PRECISION SA, SB, SC, SS, D12
INTEGER K INTEGER I, K
* .. Local Arrays .. * .. Local Arrays ..
DOUBLE PRECISION DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8), DOUBLE PRECISION DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
+ DS1(8) $ DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9)
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DROTG, STEST1 EXTERNAL DROTG, DROTMG, STEST1
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
DATA DA1/0.3D0, 0.4D0, -0.3D0, -0.4D0, -0.3D0, 0.0D0, DATA DA1/0.3D0, 0.4D0, -0.3D0, -0.4D0, -0.3D0, 0.0D0,
+ 0.0D0, 1.0D0/ + 0.0D0, 1.0D0/
@ -111,7 +155,52 @@
+ 0.0D0, 1.0D0, 1.0D0/ + 0.0D0, 1.0D0, 1.0D0/
DATA DBTRUE/0.0D0, 0.6D0, 0.0D0, -0.6D0, 0.0D0, DATA DBTRUE/0.0D0, 0.6D0, 0.0D0, -0.6D0, 0.0D0,
+ 0.0D0, 1.0D0, 0.0D0/ + 0.0D0, 1.0D0, 0.0D0/
DATA D12/4096.0D0/ * INPUT FOR MODIFIED GIVENS
DATA DAB/ .1D0,.3D0,1.2D0,.2D0,
A .7D0, .2D0, .6D0, 4.2D0,
B 0.D0,0.D0,0.D0,0.D0,
C 4.D0, -1.D0, 2.D0, 4.D0,
D 6.D-10, 2.D-2, 1.D5, 10.D0,
E 4.D10, 2.D-2, 1.D-5, 10.D0,
F 2.D-10, 4.D-2, 1.D5, 10.D0,
G 2.D10, 4.D-2, 1.D-5, 10.D0,
H 4.D0, -2.D0, 8.D0, 4.D0 /
* TRUE RESULTS FOR MODIFIED GIVENS
DATA DTRUE/0.D0,0.D0, 1.3D0, .2D0, 0.D0,0.D0,0.D0, .5D0, 0.D0,
A 0.D0,0.D0, 4.5D0, 4.2D0, 1.D0, .5D0, 0.D0,0.D0,0.D0,
B 0.D0,0.D0,0.D0,0.D0, -2.D0, 0.D0,0.D0,0.D0,0.D0,
C 0.D0,0.D0,0.D0, 4.D0, -1.D0, 0.D0,0.D0,0.D0,0.D0,
D 0.D0, 15.D-3, 0.D0, 10.D0, -1.D0, 0.D0, -1.D-4,
E 0.D0, 1.D0,
F 0.D0,0.D0, 6144.D-5, 10.D0, -1.D0, 4096.D0, -1.D6,
G 0.D0, 1.D0,
H 0.D0,0.D0,15.D0,10.D0,-1.D0, 5.D-5, 0.D0,1.D0,0.D0,
I 0.D0,0.D0, 15.D0, 10.D0, -1. D0, 5.D5, -4096.D0,
J 1.D0, 4096.D-6,
K 0.D0,0.D0, 7.D0, 4.D0, 0.D0,0.D0, -.5D0, -.25D0, 0.D0/
* 4096 = 2 ** 12
DATA D12 /4096.D0/
DTRUE(1,1) = 12.D0 / 130.D0
DTRUE(2,1) = 36.D0 / 130.D0
DTRUE(7,1) = -1.D0 / 6.D0
DTRUE(1,2) = 14.D0 / 75.D0
DTRUE(2,2) = 49.D0 / 75.D0
DTRUE(9,2) = 1.D0 / 7.D0
DTRUE(1,5) = 45.D-11 * (D12 * D12)
DTRUE(3,5) = 4.D5 / (3.D0 * D12)
DTRUE(6,5) = 1.D0 / D12
DTRUE(8,5) = 1.D4 / (3.D0 * D12)
DTRUE(1,6) = 4.D10 / (1.5D0 * D12 * D12)
DTRUE(2,6) = 2.D-2 / 1.5D0
DTRUE(8,6) = 5.D-7 * D12
DTRUE(1,7) = 4.D0 / 150.D0
DTRUE(2,7) = (2.D-10 / 1.5D0) * (D12 * D12)
DTRUE(7,7) = -DTRUE(6,5)
DTRUE(9,7) = 1.D4 / D12
DTRUE(1,8) = DTRUE(1,7)
DTRUE(2,8) = 2.D10 / (1.5D0 * D12 * D12)
DTRUE(1,9) = 32.D0 / 7.D0
DTRUE(2,9) = -16.D0 / 7.D0
* .. Executable Statements .. * .. Executable Statements ..
* *
* Compute true values which cannot be prestored * Compute true values which cannot be prestored
@ -134,6 +223,15 @@
CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC) CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC)
CALL STEST1(SC,DC1(K),DC1(K),SFAC) CALL STEST1(SC,DC1(K),DC1(K),SFAC)
CALL STEST1(SS,DS1(K),DS1(K),SFAC) CALL STEST1(SS,DS1(K),DS1(K),SFAC)
ELSEIF (ICASE.EQ.11) THEN
* .. DROTMG ..
DO I=1,4
DTEMP(I)= DAB(I,K)
DTEMP(I+4) = 0.0
END DO
DTEMP(9) = 0.0
CALL DROTMG(DTEMP(1),DTEMP(2),DTEMP(3),DTEMP(4),DTEMP(5))
CALL STEST(9,DTEMP,DTRUE(1,K),DTRUE(1,K),SFAC)
ELSE ELSE
WRITE (NOUT,*) ' Shouldn''t be here in CHECK0' WRITE (NOUT,*) ' Shouldn''t be here in CHECK0'
STOP STOP
@ -148,7 +246,7 @@
* .. Scalar Arguments .. * .. Scalar Arguments ..
DOUBLE PRECISION SFAC DOUBLE PRECISION 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 ..
INTEGER I, LEN, NP1 INTEGER I, LEN, NP1
@ -165,7 +263,7 @@
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC MAX INTRINSIC MAX
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
DATA SA/0.3D0, -1.0D0, 0.0D0, 1.0D0, 0.3D0, 0.3D0, DATA SA/0.3D0, -1.0D0, 0.0D0, 1.0D0, 0.3D0, 0.3D0,
+ 0.3D0, 0.3D0, 0.3D0, 0.3D0/ + 0.3D0, 0.3D0, 0.3D0, 0.3D0/
@ -212,11 +310,11 @@
IF (ICASE.EQ.7) THEN IF (ICASE.EQ.7) THEN
* .. DNRM2 .. * .. DNRM2 ..
STEMP(1) = DTRUE1(NP1) STEMP(1) = DTRUE1(NP1)
CALL STEST1(DNRM2(N,SX,INCX),STEMP,STEMP,SFAC) CALL STEST1(DNRM2(N,SX,INCX),STEMP(1),STEMP,SFAC)
ELSE IF (ICASE.EQ.8) THEN ELSE IF (ICASE.EQ.8) THEN
* .. DASUM .. * .. DASUM ..
STEMP(1) = DTRUE3(NP1) STEMP(1) = DTRUE3(NP1)
CALL STEST1(DASUM(N,SX,INCX),STEMP,STEMP,SFAC) CALL STEST1(DASUM(N,SX,INCX),STEMP(1),STEMP,SFAC)
ELSE IF (ICASE.EQ.9) THEN ELSE IF (ICASE.EQ.9) THEN
* .. DSCAL .. * .. DSCAL ..
CALL DSCAL(N,SA((INCX-1)*5+NP1),SX,INCX) CALL DSCAL(N,SA((INCX-1)*5+NP1),SX,INCX)
@ -242,27 +340,39 @@
* .. Scalar Arguments .. * .. Scalar Arguments ..
DOUBLE PRECISION SFAC DOUBLE PRECISION 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 ..
DOUBLE PRECISION SA, SC, SS DOUBLE PRECISION SA
INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
$ MX, MY
* .. Local Arrays .. * .. Local Arrays ..
DOUBLE PRECISION DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4), DOUBLE PRECISION DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
+ DT8(7,4,4), DT9X(7,4,4), DT9Y(7,4,4), DX1(7), $ DT8(7,4,4), DX1(7),
+ DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7), $ DY1(7), SSIZE1(4), SSIZE2(14,2), SSIZE(7),
+ SX(7), SY(7) $ STX(7), STY(7), SX(7), SY(7),
$ DPAR(5,4), DT19X(7,4,16),DT19XA(7,4,4),
$ 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)
INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
* .. External Functions .. * .. External Functions ..
DOUBLE PRECISION DDOT DOUBLE PRECISION DDOT, DSDOT
EXTERNAL DDOT EXTERNAL DDOT, DSDOT
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DAXPY, DCOPY, DSWAP, STEST, STEST1 EXTERNAL DAXPY, DCOPY, DROTM, DSWAP, STEST, STEST1
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, MIN INTRINSIC ABS, MIN
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
EQUIVALENCE (DT19X(1,1,1),DT19XA(1,1,1)),(DT19X(1,1,5),
A DT19XB(1,1,1)),(DT19X(1,1,9),DT19XC(1,1,1)),
B (DT19X(1,1,13),DT19XD(1,1,1))
EQUIVALENCE (DT19Y(1,1,1),DT19YA(1,1,1)),(DT19Y(1,1,5),
A DT19YB(1,1,1)),(DT19Y(1,1,9),DT19YC(1,1,1)),
B (DT19Y(1,1,13),DT19YD(1,1,1))
DATA SA/0.3D0/ DATA SA/0.3D0/
DATA INCXS/1, 2, -2, -1/ DATA INCXS/1, 2, -2, -1/
DATA INCYS/1, -2, 1, -2/ DATA INCYS/1, -2, 1, -2/
@ -272,7 +382,6 @@
+ -0.4D0/ + -0.4D0/
DATA DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0, DATA DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0,
+ 0.8D0/ + 0.8D0/
DATA SC, SS/0.8D0, 0.6D0/
DATA DT7/0.0D0, 0.30D0, 0.21D0, 0.62D0, 0.0D0, DATA DT7/0.0D0, 0.30D0, 0.21D0, 0.62D0, 0.0D0,
+ 0.30D0, -0.07D0, 0.85D0, 0.0D0, 0.30D0, -0.79D0, + 0.30D0, -0.07D0, 0.85D0, 0.0D0, 0.30D0, -0.79D0,
+ -0.74D0, 0.0D0, 0.30D0, 0.33D0, 1.27D0/ + -0.74D0, 0.0D0, 0.30D0, 0.33D0, 1.27D0/
@ -295,44 +404,6 @@
+ 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0, + 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.7D0, + 0.0D0, 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.7D0,
+ -0.75D0, 0.2D0, 1.04D0/ + -0.75D0, 0.2D0, 1.04D0/
DATA DT9X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.78D0, -0.46D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.78D0, -0.46D0, -0.22D0,
+ 1.06D0, 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.78D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.66D0, 0.1D0, -0.1D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.96D0, 0.1D0, -0.76D0, 0.8D0, 0.90D0,
+ -0.3D0, -0.02D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.78D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.06D0, 0.1D0,
+ -0.1D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.90D0,
+ 0.1D0, -0.22D0, 0.8D0, 0.18D0, -0.3D0, -0.02D0,
+ 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.78D0, 0.26D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.78D0, 0.26D0, -0.76D0, 1.12D0,
+ 0.0D0, 0.0D0, 0.0D0/
DATA DT9Y/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.54D0,
+ 0.08D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.04D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.7D0,
+ -0.9D0, -0.12D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.64D0, -0.9D0, -0.30D0, 0.7D0, -0.18D0, 0.2D0,
+ 0.28D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.7D0, -1.08D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.64D0, -1.26D0,
+ 0.54D0, 0.20D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0,
+ 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.7D0,
+ -0.18D0, 0.2D0, 0.16D0/
DATA DT10X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, DATA DT10X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, + 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
+ 0.0D0, 0.5D0, -0.9D0, 0.0D0, 0.0D0, 0.0D0, + 0.0D0, 0.5D0, -0.9D0, 0.0D0, 0.0D0, 0.0D0,
@ -375,6 +446,150 @@
+ 0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, + 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, 1.17D0, 1.17D0, 1.17D0,
+ 1.17D0, 1.17D0, 1.17D0/ + 1.17D0, 1.17D0, 1.17D0/
*
* FOR DROTM
*
DATA DPAR/-2.D0, 0.D0,0.D0,0.D0,0.D0,
A -1.D0, 2.D0, -3.D0, -4.D0, 5.D0,
B 0.D0, 0.D0, 2.D0, -3.D0, 0.D0,
C 1.D0, 5.D0, 2.D0, 0.D0, -4.D0/
* TRUE X RESULTS F0R ROTATIONS DROTM
DATA DT19XA/.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
A .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
B .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
C .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
D .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
E -.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
F -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
G 3.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
H .6D0, .1D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
I -.8D0, 3.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
J -.9D0, 2.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
K 3.5D0, -.4D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
L .6D0, .1D0, -.5D0, .8D0, 0.D0,0.D0,0.D0,
M -.8D0, 3.8D0, -2.2D0, -1.2D0, 0.D0,0.D0,0.D0,
N -.9D0, 2.8D0, -1.4D0, -1.3D0, 0.D0,0.D0,0.D0,
O 3.5D0, -.4D0, -2.2D0, 4.7D0, 0.D0,0.D0,0.D0/
*
DATA DT19XB/.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
A .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
B .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
C .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
D .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
E -.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
F -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
G 3.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
H .6D0, .1D0, -.5D0, 0.D0,0.D0,0.D0,0.D0,
I 0.D0, .1D0, -3.0D0, 0.D0,0.D0,0.D0,0.D0,
J -.3D0, .1D0, -2.0D0, 0.D0,0.D0,0.D0,0.D0,
K 3.3D0, .1D0, -2.0D0, 0.D0,0.D0,0.D0,0.D0,
L .6D0, .1D0, -.5D0, .8D0, .9D0, -.3D0, -.4D0,
M -2.0D0, .1D0, 1.4D0, .8D0, .6D0, -.3D0, -2.8D0,
N -1.8D0, .1D0, 1.3D0, .8D0, 0.D0, -.3D0, -1.9D0,
O 3.8D0, .1D0, -3.1D0, .8D0, 4.8D0, -.3D0, -1.5D0 /
*
DATA DT19XC/.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
A .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
B .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
C .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
D .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
E -.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
F -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
G 3.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
H .6D0, .1D0, -.5D0, 0.D0,0.D0,0.D0,0.D0,
I 4.8D0, .1D0, -3.0D0, 0.D0,0.D0,0.D0,0.D0,
J 3.3D0, .1D0, -2.0D0, 0.D0,0.D0,0.D0,0.D0,
K 2.1D0, .1D0, -2.0D0, 0.D0,0.D0,0.D0,0.D0,
L .6D0, .1D0, -.5D0, .8D0, .9D0, -.3D0, -.4D0,
M -1.6D0, .1D0, -2.2D0, .8D0, 5.4D0, -.3D0, -2.8D0,
N -1.5D0, .1D0, -1.4D0, .8D0, 3.6D0, -.3D0, -1.9D0,
O 3.7D0, .1D0, -2.2D0, .8D0, 3.6D0, -.3D0, -1.5D0 /
*
DATA DT19XD/.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
A .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
B .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
C .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
D .6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
E -.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
F -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
G 3.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
H .6D0, .1D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
I -.8D0, -1.0D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
J -.9D0, -.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
K 3.5D0, .8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
L .6D0, .1D0, -.5D0, .8D0, 0.D0,0.D0,0.D0,
M -.8D0, -1.0D0, 1.4D0, -1.6D0, 0.D0,0.D0,0.D0,
N -.9D0, -.8D0, 1.3D0, -1.6D0, 0.D0,0.D0,0.D0,
O 3.5D0, .8D0, -3.1D0, 4.8D0, 0.D0,0.D0,0.D0/
* TRUE Y RESULTS FOR ROTATIONS DROTM
DATA DT19YA/.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
A .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
B .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
C .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
D .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
E .7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
F 1.7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
G -2.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
H .5D0, -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
I .7D0, -4.8D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
J 1.7D0, -.7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
K -2.6D0, 3.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
L .5D0, -.9D0, .3D0, .7D0, 0.D0,0.D0,0.D0,
M .7D0, -4.8D0, 3.0D0, 1.1D0, 0.D0,0.D0,0.D0,
N 1.7D0, -.7D0, -.7D0, 2.3D0, 0.D0,0.D0,0.D0,
O -2.6D0, 3.5D0, -.7D0, -3.6D0, 0.D0,0.D0,0.D0/
*
DATA DT19YB/.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
A .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
B .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
C .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
D .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
E .7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
F 1.7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
G -2.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
H .5D0, -.9D0, .3D0, 0.D0,0.D0,0.D0,0.D0,
I 4.0D0, -.9D0, -.3D0, 0.D0,0.D0,0.D0,0.D0,
J -.5D0, -.9D0, 1.5D0, 0.D0,0.D0,0.D0,0.D0,
K -1.5D0, -.9D0, -1.8D0, 0.D0,0.D0,0.D0,0.D0,
L .5D0, -.9D0, .3D0, .7D0, -.6D0, .2D0, .8D0,
M 3.7D0, -.9D0, -1.2D0, .7D0, -1.5D0, .2D0, 2.2D0,
N -.3D0, -.9D0, 2.1D0, .7D0, -1.6D0, .2D0, 2.0D0,
O -1.6D0, -.9D0, -2.1D0, .7D0, 2.9D0, .2D0, -3.8D0 /
*
DATA DT19YC/.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
A .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
B .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
C .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
D .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
E .7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
F 1.7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
G -2.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
H .5D0, -.9D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
I 4.0D0, -6.3D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
J -.5D0, .3D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
K -1.5D0, 3.0D0, 0.D0,0.D0,0.D0,0.D0,0.D0,
L .5D0, -.9D0, .3D0, .7D0, 0.D0,0.D0,0.D0,
M 3.7D0, -7.2D0, 3.0D0, 1.7D0, 0.D0,0.D0,0.D0,
N -.3D0, .9D0, -.7D0, 1.9D0, 0.D0,0.D0,0.D0,
O -1.6D0, 2.7D0, -.7D0, -3.4D0, 0.D0,0.D0,0.D0/
*
DATA DT19YD/.5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
A .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
B .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
C .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
D .5D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
E .7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
F 1.7D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
G -2.6D0, 0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
H .5D0, -.9D0, .3D0, 0.D0,0.D0,0.D0,0.D0,
I .7D0, -.9D0, 1.2D0, 0.D0,0.D0,0.D0,0.D0,
J 1.7D0, -.9D0, .5D0, 0.D0,0.D0,0.D0,0.D0,
K -2.6D0, -.9D0, -1.3D0, 0.D0,0.D0,0.D0,0.D0,
L .5D0, -.9D0, .3D0, .7D0, -.6D0, .2D0, .8D0,
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 /
*
* .. Executable Statements .. * .. Executable Statements ..
* *
DO 120 KI = 1, 4 DO 120 KI = 1, 4
@ -421,6 +636,39 @@
80 CONTINUE 80 CONTINUE
CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0D0) CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0D0)
CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0) CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0)
ELSE IF (ICASE.EQ.12) THEN
* .. DROTM ..
KNI=KN+4*(KI-1)
DO KPAR=1,4
DO I=1,7
SX(I) = DX1(I)
SY(I) = DY1(I)
STX(I)= DT19X(I,KPAR,KNI)
STY(I)= DT19Y(I,KPAR,KNI)
END DO
*
DO I=1,5
DTEMP(I) = DPAR(I,KPAR)
END DO
*
DO I=1,LENX
SSIZE(I)=STX(I)
END DO
* SEE REMARK ABOVE ABOUT DT11X(1,2,7)
* AND DT11X(5,3,8).
IF ((KPAR .EQ. 2) .AND. (KNI .EQ. 7))
$ SSIZE(1) = 2.4D0
IF ((KPAR .EQ. 3) .AND. (KNI .EQ. 8))
$ SSIZE(5) = 1.8D0
*
CALL DROTM(N,SX,INCX,SY,INCY,DTEMP)
CALL STEST(LENX,SX,STX,SSIZE,SFAC)
CALL STEST(LENY,SY,STY,STY,SFAC)
END DO
ELSE IF (ICASE.EQ.13) THEN
* .. DSDOT ..
CALL TESTDSDOT(REAL(DSDOT(N,REAL(SX),INCX,REAL(SY),INCY)),
$ REAL(DT7(KN,KI)),REAL(SSIZE1(KN)), .3125E-1)
ELSE ELSE
WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
STOP STOP
@ -436,10 +684,10 @@
* .. Scalar Arguments .. * .. Scalar Arguments ..
DOUBLE PRECISION SFAC DOUBLE PRECISION 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 ..
DOUBLE PRECISION SA, SC, SS DOUBLE PRECISION SC, SS
INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
* .. Local Arrays .. * .. Local Arrays ..
DOUBLE PRECISION COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4), DOUBLE PRECISION COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
@ -454,9 +702,8 @@
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, MIN INTRINSIC ABS, MIN
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
DATA SA/0.3D0/
DATA INCXS/1, 2, -2, -1/ DATA INCXS/1, 2, -2, -1/
DATA INCYS/1, -2, 1, -2/ DATA INCYS/1, -2, 1, -2/
DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
@ -647,14 +894,15 @@
* *
* .. Parameters .. * .. Parameters ..
INTEGER NOUT INTEGER NOUT
PARAMETER (NOUT=6) DOUBLE PRECISION ZERO
PARAMETER (NOUT=6, ZERO=0.0D0)
* .. Scalar Arguments .. * .. Scalar Arguments ..
DOUBLE PRECISION SFAC DOUBLE PRECISION SFAC
INTEGER LEN INTEGER LEN
* .. Array Arguments .. * .. Array Arguments ..
DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN) DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
* .. 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 ..
DOUBLE PRECISION SD DOUBLE PRECISION SD
@ -665,12 +913,12 @@
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS INTRINSIC ABS
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Executable Statements .. * .. Executable Statements ..
* *
DO 40 I = 1, LEN DO 40 I = 1, LEN
SD = SCOMP(I) - STRUE(I) SD = SCOMP(I) - STRUE(I)
IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0) IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
+ GO TO 40 + GO TO 40
* *
* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
@ -680,16 +928,64 @@
PASS = .FALSE. PASS = .FALSE.
WRITE (NOUT,99999) WRITE (NOUT,99999)
WRITE (NOUT,99998) WRITE (NOUT,99998)
20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I), 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, I, SCOMP(I),
+ STRUE(I), SD, SSIZE(I) + STRUE(I), SD, SSIZE(I)
40 CONTINUE 40 CONTINUE
RETURN RETURN
* *
99999 FORMAT (' FAIL') 99999 FORMAT (' FAIL')
99998 FORMAT (/' CASE N INCX INCY MODE I ', 99998 FORMAT (/' CASE N INCX INCY I ',
+ ' COMP(I) TRUE(I) DIFFERENCE', + ' COMP(I) TRUE(I) DIFFERENCE',
+ ' SIZE(I)',/1X) + ' SIZE(I)',/1X)
99997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4) 99997 FORMAT (1X,I4,I3,2I5,I3,2D36.8,2D12.4)
END
SUBROUTINE TESTDSDOT(SCOMP,STRUE,SSIZE,SFAC)
* ********************************* STEST **************************
*
* THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
* SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
* NEGLIGIBLE.
*
* C. L. LAWSON, JPL, 1974 DEC 10
*
* .. Parameters ..
INTEGER NOUT
REAL ZERO
PARAMETER (NOUT=6, ZERO=0.0E0)
* .. Scalar Arguments ..
REAL SFAC, SCOMP, SSIZE, STRUE
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
REAL SD
* .. Intrinsic Functions ..
INTRINSIC ABS
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Executable Statements ..
*
SD = SCOMP - STRUE
IF (ABS(SFAC*SD) .LE. ABS(SSIZE) * EPSILON(ZERO))
+ GO TO 40
*
* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
*
IF ( .NOT. PASS) GO TO 20
* PRINT FAIL MESSAGE AND HEADER.
PASS = .FALSE.
WRITE (NOUT,99999)
WRITE (NOUT,99998)
20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, SCOMP,
+ STRUE, SD, SSIZE
40 CONTINUE
RETURN
*
99999 FORMAT (' FAIL')
99998 FORMAT (/' CASE N INCX INCY ',
+ ' COMP(I) TRUE(I) DIFFERENCE',
+ ' SIZE(I)',/1X)
99997 FORMAT (1X,I4,I3,1I5,I3,2E36.8,2E12.4)
END END
SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
* ************************* STEST1 ***************************** * ************************* STEST1 *****************************
@ -739,12 +1035,12 @@
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER ICOMP, ITRUE INTEGER ICOMP, ITRUE
* .. 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 ..
INTEGER ID INTEGER ID
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Executable Statements .. * .. Executable Statements ..
* *
IF (ICOMP.EQ.ITRUE) GO TO 40 IF (ICOMP.EQ.ITRUE) GO TO 40
@ -757,13 +1053,13 @@
WRITE (NOUT,99999) WRITE (NOUT,99999)
WRITE (NOUT,99998) WRITE (NOUT,99998)
20 ID = ICOMP - ITRUE 20 ID = ICOMP - ITRUE
WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID WRITE (NOUT,99997) ICASE, N, INCX, INCY, ICOMP, ITRUE, ID
40 CONTINUE 40 CONTINUE
RETURN RETURN
* *
99999 FORMAT (' FAIL') 99999 FORMAT (' FAIL')
99998 FORMAT (/' CASE N INCX INCY MODE ', 99998 FORMAT (/' CASE N INCX INCY ',
+ ' COMP TRUE DIFFERENCE', + ' COMP TRUE DIFFERENCE',
+ /1X) + /1X)
99997 FORMAT (1X,I4,I3,3I5,2I36,I12) 99997 FORMAT (1X,I4,I3,2I5,2I36,I12)
END END

430
blas/testing/sblat1.f
View File

@ -1,12 +1,54 @@
*> \brief \b SBLAT1
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* PROGRAM SBLAT1
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> Test program for the REAL Level 1 BLAS.
*>
*> Based upon the original BLAS test routine together with:
*> F06EAF Example Program Text
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup single_blas_testing
*
* =====================================================================
PROGRAM SBLAT1 PROGRAM SBLAT1
* Test program for the REAL Level 1 BLAS. *
* Based upon the original BLAS test routine together with: * -- Reference BLAS test routine (version 3.4.1) --
* F06EAF Example Program Text * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*
* =====================================================================
*
* .. Parameters .. * .. Parameters ..
INTEGER NOUT INTEGER NOUT
PARAMETER (NOUT=6) PARAMETER (NOUT=6)
* .. 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 SFAC REAL SFAC
@ -14,31 +56,30 @@
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
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, 13
ICASE = IC ICASE = IC
CALL HEADER CALL HEADER
* *
* .. Initialize PASS, INCX, INCY, and MODE for a new case. .. * .. Initialize PASS, INCX, and INCY for a new case. ..
* .. the value 9999 for INCX, INCY or MODE will appear in the .. * .. the value 9999 for INCX or INCY will appear in the ..
* .. detailed output, if any, for cases that do not involve .. * .. detailed output, if any, for cases that do not involve ..
* .. these parameters .. * .. these parameters ..
* *
PASS = .TRUE. PASS = .TRUE.
INCX = 9999 INCX = 9999
INCY = 9999 INCY = 9999
MODE = 9999 IF (ICASE.EQ.3 .OR. ICASE.EQ.11) THEN
IF (ICASE.EQ.3) THEN
CALL CHECK0(SFAC) CALL CHECK0(SFAC)
ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR. ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR.
+ ICASE.EQ.10) THEN + ICASE.EQ.10) THEN
CALL CHECK1(SFAC) CALL CHECK1(SFAC)
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 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13) THEN
CALL CHECK2(SFAC) CALL CHECK2(SFAC)
ELSE IF (ICASE.EQ.4) THEN ELSE IF (ICASE.EQ.4) THEN
CALL CHECK3(SFAC) CALL CHECK3(SFAC)
@ -56,12 +97,12 @@
INTEGER NOUT INTEGER NOUT
PARAMETER (NOUT=6) PARAMETER (NOUT=6)
* .. Scalars in Common .. * .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N INTEGER ICASE, INCX, INCY, N
LOGICAL PASS LOGICAL PASS
* .. Local Arrays .. * .. Local Arrays ..
CHARACTER*6 L(10) CHARACTER*6 L(13)
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
DATA L(1)/' SDOT '/ DATA L(1)/' SDOT '/
DATA L(2)/'SAXPY '/ DATA L(2)/'SAXPY '/
@ -73,6 +114,9 @@
DATA L(8)/'SASUM '/ DATA L(8)/'SASUM '/
DATA L(9)/'SSCAL '/ DATA L(9)/'SSCAL '/
DATA L(10)/'ISAMAX'/ DATA L(10)/'ISAMAX'/
DATA L(11)/'SROTMG'/
DATA L(12)/'SROTM '/
DATA L(13)/'SDSDOT'/
* .. Executable Statements .. * .. Executable Statements ..
WRITE (NOUT,99999) ICASE, L(ICASE) WRITE (NOUT,99999) ICASE, L(ICASE)
RETURN RETURN
@ -86,18 +130,18 @@
* .. 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 D12, SA, SB, SC, SS REAL D12, SA, SB, SC, SS
INTEGER K INTEGER I, K
* .. Local Arrays .. * .. Local Arrays ..
REAL DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8), REAL DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
+ DS1(8) + DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9)
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SROTG, STEST1 EXTERNAL SROTG, SROTMG, STEST1
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
DATA DA1/0.3E0, 0.4E0, -0.3E0, -0.4E0, -0.3E0, 0.0E0, DATA DA1/0.3E0, 0.4E0, -0.3E0, -0.4E0, -0.3E0, 0.0E0,
+ 0.0E0, 1.0E0/ + 0.0E0, 1.0E0/
@ -111,7 +155,52 @@
+ 0.0E0, 1.0E0, 1.0E0/ + 0.0E0, 1.0E0, 1.0E0/
DATA DBTRUE/0.0E0, 0.6E0, 0.0E0, -0.6E0, 0.0E0, DATA DBTRUE/0.0E0, 0.6E0, 0.0E0, -0.6E0, 0.0E0,
+ 0.0E0, 1.0E0, 0.0E0/ + 0.0E0, 1.0E0, 0.0E0/
DATA D12/4096.0E0/ * INPUT FOR MODIFIED GIVENS
DATA DAB/ .1E0,.3E0,1.2E0,.2E0,
A .7E0, .2E0, .6E0, 4.2E0,
B 0.E0,0.E0,0.E0,0.E0,
C 4.E0, -1.E0, 2.E0, 4.E0,
D 6.E-10, 2.E-2, 1.E5, 10.E0,
E 4.E10, 2.E-2, 1.E-5, 10.E0,
F 2.E-10, 4.E-2, 1.E5, 10.E0,
G 2.E10, 4.E-2, 1.E-5, 10.E0,
H 4.E0, -2.E0, 8.E0, 4.E0 /
* TRUE RESULTS FOR MODIFIED GIVENS
DATA DTRUE/0.E0,0.E0, 1.3E0, .2E0, 0.E0,0.E0,0.E0, .5E0, 0.E0,
A 0.E0,0.E0, 4.5E0, 4.2E0, 1.E0, .5E0, 0.E0,0.E0,0.E0,
B 0.E0,0.E0,0.E0,0.E0, -2.E0, 0.E0,0.E0,0.E0,0.E0,
C 0.E0,0.E0,0.E0, 4.E0, -1.E0, 0.E0,0.E0,0.E0,0.E0,
D 0.E0, 15.E-3, 0.E0, 10.E0, -1.E0, 0.E0, -1.E-4,
E 0.E0, 1.E0,
F 0.E0,0.E0, 6144.E-5, 10.E0, -1.E0, 4096.E0, -1.E6,
G 0.E0, 1.E0,
H 0.E0,0.E0,15.E0,10.E0,-1.E0, 5.E-5, 0.E0,1.E0,0.E0,
I 0.E0,0.E0, 15.E0, 10.E0, -1. E0, 5.E5, -4096.E0,
J 1.E0, 4096.E-6,
K 0.E0,0.E0, 7.E0, 4.E0, 0.E0,0.E0, -.5E0, -.25E0, 0.E0/
* 4096 = 2 ** 12
DATA D12 /4096.E0/
DTRUE(1,1) = 12.E0 / 130.E0
DTRUE(2,1) = 36.E0 / 130.E0
DTRUE(7,1) = -1.E0 / 6.E0
DTRUE(1,2) = 14.E0 / 75.E0
DTRUE(2,2) = 49.E0 / 75.E0
DTRUE(9,2) = 1.E0 / 7.E0
DTRUE(1,5) = 45.E-11 * (D12 * D12)
DTRUE(3,5) = 4.E5 / (3.E0 * D12)
DTRUE(6,5) = 1.E0 / D12
DTRUE(8,5) = 1.E4 / (3.E0 * D12)
DTRUE(1,6) = 4.E10 / (1.5E0 * D12 * D12)
DTRUE(2,6) = 2.E-2 / 1.5E0
DTRUE(8,6) = 5.E-7 * D12
DTRUE(1,7) = 4.E0 / 150.E0
DTRUE(2,7) = (2.E-10 / 1.5E0) * (D12 * D12)
DTRUE(7,7) = -DTRUE(6,5)
DTRUE(9,7) = 1.E4 / D12
DTRUE(1,8) = DTRUE(1,7)
DTRUE(2,8) = 2.E10 / (1.5E0 * D12 * D12)
DTRUE(1,9) = 32.E0 / 7.E0
DTRUE(2,9) = -16.E0 / 7.E0
* .. Executable Statements .. * .. Executable Statements ..
* *
* Compute true values which cannot be prestored * Compute true values which cannot be prestored
@ -134,6 +223,15 @@
CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC) CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC)
CALL STEST1(SC,DC1(K),DC1(K),SFAC) CALL STEST1(SC,DC1(K),DC1(K),SFAC)
CALL STEST1(SS,DS1(K),DS1(K),SFAC) CALL STEST1(SS,DS1(K),DS1(K),SFAC)
ELSEIF (ICASE.EQ.11) THEN
* .. SROTMG ..
DO I=1,4
DTEMP(I)= DAB(I,K)
DTEMP(I+4) = 0.0
END DO
DTEMP(9) = 0.0
CALL SROTMG(DTEMP(1),DTEMP(2),DTEMP(3),DTEMP(4),DTEMP(5))
CALL STEST(9,DTEMP,DTRUE(1,K),DTRUE(1,K),SFAC)
ELSE ELSE
WRITE (NOUT,*) ' Shouldn''t be here in CHECK0' WRITE (NOUT,*) ' Shouldn''t be here in CHECK0'
STOP STOP
@ -148,7 +246,7 @@
* .. 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 ..
INTEGER I, LEN, NP1 INTEGER I, LEN, NP1
@ -165,7 +263,7 @@
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC MAX INTRINSIC MAX
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
DATA SA/0.3E0, -1.0E0, 0.0E0, 1.0E0, 0.3E0, 0.3E0, DATA SA/0.3E0, -1.0E0, 0.0E0, 1.0E0, 0.3E0, 0.3E0,
+ 0.3E0, 0.3E0, 0.3E0, 0.3E0/ + 0.3E0, 0.3E0, 0.3E0, 0.3E0/
@ -212,11 +310,11 @@
IF (ICASE.EQ.7) THEN IF (ICASE.EQ.7) THEN
* .. SNRM2 .. * .. SNRM2 ..
STEMP(1) = DTRUE1(NP1) STEMP(1) = DTRUE1(NP1)
CALL STEST1(SNRM2(N,SX,INCX),STEMP,STEMP,SFAC) CALL STEST1(SNRM2(N,SX,INCX),STEMP(1),STEMP,SFAC)
ELSE IF (ICASE.EQ.8) THEN ELSE IF (ICASE.EQ.8) THEN
* .. SASUM .. * .. SASUM ..
STEMP(1) = DTRUE3(NP1) STEMP(1) = DTRUE3(NP1)
CALL STEST1(SASUM(N,SX,INCX),STEMP,STEMP,SFAC) CALL STEST1(SASUM(N,SX,INCX),STEMP(1),STEMP,SFAC)
ELSE IF (ICASE.EQ.9) THEN ELSE IF (ICASE.EQ.9) THEN
* .. SSCAL .. * .. SSCAL ..
CALL SSCAL(N,SA((INCX-1)*5+NP1),SX,INCX) CALL SSCAL(N,SA((INCX-1)*5+NP1),SX,INCX)
@ -242,27 +340,40 @@
* .. 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 SA, SC, SS REAL SA
INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
$ MX, MY
* .. Local Arrays .. * .. Local Arrays ..
REAL DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4), REAL DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
+ DT8(7,4,4), DT9X(7,4,4), DT9Y(7,4,4), DX1(7), $ DT8(7,4,4), DX1(7),
+ DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7), $ DY1(7), SSIZE1(4), SSIZE2(14,2), SSIZE3(4),
+ SX(7), SY(7) $ SSIZE(7), STX(7), STY(7), SX(7), SY(7),
$ DPAR(5,4), DT19X(7,4,16),DT19XA(7,4,4),
$ 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)
INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4) INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
* .. External Functions .. * .. External Functions ..
REAL SDOT REAL SDOT, SDSDOT
EXTERNAL SDOT EXTERNAL SDOT, SDSDOT
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SAXPY, SCOPY, SSWAP, STEST, STEST1 EXTERNAL SAXPY, SCOPY, SROTM, SSWAP, STEST, STEST1
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, MIN INTRINSIC ABS, MIN
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
EQUIVALENCE (DT19X(1,1,1),DT19XA(1,1,1)),(DT19X(1,1,5),
A DT19XB(1,1,1)),(DT19X(1,1,9),DT19XC(1,1,1)),
B (DT19X(1,1,13),DT19XD(1,1,1))
EQUIVALENCE (DT19Y(1,1,1),DT19YA(1,1,1)),(DT19Y(1,1,5),
A DT19YB(1,1,1)),(DT19Y(1,1,9),DT19YC(1,1,1)),
B (DT19Y(1,1,13),DT19YD(1,1,1))
DATA SA/0.3E0/ DATA SA/0.3E0/
DATA INCXS/1, 2, -2, -1/ DATA INCXS/1, 2, -2, -1/
DATA INCYS/1, -2, 1, -2/ DATA INCYS/1, -2, 1, -2/
@ -272,10 +383,11 @@
+ -0.4E0/ + -0.4E0/
DATA DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0, DATA DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
+ 0.8E0/ + 0.8E0/
DATA SC, SS/0.8E0, 0.6E0/
DATA DT7/0.0E0, 0.30E0, 0.21E0, 0.62E0, 0.0E0, DATA DT7/0.0E0, 0.30E0, 0.21E0, 0.62E0, 0.0E0,
+ 0.30E0, -0.07E0, 0.85E0, 0.0E0, 0.30E0, -0.79E0, + 0.30E0, -0.07E0, 0.85E0, 0.0E0, 0.30E0, -0.79E0,
+ -0.74E0, 0.0E0, 0.30E0, 0.33E0, 1.27E0/ + -0.74E0, 0.0E0, 0.30E0, 0.33E0, 1.27E0/
DATA ST7B/ .1, .4, .31, .72, .1, .4, .03, .95,
+ .1, .4, -.69, -.64, .1, .4, .43, 1.37/
DATA DT8/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, DATA DT8/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+ 0.0E0, 0.68E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + 0.0E0, 0.68E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+ 0.0E0, 0.0E0, 0.68E0, -0.87E0, 0.0E0, 0.0E0, + 0.0E0, 0.0E0, 0.68E0, -0.87E0, 0.0E0, 0.0E0,
@ -295,44 +407,6 @@
+ 0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.0E0, 0.0E0, + 0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.0E0, 0.0E0,
+ 0.0E0, 0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.7E0, + 0.0E0, 0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.7E0,
+ -0.75E0, 0.2E0, 1.04E0/ + -0.75E0, 0.2E0, 1.04E0/
DATA DT9X/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.46E0, 0.0E0, 0.0E0,
+ 0.0E0, 0.0E0, 0.0E0, 0.78E0, -0.46E0, -0.22E0,
+ 1.06E0, 0.0E0, 0.0E0, 0.0E0, 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.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 DT10X/0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, DATA DT10X/0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+ 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, + 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
+ 0.0E0, 0.5E0, -0.9E0, 0.0E0, 0.0E0, 0.0E0, + 0.0E0, 0.5E0, -0.9E0, 0.0E0, 0.0E0, 0.0E0,
@ -375,6 +449,151 @@
+ 0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, + 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/
DATA SSIZE3/ .1, .4, 1.7, 3.3 /
*
* FOR DROTM
*
DATA DPAR/-2.E0, 0.E0,0.E0,0.E0,0.E0,
A -1.E0, 2.E0, -3.E0, -4.E0, 5.E0,
B 0.E0, 0.E0, 2.E0, -3.E0, 0.E0,
C 1.E0, 5.E0, 2.E0, 0.E0, -4.E0/
* TRUE X RESULTS F0R ROTATIONS DROTM
DATA DT19XA/.6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
A .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
B .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
C .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
D .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
E -.8E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
F -.9E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
G 3.5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
H .6E0, .1E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
I -.8E0, 3.8E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
J -.9E0, 2.8E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
K 3.5E0, -.4E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
L .6E0, .1E0, -.5E0, .8E0, 0.E0,0.E0,0.E0,
M -.8E0, 3.8E0, -2.2E0, -1.2E0, 0.E0,0.E0,0.E0,
N -.9E0, 2.8E0, -1.4E0, -1.3E0, 0.E0,0.E0,0.E0,
O 3.5E0, -.4E0, -2.2E0, 4.7E0, 0.E0,0.E0,0.E0/
*
DATA DT19XB/.6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
A .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
B .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
C .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
D .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
E -.8E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
F -.9E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
G 3.5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
H .6E0, .1E0, -.5E0, 0.E0,0.E0,0.E0,0.E0,
I 0.E0, .1E0, -3.0E0, 0.E0,0.E0,0.E0,0.E0,
J -.3E0, .1E0, -2.0E0, 0.E0,0.E0,0.E0,0.E0,
K 3.3E0, .1E0, -2.0E0, 0.E0,0.E0,0.E0,0.E0,
L .6E0, .1E0, -.5E0, .8E0, .9E0, -.3E0, -.4E0,
M -2.0E0, .1E0, 1.4E0, .8E0, .6E0, -.3E0, -2.8E0,
N -1.8E0, .1E0, 1.3E0, .8E0, 0.E0, -.3E0, -1.9E0,
O 3.8E0, .1E0, -3.1E0, .8E0, 4.8E0, -.3E0, -1.5E0 /
*
DATA DT19XC/.6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
A .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
B .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
C .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
D .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
E -.8E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
F -.9E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
G 3.5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
H .6E0, .1E0, -.5E0, 0.E0,0.E0,0.E0,0.E0,
I 4.8E0, .1E0, -3.0E0, 0.E0,0.E0,0.E0,0.E0,
J 3.3E0, .1E0, -2.0E0, 0.E0,0.E0,0.E0,0.E0,
K 2.1E0, .1E0, -2.0E0, 0.E0,0.E0,0.E0,0.E0,
L .6E0, .1E0, -.5E0, .8E0, .9E0, -.3E0, -.4E0,
M -1.6E0, .1E0, -2.2E0, .8E0, 5.4E0, -.3E0, -2.8E0,
N -1.5E0, .1E0, -1.4E0, .8E0, 3.6E0, -.3E0, -1.9E0,
O 3.7E0, .1E0, -2.2E0, .8E0, 3.6E0, -.3E0, -1.5E0 /
*
DATA DT19XD/.6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
A .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
B .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
C .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
D .6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
E -.8E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
F -.9E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
G 3.5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
H .6E0, .1E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
I -.8E0, -1.0E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
J -.9E0, -.8E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
K 3.5E0, .8E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
L .6E0, .1E0, -.5E0, .8E0, 0.E0,0.E0,0.E0,
M -.8E0, -1.0E0, 1.4E0, -1.6E0, 0.E0,0.E0,0.E0,
N -.9E0, -.8E0, 1.3E0, -1.6E0, 0.E0,0.E0,0.E0,
O 3.5E0, .8E0, -3.1E0, 4.8E0, 0.E0,0.E0,0.E0/
* TRUE Y RESULTS FOR ROTATIONS DROTM
DATA DT19YA/.5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
A .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
B .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
C .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
D .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
E .7E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
F 1.7E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
G -2.6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
H .5E0, -.9E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
I .7E0, -4.8E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
J 1.7E0, -.7E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
K -2.6E0, 3.5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
L .5E0, -.9E0, .3E0, .7E0, 0.E0,0.E0,0.E0,
M .7E0, -4.8E0, 3.0E0, 1.1E0, 0.E0,0.E0,0.E0,
N 1.7E0, -.7E0, -.7E0, 2.3E0, 0.E0,0.E0,0.E0,
O -2.6E0, 3.5E0, -.7E0, -3.6E0, 0.E0,0.E0,0.E0/
*
DATA DT19YB/.5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
A .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
B .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
C .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
D .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
E .7E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
F 1.7E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
G -2.6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
H .5E0, -.9E0, .3E0, 0.E0,0.E0,0.E0,0.E0,
I 4.0E0, -.9E0, -.3E0, 0.E0,0.E0,0.E0,0.E0,
J -.5E0, -.9E0, 1.5E0, 0.E0,0.E0,0.E0,0.E0,
K -1.5E0, -.9E0, -1.8E0, 0.E0,0.E0,0.E0,0.E0,
L .5E0, -.9E0, .3E0, .7E0, -.6E0, .2E0, .8E0,
M 3.7E0, -.9E0, -1.2E0, .7E0, -1.5E0, .2E0, 2.2E0,
N -.3E0, -.9E0, 2.1E0, .7E0, -1.6E0, .2E0, 2.0E0,
O -1.6E0, -.9E0, -2.1E0, .7E0, 2.9E0, .2E0, -3.8E0 /
*
DATA DT19YC/.5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
A .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
B .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
C .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
D .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
E .7E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
F 1.7E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
G -2.6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
H .5E0, -.9E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
I 4.0E0, -6.3E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
J -.5E0, .3E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
K -1.5E0, 3.0E0, 0.E0,0.E0,0.E0,0.E0,0.E0,
L .5E0, -.9E0, .3E0, .7E0, 0.E0,0.E0,0.E0,
M 3.7E0, -7.2E0, 3.0E0, 1.7E0, 0.E0,0.E0,0.E0,
N -.3E0, .9E0, -.7E0, 1.9E0, 0.E0,0.E0,0.E0,
O -1.6E0, 2.7E0, -.7E0, -3.4E0, 0.E0,0.E0,0.E0/
*
DATA DT19YD/.5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
A .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
B .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
C .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
D .5E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
E .7E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
F 1.7E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
G -2.6E0, 0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
H .5E0, -.9E0, .3E0, 0.E0,0.E0,0.E0,0.E0,
I .7E0, -.9E0, 1.2E0, 0.E0,0.E0,0.E0,0.E0,
J 1.7E0, -.9E0, .5E0, 0.E0,0.E0,0.E0,0.E0,
K -2.6E0, -.9E0, -1.3E0, 0.E0,0.E0,0.E0,0.E0,
L .5E0, -.9E0, .3E0, .7E0, -.6E0, .2E0, .8E0,
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 /
*
* .. Executable Statements .. * .. Executable Statements ..
* *
DO 120 KI = 1, 4 DO 120 KI = 1, 4
@ -421,6 +640,39 @@
80 CONTINUE 80 CONTINUE
CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0E0) CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0E0)
CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0) CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0)
ELSEIF (ICASE.EQ.12) THEN
* .. SROTM ..
KNI=KN+4*(KI-1)
DO KPAR=1,4
DO I=1,7
SX(I) = DX1(I)
SY(I) = DY1(I)
STX(I)= DT19X(I,KPAR,KNI)
STY(I)= DT19Y(I,KPAR,KNI)
END DO
*
DO I=1,5
DTEMP(I) = DPAR(I,KPAR)
END DO
*
DO I=1,LENX
SSIZE(I)=STX(I)
END DO
* SEE REMARK ABOVE ABOUT DT11X(1,2,7)
* AND DT11X(5,3,8).
IF ((KPAR .EQ. 2) .AND. (KNI .EQ. 7))
$ SSIZE(1) = 2.4E0
IF ((KPAR .EQ. 3) .AND. (KNI .EQ. 8))
$ SSIZE(5) = 1.8E0
*
CALL SROTM(N,SX,INCX,SY,INCY,DTEMP)
CALL STEST(LENX,SX,STX,SSIZE,SFAC)
CALL STEST(LENY,SY,STY,STY,SFAC)
END DO
ELSEIF (ICASE.EQ.13) THEN
* .. SDSROT ..
CALL STEST1 (SDSDOT(N,.1,SX,INCX,SY,INCY),
$ ST7B(KN,KI),SSIZE3(KN),SFAC)
ELSE ELSE
WRITE (NOUT,*) ' Shouldn''t be here in CHECK2' WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
STOP STOP
@ -436,10 +688,10 @@
* .. 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 SA, SC, SS REAL SC, SS
INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
* .. Local Arrays .. * .. Local Arrays ..
REAL COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4), REAL COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
@ -454,9 +706,8 @@
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, MIN INTRINSIC ABS, MIN
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements .. * .. Data statements ..
DATA SA/0.3E0/
DATA INCXS/1, 2, -2, -1/ DATA INCXS/1, 2, -2, -1/
DATA INCYS/1, -2, 1, -2/ DATA INCYS/1, -2, 1, -2/
DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/ DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
@ -647,14 +898,15 @@
* *
* .. Parameters .. * .. Parameters ..
INTEGER NOUT INTEGER NOUT
PARAMETER (NOUT=6) REAL ZERO
PARAMETER (NOUT=6, ZERO=0.0E0)
* .. Scalar Arguments .. * .. Scalar Arguments ..
REAL SFAC REAL SFAC
INTEGER LEN INTEGER LEN
* .. Array Arguments .. * .. Array Arguments ..
REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN) REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
* .. 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 SD REAL SD
@ -665,12 +917,12 @@
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS INTRINSIC ABS
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Executable Statements .. * .. Executable Statements ..
* *
DO 40 I = 1, LEN DO 40 I = 1, LEN
SD = SCOMP(I) - STRUE(I) SD = SCOMP(I) - STRUE(I)
IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0) IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
+ GO TO 40 + GO TO 40
* *
* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
@ -680,16 +932,16 @@
PASS = .FALSE. PASS = .FALSE.
WRITE (NOUT,99999) WRITE (NOUT,99999)
WRITE (NOUT,99998) WRITE (NOUT,99998)
20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I), 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, I, SCOMP(I),
+ STRUE(I), SD, SSIZE(I) + STRUE(I), SD, SSIZE(I)
40 CONTINUE 40 CONTINUE
RETURN RETURN
* *
99999 FORMAT (' FAIL') 99999 FORMAT (' FAIL')
99998 FORMAT (/' CASE N INCX INCY MODE I ', 99998 FORMAT (/' CASE N INCX INCY I ',
+ ' COMP(I) TRUE(I) DIFFERENCE', + ' COMP(I) TRUE(I) DIFFERENCE',
+ ' SIZE(I)',/1X) + ' SIZE(I)',/1X)
99997 FORMAT (1X,I4,I3,3I5,I3,2E36.8,2E12.4) 99997 FORMAT (1X,I4,I3,2I5,I3,2E36.8,2E12.4)
END END
SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
* ************************* STEST1 ***************************** * ************************* STEST1 *****************************
@ -739,12 +991,12 @@
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER ICOMP, ITRUE INTEGER ICOMP, ITRUE
* .. 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 ..
INTEGER ID INTEGER ID
* .. Common blocks .. * .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Executable Statements .. * .. Executable Statements ..
* *
IF (ICOMP.EQ.ITRUE) GO TO 40 IF (ICOMP.EQ.ITRUE) GO TO 40
@ -757,13 +1009,13 @@
WRITE (NOUT,99999) WRITE (NOUT,99999)
WRITE (NOUT,99998) WRITE (NOUT,99998)
20 ID = ICOMP - ITRUE 20 ID = ICOMP - ITRUE
WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID WRITE (NOUT,99997) ICASE, N, INCX, INCY, ICOMP, ITRUE, ID
40 CONTINUE 40 CONTINUE
RETURN RETURN
* *
99999 FORMAT (' FAIL') 99999 FORMAT (' FAIL')
99998 FORMAT (/' CASE N INCX INCY MODE ', 99998 FORMAT (/' CASE N INCX INCY ',
+ ' COMP TRUE DIFFERENCE', + ' COMP TRUE DIFFERENCE',
+ /1X) + /1X)
99997 FORMAT (1X,I4,I3,3I5,2I36,I12) 99997 FORMAT (1X,I4,I3,2I5,2I36,I12)
END END