[TEST]UPSTREAM: Pick some source changes from 48080d0a97
* Sync new folder structure
This commit is contained in:
87
AMSS_NCKU_source/AHF_Direct/FFT.f90
Normal file
87
AMSS_NCKU_source/AHF_Direct/FFT.f90
Normal file
@@ -0,0 +1,87 @@
|
||||
|
||||
|
||||
#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
|
||||
Reference in New Issue
Block a user