Commit 70243c70 authored by Matthias Redies's avatar Matthias Redies

format fft3d

parent 4b72360e
MODULE m_fft3d
CONTAINS
SUBROUTINE fft3d(&
& afft,bfft,fg3,&
& stars,isn,scaled)
MODULE m_fft3d
CONTAINS
SUBROUTINE fft3d(&
& afft, bfft, fg3,&
& stars, isn, scaled)
!************************************************************
!* *
......@@ -19,74 +19,74 @@
USE m_types
USE m_fft_interface
IMPLICIT NONE
INTEGER, INTENT (IN) :: isn
TYPE(t_stars),INTENT(IN):: stars
REAL, INTENT (INOUT) :: afft(0:27*stars%mx1*stars%mx2*stars%mx3-1)
REAL, INTENT (INOUT) :: bfft(0:27*stars%mx1*stars%mx2*stars%mx3-1)
INTEGER, INTENT(IN) :: isn
TYPE(t_stars), INTENT(IN):: stars
REAL, INTENT(INOUT) :: afft(0:27*stars%mx1*stars%mx2*stars%mx3 - 1)
REAL, INTENT(INOUT) :: bfft(0:27*stars%mx1*stars%mx2*stars%mx3 - 1)
COMPLEX :: fg3(stars%ng3)
LOGICAL,INTENT(IN),OPTIONAL :: scaled !< determines if coefficients are scaled by stars%nstr
LOGICAL, INTENT(IN), OPTIONAL :: scaled !< determines if coefficients are scaled by stars%nstr
INTEGER i,ifftd
INTEGER i, ifftd
REAL scale
COMPLEX ctmp
LOGICAL forw
INTEGER length_zfft(3)
complex :: zfft(0:27*stars%mx1*stars%mx2*stars%mx3-1)
complex :: zfft(0:27*stars%mx1*stars%mx2*stars%mx3 - 1)
ifftd = 27*stars%mx1*stars%mx2*stars%mx3
ifftd=27*stars%mx1*stars%mx2*stars%mx3
IF (isn.GT.0) THEN
IF (isn > 0) THEN
!
! ---> put stars onto the fft-grid
! ---> put stars onto the fft-grid
!
afft=0.0
bfft=0.0
DO i=0,stars%kimax
ctmp = fg3(stars%igfft(i,1))*stars%pgfft(i)
afft(stars%igfft(i,2))=real(ctmp)
bfft(stars%igfft(i,2))=aimag(ctmp)
ENDDO
afft = 0.0
bfft = 0.0
DO i = 0, stars%kimax
ctmp = fg3(stars%igfft(i, 1))*stars%pgfft(i)
afft(stars%igfft(i, 2)) = real(ctmp)
bfft(stars%igfft(i, 2)) = aimag(ctmp)
ENDDO
ENDIF
!---> now do the fft (isn=+1 : G -> r ; isn=-1 : r -> G)
zfft = cmplx(afft,bfft)
zfft = cmplx(afft, bfft)
if (isn == -1) then
forw = .true.
forw = .true.
else
forw = .false.
forw = .false.
end if
length_zfft(1) = 3*stars%mx1
length_zfft(2) = 3*stars%mx2
length_zfft(3) = 3*stars%mx3
call fft_interface(3,length_zfft,zfft,forw)
call fft_interface(3, length_zfft, zfft, forw)
afft = real(zfft)
bfft = aimag(zfft)
IF (isn.LT.0) THEN
IF (isn < 0) THEN
!
! ---> collect stars from the fft-grid
!
DO i=1,stars%ng3
fg3(i) = cmplx(0.0,0.0)
ENDDO
DO i=0,stars%kimax
fg3(stars%igfft(i,1)) = fg3(stars%igfft(i,1)) + CONJG( stars%pgfft(i) ) * &
& zfft(stars%igfft(i,2))
ENDDO
scale=1.0/ifftd
IF (PRESENT(scaled)) THEN
IF (scaled) THEN
fg3=scale*fg3/stars%nstr
ELSE
fg3=scale*fg3
ENDIF
ELSE
fg3=scale*fg3/stars%nstr
ENDIF
DO i = 1, stars%ng3
fg3(i) = cmplx(0.0, 0.0)
ENDDO
DO i = 0, stars%kimax
fg3(stars%igfft(i, 1)) = fg3(stars%igfft(i, 1)) + CONJG(stars%pgfft(i))* &
& zfft(stars%igfft(i, 2))
ENDDO
scale = 1.0/ifftd
IF (PRESENT(scaled)) THEN
IF (scaled) THEN
fg3 = scale*fg3/stars%nstr
ELSE
fg3 = scale*fg3
ENDIF
ELSE
fg3 = scale*fg3/stars%nstr
ENDIF
ENDIF
END SUBROUTINE fft3d
END MODULE m_fft3d
END SUBROUTINE fft3d
END MODULE m_fft3d
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment