Context Navigation

set99.F @ 4249

Last change on this file since 4249 was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM

Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

File size: 1.2 KB

Line
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

Note: See TracBrowser for help on using the repository browser.