Merge branch 'master' into devel
[wrffire.git] / wrfv2_fire / external / fftpack / fftpack5 / mrftf1.F
blobdcc2659f9047a988ea91bd63288f2c87b6c5acd9
1 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2 !                                                                       
3 !   FFTPACK 5.0                                                         
4 !                                                                       
5 !   Authors:  Paul N. Swarztrauber and Richard A. Valent                
6 !                                                                       
7 !   $Id: mrftf1.f,v 1.2 2004/06/15 21:29:20 rodney Exp $                
8 !                                                                       
9 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                         
11       SUBROUTINE MRFTF1 (M,IM,N,IN,C,CH,WA,FAC) 
12       REAL       CH(M,*) ,C(IN,*)  ,WA(N)   ,FAC(15) 
13 !                                                                       
14       NF = FAC(2) 
15       NA = 1 
16       L2 = N 
17       IW = N 
18       DO 111 K1=1,NF 
19          KH = NF-K1 
20          IP = FAC(KH+3) 
21          L1 = L2/IP 
22          IDO = N/L2 
23          IDL1 = IDO*L1 
24          IW = IW-(IP-1)*IDO 
25          NA = 1-NA 
26          IF (IP .NE. 4) GO TO 102 
27          IX2 = IW+IDO 
28          IX3 = IX2+IDO 
29          IF (NA .NE. 0) GO TO 101 
30          CALL MRADF4 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2),WA(IX3)) 
31          GO TO 110 
32   101    CALL MRADF4 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2),WA(IX3)) 
33          GO TO 110 
34   102    IF (IP .NE. 2) GO TO 104 
35          IF (NA .NE. 0) GO TO 103 
36          CALL MRADF2 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW)) 
37          GO TO 110 
38   103    CALL MRADF2 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW)) 
39          GO TO 110 
40   104    IF (IP .NE. 3) GO TO 106 
41          IX2 = IW+IDO 
42          IF (NA .NE. 0) GO TO 105 
43          CALL MRADF3 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2)) 
44          GO TO 110 
45   105    CALL MRADF3 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2)) 
46          GO TO 110 
47   106    IF (IP .NE. 5) GO TO 108 
48          IX2 = IW+IDO 
49          IX3 = IX2+IDO 
50          IX4 = IX3+IDO 
51          IF (NA .NE. 0) GO TO 107 
52          CALL MRADF5(M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2),            &
53      &                      WA(IX3),WA(IX4))                            
54          GO TO 110 
55   107    CALL MRADF5(M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2),            &
56      &                      WA(IX3),WA(IX4))                            
57          GO TO 110 
58   108    IF (IDO .EQ. 1) NA = 1-NA 
59          IF (NA .NE. 0) GO TO 109 
60          CALL MRADFG (M,IDO,IP,L1,IDL1,C,C,C,IM,IN,CH,CH,1,M,WA(IW)) 
61          NA = 1 
62          GO TO 110 
63   109    CALL MRADFG (M,IDO,IP,L1,IDL1,CH,CH,CH,1,M,C,C,IM,IN,WA(IW)) 
64          NA = 0 
65   110    L2 = L1 
66   111 END DO 
67       SN = 1./N 
68       TSN = 2./N 
69       TSNM = -TSN 
70       MODN = MOD(N,2) 
71       NL = N-2 
72       IF(MODN .NE. 0) NL = N-1 
73       IF (NA .NE. 0) GO TO 120 
74       M2 = 1-IM 
75       DO 117 I=1,M 
76          M2 = M2+IM 
77          C(M2,1) = SN*CH(I,1) 
78   117 END DO 
79       DO 118 J=2,NL,2 
80       M2 = 1-IM 
81       DO 118 I=1,M 
82          M2 = M2+IM 
83          C(M2,J) = TSN*CH(I,J) 
84          C(M2,J+1) = TSNM*CH(I,J+1) 
85   118 CONTINUE 
86       IF(MODN .NE. 0) RETURN 
87       M2 = 1-IM 
88       DO 119 I=1,M 
89          M2 = M2+IM 
90          C(M2,N) = SN*CH(I,N) 
91   119 END DO 
92       RETURN 
93   120 M2 = 1-IM 
94       DO 121 I=1,M 
95          M2 = M2+IM 
96          C(M2,1) = SN*C(M2,1) 
97   121 END DO 
98       DO 122 J=2,NL,2 
99       M2 = 1-IM 
100       DO 122 I=1,M 
101          M2 = M2+IM 
102          C(M2,J) = TSN*C(M2,J) 
103          C(M2,J+1) = TSNM*C(M2,J+1) 
104   122 CONTINUE 
105       IF(MODN .NE. 0) RETURN 
106       M2 = 1-IM 
107       DO 123 I=1,M 
108          M2 = M2+IM 
109          C(M2,N) = SN*C(M2,N) 
110   123 END DO 
111       RETURN 
112       END