733 DOUBLE PRECISION SFAC
735 INTEGER ICASE, INCX, INCY, N
738 DOUBLE PRECISION SC, SS
739 INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
741 DOUBLE PRECISION COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
742 + DX1(7), DY1(7), MWPC(11), MWPS(11), MWPSTX(5),
743 + MWPSTY(5), MWPTX(11,5), MWPTY(11,5), MWPX(5),
744 + MWPY(5), SSIZE2(14,2), STX(7), STY(7), SX(7),
746 INTEGER INCXS(4), INCYS(4), LENS(4,2), MWPINX(11),
747 + MWPINY(11), MWPN(11), NS(4)
753 COMMON /combla/icase, n, incx, incy, pass
755 DATA incxs/1, 2, -2, -1/
756 DATA incys/1, -2, 1, -2/
757 DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
759 DATA dx1/0.6d0, 0.1d0, -0.5d0, 0.8d0, 0.9d0, -0.3d0,
761 DATA dy1/0.5d0, -0.9d0, 0.3d0, 0.7d0, -0.6d0, 0.2d0,
763 DATA sc, ss/0.8d0, 0.6d0/
764 DATA dt9x/0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
765 + 0.0d0, 0.78d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
766 + 0.0d0, 0.0d0, 0.78d0, -0.46d0, 0.0d0, 0.0d0,
767 + 0.0d0, 0.0d0, 0.0d0, 0.78d0, -0.46d0, -0.22d0,
768 + 1.06d0, 0.0d0, 0.0d0, 0.0d0, 0.6d0, 0.0d0,
769 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.78d0,
770 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
771 + 0.66d0, 0.1d0, -0.1d0, 0.0d0, 0.0d0, 0.0d0,
772 + 0.0d0, 0.96d0, 0.1d0, -0.76d0, 0.8d0, 0.90d0,
773 + -0.3d0, -0.02d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0,
774 + 0.0d0, 0.0d0, 0.0d0, 0.78d0, 0.0d0, 0.0d0,
775 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, -0.06d0, 0.1d0,
776 + -0.1d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.90d0,
777 + 0.1d0, -0.22d0, 0.8d0, 0.18d0, -0.3d0, -0.02d0,
778 + 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
779 + 0.78d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
780 + 0.0d0, 0.78d0, 0.26d0, 0.0d0, 0.0d0, 0.0d0,
781 + 0.0d0, 0.0d0, 0.78d0, 0.26d0, -0.76d0, 1.12d0,
782 + 0.0d0, 0.0d0, 0.0d0/
783 DATA dt9y/0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
784 + 0.0d0, 0.04d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
785 + 0.0d0, 0.0d0, 0.04d0, -0.78d0, 0.0d0, 0.0d0,
786 + 0.0d0, 0.0d0, 0.0d0, 0.04d0, -0.78d0, 0.54d0,
787 + 0.08d0, 0.0d0, 0.0d0, 0.0d0, 0.5d0, 0.0d0,
788 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.04d0,
789 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.7d0,
790 + -0.9d0, -0.12d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
791 + 0.64d0, -0.9d0, -0.30d0, 0.7d0, -0.18d0, 0.2d0,
792 + 0.28d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
793 + 0.0d0, 0.0d0, 0.04d0, 0.0d0, 0.0d0, 0.0d0,
794 + 0.0d0, 0.0d0, 0.0d0, 0.7d0, -1.08d0, 0.0d0,
795 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.64d0, -1.26d0,
796 + 0.54d0, 0.20d0, 0.0d0, 0.0d0, 0.0d0, 0.5d0,
797 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
798 + 0.04d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
799 + 0.0d0, 0.04d0, -0.9d0, 0.18d0, 0.0d0, 0.0d0,
800 + 0.0d0, 0.0d0, 0.04d0, -0.9d0, 0.18d0, 0.7d0,
801 + -0.18d0, 0.2d0, 0.16d0/
802 DATA ssize2/0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
803 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
804 + 0.0d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0,
805 + 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0,
806 + 1.17d0, 1.17d0, 1.17d0/
826 stx(i) = dt9x(i,kn,ki)
827 sty(i) = dt9y(i,kn,ki)
829 CALL drot(n,sx,incx,sy,incy,sc,ss)
830 CALL stest(lenx,sx,stx,ssize2(1,ksize),sfac)
831 CALL stest(leny,sy,sty,ssize2(1,ksize),sfac)
833 WRITE (nout,*)
' Shouldn''t be here in CHECK3'
925 mwpstx(k) = mwptx(i,k)
926 mwpsty(k) = mwpty(i,k)
928 CALL drot(mwpn(i),copyx,incx,copyy,incy,mwpc(i),mwps(i))
929 CALL stest(5,copyx,mwpstx,mwpstx,sfac)
930 CALL stest(5,copyy,mwpsty,mwpsty,sfac)
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
subroutine drot(N, DX, INCX, DY, INCY, C, S)
DROT