LCOV - code coverage report
Current view: top level - src/pw/fft - fftsg_lib.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 97.0 % 33 32
Test Date: 2025-07-25 12:55:17 Functions: 100.0 % 5 5

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 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           12 :    SUBROUTINE fftsg_do_init()
      25              : 
      26              :       ! no init needed
      27              : 
      28           12 :    END SUBROUTINE
      29              : 
      30              : ! **************************************************************************************************
      31              : !> \brief ...
      32              : ! **************************************************************************************************
      33           12 :    SUBROUTINE fftsg_do_cleanup()
      34              : 
      35              :       ! no cleanup needed
      36              : 
      37           12 :    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       114848 :    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       114848 :       ndata = MIN(max_length, rlen)
      64      9417536 :       DATA(1:ndata) = RADIX(1:ndata)
      65       114848 :       max_length = ndata
      66              : 
      67       114848 :    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         2884 :    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         2884 :       COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:)        :: xf, yf
      87              :       INTEGER                                            :: nx, ny, nz
      88              : 
      89              : !------------------------------------------------------------------------------
      90              : 
      91         2884 :       nx = n(1)
      92         2884 :       ny = n(2)
      93         2884 :       nz = n(3)
      94              : 
      95         2884 :       IF (fft_in_place) THEN
      96              : 
      97        11520 :          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         2880 :                        ny*nz, fsign, 1.0_dp)
     101              :          CALL mltfftsg('N', 'T', xf, ny, nx*nz, yf, nx*nz, ny, ny, &
     102         2880 :                        nx*nz, fsign, 1.0_dp)
     103              :          CALL mltfftsg('N', 'T', yf, nz, ny*nx, zin, ny*nx, nz, nz, &
     104         2880 :                        ny*nx, fsign, scale)
     105              : 
     106         2880 :          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         2884 :    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        16458 :    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        16458 :       IF (trans) THEN
     147        16458 :          IF (fsign > 0) THEN
     148         8082 :             CALL mltfftsg("T", "N", zin, m, n, zout, n, m, n, m, fsign, scale)
     149              :          ELSE
     150         8376 :             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        16458 :    END SUBROUTINE fftsg1dm
     157              : 
     158              : END MODULE
     159              : 
        

Generated by: LCOV version 2.0-1