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 Define XAS TDP control type and associated create, release, etc subroutines, as well as
10 : !> XAS TDP environment type and associated set, get, etc subroutines
11 : !> \author AB (11.2017)
12 : !> *************************************************************************************************
13 : MODULE xas_tdp_types
14 : USE cp_array_utils, ONLY: cp_1d_i_p_type,&
15 : cp_1d_r_p_type,&
16 : cp_2d_i_p_type,&
17 : cp_2d_r_p_type,&
18 : cp_3d_r_p_type
19 : USE cp_dbcsr_api, ONLY: dbcsr_distribution_release,&
20 : dbcsr_distribution_type,&
21 : dbcsr_p_type,&
22 : dbcsr_release,&
23 : dbcsr_release_p,&
24 : dbcsr_type
25 : USE cp_files, ONLY: file_exists
26 : USE cp_fm_types, ONLY: cp_fm_release,&
27 : cp_fm_type
28 : USE dbt_api, ONLY: dbt_destroy,&
29 : dbt_type
30 : USE distribution_2d_types, ONLY: distribution_2d_release,&
31 : distribution_2d_type
32 : USE input_constants, ONLY: &
33 : do_potential_coulomb, do_potential_short, do_potential_truncated, ot_mini_cg, &
34 : ot_mini_diis, tddfpt_singlet, tddfpt_spin_cons, tddfpt_spin_flip, tddfpt_triplet, &
35 : xas_dip_vel, xas_tdp_by_index, xas_tdp_by_kind, xc_none
36 : USE input_section_types, ONLY: section_vals_release,&
37 : section_vals_type,&
38 : section_vals_val_get
39 : USE kinds, ONLY: default_string_length,&
40 : dp
41 : USE libint_2c_3c, ONLY: libint_potential_type
42 : USE libint_wrapper, ONLY: cp_libint_static_cleanup
43 : USE mathlib, ONLY: erfc_cutoff
44 : USE memory_utilities, ONLY: reallocate
45 : USE message_passing, ONLY: mp_para_env_type
46 : USE physcon, ONLY: bohr,&
47 : evolt
48 : USE qs_grid_atom, ONLY: deallocate_grid_atom,&
49 : grid_atom_type
50 : USE qs_harmonics_atom, ONLY: deallocate_harmonics_atom,&
51 : harmonics_atom_type
52 : USE qs_loc_types, ONLY: qs_loc_env_release,&
53 : qs_loc_env_type
54 : USE qs_ot_types, ONLY: qs_ot_settings_init,&
55 : qs_ot_settings_type
56 : #include "./base/base_uses.f90"
57 :
58 : IMPLICIT NONE
59 :
60 : PRIVATE
61 :
62 : ! **************************************************************************************************
63 : !> \brief Type containing control information for TDP XAS calculations
64 : !> \param define_excited whether excited atoms are chosen by kind or index
65 : !> \param dipole_form whether the dipole moment is computed in the length or velocity representation
66 : !> \param n_search # of lowest energy MOs to search for donor orbitals
67 : !> \param check_only whether a check run for donor MOs is conducted
68 : !> \param do_hfx whether exact exchange is included
69 : !> \param do_xc wheter xc functional(s) is(are) included (libxc)
70 : !> \param do_coulomb whether the coulomb kernel is computed, .FALSE. if no xc nor hfx => normal dft
71 : !> \param sx the scaling applied to exact exchange
72 : !> \param x_potential the potential used for exact exchange (incl. cutoff, t_c_file, omega)
73 : !> \param ri_m_potential the potential used for exact exchange RI metric
74 : !> \param do_ri_metric whether a metric is used fir the RI
75 : !> \param eps_range the threshold to determine the effective range of the short range operator
76 : !> \param eps_pgf the threshold to determine the extent of all pgf in the method
77 : !> \param eps_filter threshold for dbcsr operations
78 : !> \param ri_radius the radius of the sphere defining the neighbors in the RI projection of the dens
79 : !> \param tamm_dancoff whether the calculations should be done in the Tamm-Dancoff approximation
80 : !> \param do_quad whether the electric quadrupole transition moments should be computed
81 : !> \param list_ex_atoms list of excited atom indices, kept empty if define_excited=by_kind
82 : !> \param list_ex_kinds list of excited atom kinds, kept empty if define_excited=by_index
83 : !> \param do_loc whether the core MOs should be localized
84 : !> \param do_uks whether the calculation is spin-unrestricted
85 : !> \param do_roks whether the calculation is restricted open-shell
86 : !> \param do_singlet whether singlet excitations should be computed
87 : !> \param do_triplet whether triplet excitations should be computed
88 : !> \param do_spin_cons whether spin-conserving excitation (for open-shell) should be computed
89 : !> \param do_spin_flip whether spin-flip excitation (for open-shell) should be computed
90 : !> \param do_soc whether spin-orbit coupling should be included
91 : !> \param n_excited the number of excited states to compute
92 : !> \param e_range the energy range where to look for eigenvalues
93 : !> \param state_types columns correspond to the states to excite for each atom kind/index
94 : !> the number of rows is the number of times the keyword is repeated
95 : !> \param grid_info the information about the atomic grids used for the xc kernel integrals
96 : !> \param is_periodic self-explanatory
97 : !> \param ot_settings settings for the iterative OT solver
98 : !> \param do_ot whether iterative OT solver should be used
99 : !> \param ot_max_iter maximum number ot OT iteration allowed
100 : !> \param ot_eps_iter convergence threshold for OT diagonalization
101 : ! **************************************************************************************************
102 : TYPE xas_tdp_control_type
103 : INTEGER :: define_excited = 0
104 : INTEGER :: dipole_form = 0
105 : INTEGER :: n_search = 0
106 : INTEGER :: n_excited = 0
107 : INTEGER :: ot_max_iter = 0
108 : REAL(dp) :: e_range = 0.0_dp
109 : REAL(dp) :: sx = 0.0_dp
110 : REAL(dp) :: eps_range = 0.0_dp
111 : REAL(dp) :: eps_screen = 0.0_dp
112 : REAL(dp) :: eps_pgf = 0.0_dp
113 : REAL(dp) :: eps_filter = 0.0_dp
114 : REAL(dp) :: ot_eps_iter = 0.0_dp
115 : TYPE(libint_potential_type) :: x_potential = libint_potential_type()
116 : TYPE(libint_potential_type) :: ri_m_potential = libint_potential_type()
117 : REAL(dp) :: ri_radius = 0.0_dp
118 : LOGICAL :: do_ot = .FALSE.
119 : LOGICAL :: do_hfx = .FALSE.
120 : LOGICAL :: do_xc = .FALSE.
121 : LOGICAL :: do_coulomb = .FALSE.
122 : LOGICAL :: do_ri_metric = .FALSE.
123 : LOGICAL :: check_only = .FALSE.
124 : LOGICAL :: tamm_dancoff = .FALSE.
125 : LOGICAL :: do_quad = .FALSE.
126 : LOGICAL :: xyz_dip = .FALSE.
127 : LOGICAL :: do_loc = .FALSE.
128 : LOGICAL :: do_uks = .FALSE.
129 : LOGICAL :: do_roks = .FALSE.
130 : LOGICAL :: do_soc = .FALSE.
131 : LOGICAL :: do_singlet = .FALSE.
132 : LOGICAL :: do_triplet = .FALSE.
133 : LOGICAL :: do_spin_cons = .FALSE.
134 : LOGICAL :: do_spin_flip = .FALSE.
135 : LOGICAL :: is_periodic = .FALSE.
136 : INTEGER, DIMENSION(:), POINTER :: list_ex_atoms => NULL()
137 : CHARACTER(len=default_string_length), &
138 : DIMENSION(:), POINTER :: list_ex_kinds => NULL()
139 : INTEGER, DIMENSION(:, :), POINTER :: state_types => NULL()
140 : TYPE(section_vals_type), POINTER :: loc_subsection => NULL()
141 : TYPE(section_vals_type), POINTER :: print_loc_subsection => NULL()
142 : CHARACTER(len=default_string_length), &
143 : DIMENSION(:, :), POINTER :: grid_info => NULL()
144 : TYPE(qs_ot_settings_type), POINTER :: ot_settings => NULL()
145 :
146 : LOGICAL :: do_gw2x = .FALSE.
147 : LOGICAL :: xps_only = .FALSE.
148 : REAL(dp) :: gw2x_eps = 0.0_dp
149 : LOGICAL :: pseudo_canonical = .FALSE.
150 : INTEGER :: max_gw2x_iter = 0
151 : REAL(dp) :: c_os = 0.0_dp
152 : REAL(dp) :: c_ss = 0.0_dp
153 : INTEGER :: batch_size = 0
154 :
155 : END TYPE xas_tdp_control_type
156 :
157 : !> *************************************************************************************************
158 : !> \brief Type containing informations such as inputs and results for TDP XAS calculations
159 : !> \param state_type_char an array containing the general donor state types as char (1s, 2s, 2p, ...)
160 : !> \param nex_atoms number of excited atoms
161 : !> \param nex_kinds number of excited kinds
162 : !> \param ex_atom_indices array containing the indices of the excited atoms
163 : !> \param ex_kind_indices array containing the indices of the excited kinds
164 : !> \param state_types columns correspond to the different donor states of each excited atom
165 : !> \param qs_loc_env the environment type dealing with the possible localization of donor orbitals
166 : !> \param mos_of_ex_atoms links lowest energy MOs to excited atoms. Elements of value 1 mark the
167 : !> association between the MO irow and the excited atom icolumn. The third index is for spin
168 : !> \param ri_inv_coul the inverse coulomb RI integral (P|Q)^-1, updated for each excited kind
169 : !> based on basis functions of the RI_XAS basis for that kind
170 : !> \param ri_inv_ex the inverse exchange RI integral (P|Q)^-1, updated for each excited kind
171 : !> based on basis functions of the RI_XAS basis for that kind, and with the exchange operator
172 : !> Optionally, if a RI metric is present, contains M^-1 (P|Q) M^-1
173 : !> \param q_projector the projector on the unperturbed, unoccupied ground state as a dbcsr matrix,
174 : !> for each spin
175 : !> \param dipmat the dbcsr matrices containing the dipole in x,y,z directions evaluated on the
176 : !> contracted spherical gaussians. It can either be in the length or the velocity
177 : !> representation. For length representation, it has to be computed once with the origin on
178 : !> each excited atom
179 : !> \param quadmat the dbcsr matrices containing the electric quadrupole in x2, xy, xz, y2, yz and z2
180 : !> directions in the AO basis. It is always in the length representation with the origin
181 : !> set to the current excited atom
182 : !> \param ri_3c_coul the tensor containing the RI 3-cetner Coulomb integrals (computed once)
183 : !> \param ri_3c_ex the tensor containing the RI 3-center exchange integrals (computed for each ex atom)
184 : !> \param opt_dist2d_coul an optimized distribution_2d for localized Coulomb 3-center integrals
185 : !> \param opt_dist2d_ex an optimized distribution_2d for localized exchange 3-center integrals
186 : !> \param ri_fxc the array of xc integrals of type (P|fxc|Q), for alpha-alpha, alpha-beta and beta-beta
187 : !> \param fxc_avail a boolean telling whwther fxc is availavle on all procs
188 : !> \param orb_soc the matrix where the SOC is evaluated wrt the orbital basis set, for x,y,z
189 : !> \param matrix_shalf the SQRT of the orbital overlap matrix, stored for PDOS use
190 : !> \param ot_prec roeconditioner for the OT solver
191 : !> \param lumo_evecs the LUMOs used as guess for OT
192 : !> \param lumo_evals the associated LUMO evals
193 : !> *************************************************************************************************
194 : TYPE xas_tdp_env_type
195 : CHARACTER(len=2), DIMENSION(3) :: state_type_char = ""
196 : INTEGER :: nex_atoms = 0
197 : INTEGER :: nex_kinds = 0
198 : INTEGER, DIMENSION(:), POINTER :: ex_atom_indices => NULL()
199 : INTEGER, DIMENSION(:), POINTER :: ex_kind_indices => NULL()
200 : INTEGER, DIMENSION(:, :), POINTER :: state_types => NULL()
201 : TYPE(dbt_type), POINTER :: ri_3c_coul => NULL()
202 : TYPE(dbt_type), POINTER :: ri_3c_ex => NULL()
203 : TYPE(donor_state_type), DIMENSION(:), &
204 : POINTER :: donor_states => NULL()
205 : INTEGER, DIMENSION(:, :, :), POINTER :: mos_of_ex_atoms => NULL()
206 : TYPE(qs_loc_env_type), POINTER :: qs_loc_env => NULL()
207 : REAL(dp), DIMENSION(:, :), POINTER :: ri_inv_coul => NULL()
208 : REAL(dp), DIMENSION(:, :), POINTER :: ri_inv_ex => NULL()
209 : TYPE(distribution_2d_type), POINTER :: opt_dist2d_coul => NULL()
210 : TYPE(distribution_2d_type), POINTER :: opt_dist2d_ex => NULL()
211 : TYPE(dbcsr_p_type), DIMENSION(:), &
212 : POINTER :: q_projector => NULL()
213 : TYPE(dbcsr_p_type), DIMENSION(:), &
214 : POINTER :: dipmat => NULL()
215 : TYPE(dbcsr_p_type), DIMENSION(:), &
216 : POINTER :: quadmat => NULL()
217 : TYPE(cp_2d_r_p_type), DIMENSION(:, :), &
218 : POINTER :: ri_fxc => NULL()
219 : LOGICAL :: fxc_avail = .FALSE.
220 : TYPE(dbcsr_p_type), DIMENSION(:), &
221 : POINTER :: orb_soc => NULL()
222 : TYPE(cp_fm_type), POINTER :: matrix_shalf => NULL()
223 : TYPE(cp_fm_type), DIMENSION(:), &
224 : POINTER :: lumo_evecs => NULL()
225 :
226 : TYPE(cp_1d_r_p_type), DIMENSION(:), &
227 : POINTER :: lumo_evals => NULL()
228 : TYPE(dbcsr_p_type), DIMENSION(:), &
229 : POINTER :: ot_prec => NULL()
230 : TYPE(dbcsr_p_type), DIMENSION(:), &
231 : POINTER :: fock_matrix => NULL()
232 : TYPE(cp_fm_type), POINTER :: lumo_coeffs => NULL()
233 : END TYPE xas_tdp_env_type
234 :
235 : !> *************************************************************************************************
236 : !> \brief Type containing informations about a single donor state
237 : !> \param at_index the index of the atom to which the state belongs
238 : !> \param kind_index the index of the atomic kind to which the state belongs
239 : !> \param ndo_mo the number of donor MOs per spin
240 : !> \param at_symbol the chemical symbol of the atom to which the state belongs
241 : !> \param state_type whether this is a 1s, 2s, etc state
242 : !> \param energy_evals the energy eigenvalue of the donor state, for each spin
243 : !> \param gw2x_evals the GW2X corrected energy eigenvalue of the donor state, for each spin
244 : !> \param mo_indices indices of associated MOs. Greater than 1 when not a s-type state.
245 : !> \param sc_coeffs solutions of the linear-response TDDFT equation for spin-conserving open-shell
246 : !> \param sf_coeffs solutions of the linear-response TDDFT equation for spin-flip open-shell
247 : !> \param sg_coeffs solutions of the linear-response TDDFT singlet equations
248 : !> \param tp_coeffs solutions of the linear-response TDDFT triplet equations
249 : !> \param gs_coeffs the ground state MO coefficients
250 : !> \param contract_coeffs the subset of gs_coeffs centered on excited atom, used for RI contraction
251 : !> \param sc_evals open-shell spin-conserving excitation energies
252 : !> \param sf_evals open-shell spin-flip excitation energies
253 : !> \param sg_evals singlet excitation energies => the eigenvalues of the linear response equation
254 : !> \param tp_evals triplet excitation energies => the eigenvalues of the linear response equation
255 : !> \param soc_evals excitation energies after inclusion of SOC
256 : !> \param osc_str dipole oscilaltor strengths (sum and x,y,z contributions)
257 : !> \param soc_osc_str dipole oscillator strengths after the inclusion of SOC (sum and x,y,z contributions)
258 : !> \param quad_osc_str quadrupole oscilaltor strengths
259 : !> \param soc_quad_osc_str quadrupole oscillator strengths after the inclusion of SOC
260 : !> \param sc_matrix_tdp the dbcsr matrix to be diagonalized for open-shell spin-conserving calculations
261 : !> \param sf_matrix_tdp the dbcsr matrix to be diagonalized for open-shell spin-flip calculations
262 : !> \param sg_matrix_tdp the dbcsr matrix to be diagonalized to solve the problem for singlets
263 : !> \param tp_matrix_tdp the dbcsr matrix to be diagonalized to solve the problem for triplets
264 : !> \param metric the metric of the linear response problem M*c = omega*S*c and its inverse
265 : !> \param matrix_aux the auxiliary matrix (A-D+E)^1/2 used to make the problem Hermitian
266 : !> \param blk_size the col/row block size of the dbcsr matrices
267 : !> \param dbcsr_dist the distribution of the dbcsr matrices
268 : !> *************************************************************************************************
269 : TYPE donor_state_type
270 : INTEGER :: at_index = 0
271 : INTEGER :: kind_index = 0
272 : INTEGER :: ndo_mo = 0
273 : CHARACTER(LEN=default_string_length) :: at_symbol = ""
274 : INTEGER :: state_type = 0
275 : INTEGER, DIMENSION(:), POINTER :: blk_size => NULL()
276 : REAL(dp), DIMENSION(:, :), POINTER :: energy_evals => NULL()
277 : REAL(dp), DIMENSION(:, :), POINTER :: gw2x_evals => NULL()
278 : INTEGER, DIMENSION(:, :), POINTER :: mo_indices => NULL()
279 : TYPE(cp_fm_type), POINTER :: sc_coeffs => NULL()
280 : TYPE(cp_fm_type), POINTER :: sf_coeffs => NULL()
281 : TYPE(cp_fm_type), POINTER :: sg_coeffs => NULL()
282 : TYPE(cp_fm_type), POINTER :: tp_coeffs => NULL()
283 : TYPE(cp_fm_type), POINTER :: gs_coeffs => NULL()
284 : REAL(dp), DIMENSION(:, :), POINTER :: contract_coeffs => NULL()
285 : REAL(dp), DIMENSION(:), POINTER :: sc_evals => NULL()
286 : REAL(dp), DIMENSION(:), POINTER :: sf_evals => NULL()
287 : REAL(dp), DIMENSION(:), POINTER :: sg_evals => NULL()
288 : REAL(dp), DIMENSION(:), POINTER :: tp_evals => NULL()
289 : REAL(dp), DIMENSION(:), POINTER :: soc_evals => NULL()
290 : REAL(dp), DIMENSION(:, :), POINTER :: osc_str => NULL()
291 : REAL(dp), DIMENSION(:, :), POINTER :: soc_osc_str => NULL()
292 : REAL(dp), DIMENSION(:), POINTER :: quad_osc_str => NULL()
293 : REAL(dp), DIMENSION(:), POINTER :: soc_quad_osc_str => NULL()
294 : TYPE(dbcsr_type), POINTER :: sc_matrix_tdp => NULL()
295 : TYPE(dbcsr_type), POINTER :: sf_matrix_tdp => NULL()
296 : TYPE(dbcsr_type), POINTER :: sg_matrix_tdp => NULL()
297 : TYPE(dbcsr_type), POINTER :: tp_matrix_tdp => NULL()
298 : TYPE(dbcsr_p_type), DIMENSION(:), &
299 : POINTER :: metric => NULL()
300 : TYPE(dbcsr_type), POINTER :: matrix_aux => NULL()
301 : TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist => NULL()
302 :
303 : END TYPE donor_state_type
304 :
305 : ! Some helper types for xas_tdp_atom
306 : TYPE grid_atom_p_type
307 : TYPE(grid_atom_type), POINTER :: grid_atom => NULL()
308 : END TYPE grid_atom_p_type
309 :
310 : TYPE harmonics_atom_p_type
311 : TYPE(harmonics_atom_type), POINTER :: harmonics_atom => NULL()
312 : END TYPE harmonics_atom_p_type
313 :
314 : TYPE batch_info_type
315 : TYPE(mp_para_env_type) :: para_env = mp_para_env_type()
316 : INTEGER :: batch_size = 0
317 : INTEGER :: nbatch = 0
318 : INTEGER :: ibatch = 0
319 : INTEGER :: ipe = 0
320 : INTEGER, DIMENSION(:), ALLOCATABLE :: nso_proc
321 : INTEGER, DIMENSION(:, :), ALLOCATABLE :: so_bo
322 : TYPE(cp_2d_i_p_type), POINTER, DIMENSION(:) :: so_proc_info => NULL()
323 : END TYPE batch_info_type
324 :
325 : ! **************************************************************************************************
326 : !> \brief a environment type that contains all the info needed for XAS_TDP atomic grid calculations
327 : !> \param ri_radius defines the neighbors in the RI projection of the density
328 : !> \param nspins ...
329 : !> \param excited_atoms the atoms for which RI xc-kernel calculations must be done
330 : !> \param excited_kinds the kinds for which RI xc-kernel calculations must be done
331 : !> \param grid_atom_set the set of atomic grid for each kind
332 : !> \param ri_dcoeff the expansion coefficients to express the density in the RI basis for each atom
333 : !> \param exat_neighbors the neighbors of each excited atom
334 : !> \param ri_sphi_so contains the coefficient for direct contraction from so to sgf, for the ri basis
335 : !> \param orb_sphi_so contains the coefficient for direct contraction from so to sgf, for the orb basis
336 : !> \param ga the angular part of the spherical gaussians on the grid of excited kinds
337 : !> \param gr the radial part of the spherical gaussians on the grid of excited kinds
338 : !> \param dgr1 first radial part of the gradient of the RI spherical gaussians
339 : !> \param dgr2 second radial part of the gradient of the RI spherical gaussians
340 : !> \param dga1 first angular part of the gradient of the RI spherical gaussians
341 : !> \param dga2 second angular part of the gradient of the RI spherical gaussians
342 : !> *************************************************************************************************
343 : TYPE xas_atom_env_type
344 : INTEGER :: nspins = 0
345 : REAL(dp) :: ri_radius = 0.0_dp
346 : INTEGER, DIMENSION(:), POINTER :: excited_atoms => NULL()
347 : INTEGER, DIMENSION(:), POINTER :: excited_kinds => NULL()
348 : INTEGER, DIMENSION(:), POINTER :: proc_of_exat => NULL()
349 : TYPE(grid_atom_p_type), DIMENSION(:), POINTER :: grid_atom_set => NULL()
350 : TYPE(harmonics_atom_p_type), DIMENSION(:), &
351 : POINTER :: harmonics_atom_set => NULL()
352 : TYPE(cp_1d_r_p_type), DIMENSION(:, :, :), POINTER :: ri_dcoeff => NULL()
353 : TYPE(cp_2d_r_p_type), DIMENSION(:), POINTER :: ri_sphi_so => NULL()
354 : TYPE(cp_2d_r_p_type), DIMENSION(:), POINTER :: orb_sphi_so => NULL()
355 : TYPE(cp_1d_i_p_type), DIMENSION(:), POINTER :: exat_neighbors => NULL()
356 : TYPE(cp_2d_r_p_type), DIMENSION(:), POINTER :: ga => NULL(), gr => NULL(), dgr1 => NULL(), dgr2 => NULL()
357 : TYPE(cp_3d_r_p_type), DIMENSION(:), POINTER :: dga1 => NULL(), dga2 => NULL()
358 : END TYPE xas_atom_env_type
359 :
360 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xas_tdp_types'
361 :
362 : ! *** Public data types ***
363 : PUBLIC :: xas_tdp_env_type, donor_state_type, xas_tdp_control_type, xas_atom_env_type, &
364 : batch_info_type
365 :
366 : ! *** Public subroutines ***
367 : PUBLIC :: set_donor_state, free_ds_memory, release_batch_info, &
368 : xas_tdp_env_create, xas_tdp_env_release, set_xas_tdp_env, &
369 : xas_tdp_control_create, xas_tdp_control_release, read_xas_tdp_control, &
370 : xas_atom_env_create, xas_atom_env_release, donor_state_create, free_exat_memory, &
371 : get_proc_batch_sizes
372 :
373 : CONTAINS
374 :
375 : ! **************************************************************************************************
376 : !> \brief Creates and initializes the xas_tdp_control_type
377 : !> \param xas_tdp_control the type to initialize
378 : ! **************************************************************************************************
379 48 : SUBROUTINE xas_tdp_control_create(xas_tdp_control)
380 :
381 : TYPE(xas_tdp_control_type), POINTER :: xas_tdp_control
382 :
383 48 : CPASSERT(.NOT. ASSOCIATED(xas_tdp_control))
384 48 : ALLOCATE (xas_tdp_control)
385 :
386 48 : xas_tdp_control%define_excited = xas_tdp_by_index
387 48 : xas_tdp_control%n_search = -1
388 48 : xas_tdp_control%dipole_form = xas_dip_vel
389 : xas_tdp_control%do_hfx = .FALSE.
390 : xas_tdp_control%do_xc = .FALSE.
391 48 : xas_tdp_control%do_coulomb = .TRUE.
392 : xas_tdp_control%do_ri_metric = .FALSE.
393 48 : xas_tdp_control%sx = 1.0_dp
394 48 : xas_tdp_control%eps_range = 1.0E-6_dp
395 48 : xas_tdp_control%eps_screen = 1.0E-10_dp
396 48 : xas_tdp_control%eps_pgf = -1.0_dp
397 48 : xas_tdp_control%eps_filter = 1.0E-10_dp
398 : xas_tdp_control%ri_radius = 0.0_dp
399 : xas_tdp_control%x_potential%potential_type = do_potential_coulomb
400 : xas_tdp_control%x_potential%cutoff_radius = 0.0_dp
401 : xas_tdp_control%x_potential%omega = 0.0_dp
402 48 : xas_tdp_control%x_potential%filename = " "
403 : xas_tdp_control%ri_m_potential%potential_type = do_potential_coulomb
404 : xas_tdp_control%ri_m_potential%cutoff_radius = 0.0_dp
405 : xas_tdp_control%ri_m_potential%omega = 0.0_dp
406 48 : xas_tdp_control%ri_m_potential%filename = " "
407 : xas_tdp_control%check_only = .FALSE.
408 : xas_tdp_control%tamm_dancoff = .FALSE.
409 48 : xas_tdp_control%do_ot = .TRUE.
410 : xas_tdp_control%do_quad = .FALSE.
411 : xas_tdp_control%xyz_dip = .FALSE.
412 : xas_tdp_control%do_loc = .FALSE.
413 : xas_tdp_control%do_uks = .FALSE.
414 : xas_tdp_control%do_roks = .FALSE.
415 : xas_tdp_control%do_soc = .FALSE.
416 : xas_tdp_control%do_singlet = .FALSE.
417 : xas_tdp_control%do_triplet = .FALSE.
418 : xas_tdp_control%do_spin_cons = .FALSE.
419 : xas_tdp_control%do_spin_flip = .FALSE.
420 : xas_tdp_control%is_periodic = .FALSE.
421 48 : xas_tdp_control%n_excited = -1
422 48 : xas_tdp_control%e_range = -1.0_dp
423 48 : xas_tdp_control%ot_max_iter = 500
424 48 : xas_tdp_control%ot_eps_iter = 1.0E-4_dp
425 48 : xas_tdp_control%c_os = 1.0_dp
426 48 : xas_tdp_control%c_ss = 1.0_dp
427 48 : xas_tdp_control%batch_size = 64
428 : xas_tdp_control%do_gw2x = .FALSE.
429 : xas_tdp_control%xps_only = .FALSE.
430 : NULLIFY (xas_tdp_control%state_types)
431 : NULLIFY (xas_tdp_control%list_ex_atoms)
432 : NULLIFY (xas_tdp_control%list_ex_kinds)
433 : NULLIFY (xas_tdp_control%loc_subsection)
434 : NULLIFY (xas_tdp_control%print_loc_subsection)
435 : NULLIFY (xas_tdp_control%grid_info)
436 : NULLIFY (xas_tdp_control%ot_settings)
437 :
438 48 : END SUBROUTINE xas_tdp_control_create
439 :
440 : ! **************************************************************************************************
441 : !> \brief Releases the xas_tdp_control_type
442 : !> \param xas_tdp_control the type to release
443 : ! **************************************************************************************************
444 48 : SUBROUTINE xas_tdp_control_release(xas_tdp_control)
445 :
446 : TYPE(xas_tdp_control_type), POINTER :: xas_tdp_control
447 :
448 48 : IF (ASSOCIATED(xas_tdp_control)) THEN
449 48 : IF (ASSOCIATED(xas_tdp_control%list_ex_atoms)) THEN
450 48 : DEALLOCATE (xas_tdp_control%list_ex_atoms)
451 : END IF
452 48 : IF (ASSOCIATED(xas_tdp_control%list_ex_kinds)) THEN
453 48 : DEALLOCATE (xas_tdp_control%list_ex_kinds)
454 : END IF
455 48 : IF (ASSOCIATED(xas_tdp_control%state_types)) THEN
456 48 : DEALLOCATE (xas_tdp_control%state_types)
457 : END IF
458 48 : IF (ASSOCIATED(xas_tdp_control%grid_info)) THEN
459 48 : DEALLOCATE (xas_tdp_control%grid_info)
460 : END IF
461 48 : IF (ASSOCIATED(xas_tdp_control%loc_subsection)) THEN
462 : !recursive, print_loc_subsection removed too
463 48 : CALL section_vals_release(xas_tdp_control%loc_subsection)
464 : END IF
465 48 : IF (ASSOCIATED(xas_tdp_control%ot_settings)) THEN
466 48 : DEALLOCATE (xas_tdp_control%ot_settings)
467 : END IF
468 48 : DEALLOCATE (xas_tdp_control)
469 : END IF
470 :
471 48 : END SUBROUTINE xas_tdp_control_release
472 :
473 : ! **************************************************************************************************
474 : !> \brief Reads the inputs and stores in xas_tdp_control_type
475 : !> \param xas_tdp_control the type where inputs are stored
476 : !> \param xas_tdp_section the section from which input are read
477 : ! **************************************************************************************************
478 336 : SUBROUTINE read_xas_tdp_control(xas_tdp_control, xas_tdp_section)
479 :
480 : TYPE(xas_tdp_control_type), POINTER :: xas_tdp_control
481 : TYPE(section_vals_type), POINTER :: xas_tdp_section
482 :
483 : CHARACTER(len=default_string_length), &
484 48 : DIMENSION(:), POINTER :: k_list
485 : INTEGER :: excitation, irep, nexc, nrep, ot_method, &
486 : xc_param
487 48 : INTEGER, DIMENSION(:), POINTER :: a_list, t_list
488 :
489 48 : NULLIFY (k_list, a_list, t_list)
490 :
491 : ! Deal with the lone keywords
492 :
493 : CALL section_vals_val_get(xas_tdp_section, "CHECK_ONLY", &
494 48 : l_val=xas_tdp_control%check_only)
495 :
496 : CALL section_vals_val_get(xas_tdp_section, "TAMM_DANCOFF", &
497 48 : l_val=xas_tdp_control%tamm_dancoff)
498 :
499 : CALL section_vals_val_get(xas_tdp_section, "SPIN_ORBIT_COUPLING", &
500 48 : l_val=xas_tdp_control%do_soc)
501 :
502 48 : CALL section_vals_val_get(xas_tdp_section, "DIPOLE_FORM", i_val=xas_tdp_control%dipole_form)
503 :
504 48 : CALL section_vals_val_get(xas_tdp_section, "QUADRUPOLE", l_val=xas_tdp_control%do_quad)
505 :
506 48 : CALL section_vals_val_get(xas_tdp_section, "XYZ_DIPOLE", l_val=xas_tdp_control%xyz_dip)
507 :
508 48 : CALL section_vals_val_get(xas_tdp_section, "EPS_PGF_XAS", n_rep_val=nrep)
509 48 : IF (nrep > 0) CALL section_vals_val_get(xas_tdp_section, "EPS_PGF_XAS", r_val=xas_tdp_control%eps_pgf)
510 :
511 48 : CALL section_vals_val_get(xas_tdp_section, "EPS_FILTER", r_val=xas_tdp_control%eps_filter)
512 :
513 48 : CALL section_vals_val_get(xas_tdp_section, "GRID", n_rep_val=nrep)
514 :
515 48 : IF (.NOT. ASSOCIATED(xas_tdp_control%grid_info)) THEN
516 138 : ALLOCATE (xas_tdp_control%grid_info(nrep, 3))
517 94 : DO irep = 1, nrep
518 46 : CALL section_vals_val_get(xas_tdp_section, "GRID", i_rep_val=irep, c_vals=k_list)
519 46 : IF (SIZE(k_list) .NE. 3) CPABORT("The GRID keyword needs three values")
520 416 : xas_tdp_control%grid_info(irep, :) = k_list
521 : END DO
522 : END IF
523 :
524 48 : CALL section_vals_val_get(xas_tdp_section, "EXCITATIONS", n_rep_val=nrep)
525 100 : DO irep = 1, nrep
526 52 : CALL section_vals_val_get(xas_tdp_section, "EXCITATIONS", i_rep_val=irep, i_val=excitation)
527 52 : IF (excitation == tddfpt_singlet) xas_tdp_control%do_singlet = .TRUE.
528 52 : IF (excitation == tddfpt_triplet) xas_tdp_control%do_triplet = .TRUE.
529 52 : IF (excitation == tddfpt_spin_cons) xas_tdp_control%do_spin_cons = .TRUE.
530 152 : IF (excitation == tddfpt_spin_flip) xas_tdp_control%do_spin_flip = .TRUE.
531 : END DO
532 :
533 : CALL section_vals_val_get(xas_tdp_section, "N_EXCITED", &
534 48 : i_val=xas_tdp_control%n_excited)
535 : CALL section_vals_val_get(xas_tdp_section, "ENERGY_RANGE", &
536 48 : r_val=xas_tdp_control%e_range)
537 : !store the range in Hartree, not eV
538 48 : xas_tdp_control%e_range = xas_tdp_control%e_range/evolt
539 :
540 : ! Deal with the DONOR_STATES subsection
541 :
542 : CALL section_vals_val_get(xas_tdp_section, "DONOR_STATES%DEFINE_EXCITED", &
543 48 : i_val=xas_tdp_control%define_excited)
544 :
545 48 : IF (.NOT. ASSOCIATED(xas_tdp_control%list_ex_kinds)) THEN
546 48 : IF (xas_tdp_control%define_excited .EQ. xas_tdp_by_index) THEN
547 :
548 26 : ALLOCATE (xas_tdp_control%list_ex_kinds(0))
549 :
550 22 : ELSE IF (xas_tdp_control%define_excited .EQ. xas_tdp_by_kind) THEN
551 :
552 22 : CALL section_vals_val_get(xas_tdp_section, "DONOR_STATES%KIND_LIST", c_vals=k_list)
553 :
554 22 : IF (ASSOCIATED(k_list)) THEN
555 22 : nexc = SIZE(k_list)
556 66 : ALLOCATE (xas_tdp_control%list_ex_kinds(nexc))
557 92 : xas_tdp_control%list_ex_kinds = k_list
558 : END IF
559 :
560 : END IF
561 : END IF
562 :
563 48 : IF (.NOT. ASSOCIATED(xas_tdp_control%list_ex_atoms)) THEN
564 48 : IF (xas_tdp_control%define_excited .EQ. xas_tdp_by_kind) THEN
565 :
566 22 : ALLOCATE (xas_tdp_control%list_ex_atoms(0))
567 :
568 26 : ELSE IF (xas_tdp_control%define_excited .EQ. xas_tdp_by_index) THEN
569 :
570 26 : CALL section_vals_val_get(xas_tdp_section, "DONOR_STATES%ATOM_LIST", i_vals=a_list)
571 :
572 26 : IF (ASSOCIATED(a_list)) THEN
573 26 : nexc = SIZE(a_list)
574 26 : CALL reallocate(xas_tdp_control%list_ex_atoms, 1, nexc)
575 112 : xas_tdp_control%list_ex_atoms = a_list
576 : END IF
577 :
578 : END IF
579 : END IF
580 :
581 48 : CALL section_vals_val_get(xas_tdp_section, "DONOR_STATES%STATE_TYPES", n_rep_val=nrep)
582 :
583 48 : IF (.NOT. ASSOCIATED(xas_tdp_control%state_types)) THEN
584 192 : ALLOCATE (xas_tdp_control%state_types(nrep, nexc))
585 106 : DO irep = 1, nrep
586 58 : CALL section_vals_val_get(xas_tdp_section, "DONOR_STATES%STATE_TYPES", i_rep_val=irep, i_vals=t_list)
587 58 : IF (SIZE(t_list) .NE. nexc) THEN
588 0 : CPABORT("The STATE_TYPES keywords do not have the correct number of entries.")
589 : END IF
590 292 : xas_tdp_control%state_types(irep, :) = t_list
591 : END DO
592 : END IF
593 48 : IF (ALL(xas_tdp_control%state_types == 0)) CPABORT("Please specify STATE_TYPES")
594 :
595 48 : CALL section_vals_val_get(xas_tdp_section, "DONOR_STATES%N_SEARCH", i_val=xas_tdp_control%n_search)
596 :
597 48 : CALL section_vals_val_get(xas_tdp_section, "DONOR_STATES%LOCALIZE", l_val=xas_tdp_control%do_loc)
598 :
599 : ! Deal with the KERNEL subsection
600 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%XC_FUNCTIONAL%_SECTION_PARAMETERS_", &
601 48 : i_val=xc_param)
602 48 : xas_tdp_control%do_xc = xc_param .NE. xc_none
603 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%_SECTION_PARAMETERS_", &
604 48 : l_val=xas_tdp_control%do_hfx)
605 :
606 48 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%RI_REGION", r_val=xas_tdp_control%ri_radius)
607 48 : xas_tdp_control%ri_radius = bohr*xas_tdp_control%ri_radius
608 :
609 48 : IF (xas_tdp_control%do_hfx) THEN
610 : !The main exact echange potential and related params
611 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%SCALE", &
612 38 : r_val=xas_tdp_control%sx)
613 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%POTENTIAL_TYPE", &
614 38 : i_val=xas_tdp_control%x_potential%potential_type)
615 : !truncated Coulomb
616 38 : IF (xas_tdp_control%x_potential%potential_type == do_potential_truncated) THEN
617 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%T_C_G_DATA", &
618 6 : c_val=xas_tdp_control%x_potential%filename)
619 6 : IF (.NOT. file_exists(xas_tdp_control%x_potential%filename)) THEN
620 0 : CPABORT("Could not find provided T_C_G_DATA file.")
621 : END IF
622 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%CUTOFF_RADIUS", &
623 6 : r_val=xas_tdp_control%x_potential%cutoff_radius)
624 : !store the range in bohrs
625 6 : xas_tdp_control%x_potential%cutoff_radius = bohr*xas_tdp_control%x_potential%cutoff_radius
626 : END IF
627 :
628 : !short range erfc
629 38 : IF (xas_tdp_control%x_potential%potential_type == do_potential_short) THEN
630 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%OMEGA", &
631 8 : r_val=xas_tdp_control%x_potential%omega)
632 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%EPS_RANGE", &
633 8 : r_val=xas_tdp_control%eps_range)
634 : !get the effective range (omega in 1/a0, range in a0)
635 : CALL erfc_cutoff(xas_tdp_control%eps_range, xas_tdp_control%x_potential%omega, &
636 8 : xas_tdp_control%x_potential%cutoff_radius)
637 :
638 : END IF
639 :
640 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%EPS_SCREENING", &
641 38 : r_val=xas_tdp_control%eps_screen)
642 : !The RI metric stuff
643 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%RI_METRIC%_SECTION_PARAMETERS_", &
644 38 : l_val=xas_tdp_control%do_ri_metric)
645 38 : IF (xas_tdp_control%do_ri_metric) THEN
646 :
647 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%RI_METRIC%POTENTIAL_TYPE", &
648 6 : i_val=xas_tdp_control%ri_m_potential%potential_type)
649 :
650 : !truncated Coulomb
651 6 : IF (xas_tdp_control%ri_m_potential%potential_type == do_potential_truncated) THEN
652 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%RI_METRIC%T_C_G_DATA", &
653 2 : c_val=xas_tdp_control%ri_m_potential%filename)
654 2 : IF (.NOT. file_exists(xas_tdp_control%ri_m_potential%filename)) THEN
655 0 : CPABORT("Could not find provided T_C_G_DATA file.")
656 : END IF
657 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%RI_METRIC%CUTOFF_RADIUS", &
658 2 : r_val=xas_tdp_control%ri_m_potential%cutoff_radius)
659 : !store the range in bohrs
660 2 : xas_tdp_control%ri_m_potential%cutoff_radius = bohr*xas_tdp_control%ri_m_potential%cutoff_radius
661 : END IF
662 :
663 : !short range erfc
664 6 : IF (xas_tdp_control%ri_m_potential%potential_type == do_potential_short) THEN
665 : CALL section_vals_val_get(xas_tdp_section, "KERNEL%EXACT_EXCHANGE%RI_METRIC%OMEGA", &
666 2 : r_val=xas_tdp_control%ri_m_potential%omega)
667 : !get the effective range (omega in 1/a0, range in a0)
668 : CALL erfc_cutoff(xas_tdp_control%eps_range, xas_tdp_control%ri_m_potential%omega, &
669 2 : xas_tdp_control%ri_m_potential%cutoff_radius)
670 :
671 : END IF
672 : ELSE
673 : !No defined metric, V-approximation, set all ri_m_potential params to those of x_pot
674 32 : xas_tdp_control%ri_m_potential = xas_tdp_control%x_potential
675 :
676 : END IF
677 :
678 : END IF
679 :
680 48 : IF ((.NOT. xas_tdp_control%do_xc) .AND. (.NOT. xas_tdp_control%do_hfx)) THEN
681 : !then no coulomb either and go full DFT
682 0 : xas_tdp_control%do_coulomb = .FALSE.
683 : END IF
684 :
685 : !Set up OT settings
686 48 : ALLOCATE (xas_tdp_control%ot_settings)
687 48 : CALL qs_ot_settings_init(xas_tdp_control%ot_settings)
688 : CALL section_vals_val_get(xas_tdp_section, "OT_SOLVER%_SECTION_PARAMETERS_", &
689 48 : l_val=xas_tdp_control%do_ot)
690 :
691 48 : CALL section_vals_val_get(xas_tdp_section, "OT_SOLVER%MINIMIZER", i_val=ot_method)
692 0 : SELECT CASE (ot_method)
693 : CASE (ot_mini_cg)
694 0 : xas_tdp_control%ot_settings%ot_method = "CG"
695 : CASE (ot_mini_diis)
696 48 : xas_tdp_control%ot_settings%ot_method = "DIIS"
697 : END SELECT
698 :
699 : CALL section_vals_val_get(xas_tdp_section, "OT_SOLVER%MAX_ITER", &
700 48 : i_val=xas_tdp_control%ot_max_iter)
701 : CALL section_vals_val_get(xas_tdp_section, "OT_SOLVER%EPS_ITER", &
702 48 : r_val=xas_tdp_control%ot_eps_iter)
703 :
704 : !GW2X
705 48 : CALL section_vals_val_get(xas_tdp_section, "GW2X%_SECTION_PARAMETERS_", l_val=xas_tdp_control%do_gw2x)
706 48 : IF (xas_tdp_control%do_gw2x) THEN
707 18 : CALL section_vals_val_get(xas_tdp_section, "GW2X%EPS_GW2X", r_val=xas_tdp_control%gw2x_eps)
708 18 : CALL section_vals_val_get(xas_tdp_section, "GW2X%XPS_ONLY", l_val=xas_tdp_control%xps_only)
709 18 : CALL section_vals_val_get(xas_tdp_section, "GW2X%C_OS", r_val=xas_tdp_control%c_os)
710 18 : CALL section_vals_val_get(xas_tdp_section, "GW2X%C_SS", r_val=xas_tdp_control%c_ss)
711 18 : CALL section_vals_val_get(xas_tdp_section, "GW2X%MAX_GW2X_ITER", i_val=xas_tdp_control%max_gw2x_iter)
712 18 : CALL section_vals_val_get(xas_tdp_section, "GW2X%PSEUDO_CANONICAL", l_val=xas_tdp_control%pseudo_canonical)
713 18 : CALL section_vals_val_get(xas_tdp_section, "GW2X%BATCH_SIZE", i_val=xas_tdp_control%batch_size)
714 : END IF
715 :
716 48 : END SUBROUTINE read_xas_tdp_control
717 :
718 : ! **************************************************************************************************
719 : !> \brief Creates a TDP XAS environment type
720 : !> \param xas_tdp_env the type to create
721 : ! **************************************************************************************************
722 50 : SUBROUTINE xas_tdp_env_create(xas_tdp_env)
723 :
724 : TYPE(xas_tdp_env_type), POINTER :: xas_tdp_env
725 :
726 250 : ALLOCATE (xas_tdp_env)
727 :
728 50 : xas_tdp_env%nex_atoms = 1
729 50 : xas_tdp_env%nex_kinds = 1
730 : xas_tdp_env%fxc_avail = .FALSE.
731 :
732 : NULLIFY (xas_tdp_env%ex_atom_indices)
733 : NULLIFY (xas_tdp_env%ex_kind_indices)
734 : NULLIFY (xas_tdp_env%state_types)
735 : NULLIFY (xas_tdp_env%donor_states)
736 : NULLIFY (xas_tdp_env%qs_loc_env)
737 : NULLIFY (xas_tdp_env%mos_of_ex_atoms)
738 : NULLIFY (xas_tdp_env%ri_inv_coul)
739 : NULLIFY (xas_tdp_env%ri_inv_ex)
740 : NULLIFY (xas_tdp_env%opt_dist2d_coul)
741 : NULLIFY (xas_tdp_env%opt_dist2d_ex)
742 : NULLIFY (xas_tdp_env%q_projector)
743 : NULLIFY (xas_tdp_env%dipmat)
744 : NULLIFY (xas_tdp_env%quadmat)
745 : NULLIFY (xas_tdp_env%ri_3c_coul)
746 : NULLIFY (xas_tdp_env%ri_3c_ex)
747 : NULLIFY (xas_tdp_env%ri_fxc)
748 : NULLIFY (xas_tdp_env%orb_soc)
749 : NULLIFY (xas_tdp_env%matrix_shalf)
750 : NULLIFY (xas_tdp_env%lumo_evecs)
751 : NULLIFY (xas_tdp_env%lumo_evals)
752 : NULLIFY (xas_tdp_env%ot_prec)
753 : NULLIFY (xas_tdp_env%lumo_coeffs)
754 : NULLIFY (xas_tdp_env%fock_matrix)
755 :
756 : ! Putting the state types as char manually
757 50 : xas_tdp_env%state_type_char(1) = "1s"
758 50 : xas_tdp_env%state_type_char(2) = "2s"
759 50 : xas_tdp_env%state_type_char(3) = "2p"
760 :
761 50 : END SUBROUTINE xas_tdp_env_create
762 :
763 : ! **************************************************************************************************
764 : !> \brief Releases the TDP XAS environment type
765 : !> \param xas_tdp_env the type to release
766 : ! **************************************************************************************************
767 50 : SUBROUTINE xas_tdp_env_release(xas_tdp_env)
768 :
769 : TYPE(xas_tdp_env_type), POINTER :: xas_tdp_env
770 :
771 : INTEGER :: i, j
772 :
773 50 : IF (ASSOCIATED(xas_tdp_env)) THEN
774 50 : IF (ASSOCIATED(xas_tdp_env%ex_atom_indices)) THEN
775 48 : DEALLOCATE (xas_tdp_env%ex_atom_indices)
776 : END IF
777 50 : IF (ASSOCIATED(xas_tdp_env%ex_kind_indices)) THEN
778 48 : DEALLOCATE (xas_tdp_env%ex_kind_indices)
779 : END IF
780 :
781 50 : IF (ASSOCIATED(xas_tdp_env%state_types)) THEN
782 48 : DEALLOCATE (xas_tdp_env%state_types)
783 : END IF
784 50 : IF (ASSOCIATED(xas_tdp_env%donor_states)) THEN
785 48 : CALL deallocate_donor_state_set(xas_tdp_env%donor_states)
786 : END IF
787 50 : IF (ASSOCIATED(xas_tdp_env%qs_loc_env)) THEN
788 48 : CALL qs_loc_env_release(xas_tdp_env%qs_loc_env)
789 48 : DEALLOCATE (xas_tdp_env%qs_loc_env)
790 : END IF
791 50 : IF (ASSOCIATED(xas_tdp_env%mos_of_ex_atoms)) THEN
792 48 : DEALLOCATE (xas_tdp_env%mos_of_ex_atoms)
793 : END IF
794 50 : IF (ASSOCIATED(xas_tdp_env%ri_inv_coul)) THEN
795 48 : DEALLOCATE (xas_tdp_env%ri_inv_coul)
796 : END IF
797 50 : IF (ASSOCIATED(xas_tdp_env%ri_inv_ex)) THEN
798 38 : DEALLOCATE (xas_tdp_env%ri_inv_ex)
799 : END IF
800 50 : IF (ASSOCIATED(xas_tdp_env%opt_dist2d_coul)) THEN
801 44 : CALL distribution_2d_release(xas_tdp_env%opt_dist2d_coul)
802 : END IF
803 50 : IF (ASSOCIATED(xas_tdp_env%opt_dist2d_ex)) THEN
804 0 : CALL distribution_2d_release(xas_tdp_env%opt_dist2d_ex)
805 : END IF
806 50 : IF (ASSOCIATED(xas_tdp_env%q_projector)) THEN
807 102 : DO i = 1, SIZE(xas_tdp_env%q_projector)
808 102 : CALL dbcsr_release_p(xas_tdp_env%q_projector(i)%matrix)
809 : END DO
810 48 : DEALLOCATE (xas_tdp_env%q_projector)
811 : END IF
812 50 : IF (ASSOCIATED(xas_tdp_env%dipmat)) THEN
813 192 : DO i = 1, SIZE(xas_tdp_env%dipmat)
814 192 : CALL dbcsr_release_p(xas_tdp_env%dipmat(i)%matrix)
815 : END DO
816 48 : DEALLOCATE (xas_tdp_env%dipmat)
817 : END IF
818 50 : IF (ASSOCIATED(xas_tdp_env%quadmat)) THEN
819 0 : DO i = 1, SIZE(xas_tdp_env%quadmat)
820 0 : CALL dbcsr_release_p(xas_tdp_env%quadmat(i)%matrix)
821 : END DO
822 0 : DEALLOCATE (xas_tdp_env%quadmat)
823 : END IF
824 50 : IF (ASSOCIATED(xas_tdp_env%ri_3c_coul)) THEN
825 44 : CALL dbt_destroy(xas_tdp_env%ri_3c_coul)
826 44 : DEALLOCATE (xas_tdp_env%ri_3c_coul)
827 : END IF
828 50 : IF (ASSOCIATED(xas_tdp_env%ri_3c_ex)) THEN
829 0 : CALL dbt_destroy(xas_tdp_env%ri_3c_ex)
830 0 : DEALLOCATE (xas_tdp_env%ri_3c_ex)
831 : END IF
832 50 : IF (ASSOCIATED(xas_tdp_env%ri_fxc)) THEN
833 408 : DO i = 1, SIZE(xas_tdp_env%ri_fxc, 1)
834 1888 : DO j = 1, SIZE(xas_tdp_env%ri_fxc, 2)
835 1850 : IF (ASSOCIATED(xas_tdp_env%ri_fxc(i, j)%array)) THEN
836 0 : DEALLOCATE (xas_tdp_env%ri_fxc(i, j)%array)
837 : END IF
838 : END DO
839 : END DO
840 38 : DEALLOCATE (xas_tdp_env%ri_fxc)
841 : END IF
842 50 : IF (ASSOCIATED(xas_tdp_env%orb_soc)) THEN
843 88 : DO i = 1, SIZE(xas_tdp_env%orb_soc)
844 66 : CALL dbcsr_release(xas_tdp_env%orb_soc(i)%matrix)
845 88 : DEALLOCATE (xas_tdp_env%orb_soc(i)%matrix)
846 : END DO
847 22 : DEALLOCATE (xas_tdp_env%orb_soc)
848 : END IF
849 :
850 50 : CALL cp_fm_release(xas_tdp_env%lumo_evecs)
851 :
852 50 : IF (ASSOCIATED(xas_tdp_env%lumo_evals)) THEN
853 42 : DO i = 1, SIZE(xas_tdp_env%lumo_evals)
854 42 : DEALLOCATE (xas_tdp_env%lumo_evals(i)%array)
855 : END DO
856 20 : DEALLOCATE (xas_tdp_env%lumo_evals)
857 : END IF
858 50 : IF (ASSOCIATED(xas_tdp_env%ot_prec)) THEN
859 42 : DO i = 1, SIZE(xas_tdp_env%ot_prec)
860 22 : CALL dbcsr_release(xas_tdp_env%ot_prec(i)%matrix)
861 42 : DEALLOCATE (xas_tdp_env%ot_prec(i)%matrix)
862 : END DO
863 20 : DEALLOCATE (xas_tdp_env%ot_prec)
864 : END IF
865 50 : IF (ASSOCIATED(xas_tdp_env%matrix_shalf)) THEN
866 2 : CALL cp_fm_release(xas_tdp_env%matrix_shalf)
867 2 : DEALLOCATE (xas_tdp_env%matrix_shalf)
868 2 : NULLIFY (xas_tdp_env%matrix_shalf)
869 : END IF
870 50 : IF (ASSOCIATED(xas_tdp_env%fock_matrix)) THEN
871 38 : DO i = 1, SIZE(xas_tdp_env%fock_matrix)
872 20 : CALL dbcsr_release(xas_tdp_env%fock_matrix(i)%matrix)
873 38 : DEALLOCATE (xas_tdp_env%fock_matrix(i)%matrix)
874 : END DO
875 18 : DEALLOCATE (xas_tdp_env%fock_matrix)
876 : END IF
877 50 : IF (ASSOCIATED(xas_tdp_env%lumo_coeffs)) THEN
878 0 : CALL cp_fm_release(xas_tdp_env%lumo_coeffs)
879 0 : DEALLOCATE (xas_tdp_env%lumo_coeffs)
880 0 : NULLIFY (xas_tdp_env%lumo_coeffs)
881 : END IF
882 50 : DEALLOCATE (xas_tdp_env)
883 : END IF
884 50 : END SUBROUTINE xas_tdp_env_release
885 :
886 : ! **************************************************************************************************
887 : !> \brief Sets values of selected variables within the TDP XAS environment type
888 : !> \param xas_tdp_env ...
889 : !> \param nex_atoms ...
890 : !> \param nex_kinds ...
891 : ! **************************************************************************************************
892 74 : SUBROUTINE set_xas_tdp_env(xas_tdp_env, nex_atoms, nex_kinds)
893 :
894 : TYPE(xas_tdp_env_type), POINTER :: xas_tdp_env
895 : INTEGER, INTENT(IN), OPTIONAL :: nex_atoms, nex_kinds
896 :
897 74 : CPASSERT(ASSOCIATED(xas_tdp_env))
898 :
899 74 : IF (PRESENT(nex_atoms)) xas_tdp_env%nex_atoms = nex_atoms
900 74 : IF (PRESENT(nex_kinds)) xas_tdp_env%nex_kinds = nex_kinds
901 :
902 74 : END SUBROUTINE set_xas_tdp_env
903 :
904 : ! **************************************************************************************************
905 : !> \brief Creates a donor_state
906 : !> \param donor_state ...
907 : ! **************************************************************************************************
908 70 : SUBROUTINE donor_state_create(donor_state)
909 :
910 : TYPE(donor_state_type), INTENT(INOUT) :: donor_state
911 :
912 70 : NULLIFY (donor_state%energy_evals)
913 70 : NULLIFY (donor_state%gw2x_evals)
914 70 : NULLIFY (donor_state%mo_indices)
915 70 : NULLIFY (donor_state%sc_coeffs)
916 70 : NULLIFY (donor_state%sf_coeffs)
917 70 : NULLIFY (donor_state%sg_coeffs)
918 70 : NULLIFY (donor_state%tp_coeffs)
919 70 : NULLIFY (donor_state%gs_coeffs)
920 70 : NULLIFY (donor_state%contract_coeffs)
921 70 : NULLIFY (donor_state%sc_evals)
922 70 : NULLIFY (donor_state%sf_evals)
923 70 : NULLIFY (donor_state%sg_evals)
924 70 : NULLIFY (donor_state%tp_evals)
925 70 : NULLIFY (donor_state%soc_evals)
926 70 : NULLIFY (donor_state%soc_osc_str)
927 70 : NULLIFY (donor_state%osc_str)
928 70 : NULLIFY (donor_state%soc_quad_osc_str)
929 70 : NULLIFY (donor_state%quad_osc_str)
930 70 : NULLIFY (donor_state%sc_matrix_tdp)
931 70 : NULLIFY (donor_state%sf_matrix_tdp)
932 70 : NULLIFY (donor_state%sg_matrix_tdp)
933 70 : NULLIFY (donor_state%tp_matrix_tdp)
934 70 : NULLIFY (donor_state%metric)
935 70 : NULLIFY (donor_state%matrix_aux)
936 70 : NULLIFY (donor_state%blk_size)
937 70 : NULLIFY (donor_state%dbcsr_dist)
938 :
939 70 : END SUBROUTINE donor_state_create
940 :
941 : ! **************************************************************************************************
942 : !> \brief sets specified values of the donor state type
943 : !> \param donor_state the type which values should be set
944 : !> \param at_index ...
945 : !> \param at_symbol ...
946 : !> \param kind_index ...
947 : !> \param state_type ...
948 : ! **************************************************************************************************
949 68 : SUBROUTINE set_donor_state(donor_state, at_index, at_symbol, kind_index, state_type)
950 :
951 : TYPE(donor_state_type), POINTER :: donor_state
952 : INTEGER, INTENT(IN), OPTIONAL :: at_index
953 : CHARACTER(LEN=default_string_length), OPTIONAL :: at_symbol
954 : INTEGER, INTENT(IN), OPTIONAL :: kind_index, state_type
955 :
956 68 : CPASSERT(ASSOCIATED(donor_state))
957 :
958 68 : IF (PRESENT(at_index)) donor_state%at_index = at_index
959 68 : IF (PRESENT(kind_index)) donor_state%kind_index = kind_index
960 68 : IF (PRESENT(state_type)) donor_state%state_type = state_type
961 68 : IF (PRESENT(at_symbol)) donor_state%at_symbol = at_symbol
962 :
963 68 : END SUBROUTINE set_donor_state
964 :
965 : ! **************************************************************************************************
966 : !> \brief Deallocate a set of donor states
967 : !> \param donor_state_set the set of donor states to deallocate
968 : ! **************************************************************************************************
969 48 : SUBROUTINE deallocate_donor_state_set(donor_state_set)
970 : TYPE(donor_state_type), DIMENSION(:), POINTER :: donor_state_set
971 :
972 : INTEGER :: i, j
973 :
974 48 : IF (ASSOCIATED(donor_state_set)) THEN
975 116 : DO i = 1, SIZE(donor_state_set)
976 :
977 68 : IF (ASSOCIATED(donor_state_set(i)%sc_coeffs)) THEN
978 0 : CALL cp_fm_release(donor_state_set(i)%sc_coeffs)
979 0 : DEALLOCATE (donor_state_set(i)%sc_coeffs)
980 : END IF
981 :
982 68 : IF (ASSOCIATED(donor_state_set(i)%sf_coeffs)) THEN
983 0 : CALL cp_fm_release(donor_state_set(i)%sf_coeffs)
984 0 : DEALLOCATE (donor_state_set(i)%sf_coeffs)
985 : END IF
986 :
987 68 : IF (ASSOCIATED(donor_state_set(i)%sg_coeffs)) THEN
988 0 : CALL cp_fm_release(donor_state_set(i)%sg_coeffs)
989 0 : DEALLOCATE (donor_state_set(i)%sg_coeffs)
990 : END IF
991 :
992 68 : IF (ASSOCIATED(donor_state_set(i)%tp_coeffs)) THEN
993 0 : CALL cp_fm_release(donor_state_set(i)%tp_coeffs)
994 0 : DEALLOCATE (donor_state_set(i)%tp_coeffs)
995 : END IF
996 :
997 68 : IF (ASSOCIATED(donor_state_set(i)%gs_coeffs)) THEN
998 0 : CALL cp_fm_release(donor_state_set(i)%gs_coeffs)
999 0 : DEALLOCATE (donor_state_set(i)%gs_coeffs)
1000 : END IF
1001 :
1002 68 : IF (ASSOCIATED(donor_state_set(i)%contract_coeffs)) THEN
1003 0 : DEALLOCATE (donor_state_set(i)%contract_coeffs)
1004 : END IF
1005 :
1006 68 : IF (ASSOCIATED(donor_state_set(i)%sc_evals)) THEN
1007 0 : DEALLOCATE (donor_state_set(i)%sc_evals)
1008 : END IF
1009 :
1010 68 : IF (ASSOCIATED(donor_state_set(i)%sf_evals)) THEN
1011 0 : DEALLOCATE (donor_state_set(i)%sf_evals)
1012 : END IF
1013 :
1014 68 : IF (ASSOCIATED(donor_state_set(i)%sg_evals)) THEN
1015 0 : DEALLOCATE (donor_state_set(i)%sg_evals)
1016 : END IF
1017 :
1018 68 : IF (ASSOCIATED(donor_state_set(i)%tp_evals)) THEN
1019 0 : DEALLOCATE (donor_state_set(i)%tp_evals)
1020 : END IF
1021 :
1022 68 : IF (ASSOCIATED(donor_state_set(i)%soc_evals)) THEN
1023 0 : DEALLOCATE (donor_state_set(i)%soc_evals)
1024 : END IF
1025 :
1026 68 : IF (ASSOCIATED(donor_state_set(i)%osc_str)) THEN
1027 0 : DEALLOCATE (donor_state_set(i)%osc_str)
1028 : END IF
1029 :
1030 68 : IF (ASSOCIATED(donor_state_set(i)%soc_osc_str)) THEN
1031 0 : DEALLOCATE (donor_state_set(i)%soc_osc_str)
1032 : END IF
1033 :
1034 68 : IF (ASSOCIATED(donor_state_set(i)%quad_osc_str)) THEN
1035 0 : DEALLOCATE (donor_state_set(i)%quad_osc_str)
1036 : END IF
1037 :
1038 68 : IF (ASSOCIATED(donor_state_set(i)%soc_quad_osc_str)) THEN
1039 0 : DEALLOCATE (donor_state_set(i)%soc_quad_osc_str)
1040 : END IF
1041 :
1042 68 : IF (ASSOCIATED(donor_state_set(i)%energy_evals)) THEN
1043 68 : DEALLOCATE (donor_state_set(i)%energy_evals)
1044 : END IF
1045 :
1046 68 : IF (ASSOCIATED(donor_state_set(i)%gw2x_evals)) THEN
1047 68 : DEALLOCATE (donor_state_set(i)%gw2x_evals)
1048 : END IF
1049 :
1050 68 : IF (ASSOCIATED(donor_state_set(i)%mo_indices)) THEN
1051 68 : DEALLOCATE (donor_state_set(i)%mo_indices)
1052 : END IF
1053 :
1054 68 : IF (ASSOCIATED(donor_state_set(i)%sc_matrix_tdp)) THEN
1055 0 : CALL dbcsr_release(donor_state_set(i)%sc_matrix_tdp)
1056 0 : DEALLOCATE (donor_state_set(i)%sc_matrix_tdp)
1057 : END IF
1058 :
1059 68 : IF (ASSOCIATED(donor_state_set(i)%sf_matrix_tdp)) THEN
1060 0 : CALL dbcsr_release(donor_state_set(i)%sf_matrix_tdp)
1061 0 : DEALLOCATE (donor_state_set(i)%sf_matrix_tdp)
1062 : END IF
1063 :
1064 68 : IF (ASSOCIATED(donor_state_set(i)%sg_matrix_tdp)) THEN
1065 0 : CALL dbcsr_release(donor_state_set(i)%sg_matrix_tdp)
1066 0 : DEALLOCATE (donor_state_set(i)%sg_matrix_tdp)
1067 : END IF
1068 :
1069 68 : IF (ASSOCIATED(donor_state_set(i)%tp_matrix_tdp)) THEN
1070 0 : CALL dbcsr_release(donor_state_set(i)%tp_matrix_tdp)
1071 0 : DEALLOCATE (donor_state_set(i)%tp_matrix_tdp)
1072 : END IF
1073 :
1074 68 : IF (ASSOCIATED(donor_state_set(i)%metric)) THEN
1075 0 : DO j = 1, SIZE(donor_state_set(i)%metric)
1076 0 : IF (ASSOCIATED(donor_state_set(i)%metric(j)%matrix)) THEN
1077 0 : CALL dbcsr_release(donor_state_set(i)%metric(j)%matrix)
1078 0 : DEALLOCATE (donor_state_set(i)%metric(j)%matrix)
1079 : END IF
1080 : END DO
1081 0 : DEALLOCATE (donor_state_set(i)%metric)
1082 : END IF
1083 :
1084 68 : IF (ASSOCIATED(donor_state_set(i)%matrix_aux)) THEN
1085 0 : CALL dbcsr_release(donor_state_set(i)%matrix_aux)
1086 0 : DEALLOCATE (donor_state_set(i)%matrix_aux)
1087 : END IF
1088 :
1089 68 : IF (ASSOCIATED(donor_state_set(i)%blk_size)) THEN
1090 0 : DEALLOCATE (donor_state_set(i)%blk_size)
1091 : END IF
1092 :
1093 116 : IF (ASSOCIATED(donor_state_set(i)%dbcsr_dist)) THEN
1094 0 : CALL dbcsr_distribution_release(donor_state_set(i)%dbcsr_dist)
1095 0 : DEALLOCATE (donor_state_set(i)%dbcsr_dist)
1096 : END IF
1097 : END DO
1098 48 : DEALLOCATE (donor_state_set)
1099 : END IF
1100 :
1101 48 : END SUBROUTINE deallocate_donor_state_set
1102 :
1103 : ! **************************************************************************************************
1104 : !> \brief Deallocate a donor_state's heavy attributes
1105 : !> \param donor_state ...
1106 : ! **************************************************************************************************
1107 70 : SUBROUTINE free_ds_memory(donor_state)
1108 :
1109 : TYPE(donor_state_type), POINTER :: donor_state
1110 :
1111 : INTEGER :: i
1112 :
1113 70 : IF (ASSOCIATED(donor_state%sc_evals)) DEALLOCATE (donor_state%sc_evals)
1114 70 : IF (ASSOCIATED(donor_state%contract_coeffs)) DEALLOCATE (donor_state%contract_coeffs)
1115 70 : IF (ASSOCIATED(donor_state%sf_evals)) DEALLOCATE (donor_state%sf_evals)
1116 70 : IF (ASSOCIATED(donor_state%sg_evals)) DEALLOCATE (donor_state%sg_evals)
1117 70 : IF (ASSOCIATED(donor_state%tp_evals)) DEALLOCATE (donor_state%tp_evals)
1118 70 : IF (ASSOCIATED(donor_state%soc_evals)) DEALLOCATE (donor_state%soc_evals)
1119 70 : IF (ASSOCIATED(donor_state%osc_str)) DEALLOCATE (donor_state%osc_str)
1120 70 : IF (ASSOCIATED(donor_state%soc_osc_str)) DEALLOCATE (donor_state%soc_osc_str)
1121 70 : IF (ASSOCIATED(donor_state%quad_osc_str)) DEALLOCATE (donor_state%quad_osc_str)
1122 70 : IF (ASSOCIATED(donor_state%soc_quad_osc_str)) DEALLOCATE (donor_state%soc_quad_osc_str)
1123 70 : IF (ASSOCIATED(donor_state%gs_coeffs)) THEN
1124 68 : CALL cp_fm_release(donor_state%gs_coeffs)
1125 68 : DEALLOCATE (donor_state%gs_coeffs)
1126 68 : NULLIFY (donor_state%gs_coeffs)
1127 : END IF
1128 70 : IF (ASSOCIATED(donor_state%blk_size)) DEALLOCATE (donor_state%blk_size)
1129 :
1130 70 : IF (ASSOCIATED(donor_state%sc_coeffs)) THEN
1131 8 : CALL cp_fm_release(donor_state%sc_coeffs)
1132 8 : DEALLOCATE (donor_state%sc_coeffs)
1133 8 : NULLIFY (donor_state%sc_coeffs)
1134 : END IF
1135 :
1136 70 : IF (ASSOCIATED(donor_state%sf_coeffs)) THEN
1137 2 : CALL cp_fm_release(donor_state%sf_coeffs)
1138 2 : DEALLOCATE (donor_state%sf_coeffs)
1139 2 : NULLIFY (donor_state%sf_coeffs)
1140 : END IF
1141 :
1142 70 : IF (ASSOCIATED(donor_state%sg_coeffs)) THEN
1143 50 : CALL cp_fm_release(donor_state%sg_coeffs)
1144 50 : DEALLOCATE (donor_state%sg_coeffs)
1145 50 : NULLIFY (donor_state%sg_coeffs)
1146 : END IF
1147 :
1148 70 : IF (ASSOCIATED(donor_state%tp_coeffs)) THEN
1149 2 : CALL cp_fm_release(donor_state%tp_coeffs)
1150 2 : DEALLOCATE (donor_state%tp_coeffs)
1151 2 : NULLIFY (donor_state%tp_coeffs)
1152 : END IF
1153 :
1154 70 : IF (ASSOCIATED(donor_state%sc_matrix_tdp)) THEN
1155 8 : CALL dbcsr_release(donor_state%sc_matrix_tdp)
1156 8 : DEALLOCATE (donor_state%sc_matrix_tdp)
1157 : END IF
1158 :
1159 70 : IF (ASSOCIATED(donor_state%sf_matrix_tdp)) THEN
1160 2 : CALL dbcsr_release(donor_state%sf_matrix_tdp)
1161 2 : DEALLOCATE (donor_state%sf_matrix_tdp)
1162 : END IF
1163 :
1164 70 : IF (ASSOCIATED(donor_state%sg_matrix_tdp)) THEN
1165 48 : CALL dbcsr_release(donor_state%sg_matrix_tdp)
1166 48 : DEALLOCATE (donor_state%sg_matrix_tdp)
1167 : END IF
1168 :
1169 70 : IF (ASSOCIATED(donor_state%tp_matrix_tdp)) THEN
1170 2 : CALL dbcsr_release(donor_state%tp_matrix_tdp)
1171 2 : DEALLOCATE (donor_state%tp_matrix_tdp)
1172 : END IF
1173 :
1174 70 : IF (ASSOCIATED(donor_state%metric)) THEN
1175 118 : DO i = 1, SIZE(donor_state%metric)
1176 118 : IF (ASSOCIATED(donor_state%metric(i)%matrix)) THEN
1177 62 : CALL dbcsr_release(donor_state%metric(i)%matrix)
1178 62 : DEALLOCATE (donor_state%metric(i)%matrix)
1179 : END IF
1180 : END DO
1181 56 : DEALLOCATE (donor_state%metric)
1182 : END IF
1183 :
1184 70 : IF (ASSOCIATED(donor_state%matrix_aux)) THEN
1185 6 : CALL dbcsr_release(donor_state%matrix_aux)
1186 6 : DEALLOCATE (donor_state%matrix_aux)
1187 : END IF
1188 :
1189 70 : IF (ASSOCIATED(donor_state%dbcsr_dist)) THEN
1190 56 : CALL dbcsr_distribution_release(donor_state%dbcsr_dist)
1191 56 : DEALLOCATE (donor_state%dbcsr_dist)
1192 : END IF
1193 :
1194 70 : END SUBROUTINE free_ds_memory
1195 :
1196 : ! **************************************************************************************************
1197 : !> \brief Creates a xas_atom_env type
1198 : !> \param xas_atom_env ...
1199 : ! **************************************************************************************************
1200 48 : SUBROUTINE xas_atom_env_create(xas_atom_env)
1201 :
1202 : TYPE(xas_atom_env_type), POINTER :: xas_atom_env
1203 :
1204 48 : ALLOCATE (xas_atom_env)
1205 :
1206 48 : xas_atom_env%nspins = 1
1207 : xas_atom_env%ri_radius = 0.0_dp
1208 : NULLIFY (xas_atom_env%excited_atoms)
1209 : NULLIFY (xas_atom_env%excited_kinds)
1210 : NULLIFY (xas_atom_env%grid_atom_set)
1211 : NULLIFY (xas_atom_env%harmonics_atom_set)
1212 : NULLIFY (xas_atom_env%ri_dcoeff)
1213 : NULLIFY (xas_atom_env%ri_sphi_so)
1214 : NULLIFY (xas_atom_env%orb_sphi_so)
1215 : NULLIFY (xas_atom_env%exat_neighbors)
1216 : NULLIFY (xas_atom_env%gr)
1217 : NULLIFY (xas_atom_env%ga)
1218 : NULLIFY (xas_atom_env%dgr1)
1219 : NULLIFY (xas_atom_env%dgr2)
1220 : NULLIFY (xas_atom_env%dga1)
1221 : NULLIFY (xas_atom_env%dga2)
1222 :
1223 48 : END SUBROUTINE xas_atom_env_create
1224 :
1225 : ! **************************************************************************************************
1226 : !> \brief Releases the xas_atom_env type
1227 : !> \param xas_atom_env the type to release
1228 : ! **************************************************************************************************
1229 48 : SUBROUTINE xas_atom_env_release(xas_atom_env)
1230 :
1231 : TYPE(xas_atom_env_type), POINTER :: xas_atom_env
1232 :
1233 : INTEGER :: i, j, k
1234 :
1235 48 : IF (ASSOCIATED(xas_atom_env%grid_atom_set)) THEN
1236 122 : DO i = 1, SIZE(xas_atom_env%grid_atom_set)
1237 122 : IF (ASSOCIATED(xas_atom_env%grid_atom_set(i)%grid_atom)) THEN
1238 74 : CALL deallocate_grid_atom(xas_atom_env%grid_atom_set(i)%grid_atom)
1239 : END IF
1240 : END DO
1241 48 : DEALLOCATE (xas_atom_env%grid_atom_set)
1242 : END IF
1243 :
1244 48 : IF (ASSOCIATED(xas_atom_env%harmonics_atom_set)) THEN
1245 122 : DO i = 1, SIZE(xas_atom_env%harmonics_atom_set)
1246 122 : IF (ASSOCIATED(xas_atom_env%harmonics_atom_set(i)%harmonics_atom)) THEN
1247 74 : CALL deallocate_harmonics_atom(xas_atom_env%harmonics_atom_set(i)%harmonics_atom)
1248 : END IF
1249 : END DO
1250 48 : DEALLOCATE (xas_atom_env%harmonics_atom_set)
1251 : END IF
1252 :
1253 : ! Note that excited_atoms and excited_kinds are not deallocated because they point to other
1254 : ! ressources, namely xas_tdp_env.
1255 :
1256 48 : IF (ASSOCIATED(xas_atom_env%ri_dcoeff)) THEN
1257 408 : DO i = 1, SIZE(xas_atom_env%ri_dcoeff, 1)
1258 786 : DO j = 1, SIZE(xas_atom_env%ri_dcoeff, 2)
1259 1336 : DO k = 1, SIZE(xas_atom_env%ri_dcoeff, 3)
1260 966 : IF (ASSOCIATED(xas_atom_env%ri_dcoeff(i, j, k)%array)) THEN
1261 72 : DEALLOCATE (xas_atom_env%ri_dcoeff(i, j, k)%array)
1262 : END IF
1263 : END DO
1264 : END DO
1265 : END DO
1266 38 : DEALLOCATE (xas_atom_env%ri_dcoeff)
1267 : END IF
1268 :
1269 48 : IF (ASSOCIATED(xas_atom_env%ri_sphi_so)) THEN
1270 122 : DO i = 1, SIZE(xas_atom_env%ri_sphi_so)
1271 122 : IF (ASSOCIATED(xas_atom_env%ri_sphi_so(i)%array)) THEN
1272 52 : DEALLOCATE (xas_atom_env%ri_sphi_so(i)%array)
1273 : END IF
1274 : END DO
1275 48 : DEALLOCATE (xas_atom_env%ri_sphi_so)
1276 : END IF
1277 :
1278 48 : IF (ASSOCIATED(xas_atom_env%exat_neighbors)) THEN
1279 84 : DO i = 1, SIZE(xas_atom_env%exat_neighbors)
1280 84 : IF (ASSOCIATED(xas_atom_env%exat_neighbors(i)%array)) THEN
1281 46 : DEALLOCATE (xas_atom_env%exat_neighbors(i)%array)
1282 : END IF
1283 : END DO
1284 38 : DEALLOCATE (xas_atom_env%exat_neighbors)
1285 : END IF
1286 :
1287 48 : IF (ASSOCIATED(xas_atom_env%gr)) THEN
1288 98 : DO i = 1, SIZE(xas_atom_env%gr)
1289 98 : IF (ASSOCIATED(xas_atom_env%gr(i)%array)) THEN
1290 42 : DEALLOCATE (xas_atom_env%gr(i)%array)
1291 : END IF
1292 : END DO
1293 38 : DEALLOCATE (xas_atom_env%gr)
1294 : END IF
1295 :
1296 48 : IF (ASSOCIATED(xas_atom_env%ga)) THEN
1297 98 : DO i = 1, SIZE(xas_atom_env%ga)
1298 98 : IF (ASSOCIATED(xas_atom_env%ga(i)%array)) THEN
1299 42 : DEALLOCATE (xas_atom_env%ga(i)%array)
1300 : END IF
1301 : END DO
1302 38 : DEALLOCATE (xas_atom_env%ga)
1303 : END IF
1304 :
1305 48 : IF (ASSOCIATED(xas_atom_env%dgr1)) THEN
1306 98 : DO i = 1, SIZE(xas_atom_env%dgr1)
1307 98 : IF (ASSOCIATED(xas_atom_env%dgr1(i)%array)) THEN
1308 22 : DEALLOCATE (xas_atom_env%dgr1(i)%array)
1309 : END IF
1310 : END DO
1311 38 : DEALLOCATE (xas_atom_env%dgr1)
1312 : END IF
1313 :
1314 48 : IF (ASSOCIATED(xas_atom_env%dgr2)) THEN
1315 98 : DO i = 1, SIZE(xas_atom_env%dgr2)
1316 98 : IF (ASSOCIATED(xas_atom_env%dgr2(i)%array)) THEN
1317 22 : DEALLOCATE (xas_atom_env%dgr2(i)%array)
1318 : END IF
1319 : END DO
1320 38 : DEALLOCATE (xas_atom_env%dgr2)
1321 : END IF
1322 :
1323 48 : IF (ASSOCIATED(xas_atom_env%dga1)) THEN
1324 98 : DO i = 1, SIZE(xas_atom_env%dga1)
1325 98 : IF (ASSOCIATED(xas_atom_env%dga1(i)%array)) THEN
1326 22 : DEALLOCATE (xas_atom_env%dga1(i)%array)
1327 : END IF
1328 : END DO
1329 38 : DEALLOCATE (xas_atom_env%dga1)
1330 : END IF
1331 :
1332 48 : IF (ASSOCIATED(xas_atom_env%dga2)) THEN
1333 98 : DO i = 1, SIZE(xas_atom_env%dga2)
1334 98 : IF (ASSOCIATED(xas_atom_env%dga2(i)%array)) THEN
1335 22 : DEALLOCATE (xas_atom_env%dga2(i)%array)
1336 : END IF
1337 : END DO
1338 38 : DEALLOCATE (xas_atom_env%dga2)
1339 : END IF
1340 :
1341 48 : IF (ASSOCIATED(xas_atom_env%orb_sphi_so)) THEN
1342 122 : DO i = 1, SIZE(xas_atom_env%orb_sphi_so)
1343 122 : IF (ASSOCIATED(xas_atom_env%orb_sphi_so(i)%array)) THEN
1344 74 : DEALLOCATE (xas_atom_env%orb_sphi_so(i)%array)
1345 : END IF
1346 : END DO
1347 48 : DEALLOCATE (xas_atom_env%orb_sphi_so)
1348 : END IF
1349 :
1350 : !Clean-up libint
1351 48 : CALL cp_libint_static_cleanup()
1352 :
1353 48 : DEALLOCATE (xas_atom_env)
1354 :
1355 48 : END SUBROUTINE xas_atom_env_release
1356 :
1357 : ! **************************************************************************************************
1358 : !> \brief Releases the memory heavy attribute of xas_tdp_env that are specific to the current
1359 : !> excited atom
1360 : !> \param xas_tdp_env ...
1361 : !> \param atom the index of the current excited atom
1362 : !> \param end_of_batch whether batch specific quantities should be freed
1363 : ! **************************************************************************************************
1364 58 : SUBROUTINE free_exat_memory(xas_tdp_env, atom, end_of_batch)
1365 :
1366 : TYPE(xas_tdp_env_type), POINTER :: xas_tdp_env
1367 : INTEGER, INTENT(IN) :: atom
1368 : LOGICAL :: end_of_batch
1369 :
1370 : INTEGER :: i
1371 :
1372 58 : IF (ASSOCIATED(xas_tdp_env%ri_fxc)) THEN
1373 230 : DO i = 1, SIZE(xas_tdp_env%ri_fxc, 2)
1374 230 : IF (ASSOCIATED(xas_tdp_env%ri_fxc(atom, i)%array)) THEN
1375 94 : DEALLOCATE (xas_tdp_env%ri_fxc(atom, i)%array)
1376 : END IF
1377 : END DO
1378 : END IF
1379 :
1380 58 : IF (end_of_batch) THEN
1381 52 : IF (ASSOCIATED(xas_tdp_env%opt_dist2d_ex)) THEN
1382 42 : CALL distribution_2d_release(xas_tdp_env%opt_dist2d_ex)
1383 : END IF
1384 :
1385 52 : IF (ASSOCIATED(xas_tdp_env%ri_3c_ex)) THEN
1386 42 : CALL dbt_destroy(xas_tdp_env%ri_3c_ex)
1387 42 : DEALLOCATE (xas_tdp_env%ri_3c_ex)
1388 : END IF
1389 : END IF
1390 :
1391 58 : xas_tdp_env%fxc_avail = .FALSE.
1392 :
1393 58 : END SUBROUTINE free_exat_memory
1394 :
1395 : ! **************************************************************************************************
1396 : !> \brief Releases a batch_info type
1397 : !> \param batch_info ...
1398 : ! **************************************************************************************************
1399 38 : SUBROUTINE release_batch_info(batch_info)
1400 :
1401 : TYPE(batch_info_type) :: batch_info
1402 :
1403 : INTEGER :: i
1404 :
1405 38 : CALL batch_info%para_env%free()
1406 :
1407 38 : IF (ASSOCIATED(batch_info%so_proc_info)) THEN
1408 98 : DO i = 1, SIZE(batch_info%so_proc_info)
1409 98 : IF (ASSOCIATED(batch_info%so_proc_info(i)%array)) THEN
1410 42 : DEALLOCATE (batch_info%so_proc_info(i)%array)
1411 : END IF
1412 : END DO
1413 38 : DEALLOCATE (batch_info%so_proc_info)
1414 : END IF
1415 :
1416 38 : END SUBROUTINE release_batch_info
1417 :
1418 : ! **************************************************************************************************
1419 : !> \brief Uses heuristics to determine a good batching of the processros for fxc integration
1420 : !> \param batch_size ...
1421 : !> \param nbatch ...
1422 : !> \param nex_atom ...
1423 : !> \param nprocs ...
1424 : !> \note It is here and not in xas_tdp_atom because of circular dependencies issues
1425 : ! **************************************************************************************************
1426 84 : SUBROUTINE get_proc_batch_sizes(batch_size, nbatch, nex_atom, nprocs)
1427 :
1428 : INTEGER, INTENT(OUT) :: batch_size, nbatch
1429 : INTEGER, INTENT(IN) :: nex_atom, nprocs
1430 :
1431 : INTEGER :: rest, test_size
1432 :
1433 : !We have essentially 2 cases nex_atom >= nprocs or nex_atom < nprocs
1434 :
1435 84 : IF (nex_atom >= nprocs) THEN
1436 :
1437 : !If nex_atom >= nprocs, we look from batch size (starting from 1, ending with 4) that yields
1438 : !the best indicative load balance, i.e. the best spread of excited atom per batch
1439 24 : rest = 100000
1440 72 : DO test_size = 1, MIN(nprocs, 4)
1441 48 : nbatch = nprocs/test_size
1442 72 : IF (MODULO(nex_atom, nbatch) < rest) THEN
1443 24 : rest = MODULO(nex_atom, nbatch)
1444 24 : batch_size = test_size
1445 : END IF
1446 : END DO
1447 24 : nbatch = nprocs/batch_size
1448 :
1449 : ELSE
1450 :
1451 : !If nex_atom < nprocs, simply devide processors in nex_atom batches
1452 : !At most 128 ranks per atom, experiments have shown that if nprocs >>> nex_atom, crahes occur.
1453 : !The 128 upper limit is based on trial and error
1454 60 : nbatch = nex_atom
1455 60 : batch_size = MIN(nprocs/nbatch, 128)
1456 :
1457 : END IF
1458 :
1459 : !Note: because of possible odd numbers of MPI ranks / excited atoms, a couple of procs can
1460 : ! be excluded from the batching (max 4)
1461 :
1462 84 : END SUBROUTINE get_proc_batch_sizes
1463 :
1464 0 : END MODULE xas_tdp_types
|
