test/zblat1.f

   1 *> \brief \b ZBLAT1
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       PROGRAM ZBLAT1
  12 *
  13 *
  14 *> \par Purpose:
  15 *  =============
  16 *>
  17 *> \verbatim
  18 *>
  19 *>    Test program for the COMPLEX*16 Level 1 BLAS.
  20 *>
  21 *>    Based upon the original BLAS test routine together with:
  22 *>    F06GAF Example Program Text
  23 *> \endverbatim
  24 *
  25 *  Authors:
  26 *  ========
  27 *
  28 *> \author Univ. of Tennessee
  29 *> \author Univ. of California Berkeley
  30 *> \author Univ. of Colorado Denver
  31 *> \author NAG Ltd.
  32 *
  33 *> \date April 2012
  34 *
  35 *> \ingroup complex16_blas_testing
  36 *
  37 *  =====================================================================
  38       PROGRAM ZBLAT1
  39 *
  40 *  -- Reference BLAS test routine (version 3.7.0) --
  41 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
  42 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  43 *     April 2012
  44 *
  45 *  =====================================================================
  46 *
  47 *     .. Parameters ..
  48       INTEGER          NOUT
  49       PARAMETER        (NOUT=6)
  50 *     .. Scalars in Common ..
  51       INTEGER          ICASE, INCX, INCY, MODE, N
  52       LOGICAL          PASS
  53 *     .. Local Scalars ..
  54       DOUBLE PRECISION SFAC
  55       INTEGER          IC
  56 *     .. External Subroutines ..
  57       EXTERNAL         CHECK1, CHECK2, HEADER
  58 *     .. Common blocks ..
  59       COMMON           /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
  60 *     .. Data statements ..
  61       DATA             SFAC/9.765625D-4/
  62 *     .. Executable Statements ..
  63       WRITE (NOUT,99999)
  64       DO 20 IC = 1, 10
  65          ICASE = IC
  66          CALL HEADER
  67 *
  68 *        Initialize PASS, INCX, INCY, and MODE for a new case.
  69 *        The value 9999 for INCX, INCY or MODE will appear in the
  70 *        detailed  output, if any, for cases that do not involve
  71 *        these parameters.
  72 *
  73          PASS = .TRUE.
  74          INCX = 9999
  75          INCY = 9999
  76          MODE = 9999
  77          IF (ICASE.LE.5) THEN
  78             CALL CHECK2(SFAC)
  79          ELSE IF (ICASE.GE.6) THEN
  80             CALL CHECK1(SFAC)
  81          END IF
  82 *        -- Print
  83          IF (PASS) WRITE (NOUT,99998)
  84    20 CONTINUE
  85       STOP
  86 *
  87 99999 FORMAT (' Complex BLAS Test Program Results',/1X)
  88 99998 FORMAT ('                                    ----- PASS -----')
  89       END
  90       SUBROUTINE HEADER
  91 *     .. Parameters ..
  92       INTEGER          NOUT
  93       PARAMETER        (NOUT=6)
  94 *     .. Scalars in Common ..
  95       INTEGER          ICASE, INCX, INCY, MODE, N
  96       LOGICAL          PASS
  97 *     .. Local Arrays ..
  98       CHARACTER*6      L(10)
  99 *     .. Common blocks ..
 100       COMMON           /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
 101 *     .. Data statements ..
 102       DATA             L(1)/'ZDOTC '/
 103       DATA             L(2)/'ZDOTU '/
 104       DATA             L(3)/'ZAXPY '/
 105       DATA             L(4)/'ZCOPY '/
 106       DATA             L(5)/'ZSWAP '/
 107       DATA             L(6)/'DZNRM2'/
 108       DATA             L(7)/'DZASUM'/
 109       DATA             L(8)/'ZSCAL '/
 110       DATA             L(9)/'ZDSCAL'/
 111       DATA             L(10)/'IZAMAX'/
 112 *     .. Executable Statements ..
 113       WRITE (NOUT,99999) ICASE, L(ICASE)
 114       RETURN
 115 *
 116 99999 FORMAT (/' Test of subprogram number',I3,12X,A6)
 117       END
 118       SUBROUTINE CHECK1(SFAC)
 119 *     .. Parameters ..
 120       INTEGER           NOUT
 121       PARAMETER         (NOUT=6)
 122 *     .. Scalar Arguments ..
 123       DOUBLE PRECISION  SFAC
 124 *     .. Scalars in Common ..
 125       INTEGER           ICASE, INCX, INCY, MODE, N
 126       LOGICAL           PASS
 127 *     .. Local Scalars ..
 128       COMPLEX*16        CA
 129       DOUBLE PRECISION  SA
 130       INTEGER           I, J, LEN, NP1
 131 *     .. Local Arrays ..
 132       COMPLEX*16        CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
 133      +                  MWPCS(5), MWPCT(5)
 134       DOUBLE PRECISION  STRUE2(5), STRUE4(5)
 135       INTEGER           ITRUE3(5)
 136 *     .. External Functions ..
 137       DOUBLE PRECISION  DZASUM, DZNRM2
 138       INTEGER           IZAMAX
 139       EXTERNAL          DZASUM, DZNRM2, IZAMAX
 140 *     .. External Subroutines ..
 141       EXTERNAL          ZSCAL, ZDSCAL, CTEST, ITEST1, STEST1
 142 *     .. Intrinsic Functions ..
 143       INTRINSIC         MAX
 144 *     .. Common blocks ..
 145       COMMON            /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
 146 *     .. Data statements ..
 147       DATA              SA, CA/0.3D0, (0.4D0,-0.7D0)/
 148       DATA              ((CV(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
 149      +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
 150      +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
 151      +                  (1.0D0,2.0D0), (0.3D0,-0.4D0), (3.0D0,4.0D0),
 152      +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
 153      +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
 154      +                  (0.1D0,-0.3D0), (0.5D0,-0.1D0), (5.0D0,6.0D0),
 155      +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
 156      +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (0.1D0,0.1D0),
 157      +                  (-0.6D0,0.1D0), (0.1D0,-0.3D0), (7.0D0,8.0D0),
 158      +                  (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
 159      +                  (7.0D0,8.0D0), (0.3D0,0.1D0), (0.5D0,0.0D0),
 160      +                  (0.0D0,0.5D0), (0.0D0,0.2D0), (2.0D0,3.0D0),
 161      +                  (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/
 162       DATA              ((CV(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
 163      +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
 164      +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
 165      +                  (4.0D0,5.0D0), (0.3D0,-0.4D0), (6.0D0,7.0D0),
 166      +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
 167      +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
 168      +                  (0.1D0,-0.3D0), (8.0D0,9.0D0), (0.5D0,-0.1D0),
 169      +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
 170      +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (0.1D0,0.1D0),
 171      +                  (3.0D0,6.0D0), (-0.6D0,0.1D0), (4.0D0,7.0D0),
 172      +                  (0.1D0,-0.3D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
 173      +                  (7.0D0,2.0D0), (0.3D0,0.1D0), (5.0D0,8.0D0),
 174      +                  (0.5D0,0.0D0), (6.0D0,9.0D0), (0.0D0,0.5D0),
 175      +                  (8.0D0,3.0D0), (0.0D0,0.2D0), (9.0D0,4.0D0)/
 176       DATA              STRUE2/0.0D0, 0.5D0, 0.6D0, 0.7D0, 0.8D0/
 177       DATA              STRUE4/0.0D0, 0.7D0, 1.0D0, 1.3D0, 1.6D0/
 178       DATA              ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
 179      +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
 180      +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
 181      +                  (1.0D0,2.0D0), (-0.16D0,-0.37D0), (3.0D0,4.0D0),
 182      +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
 183      +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
 184      +                  (-0.17D0,-0.19D0), (0.13D0,-0.39D0),
 185      +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
 186      +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
 187      +                  (0.11D0,-0.03D0), (-0.17D0,0.46D0),
 188      +                  (-0.17D0,-0.19D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
 189      +                  (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
 190      +                  (0.19D0,-0.17D0), (0.20D0,-0.35D0),
 191      +                  (0.35D0,0.20D0), (0.14D0,0.08D0),
 192      +                  (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0),
 193      +                  (2.0D0,3.0D0)/
 194       DATA              ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
 195      +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
 196      +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
 197      +                  (4.0D0,5.0D0), (-0.16D0,-0.37D0), (6.0D0,7.0D0),
 198      +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
 199      +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
 200      +                  (-0.17D0,-0.19D0), (8.0D0,9.0D0),
 201      +                  (0.13D0,-0.39D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
 202      +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
 203      +                  (0.11D0,-0.03D0), (3.0D0,6.0D0),
 204      +                  (-0.17D0,0.46D0), (4.0D0,7.0D0),
 205      +                  (-0.17D0,-0.19D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
 206      +                  (7.0D0,2.0D0), (0.19D0,-0.17D0), (5.0D0,8.0D0),
 207      +                  (0.20D0,-0.35D0), (6.0D0,9.0D0),
 208      +                  (0.35D0,0.20D0), (8.0D0,3.0D0),
 209      +                  (0.14D0,0.08D0), (9.0D0,4.0D0)/
 210       DATA              ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
 211      +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
 212      +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
 213      +                  (1.0D0,2.0D0), (0.09D0,-0.12D0), (3.0D0,4.0D0),
 214      +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
 215      +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
 216      +                  (0.03D0,-0.09D0), (0.15D0,-0.03D0),
 217      +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
 218      +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
 219      +                  (0.03D0,0.03D0), (-0.18D0,0.03D0),
 220      +                  (0.03D0,-0.09D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
 221      +                  (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
 222      +                  (0.09D0,0.03D0), (0.15D0,0.00D0),
 223      +                  (0.00D0,0.15D0), (0.00D0,0.06D0), (2.0D0,3.0D0),
 224      +                  (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/
 225       DATA              ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
 226      +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
 227      +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
 228      +                  (4.0D0,5.0D0), (0.09D0,-0.12D0), (6.0D0,7.0D0),
 229      +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
 230      +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
 231      +                  (0.03D0,-0.09D0), (8.0D0,9.0D0),
 232      +                  (0.15D0,-0.03D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
 233      +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
 234      +                  (0.03D0,0.03D0), (3.0D0,6.0D0),
 235      +                  (-0.18D0,0.03D0), (4.0D0,7.0D0),
 236      +                  (0.03D0,-0.09D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
 237      +                  (7.0D0,2.0D0), (0.09D0,0.03D0), (5.0D0,8.0D0),
 238      +                  (0.15D0,0.00D0), (6.0D0,9.0D0), (0.00D0,0.15D0),
 239      +                  (8.0D0,3.0D0), (0.00D0,0.06D0), (9.0D0,4.0D0)/
 240       DATA              ITRUE3/0, 1, 2, 2, 2/
 241 *     .. Executable Statements ..
 242       DO 60 INCX = 1, 2
 243          DO 40 NP1 = 1, 5
 244             N = NP1 - 1
 245             LEN = 2*MAX(N,1)
 246 *           .. Set vector arguments ..
 247             DO 20 I = 1, LEN
 248                CX(I) = CV(I,NP1,INCX)
 249    20       CONTINUE
 250             IF (ICASE.EQ.6) THEN
 251 *              .. DZNRM2 ..
 252                CALL STEST1(DZNRM2(N,CX,INCX),STRUE2(NP1),STRUE2(NP1),
 253      +                     SFAC)
 254             ELSE IF (ICASE.EQ.7) THEN
 255 *              .. DZASUM ..
 256                CALL STEST1(DZASUM(N,CX,INCX),STRUE4(NP1),STRUE4(NP1),
 257      +                     SFAC)
 258             ELSE IF (ICASE.EQ.8) THEN
 259 *              .. ZSCAL ..
 260                CALL ZSCAL(N,CA,CX,INCX)
 261                CALL CTEST(LEN,CX,CTRUE5(1,NP1,INCX),CTRUE5(1,NP1,INCX),
 262      +                    SFAC)
 263             ELSE IF (ICASE.EQ.9) THEN
 264 *              .. ZDSCAL ..
 265                CALL ZDSCAL(N,SA,CX,INCX)
 266                CALL CTEST(LEN,CX,CTRUE6(1,NP1,INCX),CTRUE6(1,NP1,INCX),
 267      +                    SFAC)
 268             ELSE IF (ICASE.EQ.10) THEN
 269 *              .. IZAMAX ..
 270                CALL ITEST1(IZAMAX(N,CX,INCX),ITRUE3(NP1))
 271             ELSE
 272                WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
 273                STOP
 274             END IF
 275 *
 276    40    CONTINUE
 277    60 CONTINUE
 278 *
 279       INCX = 1
 280       IF (ICASE.EQ.8) THEN
 281 *        ZSCAL
 282 *        Add a test for alpha equal to zero.
 283          CA = (0.0D0,0.0D0)
 284          DO 80 I = 1, 5
 285             MWPCT(I) = (0.0D0,0.0D0)
 286             MWPCS(I) = (1.0D0,1.0D0)
 287    80    CONTINUE
 288          CALL ZSCAL(5,CA,CX,INCX)
 289          CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
 290       ELSE IF (ICASE.EQ.9) THEN
 291 *        ZDSCAL
 292 *        Add a test for alpha equal to zero.
 293          SA = 0.0D0
 294          DO 100 I = 1, 5
 295             MWPCT(I) = (0.0D0,0.0D0)
 296             MWPCS(I) = (1.0D0,1.0D0)
 297   100    CONTINUE
 298          CALL ZDSCAL(5,SA,CX,INCX)
 299          CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
 300 *        Add a test for alpha equal to one.
 301          SA = 1.0D0
 302          DO 120 I = 1, 5
 303             MWPCT(I) = CX(I)
 304             MWPCS(I) = CX(I)
 305   120    CONTINUE
 306          CALL ZDSCAL(5,SA,CX,INCX)
 307          CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
 308 *        Add a test for alpha equal to minus one.
 309          SA = -1.0D0
 310          DO 140 I = 1, 5
 311             MWPCT(I) = -CX(I)
 312             MWPCS(I) = -CX(I)
 313   140    CONTINUE
 314          CALL ZDSCAL(5,SA,CX,INCX)
 315          CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
 316       END IF
 317       RETURN
 318       END
 319       SUBROUTINE CHECK2(SFAC)
 320 *     .. Parameters ..
 321       INTEGER           NOUT
 322       PARAMETER         (NOUT=6)
 323 *     .. Scalar Arguments ..
 324       DOUBLE PRECISION  SFAC
 325 *     .. Scalars in Common ..
 326       INTEGER           ICASE, INCX, INCY, MODE, N
 327       LOGICAL           PASS
 328 *     .. Local Scalars ..
 329       COMPLEX*16        CA
 330       INTEGER           I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
 331 *     .. Local Arrays ..
 332       COMPLEX*16        CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
 333      +                  CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
 334      +                  CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7)
 335       INTEGER           INCXS(4), INCYS(4), LENS(4,2), NS(4)
 336 *     .. External Functions ..
 337       COMPLEX*16        ZDOTC, ZDOTU
 338       EXTERNAL          ZDOTC, ZDOTU
 339 *     .. External Subroutines ..
 340       EXTERNAL          ZAXPY, ZCOPY, ZSWAP, CTEST
 341 *     .. Intrinsic Functions ..
 342       INTRINSIC         ABS, MIN
 343 *     .. Common blocks ..
 344       COMMON            /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
 345 *     .. Data statements ..
 346       DATA              CA/(0.4D0,-0.7D0)/
 347       DATA              INCXS/1, 2, -2, -1/
 348       DATA              INCYS/1, -2, 1, -2/
 349       DATA              LENS/1, 1, 2, 4, 1, 1, 3, 7/
 350       DATA              NS/0, 1, 2, 4/
 351       DATA              CX1/(0.7D0,-0.8D0), (-0.4D0,-0.7D0),
 352      +                  (-0.1D0,-0.9D0), (0.2D0,-0.8D0),
 353      +                  (-0.9D0,-0.4D0), (0.1D0,0.4D0), (-0.6D0,0.6D0)/
 354       DATA              CY1/(0.6D0,-0.6D0), (-0.9D0,0.5D0),
 355      +                  (0.7D0,-0.6D0), (0.1D0,-0.5D0), (-0.1D0,-0.2D0),
 356      +                  (-0.5D0,-0.3D0), (0.8D0,-0.7D0)/
 357       DATA              ((CT8(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0),
 358      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 359      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 360      +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 361      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 362      +                  (0.0D0,0.0D0), (0.32D0,-1.41D0),
 363      +                  (-1.55D0,0.5D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 364      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 365      +                  (0.32D0,-1.41D0), (-1.55D0,0.5D0),
 366      +                  (0.03D0,-0.89D0), (-0.38D0,-0.96D0),
 367      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
 368       DATA              ((CT8(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0),
 369      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 370      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 371      +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 372      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 373      +                  (0.0D0,0.0D0), (-0.07D0,-0.89D0),
 374      +                  (-0.9D0,0.5D0), (0.42D0,-1.41D0), (0.0D0,0.0D0),
 375      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 376      +                  (0.78D0,0.06D0), (-0.9D0,0.5D0),
 377      +                  (0.06D0,-0.13D0), (0.1D0,-0.5D0),
 378      +                  (-0.77D0,-0.49D0), (-0.5D0,-0.3D0),
 379      +                  (0.52D0,-1.51D0)/
 380       DATA              ((CT8(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0),
 381      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 382      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 383      +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 384      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 385      +                  (0.0D0,0.0D0), (-0.07D0,-0.89D0),
 386      +                  (-1.18D0,-0.31D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 387      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 388      +                  (0.78D0,0.06D0), (-1.54D0,0.97D0),
 389      +                  (0.03D0,-0.89D0), (-0.18D0,-1.31D0),
 390      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
 391       DATA              ((CT8(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0),
 392      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 393      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 394      +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 395      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 396      +                  (0.0D0,0.0D0), (0.32D0,-1.41D0), (-0.9D0,0.5D0),
 397      +                  (0.05D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 398      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.32D0,-1.41D0),
 399      +                  (-0.9D0,0.5D0), (0.05D0,-0.6D0), (0.1D0,-0.5D0),
 400      +                  (-0.77D0,-0.49D0), (-0.5D0,-0.3D0),
 401      +                  (0.32D0,-1.16D0)/
 402       DATA              CT7/(0.0D0,0.0D0), (-0.06D0,-0.90D0),
 403      +                  (0.65D0,-0.47D0), (-0.34D0,-1.22D0),
 404      +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
 405      +                  (-0.59D0,-1.46D0), (-1.04D0,-0.04D0),
 406      +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
 407      +                  (-0.83D0,0.59D0), (0.07D0,-0.37D0),
 408      +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
 409      +                  (-0.76D0,-1.15D0), (-1.33D0,-1.82D0)/
 410       DATA              CT6/(0.0D0,0.0D0), (0.90D0,0.06D0),
 411      +                  (0.91D0,-0.77D0), (1.80D0,-0.10D0),
 412      +                  (0.0D0,0.0D0), (0.90D0,0.06D0), (1.45D0,0.74D0),
 413      +                  (0.20D0,0.90D0), (0.0D0,0.0D0), (0.90D0,0.06D0),
 414      +                  (-0.55D0,0.23D0), (0.83D0,-0.39D0),
 415      +                  (0.0D0,0.0D0), (0.90D0,0.06D0), (1.04D0,0.79D0),
 416      +                  (1.95D0,1.22D0)/
 417       DATA              ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7D0,-0.8D0),
 418      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 419      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 420      +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 421      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 422      +                  (0.0D0,0.0D0), (0.6D0,-0.6D0), (-0.9D0,0.5D0),
 423      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 424      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0),
 425      +                  (-0.9D0,0.5D0), (0.7D0,-0.6D0), (0.1D0,-0.5D0),
 426      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
 427       DATA              ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7D0,-0.8D0),
 428      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 429      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 430      +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 431      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 432      +                  (0.0D0,0.0D0), (0.7D0,-0.6D0), (-0.4D0,-0.7D0),
 433      +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 434      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.8D0,-0.7D0),
 435      +                  (-0.4D0,-0.7D0), (-0.1D0,-0.2D0),
 436      +                  (0.2D0,-0.8D0), (0.7D0,-0.6D0), (0.1D0,0.4D0),
 437      +                  (0.6D0,-0.6D0)/
 438       DATA              ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7D0,-0.8D0),
 439      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 440      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 441      +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 442      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 443      +                  (0.0D0,0.0D0), (-0.9D0,0.5D0), (-0.4D0,-0.7D0),
 444      +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 445      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.1D0,-0.5D0),
 446      +                  (-0.4D0,-0.7D0), (0.7D0,-0.6D0), (0.2D0,-0.8D0),
 447      +                  (-0.9D0,0.5D0), (0.1D0,0.4D0), (0.6D0,-0.6D0)/
 448       DATA              ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7D0,-0.8D0),
 449      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 450      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 451      +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 452      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 453      +                  (0.0D0,0.0D0), (0.6D0,-0.6D0), (0.7D0,-0.6D0),
 454      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 455      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0),
 456      +                  (0.7D0,-0.6D0), (-0.1D0,-0.2D0), (0.8D0,-0.7D0),
 457      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
 458       DATA              ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0),
 459      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 460      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 461      +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 462      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 463      +                  (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.4D0,-0.7D0),
 464      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 465      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0),
 466      +                  (-0.4D0,-0.7D0), (-0.1D0,-0.9D0),
 467      +                  (0.2D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 468      +                  (0.0D0,0.0D0)/
 469       DATA              ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0),
 470      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 471      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 472      +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 473      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 474      +                  (0.0D0,0.0D0), (-0.1D0,-0.9D0), (-0.9D0,0.5D0),
 475      +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 476      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0),
 477      +                  (-0.9D0,0.5D0), (-0.9D0,-0.4D0), (0.1D0,-0.5D0),
 478      +                  (-0.1D0,-0.9D0), (-0.5D0,-0.3D0),
 479      +                  (0.7D0,-0.8D0)/
 480       DATA              ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0),
 481      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 482      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 483      +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 484      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 485      +                  (0.0D0,0.0D0), (-0.1D0,-0.9D0), (0.7D0,-0.8D0),
 486      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 487      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0),
 488      +                  (-0.9D0,-0.4D0), (-0.1D0,-0.9D0),
 489      +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 490      +                  (0.0D0,0.0D0)/
 491       DATA              ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0),
 492      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 493      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 494      +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 495      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 496      +                  (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.9D0,0.5D0),
 497      +                  (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 498      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0),
 499      +                  (-0.9D0,0.5D0), (-0.4D0,-0.7D0), (0.1D0,-0.5D0),
 500      +                  (-0.1D0,-0.9D0), (-0.5D0,-0.3D0),
 501      +                  (0.2D0,-0.8D0)/
 502       DATA              CSIZE1/(0.0D0,0.0D0), (0.9D0,0.9D0),
 503      +                  (1.63D0,1.73D0), (2.90D0,2.78D0)/
 504       DATA              CSIZE3/(0.0D0,0.0D0), (0.0D0,0.0D0),
 505      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 506      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (1.17D0,1.17D0),
 507      +                  (1.17D0,1.17D0), (1.17D0,1.17D0),
 508      +                  (1.17D0,1.17D0), (1.17D0,1.17D0),
 509      +                  (1.17D0,1.17D0), (1.17D0,1.17D0)/
 510       DATA              CSIZE2/(0.0D0,0.0D0), (0.0D0,0.0D0),
 511      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
 512      +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (1.54D0,1.54D0),
 513      +                  (1.54D0,1.54D0), (1.54D0,1.54D0),
 514      +                  (1.54D0,1.54D0), (1.54D0,1.54D0),
 515      +                  (1.54D0,1.54D0), (1.54D0,1.54D0)/
 516 *     .. Executable Statements ..
 517       DO 60 KI = 1, 4
 518          INCX = INCXS(KI)
 519          INCY = INCYS(KI)
 520          MX = ABS(INCX)
 521          MY = ABS(INCY)
 522 *
 523          DO 40 KN = 1, 4
 524             N = NS(KN)
 525             KSIZE = MIN(2,KN)
 526             LENX = LENS(KN,MX)
 527             LENY = LENS(KN,MY)
 528 *           .. initialize all argument arrays ..
 529             DO 20 I = 1, 7
 530                CX(I) = CX1(I)
 531                CY(I) = CY1(I)
 532    20       CONTINUE
 533             IF (ICASE.EQ.1) THEN
 534 *              .. ZDOTC ..
 535                CDOT(1) = ZDOTC(N,CX,INCX,CY,INCY)
 536                CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC)
 537             ELSE IF (ICASE.EQ.2) THEN
 538 *              .. ZDOTU ..
 539                CDOT(1) = ZDOTU(N,CX,INCX,CY,INCY)
 540                CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC)
 541             ELSE IF (ICASE.EQ.3) THEN
 542 *              .. ZAXPY ..
 543                CALL ZAXPY(N,CA,CX,INCX,CY,INCY)
 544                CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC)
 545             ELSE IF (ICASE.EQ.4) THEN
 546 *              .. ZCOPY ..
 547                CALL ZCOPY(N,CX,INCX,CY,INCY)
 548                CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0)
 549             ELSE IF (ICASE.EQ.5) THEN
 550 *              .. ZSWAP ..
 551                CALL ZSWAP(N,CX,INCX,CY,INCY)
 552                CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0D0)
 553                CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0)
 554             ELSE
 555                WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
 556                STOP
 557             END IF
 558 *
 559    40    CONTINUE
 560    60 CONTINUE
 561       RETURN
 562       END
 563       SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
 564 *     ********************************* STEST **************************
 565 *
 566 *     THIS SUBR COMPARES ARRAYS  SCOMP() AND STRUE() OF LENGTH LEN TO
 567 *     SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
 568 *     NEGLIGIBLE.
 569 *
 570 *     C. L. LAWSON, JPL, 1974 DEC 10
 571 *
 572 *     .. Parameters ..
 573       INTEGER          NOUT
 574       DOUBLE PRECISION ZERO
 575       PARAMETER        (NOUT=6, ZERO=0.0D0)
 576 *     .. Scalar Arguments ..
 577       DOUBLE PRECISION SFAC
 578       INTEGER          LEN
 579 *     .. Array Arguments ..
 580       DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
 581 *     .. Scalars in Common ..
 582       INTEGER          ICASE, INCX, INCY, MODE, N
 583       LOGICAL          PASS
 584 *     .. Local Scalars ..
 585       DOUBLE PRECISION SD
 586       INTEGER          I
 587 *     .. External Functions ..
 588       DOUBLE PRECISION SDIFF
 589       EXTERNAL         SDIFF
 590 *     .. Intrinsic Functions ..
 591       INTRINSIC        ABS
 592 *     .. Common blocks ..
 593       COMMON           /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
 594 *     .. Executable Statements ..
 595 *
 596       DO 40 I = 1, LEN
 597          SD = SCOMP(I) - STRUE(I)
 598          IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
 599      +       GO TO 40
 600 *
 601 *                             HERE    SCOMP(I) IS NOT CLOSE TO STRUE(I).
 602 *
 603          IF ( .NOT. PASS) GO TO 20
 604 *                             PRINT FAIL MESSAGE AND HEADER.
 605          PASS = .FALSE.
 606          WRITE (NOUT,99999)
 607          WRITE (NOUT,99998)
 608    20    WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I),
 609      +     STRUE(I), SD, SSIZE(I)
 610    40 CONTINUE
 611       RETURN
 612 *
 613 99999 FORMAT ('                                       FAIL')
 614 99998 FORMAT (/' CASE  N INCX INCY MODE  I                            ',
 615      +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
 616      +       '     SIZE(I)',/1X)
 617 99997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4)
 618       END
 619       SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
 620 *     ************************* STEST1 *****************************
 621 *
 622 *     THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN
 623 *     REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
 624 *     ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
 625 *
 626 *     C.L. LAWSON, JPL, 1978 DEC 6
 627 *
 628 *     .. Scalar Arguments ..
 629       DOUBLE PRECISION  SCOMP1, SFAC, STRUE1
 630 *     .. Array Arguments ..
 631       DOUBLE PRECISION  SSIZE(*)
 632 *     .. Local Arrays ..
 633       DOUBLE PRECISION  SCOMP(1), STRUE(1)
 634 *     .. External Subroutines ..
 635       EXTERNAL          STEST
 636 *     .. Executable Statements ..
 637 *
 638       SCOMP(1) = SCOMP1
 639       STRUE(1) = STRUE1
 640       CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
 641 *
 642       RETURN
 643       END
 644       DOUBLE PRECISION FUNCTION SDIFF(SA,SB)
 645 *     ********************************* SDIFF **************************
 646 *     COMPUTES DIFFERENCE OF TWO NUMBERS.  C. L. LAWSON, JPL 1974 FEB 15
 647 *
 648 *     .. Scalar Arguments ..
 649       DOUBLE PRECISION                SA, SB
 650 *     .. Executable Statements ..
 651       SDIFF = SA - SB
 652       RETURN
 653       END
 654       SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC)
 655 *     **************************** CTEST *****************************
 656 *
 657 *     C.L. LAWSON, JPL, 1978 DEC 6
 658 *
 659 *     .. Scalar Arguments ..
 660       DOUBLE PRECISION SFAC
 661       INTEGER          LEN
 662 *     .. Array Arguments ..
 663       COMPLEX*16       CCOMP(LEN), CSIZE(LEN), CTRUE(LEN)
 664 *     .. Local Scalars ..
 665       INTEGER          I
 666 *     .. Local Arrays ..
 667       DOUBLE PRECISION SCOMP(20), SSIZE(20), STRUE(20)
 668 *     .. External Subroutines ..
 669       EXTERNAL         STEST
 670 *     .. Intrinsic Functions ..
 671       INTRINSIC        DIMAG, DBLE
 672 *     .. Executable Statements ..
 673       DO 20 I = 1, LEN
 674          SCOMP(2*I-1) = DBLE(CCOMP(I))
 675          SCOMP(2*I) = DIMAG(CCOMP(I))
 676          STRUE(2*I-1) = DBLE(CTRUE(I))
 677          STRUE(2*I) = DIMAG(CTRUE(I))
 678          SSIZE(2*I-1) = DBLE(CSIZE(I))
 679          SSIZE(2*I) = DIMAG(CSIZE(I))
 680    20 CONTINUE
 681 *
 682       CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC)
 683       RETURN
 684       END
 685       SUBROUTINE ITEST1(ICOMP,ITRUE)
 686 *     ********************************* ITEST1 *************************
 687 *
 688 *     THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
 689 *     EQUALITY.
 690 *     C. L. LAWSON, JPL, 1974 DEC 10
 691 *
 692 *     .. Parameters ..
 693       INTEGER           NOUT
 694       PARAMETER         (NOUT=6)
 695 *     .. Scalar Arguments ..
 696       INTEGER           ICOMP, ITRUE
 697 *     .. Scalars in Common ..
 698       INTEGER           ICASE, INCX, INCY, MODE, N
 699       LOGICAL           PASS
 700 *     .. Local Scalars ..
 701       INTEGER           ID
 702 *     .. Common blocks ..
 703       COMMON            /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
 704 *     .. Executable Statements ..
 705       IF (ICOMP.EQ.ITRUE) GO TO 40
 706 *
 707 *                            HERE ICOMP IS NOT EQUAL TO ITRUE.
 708 *
 709       IF ( .NOT. PASS) GO TO 20
 710 *                             PRINT FAIL MESSAGE AND HEADER.
 711       PASS = .FALSE.
 712       WRITE (NOUT,99999)
 713       WRITE (NOUT,99998)
 714    20 ID = ICOMP - ITRUE
 715       WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID
 716    40 CONTINUE
 717       RETURN
 718 *
 719 99999 FORMAT ('                                       FAIL')
 720 99998 FORMAT (/' CASE  N INCX INCY MODE                               ',
 721      +       ' COMP                                TRUE     DIFFERENCE',
 722      +       /1X)
 723 99997 FORMAT (1X,I4,I3,3I5,2I36,I12)
 724       END