1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
C Copyright 1981-2007 ECMWF
C
C Licensed under the GNU Lesser General Public License which
C incorporates the terms and conditions of version 3 of the GNU
C General Public License.
C See LICENSE and gpl-3.0.txt for details.
C
SUBROUTINE SET99(TRIGS,IFAX,N)
DIMENSION TRIGS(N),IFAX(10),JFAX(10),LFAX(7)
C---->
C
C SUBROUTINE 'SET99' - COMPUTES FACTORS OF N & TRIGONOMETRIC
C FUNCTIONS REQUIRED BY FFT99 & FFT991
C
C----<
#include "jparams.h"
C
DATA LFAX/6,8,5,4,3,2,1/
IXXX=1
C
DEL= (2.0*PPI)/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
L=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
L=L+1
IFAC=LFAX(L)
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
|
