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 create destroy get and put information 8!> in xas_env to calculate the x-ray absorption spectra 9!> \par History 10!> created 05.2005 11!> \author MI (05.2005) 12! ************************************************************************************************** 13MODULE xas_env_types 14 15 USE basis_set_types, ONLY: deallocate_gto_basis_set,& 16 gto_basis_set_p_type 17 USE cp_array_utils, ONLY: cp_2d_r_p_type 18 USE cp_dbcsr_operations, ONLY: dbcsr_deallocate_matrix_set 19 USE cp_fm_pool_types, ONLY: cp_fm_pool_p_type,& 20 fm_pool_give_back_fm 21 USE cp_fm_types, ONLY: cp_fm_p_type,& 22 cp_fm_release,& 23 cp_fm_type 24 USE dbcsr_api, ONLY: dbcsr_p_type 25 USE kinds, ONLY: dp 26 USE qs_loc_types, ONLY: qs_loc_env_new_type,& 27 qs_loc_env_release,& 28 qs_loc_env_retain 29 USE qs_scf_types, ONLY: qs_scf_env_type,& 30 scf_env_release,& 31 scf_env_retain 32 USE scf_control_types, ONLY: scf_c_release,& 33 scf_c_retain,& 34 scf_control_type 35#include "./base/base_uses.f90" 36 37 IMPLICIT NONE 38 PRIVATE 39 40 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xas_env_types' 41 42! *** Public data types *** 43 44 PUBLIC :: xas_environment_type 45 46! *** Public subroutines *** 47 48 PUBLIC :: get_xas_env, set_xas_env, xas_env_create, xas_env_release, xas_env_retain 49 50! ************************************************************************************************** 51!> \param ref_count counter for pointers to xas_env 52!> \param iter_count counter for the step at which xas is calculated 53!> \param nao number of atomic orbitals in the basis 54!> \param exc_state state that is now excited (this change atom by atom) 55!> \param nvirtual number of empy states to take into account for the spectrum 56!> \param state_of_atom for each atom the states that have to be excited (global index) 57!> dimension is the number of atoms to be excited by the largest number of included states 58!> \param atom_of_state atom to which each state is assigned, 59!> dimension is the number of states occupied that might be excited 60!> \param nexc_states number of states to be excited per atom 61!> dimension is the number of atoms to be excited 62!> \param type_of_state character of the state (1s,2s,2p...) 63!> \param spectrum for each excitation the energy and the oscillator strength 64!> \param centers_wfn for each wfn the center of charge (optimized by localization) 65!> \param groundstate_coeff temporary storage for the original mos coefficients 66!> \param ostrength_sm sin and cos integrals computed for the contracted GTO functions 67!> \param dip_fm_set fm for the sin and cos integrals to define the pos operator 68!> \param qs_loc_env environment for the localization procedure 69!> \par History 70!> created 05-2005 71!> \author MI 72! ************************************************************************************************** 73 TYPE xas_environment_type 74 INTEGER :: ref_count 75 INTEGER :: iter_count 76 INTEGER :: nao, exc_state, xas_estate 77 INTEGER :: nexc_search, nexc_atoms 78 INTEGER :: spin_channel 79 INTEGER :: nvirtual, nvirtual2 80 INTEGER :: unoccupied_max_iter 81 82 INTEGER, DIMENSION(:), POINTER :: atom_of_state 83 INTEGER, DIMENSION(:), POINTER :: type_of_state 84 INTEGER, DIMENSION(:), POINTER :: mykind_of_atom 85 INTEGER, DIMENSION(:), POINTER :: mykind_of_kind 86 INTEGER, DIMENSION(:), POINTER :: exc_atoms 87 INTEGER, DIMENSION(:), POINTER :: nexc_states 88 INTEGER, DIMENSION(:, :), POINTER :: state_of_atom 89 90 REAL(dp) :: ip_energy, occ_estate, unoccupied_eps, xas_nelectron, homo_occ 91 REAL(dp), DIMENSION(:), POINTER :: all_evals 92 REAL(dp), DIMENSION(:), POINTER :: unoccupied_evals 93 REAL(dp), DIMENSION(:, :), POINTER :: spectrum 94 REAL(dp), DIMENSION(:, :), POINTER :: centers_wfn 95 TYPE(cp_2d_r_p_type), DIMENSION(:), POINTER :: stogto_overlap 96 TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: my_gto_basis 97 TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: groundstate_coeff 98 TYPE(cp_fm_p_type), DIMENSION(:, :), POINTER :: dip_fm_set 99 TYPE(cp_fm_pool_p_type), DIMENSION(:), & 100 POINTER :: ao_mo_fm_pools 101 TYPE(cp_fm_type), POINTER :: excvec_coeff 102 TYPE(cp_fm_type), POINTER :: excvec_overlap 103 TYPE(cp_fm_type), POINTER :: unoccupied_orbs 104 TYPE(cp_fm_type), POINTER :: all_vectors 105 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ostrength_sm 106 TYPE(qs_loc_env_new_type), POINTER :: qs_loc_env 107 TYPE(qs_scf_env_type), POINTER :: scf_env 108 TYPE(scf_control_type), POINTER :: scf_control 109 110 END TYPE xas_environment_type 111 112CONTAINS 113! ************************************************************************************************** 114!> \brief ... 115!> \param xas_env ... 116!> \param iter_count ... 117!> \param exc_state ... 118!> \param nao ... 119!> \param nvirtual ... 120!> \param nvirtual2 ... 121!> \param centers_wfn ... 122!> \param atom_of_state ... 123!> \param exc_atoms ... 124!> \param nexc_states ... 125!> \param type_of_state ... 126!> \param mykind_of_atom ... 127!> \param mykind_of_kind ... 128!> \param state_of_atom ... 129!> \param spectrum ... 130!> \param groundstate_coeff ... 131!> \param ostrength_sm ... 132!> \param dip_fm_set ... 133!> \param excvec_coeff ... 134!> \param excvec_overlap ... 135!> \param unoccupied_orbs ... 136!> \param unoccupied_evals ... 137!> \param unoccupied_max_iter ... 138!> \param unoccupied_eps ... 139!> \param all_vectors ... 140!> \param all_evals ... 141!> \param my_gto_basis ... 142!> \param qs_loc_env ... 143!> \param stogto_overlap ... 144!> \param occ_estate ... 145!> \param xas_nelectron ... 146!> \param xas_estate ... 147!> \param nexc_atoms ... 148!> \param nexc_search ... 149!> \param spin_channel ... 150!> \param scf_env ... 151!> \param scf_control ... 152! ************************************************************************************************** 153 SUBROUTINE get_xas_env(xas_env, iter_count, exc_state, nao, nvirtual, nvirtual2, & 154 centers_wfn, atom_of_state, exc_atoms, nexc_states, type_of_state, mykind_of_atom, & 155 mykind_of_kind, state_of_atom, spectrum, groundstate_coeff, ostrength_sm, & 156 dip_fm_set, excvec_coeff, excvec_overlap, & 157 unoccupied_orbs, unoccupied_evals, unoccupied_max_iter, unoccupied_eps, & 158 all_vectors, all_evals, my_gto_basis, qs_loc_env, & 159 stogto_overlap, occ_estate, xas_nelectron, xas_estate, nexc_atoms, nexc_search, spin_channel, & 160 scf_env, scf_control) 161 162 TYPE(xas_environment_type), POINTER :: xas_env 163 INTEGER, INTENT(OUT), OPTIONAL :: iter_count, exc_state, nao, nvirtual, & 164 nvirtual2 165 REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: centers_wfn 166 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: atom_of_state, exc_atoms, nexc_states, & 167 type_of_state, mykind_of_atom, & 168 mykind_of_kind 169 INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: state_of_atom 170 REAL(dp), DIMENSION(:, :), OPTIONAL, POINTER :: spectrum 171 TYPE(cp_fm_p_type), DIMENSION(:), OPTIONAL, & 172 POINTER :: groundstate_coeff 173 TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, & 174 POINTER :: ostrength_sm 175 TYPE(cp_fm_p_type), DIMENSION(:, :), OPTIONAL, & 176 POINTER :: dip_fm_set 177 TYPE(cp_fm_type), OPTIONAL, POINTER :: excvec_coeff, excvec_overlap, & 178 unoccupied_orbs 179 REAL(dp), DIMENSION(:), OPTIONAL, POINTER :: unoccupied_evals 180 INTEGER, INTENT(OUT), OPTIONAL :: unoccupied_max_iter 181 REAL(dp), OPTIONAL :: unoccupied_eps 182 TYPE(cp_fm_type), OPTIONAL, POINTER :: all_vectors 183 REAL(dp), DIMENSION(:), OPTIONAL, POINTER :: all_evals 184 TYPE(gto_basis_set_p_type), DIMENSION(:), & 185 OPTIONAL, POINTER :: my_gto_basis 186 TYPE(qs_loc_env_new_type), OPTIONAL, POINTER :: qs_loc_env 187 TYPE(cp_2d_r_p_type), DIMENSION(:), OPTIONAL, & 188 POINTER :: stogto_overlap 189 REAL(dp), INTENT(OUT), OPTIONAL :: occ_estate, xas_nelectron 190 INTEGER, INTENT(OUT), OPTIONAL :: xas_estate, nexc_atoms, nexc_search, & 191 spin_channel 192 TYPE(qs_scf_env_type), OPTIONAL, POINTER :: scf_env 193 TYPE(scf_control_type), OPTIONAL, POINTER :: scf_control 194 195 CHARACTER(len=*), PARAMETER :: routineN = 'get_xas_env', routineP = moduleN//':'//routineN 196 197 CPASSERT(ASSOCIATED(xas_env)) 198 199 IF (PRESENT(iter_count)) iter_count = xas_env%iter_count 200 IF (PRESENT(exc_state)) exc_state = xas_env%exc_state 201 IF (PRESENT(nao)) nao = xas_env%nao 202 IF (PRESENT(nvirtual)) nvirtual = xas_env%nvirtual 203 IF (PRESENT(nvirtual2)) nvirtual2 = xas_env%nvirtual2 204 IF (PRESENT(xas_nelectron)) xas_nelectron = xas_env%xas_nelectron 205 IF (PRESENT(occ_estate)) occ_estate = xas_env%occ_estate 206 IF (PRESENT(xas_estate)) xas_estate = xas_env%xas_estate 207 IF (PRESENT(nexc_search)) nexc_search = xas_env%nexc_search 208 IF (PRESENT(nexc_states)) nexc_states => xas_env%nexc_states 209 IF (PRESENT(spin_channel)) spin_channel = xas_env%spin_channel 210 IF (PRESENT(nexc_atoms)) nexc_atoms = xas_env%nexc_atoms 211 IF (PRESENT(unoccupied_eps)) unoccupied_eps = xas_env%unoccupied_eps 212 IF (PRESENT(unoccupied_max_iter)) unoccupied_max_iter = xas_env%unoccupied_max_iter 213 IF (PRESENT(centers_wfn)) centers_wfn => xas_env%centers_wfn 214 IF (PRESENT(atom_of_state)) atom_of_state => xas_env%atom_of_state 215 IF (PRESENT(exc_atoms)) exc_atoms => xas_env%exc_atoms 216 IF (PRESENT(type_of_state)) type_of_state => xas_env%type_of_state 217 IF (PRESENT(state_of_atom)) state_of_atom => xas_env%state_of_atom 218 IF (PRESENT(mykind_of_atom)) mykind_of_atom => xas_env%mykind_of_atom 219 IF (PRESENT(mykind_of_kind)) mykind_of_kind => xas_env%mykind_of_kind 220 IF (PRESENT(unoccupied_evals)) unoccupied_evals => xas_env%unoccupied_evals 221 IF (PRESENT(all_evals)) all_evals => xas_env%all_evals 222 IF (PRESENT(spectrum)) spectrum => xas_env%spectrum 223 IF (PRESENT(groundstate_coeff)) groundstate_coeff => xas_env%groundstate_coeff 224 IF (PRESENT(ostrength_sm)) ostrength_sm => xas_env%ostrength_sm 225 IF (PRESENT(excvec_overlap)) excvec_overlap => xas_env%excvec_overlap 226 IF (PRESENT(unoccupied_orbs)) unoccupied_orbs => xas_env%unoccupied_orbs 227 IF (PRESENT(all_vectors)) all_vectors => xas_env%all_vectors 228 IF (PRESENT(dip_fm_set)) dip_fm_set => xas_env%dip_fm_set 229 IF (PRESENT(qs_loc_env)) qs_loc_env => xas_env%qs_loc_env 230 IF (PRESENT(excvec_coeff)) excvec_coeff => xas_env%excvec_coeff 231 IF (PRESENT(my_gto_basis)) my_gto_basis => xas_env%my_gto_basis 232 IF (PRESENT(stogto_overlap)) stogto_overlap => xas_env%stogto_overlap 233 IF (PRESENT(scf_env)) scf_env => xas_env%scf_env 234 IF (PRESENT(scf_control)) scf_control => xas_env%scf_control 235 END SUBROUTINE get_xas_env 236 237! ************************************************************************************************** 238!> \brief ... 239!> \param xas_env ... 240!> \param iter_count ... 241!> \param nexc_search ... 242!> \param spin_channel ... 243!> \param nexc_atoms ... 244!> \param nvirtual ... 245!> \param nvirtual2 ... 246!> \param ip_energy ... 247!> \param occ_estate ... 248!> \param qs_loc_env ... 249!> \param xas_estate ... 250!> \param xas_nelectron ... 251!> \param homo_occ ... 252!> \param scf_env ... 253!> \param scf_control ... 254! ************************************************************************************************** 255 SUBROUTINE set_xas_env(xas_env, iter_count, nexc_search, spin_channel, nexc_atoms, & 256 nvirtual, nvirtual2, ip_energy, occ_estate, qs_loc_env, & 257 xas_estate, xas_nelectron, homo_occ, scf_env, scf_control) 258 259 TYPE(xas_environment_type), POINTER :: xas_env 260 INTEGER, INTENT(IN), OPTIONAL :: iter_count, nexc_search, spin_channel, & 261 nexc_atoms, nvirtual, nvirtual2 262 REAL(dp), INTENT(IN), OPTIONAL :: ip_energy, occ_estate 263 TYPE(qs_loc_env_new_type), OPTIONAL, POINTER :: qs_loc_env 264 INTEGER, INTENT(IN), OPTIONAL :: xas_estate 265 REAL(dp), INTENT(IN), OPTIONAL :: xas_nelectron, homo_occ 266 TYPE(qs_scf_env_type), OPTIONAL, POINTER :: scf_env 267 TYPE(scf_control_type), OPTIONAL, POINTER :: scf_control 268 269 CHARACTER(len=*), PARAMETER :: routineN = 'set_xas_env', routineP = moduleN//':'//routineN 270 271 CPASSERT(ASSOCIATED(xas_env)) 272 273 IF (PRESENT(iter_count)) xas_env%iter_count = iter_count 274 IF (PRESENT(nexc_search)) xas_env%nexc_search = nexc_search 275 IF (PRESENT(spin_channel)) xas_env%spin_channel = spin_channel 276 IF (PRESENT(nexc_atoms)) xas_env%nexc_atoms = nexc_atoms 277 IF (PRESENT(nvirtual)) xas_env%nvirtual = nvirtual 278 IF (PRESENT(nvirtual2)) xas_env%nvirtual2 = nvirtual2 279 IF (PRESENT(occ_estate)) xas_env%occ_estate = occ_estate 280 IF (PRESENT(xas_nelectron)) xas_env%xas_nelectron = xas_nelectron 281 IF (PRESENT(homo_occ)) xas_env%homo_occ = homo_occ 282 IF (PRESENT(xas_estate)) xas_env%xas_estate = xas_estate 283 IF (PRESENT(ip_energy)) xas_env%ip_energy = ip_energy 284 IF (PRESENT(qs_loc_env)) THEN 285 CALL qs_loc_env_retain(qs_loc_env) 286 IF (ASSOCIATED(xas_env%qs_loc_env)) & 287 CALL qs_loc_env_release(xas_env%qs_loc_env) 288 xas_env%qs_loc_env => qs_loc_env 289 END IF 290 IF (PRESENT(scf_env)) THEN ! accept also null pointers ? 291 CALL scf_env_retain(scf_env) 292 CALL scf_env_release(xas_env%scf_env) 293 xas_env%scf_env => scf_env 294 END IF 295 IF (PRESENT(scf_control)) THEN ! accept also null pointers? 296 CALL scf_c_retain(scf_control) 297 CALL scf_c_release(xas_env%scf_control) 298 xas_env%scf_control => scf_control 299 END IF 300 301 END SUBROUTINE set_xas_env 302 303! ************************************************************************************************** 304!> \brief ... 305!> \param xas_env ... 306! ************************************************************************************************** 307 SUBROUTINE xas_env_create(xas_env) 308 309 TYPE(xas_environment_type), POINTER :: xas_env 310 311 CHARACTER(len=*), PARAMETER :: routineN = 'xas_env_create', routineP = moduleN//':'//routineN 312 313 ALLOCATE (xas_env) 314 315 xas_env%ref_count = 1 316 xas_env%iter_count = 0 317 xas_env%nvirtual = 0 318 xas_env%nvirtual2 = 0 319 320 NULLIFY (xas_env%ao_mo_fm_pools) 321 NULLIFY (xas_env%my_gto_basis) 322 NULLIFY (xas_env%atom_of_state) 323 NULLIFY (xas_env%nexc_states) 324 NULLIFY (xas_env%state_of_atom) 325 NULLIFY (xas_env%exc_atoms) 326 NULLIFY (xas_env%excvec_coeff, xas_env%excvec_overlap) 327 NULLIFY (xas_env%type_of_state, xas_env%mykind_of_atom) 328 NULLIFY (xas_env%type_of_state, xas_env%mykind_of_kind) 329 NULLIFY (xas_env%groundstate_coeff, xas_env%dip_fm_set) 330 NULLIFY (xas_env%ostrength_sm, xas_env%qs_loc_env, xas_env%spectrum) 331 NULLIFY (xas_env%all_evals, xas_env%all_vectors) 332 NULLIFY (xas_env%unoccupied_evals, xas_env%unoccupied_orbs) 333 NULLIFY (xas_env%stogto_overlap) 334 NULLIFY (xas_env%scf_env) 335 NULLIFY (xas_env%scf_control) 336 337 END SUBROUTINE xas_env_create 338 339! ************************************************************************************************** 340!> \brief ... 341!> \param xas_env ... 342! ************************************************************************************************** 343 SUBROUTINE xas_env_release(xas_env) 344 345 TYPE(xas_environment_type), POINTER :: xas_env 346 347 CHARACTER(len=*), PARAMETER :: routineN = 'xas_env_release', & 348 routineP = moduleN//':'//routineN 349 350 INTEGER :: i, ik, j 351 352 IF (ASSOCIATED(xas_env)) THEN 353 CPASSERT(xas_env%ref_count > 0) 354 xas_env%ref_count = xas_env%ref_count - 1 355 IF (xas_env%ref_count == 0) THEN 356 357 DEALLOCATE (xas_env%state_of_atom, xas_env%atom_of_state) 358 DEALLOCATE (xas_env%nexc_states) 359 DEALLOCATE (xas_env%type_of_state) 360 DEALLOCATE (xas_env%mykind_of_atom) 361 DEALLOCATE (xas_env%mykind_of_kind) 362 DEALLOCATE (xas_env%exc_atoms) 363 DEALLOCATE (xas_env%centers_wfn) 364 IF (ASSOCIATED(xas_env%all_evals)) THEN 365 DEALLOCATE (xas_env%all_evals) 366 END IF 367 IF (ASSOCIATED(xas_env%unoccupied_evals)) THEN 368 DEALLOCATE (xas_env%unoccupied_evals) 369 END IF 370 IF (ASSOCIATED(xas_env%groundstate_coeff)) THEN 371 DO i = 1, SIZE(xas_env%groundstate_coeff) 372 CALL fm_pool_give_back_fm(xas_env%ao_mo_fm_pools(i)%pool, & 373 xas_env%groundstate_coeff(i)%matrix) 374 END DO 375 DEALLOCATE (xas_env%groundstate_coeff) 376 END IF 377 IF (ASSOCIATED(xas_env%dip_fm_set)) THEN 378 DO i = 1, SIZE(xas_env%dip_fm_set, 2) 379 DO j = 1, SIZE(xas_env%dip_fm_set, 1) 380 CALL cp_fm_release(xas_env%dip_fm_set(j, i)%matrix) 381 END DO 382 END DO 383 DEALLOCATE (xas_env%dip_fm_set) 384 END IF 385 386 IF (ASSOCIATED(xas_env%excvec_coeff)) THEN 387 CALL cp_fm_release(xas_env%excvec_coeff) 388 END IF 389 IF (ASSOCIATED(xas_env%excvec_overlap)) THEN 390 CALL cp_fm_release(xas_env%excvec_overlap) 391 END IF 392 IF (ASSOCIATED(xas_env%unoccupied_orbs)) THEN 393 CALL cp_fm_release(xas_env%unoccupied_orbs) 394 END IF 395 NULLIFY (xas_env%ao_mo_fm_pools) 396 IF (ASSOCIATED(xas_env%all_vectors) .AND. xas_env%nvirtual .GT. 0) THEN 397 CALL cp_fm_release(xas_env%all_vectors) 398 ELSE 399 NULLIFY (xas_env%all_vectors) 400 END IF 401 402 IF (ASSOCIATED(xas_env%ostrength_sm)) THEN 403 CALL dbcsr_deallocate_matrix_set(xas_env%ostrength_sm) 404 END IF 405 IF (ASSOCIATED(xas_env%qs_loc_env)) THEN 406 CALL qs_loc_env_release(xas_env%qs_loc_env) 407 END IF 408 409 IF (ASSOCIATED(xas_env%my_gto_basis)) THEN 410 DO ik = 1, SIZE(xas_env%my_gto_basis, 1) 411 CALL deallocate_gto_basis_set(xas_env%my_gto_basis(ik)%gto_basis_set) 412 END DO 413 DEALLOCATE (xas_env%my_gto_basis) 414 END IF 415 416 IF (ASSOCIATED(xas_env%stogto_overlap)) THEN 417 DO ik = 1, SIZE(xas_env%stogto_overlap, 1) 418 DEALLOCATE (xas_env%stogto_overlap(ik)%array) 419 END DO 420 DEALLOCATE (xas_env%stogto_overlap) 421 END IF 422 423 CALL scf_env_release(xas_env%scf_env) 424 CALL scf_c_release(xas_env%scf_control) 425 426 DEALLOCATE (xas_env) 427 END IF 428 END IF 429 430 END SUBROUTINE xas_env_release 431 432! ************************************************************************************************** 433!> \brief ... 434!> \param xas_env ... 435! ************************************************************************************************** 436 SUBROUTINE xas_env_retain(xas_env) 437 438 TYPE(xas_environment_type), POINTER :: xas_env 439 440 CHARACTER(len=*), PARAMETER :: routineN = 'xas_env_retain', routineP = moduleN//':'//routineN 441 442 CPASSERT(ASSOCIATED(xas_env)) 443 CPASSERT(xas_env%ref_count > 0) 444 xas_env%ref_count = xas_env%ref_count + 1 445 END SUBROUTINE xas_env_retain 446 447END MODULE xas_env_types 448 449