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

          Line data    Source code
       1             : MODULE m_fft3dxc
       2             : CONTAINS
       3        4425 :    SUBROUTINE fft3dxc( &
       4        4425 :       afft, bfft, fg3, &
       5             :       k1d, k2d, k3d, ng3, kimax, isn, &
       6        4425 :       igfft1, igfft2, pgfft, nstr)
       7             : 
       8             : !***********************************************************
       9             : !                                                          *
      10             : ! interface for fg3(star) -- fft --> (a,b)fft (r) (isn=+1) *
      11             : !         or (a,b)fft (r) -- fft --> fg3(star)    (isn=-1) *
      12             : !                                                          *
      13             : ! dimension of (a,b)fft is (k1d x k2d x k3d)               *
      14             : ! afft and bfft contain the real/imaginary part of the fft *
      15             : ! igfft1(i)  is the pointer from the g-sphere to stars     *
      16             : ! igfft2(i)  is the pointer from the g-sphere to fft-grid  *
      17             : ! pgfft(i)   contains the phases of the g-vectors of sph.  *
      18             : !                                                          *
      19             : !***********************************************************
      20             : 
      21             :       USE m_fft_interface
      22             :       IMPLICIT NONE
      23             : 
      24             :       INTEGER :: k1d, k2d, k3d, ng3, kimax, isn
      25             :       INTEGER :: igfft1(0:k1d*k2d*k3d-1), igfft2(0:k1d*k2d*k3d-1)
      26             :       INTEGER :: nstr(ng3)
      27             :       COMPLEX pgfft(0:k1d*k2d*k3d-1)
      28             :       REAL ::    afft(0:k1d*k2d*k3d-1), bfft(0:k1d*k2d*k3d-1)
      29             :       COMPLEX :: fg3(ng3)
      30             : 
      31             :       INTEGER :: i, ifftd
      32             :       REAL :: scale, zero
      33             :       COMPLEX :: ctmp
      34             : 
      35             :       LOGICAL :: forw
      36             :       INTEGER :: length_zfft(3)
      37        8850 :       complex :: zfft(0:k1d*k2d*k3d-1)
      38             : 
      39        4425 :       ifftd = k1d*k2d*k3d
      40        4425 :       zero = 0.0
      41             : 
      42        4425 :       IF (isn > 0) THEN
      43             : 
      44             :          !  ---> put stars onto the fft-grid
      45             : 
      46    23975234 :          afft = 0.0
      47    23975234 :          bfft = 0.0
      48     7851584 :          DO i = 0, kimax - 1
      49     7847970 :             ctmp = fg3(igfft1(i))*pgfft(i)
      50     7847970 :             afft(igfft2(i)) = real(ctmp)
      51     7851584 :             bfft(igfft2(i)) = aimag(ctmp)
      52             :          ENDDO
      53             :       ENDIF
      54             : 
      55             : !---> now do the fft (isn=+1 : g -> r ; isn=-1 : r -> g)
      56             : 
      57    29644470 :       zfft = cmplx(afft, bfft)
      58        4425 :       if (isn == -1) then
      59         811 :          forw = .TRUE.
      60             :       else
      61        3614 :          forw = .FALSE.
      62             :       end if
      63        4425 :       length_zfft(1) = k1d
      64        4425 :       length_zfft(2) = k2d
      65        4425 :       length_zfft(3) = k3d
      66        4425 :       call fft_interface(3, length_zfft, zfft, forw)
      67    29644470 :       afft = real(zfft)
      68    29644470 :       bfft = aimag(zfft)
      69             : 
      70        4425 :       IF (isn < 0) THEN
      71             : 
      72             :          !  ---> collect stars from the fft-grid
      73             : 
      74      464457 :          DO i = 1, ng3
      75      464457 :             fg3(i) = cmplx(0.0, 0.0)
      76             :          ENDDO
      77         811 :          scale = 1.0/ifftd
      78     1855742 :          DO i = 0, kimax - 1
      79             :             fg3(igfft1(i)) = fg3(igfft1(i)) + CONJG(pgfft(i))* &
      80         811 :                              zfft(igfft2(i))
      81             :          ENDDO
      82      928103 :          DO i = 1, ng3
      83      464457 :             fg3(i) = scale*fg3(i)/nstr(i)
      84             :          ENDDO
      85             :       ENDIF
      86             : 
      87        4425 :    END SUBROUTINE fft3dxc
      88             : END MODULE m_fft3dxc

Generated by: LCOV version 1.13