LCOV - code coverage report
Current view: top level - src - gw_kp_to_real_space_and_back.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 88.2 % 68 60
Test Date: 2025-07-25 12:55:17 Functions: 85.7 % 7 6

            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              : 
       8              : ! **************************************************************************************************
       9              : !> \brief
      10              : !> \author Jan Wilhelm
      11              : !> \date 05.2024
      12              : ! **************************************************************************************************
      13              : MODULE gw_kp_to_real_space_and_back
      14              :    USE cp_cfm_types,                    ONLY: cp_cfm_type
      15              :    USE cp_fm_types,                     ONLY: cp_fm_set_all,&
      16              :                                               cp_fm_type
      17              :    USE kinds,                           ONLY: dp
      18              :    USE kpoint_types,                    ONLY: kpoint_type
      19              :    USE mathconstants,                   ONLY: gaussi,&
      20              :                                               twopi,&
      21              :                                               z_one,&
      22              :                                               z_zero
      23              : #include "./base/base_uses.f90"
      24              : 
      25              :    IMPLICIT NONE
      26              : 
      27              :    PRIVATE
      28              : 
      29              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'gw_kp_to_real_space_and_back'
      30              : 
      31              :    PUBLIC :: fm_trafo_rs_to_ikp, trafo_rs_to_ikp, trafo_ikp_to_rs, fm_add_ikp_to_rs, &
      32              :              add_ikp_to_all_rs
      33              : 
      34              : CONTAINS
      35              : 
      36              : ! **************************************************************************************************
      37              : !> \brief ...
      38              : !> \param cfm_ikp ...
      39              : !> \param fm_rs ...
      40              : !> \param kpoints ...
      41              : !> \param ikp ...
      42              : ! **************************************************************************************************
      43         2806 :    SUBROUTINE fm_trafo_rs_to_ikp(cfm_ikp, fm_rs, kpoints, ikp)
      44              :       TYPE(cp_cfm_type)                                  :: cfm_ikp
      45              :       TYPE(cp_fm_type), DIMENSION(:)                     :: fm_rs
      46              :       TYPE(kpoint_type), POINTER                         :: kpoints
      47              :       INTEGER                                            :: ikp
      48              : 
      49              :       CHARACTER(LEN=*), PARAMETER :: routineN = 'fm_trafo_rs_to_ikp'
      50              : 
      51              :       INTEGER                                            :: handle, img, nimages, nimages_fm_rs
      52              : 
      53         2806 :       CALL timeset(routineN, handle)
      54              : 
      55         2806 :       nimages = SIZE(kpoints%index_to_cell, 1)
      56         2806 :       nimages_fm_rs = SIZE(fm_rs)
      57              : 
      58         2806 :       CPASSERT(nimages == nimages_fm_rs)
      59              : 
      60       193703 :       cfm_ikp%local_data(:, :) = z_zero
      61        28060 :       DO img = 1, nimages
      62              : 
      63              :          CALL add_rs_to_ikp(fm_rs(img)%local_data, cfm_ikp%local_data, kpoints%index_to_cell, &
      64        28060 :                             kpoints%xkp(1:3, ikp), img)
      65              : 
      66              :       END DO
      67              : 
      68         2806 :       CALL timestop(handle)
      69              : 
      70         2806 :    END SUBROUTINE fm_trafo_rs_to_ikp
      71              : 
      72              : ! **************************************************************************************************
      73              : !> \brief ...
      74              : !> \param array_rs ...
      75              : !> \param array_kp ...
      76              : !> \param index_to_cell ...
      77              : !> \param xkp ...
      78              : ! **************************************************************************************************
      79        18720 :    SUBROUTINE trafo_rs_to_ikp(array_rs, array_kp, index_to_cell, xkp)
      80              :       REAL(KIND=dp), DIMENSION(:, :, :)                  :: array_rs
      81              :       COMPLEX(KIND=dp), DIMENSION(:, :)                  :: array_kp
      82              :       INTEGER, DIMENSION(:, :)                           :: index_to_cell
      83              :       REAL(KIND=dp)                                      :: xkp(3)
      84              : 
      85              :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'trafo_rs_to_ikp'
      86              : 
      87              :       INTEGER                                            :: handle, i_cell, nimages
      88              : 
      89        18720 :       CALL timeset(routineN, handle)
      90              : 
      91        18720 :       nimages = SIZE(index_to_cell, 1)
      92              : 
      93        18720 :       CPASSERT(nimages == SIZE(array_rs, 3))
      94              : 
      95       708576 :       array_kp(:, :) = 0.0_dp
      96       187200 :       DO i_cell = 1, nimages
      97              : 
      98       187200 :          CALL add_rs_to_ikp(array_rs(:, :, i_cell), array_kp, index_to_cell, xkp, i_cell)
      99              : 
     100              :       END DO
     101              : 
     102        18720 :       CALL timestop(handle)
     103              : 
     104        18720 :    END SUBROUTINE trafo_rs_to_ikp
     105              : 
     106              : ! **************************************************************************************************
     107              : !> \brief ...
     108              : !> \param array_rs ...
     109              : !> \param array_kp ...
     110              : !> \param index_to_cell ...
     111              : !> \param xkp ...
     112              : !> \param i_cell ...
     113              : ! **************************************************************************************************
     114       193734 :    SUBROUTINE add_rs_to_ikp(array_rs, array_kp, index_to_cell, xkp, i_cell)
     115              :       REAL(KIND=dp), DIMENSION(:, :)                     :: array_rs
     116              :       COMPLEX(KIND=dp), DIMENSION(:, :)                  :: array_kp
     117              :       INTEGER, DIMENSION(:, :)                           :: index_to_cell
     118              :       REAL(KIND=dp)                                      :: xkp(3)
     119              :       INTEGER                                            :: i_cell
     120              : 
     121              :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'add_rs_to_ikp'
     122              : 
     123              :       COMPLEX(KIND=dp)                                   :: expikR
     124              :       INTEGER                                            :: handle
     125              :       REAL(KIND=dp)                                      :: arg
     126              : 
     127       193734 :       CALL timeset(routineN, handle)
     128              : 
     129              :       arg = REAL(index_to_cell(i_cell, 1), dp)*xkp(1) + &
     130              :             REAL(index_to_cell(i_cell, 2), dp)*xkp(2) + &
     131       193734 :             REAL(index_to_cell(i_cell, 3), dp)*xkp(3)
     132              : 
     133       193734 :       expikR = z_one*COS(twopi*arg) + gaussi*SIN(twopi*arg)
     134              : 
     135      8120511 :       array_kp(:, :) = array_kp(:, :) + expikR*array_rs(:, :)
     136              : 
     137       193734 :       CALL timestop(handle)
     138              : 
     139       193734 :    END SUBROUTINE add_rs_to_ikp
     140              : 
     141              : ! **************************************************************************************************
     142              : !> \brief ...
     143              : !> \param array_kp ...
     144              : !> \param array_rs ...
     145              : !> \param cell ...
     146              : !> \param kpoints ...
     147              : ! **************************************************************************************************
     148            0 :    SUBROUTINE trafo_ikp_to_rs(array_kp, array_rs, cell, kpoints)
     149              :       COMPLEX(KIND=dp), DIMENSION(:, :, :)               :: array_kp
     150              :       REAL(KIND=dp), DIMENSION(:, :)                     :: array_rs
     151              :       INTEGER                                            :: cell(3)
     152              :       TYPE(kpoint_type), POINTER                         :: kpoints
     153              : 
     154              :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'trafo_ikp_to_rs'
     155              : 
     156              :       INTEGER                                            :: handle, ikp
     157              : 
     158            0 :       CALL timeset(routineN, handle)
     159              : 
     160            0 :       CPASSERT(kpoints%nkp == SIZE(array_kp, 3))
     161              : 
     162            0 :       array_rs(:, :) = 0.0_dp
     163              : 
     164            0 :       DO ikp = 1, kpoints%nkp
     165              : 
     166            0 :          CALL add_ikp_to_rs(array_kp(:, :, ikp), array_rs, cell, kpoints, ikp)
     167              : 
     168              :       END DO
     169              : 
     170            0 :       CALL timestop(handle)
     171              : 
     172            0 :    END SUBROUTINE trafo_ikp_to_rs
     173              : 
     174              : ! **************************************************************************************************
     175              : !> \brief ...
     176              : !> \param cfm_ikp ...
     177              : !> \param fm_rs ...
     178              : !> \param kpoints ...
     179              : !> \param ikp ...
     180              : ! **************************************************************************************************
     181         2912 :    SUBROUTINE fm_add_ikp_to_rs(cfm_ikp, fm_rs, kpoints, ikp)
     182              :       TYPE(cp_cfm_type)                                  :: cfm_ikp
     183              :       TYPE(cp_fm_type), DIMENSION(:)                     :: fm_rs
     184              :       TYPE(kpoint_type), POINTER                         :: kpoints
     185              :       INTEGER                                            :: ikp
     186              : 
     187              :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'fm_add_ikp_to_rs'
     188              : 
     189              :       INTEGER                                            :: handle, img, nimages, nimages_fm_rs
     190         2912 :       INTEGER, ALLOCATABLE, DIMENSION(:, :)              :: index_to_cell
     191              : 
     192         2912 :       CALL timeset(routineN, handle)
     193              : 
     194         2912 :       nimages = SIZE(kpoints%index_to_cell, 1)
     195         2912 :       nimages_fm_rs = SIZE(fm_rs)
     196              : 
     197         2912 :       CPASSERT(nimages == nimages_fm_rs)
     198              : 
     199         8736 :       ALLOCATE (index_to_cell(nimages, 3))
     200        90272 :       index_to_cell(1:nimages, 1:3) = kpoints%index_to_cell(1:nimages, 1:3)
     201              : 
     202        29120 :       DO img = 1, nimages
     203              : 
     204        26208 :          IF (ikp == 1) CALL cp_fm_set_all(fm_rs(img), 0.0_dp)
     205              : 
     206              :          CALL add_ikp_to_rs(cfm_ikp%local_data(:, :), fm_rs(img)%local_data, &
     207       186368 :                             index_to_cell(img, 1:3), kpoints, ikp)
     208              : 
     209              :       END DO
     210              : 
     211         2912 :       CALL timestop(handle)
     212              : 
     213         5824 :    END SUBROUTINE fm_add_ikp_to_rs
     214              : 
     215              : ! **************************************************************************************************
     216              : !> \brief ...
     217              : !> \param array_kp ...
     218              : !> \param array_rs ...
     219              : !> \param kpoints ...
     220              : !> \param ikp ...
     221              : !> \param index_to_cell_ext ...
     222              : ! **************************************************************************************************
     223        14480 :    SUBROUTINE add_ikp_to_all_rs(array_kp, array_rs, kpoints, ikp, index_to_cell_ext)
     224              :       COMPLEX(KIND=dp), DIMENSION(:, :)                  :: array_kp
     225              :       REAL(KIND=dp), DIMENSION(:, :, :)                  :: array_rs
     226              :       TYPE(kpoint_type), POINTER                         :: kpoints
     227              :       INTEGER                                            :: ikp
     228              :       INTEGER, DIMENSION(:, :), OPTIONAL, POINTER        :: index_to_cell_ext
     229              : 
     230              :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'add_ikp_to_all_rs'
     231              : 
     232              :       INTEGER                                            :: cell(3), handle, img, nimages
     233        14480 :       INTEGER, DIMENSION(:, :), POINTER                  :: index_to_cell
     234              : 
     235        14480 :       CALL timeset(routineN, handle)
     236              : 
     237        14480 :       IF (PRESENT(index_to_cell_ext)) THEN
     238        14080 :          index_to_cell => index_to_cell_ext
     239              :       ELSE
     240          400 :          index_to_cell => kpoints%index_to_cell
     241              :       END IF
     242              : 
     243        14480 :       nimages = SIZE(index_to_cell, 1)
     244        14480 :       CPASSERT(SIZE(array_rs, 3) == nimages)
     245       144800 :       DO img = 1, nimages
     246              : 
     247       521280 :          cell(1:3) = index_to_cell(img, 1:3)
     248              : 
     249       144800 :          CALL add_ikp_to_rs(array_kp, array_rs(:, :, img), cell, kpoints, ikp)
     250              : 
     251              :       END DO
     252              : 
     253        14480 :       CALL timestop(handle)
     254              : 
     255        14480 :    END SUBROUTINE add_ikp_to_all_rs
     256              : 
     257              : ! **************************************************************************************************
     258              : !> \brief ...
     259              : !> \param array_kp ...
     260              : !> \param array_rs ...
     261              : !> \param cell ...
     262              : !> \param kpoints ...
     263              : !> \param ikp ...
     264              : ! **************************************************************************************************
     265       156528 :    SUBROUTINE add_ikp_to_rs(array_kp, array_rs, cell, kpoints, ikp)
     266              :       COMPLEX(KIND=dp), DIMENSION(:, :)                  :: array_kp
     267              :       REAL(KIND=dp), DIMENSION(:, :)                     :: array_rs
     268              :       INTEGER                                            :: cell(3)
     269              :       TYPE(kpoint_type), POINTER                         :: kpoints
     270              :       INTEGER                                            :: ikp
     271              : 
     272              :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'add_ikp_to_rs'
     273              : 
     274              :       INTEGER                                            :: handle
     275              :       REAL(KIND=dp)                                      :: arg, im, re
     276              : 
     277       156528 :       CALL timeset(routineN, handle)
     278              : 
     279              :       arg = REAL(cell(1), dp)*kpoints%xkp(1, ikp) + &
     280              :             REAL(cell(2), dp)*kpoints%xkp(2, ikp) + &
     281       156528 :             REAL(cell(3), dp)*kpoints%xkp(3, ikp)
     282              : 
     283       156528 :       re = COS(twopi*arg)*kpoints%wkp(ikp)
     284       156528 :       im = SIN(twopi*arg)*kpoints%wkp(ikp)
     285              : 
     286      7117056 :       array_rs(:, :) = array_rs(:, :) + re*REAL(array_kp(:, :)) + im*AIMAG(array_kp(:, :))
     287              : 
     288       156528 :       CALL timestop(handle)
     289              : 
     290       156528 :    END SUBROUTINE add_ikp_to_rs
     291              : 
     292              : END MODULE gw_kp_to_real_space_and_back
        

Generated by: LCOV version 2.0-1