OSchip
/
OpenBLAS
Not watched
1
0
Fork 0
Code
Releases 66 Wiki evaluate Activity
Issues 0 Pull Requests 0 Datasets Model Cloudbrain HPC
Browse Source

Update single and double precision BLAS1 tests from LAPACK 3.8.0 

adding tests for SROTMG, SROTM, SDSDOT, DROTMG, DROTM, DSDOT
tags/v0.3.0
Martin Kroeker GitHub 7 years ago
parent
798f1595d5
commit
53026dc63a
No known key found for this signature in database GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 728 additions and 179 deletions
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +387
    -90
      test/dblat1.f
  2. +341
    -89
      test/sblat1.f

+ 387
- 90
test/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
* Test program for the DOUBLE PRECISION Level 1 BLAS.
* Based upon the original BLAS test routine together with:
* F06EAF Example Program Text
*
* -- Reference BLAS test 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..--
* April 2012
*
* =====================================================================
*
* .. Parameters ..
INTEGER NOUT
PARAMETER (NOUT=6)
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
DOUBLE PRECISION SFAC
@@ -14,31 +56,30 @@
* .. External Subroutines ..
EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
DATA SFAC/9.765625D-4/
* .. Executable Statements ..
WRITE (NOUT,99999)
DO 20 IC = 1, 10
DO 20 IC = 1, 13
ICASE = IC
CALL HEADER
*
* .. Initialize PASS, INCX, INCY, and MODE for a new case. ..
* .. the value 9999 for INCX, INCY or MODE will appear in the ..
* .. Initialize PASS, INCX, and INCY for a new case. ..
* .. the value 9999 for INCX or INCY will appear in the ..
* .. detailed output, if any, for cases that do not involve ..
* .. these parameters ..
*
PASS = .TRUE.
INCX = 9999
INCY = 9999
MODE = 9999
IF (ICASE.EQ.3) THEN
IF (ICASE.EQ.3 .OR. ICASE.EQ.11) THEN
CALL CHECK0(SFAC)
ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR.
+ 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.12 .OR. ICASE.EQ.13) THEN
CALL CHECK2(SFAC)
ELSE IF (ICASE.EQ.4) THEN
CALL CHECK3(SFAC)
@@ -56,12 +97,12 @@
INTEGER NOUT
PARAMETER (NOUT=6)
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Arrays ..
CHARACTER*6 L(10)
CHARACTER*6 L(13)
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
DATA L(1)/' DDOT '/
DATA L(2)/'DAXPY '/
@@ -73,6 +114,9 @@
DATA L(8)/'DASUM '/
DATA L(9)/'DSCAL '/
DATA L(10)/'IDAMAX'/
DATA L(11)/'DROTMG'/
DATA L(12)/'DROTM '/
DATA L(13)/'DSDOT '/
* .. Executable Statements ..
WRITE (NOUT,99999) ICASE, L(ICASE)
RETURN
@@ -86,18 +130,18 @@
* .. Scalar Arguments ..
DOUBLE PRECISION SFAC
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
DOUBLE PRECISION D12, SA, SB, SC, SS
INTEGER K
DOUBLE PRECISION SA, SB, SC, SS, D12
INTEGER I, K
* .. Local Arrays ..
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 DROTG, STEST1
EXTERNAL DROTG, DROTMG, STEST, STEST1
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
DATA DA1/0.3D0, 0.4D0, -0.3D0, -0.4D0, -0.3D0, 0.0D0,
+ 0.0D0, 1.0D0/
@@ -111,7 +155,52 @@
+ 0.0D0, 1.0D0, 1.0D0/
DATA DBTRUE/0.0D0, 0.6D0, 0.0D0, -0.6D0, 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 ..
*
* Compute true values which cannot be prestored
@@ -134,6 +223,15 @@
CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC)
CALL STEST1(SC,DC1(K),DC1(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
WRITE (NOUT,*) ' Shouldn''t be here in CHECK0'
STOP
@@ -148,7 +246,7 @@
* .. Scalar Arguments ..
DOUBLE PRECISION SFAC
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
INTEGER I, LEN, NP1
@@ -165,7 +263,7 @@
* .. Intrinsic Functions ..
INTRINSIC MAX
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
DATA SA/0.3D0, -1.0D0, 0.0D0, 1.0D0, 0.3D0, 0.3D0,
+ 0.3D0, 0.3D0, 0.3D0, 0.3D0/
@@ -212,11 +310,11 @@
IF (ICASE.EQ.7) THEN
* .. DNRM2 ..
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
* .. DASUM ..
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
* .. DSCAL ..
CALL DSCAL(N,SA((INCX-1)*5+NP1),SX,INCX)
@@ -242,27 +340,40 @@
* .. Scalar Arguments ..
DOUBLE PRECISION SFAC
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
DOUBLE PRECISION SA, SC, SS
INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
DOUBLE PRECISION SA
INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
$ MX, MY
* .. Local Arrays ..
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),
+ DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7),
+ SX(7), SY(7)
$ DT8(7,4,4), DX1(7),
$ DY1(7), SSIZE1(4), SSIZE2(14,2), 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)
INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
* .. External Functions ..
DOUBLE PRECISION DDOT
EXTERNAL DDOT
DOUBLE PRECISION DDOT, DSDOT
EXTERNAL DDOT, DSDOT
* .. External Subroutines ..
EXTERNAL DAXPY, DCOPY, DSWAP, STEST, STEST1
EXTERNAL DAXPY, DCOPY, DROTM, DSWAP, STEST, STEST1,
$ TESTDSDOT
* .. Intrinsic Functions ..
INTRINSIC ABS, MIN
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. 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 INCXS/1, 2, -2, -1/
DATA INCYS/1, -2, 1, -2/
@@ -272,7 +383,6 @@
+ -0.4D0/
DATA DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0,
+ 0.8D0/
DATA SC, SS/0.8D0, 0.6D0/
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.74D0, 0.0D0, 0.30D0, 0.33D0, 1.27D0/
@@ -295,44 +405,6 @@
+ 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.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,
+ 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,
@@ -375,6 +447,150 @@
+ 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/
*
* 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 ..
*
DO 120 KI = 1, 4
@@ -421,6 +637,39 @@
80 CONTINUE
CALL STEST(LENX,SX,STX,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
WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
STOP
@@ -436,10 +685,10 @@
* .. Scalar Arguments ..
DOUBLE PRECISION SFAC
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
DOUBLE PRECISION SA, SC, SS
DOUBLE PRECISION SC, SS
INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
* .. Local Arrays ..
DOUBLE PRECISION COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
@@ -454,9 +703,8 @@
* .. Intrinsic Functions ..
INTRINSIC ABS, MIN
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
DATA SA/0.3D0/
DATA INCXS/1, 2, -2, -1/
DATA INCYS/1, -2, 1, -2/
DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
@@ -647,14 +895,15 @@
*
* .. Parameters ..
INTEGER NOUT
PARAMETER (NOUT=6)
DOUBLE PRECISION ZERO
PARAMETER (NOUT=6, ZERO=0.0D0)
* .. Scalar Arguments ..
DOUBLE PRECISION SFAC
INTEGER LEN
* .. Array Arguments ..
DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
DOUBLE PRECISION SD
@@ -665,12 +914,12 @@
* .. Intrinsic Functions ..
INTRINSIC ABS
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Executable Statements ..
*
DO 40 I = 1, LEN
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
*
* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
@@ -680,16 +929,64 @@
PASS = .FALSE.
WRITE (NOUT,99999)
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)
40 CONTINUE
RETURN
*
99999 FORMAT (' FAIL')
99998 FORMAT (/' CASE N INCX INCY MODE I ',
99998 FORMAT (/' CASE N INCX INCY I ',
+ ' COMP(I) TRUE(I) DIFFERENCE',
+ ' SIZE(I)',/1X)
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,3I5,I3,2D36.8,2D12.4)
99997 FORMAT (1X,I4,I3,1I5,I3,2E36.8,2E12.4)
END
SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
* ************************* STEST1 *****************************
@@ -739,12 +1036,12 @@
* .. Scalar Arguments ..
INTEGER ICOMP, ITRUE
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
INTEGER ID
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Executable Statements ..
*
IF (ICOMP.EQ.ITRUE) GO TO 40
@@ -757,13 +1054,13 @@
WRITE (NOUT,99999)
WRITE (NOUT,99998)
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
RETURN
*
99999 FORMAT (' FAIL')
99998 FORMAT (/' CASE N INCX INCY MODE ',
99998 FORMAT (/' CASE N INCX INCY ',
+ ' COMP TRUE DIFFERENCE',
+ /1X)
99997 FORMAT (1X,I4,I3,3I5,2I36,I12)
99997 FORMAT (1X,I4,I3,2I5,2I36,I12)
END

+ 341
- 89
test/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
* Test program for the REAL Level 1 BLAS.
* Based upon the original BLAS test routine together with:
* F06EAF Example Program Text
*
* -- Reference BLAS test 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..--
* April 2012
*
* =====================================================================
*
* .. Parameters ..
INTEGER NOUT
PARAMETER (NOUT=6)
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
REAL SFAC
@@ -14,31 +56,30 @@
* .. External Subroutines ..
EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
DATA SFAC/9.765625E-4/
* .. Executable Statements ..
WRITE (NOUT,99999)
DO 20 IC = 1, 10
DO 20 IC = 1, 13
ICASE = IC
CALL HEADER
*
* .. Initialize PASS, INCX, INCY, and MODE for a new case. ..
* .. the value 9999 for INCX, INCY or MODE will appear in the ..
* .. Initialize PASS, INCX, and INCY for a new case. ..
* .. the value 9999 for INCX or INCY will appear in the ..
* .. detailed output, if any, for cases that do not involve ..
* .. these parameters ..
*
PASS = .TRUE.
INCX = 9999
INCY = 9999
MODE = 9999
IF (ICASE.EQ.3) THEN
IF (ICASE.EQ.3 .OR. ICASE.EQ.11) THEN
CALL CHECK0(SFAC)
ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR.
+ 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.12 .OR. ICASE.EQ.13) THEN
CALL CHECK2(SFAC)
ELSE IF (ICASE.EQ.4) THEN
CALL CHECK3(SFAC)
@@ -56,12 +97,12 @@
INTEGER NOUT
PARAMETER (NOUT=6)
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Arrays ..
CHARACTER*6 L(10)
CHARACTER*6 L(13)
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
DATA L(1)/' SDOT '/
DATA L(2)/'SAXPY '/
@@ -73,6 +114,9 @@
DATA L(8)/'SASUM '/
DATA L(9)/'SSCAL '/
DATA L(10)/'ISAMAX'/
DATA L(11)/'SROTMG'/
DATA L(12)/'SROTM '/
DATA L(13)/'SDSDOT'/
* .. Executable Statements ..
WRITE (NOUT,99999) ICASE, L(ICASE)
RETURN
@@ -86,18 +130,18 @@
* .. Scalar Arguments ..
REAL SFAC
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
REAL D12, SA, SB, SC, SS
INTEGER K
INTEGER I, K
* .. Local Arrays ..
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 SROTG, STEST1
EXTERNAL SROTG, SROTMG, STEST, STEST1
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
DATA DA1/0.3E0, 0.4E0, -0.3E0, -0.4E0, -0.3E0, 0.0E0,
+ 0.0E0, 1.0E0/
@@ -111,7 +155,52 @@
+ 0.0E0, 1.0E0, 1.0E0/
DATA DBTRUE/0.0E0, 0.6E0, 0.0E0, -0.6E0, 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 ..
*
* Compute true values which cannot be prestored
@@ -134,6 +223,15 @@
CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC)
CALL STEST1(SC,DC1(K),DC1(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
WRITE (NOUT,*) ' Shouldn''t be here in CHECK0'
STOP
@@ -148,7 +246,7 @@
* .. Scalar Arguments ..
REAL SFAC
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
INTEGER I, LEN, NP1
@@ -165,7 +263,7 @@
* .. Intrinsic Functions ..
INTRINSIC MAX
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
DATA SA/0.3E0, -1.0E0, 0.0E0, 1.0E0, 0.3E0, 0.3E0,
+ 0.3E0, 0.3E0, 0.3E0, 0.3E0/
@@ -212,11 +310,11 @@
IF (ICASE.EQ.7) THEN
* .. SNRM2 ..
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
* .. SASUM ..
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
* .. SSCAL ..
CALL SSCAL(N,SA((INCX-1)*5+NP1),SX,INCX)
@@ -242,27 +340,40 @@
* .. Scalar Arguments ..
REAL SFAC
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
REAL SA, SC, SS
INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
REAL SA
INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
$ MX, MY
* .. Local Arrays ..
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),
+ DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7),
+ SX(7), SY(7)
$ DT8(7,4,4), DX1(7),
$ DY1(7), SSIZE1(4), SSIZE2(14,2), SSIZE3(4),
$ 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)
* .. External Functions ..
REAL SDOT
EXTERNAL SDOT
REAL SDOT, SDSDOT
EXTERNAL SDOT, SDSDOT
* .. External Subroutines ..
EXTERNAL SAXPY, SCOPY, SSWAP, STEST, STEST1
EXTERNAL SAXPY, SCOPY, SROTM, SSWAP, STEST, STEST1
* .. Intrinsic Functions ..
INTRINSIC ABS, MIN
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. 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 INCXS/1, 2, -2, -1/
DATA INCYS/1, -2, 1, -2/
@@ -272,10 +383,11 @@
+ -0.4E0/
DATA DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
+ 0.8E0/
DATA SC, SS/0.8E0, 0.6E0/
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.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,
+ 0.0E0, 0.68E0, 0.0E0, 0.0E0, 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.0E0, 0.68E0, -0.9E0, 0.33E0, 0.7E0,
+ -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,
+ 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,
@@ -375,6 +449,151 @@
+ 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 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 ..
*
DO 120 KI = 1, 4
@@ -421,6 +640,39 @@
80 CONTINUE
CALL STEST(LENX,SX,STX,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
WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
STOP
@@ -436,10 +688,10 @@
* .. Scalar Arguments ..
REAL SFAC
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
REAL SA, SC, SS
REAL SC, SS
INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
* .. Local Arrays ..
REAL COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
@@ -454,9 +706,8 @@
* .. Intrinsic Functions ..
INTRINSIC ABS, MIN
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Data statements ..
DATA SA/0.3E0/
DATA INCXS/1, 2, -2, -1/
DATA INCYS/1, -2, 1, -2/
DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
@@ -647,14 +898,15 @@
*
* .. Parameters ..
INTEGER NOUT
PARAMETER (NOUT=6)
REAL ZERO
PARAMETER (NOUT=6, ZERO=0.0E0)
* .. Scalar Arguments ..
REAL SFAC
INTEGER LEN
* .. Array Arguments ..
REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
REAL SD
@@ -665,12 +917,12 @@
* .. Intrinsic Functions ..
INTRINSIC ABS
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Executable Statements ..
*
DO 40 I = 1, LEN
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
*
* HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
@@ -680,16 +932,16 @@
PASS = .FALSE.
WRITE (NOUT,99999)
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)
40 CONTINUE
RETURN
*
99999 FORMAT (' FAIL')
99998 FORMAT (/' CASE N INCX INCY MODE I ',
99998 FORMAT (/' CASE N INCX INCY I ',
+ ' COMP(I) TRUE(I) DIFFERENCE',
+ ' 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
SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
* ************************* STEST1 *****************************
@@ -739,12 +991,12 @@
* .. Scalar Arguments ..
INTEGER ICOMP, ITRUE
* .. Scalars in Common ..
INTEGER ICASE, INCX, INCY, MODE, N
INTEGER ICASE, INCX, INCY, N
LOGICAL PASS
* .. Local Scalars ..
INTEGER ID
* .. Common blocks ..
COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
COMMON /COMBLA/ICASE, N, INCX, INCY, PASS
* .. Executable Statements ..
*
IF (ICOMP.EQ.ITRUE) GO TO 40
@@ -757,13 +1009,13 @@
WRITE (NOUT,99999)
WRITE (NOUT,99998)
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
RETURN
*
99999 FORMAT (' FAIL')
99998 FORMAT (/' CASE N INCX INCY MODE ',
99998 FORMAT (/' CASE N INCX INCY ',
+ ' COMP TRUE DIFFERENCE',
+ /1X)
99997 FORMAT (1X,I4,I3,3I5,2I36,I12)
99997 FORMAT (1X,I4,I3,2I5,2I36,I12)
END

Write Preview
Loading…
Cancel
Save