mirror of
https://github.com/saitohirga/WSJT-X.git
synced 2024-11-03 16:01:18 -05:00
76 lines
2.4 KiB
FortranFixed
76 lines
2.4 KiB
FortranFixed
|
SUBROUTINE FOUR2a (a,nfft,NDIM,ISIGN,IFORM)
|
||
|
|
|
||
|
|
C IFORM = 1, 0 or -1, as data is
|
||
|
|
C complex, real, or the first half of a complex array. Transform
|
||
|
|
C values are returned in array DATA. They are complex, real, or
|
||
|
|
C the first half of a complex array, as IFORM = 1, -1 or 0.
|
||
|
|
|
||
|
|
C The transform of a real array (IFORM = 0) dimensioned N(1) by N(2)
|
||
|
|
C by ... will be returned in the same array, now considered to
|
||
|
|
C be complex of dimensions N(1)/2+1 by N(2) by .... Note that if
|
||
|
|
C IFORM = 0 or -1, N(1) must be even, and enough room must be
|
||
|
|
C reserved. The missing values may be obtained by complex conjuga-
|
||
|
|
C tion.
|
||
|
|
|
||
|
|
C The reverse transformation of a half complex array dimensioned
|
||
|
|
C N(1)/2+1 by N(2) by ..., is accomplished by setting IFORM
|
||
|
|
C to -1. In the N array, N(1) must be the true N(1), not N(1)/2+1.
|
||
|
|
C The transform will be real and returned to the input array.
|
||
|
|
|
||
|
|
parameter (NPMAX=100)
|
||
|
|
complex a(nfft)
|
||
|
|
integer nn(NPMAX),ns(NPMAX),nf(NPMAX),nl(NPMAX)
|
||
|
|
integer plan(NPMAX)
|
||
|
|
data nplan/0/
|
||
|
|
include 'fftw3.f'
|
||
|
|
save
|
||
|
|
|
||
|
|
if(nfft.lt.0) go to 999
|
||
|
|
|
||
|
|
nloc=loc(a)
|
||
|
|
do i=1,nplan
|
||
|
|
if(nfft.eq.nn(i) .and. isign.eq.ns(i) .and.
|
||
|
|
+ iform.eq.nf(i) .and. nloc.eq.nl(i)) go to 10
|
||
|
|
enddo
|
||
|
|
if(nplan.ge.NPMAX) stop 'Too many FFTW plans requested.'
|
||
|
|
nplan=nplan+1
|
||
|
|
i=nplan
|
||
|
|
nn(i)=nfft
|
||
|
|
ns(i)=isign
|
||
|
|
nf(i)=iform
|
||
|
|
nl(i)=nloc
|
||
|
|
|
||
|
|
C Planning: FFTW_ESTIMATE, FFTW_MEASURE, FFTW_PATIENT, FFTW_EXHAUSTIVE
|
||
|
|
nspeed=FFTW_ESTIMATE
|
||
|
|
if(nfft.le.16384) nspeed=FFTW_MEASURE
|
||
|
|
|
||
|
|
if(isign.eq.-1 .and. iform.eq.1) then
|
||
|
|
call sfftw_plan_dft_1d_(plan(i),nfft,a,a,
|
||
|
|
+ FFTW_FORWARD,nspeed)
|
||
|
|
else if(isign.eq.1 .and. iform.eq.1) then
|
||
|
|
call sfftw_plan_dft_1d_(plan(i),nfft,a,a,
|
||
|
|
+ FFTW_BACKWARD,nspeed)
|
||
|
|
else if(isign.eq.-1 .and. iform.eq.0) then
|
||
|
|
call sfftw_plan_dft_r2c_1d_(plan(i),nfft,a,a,nspeed)
|
||
|
|
else if(isign.eq.1 .and. iform.eq.-1) then
|
||
|
|
call sfftw_plan_dft_c2r_1d_(plan(i),nfft,a,a,nspeed)
|
||
|
|
else
|
||
|
|
stop 'Unsupported request in four2a'
|
||
|
|
endif
|
||
|
|
|
||
|
|
i=nplan
|
||
|
|
! write(*,3001) i,nn(i),ns(i),nf(i),nl(i),plan(i)
|
||
|
|
! 3001 format(6i10)
|
||
|
|
|
||
|
|
10 call sfftw_execute_(plan(i))
|
||
|
|
return
|
||
|
|
|
||
|
|
999 do i=1,nplan
|
||
|
|
! print*,i,nn(i),ns(i),nf(i),nl(i),plan(i)
|
||
|
|
call sfftw_destroy_plan_(plan(i))
|
||
|
|
enddo
|
||
|
|
! print*,'FFTW plans destroyed:',nplan
|
||
|
|
|
||
|
|
return
|
||
|
|
end
|