(git:0de0cc2)
external_potential_methods.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
8 ! **************************************************************************************************
9 !> \brief Methods to include the effect of an external potential during an MD
10 !> or energy calculation
11 !> \author Teodoro Laino (03.2008) [tlaino]
12 ! **************************************************************************************************
15  cp_logger_type,&
16  cp_to_string
17  USE cp_subsys_types, ONLY: cp_subsys_get,&
18  cp_subsys_type
19  USE force_env_types, ONLY: force_env_get,&
21  force_env_type
23  USE fparser, ONLY: evalf,&
24  evalfd,&
25  finalizef,&
26  initf,&
27  parsef
30  section_vals_type,&
32  USE kinds, ONLY: default_path_length,&
34  dp
35  USE memory_utilities, ONLY: reallocate
36  USE particle_list_types, ONLY: particle_list_type
37  USE string_utilities, ONLY: compress
38 #include "./base/base_uses.f90"
39 
40  IMPLICIT NONE
41 
42  PRIVATE
43  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'external_potential_methods'
44  PUBLIC :: add_external_potential
45 
46 CONTAINS
47 
48 ! **************************************************************************************************
49 !> \brief ...
50 !> \param force_env ...
51 !> \date 03.2008
52 !> \author Teodoro Laino - University of Zurich [tlaino]
53 ! **************************************************************************************************
54  SUBROUTINE add_external_potential(force_env)
55  TYPE(force_env_type), POINTER :: force_env
56 
57  CHARACTER(len=*), PARAMETER :: routinen = 'add_external_potential'
58 
59  CHARACTER(LEN=default_path_length) :: coupling_function
60  CHARACTER(LEN=default_string_length) :: def_error, this_error
61  CHARACTER(LEN=default_string_length), &
62  DIMENSION(:), POINTER :: my_par
63  INTEGER :: a_var, handle, i, iatom, j, k, n_var, &
64  natom, rep
65  INTEGER, DIMENSION(:), POINTER :: iatms, nparticle
66  LOGICAL :: useall
67  REAL(kind=dp) :: dedf, dx, energy, err, lerr
68  REAL(kind=dp), DIMENSION(:), POINTER :: my_val
69  TYPE(cp_logger_type), POINTER :: logger
70  TYPE(cp_subsys_type), POINTER :: subsys
71  TYPE(particle_list_type), POINTER :: particles
72  TYPE(section_vals_type), POINTER :: ext_pot_section
73 
74  useall = .false.
75  CALL timeset(routinen, handle)
76  NULLIFY (my_par, my_val, logger, subsys, particles, ext_pot_section, nparticle)
77  ext_pot_section => section_vals_get_subs_vals(force_env%force_env_section, &
78  "EXTERNAL_POTENTIAL")
79  CALL section_vals_get(ext_pot_section, n_repetition=n_var)
80  DO rep = 1, n_var
81  natom = 0
82  logger => cp_get_default_logger()
83  CALL section_vals_val_get(ext_pot_section, "DX", r_val=dx, i_rep_section=rep)
84  CALL section_vals_val_get(ext_pot_section, "ERROR_LIMIT", r_val=lerr, i_rep_section=rep)
85  CALL get_generic_info(ext_pot_section, "FUNCTION", coupling_function, my_par, my_val, &
86  input_variables=(/"X", "Y", "Z"/), i_rep_sec=rep)
87  CALL initf(1)
88  CALL parsef(1, trim(coupling_function), my_par)
89 
90  ! Apply potential on all atoms, computing energy and forces
91  NULLIFY (particles, subsys)
92  CALL force_env_get(force_env, subsys=subsys)
93  CALL cp_subsys_get(subsys, particles=particles)
94  CALL force_env_get(force_env, additional_potential=energy)
95  CALL section_vals_val_get(ext_pot_section, "ATOMS_LIST", n_rep_val=a_var, i_rep_section=rep)
96  DO k = 1, a_var
97  CALL section_vals_val_get(ext_pot_section, "ATOMS_LIST", i_rep_val=k, i_vals=iatms, i_rep_section=rep)
98  CALL reallocate(nparticle, 1, natom + SIZE(iatms))
99  nparticle(natom + 1:natom + SIZE(iatms)) = iatms
100  natom = natom + SIZE(iatms)
101  END DO
102  IF (a_var == 0) THEN
103  natom = particles%n_els
104  useall = .true.
105  END IF
106  DO i = 1, natom
107  IF (useall) THEN
108  iatom = i
109  ELSE
110  iatom = nparticle(i)
111  END IF
112  my_val(1) = particles%els(iatom)%r(1)
113  my_val(2) = particles%els(iatom)%r(2)
114  my_val(3) = particles%els(iatom)%r(3)
115 
116  energy = energy + evalf(1, my_val)
117  DO j = 1, 3
118  dedf = evalfd(1, j, my_val, dx, err)
119  IF (abs(err) > lerr) THEN
120  WRITE (this_error, "(A,G12.6,A)") "(", err, ")"
121  WRITE (def_error, "(A,G12.6,A)") "(", lerr, ")"
122  CALL compress(this_error, .true.)
123  CALL compress(def_error, .true.)
124  CALL cp_warn(__location__, &
125  'ASSERTION (cond) failed at line '//cp_to_string(__line__)// &
126  ' Error '//trim(this_error)//' in computing numerical derivatives larger then'// &
127  trim(def_error)//' .')
128  END IF
129  particles%els(iatom)%f(j) = particles%els(iatom)%f(j) - dedf
130  END DO
131  END DO
132  CALL force_env_set(force_env, additional_potential=energy)
133  DEALLOCATE (my_par)
134  DEALLOCATE (my_val)
135  IF (a_var /= 0) THEN
136  DEALLOCATE (nparticle)
137  END IF
138  CALL finalizef()
139  END DO
140  CALL timestop(handle)
141  END SUBROUTINE add_external_potential
142 
various routines to log and control the output. The idea is that decisions about where to log should ...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
types that represent a subsys, i.e. a part of the system
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)
returns information about various attributes of the given subsys
Methods to include the effect of an external potential during an MD or energy calculation.
subroutine, public add_external_potential(force_env)
...
Interface for the force calculations.
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)
returns various attributes about the force environment
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
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.
This public domain function parser module is intended for applications where a set of mathematical ex...
Definition: fparser.F:17
real(rn) function, public evalf(i, Val)
...
Definition: fparser.F:180
real(kind=rn) function, public evalfd(id_fun, ipar, vals, h, err)
Evaluates derivatives.
Definition: fparser.F:976
subroutine, public finalizef()
...
Definition: fparser.F:101
subroutine, public initf(n)
...
Definition: fparser.F:130
subroutine, public parsef(i, FuncStr, Var)
Parse ith function string FuncStr and compile it into bytecode.
Definition: fparser.F:148
objects that represent the structure of input sections and the data contained in an input section
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_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
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
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
Utility routines for the memory handling.
represent a simple array based list of the given type
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.