test/sblat1.f

   1 *> \brief \b SBLAT1
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       PROGRAM SBLAT1
  12 *
  13 *
  14 *> \par Purpose:
  15 *  =============
  16 *>
  17 *> \verbatim
  18 *>
  19 *>    Test program for the REAL Level 1 BLAS.
  20 *>
  21 *>    Based upon the original BLAS test routine together with:
  22 *>    F06EAF Example Program Text
  23 *> \endverbatim
  24 *
  25 *  Authors:
  26 *  ========
  27 *
  28 *> \author Univ. of Tennessee
  29 *> \author Univ. of California Berkeley
  30 *> \author Univ. of Colorado Denver
  31 *> \author NAG Ltd.
  32 *
  33 *> \date April 2012
  34 *
  35 *> \ingroup single_blas_testing
  36 *
  37 *  =====================================================================
  38       PROGRAM SBLAT1
  39 *
  40 *  -- Reference BLAS test routine (version 3.8.0) --
  41 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
  42 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  43 *     April 2012
  44 *
  45 *  =====================================================================
  46 *
  47 *     .. Parameters ..
  48       INTEGER          NOUT
  49       PARAMETER        (NOUT=6)
  50 *     .. Scalars in Common ..
  51       INTEGER          ICASE, INCX, INCY, N
  52       LOGICAL          PASS
  53 *     .. Local Scalars ..
  54       REAL             SFAC
  55       INTEGER          IC
  56 *     .. External Subroutines ..
  57       EXTERNAL         CHECK0, CHECK1, CHECK2, CHECK3, HEADER
  58 *     .. Common blocks ..
  59       COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
  60 *     .. Data statements ..
  61       DATA             SFAC/9.765625E-4/
  62 *     .. Executable Statements ..
  63       WRITE (NOUT,99999)
  64       DO 20 IC = 1, 13
  65          ICASE = IC
  66          CALL HEADER
  67 *
  68 *        .. Initialize  PASS,  INCX,  and INCY for a new case. ..
  69 *        .. the value 9999 for INCX or INCY will appear in the ..
  70 *        .. detailed  output, if any, for cases  that do not involve ..
  71 *        .. these parameters ..
  72 *
  73          PASS = .TRUE.
  74          INCX = 9999
  75          INCY = 9999
  76          IF (ICASE.EQ.3 .OR. ICASE.EQ.11) THEN
  77             CALL CHECK0(SFAC)
  78          ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR.
  79      +            ICASE.EQ.10) THEN
  80             CALL CHECK1(SFAC)
  81          ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR.
  82      +            ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13) THEN
  83             CALL CHECK2(SFAC)
  84          ELSE IF (ICASE.EQ.4) THEN
  85             CALL CHECK3(SFAC)
  86          END IF
  87 *        -- Print
  88          IF (PASS) WRITE (NOUT,99998)
  89    20 CONTINUE
  90       STOP
  91 *
  92 99999 FORMAT (' Real BLAS Test Program Results',/1X)
  93 99998 FORMAT ('                                    ----- PASS -----')
  94       END
  95       SUBROUTINE HEADER
  96 *     .. Parameters ..
  97       INTEGER          NOUT
  98       PARAMETER        (NOUT=6)
  99 *     .. Scalars in Common ..
 100       INTEGER          ICASE, INCX, INCY, N
 101       LOGICAL          PASS
 102 *     .. Local Arrays ..
 103       CHARACTER*6      L(13)
 104 *     .. Common blocks ..
 105       COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
 106 *     .. Data statements ..
 107       DATA             L(1)/' SDOT '/
 108       DATA             L(2)/'SAXPY '/
 109       DATA             L(3)/'SROTG '/
 110       DATA             L(4)/' SROT '/
 111       DATA             L(5)/'SCOPY '/
 112       DATA             L(6)/'SSWAP '/
 113       DATA             L(7)/'SNRM2 '/
 114       DATA             L(8)/'SASUM '/
 115       DATA             L(9)/'SSCAL '/
 116       DATA             L(10)/'ISAMAX'/
 117       DATA             L(11)/'SROTMG'/
 118       DATA             L(12)/'SROTM '/
 119       DATA             L(13)/'SDSDOT'/
 120 *     .. Executable Statements ..
 121       WRITE (NOUT,99999) ICASE, L(ICASE)
 122       RETURN
 123 *
 124 99999 FORMAT (/' Test of subprogram number',I3,12X,A6)
 125       END
 126       SUBROUTINE CHECK0(SFAC)
 127 *     .. Parameters ..
 128       INTEGER           NOUT
 129       PARAMETER         (NOUT=6)
 130 *     .. Scalar Arguments ..
 131       REAL              SFAC
 132 *     .. Scalars in Common ..
 133       INTEGER           ICASE, INCX, INCY, N
 134       LOGICAL           PASS
 135 *     .. Local Scalars ..
 136       REAL              D12, SA, SB, SC, SS
 137       INTEGER           I, K
 138 *     .. Local Arrays ..
 139       REAL              DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
 140      +                  DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9)
 141 *     .. External Subroutines ..
 142       EXTERNAL          SROTG, SROTMG, STEST, STEST1
 143 *     .. Common blocks ..
 144       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
 145 *     .. Data statements ..
 146       DATA              DA1/0.3E0, 0.4E0, -0.3E0, -0.4E0, -0.3E0, 0.0E0,
 147      +                  0.0E0, 1.0E0/
 148       DATA              DB1/0.4E0, 0.3E0, 0.4E0, 0.3E0, -0.4E0, 0.0E0,
 149      +                  1.0E0, 0.0E0/
 150       DATA              DC1/0.6E0, 0.8E0, -0.6E0, 0.8E0, 0.6E0, 1.0E0,
 151      +                  0.0E0, 1.0E0/
 152       DATA              DS1/0.8E0, 0.6E0, 0.8E0, -0.6E0, 0.8E0, 0.0E0,
 153      +                  1.0E0, 0.0E0/
 154       DATA              DATRUE/0.5E0, 0.5E0, 0.5E0, -0.5E0, -0.5E0,
 155      +                  0.0E0, 1.0E0, 1.0E0/
 156       DATA              DBTRUE/0.0E0, 0.6E0, 0.0E0, -0.6E0, 0.0E0,
 157      +                  0.0E0, 1.0E0, 0.0E0/
 158 *     INPUT FOR MODIFIED GIVENS
 159       DATA DAB/ .1E0,.3E0,1.2E0,.2E0,
 160      A          .7E0, .2E0, .6E0, 4.2E0,
 161      B          0.E0,0.E0,0.E0,0.E0,
 162      C          4.E0, -1.E0, 2.E0, 4.E0,
 163      D          6.E-10, 2.E-2, 1.E5, 10.E0,
 164      E          4.E10, 2.E-2, 1.E-5, 10.E0,
 165      F          2.E-10, 4.E-2, 1.E5, 10.E0,
 166      G          2.E10, 4.E-2, 1.E-5, 10.E0,
 167      H          4.E0, -2.E0, 8.E0, 4.E0    /
 168 *    TRUE RESULTS FOR MODIFIED GIVENS
 169       DATA DTRUE/0.E0,0.E0, 1.3E0, .2E0, 0.E0,0.E0,0.E0, .5E0, 0.E0,
 170      A           0.E0,0.E0, 4.5E0, 4.2E0, 1.E0, .5E0, 0.E0,0.E0,0.E0,
 171      B           0.E0,0.E0,0.E0,0.E0, -2.E0, 0.E0,0.E0,0.E0,0.E0,
 172      C           0.E0,0.E0,0.E0, 4.E0, -1.E0, 0.E0,0.E0,0.E0,0.E0,
 173      D           0.E0, 15.E-3, 0.E0, 10.E0, -1.E0, 0.E0, -1.E-4,
 174      E           0.E0, 1.E0,
 175      F           0.E0,0.E0, 6144.E-5, 10.E0, -1.E0, 4096.E0, -1.E6,
 176      G           0.E0, 1.E0,
 177      H           0.E0,0.E0,15.E0,10.E0,-1.E0, 5.E-5, 0.E0,1.E0,0.E0,
 178      I           0.E0,0.E0, 15.E0, 10.E0, -1. E0, 5.E5, -4096.E0,
 179      J           1.E0, 4096.E-6,
 180      K           0.E0,0.E0, 7.E0, 4.E0, 0.E0,0.E0, -.5E0, -.25E0, 0.E0/
 181 *                   4096 = 2 ** 12
 182       DATA D12  /4096.E0/
 183       DTRUE(1,1) = 12.E0 / 130.E0
 184       DTRUE(2,1) = 36.E0 / 130.E0
 185       DTRUE(7,1) = -1.E0 / 6.E0
 186       DTRUE(1,2) = 14.E0 / 75.E0
 187       DTRUE(2,2) = 49.E0 / 75.E0
 188       DTRUE(9,2) = 1.E0 / 7.E0
 189       DTRUE(1,5) = 45.E-11 * (D12 * D12)
 190       DTRUE(3,5) = 4.E5 / (3.E0 * D12)
 191       DTRUE(6,5) = 1.E0 / D12
 192       DTRUE(8,5) = 1.E4 / (3.E0 * D12)
 193       DTRUE(1,6) = 4.E10 / (1.5E0 * D12 * D12)
 194       DTRUE(2,6) = 2.E-2 / 1.5E0
 195       DTRUE(8,6) = 5.E-7 * D12
 196       DTRUE(1,7) = 4.E0 / 150.E0
 197       DTRUE(2,7) = (2.E-10 / 1.5E0) * (D12 * D12)
 198       DTRUE(7,7) = -DTRUE(6,5)
 199       DTRUE(9,7) = 1.E4 / D12
 200       DTRUE(1,8) = DTRUE(1,7)
 201       DTRUE(2,8) = 2.E10 / (1.5E0 * D12 * D12)
 202       DTRUE(1,9) = 32.E0 / 7.E0
 203       DTRUE(2,9) = -16.E0 / 7.E0
 204 *     .. Executable Statements ..
 205 *
 206 *     Compute true values which cannot be prestored
 207 *     in decimal notation
 208 *
 209       DBTRUE(1) = 1.0E0/0.6E0
 210       DBTRUE(3) = -1.0E0/0.6E0
 211       DBTRUE(5) = 1.0E0/0.6E0
 212 *
 213       DO 20 K = 1, 8
 214 *        .. Set N=K for identification in output if any ..
 215          N = K
 216          IF (ICASE.EQ.3) THEN
 217 *           .. SROTG ..
 218             IF (K.GT.8) GO TO 40
 219             SA = DA1(K)
 220             SB = DB1(K)
 221             CALL SROTG(SA,SB,SC,SS)
 222             CALL STEST1(SA,DATRUE(K),DATRUE(K),SFAC)
 223             CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC)
 224             CALL STEST1(SC,DC1(K),DC1(K),SFAC)
 225             CALL STEST1(SS,DS1(K),DS1(K),SFAC)
 226          ELSEIF (ICASE.EQ.11) THEN
 227 *           .. SROTMG ..
 228             DO I=1,4
 229                DTEMP(I)= DAB(I,K)
 230                DTEMP(I+4) = 0.0
 231             END DO
 232             DTEMP(9) = 0.0
 233             CALL SROTMG(DTEMP(1),DTEMP(2),DTEMP(3),DTEMP(4),DTEMP(5))
 234             CALL STEST(9,DTEMP,DTRUE(1,K),DTRUE(1,K),SFAC)
 235          ELSE
 236             WRITE (NOUT,*) ' Shouldn''t be here in CHECK0'
 237             STOP
 238          END IF
 239    20 CONTINUE
 240    40 RETURN
 241       END
 242       SUBROUTINE CHECK1(SFAC)
 243 *     .. Parameters ..
 244       INTEGER           NOUT
 245       PARAMETER         (NOUT=6)
 246 *     .. Scalar Arguments ..
 247       REAL              SFAC
 248 *     .. Scalars in Common ..
 249       INTEGER           ICASE, INCX, INCY, N
 250       LOGICAL           PASS
 251 *     .. Local Scalars ..
 252       INTEGER           I, LEN, NP1
 253 *     .. Local Arrays ..
 254       REAL              DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
 255      +                  SA(10), STEMP(1), STRUE(8), SX(8)
 256       INTEGER           ITRUE2(5)
 257 *     .. External Functions ..
 258       REAL              SASUM, SNRM2
 259       INTEGER           ISAMAX
 260       EXTERNAL          SASUM, SNRM2, ISAMAX
 261 *     .. External Subroutines ..
 262       EXTERNAL          ITEST1, SSCAL, STEST, STEST1
 263 *     .. Intrinsic Functions ..
 264       INTRINSIC         MAX
 265 *     .. Common blocks ..
 266       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
 267 *     .. Data statements ..
 268       DATA              SA/0.3E0, -1.0E0, 0.0E0, 1.0E0, 0.3E0, 0.3E0,
 269      +                  0.3E0, 0.3E0, 0.3E0, 0.3E0/
 270       DATA              DV/0.1E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
 271      +                  2.0E0, 2.0E0, 0.3E0, 3.0E0, 3.0E0, 3.0E0, 3.0E0,
 272      +                  3.0E0, 3.0E0, 3.0E0, 0.3E0, -0.4E0, 4.0E0,
 273      +                  4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0, 0.2E0,
 274      +                  -0.6E0, 0.3E0, 5.0E0, 5.0E0, 5.0E0, 5.0E0,
 275      +                  5.0E0, 0.1E0, -0.3E0, 0.5E0, -0.1E0, 6.0E0,
 276      +                  6.0E0, 6.0E0, 6.0E0, 0.1E0, 8.0E0, 8.0E0, 8.0E0,
 277      +                  8.0E0, 8.0E0, 8.0E0, 8.0E0, 0.3E0, 9.0E0, 9.0E0,
 278      +                  9.0E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0, 0.3E0, 2.0E0,
 279      +                  -0.4E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
 280      +                  0.2E0, 3.0E0, -0.6E0, 5.0E0, 0.3E0, 2.0E0,
 281      +                  2.0E0, 2.0E0, 0.1E0, 4.0E0, -0.3E0, 6.0E0,
 282      +                  -0.5E0, 7.0E0, -0.1E0, 3.0E0/
 283       DATA              DTRUE1/0.0E0, 0.3E0, 0.5E0, 0.7E0, 0.6E0/
 284       DATA              DTRUE3/0.0E0, 0.3E0, 0.7E0, 1.1E0, 1.0E0/
 285       DATA              DTRUE5/0.10E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
 286      +                  2.0E0, 2.0E0, 2.0E0, -0.3E0, 3.0E0, 3.0E0,
 287      +                  3.0E0, 3.0E0, 3.0E0, 3.0E0, 3.0E0, 0.0E0, 0.0E0,
 288      +                  4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0,
 289      +                  0.20E0, -0.60E0, 0.30E0, 5.0E0, 5.0E0, 5.0E0,
 290      +                  5.0E0, 5.0E0, 0.03E0, -0.09E0, 0.15E0, -0.03E0,
 291      +                  6.0E0, 6.0E0, 6.0E0, 6.0E0, 0.10E0, 8.0E0,
 292      +                  8.0E0, 8.0E0, 8.0E0, 8.0E0, 8.0E0, 8.0E0,
 293      +                  0.09E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0,
 294      +                  9.0E0, 9.0E0, 0.09E0, 2.0E0, -0.12E0, 2.0E0,
 295      +                  2.0E0, 2.0E0, 2.0E0, 2.0E0, 0.06E0, 3.0E0,
 296      +                  -0.18E0, 5.0E0, 0.09E0, 2.0E0, 2.0E0, 2.0E0,
 297      +                  0.03E0, 4.0E0, -0.09E0, 6.0E0, -0.15E0, 7.0E0,
 298      +                  -0.03E0, 3.0E0/
 299       DATA              ITRUE2/0, 1, 2, 2, 3/
 300 *     .. Executable Statements ..
 301       DO 80 INCX = 1, 2
 302          DO 60 NP1 = 1, 5
 303             N = NP1 - 1
 304             LEN = 2*MAX(N,1)
 305 *           .. Set vector arguments ..
 306             DO 20 I = 1, LEN
 307                SX(I) = DV(I,NP1,INCX)
 308    20       CONTINUE
 309 *
 310             IF (ICASE.EQ.7) THEN
 311 *              .. SNRM2 ..
 312                STEMP(1) = DTRUE1(NP1)
 313                CALL STEST1(SNRM2(N,SX,INCX),STEMP(1),STEMP,SFAC)
 314             ELSE IF (ICASE.EQ.8) THEN
 315 *              .. SASUM ..
 316                STEMP(1) = DTRUE3(NP1)
 317                CALL STEST1(SASUM(N,SX,INCX),STEMP(1),STEMP,SFAC)
 318             ELSE IF (ICASE.EQ.9) THEN
 319 *              .. SSCAL ..
 320                CALL SSCAL(N,SA((INCX-1)*5+NP1),SX,INCX)
 321                DO 40 I = 1, LEN
 322                   STRUE(I) = DTRUE5(I,NP1,INCX)
 323    40          CONTINUE
 324                CALL STEST(LEN,SX,STRUE,STRUE,SFAC)
 325             ELSE IF (ICASE.EQ.10) THEN
 326 *              .. ISAMAX ..
 327                CALL ITEST1(ISAMAX(N,SX,INCX),ITRUE2(NP1))
 328             ELSE
 329                WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
 330                STOP
 331             END IF
 332    60    CONTINUE
 333    80 CONTINUE
 334       RETURN
 335       END
 336       SUBROUTINE CHECK2(SFAC)
 337 *     .. Parameters ..
 338       INTEGER           NOUT
 339       PARAMETER         (NOUT=6)
 340 *     .. Scalar Arguments ..
 341       REAL              SFAC
 342 *     .. Scalars in Common ..
 343       INTEGER           ICASE, INCX, INCY, N
 344       LOGICAL           PASS
 345 *     .. Local Scalars ..
 346       REAL              SA
 347       INTEGER           I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
 348      $                  MX, MY
 349 *     .. Local Arrays ..
 350       REAL              DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
 351      $                  DT8(7,4,4), DX1(7),
 352      $                  DY1(7), SSIZE1(4), SSIZE2(14,2), SSIZE3(4),
 353      $                  SSIZE(7), STX(7), STY(7), SX(7), SY(7),
 354      $                  DPAR(5,4), DT19X(7,4,16),DT19XA(7,4,4),
 355      $                  DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4),
 356      $                  DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4),
 357      $                  DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5),
 358      $                  ST7B(4,4)
 359       INTEGER           INCXS(4), INCYS(4), LENS(4,2), NS(4)
 360 *     .. External Functions ..
 361       REAL              SDOT, SDSDOT
 362       EXTERNAL          SDOT, SDSDOT
 363 *     .. External Subroutines ..
 364       EXTERNAL          SAXPY, SCOPY, SROTM, SSWAP, STEST, STEST1
 365 *     .. Intrinsic Functions ..
 366       INTRINSIC         ABS, MIN
 367 *     .. Common blocks ..
 368       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
 369 *     .. Data statements ..
 370       EQUIVALENCE (DT19X(1,1,1),DT19XA(1,1,1)),(DT19X(1,1,5),
 371      A   DT19XB(1,1,1)),(DT19X(1,1,9),DT19XC(1,1,1)),
 372      B   (DT19X(1,1,13),DT19XD(1,1,1))
 373       EQUIVALENCE (DT19Y(1,1,1),DT19YA(1,1,1)),(DT19Y(1,1,5),
 374      A   DT19YB(1,1,1)),(DT19Y(1,1,9),DT19YC(1,1,1)),
 375      B   (DT19Y(1,1,13),DT19YD(1,1,1))
 376
 377       DATA              SA/0.3E0/
 378       DATA              INCXS/1, 2, -2, -1/
 379       DATA              INCYS/1, -2, 1, -2/
 380       DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
 381       DATA              NS/0, 1, 2, 4/
 382       DATA              DX1/0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.9E0, -0.3E0,
 383      +                  -0.4E0/
 384       DATA              DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
 385      +                  0.8E0/
 386       DATA              DT7/0.0E0, 0.30E0, 0.21E0, 0.62E0, 0.0E0,
 387      +                  0.30E0, -0.07E0, 0.85E0, 0.0E0, 0.30E0, -0.79E0,
 388      +                  -0.74E0, 0.0E0, 0.30E0, 0.33E0, 1.27E0/
 389       DATA              ST7B/ .1, .4, .31, .72,     .1, .4, .03, .95,
 390      +                  .1, .4, -.69, -.64,   .1, .4, .43, 1.37/
 391       DATA              DT8/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 392      +                  0.0E0, 0.68E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 393      +                  0.0E0, 0.0E0, 0.68E0, -0.87E0, 0.0E0, 0.0E0,
 394      +                  0.0E0, 0.0E0, 0.0E0, 0.68E0, -0.87E0, 0.15E0,
 395      +                  0.94E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
 396      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.68E0,
 397      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 398      +                  0.35E0, -0.9E0, 0.48E0, 0.0E0, 0.0E0, 0.0E0,
 399      +                  0.0E0, 0.38E0, -0.9E0, 0.57E0, 0.7E0, -0.75E0,
 400      +                  0.2E0, 0.98E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0,
 401      +                  0.0E0, 0.0E0, 0.0E0, 0.68E0, 0.0E0, 0.0E0,
 402      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.35E0, -0.72E0,
 403      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.38E0,
 404      +                  -0.63E0, 0.15E0, 0.88E0, 0.0E0, 0.0E0, 0.0E0,
 405      +                  0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 406      +                  0.68E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 407      +                  0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.0E0, 0.0E0,
 408      +                  0.0E0, 0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.7E0,
 409      +                  -0.75E0, 0.2E0, 1.04E0/
 410       DATA              DT10X/0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 411      +                  0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 412      +                  0.0E0, 0.5E0, -0.9E0, 0.0E0, 0.0E0, 0.0E0,
 413      +                  0.0E0, 0.0E0, 0.5E0, -0.9E0, 0.3E0, 0.7E0,
 414      +                  0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0,
 415      +                  0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0,
 416      +                  0.0E0, 0.0E0, 0.0E0, 0.3E0, 0.1E0, 0.5E0, 0.0E0,
 417      +                  0.0E0, 0.0E0, 0.0E0, 0.8E0, 0.1E0, -0.6E0,
 418      +                  0.8E0, 0.3E0, -0.3E0, 0.5E0, 0.6E0, 0.0E0,
 419      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
 420      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.9E0,
 421      +                  0.1E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.7E0,
 422      +                  0.1E0, 0.3E0, 0.8E0, -0.9E0, -0.3E0, 0.5E0,
 423      +                  0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 424      +                  0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 425      +                  0.5E0, 0.3E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 426      +                  0.5E0, 0.3E0, -0.6E0, 0.8E0, 0.0E0, 0.0E0,
 427      +                  0.0E0/
 428       DATA              DT10Y/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 429      +                  0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 430      +                  0.0E0, 0.6E0, 0.1E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 431      +                  0.0E0, 0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.0E0,
 432      +                  0.0E0, 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 433      +                  0.0E0, 0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 434      +                  0.0E0, 0.0E0, -0.5E0, -0.9E0, 0.6E0, 0.0E0,
 435      +                  0.0E0, 0.0E0, 0.0E0, -0.4E0, -0.9E0, 0.9E0,
 436      +                  0.7E0, -0.5E0, 0.2E0, 0.6E0, 0.5E0, 0.0E0,
 437      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0,
 438      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.5E0,
 439      +                  0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 440      +                  -0.4E0, 0.9E0, -0.5E0, 0.6E0, 0.0E0, 0.0E0,
 441      +                  0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 442      +                  0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 443      +                  0.0E0, 0.6E0, -0.9E0, 0.1E0, 0.0E0, 0.0E0,
 444      +                  0.0E0, 0.0E0, 0.6E0, -0.9E0, 0.1E0, 0.7E0,
 445      +                  -0.5E0, 0.2E0, 0.8E0/
 446       DATA              SSIZE1/0.0E0, 0.3E0, 1.6E0, 3.2E0/
 447       DATA              SSIZE2/0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 448      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 449      +                  0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
 450      +                  1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
 451      +                  1.17E0, 1.17E0, 1.17E0/
 452       DATA              SSIZE3/ .1, .4, 1.7, 3.3 /
 453 *
 454 *                         FOR DROTM
 455 *
 456       DATA DPAR/-2.E0,  0.E0,0.E0,0.E0,0.E0,
 457      A          -1.E0,  2.E0, -3.E0, -4.E0,  5.E0,
 458      B           0.E0,  0.E0,  2.E0, -3.E0,  0.E0,
 459      C           1.E0,  5.E0,  2.E0,  0.E0, -4.E0/
 460 *                        TRUE X RESULTS F0R ROTATIONS DROTM
 461       DATA DT19XA/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 462      A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 463      B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 464      C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 465      D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 466      E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 467      F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 468      G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 469      H            .6E0,   .1E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 470      I           -.8E0,  3.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 471      J           -.9E0,  2.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 472      K           3.5E0,  -.4E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 473      L            .6E0,   .1E0,  -.5E0,   .8E0,          0.E0,0.E0,0.E0,
 474      M           -.8E0,  3.8E0, -2.2E0, -1.2E0,          0.E0,0.E0,0.E0,
 475      N           -.9E0,  2.8E0, -1.4E0, -1.3E0,          0.E0,0.E0,0.E0,
 476      O           3.5E0,  -.4E0, -2.2E0,  4.7E0,          0.E0,0.E0,0.E0/
 477 *
 478       DATA DT19XB/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 479      A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 480      B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 481      C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 482      D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 483      E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 484      F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 485      G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 486      H            .6E0,   .1E0,  -.5E0,             0.E0,0.E0,0.E0,0.E0,
 487      I           0.E0,    .1E0, -3.0E0,             0.E0,0.E0,0.E0,0.E0,
 488      J           -.3E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
 489      K           3.3E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
 490      L            .6E0,   .1E0,  -.5E0,   .8E0,   .9E0,  -.3E0,  -.4E0,
 491      M          -2.0E0,   .1E0,  1.4E0,   .8E0,   .6E0,  -.3E0, -2.8E0,
 492      N          -1.8E0,   .1E0,  1.3E0,   .8E0,  0.E0,   -.3E0, -1.9E0,
 493      O           3.8E0,   .1E0, -3.1E0,   .8E0,  4.8E0,  -.3E0, -1.5E0 /
 494 *
 495       DATA DT19XC/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 496      A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 497      B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 498      C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 499      D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 500      E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 501      F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 502      G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 503      H            .6E0,   .1E0,  -.5E0,             0.E0,0.E0,0.E0,0.E0,
 504      I           4.8E0,   .1E0, -3.0E0,             0.E0,0.E0,0.E0,0.E0,
 505      J           3.3E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
 506      K           2.1E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
 507      L            .6E0,   .1E0,  -.5E0,   .8E0,   .9E0,  -.3E0,  -.4E0,
 508      M          -1.6E0,   .1E0, -2.2E0,   .8E0,  5.4E0,  -.3E0, -2.8E0,
 509      N          -1.5E0,   .1E0, -1.4E0,   .8E0,  3.6E0,  -.3E0, -1.9E0,
 510      O           3.7E0,   .1E0, -2.2E0,   .8E0,  3.6E0,  -.3E0, -1.5E0 /
 511 *
 512       DATA DT19XD/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 513      A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 514      B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 515      C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 516      D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 517      E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 518      F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 519      G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 520      H            .6E0,   .1E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 521      I           -.8E0, -1.0E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 522      J           -.9E0,  -.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 523      K           3.5E0,   .8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 524      L            .6E0,   .1E0,  -.5E0,   .8E0,          0.E0,0.E0,0.E0,
 525      M           -.8E0, -1.0E0,  1.4E0, -1.6E0,          0.E0,0.E0,0.E0,
 526      N           -.9E0,  -.8E0,  1.3E0, -1.6E0,          0.E0,0.E0,0.E0,
 527      O           3.5E0,   .8E0, -3.1E0,  4.8E0,          0.E0,0.E0,0.E0/
 528 *                        TRUE Y RESULTS FOR ROTATIONS DROTM
 529       DATA DT19YA/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 530      A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 531      B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 532      C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 533      D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 534      E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 535      F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 536      G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 537      H            .5E0,  -.9E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 538      I            .7E0, -4.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 539      J           1.7E0,  -.7E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 540      K          -2.6E0,  3.5E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 541      L            .5E0,  -.9E0,   .3E0,   .7E0,          0.E0,0.E0,0.E0,
 542      M            .7E0, -4.8E0,  3.0E0,  1.1E0,          0.E0,0.E0,0.E0,
 543      N           1.7E0,  -.7E0,  -.7E0,  2.3E0,          0.E0,0.E0,0.E0,
 544      O          -2.6E0,  3.5E0,  -.7E0, -3.6E0,          0.E0,0.E0,0.E0/
 545 *
 546       DATA DT19YB/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 547      A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 548      B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 549      C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 550      D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 551      E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 552      F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 553      G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 554      H            .5E0,  -.9E0,   .3E0,             0.E0,0.E0,0.E0,0.E0,
 555      I           4.0E0,  -.9E0,  -.3E0,             0.E0,0.E0,0.E0,0.E0,
 556      J           -.5E0,  -.9E0,  1.5E0,             0.E0,0.E0,0.E0,0.E0,
 557      K          -1.5E0,  -.9E0, -1.8E0,             0.E0,0.E0,0.E0,0.E0,
 558      L            .5E0,  -.9E0,   .3E0,   .7E0,  -.6E0,   .2E0,   .8E0,
 559      M           3.7E0,  -.9E0, -1.2E0,   .7E0, -1.5E0,   .2E0,  2.2E0,
 560      N           -.3E0,  -.9E0,  2.1E0,   .7E0, -1.6E0,   .2E0,  2.0E0,
 561      O          -1.6E0,  -.9E0, -2.1E0,   .7E0,  2.9E0,   .2E0, -3.8E0 /
 562 *
 563       DATA DT19YC/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 564      A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 565      B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 566      C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 567      D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 568      E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 569      F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 570      G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 571      H            .5E0,  -.9E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 572      I           4.0E0, -6.3E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 573      J           -.5E0,   .3E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 574      K          -1.5E0,  3.0E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
 575      L            .5E0,  -.9E0,   .3E0,   .7E0,          0.E0,0.E0,0.E0,
 576      M           3.7E0, -7.2E0,  3.0E0,  1.7E0,          0.E0,0.E0,0.E0,
 577      N           -.3E0,   .9E0,  -.7E0,  1.9E0,          0.E0,0.E0,0.E0,
 578      O          -1.6E0,  2.7E0,  -.7E0, -3.4E0,          0.E0,0.E0,0.E0/
 579 *
 580       DATA DT19YD/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 581      A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 582      B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 583      C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 584      D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 585      E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 586      F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 587      G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
 588      H            .5E0,  -.9E0,   .3E0,             0.E0,0.E0,0.E0,0.E0,
 589      I            .7E0,  -.9E0,  1.2E0,             0.E0,0.E0,0.E0,0.E0,
 590      J           1.7E0,  -.9E0,   .5E0,             0.E0,0.E0,0.E0,0.E0,
 591      K          -2.6E0,  -.9E0, -1.3E0,             0.E0,0.E0,0.E0,0.E0,
 592      L            .5E0,  -.9E0,   .3E0,   .7E0,  -.6E0,   .2E0,   .8E0,
 593      M            .7E0,  -.9E0,  1.2E0,   .7E0, -1.5E0,   .2E0,  1.6E0,
 594      N           1.7E0,  -.9E0,   .5E0,   .7E0, -1.6E0,   .2E0,  2.4E0,
 595      O          -2.6E0,  -.9E0, -1.3E0,   .7E0,  2.9E0,   .2E0, -4.0E0 /
 596 *
 597 *     .. Executable Statements ..
 598 *
 599       DO 120 KI = 1, 4
 600          INCX = INCXS(KI)
 601          INCY = INCYS(KI)
 602          MX = ABS(INCX)
 603          MY = ABS(INCY)
 604 *
 605          DO 100 KN = 1, 4
 606             N = NS(KN)
 607             KSIZE = MIN(2,KN)
 608             LENX = LENS(KN,MX)
 609             LENY = LENS(KN,MY)
 610 *           .. Initialize all argument arrays ..
 611             DO 20 I = 1, 7
 612                SX(I) = DX1(I)
 613                SY(I) = DY1(I)
 614    20       CONTINUE
 615 *
 616             IF (ICASE.EQ.1) THEN
 617 *              .. SDOT ..
 618                CALL STEST1(SDOT(N,SX,INCX,SY,INCY),DT7(KN,KI),SSIZE1(KN)
 619      +                     ,SFAC)
 620             ELSE IF (ICASE.EQ.2) THEN
 621 *              .. SAXPY ..
 622                CALL SAXPY(N,SA,SX,INCX,SY,INCY)
 623                DO 40 J = 1, LENY
 624                   STY(J) = DT8(J,KN,KI)
 625    40          CONTINUE
 626                CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
 627             ELSE IF (ICASE.EQ.5) THEN
 628 *              .. SCOPY ..
 629                DO 60 I = 1, 7
 630                   STY(I) = DT10Y(I,KN,KI)
 631    60          CONTINUE
 632                CALL SCOPY(N,SX,INCX,SY,INCY)
 633                CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0)
 634             ELSE IF (ICASE.EQ.6) THEN
 635 *              .. SSWAP ..
 636                CALL SSWAP(N,SX,INCX,SY,INCY)
 637                DO 80 I = 1, 7
 638                   STX(I) = DT10X(I,KN,KI)
 639                   STY(I) = DT10Y(I,KN,KI)
 640    80          CONTINUE
 641                CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0E0)
 642                CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0)
 643             ELSEIF (ICASE.EQ.12) THEN
 644 *              .. SROTM ..
 645                KNI=KN+4*(KI-1)
 646                DO KPAR=1,4
 647                   DO I=1,7
 648                      SX(I) = DX1(I)
 649                      SY(I) = DY1(I)
 650                      STX(I)= DT19X(I,KPAR,KNI)
 651                      STY(I)= DT19Y(I,KPAR,KNI)
 652                   END DO
 653 *
 654                   DO I=1,5
 655                      DTEMP(I) = DPAR(I,KPAR)
 656                   END DO
 657 *
 658                   DO  I=1,LENX
 659                      SSIZE(I)=STX(I)
 660                   END DO
 661 *                   SEE REMARK ABOVE ABOUT DT11X(1,2,7)
 662 *                       AND DT11X(5,3,8).
 663                   IF ((KPAR .EQ. 2) .AND. (KNI .EQ. 7))
 664      $               SSIZE(1) = 2.4E0
 665                   IF ((KPAR .EQ. 3) .AND. (KNI .EQ. 8))
 666      $               SSIZE(5) = 1.8E0
 667 *
 668                   CALL   SROTM(N,SX,INCX,SY,INCY,DTEMP)
 669                   CALL   STEST(LENX,SX,STX,SSIZE,SFAC)
 670                   CALL   STEST(LENY,SY,STY,STY,SFAC)
 671                END DO
 672             ELSEIF (ICASE.EQ.13) THEN
 673 *              .. SDSROT ..
 674                CALL STEST1 (SDSDOT(N,.1,SX,INCX,SY,INCY),
 675      $                 ST7B(KN,KI),SSIZE3(KN),SFAC)
 676             ELSE
 677                WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
 678                STOP
 679             END IF
 680   100    CONTINUE
 681   120 CONTINUE
 682       RETURN
 683       END
 684       SUBROUTINE CHECK3(SFAC)
 685 *     .. Parameters ..
 686       INTEGER           NOUT
 687       PARAMETER         (NOUT=6)
 688 *     .. Scalar Arguments ..
 689       REAL              SFAC
 690 *     .. Scalars in Common ..
 691       INTEGER           ICASE, INCX, INCY, N
 692       LOGICAL           PASS
 693 *     .. Local Scalars ..
 694       REAL              SC, SS
 695       INTEGER           I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
 696 *     .. Local Arrays ..
 697       REAL              COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
 698      +                  DX1(7), DY1(7), MWPC(11), MWPS(11), MWPSTX(5),
 699      +                  MWPSTY(5), MWPTX(11,5), MWPTY(11,5), MWPX(5),
 700      +                  MWPY(5), SSIZE2(14,2), STX(7), STY(7), SX(7),
 701      +                  SY(7)
 702       INTEGER           INCXS(4), INCYS(4), LENS(4,2), MWPINX(11),
 703      +                  MWPINY(11), MWPN(11), NS(4)
 704 *     .. External Subroutines ..
 705       EXTERNAL          SROT, STEST
 706 *     .. Intrinsic Functions ..
 707       INTRINSIC         ABS, MIN
 708 *     .. Common blocks ..
 709       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
 710 *     .. Data statements ..
 711       DATA              INCXS/1, 2, -2, -1/
 712       DATA              INCYS/1, -2, 1, -2/
 713       DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
 714       DATA              NS/0, 1, 2, 4/
 715       DATA              DX1/0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.9E0, -0.3E0,
 716      +                  -0.4E0/
 717       DATA              DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
 718      +                  0.8E0/
 719       DATA              SC, SS/0.8E0, 0.6E0/
 720       DATA              DT9X/0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 721      +                  0.0E0, 0.78E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 722      +                  0.0E0, 0.0E0, 0.78E0, -0.46E0, 0.0E0, 0.0E0,
 723      +                  0.0E0, 0.0E0, 0.0E0, 0.78E0, -0.46E0, -0.22E0,
 724      +                  1.06E0, 0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0,
 725      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.78E0,
 726      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 727      +                  0.66E0, 0.1E0, -0.1E0, 0.0E0, 0.0E0, 0.0E0,
 728      +                  0.0E0, 0.96E0, 0.1E0, -0.76E0, 0.8E0, 0.90E0,
 729      +                  -0.3E0, -0.02E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0,
 730      +                  0.0E0, 0.0E0, 0.0E0, 0.78E0, 0.0E0, 0.0E0,
 731      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.06E0, 0.1E0,
 732      +                  -0.1E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.90E0,
 733      +                  0.1E0, -0.22E0, 0.8E0, 0.18E0, -0.3E0, -0.02E0,
 734      +                  0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 735      +                  0.78E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 736      +                  0.0E0, 0.78E0, 0.26E0, 0.0E0, 0.0E0, 0.0E0,
 737      +                  0.0E0, 0.0E0, 0.78E0, 0.26E0, -0.76E0, 1.12E0,
 738      +                  0.0E0, 0.0E0, 0.0E0/
 739       DATA              DT9Y/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 740      +                  0.0E0, 0.04E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 741      +                  0.0E0, 0.0E0, 0.04E0, -0.78E0, 0.0E0, 0.0E0,
 742      +                  0.0E0, 0.0E0, 0.0E0, 0.04E0, -0.78E0, 0.54E0,
 743      +                  0.08E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
 744      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.04E0,
 745      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.7E0,
 746      +                  -0.9E0, -0.12E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 747      +                  0.64E0, -0.9E0, -0.30E0, 0.7E0, -0.18E0, 0.2E0,
 748      +                  0.28E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 749      +                  0.0E0, 0.0E0, 0.04E0, 0.0E0, 0.0E0, 0.0E0,
 750      +                  0.0E0, 0.0E0, 0.0E0, 0.7E0, -1.08E0, 0.0E0,
 751      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.64E0, -1.26E0,
 752      +                  0.54E0, 0.20E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0,
 753      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 754      +                  0.04E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 755      +                  0.0E0, 0.04E0, -0.9E0, 0.18E0, 0.0E0, 0.0E0,
 756      +                  0.0E0, 0.0E0, 0.04E0, -0.9E0, 0.18E0, 0.7E0,
 757      +                  -0.18E0, 0.2E0, 0.16E0/
 758       DATA              SSIZE2/0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 759      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
 760      +                  0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
 761      +                  1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
 762      +                  1.17E0, 1.17E0, 1.17E0/
 763 *     .. Executable Statements ..
 764 *
 765       DO 60 KI = 1, 4
 766          INCX = INCXS(KI)
 767          INCY = INCYS(KI)
 768          MX = ABS(INCX)
 769          MY = ABS(INCY)
 770 *
 771          DO 40 KN = 1, 4
 772             N = NS(KN)
 773             KSIZE = MIN(2,KN)
 774             LENX = LENS(KN,MX)
 775             LENY = LENS(KN,MY)
 776 *
 777             IF (ICASE.EQ.4) THEN
 778 *              .. SROT ..
 779                DO 20 I = 1, 7
 780                   SX(I) = DX1(I)
 781                   SY(I) = DY1(I)
 782                   STX(I) = DT9X(I,KN,KI)
 783                   STY(I) = DT9Y(I,KN,KI)
 784    20          CONTINUE
 785                CALL SROT(N,SX,INCX,SY,INCY,SC,SS)
 786                CALL STEST(LENX,SX,STX,SSIZE2(1,KSIZE),SFAC)
 787                CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
 788             ELSE
 789                WRITE (NOUT,*) ' Shouldn''t be here in CHECK3'
 790                STOP
 791             END IF
 792    40    CONTINUE
 793    60 CONTINUE
 794 *
 795       MWPC(1) = 1
 796       DO 80 I = 2, 11
 797          MWPC(I) = 0
 798    80 CONTINUE
 799       MWPS(1) = 0
 800       DO 100 I = 2, 6
 801          MWPS(I) = 1
 802   100 CONTINUE
 803       DO 120 I = 7, 11
 804          MWPS(I) = -1
 805   120 CONTINUE
 806       MWPINX(1) = 1
 807       MWPINX(2) = 1
 808       MWPINX(3) = 1
 809       MWPINX(4) = -1
 810       MWPINX(5) = 1
 811       MWPINX(6) = -1
 812       MWPINX(7) = 1
 813       MWPINX(8) = 1
 814       MWPINX(9) = -1
 815       MWPINX(10) = 1
 816       MWPINX(11) = -1
 817       MWPINY(1) = 1
 818       MWPINY(2) = 1
 819       MWPINY(3) = -1
 820       MWPINY(4) = -1
 821       MWPINY(5) = 2
 822       MWPINY(6) = 1
 823       MWPINY(7) = 1
 824       MWPINY(8) = -1
 825       MWPINY(9) = -1
 826       MWPINY(10) = 2
 827       MWPINY(11) = 1
 828       DO 140 I = 1, 11
 829          MWPN(I) = 5
 830   140 CONTINUE
 831       MWPN(5) = 3
 832       MWPN(10) = 3
 833       DO 160 I = 1, 5
 834          MWPX(I) = I
 835          MWPY(I) = I
 836          MWPTX(1,I) = I
 837          MWPTY(1,I) = I
 838          MWPTX(2,I) = I
 839          MWPTY(2,I) = -I
 840          MWPTX(3,I) = 6 - I
 841          MWPTY(3,I) = I - 6
 842          MWPTX(4,I) = I
 843          MWPTY(4,I) = -I
 844          MWPTX(6,I) = 6 - I
 845          MWPTY(6,I) = I - 6
 846          MWPTX(7,I) = -I
 847          MWPTY(7,I) = I
 848          MWPTX(8,I) = I - 6
 849          MWPTY(8,I) = 6 - I
 850          MWPTX(9,I) = -I
 851          MWPTY(9,I) = I
 852          MWPTX(11,I) = I - 6
 853          MWPTY(11,I) = 6 - I
 854   160 CONTINUE
 855       MWPTX(5,1) = 1
 856       MWPTX(5,2) = 3
 857       MWPTX(5,3) = 5
 858       MWPTX(5,4) = 4
 859       MWPTX(5,5) = 5
 860       MWPTY(5,1) = -1
 861       MWPTY(5,2) = 2
 862       MWPTY(5,3) = -2
 863       MWPTY(5,4) = 4
 864       MWPTY(5,5) = -3
 865       MWPTX(10,1) = -1
 866       MWPTX(10,2) = -3
 867       MWPTX(10,3) = -5
 868       MWPTX(10,4) = 4
 869       MWPTX(10,5) = 5
 870       MWPTY(10,1) = 1
 871       MWPTY(10,2) = 2
 872       MWPTY(10,3) = 2
 873       MWPTY(10,4) = 4
 874       MWPTY(10,5) = 3
 875       DO 200 I = 1, 11
 876          INCX = MWPINX(I)
 877          INCY = MWPINY(I)
 878          DO 180 K = 1, 5
 879             COPYX(K) = MWPX(K)
 880             COPYY(K) = MWPY(K)
 881             MWPSTX(K) = MWPTX(I,K)
 882             MWPSTY(K) = MWPTY(I,K)
 883   180    CONTINUE
 884          CALL SROT(MWPN(I),COPYX,INCX,COPYY,INCY,MWPC(I),MWPS(I))
 885          CALL STEST(5,COPYX,MWPSTX,MWPSTX,SFAC)
 886          CALL STEST(5,COPYY,MWPSTY,MWPSTY,SFAC)
 887   200 CONTINUE
 888       RETURN
 889       END
 890       SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
 891 *     ********************************* STEST **************************
 892 *
 893 *     THIS SUBR COMPARES ARRAYS  SCOMP() AND STRUE() OF LENGTH LEN TO
 894 *     SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
 895 *     NEGLIGIBLE.
 896 *
 897 *     C. L. LAWSON, JPL, 1974 DEC 10
 898 *
 899 *     .. Parameters ..
 900       INTEGER          NOUT
 901       REAL             ZERO
 902       PARAMETER        (NOUT=6, ZERO=0.0E0)
 903 *     .. Scalar Arguments ..
 904       REAL             SFAC
 905       INTEGER          LEN
 906 *     .. Array Arguments ..
 907       REAL             SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
 908 *     .. Scalars in Common ..
 909       INTEGER          ICASE, INCX, INCY, N
 910       LOGICAL          PASS
 911 *     .. Local Scalars ..
 912       REAL             SD
 913       INTEGER          I
 914 *     .. External Functions ..
 915       REAL             SDIFF
 916       EXTERNAL         SDIFF
 917 *     .. Intrinsic Functions ..
 918       INTRINSIC        ABS
 919 *     .. Common blocks ..
 920       COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
 921 *     .. Executable Statements ..
 922 *
 923       DO 40 I = 1, LEN
 924          SD = SCOMP(I) - STRUE(I)
 925          IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
 926      +       GO TO 40
 927 *
 928 *                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
 929 *
 930          IF ( .NOT. PASS) GO TO 20
 931 *                             PRINT FAIL MESSAGE AND HEADER.
 932          PASS = .FALSE.
 933          WRITE (NOUT,99999)
 934          WRITE (NOUT,99998)
 935    20    WRITE (NOUT,99997) ICASE, N, INCX, INCY, I, SCOMP(I),
 936      +     STRUE(I), SD, SSIZE(I)
 937    40 CONTINUE
 938       RETURN
 939 *
 940 99999 FORMAT ('                                       FAIL')
 941 99998 FORMAT (/' CASE  N INCX INCY  I                            ',
 942      +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
 943      +       '     SIZE(I)',/1X)
 944 99997 FORMAT (1X,I4,I3,2I5,I3,2E36.8,2E12.4)
 945       END
 946       SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
 947 *     ************************* STEST1 *****************************
 948 *
 949 *     THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN
 950 *     REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
 951 *     ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
 952 *
 953 *     C.L. LAWSON, JPL, 1978 DEC 6
 954 *
 955 *     .. Scalar Arguments ..
 956       REAL              SCOMP1, SFAC, STRUE1
 957 *     .. Array Arguments ..
 958       REAL              SSIZE(*)
 959 *     .. Local Arrays ..
 960       REAL              SCOMP(1), STRUE(1)
 961 *     .. External Subroutines ..
 962       EXTERNAL          STEST
 963 *     .. Executable Statements ..
 964 *
 965       SCOMP(1) = SCOMP1
 966       STRUE(1) = STRUE1
 967       CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
 968 *
 969       RETURN
 970       END
 971       REAL             FUNCTION SDIFF(SA,SB)
 972 *     ********************************* SDIFF **************************
 973 *     COMPUTES DIFFERENCE OF TWO NUMBERS.  C. L. LAWSON, JPL 1974 FEB 15
 974 *
 975 *     .. Scalar Arguments ..
 976       REAL                            SA, SB
 977 *     .. Executable Statements ..
 978       SDIFF = SA - SB
 979       RETURN
 980       END
 981       SUBROUTINE ITEST1(ICOMP,ITRUE)
 982 *     ********************************* ITEST1 *************************
 983 *
 984 *     THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
 985 *     EQUALITY.
 986 *     C. L. LAWSON, JPL, 1974 DEC 10
 987 *
 988 *     .. Parameters ..
 989       INTEGER           NOUT
 990       PARAMETER         (NOUT=6)
 991 *     .. Scalar Arguments ..
 992       INTEGER           ICOMP, ITRUE
 993 *     .. Scalars in Common ..
 994       INTEGER           ICASE, INCX, INCY, N
 995       LOGICAL           PASS
 996 *     .. Local Scalars ..
 997       INTEGER           ID
 998 *     .. Common blocks ..
 999       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
1000 *     .. Executable Statements ..
1001 *
1002       IF (ICOMP.EQ.ITRUE) GO TO 40
1003 *
1004 *                            HERE ICOMP IS NOT EQUAL TO ITRUE.
1005 *
1006       IF ( .NOT. PASS) GO TO 20
1007 *                             PRINT FAIL MESSAGE AND HEADER.
1008       PASS = .FALSE.
1009       WRITE (NOUT,99999)
1010       WRITE (NOUT,99998)
1011    20 ID = ICOMP - ITRUE
1012       WRITE (NOUT,99997) ICASE, N, INCX, INCY, ICOMP, ITRUE, ID
1013    40 CONTINUE
1014       RETURN
1015 *
1016 99999 FORMAT ('                                       FAIL')
1017 99998 FORMAT (/' CASE  N INCX INCY                               ',
1018      +       ' COMP                                TRUE     DIFFERENCE',
1019      +       /1X)
1020 99997 FORMAT (1X,I4,I3,2I5,2I36,I12)
1021       END