LCOV - code coverage report
Current view: top level - math - fft3d.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 30 33 90.9 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             : MODULE m_fft3d
       2             : CONTAINS
       3       12299 :    SUBROUTINE fft3d(&
       4       12299 :   &                 afft, bfft, fg3,&
       5             :   &                 stars, isn, scaled)
       6             : 
       7             : !************************************************************
       8             : !*                                                          *
       9             : !* interface for fg3(star) -- FFT --> (a,b)fft (r) (isn=+1) *
      10             : !*         or (a,b)fft (r) -- FFT --> fg3(star)    (isn=-1) *
      11             : !*                                                          *
      12             : !* dimension of (a,b)fft is (3*k1d x 3*k2d x 3*k3d)         *
      13             : !* afft and bfft contain the real/imaginary part of the FFT *
      14             : !* igfft(i,1) is the pointer from the G-sphere to stars     *
      15             : !* igfft(i,2) is the pointer from the G-sphere to fft-grid  *
      16             : !* pgfft(i)   contains the phases of the G-vectors of sph.  *
      17             : !*                                                          *
      18             : !************************************************************
      19             :       USE m_types
      20             :       USE m_fft_interface
      21             :       IMPLICIT NONE
      22             : 
      23             :       INTEGER, INTENT(IN) :: isn
      24             :       TYPE(t_stars), INTENT(IN):: stars
      25             :       REAL, INTENT(INOUT) :: afft(0:27*stars%mx1*stars%mx2*stars%mx3 - 1)
      26             :       REAL, INTENT(INOUT) :: bfft(0:27*stars%mx1*stars%mx2*stars%mx3 - 1)
      27             :       COMPLEX                 :: fg3(stars%ng3)
      28             :       LOGICAL, INTENT(IN), OPTIONAL :: scaled !< determines if coefficients are scaled by stars%nstr
      29             : 
      30             :       INTEGER i, ifftd
      31             :       REAL scale
      32             :       COMPLEX ctmp
      33             :       LOGICAL forw
      34             :       INTEGER length_zfft(3)
      35       24598 :       complex :: zfft(0:27*stars%mx1*stars%mx2*stars%mx3 - 1)
      36             : 
      37       12299 :       ifftd = 27*stars%mx1*stars%mx2*stars%mx3
      38             : 
      39       12299 :       IF (isn > 0) THEN
      40             : !
      41             : !  ---> put stars onto the fft-grid
      42             : !
      43   100041451 :          afft = 0.0
      44   100041451 :          bfft = 0.0
      45    18178626 :          DO i = 0, stars%kimax
      46    18172499 :             ctmp = fg3(stars%igfft(i, 1))*stars%pgfft(i)
      47    18172499 :             afft(stars%igfft(i, 2)) = real(ctmp)
      48    18178626 :             bfft(stars%igfft(i, 2)) = aimag(ctmp)
      49             :          ENDDO
      50             :       ENDIF
      51             : 
      52             : !---> now do the fft (isn=+1 : G -> r ; isn=-1 : r -> G)
      53             : 
      54   202435187 :       zfft = cmplx(afft, bfft)
      55       12299 :       if (isn == -1) then
      56        6172 :          forw = .true.
      57             :       else
      58        6127 :          forw = .false.
      59             :       end if
      60       12299 :       length_zfft(1) = 3*stars%mx1
      61       12299 :       length_zfft(2) = 3*stars%mx2
      62       12299 :       length_zfft(3) = 3*stars%mx3
      63       12299 :       call fft_interface(3, length_zfft, zfft, forw)
      64             : 
      65   202435187 :       afft = real(zfft)
      66   202435187 :       bfft = aimag(zfft)
      67             : 
      68       12299 :       IF (isn < 0) THEN
      69             : !
      70             : !  ---> collect stars from the fft-grid
      71             : !
      72     7017754 :          DO i = 1, stars%ng3
      73     3511963 :             fg3(i) = cmplx(0.0, 0.0)
      74             :          ENDDO
      75    18547626 :          DO i = 0, stars%kimax
      76             :             fg3(stars%igfft(i, 1)) = fg3(stars%igfft(i, 1)) + CONJG(stars%pgfft(i))* &
      77    18547626 :        &                 zfft(stars%igfft(i, 2))
      78             :          ENDDO
      79        6172 :          scale = 1.0/ifftd
      80        6172 :          IF (PRESENT(scaled)) THEN
      81           0 :             IF (scaled) THEN
      82           0 :                fg3 = scale*fg3/stars%nstr
      83             :             ELSE
      84           0 :                fg3 = scale*fg3
      85             :             ENDIF
      86             :          ELSE
      87        6172 :             fg3 = scale*fg3/stars%nstr
      88             :          ENDIF
      89             :       ENDIF
      90             : 
      91       12299 :    END SUBROUTINE fft3d
      92             : END MODULE m_fft3d

Generated by: LCOV version 1.13