LCOV - code coverage report
Current view: top level - src/pw_env - rs_pw_interface.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:d0bd076) Lines: 57 101 56.4 %
Date: 2021-09-15 13:52:28 Functions: 2 3 66.7 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2021 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: COMPLEXDATA1D,&
      33             :                                               REALDATA3D,&
      34             :                                               REALSPACE,&
      35             :                                               RECIPROCALSPACE,&
      36             :                                               pw_p_type
      37             :    USE realspace_grid_types,            ONLY: pw2rs,&
      38             :                                               realspace_grid_desc_p_type,&
      39             :                                               realspace_grid_p_type,&
      40             :                                               rs2pw,&
      41             :                                               rs_grid_release,&
      42             :                                               rs_pw_transfer
      43             : #include "../base/base_uses.f90"
      44             : 
      45             :    IMPLICIT NONE
      46             : 
      47             :    PRIVATE
      48             : 
      49             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rs_pw_interface'
      50             : ! *** Public subroutines ***
      51             : 
      52             :    PUBLIC :: density_rs2pw, &
      53             :              density_rs2pw_basic, &
      54             :              potential_pw2rs
      55             : 
      56             : CONTAINS
      57             : 
      58             : ! **************************************************************************************************
      59             : !> \brief given partial densities on the realspace multigrids,
      60             : !>      computes the full density on the plane wave grids, both in real and
      61             : !>      gspace
      62             : !> \param pw_env ...
      63             : !> \param rs_rho ...
      64             : !> \param rho ...
      65             : !> \param rho_gspace ...
      66             : !> \note
      67             : !>      should contain all communication in the collocation of the density
      68             : !>      in the case of replicated grids
      69             : ! **************************************************************************************************
      70      197360 :    SUBROUTINE density_rs2pw(pw_env, rs_rho, rho, rho_gspace)
      71             : 
      72             :       TYPE(pw_env_type), POINTER                         :: pw_env
      73             :       TYPE(realspace_grid_p_type), DIMENSION(:), POINTER :: rs_rho
      74             :       TYPE(pw_p_type), INTENT(INOUT)                     :: rho, rho_gspace
      75             : 
      76             :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'density_rs2pw'
      77             : 
      78             :       INTEGER                                            :: handle, igrid_level, interp_kind
      79             :       TYPE(gridlevel_info_type), POINTER                 :: gridlevel_info
      80       98680 :       TYPE(pw_p_type), DIMENSION(:), POINTER             :: mgrid_gspace, mgrid_rspace
      81       98680 :       TYPE(pw_pool_p_type), DIMENSION(:), POINTER        :: pw_pools
      82             :       TYPE(realspace_grid_desc_p_type), DIMENSION(:), &
      83       98680 :          POINTER                                         :: rs_descs
      84             : 
      85       98680 :       CALL timeset(routineN, handle)
      86       98680 :       NULLIFY (gridlevel_info, mgrid_gspace, mgrid_rspace, rs_descs, pw_pools)
      87       98680 :       CPASSERT(ASSOCIATED(pw_env))
      88       98680 :       CALL pw_env_get(pw_env, rs_descs=rs_descs, pw_pools=pw_pools)
      89             : 
      90       98680 :       gridlevel_info => pw_env%gridlevel_info
      91             : 
      92       98680 :       CALL section_vals_val_get(pw_env%interp_section, "KIND", i_val=interp_kind)
      93             : 
      94             :       CALL pw_pools_create_pws(pw_pools, mgrid_rspace, &
      95             :                                use_data=REALDATA3D, &
      96       98680 :                                in_space=REALSPACE)
      97             : 
      98             :       CALL pw_pools_create_pws(pw_pools, mgrid_gspace, &
      99             :                                use_data=COMPLEXDATA1D, &
     100       98680 :                                in_space=RECIPROCALSPACE)
     101             : 
     102       98680 :       IF (gridlevel_info%ngrid_levels == 1) THEN
     103        3584 :          CALL rs_pw_transfer(rs_rho(1)%rs_grid, rho%pw, rs2pw)
     104        3584 :          CALL rs_grid_release(rs_rho(1)%rs_grid)
     105        3584 :          CALL pw_transfer(rho%pw, rho_gspace%pw)
     106        3584 :          IF (rho%pw%pw_grid%spherical) THEN ! rho_gspace = rho
     107           0 :             CALL pw_transfer(rho_gspace%pw, rho%pw)
     108             :          ENDIF
     109             :       ELSE
     110      483782 :          DO igrid_level = 1, gridlevel_info%ngrid_levels
     111             :             CALL rs_pw_transfer(rs_rho(igrid_level)%rs_grid, &
     112      388686 :                                 mgrid_rspace(igrid_level)%pw, rs2pw)
     113      483782 :             CALL rs_grid_release(rs_rho(igrid_level)%rs_grid)
     114             :          ENDDO
     115             : 
     116             :          ! we want both rho and rho_gspace, the latter for Hartree and co-workers.
     117       95096 :          SELECT CASE (interp_kind)
     118             :          CASE (pw_interp)
     119       95096 :             CALL pw_zero(rho_gspace%pw)
     120      483782 :             DO igrid_level = 1, gridlevel_info%ngrid_levels
     121             :                CALL pw_transfer(mgrid_rspace(igrid_level)%pw, &
     122      388686 :                                 mgrid_gspace(igrid_level)%pw)
     123      483782 :                CALL pw_axpy(mgrid_gspace(igrid_level)%pw, rho_gspace%pw)
     124             :             END DO
     125       95096 :             CALL pw_transfer(rho_gspace%pw, rho%pw)
     126             :          CASE (spline3_pbc_interp)
     127           0 :             DO igrid_level = gridlevel_info%ngrid_levels, 2, -1
     128             :                CALL pw_prolongate_s3(mgrid_rspace(igrid_level)%pw, &
     129             :                                      mgrid_rspace(igrid_level - 1)%pw, pw_pools(igrid_level)%pool, &
     130           0 :                                      pw_env%interp_section)
     131             :             END DO
     132           0 :             CALL pw_copy(mgrid_rspace(1)%pw, rho%pw)
     133           0 :             CALL pw_transfer(rho%pw, rho_gspace%pw)
     134             :          CASE default
     135             :             CALL cp_abort(__LOCATION__, &
     136             :                           "interpolator "// &
     137       95096 :                           cp_to_string(interp_kind))
     138             :          END SELECT
     139             :       END IF
     140             : 
     141             :       ! *** give back the pw multi-grids
     142       98680 :       CALL pw_pools_give_back_pws(pw_pools, mgrid_gspace)
     143       98680 :       CALL pw_pools_give_back_pws(pw_pools, mgrid_rspace)
     144       98680 :       CALL timestop(handle)
     145             : 
     146       98680 :    END SUBROUTINE density_rs2pw
     147             : 
     148             : ! **************************************************************************************************
     149             : !> \brief given partial densities on the realspace multigrids,
     150             : !>      computes the full density on the plane wave grids
     151             : !> \param pw_env ...
     152             : !> \param rs_rho ...
     153             : !> \param rho ...
     154             : !> \param rho_gspace ...
     155             : !> \note
     156             : !>      should contain the all communication in the collocation of the density
     157             : !>      in the case of replicated grids
     158             : ! **************************************************************************************************
     159           0 :    SUBROUTINE density_rs2pw_basic(pw_env, rs_rho, rho, rho_gspace)
     160             : 
     161             :       TYPE(pw_env_type), POINTER                         :: pw_env
     162             :       TYPE(realspace_grid_p_type), DIMENSION(:), POINTER :: rs_rho
     163             :       TYPE(pw_p_type), INTENT(INOUT)                     :: rho, rho_gspace
     164             : 
     165             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'density_rs2pw_basic'
     166             : 
     167             :       INTEGER                                            :: handle, igrid_level, interp_kind
     168             :       TYPE(gridlevel_info_type), POINTER                 :: gridlevel_info
     169           0 :       TYPE(pw_p_type), DIMENSION(:), POINTER             :: mgrid_gspace, mgrid_rspace
     170           0 :       TYPE(pw_pool_p_type), DIMENSION(:), POINTER        :: pw_pools
     171             :       TYPE(realspace_grid_desc_p_type), DIMENSION(:), &
     172           0 :          POINTER                                         :: rs_descs
     173             : 
     174           0 :       CALL timeset(routineN, handle)
     175           0 :       NULLIFY (gridlevel_info, mgrid_gspace, mgrid_rspace, rs_descs, pw_pools)
     176           0 :       CPASSERT(ASSOCIATED(pw_env))
     177           0 :       CALL pw_env_get(pw_env, rs_descs=rs_descs, pw_pools=pw_pools)
     178             : 
     179           0 :       gridlevel_info => pw_env%gridlevel_info
     180             : 
     181           0 :       CALL section_vals_val_get(pw_env%interp_section, "KIND", i_val=interp_kind)
     182             : 
     183             :       CALL pw_pools_create_pws(pw_pools, mgrid_rspace, &
     184             :                                use_data=REALDATA3D, &
     185           0 :                                in_space=REALSPACE)
     186             : 
     187             :       CALL pw_pools_create_pws(pw_pools, mgrid_gspace, &
     188             :                                use_data=COMPLEXDATA1D, &
     189           0 :                                in_space=RECIPROCALSPACE)
     190             : 
     191           0 :       IF (gridlevel_info%ngrid_levels == 1) THEN
     192           0 :          CALL rs_pw_transfer(rs_rho(1)%rs_grid, rho%pw, rs2pw)
     193           0 :          CALL pw_transfer(rho%pw, rho_gspace%pw)
     194             :       ELSE
     195           0 :          DO igrid_level = 1, gridlevel_info%ngrid_levels
     196             :             CALL rs_pw_transfer(rs_rho(igrid_level)%rs_grid, &
     197           0 :                                 mgrid_rspace(igrid_level)%pw, rs2pw)
     198             :          ENDDO
     199             : 
     200             :          ! we want both rho and rho_gspace, the latter for Hartree and co-workers.
     201           0 :          SELECT CASE (interp_kind)
     202             :          CASE (pw_interp)
     203           0 :             DO igrid_level = 1, gridlevel_info%ngrid_levels
     204             :                CALL pw_transfer(mgrid_rspace(igrid_level)%pw, &
     205           0 :                                 mgrid_gspace(igrid_level)%pw)
     206           0 :                IF (igrid_level /= 1) THEN
     207           0 :                   CALL pw_axpy(mgrid_gspace(igrid_level)%pw, mgrid_gspace(1)%pw)
     208             :                END IF
     209             :             END DO
     210           0 :             CALL pw_transfer(mgrid_gspace(1)%pw, rho%pw)
     211           0 :             CALL pw_transfer(mgrid_rspace(1)%pw, rho_gspace%pw)
     212             :          CASE (spline3_pbc_interp)
     213           0 :             DO igrid_level = gridlevel_info%ngrid_levels, 2, -1
     214             :                CALL pw_prolongate_s3(mgrid_rspace(igrid_level)%pw, &
     215             :                                      mgrid_rspace(igrid_level - 1)%pw, pw_pools(igrid_level)%pool, &
     216           0 :                                      pw_env%interp_section)
     217             :             END DO
     218           0 :             CALL pw_copy(mgrid_rspace(1)%pw, rho%pw)
     219           0 :             CALL pw_transfer(rho%pw, rho_gspace%pw)
     220             :          CASE default
     221             :             CALL cp_abort(__LOCATION__, &
     222             :                           "interpolator "// &
     223           0 :                           cp_to_string(interp_kind))
     224             :          END SELECT
     225             :       END IF
     226             : 
     227             :       ! *** give back the pw multi-grids
     228           0 :       CALL pw_pools_give_back_pws(pw_pools, mgrid_gspace)
     229           0 :       CALL pw_pools_give_back_pws(pw_pools, mgrid_rspace)
     230           0 :       CALL timestop(handle)
     231             : 
     232           0 :    END SUBROUTINE density_rs2pw_basic
     233             : 
     234             : ! **************************************************************************************************
     235             : !> \brief transfers a potential from a pw_grid to a vector of
     236             : !>      realspace multigrids
     237             : !> \param rs_v OUTPUT: the potential on the realspace multigrids
     238             : !> \param v_rspace INPUT : the potential on a planewave grid in Rspace
     239             : !> \param pw_env ...
     240             : !> \par History
     241             : !>      09.2006 created [Joost VandeVondele]
     242             : !> \note
     243             : !>      extracted from integrate_v_rspace
     244             : !>      should contain all parallel communication of integrate_v_rspace in the
     245             : !>      case of replicated grids.
     246             : ! **************************************************************************************************
     247      273270 :    SUBROUTINE potential_pw2rs(rs_v, v_rspace, pw_env)
     248             : 
     249             :       TYPE(realspace_grid_p_type), DIMENSION(:), POINTER :: rs_v
     250             :       TYPE(pw_p_type), INTENT(IN)                        :: v_rspace
     251             :       TYPE(pw_env_type), POINTER                         :: pw_env
     252             : 
     253             :       CHARACTER(len=*), PARAMETER                        :: routineN = 'potential_pw2rs'
     254             : 
     255             :       INTEGER                                            :: auxbas_grid, handle, igrid_level, &
     256             :                                                             interp_kind
     257             :       REAL(KIND=dp)                                      :: scale
     258             :       TYPE(gridlevel_info_type), POINTER                 :: gridlevel_info
     259       91090 :       TYPE(pw_p_type), DIMENSION(:), POINTER             :: mgrid_gspace, mgrid_rspace
     260       91090 :       TYPE(pw_pool_p_type), DIMENSION(:), POINTER        :: pw_pools
     261             : 
     262       91090 :       CALL timeset(routineN, handle)
     263             : 
     264             :       ! *** set up of the potential on the multigrids
     265             :       CALL pw_env_get(pw_env, pw_pools=pw_pools, gridlevel_info=gridlevel_info, &
     266       91090 :                       auxbas_grid=auxbas_grid)
     267             : 
     268             :       CALL pw_pools_create_pws(pw_pools, mgrid_rspace, &
     269             :                                use_data=REALDATA3D, &
     270       91090 :                                in_space=REALSPACE)
     271             : 
     272             :       ! use either realspace or fft techniques to get the potential on the rs multigrids
     273       91090 :       CALL section_vals_val_get(pw_env%interp_section, "KIND", i_val=interp_kind)
     274       91090 :       SELECT CASE (interp_kind)
     275             :       CASE (pw_interp)
     276             :          CALL pw_pools_create_pws(pw_pools, mgrid_gspace, &
     277             :                                   use_data=COMPLEXDATA1D, &
     278       91090 :                                   in_space=RECIPROCALSPACE)
     279       91090 :          CALL pw_transfer(v_rspace%pw, mgrid_gspace(auxbas_grid)%pw)
     280      451828 :          DO igrid_level = 1, gridlevel_info%ngrid_levels
     281      360738 :             IF (igrid_level /= auxbas_grid) THEN
     282      269648 :                CALL pw_copy(mgrid_gspace(auxbas_grid)%pw, mgrid_gspace(igrid_level)%pw)
     283      269648 :                CALL pw_transfer(mgrid_gspace(igrid_level)%pw, mgrid_rspace(igrid_level)%pw)
     284             :             ELSE
     285       91090 :                IF (mgrid_gspace(auxbas_grid)%pw%pw_grid%spherical) THEN
     286           0 :                   CALL pw_transfer(mgrid_gspace(auxbas_grid)%pw, mgrid_rspace(auxbas_grid)%pw)
     287             :                ELSE ! fft forward + backward should be identical
     288       91090 :                   CALL pw_copy(v_rspace%pw, mgrid_rspace(auxbas_grid)%pw)
     289             :                ENDIF
     290             :             ENDIF
     291             :             ! *** Multiply by the grid volume element ratio ***
     292      451828 :             IF (igrid_level /= auxbas_grid) THEN
     293             :                scale = mgrid_rspace(igrid_level)%pw%pw_grid%dvol/ &
     294      269648 :                        mgrid_rspace(auxbas_grid)%pw%pw_grid%dvol
     295             :                mgrid_rspace(igrid_level)%pw%cr3d = &
     296  1357613797 :                   scale*mgrid_rspace(igrid_level)%pw%cr3d
     297             :             END IF
     298             :          END DO
     299       91090 :          CALL pw_pools_give_back_pws(pw_pools, mgrid_gspace)
     300             :       CASE (spline3_pbc_interp)
     301           0 :          CALL pw_copy(v_rspace%pw, mgrid_rspace(1)%pw)
     302           0 :          DO igrid_level = 1, gridlevel_info%ngrid_levels - 1
     303           0 :             CALL pw_zero(mgrid_rspace(igrid_level + 1)%pw)
     304             :             CALL pw_restrict_s3(mgrid_rspace(igrid_level)%pw, &
     305             :                                 mgrid_rspace(igrid_level + 1)%pw, pw_pools(igrid_level + 1)%pool, &
     306           0 :                                 pw_env%interp_section)
     307             :             ! *** Multiply by the grid volume element ratio
     308             :             mgrid_rspace(igrid_level + 1)%pw%cr3d = &
     309           0 :                mgrid_rspace(igrid_level + 1)%pw%cr3d*8._dp
     310             :          END DO
     311             :       CASE default
     312             :          CALL cp_abort(__LOCATION__, &
     313             :                        "interpolation not supported "// &
     314       91090 :                        cp_to_string(interp_kind))
     315             :       END SELECT
     316             : 
     317      451828 :       DO igrid_level = 1, gridlevel_info%ngrid_levels
     318             :          CALL rs_pw_transfer(rs_v(igrid_level)%rs_grid, &
     319      451828 :                              mgrid_rspace(igrid_level)%pw, pw2rs)
     320             :       ENDDO
     321             :       ! *** give back the pw multi-grids
     322       91090 :       CALL pw_pools_give_back_pws(pw_pools, mgrid_rspace)
     323             : 
     324       91090 :       CALL timestop(handle)
     325             : 
     326       91090 :    END SUBROUTINE potential_pw2rs
     327             : 
     328             : END MODULE rs_pw_interface

Generated by: LCOV version 1.15