1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
SUBROUTINE DCOSQF (N,X,WSAVE)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DIMENSION X(*) ,WSAVE(*)
DATA SQRT2 /1.41421356237309504880D0/
IF (N.lt.2) GO TO 102
IF (N.eq.2) GO TO 101
GO TO 103
101 TSQX = SQRT2*X(2)
X(2) = X(1)-TSQX
X(1) = X(1)+TSQX
102 RETURN
103 CALL DCOSQF1 (N,X,WSAVE,WSAVE(N+1))
RETURN
END
SUBROUTINE DCOSQF1 (N,X,W,XH)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DIMENSION X(1) ,W(1) ,XH(1)
NS2 = (N+1)/2
NP2 = N+2
DO 101 K=2,NS2
KC = NP2-K
XH(K) = X(K)+X(KC)
XH(KC) = X(K)-X(KC)
101 CONTINUE
MODN = MOD(N,2)
IF (MODN .EQ. 0) XH(NS2+1) = X(NS2+1)+X(NS2+1)
DO 102 K=2,NS2
KC = NP2-K
X(K) = W(K-1)*XH(KC)+W(KC-1)*XH(K)
X(KC) = W(K-1)*XH(K)-W(KC-1)*XH(KC)
102 CONTINUE
IF (MODN .EQ. 0) X(NS2+1) = W(NS2)*XH(NS2+1)
CALL DFFTF (N,X,XH)
DO 103 I=3,N,2
XIM1 = X(I-1)-X(I)
X(I) = X(I-1)+X(I)
X(I-1) = XIM1
103 CONTINUE
RETURN
END
|