Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief Transfers densities from PW to RS grids and potentials from PW to RS
      10             : !> \par History
      11             : !>      - Copied from qs_coolocate_Density and qs_integrate_potenntial
      12             : !> \author JGH (04.2014)
      13             : ! **************************************************************************************************
      14             : MODULE rs_pw_interface
      15             :    USE cp_log_handling,                 ONLY: cp_to_string
      16             :    USE cp_spline_utils,                 ONLY: pw_interp,&
      17             :                                               pw_prolongate_s3,&
      18             :                                               pw_restrict_s3,&
      19             :                                               spline3_pbc_interp
      20             :    USE gaussian_gridlevels,             ONLY: gridlevel_info_type
      21             :    USE input_section_types,             ONLY: section_vals_val_get
      22             :    USE kinds,                           ONLY: dp
      23             :    USE pw_env_types,                    ONLY: pw_env_get,&
      24             :                                               pw_env_type
      25             :    USE pw_methods,                      ONLY: pw_axpy,&
      26             :                                               pw_copy,&
      27             :                                               pw_transfer,&
      28             :                                               pw_zero
      29             :    USE pw_pool_types,                   ONLY: pw_pool_p_type,&
      30             :                                               pw_pools_create_pws,&
      31             :                                               pw_pools_give_back_pws
      32             :    USE pw_types,                        ONLY: pw_c1d_gs_type,&
      33             :                                               pw_r3d_rs_type
      34             :    USE realspace_grid_types,            ONLY: realspace_grid_desc_p_type,&
      35             :                                               realspace_grid_type,&
      36             :                                               transfer_pw2rs,&
      37             :                                               transfer_rs2pw
      38             : #include "../base/base_uses.f90"
      39             : 
      40             :    IMPLICIT NONE
      41             : 
      42             :    PRIVATE
      43             : 
      44             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rs_pw_interface'
      45             : ! *** Public subroutines ***
      46             : 
      47             :    PUBLIC :: density_rs2pw, &
      48             :              potential_pw2rs
      49             : 
      50             : CONTAINS
      51             : 
      52             : ! **************************************************************************************************
      53             : !> \brief given partial densities on the realspace multigrids,
      54             : !>      computes the full density on the plane wave grids, both in real and
      55             : !>      gspace
      56             : !> \param pw_env ...
      57             : !> \param rs_rho ...
      58             : !> \param rho ...
      59             : !> \param rho_gspace ...
      60             : !> \note
      61             : !>      should contain all communication in the collocation of the density
      62             : !>      in the case of replicated grids
      63             : ! **************************************************************************************************
      64      194017 :    SUBROUTINE density_rs2pw(pw_env, rs_rho, rho, rho_gspace)
      65             : 
      66             :       TYPE(pw_env_type), INTENT(IN)                      :: pw_env
      67             :       TYPE(realspace_grid_type), DIMENSION(:), &
      68             :          INTENT(IN)                                      :: rs_rho
      69             :       TYPE(pw_r3d_rs_type), INTENT(INOUT)                :: rho
      70             :       TYPE(pw_c1d_gs_type), INTENT(INOUT)                :: rho_gspace
      71             : 
      72             :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'density_rs2pw'
      73             : 
      74             :       INTEGER                                            :: handle, igrid_level, interp_kind
      75             :       TYPE(gridlevel_info_type), POINTER                 :: gridlevel_info
      76      194017 :       TYPE(pw_c1d_gs_type), ALLOCATABLE, DIMENSION(:)    :: mgrid_gspace
      77      194017 :       TYPE(pw_pool_p_type), DIMENSION(:), POINTER        :: pw_pools
      78      194017 :       TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:)    :: mgrid_rspace
      79             :       TYPE(realspace_grid_desc_p_type), DIMENSION(:), &
      80      194017 :          POINTER                                         :: rs_descs
      81             : 
      82      194017 :       CALL timeset(routineN, handle)
      83      194017 :       NULLIFY (gridlevel_info, rs_descs, pw_pools)
      84      194017 :       CALL pw_env_get(pw_env, rs_descs=rs_descs, pw_pools=pw_pools)
      85             : 
      86      194017 :       gridlevel_info => pw_env%gridlevel_info
      87             : 
      88      194017 :       CALL section_vals_val_get(pw_env%interp_section, "KIND", i_val=interp_kind)
      89             : 
      90      194017 :       CALL pw_pools_create_pws(pw_pools, mgrid_rspace)
      91             : 
      92      194017 :       CALL pw_pools_create_pws(pw_pools, mgrid_gspace)
      93             : 
      94      194017 :       IF (gridlevel_info%ngrid_levels == 1) THEN
      95        4824 :          CALL transfer_rs2pw(rs_rho(1), rho)
      96        4824 :          CALL pw_transfer(rho, rho_gspace)
      97        4824 :          IF (rho%pw_grid%spherical) THEN ! rho_gspace = rho
      98           0 :             CALL pw_transfer(rho_gspace, rho)
      99             :          END IF
     100             :       ELSE
     101      954837 :          DO igrid_level = 1, gridlevel_info%ngrid_levels
     102             :             CALL transfer_rs2pw(rs_rho(igrid_level), &
     103      954837 :                                 mgrid_rspace(igrid_level))
     104             :          END DO
     105             : 
     106             :          ! we want both rho and rho_gspace, the latter for Hartree and co-workers.
     107      189193 :          SELECT CASE (interp_kind)
     108             :          CASE (pw_interp)
     109      189193 :             CALL pw_zero(rho_gspace)
     110      954837 :             DO igrid_level = 1, gridlevel_info%ngrid_levels
     111             :                CALL pw_transfer(mgrid_rspace(igrid_level), &
     112      765644 :                                 mgrid_gspace(igrid_level))
     113      954837 :                CALL pw_axpy(mgrid_gspace(igrid_level), rho_gspace)
     114             :             END DO
     115      189193 :             CALL pw_transfer(rho_gspace, rho)
     116             :          CASE (spline3_pbc_interp)
     117           0 :             DO igrid_level = gridlevel_info%ngrid_levels, 2, -1
     118             :                CALL pw_prolongate_s3(mgrid_rspace(igrid_level), &
     119             :                                      mgrid_rspace(igrid_level - 1), pw_pools(igrid_level)%pool, &
     120           0 :                                      pw_env%interp_section)
     121             :             END DO
     122           0 :             CALL pw_copy(mgrid_rspace(1), rho)
     123           0 :             CALL pw_transfer(rho, rho_gspace)
     124             :          CASE default
     125             :             CALL cp_abort(__LOCATION__, &
     126             :                           "interpolator "// &
     127      189193 :                           cp_to_string(interp_kind))
     128             :          END SELECT
     129             :       END IF
     130             : 
     131             :       ! *** give back the pw multi-grids
     132      194017 :       CALL pw_pools_give_back_pws(pw_pools, mgrid_gspace)
     133      194017 :       CALL pw_pools_give_back_pws(pw_pools, mgrid_rspace)
     134      194017 :       CALL timestop(handle)
     135             : 
     136      388034 :    END SUBROUTINE density_rs2pw
     137             : 
     138             : ! **************************************************************************************************
     139             : !> \brief transfers a potential from a pw_grid to a vector of
     140             : !>      realspace multigrids
     141             : !> \param rs_v OUTPUT: the potential on the realspace multigrids
     142             : !> \param v_rspace INPUT : the potential on a planewave grid in Rspace
     143             : !> \param pw_env ...
     144             : !> \par History
     145             : !>      09.2006 created [Joost VandeVondele]
     146             : !> \note
     147             : !>      extracted from integrate_v_rspace
     148             : !>      should contain all parallel communication of integrate_v_rspace in the
     149             : !>      case of replicated grids.
     150             : ! **************************************************************************************************
     151      217992 :    SUBROUTINE potential_pw2rs(rs_v, v_rspace, pw_env)
     152             : 
     153             :       TYPE(realspace_grid_type), DIMENSION(:), &
     154             :          INTENT(IN)                                      :: rs_v
     155             :       TYPE(pw_r3d_rs_type), INTENT(IN)                   :: v_rspace
     156             :       TYPE(pw_env_type), INTENT(IN)                      :: pw_env
     157             : 
     158             :       CHARACTER(len=*), PARAMETER                        :: routineN = 'potential_pw2rs'
     159             : 
     160             :       INTEGER                                            :: auxbas_grid, handle, igrid_level, &
     161             :                                                             interp_kind
     162             :       REAL(KIND=dp)                                      :: scale
     163             :       TYPE(gridlevel_info_type), POINTER                 :: gridlevel_info
     164      217992 :       TYPE(pw_c1d_gs_type), ALLOCATABLE, DIMENSION(:)    :: mgrid_gspace
     165      217992 :       TYPE(pw_pool_p_type), DIMENSION(:), POINTER        :: pw_pools
     166      217992 :       TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:)    :: mgrid_rspace
     167             : 
     168      217992 :       CALL timeset(routineN, handle)
     169             : 
     170             :       ! *** set up of the potential on the multigrids
     171             :       CALL pw_env_get(pw_env, pw_pools=pw_pools, gridlevel_info=gridlevel_info, &
     172      217992 :                       auxbas_grid=auxbas_grid)
     173             : 
     174      217992 :       CALL pw_pools_create_pws(pw_pools, mgrid_rspace)
     175             : 
     176             :       ! use either realspace or fft techniques to get the potential on the rs multigrids
     177      217992 :       CALL section_vals_val_get(pw_env%interp_section, "KIND", i_val=interp_kind)
     178      217992 :       SELECT CASE (interp_kind)
     179             :       CASE (pw_interp)
     180      217992 :          CALL pw_pools_create_pws(pw_pools, mgrid_gspace)
     181      217992 :          CALL pw_transfer(v_rspace, mgrid_gspace(auxbas_grid))
     182     1084142 :          DO igrid_level = 1, gridlevel_info%ngrid_levels
     183      866150 :             IF (igrid_level /= auxbas_grid) THEN
     184      648158 :                CALL pw_copy(mgrid_gspace(auxbas_grid), mgrid_gspace(igrid_level))
     185      648158 :                CALL pw_transfer(mgrid_gspace(igrid_level), mgrid_rspace(igrid_level))
     186             :             ELSE
     187      217992 :                IF (mgrid_gspace(auxbas_grid)%pw_grid%spherical) THEN
     188           0 :                   CALL pw_transfer(mgrid_gspace(auxbas_grid), mgrid_rspace(auxbas_grid))
     189             :                ELSE ! fft forward + backward should be identical
     190      217992 :                   CALL pw_copy(v_rspace, mgrid_rspace(auxbas_grid))
     191             :                END IF
     192             :             END IF
     193             :             ! *** Multiply by the grid volume element ratio ***
     194     1084142 :             IF (igrid_level /= auxbas_grid) THEN
     195             :                scale = mgrid_rspace(igrid_level)%pw_grid%dvol/ &
     196      648158 :                        mgrid_rspace(auxbas_grid)%pw_grid%dvol
     197             :                mgrid_rspace(igrid_level)%array = &
     198  2201234383 :                   scale*mgrid_rspace(igrid_level)%array
     199             :             END IF
     200             :          END DO
     201      217992 :          CALL pw_pools_give_back_pws(pw_pools, mgrid_gspace)
     202             :       CASE (spline3_pbc_interp)
     203           0 :          CALL pw_copy(v_rspace, mgrid_rspace(1))
     204           0 :          DO igrid_level = 1, gridlevel_info%ngrid_levels - 1
     205           0 :             CALL pw_zero(mgrid_rspace(igrid_level + 1))
     206             :             CALL pw_restrict_s3(mgrid_rspace(igrid_level), &
     207             :                                 mgrid_rspace(igrid_level + 1), pw_pools(igrid_level + 1)%pool, &
     208           0 :                                 pw_env%interp_section)
     209             :             ! *** Multiply by the grid volume element ratio
     210             :             mgrid_rspace(igrid_level + 1)%array = &
     211           0 :                mgrid_rspace(igrid_level + 1)%array*8._dp
     212             :          END DO
     213             :       CASE default
     214             :          CALL cp_abort(__LOCATION__, &
     215             :                        "interpolation not supported "// &
     216      435984 :                        cp_to_string(interp_kind))
     217             :       END SELECT
     218             : 
     219     1084142 :       DO igrid_level = 1, gridlevel_info%ngrid_levels
     220             :          CALL transfer_pw2rs(rs_v(igrid_level), &
     221     1084142 :                              mgrid_rspace(igrid_level))
     222             :       END DO
     223             :       ! *** give back the pw multi-grids
     224      217992 :       CALL pw_pools_give_back_pws(pw_pools, mgrid_rspace)
     225             : 
     226      217992 :       CALL timestop(handle)
     227             : 
     228      435984 :    END SUBROUTINE potential_pw2rs
     229             : 
     230             : END MODULE rs_pw_interface