FFT991.inc
References to this file elsewhere.
1 c990408
2 SUBROUTINE FFT991(A,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN)
3 C SUBROUTINE FFT991(A,WORKX,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN)
4 C SUBROUTINE FFT991(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN)
5 C=======================================================================
6 C&&& INC=1 IS ASSUMED ***
7 C&&& INPUT/OUTPUT HAS A DIMENSION OF N*LOT
8 C&&& A & WORK SHOULD HAVE A DIMENSION OF JUMP*LOT
9 C&&& CREATED ON JUN/21/88 BY N.SATO
10 C=======================================================================
11 PARAMETER(NFFT=256)
12
13 c990408
14 c DIMENSION WORKX(N, 1920)
15
16 DIMENSION A(N,LOT),WORK(JUMP,NFFT),TRIGS(N),IFAX(*)
17 DIMENSION WORK2(N*JUMP*NFFT)
18
19 IF(ISIGN .EQ. 1) GO TO 2000
20 DO L0=1,LOT,NFFT
21 LOTL=MIN(NFFT,LOT-L0+1)
22
23 DO 100 L=1,LOTL
24 DO 100 I=1,N
25 WORK(I,L)=A(I,L+L0-1)
26 100 CONTINUE
27 C
28 C GRID TO WAVE
29 C
30 C X(0),...,X(N-1) ===> A(0),A(1),B(1),...,A(N/2-1),B(N/2-1),A(N/2)
31 C
32 CALL RFFTFM (N,INC,JUMP,LOTL, WORK, TRIGS,IFAX, WORK2 )
33 C
34 C A(0),A(1),B(1),... ===> A(0),B(0),A(1),B(1),...
35 C
36 *VOPTION NOFVAL
37 DO 200 L=1,LOTL
38 DO 200 I=3,N
39 A(I,L+L0-1)=WORK(I-1,L)
40 200 CONTINUE
41 DO 240 L=1,LOTL
42 A(1,L+L0-1)=WORK(1,L)
43 A(2,L+L0-1)=0.0
44 240 CONTINUE
45 ENDDO
46 RETURN
47 C
48 C WAVE TO GRID
49 C
50 C A(0),B(0),A(1),B(1),... ===> A(0),A(1),B(1),...
51 C
52 2000 CONTINUE
53 DO L0=1,LOT,NFFT
54 LOTL=MIN(NFFT,LOT-L0+1)
55
56 DO 300 L=1,LOTL
57 DO 300 I=3,N
58 WORK(I-1,L)=A(I,L+L0-1)
59 300 CONTINUE
60 DO 340 L=1,LOTL
61 cnec DO 340 L=1,LOT
62 WORK(1,L)=A(1,L+L0-1)
63 WORK(N,L)=0.0
64 340 CONTINUE
65 C
66 C A(0),A(1),B(1)...A(N/2-1),B(N/2-1),A(N/2) ===> X(0)...X(N-1)
67 C
68 CALL RFFTBM (N,INC,JUMP,LOTL, WORK, TRIGS,IFAX, WORK2)
69
70 DO 400 L=1,LOTL
71 DO 400 I=1,N
72 A(I,L+L0-1)=WORK(I,L)
73 400 CONTINUE
74 ENDDO
75 C
76 RETURN
77 END SUBROUTINE FFT991
78