Rename *ll* and *ul* to ll and ul in in-interval
[maxima.git] / share / fftpack5 / fortran / costb1.f
blob927de8ef15971683ebb8a94687084bc2b10066e0
1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3 C FFTPACK 5.0
5 C Authors: Paul N. Swarztrauber and Richard A. Valent
7 C $Id$
9 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
11 SUBROUTINE COSTB1(N,INC,X,WSAVE,WORK,IER)
12 REAL X(INC,*) ,WSAVE(*)
13 DOUBLE PRECISION DSUM
14 IER = 0
15 NM1 = N-1
16 NP1 = N+1
17 NS2 = N/2
18 IF (N-2) 106,101,102
19 101 X1H = X(1,1)+X(1,2)
20 X(1,2) = X(1,1)-X(1,2)
21 X(1,1) = X1H
22 RETURN
23 102 IF (N .GT. 3) GO TO 103
24 X1P3 = X(1,1)+X(1,3)
25 X2 = X(1,2)
26 X(1,2) = X(1,1)-X(1,3)
27 X(1,1) = X1P3+X2
28 X(1,3) = X1P3-X2
29 RETURN
30 103 X(1,1) = X(1,1)+X(1,1)
31 X(1,N) = X(1,N)+X(1,N)
32 DSUM = X(1,1)-X(1,N)
33 X(1,1) = X(1,1)+X(1,N)
34 DO 104 K=2,NS2
35 KC = NP1-K
36 T1 = X(1,K)+X(1,KC)
37 T2 = X(1,K)-X(1,KC)
38 DSUM = DSUM+WSAVE(KC)*T2
39 T2 = WSAVE(K)*T2
40 X(1,K) = T1-T2
41 X(1,KC) = T1+T2
42 104 CONTINUE
43 MODN = MOD(N,2)
44 IF (MODN .EQ. 0) GO TO 124
45 X(1,NS2+1) = X(1,NS2+1)+X(1,NS2+1)
46 124 LENX = INC*(NM1-1) + 1
47 LNSV = NM1 + INT(LOG(REAL(NM1))/LOG(2.)) + 4
48 LNWK = NM1
50 CALL RFFT1F(NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK,
51 1 LNWK,IER1)
52 IF (IER1 .NE. 0) THEN
53 IER = 20
54 CALL XERFFT ('COSTB1',-5)
55 RETURN
56 ENDIF
58 FNM1S2 = FLOAT(NM1)/2.
59 DSUM = .5*DSUM
60 X(1,1) = FNM1S2*X(1,1)
61 IF(MOD(NM1,2) .NE. 0) GO TO 30
62 X(1,NM1) = X(1,NM1)+X(1,NM1)
63 30 FNM1S4 = FLOAT(NM1)/4.
64 DO 105 I=3,N,2
65 XI = FNM1S4*X(1,I)
66 X(1,I) = FNM1S4*X(1,I-1)
67 X(1,I-1) = DSUM
68 DSUM = DSUM+XI
69 105 CONTINUE
70 IF (MODN .NE. 0) RETURN
71 X(1,N) = DSUM
72 106 RETURN
73 END