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