source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/mrfti1.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 2.2 KB
Line 
1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: mrfti1.f,v 1.2 2004/06/15 21:29:20 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE MRFTI1 (N,WA,FAC)
12      REAL       WA(N)      ,FAC(15)
13      INTEGER    NTRYH(4)
14      DOUBLE PRECISION TPI,ARGH,ARGLD,ARG
15      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
16!                                                                       
17      NL = N
18      NF = 0
19      J = 0
20  101 J = J+1
21      IF (J-4) 102,102,103
22  102 NTRY = NTRYH(J)
23      GO TO 104
24  103 NTRY = NTRY+2
25  104 NQ = NL/NTRY
26      NR = NL-NTRY*NQ
27      IF (NR) 101,105,101
28  105 NF = NF+1
29      FAC(NF+2) = NTRY
30      NL = NQ
31      IF (NTRY .NE. 2) GO TO 107
32      IF (NF .EQ. 1) GO TO 107
33      DO 106 I=2,NF
34         IB = NF-I+2
35         FAC(IB+2) = FAC(IB+1)
36  106 END DO
37      FAC(3) = 2
38  107 IF (NL .NE. 1) GO TO 104
39      FAC(1) = N
40      FAC(2) = NF
41      TPI = 8.D0*DATAN(1.D0)
42      ARGH = TPI/FLOAT(N)
43      IS = 0
44      NFM1 = NF-1
45      L1 = 1
46      IF (NFM1 .EQ. 0) RETURN
47      DO 110 K1=1,NFM1
48         IP = FAC(K1+2)
49         LD = 0
50         L2 = L1*IP
51         IDO = N/L2
52         IPM = IP-1
53         DO 109 J=1,IPM
54            LD = LD+L1
55            I = IS
56            ARGLD = FLOAT(LD)*ARGH
57            FI = 0.
58            DO 108 II=3,IDO,2
59               I = I+2
60               FI = FI+1.
61               ARG = FI*ARGLD
62               WA(I-1) = DCOS(ARG)
63               WA(I) = DSIN(ARG)
64  108       CONTINUE
65            IS = IS+IDO
66  109    CONTINUE
67         L1 = L2
68  110 END DO
69      RETURN
70      END                                           
Note: See TracBrowser for help on using the repository browser.