Commit c240a96f by Raymond Toy

### 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