************************************************************************
      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
