2 * Test program for the DOUBLE PRECISION Level 1 CBLAS.
3 * Based upon the original CBLAS test routine together with:
4 * F06EAF Example Program Text
8 * .. Scalars in Common ..
9 INTEGER ICASE, INCX, INCY, MODE, N
14 * .. External Subroutines ..
15 EXTERNAL CHECK0, CHECK1, CHECK2, CHECK3, HEADER
17 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
18 * .. Data statements ..
19 DATA SFAC/9.765625D-4/
20 * .. Executable Statements ..
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 ..
37 ELSE IF (ICASE.EQ.7 .OR. ICASE.EQ.8 .OR. ICASE.EQ.9 .OR.
40 ELSE IF (ICASE.EQ.1 .OR. ICASE.EQ.2 .OR. ICASE.EQ.5 .OR.
43 ELSE IF (ICASE.EQ.4) THEN
47 IF (PASS) WRITE (NOUT,99998)
51 99999 FORMAT (' Real CBLAS Test Program Results',/1X)
52 99998 FORMAT (' ----- PASS -----')
58 * .. Scalars in Common ..
59 INTEGER ICASE, INCX, INCY, MODE, N
64 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
65 * .. Data statements ..
66 DATA L(1)/'CBLAS_DDOT'/
67 DATA L(2)/'CBLAS_DAXPY '/
68 DATA L(3)/'CBLAS_DROTG '/
69 DATA L(4)/'CBLAS_DROT '/
70 DATA L(5)/'CBLAS_DCOPY '/
71 DATA L(6)/'CBLAS_DSWAP '/
72 DATA L(7)/'CBLAS_DNRM2 '/
73 DATA L(8)/'CBLAS_DASUM '/
74 DATA L(9)/'CBLAS_DSCAL '/
75 DATA L(10)/'CBLAS_IDAMAX'/
76 * .. Executable Statements ..
77 WRITE (NOUT,99999) ICASE, L(ICASE)
80 99999 FORMAT (/' Test of subprogram number',I3,9X,A15)
82 SUBROUTINE CHECK0(SFAC)
86 * .. Scalar Arguments ..
88 * .. Scalars in Common ..
89 INTEGER ICASE, INCX, INCY, MODE, N
92 DOUBLE PRECISION SA, SB, SC, SS
95 DOUBLE PRECISION DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
97 * .. External Subroutines ..
98 EXTERNAL DROTGTEST, STEST1
100 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
101 * .. Data statements ..
102 DATA DA1/0.3D0, 0.4D0, -0.3D0, -0.4D0, -0.3D0, 0.0D0,
104 DATA DB1/0.4D0, 0.3D0, 0.4D0, 0.3D0, -0.4D0, 0.0D0,
106 DATA DC1/0.6D0, 0.8D0, -0.6D0, 0.8D0, 0.6D0, 1.0D0,
108 DATA DS1/0.8D0, 0.6D0, 0.8D0, -0.6D0, 0.8D0, 0.0D0,
110 DATA DATRUE/0.5D0, 0.5D0, 0.5D0, -0.5D0, -0.5D0,
111 + 0.0D0, 1.0D0, 1.0D0/
112 DATA DBTRUE/0.0D0, 0.6D0, 0.0D0, -0.6D0, 0.0D0,
113 + 0.0D0, 1.0D0, 0.0D0/
114 * .. Executable Statements ..
116 * Compute true values which cannot be prestored
117 * in decimal notation
119 DBTRUE(1) = 1.0D0/0.6D0
120 DBTRUE(3) = -1.0D0/0.6D0
121 DBTRUE(5) = 1.0D0/0.6D0
124 * .. Set N=K for identification in output if any ..
131 CALL DROTGTEST(SA,SB,SC,SS)
132 CALL STEST1(SA,DATRUE(K),DATRUE(K),SFAC)
133 CALL STEST1(SB,DBTRUE(K),DBTRUE(K),SFAC)
134 CALL STEST1(SC,DC1(K),DC1(K),SFAC)
135 CALL STEST1(SS,DS1(K),DS1(K),SFAC)
137 WRITE (NOUT,*) ' Shouldn''t be here in CHECK0'
143 SUBROUTINE CHECK1(SFAC)
147 * .. Scalar Arguments ..
148 DOUBLE PRECISION SFAC
149 * .. Scalars in Common ..
150 INTEGER ICASE, INCX, INCY, MODE, N
152 * .. Local Scalars ..
155 DOUBLE PRECISION DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
156 + SA(10), STEMP(1), STRUE(8), SX(8)
158 * .. External Functions ..
159 DOUBLE PRECISION DASUMTEST, DNRM2TEST
161 EXTERNAL DASUMTEST, DNRM2TEST, IDAMAXTEST
162 * .. External Subroutines ..
163 EXTERNAL ITEST1, DSCALTEST, STEST, STEST1
164 * .. Intrinsic Functions ..
166 * .. Common blocks ..
167 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
168 * .. Data statements ..
169 DATA SA/0.3D0, -1.0D0, 0.0D0, 1.0D0, 0.3D0, 0.3D0,
170 + 0.3D0, 0.3D0, 0.3D0, 0.3D0/
171 DATA DV/0.1D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
172 + 2.0D0, 2.0D0, 0.3D0, 3.0D0, 3.0D0, 3.0D0, 3.0D0,
173 + 3.0D0, 3.0D0, 3.0D0, 0.3D0, -0.4D0, 4.0D0,
174 + 4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0, 0.2D0,
175 + -0.6D0, 0.3D0, 5.0D0, 5.0D0, 5.0D0, 5.0D0,
176 + 5.0D0, 0.1D0, -0.3D0, 0.5D0, -0.1D0, 6.0D0,
177 + 6.0D0, 6.0D0, 6.0D0, 0.1D0, 8.0D0, 8.0D0, 8.0D0,
178 + 8.0D0, 8.0D0, 8.0D0, 8.0D0, 0.3D0, 9.0D0, 9.0D0,
179 + 9.0D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0, 0.3D0, 2.0D0,
180 + -0.4D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
181 + 0.2D0, 3.0D0, -0.6D0, 5.0D0, 0.3D0, 2.0D0,
182 + 2.0D0, 2.0D0, 0.1D0, 4.0D0, -0.3D0, 6.0D0,
183 + -0.5D0, 7.0D0, -0.1D0, 3.0D0/
184 DATA DTRUE1/0.0D0, 0.3D0, 0.5D0, 0.7D0, 0.6D0/
185 DATA DTRUE3/0.0D0, 0.3D0, 0.7D0, 1.1D0, 1.0D0/
186 DATA DTRUE5/0.10D0, 2.0D0, 2.0D0, 2.0D0, 2.0D0,
187 + 2.0D0, 2.0D0, 2.0D0, -0.3D0, 3.0D0, 3.0D0,
188 + 3.0D0, 3.0D0, 3.0D0, 3.0D0, 3.0D0, 0.0D0, 0.0D0,
189 + 4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0, 4.0D0,
190 + 0.20D0, -0.60D0, 0.30D0, 5.0D0, 5.0D0, 5.0D0,
191 + 5.0D0, 5.0D0, 0.03D0, -0.09D0, 0.15D0, -0.03D0,
192 + 6.0D0, 6.0D0, 6.0D0, 6.0D0, 0.10D0, 8.0D0,
193 + 8.0D0, 8.0D0, 8.0D0, 8.0D0, 8.0D0, 8.0D0,
194 + 0.09D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0, 9.0D0,
195 + 9.0D0, 9.0D0, 0.09D0, 2.0D0, -0.12D0, 2.0D0,
196 + 2.0D0, 2.0D0, 2.0D0, 2.0D0, 0.06D0, 3.0D0,
197 + -0.18D0, 5.0D0, 0.09D0, 2.0D0, 2.0D0, 2.0D0,
198 + 0.03D0, 4.0D0, -0.09D0, 6.0D0, -0.15D0, 7.0D0,
200 DATA ITRUE2/0, 1, 2, 2, 3/
201 * .. Executable Statements ..
206 * .. Set vector arguments ..
208 SX(I) = DV(I,NP1,INCX)
213 STEMP(1) = DTRUE1(NP1)
214 CALL STEST1(DNRM2TEST(N,SX,INCX),STEMP,STEMP,SFAC)
215 ELSE IF (ICASE.EQ.8) THEN
217 STEMP(1) = DTRUE3(NP1)
218 CALL STEST1(DASUMTEST(N,SX,INCX),STEMP,STEMP,SFAC)
219 ELSE IF (ICASE.EQ.9) THEN
221 CALL DSCALTEST(N,SA((INCX-1)*5+NP1),SX,INCX)
223 STRUE(I) = DTRUE5(I,NP1,INCX)
225 CALL STEST(LEN,SX,STRUE,STRUE,SFAC)
226 ELSE IF (ICASE.EQ.10) THEN
228 CALL ITEST1(IDAMAXTEST(N,SX,INCX),ITRUE2(NP1))
230 WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
237 SUBROUTINE CHECK2(SFAC)
241 * .. Scalar Arguments ..
242 DOUBLE PRECISION SFAC
243 * .. Scalars in Common ..
244 INTEGER ICASE, INCX, INCY, MODE, N
246 * .. Local Scalars ..
248 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
250 DOUBLE PRECISION DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
251 + DT8(7,4,4), DX1(7),
252 + DY1(7), SSIZE1(4), SSIZE2(14,2), STX(7), STY(7),
254 INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
255 * .. External Functions ..
257 DOUBLE PRECISION DDOTTEST
258 * .. External Subroutines ..
259 EXTERNAL DAXPYTEST, DCOPYTEST, DSWAPTEST, STEST, STEST1
260 * .. Intrinsic Functions ..
262 * .. Common blocks ..
263 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
264 * .. Data statements ..
266 DATA INCXS/1, 2, -2, -1/
267 DATA INCYS/1, -2, 1, -2/
268 DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
270 DATA DX1/0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.9D0, -0.3D0,
272 DATA DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0,
274 DATA DT7/0.0D0, 0.30D0, 0.21D0, 0.62D0, 0.0D0,
275 + 0.30D0, -0.07D0, 0.85D0, 0.0D0, 0.30D0, -0.79D0,
276 + -0.74D0, 0.0D0, 0.30D0, 0.33D0, 1.27D0/
277 DATA DT8/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
278 + 0.0D0, 0.68D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
279 + 0.0D0, 0.0D0, 0.68D0, -0.87D0, 0.0D0, 0.0D0,
280 + 0.0D0, 0.0D0, 0.0D0, 0.68D0, -0.87D0, 0.15D0,
281 + 0.94D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
282 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.68D0,
283 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
284 + 0.35D0, -0.9D0, 0.48D0, 0.0D0, 0.0D0, 0.0D0,
285 + 0.0D0, 0.38D0, -0.9D0, 0.57D0, 0.7D0, -0.75D0,
286 + 0.2D0, 0.98D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0,
287 + 0.0D0, 0.0D0, 0.0D0, 0.68D0, 0.0D0, 0.0D0,
288 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.35D0, -0.72D0,
289 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.38D0,
290 + -0.63D0, 0.15D0, 0.88D0, 0.0D0, 0.0D0, 0.0D0,
291 + 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
292 + 0.68D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
293 + 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.0D0, 0.0D0,
294 + 0.0D0, 0.0D0, 0.68D0, -0.9D0, 0.33D0, 0.7D0,
295 + -0.75D0, 0.2D0, 1.04D0/
296 DATA DT10X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
297 + 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
298 + 0.0D0, 0.5D0, -0.9D0, 0.0D0, 0.0D0, 0.0D0,
299 + 0.0D0, 0.0D0, 0.5D0, -0.9D0, 0.3D0, 0.7D0,
300 + 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0,
301 + 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0,
302 + 0.0D0, 0.0D0, 0.0D0, 0.3D0, 0.1D0, 0.5D0, 0.0D0,
303 + 0.0D0, 0.0D0, 0.0D0, 0.8D0, 0.1D0, -0.6D0,
304 + 0.8D0, 0.3D0, -0.3D0, 0.5D0, 0.6D0, 0.0D0,
305 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
306 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.9D0,
307 + 0.1D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.7D0,
308 + 0.1D0, 0.3D0, 0.8D0, -0.9D0, -0.3D0, 0.5D0,
309 + 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
310 + 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
311 + 0.5D0, 0.3D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
312 + 0.5D0, 0.3D0, -0.6D0, 0.8D0, 0.0D0, 0.0D0,
314 DATA DT10Y/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
315 + 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
316 + 0.0D0, 0.6D0, 0.1D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
317 + 0.0D0, 0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.0D0,
318 + 0.0D0, 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
319 + 0.0D0, 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
320 + 0.0D0, 0.0D0, -0.5D0, -0.9D0, 0.6D0, 0.0D0,
321 + 0.0D0, 0.0D0, 0.0D0, -0.4D0, -0.9D0, 0.9D0,
322 + 0.7D0, -0.5D0, 0.2D0, 0.6D0, 0.5D0, 0.0D0,
323 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0,
324 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.5D0,
325 + 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
326 + -0.4D0, 0.9D0, -0.5D0, 0.6D0, 0.0D0, 0.0D0,
327 + 0.0D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
328 + 0.0D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
329 + 0.0D0, 0.6D0, -0.9D0, 0.1D0, 0.0D0, 0.0D0,
330 + 0.0D0, 0.0D0, 0.6D0, -0.9D0, 0.1D0, 0.7D0,
331 + -0.5D0, 0.2D0, 0.8D0/
332 DATA SSIZE1/0.0D0, 0.3D0, 1.6D0, 3.2D0/
333 DATA SSIZE2/0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
334 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
335 + 0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
336 + 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
337 + 1.17D0, 1.17D0, 1.17D0/
338 * .. Executable Statements ..
351 * .. Initialize all argument arrays ..
359 CALL STEST1(DDOTTEST(N,SX,INCX,SY,INCY),DT7(KN,KI),
361 ELSE IF (ICASE.EQ.2) THEN
363 CALL DAXPYTEST(N,SA,SX,INCX,SY,INCY)
365 STY(J) = DT8(J,KN,KI)
367 CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
368 ELSE IF (ICASE.EQ.5) THEN
371 STY(I) = DT10Y(I,KN,KI)
373 CALL DCOPYTEST(N,SX,INCX,SY,INCY)
374 CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0)
375 ELSE IF (ICASE.EQ.6) THEN
377 CALL DSWAPTEST(N,SX,INCX,SY,INCY)
379 STX(I) = DT10X(I,KN,KI)
380 STY(I) = DT10Y(I,KN,KI)
382 CALL STEST(LENX,SX,STX,SSIZE2(1,1),1.0D0)
383 CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0D0)
385 WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
392 SUBROUTINE CHECK3(SFAC)
396 * .. Scalar Arguments ..
397 DOUBLE PRECISION SFAC
398 * .. Scalars in Common ..
399 INTEGER ICASE, INCX, INCY, MODE, N
401 * .. Local Scalars ..
402 DOUBLE PRECISION SC, SS
403 INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
405 DOUBLE PRECISION COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
406 + DX1(7), DY1(7), MWPC(11), MWPS(11), MWPSTX(5),
407 + MWPSTY(5), MWPTX(11,5), MWPTY(11,5), MWPX(5),
408 + MWPY(5), SSIZE2(14,2), STX(7), STY(7), SX(7),
410 INTEGER INCXS(4), INCYS(4), LENS(4,2), MWPINX(11),
411 + MWPINY(11), MWPN(11), NS(4)
412 * .. External Subroutines ..
413 EXTERNAL STEST,DROTTEST
414 * .. Intrinsic Functions ..
416 * .. Common blocks ..
417 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
418 * .. Data statements ..
419 DATA INCXS/1, 2, -2, -1/
420 DATA INCYS/1, -2, 1, -2/
421 DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
423 DATA DX1/0.6D0, 0.1D0, -0.5D0, 0.8D0, 0.9D0, -0.3D0,
425 DATA DY1/0.5D0, -0.9D0, 0.3D0, 0.7D0, -0.6D0, 0.2D0,
427 DATA SC, SS/0.8D0, 0.6D0/
428 DATA DT9X/0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
429 + 0.0D0, 0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
430 + 0.0D0, 0.0D0, 0.78D0, -0.46D0, 0.0D0, 0.0D0,
431 + 0.0D0, 0.0D0, 0.0D0, 0.78D0, -0.46D0, -0.22D0,
432 + 1.06D0, 0.0D0, 0.0D0, 0.0D0, 0.6D0, 0.0D0,
433 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.78D0,
434 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
435 + 0.66D0, 0.1D0, -0.1D0, 0.0D0, 0.0D0, 0.0D0,
436 + 0.0D0, 0.96D0, 0.1D0, -0.76D0, 0.8D0, 0.90D0,
437 + -0.3D0, -0.02D0, 0.6D0, 0.0D0, 0.0D0, 0.0D0,
438 + 0.0D0, 0.0D0, 0.0D0, 0.78D0, 0.0D0, 0.0D0,
439 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, -0.06D0, 0.1D0,
440 + -0.1D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.90D0,
441 + 0.1D0, -0.22D0, 0.8D0, 0.18D0, -0.3D0, -0.02D0,
442 + 0.6D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
443 + 0.78D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
444 + 0.0D0, 0.78D0, 0.26D0, 0.0D0, 0.0D0, 0.0D0,
445 + 0.0D0, 0.0D0, 0.78D0, 0.26D0, -0.76D0, 1.12D0,
446 + 0.0D0, 0.0D0, 0.0D0/
447 DATA DT9Y/0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
448 + 0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
449 + 0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.0D0, 0.0D0,
450 + 0.0D0, 0.0D0, 0.0D0, 0.04D0, -0.78D0, 0.54D0,
451 + 0.08D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0, 0.0D0,
452 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.04D0,
453 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.7D0,
454 + -0.9D0, -0.12D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
455 + 0.64D0, -0.9D0, -0.30D0, 0.7D0, -0.18D0, 0.2D0,
456 + 0.28D0, 0.5D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
457 + 0.0D0, 0.0D0, 0.04D0, 0.0D0, 0.0D0, 0.0D0,
458 + 0.0D0, 0.0D0, 0.0D0, 0.7D0, -1.08D0, 0.0D0,
459 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.64D0, -1.26D0,
460 + 0.54D0, 0.20D0, 0.0D0, 0.0D0, 0.0D0, 0.5D0,
461 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
462 + 0.04D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
463 + 0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.0D0, 0.0D0,
464 + 0.0D0, 0.0D0, 0.04D0, -0.9D0, 0.18D0, 0.7D0,
465 + -0.18D0, 0.2D0, 0.16D0/
466 DATA SSIZE2/0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
467 + 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0, 0.0D0,
468 + 0.0D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
469 + 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0, 1.17D0,
470 + 1.17D0, 1.17D0, 1.17D0/
471 * .. Executable Statements ..
490 STX(I) = DT9X(I,KN,KI)
491 STY(I) = DT9Y(I,KN,KI)
493 CALL DROTTEST(N,SX,INCX,SY,INCY,SC,SS)
494 CALL STEST(LENX,SX,STX,SSIZE2(1,KSIZE),SFAC)
495 CALL STEST(LENY,SY,STY,SSIZE2(1,KSIZE),SFAC)
497 WRITE (NOUT,*) ' Shouldn''t be here in CHECK3'
589 MWPSTX(K) = MWPTX(I,K)
590 MWPSTY(K) = MWPTY(I,K)
592 CALL DROTTEST(MWPN(I),COPYX,INCX,COPYY,INCY,MWPC(I),MWPS(I))
593 CALL STEST(5,COPYX,MWPSTX,MWPSTX,SFAC)
594 CALL STEST(5,COPYY,MWPSTY,MWPSTY,SFAC)
598 SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
599 * ********************************* STEST **************************
601 * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
602 * SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
605 * C. L. LAWSON, JPL, 1974 DEC 10
610 * .. Scalar Arguments ..
611 DOUBLE PRECISION SFAC
613 * .. Array Arguments ..
614 DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
615 * .. Scalars in Common ..
616 INTEGER ICASE, INCX, INCY, MODE, N
618 * .. Local Scalars ..
621 * .. External Functions ..
622 DOUBLE PRECISION SDIFF
624 * .. Intrinsic Functions ..
626 * .. Common blocks ..
627 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
628 * .. Executable Statements ..
631 SD = SCOMP(I) - STRUE(I)
632 IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0)
635 * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
637 IF ( .NOT. PASS) GO TO 20
638 * PRINT FAIL MESSAGE AND HEADER.
642 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I),
643 + STRUE(I), SD, SSIZE(I)
647 99999 FORMAT (' FAIL')
648 99998 FORMAT (/' CASE N INCX INCY MODE I ',
649 + ' COMP(I) TRUE(I) DIFFERENCE',
651 99997 FORMAT (1X,I4,I3,3I5,I3,2D36.8,2D12.4)
653 SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
654 * ************************* STEST1 *****************************
656 * THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
657 * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
658 * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
660 * C.L. LAWSON, JPL, 1978 DEC 6
662 * .. Scalar Arguments ..
663 DOUBLE PRECISION SCOMP1, SFAC, STRUE1
664 * .. Array Arguments ..
665 DOUBLE PRECISION SSIZE(*)
667 DOUBLE PRECISION SCOMP(1), STRUE(1)
668 * .. External Subroutines ..
670 * .. Executable Statements ..
674 CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
678 DOUBLE PRECISION FUNCTION SDIFF(SA,SB)
679 * ********************************* SDIFF **************************
680 * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15
682 * .. Scalar Arguments ..
683 DOUBLE PRECISION SA, SB
684 * .. Executable Statements ..
688 SUBROUTINE ITEST1(ICOMP,ITRUE)
689 * ********************************* ITEST1 *************************
691 * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
693 * C. L. LAWSON, JPL, 1974 DEC 10
698 * .. Scalar Arguments ..
700 * .. Scalars in Common ..
701 INTEGER ICASE, INCX, INCY, MODE, N
703 * .. Local Scalars ..
705 * .. Common blocks ..
706 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
707 * .. Executable Statements ..
709 IF (ICOMP.EQ.ITRUE) GO TO 40
711 * HERE ICOMP IS NOT EQUAL TO ITRUE.
713 IF ( .NOT. PASS) GO TO 20
714 * PRINT FAIL MESSAGE AND HEADER.
718 20 ID = ICOMP - ITRUE
719 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID
723 99999 FORMAT (' FAIL')
724 99998 FORMAT (/' CASE N INCX INCY MODE ',
725 + ' COMP TRUE DIFFERENCE',
727 99997 FORMAT (1X,I4,I3,3I5,2I36,I12)