SUBROUTINE REALFT(DATA,N,ISIGN) c c (c) Numerical Recipes Software -- site license required for use c c double precision version of the original real DFT of numerical recipes c REAL*8 WR,WI,WPR,WPI,WTEMP,THETA ! DIMENSION DATA(*) DIMENSION DATA(2*N) !17/11/1991 CORRECTION TO MATCH NUM. REC. TEXTBOOK THETA=6.28318530717959D0/2.0D0/DBLE(N) C1=0.5 IF (ISIGN.EQ.1) THEN C2=-0.5 CALL FOUR1(DATA,N,+1) ELSE C2=0.5 THETA=-THETA ENDIF WPR=-2.0D0*DSIN(0.5D0*THETA)**2 WPI=DSIN(THETA) WR=1.0D0+WPR WI=WPI N2P3=2*N+3 DO 11 I=2,N/2+1 I1=2*I-1 I2=I1+1 I3=N2P3-I2 I4=I3+1 WRS=SNGL(WR) WIS=SNGL(WI) H1R=C1*(DATA(I1)+DATA(I3)) H1I=C1*(DATA(I2)-DATA(I4)) H2R=-C2*(DATA(I2)+DATA(I4)) H2I=C2*(DATA(I1)-DATA(I3)) DATA(I1)=H1R+WRS*H2R-WIS*H2I DATA(I2)=H1I+WRS*H2I+WIS*H2R DATA(I3)=H1R-WRS*H2R+WIS*H2I DATA(I4)=-H1I+WRS*H2I+WIS*H2R WTEMP=WR WR=WR*WPR-WI*WPI+WR WI=WI*WPR+WTEMP*WPI+WI 11 CONTINUE IF (ISIGN.EQ.1) THEN H1R=DATA(1) DATA(1)=H1R+DATA(2) DATA(2)=H1R-DATA(2) ELSE H1R=DATA(1) DATA(1)=C1*(H1R+DATA(2)) DATA(2)=C1*(H1R-DATA(2)) CALL FOUR1(DATA,N,-1) ENDIF RETURN END c c c SUBROUTINE FOUR1(DATA,NN,ISIGN) REAL*8 WR,WI,WPR,WPI,WTEMP,THETA ! DIMENSION DATA(*) c c double precision version of the original numerical recipes subroutine c DIMENSION DATA(2*NN) !17/11/1991 CORRECTION TO MATCH NUM. REC. TEXTBOOK N=2*NN J=1 DO 11 I=1,N,2 IF(J.GT.I)THEN TEMPR=DATA(J) TEMPI=DATA(J+1) DATA(J)=DATA(I) DATA(J+1)=DATA(I+1) DATA(I)=TEMPR DATA(I+1)=TEMPI ENDIF M=N/2 1 IF ((M.GE.2).AND.(J.GT.M)) THEN J=J-M M=M/2 GO TO 1 ENDIF J=J+M 11 CONTINUE MMAX=2 2 IF (N.GT.MMAX) THEN ISTEP=2*MMAX THETA=6.28318530717959D0/(ISIGN*MMAX) WPR=-2.D0*DSIN(0.5D0*THETA)**2 WPI=DSIN(THETA) WR=1.D0 WI=0.D0 DO 13 M=1,MMAX,2 DO 12 I=M,N,ISTEP J=I+MMAX TEMPR=SNGL(WR)*DATA(J)-SNGL(WI)*DATA(J+1) TEMPI=SNGL(WR)*DATA(J+1)+SNGL(WI)*DATA(J) DATA(J)=DATA(I)-TEMPR DATA(J+1)=DATA(I+1)-TEMPI DATA(I)=DATA(I)+TEMPR DATA(I+1)=DATA(I+1)+TEMPI 12 CONTINUE WTEMP=WR WR=WR*WPR-WI*WPI+WR WI=WI*WPR+WTEMP*WPI+WI 13 CONTINUE MMAX=ISTEP GO TO 2 ENDIF RETURN END