source: LMDZ5/branches/testing/libf/phylmd/rrtm/set99.F @ 3078

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

Merged trunk changes r1920:1997 into testing branch
  • 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)
4C
5C     SUBROUTINE 'SET99' - COMPUTES FACTORS OF N & TRIGONOMETRIC
6C     FUNCTIONS REQUIRED BY FFT99 & FFT991
7C
8      SAVE NLFAX
9C
10      DATA NLFAX/6,8,5,4,3,2,1/
11C
12      IXXX=1
13C
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
22C
23C     FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED)
24C     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
45C
46      WRITE(6,40) N
47   40 FORMAT(4H1N =,I4,27H - CONTAINS ILLEGAL FACTORS)
48      RETURN
49C
50C     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.