#if 0 program checkFFT use dfport implicit none double precision::x integer,parameter::N=256 double precision,dimension(N*2)::p double precision,dimension(N/2)::s integer::ncount,j,idum character(len=8)::tt tt=clock() idum=iachar(tt(8:8))-48 p=0.0 open(77,file='prime.dat',status='unknown') loop1:do ncount=1,N x=ran(idum) p(2*ncount-1)=x write(77,'(f15.3)')x enddo loop1 close(77) call four1(p,N,1) do j=1,N/2 s(j)=p(2*j)*p(2*j)+p(2*j-1)*p(2*j-1) enddo x=0.0 do j=1,N/2 x=x+s(j) enddo s=s/x open(77,file='power.dat',status='unknown') do j=1,N/2 write(77,'(2(1x,f15.3))')dble(j-1)/dble(N),s(j) enddo close(77) end program checkFFT #endif !------------- ! Optimized FFT using Intel oneMKL DFTI ! Mathematical equivalence: Standard DFT definition ! Forward (isign=1): X[k] = sum_{n=0}^{N-1} x[n] * exp(-2*pi*i*k*n/N) ! Backward (isign=-1): X[k] = sum_{n=0}^{N-1} x[n] * exp(+2*pi*i*k*n/N) ! Input/Output: dataa is interleaved complex array [Re(0),Im(0),Re(1),Im(1),...] !------------- SUBROUTINE four1(dataa,nn,isign) use MKL_DFTI implicit none INTEGER, intent(in) :: isign, nn DOUBLE PRECISION, dimension(2*nn), intent(inout) :: dataa type(DFTI_DESCRIPTOR), pointer :: desc integer :: status ! Create DFTI descriptor for 1D complex-to-complex transform status = DftiCreateDescriptor(desc, DFTI_DOUBLE, DFTI_COMPLEX, 1, nn) if (status /= 0) return ! Set input/output storage as interleaved complex (default) status = DftiSetValue(desc, DFTI_PLACEMENT, DFTI_INPLACE) if (status /= 0) then status = DftiFreeDescriptor(desc) return endif ! Commit the descriptor status = DftiCommitDescriptor(desc) if (status /= 0) then status = DftiFreeDescriptor(desc) return endif ! Execute FFT based on direction if (isign == 1) then ! Forward FFT: exp(-2*pi*i*k*n/N) status = DftiComputeForward(desc, dataa) else ! Backward FFT: exp(+2*pi*i*k*n/N) status = DftiComputeBackward(desc, dataa) endif ! Free descriptor status = DftiFreeDescriptor(desc) return END SUBROUTINE four1