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 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 210832 : 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 210832 : TYPE(pw_c1d_gs_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace
77 210832 : TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
78 210832 : TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:) :: mgrid_rspace
79 : TYPE(realspace_grid_desc_p_type), DIMENSION(:), &
80 210832 : POINTER :: rs_descs
81 :
82 210832 : CALL timeset(routineN, handle)
83 210832 : NULLIFY (gridlevel_info, rs_descs, pw_pools)
84 210832 : CALL pw_env_get(pw_env, rs_descs=rs_descs, pw_pools=pw_pools)
85 :
86 210832 : gridlevel_info => pw_env%gridlevel_info
87 :
88 210832 : CALL section_vals_val_get(pw_env%interp_section, "KIND", i_val=interp_kind)
89 :
90 210832 : CALL pw_pools_create_pws(pw_pools, mgrid_rspace)
91 :
92 210832 : CALL pw_pools_create_pws(pw_pools, mgrid_gspace)
93 :
94 210832 : IF (gridlevel_info%ngrid_levels == 1) THEN
95 5948 : CALL transfer_rs2pw(rs_rho(1), rho)
96 5948 : CALL pw_transfer(rho, rho_gspace)
97 5948 : IF (rho%pw_grid%spherical) THEN ! rho_gspace = rho
98 0 : CALL pw_transfer(rho_gspace, rho)
99 : END IF
100 : ELSE
101 1033392 : DO igrid_level = 1, gridlevel_info%ngrid_levels
102 : CALL transfer_rs2pw(rs_rho(igrid_level), &
103 1033392 : mgrid_rspace(igrid_level))
104 : END DO
105 :
106 : ! we want both rho and rho_gspace, the latter for Hartree and co-workers.
107 204884 : SELECT CASE (interp_kind)
108 : CASE (pw_interp)
109 204884 : CALL pw_zero(rho_gspace)
110 1033392 : DO igrid_level = 1, gridlevel_info%ngrid_levels
111 : CALL pw_transfer(mgrid_rspace(igrid_level), &
112 828508 : mgrid_gspace(igrid_level))
113 1033392 : CALL pw_axpy(mgrid_gspace(igrid_level), rho_gspace)
114 : END DO
115 204884 : 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 204884 : cp_to_string(interp_kind))
128 : END SELECT
129 : END IF
130 :
131 : ! *** give back the pw multi-grids
132 210832 : CALL pw_pools_give_back_pws(pw_pools, mgrid_gspace)
133 210832 : CALL pw_pools_give_back_pws(pw_pools, mgrid_rspace)
134 210832 : CALL timestop(handle)
135 :
136 421664 : 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 232097 : 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 232097 : TYPE(pw_c1d_gs_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace
165 232097 : TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
166 232097 : TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:) :: mgrid_rspace
167 :
168 232097 : 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 232097 : auxbas_grid=auxbas_grid)
173 :
174 232097 : 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 232097 : CALL section_vals_val_get(pw_env%interp_section, "KIND", i_val=interp_kind)
178 232097 : SELECT CASE (interp_kind)
179 : CASE (pw_interp)
180 232097 : CALL pw_pools_create_pws(pw_pools, mgrid_gspace)
181 232097 : CALL pw_transfer(v_rspace, mgrid_gspace(auxbas_grid))
182 1152077 : DO igrid_level = 1, gridlevel_info%ngrid_levels
183 919980 : IF (igrid_level /= auxbas_grid) THEN
184 687883 : CALL pw_copy(mgrid_gspace(auxbas_grid), mgrid_gspace(igrid_level))
185 687883 : CALL pw_transfer(mgrid_gspace(igrid_level), mgrid_rspace(igrid_level))
186 : ELSE
187 232097 : 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 232097 : CALL pw_copy(v_rspace, mgrid_rspace(auxbas_grid))
191 : END IF
192 : END IF
193 : ! *** Multiply by the grid volume element ratio ***
194 1152077 : IF (igrid_level /= auxbas_grid) THEN
195 : scale = mgrid_rspace(igrid_level)%pw_grid%dvol/ &
196 687883 : mgrid_rspace(auxbas_grid)%pw_grid%dvol
197 : mgrid_rspace(igrid_level)%array = &
198 2409900911 : scale*mgrid_rspace(igrid_level)%array
199 : END IF
200 : END DO
201 232097 : 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 464194 : cp_to_string(interp_kind))
217 : END SELECT
218 :
219 1152077 : DO igrid_level = 1, gridlevel_info%ngrid_levels
220 : CALL transfer_pw2rs(rs_v(igrid_level), &
221 1152077 : mgrid_rspace(igrid_level))
222 : END DO
223 : ! *** give back the pw multi-grids
224 232097 : CALL pw_pools_give_back_pws(pw_pools, mgrid_rspace)
225 :
226 232097 : CALL timestop(handle)
227 :
228 464194 : END SUBROUTINE potential_pw2rs
229 :
230 : END MODULE rs_pw_interface
|
