Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : MODULE qs_kernel_methods
9 : USE cp_dbcsr_api, ONLY: dbcsr_distribution_type
10 : USE input_section_types, ONLY: section_get_lval,&
11 : section_vals_get_subs_vals,&
12 : section_vals_type
13 : USE kinds, ONLY: dp
14 : USE pw_env_types, ONLY: pw_env_get,&
15 : pw_env_type
16 : USE pw_methods, ONLY: pw_axpy,&
17 : pw_zero
18 : USE pw_pool_types, ONLY: pw_pool_type
19 : USE pw_types, ONLY: pw_c1d_gs_type,&
20 : pw_r3d_rs_type
21 : USE qs_environment_types, ONLY: get_qs_env,&
22 : qs_environment_type
23 : USE qs_fxc, ONLY: qs_fxc_prep
24 : USE qs_kernel_types, ONLY: full_kernel_env_type
25 : USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
26 : USE qs_rho_methods, ONLY: qs_rho_copy
27 : USE qs_rho_types, ONLY: qs_rho_create,&
28 : qs_rho_get,&
29 : qs_rho_type
30 : USE qs_tddfpt2_subgroups, ONLY: tddfpt_subgroup_env_type
31 : USE xc_fxc_kernel, ONLY: calc_fxc_kernel
32 : #include "./base/base_uses.f90"
33 :
34 : IMPLICIT NONE
35 :
36 : PRIVATE
37 :
38 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_kernel_methods'
39 :
40 : LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .FALSE.
41 :
42 : PUBLIC :: create_kernel_env, create_fxc_kernel
43 :
44 : CONTAINS
45 :
46 : ! **************************************************************************************************
47 : !> \brief Create kernel environment.
48 : !> \param kernel_env kernel environment (allocated and initialised on exit)
49 : !> \param xc_section input section which defines an exchange-correlation functional
50 : !> \param is_rks_triplets indicates that the triplet excited states calculation using
51 : !> spin-unpolarised molecular orbitals has been requested
52 : !> \param rho_struct_sub ground state charge density, if not associated on input, it will be associated on output
53 : !> \param sub_env parallel group environment
54 : !> \param qs_env ...
55 : !> \par History
56 : !> * 02.2017 created [Sergey Chulkov]
57 : !> * 06.2018 the charge density needs to be provided via a dummy argument [Sergey Chulkov]
58 : ! **************************************************************************************************
59 1036 : SUBROUTINE create_kernel_env(kernel_env, xc_section, is_rks_triplets, rho_struct_sub, &
60 : sub_env, qs_env)
61 : TYPE(full_kernel_env_type), INTENT(inout) :: kernel_env
62 : TYPE(section_vals_type), INTENT(IN), POINTER :: xc_section
63 : LOGICAL, INTENT(in) :: is_rks_triplets
64 : TYPE(qs_rho_type), POINTER :: rho_struct_sub
65 : TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
66 : TYPE(qs_environment_type), INTENT(in), POINTER :: qs_env
67 :
68 : CHARACTER(LEN=*), PARAMETER :: routineN = 'create_kernel_env'
69 :
70 : INTEGER :: handle, nspins
71 : TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist
72 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
73 1036 : POINTER :: sab_orb
74 : TYPE(pw_env_type), POINTER :: pw_env
75 : TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
76 : TYPE(pw_r3d_rs_type), POINTER :: rho_nlcc, weights
77 :
78 1036 : CALL timeset(routineN, handle)
79 :
80 1036 : pw_env => sub_env%pw_env
81 1036 : dbcsr_dist => sub_env%dbcsr_dist
82 1036 : sab_orb => sub_env%sab_orb
83 :
84 1036 : nspins = SIZE(sub_env%mos_occ)
85 :
86 1036 : NULLIFY (weights, rho_nlcc)
87 1036 : weights => sub_env%xcint_weights
88 1036 : IF (sub_env%is_split .AND. ASSOCIATED(weights)) THEN
89 0 : CPABORT("Split communicators and integration weights")
90 : END IF
91 1036 : CALL get_qs_env(qs_env, rho_nlcc=rho_nlcc)
92 1036 : IF (sub_env%is_split .AND. ASSOCIATED(rho_nlcc)) THEN
93 0 : CPABORT("Split communicators and NLCC not implemented")
94 : END IF
95 :
96 1036 : CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
97 1036 : IF (.NOT. ASSOCIATED(kernel_env%rho0_struct)) THEN
98 1036 : ALLOCATE (kernel_env%rho0_struct)
99 1036 : CALL qs_rho_create(kernel_env%rho0_struct)
100 : END IF
101 1036 : CALL qs_rho_copy(rho_struct_sub, kernel_env%rho0_struct, auxbas_pw_pool, nspins)
102 :
103 : ! ++ allocate structure for response density
104 1036 : kernel_env%xc_section => xc_section
105 23828 : ALLOCATE (kernel_env%xc_rho_set)
106 : CALL qs_fxc_prep(qs_env, rho_struct_sub, &
107 : kernel_env%xc_rho_set, kernel_env%xc_deriv_set, &
108 1036 : xc_section, pw_env, is_rks_triplets)
109 :
110 1036 : kernel_env%alpha = 1.0_dp
111 1036 : kernel_env%beta = 0.0_dp
112 : ! kernel_env%beta is taken into account in spin-restricted case only
113 1036 : IF (nspins == 1) THEN
114 900 : IF (is_rks_triplets) THEN
115 : ! K_{triplets} = K_{alpha,alpha} - K_{alpha,beta}
116 110 : kernel_env%beta = -1.0_dp
117 : ELSE
118 : ! alpha beta
119 : ! K_{singlets} = K_{alpha,alpha} + K_{alpha,beta} = 2 * K_{alpha,alpha} + 0 * K_{alpha,beta},
120 : ! due to the following relation : K_{alpha,alpha,singlets} == K_{alpha,beta,singlets}
121 790 : kernel_env%alpha = 2.0_dp
122 : END IF
123 : END IF
124 :
125 : ! finite differences
126 1036 : kernel_env%deriv2_analytic = section_get_lval(xc_section, "2ND_DERIV_ANALYTICAL")
127 1036 : kernel_env%deriv3_analytic = section_get_lval(xc_section, "3RD_DERIV_ANALYTICAL")
128 :
129 1036 : CALL timestop(handle)
130 :
131 1036 : END SUBROUTINE create_kernel_env
132 :
133 : ! **************************************************************************************************
134 : !> \brief Create the xc kernel potential for the approximate Fxc kernel model
135 : !> \param rho_struct ...
136 : !> \param fxc_rspace ...
137 : !> \param xc_section ...
138 : !> \param is_rks_triplets ...
139 : !> \param sub_env ...
140 : !> \param qs_env ...
141 : ! **************************************************************************************************
142 24 : SUBROUTINE create_fxc_kernel(rho_struct, fxc_rspace, xc_section, is_rks_triplets, sub_env, qs_env)
143 : TYPE(qs_rho_type), POINTER :: rho_struct
144 : TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: fxc_rspace
145 : TYPE(section_vals_type), INTENT(IN), POINTER :: xc_section
146 : LOGICAL, INTENT(IN) :: is_rks_triplets
147 : TYPE(tddfpt_subgroup_env_type), INTENT(IN) :: sub_env
148 : TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env
149 :
150 : CHARACTER(LEN=*), PARAMETER :: routineN = 'create_fxc_kernel'
151 :
152 : INTEGER :: handle, ispin, nspins
153 : LOGICAL :: rho_g_valid, tau_r_valid
154 : REAL(KIND=dp) :: factor
155 12 : TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
156 : TYPE(pw_c1d_gs_type), POINTER :: rho_nlcc_g
157 : TYPE(pw_env_type), POINTER :: pw_env
158 : TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
159 12 : TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau_r
160 : TYPE(pw_r3d_rs_type), POINTER :: rho_nlcc
161 : TYPE(section_vals_type), POINTER :: xc_kernel
162 :
163 12 : CALL timeset(routineN, handle)
164 :
165 12 : pw_env => sub_env%pw_env
166 12 : CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
167 :
168 12 : NULLIFY (rho_r, rho_g, tau_r)
169 : CALL qs_rho_get(rho_struct, &
170 : tau_r_valid=tau_r_valid, &
171 : rho_g_valid=rho_g_valid, &
172 : rho_r=rho_r, &
173 : rho_g=rho_g, &
174 12 : tau_r=tau_r)
175 :
176 12 : IF (.NOT. tau_r_valid) NULLIFY (tau_r)
177 12 : IF (.NOT. rho_g_valid) NULLIFY (rho_g)
178 :
179 12 : nspins = SIZE(rho_r)
180 :
181 12 : NULLIFY (rho_nlcc, rho_nlcc_g)
182 : CALL get_qs_env(qs_env, &
183 : rho_nlcc=rho_nlcc, &
184 12 : rho_nlcc_g=rho_nlcc_g)
185 : ! add the nlcc densities
186 12 : IF (ASSOCIATED(rho_nlcc)) THEN
187 0 : factor = 1.0_dp
188 0 : DO ispin = 1, nspins
189 0 : CALL pw_axpy(rho_nlcc, rho_r(ispin), factor)
190 0 : CALL pw_axpy(rho_nlcc_g, rho_g(ispin), factor)
191 : END DO
192 : END IF
193 :
194 48 : DO ispin = 1, SIZE(fxc_rspace)
195 48 : CALL pw_zero(fxc_rspace(ispin))
196 : END DO
197 :
198 12 : xc_kernel => section_vals_get_subs_vals(xc_section, "XC_KERNEL")
199 : CALL calc_fxc_kernel(fxc_rspace, rho_r, rho_g, tau_r, &
200 12 : xc_kernel, is_rks_triplets, auxbas_pw_pool)
201 :
202 : ! remove the nlcc densities (keep stuff in original state)
203 12 : IF (ASSOCIATED(rho_nlcc)) THEN
204 0 : factor = -1.0_dp
205 0 : DO ispin = 1, nspins
206 0 : CALL pw_axpy(rho_nlcc, rho_r(ispin), factor)
207 0 : CALL pw_axpy(rho_nlcc_g, rho_g(ispin), factor)
208 : END DO
209 : END IF
210 :
211 12 : CALL timestop(handle)
212 :
213 12 : END SUBROUTINE create_fxc_kernel
214 :
215 : END MODULE qs_kernel_methods
|