Commit c240a96f authored by Raymond Toy's avatar Raymond Toy
Browse files

Import most fixes from FFTPACK51

Most if the fixes are due to computing the lengths (and indices) for
LENSAV.  Apparently the lengths should be log2(N) instead of log(N).

But the fix for c1fm1f.f fixes a genuine bug in the complex fft which
caused wrong results for non-power of 2 FFT sizes.

Also fixed a couple of typos and incorrect return ier codes.
parent f8319349
...@@ -14,7 +14,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -14,7 +14,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C C
IER = 0 IER = 0
C C
IF (LENSAV .LT. 2*N + INT(LOG(REAL(N))) +4) THEN IF (LENSAV .LT. 2*N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('COST1I', 3) CALL XERFFT ('COST1I', 3)
GO TO 300 GO TO 300
...@@ -33,7 +33,7 @@ C ...@@ -33,7 +33,7 @@ C
WSAVE(K) = 2.*SIN(FK*DT) WSAVE(K) = 2.*SIN(FK*DT)
WSAVE(KC) = 2.*COS(FK*DT) WSAVE(KC) = 2.*COS(FK*DT)
101 CONTINUE 101 CONTINUE
LNSV = NM1 + INT(LOG(REAL(NM1))) +4 LNSV = NM1 + INT(LOG(REAL(NM1))/LOG(2.)) +4
CALL RFFT1I (NM1, WSAVE(N+1), LNSV, IER1) CALL RFFT1I (NM1, WSAVE(N+1), LNSV, IER1)
IF (IER1 .NE. 0) THEN IF (IER1 .NE. 0) THEN
IER = 20 IER = 20
......
...@@ -44,7 +44,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -44,7 +44,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
IF (MODN .EQ. 0) GO TO 124 IF (MODN .EQ. 0) GO TO 124
X(1,NS2+1) = X(1,NS2+1)+X(1,NS2+1) X(1,NS2+1) = X(1,NS2+1)+X(1,NS2+1)
124 LENX = INC*(NM1-1) + 1 124 LENX = INC*(NM1-1) + 1
LNSV = NM1 + INT(LOG(REAL(NM1))) + 4 LNSV = NM1 + INT(LOG(REAL(NM1))/LOG(2.)) + 4
LNWK = NM1 LNWK = NM1
C C
CALL RFFT1F(NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK, CALL RFFT1F(NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK,
......
...@@ -42,7 +42,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -42,7 +42,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
IF (MODN .EQ. 0) GO TO 124 IF (MODN .EQ. 0) GO TO 124
X(1,NS2+1) = X(1,NS2+1)+X(1,NS2+1) X(1,NS2+1) = X(1,NS2+1)+X(1,NS2+1)
124 LENX = INC*(NM1-1) + 1 124 LENX = INC*(NM1-1) + 1
LNSV = NM1 + INT(LOG(REAL(NM1))) + 4 LNSV = NM1 + INT(LOG(REAL(NM1))/LOG(2.)) + 4
LNWK = NM1 LNWK = NM1
C C
CALL RFFT1F(NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK, CALL RFFT1F(NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK,
......
...@@ -20,7 +20,7 @@ C ...@@ -20,7 +20,7 @@ C
IER = 1 IER = 1
CALL XERFFT ('COSTMB', 6) CALL XERFFT ('COSTMB', 6)
GO TO 100 GO TO 100
ELSEIF (LENSAV .LT. 2*N + INT(LOG(REAL(N))) +4) THEN ELSEIF (LENSAV .LT. 2*N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('COSTMB', 8) CALL XERFFT ('COSTMB', 8)
GO TO 100 GO TO 100
......
...@@ -20,7 +20,7 @@ C ...@@ -20,7 +20,7 @@ C
IER = 1 IER = 1
CALL XERFFT ('COSTMF', 6) CALL XERFFT ('COSTMF', 6)
GO TO 100 GO TO 100
ELSEIF (LENSAV .LT. 2*N + INT(LOG(REAL(N))) +4) THEN ELSEIF (LENSAV .LT. 2*N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('COSTMF', 8) CALL XERFFT ('COSTMF', 8)
GO TO 100 GO TO 100
......
...@@ -14,7 +14,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -14,7 +14,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C C
IER = 0 IER = 0
C C
IF (LENSAV .LT. 2*N + INT(LOG(REAL(N))) +4) THEN IF (LENSAV .LT. 2*N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('COSTMI', 3) CALL XERFFT ('COSTMI', 3)
GO TO 300 GO TO 300
...@@ -33,7 +33,7 @@ C ...@@ -33,7 +33,7 @@ C
WSAVE(K) = 2.*SIN(FK*DT) WSAVE(K) = 2.*SIN(FK*DT)
WSAVE(KC) = 2.*COS(FK*DT) WSAVE(KC) = 2.*COS(FK*DT)
101 CONTINUE 101 CONTINUE
LNSV = NM1 + INT(LOG(REAL(NM1))) +4 LNSV = NM1 + INT(LOG(REAL(NM1))/LOG(2.)) +4
CALL RFFTMI (NM1, WSAVE(N+1), LNSV, IER1) CALL RFFTMI (NM1, WSAVE(N+1), LNSV, IER1)
IF (IER1 .NE. 0) THEN IF (IER1 .NE. 0) THEN
IER = 20 IER = 20
......
...@@ -31,7 +31,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -31,7 +31,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
303 CONTINUE 303 CONTINUE
302 CONTINUE 302 CONTINUE
LENX = (LOT-1)*JUMP + INC*(N-1) + 1 LENX = (LOT-1)*JUMP + INC*(N-1) + 1
LNSV = N + INT(LOG(REAL(N))) + 4 LNSV = N + INT(LOG(REAL(N))/LOG(2.)) + 4
LNWK = LOT*N LNWK = LOT*N
C C
CALL RFFTMB(LOT,JUMP,N,INC,X,LENX,WSAVE(N+1),LNSV,WORK,LNWK,IER1) CALL RFFTMB(LOT,JUMP,N,INC,X,LENX,WSAVE(N+1),LNSV,WORK,LNWK,IER1)
......
...@@ -47,7 +47,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -47,7 +47,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
304 CONTINUE 304 CONTINUE
303 CONTINUE 303 CONTINUE
LENX = (LOT-1)*JUMP + INC*(N-1) + 1 LENX = (LOT-1)*JUMP + INC*(N-1) + 1
LNSV = N + INT(LOG(REAL(N))) + 4 LNSV = N + INT(LOG(REAL(N))/LOG(2.)) + 4
LNWK = LOT*N LNWK = LOT*N
C C
CALL RFFTMF(LOT,JUMP,N,INC,X,LENX,WSAVE(N+1),LNSV,WORK,LNWK,IER1) CALL RFFTMF(LOT,JUMP,N,INC,X,LENX,WSAVE(N+1),LNSV,WORK,LNWK,IER1)
......
...@@ -62,7 +62,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -62,7 +62,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
123 CONTINUE 123 CONTINUE
124 CONTINUE 124 CONTINUE
LENX = (LOT-1)*JUMP + INC*(NM1-1) + 1 LENX = (LOT-1)*JUMP + INC*(NM1-1) + 1
LNSV = NM1 + INT(LOG(REAL(NM1))) + 4 LNSV = NM1 + INT(LOG(REAL(NM1))/LOG(2.)) + 4
LNWK = LOT*NM1 LNWK = LOT*NM1
C C
CALL RFFTMF(LOT,JUMP,NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK, CALL RFFTMF(LOT,JUMP,NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK,
......
...@@ -58,7 +58,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -58,7 +58,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
123 CONTINUE 123 CONTINUE
124 CONTINUE 124 CONTINUE
LENX = (LOT-1)*JUMP + INC*(NM1-1) + 1 LENX = (LOT-1)*JUMP + INC*(NM1-1) + 1
LNSV = NM1 + INT(LOG(REAL(NM1))) + 4 LNSV = NM1 + INT(LOG(REAL(NM1))/LOG(2.)) + 4
LNWK = LOT*NM1 LNWK = LOT*NM1
C C
CALL RFFTMF(LOT,JUMP,NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK, CALL RFFTMF(LOT,JUMP,NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK,
......
...@@ -45,7 +45,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -45,7 +45,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
XH(M,1) = 0. XH(M,1) = 0.
127 CONTINUE 127 CONTINUE
LNXH = LOT-1 + LOT*(NP1-1) + 1 LNXH = LOT-1 + LOT*(NP1-1) + 1
LNSV = NP1 + INT(LOG(REAL(NP1))) + 4 LNSV = NP1 + INT(LOG(REAL(NP1))/LOG(2.)) + 4
LNWK = LOT*NP1 LNWK = LOT*NP1
C C
CALL RFFTMF(LOT,1,NP1,LOT,XH,LNXH,WSAVE(NS2+1),LNSV,WORK, CALL RFFTMF(LOT,1,NP1,LOT,XH,LNXH,WSAVE(NS2+1),LNSV,WORK,
......
...@@ -45,7 +45,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -45,7 +45,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
XH(M,1) = 0. XH(M,1) = 0.
127 CONTINUE 127 CONTINUE
LNXH = LOT-1 + LOT*(NP1-1) + 1 LNXH = LOT-1 + LOT*(NP1-1) + 1
LNSV = NP1 + INT(LOG(REAL(NP1))) + 4 LNSV = NP1 + INT(LOG(REAL(NP1))/LOG(2.)) + 4
LNWK = LOT*NP1 LNWK = LOT*NP1
C C
CALL RFFTMF(LOT,1,NP1,LOT,XH,LNXH,WSAVE(NS2+1),LNSV,WORK, CALL RFFTMF(LOT,1,NP1,LOT,XH,LNXH,WSAVE(NS2+1),LNSV,WORK,
......
...@@ -18,7 +18,7 @@ C ...@@ -18,7 +18,7 @@ C
IF (LENR .LT. INC*(N-1) + 1) THEN IF (LENR .LT. INC*(N-1) + 1) THEN
IER = 1 IER = 1
CALL XERFFT ('RFFT1B ', 6) CALL XERFFT ('RFFT1B ', 6)
ELSEIF (LENSAV .LT. N + INT(LOG(REAL(N))) +4) THEN ELSEIF (LENSAV .LT. N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('RFFT1B ', 8) CALL XERFFT ('RFFT1B ', 8)
ELSEIF (LENWRK .LT. N) THEN ELSEIF (LENWRK .LT. N) THEN
......
...@@ -18,7 +18,7 @@ C ...@@ -18,7 +18,7 @@ C
IF (LENR .LT. INC*(N-1) + 1) THEN IF (LENR .LT. INC*(N-1) + 1) THEN
IER = 1 IER = 1
CALL XERFFT ('RFFT1F ', 6) CALL XERFFT ('RFFT1F ', 6)
ELSEIF (LENSAV .LT. N + INT(LOG(REAL(N))) +4) THEN ELSEIF (LENSAV .LT. N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('RFFT1F ', 8) CALL XERFFT ('RFFT1F ', 8)
ELSEIF (LENWRK .LT. N) THEN ELSEIF (LENWRK .LT. N) THEN
......
...@@ -14,7 +14,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -14,7 +14,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C C
IER = 0 IER = 0
C C
IF (LENSAV .LT. N + INT(LOG(REAL(N))) +4) THEN IF (LENSAV .LT. N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('RFFT1I ', 3) CALL XERFFT ('RFFT1I ', 3)
ENDIF ENDIF
......
...@@ -19,7 +19,7 @@ C ...@@ -19,7 +19,7 @@ C
IF (LENR .LT. (LOT-1)*JUMP + INC*(N-1) + 1) THEN IF (LENR .LT. (LOT-1)*JUMP + INC*(N-1) + 1) THEN
IER = 1 IER = 1
CALL XERFFT ('RFFTMB ', 6) CALL XERFFT ('RFFTMB ', 6)
ELSEIF (LENSAV .LT. N + INT(LOG(REAL(N))) +4) THEN ELSEIF (LENSAV .LT. N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('RFFTMB ', 8) CALL XERFFT ('RFFTMB ', 8)
ELSEIF (LENWRK .LT. LOT*N) THEN ELSEIF (LENWRK .LT. LOT*N) THEN
......
...@@ -19,7 +19,7 @@ C ...@@ -19,7 +19,7 @@ C
IF (LENR .LT. (LOT-1)*JUMP + INC*(N-1) + 1) THEN IF (LENR .LT. (LOT-1)*JUMP + INC*(N-1) + 1) THEN
IER = 1 IER = 1
CALL XERFFT ('RFFTMF ', 6) CALL XERFFT ('RFFTMF ', 6)
ELSEIF (LENSAV .LT. N + INT(LOG(REAL(N))) +4) THEN ELSEIF (LENSAV .LT. N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('RFFTMF ', 8) CALL XERFFT ('RFFTMF ', 8)
ELSEIF (LENWRK .LT. LOT*N) THEN ELSEIF (LENWRK .LT. LOT*N) THEN
......
...@@ -14,7 +14,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ...@@ -14,7 +14,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C C
IER = 0 IER = 0
C C
IF (LENSAV .LT. N + INT(LOG(REAL(N))) +4) THEN IF (LENSAV .LT. N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('RFFTMI ', 3) CALL XERFFT ('RFFTMI ', 3)
ENDIF ENDIF
......
...@@ -18,7 +18,7 @@ C ...@@ -18,7 +18,7 @@ C
IF (LENX .LT. INC*(N-1) + 1) THEN IF (LENX .LT. INC*(N-1) + 1) THEN
IER = 1 IER = 1
CALL XERFFT ('SINQ1B', 6) CALL XERFFT ('SINQ1B', 6)
ELSEIF (LENSAV .LT. 2*N + INT(LOG(REAL(N))) +4) THEN ELSEIF (LENSAV .LT. 2*N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('SINQ1B', 8) CALL XERFFT ('SINQ1B', 8)
ELSEIF (LENWRK .LT. N) THEN ELSEIF (LENWRK .LT. N) THEN
...@@ -27,7 +27,6 @@ C ...@@ -27,7 +27,6 @@ C
ENDIF ENDIF
C C
IF (N .GT. 1) GO TO 101 IF (N .GT. 1) GO TO 101
X(1,1) = 4.*X(1,1)
RETURN RETURN
101 NS2 = N/2 101 NS2 = N/2
DO 102 K=2,N,2 DO 102 K=2,N,2
......
...@@ -19,7 +19,7 @@ C ...@@ -19,7 +19,7 @@ C
IER = 1 IER = 1
CALL XERFFT ('SINQ1F', 6) CALL XERFFT ('SINQ1F', 6)
GO TO 300 GO TO 300
ELSEIF (LENSAV .LT. 2*N + INT(LOG(REAL(N))) +4) THEN ELSEIF (LENSAV .LT. 2*N + INT(LOG(REAL(N))/LOG(2.)) +4) THEN
IER = 2 IER = 2
CALL XERFFT ('SINQ1F', 8) CALL XERFFT ('SINQ1F', 8)
GO TO 300 GO TO 300
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment