Last change
on this file since 4799 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
|
-
Property copyright set to
Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory
|
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.