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
C
IER = 0
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
CALL XERFFT ('COST1I', 3)
GO TO 300
......@@ -33,7 +33,7 @@ C
WSAVE(K) = 2.*SIN(FK*DT)
WSAVE(KC) = 2.*COS(FK*DT)
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)
IF (IER1 .NE. 0) THEN
IER = 20
......
......@@ -44,7 +44,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
IF (MODN .EQ. 0) GO TO 124
X(1,NS2+1) = X(1,NS2+1)+X(1,NS2+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
C
CALL RFFT1F(NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK,
......
......@@ -42,7 +42,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
IF (MODN .EQ. 0) GO TO 124
X(1,NS2+1) = X(1,NS2+1)+X(1,NS2+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
C
CALL RFFT1F(NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK,
......
......@@ -20,7 +20,7 @@ C
IER = 1
CALL XERFFT ('COSTMB', 6)
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
CALL XERFFT ('COSTMB', 8)
GO TO 100
......
......@@ -20,7 +20,7 @@ C
IER = 1
CALL XERFFT ('COSTMF', 6)
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
CALL XERFFT ('COSTMF', 8)
GO TO 100
......
......@@ -14,7 +14,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
IER = 0
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
CALL XERFFT ('COSTMI', 3)
GO TO 300
......@@ -33,7 +33,7 @@ C
WSAVE(K) = 2.*SIN(FK*DT)
WSAVE(KC) = 2.*COS(FK*DT)
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)
IF (IER1 .NE. 0) THEN
IER = 20
......
......@@ -31,7 +31,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
303 CONTINUE
302 CONTINUE
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
C
CALL RFFTMB(LOT,JUMP,N,INC,X,LENX,WSAVE(N+1),LNSV,WORK,LNWK,IER1)
......
......@@ -47,7 +47,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
304 CONTINUE
303 CONTINUE
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
C
CALL RFFTMF(LOT,JUMP,N,INC,X,LENX,WSAVE(N+1),LNSV,WORK,LNWK,IER1)
......
......@@ -62,7 +62,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
123 CONTINUE
124 CONTINUE
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
C
CALL RFFTMF(LOT,JUMP,NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK,
......
......@@ -58,7 +58,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
123 CONTINUE
124 CONTINUE
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
C
CALL RFFTMF(LOT,JUMP,NM1,INC,X,LENX,WSAVE(N+1),LNSV,WORK,
......
......@@ -45,7 +45,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
XH(M,1) = 0.
127 CONTINUE
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
C
CALL RFFTMF(LOT,1,NP1,LOT,XH,LNXH,WSAVE(NS2+1),LNSV,WORK,
......
......@@ -45,7 +45,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
XH(M,1) = 0.
127 CONTINUE
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
C
CALL RFFTMF(LOT,1,NP1,LOT,XH,LNXH,WSAVE(NS2+1),LNSV,WORK,
......
......@@ -18,7 +18,7 @@ C
IF (LENR .LT. INC*(N-1) + 1) THEN
IER = 1
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
CALL XERFFT ('RFFT1B ', 8)
ELSEIF (LENWRK .LT. N) THEN
......
......@@ -18,7 +18,7 @@ C
IF (LENR .LT. INC*(N-1) + 1) THEN
IER = 1
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
CALL XERFFT ('RFFT1F ', 8)
ELSEIF (LENWRK .LT. N) THEN
......
......@@ -14,7 +14,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
IER = 0
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
CALL XERFFT ('RFFT1I ', 3)
ENDIF
......
......@@ -19,7 +19,7 @@ C
IF (LENR .LT. (LOT-1)*JUMP + INC*(N-1) + 1) THEN
IER = 1
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
CALL XERFFT ('RFFTMB ', 8)
ELSEIF (LENWRK .LT. LOT*N) THEN
......
......@@ -19,7 +19,7 @@ C
IF (LENR .LT. (LOT-1)*JUMP + INC*(N-1) + 1) THEN
IER = 1
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
CALL XERFFT ('RFFTMF ', 8)
ELSEIF (LENWRK .LT. LOT*N) THEN
......
......@@ -14,7 +14,7 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
IER = 0
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
CALL XERFFT ('RFFTMI ', 3)
ENDIF
......
......@@ -18,7 +18,7 @@ C
IF (LENX .LT. INC*(N-1) + 1) THEN
IER = 1
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
CALL XERFFT ('SINQ1B', 8)
ELSEIF (LENWRK .LT. N) THEN
......@@ -27,7 +27,6 @@ C
ENDIF
C
IF (N .GT. 1) GO TO 101
X(1,1) = 4.*X(1,1)
RETURN
101 NS2 = N/2
DO 102 K=2,N,2
......
......@@ -19,7 +19,7 @@ C
IER = 1
CALL XERFFT ('SINQ1F', 6)
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
CALL XERFFT ('SINQ1F', 8)
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