~ubuntu-branches/ubuntu/karmic/python-scipy/karmic

« back to all changes in this revision

Viewing changes to scipy/fftpack/dfftpack/zfftf1.f

  • Committer: Bazaar Package Importer
  • Author(s): Ondrej Certik
  • Date: 2008-06-16 22:58:01 UTC
  • mfrom: (2.1.24 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080616225801-irdhrpcwiocfbcmt
Tags: 0.6.0-12
* The description updated to match the current SciPy (Closes: #489149).
* Standards-Version bumped to 3.8.0 (no action needed)
* Build-Depends: netcdf-dev changed to libnetcdf-dev

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
      SUBROUTINE ZFFTF1 (N,C,CH,WA,IFAC)
 
2
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
 
3
      DIMENSION       CH(*)      ,C(*)       ,WA(*)      ,IFAC(*)
 
4
      NF = IFAC(2)
 
5
      NA = 0
 
6
      L1 = 1
 
7
      IW = 1
 
8
      DO 116 K1=1,NF
 
9
         IP = IFAC(K1+2)
 
10
         L2 = IP*L1
 
11
         IDO = N/L2
 
12
         IDOT = IDO+IDO
 
13
         IDL1 = IDOT*L1
 
14
         IF (IP .NE. 4) GO TO 103
 
15
         IX2 = IW+IDOT
 
16
         IX3 = IX2+IDOT
 
17
         IF (NA .NE. 0) GO TO 101
 
18
         CALL DPASSF4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
 
19
         GO TO 102
 
20
  101    CALL DPASSF4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
 
21
  102    NA = 1-NA
 
22
         GO TO 115
 
23
  103    IF (IP .NE. 2) GO TO 106
 
24
         IF (NA .NE. 0) GO TO 104
 
25
         CALL DPASSF2 (IDOT,L1,C,CH,WA(IW))
 
26
         GO TO 105
 
27
  104    CALL DPASSF2 (IDOT,L1,CH,C,WA(IW))
 
28
  105    NA = 1-NA
 
29
         GO TO 115
 
30
  106    IF (IP .NE. 3) GO TO 109
 
31
         IX2 = IW+IDOT
 
32
         IF (NA .NE. 0) GO TO 107
 
33
         CALL DPASSF3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
 
34
         GO TO 108
 
35
  107    CALL DPASSF3 (IDOT,L1,CH,C,WA(IW),WA(IX2))
 
36
  108    NA = 1-NA
 
37
         GO TO 115
 
38
  109    IF (IP .NE. 5) GO TO 112
 
39
         IX2 = IW+IDOT
 
40
         IX3 = IX2+IDOT
 
41
         IX4 = IX3+IDOT
 
42
         IF (NA .NE. 0) GO TO 110
 
43
         CALL DPASSF5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
 
44
         GO TO 111
 
45
  110    CALL DPASSF5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
 
46
  111    NA = 1-NA
 
47
         GO TO 115
 
48
  112    IF (NA .NE. 0) GO TO 113
 
49
         CALL DPASSF (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
 
50
         GO TO 114
 
51
  113    CALL DPASSF (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
 
52
  114    IF (NAC .NE. 0) NA = 1-NA
 
53
  115    L1 = L2
 
54
         IW = IW+(IP-1)*IDOT
 
55
  116 CONTINUE
 
56
      IF (NA .EQ. 0) RETURN
 
57
      N2 = N+N
 
58
      DO 117 I=1,N2
 
59
         C(I) = CH(I)
 
60
  117 CONTINUE
 
61
      RETURN
 
62
      END
 
63
 
 
64
      SUBROUTINE DPASSF (NAC,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
 
65
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
 
66
      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
 
67
     1                C1(IDO,L1,IP)          ,WA(1)      ,C2(IDL1,IP),
 
68
     2                CH2(IDL1,IP)
 
69
      IDOT = IDO/2
 
70
      NT = IP*IDL1
 
71
      IPP2 = IP+2
 
72
      IPPH = (IP+1)/2
 
73
      IDP = IP*IDO
 
74
C
 
75
      IF (IDO .LT. L1) GO TO 106
 
76
      DO 103 J=2,IPPH
 
77
         JC = IPP2-J
 
78
         DO 102 K=1,L1
 
79
            DO 101 I=1,IDO
 
80
               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)
 
81
               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)
 
82
  101       CONTINUE
 
83
  102    CONTINUE
 
84
  103 CONTINUE
 
85
      DO 105 K=1,L1
 
86
         DO 104 I=1,IDO
 
87
            CH(I,K,1) = CC(I,1,K)
 
88
  104    CONTINUE
 
89
  105 CONTINUE
 
90
      GO TO 112
 
91
  106 DO 109 J=2,IPPH
 
92
         JC = IPP2-J
 
93
         DO 108 I=1,IDO
 
94
            DO 107 K=1,L1
 
95
               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)
 
96
               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)
 
97
  107       CONTINUE
 
98
  108    CONTINUE
 
99
  109 CONTINUE
 
100
      DO 111 I=1,IDO
 
101
         DO 110 K=1,L1
 
102
            CH(I,K,1) = CC(I,1,K)
 
103
  110    CONTINUE
 
104
  111 CONTINUE
 
105
  112 IDL = 2-IDO
 
106
      INC = 0
 
107
      DO 116 L=2,IPPH
 
108
         LC = IPP2-L
 
109
         IDL = IDL+IDO
 
110
         DO 113 IK=1,IDL1
 
111
            C2(IK,L) = CH2(IK,1)+WA(IDL-1)*CH2(IK,2)
 
112
            C2(IK,LC) = -WA(IDL)*CH2(IK,IP)
 
113
  113    CONTINUE
 
114
         IDLJ = IDL
 
115
         INC = INC+IDO
 
116
         DO 115 J=3,IPPH
 
117
            JC = IPP2-J
 
118
            IDLJ = IDLJ+INC
 
119
            IF (IDLJ .GT. IDP) IDLJ = IDLJ-IDP
 
120
            WAR = WA(IDLJ-1)
 
121
            WAI = WA(IDLJ)
 
122
            DO 114 IK=1,IDL1
 
123
               C2(IK,L) = C2(IK,L)+WAR*CH2(IK,J)
 
124
               C2(IK,LC) = C2(IK,LC)-WAI*CH2(IK,JC)
 
125
  114       CONTINUE
 
126
  115    CONTINUE
 
127
  116 CONTINUE
 
128
      DO 118 J=2,IPPH
 
129
         DO 117 IK=1,IDL1
 
130
            CH2(IK,1) = CH2(IK,1)+CH2(IK,J)
 
131
  117    CONTINUE
 
132
  118 CONTINUE
 
133
      DO 120 J=2,IPPH
 
134
         JC = IPP2-J
 
135
         DO 119 IK=2,IDL1,2
 
136
            CH2(IK-1,J) = C2(IK-1,J)-C2(IK,JC)
 
137
            CH2(IK-1,JC) = C2(IK-1,J)+C2(IK,JC)
 
138
            CH2(IK,J) = C2(IK,J)+C2(IK-1,JC)
 
139
            CH2(IK,JC) = C2(IK,J)-C2(IK-1,JC)
 
140
  119    CONTINUE
 
141
  120 CONTINUE
 
142
      NAC = 1
 
143
      IF (IDO .EQ. 2) RETURN
 
144
      NAC = 0
 
145
      DO 121 IK=1,IDL1
 
146
         C2(IK,1) = CH2(IK,1)
 
147
  121 CONTINUE
 
148
      DO 123 J=2,IP
 
149
         DO 122 K=1,L1
 
150
            C1(1,K,J) = CH(1,K,J)
 
151
            C1(2,K,J) = CH(2,K,J)
 
152
  122    CONTINUE
 
153
  123 CONTINUE
 
154
      IF (IDOT .GT. L1) GO TO 127
 
155
      IDIJ = 0
 
156
      DO 126 J=2,IP
 
157
         IDIJ = IDIJ+2
 
158
         DO 125 I=4,IDO,2
 
159
            IDIJ = IDIJ+2
 
160
            DO 124 K=1,L1
 
161
               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)+WA(IDIJ)*CH(I,K,J)
 
162
               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)-WA(IDIJ)*CH(I-1,K,J)
 
163
  124       CONTINUE
 
164
  125    CONTINUE
 
165
  126 CONTINUE
 
166
      RETURN
 
167
  127 IDJ = 2-IDO
 
168
      DO 130 J=2,IP
 
169
         IDJ = IDJ+IDO
 
170
         DO 129 K=1,L1
 
171
            IDIJ = IDJ
 
172
            DO 128 I=4,IDO,2
 
173
               IDIJ = IDIJ+2
 
174
               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)+WA(IDIJ)*CH(I,K,J)
 
175
               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)-WA(IDIJ)*CH(I-1,K,J)
 
176
  128       CONTINUE
 
177
  129    CONTINUE
 
178
  130 CONTINUE
 
179
      RETURN
 
180
      END
 
181
 
 
182
      SUBROUTINE DPASSF2 (IDO,L1,CC,CH,WA1)
 
183
      IMPLICIT DOUBLE PRECISION (A-H,O-Z) 
 
184
      DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
 
185
     1                WA1(1)
 
186
      IF (IDO .GT. 2) GO TO 102
 
187
      DO 101 K=1,L1
 
188
         CH(1,K,1) = CC(1,1,K)+CC(1,2,K)
 
189
         CH(1,K,2) = CC(1,1,K)-CC(1,2,K)
 
190
         CH(2,K,1) = CC(2,1,K)+CC(2,2,K)
 
191
         CH(2,K,2) = CC(2,1,K)-CC(2,2,K)
 
192
  101 CONTINUE
 
193
      RETURN
 
194
  102 DO 104 K=1,L1
 
195
         DO 103 I=2,IDO,2
 
196
            CH(I-1,K,1) = CC(I-1,1,K)+CC(I-1,2,K)
 
197
            TR2 = CC(I-1,1,K)-CC(I-1,2,K)
 
198
            CH(I,K,1) = CC(I,1,K)+CC(I,2,K)
 
199
            TI2 = CC(I,1,K)-CC(I,2,K)
 
200
            CH(I,K,2) = WA1(I-1)*TI2-WA1(I)*TR2
 
201
            CH(I-1,K,2) = WA1(I-1)*TR2+WA1(I)*TI2
 
202
  103    CONTINUE
 
203
  104 CONTINUE
 
204
      RETURN
 
205
      END
 
206
 
 
207
      SUBROUTINE DPASSF3 (IDO,L1,CC,CH,WA1,WA2)
 
208
      IMPLICIT DOUBLE PRECISION (A-H,O-Z) 
 
209
      DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
 
210
     1                WA1(1)     ,WA2(1)
 
211
C     *** TAUI IS -SQRT(3)/2 ***
 
212
      DATA TAUR,TAUI /-0.5D0,-0.86602540378443864676D0/
 
213
      IF (IDO .NE. 2) GO TO 102
 
214
      DO 101 K=1,L1
 
215
         TR2 = CC(1,2,K)+CC(1,3,K)
 
216
         CR2 = CC(1,1,K)+TAUR*TR2
 
217
         CH(1,K,1) = CC(1,1,K)+TR2
 
218
         TI2 = CC(2,2,K)+CC(2,3,K)
 
219
         CI2 = CC(2,1,K)+TAUR*TI2
 
220
         CH(2,K,1) = CC(2,1,K)+TI2
 
221
         CR3 = TAUI*(CC(1,2,K)-CC(1,3,K))
 
222
         CI3 = TAUI*(CC(2,2,K)-CC(2,3,K))
 
223
         CH(1,K,2) = CR2-CI3
 
224
         CH(1,K,3) = CR2+CI3
 
225
         CH(2,K,2) = CI2+CR3
 
226
         CH(2,K,3) = CI2-CR3
 
227
  101 CONTINUE
 
228
      RETURN
 
229
  102 DO 104 K=1,L1
 
230
         DO 103 I=2,IDO,2
 
231
            TR2 = CC(I-1,2,K)+CC(I-1,3,K)
 
232
            CR2 = CC(I-1,1,K)+TAUR*TR2
 
233
            CH(I-1,K,1) = CC(I-1,1,K)+TR2
 
234
            TI2 = CC(I,2,K)+CC(I,3,K)
 
235
            CI2 = CC(I,1,K)+TAUR*TI2
 
236
            CH(I,K,1) = CC(I,1,K)+TI2
 
237
            CR3 = TAUI*(CC(I-1,2,K)-CC(I-1,3,K))
 
238
            CI3 = TAUI*(CC(I,2,K)-CC(I,3,K))
 
239
            DR2 = CR2-CI3
 
240
            DR3 = CR2+CI3
 
241
            DI2 = CI2+CR3
 
242
            DI3 = CI2-CR3
 
243
            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2
 
244
            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2
 
245
            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3
 
246
            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3
 
247
  103    CONTINUE
 
248
  104 CONTINUE
 
249
      RETURN
 
250
      END
 
251
 
 
252
      SUBROUTINE DPASSF4 (IDO,L1,CC,CH,WA1,WA2,WA3)
 
253
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
 
254
      DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
 
255
     1                WA1(1)     ,WA2(1)     ,WA3(1)
 
256
      IF (IDO .NE. 2) GO TO 102
 
257
      DO 101 K=1,L1
 
258
         TI1 = CC(2,1,K)-CC(2,3,K)
 
259
         TI2 = CC(2,1,K)+CC(2,3,K)
 
260
         TR4 = CC(2,2,K)-CC(2,4,K)
 
261
         TI3 = CC(2,2,K)+CC(2,4,K)
 
262
         TR1 = CC(1,1,K)-CC(1,3,K)
 
263
         TR2 = CC(1,1,K)+CC(1,3,K)
 
264
         TI4 = CC(1,4,K)-CC(1,2,K)
 
265
         TR3 = CC(1,2,K)+CC(1,4,K)
 
266
         CH(1,K,1) = TR2+TR3
 
267
         CH(1,K,3) = TR2-TR3
 
268
         CH(2,K,1) = TI2+TI3
 
269
         CH(2,K,3) = TI2-TI3
 
270
         CH(1,K,2) = TR1+TR4
 
271
         CH(1,K,4) = TR1-TR4
 
272
         CH(2,K,2) = TI1+TI4
 
273
         CH(2,K,4) = TI1-TI4
 
274
  101 CONTINUE
 
275
      RETURN
 
276
  102 DO 104 K=1,L1
 
277
         DO 103 I=2,IDO,2
 
278
            TI1 = CC(I,1,K)-CC(I,3,K)
 
279
            TI2 = CC(I,1,K)+CC(I,3,K)
 
280
            TI3 = CC(I,2,K)+CC(I,4,K)
 
281
            TR4 = CC(I,2,K)-CC(I,4,K)
 
282
            TR1 = CC(I-1,1,K)-CC(I-1,3,K)
 
283
            TR2 = CC(I-1,1,K)+CC(I-1,3,K)
 
284
            TI4 = CC(I-1,4,K)-CC(I-1,2,K)
 
285
            TR3 = CC(I-1,2,K)+CC(I-1,4,K)
 
286
            CH(I-1,K,1) = TR2+TR3
 
287
            CR3 = TR2-TR3
 
288
            CH(I,K,1) = TI2+TI3
 
289
            CI3 = TI2-TI3
 
290
            CR2 = TR1+TR4
 
291
            CR4 = TR1-TR4
 
292
            CI2 = TI1+TI4
 
293
            CI4 = TI1-TI4
 
294
            CH(I-1,K,2) = WA1(I-1)*CR2+WA1(I)*CI2
 
295
            CH(I,K,2) = WA1(I-1)*CI2-WA1(I)*CR2
 
296
            CH(I-1,K,3) = WA2(I-1)*CR3+WA2(I)*CI3
 
297
            CH(I,K,3) = WA2(I-1)*CI3-WA2(I)*CR3
 
298
            CH(I-1,K,4) = WA3(I-1)*CR4+WA3(I)*CI4
 
299
            CH(I,K,4) = WA3(I-1)*CI4-WA3(I)*CR4
 
300
  103    CONTINUE
 
301
  104 CONTINUE
 
302
      RETURN
 
303
      END
 
304
 
 
305
      SUBROUTINE DPASSF5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
 
306
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
 
307
      DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
 
308
     1                WA1(1)     ,WA2(1)     ,WA3(1)     ,WA4(1)
 
309
C     *** TR11=COS(2*PI/5), TI11=-SIN(2*PI/5)
 
310
C     *** TR12=-COS(4*PI/5), TI12=-SIN(4*PI/5)  
 
311
      DATA TR11,TI11,TR12,TI12 /0.3090169943749474241D0,
 
312
     +     -0.95105651629515357212D0,
 
313
     1     -0.8090169943749474241D0, -0.58778525229247312917D0/
 
314
      IF (IDO .NE. 2) GO TO 102
 
315
      DO 101 K=1,L1
 
316
         TI5 = CC(2,2,K)-CC(2,5,K)
 
317
         TI2 = CC(2,2,K)+CC(2,5,K)
 
318
         TI4 = CC(2,3,K)-CC(2,4,K)
 
319
         TI3 = CC(2,3,K)+CC(2,4,K)
 
320
         TR5 = CC(1,2,K)-CC(1,5,K)
 
321
         TR2 = CC(1,2,K)+CC(1,5,K)
 
322
         TR4 = CC(1,3,K)-CC(1,4,K)
 
323
         TR3 = CC(1,3,K)+CC(1,4,K)
 
324
         CH(1,K,1) = CC(1,1,K)+TR2+TR3
 
325
         CH(2,K,1) = CC(2,1,K)+TI2+TI3
 
326
         CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
 
327
         CI2 = CC(2,1,K)+TR11*TI2+TR12*TI3
 
328
         CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
 
329
         CI3 = CC(2,1,K)+TR12*TI2+TR11*TI3
 
330
         CR5 = TI11*TR5+TI12*TR4
 
331
         CI5 = TI11*TI5+TI12*TI4
 
332
         CR4 = TI12*TR5-TI11*TR4
 
333
         CI4 = TI12*TI5-TI11*TI4
 
334
         CH(1,K,2) = CR2-CI5
 
335
         CH(1,K,5) = CR2+CI5
 
336
         CH(2,K,2) = CI2+CR5
 
337
         CH(2,K,3) = CI3+CR4
 
338
         CH(1,K,3) = CR3-CI4
 
339
         CH(1,K,4) = CR3+CI4
 
340
         CH(2,K,4) = CI3-CR4
 
341
         CH(2,K,5) = CI2-CR5
 
342
  101 CONTINUE
 
343
      RETURN
 
344
  102 DO 104 K=1,L1
 
345
         DO 103 I=2,IDO,2
 
346
            TI5 = CC(I,2,K)-CC(I,5,K)
 
347
            TI2 = CC(I,2,K)+CC(I,5,K)
 
348
            TI4 = CC(I,3,K)-CC(I,4,K)
 
349
            TI3 = CC(I,3,K)+CC(I,4,K)
 
350
            TR5 = CC(I-1,2,K)-CC(I-1,5,K)
 
351
            TR2 = CC(I-1,2,K)+CC(I-1,5,K)
 
352
            TR4 = CC(I-1,3,K)-CC(I-1,4,K)
 
353
            TR3 = CC(I-1,3,K)+CC(I-1,4,K)
 
354
            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
 
355
            CH(I,K,1) = CC(I,1,K)+TI2+TI3
 
356
            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
 
357
            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
 
358
            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
 
359
            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
 
360
            CR5 = TI11*TR5+TI12*TR4
 
361
            CI5 = TI11*TI5+TI12*TI4
 
362
            CR4 = TI12*TR5-TI11*TR4
 
363
            CI4 = TI12*TI5-TI11*TI4
 
364
            DR3 = CR3-CI4
 
365
            DR4 = CR3+CI4
 
366
            DI3 = CI3+CR4
 
367
            DI4 = CI3-CR4
 
368
            DR5 = CR2+CI5
 
369
            DR2 = CR2-CI5
 
370
            DI5 = CI2-CR5
 
371
            DI2 = CI2+CR5
 
372
            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2
 
373
            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2
 
374
            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3
 
375
            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3
 
376
            CH(I-1,K,4) = WA3(I-1)*DR4+WA3(I)*DI4
 
377
            CH(I,K,4) = WA3(I-1)*DI4-WA3(I)*DR4
 
378
            CH(I-1,K,5) = WA4(I-1)*DR5+WA4(I)*DI5
 
379
            CH(I,K,5) = WA4(I-1)*DI5-WA4(I)*DR5
 
380
  103    CONTINUE
 
381
  104 CONTINUE
 
382
      RETURN
 
383
      END