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

          Line data    Source code
       1             : MODULE m_fft2d
       2             : CONTAINS
       3        9300 :   SUBROUTINE fft2d(&
       4             :        &                 stars,&
       5        9300 :        &                 afft2,bfft2,&
       6        9300 :        &                 fg,fgi,fgxy,&
       7             :        &                 stride,isn,&
       8        9300 :        &                 gfxy )
       9             : 
      10             :     !*************************************************************
      11             :     !*                                                           *
      12             :     !* interface for fg2(star) -- FFT --> gfft (r)     (isn=+1)  *
      13             :     !*            or gfft (r)  -- FFT --> fg2(star)    (isn=-1)  *
      14             :     !*                                                           *
      15             :     !* dimension of gfft2 is (3*stars%mx1 x 3*stars%mx2)                     *
      16             :     !* afft/bfft contain the real/imaginary part of gfft         *
      17             :     !* stars%igfft2(i,1) is the pointer from the G-sphere to stars     *
      18             :     !* stars%igfft2(i,2) is the pointer from the G-sphere to fft-grid  *
      19             :     !* stars%pgfft2(i)   contains the phases of the G-vectors of sph.  *
      20             :     !*                                                           *
      21             :     !*************************************************************
      22             : #include"cpp_double.h"
      23             :     USE m_cfft
      24             :     USE m_types
      25             :     IMPLICIT NONE
      26             :     TYPE(t_stars),INTENT(IN) :: stars
      27             :     INTEGER, INTENT (IN) :: isn,stride
      28             :     REAL                 :: fg,fgi
      29             : 
      30             :     REAL,   INTENT (INOUT):: afft2(0:9*stars%mx1*stars%mx2-1),bfft2(0:9*stars%mx1*stars%mx2-1)
      31             :     COMPLEX               :: fgxy(stride,stars%ng2-1)
      32             :     REAL,OPTIONAL,INTENT(IN) :: gfxy(0:) !factor to calculate the derivates, i.e. g_x
      33             : 
      34             :     !... local variables
      35             : 
      36             :     INTEGER i,ifftd2
      37             :     REAL  scale
      38       18600 :     COMPLEX fg2(stars%ng2)
      39             : 
      40        9300 :     ifftd2=9*stars%mx1*stars%mx2
      41             :     !
      42        9300 :     IF (isn.GT.0) THEN
      43             :        !
      44             :        !  ---> put stars onto the fft-grid 
      45             :        !
      46        8000 :        fg2(1) = CMPLX(fg,fgi)
      47        8000 :        CALL CPP_BLAS_ccopy(stars%ng2-1,fgxy,stride,fg2(2),1)
      48             :        !fg2(2:)=fgxy(1,:)
      49     7658000 :        afft2=0.0
      50     7658000 :        bfft2=0.0
      51        8000 :        IF (PRESENT(gfxy)) THEN
      52     3914400 :           DO i=0,stars%kimax2
      53     1951600 :              afft2(stars%igfft2(i,2))=REAL(fg2(stars%igfft2(i,1))*stars%pgfft2(i))*gfxy(i)
      54     1957200 :              bfft2(stars%igfft2(i,2))=AIMAG(fg2(stars%igfft2(i,1))*stars%pgfft2(i))*gfxy(i)
      55             :           ENDDO
      56             :        ELSE 
      57     1677600 :           DO i=0,stars%kimax2
      58      836400 :              afft2(stars%igfft2(i,2))=REAL(fg2(stars%igfft2(i,1))*stars%pgfft2(i))
      59      838800 :              bfft2(stars%igfft2(i,2))=AIMAG(fg2(stars%igfft2(i,1))*stars%pgfft2(i))
      60             :           ENDDO
      61             :        ENDIF
      62             :     ENDIF
      63             : 
      64             :     !---> now do the fft (isn=+1 : G -> r ; isn=-1 : r -> G)
      65             : 
      66        9300 :     CALL cfft(afft2,bfft2,ifftd2,3*stars%mx1,3*stars%mx1,isn)
      67        9300 :     CALL cfft(afft2,bfft2,ifftd2,3*stars%mx2,ifftd2,isn)
      68             : 
      69        9300 :     IF (isn.LT.0) THEN
      70             :        !
      71             :        !  ---> collect stars from the fft-grid
      72             :        !
      73      642300 :        DO i=1,stars%ng2
      74      321800 :           fg2(i) = CMPLX(0.0,0.0)
      75             :        ENDDO
      76        1300 :        scale=1.0/ifftd2
      77      463400 :        DO i=0,stars%kimax2
      78             :           fg2(stars%igfft2(i,1))=fg2(stars%igfft2(i,1))+ CONJG( stars%pgfft2(i) ) * &
      79      463400 :                &                 CMPLX(afft2(stars%igfft2(i,2)),bfft2(stars%igfft2(i,2)))
      80             :        ENDDO
      81        1300 :        fg=scale*REAL(fg2(1))/stars%nstr2(1)
      82        1300 :        fgi=scale*AIMAG(fg2(1))/stars%nstr2(1)
      83      320500 :        DO i=2,stars%ng2
      84      320500 :           fgxy(1,i-1)=scale*fg2(i)/stars%nstr2(i)
      85             :        ENDDO
      86             :     ENDIF
      87             : 
      88        9300 :   END SUBROUTINE fft2d
      89             : END MODULE m_fft2d

Generated by: LCOV version 1.13