2 * Test program for the REAL 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.765625E-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_SDOT '/
67 DATA L(2)/'CBLAS_SAXPY '/
68 DATA L(3)/'CBLAS_SROTG '/
69 DATA L(4)/'CBLAS_SROT '/
70 DATA L(5)/'CBLAS_SCOPY '/
71 DATA L(6)/'CBLAS_SSWAP '/
72 DATA L(7)/'CBLAS_SNRM2 '/
73 DATA L(8)/'CBLAS_SASUM '/
74 DATA L(9)/'CBLAS_SSCAL '/
75 DATA L(10)/'CBLAS_ISAMAX'/
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
95 REAL DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
97 * .. External Subroutines ..
98 EXTERNAL SROTGTEST, STEST1
100 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
101 * .. Data statements ..
102 DATA DA1/0.3E0, 0.4E0, -0.3E0, -0.4E0, -0.3E0, 0.0E0,
104 DATA DB1/0.4E0, 0.3E0, 0.4E0, 0.3E0, -0.4E0, 0.0E0,
106 DATA DC1/0.6E0, 0.8E0, -0.6E0, 0.8E0, 0.6E0, 1.0E0,
108 DATA DS1/0.8E0, 0.6E0, 0.8E0, -0.6E0, 0.8E0, 0.0E0,
110 DATA DATRUE/0.5E0, 0.5E0, 0.5E0, -0.5E0, -0.5E0,
111 + 0.0E0, 1.0E0, 1.0E0/
112 DATA DBTRUE/0.0E0, 0.6E0, 0.0E0, -0.6E0, 0.0E0,
113 + 0.0E0, 1.0E0, 0.0E0/
114 * .. Executable Statements ..
116 * Compute true values which cannot be prestored
117 * in decimal notation
119 DBTRUE(1) = 1.0E0/0.6E0
120 DBTRUE(3) = -1.0E0/0.6E0
121 DBTRUE(5) = 1.0E0/0.6E0
124 * .. Set N=K for identification in output if any ..
131 CALL SROTGTEST(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 ..
149 * .. Scalars in Common ..
150 INTEGER ICASE, INCX, INCY, MODE, N
152 * .. Local Scalars ..
155 REAL 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 REAL SASUMTEST, SNRM2TEST
161 EXTERNAL SASUMTEST, SNRM2TEST, ISAMAXTEST
162 * .. External Subroutines ..
163 EXTERNAL ITEST1, SSCALTEST, STEST, STEST1
164 * .. Intrinsic Functions ..
166 * .. Common blocks ..
167 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
168 * .. Data statements ..
169 DATA SA/0.3E0, -1.0E0, 0.0E0, 1.0E0, 0.3E0, 0.3E0,
170 + 0.3E0, 0.3E0, 0.3E0, 0.3E0/
171 DATA DV/0.1E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
172 + 2.0E0, 2.0E0, 0.3E0, 3.0E0, 3.0E0, 3.0E0, 3.0E0,
173 + 3.0E0, 3.0E0, 3.0E0, 0.3E0, -0.4E0, 4.0E0,
174 + 4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0, 0.2E0,
175 + -0.6E0, 0.3E0, 5.0E0, 5.0E0, 5.0E0, 5.0E0,
176 + 5.0E0, 0.1E0, -0.3E0, 0.5E0, -0.1E0, 6.0E0,
177 + 6.0E0, 6.0E0, 6.0E0, 0.1E0, 8.0E0, 8.0E0, 8.0E0,
178 + 8.0E0, 8.0E0, 8.0E0, 8.0E0, 0.3E0, 9.0E0, 9.0E0,
179 + 9.0E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0, 0.3E0, 2.0E0,
180 + -0.4E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
181 + 0.2E0, 3.0E0, -0.6E0, 5.0E0, 0.3E0, 2.0E0,
182 + 2.0E0, 2.0E0, 0.1E0, 4.0E0, -0.3E0, 6.0E0,
183 + -0.5E0, 7.0E0, -0.1E0, 3.0E0/
184 DATA DTRUE1/0.0E0, 0.3E0, 0.5E0, 0.7E0, 0.6E0/
185 DATA DTRUE3/0.0E0, 0.3E0, 0.7E0, 1.1E0, 1.0E0/
186 DATA DTRUE5/0.10E0, 2.0E0, 2.0E0, 2.0E0, 2.0E0,
187 + 2.0E0, 2.0E0, 2.0E0, -0.3E0, 3.0E0, 3.0E0,
188 + 3.0E0, 3.0E0, 3.0E0, 3.0E0, 3.0E0, 0.0E0, 0.0E0,
189 + 4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0,
190 + 0.20E0, -0.60E0, 0.30E0, 5.0E0, 5.0E0, 5.0E0,
191 + 5.0E0, 5.0E0, 0.03E0, -0.09E0, 0.15E0, -0.03E0,
192 + 6.0E0, 6.0E0, 6.0E0, 6.0E0, 0.10E0, 8.0E0,
193 + 8.0E0, 8.0E0, 8.0E0, 8.0E0, 8.0E0, 8.0E0,
194 + 0.09E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0, 9.0E0,
195 + 9.0E0, 9.0E0, 0.09E0, 2.0E0, -0.12E0, 2.0E0,
196 + 2.0E0, 2.0E0, 2.0E0, 2.0E0, 0.06E0, 3.0E0,
197 + -0.18E0, 5.0E0, 0.09E0, 2.0E0, 2.0E0, 2.0E0,
198 + 0.03E0, 4.0E0, -0.09E0, 6.0E0, -0.15E0, 7.0E0,
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(SNRM2TEST(N,SX,INCX),STEMP,STEMP,SFAC)
215 ELSE IF (ICASE.EQ.8) THEN
217 STEMP(1) = DTRUE3(NP1)
218 CALL STEST1(SASUMTEST(N,SX,INCX),STEMP,STEMP,SFAC)
219 ELSE IF (ICASE.EQ.9) THEN
221 CALL SSCALTEST(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(ISAMAXTEST(N,SX,INCX),ITRUE2(NP1))
230 WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
237 SUBROUTINE CHECK2(SFAC)
241 * .. Scalar Arguments ..
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 REAL 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 ..
258 * .. External Subroutines ..
259 EXTERNAL SAXPYTEST, SCOPYTEST, SSWAPTEST, 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.6E0, 0.1E0, -0.5E0, 0.8E0, 0.9E0, -0.3E0,
272 DATA DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
274 DATA DT7/0.0E0, 0.30E0, 0.21E0, 0.62E0, 0.0E0,
275 + 0.30E0, -0.07E0, 0.85E0, 0.0E0, 0.30E0, -0.79E0,
276 + -0.74E0, 0.0E0, 0.30E0, 0.33E0, 1.27E0/
277 DATA DT8/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
278 + 0.0E0, 0.68E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
279 + 0.0E0, 0.0E0, 0.68E0, -0.87E0, 0.0E0, 0.0E0,
280 + 0.0E0, 0.0E0, 0.0E0, 0.68E0, -0.87E0, 0.15E0,
281 + 0.94E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
282 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.68E0,
283 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
284 + 0.35E0, -0.9E0, 0.48E0, 0.0E0, 0.0E0, 0.0E0,
285 + 0.0E0, 0.38E0, -0.9E0, 0.57E0, 0.7E0, -0.75E0,
286 + 0.2E0, 0.98E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0,
287 + 0.0E0, 0.0E0, 0.0E0, 0.68E0, 0.0E0, 0.0E0,
288 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.35E0, -0.72E0,
289 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.38E0,
290 + -0.63E0, 0.15E0, 0.88E0, 0.0E0, 0.0E0, 0.0E0,
291 + 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
292 + 0.68E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
293 + 0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.0E0, 0.0E0,
294 + 0.0E0, 0.0E0, 0.68E0, -0.9E0, 0.33E0, 0.7E0,
295 + -0.75E0, 0.2E0, 1.04E0/
296 DATA DT10X/0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
297 + 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
298 + 0.0E0, 0.5E0, -0.9E0, 0.0E0, 0.0E0, 0.0E0,
299 + 0.0E0, 0.0E0, 0.5E0, -0.9E0, 0.3E0, 0.7E0,
300 + 0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0,
301 + 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0,
302 + 0.0E0, 0.0E0, 0.0E0, 0.3E0, 0.1E0, 0.5E0, 0.0E0,
303 + 0.0E0, 0.0E0, 0.0E0, 0.8E0, 0.1E0, -0.6E0,
304 + 0.8E0, 0.3E0, -0.3E0, 0.5E0, 0.6E0, 0.0E0,
305 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
306 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.9E0,
307 + 0.1E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.7E0,
308 + 0.1E0, 0.3E0, 0.8E0, -0.9E0, -0.3E0, 0.5E0,
309 + 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
310 + 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
311 + 0.5E0, 0.3E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
312 + 0.5E0, 0.3E0, -0.6E0, 0.8E0, 0.0E0, 0.0E0,
314 DATA DT10Y/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
315 + 0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
316 + 0.0E0, 0.6E0, 0.1E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
317 + 0.0E0, 0.6E0, 0.1E0, -0.5E0, 0.8E0, 0.0E0,
318 + 0.0E0, 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
319 + 0.0E0, 0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
320 + 0.0E0, 0.0E0, -0.5E0, -0.9E0, 0.6E0, 0.0E0,
321 + 0.0E0, 0.0E0, 0.0E0, -0.4E0, -0.9E0, 0.9E0,
322 + 0.7E0, -0.5E0, 0.2E0, 0.6E0, 0.5E0, 0.0E0,
323 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0,
324 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.5E0,
325 + 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
326 + -0.4E0, 0.9E0, -0.5E0, 0.6E0, 0.0E0, 0.0E0,
327 + 0.0E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
328 + 0.0E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
329 + 0.0E0, 0.6E0, -0.9E0, 0.1E0, 0.0E0, 0.0E0,
330 + 0.0E0, 0.0E0, 0.6E0, -0.9E0, 0.1E0, 0.7E0,
331 + -0.5E0, 0.2E0, 0.8E0/
332 DATA SSIZE1/0.0E0, 0.3E0, 1.6E0, 3.2E0/
333 DATA SSIZE2/0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
334 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
335 + 0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
336 + 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
337 + 1.17E0, 1.17E0, 1.17E0/
338 * .. Executable Statements ..
351 * .. Initialize all argument arrays ..
359 CALL STEST1(SDOTTEST(N,SX,INCX,SY,INCY),DT7(KN,KI),
361 ELSE IF (ICASE.EQ.2) THEN
363 CALL SAXPYTEST(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 SCOPYTEST(N,SX,INCX,SY,INCY)
374 CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0)
375 ELSE IF (ICASE.EQ.6) THEN
377 CALL SSWAPTEST(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.0E0)
383 CALL STEST(LENY,SY,STY,SSIZE2(1,1),1.0E0)
385 WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
392 SUBROUTINE CHECK3(SFAC)
396 * .. Scalar Arguments ..
398 * .. Scalars in Common ..
399 INTEGER ICASE, INCX, INCY, MODE, N
401 * .. Local Scalars ..
403 INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
405 REAL 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 SROTTEST, STEST
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.6E0, 0.1E0, -0.5E0, 0.8E0, 0.9E0, -0.3E0,
425 DATA DY1/0.5E0, -0.9E0, 0.3E0, 0.7E0, -0.6E0, 0.2E0,
427 DATA SC, SS/0.8E0, 0.6E0/
428 DATA DT9X/0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
429 + 0.0E0, 0.78E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
430 + 0.0E0, 0.0E0, 0.78E0, -0.46E0, 0.0E0, 0.0E0,
431 + 0.0E0, 0.0E0, 0.0E0, 0.78E0, -0.46E0, -0.22E0,
432 + 1.06E0, 0.0E0, 0.0E0, 0.0E0, 0.6E0, 0.0E0,
433 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.78E0,
434 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
435 + 0.66E0, 0.1E0, -0.1E0, 0.0E0, 0.0E0, 0.0E0,
436 + 0.0E0, 0.96E0, 0.1E0, -0.76E0, 0.8E0, 0.90E0,
437 + -0.3E0, -0.02E0, 0.6E0, 0.0E0, 0.0E0, 0.0E0,
438 + 0.0E0, 0.0E0, 0.0E0, 0.78E0, 0.0E0, 0.0E0,
439 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, -0.06E0, 0.1E0,
440 + -0.1E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.90E0,
441 + 0.1E0, -0.22E0, 0.8E0, 0.18E0, -0.3E0, -0.02E0,
442 + 0.6E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
443 + 0.78E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
444 + 0.0E0, 0.78E0, 0.26E0, 0.0E0, 0.0E0, 0.0E0,
445 + 0.0E0, 0.0E0, 0.78E0, 0.26E0, -0.76E0, 1.12E0,
446 + 0.0E0, 0.0E0, 0.0E0/
447 DATA DT9Y/0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
448 + 0.0E0, 0.04E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
449 + 0.0E0, 0.0E0, 0.04E0, -0.78E0, 0.0E0, 0.0E0,
450 + 0.0E0, 0.0E0, 0.0E0, 0.04E0, -0.78E0, 0.54E0,
451 + 0.08E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0, 0.0E0,
452 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.04E0,
453 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.7E0,
454 + -0.9E0, -0.12E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
455 + 0.64E0, -0.9E0, -0.30E0, 0.7E0, -0.18E0, 0.2E0,
456 + 0.28E0, 0.5E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
457 + 0.0E0, 0.0E0, 0.04E0, 0.0E0, 0.0E0, 0.0E0,
458 + 0.0E0, 0.0E0, 0.0E0, 0.7E0, -1.08E0, 0.0E0,
459 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.64E0, -1.26E0,
460 + 0.54E0, 0.20E0, 0.0E0, 0.0E0, 0.0E0, 0.5E0,
461 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
462 + 0.04E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
463 + 0.0E0, 0.04E0, -0.9E0, 0.18E0, 0.0E0, 0.0E0,
464 + 0.0E0, 0.0E0, 0.04E0, -0.9E0, 0.18E0, 0.7E0,
465 + -0.18E0, 0.2E0, 0.16E0/
466 DATA SSIZE2/0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
467 + 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,
468 + 0.0E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
469 + 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0, 1.17E0,
470 + 1.17E0, 1.17E0, 1.17E0/
471 * .. Executable Statements ..
490 STX(I) = DT9X(I,KN,KI)
491 STY(I) = DT9Y(I,KN,KI)
493 CALL SROTTEST(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 SROTTEST(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 ..
613 * .. Array Arguments ..
614 REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
615 * .. Scalars in Common ..
616 INTEGER ICASE, INCX, INCY, MODE, N
618 * .. Local Scalars ..
621 * .. External Functions ..
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.0E0)
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,2E36.8,2E12.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 REAL SCOMP1, SFAC, STRUE1
664 * .. Array Arguments ..
667 REAL SCOMP(1), STRUE(1)
668 * .. External Subroutines ..
670 * .. Executable Statements ..
674 CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
678 REAL FUNCTION SDIFF(SA,SB)
679 * ********************************* SDIFF **************************
680 * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15
682 * .. Scalar Arguments ..
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)