LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dblat1.f
Go to the documentation of this file.
00001 *> \brief \b DBLAT1
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 DBLAT1
00012 * 
00013 *
00014 *> \par Purpose:
00015 *  =============
00016 *>
00017 *> \verbatim
00018 *>
00019 *>    Test program for the DOUBLE PRECISION 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 double_blas_testing
00036 *
00037 *  =====================================================================
00038       PROGRAM DBLAT1
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       DOUBLE PRECISION 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.765625D-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)/' DDOT '/
00108       DATA             L(2)/'DAXPY '/
00109       DATA             L(3)/'DROTG '/
00110       DATA             L(4)/' DROT '/
00111       DATA             L(5)/'DCOPY '/
00112       DATA             L(6)/'DSWAP '/
00113       DATA             L(7)/'DNRM2 '/
00114       DATA             L(8)/'DASUM '/
00115       DATA             L(9)/'DSCAL '/
00116       DATA             L(10)/'IDAMAX'/
00117       DATA             L(11)/'DROTMG'/
00118       DATA             L(12)/'DROTM '/
00119       DATA             L(13)/'DSDOT '/
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       DOUBLE PRECISION  SFAC
00132 *     .. Scalars in Common ..
00133       INTEGER           ICASE, INCX, INCY, N
00134       LOGICAL           PASS
00135 *     .. Local Scalars ..
00136       DOUBLE PRECISION  SA, SB, SC, SS, D12
00137       INTEGER           I, K
00138 *     .. Local Arrays ..
00139       DOUBLE PRECISION  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          DROTG, DROTMG, STEST1
00143 *     .. Common blocks ..
00144       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
00145 *     .. Data statements ..
00146       DATA              DA1/0.3D0, 0.4D0, -0.3D0, -0.4D0, -0.3D0, 0.0D0,
00147      +                  0.0D0, 1.0D0/
00148       DATA              DB1/0.4D0, 0.3D0, 0.4D0, 0.3D0, -0.4D0, 0.0D0,
00149      +                  1.0D0, 0.0D0/
00150       DATA              DC1/0.6D0, 0.8D0, -0.6D0, 0.8D0, 0.6D0, 1.0D0,
00151      +                  0.0D0, 1.0D0/
00152       DATA              DS1/0.8D0, 0.6D0, 0.8D0, -0.6D0, 0.8D0, 0.0D0,
00153      +                  1.0D0, 0.0D0/
00154       DATA              DATRUE/0.5D0, 0.5D0, 0.5D0, -0.5D0, -0.5D0,
00155      +                  0.0D0, 1.0D0, 1.0D0/
00156       DATA              DBTRUE/0.0D0, 0.6D0, 0.0D0, -0.6D0, 0.0D0,
00157      +                  0.0D0, 1.0D0, 0.0D0/
00158 *     INPUT FOR MODIFIED GIVENS
00159       DATA DAB/ .1D0,.3D0,1.2D0,.2D0,
00160      A          .7D0, .2D0, .6D0, 4.2D0,
00161      B          0.D0,0.D0,0.D0,0.D0,
00162      C          4.D0, -1.D0, 2.D0, 4.D0,
00163      D          6.D-10, 2.D-2, 1.D5, 10.D0,
00164      E          4.D10, 2.D-2, 1.D-5, 10.D0,
00165      F          2.D-10, 4.D-2, 1.D5, 10.D0,
00166      G          2.D10, 4.D-2, 1.D-5, 10.D0,
00167      H          4.D0, -2.D0, 8.D0, 4.D0    /
00168 *    TRUE RESULTS FOR MODIFIED GIVENS
00169       DATA DTRUE/0.D0,0.D0, 1.3D0, .2D0, 0.D0,0.D0,0.D0, .5D0, 0.D0,
00170      A           0.D0,0.D0, 4.5D0, 4.2D0, 1.D0, .5D0, 0.D0,0.D0,0.D0,
00171      B           0.D0,0.D0,0.D0,0.D0, -2.D0, 0.D0,0.D0,0.D0,0.D0,
00172      C           0.D0,0.D0,0.D0, 4.D0, -1.D0, 0.D0,0.D0,0.D0,0.D0,
00173      D           0.D0, 15.D-3, 0.D0, 10.D0, -1.D0, 0.D0, -1.D-4,
00174      E           0.D0, 1.D0,
00175      F           0.D0,0.D0, 6144.D-5, 10.D0, -1.D0, 4096.D0, -1.D6,
00176      G           0.D0, 1.D0,
00177      H           0.D0,0.D0,15.D0,10.D0,-1.D0, 5.D-5, 0.D0,1.D0,0.D0,
00178      I           0.D0,0.D0, 15.D0, 10.D0, -1. D0, 5.D5, -4096.D0,
00179      J           1.D0, 4096.D-6,
00180      K           0.D0,0.D0, 7.D0, 4.D0, 0.D0,0.D0, -.5D0, -.25D0, 0.D0/
00181 *                   4096 = 2 ** 12
00182       DATA D12  /4096.D0/
00183       DTRUE(1,1) = 12.D0 / 130.D0
00184       DTRUE(2,1) = 36.D0 / 130.D0
00185       DTRUE(7,1) = -1.D0 / 6.D0
00186       DTRUE(1,2) = 14.D0 / 75.D0
00187       DTRUE(2,2) = 49.D0 / 75.D0
00188       DTRUE(9,2) = 1.D0 / 7.D0
00189       DTRUE(1,5) = 45.D-11 * (D12 * D12)
00190       DTRUE(3,5) = 4.D5 / (3.D0 * D12)
00191       DTRUE(6,5) = 1.D0 / D12
00192       DTRUE(8,5) = 1.D4 / (3.D0 * D12)
00193       DTRUE(1,6) = 4.D10 / (1.5D0 * D12 * D12)
00194       DTRUE(2,6) = 2.D-2 / 1.5D0
00195       DTRUE(8,6) = 5.D-7 * D12
00196       DTRUE(1,7) = 4.D0 / 150.D0
00197       DTRUE(2,7) = (2.D-10 / 1.5D0) * (D12 * D12)
00198       DTRUE(7,7) = -DTRUE(6,5)
00199       DTRUE(9,7) = 1.D4 / D12
00200       DTRUE(1,8) = DTRUE(1,7)
00201       DTRUE(2,8) = 2.D10 / (1.5D0 * D12 * D12)
00202       DTRUE(1,9) = 32.D0 / 7.D0
00203       DTRUE(2,9) = -16.D0 / 7.D0
00204 *     .. Executable Statements ..
00205 *
00206 *     Compute true values which cannot be prestored
00207 *     in decimal notation
00208 *
00209       DBTRUE(1) = 1.0D0/0.6D0
00210       DBTRUE(3) = -1.0D0/0.6D0
00211       DBTRUE(5) = 1.0D0/0.6D0
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 *           .. DROTG ..
00218             IF (K.GT.8) GO TO 40
00219             SA = DA1(K)
00220             SB = DB1(K)
00221             CALL DROTG(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 *           .. DROTMG ..
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 DROTMG(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       DOUBLE PRECISION  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       DOUBLE PRECISION  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       DOUBLE PRECISION  DASUM, DNRM2
00259       INTEGER           IDAMAX
00260       EXTERNAL          DASUM, DNRM2, IDAMAX
00261 *     .. External Subroutines ..
00262       EXTERNAL          ITEST1, DSCAL, 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.3D0, -1.0D0, 0.0D0, 1.0D0, 0.3D0, 0.3D0,
00269      +                  0.3D0, 0.3D0, 0.3D0, 0.3D0/
00270       DATA              DV/0.1D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
00271      +                  2.0D0, 2.0D0, 0.3D0, 3.0D0, 3.0D0, 3.0D0, 3.0D0,
00272      +                  3.0D0, 3.0D0, 3.0D0, 0.3D0, -0.4D0, 4.0D0,
00273      +                  4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0, 0.2D0,
00274      +                  -0.6D0, 0.3D0, 5.0D0, 5.0D0, 5.0D0, 5.0D0,
00275      +                  5.0D0, 0.1D0, -0.3D0, 0.5D0, -0.1D0, 6.0D0,
00276      +                  6.0D0, 6.0D0, 6.0D0, 0.1D0, 8.0D0, 8.0D0, 8.0D0,
00277      +                  8.0D0, 8.0D0, 8.0D0, 8.0D0, 0.3D0, 9.0D0, 9.0D0,
00278      +                  9.0D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0, 0.3D0, 2.0D0,
00279      +                  -0.4D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
00280      +                  0.2D0, 3.0D0, -0.6D0, 5.0D0, 0.3D0, 2.0D0,
00281      +                  2.0D0, 2.0D0, 0.1D0, 4.0D0, -0.3D0, 6.0D0,
00282      +                  -0.5D0, 7.0D0, -0.1D0, 3.0D0/
00283       DATA              DTRUE1/0.0D0, 0.3D0, 0.5D0, 0.7D0, 0.6D0/
00284       DATA              DTRUE3/0.0D0, 0.3D0, 0.7D0, 1.1D0, 1.0D0/
00285       DATA              DTRUE5/0.10D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
00286      +                  2.0D0, 2.0D0, 2.0D0, -0.3D0, 3.0D0, 3.0D0,
00287      +                  3.0D0, 3.0D0, 3.0D0, 3.0D0, 3.0D0, 0.0D0, 0.0D0,
00288      +                  4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0,
00289      +                  0.20D0, -0.60D0, 0.30D0, 5.0D0, 5.0D0, 5.0D0,
00290      +                  5.0D0, 5.0D0, 0.03D0, -0.09D0, 0.15D0, -0.03D0,
00291      +                  6.0D0, 6.0D0, 6.0D0, 6.0D0, 0.10D0, 8.0D0,
00292      +                  8.0D0, 8.0D0, 8.0D0, 8.0D0, 8.0D0, 8.0D0,
00293      +                  0.09D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0,
00294      +                  9.0D0, 9.0D0, 0.09D0, 2.0D0, -0.12D0, 2.0D0,
00295      +                  2.0D0, 2.0D0, 2.0D0, 2.0D0, 0.06D0, 3.0D0,
00296      +                  -0.18D0, 5.0D0, 0.09D0, 2.0D0, 2.0D0, 2.0D0,
00297      +                  0.03D0, 4.0D0, -0.09D0, 6.0D0, -0.15D0, 7.0D0,
00298      +                  -0.03D0, 3.0D0/
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 *              .. DNRM2 ..
00312                STEMP(1) = DTRUE1(NP1)
00313                CALL STEST1(DNRM2(N,SX,INCX),STEMP(1),STEMP,SFAC)
00314             ELSE IF (ICASE.EQ.8) THEN
00315 *              .. DASUM ..
00316                STEMP(1) = DTRUE3(NP1)
00317                CALL STEST1(DASUM(N,SX,INCX),STEMP(1),STEMP,SFAC)
00318             ELSE IF (ICASE.EQ.9) THEN
00319 *              .. DSCAL ..
00320                CALL DSCAL(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 *              .. IDAMAX ..
00327                CALL ITEST1(IDAMAX(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       DOUBLE PRECISION  SFAC
00342 *     .. Scalars in Common ..
00343       INTEGER           ICASE, INCX, INCY, N
00344       LOGICAL           PASS
00345 *     .. Local Scalars ..
00346       DOUBLE PRECISION  SA
00347       INTEGER           I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
00348      $                  MX, MY 
00349 *     .. Local Arrays ..
00350       DOUBLE PRECISION  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), SSIZE(7),
00353      $                  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       INTEGER           INCXS(4), INCYS(4), LENS(4,2), NS(4)
00359 *     .. External Functions ..
00360       DOUBLE PRECISION  DDOT, DSDOT
00361       EXTERNAL          DDOT, DSDOT
00362 *     .. External Subroutines ..
00363       EXTERNAL          DAXPY, DCOPY, DROTM, DSWAP, STEST, STEST1
00364 *     .. Intrinsic Functions ..
00365       INTRINSIC         ABS, MIN
00366 *     .. Common blocks ..
00367       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
00368 *     .. Data statements ..
00369       EQUIVALENCE (DT19X(1,1,1),DT19XA(1,1,1)),(DT19X(1,1,5),
00370      A   DT19XB(1,1,1)),(DT19X(1,1,9),DT19XC(1,1,1)),
00371      B   (DT19X(1,1,13),DT19XD(1,1,1))
00372       EQUIVALENCE (DT19Y(1,1,1),DT19YA(1,1,1)),(DT19Y(1,1,5),
00373      A   DT19YB(1,1,1)),(DT19Y(1,1,9),DT19YC(1,1,1)),
00374      B   (DT19Y(1,1,13),DT19YD(1,1,1))
00375 
00376       DATA              SA/0.3D0/
00377       DATA              INCXS/1, 2, -2, -1/
00378       DATA              INCYS/1, -2, 1, -2/
00379       DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
00380       DATA              NS/0, 1, 2, 4/
00381       DATA              DX1/0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.9D0, -0.3D0,
00382      +                  -0.4D0/
00383       DATA              DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0,
00384      +                  0.8D0/
00385       DATA              DT7/0.0D0, 0.30D0, 0.21D0, 0.62D0, 0.0D0,
00386      +                  0.30D0, -0.07D0, 0.85D0, 0.0D0, 0.30D0, -0.79D0,
00387      +                  -0.74D0, 0.0D0, 0.30D0, 0.33D0, 1.27D0/
00388       DATA              DT8/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00389      +                  0.0D0, 0.68D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00390      +                  0.0D0, 0.0D0, 0.68D0, -0.87D0, 0.0D0, 0.0D0,
00391      +                  0.0D0, 0.0D0, 0.0D0, 0.68D0, -0.87D0, 0.15D0,
00392      +                  0.94D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
00393      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.68D0,
00394      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00395      +                  0.35D0, -0.9D0, 0.48D0, 0.0D0, 0.0D0, 0.0D0,
00396      +                  0.0D0, 0.38D0, -0.9D0, 0.57D0, 0.7D0, -0.75D0,
00397      +                  0.2D0, 0.98D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0,
00398      +                  0.0D0, 0.0D0, 0.0D0, 0.68D0, 0.0D0, 0.0D0,
00399      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.35D0, -0.72D0,
00400      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.38D0,
00401      +                  -0.63D0, 0.15D0, 0.88D0, 0.0D0, 0.0D0, 0.0D0,
00402      +                  0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00403      +                  0.68D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00404      +                  0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0,
00405      +                  0.0D0, 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.7D0,
00406      +                  -0.75D0, 0.2D0, 1.04D0/
00407       DATA              DT10X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00408      +                  0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00409      +                  0.0D0, 0.5D0, -0.9D0, 0.0D0, 0.0D0, 0.0D0,
00410      +                  0.0D0, 0.0D0, 0.5D0, -0.9D0, 0.3D0, 0.7D0,
00411      +                  0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0,
00412      +                  0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0,
00413      +                  0.0D0, 0.0D0, 0.0D0, 0.3D0, 0.1D0, 0.5D0, 0.0D0,
00414      +                  0.0D0, 0.0D0, 0.0D0, 0.8D0, 0.1D0, -0.6D0,
00415      +                  0.8D0, 0.3D0, -0.3D0, 0.5D0, 0.6D0, 0.0D0,
00416      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
00417      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.9D0,
00418      +                  0.1D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.7D0,
00419      +                  0.1D0, 0.3D0, 0.8D0, -0.9D0, -0.3D0, 0.5D0,
00420      +                  0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00421      +                  0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00422      +                  0.5D0, 0.3D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00423      +                  0.5D0, 0.3D0, -0.6D0, 0.8D0, 0.0D0, 0.0D0,
00424      +                  0.0D0/
00425       DATA              DT10Y/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00426      +                  0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00427      +                  0.0D0, 0.6D0, 0.1D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00428      +                  0.0D0, 0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.0D0,
00429      +                  0.0D0, 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00430      +                  0.0D0, 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00431      +                  0.0D0, 0.0D0, -0.5D0, -0.9D0, 0.6D0, 0.0D0,
00432      +                  0.0D0, 0.0D0, 0.0D0, -0.4D0, -0.9D0, 0.9D0,
00433      +                  0.7D0, -0.5D0, 0.2D0, 0.6D0, 0.5D0, 0.0D0,
00434      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0,
00435      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.5D0,
00436      +                  0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00437      +                  -0.4D0, 0.9D0, -0.5D0, 0.6D0, 0.0D0, 0.0D0,
00438      +                  0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00439      +                  0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00440      +                  0.0D0, 0.6D0, -0.9D0, 0.1D0, 0.0D0, 0.0D0,
00441      +                  0.0D0, 0.0D0, 0.6D0, -0.9D0, 0.1D0, 0.7D0,
00442      +                  -0.5D0, 0.2D0, 0.8D0/
00443       DATA              SSIZE1/0.0D0, 0.3D0, 1.6D0, 3.2D0/
00444       DATA              SSIZE2/0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00445      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00446      +                  0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
00447      +                  1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
00448      +                  1.17D0, 1.17D0, 1.17D0/
00449 *
00450 *                         FOR DROTM
00451 *
00452       DATA DPAR/-2.D0,  0.D0,0.D0,0.D0,0.D0,
00453      A          -1.D0,  2.D0, -3.D0, -4.D0,  5.D0,
00454      B           0.D0,  0.D0,  2.D0, -3.D0,  0.D0,
00455      C           1.D0,  5.D0,  2.D0,  0.D0, -4.D0/
00456 *                        TRUE X RESULTS F0R ROTATIONS DROTM
00457       DATA DT19XA/.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00458      A            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00459      B            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00460      C            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00461      D            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00462      E           -.8D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00463      F           -.9D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00464      G           3.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00465      H            .6D0,   .1D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00466      I           -.8D0,  3.8D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00467      J           -.9D0,  2.8D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00468      K           3.5D0,  -.4D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00469      L            .6D0,   .1D0,  -.5D0,   .8D0,          0.D0,0.D0,0.D0,
00470      M           -.8D0,  3.8D0, -2.2D0, -1.2D0,          0.D0,0.D0,0.D0,
00471      N           -.9D0,  2.8D0, -1.4D0, -1.3D0,          0.D0,0.D0,0.D0,
00472      O           3.5D0,  -.4D0, -2.2D0,  4.7D0,          0.D0,0.D0,0.D0/
00473 *
00474       DATA DT19XB/.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00475      A            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00476      B            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00477      C            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00478      D            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00479      E           -.8D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00480      F           -.9D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00481      G           3.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00482      H            .6D0,   .1D0,  -.5D0,             0.D0,0.D0,0.D0,0.D0,
00483      I           0.D0,    .1D0, -3.0D0,             0.D0,0.D0,0.D0,0.D0,
00484      J           -.3D0,   .1D0, -2.0D0,             0.D0,0.D0,0.D0,0.D0,
00485      K           3.3D0,   .1D0, -2.0D0,             0.D0,0.D0,0.D0,0.D0,
00486      L            .6D0,   .1D0,  -.5D0,   .8D0,   .9D0,  -.3D0,  -.4D0,
00487      M          -2.0D0,   .1D0,  1.4D0,   .8D0,   .6D0,  -.3D0, -2.8D0,
00488      N          -1.8D0,   .1D0,  1.3D0,   .8D0,  0.D0,   -.3D0, -1.9D0,
00489      O           3.8D0,   .1D0, -3.1D0,   .8D0,  4.8D0,  -.3D0, -1.5D0 /
00490 *
00491       DATA DT19XC/.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00492      A            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00493      B            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00494      C            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00495      D            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00496      E           -.8D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00497      F           -.9D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00498      G           3.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00499      H            .6D0,   .1D0,  -.5D0,             0.D0,0.D0,0.D0,0.D0,
00500      I           4.8D0,   .1D0, -3.0D0,             0.D0,0.D0,0.D0,0.D0,
00501      J           3.3D0,   .1D0, -2.0D0,             0.D0,0.D0,0.D0,0.D0,
00502      K           2.1D0,   .1D0, -2.0D0,             0.D0,0.D0,0.D0,0.D0,
00503      L            .6D0,   .1D0,  -.5D0,   .8D0,   .9D0,  -.3D0,  -.4D0,
00504      M          -1.6D0,   .1D0, -2.2D0,   .8D0,  5.4D0,  -.3D0, -2.8D0,
00505      N          -1.5D0,   .1D0, -1.4D0,   .8D0,  3.6D0,  -.3D0, -1.9D0,
00506      O           3.7D0,   .1D0, -2.2D0,   .8D0,  3.6D0,  -.3D0, -1.5D0 /
00507 *
00508       DATA DT19XD/.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00509      A            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00510      B            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00511      C            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00512      D            .6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00513      E           -.8D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00514      F           -.9D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00515      G           3.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00516      H            .6D0,   .1D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00517      I           -.8D0, -1.0D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00518      J           -.9D0,  -.8D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00519      K           3.5D0,   .8D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00520      L            .6D0,   .1D0,  -.5D0,   .8D0,          0.D0,0.D0,0.D0,
00521      M           -.8D0, -1.0D0,  1.4D0, -1.6D0,          0.D0,0.D0,0.D0,
00522      N           -.9D0,  -.8D0,  1.3D0, -1.6D0,          0.D0,0.D0,0.D0,
00523      O           3.5D0,   .8D0, -3.1D0,  4.8D0,          0.D0,0.D0,0.D0/
00524 *                        TRUE Y RESULTS FOR ROTATIONS DROTM
00525       DATA DT19YA/.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00526      A            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00527      B            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00528      C            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00529      D            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00530      E            .7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00531      F           1.7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00532      G          -2.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00533      H            .5D0,  -.9D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00534      I            .7D0, -4.8D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00535      J           1.7D0,  -.7D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00536      K          -2.6D0,  3.5D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00537      L            .5D0,  -.9D0,   .3D0,   .7D0,          0.D0,0.D0,0.D0,
00538      M            .7D0, -4.8D0,  3.0D0,  1.1D0,          0.D0,0.D0,0.D0,
00539      N           1.7D0,  -.7D0,  -.7D0,  2.3D0,          0.D0,0.D0,0.D0,
00540      O          -2.6D0,  3.5D0,  -.7D0, -3.6D0,          0.D0,0.D0,0.D0/
00541 *
00542       DATA DT19YB/.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00543      A            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00544      B            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00545      C            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00546      D            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00547      E            .7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00548      F           1.7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00549      G          -2.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00550      H            .5D0,  -.9D0,   .3D0,             0.D0,0.D0,0.D0,0.D0,
00551      I           4.0D0,  -.9D0,  -.3D0,             0.D0,0.D0,0.D0,0.D0,
00552      J           -.5D0,  -.9D0,  1.5D0,             0.D0,0.D0,0.D0,0.D0,
00553      K          -1.5D0,  -.9D0, -1.8D0,             0.D0,0.D0,0.D0,0.D0,
00554      L            .5D0,  -.9D0,   .3D0,   .7D0,  -.6D0,   .2D0,   .8D0,
00555      M           3.7D0,  -.9D0, -1.2D0,   .7D0, -1.5D0,   .2D0,  2.2D0,
00556      N           -.3D0,  -.9D0,  2.1D0,   .7D0, -1.6D0,   .2D0,  2.0D0,
00557      O          -1.6D0,  -.9D0, -2.1D0,   .7D0,  2.9D0,   .2D0, -3.8D0 /
00558 *
00559       DATA DT19YC/.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00560      A            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00561      B            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00562      C            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00563      D            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00564      E            .7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00565      F           1.7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00566      G          -2.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00567      H            .5D0,  -.9D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00568      I           4.0D0, -6.3D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00569      J           -.5D0,   .3D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00570      K          -1.5D0,  3.0D0,             0.D0,0.D0,0.D0,0.D0,0.D0,
00571      L            .5D0,  -.9D0,   .3D0,   .7D0,          0.D0,0.D0,0.D0,
00572      M           3.7D0, -7.2D0,  3.0D0,  1.7D0,          0.D0,0.D0,0.D0,
00573      N           -.3D0,   .9D0,  -.7D0,  1.9D0,          0.D0,0.D0,0.D0,
00574      O          -1.6D0,  2.7D0,  -.7D0, -3.4D0,          0.D0,0.D0,0.D0/
00575 *
00576       DATA DT19YD/.5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00577      A            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00578      B            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00579      C            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00580      D            .5D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00581      E            .7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00582      F           1.7D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00583      G          -2.6D0,                  0.D0,0.D0,0.D0,0.D0,0.D0,0.D0,
00584      H            .5D0,  -.9D0,   .3D0,             0.D0,0.D0,0.D0,0.D0,
00585      I            .7D0,  -.9D0,  1.2D0,             0.D0,0.D0,0.D0,0.D0,
00586      J           1.7D0,  -.9D0,   .5D0,             0.D0,0.D0,0.D0,0.D0,
00587      K          -2.6D0,  -.9D0, -1.3D0,             0.D0,0.D0,0.D0,0.D0,
00588      L            .5D0,  -.9D0,   .3D0,   .7D0,  -.6D0,   .2D0,   .8D0,
00589      M            .7D0,  -.9D0,  1.2D0,   .7D0, -1.5D0,   .2D0,  1.6D0,
00590      N           1.7D0,  -.9D0,   .5D0,   .7D0, -1.6D0,   .2D0,  2.4D0,
00591      O          -2.6D0,  -.9D0, -1.3D0,   .7D0,  2.9D0,   .2D0, -4.0D0 /
00592 *    
00593 *     .. Executable Statements ..
00594 *
00595       DO 120 KI = 1, 4
00596          INCX = INCXS(KI)
00597          INCY = INCYS(KI)
00598          MX = ABS(INCX)
00599          MY = ABS(INCY)
00600 *
00601          DO 100 KN = 1, 4
00602             N = NS(KN)
00603             KSIZE = MIN(2,KN)
00604             LENX = LENS(KN,MX)
00605             LENY = LENS(KN,MY)
00606 *           .. Initialize all argument arrays ..
00607             DO 20 I = 1, 7
00608                SX(I) = DX1(I)
00609                SY(I) = DY1(I)
00610    20       CONTINUE
00611 *
00612             IF (ICASE.EQ.1) THEN
00613 *              .. DDOT ..
00614                CALL STEST1(DDOT(N,SX,INCX,SY,INCY),DT7(KN,KI),SSIZE1(KN)
00615      +                     ,SFAC)
00616             ELSE IF (ICASE.EQ.2) THEN
00617 *              .. DAXPY ..
00618                CALL DAXPY(N,SA,SX,INCX,SY,INCY)
00619                DO 40 J = 1, LENY
00620                   STY(J) = DT8(J,KN,KI)
00621    40          CONTINUE
00622                CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
00623             ELSE IF (ICASE.EQ.5) THEN
00624 *              .. DCOPY ..
00625                DO 60 I = 1, 7
00626                   STY(I) = DT10Y(I,KN,KI)
00627    60          CONTINUE
00628                CALL DCOPY(N,SX,INCX,SY,INCY)
00629                CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0)
00630             ELSE IF (ICASE.EQ.6) THEN
00631 *              .. DSWAP ..
00632                CALL DSWAP(N,SX,INCX,SY,INCY)
00633                DO 80 I = 1, 7
00634                   STX(I) = DT10X(I,KN,KI)
00635                   STY(I) = DT10Y(I,KN,KI)
00636    80          CONTINUE
00637                CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0D0)
00638                CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0)
00639             ELSE IF (ICASE.EQ.12) THEN
00640 *              .. DROTM ..
00641                KNI=KN+4*(KI-1)
00642                DO KPAR=1,4
00643                   DO I=1,7
00644                      SX(I) = DX1(I)
00645                      SY(I) = DY1(I)
00646                      STX(I)= DT19X(I,KPAR,KNI)
00647                      STY(I)= DT19Y(I,KPAR,KNI)
00648                   END DO
00649 *
00650                   DO I=1,5
00651                      DTEMP(I) = DPAR(I,KPAR)
00652                   END DO
00653 *
00654                   DO  I=1,LENX
00655                      SSIZE(I)=STX(I)
00656                   END DO
00657 *                   SEE REMARK ABOVE ABOUT DT11X(1,2,7)
00658 *                       AND DT11X(5,3,8).
00659                   IF ((KPAR .EQ. 2) .AND. (KNI .EQ. 7))
00660      $               SSIZE(1) = 2.4D0
00661                   IF ((KPAR .EQ. 3) .AND. (KNI .EQ. 8))
00662      $               SSIZE(5) = 1.8D0
00663 *
00664                   CALL   DROTM(N,SX,INCX,SY,INCY,DTEMP)
00665                   CALL   STEST(LENX,SX,STX,SSIZE,SFAC)
00666                   CALL   STEST(LENY,SY,STY,STY,SFAC)
00667                END DO
00668             ELSE IF (ICASE.EQ.13) THEN
00669 *              .. DSDOT ..
00670             CALL TESTDSDOT(REAL(DSDOT(N,REAL(SX),INCX,REAL(SY),INCY)),
00671      $                 REAL(DT7(KN,KI)),REAL(SSIZE1(KN)), .3125E-1)
00672             ELSE
00673                WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
00674                STOP
00675             END IF
00676   100    CONTINUE
00677   120 CONTINUE
00678       RETURN
00679       END
00680       SUBROUTINE CHECK3(SFAC)
00681 *     .. Parameters ..
00682       INTEGER           NOUT
00683       PARAMETER         (NOUT=6)
00684 *     .. Scalar Arguments ..
00685       DOUBLE PRECISION  SFAC
00686 *     .. Scalars in Common ..
00687       INTEGER           ICASE, INCX, INCY, N
00688       LOGICAL           PASS
00689 *     .. Local Scalars ..
00690       DOUBLE PRECISION  SC, SS
00691       INTEGER           I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
00692 *     .. Local Arrays ..
00693       DOUBLE PRECISION  COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
00694      +                  DX1(7), DY1(7), MWPC(11), MWPS(11), MWPSTX(5),
00695      +                  MWPSTY(5), MWPTX(11,5), MWPTY(11,5), MWPX(5),
00696      +                  MWPY(5), SSIZE2(14,2), STX(7), STY(7), SX(7),
00697      +                  SY(7)
00698       INTEGER           INCXS(4), INCYS(4), LENS(4,2), MWPINX(11),
00699      +                  MWPINY(11), MWPN(11), NS(4)
00700 *     .. External Subroutines ..
00701       EXTERNAL          DROT, STEST
00702 *     .. Intrinsic Functions ..
00703       INTRINSIC         ABS, MIN
00704 *     .. Common blocks ..
00705       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
00706 *     .. Data statements ..
00707       DATA              INCXS/1, 2, -2, -1/
00708       DATA              INCYS/1, -2, 1, -2/
00709       DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
00710       DATA              NS/0, 1, 2, 4/
00711       DATA              DX1/0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.9D0, -0.3D0,
00712      +                  -0.4D0/
00713       DATA              DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0,
00714      +                  0.8D0/
00715       DATA              SC, SS/0.8D0, 0.6D0/
00716       DATA              DT9X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00717      +                  0.0D0, 0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00718      +                  0.0D0, 0.0D0, 0.78D0, -0.46D0, 0.0D0, 0.0D0,
00719      +                  0.0D0, 0.0D0, 0.0D0, 0.78D0, -0.46D0, -0.22D0,
00720      +                  1.06D0, 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0,
00721      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.78D0,
00722      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00723      +                  0.66D0, 0.1D0, -0.1D0, 0.0D0, 0.0D0, 0.0D0,
00724      +                  0.0D0, 0.96D0, 0.1D0, -0.76D0, 0.8D0, 0.90D0,
00725      +                  -0.3D0, -0.02D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0,
00726      +                  0.0D0, 0.0D0, 0.0D0, 0.78D0, 0.0D0, 0.0D0,
00727      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.06D0, 0.1D0,
00728      +                  -0.1D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.90D0,
00729      +                  0.1D0, -0.22D0, 0.8D0, 0.18D0, -0.3D0, -0.02D0,
00730      +                  0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00731      +                  0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00732      +                  0.0D0, 0.78D0, 0.26D0, 0.0D0, 0.0D0, 0.0D0,
00733      +                  0.0D0, 0.0D0, 0.78D0, 0.26D0, -0.76D0, 1.12D0,
00734      +                  0.0D0, 0.0D0, 0.0D0/
00735       DATA              DT9Y/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00736      +                  0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00737      +                  0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.0D0, 0.0D0,
00738      +                  0.0D0, 0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.54D0,
00739      +                  0.08D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
00740      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.04D0,
00741      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.7D0,
00742      +                  -0.9D0, -0.12D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00743      +                  0.64D0, -0.9D0, -0.30D0, 0.7D0, -0.18D0, 0.2D0,
00744      +                  0.28D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00745      +                  0.0D0, 0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0,
00746      +                  0.0D0, 0.0D0, 0.0D0, 0.7D0, -1.08D0, 0.0D0,
00747      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.64D0, -1.26D0,
00748      +                  0.54D0, 0.20D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0,
00749      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00750      +                  0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00751      +                  0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.0D0, 0.0D0,
00752      +                  0.0D0, 0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.7D0,
00753      +                  -0.18D0, 0.2D0, 0.16D0/
00754       DATA              SSIZE2/0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00755      +                  0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
00756      +                  0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
00757      +                  1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
00758      +                  1.17D0, 1.17D0, 1.17D0/
00759 *     .. Executable Statements ..
00760 *
00761       DO 60 KI = 1, 4
00762          INCX = INCXS(KI)
00763          INCY = INCYS(KI)
00764          MX = ABS(INCX)
00765          MY = ABS(INCY)
00766 *
00767          DO 40 KN = 1, 4
00768             N = NS(KN)
00769             KSIZE = MIN(2,KN)
00770             LENX = LENS(KN,MX)
00771             LENY = LENS(KN,MY)
00772 *
00773             IF (ICASE.EQ.4) THEN
00774 *              .. DROT ..
00775                DO 20 I = 1, 7
00776                   SX(I) = DX1(I)
00777                   SY(I) = DY1(I)
00778                   STX(I) = DT9X(I,KN,KI)
00779                   STY(I) = DT9Y(I,KN,KI)
00780    20          CONTINUE
00781                CALL DROT(N,SX,INCX,SY,INCY,SC,SS)
00782                CALL STEST(LENX,SX,STX,SSIZE2(1,KSIZE),SFAC)
00783                CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
00784             ELSE
00785                WRITE (NOUT,*) ' Shouldn''t be here in CHECK3'
00786                STOP
00787             END IF
00788    40    CONTINUE
00789    60 CONTINUE
00790 *
00791       MWPC(1) = 1
00792       DO 80 I = 2, 11
00793          MWPC(I) = 0
00794    80 CONTINUE
00795       MWPS(1) = 0
00796       DO 100 I = 2, 6
00797          MWPS(I) = 1
00798   100 CONTINUE
00799       DO 120 I = 7, 11
00800          MWPS(I) = -1
00801   120 CONTINUE
00802       MWPINX(1) = 1
00803       MWPINX(2) = 1
00804       MWPINX(3) = 1
00805       MWPINX(4) = -1
00806       MWPINX(5) = 1
00807       MWPINX(6) = -1
00808       MWPINX(7) = 1
00809       MWPINX(8) = 1
00810       MWPINX(9) = -1
00811       MWPINX(10) = 1
00812       MWPINX(11) = -1
00813       MWPINY(1) = 1
00814       MWPINY(2) = 1
00815       MWPINY(3) = -1
00816       MWPINY(4) = -1
00817       MWPINY(5) = 2
00818       MWPINY(6) = 1
00819       MWPINY(7) = 1
00820       MWPINY(8) = -1
00821       MWPINY(9) = -1
00822       MWPINY(10) = 2
00823       MWPINY(11) = 1
00824       DO 140 I = 1, 11
00825          MWPN(I) = 5
00826   140 CONTINUE
00827       MWPN(5) = 3
00828       MWPN(10) = 3
00829       DO 160 I = 1, 5
00830          MWPX(I) = I
00831          MWPY(I) = I
00832          MWPTX(1,I) = I
00833          MWPTY(1,I) = I
00834          MWPTX(2,I) = I
00835          MWPTY(2,I) = -I
00836          MWPTX(3,I) = 6 - I
00837          MWPTY(3,I) = I - 6
00838          MWPTX(4,I) = I
00839          MWPTY(4,I) = -I
00840          MWPTX(6,I) = 6 - I
00841          MWPTY(6,I) = I - 6
00842          MWPTX(7,I) = -I
00843          MWPTY(7,I) = I
00844          MWPTX(8,I) = I - 6
00845          MWPTY(8,I) = 6 - I
00846          MWPTX(9,I) = -I
00847          MWPTY(9,I) = I
00848          MWPTX(11,I) = I - 6
00849          MWPTY(11,I) = 6 - I
00850   160 CONTINUE
00851       MWPTX(5,1) = 1
00852       MWPTX(5,2) = 3
00853       MWPTX(5,3) = 5
00854       MWPTX(5,4) = 4
00855       MWPTX(5,5) = 5
00856       MWPTY(5,1) = -1
00857       MWPTY(5,2) = 2
00858       MWPTY(5,3) = -2
00859       MWPTY(5,4) = 4
00860       MWPTY(5,5) = -3
00861       MWPTX(10,1) = -1
00862       MWPTX(10,2) = -3
00863       MWPTX(10,3) = -5
00864       MWPTX(10,4) = 4
00865       MWPTX(10,5) = 5
00866       MWPTY(10,1) = 1
00867       MWPTY(10,2) = 2
00868       MWPTY(10,3) = 2
00869       MWPTY(10,4) = 4
00870       MWPTY(10,5) = 3
00871       DO 200 I = 1, 11
00872          INCX = MWPINX(I)
00873          INCY = MWPINY(I)
00874          DO 180 K = 1, 5
00875             COPYX(K) = MWPX(K)
00876             COPYY(K) = MWPY(K)
00877             MWPSTX(K) = MWPTX(I,K)
00878             MWPSTY(K) = MWPTY(I,K)
00879   180    CONTINUE
00880          CALL DROT(MWPN(I),COPYX,INCX,COPYY,INCY,MWPC(I),MWPS(I))
00881          CALL STEST(5,COPYX,MWPSTX,MWPSTX,SFAC)
00882          CALL STEST(5,COPYY,MWPSTY,MWPSTY,SFAC)
00883   200 CONTINUE
00884       RETURN
00885       END
00886       SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
00887 *     ********************************* STEST **************************
00888 *
00889 *     THIS SUBR COMPARES ARRAYS  SCOMP() AND STRUE() OF LENGTH LEN TO
00890 *     SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
00891 *     NEGLIGIBLE.
00892 *
00893 *     C. L. LAWSON, JPL, 1974 DEC 10
00894 *
00895 *     .. Parameters ..
00896       INTEGER          NOUT
00897       DOUBLE PRECISION ZERO
00898       PARAMETER        (NOUT=6, ZERO=0.0D0)
00899 *     .. Scalar Arguments ..
00900       DOUBLE PRECISION SFAC
00901       INTEGER          LEN
00902 *     .. Array Arguments ..
00903       DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
00904 *     .. Scalars in Common ..
00905       INTEGER          ICASE, INCX, INCY, N
00906       LOGICAL          PASS
00907 *     .. Local Scalars ..
00908       DOUBLE PRECISION SD
00909       INTEGER          I
00910 *     .. External Functions ..
00911       DOUBLE PRECISION SDIFF
00912       EXTERNAL         SDIFF
00913 *     .. Intrinsic Functions ..
00914       INTRINSIC        ABS
00915 *     .. Common blocks ..
00916       COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
00917 *     .. Executable Statements ..
00918 *
00919       DO 40 I = 1, LEN
00920          SD = SCOMP(I) - STRUE(I)
00921          IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
00922      +       GO TO 40
00923 *
00924 *                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
00925 *
00926          IF ( .NOT. PASS) GO TO 20
00927 *                             PRINT FAIL MESSAGE AND HEADER.
00928          PASS = .FALSE.
00929          WRITE (NOUT,99999)
00930          WRITE (NOUT,99998)
00931    20    WRITE (NOUT,99997) ICASE, N, INCX, INCY, I, SCOMP(I),
00932      +     STRUE(I), SD, SSIZE(I)
00933    40 CONTINUE
00934       RETURN
00935 *
00936 99999 FORMAT ('                                       FAIL')
00937 99998 FORMAT (/' CASE  N INCX INCY  I                            ',
00938      +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
00939      +       '     SIZE(I)',/1X)
00940 99997 FORMAT (1X,I4,I3,2I5,I3,2D36.8,2D12.4)
00941       END
00942       SUBROUTINE TESTDSDOT(SCOMP,STRUE,SSIZE,SFAC)
00943 *     ********************************* STEST **************************
00944 *
00945 *     THIS SUBR COMPARES ARRAYS  SCOMP() AND STRUE() OF LENGTH LEN TO
00946 *     SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
00947 *     NEGLIGIBLE.
00948 *
00949 *     C. L. LAWSON, JPL, 1974 DEC 10
00950 *
00951 *     .. Parameters ..
00952       INTEGER          NOUT
00953       REAL             ZERO
00954       PARAMETER        (NOUT=6, ZERO=0.0E0)
00955 *     .. Scalar Arguments ..
00956       REAL             SFAC, SCOMP, SSIZE, STRUE
00957 *     .. Scalars in Common ..
00958       INTEGER          ICASE, INCX, INCY, N
00959       LOGICAL          PASS
00960 *     .. Local Scalars ..
00961       REAL             SD
00962 *     .. Intrinsic Functions ..
00963       INTRINSIC        ABS
00964 *     .. Common blocks ..
00965       COMMON           /COMBLA/ICASE, N, INCX, INCY, PASS
00966 *     .. Executable Statements ..
00967 *
00968          SD = SCOMP - STRUE
00969          IF (ABS(SFAC*SD) .LE. ABS(SSIZE) * EPSILON(ZERO))
00970      +       GO TO 40
00971 *
00972 *                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
00973 *
00974          IF ( .NOT. PASS) GO TO 20
00975 *                             PRINT FAIL MESSAGE AND HEADER.
00976          PASS = .FALSE.
00977          WRITE (NOUT,99999)
00978          WRITE (NOUT,99998)
00979    20    WRITE (NOUT,99997) ICASE, N, INCX, INCY, SCOMP,
00980      +     STRUE, SD, SSIZE
00981    40 CONTINUE
00982       RETURN
00983 *
00984 99999 FORMAT ('                                       FAIL')
00985 99998 FORMAT (/' CASE  N INCX INCY                           ',
00986      +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
00987      +       '     SIZE(I)',/1X)
00988 99997 FORMAT (1X,I4,I3,1I5,I3,2E36.8,2E12.4)
00989       END
00990       SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
00991 *     ************************* STEST1 *****************************
00992 *
00993 *     THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
00994 *     REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
00995 *     ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
00996 *
00997 *     C.L. LAWSON, JPL, 1978 DEC 6
00998 *
00999 *     .. Scalar Arguments ..
01000       DOUBLE PRECISION  SCOMP1, SFAC, STRUE1
01001 *     .. Array Arguments ..
01002       DOUBLE PRECISION  SSIZE(*)
01003 *     .. Local Arrays ..
01004       DOUBLE PRECISION  SCOMP(1), STRUE(1)
01005 *     .. External Subroutines ..
01006       EXTERNAL          STEST
01007 *     .. Executable Statements ..
01008 *
01009       SCOMP(1) = SCOMP1
01010       STRUE(1) = STRUE1
01011       CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
01012 *
01013       RETURN
01014       END
01015       DOUBLE PRECISION FUNCTION SDIFF(SA,SB)
01016 *     ********************************* SDIFF **************************
01017 *     COMPUTES DIFFERENCE OF TWO NUMBERS.  C. L. LAWSON, JPL 1974 FEB 15
01018 *
01019 *     .. Scalar Arguments ..
01020       DOUBLE PRECISION                SA, SB
01021 *     .. Executable Statements ..
01022       SDIFF = SA - SB
01023       RETURN
01024       END
01025       SUBROUTINE ITEST1(ICOMP,ITRUE)
01026 *     ********************************* ITEST1 *************************
01027 *
01028 *     THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
01029 *     EQUALITY.
01030 *     C. L. LAWSON, JPL, 1974 DEC 10
01031 *
01032 *     .. Parameters ..
01033       INTEGER           NOUT
01034       PARAMETER         (NOUT=6)
01035 *     .. Scalar Arguments ..
01036       INTEGER           ICOMP, ITRUE
01037 *     .. Scalars in Common ..
01038       INTEGER           ICASE, INCX, INCY, N
01039       LOGICAL           PASS
01040 *     .. Local Scalars ..
01041       INTEGER           ID
01042 *     .. Common blocks ..
01043       COMMON            /COMBLA/ICASE, N, INCX, INCY, PASS
01044 *     .. Executable Statements ..
01045 *
01046       IF (ICOMP.EQ.ITRUE) GO TO 40
01047 *
01048 *                            HERE ICOMP IS NOT EQUAL TO ITRUE.
01049 *
01050       IF ( .NOT. PASS) GO TO 20
01051 *                             PRINT FAIL MESSAGE AND HEADER.
01052       PASS = .FALSE.
01053       WRITE (NOUT,99999)
01054       WRITE (NOUT,99998)
01055    20 ID = ICOMP - ITRUE
01056       WRITE (NOUT,99997) ICASE, N, INCX, INCY, ICOMP, ITRUE, ID
01057    40 CONTINUE
01058       RETURN
01059 *
01060 99999 FORMAT ('                                       FAIL')
01061 99998 FORMAT (/' CASE  N INCX INCY                               ',
01062      +       ' COMP                                TRUE     DIFFERENCE',
01063      +       /1X)
01064 99997 FORMAT (1X,I4,I3,2I5,2I36,I12)
01065       END
 All Files Functions