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

!************************************************************
!*                                                          *
!* 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
      IMPLICIT NONE
Matthias Redies's avatar
Matthias Redies committed
22 23 24 25 26

      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)
27
      COMPLEX                 :: fg3(stars%ng3)
Matthias Redies's avatar
Matthias Redies committed
28
      LOGICAL, INTENT(IN), OPTIONAL :: scaled !< determines if coefficients are scaled by stars%nstr
29

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

      ifftd = 27*stars%mx1*stars%mx2*stars%mx3
38

Matthias Redies's avatar
Matthias Redies committed
39
      IF (isn > 0) THEN
40
!
Matthias Redies's avatar
Matthias Redies committed
41
!  ---> put stars onto the fft-grid
42
!
Matthias Redies's avatar
Matthias Redies committed
43 44 45 46 47 48 49
         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
50 51 52 53
      ENDIF

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

Matthias Redies's avatar
Matthias Redies committed
54
      zfft = cmplx(afft, bfft)
Daniel Wortmann's avatar
Daniel Wortmann committed
55
      if (isn == -1) then
Matthias Redies's avatar
Matthias Redies committed
56
         forw = .true.
Daniel Wortmann's avatar
Daniel Wortmann committed
57
      else
Matthias Redies's avatar
Matthias Redies committed
58
         forw = .false.
Daniel Wortmann's avatar
Daniel Wortmann committed
59 60 61 62
      end if
      length_zfft(1) = 3*stars%mx1
      length_zfft(2) = 3*stars%mx2
      length_zfft(3) = 3*stars%mx3
Matthias Redies's avatar
Matthias Redies committed
63
      call fft_interface(3, length_zfft, zfft, forw)
Daniel Wortmann's avatar
Daniel Wortmann committed
64 65 66

      afft = real(zfft)
      bfft = aimag(zfft)
67

Matthias Redies's avatar
Matthias Redies committed
68
      IF (isn < 0) THEN
69 70 71
!
!  ---> collect stars from the fft-grid
!
Matthias Redies's avatar
Matthias Redies committed
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
         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
89 90
      ENDIF

Matthias Redies's avatar
Matthias Redies committed
91 92
   END SUBROUTINE fft3d
END MODULE m_fft3d