1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief Defines CDFT control structures 8!> \par History 9!> separated from cp_control_types [03.2017] 10!> \author Nico Holmberg [03.2017] 11! ************************************************************************************************** 12MODULE qs_cdft_types 13 USE cp_array_utils, ONLY: cp_1d_r_p_type 14 USE cp_fm_types, ONLY: cp_fm_p_type 15 USE dbcsr_api, ONLY: dbcsr_p_type 16 USE hirshfeld_types, ONLY: hirshfeld_type,& 17 release_hirshfeld_type 18 USE input_constants, ONLY: becke_cutoff_global,& 19 outer_scf_none,& 20 radius_single,& 21 shape_function_gaussian 22 USE kinds, ONLY: default_path_length,& 23 dp 24 USE outer_scf_control_types, ONLY: outer_scf_control_type,& 25 qs_outer_scf_type 26 USE pw_types, ONLY: pw_p_type 27 USE qs_cdft_opt_types, ONLY: cdft_opt_type_release 28#include "./base/base_uses.f90" 29 30 IMPLICIT NONE 31 32 PRIVATE 33 34! ************************************************************************************************** 35!> \brief some parameters useful for becke_constraints 36!> \param aij pairwise parameters used to adjust the Becke cell boundaries built from atomic radii 37!> \param adjust logical which determines if the Becke potential is adjusted with atomic radii 38!> \param cavity the Gaussian confinement cavity: the constraint is nonzero outside this cavity 39!> \param cavity_confine logical which determines if cavity confinement is active 40!> \param cavity_mat a compacted version of cavity 41!> \param cavity_shape the confinement cavity shape id 42!> \param cavity_env the structure used to build the Gaussian cavity 43!> \param confine_bounds grid point indices outside which the constraint vanishes along Z-axis 44!> \param cutoff_type the cutoff type to use for building the constraint 45!> \param cutoffs element specific cutoffs 46!> \param cutoffs_tmp same as cutoffs but a temporary read during parsing of this type 47!> \param eps_cavity threshold used screen small values of the Gaussian cavity density 48!> \param in_memory logical which determines if the gradients of the Becke potential should be 49!> \param print_cavity logical to print the Gaussian confinement cavity 50!> \param radii permanent copy of radii_tmp 51!> \param radii_tmp temporary list of element specific atomic radii used to adjust the Becke cells 52!> \param rcavity an optional global radius parameter used to define the Gaussian confinement cavity 53!> \param rglobal global cutoff to use for building the constraint 54!> computed simultaneously with the potential instead of separately 55!> \param should_skip logical which determines is grid points should be skipped if all constraint 56!> atoms are found to reside beyond the cutoff distance from it 57!> \param use_bohr decides whether to use angstrom or bohr units for the confinement cavity radius 58! ************************************************************************************************** 59 ! Utility vector container for building becke constraint 60 TYPE becke_vector_buffer 61 LOGICAL :: store_vectors 62 REAL(kind=dp), ALLOCATABLE, & 63 DIMENSION(:) :: distances 64 REAL(kind=dp), ALLOCATABLE, & 65 DIMENSION(:, :) :: distance_vecs, & 66 position_vecs, & 67 R12 68 REAL(kind=dp), ALLOCATABLE, & 69 DIMENSION(:, :, :) :: pair_dist_vecs 70 END TYPE becke_vector_buffer 71 72 TYPE becke_constraint_type 73 INTEGER :: cavity_shape, cutoff_type, & 74 confine_bounds(2) 75 LOGICAL :: in_memory, & 76 adjust, cavity_confine, & 77 should_skip, print_cavity, & 78 use_bohr 79 REAL(KIND=dp) :: rglobal, & 80 rcavity, eps_cavity 81 REAL(KIND=dp), DIMENSION(:), POINTER :: cutoffs, cutoffs_tmp, & 82 radii_tmp, radii 83 REAL(KIND=dp), POINTER, & 84 DIMENSION(:, :) :: aij 85 REAL(KIND=dp), POINTER, & 86 DIMENSION(:, :, :) :: cavity_mat 87 TYPE(becke_vector_buffer) :: vector_buffer 88 TYPE(hirshfeld_type), POINTER :: cavity_env 89 TYPE(pw_p_type) :: cavity 90 END TYPE becke_constraint_type 91 92! ************************************************************************************************** 93! \brief control parameters for Hirshfeld constraints 94!> \param gaussian_shape the type of Gaussian to use (shape_function Gaussian) 95!> \param radii list of Gaussian radii for different atomic kinds 96!> \param radius Gaussian radius parameter 97!> \param shape_function the constraint type: atomic density or single Gaussian 98!> \param use_bohr determines whether to use angstrom or bohr units for the radii of Gaussians 99!> \param hirshfeld_env auxiliary type storing information about the Gaussians 100! ************************************************************************************************** 101 TYPE hirshfeld_constraint_type 102 INTEGER :: gaussian_shape, shape_function 103 LOGICAL :: use_bohr 104 REAL(KIND=dp) :: radius 105 REAL(KIND=dp), DIMENSION(:), POINTER :: radii 106 TYPE(hirshfeld_type), POINTER :: hirshfeld_env 107 END TYPE hirshfeld_constraint_type 108 109! ************************************************************************************************** 110!> \brief control parameters for CDFT simulations 111!> \param fragment_a_fname filename of cube file holding the total electron density 112!> of isolated fragment a 113!> \param fragment_b_fname filename of cube file holding the total electron density 114!> of isolated fragment b 115!> \param fragment_a_spin_fname filename of cube file holding the spin difference density 116!> of isolated fragment a 117!> \param fragment_b_spin_fname filename of cube file holding the spin difference density 118!> of isolated fragment b 119!> \param ref_count the ref count 120!> \param need_pot logical which determines if the Becke potential needs to be built 121!> \param save_pot logical which determines if the Becke potential should be saved until forces 122!> have been evaluated 123!> \param atomic_charges flag that determines if atomic CDFT charges should be computed 124!> \param total_steps counter to keep track of the total number of SCF steps 125!> \param type the type of CDFT constraint to use 126!> \param precond_freq preconditioner can be used if SCF converged in less than precond_freq steps 127!> \param nreused determines how many times the current OT preconditioner has been reused 128!> \param max_reuse the same preconditioner can be used a maximum of max_reuse times 129!> \param purge_freq determines how large nbad_conv can grow before purging the wfn/constraint history 130!> \param nbad_conv a running counter keeping track of the number of CDFT SCF loops when the first 131!> CDFT SCF iteration required more than 1 outer SCF loop. Reset when convergence is 132!> smooth 133!> \param purge_offset purging is only allowed when more than purge_offset steps have passed since 134!> last purge 135!> \param istep a counter to keep track of how many steps have passed since the last purge 136!> \param ienergy a counter tracking the total number of CDFT energy evaluations 137!> \param natoms the total number of atoms included in constraint/dummy atom groups 138!> \param atoms list of constraint atoms 139!> \param need_pot logical which determines if the constraint potential needs to be built 140!> \param save_pot logical which determines if the constraint potential should be saved until forces 141!> have been evaluated 142!> \param do_et logical which determines if a ET coupling calculation was requested 143!> \param reuse_precond logical which determines if a preconditioner can be reused 144!> \param purge_history logical which determines if the wfn/constraint history can be purged 145!> \param should_purge logical which determines if purging should take place after this CDFT SCF loop 146!> \param calculate_metric logical which determines if the ET coupling reliablity metric is computed 147!> \param fragment_density use isolated fragment densities as a reference for the constraint 148!> \param fragments_integrated logical to determine if the fragment densities have been integrated 149!> \param flip_fragment should the spin difference density of the either fragment be flipped 150!> \param transfer_pot logical which determines if constraint should be saved for reuse later 151!> \param external_control logical which determines if the constraint has already been built 152!> in a mixed_env that holds multiple CDFT states 153!> \param first_iteration a flag to mark the first iteration for printing of additional data 154!> \param print_weight logical which determines if CDFT weight functions should be saved to a file 155!> \param is_constraint list of logicals which determines if an atom is included in a constraint group 156!> \param strength Lagrangian multipliers of the constraints 157!> \param target target values of the constraints 158!> \param value integrated values of the constraints 159!> \param charges_fragment atomic partial charges computed from the isolated fragment densities 160!> \param becke_control control parameters for Becke constraints 161!> \param group container for atom groups each defining their own constraint 162!> \param occupations occupation numbers in case non-uniform MO occupation (for do_et) 163!> \param mo_coeff save the MO coeffs (for do_et) 164!> \param matrix_s save the overlap matrix (for do_et) 165!> \param wmat matrix representation of the weight function (for do_et) 166!> \param matrix_p save the density matrix (for calculate_metric) 167!> \param hirshfeld_control control parameters for Hirshfeld constraints 168!> \param constraint_control the outer_scf_control_type for the CDFT constraints 169!> \param ot_control the outer_scf_control_type for OT where data is stashed when outside the OT 170!> outer loop 171!> \param charge atomic CDFT real space potentials needed to calculate CDFT charges 172!> \param fragments container for isolated fragment densities read from cube files 173!> \param constraint holds information about the CDFT SCF loop 174! ************************************************************************************************** 175 ! To build multiple constraints 176 TYPE cdft_group_type 177 ! Atoms of this constraint group 178 INTEGER, POINTER, DIMENSION(:) :: atoms 179 ! Constraint type: charge constraint, magnetization density constraint, or spin channel specific constraint 180 INTEGER :: constraint_type 181 ! Is the constraint fragment based 182 LOGICAL :: is_fragment_constraint 183 ! Temporary array holding a component of the weight function gradient that only includes 184 ! terms defined on constraint atoms 185 REAL(kind=dp), ALLOCATABLE, & 186 DIMENSION(:, :) :: d_sum_const_dR 187 ! Coefficients that determine how to sum up the atoms to form the constraint 188 REAL(KIND=dp), POINTER, DIMENSION(:) :: coeff 189 ! Result of integration dw/dR * rho_r dr where dw/dR is the weight function gradient 190 REAL(KIND=dp), POINTER, & 191 DIMENSION(:, :) :: integrated 192 ! Atomic gradients of the weight function at every grid point 193 REAL(KIND=dp), POINTER, & 194 DIMENSION(:, :, :, :) :: gradients 195 ! The weight function of this constraint group 196 TYPE(pw_p_type) :: weight 197 END TYPE cdft_group_type 198 199 TYPE cdft_control_type 200 CHARACTER(LEN=default_path_length) :: fragment_a_fname, & 201 fragment_b_fname, & 202 fragment_a_spin_fname, & 203 fragment_b_spin_fname 204 INTEGER :: ref_count, total_steps, TYPE, & 205 precond_freq, nreused, max_reuse, & 206 purge_freq, nbad_conv, purge_offset, & 207 istep, ienergy, natoms 208 INTEGER, POINTER, DIMENSION(:) :: atoms 209 LOGICAL :: need_pot, save_pot, do_et, & 210 reuse_precond, purge_history, & 211 should_purge, calculate_metric, & 212 atomic_charges, fragment_density, & 213 fragments_integrated, flip_fragment(2), & 214 transfer_pot, external_control, & 215 first_iteration, print_weight 216 LOGICAL, POINTER, DIMENSION(:) :: is_constraint 217 REAL(KIND=dp), DIMENSION(:), POINTER :: strength, TARGET, value 218 REAL(KIND=dp), POINTER, & 219 DIMENSION(:, :) :: charges_fragment 220 TYPE(becke_constraint_type), POINTER :: becke_control 221 TYPE(cdft_group_type), POINTER, & 222 DIMENSION(:) :: group 223 TYPE(cp_1d_r_p_type), ALLOCATABLE, & 224 DIMENSION(:) :: occupations 225 TYPE(cp_fm_p_type), DIMENSION(:), & 226 POINTER :: mo_coeff 227 TYPE(dbcsr_p_type) :: matrix_s 228 TYPE(dbcsr_p_type), DIMENSION(:), & 229 POINTER :: wmat, matrix_p 230 TYPE(hirshfeld_constraint_type), & 231 POINTER :: hirshfeld_control 232 TYPE(outer_scf_control_type) :: constraint_control, ot_control 233 TYPE(pw_p_type), POINTER, & 234 DIMENSION(:) :: charge 235 TYPE(pw_p_type), POINTER, & 236 DIMENSION(:, :) :: fragments 237 TYPE(qs_outer_scf_type) :: constraint 238 END TYPE cdft_control_type 239 240 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_cdft_types' 241 242 ! Public data types 243 244 PUBLIC :: becke_constraint_type, & 245 cdft_control_type, & 246 cdft_group_type, & 247 hirshfeld_constraint_type 248 249 ! Public subroutines 250 251 PUBLIC :: cdft_control_create, & 252 cdft_control_release 253 254CONTAINS 255 256! ************************************************************************************************** 257!> \brief create the becke_constraint_type 258!> \param becke_control the structure to create 259!> \par History 260!> 02.2007 created [Florian Schiffmann] 261! ************************************************************************************************** 262 SUBROUTINE becke_control_create(becke_control) 263 TYPE(becke_constraint_type), POINTER :: becke_control 264 265 CHARACTER(len=*), PARAMETER :: routineN = 'becke_control_create', & 266 routineP = moduleN//':'//routineN 267 268 CPASSERT(.NOT. ASSOCIATED(becke_control)) 269 ALLOCATE (becke_control) 270 271 becke_control%adjust = .FALSE. 272 becke_control%cutoff_type = becke_cutoff_global 273 becke_control%cavity_confine = .FALSE. 274 becke_control%should_skip = .FALSE. 275 becke_control%print_cavity = .FALSE. 276 becke_control%in_memory = .FALSE. 277 becke_control%use_bohr = .FALSE. 278 becke_control%confine_bounds = 0 279 becke_control%rcavity = 3.0_dp 280 becke_control%rglobal = 6.0_dp 281 becke_control%eps_cavity = 1.0e-6_dp 282 becke_control%cavity_shape = radius_single 283 becke_control%vector_buffer%store_vectors = .TRUE. 284 NULLIFY (becke_control%cavity%pw) 285 NULLIFY (becke_control%aij) 286 NULLIFY (becke_control%cavity_mat) 287 NULLIFY (becke_control%cavity_env) 288 NULLIFY (becke_control%cutoffs) 289 NULLIFY (becke_control%cutoffs_tmp) 290 NULLIFY (becke_control%radii) 291 NULLIFY (becke_control%radii_tmp) 292 END SUBROUTINE becke_control_create 293 294! ************************************************************************************************** 295!> \brief release the becke_constraint_type 296!> \param becke_control the structure to release 297!> \par History 298!> 02.2007 created [Florian Schiffmann] 299! ************************************************************************************************** 300 SUBROUTINE becke_control_release(becke_control) 301 TYPE(becke_constraint_type), POINTER :: becke_control 302 303 CHARACTER(len=*), PARAMETER :: routineN = 'becke_control_release', & 304 routineP = moduleN//':'//routineN 305 306 CPASSERT(ASSOCIATED(becke_control)) 307 IF (becke_control%vector_buffer%store_vectors) THEN 308 IF (ALLOCATED(becke_control%vector_buffer%distances)) & 309 DEALLOCATE (becke_control%vector_buffer%distances) 310 IF (ALLOCATED(becke_control%vector_buffer%distance_vecs)) & 311 DEALLOCATE (becke_control%vector_buffer%distance_vecs) 312 IF (ALLOCATED(becke_control%vector_buffer%position_vecs)) & 313 DEALLOCATE (becke_control%vector_buffer%position_vecs) 314 IF (ALLOCATED(becke_control%vector_buffer%R12)) & 315 DEALLOCATE (becke_control%vector_buffer%R12) 316 IF (ALLOCATED(becke_control%vector_buffer%pair_dist_vecs)) & 317 DEALLOCATE (becke_control%vector_buffer%pair_dist_vecs) 318 END IF 319 IF (ASSOCIATED(becke_control%cutoffs)) & 320 DEALLOCATE (becke_control%cutoffs) 321 IF (ASSOCIATED(becke_control%cutoffs_tmp)) & 322 DEALLOCATE (becke_control%cutoffs_tmp) 323 IF (ASSOCIATED(becke_control%radii_tmp)) & 324 DEALLOCATE (becke_control%radii_tmp) 325 IF (ASSOCIATED(becke_control%radii)) & 326 DEALLOCATE (becke_control%radii) 327 IF (ASSOCIATED(becke_control%aij)) & 328 DEALLOCATE (becke_control%aij) 329 IF (ASSOCIATED(becke_control%cavity_mat)) & 330 DEALLOCATE (becke_control%cavity_mat) 331 IF (becke_control%cavity_confine) & 332 CALL release_hirshfeld_type(becke_control%cavity_env) 333 DEALLOCATE (becke_control) 334 335 END SUBROUTINE becke_control_release 336 337! ************************************************************************************************** 338!> \brief create the cdft_control_type 339!> \param cdft_control the structure to create 340!> \par History 341!> 12.2015 created [Nico Holmberg] 342! ************************************************************************************************** 343 SUBROUTINE cdft_control_create(cdft_control) 344 TYPE(cdft_control_type), POINTER :: cdft_control 345 346 CHARACTER(len=*), PARAMETER :: routineN = 'cdft_control_create', & 347 routineP = moduleN//':'//routineN 348 349 CPASSERT(.NOT. ASSOCIATED(cdft_control)) 350 ALLOCATE (cdft_control) 351 cdft_control%ref_count = 1 352 cdft_control%total_steps = 0 353 NULLIFY (cdft_control%strength) 354 NULLIFY (cdft_control%target) 355 NULLIFY (cdft_control%value) 356 NULLIFY (cdft_control%atoms) 357 NULLIFY (cdft_control%is_constraint) 358 NULLIFY (cdft_control%charges_fragment) 359 NULLIFY (cdft_control%fragments) 360 NULLIFY (cdft_control%group) 361 NULLIFY (cdft_control%charge) 362 cdft_control%natoms = 0 363 cdft_control%type = outer_scf_none 364 cdft_control%need_pot = .TRUE. 365 cdft_control%save_pot = .FALSE. 366 cdft_control%transfer_pot = .FALSE. 367 cdft_control%atomic_charges = .FALSE. 368 cdft_control%first_iteration = .TRUE. 369 cdft_control%fragment_density = .FALSE. 370 cdft_control%fragments_integrated = .FALSE. 371 cdft_control%flip_fragment = .FALSE. 372 cdft_control%external_control = .FALSE. 373 cdft_control%do_et = .FALSE. 374 cdft_control%reuse_precond = .FALSE. 375 cdft_control%nreused = 0 376 cdft_control%precond_freq = 0 377 cdft_control%max_reuse = 0 378 cdft_control%should_purge = .FALSE. 379 cdft_control%purge_history = .FALSE. 380 cdft_control%calculate_metric = .FALSE. 381 cdft_control%purge_freq = 0 382 cdft_control%nbad_conv = 0 383 cdft_control%purge_offset = 0 384 cdft_control%istep = 0 385 cdft_control%ienergy = 0 386 NULLIFY (cdft_control%becke_control) 387 CALL becke_control_create(cdft_control%becke_control) 388 NULLIFY (cdft_control%hirshfeld_control) 389 CALL hirshfeld_control_create(cdft_control%hirshfeld_control) 390 NULLIFY (cdft_control%wmat) 391 NULLIFY (cdft_control%matrix_s%matrix) 392 NULLIFY (cdft_control%mo_coeff) 393 NULLIFY (cdft_control%matrix_p) 394 ! Outer SCF default settings 395 cdft_control%ot_control%have_scf = .FALSE. 396 cdft_control%ot_control%max_scf = 0 397 cdft_control%ot_control%eps_scf = 0.0_dp 398 cdft_control%ot_control%step_size = 0.0_dp 399 cdft_control%ot_control%type = -1 400 cdft_control%ot_control%optimizer = -1 401 cdft_control%ot_control%diis_buffer_length = -1 402 NULLIFY (cdft_control%ot_control%cdft_opt_control) 403 cdft_control%constraint_control%have_scf = .FALSE. 404 cdft_control%constraint_control%max_scf = 0 405 cdft_control%constraint_control%eps_scf = 0.0_dp 406 cdft_control%constraint_control%step_size = 0.0_dp 407 cdft_control%constraint_control%type = -1 408 cdft_control%constraint_control%optimizer = -1 409 cdft_control%constraint_control%diis_buffer_length = -1 410 NULLIFY (cdft_control%constraint_control%cdft_opt_control) 411 cdft_control%constraint%iter_count = 0 412 NULLIFY (cdft_control%constraint%variables) 413 NULLIFY (cdft_control%constraint%gradient) 414 NULLIFY (cdft_control%constraint%energy) 415 NULLIFY (cdft_control%constraint%count) 416 NULLIFY (cdft_control%constraint%inv_jacobian) 417 cdft_control%constraint%deallocate_jacobian = .TRUE. 418 END SUBROUTINE cdft_control_create 419 420! ************************************************************************************************** 421!> \brief release the cdft_control_type 422!> \param cdft_control the structure to release 423!> \par History 424!> 12.2015 created [Nico Holmberg] 425! ************************************************************************************************** 426 SUBROUTINE cdft_control_release(cdft_control) 427 TYPE(cdft_control_type), POINTER :: cdft_control 428 429 CHARACTER(len=*), PARAMETER :: routineN = 'cdft_control_release', & 430 routineP = moduleN//':'//routineN 431 432 INTEGER :: i 433 434 CPASSERT(ASSOCIATED(cdft_control)) 435 CPASSERT(cdft_control%ref_count > 0) 436 cdft_control%ref_count = cdft_control%ref_count - 1 437 IF (cdft_control%ref_count == 0) THEN 438 ! Constraint settings 439 IF (ASSOCIATED(cdft_control%atoms)) & 440 DEALLOCATE (cdft_control%atoms) 441 IF (ASSOCIATED(cdft_control%strength)) & 442 DEALLOCATE (cdft_control%strength) 443 IF (ASSOCIATED(cdft_control%target)) & 444 DEALLOCATE (cdft_control%target) 445 IF (ASSOCIATED(cdft_control%value)) & 446 DEALLOCATE (cdft_control%value) 447 IF (ASSOCIATED(cdft_control%charges_fragment)) & 448 DEALLOCATE (cdft_control%charges_fragment) 449 IF (ASSOCIATED(cdft_control%fragments)) & 450 DEALLOCATE (cdft_control%fragments) 451 IF (ASSOCIATED(cdft_control%is_constraint)) & 452 DEALLOCATE (cdft_control%is_constraint) 453 IF (ASSOCIATED(cdft_control%charge)) & 454 DEALLOCATE (cdft_control%charge) 455 ! Constraint atom groups 456 IF (ASSOCIATED(cdft_control%group)) THEN 457 DO i = 1, SIZE(cdft_control%group) 458 IF (ASSOCIATED(cdft_control%group(i)%atoms)) & 459 DEALLOCATE (cdft_control%group(i)%atoms) 460 IF (ASSOCIATED(cdft_control%group(i)%coeff)) & 461 DEALLOCATE (cdft_control%group(i)%coeff) 462 IF (ALLOCATED(cdft_control%group(i)%d_sum_const_dR)) & 463 DEALLOCATE (cdft_control%group(i)%d_sum_const_dR) 464 IF (ASSOCIATED(cdft_control%group(i)%gradients)) & 465 DEALLOCATE (cdft_control%group(i)%gradients) 466 IF (ASSOCIATED(cdft_control%group(i)%integrated)) & 467 DEALLOCATE (cdft_control%group(i)%integrated) 468 END DO 469 DEALLOCATE (cdft_control%group) 470 END IF 471 ! Constraint type specific deallocations 472 IF (ASSOCIATED(cdft_control%becke_control)) THEN 473 CALL becke_control_release(cdft_control%becke_control) 474 END IF 475 IF (ASSOCIATED(cdft_control%hirshfeld_control)) THEN 476 CALL hirshfeld_control_release(cdft_control%hirshfeld_control) 477 END IF 478 ! Release OUTER_SCF types 479 CALL cdft_opt_type_release(cdft_control%ot_control%cdft_opt_control) 480 CALL cdft_opt_type_release(cdft_control%constraint_control%cdft_opt_control) 481 IF (ASSOCIATED(cdft_control%constraint%variables)) & 482 DEALLOCATE (cdft_control%constraint%variables) 483 IF (ASSOCIATED(cdft_control%constraint%count)) & 484 DEALLOCATE (cdft_control%constraint%count) 485 IF (ASSOCIATED(cdft_control%constraint%gradient)) & 486 DEALLOCATE (cdft_control%constraint%gradient) 487 IF (ASSOCIATED(cdft_control%constraint%energy)) & 488 DEALLOCATE (cdft_control%constraint%energy) 489 IF (ASSOCIATED(cdft_control%constraint%inv_jacobian)) & 490 DEALLOCATE (cdft_control%constraint%inv_jacobian) 491 ! Storage for mixed CDFT calculations 492 IF (ALLOCATED(cdft_control%occupations)) THEN 493 DO i = 1, SIZE(cdft_control%occupations) 494 IF (ASSOCIATED(cdft_control%occupations(i)%array)) & 495 DEALLOCATE (cdft_control%occupations(i)%array) 496 END DO 497 DEALLOCATE (cdft_control%occupations) 498 END IF 499 ! Release control 500 cdft_control%type = outer_scf_none 501 DEALLOCATE (cdft_control) 502 END IF 503 END SUBROUTINE cdft_control_release 504 505! ************************************************************************************************** 506!> \brief retain the cdft_control_type 507!> \param cdft_control the structure to retain 508!> \par History 509!> created 12.2015 [Nico Holmberg] 510! ************************************************************************************************** 511 SUBROUTINE cdft_control_retain(cdft_control) 512 TYPE(cdft_control_type), POINTER :: cdft_control 513 514 CHARACTER(len=*), PARAMETER :: routineN = 'cdft_control_retain', & 515 routineP = moduleN//':'//routineN 516 517 CPASSERT(ASSOCIATED(cdft_control)) 518 cdft_control%ref_count = cdft_control%ref_count + 1 519 END SUBROUTINE cdft_control_retain 520 521! ************************************************************************************************** 522!> \brief create the hirshfeld_constraint_type 523!> \param hirshfeld_control the structure to create 524!> \par History 525!> 09.2018 created [Nico Holmberg] 526! ************************************************************************************************** 527 SUBROUTINE hirshfeld_control_create(hirshfeld_control) 528 TYPE(hirshfeld_constraint_type), POINTER :: hirshfeld_control 529 530 CHARACTER(len=*), PARAMETER :: routineN = 'hirshfeld_control_create', & 531 routineP = moduleN//':'//routineN 532 533 CPASSERT(.NOT. ASSOCIATED(hirshfeld_control)) 534 ALLOCATE (hirshfeld_control) 535 536 hirshfeld_control%use_bohr = .FALSE. 537 hirshfeld_control%radius = 3.0_dp 538 hirshfeld_control%shape_function = shape_function_gaussian 539 hirshfeld_control%gaussian_shape = radius_single 540 NULLIFY (hirshfeld_control%hirshfeld_env) 541 NULLIFY (hirshfeld_control%radii) 542 543 END SUBROUTINE hirshfeld_control_create 544 545! ************************************************************************************************** 546!> \brief release the hirshfeld_constraint_type 547!> \param hirshfeld_control the structure to release 548!> \par History 549!> 09.2018 created [Nico Holmberg] 550! ************************************************************************************************** 551 SUBROUTINE hirshfeld_control_release(hirshfeld_control) 552 TYPE(hirshfeld_constraint_type), POINTER :: hirshfeld_control 553 554 CHARACTER(len=*), PARAMETER :: routineN = 'hirshfeld_control_release', & 555 routineP = moduleN//':'//routineN 556 557 CPASSERT(ASSOCIATED(hirshfeld_control)) 558 559 IF (ASSOCIATED(hirshfeld_control%radii)) & 560 DEALLOCATE (hirshfeld_control%radii) 561 CALL release_hirshfeld_type(hirshfeld_control%hirshfeld_env) 562 DEALLOCATE (hirshfeld_control) 563 564 END SUBROUTINE hirshfeld_control_release 565 566END MODULE qs_cdft_types 567