cb252f5ea2
- FFT.f90: Replace hand-written Cooley-Tukey FFT with oneMKL DFTI - ilucg.f90: Replace manual dot product loop with BLAS DDOT - gaussj.C: Replace Gauss-Jordan elimination with LAPACK dgesv/dgetri - makefile.inc: Add MKL include paths and library linking All optimizations maintain mathematical equivalence and numerical precision.
88 lines
2.1 KiB
Fortran
88 lines
2.1 KiB
Fortran
|
|
|
|
#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
|