Rename *ll* and *ul* to ll and ul in in-interval
[maxima.git] / share / fftpack5 / fortran / cmf4kf.f
blob9a291085042c81bc74fce6377b224086ac9c3e5b
1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3 C FFTPACK 5.0
5 C Authors: Paul N. Swarztrauber and Richard A. Valent
7 C $Id$
9 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
11 SUBROUTINE CMF4KF (LOT,IDO,L1,NA,CC,IM1,IN1,CH,IM2,IN2,WA)
12 REAL CC(2,IN1,L1,IDO,4),CH(2,IN2,L1,4,IDO),WA(IDO,3,2)
14 C FFTPACK 5.0 auxiliary routine
16 M1D = (LOT-1)*IM1+1
17 M2S = 1-IM2
18 IF (IDO .GT. 1) GO TO 102
19 SN = 1./REAL(4*L1)
20 IF (NA .EQ. 1) GO TO 106
21 DO 101 K=1,L1
22 DO 101 M1=1,M1D,IM1
23 TI1 = CC(2,M1,K,1,1)-CC(2,M1,K,1,3)
24 TI2 = CC(2,M1,K,1,1)+CC(2,M1,K,1,3)
25 TR4 = CC(2,M1,K,1,2)-CC(2,M1,K,1,4)
26 TI3 = CC(2,M1,K,1,2)+CC(2,M1,K,1,4)
27 TR1 = CC(1,M1,K,1,1)-CC(1,M1,K,1,3)
28 TR2 = CC(1,M1,K,1,1)+CC(1,M1,K,1,3)
29 TI4 = CC(1,M1,K,1,4)-CC(1,M1,K,1,2)
30 TR3 = CC(1,M1,K,1,2)+CC(1,M1,K,1,4)
31 CC(1,M1,K,1,1) = SN*(TR2+TR3)
32 CC(1,M1,K,1,3) = SN*(TR2-TR3)
33 CC(2,M1,K,1,1) = SN*(TI2+TI3)
34 CC(2,M1,K,1,3) = SN*(TI2-TI3)
35 CC(1,M1,K,1,2) = SN*(TR1+TR4)
36 CC(1,M1,K,1,4) = SN*(TR1-TR4)
37 CC(2,M1,K,1,2) = SN*(TI1+TI4)
38 CC(2,M1,K,1,4) = SN*(TI1-TI4)
39 101 CONTINUE
40 RETURN
41 106 DO 107 K=1,L1
42 M2 = M2S
43 DO 107 M1=1,M1D,IM1
44 M2 = M2+IM2
45 TI1 = CC(2,M1,K,1,1)-CC(2,M1,K,1,3)
46 TI2 = CC(2,M1,K,1,1)+CC(2,M1,K,1,3)
47 TR4 = CC(2,M1,K,1,2)-CC(2,M1,K,1,4)
48 TI3 = CC(2,M1,K,1,2)+CC(2,M1,K,1,4)
49 TR1 = CC(1,M1,K,1,1)-CC(1,M1,K,1,3)
50 TR2 = CC(1,M1,K,1,1)+CC(1,M1,K,1,3)
51 TI4 = CC(1,M1,K,1,4)-CC(1,M1,K,1,2)
52 TR3 = CC(1,M1,K,1,2)+CC(1,M1,K,1,4)
53 CH(1,M2,K,1,1) = SN*(TR2+TR3)
54 CH(1,M2,K,3,1) = SN*(TR2-TR3)
55 CH(2,M2,K,1,1) = SN*(TI2+TI3)
56 CH(2,M2,K,3,1) = SN*(TI2-TI3)
57 CH(1,M2,K,2,1) = SN*(TR1+TR4)
58 CH(1,M2,K,4,1) = SN*(TR1-TR4)
59 CH(2,M2,K,2,1) = SN*(TI1+TI4)
60 CH(2,M2,K,4,1) = SN*(TI1-TI4)
61 107 CONTINUE
62 RETURN
63 102 DO 103 K=1,L1
64 M2 = M2S
65 DO 103 M1=1,M1D,IM1
66 M2 = M2+IM2
67 TI1 = CC(2,M1,K,1,1)-CC(2,M1,K,1,3)
68 TI2 = CC(2,M1,K,1,1)+CC(2,M1,K,1,3)
69 TR4 = CC(2,M1,K,1,2)-CC(2,M1,K,1,4)
70 TI3 = CC(2,M1,K,1,2)+CC(2,M1,K,1,4)
71 TR1 = CC(1,M1,K,1,1)-CC(1,M1,K,1,3)
72 TR2 = CC(1,M1,K,1,1)+CC(1,M1,K,1,3)
73 TI4 = CC(1,M1,K,1,4)-CC(1,M1,K,1,2)
74 TR3 = CC(1,M1,K,1,2)+CC(1,M1,K,1,4)
75 CH(1,M2,K,1,1) = TR2+TR3
76 CH(1,M2,K,3,1) = TR2-TR3
77 CH(2,M2,K,1,1) = TI2+TI3
78 CH(2,M2,K,3,1) = TI2-TI3
79 CH(1,M2,K,2,1) = TR1+TR4
80 CH(1,M2,K,4,1) = TR1-TR4
81 CH(2,M2,K,2,1) = TI1+TI4
82 CH(2,M2,K,4,1) = TI1-TI4
83 103 CONTINUE
84 DO 105 I=2,IDO
85 DO 104 K=1,L1
86 M2 = M2S
87 DO 104 M1=1,M1D,IM1
88 M2 = M2+IM2
89 TI1 = CC(2,M1,K,I,1)-CC(2,M1,K,I,3)
90 TI2 = CC(2,M1,K,I,1)+CC(2,M1,K,I,3)
91 TI3 = CC(2,M1,K,I,2)+CC(2,M1,K,I,4)
92 TR4 = CC(2,M1,K,I,2)-CC(2,M1,K,I,4)
93 TR1 = CC(1,M1,K,I,1)-CC(1,M1,K,I,3)
94 TR2 = CC(1,M1,K,I,1)+CC(1,M1,K,I,3)
95 TI4 = CC(1,M1,K,I,4)-CC(1,M1,K,I,2)
96 TR3 = CC(1,M1,K,I,2)+CC(1,M1,K,I,4)
97 CH(1,M2,K,1,I) = TR2+TR3
98 CR3 = TR2-TR3
99 CH(2,M2,K,1,I) = TI2+TI3
100 CI3 = TI2-TI3
101 CR2 = TR1+TR4
102 CR4 = TR1-TR4
103 CI2 = TI1+TI4
104 CI4 = TI1-TI4
105 CH(1,M2,K,2,I) = WA(I,1,1)*CR2+WA(I,1,2)*CI2
106 CH(2,M2,K,2,I) = WA(I,1,1)*CI2-WA(I,1,2)*CR2
107 CH(1,M2,K,3,I) = WA(I,2,1)*CR3+WA(I,2,2)*CI3
108 CH(2,M2,K,3,I) = WA(I,2,1)*CI3-WA(I,2,2)*CR3
109 CH(1,M2,K,4,I) = WA(I,3,1)*CR4+WA(I,3,2)*CI4
110 CH(2,M2,K,4,I) = WA(I,3,1)*CI4-WA(I,3,2)*CR4
111 104 CONTINUE
112 105 CONTINUE
113 RETURN