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