278
279 INTEGER NOUT
280 parameter(nout=6)
281
282 REAL SFAC
283
284 INTEGER ICASE, INCX, INCY, MODE, N
285 LOGICAL PASS
286
287 COMPLEX CA,CTEMP
288 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
289
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
295 EXTERNAL cdotctest, cdotutest
296
297 EXTERNAL caxpytest, ccopytest, cswaptest,
ctest
298
299 INTRINSIC abs, min
300
301 COMMON /combla/icase, n, incx, incy, mode, pass
302
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
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
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
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
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
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
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
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
subroutine ctest(LEN, CCOMP, CTRUE, CSIZE, SFAC)