fft3d.f90 2.8 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
      MODULE m_fft3d
      CONTAINS
      SUBROUTINE fft3d(&
     &                 afft,bfft,fg3,&
     &                 stars,isn,scaled)

!************************************************************
!*                                                          *
!* interface for fg3(star) -- FFT --> (a,b)fft (r) (isn=+1) *
!*         or (a,b)fft (r) -- FFT --> fg3(star)    (isn=-1) *
!*                                                          *
!* dimension of (a,b)fft is (3*k1d x 3*k2d x 3*k3d)         *
!* afft and bfft contain the real/imaginary part of the FFT *
!* igfft(i,1) is the pointer from the G-sphere to stars     *
!* igfft(i,2) is the pointer from the G-sphere to fft-grid  *
!* pgfft(i)   contains the phases of the G-vectors of sph.  *
!*                                                          *
!************************************************************
      USE m_types
Daniel Wortmann's avatar
Daniel Wortmann committed
20
      USE m_fft_interface
21 22 23 24
      IMPLICIT NONE
    
      INTEGER, INTENT (IN) :: isn
      TYPE(t_stars),INTENT(IN):: stars
25 26
      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)
27 28 29 30 31
      COMPLEX                 :: fg3(stars%ng3)
      LOGICAL,INTENT(IN),OPTIONAL :: scaled !< determines if coefficients are scaled by stars%nstr

      INTEGER i,ifftd
      REAL scale
32
      COMPLEX ctmp
Daniel Wortmann's avatar
Daniel Wortmann committed
33 34 35
      LOGICAL forw
      INTEGER length_zfft(3)
      complex :: zfft(0:27*stars%mx1*stars%mx2*stars%mx3-1)
36

37
      ifftd=27*stars%mx1*stars%mx2*stars%mx3
38 39 40 41 42 43 44 45
     
      IF (isn.GT.0) THEN
!
!  ---> put stars onto the fft-grid 
!
        afft=0.0
        bfft=0.0
        DO i=0,stars%kimax
46 47 48
          ctmp = fg3(stars%igfft(i,1))*stars%pgfft(i)
          afft(stars%igfft(i,2))=real(ctmp)
          bfft(stars%igfft(i,2))=aimag(ctmp)
49 50 51 52 53
        ENDDO
      ENDIF

!---> now do the fft (isn=+1 : G -> r ; isn=-1 : r -> G)

Daniel Wortmann's avatar
Daniel Wortmann committed
54 55 56 57 58 59 60 61 62 63 64 65 66
      zfft = cmplx(afft,bfft)
      if (isn == -1) then
          forw = .true.
      else
          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)

      afft = real(zfft)
      bfft = aimag(zfft)
67 68 69 70 71 72 73 74 75

      IF (isn.LT.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
76
          fg3(stars%igfft(i,1)) = fg3(stars%igfft(i,1)) + CONJG( stars%pgfft(i) ) * &
Daniel Wortmann's avatar
Daniel Wortmann committed
77
     &                 zfft(stars%igfft(i,2))
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
        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