************************************************************************ SUBROUTINE FTZLPR(N,IT,T) IMPLICIT REAL (A-H,O-Z) DIMENSION IT(5),T(0:N-1,2) DATA PI/3.1415926535897932385D0/ J=N DO 20 I=5,2,-1 IT(I)=0 10 CONTINUE K=MOD(J,I) IF(K.EQ.0) THEN IT(I)=IT(I)+1 J=J/I GO TO 10 END IF 20 CONTINUE IF(J.NE.1) THEN WRITE(6,*) '***ERROR*** N.NE.(2**P)*(3**Q)*(5**R)' STOP END IF IS=IT(2)+IT(3)+IT(4)+IT(5) IT(1)=MOD(IS,2) DO 30 I=0,N-1 T(I,1)=COS(2*PI*I/N) T(I,2)=SIN(2*PI*I/N) 30 CONTINUE END ************************************************************************ SUBROUTINE FTZLMN(X,Y,M,N,IT,T) IMPLICIT REAL (A-H,O-Z) DIMENSION IT(5),T(0:N-1,2) DIMENSION X(M*N,2),Y(M*N,2) JP=N JR=1 K=1 DO 10 I=1,IT(1) IF(K.EQ. 1) CALL FTZLP1(X(1,1),X(1,2),Y(1,1),Y(1,2),M,N) IF(K.EQ.-1) CALL FTZLP1(Y(1,1),Y(1,2),X(1,1),X(1,2),M,N) K=-K 10 CONTINUE DO 20 I=1,IT(2) IF(K.EQ. 1) CALL FTZLP2(X(1,1),X(1,2),Y(1,1),Y(1,2),M,N,T,JP,JR) IF(K.EQ.-1) CALL FTZLP2(Y(1,1),Y(1,2),X(1,1),X(1,2),M,N,T,JP,JR) K=-K 20 CONTINUE DO 30 I=1,IT(3) IF(K.EQ. 1) CALL FTZLP3(X(1,1),X(1,2),Y(1,1),Y(1,2),M,N,T,JP,JR) IF(K.EQ.-1) CALL FTZLP3(Y(1,1),Y(1,2),X(1,1),X(1,2),M,N,T,JP,JR) K=-K 30 CONTINUE DO 40 I=1,IT(4) IF(K.EQ. 1) CALL FTZLP4(X(1,1),X(1,2),Y(1,1),Y(1,2),M,N,T,JP,JR) IF(K.EQ.-1) CALL FTZLP4(Y(1,1),Y(1,2),X(1,1),X(1,2),M,N,T,JP,JR) K=-K 40 CONTINUE DO 50 I=1,IT(5) IF(K.EQ. 1) CALL FTZLP5(X(1,1),X(1,2),Y(1,1),Y(1,2),M,N,T,JP,JR) IF(K.EQ.-1) CALL FTZLP5(Y(1,1),Y(1,2),X(1,1),X(1,2),M,N,T,JP,JR) K=-K 50 CONTINUE END ************************************************************************ SUBROUTINE FTZLP1(A,B,C,D,M,N) IMPLICIT REAL (A-H,O-Z) DIMENSION A(*),B(*),C(*),D(*) DO 10 I=1,N*M C(I)=A(I) D(I)=B(I) 10 CONTINUE END ************************************************************************ SUBROUTINE FTZLP2(A,B,C,D,M,N,T,JP,JR) IMPLICIT REAL (A-H,O-Z) DIMENSION T(0:N-1,2) DIMENSION A(*),B(*),C(*),D(*) NM=N*M JQ=2 JMPR=NM/JQ JP=JP/JQ JMR=JR*M JMQR=JMR*JQ IPR=0 IMPR=0 IMPQR=0 DO 20 IP=0,JP-1 K1=IPR C1=T(K1,1) S1=T(K1,2) IA=IMPR JA=IMPQR IB=IA+JMPR JB=JA+JMR *VOCL LOOP,NOVREC(C,D) DO 10 I=1,JMR C(JA+I)=A(IA+I)+A(IB+I) D(JA+I)=B(IA+I)+B(IB+I) C(JB+I)=C1*(A(IA+I)-A(IB+I))-S1*(B(IA+I)-B(IB+I)) D(JB+I)=S1*(A(IA+I)-A(IB+I))+C1*(B(IA+I)-B(IB+I)) 10 CONTINUE IPR=IPR+JR IMPR=IMPR+JMR IMPQR=IMPQR+JMQR 20 CONTINUE JR=JR*JQ END ************************************************************************ SUBROUTINE FTZLP3(A,B,C,D,M,N,T,JP,JR) IMPLICIT REAL (A-H,O-Z) DIMENSION T(0:N-1,2) DIMENSION A(*),B(*),C(*),D(*) DATA SIN60/0.86602540378443864676D0/, & COS60/0.5D0/ NM=N*M JQ=3 JMPR=NM/JQ JP=JP/JQ JMR=JR*M JMQR=JMR*JQ IPR=0 IMPR=0 IMPQR=0 DO 20 IP=0,JP-1 K1=IPR K2=K1+IPR C1=T(K1,1) S1=T(K1,2) C2=T(K2,1) S2=T(K2,2) IA=IMPR JA=IMPQR IB=IA+JMPR JB=JA+JMR IC=IB+JMPR JC=JB+JMR *VOCL LOOP,NOVREC(C,D) DO 10 I=1,JMR C(JA+I)=A(IA+I)+(A(IB+I)+A(IC+I)) D(JA+I)=B(IA+I)+(B(IB+I)+B(IC+I)) C(JB+I)= & C1*((A(IA+I)-COS60*(A(IB+I)+A(IC+I)))-(SIN60*(B(IB+I)-B(IC+I)))) & -S1*((B(IA+I)-COS60*(B(IB+I)+B(IC+I)))+(SIN60*(A(IB+I)-A(IC+I)))) D(JB+I)= & S1*((A(IA+I)-COS60*(A(IB+I)+A(IC+I)))-(SIN60*(B(IB+I)-B(IC+I)))) & +C1*((B(IA+I)-COS60*(B(IB+I)+B(IC+I)))+(SIN60*(A(IB+I)-A(IC+I)))) C(JC+I)= & C2*((A(IA+I)-COS60*(A(IB+I)+A(IC+I)))+(SIN60*(B(IB+I)-B(IC+I)))) & -S2*((B(IA+I)-COS60*(B(IB+I)+B(IC+I)))-(SIN60*(A(IB+I)-A(IC+I)))) D(JC+I)= & S2*((A(IA+I)-COS60*(A(IB+I)+A(IC+I)))+(SIN60*(B(IB+I)-B(IC+I)))) & +C2*((B(IA+I)-COS60*(B(IB+I)+B(IC+I)))-(SIN60*(A(IB+I)-A(IC+I)))) 10 CONTINUE IPR=IPR+JR IMPR=IMPR+JMR IMPQR=IMPQR+JMQR 20 CONTINUE JR=JR*JQ END ************************************************************************ SUBROUTINE FTZLP4(A,B,C,D,M,N,T,JP,JR) IMPLICIT REAL (A-H,O-Z) DIMENSION T(0:N-1,2) DIMENSION A(*),B(*),C(*),D(*) NM=N*M JQ=4 JMPR=NM/JQ JP=JP/JQ JMR=JR*M JMQR=JMR*JQ IPR=0 IMPR=0 IMPQR=0 DO 20 IP=0,JP-1 K1=IPR K2=K1+IPR K3=K2+IPR C1=T(K1,1) S1=T(K1,2) C2=T(K2,1) S2=T(K2,2) C3=T(K3,1) S3=T(K3,2) IA=IMPR JA=IMPQR IB=IA+JMPR JB=JA+JMR IC=IB+JMPR JC=JB+JMR ID=IC+JMPR JD=JC+JMR *VOCL LOOP,NOVREC(C,D) DO 10 I=1,JMR C(JA+I)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) D(JA+I)=(B(IA+I)+B(IC+I))+(B(IB+I)+B(ID+I)) C(JC+I)= & C2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) & -S2*((B(IA+I)+B(IC+I))-(B(IB+I)+B(ID+I))) D(JC+I)= & S2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) & +C2*((B(IA+I)+B(IC+I))-(B(IB+I)+B(ID+I))) C(JB+I)= & C1*((A(IA+I)-A(IC+I))-(B(IB+I)-B(ID+I))) & -S1*((B(IA+I)-B(IC+I))+(A(IB+I)-A(ID+I))) D(JB+I)= & S1*((A(IA+I)-A(IC+I))-(B(IB+I)-B(ID+I))) & +C1*((B(IA+I)-B(IC+I))+(A(IB+I)-A(ID+I))) C(JD+I)= & C3*((A(IA+I)-A(IC+I))+(B(IB+I)-B(ID+I))) & -S3*((B(IA+I)-B(IC+I))-(A(IB+I)-A(ID+I))) D(JD+I)= & S3*((A(IA+I)-A(IC+I))+(B(IB+I)-B(ID+I))) & +C3*((B(IA+I)-B(IC+I))-(A(IB+I)-A(ID+I))) 10 CONTINUE IPR=IPR+JR IMPR=IMPR+JMR IMPQR=IMPQR+JMQR 20 CONTINUE JR=JR*JQ END ************************************************************************ SUBROUTINE FTZLP5(A,B,C,D,M,N,T,JP,JR) IMPLICIT REAL (A-H,O-Z) DIMENSION T(0:N-1,2) DIMENSION A(*),B(*),C(*),D(*) DATA SIN36/0.58778525229247312917D0/, & COS36/0.80901699437494742410D0/, & SIN72/0.95105651629515357212D0/, & COS72/0.30901699437494742410D0/ NM=N*M JQ=5 JMPR=NM/JQ JP=JP/JQ JMR=JR*M JMQR=JMR*JQ IPR=0 IMPR=0 IMPQR=0 DO 20 IP=0,JP-1 K1=IPR K2=K1+IPR K3=K2+IPR K4=K3+IPR C1=T(K1,1) S1=T(K1,2) C2=T(K2,1) S2=T(K2,2) C3=T(K3,1) S3=T(K3,2) C4=T(K4,1) S4=T(K4,2) IA=IMPR JA=IMPQR IB=IA+JMPR JB=JA+JMR IC=IB+JMPR JC=JB+JMR ID=IC+JMPR JD=JC+JMR IE=ID+JMPR JE=JD+JMR *VOCL LOOP,NOVREC(C,D) DO 10 I=1,JMR C(JA+I)=A(IA+I)+(A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)) D(JA+I)=B(IA+I)+(B(IB+I)+B(IE+I))+(B(IC+I)+B(ID+I)) C(JB+I)= & C1*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) & -(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) & -S1*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) & +(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) D(JB+I)= & S1*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) & -(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) & +C1*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) & +(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) C(JC+I)= & C2*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) & -(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) & -S2*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) & +(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) D(JC+I)= & S2*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) & -(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) & +C2*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) & +(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) C(JD+I)= & C3*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) & +(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) & -S3*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) & -(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) D(JD+I)= & S3*((A(IA+I)-COS36*(A(IB+I)+A(IE+I))+COS72*(A(IC+I)+A(ID+I))) & +(SIN36*(B(IB+I)-B(IE+I))-SIN72*(B(IC+I)-B(ID+I)))) & +C3*((B(IA+I)-COS36*(B(IB+I)+B(IE+I))+COS72*(B(IC+I)+B(ID+I))) & -(SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)))) C(JE+I)= & C4*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) & +(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) & -S4*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) & -(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) D(JE+I)= & S4*((A(IA+I)+COS72*(A(IB+I)+A(IE+I))-COS36*(A(IC+I)+A(ID+I))) & +(SIN72*(B(IB+I)-B(IE+I))+SIN36*(B(IC+I)-B(ID+I)))) & +C4*((B(IA+I)+COS72*(B(IB+I)+B(IE+I))-COS36*(B(IC+I)+B(ID+I))) & -(SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)))) 10 CONTINUE IPR=IPR+JR IMPR=IMPR+JMR IMPQR=IMPQR+JMQR 20 CONTINUE JR=JR*JQ END