397 DOUBLE PRECISION sfac
399 INTEGER icase, incx, incy, mode, n
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)
413 EXTERNAL stest,drottest
417 COMMON /combla/icase, n, incx, incy, mode, pass
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/
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)
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)