Merge branch 'master' into bug-4403-remove-polyfill
[maxima.git] / share / fftpack5 / fortran / mradb3.f
blobea637ea3d2df20657fd9fdacf1c04205084680ed
1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3 C FFTPACK 5.0
5 C Authors: Paul N. Swarztrauber and Richard A. Valent
7 C $Id$
9 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
11 SUBROUTINE MRADB3 (M,IDO,L1,CC,IM1,IN1,CH,IM2,IN2,WA1,WA2)
12 REAL CC(IN1,IDO,3,L1) ,CH(IN2,IDO,L1,3),
13 1 WA1(IDO) ,WA2(IDO)
15 M1D = (M-1)*IM1+1
16 M2S = 1-IM2
17 ARG=2.*4.*ATAN(1.0)/3.
18 TAUR=COS(ARG)
19 TAUI=SIN(ARG)
20 DO 101 K=1,L1
21 M2 = M2S
22 DO 1001 M1=1,M1D,IM1
23 M2 = M2+IM2
24 CH(M2,1,K,1) = CC(M1,1,1,K)+2.*CC(M1,IDO,2,K)
25 CH(M2,1,K,2) = CC(M1,1,1,K)+(2.*TAUR)*CC(M1,IDO,2,K)
26 1 -(2.*TAUI)*CC(M1,1,3,K)
27 CH(M2,1,K,3) = CC(M1,1,1,K)+(2.*TAUR)*CC(M1,IDO,2,K)
28 1 +2.*TAUI*CC(M1,1,3,K)
29 1001 CONTINUE
30 101 CONTINUE
31 IF (IDO .EQ. 1) RETURN
32 IDP2 = IDO+2
33 DO 103 K=1,L1
34 DO 102 I=3,IDO,2
35 IC = IDP2-I
36 M2 = M2S
37 DO 1002 M1=1,M1D,IM1
38 M2 = M2+IM2
39 CH(M2,I-1,K,1) = CC(M1,I-1,1,K)+(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))
40 CH(M2,I,K,1) = CC(M1,I,1,K)+(CC(M1,I,3,K)-CC(M1,IC,2,K))
41 CH(M2,I-1,K,2) = WA1(I-2)*
42 1 ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))-
43 * (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))
44 2 -WA1(I-1)*
45 3 ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))+
46 * (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))
47 CH(M2,I,K,2) = WA1(I-2)*
48 4 ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))+
49 8 (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))
50 5 +WA1(I-1)*
51 6 ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))-
52 8 (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))
53 CH(M2,I-1,K,3) = WA2(I-2)*
54 7 ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))+
55 8 (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))
56 8 -WA2(I-1)*
57 9 ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))-
58 8 (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))
59 CH(M2,I,K,3) = WA2(I-2)*
60 1 ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))-
61 8 (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))
62 2 +WA2(I-1)*
63 3 ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))+
64 8 (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))
65 1002 CONTINUE
66 102 CONTINUE
67 103 CONTINUE
68 RETURN
69 END