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