• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1      PROGRAM ZCBLAT1
2*     Test program for the COMPLEX*16 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      DOUBLE PRECISION 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.765625D-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*
4599999 FORMAT (' Complex CBLAS Test Program Results',/1X)
4699998 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_ZDOTC'/
61      DATA             L(2)/'CBLAS_ZDOTU'/
62      DATA             L(3)/'CBLAS_ZAXPY'/
63      DATA             L(4)/'CBLAS_ZCOPY'/
64      DATA             L(5)/'CBLAS_ZSWAP'/
65      DATA             L(6)/'CBLAS_DZNRM2'/
66      DATA             L(7)/'CBLAS_DZASUM'/
67      DATA             L(8)/'CBLAS_ZSCAL'/
68      DATA             L(9)/'CBLAS_ZDSCAL'/
69      DATA             L(10)/'CBLAS_IZAMAX'/
70*     .. Executable Statements ..
71      WRITE (NOUT,99999) ICASE, L(ICASE)
72      RETURN
73*
7499999 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      DOUBLE PRECISION  SFAC
82*     .. Scalars in Common ..
83      INTEGER           ICASE, INCX, INCY, MODE, N
84      LOGICAL           PASS
85*     .. Local Scalars ..
86      COMPLEX*16        CA
87      DOUBLE PRECISION  SA
88      INTEGER           I, J, LEN, NP1
89*     .. Local Arrays ..
90      COMPLEX*16        CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
91     +                  MWPCS(5), MWPCT(5)
92      DOUBLE PRECISION  STRUE2(5), STRUE4(5)
93      INTEGER           ITRUE3(5)
94*     .. External Functions ..
95      DOUBLE PRECISION  DZASUMTEST, DZNRM2TEST
96      INTEGER           IZAMAXTEST
97      EXTERNAL          DZASUMTEST, DZNRM2TEST, IZAMAXTEST
98*     .. External Subroutines ..
99      EXTERNAL          ZSCALTEST, ZDSCALTEST, 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.3D0, (0.4D0,-0.7D0)/
106      DATA              ((CV(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
107     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
108     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
109     +                  (1.0D0,2.0D0), (0.3D0,-0.4D0), (3.0D0,4.0D0),
110     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
111     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
112     +                  (0.1D0,-0.3D0), (0.5D0,-0.1D0), (5.0D0,6.0D0),
113     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
114     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (0.1D0,0.1D0),
115     +                  (-0.6D0,0.1D0), (0.1D0,-0.3D0), (7.0D0,8.0D0),
116     +                  (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
117     +                  (7.0D0,8.0D0), (0.3D0,0.1D0), (0.1D0,0.4D0),
118     +                  (0.4D0,0.1D0), (0.1D0,0.2D0), (2.0D0,3.0D0),
119     +                  (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/
120      DATA              ((CV(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
121     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
122     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
123     +                  (4.0D0,5.0D0), (0.3D0,-0.4D0), (6.0D0,7.0D0),
124     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
125     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
126     +                  (0.1D0,-0.3D0), (8.0D0,9.0D0), (0.5D0,-0.1D0),
127     +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
128     +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (0.1D0,0.1D0),
129     +                  (3.0D0,6.0D0), (-0.6D0,0.1D0), (4.0D0,7.0D0),
130     +                  (0.1D0,-0.3D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
131     +                  (7.0D0,2.0D0), (0.3D0,0.1D0), (5.0D0,8.0D0),
132     +                  (0.1D0,0.4D0), (6.0D0,9.0D0), (0.4D0,0.1D0),
133     +                  (8.0D0,3.0D0), (0.1D0,0.2D0), (9.0D0,4.0D0)/
134      DATA              STRUE2/0.0D0, 0.5D0, 0.6D0, 0.7D0, 0.7D0/
135      DATA              STRUE4/0.0D0, 0.7D0, 1.0D0, 1.3D0, 1.7D0/
136      DATA              ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
137     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
138     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
139     +                  (1.0D0,2.0D0), (-0.16D0,-0.37D0), (3.0D0,4.0D0),
140     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
141     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
142     +                  (-0.17D0,-0.19D0), (0.13D0,-0.39D0),
143     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
144     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
145     +                  (0.11D0,-0.03D0), (-0.17D0,0.46D0),
146     +                  (-0.17D0,-0.19D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
147     +                  (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
148     +                  (0.19D0,-0.17D0), (0.32D0,0.09D0),
149     +                  (0.23D0,-0.24D0), (0.18D0,0.01D0),
150     +                  (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0),
151     +                  (2.0D0,3.0D0)/
152      DATA              ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
153     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
154     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
155     +                  (4.0D0,5.0D0), (-0.16D0,-0.37D0), (6.0D0,7.0D0),
156     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
157     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
158     +                  (-0.17D0,-0.19D0), (8.0D0,9.0D0),
159     +                  (0.13D0,-0.39D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
160     +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
161     +                  (0.11D0,-0.03D0), (3.0D0,6.0D0),
162     +                  (-0.17D0,0.46D0), (4.0D0,7.0D0),
163     +                  (-0.17D0,-0.19D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
164     +                  (7.0D0,2.0D0), (0.19D0,-0.17D0), (5.0D0,8.0D0),
165     +                  (0.32D0,0.09D0), (6.0D0,9.0D0),
166     +                  (0.23D0,-0.24D0), (8.0D0,3.0D0),
167     +                  (0.18D0,0.01D0), (9.0D0,4.0D0)/
168      DATA              ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
169     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
170     +                  (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
171     +                  (1.0D0,2.0D0), (0.09D0,-0.12D0), (3.0D0,4.0D0),
172     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
173     +                  (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
174     +                  (0.03D0,-0.09D0), (0.15D0,-0.03D0),
175     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
176     +                  (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
177     +                  (0.03D0,0.03D0), (-0.18D0,0.03D0),
178     +                  (0.03D0,-0.09D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
179     +                  (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
180     +                  (0.09D0,0.03D0), (0.03D0,0.12D0),
181     +                  (0.12D0,0.03D0), (0.03D0,0.06D0), (2.0D0,3.0D0),
182     +                  (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/
183      DATA              ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
184     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
185     +                  (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
186     +                  (4.0D0,5.0D0), (0.09D0,-0.12D0), (6.0D0,7.0D0),
187     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
188     +                  (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
189     +                  (0.03D0,-0.09D0), (8.0D0,9.0D0),
190     +                  (0.15D0,-0.03D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
191     +                  (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
192     +                  (0.03D0,0.03D0), (3.0D0,6.0D0),
193     +                  (-0.18D0,0.03D0), (4.0D0,7.0D0),
194     +                  (0.03D0,-0.09D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
195     +                  (7.0D0,2.0D0), (0.09D0,0.03D0), (5.0D0,8.0D0),
196     +                  (0.03D0,0.12D0), (6.0D0,9.0D0), (0.12D0,0.03D0),
197     +                  (8.0D0,3.0D0), (0.03D0,0.06D0), (9.0D0,4.0D0)/
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*              .. DZNRM2TEST ..
210               CALL STEST1(DZNRM2TEST(N,CX,INCX),STRUE2(NP1),
211     +                     STRUE2(NP1),SFAC)
212            ELSE IF (ICASE.EQ.7) THEN
213*              .. DZASUMTEST ..
214               CALL STEST1(DZASUMTEST(N,CX,INCX),STRUE4(NP1),
215     +                     STRUE4(NP1),SFAC)
216            ELSE IF (ICASE.EQ.8) THEN
217*              .. ZSCALTEST ..
218               CALL ZSCALTEST(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*              .. ZDSCALTEST ..
223               CALL ZDSCALTEST(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*              .. IZAMAXTEST ..
228               CALL ITEST1(IZAMAXTEST(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*        ZSCALTEST
240*        Add a test for alpha equal to zero.
241         CA = (0.0D0,0.0D0)
242         DO 80 I = 1, 5
243            MWPCT(I) = (0.0D0,0.0D0)
244            MWPCS(I) = (1.0D0,1.0D0)
245   80    CONTINUE
246         CALL ZSCALTEST(5,CA,CX,INCX)
247         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
248      ELSE IF (ICASE.EQ.9) THEN
249*        ZDSCALTEST
250*        Add a test for alpha equal to zero.
251         SA = 0.0D0
252         DO 100 I = 1, 5
253            MWPCT(I) = (0.0D0,0.0D0)
254            MWPCS(I) = (1.0D0,1.0D0)
255  100    CONTINUE
256         CALL ZDSCALTEST(5,SA,CX,INCX)
257         CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
258*        Add a test for alpha equal to one.
259         SA = 1.0D0
260         DO 120 I = 1, 5
261            MWPCT(I) = CX(I)
262            MWPCS(I) = CX(I)
263  120    CONTINUE
264         CALL ZDSCALTEST(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.0D0
268         DO 140 I = 1, 5
269            MWPCT(I) = -CX(I)
270            MWPCS(I) = -CX(I)
271  140    CONTINUE
272         CALL ZDSCALTEST(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      DOUBLE PRECISION  SFAC
283*     .. Scalars in Common ..
284      INTEGER           ICASE, INCX, INCY, MODE, N
285      LOGICAL           PASS
286*     .. Local Scalars ..
287      COMPLEX*16        CA,ZTEMP
288      INTEGER           I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
289*     .. Local Arrays ..
290      COMPLEX*16        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          ZDOTCTEST, ZDOTUTEST
296*     .. External Subroutines ..
297      EXTERNAL          ZAXPYTEST, ZCOPYTEST, ZSWAPTEST, 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.4D0,-0.7D0)/
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.7D0,-0.8D0), (-0.4D0,-0.7D0),
309     +                  (-0.1D0,-0.9D0), (0.2D0,-0.8D0),
310     +                  (-0.9D0,-0.4D0), (0.1D0,0.4D0), (-0.6D0,0.6D0)/
311      DATA              CY1/(0.6D0,-0.6D0), (-0.9D0,0.5D0),
312     +                  (0.7D0,-0.6D0), (0.1D0,-0.5D0), (-0.1D0,-0.2D0),
313     +                  (-0.5D0,-0.3D0), (0.8D0,-0.7D0)/
314      DATA              ((CT8(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0),
315     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
316     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
317     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
318     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
319     +                  (0.0D0,0.0D0), (0.32D0,-1.41D0),
320     +                  (-1.55D0,0.5D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
321     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
322     +                  (0.32D0,-1.41D0), (-1.55D0,0.5D0),
323     +                  (0.03D0,-0.89D0), (-0.38D0,-0.96D0),
324     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
325      DATA              ((CT8(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0),
326     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
327     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
328     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
329     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
330     +                  (0.0D0,0.0D0), (-0.07D0,-0.89D0),
331     +                  (-0.9D0,0.5D0), (0.42D0,-1.41D0), (0.0D0,0.0D0),
332     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
333     +                  (0.78D0,0.06D0), (-0.9D0,0.5D0),
334     +                  (0.06D0,-0.13D0), (0.1D0,-0.5D0),
335     +                  (-0.77D0,-0.49D0), (-0.5D0,-0.3D0),
336     +                  (0.52D0,-1.51D0)/
337      DATA              ((CT8(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0),
338     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
339     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
340     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
341     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
342     +                  (0.0D0,0.0D0), (-0.07D0,-0.89D0),
343     +                  (-1.18D0,-0.31D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
344     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
345     +                  (0.78D0,0.06D0), (-1.54D0,0.97D0),
346     +                  (0.03D0,-0.89D0), (-0.18D0,-1.31D0),
347     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
348      DATA              ((CT8(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0),
349     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
350     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
351     +                  (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
352     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
353     +                  (0.0D0,0.0D0), (0.32D0,-1.41D0), (-0.9D0,0.5D0),
354     +                  (0.05D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
355     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.32D0,-1.41D0),
356     +                  (-0.9D0,0.5D0), (0.05D0,-0.6D0), (0.1D0,-0.5D0),
357     +                  (-0.77D0,-0.49D0), (-0.5D0,-0.3D0),
358     +                  (0.32D0,-1.16D0)/
359      DATA              CT7/(0.0D0,0.0D0), (-0.06D0,-0.90D0),
360     +                  (0.65D0,-0.47D0), (-0.34D0,-1.22D0),
361     +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
362     +                  (-0.59D0,-1.46D0), (-1.04D0,-0.04D0),
363     +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
364     +                  (-0.83D0,0.59D0), (0.07D0,-0.37D0),
365     +                  (0.0D0,0.0D0), (-0.06D0,-0.90D0),
366     +                  (-0.76D0,-1.15D0), (-1.33D0,-1.82D0)/
367      DATA              CT6/(0.0D0,0.0D0), (0.90D0,0.06D0),
368     +                  (0.91D0,-0.77D0), (1.80D0,-0.10D0),
369     +                  (0.0D0,0.0D0), (0.90D0,0.06D0), (1.45D0,0.74D0),
370     +                  (0.20D0,0.90D0), (0.0D0,0.0D0), (0.90D0,0.06D0),
371     +                  (-0.55D0,0.23D0), (0.83D0,-0.39D0),
372     +                  (0.0D0,0.0D0), (0.90D0,0.06D0), (1.04D0,0.79D0),
373     +                  (1.95D0,1.22D0)/
374      DATA              ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7D0,-0.8D0),
375     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
376     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
377     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
378     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
379     +                  (0.0D0,0.0D0), (0.6D0,-0.6D0), (-0.9D0,0.5D0),
380     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
381     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0),
382     +                  (-0.9D0,0.5D0), (0.7D0,-0.6D0), (0.1D0,-0.5D0),
383     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
384      DATA              ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7D0,-0.8D0),
385     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
386     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
387     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
388     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
389     +                  (0.0D0,0.0D0), (0.7D0,-0.6D0), (-0.4D0,-0.7D0),
390     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
391     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.8D0,-0.7D0),
392     +                  (-0.4D0,-0.7D0), (-0.1D0,-0.2D0),
393     +                  (0.2D0,-0.8D0), (0.7D0,-0.6D0), (0.1D0,0.4D0),
394     +                  (0.6D0,-0.6D0)/
395      DATA              ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7D0,-0.8D0),
396     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
397     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
398     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
399     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
400     +                  (0.0D0,0.0D0), (-0.9D0,0.5D0), (-0.4D0,-0.7D0),
401     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
402     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.1D0,-0.5D0),
403     +                  (-0.4D0,-0.7D0), (0.7D0,-0.6D0), (0.2D0,-0.8D0),
404     +                  (-0.9D0,0.5D0), (0.1D0,0.4D0), (0.6D0,-0.6D0)/
405      DATA              ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7D0,-0.8D0),
406     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
407     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
408     +                  (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
409     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
410     +                  (0.0D0,0.0D0), (0.6D0,-0.6D0), (0.7D0,-0.6D0),
411     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
412     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0),
413     +                  (0.7D0,-0.6D0), (-0.1D0,-0.2D0), (0.8D0,-0.7D0),
414     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
415      DATA              ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0),
416     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
417     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
418     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
419     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
420     +                  (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.4D0,-0.7D0),
421     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
422     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0),
423     +                  (-0.4D0,-0.7D0), (-0.1D0,-0.9D0),
424     +                  (0.2D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
425     +                  (0.0D0,0.0D0)/
426      DATA              ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0),
427     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
428     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
429     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
430     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
431     +                  (0.0D0,0.0D0), (-0.1D0,-0.9D0), (-0.9D0,0.5D0),
432     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
433     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0),
434     +                  (-0.9D0,0.5D0), (-0.9D0,-0.4D0), (0.1D0,-0.5D0),
435     +                  (-0.1D0,-0.9D0), (-0.5D0,-0.3D0),
436     +                  (0.7D0,-0.8D0)/
437      DATA              ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0),
438     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
439     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
440     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
441     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
442     +                  (0.0D0,0.0D0), (-0.1D0,-0.9D0), (0.7D0,-0.8D0),
443     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
444     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0),
445     +                  (-0.9D0,-0.4D0), (-0.1D0,-0.9D0),
446     +                  (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
447     +                  (0.0D0,0.0D0)/
448      DATA              ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0),
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.7D0,-0.8D0), (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.7D0,-0.8D0), (-0.9D0,0.5D0),
454     +                  (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
455     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0),
456     +                  (-0.9D0,0.5D0), (-0.4D0,-0.7D0), (0.1D0,-0.5D0),
457     +                  (-0.1D0,-0.9D0), (-0.5D0,-0.3D0),
458     +                  (0.2D0,-0.8D0)/
459      DATA              CSIZE1/(0.0D0,0.0D0), (0.9D0,0.9D0),
460     +                  (1.63D0,1.73D0), (2.90D0,2.78D0)/
461      DATA              CSIZE3/(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.0D0,0.0D0), (1.17D0,1.17D0),
464     +                  (1.17D0,1.17D0), (1.17D0,1.17D0),
465     +                  (1.17D0,1.17D0), (1.17D0,1.17D0),
466     +                  (1.17D0,1.17D0), (1.17D0,1.17D0)/
467      DATA              CSIZE2/(0.0D0,0.0D0), (0.0D0,0.0D0),
468     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
469     +                  (0.0D0,0.0D0), (0.0D0,0.0D0), (1.54D0,1.54D0),
470     +                  (1.54D0,1.54D0), (1.54D0,1.54D0),
471     +                  (1.54D0,1.54D0), (1.54D0,1.54D0),
472     +                  (1.54D0,1.54D0), (1.54D0,1.54D0)/
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*              .. ZDOTCTEST ..
492               CALL ZDOTCTEST(N,CX,INCX,CY,INCY,ZTEMP)
493               CDOT(1) = ZTEMP
494               CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC)
495            ELSE IF (ICASE.EQ.2) THEN
496*              .. ZDOTUTEST ..
497               CALL ZDOTUTEST(N,CX,INCX,CY,INCY,ZTEMP)
498               CDOT(1) = ZTEMP
499               CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC)
500            ELSE IF (ICASE.EQ.3) THEN
501*              .. ZAXPYTEST ..
502               CALL ZAXPYTEST(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*              .. ZCOPYTEST ..
506               CALL ZCOPYTEST(N,CX,INCX,CY,INCY)
507               CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0)
508            ELSE IF (ICASE.EQ.5) THEN
509*              .. ZSWAPTEST ..
510               CALL ZSWAPTEST(N,CX,INCX,CY,INCY)
511               CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0D0)
512               CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0)
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      DOUBLE PRECISION SFAC
536      INTEGER          LEN
537*     .. Array Arguments ..
538      DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
539*     .. Scalars in Common ..
540      INTEGER          ICASE, INCX, INCY, MODE, N
541      LOGICAL          PASS
542*     .. Local Scalars ..
543      DOUBLE PRECISION SD
544      INTEGER          I
545*     .. External Functions ..
546      DOUBLE PRECISION 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.0D0)
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*
57199999 FORMAT ('                                       FAIL')
57299998 FORMAT (/' CASE  N INCX INCY MODE  I                            ',
573     +       ' COMP(I)                             TRUE(I)  DIFFERENCE',
574     +       '     SIZE(I)',/1X)
57599997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.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      DOUBLE PRECISION  SCOMP1, SFAC, STRUE1
588*     .. Array Arguments ..
589      DOUBLE PRECISION  SSIZE(*)
590*     .. Local Arrays ..
591      DOUBLE PRECISION  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      DOUBLE PRECISION FUNCTION SDIFF(SA,SB)
603*     ********************************* SDIFF **************************
604*     COMPUTES DIFFERENCE OF TWO NUMBERS.  C. L. LAWSON, JPL 1974 FEB 15
605*
606*     .. Scalar Arguments ..
607      DOUBLE PRECISION                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      DOUBLE PRECISION SFAC
619      INTEGER          LEN
620*     .. Array Arguments ..
621      COMPLEX*16       CCOMP(LEN), CSIZE(LEN), CTRUE(LEN)
622*     .. Local Scalars ..
623      INTEGER          I
624*     .. Local Arrays ..
625      DOUBLE PRECISION SCOMP(20), SSIZE(20), STRUE(20)
626*     .. External Subroutines ..
627      EXTERNAL         STEST
628*     .. Intrinsic Functions ..
629      INTRINSIC        DIMAG, DBLE
630*     .. Executable Statements ..
631      DO 20 I = 1, LEN
632         SCOMP(2*I-1) = DBLE(CCOMP(I))
633         SCOMP(2*I) = DIMAG(CCOMP(I))
634         STRUE(2*I-1) = DBLE(CTRUE(I))
635         STRUE(2*I) = DIMAG(CTRUE(I))
636         SSIZE(2*I-1) = DBLE(CSIZE(I))
637         SSIZE(2*I) = DIMAG(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*
67799999 FORMAT ('                                       FAIL')
67899998 FORMAT (/' CASE  N INCX INCY MODE                               ',
679     +       ' COMP                                TRUE     DIFFERENCE',
680     +       /1X)
68199997 FORMAT (1X,I4,I3,3I5,2I36,I12)
682      END
683