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