LCOV - code coverage report
Current view: top level - src/pw/fft - fftsg_lib.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:f515968) Lines: 32 33 97.0 %
Date: 2022-07-03 19:52:34 Functions: 5 5 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2022 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : MODULE fftsg_lib
       8             :    USE fft_kinds,                       ONLY: dp
       9             :    USE mltfftsg_tools,                  ONLY: mltfftsg
      10             : 
      11             :    IMPLICIT NONE
      12             : 
      13             :    PRIVATE
      14             : 
      15             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'fftsg_lib'
      16             : 
      17             :    PUBLIC :: fftsg_do_init, fftsg_do_cleanup, fftsg_get_lengths, fftsg3d, fftsg1dm
      18             : 
      19             : CONTAINS
      20             : 
      21             : ! **************************************************************************************************
      22             : !> \brief ...
      23             : ! **************************************************************************************************
      24          10 :    SUBROUTINE fftsg_do_init()
      25             : 
      26             :       ! no init needed
      27             : 
      28          10 :    END SUBROUTINE
      29             : 
      30             : ! **************************************************************************************************
      31             : !> \brief ...
      32             : ! **************************************************************************************************
      33          10 :    SUBROUTINE fftsg_do_cleanup()
      34             : 
      35             :       ! no cleanup needed
      36             : 
      37          10 :    END SUBROUTINE
      38             : 
      39             : ! **************************************************************************************************
      40             : !> \brief ...
      41             : !> \param DATA ...
      42             : !> \param max_length ...
      43             : !> \par History
      44             : !>      Adapted to new interface structure
      45             : !> \author JGH
      46             : ! **************************************************************************************************
      47       92870 :    SUBROUTINE fftsg_get_lengths(DATA, max_length)
      48             : 
      49             :       INTEGER, DIMENSION(*)                              :: DATA
      50             :       INTEGER, INTENT(INOUT)                             :: max_length
      51             : 
      52             :       INTEGER, PARAMETER                                 :: rlen = 81
      53             :       INTEGER, DIMENSION(rlen), PARAMETER :: radix = (/2, 4, 6, 8, 9, 12, 15, 16, 18, 20, 24, 25, &
      54             :          27, 30, 32, 36, 40, 45, 48, 54, 60, 64, 72, 75, 80, 81, 90, 96, 100, 108, 120, 125, 128, &
      55             :          135, 144, 150, 160, 162, 180, 192, 200, 216, 225, 240, 243, 256, 270, 288, 300, 320, 324, &
      56             :          360, 375, 384, 400, 405, 432, 450, 480, 486, 500, 512, 540, 576, 600, 625, 640, 648, 675, &
      57             :          720, 729, 750, 768, 800, 810, 864, 900, 960, 972, 1000, 1024/)
      58             : 
      59             :       INTEGER                                            :: ndata
      60             : 
      61             : !------------------------------------------------------------------------------
      62             : 
      63       92870 :       ndata = MIN(max_length, rlen)
      64     7615340 :       DATA(1:ndata) = RADIX(1:ndata)
      65       92870 :       max_length = ndata
      66             : 
      67       92870 :    END SUBROUTINE fftsg_get_lengths
      68             : 
      69             : ! **************************************************************************************************
      70             : !> \brief ...
      71             : !> \param fft_in_place ...
      72             : !> \param fsign ...
      73             : !> \param scale ...
      74             : !> \param n ...
      75             : !> \param zin ...
      76             : !> \param zout ...
      77             : ! **************************************************************************************************
      78         886 :    SUBROUTINE fftsg3d(fft_in_place, fsign, scale, n, zin, zout)
      79             : 
      80             :       LOGICAL, INTENT(IN)                                :: fft_in_place
      81             :       INTEGER, INTENT(INOUT)                             :: fsign
      82             :       REAL(KIND=dp), INTENT(IN)                          :: scale
      83             :       INTEGER, DIMENSION(*), INTENT(IN)                  :: n
      84             :       COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT)      :: zin, zout
      85             : 
      86         886 :       COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:)        :: xf, yf
      87             :       INTEGER                                            :: nx, ny, nz
      88             : 
      89             : !------------------------------------------------------------------------------
      90             : 
      91         886 :       nx = n(1)
      92         886 :       ny = n(2)
      93         886 :       nz = n(3)
      94             : 
      95         886 :       IF (fft_in_place) THEN
      96             : 
      97        4410 :          ALLOCATE (xf(nx*ny*nz), yf(nx*ny*nz))
      98             : 
      99             :          CALL mltfftsg('N', 'T', zin, nx, ny*nz, xf, ny*nz, nx, nx, &
     100         882 :                        ny*nz, fsign, 1.0_dp)
     101             :          CALL mltfftsg('N', 'T', xf, ny, nx*nz, yf, nx*nz, ny, ny, &
     102         882 :                        nx*nz, fsign, 1.0_dp)
     103             :          CALL mltfftsg('N', 'T', yf, nz, ny*nx, zin, ny*nx, nz, nz, &
     104         882 :                        ny*nx, fsign, scale)
     105             : 
     106         882 :          DEALLOCATE (xf, yf)
     107             : 
     108             :       ELSE
     109             : 
     110          12 :          ALLOCATE (xf(nx*ny*nz))
     111             : 
     112             :          CALL mltfftsg('N', 'T', zin, nx, ny*nz, zout, ny*nz, nx, nx, &
     113           4 :                        ny*nz, fsign, 1.0_dp)
     114             :          CALL mltfftsg('N', 'T', zout, ny, nx*nz, xf, nx*nz, ny, ny, &
     115           4 :                        nx*nz, fsign, 1.0_dp)
     116             :          CALL mltfftsg('N', 'T', xf, nz, ny*nx, zout, ny*nx, nz, nz, &
     117           4 :                        ny*nx, fsign, scale)
     118             : 
     119           4 :          DEALLOCATE (xf)
     120             : 
     121             :       END IF
     122             : 
     123         886 :    END SUBROUTINE fftsg3d
     124             : 
     125             : ! **************************************************************************************************
     126             : !> \brief ...
     127             : !> \param fsign ...
     128             : !> \param trans ...
     129             : !> \param n ...
     130             : !> \param m ...
     131             : !> \param zin ...
     132             : !> \param zout ...
     133             : !> \param scale ...
     134             : ! **************************************************************************************************
     135       15402 :    SUBROUTINE fftsg1dm(fsign, trans, n, m, zin, zout, scale)
     136             : 
     137             :       INTEGER, INTENT(INOUT)                             :: fsign
     138             :       LOGICAL, INTENT(IN)                                :: trans
     139             :       INTEGER, INTENT(IN)                                :: n, m
     140             :       COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT)      :: zin
     141             :       COMPLEX(KIND=dp), DIMENSION(*), INTENT(OUT)        :: zout
     142             :       REAL(KIND=dp), INTENT(IN)                          :: scale
     143             : 
     144             : !------------------------------------------------------------------------------
     145             : 
     146       15402 :       IF (trans) THEN
     147       15402 :          IF (fsign > 0) THEN
     148        7572 :             CALL mltfftsg("T", "N", zin, m, n, zout, n, m, n, m, fsign, scale)
     149             :          ELSE
     150        7830 :             CALL mltfftsg("N", "T", zin, n, m, zout, m, n, n, m, fsign, scale)
     151             :          END IF
     152             :       ELSE
     153           0 :          CALL mltfftsg("N", "N", zin, n, m, zout, n, m, n, m, fsign, scale)
     154             :       END IF
     155             : 
     156       15402 :    END SUBROUTINE fftsg1dm
     157             : 
     158             : END MODULE
     159             : 

Generated by: LCOV version 1.15