set99.F Source File


Contents

Source Code


Source Code

      SUBROUTINE SET99(TRIGS,IFAX,N)
      REAL             TRIGS(N)
      INTEGER IFAX(*),JFAX(10),NLFAX(7)
      INTEGER N, NU, IFAC, IL, IXXX, K, NIL, NHL, I, NFAX
      REAL ANGLE, DEL
C
C     SUBROUTINE 'SET99' - COMPUTES FACTORS OF N & TRIGONOMETRIC
C     FUNCTIONS REQUIRED BY FFT99 & FFT991
C
      SAVE NLFAX
C
      DATA NLFAX/6,8,5,4,3,2,1/
C
      IXXX=1
C
      DEL=4.0E0*ASIN(1.0E0)/FLOAT(N)
      NIL=0
      NHL=(N/2)-1
      DO 10 K=NIL,NHL
      ANGLE=FLOAT(K)*DEL
      TRIGS(2*K+1)=COS(ANGLE)
      TRIGS(2*K+2)=SIN(ANGLE)
   10 CONTINUE
C
C     FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED)
C     LOOK FOR SIXES FIRST, STORE FACTORS IN DESCENDING ORDER
      NU=N
      IFAC=6
      K=0
      IL=1
   20 CONTINUE
      IF (MOD(NU,IFAC).NE.0) GO TO 30
      K=K+1
      JFAX(K)=IFAC
      IF (IFAC.NE.8) GO TO 25
      IF (K.EQ.1) GO TO 25
      JFAX(1)=8
      JFAX(K)=6
   25 CONTINUE
      NU=NU/IFAC
      IF (NU.EQ.1) GO TO 50
      IF (IFAC.NE.8) GO TO 20
   30 CONTINUE
      IL=IL+1
      IFAC=NLFAX(IL)
      IF (IFAC.GT.1) GO TO 20
C
      WRITE(6,40) N
   40 FORMAT(4H1N =,I4,27H - CONTAINS ILLEGAL FACTORS)
      RETURN
C
C     NOW REVERSE ORDER OF FACTORS
   50 CONTINUE
      NFAX=K
      IFAX(1)=NFAX
      DO 60 I=1,NFAX
      IFAX(NFAX+2-I)=JFAX(I)
   60 CONTINUE
      IFAX(10)=N
      RETURN
      END SUBROUTINE SET99