(git:42db5d2)
Loading...
Searching...
No Matches
force_env_methods.F
Go to the documentation of this file.
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 Interface for the force calculations
10!> \par History
11!> cjm, FEB-20-2001: pass variable box_ref
12!> cjm, SEPT-12-2002: major reorganization
13!> fawzi, APR-12-2003: introduced force_env (based on the work by CJM&JGH)
14!> fawzi, NOV-3-2004: reorganized interface for f77 interface
15!> \author fawzi
16! **************************************************************************************************
18 USE atprop_types, ONLY: atprop_init,&
21 huang2011,&
22 cite_reference
23 USE cell_methods, ONLY: cell_create,&
25 USE cell_types, ONLY: cell_clone,&
28 cell_type,&
43 USE cp_output_handling, ONLY: cp_p_file,&
63 USE eip_silicon, ONLY: eip_bazant,&
67 USE embed_types, ONLY: embed_env_type,&
73 USE force_env_types, ONLY: &
81 USE fp_methods, ONLY: fp_eval
82 USE fparser, ONLY: evalerrtype,&
83 evalf,&
84 evalfd,&
85 finalizef,&
86 initf,&
87 parsef
90 USE grrm_utils, ONLY: write_grrm
91 USE input_constants, ONLY: &
102 USE ipi_server, ONLY: request_forces
103 USE kahan_sum, ONLY: accurate_sum
104 USE kinds, ONLY: default_path_length,&
106 dp
110 USE kpoint_types, ONLY: get_kpoint_info,&
115 USE machine, ONLY: m_memory
116 USE mathlib, ONLY: abnormal_value
147 USE physcon, ONLY: debye
148 USE pw_env_types, ONLY: pw_env_get,&
150 USE pw_methods, ONLY: pw_axpy,&
151 pw_copy,&
153 pw_zero
154 USE pw_pool_types, ONLY: pw_pool_type
155 USE pw_types, ONLY: pw_r3d_rs_type
159 USE qmmm_types, ONLY: qmmm_env_type
162 USE qmmmx_types, ONLY: qmmmx_env_type
170 USE qs_mo_types, ONLY: mo_set_type
171 USE qs_rho_types, ONLY: qs_rho_get,&
176 USE scine_utils, ONLY: write_scine
177 USE string_utilities, ONLY: compress
184#include "./base/base_uses.f90"
185
186 IMPLICIT NONE
187
188 PRIVATE
189
190 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'force_env_methods'
191
192 PUBLIC :: force_env_create, &
195
196 INTEGER, SAVE, PRIVATE :: last_force_env_id = 0
197
198CONTAINS
199
200! **************************************************************************************************
201!> \brief Interface routine for force and energy calculations
202!> \param force_env the force_env of which you want the energy and forces
203!> \param calc_force if false the forces *might* be left unchanged
204!> or be invalid, no guarantees can be given. Defaults to true
205!> \param consistent_energies Performs an additional qs_ks_update_qs_env, so
206!> that the energies are appropriate to the forces, they are in the
207!> non-selfconsistent case not consistent to each other! [08.2005, TdK]
208!> \param skip_external_control ...
209!> \param eval_energy_forces ...
210!> \param require_consistent_energy_force ...
211!> \param linres ...
212!> \param calc_stress_tensor ...
213!> \author CJM & fawzi
214! **************************************************************************************************
215 RECURSIVE SUBROUTINE force_env_calc_energy_force(force_env, calc_force, &
216 consistent_energies, skip_external_control, eval_energy_forces, &
217 require_consistent_energy_force, linres, calc_stress_tensor)
218
219 TYPE(force_env_type), POINTER :: force_env
220 LOGICAL, INTENT(IN), OPTIONAL :: calc_force, consistent_energies, skip_external_control, &
221 eval_energy_forces, require_consistent_energy_force, linres, calc_stress_tensor
222
223 REAL(kind=dp), PARAMETER :: ateps = 1.0e-6_dp
224
225 CHARACTER(LEN=default_string_length) :: unit_string
226 INTEGER :: ikind, nat, ndigits, nfixed_atoms, &
227 nfixed_atoms_total, nkind, &
228 output_unit, print_forces, print_grrm, &
229 print_scine
230 LOGICAL :: calculate_forces, calculate_stress_tensor, do_apt_fd, energy_consistency, &
231 eval_ef, linres_run, my_skip, print_components
232 REAL(kind=dp) :: checksum, e_entropy, e_gap, e_pot, &
233 fconv, sum_energy
234 REAL(kind=dp), DIMENSION(3) :: grand_total_force, total_force
235 TYPE(atprop_type), POINTER :: atprop_env
236 TYPE(cell_type), POINTER :: cell
237 TYPE(cp_logger_type), POINTER :: logger
238 TYPE(cp_subsys_type), POINTER :: subsys
239 TYPE(molecule_kind_list_type), POINTER :: molecule_kinds
240 TYPE(molecule_kind_type), DIMENSION(:), POINTER :: molecule_kind_set
241 TYPE(molecule_kind_type), POINTER :: molecule_kind
242 TYPE(particle_list_type), POINTER :: core_particles, particles, &
243 shell_particles
244 TYPE(section_vals_type), POINTER :: print_key
245 TYPE(virial_type), POINTER :: virial
246
247 NULLIFY (logger, virial, subsys, atprop_env, cell)
248 logger => cp_get_default_logger()
249 eval_ef = .true.
250 my_skip = .false.
251 calculate_forces = .true.
252 energy_consistency = .false.
253 linres_run = .false.
254 e_gap = -1.0_dp
255 e_entropy = -1.0_dp
256 unit_string = ""
257
258 IF (PRESENT(eval_energy_forces)) eval_ef = eval_energy_forces
259 IF (PRESENT(skip_external_control)) my_skip = skip_external_control
260 IF (PRESENT(calc_force)) calculate_forces = calc_force
261 IF (PRESENT(calc_stress_tensor)) THEN
262 calculate_stress_tensor = calc_stress_tensor
263 ELSE
264 calculate_stress_tensor = calculate_forces
265 END IF
266 IF (PRESENT(consistent_energies)) energy_consistency = consistent_energies
267 IF (PRESENT(linres)) linres_run = linres
268
269 cpassert(ASSOCIATED(force_env))
270 cpassert(force_env%ref_count > 0)
271 CALL force_env_get(force_env, subsys=subsys)
272 CALL force_env_set(force_env, additional_potential=0.0_dp)
273 CALL cp_subsys_get(subsys, virial=virial, atprop=atprop_env, cell=cell)
274 IF (virial%pv_availability) CALL zero_virial(virial, reset=.false.)
275
276 nat = force_env_get_natom(force_env)
277 CALL atprop_init(atprop_env, nat)
278 IF (eval_ef) THEN
279 SELECT CASE (force_env%in_use)
280 CASE (use_fist_force)
281 CALL fist_calc_energy_force(force_env%fist_env)
282 CASE (use_qs_force)
283 CALL force_env_refresh_kpoint_symmetry(force_env, fd_energy=.NOT. calculate_forces)
284 CALL qs_calc_energy_force(force_env%qs_env, calculate_forces, energy_consistency, linres_run)
285 CASE (use_pwdft_force)
286 IF (virial%pv_availability .AND. calculate_stress_tensor) THEN
287 CALL pwdft_calc_energy_force(force_env%pwdft_env, calculate_forces,.NOT. virial%pv_numer)
288 ELSE
289 CALL pwdft_calc_energy_force(force_env%pwdft_env, calculate_forces, .false.)
290 END IF
291 e_gap = force_env%pwdft_env%energy%band_gap
292 e_entropy = force_env%pwdft_env%energy%entropy
293 CASE (use_eip_force)
294 SELECT CASE (force_env%eip_env%eip_model)
295 CASE (use_lenosky_eip)
296 CALL eip_lenosky(force_env%eip_env)
297 CASE (use_bazant_eip)
298 CALL eip_bazant(force_env%eip_env)
300 CALL eip_stillinger_weber(force_env%eip_env)
301 CASE (use_tersoff_eip)
302 CALL eip_tersoff(force_env%eip_env)
303 CASE DEFAULT
304 cpabort("Unknown EIP model.")
305 END SELECT
306 CASE (use_qmmm)
307 CALL qmmm_calc_energy_force(force_env%qmmm_env, &
308 calculate_forces, energy_consistency, linres=linres_run)
309 CASE (use_qmmmx)
310 CALL qmmmx_calc_energy_force(force_env%qmmmx_env, &
311 calculate_forces, energy_consistency, linres=linres_run, &
312 require_consistent_energy_force=require_consistent_energy_force)
313 CASE (use_mixed_force)
314 CALL mixed_energy_forces(force_env, calculate_forces)
315 CASE (use_nnp_force)
316 CALL nnp_calc_energy_force(force_env%nnp_env, &
317 calculate_forces)
318 CASE (use_embed)
319 CALL embed_energy(force_env)
320 CASE (use_ipi)
321 CALL request_forces(force_env%ipi_env)
322 CASE default
323 cpabort("Unknown force environment; cannot evaluate energy or force")
324 END SELECT
325 END IF
326 ! In case it is requested, we evaluate the stress tensor numerically
327 IF (virial%pv_availability) THEN
328 IF (virial%pv_numer .AND. calculate_stress_tensor) THEN
329 ! Compute the numerical stress tensor
330 CALL force_env_calc_num_pressure(force_env)
331 ELSE
332 IF (calculate_forces) THEN
333 ! Symmetrize analytical stress tensor
334 CALL symmetrize_virial(virial)
335 ELSE
336 IF (calculate_stress_tensor) THEN
337 CALL cp_warn(__location__, "The calculation of the stress tensor "// &
338 "requires the calculation of the forces")
339 END IF
340 END IF
341 END IF
342 END IF
343
344 ! In case requested, compute the APT numerically
345 do_apt_fd = .false.
346 IF (force_env%in_use == use_qs_force) THEN
347 CALL section_vals_val_get(force_env%qs_env%input, "PROPERTIES%LINRES%DCDR%APT_FD", l_val=do_apt_fd)
348 IF (do_apt_fd) THEN
349 print_key => section_vals_get_subs_vals(force_env%qs_env%input, &
350 subsection_name="PROPERTIES%LINRES%DCDR%PRINT%APT")
351 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
352 CALL apt_fdiff(force_env)
353 END IF
354 END IF
355 END IF
356
357 !sample peak memory
358 CALL m_memory()
359
360 ! Some additional tasks..
361 IF (.NOT. my_skip) THEN
362 ! Flexible Partitioning
363 IF (ASSOCIATED(force_env%fp_env)) THEN
364 IF (force_env%fp_env%use_fp) THEN
365 CALL fp_eval(force_env%fp_env, subsys, cell)
366 END IF
367 END IF
368 ! Constraints ONLY of Fixed Atom type
369 CALL fix_atom_control(force_env)
370 ! All Restraints
371 CALL restraint_control(force_env)
372 ! Virtual Sites
373 CALL vsite_force_control(force_env)
374 ! External Potential
375 CALL add_external_potential(force_env)
376 ! Rescale forces if requested
377 CALL rescale_forces(force_env)
378 END IF
379
380 CALL force_env_get(force_env, potential_energy=e_pot)
381
382 ! Print energy always in the same format for all methods
383 output_unit = cp_print_key_unit_nr(logger, force_env%force_env_section, "PRINT%PROGRAM_RUN_INFO", &
384 extension=".Log")
385 IF (output_unit > 0) THEN
386 CALL section_vals_val_get(force_env%force_env_section, "PRINT%PROGRAM_RUN_INFO%ENERGY_UNIT", &
387 c_val=unit_string)
388 fconv = cp_unit_from_cp2k(1.0_dp, trim(adjustl(unit_string)))
389 WRITE (unit=output_unit, fmt="(/,T2,A,T55,F26.15)") &
390 "ENERGY| Total FORCE_EVAL ( "//trim(adjustl(use_prog_name(force_env%in_use)))// &
391 " ) energy ["//trim(adjustl(unit_string))//"]", e_pot*fconv
392 IF (e_gap > -0.1_dp) THEN
393 WRITE (unit=output_unit, fmt="(/,T2,A,T55,F26.15)") &
394 "ENERGY| Total FORCE_EVAL ( "//trim(adjustl(use_prog_name(force_env%in_use)))// &
395 " ) gap ["//trim(adjustl(unit_string))//"]", e_gap*fconv
396 END IF
397 IF (e_entropy > -0.1_dp) THEN
398 WRITE (unit=output_unit, fmt="(/,T2,A,T55,F26.15)") &
399 "ENERGY| Total FORCE_EVAL ( "//trim(adjustl(use_prog_name(force_env%in_use)))// &
400 " ) free energy ["//trim(adjustl(unit_string))//"]", (e_pot - e_entropy)*fconv
401 END IF
402 END IF
403 CALL cp_print_key_finished_output(output_unit, logger, force_env%force_env_section, &
404 "PRINT%PROGRAM_RUN_INFO")
405
406 ! terminate the run if the value of the potential is abnormal
407 IF (abnormal_value(e_pot)) THEN
408 cpabort("Potential energy is an abnormal value (NaN/Inf).")
409 END IF
410
411 ! Print forces, if requested
412 print_forces = cp_print_key_unit_nr(logger, force_env%force_env_section, "PRINT%FORCES", &
413 extension=".xyz")
414 IF ((print_forces > 0) .AND. calculate_forces) THEN
415 CALL force_env_get(force_env, subsys=subsys)
416 CALL cp_subsys_get(subsys, &
417 core_particles=core_particles, &
418 particles=particles, &
419 shell_particles=shell_particles)
420 ! Variable precision output of the forces
421 CALL section_vals_val_get(force_env%force_env_section, "PRINT%FORCES%NDIGITS", &
422 i_val=ndigits)
423 CALL section_vals_val_get(force_env%force_env_section, "PRINT%FORCES%FORCE_UNIT", &
424 c_val=unit_string)
425 IF (ASSOCIATED(core_particles) .OR. ASSOCIATED(shell_particles)) THEN
426 CALL write_forces(particles, print_forces, "Atomic", ndigits, unit_string, &
427 total_force, zero_force_core_shell_atom=.true.)
428 grand_total_force(1:3) = total_force(1:3)
429 IF (ASSOCIATED(core_particles)) THEN
430 CALL write_forces(core_particles, print_forces, "Core particle", ndigits, &
431 unit_string, total_force, zero_force_core_shell_atom=.false.)
432 grand_total_force(:) = grand_total_force(:) + total_force(:)
433 END IF
434 IF (ASSOCIATED(shell_particles)) THEN
435 CALL write_forces(shell_particles, print_forces, "Shell particle", ndigits, &
436 unit_string, total_force, zero_force_core_shell_atom=.false., &
437 grand_total_force=grand_total_force)
438 END IF
439 ELSE
440 CALL write_forces(particles, print_forces, "Atomic", ndigits, unit_string, total_force)
441 END IF
442 END IF
443 CALL cp_print_key_finished_output(print_forces, logger, force_env%force_env_section, "PRINT%FORCES")
444
445 ! Write stress tensor
446 IF (virial%pv_availability) THEN
447 ! If the virial is defined but we are not computing forces let's zero the
448 ! virial for consistency
449 IF (calculate_forces .AND. calculate_stress_tensor) THEN
450 output_unit = cp_print_key_unit_nr(logger, force_env%force_env_section, "PRINT%STRESS_TENSOR", &
451 extension=".stress_tensor")
452 IF (output_unit > 0) THEN
453 CALL section_vals_val_get(force_env%force_env_section, "PRINT%STRESS_TENSOR%COMPONENTS", &
454 l_val=print_components)
455 CALL section_vals_val_get(force_env%force_env_section, "PRINT%STRESS_TENSOR%STRESS_UNIT", &
456 c_val=unit_string)
457 IF (print_components) THEN
458 IF ((.NOT. virial%pv_numer) .AND. (force_env%in_use == use_qs_force)) THEN
459 CALL write_stress_tensor_components(virial, output_unit, cell, unit_string)
460 END IF
461 END IF
462 CALL write_stress_tensor(virial%pv_virial, output_unit, cell, unit_string, virial%pv_numer)
463 END IF
464 CALL cp_print_key_finished_output(output_unit, logger, force_env%force_env_section, &
465 "PRINT%STRESS_TENSOR")
466 ELSE
467 CALL zero_virial(virial, reset=.false.)
468 END IF
469 ELSE
470 output_unit = cp_print_key_unit_nr(logger, force_env%force_env_section, "PRINT%STRESS_TENSOR", &
471 extension=".stress_tensor")
472 IF (output_unit > 0) THEN
473 CALL cp_warn(__location__, "To print the stress tensor switch on the "// &
474 "virial evaluation with the keyword: STRESS_TENSOR")
475 END IF
476 CALL cp_print_key_finished_output(output_unit, logger, force_env%force_env_section, &
477 "PRINT%STRESS_TENSOR")
478 END IF
479
480 ! Atomic energy
481 output_unit = cp_print_key_unit_nr(logger, force_env%force_env_section, "PRINT%PROGRAM_RUN_INFO", &
482 extension=".Log")
483 IF (atprop_env%energy) THEN
484 CALL force_env%para_env%sum(atprop_env%atener)
485 CALL force_env_get(force_env, potential_energy=e_pot)
486 IF (output_unit > 0) THEN
487 IF (logger%iter_info%print_level >= low_print_level) THEN
488 CALL cp_subsys_get(subsys=subsys, particles=particles)
489 CALL write_atener(output_unit, particles, atprop_env%atener, "Mulliken Atomic Energies")
490 END IF
491 sum_energy = accurate_sum(atprop_env%atener(:))
492 checksum = abs(e_pot - sum_energy)
493 WRITE (unit=output_unit, fmt="(/,(T2,A,T56,F25.13))") &
494 "Potential energy (Atomic):", sum_energy, &
495 "Potential energy (Total) :", e_pot, &
496 "Difference :", checksum
497 cpassert((checksum < ateps*abs(e_pot)))
498 END IF
499 CALL cp_print_key_finished_output(output_unit, logger, force_env%force_env_section, &
500 "PRINT%PROGRAM_RUN_INFO")
501 END IF
502
503 ! Print GRMM interface file
504 print_grrm = cp_print_key_unit_nr(logger, force_env%force_env_section, "PRINT%GRRM", &
505 file_position="REWIND", extension=".rrm")
506 IF (print_grrm > 0) THEN
507 CALL force_env_get(force_env, subsys=subsys)
508 CALL cp_subsys_get(subsys=subsys, particles=particles, &
509 molecule_kinds=molecule_kinds)
510 ! Count the number of fixed atoms
511 nfixed_atoms_total = 0
512 nkind = molecule_kinds%n_els
513 molecule_kind_set => molecule_kinds%els
514 DO ikind = 1, nkind
515 molecule_kind => molecule_kind_set(ikind)
516 CALL get_molecule_kind(molecule_kind, nfixd=nfixed_atoms)
517 nfixed_atoms_total = nfixed_atoms_total + nfixed_atoms
518 END DO
519 !
520 CALL write_grrm(print_grrm, force_env, particles%els, e_pot, fixed_atoms=nfixed_atoms_total)
521 END IF
522 CALL cp_print_key_finished_output(print_grrm, logger, force_env%force_env_section, "PRINT%GRRM")
523
524 print_scine = cp_print_key_unit_nr(logger, force_env%force_env_section, "PRINT%SCINE", &
525 file_position="REWIND", extension=".scine")
526 IF (print_scine > 0) THEN
527 CALL force_env_get(force_env, subsys=subsys)
528 CALL cp_subsys_get(subsys=subsys, particles=particles)
529 !
530 CALL write_scine(print_scine, force_env, particles%els, e_pot)
531 END IF
532 CALL cp_print_key_finished_output(print_scine, logger, force_env%force_env_section, "PRINT%SCINE")
533
534 END SUBROUTINE force_env_calc_energy_force
535
536! **************************************************************************************************
537!> \brief Rebuild k-point data for geometries whose atomic symmetry can change.
538!> Atomic k-point symmetry may change when atoms or cell vectors move.
539!> \param force_env ...
540!> \param fd_energy ...
541! **************************************************************************************************
542 SUBROUTINE force_env_refresh_kpoint_symmetry(force_env, fd_energy)
543
544 TYPE(force_env_type), POINTER :: force_env
545 LOGICAL, INTENT(IN) :: fd_energy
546
547 REAL(kind=dp), PARAMETER :: eps_cell = 1.0e-14_dp
548
549 CHARACTER(LEN=default_string_length) :: kp_scheme
550 INTEGER :: run_type_id
551 LOGICAL :: debug_full_kpoint_symmetry, debug_full_kpoint_symmetry_explicit, &
552 debug_inversion_only, do_kpoints, dynamic_symmetry, force_full_debug_symmetry, full_grid, &
553 input_full_grid, input_inversion_symmetry_only, inversion_symmetry_only, kpoint_symmetry, &
554 moving_geometry, non_lower_triangular_cell, use_full_grid, use_inversion_symmetry_only
555 TYPE(cell_type), POINTER :: cell
556 TYPE(cp_blacs_env_type), POINTER :: blacs_env
557 TYPE(dft_control_type), POINTER :: dft_control
558 TYPE(global_environment_type), POINTER :: globenv
559 TYPE(kpoint_type), POINTER :: kpoints
560 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
561 TYPE(mp_para_env_type), POINTER :: para_env
562 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
563 TYPE(qs_wf_history_type), POINTER :: wf_history
564 TYPE(section_vals_type), POINTER :: input, kpoint_section
565
566 IF (.NOT. ASSOCIATED(force_env)) RETURN
567 IF (force_env%in_use /= use_qs_force) RETURN
568
569 NULLIFY (globenv)
570 CALL force_env_get(force_env, globenv=globenv)
571 IF (.NOT. ASSOCIATED(globenv)) RETURN
572 run_type_id = globenv%run_type_id
573 moving_geometry = .false.
574 SELECT CASE (run_type_id)
576 moving_geometry = .true.
577 CASE DEFAULT
578 moving_geometry = .false.
579 END SELECT
580 IF (run_type_id /= debug_run .AND. .NOT. moving_geometry) RETURN
581
582 NULLIFY (blacs_env, cell, dft_control, input, kpoint_section, kpoints, mos, para_env, &
583 particle_set, wf_history)
584 CALL get_qs_env(qs_env=force_env%qs_env, &
585 blacs_env=blacs_env, &
586 cell=cell, &
587 dft_control=dft_control, &
588 do_kpoints=do_kpoints, &
589 input=input, &
590 kpoints=kpoints, &
591 mos=mos, &
592 para_env=para_env, &
593 particle_set=particle_set, &
594 wf_history=wf_history)
595 IF (.NOT. do_kpoints) RETURN
596
597 CALL get_kpoint_info(kpoints, kp_scheme=kp_scheme, symmetry=kpoint_symmetry, full_grid=full_grid, &
598 inversion_symmetry_only=inversion_symmetry_only)
599 IF (.NOT. kpoint_symmetry) RETURN
600 IF (trim(kp_scheme) /= "MONKHORST-PACK" .AND. trim(kp_scheme) /= "MACDONALD" .AND. &
601 trim(kp_scheme) /= "GENERAL") RETURN
602
603 input_full_grid = full_grid
604 input_inversion_symmetry_only = inversion_symmetry_only
605 debug_full_kpoint_symmetry = .false.
606 debug_full_kpoint_symmetry_explicit = .false.
607 IF (ASSOCIATED(input)) THEN
608 kpoint_section => section_vals_get_subs_vals(input, "DFT%KPOINTS")
609 CALL section_vals_val_get(kpoint_section, "FULL_GRID", l_val=input_full_grid)
610 CALL section_vals_val_get(kpoint_section, "INVERSION_SYMMETRY_ONLY", &
611 l_val=input_inversion_symmetry_only)
612 CALL section_vals_val_get(kpoint_section, "DEBUG_FULL_KPOINT_SYMMETRY", &
613 l_val=debug_full_kpoint_symmetry, &
614 explicit=debug_full_kpoint_symmetry_explicit)
615 END IF
616 ! Moving geometries and DEBUG finite differences must not reuse atomic symmetry from
617 ! another geometry. Rebuild the k-point symmetry from the current cell and positions.
618 ! An explicit DEBUG_FULL_KPOINT_SYMMETRY OFF keeps numerical finite-difference
619 ! energies and DFTB DEBUG checks on inversion/time-reversal reduction.
620 debug_inversion_only = run_type_id == debug_run .AND. .NOT. debug_full_kpoint_symmetry .AND. &
621 (fd_energy .OR. dft_control%qs_control%dftb)
622 force_full_debug_symmetry = run_type_id == debug_run .AND. debug_full_kpoint_symmetry_explicit .AND. &
623 debug_full_kpoint_symmetry
624 use_full_grid = input_full_grid
625 use_inversion_symmetry_only = (input_inversion_symmetry_only .OR. debug_inversion_only) .AND. &
626 (.NOT. use_full_grid)
627 ! Preserve restrictions selected during initial setup. The explicit DEBUG expert option
628 ! remains available for symmetry diagnostics on otherwise unsupported cell matrices.
629 IF (inversion_symmetry_only .AND. .NOT. force_full_debug_symmetry .AND. .NOT. use_full_grid) THEN
630 use_inversion_symmetry_only = .true.
631 END IF
632 non_lower_triangular_cell = (abs(cell%hmat(2, 1)) > eps_cell) .OR. &
633 (abs(cell%hmat(3, 1)) > eps_cell) .OR. &
634 (abs(cell%hmat(3, 2)) > eps_cell)
635 IF (non_lower_triangular_cell .AND. .NOT. force_full_debug_symmetry .AND. .NOT. use_full_grid) THEN
636 use_inversion_symmetry_only = .true.
637 END IF
638 dynamic_symmetry = kpoint_symmetry .AND. .NOT. use_full_grid .AND. &
639 .NOT. use_inversion_symmetry_only
640 IF (run_type_id == debug_run .AND. .NOT. fd_energy .AND. .NOT. dynamic_symmetry .AND. &
641 (full_grid .EQV. use_full_grid) .AND. &
642 (inversion_symmetry_only .EQV. use_inversion_symmetry_only)) THEN
643 CALL qs_basis_rotation(force_env%qs_env, kpoints)
644 RETURN
645 END IF
646 IF (moving_geometry .AND. .NOT. dynamic_symmetry) RETURN
647 IF (moving_geometry .AND. .NOT. kpoint_has_nontrivial_atomic_symmetry(kpoints)) RETURN
648 CALL set_kpoint_info(kpoints, full_grid=use_full_grid, &
649 inversion_symmetry_only=use_inversion_symmetry_only)
650
651 CALL kpoint_reset_initialization(kpoints)
652 CALL kpoint_initialize(kpoints, particle_set, cell)
653 CALL kpoint_env_initialize(kpoints, para_env, blacs_env, with_aux_fit=dft_control%do_admm)
654 CALL kpoint_initialize_mos(kpoints, mos)
655 CALL wfi_clear(wf_history)
656 CALL qs_basis_rotation(force_env%qs_env, kpoints)
657
658 END SUBROUTINE force_env_refresh_kpoint_symmetry
659
660! **************************************************************************************************
661!> \brief Return whether the current reduced mesh uses nontrivial atomic symmetry operations.
662!> \param kpoints ...
663!> \return has_symmetry
664! **************************************************************************************************
665 FUNCTION kpoint_has_nontrivial_atomic_symmetry(kpoints) RESULT(has_symmetry)
666
667 TYPE(kpoint_type), POINTER :: kpoints
668 LOGICAL :: has_symmetry
669
670 INTEGER :: iatom, ik, isym, natom
671 REAL(kind=dp), DIMENSION(3, 3) :: eye3
672 TYPE(kpoint_sym_type), POINTER :: kpsym
673
674 has_symmetry = .false.
675 IF (.NOT. ASSOCIATED(kpoints)) RETURN
676 IF (.NOT. ASSOCIATED(kpoints%kp_sym)) RETURN
677
678 eye3 = 0.0_dp
679 eye3(1, 1) = 1.0_dp
680 eye3(2, 2) = 1.0_dp
681 eye3(3, 3) = 1.0_dp
682
683 DO ik = 1, kpoints%nkp
684 kpsym => kpoints%kp_sym(ik)%kpoint_sym
685 IF (.NOT. ASSOCIATED(kpsym)) cycle
686 IF (.NOT. kpsym%apply_symmetry) cycle
687 IF (.NOT. ASSOCIATED(kpsym%rot)) cycle
688 IF (.NOT. ASSOCIATED(kpsym%f0)) cycle
689 IF (.NOT. ASSOCIATED(kpsym%fcell)) cycle
690
691 natom = SIZE(kpsym%f0, 1)
692 DO isym = 1, SIZE(kpsym%rot, 3)
693 IF (maxval(abs(kpsym%rot(1:3, 1:3, isym) - eye3(1:3, 1:3))) > 1.e-12_dp .OR. &
694 any(kpsym%fcell(1:3, 1:natom, isym) /= 0)) THEN
695 has_symmetry = .true.
696 RETURN
697 END IF
698 DO iatom = 1, natom
699 IF (kpsym%f0(iatom, isym) /= iatom) THEN
700 has_symmetry = .true.
701 RETURN
702 END IF
703 END DO
704 END DO
705 END DO
706
707 END FUNCTION kpoint_has_nontrivial_atomic_symmetry
708
709! **************************************************************************************************
710!> \brief Evaluates the stress tensor and pressure numerically
711!> \param force_env ...
712!> \param dx ...
713!> \par History
714!> 10.2005 created [JCS]
715!> 05.2009 Teodoro Laino [tlaino] - rewriting for general force_env
716!>
717!> \author JCS
718! **************************************************************************************************
719 SUBROUTINE force_env_calc_num_pressure(force_env, dx)
720
721 TYPE(force_env_type), POINTER :: force_env
722 REAL(kind=dp), INTENT(IN), OPTIONAL :: dx
723
724 REAL(kind=dp), PARAMETER :: default_dx = 0.001_dp
725
726 CHARACTER(LEN=default_string_length) :: unit_string
727 INTEGER :: i, ip, iq, j, k, method_id, natom, &
728 ncore, nshell, output_unit, symmetry_id
729 LOGICAL :: use_sym_strain_2d
730 REAL(kind=dp) :: dx_w, eps_w
731 REAL(kind=dp), DIMENSION(2) :: numer_energy
732 REAL(kind=dp), DIMENSION(3) :: s
733 REAL(kind=dp), DIMENSION(3, 3) :: hmat_deformed, numer_pv_2d, &
734 numer_stress, strain
735 REAL(kind=dp), DIMENSION(:, :), POINTER :: ref_pos_atom, ref_pos_core, ref_pos_shell
736 TYPE(cell_type), POINTER :: cell, cell_local
737 TYPE(cp_logger_type), POINTER :: logger
738 TYPE(cp_subsys_type), POINTER :: subsys
739 TYPE(dft_control_type), POINTER :: dft_control
740 TYPE(global_environment_type), POINTER :: globenv
741 TYPE(particle_list_type), POINTER :: core_particles, particles, &
742 shell_particles
743 TYPE(virial_type), POINTER :: virial
744
745 NULLIFY (cell_local)
746 NULLIFY (dft_control)
747 NULLIFY (core_particles)
748 NULLIFY (particles)
749 NULLIFY (shell_particles)
750 NULLIFY (ref_pos_atom)
751 NULLIFY (ref_pos_core)
752 NULLIFY (ref_pos_shell)
753 natom = 0
754 method_id = 0
755 ncore = 0
756 nshell = 0
757 numer_pv_2d = 0.0_dp
758 numer_stress = 0.0_dp
759 use_sym_strain_2d = .false.
760
761 logger => cp_get_default_logger()
762
763 dx_w = default_dx
764 IF (PRESENT(dx)) dx_w = dx
765 CALL force_env_get(force_env, subsys=subsys, globenv=globenv, in_use=method_id)
766 CALL cp_subsys_get(subsys, &
767 core_particles=core_particles, &
768 particles=particles, &
769 shell_particles=shell_particles, &
770 virial=virial)
771 output_unit = cp_print_key_unit_nr(logger, force_env%force_env_section, "PRINT%STRESS_TENSOR", &
772 extension=".stress_tensor")
773 IF (output_unit > 0) THEN
774 WRITE (output_unit, "(/A,A/)") " **************************** ", &
775 "NUMERICAL STRESS ********************************"
776 END IF
777
778 ! Save all original particle positions
779 natom = particles%n_els
780 ALLOCATE (ref_pos_atom(natom, 3))
781 DO i = 1, natom
782 ref_pos_atom(i, :) = particles%els(i)%r
783 END DO
784 IF (ASSOCIATED(core_particles)) THEN
785 ncore = core_particles%n_els
786 ALLOCATE (ref_pos_core(ncore, 3))
787 DO i = 1, ncore
788 ref_pos_core(i, :) = core_particles%els(i)%r
789 END DO
790 END IF
791 IF (ASSOCIATED(shell_particles)) THEN
792 nshell = shell_particles%n_els
793 ALLOCATE (ref_pos_shell(nshell, 3))
794 DO i = 1, nshell
795 ref_pos_shell(i, :) = shell_particles%els(i)%r
796 END DO
797 END IF
798 CALL force_env_get(force_env, cell=cell)
799 ! Save cell symmetry (distorted cell has no symmetry)
800 symmetry_id = cell%symmetry_id
801 cell%symmetry_id = cell_sym_triclinic
802 !
803 CALL cell_create(cell_local)
804 CALL cell_clone(cell, cell_local)
805 IF (count(cell_local%perd /= 0) == 2 .AND. method_id == use_qs_force) THEN
806 CALL get_qs_env(qs_env=force_env%qs_env, dft_control=dft_control)
807 SELECT CASE (dft_control%qs_control%method_id)
810 use_sym_strain_2d = .true.
811 END SELECT
812 END IF
813 ! First change box
814 DO ip = 1, 3
815 DO iq = 1, 3
816 IF (use_sym_strain_2d) THEN
817 IF (cell_local%perd(ip) == 0 .OR. cell_local%perd(iq) == 0) cycle
818 IF (iq < ip) cycle
819 END IF
820 IF (virial%pv_diagonal .AND. (ip /= iq)) cycle
821 DO k = 1, 2
822 hmat_deformed = cell_local%hmat
823 IF (use_sym_strain_2d) THEN
824 eps_w = -(-1.0_dp)**k*dx_w
825 strain = 0.0_dp
826 DO i = 1, 3
827 strain(i, i) = 1.0_dp
828 END DO
829 IF (ip == iq) THEN
830 strain(ip, ip) = strain(ip, ip) + eps_w
831 ELSE
832 strain(ip, iq) = strain(ip, iq) + 0.5_dp*eps_w
833 strain(iq, ip) = strain(iq, ip) + 0.5_dp*eps_w
834 END IF
835 hmat_deformed = matmul(strain, cell_local%hmat)
836 ELSE
837 hmat_deformed(ip, iq) = hmat_deformed(ip, iq) - (-1.0_dp)**k*dx_w
838 END IF
839 cell%hmat = hmat_deformed
840 CALL init_cell(cell)
841 ! Scale positions
842 DO i = 1, natom
843 CALL real_to_scaled(s, ref_pos_atom(i, 1:3), cell_local)
844 CALL scaled_to_real(particles%els(i)%r, s, cell)
845 END DO
846 DO i = 1, ncore
847 CALL real_to_scaled(s, ref_pos_core(i, 1:3), cell_local)
848 CALL scaled_to_real(core_particles%els(i)%r, s, cell)
849 END DO
850 DO i = 1, nshell
851 CALL real_to_scaled(s, ref_pos_shell(i, 1:3), cell_local)
852 CALL scaled_to_real(shell_particles%els(i)%r, s, cell)
853 END DO
854 ! Compute energies
855 CALL force_env_calc_energy_force(force_env, &
856 calc_force=.false., &
857 consistent_energies=.true., &
858 calc_stress_tensor=.false.)
859 CALL force_env_get(force_env, potential_energy=numer_energy(k))
860 ! Reset cell
861 cell%hmat = cell_local%hmat
862 END DO
863 CALL init_cell(cell)
864 IF (use_sym_strain_2d) THEN
865 numer_pv_2d(ip, iq) = -0.5_dp*(numer_energy(1) - numer_energy(2))/dx_w
866 numer_pv_2d(iq, ip) = numer_pv_2d(ip, iq)
867 IF (output_unit > 0) THEN
868 IF (globenv%run_type_id == debug_run) THEN
869 WRITE (unit=output_unit, fmt="(/,T2,A,T19,A,F7.4,A,T44,A,F7.4,A,T69,A)") &
870 "DEBUG|", "E(e"//achar(119 + ip)//achar(119 + iq)//" +", dx_w, ")", &
871 "E(e"//achar(119 + ip)//achar(119 + iq)//" -", dx_w, ")", &
872 "pv(numerical)"
873 WRITE (unit=output_unit, fmt="(T2,A,2(1X,F24.8),1X,F22.8)") &
874 "DEBUG|", numer_energy(1:2), numer_pv_2d(ip, iq)
875 ELSE
876 WRITE (unit=output_unit, fmt="(/,T7,A,F7.4,A,T27,A,F7.4,A,T49,A)") &
877 "E(e"//achar(119 + ip)//achar(119 + iq)//" +", dx_w, ")", &
878 "E(e"//achar(119 + ip)//achar(119 + iq)//" -", dx_w, ")", &
879 "pv(numerical)"
880 WRITE (unit=output_unit, fmt="(3(1X,F19.8))") &
881 numer_energy(1:2), numer_pv_2d(ip, iq)
882 END IF
883 END IF
884 ELSE
885 numer_stress(ip, iq) = 0.5_dp*(numer_energy(1) - numer_energy(2))/dx_w
886 IF (output_unit > 0) THEN
887 IF (globenv%run_type_id == debug_run) THEN
888 WRITE (unit=output_unit, fmt="(/,T2,A,T19,A,F7.4,A,T44,A,F7.4,A,T69,A)") &
889 "DEBUG|", "E("//achar(119 + ip)//achar(119 + iq)//" +", dx_w, ")", &
890 "E("//achar(119 + ip)//achar(119 + iq)//" -", dx_w, ")", &
891 "f(numerical)"
892 WRITE (unit=output_unit, fmt="(T2,A,2(1X,F24.8),1X,F22.8)") &
893 "DEBUG|", numer_energy(1:2), numer_stress(ip, iq)
894 ELSE
895 WRITE (unit=output_unit, fmt="(/,T7,A,F7.4,A,T27,A,F7.4,A,T49,A)") &
896 "E("//achar(119 + ip)//achar(119 + iq)//" +", dx_w, ")", &
897 "E("//achar(119 + ip)//achar(119 + iq)//" -", dx_w, ")", &
898 "f(numerical)"
899 WRITE (unit=output_unit, fmt="(3(1X,F19.8))") &
900 numer_energy(1:2), numer_stress(ip, iq)
901 END IF
902 END IF
903 END IF
904 END DO
905 END DO
906
907 ! Reset positions and rebuild original environment
908 cell%symmetry_id = symmetry_id
909 CALL init_cell(cell)
910 DO i = 1, natom
911 particles%els(i)%r = ref_pos_atom(i, :)
912 END DO
913 DO i = 1, ncore
914 core_particles%els(i)%r = ref_pos_core(i, :)
915 END DO
916 DO i = 1, nshell
917 shell_particles%els(i)%r = ref_pos_shell(i, :)
918 END DO
919 CALL force_env_calc_energy_force(force_env, &
920 calc_force=.false., &
921 consistent_energies=.true., &
922 calc_stress_tensor=.false.)
923
924 ! Computing pv_test
925 virial%pv_virial = 0.0_dp
926 IF (use_sym_strain_2d) THEN
927 virial%pv_virial = numer_pv_2d
928 ELSE
929 DO i = 1, 3
930 DO j = 1, 3
931 DO k = 1, 3
932 virial%pv_virial(i, j) = virial%pv_virial(i, j) - &
933 0.5_dp*(numer_stress(i, k)*cell_local%hmat(j, k) + &
934 numer_stress(j, k)*cell_local%hmat(i, k))
935 END DO
936 END DO
937 END DO
938 END IF
939 IF (output_unit > 0) THEN
940 IF (globenv%run_type_id == debug_run) THEN
941 CALL section_vals_val_get(force_env%force_env_section, "PRINT%FORCES%FORCE_UNIT", &
942 c_val=unit_string)
943 CALL write_stress_tensor(virial%pv_virial, output_unit, cell, unit_string, virial%pv_numer)
944 END IF
945 WRITE (output_unit, "(/,A,/)") " **************************** "// &
946 "NUMERICAL STRESS END *****************************"
947 END IF
948
949 CALL cp_print_key_finished_output(output_unit, logger, force_env%force_env_section, &
950 "PRINT%STRESS_TENSOR")
951
952 ! Release storage
953 IF (ASSOCIATED(ref_pos_atom)) THEN
954 DEALLOCATE (ref_pos_atom)
955 END IF
956 IF (ASSOCIATED(ref_pos_core)) THEN
957 DEALLOCATE (ref_pos_core)
958 END IF
959 IF (ASSOCIATED(ref_pos_shell)) THEN
960 DEALLOCATE (ref_pos_shell)
961 END IF
962 IF (ASSOCIATED(cell_local)) CALL cell_release(cell_local)
963
964 END SUBROUTINE force_env_calc_num_pressure
965
966! **************************************************************************************************
967!> \brief creates and initializes a force environment
968!> \param force_env the force env to create
969!> \param root_section ...
970!> \param para_env ...
971!> \param globenv ...
972!> \param fist_env , qs_env: exactly one of these should be
973!> associated, the one that is active
974!> \param qs_env ...
975!> \param meta_env ...
976!> \param sub_force_env ...
977!> \param qmmm_env ...
978!> \param qmmmx_env ...
979!> \param eip_env ...
980!> \param pwdft_env ...
981!> \param force_env_section ...
982!> \param mixed_env ...
983!> \param embed_env ...
984!> \param nnp_env ...
985!> \param ipi_env ...
986!> \par History
987!> 04.2003 created [fawzi]
988!> \author fawzi
989! **************************************************************************************************
990 SUBROUTINE force_env_create(force_env, root_section, para_env, globenv, fist_env, &
991 qs_env, meta_env, sub_force_env, qmmm_env, qmmmx_env, eip_env, pwdft_env, force_env_section, &
992 mixed_env, embed_env, nnp_env, ipi_env)
993
994 TYPE(force_env_type), POINTER :: force_env
995 TYPE(section_vals_type), POINTER :: root_section
996 TYPE(mp_para_env_type), POINTER :: para_env
997 TYPE(global_environment_type), POINTER :: globenv
998 TYPE(fist_environment_type), OPTIONAL, POINTER :: fist_env
999 TYPE(qs_environment_type), OPTIONAL, POINTER :: qs_env
1000 TYPE(meta_env_type), OPTIONAL, POINTER :: meta_env
1001 TYPE(force_env_p_type), DIMENSION(:), OPTIONAL, &
1002 POINTER :: sub_force_env
1003 TYPE(qmmm_env_type), OPTIONAL, POINTER :: qmmm_env
1004 TYPE(qmmmx_env_type), OPTIONAL, POINTER :: qmmmx_env
1005 TYPE(eip_environment_type), OPTIONAL, POINTER :: eip_env
1006 TYPE(pwdft_environment_type), OPTIONAL, POINTER :: pwdft_env
1007 TYPE(section_vals_type), POINTER :: force_env_section
1008 TYPE(mixed_environment_type), OPTIONAL, POINTER :: mixed_env
1009 TYPE(embed_env_type), OPTIONAL, POINTER :: embed_env
1010 TYPE(nnp_type), OPTIONAL, POINTER :: nnp_env
1011 TYPE(ipi_environment_type), OPTIONAL, POINTER :: ipi_env
1012
1013 ALLOCATE (force_env)
1014 NULLIFY (force_env%fist_env, force_env%qs_env, &
1015 force_env%para_env, force_env%globenv, &
1016 force_env%meta_env, force_env%sub_force_env, &
1017 force_env%qmmm_env, force_env%qmmmx_env, force_env%fp_env, &
1018 force_env%force_env_section, force_env%eip_env, force_env%mixed_env, &
1019 force_env%embed_env, force_env%pwdft_env, force_env%nnp_env, &
1020 force_env%root_section)
1021 last_force_env_id = last_force_env_id + 1
1022 force_env%ref_count = 1
1023 force_env%in_use = 0
1024 force_env%additional_potential = 0.0_dp
1025
1026 force_env%globenv => globenv
1027 CALL globenv_retain(force_env%globenv)
1028
1029 force_env%root_section => root_section
1030 CALL section_vals_retain(root_section)
1031
1032 force_env%para_env => para_env
1033 CALL force_env%para_env%retain()
1034
1035 CALL section_vals_retain(force_env_section)
1036 force_env%force_env_section => force_env_section
1037
1038 IF (PRESENT(fist_env)) THEN
1039 cpassert(ASSOCIATED(fist_env))
1040 cpassert(force_env%in_use == 0)
1041 force_env%in_use = use_fist_force
1042 force_env%fist_env => fist_env
1043 END IF
1044 IF (PRESENT(eip_env)) THEN
1045 cpassert(ASSOCIATED(eip_env))
1046 cpassert(force_env%in_use == 0)
1047 force_env%in_use = use_eip_force
1048 force_env%eip_env => eip_env
1049 END IF
1050 IF (PRESENT(pwdft_env)) THEN
1051 cpassert(ASSOCIATED(pwdft_env))
1052 cpassert(force_env%in_use == 0)
1053 force_env%in_use = use_pwdft_force
1054 force_env%pwdft_env => pwdft_env
1055 END IF
1056 IF (PRESENT(qs_env)) THEN
1057 cpassert(ASSOCIATED(qs_env))
1058 cpassert(force_env%in_use == 0)
1059 force_env%in_use = use_qs_force
1060 force_env%qs_env => qs_env
1061 END IF
1062 IF (PRESENT(qmmm_env)) THEN
1063 cpassert(ASSOCIATED(qmmm_env))
1064 cpassert(force_env%in_use == 0)
1065 force_env%in_use = use_qmmm
1066 force_env%qmmm_env => qmmm_env
1067 END IF
1068 IF (PRESENT(qmmmx_env)) THEN
1069 cpassert(ASSOCIATED(qmmmx_env))
1070 cpassert(force_env%in_use == 0)
1071 force_env%in_use = use_qmmmx
1072 force_env%qmmmx_env => qmmmx_env
1073 END IF
1074 IF (PRESENT(mixed_env)) THEN
1075 cpassert(ASSOCIATED(mixed_env))
1076 cpassert(force_env%in_use == 0)
1077 force_env%in_use = use_mixed_force
1078 force_env%mixed_env => mixed_env
1079 END IF
1080 IF (PRESENT(embed_env)) THEN
1081 cpassert(ASSOCIATED(embed_env))
1082 cpassert(force_env%in_use == 0)
1083 force_env%in_use = use_embed
1084 force_env%embed_env => embed_env
1085 END IF
1086 IF (PRESENT(nnp_env)) THEN
1087 cpassert(ASSOCIATED(nnp_env))
1088 cpassert(force_env%in_use == 0)
1089 force_env%in_use = use_nnp_force
1090 force_env%nnp_env => nnp_env
1091 END IF
1092 IF (PRESENT(ipi_env)) THEN
1093 cpassert(ASSOCIATED(ipi_env))
1094 cpassert(force_env%in_use == 0)
1095 force_env%in_use = use_ipi
1096 force_env%ipi_env => ipi_env
1097 END IF
1098 cpassert(force_env%in_use /= 0)
1099
1100 IF (PRESENT(sub_force_env)) THEN
1101 force_env%sub_force_env => sub_force_env
1102 END IF
1103
1104 IF (PRESENT(meta_env)) THEN
1105 force_env%meta_env => meta_env
1106 ELSE
1107 NULLIFY (force_env%meta_env)
1108 END IF
1109
1110 END SUBROUTINE force_env_create
1111
1112! **************************************************************************************************
1113!> \brief ****f* force_env_methods/mixed_energy_forces [1.0]
1114!>
1115!> Computes energy and forces for a mixed force_env type
1116!> \param force_env the force_env that holds the mixed_env type
1117!> \param calculate_forces decides if forces should be calculated
1118!> \par History
1119!> 11.06 created [fschiff]
1120!> 04.07 generalization to an illimited number of force_eval [tlaino]
1121!> 04.07 further generalization to force_eval with different geometrical
1122!> structures [tlaino]
1123!> 04.08 reorganizing the genmix structure (collecting common code)
1124!> 01.16 added CDFT [Nico Holmberg]
1125!> 08.17 added DFT embedding [Vladimir Rybkin]
1126!> \author Florian Schiffmann
1127! **************************************************************************************************
1128 SUBROUTINE mixed_energy_forces(force_env, calculate_forces)
1129
1130 TYPE(force_env_type), POINTER :: force_env
1131 LOGICAL, INTENT(IN) :: calculate_forces
1132
1133 CHARACTER(LEN=default_path_length) :: coupling_function
1134 CHARACTER(LEN=default_string_length) :: def_error, description, this_error
1135 INTEGER :: iforce_eval, iparticle, istate(2), &
1136 jparticle, mixing_type, my_group, &
1137 natom, nforce_eval, source, unit_nr
1138 INTEGER, DIMENSION(:), POINTER :: glob_natoms, itmplist, map_index
1139 LOGICAL :: dip_exists
1140 REAL(kind=dp) :: coupling_parameter, dedf, der_1, der_2, &
1141 dx, energy, err, lambda, lerr, &
1142 restraint_strength, restraint_target, &
1143 sd
1144 REAL(kind=dp), DIMENSION(3) :: dip_mix
1145 REAL(kind=dp), DIMENSION(:), POINTER :: energies
1146 TYPE(cell_type), POINTER :: cell_mix
1147 TYPE(cp_logger_type), POINTER :: logger, my_logger
1148 TYPE(cp_result_p_type), DIMENSION(:), POINTER :: results
1149 TYPE(cp_result_type), POINTER :: loc_results, results_mix
1150 TYPE(cp_subsys_p_type), DIMENSION(:), POINTER :: subsystems
1151 TYPE(cp_subsys_type), POINTER :: subsys_mix
1152 TYPE(mixed_energy_type), POINTER :: mixed_energy
1153 TYPE(mixed_force_type), DIMENSION(:), POINTER :: global_forces
1154 TYPE(particle_list_p_type), DIMENSION(:), POINTER :: particles
1155 TYPE(particle_list_type), POINTER :: particles_mix
1156 TYPE(section_vals_type), POINTER :: force_env_section, gen_section, &
1157 mapping_section, mixed_section, &
1158 root_section
1159 TYPE(virial_p_type), DIMENSION(:), POINTER :: virials
1160 TYPE(virial_type), POINTER :: loc_virial, virial_mix
1161
1162 logger => cp_get_default_logger()
1163 cpassert(ASSOCIATED(force_env))
1164 ! Get infos about the mixed subsys
1165 CALL force_env_get(force_env=force_env, &
1166 subsys=subsys_mix, &
1167 force_env_section=force_env_section, &
1168 root_section=root_section, &
1169 cell=cell_mix)
1170 CALL cp_subsys_get(subsys=subsys_mix, &
1171 particles=particles_mix, &
1172 virial=virial_mix, &
1173 results=results_mix)
1174 NULLIFY (map_index, glob_natoms, global_forces, itmplist)
1175
1176 nforce_eval = SIZE(force_env%sub_force_env)
1177 mixed_section => section_vals_get_subs_vals(force_env_section, "MIXED")
1178 mapping_section => section_vals_get_subs_vals(mixed_section, "MAPPING")
1179 ! Global Info
1180 ALLOCATE (subsystems(nforce_eval))
1181 ALLOCATE (particles(nforce_eval))
1182 ! Local Info to sync
1183 ALLOCATE (global_forces(nforce_eval))
1184 ALLOCATE (energies(nforce_eval))
1185 ALLOCATE (glob_natoms(nforce_eval))
1186 ALLOCATE (virials(nforce_eval))
1187 ALLOCATE (results(nforce_eval))
1188 energies = 0.0_dp
1189 glob_natoms = 0
1190 ! Check if mixed CDFT calculation is requested and initialize
1191 CALL mixed_cdft_init(force_env, calculate_forces)
1192
1193 !
1194 IF (.NOT. force_env%mixed_env%do_mixed_cdft) THEN
1195 DO iforce_eval = 1, nforce_eval
1196 NULLIFY (subsystems(iforce_eval)%subsys, particles(iforce_eval)%list)
1197 NULLIFY (results(iforce_eval)%results, virials(iforce_eval)%virial)
1198 ALLOCATE (virials(iforce_eval)%virial)
1199 CALL cp_result_create(results(iforce_eval)%results)
1200 IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) cycle
1201 ! From this point on the error is the sub_error
1202 my_group = force_env%mixed_env%group_distribution(force_env%para_env%mepos)
1203 my_logger => force_env%mixed_env%sub_logger(my_group + 1)%p
1204 ! Copy iterations info (they are updated only in the main mixed_env)
1205 CALL cp_iteration_info_copy_iter(logger%iter_info, my_logger%iter_info)
1206 CALL cp_add_default_logger(my_logger)
1207
1208 ! Get all available subsys
1209 CALL force_env_get(force_env=force_env%sub_force_env(iforce_eval)%force_env, &
1210 subsys=subsystems(iforce_eval)%subsys)
1211
1212 ! all force_env share the same cell
1213 CALL cp_subsys_set(subsystems(iforce_eval)%subsys, cell=cell_mix)
1214
1215 ! Get available particles
1216 CALL cp_subsys_get(subsys=subsystems(iforce_eval)%subsys, &
1217 particles=particles(iforce_eval)%list)
1218
1219 ! Get Mapping index array
1220 natom = SIZE(particles(iforce_eval)%list%els)
1221
1222 CALL get_subsys_map_index(mapping_section, natom, iforce_eval, nforce_eval, &
1223 map_index)
1224
1225 ! Mapping particles from iforce_eval environment to the mixed env
1226 DO iparticle = 1, natom
1227 jparticle = map_index(iparticle)
1228 particles(iforce_eval)%list%els(iparticle)%r = particles_mix%els(jparticle)%r
1229 END DO
1230
1231 ! Calculate energy and forces for each sub_force_env
1232 CALL force_env_calc_energy_force(force_env%sub_force_env(iforce_eval)%force_env, &
1233 calc_force=calculate_forces, &
1234 skip_external_control=.true.)
1235
1236 ! Only the rank 0 process collect info for each computation
1237 IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%is_source()) THEN
1238 CALL force_env_get(force_env%sub_force_env(iforce_eval)%force_env, &
1239 potential_energy=energy)
1240 CALL cp_subsys_get(subsystems(iforce_eval)%subsys, &
1241 virial=loc_virial, results=loc_results)
1242 energies(iforce_eval) = energy
1243 glob_natoms(iforce_eval) = natom
1244 virials(iforce_eval)%virial = loc_virial
1245 CALL cp_result_copy(loc_results, results(iforce_eval)%results)
1246 END IF
1247 ! Deallocate map_index array
1248 IF (ASSOCIATED(map_index)) THEN
1249 DEALLOCATE (map_index)
1250 END IF
1252 END DO
1253 ELSE
1254 CALL mixed_cdft_energy_forces(force_env, calculate_forces, particles, energies, &
1255 glob_natoms, virials, results)
1256 END IF
1257 ! Handling Parallel execution
1258 CALL force_env%para_env%sync()
1259 ! Post CDFT operations
1260 CALL mixed_cdft_post_energy_forces(force_env)
1261 ! Let's transfer energy, natom, forces, virials
1262 CALL force_env%para_env%sum(energies)
1263 CALL force_env%para_env%sum(glob_natoms)
1264 ! Transfer forces
1265 DO iforce_eval = 1, nforce_eval
1266 ALLOCATE (global_forces(iforce_eval)%forces(3, glob_natoms(iforce_eval)))
1267 global_forces(iforce_eval)%forces = 0.0_dp
1268 IF (ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) THEN
1269 IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%is_source()) THEN
1270 ! Forces
1271 DO iparticle = 1, glob_natoms(iforce_eval)
1272 global_forces(iforce_eval)%forces(:, iparticle) = &
1273 particles(iforce_eval)%list%els(iparticle)%f
1274 END DO
1275 END IF
1276 END IF
1277 CALL force_env%para_env%sum(global_forces(iforce_eval)%forces)
1278 !Transfer only the relevant part of the virial..
1279 CALL force_env%para_env%sum(virials(iforce_eval)%virial%pv_total)
1280 CALL force_env%para_env%sum(virials(iforce_eval)%virial%pv_kinetic)
1281 CALL force_env%para_env%sum(virials(iforce_eval)%virial%pv_virial)
1282 CALL force_env%para_env%sum(virials(iforce_eval)%virial%pv_xc)
1283 CALL force_env%para_env%sum(virials(iforce_eval)%virial%pv_fock_4c)
1284 CALL force_env%para_env%sum(virials(iforce_eval)%virial%pv_constraint)
1285 !Transfer results
1286 source = 0
1287 IF (ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) THEN
1288 IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%is_source()) THEN
1289 source = force_env%para_env%mepos
1290 END IF
1291 END IF
1292 CALL force_env%para_env%sum(source)
1293 CALL cp_results_mp_bcast(results(iforce_eval)%results, source, force_env%para_env)
1294 END DO
1295
1296 force_env%mixed_env%energies = energies
1297 ! Start combining the different sub_force_env
1298 CALL get_mixed_env(mixed_env=force_env%mixed_env, &
1299 mixed_energy=mixed_energy)
1300
1301 !NB: do this for all MIXING_TYPE values, since some need it (e.g. linear mixing
1302 !NB if the first system has fewer atoms than the second)
1303 DO iparticle = 1, SIZE(particles_mix%els)
1304 particles_mix%els(iparticle)%f(:) = 0.0_dp
1305 END DO
1306
1307 CALL section_vals_val_get(mixed_section, "MIXING_TYPE", i_val=mixing_type)
1308 SELECT CASE (mixing_type)
1310 ! Support offered only 2 force_eval
1311 cpassert(nforce_eval == 2)
1312 CALL section_vals_val_get(mixed_section, "LINEAR%LAMBDA", r_val=lambda)
1313 mixed_energy%pot = lambda*energies(1) + (1.0_dp - lambda)*energies(2)
1314 ! General Mapping of forces...
1315 CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, &
1316 lambda, 1, nforce_eval, map_index, mapping_section, .true.)
1317 CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, &
1318 (1.0_dp - lambda), 2, nforce_eval, map_index, mapping_section, .false.)
1319 CASE (mix_minimum)
1320 ! Support offered only 2 force_eval
1321 cpassert(nforce_eval == 2)
1322 IF (energies(1) < energies(2)) THEN
1323 mixed_energy%pot = energies(1)
1324 CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, &
1325 1.0_dp, 1, nforce_eval, map_index, mapping_section, .true.)
1326 ELSE
1327 mixed_energy%pot = energies(2)
1328 CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, &
1329 1.0_dp, 2, nforce_eval, map_index, mapping_section, .true.)
1330 END IF
1331 CASE (mix_coupled)
1332 ! Support offered only 2 force_eval
1333 cpassert(nforce_eval == 2)
1334 CALL section_vals_val_get(mixed_section, "COUPLING%COUPLING_PARAMETER", &
1335 r_val=coupling_parameter)
1336 sd = sqrt((energies(1) - energies(2))**2 + 4.0_dp*coupling_parameter**2)
1337 der_1 = (1.0_dp - (1.0_dp/(2.0_dp*sd))*2.0_dp*(energies(1) - energies(2)))/2.0_dp
1338 der_2 = (1.0_dp + (1.0_dp/(2.0_dp*sd))*2.0_dp*(energies(1) - energies(2)))/2.0_dp
1339 mixed_energy%pot = (energies(1) + energies(2) - sd)/2.0_dp
1340 ! General Mapping of forces...
1341 CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, &
1342 der_1, 1, nforce_eval, map_index, mapping_section, .true.)
1343 CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, &
1344 der_2, 2, nforce_eval, map_index, mapping_section, .false.)
1345 CASE (mix_restrained)
1346 ! Support offered only 2 force_eval
1347 cpassert(nforce_eval == 2)
1348 CALL section_vals_val_get(mixed_section, "RESTRAINT%RESTRAINT_TARGET", &
1349 r_val=restraint_target)
1350 CALL section_vals_val_get(mixed_section, "RESTRAINT%RESTRAINT_STRENGTH", &
1351 r_val=restraint_strength)
1352 mixed_energy%pot = energies(1) + restraint_strength*(energies(1) - energies(2) - restraint_target)**2
1353 der_2 = -2.0_dp*restraint_strength*(energies(1) - energies(2) - restraint_target)
1354 der_1 = 1.0_dp - der_2
1355 ! General Mapping of forces...
1356 CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, &
1357 der_1, 1, nforce_eval, map_index, mapping_section, .true.)
1358 CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, &
1359 der_2, 2, nforce_eval, map_index, mapping_section, .false.)
1360 CASE (mix_generic)
1361 ! Support any number of force_eval sections
1362 gen_section => section_vals_get_subs_vals(mixed_section, "GENERIC")
1363 CALL get_generic_info(gen_section, "MIXING_FUNCTION", coupling_function, force_env%mixed_env%par, &
1364 force_env%mixed_env%val, energies)
1365 CALL initf(1)
1366 CALL parsef(1, trim(coupling_function), force_env%mixed_env%par)
1367 ! Now the hardest part.. map energy with corresponding force_eval
1368 mixed_energy%pot = evalf(1, force_env%mixed_env%val)
1369 cpassert(evalerrtype <= 0)
1370 CALL zero_virial(virial_mix, reset=.false.)
1371 CALL cp_results_erase(results_mix)
1372 DO iforce_eval = 1, nforce_eval
1373 CALL section_vals_val_get(gen_section, "DX", r_val=dx)
1374 CALL section_vals_val_get(gen_section, "ERROR_LIMIT", r_val=lerr)
1375 dedf = evalfd(1, iforce_eval, force_env%mixed_env%val, dx, err)
1376 IF (abs(err) > lerr) THEN
1377 WRITE (this_error, "(A,G12.6,A)") "(", err, ")"
1378 WRITE (def_error, "(A,G12.6,A)") "(", lerr, ")"
1379 CALL compress(this_error, .true.)
1380 CALL compress(def_error, .true.)
1381 CALL cp_warn(__location__, &
1382 'ASSERTION (cond) failed at line '//cp_to_string(__line__)// &
1383 ' Error '//trim(this_error)//' in computing numerical derivatives larger then'// &
1384 trim(def_error)//' .')
1385 END IF
1386 ! General Mapping of forces...
1387 CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, &
1388 dedf, iforce_eval, nforce_eval, map_index, mapping_section, .false.)
1389 force_env%mixed_env%val(iforce_eval) = energies(iforce_eval)
1390 END DO
1391 ! Let's store the needed information..
1392 force_env%mixed_env%dx = dx
1393 force_env%mixed_env%lerr = lerr
1394 force_env%mixed_env%coupling_function = trim(coupling_function)
1395 CALL finalizef()
1396 CASE (mix_cdft)
1397 ! Supports any number of force_evals for calculation of CDFT properties, but forces only from two
1398 CALL section_vals_val_get(mixed_section, "MIXED_CDFT%LAMBDA", r_val=lambda)
1399 ! Get the states which determine the forces
1400 CALL section_vals_val_get(mixed_section, "MIXED_CDFT%FORCE_STATES", i_vals=itmplist)
1401 IF (SIZE(itmplist) /= 2) THEN
1402 CALL cp_abort(__location__, &
1403 "Keyword FORCE_STATES takes exactly two input values.")
1404 END IF
1405 IF (any(itmplist < 0)) THEN
1406 cpabort("Invalid force_eval index.")
1407 END IF
1408 istate = itmplist
1409 IF (istate(1) > nforce_eval .OR. istate(2) > nforce_eval) THEN
1410 cpabort("Invalid force_eval index.")
1411 END IF
1412 mixed_energy%pot = lambda*energies(istate(1)) + (1.0_dp - lambda)*energies(istate(2))
1413 ! General Mapping of forces...
1414 CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, &
1415 lambda, istate(1), nforce_eval, map_index, mapping_section, .true.)
1416 CALL mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, &
1417 (1.0_dp - lambda), istate(2), nforce_eval, map_index, mapping_section, .false.)
1418 CASE DEFAULT
1419 cpabort("Unknown mixing type for mixed_energy_forces")
1420 END SELECT
1421 !Simply deallocate and loose the pointer references..
1422 DO iforce_eval = 1, nforce_eval
1423 DEALLOCATE (global_forces(iforce_eval)%forces)
1424 IF (ASSOCIATED(virials(iforce_eval)%virial)) DEALLOCATE (virials(iforce_eval)%virial)
1425 CALL cp_result_release(results(iforce_eval)%results)
1426 END DO
1427 DEALLOCATE (global_forces)
1428 DEALLOCATE (subsystems)
1429 DEALLOCATE (particles)
1430 DEALLOCATE (energies)
1431 DEALLOCATE (glob_natoms)
1432 DEALLOCATE (virials)
1433 DEALLOCATE (results)
1434 ! Print Section
1435 unit_nr = cp_print_key_unit_nr(logger, mixed_section, "PRINT%DIPOLE", &
1436 extension=".data", middle_name="MIXED_DIPOLE", log_filename=.false.)
1437 IF (unit_nr > 0) THEN
1438 description = '[DIPOLE]'
1439 dip_exists = test_for_result(results=results_mix, description=description)
1440 IF (dip_exists) THEN
1441 CALL get_results(results=results_mix, description=description, values=dip_mix)
1442 WRITE (unit_nr, '(/,1X,A,T48,3F21.16)') "MIXED ENV| DIPOLE ( A.U.)|", dip_mix
1443 WRITE (unit_nr, '( 1X,A,T48,3F21.16)') "MIXED ENV| DIPOLE (Debye)|", dip_mix*debye
1444 ELSE
1445 WRITE (unit_nr, *) "NO FORCE_EVAL section calculated the dipole"
1446 END IF
1447 END IF
1448 CALL cp_print_key_finished_output(unit_nr, logger, mixed_section, "PRINT%DIPOLE")
1449 END SUBROUTINE mixed_energy_forces
1450
1451! **************************************************************************************************
1452!> \brief Driver routine for mixed CDFT energy and force calculations
1453!> \param force_env the force_env that holds the mixed_env
1454!> \param calculate_forces if forces should be calculated
1455!> \param particles system particles
1456!> \param energies the energies of the CDFT states
1457!> \param glob_natoms the total number of particles
1458!> \param virials the virials stored in subsys
1459!> \param results results stored in subsys
1460!> \par History
1461!> 01.17 created [Nico Holmberg]
1462!> \author Nico Holmberg
1463! **************************************************************************************************
1464 SUBROUTINE mixed_cdft_energy_forces(force_env, calculate_forces, particles, energies, &
1465 glob_natoms, virials, results)
1466 TYPE(force_env_type), POINTER :: force_env
1467 LOGICAL, INTENT(IN) :: calculate_forces
1468 TYPE(particle_list_p_type), DIMENSION(:), POINTER :: particles
1469 REAL(kind=dp), DIMENSION(:), POINTER :: energies
1470 INTEGER, DIMENSION(:), POINTER :: glob_natoms
1471 TYPE(virial_p_type), DIMENSION(:), POINTER :: virials
1472 TYPE(cp_result_p_type), DIMENSION(:), POINTER :: results
1473
1474 INTEGER :: iforce_eval, iparticle, jparticle, &
1475 my_group, natom, nforce_eval
1476 INTEGER, DIMENSION(:), POINTER :: map_index
1477 REAL(kind=dp) :: energy
1478 TYPE(cell_type), POINTER :: cell_mix
1479 TYPE(cp_logger_type), POINTER :: logger, my_logger
1480 TYPE(cp_result_type), POINTER :: loc_results, results_mix
1481 TYPE(cp_subsys_p_type), DIMENSION(:), POINTER :: subsystems
1482 TYPE(cp_subsys_type), POINTER :: subsys_mix
1483 TYPE(particle_list_type), POINTER :: particles_mix
1484 TYPE(section_vals_type), POINTER :: force_env_section, mapping_section, &
1485 mixed_section, root_section
1486 TYPE(virial_type), POINTER :: loc_virial, virial_mix
1487
1488 logger => cp_get_default_logger()
1489 cpassert(ASSOCIATED(force_env))
1490 ! Get infos about the mixed subsys
1491 CALL force_env_get(force_env=force_env, &
1492 subsys=subsys_mix, &
1493 force_env_section=force_env_section, &
1494 root_section=root_section, &
1495 cell=cell_mix)
1496 CALL cp_subsys_get(subsys=subsys_mix, &
1497 particles=particles_mix, &
1498 virial=virial_mix, &
1499 results=results_mix)
1500 NULLIFY (map_index)
1501 nforce_eval = SIZE(force_env%sub_force_env)
1502 mixed_section => section_vals_get_subs_vals(force_env_section, "MIXED")
1503 mapping_section => section_vals_get_subs_vals(mixed_section, "MAPPING")
1504 ALLOCATE (subsystems(nforce_eval))
1505 DO iforce_eval = 1, nforce_eval
1506 NULLIFY (subsystems(iforce_eval)%subsys, particles(iforce_eval)%list)
1507 NULLIFY (results(iforce_eval)%results, virials(iforce_eval)%virial)
1508 ALLOCATE (virials(iforce_eval)%virial)
1509 CALL cp_result_create(results(iforce_eval)%results)
1510 IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) cycle
1511 ! Get all available subsys
1512 CALL force_env_get(force_env=force_env%sub_force_env(iforce_eval)%force_env, &
1513 subsys=subsystems(iforce_eval)%subsys)
1514
1515 ! all force_env share the same cell
1516 CALL cp_subsys_set(subsystems(iforce_eval)%subsys, cell=cell_mix)
1517
1518 ! Get available particles
1519 CALL cp_subsys_get(subsys=subsystems(iforce_eval)%subsys, &
1520 particles=particles(iforce_eval)%list)
1521
1522 ! Get Mapping index array
1523 natom = SIZE(particles(iforce_eval)%list%els)
1524 ! Serial mode need to deallocate first
1525 IF (ASSOCIATED(map_index)) THEN
1526 DEALLOCATE (map_index)
1527 END IF
1528 CALL get_subsys_map_index(mapping_section, natom, iforce_eval, nforce_eval, &
1529 map_index)
1530
1531 ! Mapping particles from iforce_eval environment to the mixed env
1532 DO iparticle = 1, natom
1533 jparticle = map_index(iparticle)
1534 particles(iforce_eval)%list%els(iparticle)%r = particles_mix%els(jparticle)%r
1535 END DO
1536 ! Mixed CDFT + QMMM: Need to translate now
1537 IF (force_env%mixed_env%do_mixed_qmmm_cdft) THEN
1538 CALL apply_qmmm_translate(force_env%sub_force_env(iforce_eval)%force_env%qmmm_env)
1539 END IF
1540 END DO
1541 ! For mixed CDFT calculations parallelized over CDFT states
1542 ! build weight and gradient on all processors before splitting into groups and
1543 ! starting energy calculation
1544 CALL mixed_cdft_build_weight(force_env, calculate_forces)
1545 DO iforce_eval = 1, nforce_eval
1546 IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) cycle
1547 ! From this point on the error is the sub_error
1548 IF (force_env%mixed_env%cdft_control%run_type == mixed_cdft_serial .AND. iforce_eval >= 2) THEN
1549 my_logger => force_env%mixed_env%cdft_control%sub_logger(iforce_eval - 1)%p
1550 ELSE
1551 my_group = force_env%mixed_env%group_distribution(force_env%para_env%mepos)
1552 my_logger => force_env%mixed_env%sub_logger(my_group + 1)%p
1553 END IF
1554 ! Copy iterations info (they are updated only in the main mixed_env)
1555 CALL cp_iteration_info_copy_iter(logger%iter_info, my_logger%iter_info)
1556 CALL cp_add_default_logger(my_logger)
1557 ! Serial CDFT calculation: transfer weight/gradient
1558 CALL mixed_cdft_build_weight(force_env, calculate_forces, iforce_eval)
1559 ! Calculate energy and forces for each sub_force_env
1560 CALL force_env_calc_energy_force(force_env%sub_force_env(iforce_eval)%force_env, &
1561 calc_force=calculate_forces, &
1562 skip_external_control=.true.)
1563 ! Only the rank 0 process collect info for each computation
1564 IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%is_source()) THEN
1565 CALL force_env_get(force_env%sub_force_env(iforce_eval)%force_env, &
1566 potential_energy=energy)
1567 CALL cp_subsys_get(subsystems(iforce_eval)%subsys, &
1568 virial=loc_virial, results=loc_results)
1569 energies(iforce_eval) = energy
1570 glob_natoms(iforce_eval) = natom
1571 virials(iforce_eval)%virial = loc_virial
1572 CALL cp_result_copy(loc_results, results(iforce_eval)%results)
1573 END IF
1574 ! Deallocate map_index array
1575 IF (ASSOCIATED(map_index)) THEN
1576 DEALLOCATE (map_index)
1577 END IF
1579 END DO
1580 DEALLOCATE (subsystems)
1581
1582 END SUBROUTINE mixed_cdft_energy_forces
1583
1584! **************************************************************************************************
1585!> \brief Perform additional tasks for mixed CDFT calculations after solving the electronic structure
1586!> of both CDFT states
1587!> \param force_env the force_env that holds the CDFT states
1588!> \par History
1589!> 01.17 created [Nico Holmberg]
1590!> \author Nico Holmberg
1591! **************************************************************************************************
1592 SUBROUTINE mixed_cdft_post_energy_forces(force_env)
1593 TYPE(force_env_type), POINTER :: force_env
1594
1595 INTEGER :: iforce_eval, nforce_eval, nvar
1596 TYPE(dft_control_type), POINTER :: dft_control
1597 TYPE(qs_environment_type), POINTER :: qs_env
1598
1599 cpassert(ASSOCIATED(force_env))
1600 NULLIFY (qs_env, dft_control)
1601 IF (force_env%mixed_env%do_mixed_cdft) THEN
1602 nforce_eval = SIZE(force_env%sub_force_env)
1603 nvar = force_env%mixed_env%cdft_control%nconstraint
1604 ! Transfer cdft strengths for writing restart
1605 IF (.NOT. ASSOCIATED(force_env%mixed_env%strength)) THEN
1606 ALLOCATE (force_env%mixed_env%strength(nforce_eval, nvar))
1607 END IF
1608 force_env%mixed_env%strength = 0.0_dp
1609 DO iforce_eval = 1, nforce_eval
1610 IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) cycle
1611 IF (force_env%mixed_env%do_mixed_qmmm_cdft) THEN
1612 qs_env => force_env%sub_force_env(iforce_eval)%force_env%qmmm_env%qs_env
1613 ELSE
1614 CALL force_env_get(force_env%sub_force_env(iforce_eval)%force_env, qs_env=qs_env)
1615 END IF
1616 CALL get_qs_env(qs_env, dft_control=dft_control)
1617 IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%is_source()) THEN
1618 force_env%mixed_env%strength(iforce_eval, :) = dft_control%qs_control%cdft_control%strength(:)
1619 END IF
1620 END DO
1621 CALL force_env%para_env%sum(force_env%mixed_env%strength)
1622 ! Mixed CDFT: calculate ET coupling
1623 IF (force_env%mixed_env%do_mixed_et) THEN
1624 IF (modulo(force_env%mixed_env%cdft_control%sim_step, force_env%mixed_env%et_freq) == 0) THEN
1625 CALL mixed_cdft_calculate_coupling(force_env)
1626 END IF
1627 END IF
1628 END IF
1629
1630 END SUBROUTINE mixed_cdft_post_energy_forces
1631
1632! **************************************************************************************************
1633!> \brief Computes the total energy for an embedded calculation
1634!> \param force_env ...
1635!> \author Vladimir Rybkin
1636! **************************************************************************************************
1637 SUBROUTINE embed_energy(force_env)
1638
1639 TYPE(force_env_type), POINTER :: force_env
1640
1641 INTEGER :: iforce_eval, iparticle, jparticle, &
1642 my_group, natom, nforce_eval
1643 INTEGER, DIMENSION(:), POINTER :: glob_natoms, map_index
1644 LOGICAL :: converged_embed
1645 REAL(kind=dp) :: energy
1646 REAL(kind=dp), DIMENSION(:), POINTER :: energies
1647 TYPE(cell_type), POINTER :: cell_embed
1648 TYPE(cp_logger_type), POINTER :: logger, my_logger
1649 TYPE(cp_result_p_type), DIMENSION(:), POINTER :: results
1650 TYPE(cp_result_type), POINTER :: loc_results, results_embed
1651 TYPE(cp_subsys_p_type), DIMENSION(:), POINTER :: subsystems
1652 TYPE(cp_subsys_type), POINTER :: subsys_embed
1653 TYPE(dft_control_type), POINTER :: dft_control
1654 TYPE(particle_list_p_type), DIMENSION(:), POINTER :: particles
1655 TYPE(particle_list_type), POINTER :: particles_embed
1656 TYPE(pw_env_type), POINTER :: pw_env
1657 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1658 TYPE(pw_r3d_rs_type), POINTER :: embed_pot, spin_embed_pot
1659 TYPE(section_vals_type), POINTER :: embed_section, force_env_section, &
1660 mapping_section, root_section
1661
1662 logger => cp_get_default_logger()
1663 cpassert(ASSOCIATED(force_env))
1664 ! Get infos about the embedding subsys
1665 CALL force_env_get(force_env=force_env, &
1666 subsys=subsys_embed, &
1667 force_env_section=force_env_section, &
1668 root_section=root_section, &
1669 cell=cell_embed)
1670 CALL cp_subsys_get(subsys=subsys_embed, &
1671 particles=particles_embed, &
1672 results=results_embed)
1673 NULLIFY (map_index, glob_natoms)
1674
1675 nforce_eval = SIZE(force_env%sub_force_env)
1676 embed_section => section_vals_get_subs_vals(force_env_section, "EMBED")
1677 mapping_section => section_vals_get_subs_vals(embed_section, "MAPPING")
1678 ! Global Info
1679 ALLOCATE (subsystems(nforce_eval))
1680 ALLOCATE (particles(nforce_eval))
1681 ! Local Info to sync
1682 ALLOCATE (energies(nforce_eval))
1683 ALLOCATE (glob_natoms(nforce_eval))
1684 ALLOCATE (results(nforce_eval))
1685 energies = 0.0_dp
1686 glob_natoms = 0
1687
1688 DO iforce_eval = 1, nforce_eval
1689 NULLIFY (subsystems(iforce_eval)%subsys, particles(iforce_eval)%list)
1690 NULLIFY (results(iforce_eval)%results)
1691 CALL cp_result_create(results(iforce_eval)%results)
1692 IF (.NOT. ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env)) cycle
1693 ! From this point on the error is the sub_error
1694 my_group = force_env%embed_env%group_distribution(force_env%para_env%mepos)
1695 my_logger => force_env%embed_env%sub_logger(my_group + 1)%p
1696 ! Copy iterations info (they are updated only in the main embed_env)
1697 CALL cp_iteration_info_copy_iter(logger%iter_info, my_logger%iter_info)
1698 CALL cp_add_default_logger(my_logger)
1699
1700 ! Get all available subsys
1701 CALL force_env_get(force_env=force_env%sub_force_env(iforce_eval)%force_env, &
1702 subsys=subsystems(iforce_eval)%subsys)
1703
1704 ! Check if we import density from previous force calculations
1705 ! Only for QUICKSTEP
1706 IF (ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env%qs_env)) THEN
1707 NULLIFY (dft_control)
1708 CALL get_qs_env(force_env%sub_force_env(iforce_eval)%force_env%qs_env, dft_control=dft_control)
1709 IF (dft_control%qs_control%ref_embed_subsys) THEN
1710 IF (iforce_eval == 2) cpabort("Density importing force_eval can't be the first.")
1711 END IF
1712 END IF
1713
1714 ! all force_env share the same cell
1715 CALL cp_subsys_set(subsystems(iforce_eval)%subsys, cell=cell_embed)
1716
1717 ! Get available particles
1718 CALL cp_subsys_get(subsys=subsystems(iforce_eval)%subsys, &
1719 particles=particles(iforce_eval)%list)
1720
1721 ! Get Mapping index array
1722 natom = SIZE(particles(iforce_eval)%list%els)
1723
1724 CALL get_subsys_map_index(mapping_section, natom, iforce_eval, nforce_eval, &
1725 map_index, .true.)
1726
1727 ! Mapping particles from iforce_eval environment to the embed env
1728 DO iparticle = 1, natom
1729 jparticle = map_index(iparticle)
1730 particles(iforce_eval)%list%els(iparticle)%r = particles_embed%els(jparticle)%r
1731 END DO
1732
1733 ! Calculate energy and forces for each sub_force_env
1734 CALL force_env_calc_energy_force(force_env%sub_force_env(iforce_eval)%force_env, &
1735 calc_force=.false., &
1736 skip_external_control=.true.)
1737
1738 ! Call DFT embedding
1739 IF (ASSOCIATED(force_env%sub_force_env(iforce_eval)%force_env%qs_env)) THEN
1740 NULLIFY (dft_control)
1741 CALL get_qs_env(force_env%sub_force_env(iforce_eval)%force_env%qs_env, dft_control=dft_control)
1742 IF (dft_control%qs_control%ref_embed_subsys) THEN
1743 ! Now we can optimize the embedding potential
1744 CALL dft_embedding(force_env, iforce_eval, energies, converged_embed)
1745 IF (.NOT. converged_embed) cpabort("Embedding potential optimization not converged.")
1746 END IF
1747 ! Deallocate embedding potential on the high-level subsystem
1748 IF (dft_control%qs_control%high_level_embed_subsys) THEN
1749 CALL get_qs_env(qs_env=force_env%sub_force_env(iforce_eval)%force_env%qs_env, &
1750 embed_pot=embed_pot, spin_embed_pot=spin_embed_pot, pw_env=pw_env)
1751 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
1752 CALL auxbas_pw_pool%give_back_pw(embed_pot)
1753 IF (ASSOCIATED(embed_pot)) THEN
1754 CALL embed_pot%release()
1755 DEALLOCATE (embed_pot)
1756 END IF
1757 IF (ASSOCIATED(spin_embed_pot)) THEN
1758 CALL auxbas_pw_pool%give_back_pw(spin_embed_pot)
1759 CALL spin_embed_pot%release()
1760 DEALLOCATE (spin_embed_pot)
1761 END IF
1762 END IF
1763 END IF
1764
1765 ! Only the rank 0 process collect info for each computation
1766 IF (force_env%sub_force_env(iforce_eval)%force_env%para_env%is_source()) THEN
1767 CALL force_env_get(force_env%sub_force_env(iforce_eval)%force_env, &
1768 potential_energy=energy)
1769 CALL cp_subsys_get(subsystems(iforce_eval)%subsys, &
1770 results=loc_results)
1771 energies(iforce_eval) = energy
1772 glob_natoms(iforce_eval) = natom
1773 CALL cp_result_copy(loc_results, results(iforce_eval)%results)
1774 END IF
1775 ! Deallocate map_index array
1776 IF (ASSOCIATED(map_index)) THEN
1777 DEALLOCATE (map_index)
1778 END IF
1780 END DO
1781
1782 ! Handling Parallel execution
1783 CALL force_env%para_env%sync()
1784 ! Let's transfer energy, natom
1785 CALL force_env%para_env%sum(energies)
1786 CALL force_env%para_env%sum(glob_natoms)
1787
1788 force_env%embed_env%energies = energies
1789
1790 !NB if the first system has fewer atoms than the second)
1791 DO iparticle = 1, SIZE(particles_embed%els)
1792 particles_embed%els(iparticle)%f(:) = 0.0_dp
1793 END DO
1794
1795 ! ONIOM type of mixing in embedding: E = E_total + E_cluster_high - E_cluster
1796 force_env%embed_env%pot_energy = energies(3) + energies(4) - energies(2)
1797
1798 !Simply deallocate and loose the pointer references..
1799 DO iforce_eval = 1, nforce_eval
1800 CALL cp_result_release(results(iforce_eval)%results)
1801 END DO
1802 DEALLOCATE (subsystems)
1803 DEALLOCATE (particles)
1804 DEALLOCATE (energies)
1805 DEALLOCATE (glob_natoms)
1806 DEALLOCATE (results)
1807
1808 END SUBROUTINE embed_energy
1809
1810! **************************************************************************************************
1811!> \brief ...
1812!> \param force_env ...
1813!> \param ref_subsys_number ...
1814!> \param energies ...
1815!> \param converged_embed ...
1816! **************************************************************************************************
1817 SUBROUTINE dft_embedding(force_env, ref_subsys_number, energies, converged_embed)
1818 TYPE(force_env_type), POINTER :: force_env
1819 INTEGER :: ref_subsys_number
1820 REAL(kind=dp), DIMENSION(:), POINTER :: energies
1821 LOGICAL :: converged_embed
1822
1823 INTEGER :: embed_method
1824 TYPE(section_vals_type), POINTER :: embed_section, force_env_section
1825
1826 ! Find out which embedding scheme is used
1827 CALL force_env_get(force_env=force_env, &
1828 force_env_section=force_env_section)
1829 embed_section => section_vals_get_subs_vals(force_env_section, "EMBED")
1830
1831 CALL section_vals_val_get(embed_section, "EMBED_METHOD", i_val=embed_method)
1832 SELECT CASE (embed_method)
1833 CASE (dfet)
1834 ! Density functional embedding
1835 CALL dfet_embedding(force_env, ref_subsys_number, energies, converged_embed)
1836 CASE (dmfet)
1837 ! Density matrix embedding theory
1838 CALL dmfet_embedding(force_env, ref_subsys_number, energies, converged_embed)
1839 END SELECT
1840
1841 END SUBROUTINE dft_embedding
1842! **************************************************************************************************
1843!> \brief ... Main driver for DFT embedding
1844!> \param force_env ...
1845!> \param ref_subsys_number ...
1846!> \param energies ...
1847!> \param converged_embed ...
1848!> \author Vladimir Rybkin
1849! **************************************************************************************************
1850 SUBROUTINE dfet_embedding(force_env, ref_subsys_number, energies, converged_embed)
1851 TYPE(force_env_type), POINTER :: force_env
1852 INTEGER :: ref_subsys_number
1853 REAL(kind=dp), DIMENSION(:), POINTER :: energies
1854 LOGICAL :: converged_embed
1855
1856 CHARACTER(LEN=*), PARAMETER :: routinen = 'dfet_embedding'
1857
1858 INTEGER :: cluster_subsys_num, handle, &
1859 i_force_eval, i_iter, i_spin, &
1860 nforce_eval, nspins, nspins_subsys, &
1861 output_unit
1862 REAL(kind=dp) :: cluster_energy
1863 REAL(kind=dp), DIMENSION(:), POINTER :: rhs
1864 TYPE(cp_logger_type), POINTER :: logger
1865 TYPE(dft_control_type), POINTER :: dft_control
1866 TYPE(opt_embed_pot_type) :: opt_embed
1867 TYPE(pw_env_type), POINTER :: pw_env
1868 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1869 TYPE(pw_r3d_rs_type) :: diff_rho_r, diff_rho_spin
1870 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r_ref, rho_r_subsys
1871 TYPE(pw_r3d_rs_type), POINTER :: embed_pot, embed_pot_subsys, &
1872 spin_embed_pot, spin_embed_pot_subsys
1873 TYPE(qs_energy_type), POINTER :: energy
1874 TYPE(qs_rho_type), POINTER :: rho, subsys_rho
1875 TYPE(section_vals_type), POINTER :: dft_section, embed_section, &
1876 force_env_section, input, &
1877 mapping_section, opt_embed_section
1878
1879 CALL timeset(routinen, handle)
1880
1881 CALL cite_reference(huang2011)
1882 CALL cite_reference(heaton_burgess2007)
1883
1884 CALL get_qs_env(qs_env=force_env%sub_force_env(ref_subsys_number)%force_env%qs_env)
1885
1886 ! Reveal input file
1887 NULLIFY (logger)
1888 logger => cp_get_default_logger()
1889 output_unit = cp_print_key_unit_nr(logger, force_env%force_env_section, "PRINT%PROGRAM_RUN_INFO", &
1890 extension=".Log")
1891
1892 NULLIFY (dft_section, input, opt_embed_section)
1893 NULLIFY (energy, dft_control)
1894
1895 CALL get_qs_env(qs_env=force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, &
1896 pw_env=pw_env, dft_control=dft_control, rho=rho, energy=energy, &
1897 input=input)
1898 nspins = dft_control%nspins
1899
1900 dft_section => section_vals_get_subs_vals(input, "DFT")
1901 opt_embed_section => section_vals_get_subs_vals(input, &
1902 "DFT%QS%OPT_EMBED")
1903 ! Rho_r is the reference
1904 CALL qs_rho_get(rho_struct=rho, rho_r=rho_r_ref)
1905
1906 ! We need to understand how to treat spins states
1907 CALL understand_spin_states(force_env, ref_subsys_number, opt_embed%change_spin, opt_embed%open_shell_embed, &
1908 opt_embed%all_nspins)
1909
1910 ! Prepare everything for the potential maximization
1911 CALL prepare_embed_opt(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, opt_embed, &
1912 opt_embed_section)
1913
1914 ! Initialize embedding potential
1915 CALL init_embed_pot(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, embed_pot, &
1916 opt_embed%add_const_pot, opt_embed%Fermi_Amaldi, opt_embed%const_pot, &
1917 opt_embed%open_shell_embed, spin_embed_pot, &
1918 opt_embed%pot_diff, opt_embed%Coulomb_guess, opt_embed%grid_opt)
1919
1920 ! Read embedding potential vector from the file
1921 IF (opt_embed%read_embed_pot .OR. opt_embed%read_embed_pot_cube) CALL read_embed_pot( &
1922 force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, embed_pot, spin_embed_pot, &
1923 opt_embed_section, opt_embed)
1924
1925 ! Prepare the pw object to store density differences
1926 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
1927 CALL auxbas_pw_pool%create_pw(diff_rho_r)
1928 CALL pw_zero(diff_rho_r)
1929 IF (opt_embed%open_shell_embed) THEN
1930 CALL auxbas_pw_pool%create_pw(diff_rho_spin)
1931 CALL pw_zero(diff_rho_spin)
1932 END IF
1933
1934 ! Check the preliminary density differences
1935 DO i_spin = 1, nspins
1936 CALL pw_axpy(rho_r_ref(i_spin), diff_rho_r, -1.0_dp)
1937 END DO
1938 IF (opt_embed%open_shell_embed) THEN ! Spin part
1939 IF (nspins == 2) THEN ! Reference systems has an open shell, else the reference diff_rho_spin is zero
1940 CALL pw_axpy(rho_r_ref(1), diff_rho_spin, -1.0_dp)
1941 CALL pw_axpy(rho_r_ref(2), diff_rho_spin, 1.0_dp)
1942 END IF
1943 END IF
1944
1945 DO i_force_eval = 1, ref_subsys_number - 1
1946 NULLIFY (subsys_rho, rho_r_subsys, dft_control)
1947 CALL get_qs_env(force_env%sub_force_env(i_force_eval)%force_env%qs_env, rho=subsys_rho, energy=energy, &
1948 dft_control=dft_control)
1949 nspins_subsys = dft_control%nspins
1950 ! Add subsystem densities
1951 CALL qs_rho_get(rho_struct=subsys_rho, rho_r=rho_r_subsys)
1952 DO i_spin = 1, nspins_subsys
1953 CALL pw_axpy(rho_r_subsys(i_spin), diff_rho_r, allow_noncompatible_grids=.true.)
1954 END DO
1955 IF (opt_embed%open_shell_embed) THEN ! Spin part
1956 IF (nspins_subsys == 2) THEN ! The subsystem makes contribution if it is spin-polarized
1957 ! We may need to change spin ONLY FOR THE SECOND SUBSYSTEM: that's the internal convention
1958 IF ((i_force_eval == 2) .AND. (opt_embed%change_spin)) THEN
1959 CALL pw_axpy(rho_r_subsys(1), diff_rho_spin, -1.0_dp, allow_noncompatible_grids=.true.)
1960 CALL pw_axpy(rho_r_subsys(2), diff_rho_spin, 1.0_dp, allow_noncompatible_grids=.true.)
1961 ELSE
1962 ! First subsystem (always) and second subsystem (without spin change)
1963 CALL pw_axpy(rho_r_subsys(1), diff_rho_spin, 1.0_dp, allow_noncompatible_grids=.true.)
1964 CALL pw_axpy(rho_r_subsys(2), diff_rho_spin, -1.0_dp, allow_noncompatible_grids=.true.)
1965 END IF
1966 END IF
1967 END IF
1968 END DO
1969
1970 ! Print density difference
1971 CALL print_rho_diff(diff_rho_r, 0, force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, .false.)
1972 IF (opt_embed%open_shell_embed) THEN ! Spin part
1973 CALL print_rho_spin_diff(diff_rho_spin, 0, force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, .false.)
1974 END IF
1975
1976 ! Construct electrostatic guess if needed
1977 IF (opt_embed%Coulomb_guess) THEN
1978 ! Reveal resp charges for total system
1979 nforce_eval = SIZE(force_env%sub_force_env)
1980 NULLIFY (rhs)
1981 CALL get_qs_env(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, rhs=rhs)
1982 ! Get the mapping
1983 CALL force_env_get(force_env=force_env, &
1984 force_env_section=force_env_section)
1985 embed_section => section_vals_get_subs_vals(force_env_section, "EMBED")
1986 mapping_section => section_vals_get_subs_vals(embed_section, "MAPPING")
1987
1988 DO i_force_eval = 1, ref_subsys_number - 1
1989 IF (i_force_eval == 1) THEN
1990 CALL coulomb_guess(embed_pot, rhs, mapping_section, &
1991 force_env%sub_force_env(i_force_eval)%force_env%qs_env, nforce_eval, i_force_eval, opt_embed%eta)
1992 ELSE
1993 CALL coulomb_guess(opt_embed%pot_diff, rhs, mapping_section, &
1994 force_env%sub_force_env(i_force_eval)%force_env%qs_env, nforce_eval, i_force_eval, opt_embed%eta)
1995 END IF
1996 END DO
1997 CALL pw_axpy(opt_embed%pot_diff, embed_pot)
1998 IF (.NOT. opt_embed%grid_opt) CALL pw_copy(embed_pot, opt_embed%const_pot)
1999
2000 END IF
2001
2002 ! Difference guess
2003 IF (opt_embed%diff_guess) THEN
2004 CALL pw_copy(diff_rho_r, embed_pot)
2005 IF (.NOT. opt_embed%grid_opt) CALL pw_copy(embed_pot, opt_embed%const_pot)
2006 ! Open shell
2007 IF (opt_embed%open_shell_embed) CALL pw_copy(diff_rho_spin, spin_embed_pot)
2008 END IF
2009
2010 ! Calculate subsystems with trial embedding potential
2011 DO i_iter = 1, opt_embed%n_iter
2012 opt_embed%i_iter = i_iter
2013
2014 ! Set the density difference as the negative reference one
2015 CALL pw_zero(diff_rho_r)
2016 CALL get_qs_env(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, dft_control=dft_control)
2017 nspins = dft_control%nspins
2018 DO i_spin = 1, nspins
2019 CALL pw_axpy(rho_r_ref(i_spin), diff_rho_r, -1.0_dp)
2020 END DO
2021 IF (opt_embed%open_shell_embed) THEN ! Spin part
2022 CALL pw_zero(diff_rho_spin)
2023 IF (nspins == 2) THEN ! Reference systems has an open shell, else the reference diff_rho_spin is zero
2024 CALL pw_axpy(rho_r_ref(1), diff_rho_spin, -1.0_dp)
2025 CALL pw_axpy(rho_r_ref(2), diff_rho_spin, 1.0_dp)
2026 END IF
2027 END IF
2028
2029 DO i_force_eval = 1, ref_subsys_number - 1
2030 NULLIFY (dft_control)
2031 CALL get_qs_env(force_env%sub_force_env(i_force_eval)%force_env%qs_env, dft_control=dft_control)
2032 nspins_subsys = dft_control%nspins
2033
2034 IF ((i_force_eval == 2) .AND. (opt_embed%change_spin)) THEN
2035 ! Here we change the sign of the spin embedding potential due to spin change:
2036 ! only in spin_embed_subsys
2037 CALL make_subsys_embed_pot(force_env%sub_force_env(i_force_eval)%force_env%qs_env, &
2038 embed_pot, embed_pot_subsys, spin_embed_pot, spin_embed_pot_subsys, &
2039 opt_embed%open_shell_embed, .true.)
2040 ELSE ! Regular case
2041 CALL make_subsys_embed_pot(force_env%sub_force_env(i_force_eval)%force_env%qs_env, &
2042 embed_pot, embed_pot_subsys, spin_embed_pot, spin_embed_pot_subsys, &
2043 opt_embed%open_shell_embed, .false.)
2044 END IF
2045
2046 ! Switch on external potential in the subsystems
2047 dft_control%apply_embed_pot = .true.
2048
2049 ! Add the embedding potential
2050 CALL set_qs_env(force_env%sub_force_env(i_force_eval)%force_env%qs_env, embed_pot=embed_pot_subsys)
2051 IF ((opt_embed%open_shell_embed) .AND. (nspins_subsys == 2)) THEN ! Spin part
2052 CALL set_qs_env(force_env%sub_force_env(i_force_eval)%force_env%qs_env, &
2053 spin_embed_pot=spin_embed_pot_subsys)
2054 END IF
2055
2056 ! Get the previous subsystem densities
2057 CALL get_prev_density(opt_embed, force_env%sub_force_env(i_force_eval)%force_env, i_force_eval)
2058
2059 ! Calculate the new density
2060 CALL force_env_calc_energy_force(force_env=force_env%sub_force_env(i_force_eval)%force_env, &
2061 calc_force=.false., &
2062 skip_external_control=.true.)
2063
2064 CALL get_max_subsys_diff(opt_embed, force_env%sub_force_env(i_force_eval)%force_env, i_force_eval)
2065
2066 ! Extract subsystem density and energy
2067 NULLIFY (rho_r_subsys, energy)
2068
2069 CALL get_qs_env(force_env%sub_force_env(i_force_eval)%force_env%qs_env, rho=subsys_rho, &
2070 energy=energy)
2071 opt_embed%w_func(i_iter) = opt_embed%w_func(i_iter) + energy%total
2072
2073 ! Find out which subsystem is the cluster
2074 IF (dft_control%qs_control%cluster_embed_subsys) THEN
2075 cluster_subsys_num = i_force_eval
2076 cluster_energy = energy%total
2077 END IF
2078
2079 ! Add subsystem densities
2080 CALL qs_rho_get(rho_struct=subsys_rho, rho_r=rho_r_subsys)
2081 DO i_spin = 1, nspins_subsys
2082 CALL pw_axpy(rho_r_subsys(i_spin), diff_rho_r, allow_noncompatible_grids=.true.)
2083 END DO
2084 IF (opt_embed%open_shell_embed) THEN ! Spin part
2085 IF (nspins_subsys == 2) THEN ! The subsystem makes contribution if it is spin-polarized
2086 ! We may need to change spin ONLY FOR THE SECOND SUBSYSTEM: that's the internal convention
2087 IF ((i_force_eval == 2) .AND. (opt_embed%change_spin)) THEN
2088 CALL pw_axpy(rho_r_subsys(1), diff_rho_spin, -1.0_dp, allow_noncompatible_grids=.true.)
2089 CALL pw_axpy(rho_r_subsys(2), diff_rho_spin, 1.0_dp, allow_noncompatible_grids=.true.)
2090 ELSE
2091 ! First subsystem (always) and second subsystem (without spin change)
2092 CALL pw_axpy(rho_r_subsys(1), diff_rho_spin, 1.0_dp, allow_noncompatible_grids=.true.)
2093 CALL pw_axpy(rho_r_subsys(2), diff_rho_spin, -1.0_dp, allow_noncompatible_grids=.true.)
2094 END IF
2095 END IF
2096 END IF
2097
2098 ! Release embedding potential for subsystem
2099 CALL embed_pot_subsys%release()
2100 DEALLOCATE (embed_pot_subsys)
2101 IF (opt_embed%open_shell_embed) THEN
2102 CALL spin_embed_pot_subsys%release()
2103 DEALLOCATE (spin_embed_pot_subsys)
2104 END IF
2105
2106 END DO ! i_force_eval
2107
2108 ! Print embedding potential for restart
2109 CALL print_embed_restart(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, &
2110 opt_embed%dimen_aux, opt_embed%embed_pot_coef, embed_pot, i_iter, &
2111 spin_embed_pot, opt_embed%open_shell_embed, opt_embed%grid_opt, .false.)
2112 CALL print_pot_simple_grid(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, &
2113 embed_pot, spin_embed_pot, i_iter, opt_embed%open_shell_embed, .false., &
2114 force_env%sub_force_env(cluster_subsys_num)%force_env%qs_env)
2115
2116 ! Integrate the potential over density differences and add to w functional; also add regularization contribution
2117 DO i_spin = 1, nspins ! Sum over nspins for the reference system, not subsystem!
2118 opt_embed%w_func(i_iter) = opt_embed%w_func(i_iter) - pw_integral_ab(embed_pot, rho_r_ref(i_spin))
2119 END DO
2120 ! Spin part
2121 IF (opt_embed%open_shell_embed) THEN
2122 ! If reference system is not spin-polarized then it does not make a contribution to W functional
2123 IF (nspins == 2) THEN
2124 opt_embed%w_func(i_iter) = opt_embed%w_func(i_iter) &
2125 - pw_integral_ab(spin_embed_pot, rho_r_ref(1)) &
2126 + pw_integral_ab(spin_embed_pot, rho_r_ref(2))
2127 END IF
2128 END IF
2129 ! Finally, add the regularization term
2130 opt_embed%w_func(i_iter) = opt_embed%w_func(i_iter) + opt_embed%reg_term
2131
2132 ! Print information and check convergence
2133 CALL print_emb_opt_info(output_unit, i_iter, opt_embed)
2134 CALL conv_check_embed(opt_embed, diff_rho_r, diff_rho_spin, output_unit)
2135 IF (opt_embed%converged) EXIT
2136
2137 ! Update the trust radius and control the step
2138 IF ((i_iter > 1) .AND. (.NOT. opt_embed%steep_desc)) CALL step_control(opt_embed)
2139
2140 ! Print density difference
2141 CALL print_rho_diff(diff_rho_r, i_iter, force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, .false.)
2142 IF (opt_embed%open_shell_embed) THEN ! Spin part
2143 CALL print_rho_spin_diff(diff_rho_spin, i_iter, force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, .false.)
2144 END IF
2145
2146 ! Calculate potential gradient if the step has been accepted. Otherwise, we reuse the previous one
2147
2148 IF (opt_embed%accept_step .AND. (.NOT. opt_embed%grid_opt)) THEN
2149 CALL calculate_embed_pot_grad(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, &
2150 diff_rho_r, diff_rho_spin, opt_embed)
2151 END IF
2152 ! Take the embedding step
2153 CALL opt_embed_step(diff_rho_r, diff_rho_spin, opt_embed, embed_pot, spin_embed_pot, rho_r_ref, &
2154 force_env%sub_force_env(ref_subsys_number)%force_env%qs_env)
2155
2156 END DO ! i_iter
2157
2158 ! Print final embedding potential for restart
2159 CALL print_embed_restart(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, &
2160 opt_embed%dimen_aux, opt_embed%embed_pot_coef, embed_pot, i_iter, &
2161 spin_embed_pot, opt_embed%open_shell_embed, opt_embed%grid_opt, .true.)
2162 CALL print_pot_simple_grid(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, &
2163 embed_pot, spin_embed_pot, i_iter, opt_embed%open_shell_embed, .true., &
2164 force_env%sub_force_env(cluster_subsys_num)%force_env%qs_env)
2165
2166 ! Print final density difference
2167 !CALL print_rho_diff(diff_rho_r, i_iter, force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, .TRUE.)
2168 IF (opt_embed%open_shell_embed) THEN ! Spin part
2169 CALL print_rho_spin_diff(diff_rho_spin, i_iter, force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, .true.)
2170 END IF
2171
2172 ! Give away plane waves pools
2173 CALL diff_rho_r%release()
2174 IF (opt_embed%open_shell_embed) THEN
2175 CALL diff_rho_spin%release()
2176 END IF
2177
2178 CALL cp_print_key_finished_output(output_unit, logger, force_env%force_env_section, &
2179 "PRINT%PROGRAM_RUN_INFO")
2180
2181 ! If converged send the embedding potential to the higher-level calculation.
2182 IF (opt_embed%converged) THEN
2183 CALL get_qs_env(force_env%sub_force_env(ref_subsys_number + 1)%force_env%qs_env, dft_control=dft_control, &
2184 pw_env=pw_env)
2185 nspins_subsys = dft_control%nspins
2186 dft_control%apply_embed_pot = .true.
2187 ! The embedded subsystem corresponds to subsystem #2, where spin change is possible
2188 CALL make_subsys_embed_pot(force_env%sub_force_env(ref_subsys_number + 1)%force_env%qs_env, &
2189 embed_pot, embed_pot_subsys, spin_embed_pot, spin_embed_pot_subsys, &
2190 opt_embed%open_shell_embed, opt_embed%change_spin)
2191
2192 IF (opt_embed%Coulomb_guess) THEN
2193 CALL pw_axpy(opt_embed%pot_diff, embed_pot_subsys, -1.0_dp, allow_noncompatible_grids=.true.)
2194 END IF
2195
2196 CALL set_qs_env(force_env%sub_force_env(ref_subsys_number + 1)%force_env%qs_env, embed_pot=embed_pot_subsys)
2197
2198 IF ((opt_embed%open_shell_embed) .AND. (nspins_subsys == 2)) THEN
2199 CALL set_qs_env(force_env%sub_force_env(ref_subsys_number + 1)%force_env%qs_env, &
2200 spin_embed_pot=spin_embed_pot_subsys)
2201 END IF
2202
2203 ! Substitute the correct energy in energies: only on rank 0
2204 IF (force_env%sub_force_env(cluster_subsys_num)%force_env%para_env%is_source()) THEN
2205 energies(cluster_subsys_num) = cluster_energy
2206 END IF
2207 END IF
2208
2209 ! Deallocate and release opt_embed content
2210 CALL release_opt_embed(opt_embed)
2211
2212 ! Deallocate embedding potential
2213 CALL embed_pot%release()
2214 DEALLOCATE (embed_pot)
2215 IF (opt_embed%open_shell_embed) THEN
2216 CALL spin_embed_pot%release()
2217 DEALLOCATE (spin_embed_pot)
2218 END IF
2219
2220 converged_embed = opt_embed%converged
2221
2222 CALL timestop(handle)
2223
2224 END SUBROUTINE dfet_embedding
2225
2226! **************************************************************************************************
2227!> \brief Main driver for the DMFET embedding
2228!> \param force_env ...
2229!> \param ref_subsys_number ...
2230!> \param energies ...
2231!> \param converged_embed ...
2232!> \author Vladimir Rybkin
2233! **************************************************************************************************
2234 SUBROUTINE dmfet_embedding(force_env, ref_subsys_number, energies, converged_embed)
2235 TYPE(force_env_type), POINTER :: force_env
2236 INTEGER :: ref_subsys_number
2237 REAL(kind=dp), DIMENSION(:), POINTER :: energies
2238 LOGICAL :: converged_embed
2239
2240 CHARACTER(LEN=*), PARAMETER :: routinen = 'dmfet_embedding'
2241
2242 INTEGER :: cluster_subsys_num, handle, &
2243 i_force_eval, i_iter, output_unit
2244 LOGICAL :: subsys_open_shell
2245 REAL(kind=dp) :: cluster_energy
2246 TYPE(cp_logger_type), POINTER :: logger
2247 TYPE(dft_control_type), POINTER :: dft_control
2248 TYPE(mp_para_env_type), POINTER :: para_env
2249 TYPE(opt_dmfet_pot_type) :: opt_dmfet
2250 TYPE(qs_energy_type), POINTER :: energy
2251 TYPE(section_vals_type), POINTER :: dft_section, input, opt_dmfet_section
2252
2253 CALL timeset(routinen, handle)
2254
2255 CALL get_qs_env(qs_env=force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, &
2256 para_env=para_env)
2257
2258 ! Reveal input file
2259 NULLIFY (logger)
2260 logger => cp_get_default_logger()
2261 output_unit = cp_print_key_unit_nr(logger, force_env%force_env_section, "PRINT%PROGRAM_RUN_INFO", &
2262 extension=".Log")
2263
2264 NULLIFY (dft_section, input, opt_dmfet_section)
2265 NULLIFY (energy)
2266
2267 CALL get_qs_env(qs_env=force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, &
2268 energy=energy, input=input)
2269
2270 dft_section => section_vals_get_subs_vals(input, "DFT")
2271 opt_dmfet_section => section_vals_get_subs_vals(input, &
2272 "DFT%QS%OPT_DMFET")
2273
2274 ! We need to understand how to treat spins states
2275 CALL understand_spin_states(force_env, ref_subsys_number, opt_dmfet%change_spin, opt_dmfet%open_shell_embed, &
2276 opt_dmfet%all_nspins)
2277
2278 ! Prepare for the potential optimization
2279 CALL prepare_dmfet_opt(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, &
2280 opt_dmfet, opt_dmfet_section)
2281
2282 ! Get the reference density matrix/matrices
2283 subsys_open_shell = subsys_spin(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env)
2284 CALL build_full_dm(force_env%sub_force_env(ref_subsys_number)%force_env%qs_env, &
2285 opt_dmfet%dm_total, subsys_open_shell, opt_dmfet%open_shell_embed, opt_dmfet%dm_total_beta)
2286
2287 ! Check the preliminary DM difference
2288 CALL cp_fm_copy_general(opt_dmfet%dm_total, opt_dmfet%dm_diff, para_env)
2289 IF (opt_dmfet%open_shell_embed) CALL cp_fm_copy_general(opt_dmfet%dm_total_beta, &
2290 opt_dmfet%dm_diff_beta, para_env)
2291
2292 DO i_force_eval = 1, ref_subsys_number - 1
2293
2294 ! Get the subsystem density matrix/matrices
2295 subsys_open_shell = subsys_spin(force_env%sub_force_env(i_force_eval)%force_env%qs_env)
2296
2297 CALL build_full_dm(force_env%sub_force_env(i_force_eval)%force_env%qs_env, &
2298 opt_dmfet%dm_subsys, subsys_open_shell, opt_dmfet%open_shell_embed, &
2299 opt_dmfet%dm_subsys_beta)
2300
2301 CALL cp_fm_scale_and_add(-1.0_dp, opt_dmfet%dm_diff, 1.0_dp, opt_dmfet%dm_subsys)
2302
2303 IF (opt_dmfet%open_shell_embed) CALL cp_fm_scale_and_add(-1.0_dp, opt_dmfet%dm_diff_beta, &
2304 1.0_dp, opt_dmfet%dm_subsys_beta)
2305
2306 END DO
2307
2308 ! Main loop of iterative matrix potential optimization
2309 DO i_iter = 1, opt_dmfet%n_iter
2310
2311 opt_dmfet%i_iter = i_iter
2312
2313 ! Set the dm difference as the reference one
2314 CALL cp_fm_copy_general(opt_dmfet%dm_total, opt_dmfet%dm_diff, para_env)
2315
2316 IF (opt_dmfet%open_shell_embed) CALL cp_fm_copy_general(opt_dmfet%dm_total_beta, &
2317 opt_dmfet%dm_diff_beta, para_env)
2318
2319 ! Loop over force evaluations
2320 DO i_force_eval = 1, ref_subsys_number - 1
2321
2322 ! Switch on external potential in the subsystems
2323 NULLIFY (dft_control)
2324 CALL get_qs_env(force_env%sub_force_env(i_force_eval)%force_env%qs_env, dft_control=dft_control)
2325 dft_control%apply_dmfet_pot = .true.
2326
2327 ! Calculate the new density
2328 CALL force_env_calc_energy_force(force_env=force_env%sub_force_env(i_force_eval)%force_env, &
2329 calc_force=.false., &
2330 skip_external_control=.true.)
2331
2332 ! Extract subsystem density matrix and energy
2333 NULLIFY (energy)
2334
2335 CALL get_qs_env(force_env%sub_force_env(i_force_eval)%force_env%qs_env, energy=energy)
2336 opt_dmfet%w_func(i_iter) = opt_dmfet%w_func(i_iter) + energy%total
2337
2338 ! Find out which subsystem is the cluster
2339 IF (dft_control%qs_control%cluster_embed_subsys) THEN
2340 cluster_subsys_num = i_force_eval
2341 cluster_energy = energy%total
2342 END IF
2343
2344 ! Add subsystem density matrices
2345 subsys_open_shell = subsys_spin(force_env%sub_force_env(i_force_eval)%force_env%qs_env)
2346
2347 CALL build_full_dm(force_env%sub_force_env(i_force_eval)%force_env%qs_env, &
2348 opt_dmfet%dm_subsys, subsys_open_shell, opt_dmfet%open_shell_embed, &
2349 opt_dmfet%dm_subsys_beta)
2350
2351 IF (opt_dmfet%open_shell_embed) THEN ! Open-shell embedding
2352 ! We may need to change spin ONLY FOR THE SECOND SUBSYSTEM: that's the internal convention
2353 IF ((i_force_eval == 2) .AND. (opt_dmfet%change_spin)) THEN
2354 CALL cp_fm_scale_and_add(-1.0_dp, opt_dmfet%dm_diff_beta, 1.0_dp, opt_dmfet%dm_subsys)
2355 CALL cp_fm_scale_and_add(-1.0_dp, opt_dmfet%dm_diff, 1.0_dp, opt_dmfet%dm_subsys_beta)
2356 ELSE
2357 CALL cp_fm_scale_and_add(-1.0_dp, opt_dmfet%dm_diff, 1.0_dp, opt_dmfet%dm_subsys)
2358 CALL cp_fm_scale_and_add(-1.0_dp, opt_dmfet%dm_diff_beta, 1.0_dp, opt_dmfet%dm_subsys_beta)
2359 END IF
2360 ELSE ! Closed-shell embedding
2361 CALL cp_fm_scale_and_add(-1.0_dp, opt_dmfet%dm_diff, 1.0_dp, opt_dmfet%dm_subsys)
2362 END IF
2363
2364 END DO ! i_force_eval
2365
2366 CALL check_dmfet(opt_dmfet, force_env%sub_force_env(ref_subsys_number)%force_env%qs_env)
2367
2368 END DO ! i_iter
2369
2370 ! Substitute the correct energy in energies: only on rank 0
2371 IF (force_env%sub_force_env(cluster_subsys_num)%force_env%para_env%is_source()) THEN
2372 energies(cluster_subsys_num) = cluster_energy
2373 END IF
2374
2375 CALL release_dmfet_opt(opt_dmfet)
2376
2377 converged_embed = .false.
2378
2379 END SUBROUTINE dmfet_embedding
2380
2381END MODULE force_env_methods
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
Holds information on atomic properties.
subroutine, public atprop_init(atprop_env, natom)
...
collects all references to literature in CP2K as new algorithms / method are included from literature...
integer, save, public huang2011
integer, save, public heaton_burgess2007
Handles all functions related to the CELL.
subroutine, public init_cell(cell, hmat, periodic)
Initialise/readjust a simulation cell after hmat has been changed.
subroutine, public cell_create(cell, hmat, periodic, tag)
allocates and initializes a cell
Handles all functions related to the CELL.
Definition cell_types.F:15
subroutine, public scaled_to_real(r, s, cell)
Transform scaled cell coordinates real coordinates. r=h*s.
Definition cell_types.F:625
integer, parameter, public cell_sym_triclinic
Definition cell_types.F:29
subroutine, public real_to_scaled(s, r, cell)
Transform real to scaled cell coordinates. s=h_inv*r.
Definition cell_types.F:595
subroutine, public cell_release(cell)
releases the given cell (see doc/ReferenceCounting.html)
Definition cell_types.F:668
subroutine, public cell_clone(cell_in, cell_out, tag)
Clone cell variable.
Definition cell_types.F:141
subroutine, public fix_atom_control(force_env, w)
allows for fix atom constraints
Routines to handle the virtual site constraint/restraint.
subroutine, public vsite_force_control(force_env)
control force distribution for virtual sites
methods related to the blacs parallel environment
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
Basic linear algebra operations for full matrices.
subroutine, public cp_fm_scale_and_add(alpha, matrix_a, beta, matrix_b)
calc A <- alpha*A + beta*B optimized for alpha == 1.0 (just add beta*B) and beta == 0....
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
subroutine, public cp_fm_copy_general(source, destination, para_env)
General copy of a fm matrix to another fm matrix. Uses non-blocking MPI rather than ScaLAPACK.
Collection of routines to handle the iteration info.
subroutine, public cp_iteration_info_copy_iter(iteration_info_in, iteration_info_out)
Copies iterations info of an iteration info into another iteration info.
various routines to log and control the output. The idea is that decisions about where to log should ...
subroutine, public cp_rm_default_logger()
the cousin of cp_add_default_logger, decrements the stack, so that the default logger is what it has ...
subroutine, public cp_add_default_logger(logger)
adds a default logger. MUST be called before logging occours
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
integer, parameter, public low_print_level
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
integer, parameter, public cp_p_file
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
set of type/routines to handle the storage of results in force_envs
subroutine, public cp_results_mp_bcast(results, source, para_env)
broadcast results type
subroutine, public cp_results_erase(results, description, nval)
erase a part of result_list
logical function, public test_for_result(results, description)
test for a certain result in the result_list
set of type/routines to handle the storage of results in force_envs
subroutine, public cp_result_copy(results_in, results_out)
Copies the cp_result type.
subroutine, public cp_result_release(results)
Releases cp_result type.
subroutine, public cp_result_create(results)
Allocates and intitializes the cp_result.
types that represent a subsys, i.e. a part of the system
subroutine, public cp_subsys_set(subsys, atomic_kinds, particles, local_particles, molecules, molecule_kinds, local_molecules, para_env, colvar_p, shell_particles, core_particles, gci, multipoles, results, cell, cell_ref, use_ref_cell)
sets various propreties of the subsys
subroutine, public cp_subsys_get(subsys, ref_count, atomic_kinds, atomic_kind_set, particles, particle_set, local_particles, molecules, molecule_set, molecule_kinds, molecule_kind_set, local_molecules, para_env, colvar_p, shell_particles, core_particles, gci, multipoles, natom, nparticle, ncore, nshell, nkind, atprop, virial, results, cell, cell_ref, use_ref_cell)
returns information about various attributes of the given subsys
unit conversion facility
Definition cp_units.F:30
real(kind=dp) function, public cp_unit_from_cp2k(value, unit_str, defaults, power)
converts from the internal cp2k units to the given unit
Definition cp_units.F:1251
The environment for the empirical interatomic potential methods.
Empirical interatomic potentials for Silicon.
Definition eip_silicon.F:17
subroutine, public eip_stillinger_weber(eip_env)
Interface routine of the Stillinger-Weber force field to CP2K.
subroutine, public eip_lenosky(eip_env)
Interface routine of Goedecker's Lenosky force field to CP2K.
subroutine, public eip_tersoff(eip_env)
Interface routine of the Tersoff force field to CP2K.
subroutine, public eip_bazant(eip_env)
Interface routine of Goedecker's Bazant EDIP to CP2K.
Definition eip_silicon.F:76
Methods to include the effect of an external potential during an MD or energy calculation.
subroutine, public add_external_potential(force_env)
...
subroutine, public fist_calc_energy_force(fist_env, debug)
Calculates the total potential energy, total force, and the total pressure tensor from the potentials...
Definition fist_force.F:112
Interface for the force calculations.
recursive subroutine, public force_env_calc_energy_force(force_env, calc_force, consistent_energies, skip_external_control, eval_energy_forces, require_consistent_energy_force, linres, calc_stress_tensor)
Interface routine for force and energy calculations.
subroutine, public force_env_calc_num_pressure(force_env, dx)
Evaluates the stress tensor and pressure numerically.
subroutine, public force_env_create(force_env, root_section, para_env, globenv, fist_env, qs_env, meta_env, sub_force_env, qmmm_env, qmmmx_env, eip_env, pwdft_env, force_env_section, mixed_env, embed_env, nnp_env, ipi_env)
creates and initializes a force environment
Interface for the force calculations.
integer function, public force_env_get_natom(force_env)
returns the number of atoms
integer, parameter, public use_qmmm
integer, parameter, public use_mixed_force
character(len=10), dimension(501:510), parameter, public use_prog_name
integer, parameter, public use_eip_force
recursive subroutine, public force_env_get(force_env, in_use, fist_env, qs_env, meta_env, fp_env, subsys, para_env, potential_energy, additional_potential, kinetic_energy, harmonic_shell, kinetic_shell, cell, sub_force_env, qmmm_env, qmmmx_env, eip_env, pwdft_env, globenv, input, force_env_section, method_name_id, root_section, mixed_env, nnp_env, embed_env, ipi_env)
returns various attributes about the force environment
integer, parameter, public use_embed
integer, parameter, public use_qmmmx
subroutine, public force_env_set(force_env, meta_env, fp_env, force_env_section, method_name_id, additional_potential)
changes some attributes of the force_env
integer, parameter, public use_qs_force
integer, parameter, public use_pwdft_force
integer, parameter, public use_nnp_force
integer, parameter, public use_ipi
integer, parameter, public use_fist_force
Util force_env module.
subroutine, public write_forces(particles, iw, label, ndigits, unit_string, total_force, grand_total_force, zero_force_core_shell_atom)
Write forces either to the screen or to a file.
subroutine, public write_atener(iounit, particles, atener, label)
Write the atomic coordinates, types, and energies.
subroutine, public rescale_forces(force_env)
Rescale forces if requested.
subroutine, public get_generic_info(gen_section, func_name, xfunction, parameters, values, var_values, size_variables, i_rep_sec, input_variables)
Reads from the input structure all information for generic functions.
methods used in the flexible partitioning scheme
Definition fp_methods.F:14
subroutine, public fp_eval(fp_env, subsys, cell)
Computes the forces and the energy due to the flexible potential & bias, and writes the weights file.
Definition fp_methods.F:55
This public domain function parser module is intended for applications where a set of mathematical ex...
Definition fparser.F:17
subroutine, public parsef(i, funcstr, var)
Parse ith function string FuncStr and compile it into bytecode.
Definition fparser.F:174
real(rn) function, public evalf(i, val)
...
Definition fparser.F:206
integer, public evalerrtype
Definition fparser.F:33
real(kind=rn) function, public evalfd(id_fun, ipar, vals, h, err)
Evaluates derivatives.
Definition fparser.F:1097
subroutine, public finalizef()
...
Definition fparser.F:127
subroutine, public initf(n)
...
Definition fparser.F:156
Define type storing the global information of a run. Keep the amount of stored data small....
subroutine, public globenv_retain(globenv)
Retains the global environment globenv.
GRRM interface.
Definition grrm_utils.F:12
subroutine, public write_grrm(iounit, force_env, particles, energy, dipole, hessian, dipder, polar, fixed_atoms)
Write GRRM interface file.
Definition grrm_utils.F:50
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public use_bazant_eip
integer, parameter, public driver_run
integer, parameter, public mixed_cdft_serial
integer, parameter, public mix_cdft
integer, parameter, public do_method_ofgpw
integer, parameter, public mix_linear_combination
integer, parameter, public do_method_rigpw
integer, parameter, public do_method_gpw
integer, parameter, public dmfet
integer, parameter, public use_tersoff_eip
integer, parameter, public use_lenosky_eip
integer, parameter, public ehrenfest
integer, parameter, public use_stillinger_weber_eip
integer, parameter, public mix_coupled
integer, parameter, public debug_run
integer, parameter, public mix_restrained
integer, parameter, public do_method_gapw
integer, parameter, public mix_generic
integer, parameter, public mol_dyn_run
integer, parameter, public dfet
integer, parameter, public cell_opt_run
integer, parameter, public do_method_lrigpw
integer, parameter, public mix_minimum
integer, parameter, public do_method_gapw_xc
integer, parameter, public geo_opt_run
objects that represent the structure of input sections and the data contained in an input section
subroutine, public section_vals_retain(section_vals)
retains the given section values (see doc/ReferenceCounting.html)
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
The environment for the empirical interatomic potential methods.
i–PI server mode: Communication with i–PI clients
Definition ipi_server.F:14
subroutine, public request_forces(ipi_env)
Send atomic positions to a client and retrieve forces.
Definition ipi_server.F:177
sums arrays of real/complex numbers with much reduced round-off as compared to a naive implementation...
Definition kahan_sum.F:29
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_string_length
Definition kinds.F:57
integer, parameter, public default_path_length
Definition kinds.F:58
Routines needed for kpoint calculation.
subroutine, public kpoint_initialize_mos(kpoint, mos, added_mos, for_aux_fit)
Initialize a set of MOs and density matrix for each kpoint (kpoint group)
subroutine, public kpoint_initialize(kpoint, particle_set, cell)
Generate the kpoints and initialize the kpoint environment.
subroutine, public kpoint_env_initialize(kpoint, para_env, blacs_env, with_aux_fit)
Initialize the kpoint environment.
Types and basic routines needed for a kpoint calculation.
subroutine, public set_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, sab_nl, sab_nl_nosym, inversion_symmetry_only, symmetry_backend, symmetry_reduction_method, gamma_centered)
Set information in a kpoint environment.
subroutine, public kpoint_reset_initialization(kpoint)
Reset all data derived from a concrete k-point initialization. Input options such as the scheme,...
subroutine, public get_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, sab_nl, sab_nl_nosym, inversion_symmetry_only, symmetry_backend, symmetry_reduction_method, gamma_centered)
Retrieve information from a kpoint environment.
K-points and crystal symmetry routines based on.
Definition kpsym.F:28
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
subroutine, public m_memory(mem)
Returns the total amount of memory [bytes] in use, if known, zero otherwise.
Definition machine.F:440
Collection of simple mathematical functions and subroutines.
Definition mathlib.F:15
logical function, public abnormal_value(a)
determines if a value is not normal (e.g. for Inf and Nan) based on IO to work also under optimizatio...
Definition mathlib.F:159
Interface to the message passing library MPI.
defines types for metadynamics calculation
Methods for mixed CDFT calculations.
subroutine, public mixed_cdft_calculate_coupling(force_env)
Driver routine to calculate the electronic coupling(s) between CDFT states.
subroutine, public mixed_cdft_build_weight(force_env, calculate_forces, iforce_eval)
Driver routine to handle the build of CDFT weight/gradient in parallel and serial modes.
subroutine, public mixed_cdft_init(force_env, calculate_forces)
Initialize a mixed CDFT calculation.
subroutine, public get_mixed_env(mixed_env, atomic_kind_set, particle_set, local_particles, local_molecules, molecule_kind_set, molecule_set, cell, cell_ref, mixed_energy, para_env, sub_para_env, subsys, input, results, cdft_control)
Get the MIXED environment.
Util mixed_environment.
subroutine, public get_subsys_map_index(mapping_section, natom, iforce_eval, nforce_eval, map_index, force_eval_embed)
performs mapping of the subsystems of different force_eval
subroutine, public mixed_map_forces(particles_mix, virial_mix, results_mix, global_forces, virials, results, factor, iforce_eval, nforce_eval, map_index, mapping_section, overwrite)
Maps forces between the different force_eval sections/environments.
represent a simple array based list of the given type
Define the molecule kind structure types and the corresponding functionality.
subroutine, public get_molecule_kind(molecule_kind, atom_list, bond_list, bend_list, ub_list, impr_list, opbend_list, colv_list, fixd_list, g3x3_list, g4x6_list, vsite_list, torsion_list, shell_list, name, mass, charge, kind_number, natom, nbend, nbond, nub, nimpr, nopbend, nconstraint, nconstraint_fixd, nfixd, ncolv, ng3x3, ng4x6, nvsite, nfixd_restraint, ng3x3_restraint, ng4x6_restraint, nvsite_restraint, nrestraints, nmolecule, nsgf, nshell, ntorsion, molecule_list, nelectron, nelectron_alpha, nelectron_beta, bond_kind_set, bend_kind_set, ub_kind_set, impr_kind_set, opbend_kind_set, torsion_kind_set, molname_generated)
Get informations about a molecule kind.
Data types for neural network potentials.
Methods dealing with Neural Network potentials.
Definition nnp_force.F:14
subroutine, public nnp_calc_energy_force(nnp, calc_forces)
Calculate the energy and force for a given configuration with the NNP.
Definition nnp_force.F:64
subroutine, public check_dmfet(opt_dmfet, qs_env)
...
subroutine, public release_dmfet_opt(opt_dmfet)
...
subroutine, public build_full_dm(qs_env, dm, open_shell, open_shell_embed, dm_beta)
Builds density matrices from MO coefficients in full matrix format.
subroutine, public prepare_dmfet_opt(qs_env, opt_dmfet, opt_dmfet_section)
...
logical function, public subsys_spin(qs_env)
...
subroutine, public print_embed_restart(qs_env, dimen_aux, embed_pot_coef, embed_pot, i_iter, embed_pot_spin, open_shell_embed, grid_opt, final_one)
Print embedding potential as a cube and as a binary (for restarting)
subroutine, public make_subsys_embed_pot(qs_env, embed_pot, embed_pot_subsys, spin_embed_pot, spin_embed_pot_subsys, open_shell_embed, change_spin_sign)
Creates a subsystem embedding potential.
subroutine, public print_rho_spin_diff(spin_diff_rho_r, i_iter, qs_env, final_one)
Prints a cube for the (spin_rho_A + spin_rho_B - spin_rho_ref) to be minimized in embedding.
subroutine, public get_max_subsys_diff(opt_embed, force_env, subsys_num)
...
subroutine, public print_emb_opt_info(output_unit, step_num, opt_embed)
...
subroutine, public init_embed_pot(qs_env, embed_pot, add_const_pot, fermi_amaldi, const_pot, open_shell_embed, spin_embed_pot, pot_diff, coulomb_guess, grid_opt)
...
subroutine, public understand_spin_states(force_env, ref_subsys_number, change_spin, open_shell_embed, all_nspins)
Find out whether we need to swap alpha- and beta- spind densities in the second subsystem.
subroutine, public read_embed_pot(qs_env, embed_pot, spin_embed_pot, section, opt_embed)
...
subroutine, public get_prev_density(opt_embed, force_env, subsys_num)
...
subroutine, public coulomb_guess(v_rspace, rhs, mapping_section, qs_env, nforce_eval, iforce_eval, eta)
Calculates subsystem Coulomb potential from the RESP charges of the total system.
subroutine, public print_rho_diff(diff_rho_r, i_iter, qs_env, final_one)
Prints a cube for the (rho_A + rho_B - rho_ref) to be minimized in embedding.
subroutine, public conv_check_embed(opt_embed, diff_rho_r, diff_rho_spin, output_unit)
...
subroutine, public step_control(opt_embed)
Controls the step, changes the trust radius if needed in maximization of the V_emb.
subroutine, public opt_embed_step(diff_rho_r, diff_rho_spin, opt_embed, embed_pot, spin_embed_pot, rho_r_ref, qs_env)
Takes maximization step in embedding potential optimization.
subroutine, public calculate_embed_pot_grad(qs_env, diff_rho_r, diff_rho_spin, opt_embed)
Calculates the derivative of the embedding potential wrt to the expansion coefficients.
subroutine, public print_pot_simple_grid(qs_env, embed_pot, embed_pot_spin, i_iter, open_shell_embed, final_one, qs_env_cluster)
Prints a volumetric file: X Y Z value for interfacing with external programs.
subroutine, public prepare_embed_opt(qs_env, opt_embed, opt_embed_section)
Creates and allocates objects for optimization of embedding potential.
subroutine, public release_opt_embed(opt_embed)
Deallocate stuff for optimizing embedding potential.
represent a simple array based list of the given type
Define the data structure for the particle information.
Definition of physical constants:
Definition physcon.F:68
real(kind=dp), parameter, public debye
Definition physcon.F:201
container for various plainwaves related things
subroutine, public pw_env_get(pw_env, pw_pools, cube_info, gridlevel_info, auxbas_pw_pool, auxbas_grid, auxbas_rs_desc, auxbas_rs_grid, rs_descs, rs_grids, xc_pw_pool, vdw_pw_pool, poisson_env, interp_section)
returns the various attributes of the pw env
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
The type definitions for the PWDFT environment.
Methods and functions on the PWDFT environment.
subroutine, public pwdft_calc_energy_force(pwdft_env, calculate_forces, calculate_stress)
Calculate energy and forces within the PWDFT/SIRIUS code.
Calculates QM/MM energy and forces.
Definition qmmm_force.F:14
subroutine, public qmmm_calc_energy_force(qmmm_env, calc_force, consistent_energies, linres)
calculates the qm/mm energy and forces
Definition qmmm_force.F:76
Basic container type for QM/MM.
Definition qmmm_types.F:12
subroutine, public apply_qmmm_translate(qmmm_env)
Apply translation to the full system in order to center the QM system into the QM box.
Definition qmmm_util.F:375
Calculates QM/MM energy and forces with Force-Mixing.
Definition qmmmx_force.F:14
subroutine, public qmmmx_calc_energy_force(qmmmx_env, calc_force, consistent_energies, linres, require_consistent_energy_force)
calculates the qm/mm energy and forces
Definition qmmmx_force.F:66
Basic container type for QM/MM with force mixing.
Definition qmmmx_types.F:12
Atomic Polarization Tensor calculation by dF/d(E-field) finite differences.
subroutine, public apt_fdiff(force_env)
Calculate Atomic Polarization Tensors by dF/d(E-field) finite differences.
subroutine, public qs_basis_rotation(qs_env, kpoints, basis_type)
Construct basis set rotation matrices.
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, mimic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, matrix_vhxc, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, xcint_weights, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
subroutine, public set_qs_env(qs_env, super_cell, mos, qmmm, qmmm_periodic, mimic, ewald_env, ewald_pw, mpools, rho_external, external_vxc, mask, scf_control, rel_control, qs_charges, ks_env, ks_qmmm_env, wf_history, scf_env, active_space, input, oce, rho_atom_set, rho0_atom_set, rho0_mpole, run_rtp, rtp, rhoz_set, rhoz_tot, ecoul_1c, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, efield, rhoz_cneo_set, linres_control, xas_env, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, ls_scf_env, do_transport, transport_env, lri_env, lri_density, exstate_env, ec_env, dispersion_env, harris_env, gcp_env, mp2_env, bs_env, kg_env, force, kpoints, wanniercentres, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Set the QUICKSTEP environment.
Quickstep force driver routine.
Definition qs_force.F:12
subroutine, public qs_calc_energy_force(qs_env, calc_force, consistent_energies, linres)
...
Definition qs_force.F:111
Definition and initialisation of the mo data type.
Definition qs_mo_types.F:22
superstucture that hold various representations of the density and keeps track of which ones are vali...
subroutine, public qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, rho_r_sccs, soft_valid, complex_rho_ao)
returns info about the density described by this object. If some representation is not available an e...
interpolate the wavefunctions to speed up the convergence when doing MD
subroutine, public wfi_clear(wf_history)
Clear stored wavefunction snapshots while preserving history settings.
Handles all possible kinds of restraints in CP2K.
Definition restraint.F:14
subroutine, public restraint_control(force_env)
Computes restraints.
Definition restraint.F:67
SCINE interface.
Definition scine_utils.F:12
subroutine, public write_scine(iounit, force_env, particles, energy, hessian)
Write SCINE interface file.
Definition scine_utils.F:46
Utilities for string manipulations.
subroutine, public compress(string, full)
Eliminate multiple space characters in a string. If full is .TRUE., then all spaces are eliminated.
subroutine, public write_stress_tensor(pv_virial, iw, cell, unit_string, numerical)
Print stress tensor to output file.
subroutine, public write_stress_tensor_components(virial, iw, cell, unit_string)
...
subroutine, public zero_virial(virial, reset)
...
subroutine, public symmetrize_virial(virial)
Symmetrize the virial components.
type for the atomic properties
Type defining parameters related to the simulation cell.
Definition cell_types.F:60
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
type of a logger, at the moment it contains just a print level starting at which level it should be l...
contains arbitrary information which need to be stored
represent a pointer to a subsys, to be able to create arrays of pointers
represents a system: atoms, molecules, their pos,vel,...
The empirical interatomic potential environment.
Embedding environment type.
Type containing main data for matrix embedding potential optimization.
Type containing main data for embedding potential optimization.
Definition embed_types.F:67
allows for the creation of an array of force_env
wrapper to abstract the force evaluation of the various methods
contains the initially parsed file and the initial parallel environment
Keeps symmetry information about a specific k-point.
Contains information about kpoints.
stores all the informations relevant to an mpi environment
Main data type collecting all relevant data for neural network potentials.
contained for different pw related things
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
keeps the density in various representations, keeping track of which ones are valid.
keeps track of the previous wavefunctions and can extrapolate them for the next step of md