LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sblat1.f
Go to the documentation of this file.
00001 *> \brief \b SBLAT1
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       PROGRAM SBLAT1
00012 * 
00013 *
00014 *> \par Purpose:
00015 *  =============
00016 *>
00017 *> \verbatim
00018 *>
00019 *>    Test program for the REAL Level 1 BLAS.
00020 *>
00021 *>    Based upon the original BLAS test routine together with:
00022 *>    F06EAF Example Program Text
00023 *> \endverbatim
00024 *
00025 *  Authors:
00026 *  ========
00027 *
00028 *> \author Univ. of Tennessee 
00029 *> \author Univ. of California Berkeley 
00030 *> \author Univ. of Colorado Denver 
00031 *> \author NAG Ltd. 
00032 *
00033 *> \date April 2012
00034 *
00035 *> \ingroup single_blas_testing
00036 *
00037 *  =====================================================================
00038       PROGRAM SBLAT1
00039 *
00040 *  -- Reference BLAS test routine (version 3.4.1) --
00041 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
00042 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00043 *     April 2012
00044 *
00045 *  =====================================================================
00046 *
00047 *     .. Parameters ..
00048       INTEGER          NOUT
00049       PARAMETER        (NOUT=6)
00050 *     .. Scalars in Common ..
00051       INTEGER          ICASE, INCX, INCY, N
00052       LOGICAL          PASS
00053 *     .. Local Scalars ..
00054       REAL             SFAC
00055       INTEGER          IC
00056 *     .. External Subroutines ..
00057       EXTERNAL         CHECK0, CHECK1, CHECK2, CHECK3, HEADER
00058 *     .. Common blocks ..
00059       COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
00060 *     .. Data statements ..
00061       DATA             SFAC/9.765625E-4/
00062 *     .. Executable Statements ..
00063       WRITE (NOUT,99999)
00064       DO 20 IC = 1, 13
00065          ICASE = IC
00066          CALL HEADER
00067 *
00068 *        .. Initialize  PASS,  INCX,  and INCY for a new case. ..
00069 *        .. the value 9999 for INCX or INCY will appear in the ..
00070 *        .. detailed  output, if any, for cases  that do not involve ..
00071 *        .. these parameters ..
00072 *
00073          PASS = .TRUE.
00074          INCX = 9999
00075          INCY = 9999
00076          IF (ICASE.EQ.3 .OR. ICASE.EQ.11) THEN
00077             CALL CHECK0(SFAC)
00078          ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR.
00079      +            ICASE.EQ.10) THEN
00080             CALL CHECK1(SFAC)
00081          ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR.
00082      +            ICASE.EQ.6 .OR. ICASE.EQ.12 .OR. ICASE.EQ.13) THEN
00083             CALL CHECK2(SFAC)
00084          ELSE IF (ICASE.EQ.4) THEN
00085             CALL CHECK3(SFAC)
00086          END IF
00087 *        -- Print
00088          IF (PASS) WRITE (NOUT,99998)
00089    20 CONTINUE
00090       STOP
00091 *
00092 99999 FORMAT (' Real BLAS Test Program Results',/1X)
00093 99998 FORMAT ('                                    ----- PASS -----')
00094       END
00095       SUBROUTINE HEADER
00096 *     .. Parameters ..
00097       INTEGER          NOUT
00098       PARAMETER        (NOUT=6)
00099 *     .. Scalars in Common ..
00100       INTEGER          ICASE, INCX, INCY, N
00101       LOGICAL          PASS
00102 *     .. Local Arrays ..
00103       CHARACTER*6      L(13)
00104 *     .. Common blocks ..
00105       COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
00106 *     .. Data statements ..
00107       DATA             L(1)/' SDOT '/
00108       DATA             L(2)/'SAXPY '/
00109       DATA             L(3)/'SROTG '/
00110       DATA             L(4)/' SROT '/
00111       DATA             L(5)/'SCOPY '/
00112       DATA             L(6)/'SSWAP '/
00113       DATA             L(7)/'SNRM2 '/
00114       DATA             L(8)/'SASUM '/
00115       DATA             L(9)/'SSCAL '/
00116       DATA             L(10)/'ISAMAX'/
00117       DATA             L(11)/'SROTMG'/
00118       DATA             L(12)/'SROTM '/
00119       DATA             L(13)/'SDSDOT'/
00120 *     .. Executable Statements ..
00121       WRITE (NOUT,99999) ICASE, L(ICASE)
00122       RETURN
00123 *
00124 99999 FORMAT (/' Test of subprogram number',I3,12X,A6)
00125       END
00126       SUBROUTINE CHECK0(SFAC)
00127 *     .. Parameters ..
00128       INTEGER           NOUT
00129       PARAMETER         (NOUT=6)
00130 *     .. Scalar Arguments ..
00131       REAL              SFAC
00132 *     .. Scalars in Common ..
00133       INTEGER           ICASE, INCX, INCY, N
00134       LOGICAL           PASS
00135 *     .. Local Scalars ..
00136       REAL              D12, SA, SB, SC, SS
00137       INTEGER           I, K
00138 *     .. Local Arrays ..
00139       REAL              DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
00140      +                  DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9)
00141 *     .. External Subroutines ..
00142       EXTERNAL          SROTG, SROTMG, STEST1
00143 *     .. Common blocks ..
00144       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
00145 *     .. Data statements ..
00146       DATA              DA1/0.3E0, 0.4E0, -0.3E0, -0.4E0, -0.3E0, 0.0E0,
00147      +                  0.0E0, 1.0E0/
00148       DATA              DB1/0.4E0, 0.3E0, 0.4E0, 0.3E0, -0.4E0, 0.0E0,
00149      +                  1.0E0, 0.0E0/
00150       DATA              DC1/0.6E0, 0.8E0, -0.6E0, 0.8E0, 0.6E0, 1.0E0,
00151      +                  0.0E0, 1.0E0/
00152       DATA              DS1/0.8E0, 0.6E0, 0.8E0, -0.6E0, 0.8E0, 0.0E0,
00153      +                  1.0E0, 0.0E0/
00154       DATA              DATRUE/0.5E0, 0.5E0, 0.5E0, -0.5E0, -0.5E0,
00155      +                  0.0E0, 1.0E0, 1.0E0/
00156       DATA              DBTRUE/0.0E0, 0.6E0, 0.0E0, -0.6E0, 0.0E0,
00157      +                  0.0E0, 1.0E0, 0.0E0/
00158 *     INPUT FOR MODIFIED GIVENS
00159       DATA DAB/ .1E0,.3E0,1.2E0,.2E0,
00160      A          .7E0, .2E0, .6E0, 4.2E0,
00161      B          0.E0,0.E0,0.E0,0.E0,
00162      C          4.E0, -1.E0, 2.E0, 4.E0,
00163      D          6.E-10, 2.E-2, 1.E5, 10.E0,
00164      E          4.E10, 2.E-2, 1.E-5, 10.E0,
00165      F          2.E-10, 4.E-2, 1.E5, 10.E0,
00166      G          2.E10, 4.E-2, 1.E-5, 10.E0,
00167      H          4.E0, -2.E0, 8.E0, 4.E0    /
00168 *    TRUE RESULTS FOR MODIFIED GIVENS
00169       DATA DTRUE/0.E0,0.E0, 1.3E0, .2E0, 0.E0,0.E0,0.E0, .5E0, 0.E0,
00170      A           0.E0,0.E0, 4.5E0, 4.2E0, 1.E0, .5E0, 0.E0,0.E0,0.E0,
00171      B           0.E0,0.E0,0.E0,0.E0, -2.E0, 0.E0,0.E0,0.E0,0.E0,
00172      C           0.E0,0.E0,0.E0, 4.E0, -1.E0, 0.E0,0.E0,0.E0,0.E0,
00173      D           0.E0, 15.E-3, 0.E0, 10.E0, -1.E0, 0.E0, -1.E-4,
00174      E           0.E0, 1.E0,
00175      F           0.E0,0.E0, 6144.E-5, 10.E0, -1.E0, 4096.E0, -1.E6,
00176      G           0.E0, 1.E0,
00177      H           0.E0,0.E0,15.E0,10.E0,-1.E0, 5.E-5, 0.E0,1.E0,0.E0,
00178      I           0.E0,0.E0, 15.E0, 10.E0, -1. E0, 5.E5, -4096.E0,
00179      J           1.E0, 4096.E-6,
00180      K           0.E0,0.E0, 7.E0, 4.E0, 0.E0,0.E0, -.5E0, -.25E0, 0.E0/
00181 *                   4096 = 2 ** 12
00182       DATA D12  /4096.E0/
00183       DTRUE(1,1) = 12.E0 / 130.E0
00184       DTRUE(2,1) = 36.E0 / 130.E0
00185       DTRUE(7,1) = -1.E0 / 6.E0
00186       DTRUE(1,2) = 14.E0 / 75.E0
00187       DTRUE(2,2) = 49.E0 / 75.E0
00188       DTRUE(9,2) = 1.E0 / 7.E0
00189       DTRUE(1,5) = 45.E-11 * (D12 * D12)
00190       DTRUE(3,5) = 4.E5 / (3.E0 * D12)
00191       DTRUE(6,5) = 1.E0 / D12
00192       DTRUE(8,5) = 1.E4 / (3.E0 * D12)
00193       DTRUE(1,6) = 4.E10 / (1.5E0 * D12 * D12)
00194       DTRUE(2,6) = 2.E-2 / 1.5E0
00195       DTRUE(8,6) = 5.E-7 * D12
00196       DTRUE(1,7) = 4.E0 / 150.E0
00197       DTRUE(2,7) = (2.E-10 / 1.5E0) * (D12 * D12)
00198       DTRUE(7,7) = -DTRUE(6,5)
00199       DTRUE(9,7) = 1.E4 / D12
00200       DTRUE(1,8) = DTRUE(1,7)
00201       DTRUE(2,8) = 2.E10 / (1.5E0 * D12 * D12)
00202       DTRUE(1,9) = 32.E0 / 7.E0
00203       DTRUE(2,9) = -16.E0 / 7.E0
00204 *     .. Executable Statements ..
00205 *
00206 *     Compute true values which cannot be prestored
00207 *     in decimal notation
00208 *
00209       DBTRUE(1) = 1.0E0/0.6E0
00210       DBTRUE(3) = -1.0E0/0.6E0
00211       DBTRUE(5) = 1.0E0/0.6E0
00212 *
00213       DO 20 K = 1, 8
00214 *        .. Set N=K for identification in output if any ..
00215          N = K
00216          IF (ICASE.EQ.3) THEN
00217 *           .. SROTG ..
00218             IF (K.GT.8) GO TO 40
00219             SA = DA1(K)
00220             SB = DB1(K)
00221             CALL SROTG(SA,SB,SC,SS)
00222             CALL STEST1(SA,DATRUE(K),DATRUE(K),SFAC)
00223             CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC)
00224             CALL STEST1(SC,DC1(K),DC1(K),SFAC)
00225             CALL STEST1(SS,DS1(K),DS1(K),SFAC)
00226          ELSEIF (ICASE.EQ.11) THEN
00227 *           .. SROTMG ..
00228             DO I=1,4
00229                DTEMP(I)= DAB(I,K)
00230                DTEMP(I+4) = 0.0
00231             END DO
00232             DTEMP(9) = 0.0
00233             CALL SROTMG(DTEMP(1),DTEMP(2),DTEMP(3),DTEMP(4),DTEMP(5))
00234             CALL STEST(9,DTEMP,DTRUE(1,K),DTRUE(1,K),SFAC)
00235          ELSE
00236             WRITE (NOUT,*) ' Shouldn''t be here in CHECK0'
00237             STOP
00238          END IF
00239    20 CONTINUE
00240    40 RETURN
00241       END
00242       SUBROUTINE CHECK1(SFAC)
00243 *     .. Parameters ..
00244       INTEGER           NOUT
00245       PARAMETER         (NOUT=6)
00246 *     .. Scalar Arguments ..
00247       REAL              SFAC
00248 *     .. Scalars in Common ..
00249       INTEGER           ICASE, INCX, INCY, N
00250       LOGICAL           PASS
00251 *     .. Local Scalars ..
00252       INTEGER           I, LEN, NP1
00253 *     .. Local Arrays ..
00254       REAL              DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
00255      +                  SA(10), STEMP(1), STRUE(8), SX(8)
00256       INTEGER           ITRUE2(5)
00257 *     .. External Functions ..
00258       REAL              SASUM, SNRM2
00259       INTEGER           ISAMAX
00260       EXTERNAL          SASUM, SNRM2, ISAMAX
00261 *     .. External Subroutines ..
00262       EXTERNAL          ITEST1, SSCAL, STEST, STEST1
00263 *     .. Intrinsic Functions ..
00264       INTRINSIC         MAX
00265 *     .. Common blocks ..
00266       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
00267 *     .. Data statements ..
00268       DATA              SA/0.3E0, -1.0E0, 0.0E0, 1.0E0, 0.3E0, 0.3E0,
00269      +                  0.3E0, 0.3E0, 0.3E0, 0.3E0/
00270       DATA              DV/0.1E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
00271      +                  2.0E0, 2.0E0, 0.3E0, 3.0E0, 3.0E0, 3.0E0, 3.0E0,
00272      +                  3.0E0, 3.0E0, 3.0E0, 0.3E0, -0.4E0, 4.0E0,
00273      +                  4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0, 0.2E0,
00274      +                  -0.6E0, 0.3E0, 5.0E0, 5.0E0, 5.0E0, 5.0E0,
00275      +                  5.0E0, 0.1E0, -0.3E0, 0.5E0, -0.1E0, 6.0E0,
00276      +                  6.0E0, 6.0E0, 6.0E0, 0.1E0, 8.0E0, 8.0E0, 8.0E0,
00277      +                  8.0E0, 8.0E0, 8.0E0, 8.0E0, 0.3E0, 9.0E0, 9.0E0,
00278      +                  9.0E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0, 0.3E0, 2.0E0,
00279      +                  -0.4E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
00280      +                  0.2E0, 3.0E0, -0.6E0, 5.0E0, 0.3E0, 2.0E0,
00281      +                  2.0E0, 2.0E0, 0.1E0, 4.0E0, -0.3E0, 6.0E0,
00282      +                  -0.5E0, 7.0E0, -0.1E0, 3.0E0/
00283       DATA              DTRUE1/0.0E0, 0.3E0, 0.5E0, 0.7E0, 0.6E0/
00284       DATA              DTRUE3/0.0E0, 0.3E0, 0.7E0, 1.1E0, 1.0E0/
00285       DATA              DTRUE5/0.10E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
00286      +                  2.0E0, 2.0E0, 2.0E0, -0.3E0, 3.0E0, 3.0E0,
00287      +                  3.0E0, 3.0E0, 3.0E0, 3.0E0, 3.0E0, 0.0E0, 0.0E0,
00288      +                  4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0,
00289      +                  0.20E0, -0.60E0, 0.30E0, 5.0E0, 5.0E0, 5.0E0,
00290      +                  5.0E0, 5.0E0, 0.03E0, -0.09E0, 0.15E0, -0.03E0,
00291      +                  6.0E0, 6.0E0, 6.0E0, 6.0E0, 0.10E0, 8.0E0,
00292      +                  8.0E0, 8.0E0, 8.0E0, 8.0E0, 8.0E0, 8.0E0,
00293      +                  0.09E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0,
00294      +                  9.0E0, 9.0E0, 0.09E0, 2.0E0, -0.12E0, 2.0E0,
00295      +                  2.0E0, 2.0E0, 2.0E0, 2.0E0, 0.06E0, 3.0E0,
00296      +                  -0.18E0, 5.0E0, 0.09E0, 2.0E0, 2.0E0, 2.0E0,
00297      +                  0.03E0, 4.0E0, -0.09E0, 6.0E0, -0.15E0, 7.0E0,
00298      +                  -0.03E0, 3.0E0/
00299       DATA              ITRUE2/0, 1, 2, 2, 3/
00300 *     .. Executable Statements ..
00301       DO 80 INCX = 1, 2
00302          DO 60 NP1 = 1, 5
00303             N = NP1 - 1
00304             LEN = 2*MAX(N,1)
00305 *           .. Set vector arguments ..
00306             DO 20 I = 1, LEN
00307                SX(I) = DV(I,NP1,INCX)
00308    20       CONTINUE
00309 *
00310             IF (ICASE.EQ.7) THEN
00311 *              .. SNRM2 ..
00312                STEMP(1) = DTRUE1(NP1)
00313                CALL STEST1(SNRM2(N,SX,INCX),STEMP(1),STEMP,SFAC)
00314             ELSE IF (ICASE.EQ.8) THEN
00315 *              .. SASUM ..
00316                STEMP(1) = DTRUE3(NP1)
00317                CALL STEST1(SASUM(N,SX,INCX),STEMP(1),STEMP,SFAC)
00318             ELSE IF (ICASE.EQ.9) THEN
00319 *              .. SSCAL ..
00320                CALL SSCAL(N,SA((INCX-1)*5+NP1),SX,INCX)
00321                DO 40 I = 1, LEN
00322                   STRUE(I) = DTRUE5(I,NP1,INCX)
00323    40          CONTINUE
00324                CALL STEST(LEN,SX,STRUE,STRUE,SFAC)
00325             ELSE IF (ICASE.EQ.10) THEN
00326 *              .. ISAMAX ..
00327                CALL ITEST1(ISAMAX(N,SX,INCX),ITRUE2(NP1))
00328             ELSE
00329                WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
00330                STOP
00331             END IF
00332    60    CONTINUE
00333    80 CONTINUE
00334       RETURN
00335       END
00336       SUBROUTINE CHECK2(SFAC)
00337 *     .. Parameters ..
00338       INTEGER           NOUT
00339       PARAMETER         (NOUT=6)
00340 *     .. Scalar Arguments ..
00341       REAL              SFAC
00342 *     .. Scalars in Common ..
00343       INTEGER           ICASE, INCX, INCY, N
00344       LOGICAL           PASS
00345 *     .. Local Scalars ..
00346       REAL              SA
00347       INTEGER           I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
00348      $                  MX, MY 
00349 *     .. Local Arrays ..
00350       REAL              DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
00351      $                  DT8(7,4,4), DX1(7),
00352      $                  DY1(7), SSIZE1(4), SSIZE2(14,2), SSIZE3(4),
00353      $                  SSIZE(7), STX(7), STY(7), SX(7), SY(7),
00354      $                  DPAR(5,4), DT19X(7,4,16),DT19XA(7,4,4),
00355      $                  DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4),
00356      $                  DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4),
00357      $                  DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5),
00358      $                  ST7B(4,4)
00359       INTEGER           INCXS(4), INCYS(4), LENS(4,2), NS(4)
00360 *     .. External Functions ..
00361       REAL              SDOT, SDSDOT
00362       EXTERNAL          SDOT, SDSDOT
00363 *     .. External Subroutines ..
00364       EXTERNAL          SAXPY, SCOPY, SROTM, SSWAP, STEST, STEST1
00365 *     .. Intrinsic Functions ..
00366       INTRINSIC         ABS, MIN
00367 *     .. Common blocks ..
00368       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
00369 *     .. Data statements ..
00370       EQUIVALENCE (DT19X(1,1,1),DT19XA(1,1,1)),(DT19X(1,1,5),
00371      A   DT19XB(1,1,1)),(DT19X(1,1,9),DT19XC(1,1,1)),
00372      B   (DT19X(1,1,13),DT19XD(1,1,1))
00373       EQUIVALENCE (DT19Y(1,1,1),DT19YA(1,1,1)),(DT19Y(1,1,5),
00374      A   DT19YB(1,1,1)),(DT19Y(1,1,9),DT19YC(1,1,1)),
00375      B   (DT19Y(1,1,13),DT19YD(1,1,1))
00376 
00377       DATA              SA/0.3E0/
00378       DATA              INCXS/1, 2, -2, -1/
00379       DATA              INCYS/1, -2, 1, -2/
00380       DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
00381       DATA              NS/0, 1, 2, 4/
00382       DATA              DX1/0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.9E0, -0.3E0,
00383      +                  -0.4E0/
00384       DATA              DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
00385      +                  0.8E0/
00386       DATA              DT7/0.0E0, 0.30E0, 0.21E0, 0.62E0, 0.0E0,
00387      +                  0.30E0, -0.07E0, 0.85E0, 0.0E0, 0.30E0, -0.79E0,
00388      +                  -0.74E0, 0.0E0, 0.30E0, 0.33E0, 1.27E0/
00389       DATA              ST7B/ .1, .4, .31, .72,     .1, .4, .03, .95,
00390      +                  .1, .4, -.69, -.64,   .1, .4, .43, 1.37/
00391       DATA              DT8/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00392      +                  0.0E0, 0.68E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00393      +                  0.0E0, 0.0E0, 0.68E0, -0.87E0, 0.0E0, 0.0E0,
00394      +                  0.0E0, 0.0E0, 0.0E0, 0.68E0, -0.87E0, 0.15E0,
00395      +                  0.94E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
00396      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.68E0,
00397      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00398      +                  0.35E0, -0.9E0, 0.48E0, 0.0E0, 0.0E0, 0.0E0,
00399      +                  0.0E0, 0.38E0, -0.9E0, 0.57E0, 0.7E0, -0.75E0,
00400      +                  0.2E0, 0.98E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0,
00401      +                  0.0E0, 0.0E0, 0.0E0, 0.68E0, 0.0E0, 0.0E0,
00402      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.35E0, -0.72E0,
00403      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.38E0,
00404      +                  -0.63E0, 0.15E0, 0.88E0, 0.0E0, 0.0E0, 0.0E0,
00405      +                  0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00406      +                  0.68E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00407      +                  0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.0E0, 0.0E0,
00408      +                  0.0E0, 0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.7E0,
00409      +                  -0.75E0, 0.2E0, 1.04E0/
00410       DATA              DT10X/0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00411      +                  0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00412      +                  0.0E0, 0.5E0, -0.9E0, 0.0E0, 0.0E0, 0.0E0,
00413      +                  0.0E0, 0.0E0, 0.5E0, -0.9E0, 0.3E0, 0.7E0,
00414      +                  0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0,
00415      +                  0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0,
00416      +                  0.0E0, 0.0E0, 0.0E0, 0.3E0, 0.1E0, 0.5E0, 0.0E0,
00417      +                  0.0E0, 0.0E0, 0.0E0, 0.8E0, 0.1E0, -0.6E0,
00418      +                  0.8E0, 0.3E0, -0.3E0, 0.5E0, 0.6E0, 0.0E0,
00419      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
00420      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.9E0,
00421      +                  0.1E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.7E0,
00422      +                  0.1E0, 0.3E0, 0.8E0, -0.9E0, -0.3E0, 0.5E0,
00423      +                  0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00424      +                  0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00425      +                  0.5E0, 0.3E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00426      +                  0.5E0, 0.3E0, -0.6E0, 0.8E0, 0.0E0, 0.0E0,
00427      +                  0.0E0/
00428       DATA              DT10Y/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00429      +                  0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00430      +                  0.0E0, 0.6E0, 0.1E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00431      +                  0.0E0, 0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.0E0,
00432      +                  0.0E0, 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00433      +                  0.0E0, 0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00434      +                  0.0E0, 0.0E0, -0.5E0, -0.9E0, 0.6E0, 0.0E0,
00435      +                  0.0E0, 0.0E0, 0.0E0, -0.4E0, -0.9E0, 0.9E0,
00436      +                  0.7E0, -0.5E0, 0.2E0, 0.6E0, 0.5E0, 0.0E0,
00437      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0,
00438      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.5E0,
00439      +                  0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00440      +                  -0.4E0, 0.9E0, -0.5E0, 0.6E0, 0.0E0, 0.0E0,
00441      +                  0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00442      +                  0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00443      +                  0.0E0, 0.6E0, -0.9E0, 0.1E0, 0.0E0, 0.0E0,
00444      +                  0.0E0, 0.0E0, 0.6E0, -0.9E0, 0.1E0, 0.7E0,
00445      +                  -0.5E0, 0.2E0, 0.8E0/
00446       DATA              SSIZE1/0.0E0, 0.3E0, 1.6E0, 3.2E0/
00447       DATA              SSIZE2/0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00448      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00449      +                  0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
00450      +                  1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
00451      +                  1.17E0, 1.17E0, 1.17E0/
00452       DATA              SSIZE3/ .1, .4, 1.7, 3.3 /
00453 *
00454 *                         FOR DROTM
00455 *
00456       DATA DPAR/-2.E0,  0.E0,0.E0,0.E0,0.E0,
00457      A          -1.E0,  2.E0, -3.E0, -4.E0,  5.E0,
00458      B           0.E0,  0.E0,  2.E0, -3.E0,  0.E0,
00459      C           1.E0,  5.E0,  2.E0,  0.E0, -4.E0/
00460 *                        TRUE X RESULTS F0R ROTATIONS DROTM
00461       DATA DT19XA/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00462      A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00463      B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00464      C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00465      D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00466      E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00467      F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00468      G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00469      H            .6E0,   .1E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00470      I           -.8E0,  3.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00471      J           -.9E0,  2.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00472      K           3.5E0,  -.4E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00473      L            .6E0,   .1E0,  -.5E0,   .8E0,          0.E0,0.E0,0.E0,
00474      M           -.8E0,  3.8E0, -2.2E0, -1.2E0,          0.E0,0.E0,0.E0,
00475      N           -.9E0,  2.8E0, -1.4E0, -1.3E0,          0.E0,0.E0,0.E0,
00476      O           3.5E0,  -.4E0, -2.2E0,  4.7E0,          0.E0,0.E0,0.E0/
00477 *
00478       DATA DT19XB/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00479      A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00480      B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00481      C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00482      D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00483      E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00484      F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00485      G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00486      H            .6E0,   .1E0,  -.5E0,             0.E0,0.E0,0.E0,0.E0,
00487      I           0.E0,    .1E0, -3.0E0,             0.E0,0.E0,0.E0,0.E0,
00488      J           -.3E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
00489      K           3.3E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
00490      L            .6E0,   .1E0,  -.5E0,   .8E0,   .9E0,  -.3E0,  -.4E0,
00491      M          -2.0E0,   .1E0,  1.4E0,   .8E0,   .6E0,  -.3E0, -2.8E0,
00492      N          -1.8E0,   .1E0,  1.3E0,   .8E0,  0.E0,   -.3E0, -1.9E0,
00493      O           3.8E0,   .1E0, -3.1E0,   .8E0,  4.8E0,  -.3E0, -1.5E0 /
00494 *
00495       DATA DT19XC/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00496      A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00497      B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00498      C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00499      D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00500      E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00501      F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00502      G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00503      H            .6E0,   .1E0,  -.5E0,             0.E0,0.E0,0.E0,0.E0,
00504      I           4.8E0,   .1E0, -3.0E0,             0.E0,0.E0,0.E0,0.E0,
00505      J           3.3E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
00506      K           2.1E0,   .1E0, -2.0E0,             0.E0,0.E0,0.E0,0.E0,
00507      L            .6E0,   .1E0,  -.5E0,   .8E0,   .9E0,  -.3E0,  -.4E0,
00508      M          -1.6E0,   .1E0, -2.2E0,   .8E0,  5.4E0,  -.3E0, -2.8E0,
00509      N          -1.5E0,   .1E0, -1.4E0,   .8E0,  3.6E0,  -.3E0, -1.9E0,
00510      O           3.7E0,   .1E0, -2.2E0,   .8E0,  3.6E0,  -.3E0, -1.5E0 /
00511 *
00512       DATA DT19XD/.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00513      A            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00514      B            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00515      C            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00516      D            .6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00517      E           -.8E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00518      F           -.9E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00519      G           3.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00520      H            .6E0,   .1E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00521      I           -.8E0, -1.0E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00522      J           -.9E0,  -.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00523      K           3.5E0,   .8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00524      L            .6E0,   .1E0,  -.5E0,   .8E0,          0.E0,0.E0,0.E0,
00525      M           -.8E0, -1.0E0,  1.4E0, -1.6E0,          0.E0,0.E0,0.E0,
00526      N           -.9E0,  -.8E0,  1.3E0, -1.6E0,          0.E0,0.E0,0.E0,
00527      O           3.5E0,   .8E0, -3.1E0,  4.8E0,          0.E0,0.E0,0.E0/
00528 *                        TRUE Y RESULTS FOR ROTATIONS DROTM
00529       DATA DT19YA/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00530      A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00531      B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00532      C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00533      D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00534      E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00535      F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00536      G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00537      H            .5E0,  -.9E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00538      I            .7E0, -4.8E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00539      J           1.7E0,  -.7E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00540      K          -2.6E0,  3.5E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00541      L            .5E0,  -.9E0,   .3E0,   .7E0,          0.E0,0.E0,0.E0,
00542      M            .7E0, -4.8E0,  3.0E0,  1.1E0,          0.E0,0.E0,0.E0,
00543      N           1.7E0,  -.7E0,  -.7E0,  2.3E0,          0.E0,0.E0,0.E0,
00544      O          -2.6E0,  3.5E0,  -.7E0, -3.6E0,          0.E0,0.E0,0.E0/
00545 *
00546       DATA DT19YB/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00547      A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00548      B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00549      C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00550      D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00551      E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00552      F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00553      G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00554      H            .5E0,  -.9E0,   .3E0,             0.E0,0.E0,0.E0,0.E0,
00555      I           4.0E0,  -.9E0,  -.3E0,             0.E0,0.E0,0.E0,0.E0,
00556      J           -.5E0,  -.9E0,  1.5E0,             0.E0,0.E0,0.E0,0.E0,
00557      K          -1.5E0,  -.9E0, -1.8E0,             0.E0,0.E0,0.E0,0.E0,
00558      L            .5E0,  -.9E0,   .3E0,   .7E0,  -.6E0,   .2E0,   .8E0,
00559      M           3.7E0,  -.9E0, -1.2E0,   .7E0, -1.5E0,   .2E0,  2.2E0,
00560      N           -.3E0,  -.9E0,  2.1E0,   .7E0, -1.6E0,   .2E0,  2.0E0,
00561      O          -1.6E0,  -.9E0, -2.1E0,   .7E0,  2.9E0,   .2E0, -3.8E0 /
00562 *
00563       DATA DT19YC/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00564      A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00565      B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00566      C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00567      D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00568      E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00569      F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00570      G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00571      H            .5E0,  -.9E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00572      I           4.0E0, -6.3E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00573      J           -.5E0,   .3E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00574      K          -1.5E0,  3.0E0,             0.E0,0.E0,0.E0,0.E0,0.E0,
00575      L            .5E0,  -.9E0,   .3E0,   .7E0,          0.E0,0.E0,0.E0,
00576      M           3.7E0, -7.2E0,  3.0E0,  1.7E0,          0.E0,0.E0,0.E0,
00577      N           -.3E0,   .9E0,  -.7E0,  1.9E0,          0.E0,0.E0,0.E0,
00578      O          -1.6E0,  2.7E0,  -.7E0, -3.4E0,          0.E0,0.E0,0.E0/
00579 *
00580       DATA DT19YD/.5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00581      A            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00582      B            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00583      C            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00584      D            .5E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00585      E            .7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00586      F           1.7E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00587      G          -2.6E0,                  0.E0,0.E0,0.E0,0.E0,0.E0,0.E0,
00588      H            .5E0,  -.9E0,   .3E0,             0.E0,0.E0,0.E0,0.E0,
00589      I            .7E0,  -.9E0,  1.2E0,             0.E0,0.E0,0.E0,0.E0,
00590      J           1.7E0,  -.9E0,   .5E0,             0.E0,0.E0,0.E0,0.E0,
00591      K          -2.6E0,  -.9E0, -1.3E0,             0.E0,0.E0,0.E0,0.E0,
00592      L            .5E0,  -.9E0,   .3E0,   .7E0,  -.6E0,   .2E0,   .8E0,
00593      M            .7E0,  -.9E0,  1.2E0,   .7E0, -1.5E0,   .2E0,  1.6E0,
00594      N           1.7E0,  -.9E0,   .5E0,   .7E0, -1.6E0,   .2E0,  2.4E0,
00595      O          -2.6E0,  -.9E0, -1.3E0,   .7E0,  2.9E0,   .2E0, -4.0E0 /
00596 *
00597 *     .. Executable Statements ..
00598 *
00599       DO 120 KI = 1, 4
00600          INCX = INCXS(KI)
00601          INCY = INCYS(KI)
00602          MX = ABS(INCX)
00603          MY = ABS(INCY)
00604 *
00605          DO 100 KN = 1, 4
00606             N = NS(KN)
00607             KSIZE = MIN(2,KN)
00608             LENX = LENS(KN,MX)
00609             LENY = LENS(KN,MY)
00610 *           .. Initialize all argument arrays ..
00611             DO 20 I = 1, 7
00612                SX(I) = DX1(I)
00613                SY(I) = DY1(I)
00614    20       CONTINUE
00615 *
00616             IF (ICASE.EQ.1) THEN
00617 *              .. SDOT ..
00618                CALL STEST1(SDOT(N,SX,INCX,SY,INCY),DT7(KN,KI),SSIZE1(KN)
00619      +                     ,SFAC)
00620             ELSE IF (ICASE.EQ.2) THEN
00621 *              .. SAXPY ..
00622                CALL SAXPY(N,SA,SX,INCX,SY,INCY)
00623                DO 40 J = 1, LENY
00624                   STY(J) = DT8(J,KN,KI)
00625    40          CONTINUE
00626                CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
00627             ELSE IF (ICASE.EQ.5) THEN
00628 *              .. SCOPY ..
00629                DO 60 I = 1, 7
00630                   STY(I) = DT10Y(I,KN,KI)
00631    60          CONTINUE
00632                CALL SCOPY(N,SX,INCX,SY,INCY)
00633                CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0)
00634             ELSE IF (ICASE.EQ.6) THEN
00635 *              .. SSWAP ..
00636                CALL SSWAP(N,SX,INCX,SY,INCY)
00637                DO 80 I = 1, 7
00638                   STX(I) = DT10X(I,KN,KI)
00639                   STY(I) = DT10Y(I,KN,KI)
00640    80          CONTINUE
00641                CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0E0)
00642                CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0)
00643             ELSEIF (ICASE.EQ.12) THEN
00644 *              .. SROTM ..
00645                KNI=KN+4*(KI-1)
00646                DO KPAR=1,4
00647                   DO I=1,7
00648                      SX(I) = DX1(I)
00649                      SY(I) = DY1(I)
00650                      STX(I)= DT19X(I,KPAR,KNI)
00651                      STY(I)= DT19Y(I,KPAR,KNI)
00652                   END DO
00653 *
00654                   DO I=1,5
00655                      DTEMP(I) = DPAR(I,KPAR)
00656                   END DO
00657 *
00658                   DO  I=1,LENX
00659                      SSIZE(I)=STX(I)
00660                   END DO
00661 *                   SEE REMARK ABOVE ABOUT DT11X(1,2,7)
00662 *                       AND DT11X(5,3,8).
00663                   IF ((KPAR .EQ. 2) .AND. (KNI .EQ. 7))
00664      $               SSIZE(1) = 2.4E0
00665                   IF ((KPAR .EQ. 3) .AND. (KNI .EQ. 8))
00666      $               SSIZE(5) = 1.8E0
00667 *
00668                   CALL   SROTM(N,SX,INCX,SY,INCY,DTEMP)
00669                   CALL   STEST(LENX,SX,STX,SSIZE,SFAC)
00670                   CALL   STEST(LENY,SY,STY,STY,SFAC)
00671                END DO
00672             ELSEIF (ICASE.EQ.13) THEN
00673 *              .. SDSROT ..
00674                CALL STEST1 (SDSDOT(N,.1,SX,INCX,SY,INCY),
00675      $                 ST7B(KN,KI),SSIZE3(KN),SFAC)
00676             ELSE
00677                WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
00678                STOP
00679             END IF
00680   100    CONTINUE
00681   120 CONTINUE
00682       RETURN
00683       END
00684       SUBROUTINE CHECK3(SFAC)
00685 *     .. Parameters ..
00686       INTEGER           NOUT
00687       PARAMETER         (NOUT=6)
00688 *     .. Scalar Arguments ..
00689       REAL              SFAC
00690 *     .. Scalars in Common ..
00691       INTEGER           ICASE, INCX, INCY, N
00692       LOGICAL           PASS
00693 *     .. Local Scalars ..
00694       REAL              SC, SS
00695       INTEGER           I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
00696 *     .. Local Arrays ..
00697       REAL              COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
00698      +                  DX1(7), DY1(7), MWPC(11), MWPS(11), MWPSTX(5),
00699      +                  MWPSTY(5), MWPTX(11,5), MWPTY(11,5), MWPX(5),
00700      +                  MWPY(5), SSIZE2(14,2), STX(7), STY(7), SX(7),
00701      +                  SY(7)
00702       INTEGER           INCXS(4), INCYS(4), LENS(4,2), MWPINX(11),
00703      +                  MWPINY(11), MWPN(11), NS(4)
00704 *     .. External Subroutines ..
00705       EXTERNAL          SROT, STEST
00706 *     .. Intrinsic Functions ..
00707       INTRINSIC         ABS, MIN
00708 *     .. Common blocks ..
00709       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
00710 *     .. Data statements ..
00711       DATA              INCXS/1, 2, -2, -1/
00712       DATA              INCYS/1, -2, 1, -2/
00713       DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
00714       DATA              NS/0, 1, 2, 4/
00715       DATA              DX1/0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.9E0, -0.3E0,
00716      +                  -0.4E0/
00717       DATA              DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
00718      +                  0.8E0/
00719       DATA              SC, SS/0.8E0, 0.6E0/
00720       DATA              DT9X/0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00721      +                  0.0E0, 0.78E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00722      +                  0.0E0, 0.0E0, 0.78E0, -0.46E0, 0.0E0, 0.0E0,
00723      +                  0.0E0, 0.0E0, 0.0E0, 0.78E0, -0.46E0, -0.22E0,
00724      +                  1.06E0, 0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0,
00725      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.78E0,
00726      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00727      +                  0.66E0, 0.1E0, -0.1E0, 0.0E0, 0.0E0, 0.0E0,
00728      +                  0.0E0, 0.96E0, 0.1E0, -0.76E0, 0.8E0, 0.90E0,
00729      +                  -0.3E0, -0.02E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0,
00730      +                  0.0E0, 0.0E0, 0.0E0, 0.78E0, 0.0E0, 0.0E0,
00731      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.06E0, 0.1E0,
00732      +                  -0.1E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.90E0,
00733      +                  0.1E0, -0.22E0, 0.8E0, 0.18E0, -0.3E0, -0.02E0,
00734      +                  0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00735      +                  0.78E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00736      +                  0.0E0, 0.78E0, 0.26E0, 0.0E0, 0.0E0, 0.0E0,
00737      +                  0.0E0, 0.0E0, 0.78E0, 0.26E0, -0.76E0, 1.12E0,
00738      +                  0.0E0, 0.0E0, 0.0E0/
00739       DATA              DT9Y/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00740      +                  0.0E0, 0.04E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00741      +                  0.0E0, 0.0E0, 0.04E0, -0.78E0, 0.0E0, 0.0E0,
00742      +                  0.0E0, 0.0E0, 0.0E0, 0.04E0, -0.78E0, 0.54E0,
00743      +                  0.08E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
00744      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.04E0,
00745      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.7E0,
00746      +                  -0.9E0, -0.12E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00747      +                  0.64E0, -0.9E0, -0.30E0, 0.7E0, -0.18E0, 0.2E0,
00748      +                  0.28E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00749      +                  0.0E0, 0.0E0, 0.04E0, 0.0E0, 0.0E0, 0.0E0,
00750      +                  0.0E0, 0.0E0, 0.0E0, 0.7E0, -1.08E0, 0.0E0,
00751      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.64E0, -1.26E0,
00752      +                  0.54E0, 0.20E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0,
00753      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00754      +                  0.04E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00755      +                  0.0E0, 0.04E0, -0.9E0, 0.18E0, 0.0E0, 0.0E0,
00756      +                  0.0E0, 0.0E0, 0.04E0, -0.9E0, 0.18E0, 0.7E0,
00757      +                  -0.18E0, 0.2E0, 0.16E0/
00758       DATA              SSIZE2/0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00759      +                  0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
00760      +                  0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
00761      +                  1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
00762      +                  1.17E0, 1.17E0, 1.17E0/
00763 *     .. Executable Statements ..
00764 *
00765       DO 60 KI = 1, 4
00766          INCX = INCXS(KI)
00767          INCY = INCYS(KI)
00768          MX = ABS(INCX)
00769          MY = ABS(INCY)
00770 *
00771          DO 40 KN = 1, 4
00772             N = NS(KN)
00773             KSIZE = MIN(2,KN)
00774             LENX = LENS(KN,MX)
00775             LENY = LENS(KN,MY)
00776 *
00777             IF (ICASE.EQ.4) THEN
00778 *              .. SROT ..
00779                DO 20 I = 1, 7
00780                   SX(I) = DX1(I)
00781                   SY(I) = DY1(I)
00782                   STX(I) = DT9X(I,KN,KI)
00783                   STY(I) = DT9Y(I,KN,KI)
00784    20          CONTINUE
00785                CALL SROT(N,SX,INCX,SY,INCY,SC,SS)
00786                CALL STEST(LENX,SX,STX,SSIZE2(1,KSIZE),SFAC)
00787                CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
00788             ELSE
00789                WRITE (NOUT,*) ' Shouldn''t be here in CHECK3'
00790                STOP
00791             END IF
00792    40    CONTINUE
00793    60 CONTINUE
00794 *
00795       MWPC(1) = 1
00796       DO 80 I = 2, 11
00797          MWPC(I) = 0
00798    80 CONTINUE
00799       MWPS(1) = 0
00800       DO 100 I = 2, 6
00801          MWPS(I) = 1
00802   100 CONTINUE
00803       DO 120 I = 7, 11
00804          MWPS(I) = -1
00805   120 CONTINUE
00806       MWPINX(1) = 1
00807       MWPINX(2) = 1
00808       MWPINX(3) = 1
00809       MWPINX(4) = -1
00810       MWPINX(5) = 1
00811       MWPINX(6) = -1
00812       MWPINX(7) = 1
00813       MWPINX(8) = 1
00814       MWPINX(9) = -1
00815       MWPINX(10) = 1
00816       MWPINX(11) = -1
00817       MWPINY(1) = 1
00818       MWPINY(2) = 1
00819       MWPINY(3) = -1
00820       MWPINY(4) = -1
00821       MWPINY(5) = 2
00822       MWPINY(6) = 1
00823       MWPINY(7) = 1
00824       MWPINY(8) = -1
00825       MWPINY(9) = -1
00826       MWPINY(10) = 2
00827       MWPINY(11) = 1
00828       DO 140 I = 1, 11
00829          MWPN(I) = 5
00830   140 CONTINUE
00831       MWPN(5) = 3
00832       MWPN(10) = 3
00833       DO 160 I = 1, 5
00834          MWPX(I) = I
00835          MWPY(I) = I
00836          MWPTX(1,I) = I
00837          MWPTY(1,I) = I
00838          MWPTX(2,I) = I
00839          MWPTY(2,I) = -I
00840          MWPTX(3,I) = 6 - I
00841          MWPTY(3,I) = I - 6
00842          MWPTX(4,I) = I
00843          MWPTY(4,I) = -I
00844          MWPTX(6,I) = 6 - I
00845          MWPTY(6,I) = I - 6
00846          MWPTX(7,I) = -I
00847          MWPTY(7,I) = I
00848          MWPTX(8,I) = I - 6
00849          MWPTY(8,I) = 6 - I
00850          MWPTX(9,I) = -I
00851          MWPTY(9,I) = I
00852          MWPTX(11,I) = I - 6
00853          MWPTY(11,I) = 6 - I
00854   160 CONTINUE
00855       MWPTX(5,1) = 1
00856       MWPTX(5,2) = 3
00857       MWPTX(5,3) = 5
00858       MWPTX(5,4) = 4
00859       MWPTX(5,5) = 5
00860       MWPTY(5,1) = -1
00861       MWPTY(5,2) = 2
00862       MWPTY(5,3) = -2
00863       MWPTY(5,4) = 4
00864       MWPTY(5,5) = -3
00865       MWPTX(10,1) = -1
00866       MWPTX(10,2) = -3
00867       MWPTX(10,3) = -5
00868       MWPTX(10,4) = 4
00869       MWPTX(10,5) = 5
00870       MWPTY(10,1) = 1
00871       MWPTY(10,2) = 2
00872       MWPTY(10,3) = 2
00873       MWPTY(10,4) = 4
00874       MWPTY(10,5) = 3
00875       DO 200 I = 1, 11
00876          INCX = MWPINX(I)
00877          INCY = MWPINY(I)
00878          DO 180 K = 1, 5
00879             COPYX(K) = MWPX(K)
00880             COPYY(K) = MWPY(K)
00881             MWPSTX(K) = MWPTX(I,K)
00882             MWPSTY(K) = MWPTY(I,K)
00883   180    CONTINUE
00884          CALL SROT(MWPN(I),COPYX,INCX,COPYY,INCY,MWPC(I),MWPS(I))
00885          CALL STEST(5,COPYX,MWPSTX,MWPSTX,SFAC)
00886          CALL STEST(5,COPYY,MWPSTY,MWPSTY,SFAC)
00887   200 CONTINUE
00888       RETURN
00889       END
00890       SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
00891 *     ********************************* STEST **************************
00892 *
00893 *     THIS SUBR COMPARES ARRAYS  SCOMP() AND STRUE() OF LENGTH LEN TO
00894 *     SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
00895 *     NEGLIGIBLE.
00896 *
00897 *     C. L. LAWSON, JPL, 1974 DEC 10
00898 *
00899 *     .. Parameters ..
00900       INTEGER          NOUT
00901       REAL             ZERO
00902       PARAMETER        (NOUT=6, ZERO=0.0E0)
00903 *     .. Scalar Arguments ..
00904       REAL             SFAC
00905       INTEGER          LEN
00906 *     .. Array Arguments ..
00907       REAL             SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
00908 *     .. Scalars in Common ..
00909       INTEGER          ICASE, INCX, INCY, N
00910       LOGICAL          PASS
00911 *     .. Local Scalars ..
00912       REAL             SD
00913       INTEGER          I
00914 *     .. External Functions ..
00915       REAL             SDIFF
00916       EXTERNAL         SDIFF
00917 *     .. Intrinsic Functions ..
00918       INTRINSIC        ABS
00919 *     .. Common blocks ..
00920       COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
00921 *     .. Executable Statements ..
00922 *
00923       DO 40 I = 1, LEN
00924          SD = SCOMP(I) - STRUE(I)
00925          IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
00926      +       GO TO 40
00927 *
00928 *                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
00929 *
00930          IF ( .NOT. PASS) GO TO 20
00931 *                             PRINT FAIL MESSAGE AND HEADER.
00932          PASS = .FALSE.
00933          WRITE (NOUT,99999)
00934          WRITE (NOUT,99998)
00935    20    WRITE (NOUT,99997) ICASE, N, INCX, INCY, I, SCOMP(I),
00936      +     STRUE(I), SD, SSIZE(I)
00937    40 CONTINUE
00938       RETURN
00939 *
00940 99999 FORMAT ('                                       FAIL')
00941 99998 FORMAT (/' CASE  N INCX INCY  I                            ',
00942      +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
00943      +       '     SIZE(I)',/1X)
00944 99997 FORMAT (1X,I4,I3,2I5,I3,2E36.8,2E12.4)
00945       END
00946       SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
00947 *     ************************* STEST1 *****************************
00948 *
00949 *     THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
00950 *     REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
00951 *     ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
00952 *
00953 *     C.L. LAWSON, JPL, 1978 DEC 6
00954 *
00955 *     .. Scalar Arguments ..
00956       REAL              SCOMP1, SFAC, STRUE1
00957 *     .. Array Arguments ..
00958       REAL              SSIZE(*)
00959 *     .. Local Arrays ..
00960       REAL              SCOMP(1), STRUE(1)
00961 *     .. External Subroutines ..
00962       EXTERNAL          STEST
00963 *     .. Executable Statements ..
00964 *
00965       SCOMP(1) = SCOMP1
00966       STRUE(1) = STRUE1
00967       CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
00968 *
00969       RETURN
00970       END
00971       REAL             FUNCTION SDIFF(SA,SB)
00972 *     ********************************* SDIFF **************************
00973 *     COMPUTES DIFFERENCE OF TWO NUMBERS.  C. L. LAWSON, JPL 1974 FEB 15
00974 *
00975 *     .. Scalar Arguments ..
00976       REAL                            SA, SB
00977 *     .. Executable Statements ..
00978       SDIFF = SA - SB
00979       RETURN
00980       END
00981       SUBROUTINE ITEST1(ICOMP,ITRUE)
00982 *     ********************************* ITEST1 *************************
00983 *
00984 *     THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
00985 *     EQUALITY.
00986 *     C. L. LAWSON, JPL, 1974 DEC 10
00987 *
00988 *     .. Parameters ..
00989       INTEGER           NOUT
00990       PARAMETER         (NOUT=6)
00991 *     .. Scalar Arguments ..
00992       INTEGER           ICOMP, ITRUE
00993 *     .. Scalars in Common ..
00994       INTEGER           ICASE, INCX, INCY, N
00995       LOGICAL           PASS
00996 *     .. Local Scalars ..
00997       INTEGER           ID
00998 *     .. Common blocks ..
00999       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
01000 *     .. Executable Statements ..
01001 *
01002       IF (ICOMP.EQ.ITRUE) GO TO 40
01003 *
01004 *                            HERE ICOMP IS NOT EQUAL TO ITRUE.
01005 *
01006       IF ( .NOT. PASS) GO TO 20
01007 *                             PRINT FAIL MESSAGE AND HEADER.
01008       PASS = .FALSE.
01009       WRITE (NOUT,99999)
01010       WRITE (NOUT,99998)
01011    20 ID = ICOMP - ITRUE
01012       WRITE (NOUT,99997) ICASE, N, INCX, INCY, ICOMP, ITRUE, ID
01013    40 CONTINUE
01014       RETURN
01015 *
01016 99999 FORMAT ('                                       FAIL')
01017 99998 FORMAT (/' CASE  N INCX INCY                               ',
01018      +       ' COMP                                TRUE     DIFFERENCE',
01019      +       /1X)
01020 99997 FORMAT (1X,I4,I3,2I5,2I36,I12)
01021       END
 All Files Functions