1 |
|
|
SUBROUTINE SET99(TRIGS,IFAX,N) |
2 |
|
|
REAL TRIGS(N) |
3 |
|
|
INTEGER IFAX(*),JFAX(10),NLFAX(7) |
4 |
|
|
C |
5 |
|
|
C SUBROUTINE 'SET99' - COMPUTES FACTORS OF N & TRIGONOMETRIC |
6 |
|
|
C FUNCTIONS REQUIRED BY FFT99 & FFT991 |
7 |
|
|
C |
8 |
|
|
SAVE NLFAX |
9 |
|
|
C |
10 |
|
|
DATA NLFAX/6,8,5,4,3,2,1/ |
11 |
|
|
C |
12 |
|
|
IXXX=1 |
13 |
|
|
C |
14 |
|
|
DEL=4.0E0*ASIN(1.0E0)/FLOAT(N) |
15 |
|
|
NIL=0 |
16 |
|
|
NHL=(N/2)-1 |
17 |
|
|
DO 10 K=NIL,NHL |
18 |
|
|
ANGLE=FLOAT(K)*DEL |
19 |
|
|
TRIGS(2*K+1)=COS(ANGLE) |
20 |
|
|
TRIGS(2*K+2)=SIN(ANGLE) |
21 |
|
|
10 CONTINUE |
22 |
|
|
C |
23 |
|
|
C FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED) |
24 |
|
|
C LOOK FOR SIXES FIRST, STORE FACTORS IN DESCENDING ORDER |
25 |
|
|
NU=N |
26 |
|
|
IFAC=6 |
27 |
|
|
K=0 |
28 |
|
|
IL=1 |
29 |
|
|
20 CONTINUE |
30 |
|
|
IF (MOD(NU,IFAC).NE.0) GO TO 30 |
31 |
|
|
K=K+1 |
32 |
|
|
JFAX(K)=IFAC |
33 |
|
|
IF (IFAC.NE.8) GO TO 25 |
34 |
|
|
IF (K.EQ.1) GO TO 25 |
35 |
|
|
JFAX(1)=8 |
36 |
|
|
JFAX(K)=6 |
37 |
|
|
25 CONTINUE |
38 |
|
|
NU=NU/IFAC |
39 |
|
|
IF (NU.EQ.1) GO TO 50 |
40 |
|
|
IF (IFAC.NE.8) GO TO 20 |
41 |
|
|
30 CONTINUE |
42 |
|
|
IL=IL+1 |
43 |
|
|
IFAC=NLFAX(IL) |
44 |
|
|
IF (IFAC.GT.1) GO TO 20 |
45 |
|
|
C |
46 |
|
|
WRITE(6,40) N |
47 |
|
|
40 FORMAT(4H1N =,I4,27H - CONTAINS ILLEGAL FACTORS) |
48 |
|
|
RETURN |
49 |
|
|
C |
50 |
|
|
C NOW REVERSE ORDER OF FACTORS |
51 |
|
|
50 CONTINUE |
52 |
|
|
NFAX=K |
53 |
|
|
IFAX(1)=NFAX |
54 |
|
|
DO 60 I=1,NFAX |
55 |
|
|
IFAX(NFAX+2-I)=JFAX(I) |
56 |
|
|
60 CONTINUE |
57 |
|
|
IFAX(10)=N |
58 |
|
|
RETURN |
59 |
|
|
END |